[ADP-3229] Move SyncProgress module to primitive lib (#4253)

- [x] Move SyncProgress module to primitive lib ADP-3229
cardano-foundation · Nov 22, 2023 · 1b369e8 · 1b369e8
2 parents e5a6ca6 + 951d352
commit 1b369e8
Show file tree

Hide file tree

Showing 6 changed files with 70 additions and 52 deletions.
diff --git 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/.../Cardano/Wallet/Primitive/SyncProgress.hs → .../Cardano/Wallet/Primitive/SyncProgress.hs b/.../Cardano/Wallet/Primitive/SyncProgress.hs → .../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
@@ -1,17 +1,24 @@
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TypeApplications #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
 
 module Cardano.Wallet.Primitive.Types.Block.Gen
     ( genBlockHeader
+    , genSlot
+    , genSlotNo
+    , shrinkSlotNo
     )
 where
 
 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
@@ -1,6 +1,5 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE TupleSections #-}
-{-# LANGUAGE TypeApplications #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
 {- HLINT ignore "Use camelCase" -}
@@ -12,15 +11,16 @@ module Cardano.Wallet.Primitive.Types.BlockSummarySpec
 import Prelude
 
 import Cardano.Slotting.Slot
-    ( SlotNo (..)
-    , WithOrigin (..)
+    ( WithOrigin (..)
     )
 import Cardano.Wallet.Primitive.Types.Block
     ( BlockHeader (..)
     , Slot
     )
 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/...dano/Wallet/Primitive/SyncProgressSpec.hs → ...dano/Wallet/Primitive/SyncProgressSpec.hs b/...dano/Wallet/Primitive/SyncProgressSpec.hs → ...dano/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
@@ -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