Fix golden test data generation for Conway

IntersectMBO · May 7, 2024 · ef0f210 · ef0f210
1 parent fed9c83
commit ef0f210
Show file tree

Hide file tree

Showing 5 changed files with 45 additions and 13 deletions.
diff --git a/eras/conway/test-suite/cardano-ledger-conway-test.cabal b/eras/conway/test-suite/cardano-ledger-conway-test.cabal
@@ -30,7 +30,7 @@ library
 
     build-depends:
         base >=4.14 && <5,
-        cardano-data,
+        cardano-data:{cardano-data, testlib} >=1.2.2,
         cardano-ledger-alonzo:{cardano-ledger-alonzo, testlib} >=1.6,
         cardano-ledger-alonzo-test,
         cardano-ledger-babbage >=1.3 && <1.9,

diff --git a/eras/conway/test-suite/golden/translations.cbor b/eras/conway/test-suite/golden/translations.cbor
diff --git a/eras/conway/test-suite/src/Test/Cardano/Ledger/Conway/Translation/TranslatableGen.hs b/eras/conway/test-suite/src/Test/Cardano/Ledger/Conway/Translation/TranslatableGen.hs
@@ -11,15 +11,18 @@ import Cardano.Ledger.Alonzo.Scripts (AlonzoEraScript, AsIx (..), PlutusPurpose)
 import Cardano.Ledger.Alonzo.TxWits (Redeemers (..))
 import Cardano.Ledger.Binary (mkSized)
 import Cardano.Ledger.Conway (Conway, ConwayEra)
+import Cardano.Ledger.Conway.Governance (VotingProcedures (..))
 import Cardano.Ledger.Conway.Scripts (ConwayPlutusPurpose (..))
 import Cardano.Ledger.Conway.TxBody (ConwayTxBody (..))
+import Cardano.Ledger.Conway.TxCert
 import Cardano.Ledger.Core
 import Cardano.Ledger.Crypto
 import Cardano.Ledger.Plutus (Data (..), ExUnits, Language (..), SLanguage (..))
 import Cardano.Ledger.TxIn (TxIn (..))
 import qualified Data.Map.Strict as Map
 import Data.Sequence.Strict (fromList)
 import qualified Data.Set as Set
+import Test.Cardano.Data.Arbitrary (genOSet)
 import Test.Cardano.Ledger.Alonzo.Translation.TranslatableGen (
   TranslatableGen (..),
   TxInfoLanguage (..),
@@ -49,17 +52,40 @@ genTxBody l = do
                 <$> BabbageTranslatableGen.genTxOut @(ConwayEra c) l
             )
   let genTxIns = Set.fromList <$> listOf1 (arbitrary :: Gen (TxIn c))
+      offPrePlutusV3 freq = if l >= PlutusV3 then freq else 0
+      genDelegatee =
+        frequency
+          [ (33, DelegStake <$> arbitrary)
+          , (offPrePlutusV3 33, DelegVote <$> arbitrary)
+          , (offPrePlutusV3 33, DelegStakeVote <$> arbitrary <*> arbitrary)
+          ]
+      genDelegCert =
+        frequency
+          [ (25, ConwayRegCert <$> arbitrary <*> arbitrary)
+          , (25, ConwayUnRegCert <$> arbitrary <*> arbitrary)
+          , (25, ConwayDelegCert <$> arbitrary <*> genDelegatee)
+          , (offPrePlutusV3 25, ConwayRegDelegCert <$> arbitrary <*> genDelegatee <*> arbitrary)
+          ]
+      genTxCerts =
+        genOSet $
+          frequency
+            [ (33, ConwayTxCertDeleg <$> genDelegCert)
+            , (33, ConwayTxCertPool <$> arbitrary)
+            , (offPrePlutusV3 33, ConwayTxCertGov <$> arbitrary)
+            ]
+      genForPlutusV3 :: Arbitrary a => a -> Gen a
+      genForPlutusV3 d =
+        case l of
+          PlutusV3 -> arbitrary
+          _ -> pure d
   ConwayTxBody
     <$> genTxIns
     <*> arbitrary
-    <*> ( case l of -- refinputs
-            PlutusV1 -> pure Set.empty
-            _ -> arbitrary
-        )
-    <*> genTxOuts
     <*> arbitrary
+    <*> genTxOuts
     <*> arbitrary
     <*> arbitrary
+    <*> genTxCerts
     <*> arbitrary
     <*> arbitrary
     <*> scale (`div` 15) arbitrary
@@ -68,10 +94,10 @@ genTxBody l = do
     <*> arbitrary
     <*> arbitrary
     <*> arbitrary
-    <*> arbitrary
-    <*> arbitrary
-    <*> arbitrary
-    <*> arbitrary
+    <*> genForPlutusV3 (VotingProcedures mempty)
+    <*> genForPlutusV3 mempty
+    <*> genForPlutusV3 mempty
+    <*> genForPlutusV3 mempty
 
 genRedeemers ::
   forall era.

diff --git a/libs/cardano-data/CHANGELOG.md b/libs/cardano-data/CHANGELOG.md
@@ -5,6 +5,10 @@
 * Add `assocList`, `elems`
 * Add module Data.MonoTuple
 
+### `testlib`
+
+* Add `genOSet`
+
 ## 1.2.1.0
 
 * Add `ToJSON` instance for `OSet` #4112

diff --git a/libs/cardano-data/testlib/Test/Cardano/Data/Arbitrary.hs b/libs/cardano-data/testlib/Test/Cardano/Data/Arbitrary.hs
@@ -2,18 +2,20 @@
 {-# LANGUAGE ImportQualifiedPost #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
 
-module Test.Cardano.Data.Arbitrary where
+module Test.Cardano.Data.Arbitrary (genOSet) where
 
 import Data.Map.Strict qualified as Map
 import Data.OMap.Strict qualified as OMap
 import Data.OSet.Strict qualified as OSet
-import Data.Set qualified as Set
 import Lens.Micro (set)
 import Test.Cardano.Ledger.Binary.Arbitrary ()
 import Test.QuickCheck
 
 instance (Arbitrary a, Ord a) => Arbitrary (OSet.OSet a) where
-  arbitrary = fmap OSet.fromFoldable . shuffle . Set.toList =<< arbitrary
+  arbitrary = genOSet arbitrary
+
+genOSet :: Ord a => Gen a -> Gen (OSet.OSet a)
+genOSet = fmap OSet.fromFoldable . listOf
 
 instance (Ord v, Arbitrary v, OMap.HasOKey k v, Arbitrary k) => Arbitrary (OMap.OMap k v) where
   arbitrary =