-- | Module containing time conversion functions. These functions are assuming
-- that there is never going to be a different slot or epoch length and project
-- a slot/time accordingly.
--
-- See Hydra.Chain.Direct.TimeHandle for an alternative that uses the
-- cardano-node provided 'EraSummary' to do "correct" translation on time.
module Hydra.Ledger.Cardano.Time where

import Hydra.Prelude

import Cardano.Slotting.Slot (SlotNo (..))
import Cardano.Slotting.Time (RelativeTime (..), SlotLength, SystemStart, getSlotLength, getSystemStart, toRelativeTime)

-- | Convert a 'SlotNo' to a 'UTCTime' using given 'SystemStart' and
-- 'SlotLength'. This assumes the slot length never changes!
slotNoToUTCTime :: SystemStart -> SlotLength -> SlotNo -> UTCTime
slotNoToUTCTime :: SystemStart -> SlotLength -> SlotNo -> UTCTime
slotNoToUTCTime SystemStart
systemStart SlotLength
slotLength SlotNo
slotNo =
  (NominalDiffTime
numberOfSlots NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
slotDuration) NominalDiffTime -> UTCTime -> UTCTime
`addUTCTime` UTCTime
startTime
 where
  startTime :: UTCTime
startTime = SystemStart -> UTCTime
getSystemStart SystemStart
systemStart

  slotDuration :: NominalDiffTime
slotDuration = SlotLength -> NominalDiffTime
getSlotLength SlotLength
slotLength

  numberOfSlots :: NominalDiffTime
numberOfSlots = Word64 -> NominalDiffTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> NominalDiffTime) -> Word64 -> NominalDiffTime
forall a b. (a -> b) -> a -> b
$ SlotNo -> Word64
unSlotNo SlotNo
slotNo

-- | Convert a 'UTCTime' to a 'SlotNo' using given 'SystemStart' and
-- 'SlotLength'. This assumes the slot length never changes! Also if the UTCTime
-- is before the systemStart it will truncate to slot 0.
slotNoFromUTCTime :: SystemStart -> SlotLength -> UTCTime -> SlotNo
slotNoFromUTCTime :: SystemStart -> SlotLength -> UTCTime -> SlotNo
slotNoFromUTCTime SystemStart
systemStart SlotLength
slotLength UTCTime
utcTime =
  Word64 -> SlotNo
SlotNo (Word64 -> SlotNo) -> Word64 -> SlotNo
forall a b. (a -> b) -> a -> b
$ NominalDiffTime -> Word64
forall b. Integral b => NominalDiffTime -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate (NominalDiffTime
relativeTime NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Fractional a => a -> a -> a
/ SlotLength -> NominalDiffTime
getSlotLength SlotLength
slotLength)
 where
  (RelativeTime NominalDiffTime
relativeTime) =
    SystemStart -> UTCTime -> RelativeTime
toRelativeTime SystemStart
systemStart UTCTime
utcTime