-- | 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
  -> WithOrigin SlotNo
     -- ^ Slot we are comparing a new epoch against
  -> SlotNo
      -- ^ Slot we want to check
  -> 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
    EpochNo
oldEpoch  <- case WithOrigin SlotNo
reference of
                   WithOrigin SlotNo
Origin      -> EpochNo -> Identity EpochNo
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
epochSize <- EpochInfo Identity -> EpochNo -> Identity EpochSize
forall (m :: * -> *).
HasCallStack =>
EpochInfo m -> EpochNo -> m EpochSize
epochInfoSize  EpochInfo Identity
ei EpochNo
oldEpoch
    SlotNo
firstSlot <- EpochInfo Identity -> EpochNo -> Identity SlotNo
forall (m :: * -> *).
HasCallStack =>
EpochInfo m -> EpochNo -> m SlotNo
epochInfoFirst EpochInfo Identity
ei EpochNo
oldEpoch

    let epochsAfter :: Word64
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 :: EpochNo
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.
    Bool -> Identity Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> Identity Bool) -> Bool -> Identity Bool
forall a b. (a -> b) -> a -> b
$ EpochNo
newEpoch EpochNo -> EpochNo -> Bool
forall a. Ord a => a -> a -> Bool
> EpochNo
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
    EpochNo
epoch <- EpochInfo Identity -> SlotNo -> Identity EpochNo
forall (m :: * -> *).
HasCallStack =>
EpochInfo m -> SlotNo -> m EpochNo
epochInfoEpoch EpochInfo Identity
ei SlotNo
slot
    EpochInfo Identity -> EpochNo -> Identity SlotNo
forall (m :: * -> *).
HasCallStack =>
EpochInfo m -> EpochNo -> m SlotNo
epochInfoFirst EpochInfo Identity
ei EpochNo
epoch