From 248d2debef18f94e057ecb04ab603dc1c6fddf69 Mon Sep 17 00:00:00 2001
From: Thomas Winant <thomas@well-typed.com>
Date: Fri, 20 Nov 2020 11:59:19 +0100
Subject: [PATCH] Add getSlotTime

As requested by the network team. See its docstring for more information.
---
 .../src/Ouroboros/Consensus/NodeKernel.hs     | 21 +++++++++++++++++++
 1 file changed, 21 insertions(+)

diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/NodeKernel.hs b/ouroboros-consensus/src/Ouroboros/Consensus/NodeKernel.hs
index 7cef62274ab..c10333ba826 100644
--- a/ouroboros-consensus/src/Ouroboros/Consensus/NodeKernel.hs
+++ b/ouroboros-consensus/src/Ouroboros/Consensus/NodeKernel.hs
@@ -21,6 +21,7 @@ module Ouroboros.Consensus.NodeKernel (
   , getMempoolReader
   , getMempoolWriter
   , getPeersFromCurrentLedger
+  , getSlotTime
   ) where
 
 import           Control.Monad
@@ -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)
@@ -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
@@ -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