[CO-354] Run testsuites with multiple ProtocolMagics

To minimize risk of inadequate test coverage, due to too few
`ProtocolMagic`s being used, we run the tests a specified number
of times, with different `ProtocolMagic` values.

We also use `choose` from Quickcheck to get uniformly distributed random
values for the `ProtocolMagicId` field. `arbitrary`, by comparison,
generates small Int32s, which is not desirable for testing because we
want to exercise multiple sizes of CBOR encoding.

client/test/Test/Pos/Client/Txp/UtilSpec.hs

@@ -15,7 +15,7 @@ import qualified Data.Map as M
 import qualified Data.Set as S
 import           Formatting (build, hex, left, sformat, shown, (%), (%.))
 import           Test.Hspec (Spec, describe, runIO)
-import           Test.Hspec.QuickCheck (prop)
+import           Test.Hspec.QuickCheck (modifyMaxSuccess, prop)
 import           Test.QuickCheck (Discard (..), Gen, Testable, arbitrary, choose, generate)
 import           Test.QuickCheck.Monadic (forAllM, stop)
 
@@ -38,23 +38,32 @@ import           Pos.Util.Util (leftToPanic)
 import           Test.Pos.Client.Txp.Mode (HasTxpConfigurations, TxpTestMode, TxpTestProperty,
                                            withBVData)
 import           Test.Pos.Configuration (withProvidedMagicConfig)
+import           Test.Pos.Crypto.Arbitrary (genProtocolMagicUniformWithRNM)
 import           Test.Pos.Util.QuickCheck.Arbitrary (nonrepeating)
 import           Test.Pos.Util.QuickCheck.Property (stopProperty)
 
 ----------------------------------------------------------------------------
 -- Tests
 ----------------------------------------------------------------------------
 
+
+-- We run the tests this number of times, with different `ProtocolMagics`, to get increased
+-- coverage. We should really do this inside of the `prop`, but it is difficult to do that
+-- without significant rewriting of the testsuite.
+testMultiple :: Int
+testMultiple = 3
+
 spec :: Spec
 spec = do
     runWithMagic NMMustBeNothing
     runWithMagic NMMustBeJust
 
 runWithMagic :: RequiresNetworkMagic -> Spec
-runWithMagic rnm = do
-    pm <- (\ident -> ProtocolMagic ident rnm) <$> runIO (generate arbitrary)
-    describe ("(requiresNetworkMagic=" ++ show rnm ++ ")") $
-        specBody pm
+runWithMagic rnm = replicateM_ testMultiple $
+    modifyMaxSuccess (`div` testMultiple) $ do
+        pm <- runIO (generate (genProtocolMagicUniformWithRNM rnm))
+        describe ("(requiresNetworkMagic=" ++ show rnm ++ ")") $
+            specBody pm
 
 specBody :: ProtocolMagic -> Spec
 specBody pm = withProvidedMagicConfig pm $

core/test/Test/Pos/Core/AddressSpec.hs

@@ -27,17 +27,26 @@ import           Pos.Crypto (EncryptedSecretKey, PassPhrase, ProtocolMagic (..),
 import           Pos.Crypto.HD (HDAddressPayload (..))
 
 import           Test.Pos.Core.Arbitrary ()
+import           Test.Pos.Crypto.Arbitrary (genProtocolMagicUniformWithRNM)
+
+
+-- We run the tests this number of times, with different `ProtocolMagics`, to get increased
+-- coverage. We should really do this inside of the `prop`, but it is difficult to do that
+-- without significant rewriting of the testsuite.
+testMultiple :: Int
+testMultiple = 3
 
 spec :: Spec
 spec = do
     runWithMagic NMMustBeNothing
     runWithMagic NMMustBeJust
 
 runWithMagic :: RequiresNetworkMagic -> Spec
-runWithMagic rnm = do
-    pm <- (\ident -> ProtocolMagic ident rnm) <$> runIO (generate arbitrary)
-    describe ("(requiresNetworkMagic=" ++ show rnm ++ ")") $
-        specBody pm
+runWithMagic rnm = replicateM_ testMultiple $
+    modifyMaxSuccess (`div` testMultiple) $ do
+        pm <- runIO (generate (genProtocolMagicUniformWithRNM rnm))
+        describe ("(requiresNetworkMagic=" ++ show rnm ++ ")") $
+            specBody pm
 
 -- An attempt to avoid rightward creep
 specBody :: ProtocolMagic -> Spec

core/test/Test/Pos/Core/CborSpec.hs

@@ -13,6 +13,7 @@ module Test.Pos.Core.CborSpec
 import           Universum
 
 import           Test.Hspec (Spec, describe, runIO)
+import           Test.Hspec.QuickCheck (modifyMaxSuccess)
 import           Test.QuickCheck (Arbitrary (..), generate)
 import           Test.QuickCheck.Arbitrary.Generic (genericArbitrary, genericShrink)
 
@@ -29,7 +30,7 @@ import           Pos.Merkle (MerkleTree)
 import           Test.Pos.Binary.Helpers (binaryTest)
 import           Test.Pos.Core.Arbitrary ()
 import           Test.Pos.Core.Chrono ()
-import           Test.Pos.Crypto.Arbitrary ()
+import           Test.Pos.Crypto.Arbitrary (genProtocolMagicUniformWithRNM)
 
 
 data MyScript = MyScript
@@ -77,50 +78,56 @@ instance Bi (Attributes X2) where
 
 ----------------------------------------
 
+-- We run the tests this number of times, with different `ProtocolMagics`, to get increased
+-- coverage. We should really do this inside of the `prop`, but it is difficult to do that
+-- without significant rewriting of the testsuite.
+testMultiple :: Int
+testMultiple = 3
 
 spec :: Spec
 spec = do
     runWithMagic NMMustBeNothing
     runWithMagic NMMustBeJust
 
 runWithMagic :: RequiresNetworkMagic -> Spec
-runWithMagic rnm = do
-    pm <- (\ident -> ProtocolMagic ident rnm) <$> runIO (generate arbitrary)
-    describe ("(requiresNetworkMagic=" ++ show rnm ++ ")") $
-        withGenesisSpec 0 (defaultCoreConfiguration pm) $ \_ ->
-            describe "Cbor Bi instances" $ do
-                describe "Core.Address" $ do
-                    binaryTest @Address
-                    binaryTest @Address'
-                    binaryTest @AddrType
-                    binaryTest @AddrStakeDistribution
-                    binaryTest @AddrSpendingData
-                describe "Core.Types" $ do
-                    binaryTest @Timestamp
-                    binaryTest @TimeDiff
-                    binaryTest @EpochIndex
-                    binaryTest @Coin
-                    binaryTest @CoinPortion
-                    binaryTest @LocalSlotIndex
-                    binaryTest @SlotId
-                    binaryTest @EpochOrSlot
-                    binaryTest @SharedSeed
-                    binaryTest @ChainDifficulty
-                    binaryTest @SoftforkRule
-                    binaryTest @BlockVersionData
-                    binaryTest @(Attributes ())
-                    binaryTest @(Attributes AddrAttributes)
-                describe "Core.Fee" $ do
-                    binaryTest @Coeff
-                    binaryTest @TxSizeLinear
-                    binaryTest @TxFeePolicy
-                describe "Core.Script" $ do
-                    binaryTest @Script
-                describe "Core.Vss" $ do
-                    binaryTest @VssCertificate
-                describe "Core.Version" $ do
-                    binaryTest @ApplicationName
-                    binaryTest @SoftwareVersion
-                    binaryTest @BlockVersion
-                describe "Merkle" $ do
-                    binaryTest @(MerkleTree Int32)
+runWithMagic rnm = replicateM_ testMultiple $
+    modifyMaxSuccess (`div` testMultiple) $ do
+        pm <- runIO (generate (genProtocolMagicUniformWithRNM rnm))
+        describe ("(requiresNetworkMagic=" ++ show rnm ++ ")") $
+            withGenesisSpec 0 (defaultCoreConfiguration pm) $ \_ ->
+                describe "Cbor Bi instances" $ do
+                    describe "Core.Address" $ do
+                        binaryTest @Address
+                        binaryTest @Address'
+                        binaryTest @AddrType
+                        binaryTest @AddrStakeDistribution
+                        binaryTest @AddrSpendingData
+                    describe "Core.Types" $ do
+                        binaryTest @Timestamp
+                        binaryTest @TimeDiff
+                        binaryTest @EpochIndex
+                        binaryTest @Coin
+                        binaryTest @CoinPortion
+                        binaryTest @LocalSlotIndex
+                        binaryTest @SlotId
+                        binaryTest @EpochOrSlot
+                        binaryTest @SharedSeed
+                        binaryTest @ChainDifficulty
+                        binaryTest @SoftforkRule
+                        binaryTest @BlockVersionData
+                        binaryTest @(Attributes ())
+                        binaryTest @(Attributes AddrAttributes)
+                    describe "Core.Fee" $ do
+                        binaryTest @Coeff
+                        binaryTest @TxSizeLinear
+                        binaryTest @TxFeePolicy
+                    describe "Core.Script" $ do
+                        binaryTest @Script
+                    describe "Core.Vss" $ do
+                        binaryTest @VssCertificate
+                    describe "Core.Version" $ do
+                        binaryTest @ApplicationName
+                        binaryTest @SoftwareVersion
+                        binaryTest @BlockVersion
+                    describe "Merkle" $ do
+                        binaryTest @(MerkleTree Int32)

core/test/Test/Pos/Core/SlottingSpec.hs

@@ -7,27 +7,35 @@ module Test.Pos.Core.SlottingSpec
 import           Universum
 
 import           Test.Hspec (Expectation, Spec, anyErrorCall, describe, runIO)
-import           Test.Hspec.QuickCheck (prop)
-import           Test.QuickCheck (NonNegative (..), Positive (..), Property, arbitrary, generate,
-                                  (===), (==>))
+import           Test.Hspec.QuickCheck (modifyMaxSuccess, prop)
+import           Test.QuickCheck (NonNegative (..), Positive (..), Property, generate, (===), (==>))
 
 import           Pos.Core (EpochOrSlot, HasConfiguration, SlotId (..), defaultCoreConfiguration,
                            flattenSlotId, unflattenSlotId, withGenesisSpec)
 import           Pos.Crypto (ProtocolMagic (..), RequiresNetworkMagic (..))
 
 import           Test.Pos.Core.Arbitrary (EoSToIntOverflow (..), UnreasonableEoS (..))
+import           Test.Pos.Crypto.Arbitrary (genProtocolMagicUniformWithRNM)
 import           Test.Pos.Util.QuickCheck.Property (shouldThrowException, (.=.))
 
+
+-- We run the tests this number of times, with different `ProtocolMagics`, to get increased
+-- coverage. We should really do this inside of the `prop`, but it is difficult to do that
+-- without significant rewriting of the testsuite.
+testMultiple :: Int
+testMultiple = 3
+
 spec :: Spec
 spec = do
     runWithMagic NMMustBeNothing
     runWithMagic NMMustBeJust
 
 runWithMagic :: RequiresNetworkMagic -> Spec
-runWithMagic rnm = do
-    pm <- (\ident -> ProtocolMagic ident rnm) <$> runIO (generate arbitrary)
-    describe ("(requiresNetworkMagic=" ++ show rnm ++ ")") $
-        specBody pm
+runWithMagic rnm = replicateM_ testMultiple $
+    modifyMaxSuccess (`div` testMultiple) $ do
+        pm <- runIO (generate (genProtocolMagicUniformWithRNM rnm))
+        describe ("(requiresNetworkMagic=" ++ show rnm ++ ")") $
+            specBody pm
 
 specBody :: ProtocolMagic -> Spec
 specBody pm = withGenesisSpec 0 (defaultCoreConfiguration pm) $ \_ -> describe "Slotting" $ do

crypto/test/Test/Pos/Crypto/Arbitrary.hs

@@ -9,14 +9,15 @@ module Test.Pos.Crypto.Arbitrary
        , genSignature
        , genSignatureEncoded
        , genRedeemSignature
+       , genProtocolMagicUniformWithRNM
        ) where
 
 import           Universum hiding (keys)
 
 import           Control.Monad (zipWithM)
 import qualified Data.ByteArray as ByteArray
 import           Data.List.NonEmpty (fromList)
-import           Test.QuickCheck (Arbitrary (..), Gen, elements, oneof, vector)
+import           Test.QuickCheck (Arbitrary (..), Gen, choose, elements, oneof, vector)
 import           Test.QuickCheck.Arbitrary.Generic (genericArbitrary, genericShrink)
 
 import           Pos.Binary.Class (AsBinary (..), AsBinaryClass (..), Bi, Raw)
@@ -54,6 +55,12 @@ instance Arbitrary ProtocolMagicId where
 instance Arbitrary RequiresNetworkMagic where
     arbitrary = elements [NMMustBeNothing, NMMustBeJust]
 
+genProtocolMagicUniformWithRNM :: RequiresNetworkMagic -> Gen ProtocolMagic
+genProtocolMagicUniformWithRNM rnm =
+    (\ident -> ProtocolMagic (ProtocolMagicId ident) rnm)
+    <$>
+    choose (minBound, maxBound)
+
 {- A note on 'Arbitrary' instances
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 

explorer/cardano-sl-explorer.cabal

@@ -356,6 +356,7 @@ test-suite cardano-explorer-test
                      , cardano-sl-block-test
                      , cardano-sl-core
                      , cardano-sl-crypto
+                     , cardano-sl-crypto-test
                      , cardano-sl-explorer
                      , cardano-sl-txp
                      , cardano-sl-util

explorer/test/Test/Pos/Explorer/Socket/MethodsSpec.hs

@@ -16,12 +16,12 @@ import qualified Data.Set as S
 import           Network.EngineIO (SocketId)
 
 import           Test.Hspec (Spec, anyException, describe, it, runIO, shouldBe, shouldThrow)
-import           Test.Hspec.QuickCheck (modifyMaxSize, prop)
+import           Test.Hspec.QuickCheck (modifyMaxSize, modifyMaxSuccess, prop)
 import           Test.QuickCheck (Property, arbitrary, forAll, generate)
 import           Test.QuickCheck.Monadic (assert, monadicIO, run)
 
 import           Pos.Core.NetworkMagic (NetworkMagic, makeNetworkMagic)
-import           Pos.Crypto (ProtocolMagic (..), RequiresNetworkMagic (..), SecretKey)
+import           Pos.Crypto (RequiresNetworkMagic (..), SecretKey)
 import           Pos.Explorer.ExplorerMode (runSubTestMode)
 import           Pos.Explorer.Socket.Holder (ConnectionsState, ExplorerSocket (..),
                                              csAddressSubscribers, csBlocksPageSubscribers,
@@ -36,6 +36,7 @@ import           Pos.Explorer.Socket.Methods (addrSubParam, addressSetByTxs, blo
 import           Pos.Explorer.TestUtil (secretKeyToAddress)
 import           Pos.Explorer.Web.ClientTypes (CAddress (..), toCAddress)
 
+import           Test.Pos.Crypto.Arbitrary (genProtocolMagicUniformWithRNM)
 import           Test.Pos.Explorer.MockFactory (mkTxOut)
 
 
@@ -45,16 +46,23 @@ import           Test.Pos.Explorer.MockFactory (mkTxOut)
 
 -- stack test cardano-sl-explorer --fast --test-arguments "-m Test.Pos.Explorer.Socket"
 
+-- We run the tests this number of times, with different `ProtocolMagics`, to get increased
+-- coverage. We should really do this inside of the `prop`, but it is difficult to do that
+-- without significant rewriting of the testsuite.
+testMultiple :: Int
+testMultiple = 3
+
 spec :: Spec
 spec = do
     runWithMagic NMMustBeNothing
     runWithMagic NMMustBeJust
 
 runWithMagic :: RequiresNetworkMagic -> Spec
-runWithMagic rnm = do
-    pm <- (\ident -> ProtocolMagic ident rnm) <$> runIO (generate arbitrary)
-    describe ("(requiresNetworkMagic=" ++ show rnm ++ ")") $
-        specBody (makeNetworkMagic pm)
+runWithMagic rnm = replicateM_ testMultiple $
+    modifyMaxSuccess (`div` testMultiple) $ do
+        pm <- runIO (generate (genProtocolMagicUniformWithRNM rnm))
+        describe ("(requiresNetworkMagic=" ++ show rnm ++ ")") $
+            specBody (makeNetworkMagic pm)
 
 specBody :: NetworkMagic -> Spec
 specBody nm =

explorer/test/Test/Pos/Explorer/Web/ServerSpec.hs

@@ -31,6 +31,7 @@ import           Pos.Util.Mockable ()
 
 import           Test.Pos.Block.Arbitrary ()
 import           Test.Pos.Configuration (withProvidedMagicConfig)
+import           Test.Pos.Crypto.Arbitrary (genProtocolMagicUniformWithRNM)
 
 
 ----------------------------------------------------------------
@@ -40,16 +41,24 @@ import           Test.Pos.Configuration (withProvidedMagicConfig)
 {-# ANN module ("HLint: ignore Reduce duplication" :: Text) #-}
 
 -- stack test cardano-sl-explorer --fast --test-arguments "-m Pos.Explorer.Web.Server"
+
+-- We run the tests this number of times, with different `ProtocolMagics`, to get increased
+-- coverage. We should really do this inside of the `prop`, but it is difficult to do that
+-- without significant rewriting of the testsuite.
+testMultiple :: Int
+testMultiple = 3
+
 spec :: Spec
 spec = do
     runWithMagic NMMustBeNothing
     runWithMagic NMMustBeJust
 
 runWithMagic :: RequiresNetworkMagic -> Spec
-runWithMagic rnm = do
-    pm <- (\ident -> ProtocolMagic ident rnm) <$> runIO (generate arbitrary)
-    describe ("(requiresNetworkMagic=" ++ show rnm ++ ")") $
-        specBody pm
+runWithMagic rnm = replicateM_ testMultiple $
+    modifyMaxSuccess (`div` testMultiple) $ do
+        pm <- runIO (generate (genProtocolMagicUniformWithRNM rnm))
+        describe ("(requiresNetworkMagic=" ++ show rnm ++ ")") $
+            specBody pm
 
 specBody :: ProtocolMagic -> Spec
 specBody pm = withProvidedMagicConfig pm $ do