module Ouroboros.Consensus.BlockchainTime.WallClock.Default (defaultSystemTime) where

import Control.Monad
import Control.Monad.Class.MonadTime.SI (MonadTime (..))
import Control.Tracer
import Data.Time (UTCTime, diffUTCTime)
import Ouroboros.Consensus.BlockchainTime.WallClock.Types
import Ouroboros.Consensus.BlockchainTime.WallClock.Util
import Ouroboros.Consensus.Util.IOLike
import Ouroboros.Consensus.Util.Time

defaultSystemTime ::
  (MonadTime m, MonadDelay m) =>
  SystemStart ->
  Tracer m (TraceBlockchainTimeEvent UTCTime) ->
  SystemTime m
defaultSystemTime :: forall (m :: * -> *).
(MonadTime m, MonadDelay m) =>
SystemStart
-> Tracer m (TraceBlockchainTimeEvent UTCTime) -> SystemTime m
defaultSystemTime SystemStart
start Tracer m (TraceBlockchainTimeEvent UTCTime)
tracer =
  SystemTime
    { systemTimeCurrent :: m RelativeTime
systemTimeCurrent = SystemStart -> UTCTime -> RelativeTime
toRelativeTime SystemStart
start (UTCTime -> RelativeTime) -> m UTCTime -> m RelativeTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m UTCTime
forall (m :: * -> *). MonadTime m => m UTCTime
getCurrentTime
    , systemTimeWait :: m ()
systemTimeWait = SystemStart -> Tracer m (TraceBlockchainTimeEvent UTCTime) -> m ()
forall (m :: * -> *).
(MonadTime m, MonadDelay m) =>
SystemStart -> Tracer m (TraceBlockchainTimeEvent UTCTime) -> m ()
waitForSystemStart SystemStart
start Tracer m (TraceBlockchainTimeEvent UTCTime)
tracer
    }

-- | Wait until system start if necessary
waitForSystemStart ::
  (MonadTime m, MonadDelay m) =>
  SystemStart ->
  Tracer m (TraceBlockchainTimeEvent UTCTime) ->
  m ()
waitForSystemStart :: forall (m :: * -> *).
(MonadTime m, MonadDelay m) =>
SystemStart -> Tracer m (TraceBlockchainTimeEvent UTCTime) -> m ()
waitForSystemStart SystemStart
start Tracer m (TraceBlockchainTimeEvent UTCTime)
tracer = do
  now <- m UTCTime
forall (m :: * -> *). MonadTime m => m UTCTime
getCurrentTime
  when (getSystemStart start > now) $ do
    let delay = SystemStart -> UTCTime
getSystemStart SystemStart
start UTCTime -> UTCTime -> NominalDiffTime
`diffUTCTime` UTCTime
now
    traceWith tracer $ TraceStartTimeInTheFuture start delay
    threadDelay (nominalDelay delay)