{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Cardano.Slotting.Time (
  -- * System time
  SystemStart (..),

  -- * Relative time
  RelativeTime (..),
  addRelativeTime,
  diffRelativeTime,
  fromRelativeTime,
  multRelativeTime,
  toRelativeTime,

  -- * Nominal diff time
  multNominalDiffTime,

  -- * Slot length
  getSlotLength,
  mkSlotLength,

  -- ** Conversions
  slotLengthFromMillisec,
  slotLengthFromSec,
  slotLengthToMillisec,
  slotLengthToSec,

  -- ** opaque
  SlotLength,
) where

import Cardano.Binary (FromCBOR (..), ToCBOR (..))
import Codec.Serialise
import Control.Exception (assert)
import Data.Aeson (FromJSON, ToJSON)
import Data.Fixed
import Data.Time (
  NominalDiffTime,
  UTCTime,
  addUTCTime,
  diffUTCTime,
  nominalDiffTimeToSeconds,
  secondsToNominalDiffTime,
 )
import GHC.Generics (Generic)
import NoThunks.Class (InspectHeap (..), NoThunks)
import Quiet

{-------------------------------------------------------------------------------
  System start
-------------------------------------------------------------------------------}

-- | System start
--
-- Slots are counted from the system start.
newtype SystemStart = SystemStart {SystemStart -> UTCTime
getSystemStart :: UTCTime}
  deriving (SystemStart -> SystemStart -> Bool
(SystemStart -> SystemStart -> Bool)
-> (SystemStart -> SystemStart -> Bool) -> Eq SystemStart
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SystemStart -> SystemStart -> Bool
== :: SystemStart -> SystemStart -> Bool
$c/= :: SystemStart -> SystemStart -> Bool
/= :: SystemStart -> SystemStart -> Bool
Eq, (forall x. SystemStart -> Rep SystemStart x)
-> (forall x. Rep SystemStart x -> SystemStart)
-> Generic SystemStart
forall x. Rep SystemStart x -> SystemStart
forall x. SystemStart -> Rep SystemStart x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SystemStart -> Rep SystemStart x
from :: forall x. SystemStart -> Rep SystemStart x
$cto :: forall x. Rep SystemStart x -> SystemStart
to :: forall x. Rep SystemStart x -> SystemStart
Generic)
  deriving (Context -> SystemStart -> IO (Maybe ThunkInfo)
Proxy SystemStart -> String
(Context -> SystemStart -> IO (Maybe ThunkInfo))
-> (Context -> SystemStart -> IO (Maybe ThunkInfo))
-> (Proxy SystemStart -> String)
-> NoThunks SystemStart
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> SystemStart -> IO (Maybe ThunkInfo)
noThunks :: Context -> SystemStart -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> SystemStart -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> SystemStart -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy SystemStart -> String
showTypeOf :: Proxy SystemStart -> String
NoThunks) via InspectHeap SystemStart
  deriving (Int -> SystemStart -> ShowS
[SystemStart] -> ShowS
SystemStart -> String
(Int -> SystemStart -> ShowS)
-> (SystemStart -> String)
-> ([SystemStart] -> ShowS)
-> Show SystemStart
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SystemStart -> ShowS
showsPrec :: Int -> SystemStart -> ShowS
$cshow :: SystemStart -> String
show :: SystemStart -> String
$cshowList :: [SystemStart] -> ShowS
showList :: [SystemStart] -> ShowS
Show) via Quiet SystemStart
  deriving newtype ([SystemStart] -> Encoding
SystemStart -> Encoding
(SystemStart -> Encoding)
-> (forall s. Decoder s SystemStart)
-> ([SystemStart] -> Encoding)
-> (forall s. Decoder s [SystemStart])
-> Serialise SystemStart
forall s. Decoder s [SystemStart]
forall s. Decoder s SystemStart
forall a.
(a -> Encoding)
-> (forall s. Decoder s a)
-> ([a] -> Encoding)
-> (forall s. Decoder s [a])
-> Serialise a
$cencode :: SystemStart -> Encoding
encode :: SystemStart -> Encoding
$cdecode :: forall s. Decoder s SystemStart
decode :: forall s. Decoder s SystemStart
$cencodeList :: [SystemStart] -> Encoding
encodeList :: [SystemStart] -> Encoding
$cdecodeList :: forall s. Decoder s [SystemStart]
decodeList :: forall s. Decoder s [SystemStart]
Serialise)
  deriving newtype (Typeable SystemStart
Typeable SystemStart =>
(SystemStart -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy SystemStart -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [SystemStart] -> Size)
-> ToCBOR SystemStart
SystemStart -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [SystemStart] -> Size
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy SystemStart -> Size
forall a.
Typeable a =>
(a -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> ToCBOR a
$ctoCBOR :: SystemStart -> Encoding
toCBOR :: SystemStart -> Encoding
$cencodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy SystemStart -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy SystemStart -> Size
$cencodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [SystemStart] -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [SystemStart] -> Size
ToCBOR, Typeable SystemStart
Typeable SystemStart =>
(forall s. Decoder s SystemStart)
-> (Proxy SystemStart -> Text) -> FromCBOR SystemStart
Proxy SystemStart -> Text
forall s. Decoder s SystemStart
forall a.
Typeable a =>
(forall s. Decoder s a) -> (Proxy a -> Text) -> FromCBOR a
$cfromCBOR :: forall s. Decoder s SystemStart
fromCBOR :: forall s. Decoder s SystemStart
$clabel :: Proxy SystemStart -> Text
label :: Proxy SystemStart -> Text
FromCBOR, [SystemStart] -> Value
[SystemStart] -> Encoding
SystemStart -> Bool
SystemStart -> Value
SystemStart -> Encoding
(SystemStart -> Value)
-> (SystemStart -> Encoding)
-> ([SystemStart] -> Value)
-> ([SystemStart] -> Encoding)
-> (SystemStart -> Bool)
-> ToJSON SystemStart
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: SystemStart -> Value
toJSON :: SystemStart -> Value
$ctoEncoding :: SystemStart -> Encoding
toEncoding :: SystemStart -> Encoding
$ctoJSONList :: [SystemStart] -> Value
toJSONList :: [SystemStart] -> Value
$ctoEncodingList :: [SystemStart] -> Encoding
toEncodingList :: [SystemStart] -> Encoding
$comitField :: SystemStart -> Bool
omitField :: SystemStart -> Bool
ToJSON, Maybe SystemStart
Value -> Parser [SystemStart]
Value -> Parser SystemStart
(Value -> Parser SystemStart)
-> (Value -> Parser [SystemStart])
-> Maybe SystemStart
-> FromJSON SystemStart
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser SystemStart
parseJSON :: Value -> Parser SystemStart
$cparseJSONList :: Value -> Parser [SystemStart]
parseJSONList :: Value -> Parser [SystemStart]
$comittedField :: Maybe SystemStart
omittedField :: Maybe SystemStart
FromJSON)

{-------------------------------------------------------------------------------
  Relative time
-------------------------------------------------------------------------------}

-- | 'RelativeTime' is time relative to the 'SystemStart'
--
-- Precision is in picoseconds
newtype RelativeTime = RelativeTime {RelativeTime -> NominalDiffTime
getRelativeTime :: NominalDiffTime}
  deriving stock (RelativeTime -> RelativeTime -> Bool
(RelativeTime -> RelativeTime -> Bool)
-> (RelativeTime -> RelativeTime -> Bool) -> Eq RelativeTime
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RelativeTime -> RelativeTime -> Bool
== :: RelativeTime -> RelativeTime -> Bool
$c/= :: RelativeTime -> RelativeTime -> Bool
/= :: RelativeTime -> RelativeTime -> Bool
Eq, Eq RelativeTime
Eq RelativeTime =>
(RelativeTime -> RelativeTime -> Ordering)
-> (RelativeTime -> RelativeTime -> Bool)
-> (RelativeTime -> RelativeTime -> Bool)
-> (RelativeTime -> RelativeTime -> Bool)
-> (RelativeTime -> RelativeTime -> Bool)
-> (RelativeTime -> RelativeTime -> RelativeTime)
-> (RelativeTime -> RelativeTime -> RelativeTime)
-> Ord RelativeTime
RelativeTime -> RelativeTime -> Bool
RelativeTime -> RelativeTime -> Ordering
RelativeTime -> RelativeTime -> RelativeTime
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: RelativeTime -> RelativeTime -> Ordering
compare :: RelativeTime -> RelativeTime -> Ordering
$c< :: RelativeTime -> RelativeTime -> Bool
< :: RelativeTime -> RelativeTime -> Bool
$c<= :: RelativeTime -> RelativeTime -> Bool
<= :: RelativeTime -> RelativeTime -> Bool
$c> :: RelativeTime -> RelativeTime -> Bool
> :: RelativeTime -> RelativeTime -> Bool
$c>= :: RelativeTime -> RelativeTime -> Bool
>= :: RelativeTime -> RelativeTime -> Bool
$cmax :: RelativeTime -> RelativeTime -> RelativeTime
max :: RelativeTime -> RelativeTime -> RelativeTime
$cmin :: RelativeTime -> RelativeTime -> RelativeTime
min :: RelativeTime -> RelativeTime -> RelativeTime
Ord, (forall x. RelativeTime -> Rep RelativeTime x)
-> (forall x. Rep RelativeTime x -> RelativeTime)
-> Generic RelativeTime
forall x. Rep RelativeTime x -> RelativeTime
forall x. RelativeTime -> Rep RelativeTime x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RelativeTime -> Rep RelativeTime x
from :: forall x. RelativeTime -> Rep RelativeTime x
$cto :: forall x. Rep RelativeTime x -> RelativeTime
to :: forall x. Rep RelativeTime x -> RelativeTime
Generic)
  deriving newtype (Context -> RelativeTime -> IO (Maybe ThunkInfo)
Proxy RelativeTime -> String
(Context -> RelativeTime -> IO (Maybe ThunkInfo))
-> (Context -> RelativeTime -> IO (Maybe ThunkInfo))
-> (Proxy RelativeTime -> String)
-> NoThunks RelativeTime
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> RelativeTime -> IO (Maybe ThunkInfo)
noThunks :: Context -> RelativeTime -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> RelativeTime -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> RelativeTime -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy RelativeTime -> String
showTypeOf :: Proxy RelativeTime -> String
NoThunks)
  deriving (Int -> RelativeTime -> ShowS
[RelativeTime] -> ShowS
RelativeTime -> String
(Int -> RelativeTime -> ShowS)
-> (RelativeTime -> String)
-> ([RelativeTime] -> ShowS)
-> Show RelativeTime
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RelativeTime -> ShowS
showsPrec :: Int -> RelativeTime -> ShowS
$cshow :: RelativeTime -> String
show :: RelativeTime -> String
$cshowList :: [RelativeTime] -> ShowS
showList :: [RelativeTime] -> ShowS
Show) via Quiet RelativeTime
  deriving newtype ([RelativeTime] -> Value
[RelativeTime] -> Encoding
RelativeTime -> Bool
RelativeTime -> Value
RelativeTime -> Encoding
(RelativeTime -> Value)
-> (RelativeTime -> Encoding)
-> ([RelativeTime] -> Value)
-> ([RelativeTime] -> Encoding)
-> (RelativeTime -> Bool)
-> ToJSON RelativeTime
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: RelativeTime -> Value
toJSON :: RelativeTime -> Value
$ctoEncoding :: RelativeTime -> Encoding
toEncoding :: RelativeTime -> Encoding
$ctoJSONList :: [RelativeTime] -> Value
toJSONList :: [RelativeTime] -> Value
$ctoEncodingList :: [RelativeTime] -> Encoding
toEncodingList :: [RelativeTime] -> Encoding
$comitField :: RelativeTime -> Bool
omitField :: RelativeTime -> Bool
ToJSON, Maybe RelativeTime
Value -> Parser [RelativeTime]
Value -> Parser RelativeTime
(Value -> Parser RelativeTime)
-> (Value -> Parser [RelativeTime])
-> Maybe RelativeTime
-> FromJSON RelativeTime
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser RelativeTime
parseJSON :: Value -> Parser RelativeTime
$cparseJSONList :: Value -> Parser [RelativeTime]
parseJSONList :: Value -> Parser [RelativeTime]
$comittedField :: Maybe RelativeTime
omittedField :: Maybe RelativeTime
FromJSON)

instance ToCBOR RelativeTime where
  toCBOR :: RelativeTime -> Encoding
toCBOR = Pico -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Pico -> Encoding)
-> (RelativeTime -> Pico) -> RelativeTime -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NominalDiffTime -> Pico
nominalDiffTimeToSeconds (NominalDiffTime -> Pico)
-> (RelativeTime -> NominalDiffTime) -> RelativeTime -> Pico
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RelativeTime -> NominalDiffTime
getRelativeTime

instance FromCBOR RelativeTime where
  fromCBOR :: forall s. Decoder s RelativeTime
fromCBOR = NominalDiffTime -> RelativeTime
RelativeTime (NominalDiffTime -> RelativeTime)
-> (Pico -> NominalDiffTime) -> Pico -> RelativeTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pico -> NominalDiffTime
secondsToNominalDiffTime (Pico -> RelativeTime) -> Decoder s Pico -> Decoder s RelativeTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Pico
forall s. Decoder s Pico
forall a s. FromCBOR a => Decoder s a
fromCBOR

instance Serialise RelativeTime where
  encode :: RelativeTime -> Encoding
encode = RelativeTime -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR
  decode :: forall s. Decoder s RelativeTime
decode = Decoder s RelativeTime
forall s. Decoder s RelativeTime
forall a s. FromCBOR a => Decoder s a
fromCBOR

addRelativeTime :: NominalDiffTime -> RelativeTime -> RelativeTime
addRelativeTime :: NominalDiffTime -> RelativeTime -> RelativeTime
addRelativeTime NominalDiffTime
delta (RelativeTime NominalDiffTime
t) = NominalDiffTime -> RelativeTime
RelativeTime (NominalDiffTime
t NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
+ NominalDiffTime
delta)

diffRelativeTime :: RelativeTime -> RelativeTime -> NominalDiffTime
diffRelativeTime :: RelativeTime -> RelativeTime -> NominalDiffTime
diffRelativeTime (RelativeTime NominalDiffTime
t) (RelativeTime NominalDiffTime
t') = NominalDiffTime
t NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
- NominalDiffTime
t'

toRelativeTime :: SystemStart -> UTCTime -> RelativeTime
toRelativeTime :: SystemStart -> UTCTime -> RelativeTime
toRelativeTime (SystemStart UTCTime
t) UTCTime
t' =
  Bool -> RelativeTime -> RelativeTime
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (UTCTime
t' UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
>= UTCTime
t) (RelativeTime -> RelativeTime) -> RelativeTime -> RelativeTime
forall a b. (a -> b) -> a -> b
$
    NominalDiffTime -> RelativeTime
RelativeTime (UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
t' UTCTime
t)

fromRelativeTime :: SystemStart -> RelativeTime -> UTCTime
fromRelativeTime :: SystemStart -> RelativeTime -> UTCTime
fromRelativeTime (SystemStart UTCTime
t) (RelativeTime NominalDiffTime
t') = NominalDiffTime -> UTCTime -> UTCTime
addUTCTime NominalDiffTime
t' UTCTime
t

multRelativeTime :: Integral f => RelativeTime -> f -> RelativeTime
multRelativeTime :: forall f. Integral f => RelativeTime -> f -> RelativeTime
multRelativeTime (RelativeTime NominalDiffTime
t) =
  NominalDiffTime -> RelativeTime
RelativeTime (NominalDiffTime -> RelativeTime)
-> (f -> NominalDiffTime) -> f -> RelativeTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NominalDiffTime -> f -> NominalDiffTime
forall f. Integral f => NominalDiffTime -> f -> NominalDiffTime
multNominalDiffTime NominalDiffTime
t

multNominalDiffTime :: Integral f => NominalDiffTime -> f -> NominalDiffTime
multNominalDiffTime :: forall f. Integral f => NominalDiffTime -> f -> NominalDiffTime
multNominalDiffTime NominalDiffTime
t f
f =
  Pico -> NominalDiffTime
secondsToNominalDiffTime (Pico -> NominalDiffTime) -> Pico -> NominalDiffTime
forall a b. (a -> b) -> a -> b
$
    NominalDiffTime -> Pico
nominalDiffTimeToSeconds NominalDiffTime
t Pico -> Pico -> Pico
forall a. Num a => a -> a -> a
* f -> Pico
forall a b. (Integral a, Num b) => a -> b
fromIntegral f
f

{-------------------------------------------------------------------------------
  SlotLength
-------------------------------------------------------------------------------}

-- | Slot length
--
-- Precision is in milliseconds
newtype SlotLength = SlotLength {SlotLength -> NominalDiffTime
getSlotLength :: NominalDiffTime}
  deriving (SlotLength -> SlotLength -> Bool
(SlotLength -> SlotLength -> Bool)
-> (SlotLength -> SlotLength -> Bool) -> Eq SlotLength
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SlotLength -> SlotLength -> Bool
== :: SlotLength -> SlotLength -> Bool
$c/= :: SlotLength -> SlotLength -> Bool
/= :: SlotLength -> SlotLength -> Bool
Eq, (forall x. SlotLength -> Rep SlotLength x)
-> (forall x. Rep SlotLength x -> SlotLength) -> Generic SlotLength
forall x. Rep SlotLength x -> SlotLength
forall x. SlotLength -> Rep SlotLength x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SlotLength -> Rep SlotLength x
from :: forall x. SlotLength -> Rep SlotLength x
$cto :: forall x. Rep SlotLength x -> SlotLength
to :: forall x. Rep SlotLength x -> SlotLength
Generic, Context -> SlotLength -> IO (Maybe ThunkInfo)
Proxy SlotLength -> String
(Context -> SlotLength -> IO (Maybe ThunkInfo))
-> (Context -> SlotLength -> IO (Maybe ThunkInfo))
-> (Proxy SlotLength -> String)
-> NoThunks SlotLength
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> SlotLength -> IO (Maybe ThunkInfo)
noThunks :: Context -> SlotLength -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> SlotLength -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> SlotLength -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy SlotLength -> String
showTypeOf :: Proxy SlotLength -> String
NoThunks)
  deriving (Int -> SlotLength -> ShowS
[SlotLength] -> ShowS
SlotLength -> String
(Int -> SlotLength -> ShowS)
-> (SlotLength -> String)
-> ([SlotLength] -> ShowS)
-> Show SlotLength
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SlotLength -> ShowS
showsPrec :: Int -> SlotLength -> ShowS
$cshow :: SlotLength -> String
show :: SlotLength -> String
$cshowList :: [SlotLength] -> ShowS
showList :: [SlotLength] -> ShowS
Show) via Quiet SlotLength

instance ToCBOR SlotLength where
  toCBOR :: SlotLength -> Encoding
toCBOR = Integer -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Integer -> Encoding)
-> (SlotLength -> Integer) -> SlotLength -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SlotLength -> Integer
slotLengthToMillisec

instance FromCBOR SlotLength where
  fromCBOR :: forall s. Decoder s SlotLength
fromCBOR = Integer -> SlotLength
slotLengthFromMillisec (Integer -> SlotLength)
-> Decoder s Integer -> Decoder s SlotLength
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Integer
forall s. Decoder s Integer
forall a s. FromCBOR a => Decoder s a
fromCBOR

instance Serialise SlotLength where
  encode :: SlotLength -> Encoding
encode = SlotLength -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR
  decode :: forall s. Decoder s SlotLength
decode = Decoder s SlotLength
forall s. Decoder s SlotLength
forall a s. FromCBOR a => Decoder s a
fromCBOR

-- | Constructor for 'SlotLength'
mkSlotLength :: NominalDiffTime -> SlotLength
mkSlotLength :: NominalDiffTime -> SlotLength
mkSlotLength = NominalDiffTime -> SlotLength
SlotLength

slotLengthFromSec :: Integer -> SlotLength
slotLengthFromSec :: Integer -> SlotLength
slotLengthFromSec = Integer -> SlotLength
slotLengthFromMillisec (Integer -> SlotLength)
-> (Integer -> Integer) -> Integer -> SlotLength
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
1000)

slotLengthToSec :: SlotLength -> Integer
slotLengthToSec :: SlotLength -> Integer
slotLengthToSec = (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
1000) (Integer -> Integer)
-> (SlotLength -> Integer) -> SlotLength -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SlotLength -> Integer
slotLengthToMillisec

slotLengthFromMillisec :: Integer -> SlotLength
slotLengthFromMillisec :: Integer -> SlotLength
slotLengthFromMillisec = NominalDiffTime -> SlotLength
mkSlotLength (NominalDiffTime -> SlotLength)
-> (Integer -> NominalDiffTime) -> Integer -> SlotLength
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> NominalDiffTime
conv
  where
    -- Explicit type annotation here means that /if/ we change the precision,
    -- we are forced to reconsider this code.
    conv :: Integer -> NominalDiffTime
    conv :: Integer -> NominalDiffTime
conv =
      (Pico -> NominalDiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac :: Pico -> NominalDiffTime)
        (Pico -> NominalDiffTime)
-> (Integer -> Pico) -> Integer -> NominalDiffTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pico -> Pico -> Pico
forall a. Fractional a => a -> a -> a
/ Pico
1000)
        (Pico -> Pico) -> (Integer -> Pico) -> Integer -> Pico
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Pico
forall a. Num a => Integer -> a
fromInteger :: Integer -> Pico)

slotLengthToMillisec :: SlotLength -> Integer
slotLengthToMillisec :: SlotLength -> Integer
slotLengthToMillisec = NominalDiffTime -> Integer
conv (NominalDiffTime -> Integer)
-> (SlotLength -> NominalDiffTime) -> SlotLength -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SlotLength -> NominalDiffTime
getSlotLength
  where
    -- Explicit type annotation here means that /if/ we change the precision,
    -- we are forced to reconsider this code.
    conv :: NominalDiffTime -> Integer
    conv :: NominalDiffTime -> Integer
conv =
      Pico -> Integer
forall b. Integral b => Pico -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate
        (Pico -> Integer)
-> (NominalDiffTime -> Pico) -> NominalDiffTime -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pico -> Pico -> Pico
forall a. Num a => a -> a -> a
* Pico
1000)
        (Pico -> Pico)
-> (NominalDiffTime -> Pico) -> NominalDiffTime -> Pico
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NominalDiffTime -> Pico
forall a b. (Real a, Fractional b) => a -> b
realToFrac :: NominalDiffTime -> Pico)