diff --git a/lib/core-integration/src/Test/Integration/Framework/DSL.hs b/lib/core-integration/src/Test/Integration/Framework/DSL.hs index f4501e9373a..0ad0ae667d2 100644 --- a/lib/core-integration/src/Test/Integration/Framework/DSL.hs +++ b/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)] diff --git a/lib/core/cardano-wallet-core.cabal b/lib/core/cardano-wallet-core.cabal index bc459669a12..950eb29f333 100644 --- a/lib/core/cardano-wallet-core.cabal +++ b/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 diff --git a/lib/core/src/Cardano/Wallet/Primitive/Slotting.hs b/lib/core/src/Cardano/Wallet/Primitive/Slotting.hs index 519a366c2ad..25b0d21fc3b 100644 --- a/lib/core/src/Cardano/Wallet/Primitive/Slotting.hs +++ b/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,22 +38,6 @@ 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 @@ -63,8 +45,7 @@ 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 diff --git a/lib/core/test/unit/Cardano/Wallet/Primitive/ModelSpec.hs b/lib/core/test/unit/Cardano/Wallet/Primitive/ModelSpec.hs index 216dbdb67e5..a257b39f6ad 100644 --- a/lib/core/test/unit/Cardano/Wallet/Primitive/ModelSpec.hs +++ b/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 (..) diff --git a/lib/core/test/unit/Cardano/Wallet/Primitive/Slotting/Legacy.hs b/lib/core/test/unit/Cardano/Wallet/Primitive/Slotting/Legacy.hs new file mode 100644 index 00000000000..8ccf67b6a97 --- /dev/null +++ b/lib/core/test/unit/Cardano/Wallet/Primitive/Slotting/Legacy.hs @@ -0,0 +1,198 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedLabels #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + +-- | Legacy slotting API functions. +-- Used as a reference in tests. + +module Cardano.Wallet.Primitive.Slotting.Legacy + ( SlotParameters (..) + , slotParams + , epochStartTime + , flatSlot + , fromFlatSlot + , slotStartTime + , slotCeiling + , slotFloor + , slotAt' + , slotDifference + , slotPred + , slotSucc + , slotMinBound + , slotRangeFromTimeRange' + ) where + +import Prelude + +import Cardano.Wallet.Primitive.Types + ( ActiveSlotCoefficient + , EpochLength (..) + , EpochNo (..) + , Range (..) + , SlotId (..) + , SlotInEpoch (..) + , SlotLength (..) + , SlottingParameters (..) + , StartTime (..) + ) +import Data.Generics.Internal.VL.Lens + ( (^.) ) +import Data.Maybe + ( fromMaybe ) +import Data.Quantity + ( Quantity (..) ) +import Data.Time + ( UTCTime ) +import Data.Time.Clock + ( NominalDiffTime, addUTCTime, diffUTCTime ) +import Data.Word + ( Word64 ) +import GHC.Generics + ( Generic ) +import Numeric.Natural + ( Natural ) + +{------------------------------------------------------------------------------- + Legacy slotting functions: + These only work for a single era. +-------------------------------------------------------------------------------} + +-- | 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 + +-- | @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 + +-- | 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)) diff --git a/lib/core/test/unit/Cardano/Wallet/Primitive/SlottingSpec.hs b/lib/core/test/unit/Cardano/Wallet/Primitive/SlottingSpec.hs index 016a89689b2..c741f4268e6 100644 --- a/lib/core/test/unit/Cardano/Wallet/Primitive/SlottingSpec.hs +++ b/lib/core/test/unit/Cardano/Wallet/Primitive/SlottingSpec.hs @@ -1,8 +1,10 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE TypeApplications #-} {-# OPTIONS_GHC -fno-warn-orphans #-} + module Cardano.Wallet.Primitive.SlottingSpec ( spec ) where @@ -15,18 +17,20 @@ import Cardano.Wallet.Gen ( genActiveSlotCoefficient, shrinkActiveSlotCoefficient ) import Cardano.Wallet.Primitive.Slotting ( Qry - , SlotParameters , endTimeOfEpoch , epochOf , firstSlotInEpoch + , singleEraInterpreter + , slotRangeFromTimeRange + , startTime + ) +import Cardano.Wallet.Primitive.Slotting.Legacy + ( SlotParameters (..) , flatSlot , fromFlatSlot - , singleEraInterpreter , slotParams - , slotRangeFromTimeRange , slotRangeFromTimeRange' , slotStartTime - , startTime ) import Cardano.Wallet.Primitive.Types ( ActiveSlotCoefficient @@ -42,6 +46,8 @@ import Cardano.Wallet.Primitive.Types.Hash ( Hash (..) ) import Data.Functor.Identity ( runIdentity ) +import Data.Generics.Internal.VL.Lens + ( (^.) ) import Data.Quantity ( Quantity (..) ) import Data.Time @@ -77,7 +83,7 @@ spec = do let legacy = slotRangeFromTimeRange' (slotParams t0 sp) timeRange - let el = getEpochLength sp + let el = sp ^. #getEpochLength let res' = fmap (fromFlatSlot el . unSlotNo) <$> res res' === legacy @@ -85,7 +91,7 @@ spec = do $ withMaxSuccess 10000 $ property $ \t0 sp e -> do let res = runIdentity $ singleEraInterpreter t0 sp (firstSlotInEpoch e) - let legacy = SlotNo $ flatSlot (getEpochLength sp) $ SlotId e 0 + let legacy = SlotNo $ flatSlot (sp ^. #getEpochLength) $ SlotId e 0 res === legacy @@ -106,10 +112,14 @@ legacySlottingTest legacySlottingTest legacyImpl newImpl t0 sp slotNo = withMaxSuccess 10000 $ do let res = runIdentity $ singleEraInterpreter t0 sp (newImpl slotNo) let legacy = legacyImpl (slotParams t0 sp) $ fromFlatSlot - (getEpochLength sp) + (sp ^. #getEpochLength) (unSlotNo slotNo) res === legacy +{------------------------------------------------------------------------------- + Arbitrary instances +-------------------------------------------------------------------------------} + instance Arbitrary SlotNo where -- Don't generate /too/ large slots arbitrary = SlotNo . fromIntegral <$> (arbitrary @Word32) diff --git a/lib/core/test/unit/Cardano/Wallet/Primitive/TypesSpec.hs b/lib/core/test/unit/Cardano/Wallet/Primitive/TypesSpec.hs index 080dd595d62..d8fb4cfb48e 100644 --- a/lib/core/test/unit/Cardano/Wallet/Primitive/TypesSpec.hs +++ b/lib/core/test/unit/Cardano/Wallet/Primitive/TypesSpec.hs @@ -30,7 +30,7 @@ import Cardano.Wallet.Primitive.AddressDerivation ( Depth (..), WalletKey (..), digest, publicKey ) import Cardano.Wallet.Primitive.AddressDerivation.Jormungandr ( JormungandrKey (..), generateKeyFromSeed ) -import Cardano.Wallet.Primitive.Slotting +import Cardano.Wallet.Primitive.Slotting.Legacy ( SlotParameters (..) , epochStartTime , flatSlot diff --git a/lib/shelley/src/Cardano/Wallet/Byron/Compatibility.hs b/lib/shelley/src/Cardano/Wallet/Byron/Compatibility.hs index 521b0f473a1..f22b59d812d 100644 --- a/lib/shelley/src/Cardano/Wallet/Byron/Compatibility.hs +++ b/lib/shelley/src/Cardano/Wallet/Byron/Compatibility.hs @@ -38,7 +38,6 @@ module Cardano.Wallet.Byron.Compatibility , toByronHash , toGenTx , toPoint - , toSlotInEpoch , fromBlockNo , fromByronBlock @@ -49,7 +48,6 @@ module Cardano.Wallet.Byron.Compatibility , byronCodecConfig , fromNetworkMagic , fromProtocolMagicId - , fromSlotNo , fromTip , fromTxAux , fromTxIn @@ -85,8 +83,6 @@ import Cardano.Crypto ( serializeCborHash ) import Cardano.Crypto.ProtocolMagic ( ProtocolMagicId, unProtocolMagicId ) -import Cardano.Wallet.Primitive.Slotting - ( flatSlot, fromFlatSlot ) import Cardano.Wallet.Unsafe ( unsafeDeserialiseCbor, unsafeFromHex ) import Crypto.Hash.Utils @@ -306,10 +302,6 @@ toPoint genesisH (W.BlockHeader sl _ h _) | h == (coerce genesisH) = O.GenesisPoint | otherwise = O.Point $ Point.block sl (toByronHash h) -toSlotInEpoch :: W.EpochLength -> W.SlotId -> SlotNo -toSlotInEpoch epLength = - SlotNo . flatSlot epLength - -- | SealedTx are the result of rightfully constructed byron transactions so, it -- is relatively safe to unserialize them from CBOR. toGenTx :: HasCallStack => W.SealedTx -> GenTx ByronBlock @@ -395,10 +387,6 @@ fromChainHash genesisHash = \case O.GenesisHash -> coerce genesisHash O.BlockHash h -> fromByronHash h -fromSlotNo :: W.EpochLength -> SlotNo -> W.SlotId -fromSlotNo epLength (SlotNo sl) = - fromFlatSlot epLength sl - -- FIXME unsafe conversion (Word64 -> Word32) fromBlockNo :: BlockNo -> Quantity "block" Word32 fromBlockNo (BlockNo h) = diff --git a/lib/shelley/test/unit/Cardano/Wallet/Shelley/CompatibilitySpec.hs b/lib/shelley/test/unit/Cardano/Wallet/Shelley/CompatibilitySpec.hs index bdc09386cd8..ff987582437 100644 --- a/lib/shelley/test/unit/Cardano/Wallet/Shelley/CompatibilitySpec.hs +++ b/lib/shelley/test/unit/Cardano/Wallet/Shelley/CompatibilitySpec.hs @@ -41,10 +41,8 @@ import Cardano.Wallet.Primitive.AddressDerivation.Byron ( ByronKey (..) ) import Cardano.Wallet.Primitive.AddressDerivation.Shelley ( ShelleyKey (..) ) -import Cardano.Wallet.Primitive.Slotting - ( fromFlatSlot ) import Cardano.Wallet.Primitive.Types - ( DecentralizationLevel (..), EpochLength (..), SlotId (..) ) + ( DecentralizationLevel (..), SlotId (..) ) import Cardano.Wallet.Primitive.Types.Address ( Address (..) ) import Cardano.Wallet.Primitive.Types.Hash @@ -88,7 +86,7 @@ import Data.Text import Data.Text.Class ( toText ) import Data.Word - ( Word64 ) + ( Word32, Word64 ) import GHC.TypeLits ( natVal ) import Ouroboros.Network.Block @@ -319,9 +317,6 @@ instance Arbitrary (Tip (CardanoBlock StandardCrypto)) where . BS.pack <$> vector 5 return $ Tip (SlotNo n) hash (BlockNo n) -epochLength :: EpochLength -epochLength = EpochLength 10 - instance Arbitrary SL.UnitInterval where arbitrary = oneof [ pure interval0 @@ -332,7 +327,9 @@ instance Arbitrary SL.UnitInterval where shrink = genericShrink instance Arbitrary SlotId where - arbitrary = fromFlatSlot epochLength <$> choose (0, 100) + arbitrary = SlotId + <$> (W.EpochNo . fromIntegral <$> choose (0, 10 :: Word32)) + <*> (W.SlotInEpoch <$> choose (0, 10)) instance Arbitrary (ShelleyKey 'AddressK XPrv) where shrink _ = []