Revert "Revert "Add forecastFutureEpochStartUsingTip and test""

This reverts commit a4dfc73.
cardano-foundation · Jul 24, 2020 · 314c063 · 314c063
1 parent 55b59b7
commit 314c063
Show file tree

Hide file tree

Showing 2 changed files with 46 additions and 1 deletion.
diff --git a/lib/core/src/Cardano/Wallet/Primitive/Slotting.hs b/lib/core/src/Cardano/Wallet/Primitive/Slotting.hs
@@ -26,6 +26,7 @@ module Cardano.Wallet.Primitive.Slotting
     , slotRangeFromTimeRange
     , firstSlotInEpoch
     , ongoingSlotAt
+    , forecastFutureEpochStartUsingTip
 
     -- ** Running queries
     , TimeInterpreter
@@ -148,6 +149,42 @@ startTime s = do
     rel <- HardForkQry (fst <$> HF.slotToWallclock s)
     RelToUTCTime rel
 
+-- | @Qry@ can not normally be used for conversions outside the forecast range.
+--
+-- This function estimates the start time of an epoch based on the time/slot
+-- information of a given @SlotNo@.
+--
+-- If a hard-fork occurs between the tip and the epoch, the result will be
+-- incorrect.
+forecastFutureEpochStartUsingTip :: SlotNo -> EpochNo -> Qry UTCTime
+forecastFutureEpochStartUsingTip tip epoch = do
+    tipEpoch <- epochOf tip
+    -- Epoch: e         | e+1    | ... | ... | e+?
+    --           *      *                    *
+    --          tip    ref              future epoch
+
+    let refEpoch = EpochNo $ fromIntegral (unEpochNo tipEpoch) + 1
+    ref <- firstSlotInEpoch refEpoch
+    refTime <- startTime ref
+    el <- HardForkQry $ HF.QEpochSize $ toCardanoEpochNo refEpoch
+    sl <- HardForkQry $ HF.QSlotLength ref
+
+    if refEpoch < epoch
+    then
+        let
+            convert = fromRational . toRational
+            el' = convert $ Cardano.unEpochSize el
+            sl' = Cardano.getSlotLength sl
+            epochDelta = convert $ fromIntegral $ unEpochNo $ epoch - refEpoch
+
+            slotDelta = el' * sl' * epochDelta
+
+        in return $ slotDelta `addUTCTime` refTime
+    else startTime =<< firstSlotInEpoch epoch
+
+  where
+    toCardanoEpochNo (EpochNo e) = Cardano.EpochNo $ fromIntegral e
+
 -- | Translate 'EpochNo' to the 'SlotNo' of the first slot in that epoch
 firstSlotInEpoch :: EpochNo -> Qry SlotNo
 firstSlotInEpoch = fmap fst . HardForkQry . HF.epochToSlot . convertEpochNo

diff --git a/lib/core/test/unit/Cardano/Wallet/Primitive/SlottingSpec.hs b/lib/core/test/unit/Cardano/Wallet/Primitive/SlottingSpec.hs
@@ -19,6 +19,7 @@ import Cardano.Wallet.Primitive.Slotting
     , epochOf
     , firstSlotInEpoch
     , flatSlot
+    , forecastFutureEpochStartUsingTip
     , fromFlatSlot
     , singleEraInterpreter
     , slotParams
@@ -58,7 +59,7 @@ import Test.Utils.Time
 
 spec :: Spec
 spec = do
-    describe "slotting" $
+    describe "slotting" $ do
         describe "runQuery NEW singleEraInterpreter == OLD . fromFlatSlot" $ do
             it "epochOf and epochNumber"
                 $  property $ legacySlottingTest (\_ s -> epochNumber s) epochOf
@@ -88,6 +89,13 @@ spec = do
                     let legacy = SlotNo $ flatSlot (getEpochLength gp) $ SlotId e 0
 
                     res === legacy
+
+        it "forecastFutureEpochStartUsingTip matches (startTime =<< firstSlotInEpoch)\
+           \ (always true useing singleEraInterpreter)"
+            $ withMaxSuccess 10000 $ property $ \gp tip e -> do
+                let run = runIdentity . singleEraInterpreter gp
+                run (forecastFutureEpochStartUsingTip tip e)
+                    === run (startTime =<< firstSlotInEpoch e)
 legacySlottingTest
     :: (Eq a, Show a)
     => (SlotParameters -> SlotId -> a)