Move decentralisationParam test case over to shelley package

cardano-foundation · Jun 12, 2020 · 734dd56 · 734dd56
1 parent d5f30e4
commit 734dd56
Show file tree

Hide file tree

Showing 3 changed files with 93 additions and 10 deletions.
diff --git a/lib/byron/test/unit/Cardano/Wallet/Byron/NetworkSpec.hs b/lib/byron/test/unit/Cardano/Wallet/Byron/NetworkSpec.hs
@@ -19,8 +19,7 @@ import Cardano.Wallet.Byron.Network
 import Cardano.Wallet.Network
     ( NetworkLayer (..) )
 import Cardano.Wallet.Primitive.Types
-    ( DecentralizationLevel (..)
-    , FeePolicy (..)
+    ( FeePolicy (..)
     , NetworkParameters (..)
     , ProtocolParameters (..)
     , TxParameters (..)
@@ -36,7 +35,7 @@ import Data.Generics.Labels
 import Data.Maybe
     ( mapMaybe )
 import Data.Quantity
-    ( Quantity (..), mkPercentage )
+    ( Quantity (..) )
 import Test.Hspec
     ( Spec, describe, it, shouldBe, shouldReturn )
 import Test.Utils.Paths
@@ -54,8 +53,7 @@ spec = describe "getTxParameters" $ do
         withTestNode $ \np sock vData -> withLogging $ \(tr, getLogs) -> do
             -- Initial TxParameters for NetworkLayer are all zero
             let np' = np &
-                    (#protocolParameters . #txParameters) `set` zeroTxParameters &
-                    (#protocolParameters . #decentralizationLevel) `set` halfD
+                    (#protocolParameters . #txParameters) `set` zeroTxParameters
             withNetworkLayer tr np' sock vData $ \nl -> do
                 -- After a short while, the network layer should have gotten
                 -- protocol parameters from the node, and they should reflect
@@ -82,8 +80,3 @@ zeroTxParameters :: TxParameters
 zeroTxParameters = TxParameters
     (LinearFee (Quantity 0) (Quantity 0) (Quantity 0))
     (Quantity 0)
-
--- | A value that is not the same as what's in the test data genesis.
-halfD :: DecentralizationLevel
-halfD = DecentralizationLevel p
-    where Right p = mkPercentage (1/2)
diff --git a/lib/shelley/cardano-wallet-shelley.cabal b/lib/shelley/cardano-wallet-shelley.cabal
@@ -151,6 +151,7 @@ test-suite unit
       Main.hs
   other-modules:
       Cardano.Wallet.Shelley.CompatibilitySpec
+      Cardano.Wallet.Shelley.NetworkSpec
 
 test-suite integration
   default-language:

diff --git a/lib/shelley/test/unit/Cardano/Wallet/Shelley/NetworkSpec.hs b/lib/shelley/test/unit/Cardano/Wallet/Shelley/NetworkSpec.hs
@@ -0,0 +1,89 @@
+{-# LANGUAGE NumericUnderscores #-}
+{-# LANGUAGE OverloadedLabels #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+module Cardano.Wallet.Shelley.NetworkSpec (spec) where
+
+import Prelude
+
+import Cardano.BM.Data.Severity
+    ( Severity (..) )
+import Cardano.BM.Trace
+    ( nullTracer )
+import Cardano.Wallet.Byron.Compatibility
+    ( NodeVersionData )
+import Cardano.Wallet.Byron.Launch
+    ( withCardanoNode )
+import Cardano.Wallet.Byron.Network
+    ( NetworkLayerLog (..), withNetworkLayer )
+import Cardano.Wallet.Network
+    ( NetworkLayer (..) )
+import Cardano.Wallet.Primitive.Types
+    ( DecentralizationLevel (..)
+    , FeePolicy (..)
+    , NetworkParameters (..)
+    , ProtocolParameters (..)
+    , TxParameters (..)
+    )
+import Control.Retry
+    ( constantDelay, limitRetries, recoverAll )
+import Data.Function
+    ( (&) )
+import Data.Generics.Internal.VL.Lens
+    ( set )
+import Data.Generics.Labels
+    ()
+import Data.Maybe
+    ( mapMaybe )
+import Data.Quantity
+    ( Quantity (..), mkPercentage )
+import Test.Hspec
+    ( Spec, describe, it, shouldBe, shouldReturn )
+import Test.Utils.Paths
+    ( getTestData )
+import Test.Utils.Trace
+    ( withLogging )
+
+{-------------------------------------------------------------------------------
+                                      Spec
+-------------------------------------------------------------------------------}
+
+spec :: Spec
+spec = describe "getTxParameters" $ do
+    it "Correct values are queried" $
+        withTestNode $ \np sock vData -> withLogging $ \(tr, getLogs) -> do
+            -- Initial TxParameters for NetworkLayer are all zero
+            let np' = np &
+                    (#protocolParameters . #txParameters) `set` zeroTxParameters &
+                    (#protocolParameters . #decentralizationLevel) `set` fakeD
+            withNetworkLayer tr np' sock vData $ \nl -> do
+                -- After a short while, the network layer should have gotten
+                -- protocol parameters from the node, and they should reflect
+                -- the genesis block configuration.
+                let retryPolicy = constantDelay 1_000_000 <> limitRetries 10
+                recoverAll retryPolicy $ const $
+                    getProtocolParameters nl `shouldReturn`
+                        protocolParameters np
+            -- Parameters update should be logged exactly once.
+            msg <- mapMaybe isMsgProtocolParams <$> getLogs
+            msg `shouldBe` [protocolParameters np]
+
+withTestNode
+    :: (NetworkParameters -> FilePath -> NodeVersionData -> IO a)
+    -> IO a
+withTestNode action = withCardanoNode nullTracer $(getTestData) Error $
+    \sock _block0 (np, vData) -> action np sock vData
+
+isMsgProtocolParams :: NetworkLayerLog -> Maybe ProtocolParameters
+isMsgProtocolParams (MsgProtocolParameters pp) = Just pp
+isMsgProtocolParams _ = Nothing
+
+zeroTxParameters :: TxParameters
+zeroTxParameters = TxParameters
+    (LinearFee (Quantity 0) (Quantity 0) (Quantity 0))
+    (Quantity 0)
+
+-- | A value that is not the same as what's in the test data genesis.
+fakeD :: DecentralizationLevel
+fakeD = DecentralizationLevel p
+    where Right p = mkPercentage (5/32)