{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE RankNTypes #-}

module Cardano.Slotting.EpochInfo.API
  ( EpochInfo (..),
    epochInfoSize,
    epochInfoFirst,
    epochInfoEpoch,
    epochInfoRange,
    epochInfoSlotToRelativeTime,
    epochInfoSlotToUTCTime,
    epochInfoSlotLength,

    -- * Utility
    hoistEpochInfo,
    generalizeEpochInfo,
  )
where

import Cardano.Slotting.Slot (EpochNo (..), EpochSize (..), SlotNo (..))
import Cardano.Slotting.Time (RelativeTime, SystemStart, fromRelativeTime, SlotLength)
import Control.Monad.Morph (generalize)
import Data.Functor.Identity
import Data.Time.Clock (UTCTime)
import GHC.Stack (HasCallStack)
import NoThunks.Class (NoThunks, OnlyCheckWhnfNamed (..))

-- | Information about epochs
--
-- Different epochs may have different sizes and different slot lengths. This
-- information is encapsulated by 'EpochInfo'. It is parameterized over a monad
-- @m@ because the information about how long each epoch is may depend on
-- information derived from the blockchain itself. It ultimately requires acess
-- to state, and so either uses the monad for that or uses the monad to reify
-- failure due to cached state information being too stale for the current
-- query.
data EpochInfo m
  = EpochInfo
      { -- | Return the size of the given epoch as a number of slots
        --
        -- Note that the number of slots does /not/ bound the number of blocks,
        -- since the EBB and a regular block share a slot number.
        EpochInfo m -> HasCallStack => EpochNo -> m EpochSize
epochInfoSize_ :: HasCallStack => EpochNo -> m EpochSize,
        -- | First slot in the specified epoch
        --
        -- See also 'epochInfoRange'
        EpochInfo m -> HasCallStack => EpochNo -> m SlotNo
epochInfoFirst_ :: HasCallStack => EpochNo -> m SlotNo,
        -- | Epoch containing the given slot
        --
        -- We should have the property that
        --
        -- > s `inRange` epochInfoRange (epochInfoEpoch s)
        EpochInfo m -> HasCallStack => SlotNo -> m EpochNo
epochInfoEpoch_ :: HasCallStack => SlotNo -> m EpochNo,
        -- | The 'RelativeTime' of the start of the given slot
        --
        -- This calculation depends on the varying slot lengths of the relevant
        -- epochs.
        --
        -- See also 'epochInfoSlotToUTCTime'.
        EpochInfo m -> HasCallStack => SlotNo -> m RelativeTime
epochInfoSlotToRelativeTime_ ::
          HasCallStack => SlotNo -> m RelativeTime,
        -- | Return the length of the specified slot.
        EpochInfo m -> HasCallStack => SlotNo -> m SlotLength
epochInfoSlotLength_ ::
          HasCallStack => SlotNo -> m SlotLength
      }
  deriving Context -> EpochInfo m -> IO (Maybe ThunkInfo)
Proxy (EpochInfo m) -> String
(Context -> EpochInfo m -> IO (Maybe ThunkInfo))
-> (Context -> EpochInfo m -> IO (Maybe ThunkInfo))
-> (Proxy (EpochInfo m) -> String)
-> NoThunks (EpochInfo m)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
forall (m :: * -> *).
Context -> EpochInfo m -> IO (Maybe ThunkInfo)
forall (m :: * -> *). Proxy (EpochInfo m) -> String
showTypeOf :: Proxy (EpochInfo m) -> String
$cshowTypeOf :: forall (m :: * -> *). Proxy (EpochInfo m) -> String
wNoThunks :: Context -> EpochInfo m -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall (m :: * -> *).
Context -> EpochInfo m -> IO (Maybe ThunkInfo)
noThunks :: Context -> EpochInfo m -> IO (Maybe ThunkInfo)
$cnoThunks :: forall (m :: * -> *).
Context -> EpochInfo m -> IO (Maybe ThunkInfo)
NoThunks via OnlyCheckWhnfNamed "EpochInfo" (EpochInfo m)

-- | Unhelpful instance, but this type occurs in records (eg @Shelley.Globals@)
-- that we want to be able to 'show'
instance Show (EpochInfo f) where
  showsPrec :: Int -> EpochInfo f -> ShowS
showsPrec Int
_ EpochInfo f
_ = String -> ShowS
showString String
"EpochInfoHasNoUsefulShowInstance"

epochInfoRange :: Monad m => EpochInfo m -> EpochNo -> m (SlotNo, SlotNo)
epochInfoRange :: EpochInfo m -> EpochNo -> m (SlotNo, SlotNo)
epochInfoRange EpochInfo m
epochInfo EpochNo
epochNo =
  SlotNo -> EpochSize -> (SlotNo, SlotNo)
aux (SlotNo -> EpochSize -> (SlotNo, SlotNo))
-> m SlotNo -> m (EpochSize -> (SlotNo, SlotNo))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EpochInfo m -> EpochNo -> m SlotNo
forall (m :: * -> *).
HasCallStack =>
EpochInfo m -> EpochNo -> m SlotNo
epochInfoFirst EpochInfo m
epochInfo EpochNo
epochNo
    m (EpochSize -> (SlotNo, SlotNo))
-> m EpochSize -> m (SlotNo, SlotNo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> EpochInfo m -> EpochNo -> m EpochSize
forall (m :: * -> *).
HasCallStack =>
EpochInfo m -> EpochNo -> m EpochSize
epochInfoSize EpochInfo m
epochInfo EpochNo
epochNo
  where
    aux :: SlotNo -> EpochSize -> (SlotNo, SlotNo)
    aux :: SlotNo -> EpochSize -> (SlotNo, SlotNo)
aux (SlotNo Word64
s) (EpochSize Word64
sz) = (Word64 -> SlotNo
SlotNo Word64
s, Word64 -> SlotNo
SlotNo (Word64
s Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
sz Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
1))

-- | The start of the given slot
epochInfoSlotToUTCTime ::
     (HasCallStack, Monad m)
  => EpochInfo m
  -> SystemStart
  -> SlotNo
  -> m UTCTime
epochInfoSlotToUTCTime :: EpochInfo m -> SystemStart -> SlotNo -> m UTCTime
epochInfoSlotToUTCTime EpochInfo m
ei SystemStart
start SlotNo
sl =
  SystemStart -> RelativeTime -> UTCTime
fromRelativeTime SystemStart
start (RelativeTime -> UTCTime) -> m RelativeTime -> m UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EpochInfo m -> SlotNo -> m RelativeTime
forall (m :: * -> *).
HasCallStack =>
EpochInfo m -> SlotNo -> m RelativeTime
epochInfoSlotToRelativeTime EpochInfo m
ei SlotNo
sl

{-------------------------------------------------------------------------------
  Extraction functions that preserve the HasCallStack constraint

  (Ideally, ghc would just do this..)
-------------------------------------------------------------------------------}

epochInfoSize :: HasCallStack => EpochInfo m -> EpochNo -> m EpochSize
epochInfoSize :: EpochInfo m -> EpochNo -> m EpochSize
epochInfoSize = EpochInfo m -> EpochNo -> m EpochSize
forall (m :: * -> *).
EpochInfo m -> HasCallStack => EpochNo -> m EpochSize
epochInfoSize_

epochInfoFirst :: HasCallStack => EpochInfo m -> EpochNo -> m SlotNo
epochInfoFirst :: EpochInfo m -> EpochNo -> m SlotNo
epochInfoFirst = EpochInfo m -> EpochNo -> m SlotNo
forall (m :: * -> *).
EpochInfo m -> HasCallStack => EpochNo -> m SlotNo
epochInfoFirst_

epochInfoEpoch :: HasCallStack => EpochInfo m -> SlotNo -> m EpochNo
epochInfoEpoch :: EpochInfo m -> SlotNo -> m EpochNo
epochInfoEpoch = EpochInfo m -> SlotNo -> m EpochNo
forall (m :: * -> *).
EpochInfo m -> HasCallStack => SlotNo -> m EpochNo
epochInfoEpoch_

epochInfoSlotToRelativeTime ::
  HasCallStack => EpochInfo m -> SlotNo -> m RelativeTime
epochInfoSlotToRelativeTime :: EpochInfo m -> SlotNo -> m RelativeTime
epochInfoSlotToRelativeTime = EpochInfo m -> SlotNo -> m RelativeTime
forall (m :: * -> *).
EpochInfo m -> HasCallStack => SlotNo -> m RelativeTime
epochInfoSlotToRelativeTime_

epochInfoSlotLength ::
  HasCallStack => EpochInfo m -> SlotNo -> m SlotLength
epochInfoSlotLength :: EpochInfo m -> SlotNo -> m SlotLength
epochInfoSlotLength = EpochInfo m -> SlotNo -> m SlotLength
forall (m :: * -> *).
EpochInfo m -> HasCallStack => SlotNo -> m SlotLength
epochInfoSlotLength_

{-------------------------------------------------------------------------------
  Utility
-------------------------------------------------------------------------------}

hoistEpochInfo :: (forall a. m a -> n a) -> EpochInfo m -> EpochInfo n
hoistEpochInfo :: (forall a. m a -> n a) -> EpochInfo m -> EpochInfo n
hoistEpochInfo forall a. m a -> n a
f EpochInfo m
ei = EpochInfo :: forall (m :: * -> *).
(HasCallStack => EpochNo -> m EpochSize)
-> (HasCallStack => EpochNo -> m SlotNo)
-> (HasCallStack => SlotNo -> m EpochNo)
-> (HasCallStack => SlotNo -> m RelativeTime)
-> (HasCallStack => SlotNo -> m SlotLength)
-> EpochInfo m
EpochInfo
  { epochInfoSize_ :: HasCallStack => EpochNo -> n EpochSize
epochInfoSize_ = m EpochSize -> n EpochSize
forall a. m a -> n a
f (m EpochSize -> n EpochSize)
-> (EpochNo -> m EpochSize) -> EpochNo -> n EpochSize
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EpochInfo m -> EpochNo -> m EpochSize
forall (m :: * -> *).
HasCallStack =>
EpochInfo m -> EpochNo -> m EpochSize
epochInfoSize EpochInfo m
ei,
    epochInfoFirst_ :: HasCallStack => EpochNo -> n SlotNo
epochInfoFirst_ = m SlotNo -> n SlotNo
forall a. m a -> n a
f (m SlotNo -> n SlotNo)
-> (EpochNo -> m SlotNo) -> EpochNo -> n SlotNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EpochInfo m -> EpochNo -> m SlotNo
forall (m :: * -> *).
HasCallStack =>
EpochInfo m -> EpochNo -> m SlotNo
epochInfoFirst EpochInfo m
ei,
    epochInfoEpoch_ :: HasCallStack => SlotNo -> n EpochNo
epochInfoEpoch_ = m EpochNo -> n EpochNo
forall a. m a -> n a
f (m EpochNo -> n EpochNo)
-> (SlotNo -> m EpochNo) -> SlotNo -> n EpochNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EpochInfo m -> SlotNo -> m EpochNo
forall (m :: * -> *).
HasCallStack =>
EpochInfo m -> SlotNo -> m EpochNo
epochInfoEpoch EpochInfo m
ei,
    epochInfoSlotToRelativeTime_ :: HasCallStack => SlotNo -> n RelativeTime
epochInfoSlotToRelativeTime_ = m RelativeTime -> n RelativeTime
forall a. m a -> n a
f (m RelativeTime -> n RelativeTime)
-> (SlotNo -> m RelativeTime) -> SlotNo -> n RelativeTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EpochInfo m -> SlotNo -> m RelativeTime
forall (m :: * -> *).
HasCallStack =>
EpochInfo m -> SlotNo -> m RelativeTime
epochInfoSlotToRelativeTime EpochInfo m
ei,
    epochInfoSlotLength_ :: HasCallStack => SlotNo -> n SlotLength
epochInfoSlotLength_ = m SlotLength -> n SlotLength
forall a. m a -> n a
f (m SlotLength -> n SlotLength)
-> (SlotNo -> m SlotLength) -> SlotNo -> n SlotLength
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EpochInfo m -> SlotNo -> m SlotLength
forall (m :: * -> *).
HasCallStack =>
EpochInfo m -> SlotNo -> m SlotLength
epochInfoSlotLength EpochInfo m
ei
  }

generalizeEpochInfo :: Monad m => EpochInfo Identity -> EpochInfo m
generalizeEpochInfo :: EpochInfo Identity -> EpochInfo m
generalizeEpochInfo = (forall a. Identity a -> m a) -> EpochInfo Identity -> EpochInfo m
forall (m :: * -> *) (n :: * -> *).
(forall a. m a -> n a) -> EpochInfo m -> EpochInfo n
hoistEpochInfo forall a. Identity a -> m a
forall (m :: * -> *) a. Monad m => Identity a -> m a
generalize