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

module Ouroboros.Consensus.BlockchainTime.WallClock.Types
  ( -- * System time
    SystemStart (..)

    -- * Relative time
  , RelativeTime (..)
  , addRelTime
  , diffRelTime
  , fromRelativeTime
  , toRelativeTime

    -- * Get current time (as 'RelativeTime')
  , SystemTime (..)

    -- * Attach an arrival time (as 'RelativeTime') to an object
  , WithArrivalTime (..)
  , addArrivalTime

    -- * Slot length
  , getSlotLength
  , mkSlotLength

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

    -- ** opaque
  , SlotLength
  ) where

import Cardano.Slotting.Time
import Data.Time.Clock (NominalDiffTime)
import GHC.Generics (Generic)
import NoThunks.Class (NoThunks, OnlyCheckWhnfNamed (..))

addRelTime :: NominalDiffTime -> RelativeTime -> RelativeTime
addRelTime :: NominalDiffTime -> RelativeTime -> RelativeTime
addRelTime = NominalDiffTime -> RelativeTime -> RelativeTime
addRelativeTime

diffRelTime :: RelativeTime -> RelativeTime -> NominalDiffTime
diffRelTime :: RelativeTime -> RelativeTime -> NominalDiffTime
diffRelTime = RelativeTime -> RelativeTime -> NominalDiffTime
diffRelativeTime

{-------------------------------------------------------------------------------
  Get current time (as RelativeTime)
-------------------------------------------------------------------------------}

-- | System time
--
-- Slots are counted from the system start.
data SystemTime m = SystemTime
  { forall (m :: * -> *). SystemTime m -> m RelativeTime
systemTimeCurrent :: m RelativeTime
  -- ^ Get current time (as a 'RelativeTime')
  --
  -- For real deployment, this will take the current 'UTCTime' and then
  -- subtract the 'SystemStart' (see 'defaultSystemTime'). Tests don't
  -- bother with a 'UTCTime' and just work entirely in 'RelativeTime'.
  , forall (m :: * -> *). SystemTime m -> m ()
systemTimeWait :: m ()
  -- ^ Wait for 'SystemStart'
  --
  -- For the real deployment, this waits for the current 'UTCTime'
  -- to reach 'SystemStart'. In tests this does nothing.
  }
  deriving Context -> SystemTime m -> IO (Maybe ThunkInfo)
Proxy (SystemTime m) -> String
(Context -> SystemTime m -> IO (Maybe ThunkInfo))
-> (Context -> SystemTime m -> IO (Maybe ThunkInfo))
-> (Proxy (SystemTime m) -> String)
-> NoThunks (SystemTime m)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
forall (m :: * -> *).
Context -> SystemTime m -> IO (Maybe ThunkInfo)
forall (m :: * -> *). Proxy (SystemTime m) -> String
$cnoThunks :: forall (m :: * -> *).
Context -> SystemTime m -> IO (Maybe ThunkInfo)
noThunks :: Context -> SystemTime m -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall (m :: * -> *).
Context -> SystemTime m -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> SystemTime m -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall (m :: * -> *). Proxy (SystemTime m) -> String
showTypeOf :: Proxy (SystemTime m) -> String
NoThunks via OnlyCheckWhnfNamed "SystemTime" (SystemTime m)

{-------------------------------------------------------------------------------
  Attach an arrival time (as RelativeTime) to an object
-------------------------------------------------------------------------------}

-- | WithArrivalTime
data WithArrivalTime a = WithArrivalTime
  { forall a. WithArrivalTime a -> RelativeTime
getArrivalTime :: !RelativeTime
  -- ^ The time at which the object arrived
  , forall a. WithArrivalTime a -> a
forgetArrivalTime :: !a
  -- ^ The object without its arrival time
  }
  deriving (Int -> WithArrivalTime a -> ShowS
[WithArrivalTime a] -> ShowS
WithArrivalTime a -> String
(Int -> WithArrivalTime a -> ShowS)
-> (WithArrivalTime a -> String)
-> ([WithArrivalTime a] -> ShowS)
-> Show (WithArrivalTime a)
forall a. Show a => Int -> WithArrivalTime a -> ShowS
forall a. Show a => [WithArrivalTime a] -> ShowS
forall a. Show a => WithArrivalTime a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> WithArrivalTime a -> ShowS
showsPrec :: Int -> WithArrivalTime a -> ShowS
$cshow :: forall a. Show a => WithArrivalTime a -> String
show :: WithArrivalTime a -> String
$cshowList :: forall a. Show a => [WithArrivalTime a] -> ShowS
showList :: [WithArrivalTime a] -> ShowS
Show, WithArrivalTime a -> WithArrivalTime a -> Bool
(WithArrivalTime a -> WithArrivalTime a -> Bool)
-> (WithArrivalTime a -> WithArrivalTime a -> Bool)
-> Eq (WithArrivalTime a)
forall a. Eq a => WithArrivalTime a -> WithArrivalTime a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => WithArrivalTime a -> WithArrivalTime a -> Bool
== :: WithArrivalTime a -> WithArrivalTime a -> Bool
$c/= :: forall a. Eq a => WithArrivalTime a -> WithArrivalTime a -> Bool
/= :: WithArrivalTime a -> WithArrivalTime a -> Bool
Eq, Eq (WithArrivalTime a)
Eq (WithArrivalTime a) =>
(WithArrivalTime a -> WithArrivalTime a -> Ordering)
-> (WithArrivalTime a -> WithArrivalTime a -> Bool)
-> (WithArrivalTime a -> WithArrivalTime a -> Bool)
-> (WithArrivalTime a -> WithArrivalTime a -> Bool)
-> (WithArrivalTime a -> WithArrivalTime a -> Bool)
-> (WithArrivalTime a -> WithArrivalTime a -> WithArrivalTime a)
-> (WithArrivalTime a -> WithArrivalTime a -> WithArrivalTime a)
-> Ord (WithArrivalTime a)
WithArrivalTime a -> WithArrivalTime a -> Bool
WithArrivalTime a -> WithArrivalTime a -> Ordering
WithArrivalTime a -> WithArrivalTime a -> WithArrivalTime a
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
forall a. Ord a => Eq (WithArrivalTime a)
forall a. Ord a => WithArrivalTime a -> WithArrivalTime a -> Bool
forall a.
Ord a =>
WithArrivalTime a -> WithArrivalTime a -> Ordering
forall a.
Ord a =>
WithArrivalTime a -> WithArrivalTime a -> WithArrivalTime a
$ccompare :: forall a.
Ord a =>
WithArrivalTime a -> WithArrivalTime a -> Ordering
compare :: WithArrivalTime a -> WithArrivalTime a -> Ordering
$c< :: forall a. Ord a => WithArrivalTime a -> WithArrivalTime a -> Bool
< :: WithArrivalTime a -> WithArrivalTime a -> Bool
$c<= :: forall a. Ord a => WithArrivalTime a -> WithArrivalTime a -> Bool
<= :: WithArrivalTime a -> WithArrivalTime a -> Bool
$c> :: forall a. Ord a => WithArrivalTime a -> WithArrivalTime a -> Bool
> :: WithArrivalTime a -> WithArrivalTime a -> Bool
$c>= :: forall a. Ord a => WithArrivalTime a -> WithArrivalTime a -> Bool
>= :: WithArrivalTime a -> WithArrivalTime a -> Bool
$cmax :: forall a.
Ord a =>
WithArrivalTime a -> WithArrivalTime a -> WithArrivalTime a
max :: WithArrivalTime a -> WithArrivalTime a -> WithArrivalTime a
$cmin :: forall a.
Ord a =>
WithArrivalTime a -> WithArrivalTime a -> WithArrivalTime a
min :: WithArrivalTime a -> WithArrivalTime a -> WithArrivalTime a
Ord, (forall x. WithArrivalTime a -> Rep (WithArrivalTime a) x)
-> (forall x. Rep (WithArrivalTime a) x -> WithArrivalTime a)
-> Generic (WithArrivalTime a)
forall x. Rep (WithArrivalTime a) x -> WithArrivalTime a
forall x. WithArrivalTime a -> Rep (WithArrivalTime a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (WithArrivalTime a) x -> WithArrivalTime a
forall a x. WithArrivalTime a -> Rep (WithArrivalTime a) x
$cfrom :: forall a x. WithArrivalTime a -> Rep (WithArrivalTime a) x
from :: forall x. WithArrivalTime a -> Rep (WithArrivalTime a) x
$cto :: forall a x. Rep (WithArrivalTime a) x -> WithArrivalTime a
to :: forall x. Rep (WithArrivalTime a) x -> WithArrivalTime a
Generic, Context -> WithArrivalTime a -> IO (Maybe ThunkInfo)
Proxy (WithArrivalTime a) -> String
(Context -> WithArrivalTime a -> IO (Maybe ThunkInfo))
-> (Context -> WithArrivalTime a -> IO (Maybe ThunkInfo))
-> (Proxy (WithArrivalTime a) -> String)
-> NoThunks (WithArrivalTime a)
forall a.
NoThunks a =>
Context -> WithArrivalTime a -> IO (Maybe ThunkInfo)
forall a. NoThunks a => Proxy (WithArrivalTime a) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: forall a.
NoThunks a =>
Context -> WithArrivalTime a -> IO (Maybe ThunkInfo)
noThunks :: Context -> WithArrivalTime a -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall a.
NoThunks a =>
Context -> WithArrivalTime a -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> WithArrivalTime a -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall a. NoThunks a => Proxy (WithArrivalTime a) -> String
showTypeOf :: Proxy (WithArrivalTime a) -> String
NoThunks)

-- | Add an arrival time to an object
addArrivalTime :: Monad m => SystemTime m -> a -> m (WithArrivalTime a)
addArrivalTime :: forall (m :: * -> *) a.
Monad m =>
SystemTime m -> a -> m (WithArrivalTime a)
addArrivalTime SystemTime m
systemTime a
a = do
  t <- SystemTime m -> m RelativeTime
forall (m :: * -> *). SystemTime m -> m RelativeTime
systemTimeCurrent SystemTime m
systemTime
  return (WithArrivalTime t a)