Generate arbitrary PoolParams with no default vote before Dijkstra

and in Snapshots

Author: teodanciu

eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Arbitrary.hs

@@ -23,6 +23,7 @@ module Test.Cardano.Ledger.Conway.Arbitrary (
   genParameterChange,
   genNewConstitution,
   govActionGenerators,
+  genConwayTxCertPool,
   genConwayPlutusPurposePointer,
   genGovAction,
   genGovActionState,
@@ -76,7 +77,8 @@ import Test.Cardano.Ledger.Alonzo.Arbitrary (genValidAndUnknownCostModels, genVa
 import Test.Cardano.Ledger.Babbage.Arbitrary ()
 import Test.Cardano.Ledger.Binary.Random (QC (..))
 import Test.Cardano.Ledger.Common
-import Test.Cardano.Ledger.Core.Arbitrary (uniformSubMap)
+import Test.Cardano.Ledger.Core.Arbitrary (genPoolParamsNoDefaultVote, uniformSubMap)
+import Test.Cardano.Ledger.Shelley.Arbitrary ()
 
 instance
   (Era era, Arbitrary (PParamsUpdate era)) =>
@@ -163,10 +165,18 @@ instance Era era => Arbitrary (ConwayTxCert era) where
   arbitrary =
     oneof
       [ ConwayTxCertDeleg <$> arbitrary
-      , ConwayTxCertPool <$> arbitrary
+      , genConwayTxCertPool
       , ConwayTxCertGov <$> arbitrary
       ]
 
+genConwayTxCertPool :: Gen (ConwayTxCert era)
+genConwayTxCertPool =
+  ConwayTxCertPool
+    <$> oneof
+      [ RegPool <$> genPoolParamsNoDefaultVote
+      , RetirePool <$> arbitrary <*> arbitrary
+      ]
+
 instance Arbitrary ConwayGovCert where
   arbitrary =
     oneof

eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Translation/TranslatableGen.hs

@@ -30,7 +30,7 @@ import qualified Test.Cardano.Ledger.Babbage.Translation.TranslatableGen as Babb
   utxoWithTx,
  )
 import Test.Cardano.Ledger.Common
-import Test.Cardano.Ledger.Conway.Arbitrary ()
+import Test.Cardano.Ledger.Conway.Arbitrary (genConwayTxCertPool)
 
 instance TranslatableGen ConwayEra where
   tgRedeemers = genRedeemers
@@ -65,7 +65,7 @@ genTxBody l@(SupportedLanguage slang) = do
         genOSet $
           frequency
             [ (33, ConwayTxCertDeleg <$> genDelegCert)
-            , (33, ConwayTxCertPool <$> arbitrary)
+            , (33, genConwayTxCertPool)
             , (offPrePlutusV3 33, ConwayTxCertGov <$> arbitrary)
             ]
       genForPlutusV3 :: Arbitrary a => a -> Gen a

eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/Arbitrary.hs

@@ -77,7 +77,7 @@ import Cardano.Ledger.Shelley.Tx (Tx (..))
 import Cardano.Ledger.Shelley.TxAuxData
 import Cardano.Ledger.Shelley.TxCert (
   GenesisDelegCert (..),
-  ShelleyTxCert,
+  ShelleyTxCert (..),
  )
 import Cardano.Ledger.Shelley.TxOut
 import Cardano.Ledger.Shelley.TxWits (ShelleyTxWits (ShelleyTxWits))
@@ -93,7 +93,7 @@ import Data.Word (Word64)
 import Generic.Random (genericArbitraryU)
 import Test.Cardano.Chain.UTxO.Gen (genCompactTxOut)
 import Test.Cardano.Ledger.Common
-import Test.Cardano.Ledger.Core.Arbitrary ()
+import Test.Cardano.Ledger.Core.Arbitrary (genPoolParamsNoDefaultVote)
 import Test.Cardano.Ledger.Core.Utils (unsafeBoundRational)
 import Test.QuickCheck.Hedgehog (hedgehog)
 
@@ -248,7 +248,7 @@ instance Arbitrary PoolRewardInfo where
     PoolRewardInfo
       <$> arbitrary
       <*> arbitrary
-      <*> arbitrary
+      <*> genPoolParamsNoDefaultVote
       <*> arbitrary
       <*> arbitrary
   shrink = genericShrink
@@ -439,8 +439,18 @@ vectorOfMetadatumSimple = do
 ------------------------------------------------------------------------------------------
 
 instance Era era => Arbitrary (ShelleyTxCert era) where
-  arbitrary = genericArbitraryU
   shrink = genericShrink
+  arbitrary =
+    oneof
+      [ ShelleyTxCertDelegCert <$> arbitrary
+      , ShelleyTxCertPool
+          <$> oneof
+            [ RegPool <$> genPoolParamsNoDefaultVote
+            , RetirePool <$> arbitrary <*> arbitrary
+            ]
+      , ShelleyTxCertGenesisDeleg <$> arbitrary
+      , ShelleyTxCertMir <$> arbitrary
+      ]
 
 instance Arbitrary ShelleyDelegCert where
   arbitrary = genericArbitraryU
@@ -608,7 +618,17 @@ instance
     pure ShelleyGenesis {..}
 
 instance Arbitrary ShelleyGenesisStaking where
-  arbitrary = ShelleyGenesisStaking <$> arbitrary <*> arbitrary
+  arbitrary = ShelleyGenesisStaking <$> genPoolParamsListMap <*> arbitrary
+
+genPoolParamsListMap :: Gen (LM.ListMap (KeyHash 'StakePool) PoolParams)
+genPoolParamsListMap =
+  LM.fromList <$> listOf pair
+  where
+    pair :: Gen (KeyHash 'StakePool, PoolParams)
+    pair = do
+      k <- arbitrary
+      v <- genPoolParamsNoDefaultVote
+      pure (k, v)
 
 instance
   ( Era era

eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/UnitTests/InstantStakeTest.hs

@@ -20,7 +20,7 @@ import Data.MonoTuple (TupleN)
 import qualified Data.VMap as VMap
 import Lens.Micro
 import Test.Cardano.Ledger.Common
-import Test.Cardano.Ledger.Core.Arbitrary ()
+import Test.Cardano.Ledger.Core.Arbitrary (genPoolParamsNoDefaultVote)
 import Test.Cardano.Ledger.Core.KeyPair (mkAddr)
 import Test.Cardano.Ledger.Shelley.Era
 import Test.Cardano.Ledger.Shelley.ImpTest
@@ -36,7 +36,7 @@ arbitraryLens l b = (l .~ b) <$> arbitrary
 
 instantStakeIncludesRewards :: forall era. ShelleyEraImp era => Gen Property
 instantStakeIncludesRewards = do
-  (pool1, pool2) <- arbitrary @(TupleN 2 PoolParams)
+  (pool1, pool2) <- (,) <$> genPoolParamsNoDefaultVote <*> genPoolParamsNoDefaultVote
   let
     poolId1 = pool1 ^. ppIdL
     poolId2 = pool2 ^. ppIdL

libs/cardano-ledger-api/cardano-ledger-api.cabal

@@ -100,6 +100,7 @@ library testlib
     cardano-ledger-binary:{cardano-ledger-binary, testlib},
     cardano-ledger-core:{cardano-ledger-core, testlib},
     cardano-ledger-dijkstra:testlib,
+    containers,
     data-default,
     prettyprinter,
 

libs/cardano-ledger-api/testlib/Test/Cardano/Ledger/Api/Arbitrary.hs

@@ -3,11 +3,19 @@
 module Test.Cardano.Ledger.Api.Arbitrary () where
 
 import Cardano.Ledger.Api.State.Query (MemberStatus, QueryPoolStateResult (..))
+import qualified Data.Map as Map
 import Test.Cardano.Ledger.Common
+import Test.Cardano.Ledger.Core.Arbitrary (genPoolParamsNoDefaultVote)
 import Test.Cardano.Ledger.Dijkstra.Arbitrary ()
 
 instance Arbitrary MemberStatus where
   arbitrary = arbitraryBoundedEnum
 
 instance Arbitrary QueryPoolStateResult where
-  arbitrary = QueryPoolStateResult <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
+  arbitrary = QueryPoolStateResult <$> genPoolParams <*> genPoolParams <*> arbitrary <*> arbitrary
+    where
+      genPoolParams = Map.fromList <$> listOf pair
+      pair = do
+        k <- arbitrary
+        v <- genPoolParamsNoDefaultVote
+        pure (k, v)

libs/cardano-ledger-core/testlib/Test/Cardano/Ledger/Core/Arbitrary.hs

@@ -20,6 +20,7 @@ module Test.Cardano.Ledger.Core.Arbitrary (
   genAddrBadPtr,
   genCompactAddrBadPtr,
   genBadPtr,
+  genPoolParamsNoDefaultVote,
   genericShrinkMemo,
 
   -- * Plutus
@@ -451,6 +452,20 @@ instance Arbitrary PoolParams where
       <*> arbitrary
       <*> arbitrary
 
+genPoolParamsNoDefaultVote :: Gen PoolParams
+genPoolParamsNoDefaultVote =
+  PoolParams
+    <$> arbitrary
+    <*> arbitrary
+    <*> arbitrary
+    <*> arbitrary
+    <*> arbitrary
+    <*> arbitrary
+    <*> arbitrary
+    <*> arbitrary
+    <*> arbitrary
+    <*> pure BaseTypes.SNothing
+
 instance Arbitrary StakePoolState where
   arbitrary =
     StakePoolState
@@ -667,7 +682,17 @@ instance Arbitrary SnapShot where
     SnapShot
       <$> arbitrary
       <*> arbitrary
-      <*> arbitrary
+      <*> genPoolParamsVMap
+
+genPoolParamsVMap :: Gen (VMap.VMap VMap.VB VMap.VB (KeyHash 'StakePool) PoolParams)
+genPoolParamsVMap =
+  VMap.fromMap . Map.fromList <$> listOf pair
+  where
+    pair :: Gen (KeyHash 'StakePool, PoolParams)
+    pair = do
+      k <- arbitrary
+      v <- genPoolParamsNoDefaultVote
+      pure (k, v)
 
 instance Arbitrary SnapShots where
   arbitrary = do
@@ -684,7 +709,7 @@ instance Arbitrary SnapShots where
 -- There will never be a real Stake in the system with that many Ada, because total Ada is constant.
 -- So using a restricted Arbitrary Generator is OK.
 instance Arbitrary Stake where
-  arbitrary = Stake <$> (VMap.fromMap <$> theMap)
+  arbitrary = Stake . VMap.fromMap <$> theMap
     where
       genWord64 :: Int -> Gen Word64
       genWord64 n =