Move legacy slotting functions out of main code into unit tests

lib/core-integration/src/Test/Integration/Framework/DSL.hs

@@ -139,7 +139,6 @@ module Test.Integration.Framework.DSL
     , verifyMaintenanceAction
 
     -- * Delegation helpers
-    , mkEpochInfo
     , notDelegating
     , delegating
     , getSlotParams
@@ -195,7 +194,7 @@ import Cardano.Wallet.Api.Types
     , ApiBlockReference (..)
     , ApiByronWallet
     , ApiCoinSelection
-    , ApiEpochInfo (ApiEpochInfo)
+    , ApiEpochInfo
     , ApiFee
     , ApiMaintenanceAction (..)
     , ApiNetworkInformation
@@ -236,8 +235,6 @@ import Cardano.Wallet.Primitive.AddressDerivation.Jormungandr
     ( generateKeyFromSeed )
 import Cardano.Wallet.Primitive.AddressDerivation.Shelley
     ( ShelleyKey )
-import Cardano.Wallet.Primitive.Slotting
-    ( SlotParameters (..), epochStartTime )
 import Cardano.Wallet.Primitive.SyncProgress
     ( SyncProgress (..) )
 import Cardano.Wallet.Primitive.Types
@@ -250,6 +247,7 @@ import Cardano.Wallet.Primitive.Types
     , Settings
     , SlotLength (..)
     , SlotNo (..)
+    , SlottingParameters (..)
     , SortOrder (..)
     , WalletId (..)
     )
@@ -2166,7 +2164,7 @@ pubKeyFromMnemonics mnemonics =
 getSlotParams
     :: MonadIO m
     => Context t
-    -> m (EpochNo, SlotParameters)
+    -> m (EpochNo, SlottingParameters)
 getSlotParams ctx = do
     r1 <- liftIO $ request @ApiNetworkInformation ctx
           Link.getNetworkInfo Default Empty
@@ -2180,11 +2178,9 @@ getSlotParams ctx = do
     let (Quantity slotL) = getFromResponse #slotLength r2
     let (Quantity epochL) = getFromResponse #epochLength r2
     let (Quantity coeff) = getFromResponse #activeSlotCoefficient r2
-    let (ApiT genesisBlockDate) = getFromResponse #blockchainStartTime r2
-    let sp = SlotParameters
-            (EpochLength epochL)
+    let sp = SlottingParameters
             (SlotLength slotL)
-            genesisBlockDate
+            (EpochLength epochL)
             (ActiveSlotCoefficient coeff)
 
     return (currentEpoch, sp)
@@ -2197,22 +2193,10 @@ getTTLSlots
     -> NominalDiffTime
     -> m SlotNo
 getTTLSlots ctx dt = liftIO $ do
-    (_, SlotParameters _ (SlotLength _slotLenWrong) _ _) <- getSlotParams ctx
+    _slotLenWrong <- unSlotLength . getSlotLength . snd <$> getSlotParams ctx
     let slotLen = 0.2 -- fixme: this is the value from byron genesis
     pure $ SlotNo $ ceiling $ dt / slotLen
 
--- | Handy constructor for ApiEpochInfo
-mkEpochInfo
-    :: EpochNo
-    -- ^ Epoch to construct
-    -> SlotParameters
-    -- ^ Blockchain slot parameters
-    -> ApiEpochInfo
-mkEpochInfo epochNo sp =
-    ApiEpochInfo
-        (ApiT epochNo)
-        (epochStartTime sp epochNo)
-
 -- | Wallet not delegating and not about to join any stake pool.
 notDelegating
     :: [(Maybe (ApiT PoolId), ApiEpochInfo)]

lib/core/cardano-wallet-core.cabal

@@ -310,6 +310,7 @@ test-suite unit
       Cardano.Wallet.Primitive.CoinSelectionSpec
       Cardano.Wallet.Primitive.FeeSpec
       Cardano.Wallet.Primitive.ModelSpec
+      Cardano.Wallet.Primitive.Slotting.Legacy
       Cardano.Wallet.Primitive.SlottingSpec
       Cardano.Wallet.Primitive.SyncProgressSpec
       Cardano.Wallet.Primitive.TypesSpec

lib/core/src/Cardano/Wallet/Primitive/Slotting.hs

@@ -1,10 +1,8 @@
 {-# LANGUAGE DataKinds #-}
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE KindSignatures #-}
 {-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedLabels #-}
 {-# LANGUAGE Rank2Types #-}
 
@@ -40,31 +38,14 @@ module Cardano.Wallet.Primitive.Slotting
 
     -- ** Helpers
     , unsafeEpochNo
-
-      -- * Legacy api - Inaccurate with cardano-node, okay with Jörmungandr
-    , SlotParameters (..)
-    , slotParams
-    , epochStartTime
-    , flatSlot
-    , fromFlatSlot
-    , slotStartTime
-    , slotCeiling
-    , slotFloor
-    , slotAt'
-    , slotDifference
-    , slotPred
-    , slotSucc
-    , slotMinBound
-    , slotRangeFromTimeRange'
     ) where
 
 import Prelude
 
 import Cardano.Wallet.Orphans
     ()
 import Cardano.Wallet.Primitive.Types
-    ( ActiveSlotCoefficient (..)
-    , EpochLength (..)
+    ( EpochLength (..)
     , EpochNo (..)
     , Range (..)
     , SlotId (..)
@@ -86,20 +67,12 @@ import Data.Functor.Identity
     ( Identity )
 import Data.Generics.Internal.VL.Lens
     ( (^.) )
-import Data.Maybe
-    ( fromMaybe )
-import Data.Quantity
-    ( Quantity (..) )
 import Data.Time.Clock
-    ( NominalDiffTime, UTCTime, addUTCTime, diffUTCTime, getCurrentTime )
+    ( NominalDiffTime, UTCTime, addUTCTime, getCurrentTime )
 import Data.Word
     ( Word32, Word64 )
-import GHC.Generics
-    ( Generic )
 import GHC.Stack
     ( HasCallStack )
-import Numeric.Natural
-    ( Natural )
 import Ouroboros.Consensus.BlockchainTime.WallClock.Types
     ( SystemStart (..) )
 import Ouroboros.Consensus.HardFork.History.Qry
@@ -349,144 +322,3 @@ runQuery systemStart int = go
         -- Cardano.toRelativeTime may throw, so we need this guard:
         | utc < getSystemStart systemStart = pure Nothing
         | otherwise = pure $ Just $ Cardano.toRelativeTime systemStart utc
-
--- -----------------------------------------------------------------------------
--- Legacy functions
--- These only work for a single era. We need to stop using them
-
--- | The essential parameters necessary for performing slot arithmetic.
-data SlotParameters = SlotParameters
-    { getEpochLength
-        :: EpochLength
-    , getSlotLength
-        :: SlotLength
-    , getGenesisBlockDate
-        :: StartTime
-    , getActiveSlotCoefficient
-        :: ActiveSlotCoefficient
-    } deriving (Eq, Generic, Show)
-
-slotParams :: StartTime -> SlottingParameters -> SlotParameters
-slotParams t0 sp = SlotParameters
-    (sp ^. #getEpochLength)
-    (sp ^. #getSlotLength)
-    t0
-    (sp ^. #getActiveSlotCoefficient)
-
--- | Calculate the time at which an epoch begins.
-epochStartTime :: SlotParameters -> EpochNo -> UTCTime
-epochStartTime sps e = slotStartTime sps $ SlotId e 0
-
--- | Convert a 'SlotId' to the number of slots since genesis.
-flatSlot :: EpochLength -> SlotId -> Word64
-flatSlot (EpochLength epochLength) (SlotId (EpochNo e) (SlotInEpoch s)) =
-    fromIntegral epochLength * fromIntegral e + fromIntegral s
-
--- | Convert a 'flatSlot' index to 'SlotId'.
---
--- This function will fail if applied to a value that is higher than the maximum
--- value of 'flatSlot' for the specified 'EpochLength'.
---
-fromFlatSlot :: EpochLength -> Word64 -> SlotId
-fromFlatSlot el@(EpochLength epochLength) n
-    | n <= maxFlatSlot =
-        SlotId (EpochNo $ fromIntegral e) (fromIntegral s)
-    | otherwise =
-        error $ mconcat
-            [ "fromFlatSlot: The specified flat slot number ("
-            , show n
-            , ") is higher than the maximum flat slot number ("
-            , show maxFlatSlot
-            , ") for the specified epoch length ("
-            , show epochLength
-            , ")."
-            ]
-  where
-    e = n `div` fromIntegral epochLength
-    s = n `mod` fromIntegral epochLength
-    maxFlatSlot =
-        flatSlot el (SlotId (EpochNo maxBound) (SlotInEpoch $ epochLength - 1))
-
--- | @slotDifference a b@ is how many slots @a@ is after @b@. The result is
--- non-negative, and if @b > a@ then this function returns zero.
-slotDifference :: SlotParameters -> SlotId -> SlotId -> Quantity "slot" Natural
-slotDifference (SlotParameters el _ _ _) a b
-    | a' > b' = Quantity $ fromIntegral $ a' - b'
-    | otherwise = Quantity 0
-  where
-    a' = flatSlot el a
-    b' = flatSlot el b
-
--- | Return the slot immediately before the given slot.
-slotPred :: SlotParameters -> SlotId -> Maybe SlotId
-slotPred (SlotParameters (EpochLength el) _ _ _) (SlotId en sn)
-    | en == 0 && sn == 0 = Nothing
-    | sn > 0 = Just $ SlotId en (sn - 1)
-    | otherwise = Just $ SlotId (en - 1) (SlotInEpoch $ el - 1)
-
--- | Return the slot immediately after the given slot.
-slotSucc :: SlotParameters -> SlotId -> SlotId
-slotSucc (SlotParameters (EpochLength el) _ _ _) (SlotId en (SlotInEpoch sn))
-    | sn < el - 1 = SlotId en (SlotInEpoch $ sn + 1)
-    | otherwise = SlotId (en + 1) 0
-
--- | The time when a slot begins.
-slotStartTime :: SlotParameters -> SlotId -> UTCTime
-slotStartTime (SlotParameters el (SlotLength sl) (StartTime st) _) slot =
-    addUTCTime offset st
-  where
-    offset = sl * fromIntegral (flatSlot el slot)
-
--- | For the given time 't', determine the ID of the earliest slot with start
---   time 's' such that 't ≤ s'.
-slotCeiling :: SlotParameters -> UTCTime -> SlotId
-slotCeiling sp@(SlotParameters _ (SlotLength sl) _ _) t =
-    fromMaybe slotMinBound $ slotAt' sp (addUTCTime (pred sl) t)
-
--- | For the given time 't', determine the ID of the latest slot with start
---   time 's' such that 's ≤ t'.
-slotFloor :: SlotParameters -> UTCTime -> Maybe SlotId
-slotFloor = slotAt'
-
--- | Returns the earliest slot.
-slotMinBound :: SlotId
-slotMinBound = SlotId 0 0
-
--- | For the given time 't', determine the ID of the unique slot with start
---   time 's' and end time 'e' such that 's ≤ t ≤ e'.
-slotAt' :: SlotParameters -> UTCTime -> Maybe SlotId
-slotAt' (SlotParameters (EpochLength el) (SlotLength sl) (StartTime st) _) t
-    | t < st = Nothing
-    | otherwise = Just $ SlotId {epochNumber, slotNumber}
-  where
-    diff :: NominalDiffTime
-    diff = t `diffUTCTime` st
-
-    epochLength :: NominalDiffTime
-    epochLength = fromIntegral el * sl
-
-    epochNumber = EpochNo $
-        floor (diff / epochLength)
-
-    slotNumber = SlotInEpoch $
-        floor ((diff - fromIntegral (unEpochNo epochNumber) * epochLength) / sl)
-
--- | Transforms the given inclusive time range into an inclusive slot range.
---
--- This function returns a slot range if (and only if) the specified time range
--- intersects with the life of the blockchain.
---
--- If, on the other hand, the specified time range terminates before the start
--- of the blockchain, this function returns 'Nothing'.
---
-slotRangeFromTimeRange'
-    :: SlotParameters
-    -> Range UTCTime
-    -> Maybe (Range SlotId)
-slotRangeFromTimeRange' sps (Range mStart mEnd) =
-    Range slotStart <$> slotEnd
-  where
-    slotStart =
-        slotCeiling sps <$> mStart
-    slotEnd =
-        maybe (Just Nothing) (fmap Just . slotFloor sps) mEnd

lib/core/test/unit/Cardano/Wallet/Primitive/ModelSpec.hs

@@ -34,7 +34,7 @@ import Cardano.Wallet.Primitive.Model
     , totalBalance
     , totalUTxO
     )
-import Cardano.Wallet.Primitive.Slotting
+import Cardano.Wallet.Primitive.Slotting.Legacy
     ( flatSlot )
 import Cardano.Wallet.Primitive.Types
     ( Block (..)