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)