module Cardano.Slotting.EpochInfo.Extend where

import Cardano.Slotting.EpochInfo.API (EpochInfo (..))
import Cardano.Slotting.Slot (
  EpochNo (EpochNo),
  EpochSize (EpochSize),
  SlotNo (SlotNo),
  binOpEpochNo,
 )
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 :: forall (m :: * -> *).
Monad m =>
SlotNo -> EpochInfo m -> EpochInfo m
unsafeLinearExtendEpochInfo SlotNo
basisSlot EpochInfo m
underlyingEI =
  let lastKnownEpochM :: m EpochNo
lastKnownEpochM = forall (m :: * -> *).
EpochInfo m -> (?callStack::CallStack) => 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 forall a. Ord a => a -> a -> Bool
<= EpochNo
lke
          then forall (m :: * -> *).
EpochInfo m -> (?callStack::CallStack) => EpochNo -> m EpochSize
epochInfoSize_ EpochInfo m
underlyingEI EpochNo
en
          else forall (m :: * -> *).
EpochInfo m -> (?callStack::CallStack) => 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 forall a. Ord a => a -> a -> Bool
<= EpochNo
lke
          then forall (m :: * -> *).
EpochInfo m -> (?callStack::CallStack) => EpochNo -> m SlotNo
epochInfoFirst_ EpochInfo m
underlyingEI EpochNo
en
          else do
            SlotNo Word64
lkeStart <- forall (m :: * -> *).
EpochInfo m -> (?callStack::CallStack) => EpochNo -> m SlotNo
epochInfoFirst_ EpochInfo m
underlyingEI EpochNo
lke
            EpochSize Word64
sz <- forall (m :: * -> *).
EpochInfo m -> (?callStack::CallStack) => EpochNo -> m EpochSize
epochInfoSize_ EpochInfo m
underlyingEI EpochNo
en
            let EpochNo Word64
numEpochs = (Word64 -> Word64 -> Word64) -> EpochNo -> EpochNo -> EpochNo
binOpEpochNo (-) EpochNo
en EpochNo
lke
            forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> SlotNo
SlotNo forall a b. (a -> b) -> a -> b
$ Word64
lkeStart forall a. Num a => a -> a -> a
+ (Word64
numEpochs forall a. Num a => a -> a -> a
* Word64
sz)
      goEpoch :: SlotNo -> m EpochNo
goEpoch = \SlotNo
sn ->
        if SlotNo
sn forall a. Ord a => a -> a -> Bool
<= SlotNo
basisSlot
          then forall (m :: * -> *).
EpochInfo m -> (?callStack::CallStack) => SlotNo -> m EpochNo
epochInfoEpoch_ EpochInfo m
underlyingEI SlotNo
sn
          else do
            EpochNo
lke <- m EpochNo
lastKnownEpochM
            SlotNo
lkeStart <- forall (m :: * -> *).
EpochInfo m -> (?callStack::CallStack) => EpochNo -> m SlotNo
epochInfoFirst_ EpochInfo m
underlyingEI EpochNo
lke
            EpochSize Word64
sz <- forall (m :: * -> *).
EpochInfo m -> (?callStack::CallStack) => EpochNo -> m EpochSize
epochInfoSize_ EpochInfo m
underlyingEI EpochNo
lke
            let SlotNo Word64
slotsForward = SlotNo
sn forall a. Num a => a -> a -> a
- SlotNo
lkeStart
            forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64 -> Word64 -> Word64) -> EpochNo -> EpochNo -> EpochNo
binOpEpochNo forall a. Num a => a -> a -> a
(+) EpochNo
lke forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> EpochNo
EpochNo forall a b. (a -> b) -> a -> b
$ Word64
slotsForward forall a. Integral a => a -> a -> a
`div` Word64
sz
      goTime :: SlotNo -> m RelativeTime
goTime = \SlotNo
sn ->
        if SlotNo
sn forall a. Ord a => a -> a -> Bool
<= SlotNo
basisSlot
          then forall (m :: * -> *).
EpochInfo m -> (?callStack::CallStack) => SlotNo -> m RelativeTime
epochInfoSlotToRelativeTime_ EpochInfo m
underlyingEI SlotNo
sn
          else do
            let SlotNo Word64
slotDiff = SlotNo
sn forall a. Num a => a -> a -> a
- SlotNo
basisSlot

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

            forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
              NominalDiffTime -> RelativeTime -> RelativeTime
addRelativeTime
                (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 forall a. Ord a => a -> a -> Bool
<= SlotNo
basisSlot
          then forall (m :: * -> *).
EpochInfo m -> (?callStack::CallStack) => SlotNo -> m SlotLength
epochInfoSlotLength_ EpochInfo m
underlyingEI SlotNo
sn
          else forall (m :: * -> *).
EpochInfo m -> (?callStack::CallStack) => SlotNo -> m SlotLength
epochInfoSlotLength_ EpochInfo m
underlyingEI SlotNo
basisSlot
   in EpochInfo
        { epochInfoSize_ :: (?callStack::CallStack) => EpochNo -> m EpochSize
epochInfoSize_ = EpochNo -> m EpochSize
goSize
        , epochInfoFirst_ :: (?callStack::CallStack) => EpochNo -> m SlotNo
epochInfoFirst_ = EpochNo -> m SlotNo
goFirst
        , epochInfoEpoch_ :: (?callStack::CallStack) => SlotNo -> m EpochNo
epochInfoEpoch_ = SlotNo -> m EpochNo
goEpoch
        , epochInfoSlotToRelativeTime_ :: (?callStack::CallStack) => SlotNo -> m RelativeTime
epochInfoSlotToRelativeTime_ = SlotNo -> m RelativeTime
goTime
        , epochInfoSlotLength_ :: (?callStack::CallStack) => SlotNo -> m SlotLength
epochInfoSlotLength_ = SlotNo -> m SlotLength
goLength
        }