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

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

    -- * Utility
    hoistEpochInfo,
    generalizeEpochInfo,
  )
where

import Cardano.Slotting.Slot (EpochNo (..), EpochSize (..), SlotNo (..))
import Control.Monad.Morph (generalize)
import Data.Functor.Classes (showsUnaryWith)
import Data.Functor.Identity
import GHC.Stack (HasCallStack)
import NoThunks.Class (NoThunks, OnlyCheckWhnfNamed (..))

-- | Information about epochs
--
-- Epochs may have different sizes at different times during the lifetime of the
-- blockchain. 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, and
-- hence requires access to state.
--
-- The other functions provide some derived information from epoch sizes. In the
-- default implementation all of these functions query and update an internal
-- cache maintaining cumulative epoch sizes; for that reason, all of these
-- functions live in a monad @m@.
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
      }
  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)

-- | Show instance only for non-stateful instances
instance Show (EpochInfo Identity) where
  showsPrec :: Int -> EpochInfo Identity -> ShowS
showsPrec Int
p EpochInfo Identity
ei =
    (Int -> EpochSize -> ShowS) -> String -> Int -> EpochSize -> ShowS
forall a. (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
showsUnaryWith Int -> EpochSize -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec String
"fixedSizeEpochInfo" Int
p
      (EpochSize -> ShowS) -> EpochSize -> ShowS
forall a b. (a -> b) -> a -> b
$ Identity EpochSize -> EpochSize
forall a. Identity a -> a
runIdentity
      (Identity EpochSize -> EpochSize)
-> Identity EpochSize -> EpochSize
forall a b. (a -> b) -> a -> b
$ EpochInfo Identity -> EpochNo -> Identity EpochSize
forall (m :: * -> *).
HasCallStack =>
EpochInfo m -> EpochNo -> m EpochSize
epochInfoSize EpochInfo Identity
ei (Word64 -> EpochNo
EpochNo Word64
0)

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))

{-------------------------------------------------------------------------------
  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_

{-------------------------------------------------------------------------------
  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)
-> 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
  }

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