-- | Assorted utility functions for Shelley protocol integration.
--
-- In particular, various things we need for integration with the @delegation@
-- package from cardano-ledger-specs.
module Ouroboros.Consensus.Protocol.Ledger.Util
  ( firstSlotOfEpochOfSlot
  , isNewEpoch
  ) where

import Cardano.Slotting.EpochInfo
import Data.Functor.Identity (Identity (..))
import Ouroboros.Consensus.Block
import Ouroboros.Consensus.HardFork.History.Util
  ( addEpochs
  , countSlots
  )

-- | Verify whether a slot represents a change to a new epoch with regard to
-- some other slot.
--
-- PRECONDITION: the two slots must be in the same era.
isNewEpoch ::
  EpochInfo Identity ->
  -- | Slot we are comparing a new epoch against
  WithOrigin SlotNo ->
  -- | Slot we want to check
  SlotNo ->
  Bool
isNewEpoch :: EpochInfo Identity -> WithOrigin SlotNo -> SlotNo -> Bool
isNewEpoch EpochInfo Identity
ei WithOrigin SlotNo
reference SlotNo
newSlot = Identity Bool -> Bool
forall a. Identity a -> a
runIdentity (Identity Bool -> Bool) -> Identity Bool -> Bool
forall a b. (a -> b) -> a -> b
$ do
  oldEpoch <- case WithOrigin SlotNo
reference of
    WithOrigin SlotNo
Origin -> EpochNo -> Identity EpochNo
forall a. a -> Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (EpochNo -> Identity EpochNo) -> EpochNo -> Identity EpochNo
forall a b. (a -> b) -> a -> b
$ Word64 -> EpochNo
EpochNo Word64
0
    NotOrigin SlotNo
s -> EpochInfo Identity -> SlotNo -> Identity EpochNo
forall (m :: * -> *).
HasCallStack =>
EpochInfo m -> SlotNo -> m EpochNo
epochInfoEpoch EpochInfo Identity
ei SlotNo
s
  epochSize <- epochInfoSize ei oldEpoch
  firstSlot <- epochInfoFirst ei oldEpoch

  let epochsAfter = (HasCallStack => SlotNo -> SlotNo -> Word64
SlotNo -> SlotNo -> Word64
countSlots SlotNo
newSlot SlotNo
firstSlot) Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`div` EpochSize -> Word64
unEpochSize EpochSize
epochSize
      newEpoch = Word64 -> EpochNo -> EpochNo
addEpochs Word64
epochsAfter EpochNo
oldEpoch
  -- Note that we don't call:
  -- > epochInfoEpoch ei newSlot
  -- because the 'EpochInfo' might have limited range. The precondition
  -- justifies the calculation that we do here.
  pure $ newEpoch > oldEpoch

-- | Return the first slot in the epoch of the given slot.
firstSlotOfEpochOfSlot ::
  EpochInfo Identity ->
  SlotNo ->
  SlotNo
firstSlotOfEpochOfSlot :: EpochInfo Identity -> SlotNo -> SlotNo
firstSlotOfEpochOfSlot EpochInfo Identity
ei SlotNo
slot = Identity SlotNo -> SlotNo
forall a. Identity a -> a
runIdentity (Identity SlotNo -> SlotNo) -> Identity SlotNo -> SlotNo
forall a b. (a -> b) -> a -> b
$ do
  epoch <- EpochInfo Identity -> SlotNo -> Identity EpochNo
forall (m :: * -> *).
HasCallStack =>
EpochInfo m -> SlotNo -> m EpochNo
epochInfoEpoch EpochInfo Identity
ei SlotNo
slot
  epochInfoFirst ei epoch