From 314c06306a0bea16d3e15cfbde21fb9016ffced0 Mon Sep 17 00:00:00 2001 From: Johannes Lund Date: Fri, 24 Jul 2020 12:56:39 +0200 Subject: [PATCH] Revert "Revert "Add forecastFutureEpochStartUsingTip and test"" This reverts commit a4dfc73e2858bdd00abe7aa31fd0fc99b75ee09e. --- .../src/Cardano/Wallet/Primitive/Slotting.hs | 37 +++++++++++++++++++ .../Cardano/Wallet/Primitive/SlottingSpec.hs | 10 ++++- 2 files changed, 46 insertions(+), 1 deletion(-) diff --git a/lib/core/src/Cardano/Wallet/Primitive/Slotting.hs b/lib/core/src/Cardano/Wallet/Primitive/Slotting.hs index 2d147d156fe..b6ff97a14e9 100644 --- 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 index 7ae584a7b0b..56de7000941 100644 --- 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)