Skip to content

Commit

Permalink
Add getSlotTime
Browse files Browse the repository at this point in the history
As requested by the network team. See its docstring for more information.
  • Loading branch information
mrBliss committed Nov 20, 2020
1 parent 67b43dc commit 248d2de
Showing 1 changed file with 21 additions and 0 deletions.
21 changes: 21 additions & 0 deletions ouroboros-consensus/src/Ouroboros/Consensus/NodeKernel.hs
Original file line number Diff line number Diff line change
Expand Up @@ -21,6 +21,7 @@ module Ouroboros.Consensus.NodeKernel (
, getMempoolReader
, getMempoolWriter
, getPeersFromCurrentLedger
, getSlotTime
) where

import Control.Monad
Expand All @@ -31,6 +32,7 @@ import Data.Map.Strict (Map)
import Data.Maybe (isJust)
import Data.Proxy
import qualified Data.Text as Text
import Data.Time (UTCTime)
import Data.Word (Word32)
import GHC.Stack (HasCallStack)
import System.Random (StdGen)
Expand All @@ -53,8 +55,11 @@ import Ouroboros.Consensus.Block hiding (blockMatchesHeader)
import qualified Ouroboros.Consensus.Block as Block
import Ouroboros.Consensus.BlockchainTime
import Ouroboros.Consensus.Config
import Ouroboros.Consensus.Config.SupportsNode (ConfigSupportsNode)
import qualified Ouroboros.Consensus.Config.SupportsNode as Config
import Ouroboros.Consensus.Forecast
import Ouroboros.Consensus.HardFork.History (RunWithCachedSummary)
import qualified Ouroboros.Consensus.HardFork.History as HF
import Ouroboros.Consensus.HeaderValidation
import Ouroboros.Consensus.Ledger.Abstract
import Ouroboros.Consensus.Ledger.Extended
Expand Down Expand Up @@ -682,3 +687,19 @@ getPeersFromCurrentLedger ::
-> STM m [(PoolStake, NonEmpty DomainAddress)]
getPeersFromCurrentLedger kernel =
getPeers . ledgerState <$> ChainDB.getCurrentLedger (getChainDB kernel)

-- | Return the time corresponding to the given slot.
--
-- If the slot is too far in the future w.r.t. the current ledger state,
-- 'HF.PastHorizonException' will be returned.
getSlotTime ::
(IOLike m, ConfigSupportsNode blk)
=> NodeKernel m remotePeer localPeer blk
-> SlotNo
-> STM m (Either HF.PastHorizonException UTCTime)
getSlotTime kernel slot =
fmap (fromRelativeTime systemStart . fst) <$>
HF.cachedRunQuery (getCachedSummary kernel) (HF.slotToWallclock slot)
where
systemStart :: SystemStart
systemStart = Config.getSystemStart $ configBlock $ getTopLevelConfig kernel

0 comments on commit 248d2de

Please sign in to comment.