diff --git a/lib/primitive/cardano-wallet-primitive.cabal b/lib/primitive/cardano-wallet-primitive.cabal index 2f7c3ec745b..f8363ff2617 100644 --- a/lib/primitive/cardano-wallet-primitive.cabal +++ b/lib/primitive/cardano-wallet-primitive.cabal @@ -99,6 +99,7 @@ library Cardano.Wallet.Primitive.NetworkId Cardano.Wallet.Primitive.Slotting Cardano.Wallet.Primitive.Slotting.Legacy + Cardano.Wallet.Primitive.SyncProgress Cardano.Wallet.Primitive.Types.Address Cardano.Wallet.Primitive.Types.Address.Gen Cardano.Wallet.Primitive.Types.Block @@ -174,6 +175,7 @@ test-suite test , containers , delta-store , delta-types + , deepseq , filepath , fmt , generic-arbitrary @@ -202,6 +204,7 @@ test-suite test other-modules: Cardano.Wallet.Primitive.CollateralSpec Cardano.Wallet.Primitive.SlottingSpec + Cardano.Wallet.Primitive.SyncProgressSpec Cardano.Wallet.Primitive.Types.AddressSpec Cardano.Wallet.Primitive.Types.BlockSummarySpec Cardano.Wallet.Primitive.Types.CoinSpec diff --git a/lib/wallet/src/Cardano/Wallet/Primitive/SyncProgress.hs b/lib/primitive/lib/Cardano/Wallet/Primitive/SyncProgress.hs similarity index 98% rename from lib/wallet/src/Cardano/Wallet/Primitive/SyncProgress.hs rename to lib/primitive/lib/Cardano/Wallet/Primitive/SyncProgress.hs index e3eb45410fc..cafd175ceeb 100644 --- a/lib/wallet/src/Cardano/Wallet/Primitive/SyncProgress.hs +++ b/lib/primitive/lib/Cardano/Wallet/Primitive/SyncProgress.hs @@ -19,14 +19,14 @@ module Cardano.Wallet.Primitive.SyncProgress import Prelude +import Cardano.Slotting.Slot + ( SlotNo + ) import Cardano.Wallet.Primitive.Slotting ( TimeInterpreter , interpretQuery , slotToRelTime ) -import Cardano.Wallet.Primitive.Types - ( SlotNo (..) - ) import Control.DeepSeq ( NFData (..) ) diff --git a/lib/primitive/lib/Cardano/Wallet/Primitive/Types/Block/Gen.hs b/lib/primitive/lib/Cardano/Wallet/Primitive/Types/Block/Gen.hs index cbf42650252..a0e1e7702ca 100644 --- a/lib/primitive/lib/Cardano/Wallet/Primitive/Types/Block/Gen.hs +++ b/lib/primitive/lib/Cardano/Wallet/Primitive/Types/Block/Gen.hs @@ -1,7 +1,12 @@ {-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeApplications #-} +{-# OPTIONS_GHC -Wno-orphans #-} module Cardano.Wallet.Primitive.Types.Block.Gen ( genBlockHeader + , genSlot + , genSlotNo + , shrinkSlotNo ) where @@ -9,9 +14,11 @@ import Prelude import Cardano.Slotting.Slot ( SlotNo (..) + , WithOrigin (..) ) import Cardano.Wallet.Primitive.Types.Block ( BlockHeader (..) + , Slot ) import Cardano.Wallet.Primitive.Types.Hash ( Hash (..) @@ -26,8 +33,10 @@ import Data.Word ( Word32 ) import Test.QuickCheck - ( Gen + ( Arbitrary (..) + , Gen , elements + , frequency ) genBlockHeader :: SlotNo -> Gen BlockHeader @@ -49,3 +58,17 @@ genBlockHeader sl = do $ unsafeFromHex "63b8828e2eadc3f14b9b691fa9df76139a9c9b13a12ec862b324cc5a88f9fcc5" ] + +genSlot :: Gen Slot +genSlot = + frequency + [ (1, pure Origin) + , (40, At <$> genSlotNo) + ] + +-- | Don't generate /too/ large slots +genSlotNo :: Gen SlotNo +genSlotNo = SlotNo . fromIntegral <$> arbitrary @Word32 + +shrinkSlotNo :: SlotNo -> [SlotNo] +shrinkSlotNo (SlotNo x) = SlotNo <$> shrink x diff --git a/lib/primitive/test/data/Cardano/Wallet/Primitive/Types/BlockSummarySpec.hs b/lib/primitive/test/data/Cardano/Wallet/Primitive/Types/BlockSummarySpec.hs index 4ee9f46cc95..d6a698e393d 100644 --- a/lib/primitive/test/data/Cardano/Wallet/Primitive/Types/BlockSummarySpec.hs +++ b/lib/primitive/test/data/Cardano/Wallet/Primitive/Types/BlockSummarySpec.hs @@ -1,6 +1,5 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TupleSections #-} -{-# LANGUAGE TypeApplications #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {- HLINT ignore "Use camelCase" -} @@ -12,8 +11,7 @@ module Cardano.Wallet.Primitive.Types.BlockSummarySpec import Prelude import Cardano.Slotting.Slot - ( SlotNo (..) - , WithOrigin (..) + ( WithOrigin (..) ) import Cardano.Wallet.Primitive.Types.Block ( BlockHeader (..) @@ -21,6 +19,8 @@ import Cardano.Wallet.Primitive.Types.Block ) import Cardano.Wallet.Primitive.Types.Block.Gen ( genBlockHeader + , genSlot + , genSlotNo ) import Cardano.Wallet.Primitive.Types.BlockSummary ( BlockEvents (BlockEvents, slot) @@ -39,9 +39,6 @@ import Cardano.Wallet.Primitive.Types.Tx.Gen import Data.Foldable ( toList ) -import Data.Word - ( Word32 - ) import Test.Hspec ( Spec , describe @@ -52,7 +49,6 @@ import Test.QuickCheck , Gen , Property , forAll - , frequency , listOf1 , property , resize @@ -140,13 +136,3 @@ instance Arbitrary BlockEvents where ht <$> (wholeList <$> resize 2 (listOf1 genTx)) <*> pure (wholeList []) - -genSlot :: Gen Slot -genSlot = frequency - [ ( 1, pure Origin) - , (40, At <$> genSlotNo) - ] - --- | Don't generate /too/ large slots -genSlotNo :: Gen SlotNo -genSlotNo = SlotNo . fromIntegral <$> arbitrary @Word32 diff --git a/lib/wallet/test/unit/Cardano/Wallet/Primitive/SyncProgressSpec.hs b/lib/primitive/test/spec/Cardano/Wallet/Primitive/SyncProgressSpec.hs similarity index 85% rename from lib/wallet/test/unit/Cardano/Wallet/Primitive/SyncProgressSpec.hs rename to lib/primitive/test/spec/Cardano/Wallet/Primitive/SyncProgressSpec.hs index d4553be80fc..b1cea292b30 100644 --- a/lib/wallet/test/unit/Cardano/Wallet/Primitive/SyncProgressSpec.hs +++ b/lib/primitive/test/spec/Cardano/Wallet/Primitive/SyncProgressSpec.hs @@ -10,13 +10,12 @@ module Cardano.Wallet.Primitive.SyncProgressSpec import Prelude -import Cardano.Wallet.Gen - ( genBlockHeader - , genSlotNo - , shrinkSlotNo +import Cardano.Slotting.Slot + ( SlotNo (..) ) import Cardano.Wallet.Primitive.Slotting - ( TimeInterpreter + ( StartTime (..) + , TimeInterpreter , interpretQuery , mkSingleEraInterpreter , slotToRelTime @@ -26,14 +25,19 @@ import Cardano.Wallet.Primitive.SyncProgress , SyncTolerance (..) , syncProgress ) -import Cardano.Wallet.Primitive.Types - ( ActiveSlotCoefficient (..) - , BlockHeader (..) +import Cardano.Wallet.Primitive.Types.Block + ( BlockHeader + ) +import Cardano.Wallet.Primitive.Types.Block.Gen + ( genBlockHeader + , genSlotNo + , shrinkSlotNo + ) +import Cardano.Wallet.Primitive.Types.SlottingParameters + ( ActiveSlotCoefficient , EpochLength (..) , SlotLength (..) - , SlotNo (..) , SlottingParameters (..) - , StartTime (..) ) import Cardano.Wallet.Primitive.Types.SlottingParameters.Gen ( genActiveSlotCoefficient @@ -87,12 +91,13 @@ import UnliftIO.Exception spec :: Spec spec = do let t0 = read "2019-11-09 16:43:02 UTC" - let sp = SlottingParameters - { getEpochLength = EpochLength 21_600 - , getSlotLength = SlotLength 10 - , getActiveSlotCoefficient = 1 - , getSecurityParameter = Quantity 2_160 - } + let sp = + SlottingParameters + { getEpochLength = EpochLength 21_600 + , getSlotLength = SlotLength 10 + , getActiveSlotCoefficient = 1 + , getSecurityParameter = Quantity 2_160 + } let st = SyncTolerance 10 let ti = (mkSingleEraInterpreter (StartTime t0) sp :: TimeInterpreter Identity) @@ -155,9 +160,10 @@ spec = do ] forM_ plots $ \(nodeTip, p) -> do let ntwkTime = runQry $ slotToRelTime $ SlotNo 10 - let progress = if p == 1 - then Ready - else Syncing (Quantity $ unsafeMkPercentage p) + let progress = + if p == 1 + then Ready + else Syncing (Quantity $ unsafeMkPercentage p) runIdentity (syncProgress tolerance ti nodeTip ntwkTime) `shouldBe` progress @@ -168,21 +174,15 @@ spec = do runIdentity (syncProgress tolerance ti tip ntwkTime) `shouldBe` Syncing (Quantity $ unsafeMkPercentage 0.000_5) - it "syncProgress should never crash" $ withMaxSuccess 10_000 - $ property $ \tip dt -> monadicIO $ do + it "syncProgress should never crash" + $ withMaxSuccess 10_000 + $ property + $ \tip dt -> monadicIO $ do let x = runIdentity $ syncProgress tolerance ti tip dt res <- run (try @IO @SomeException $ evaluate x) monitor (counterexample $ "Result: " ++ show res) assert (isRight res) -instance Arbitrary BlockHeader where - shrink _ = [] - arbitrary = arbitrary >>= genBlockHeader - -instance Arbitrary SlotNo where - arbitrary = genSlotNo - shrink = shrinkSlotNo - -- Arbitrary instance with whole second values. instance Arbitrary RelativeTime where arbitrary = RelativeTime . fromIntegral <$> arbitrary @Int @@ -192,3 +192,11 @@ instance Arbitrary RelativeTime where instance Arbitrary ActiveSlotCoefficient where shrink = shrinkActiveSlotCoefficient arbitrary = genActiveSlotCoefficient + +instance Arbitrary BlockHeader where + shrink _ = [] + arbitrary = arbitrary >>= genBlockHeader + +instance Arbitrary SlotNo where + arbitrary = genSlotNo + shrink = shrinkSlotNo diff --git a/lib/wallet/cardano-wallet.cabal b/lib/wallet/cardano-wallet.cabal index 134da66df63..9974d009c1b 100644 --- a/lib/wallet/cardano-wallet.cabal +++ b/lib/wallet/cardano-wallet.cabal @@ -303,7 +303,6 @@ library Cardano.Wallet.Primitive.Delegation.UTxO Cardano.Wallet.Primitive.Model Cardano.Wallet.Primitive.Slotting.TimeTranslation - Cardano.Wallet.Primitive.SyncProgress Cardano.Wallet.Primitive.Types Cardano.Wallet.Primitive.Types.Address.Constants Cardano.Wallet.Primitive.Types.Credentials @@ -914,7 +913,6 @@ test-suite unit Cardano.Wallet.Primitive.ModelSpec Cardano.Wallet.Primitive.Passphrase.LegacySpec Cardano.Wallet.Primitive.PassphraseSpec - Cardano.Wallet.Primitive.SyncProgressSpec Cardano.Wallet.Primitive.Types.StateDeltaSeqSpec Cardano.Wallet.Primitive.Types.Tx.TxSeqSpec Cardano.Wallet.Primitive.TypesSpec