module Cardano.Slotting.EpochInfo.Extend where

import Cardano.Slotting.EpochInfo.API (EpochInfo (..))
import Cardano.Slotting.Slot (EpochNo (EpochNo), EpochSize (EpochSize), SlotNo (SlotNo))
import Cardano.Slotting.Time
  ( SlotLength (getSlotLength),
    addRelativeTime,
    multNominalDiffTime,
  )

-- | Given a basis point, use it and its slot length to impute a linear
-- relationship between slots and time in order to extend an 'EpochInfo' to
-- infinity.
--
-- The returned `EpochInfo` may still fail (according to the semantics of the
-- specified monad) if any of the underlying operations fail. For example, if we
-- cannot translate the basis point.
unsafeLinearExtendEpochInfo ::
  Monad m =>
  SlotNo ->
  EpochInfo m ->
  EpochInfo m
unsafeLinearExtendEpochInfo :: SlotNo -> EpochInfo m -> EpochInfo m
unsafeLinearExtendEpochInfo SlotNo
basisSlot EpochInfo m
underlyingEI =
  let lastKnownEpochM :: m EpochNo
lastKnownEpochM = EpochInfo m -> SlotNo -> m EpochNo
forall (m :: * -> *).
EpochInfo m -> HasCallStack => SlotNo -> m EpochNo
epochInfoEpoch_ EpochInfo m
underlyingEI SlotNo
basisSlot

      goSize :: EpochNo -> m EpochSize
goSize = \EpochNo
en -> do
        EpochNo
lke <- m EpochNo
lastKnownEpochM
        if EpochNo
en EpochNo -> EpochNo -> Bool
forall a. Ord a => a -> a -> Bool
<= EpochNo
lke
          then EpochInfo m -> EpochNo -> m EpochSize
forall (m :: * -> *).
EpochInfo m -> HasCallStack => EpochNo -> m EpochSize
epochInfoSize_ EpochInfo m
underlyingEI EpochNo
en
          else EpochInfo m -> EpochNo -> m EpochSize
forall (m :: * -> *).
EpochInfo m -> HasCallStack => EpochNo -> m EpochSize
epochInfoSize_ EpochInfo m
underlyingEI EpochNo
lke
      goFirst :: EpochNo -> m SlotNo
goFirst = \EpochNo
en -> do
        EpochNo
lke <- m EpochNo
lastKnownEpochM
        if EpochNo
en EpochNo -> EpochNo -> Bool
forall a. Ord a => a -> a -> Bool
<= EpochNo
lke
          then EpochInfo m -> EpochNo -> m SlotNo
forall (m :: * -> *).
EpochInfo m -> HasCallStack => EpochNo -> m SlotNo
epochInfoFirst_ EpochInfo m
underlyingEI EpochNo
en
          else do
            SlotNo Word64
lkeStart <- EpochInfo m -> EpochNo -> m SlotNo
forall (m :: * -> *).
EpochInfo m -> HasCallStack => EpochNo -> m SlotNo
epochInfoFirst_ EpochInfo m
underlyingEI EpochNo
lke
            EpochSize Word64
sz <- EpochInfo m -> EpochNo -> m EpochSize
forall (m :: * -> *).
EpochInfo m -> HasCallStack => EpochNo -> m EpochSize
epochInfoSize_ EpochInfo m
underlyingEI EpochNo
en
            let EpochNo Word64
numEpochs = EpochNo
en EpochNo -> EpochNo -> EpochNo
forall a. Num a => a -> a -> a
- EpochNo
lke
            SlotNo -> m SlotNo
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SlotNo -> m SlotNo) -> (Word64 -> SlotNo) -> Word64 -> m SlotNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> SlotNo
SlotNo (Word64 -> m SlotNo) -> Word64 -> m SlotNo
forall a b. (a -> b) -> a -> b
$ Word64
lkeStart Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ (Word64
numEpochs Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
sz)
      goEpoch :: SlotNo -> m EpochNo
goEpoch = \SlotNo
sn ->
        if SlotNo
sn SlotNo -> SlotNo -> Bool
forall a. Ord a => a -> a -> Bool
<= SlotNo
basisSlot
          then EpochInfo m -> SlotNo -> m EpochNo
forall (m :: * -> *).
EpochInfo m -> HasCallStack => SlotNo -> m EpochNo
epochInfoEpoch_ EpochInfo m
underlyingEI SlotNo
sn
          else do
            EpochNo
lke <- m EpochNo
lastKnownEpochM
            SlotNo
lkeStart <- EpochInfo m -> EpochNo -> m SlotNo
forall (m :: * -> *).
EpochInfo m -> HasCallStack => EpochNo -> m SlotNo
epochInfoFirst_ EpochInfo m
underlyingEI EpochNo
lke
            EpochSize Word64
sz <- EpochInfo m -> EpochNo -> m EpochSize
forall (m :: * -> *).
EpochInfo m -> HasCallStack => EpochNo -> m EpochSize
epochInfoSize_ EpochInfo m
underlyingEI EpochNo
lke
            let SlotNo Word64
slotsForward = SlotNo
sn SlotNo -> SlotNo -> SlotNo
forall a. Num a => a -> a -> a
- SlotNo
lkeStart
            EpochNo -> m EpochNo
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EpochNo -> m EpochNo)
-> (Word64 -> EpochNo) -> Word64 -> m EpochNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EpochNo
lke EpochNo -> EpochNo -> EpochNo
forall a. Num a => a -> a -> a
+) (EpochNo -> EpochNo) -> (Word64 -> EpochNo) -> Word64 -> EpochNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> EpochNo
EpochNo (Word64 -> m EpochNo) -> Word64 -> m EpochNo
forall a b. (a -> b) -> a -> b
$ Word64
slotsForward Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`div` Word64
sz
      goTime :: SlotNo -> m RelativeTime
goTime = \SlotNo
sn ->
        if SlotNo
sn SlotNo -> SlotNo -> Bool
forall a. Ord a => a -> a -> Bool
<= SlotNo
basisSlot
          then EpochInfo m -> SlotNo -> m RelativeTime
forall (m :: * -> *).
EpochInfo m -> HasCallStack => SlotNo -> m RelativeTime
epochInfoSlotToRelativeTime_ EpochInfo m
underlyingEI SlotNo
sn
          else do
            let SlotNo Word64
slotDiff = SlotNo
sn SlotNo -> SlotNo -> SlotNo
forall a. Num a => a -> a -> a
- SlotNo
basisSlot

            RelativeTime
a1 <- EpochInfo m -> SlotNo -> m RelativeTime
forall (m :: * -> *).
EpochInfo m -> HasCallStack => SlotNo -> m RelativeTime
epochInfoSlotToRelativeTime_ EpochInfo m
underlyingEI SlotNo
basisSlot
            SlotLength
lgth <- EpochInfo m -> SlotNo -> m SlotLength
forall (m :: * -> *).
EpochInfo m -> HasCallStack => SlotNo -> m SlotLength
epochInfoSlotLength_ EpochInfo m
underlyingEI SlotNo
basisSlot

            RelativeTime -> m RelativeTime
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelativeTime -> m RelativeTime) -> RelativeTime -> m RelativeTime
forall a b. (a -> b) -> a -> b
$
              NominalDiffTime -> RelativeTime -> RelativeTime
addRelativeTime
                (NominalDiffTime -> Word64 -> NominalDiffTime
forall f. Integral f => NominalDiffTime -> f -> NominalDiffTime
multNominalDiffTime (SlotLength -> NominalDiffTime
getSlotLength SlotLength
lgth) Word64
slotDiff)
                RelativeTime
a1
      goLength :: SlotNo -> m SlotLength
goLength = \SlotNo
sn ->
        if SlotNo
sn SlotNo -> SlotNo -> Bool
forall a. Ord a => a -> a -> Bool
<= SlotNo
basisSlot
          then EpochInfo m -> SlotNo -> m SlotLength
forall (m :: * -> *).
EpochInfo m -> HasCallStack => SlotNo -> m SlotLength
epochInfoSlotLength_ EpochInfo m
underlyingEI SlotNo
sn
          else EpochInfo m -> SlotNo -> m SlotLength
forall (m :: * -> *).
EpochInfo m -> HasCallStack => SlotNo -> m SlotLength
epochInfoSlotLength_ EpochInfo m
underlyingEI SlotNo
basisSlot
   in 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 -> m EpochSize
epochInfoSize_ = HasCallStack => EpochNo -> m EpochSize
EpochNo -> m EpochSize
goSize,
          epochInfoFirst_ :: HasCallStack => EpochNo -> m SlotNo
epochInfoFirst_ = HasCallStack => EpochNo -> m SlotNo
EpochNo -> m SlotNo
goFirst,
          epochInfoEpoch_ :: HasCallStack => SlotNo -> m EpochNo
epochInfoEpoch_ = HasCallStack => SlotNo -> m EpochNo
SlotNo -> m EpochNo
goEpoch,
          epochInfoSlotToRelativeTime_ :: HasCallStack => SlotNo -> m RelativeTime
epochInfoSlotToRelativeTime_ = HasCallStack => SlotNo -> m RelativeTime
SlotNo -> m RelativeTime
goTime,
          epochInfoSlotLength_ :: HasCallStack => SlotNo -> m SlotLength
epochInfoSlotLength_ = HasCallStack => SlotNo -> m SlotLength
SlotNo -> m SlotLength
goLength
        }