Resolves CAD-1845

* Extract EraIndepGenerators from the ShelleyEra serialisation generators
* re-uses EraIndep as a base for ShelleyMAEra serialisation generators
* ShelleyMAEra generators are fixed to MaryEra C_Crypto and AllegraEra C_Crypto

Note - the following to be done in subsequent commit:

* implement a non-trivial TimeLock generator
* implement PredicateFailure generators for ShelleyMAEra
* implement serialisation tests based on these generators

shelley-ma/shelley-ma-test/cardano-ledger-shelley-ma-test.cabal

@@ -22,17 +22,22 @@ library
  Test.Cardano.Ledger.ShelleyMA.TxBody
  Test.Cardano.Ledger.ShelleyMA.Timelocks
  Test.Cardano.Ledger.ShelleyMA.Coders
-
+ Test.Cardano.Ledger.ShelleyMA.Serialisation.Generators
  -- other-extensions:
  build-depends:
  array,
  cardano-ledger-shelley-ma,
+ shelley-spec-ledger-test,
  base >=4.9 && <4.15,
  bytestring,
  cardano-binary,
+ cardano-crypto,
  cardano-crypto-class,
  cardano-crypto-praos,
+ cardano-crypto-test,
+ cardano-crypto-wrapper,
  cardano-prelude,
+ generic-random,
  cardano-slotting,
  cborg,
  containers,
@@ -47,6 +52,7 @@ library
  tasty-quickcheck,
  tasty,
  text,
+ QuickCheck >= 2.13.2,
  hs-source-dirs: src
  ghc-options:
  -Wall
@@ -79,12 +85,18 @@ test-suite cardano-ledger-shelley-ma-test
  -- determined ad-hoc.
  "-with-rtsopts=-K4m -M250m"
  build-depends:
+ cardano-ledger-shelley-ma,
+ shelley-spec-ledger-test,
  cardano-ledger-shelley-ma-test,
  base >=4.9 && <4.15,
  bytestring,
  cardano-binary,
+ cardano-crypto,
  cardano-crypto-class,
  cardano-crypto-praos,
+ cardano-crypto-test,
+ cardano-crypto-wrapper,
+ generic-random,
  cardano-prelude,
  cardano-slotting,
  cborg,
@@ -99,3 +111,5 @@ test-suite cardano-ledger-shelley-ma-test
  tasty-hunit,
  tasty-quickcheck,
  tasty,
+ text,
+ QuickCheck,

shelley-ma/shelley-ma-test/src/Test/Cardano/Ledger/ShelleyMA/Serialisation/Generators.hs

@@ -0,0 +1,225 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE QuantifiedConstraints #-}
+{-# LANGUAGE Rank2Types #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+
+module Test.Cardano.Ledger.ShelleyMA.Serialisation.Generators () where
+
+import Cardano.Binary (Annotator, FromCBOR (..))
+import Cardano.Ledger.Allegra (AllegraEra)
+import qualified Cardano.Ledger.Core as Abstract
+import Cardano.Ledger.Era (Crypto, Era)
+import Cardano.Ledger.Mary (MaryEra)
+import qualified Cardano.Ledger.Mary.Value as Mary (AssetID (..), PolicyID (..), Value (..))
+import Cardano.Ledger.Shelley (ShelleyBased)
+import Cardano.Ledger.ShelleyMA.Scripts as MA (Script (..))
+import Cardano.Ledger.ShelleyMA.Timelocks (Timelock (..), ValidityInterval)
+import qualified Cardano.Ledger.ShelleyMA.TxBody as MA (TxBody (..))
+import Cardano.Slotting.Block (BlockNo (..))
+import Cardano.Slotting.Slot (SlotNo (..))
+import qualified Data.Map.Strict as Map (fromList)
+import Data.Proxy (Proxy (..))
+import Generic.Random (genericArbitraryU)
+import Shelley.Spec.Ledger.API hiding (SignedDSIGN, TxBody (..))
+import Shelley.Spec.Ledger.Tx (ValidateScript, WitnessSetHKD (WitnessSet), hashScript)
+import Test.QuickCheck
+ ( Arbitrary,
+ arbitrary,
+ genericShrink,
+ listOf,
+ oneof,
+ resize,
+ shrink,
+ )
+import Test.QuickCheck.Gen (vectorOf)
+import Test.Shelley.Spec.Ledger.ConcreteCryptoTypes (C_Crypto, Mock)
+import Test.Shelley.Spec.Ledger.Generator.Core
+ ( KeySpace (KeySpace_),
+ geKeySpace,
+ ksCoreNodes,
+ mkBlock,
+ mkOCert,
+ )
+import Test.Shelley.Spec.Ledger.Generator.Presets (genEnv)
+import Test.Shelley.Spec.Ledger.Serialisation.EraIndepGenerators
+ ( EraGen (..),
+ maxTxWits,
+ )
+import Test.Tasty.QuickCheck (Gen, choose, elements)
+
+{-------------------------------------------------------------------------------
+ ShelleyMAEra Generators
+
+ Generators used for roundtrip tests, generated values are not
+ necessarily valid
+-------------------------------------------------------------------------------}
+
+genTxBody ::
+ ( ShelleyBased era,
+ Abstract.TxBody era ~ MA.TxBody era,
+ Mock (Crypto era),
+ Arbitrary (Abstract.Value era)
+ ) =>
+ Gen (MA.TxBody era)
+genTxBody =
+ MA.TxBody
+ <$> arbitrary
+ <*> arbitrary
+ <*> arbitrary
+ <*> arbitrary
+ <*> arbitrary
+ <*> arbitrary
+ <*> arbitrary
+ <*> arbitrary
+ <*> arbitrary
+
+genTx ::
+ ( ShelleyBased era,
+ Abstract.TxBody era ~ MA.TxBody era,
+ Mock (Crypto era),
+ Arbitrary (WitnessSet era),
+ Arbitrary (Abstract.Value era)
+ ) =>
+ Gen (Tx era)
+genTx =
+ Tx
+ <$> genTxBody
+ <*> (resize maxTxWits arbitrary)
+ <*> arbitrary
+
+genBlock ::
+ forall era.
+ ( ShelleyBased era,
+ Abstract.TxBody era ~ MA.TxBody era,
+ Mock (Crypto era),
+ Arbitrary (WitnessSet era),
+ Arbitrary (Abstract.Value era)
+ ) =>
+ Gen (Block era)
+genBlock = do
+ let KeySpace_ {ksCoreNodes} = geKeySpace (genEnv p)
+ prevHash <- arbitrary :: Gen (HashHeader (Crypto era))
+ allPoolKeys <- elements (map snd ksCoreNodes)
+ txs <- listOf genTx
+ curSlotNo <- SlotNo <$> choose (0, 10)
+ curBlockNo <- BlockNo <$> choose (0, 100)
+ epochNonce <- arbitrary :: Gen Nonce
+ let kesPeriod = 1
+ keyRegKesPeriod = 1
+ ocert = mkOCert allPoolKeys 1 (KESPeriod kesPeriod)
+ return $
+ mkBlock
+ prevHash
+ allPoolKeys
+ txs
+ curSlotNo
+ curBlockNo
+ epochNonce
+ kesPeriod
+ keyRegKesPeriod
+ ocert
+ where
+ p :: Proxy era
+ p = Proxy
+
+genMAScript ::
+ (Era era, Mock (Crypto era)) =>
+ Gen (MA.Script era)
+genMAScript =
+ oneof
+ [ MA.ScriptMSig <$> arbitrary,
+ -- TODO @uroboros Write recursive (and sized) generator that engages all Timelock contructors
+ MA.ScriptTimelock . Interval <$> arbitrary
+ ]
+
+genWitnessSet ::
+ forall era.
+ ( Era era,
+ Mock (Crypto era),
+ ValidateScript era,
+ FromCBOR (Annotator (Abstract.Script era)),
+ EraGen era
+ ) =>
+ Gen (WitnessSet era)
+genWitnessSet =
+ WitnessSet
+ <$> arbitrary
+ <*> (mscriptsToWits <$> (vectorOf 5 (genScript @era)))
+ <*> arbitrary
+ where
+ mscriptsToWits = Map.fromList . map (\s -> (hashScript s, s))
+
+{-------------------------------------------------------------------------------
+ MaryEra Arbitrary Instances
+-------------------------------------------------------------------------------}
+
+instance
+ (Mock c) =>
+ EraGen (MaryEra c)
+ where
+ genScript = genMAScript
+
+instance Arbitrary (MA.TxBody (MaryEra C_Crypto)) where
+ arbitrary = genTxBody
+
+instance Arbitrary (Tx (MaryEra C_Crypto)) where
+ arbitrary = genTx
+
+instance Arbitrary (Block (MaryEra C_Crypto)) where
+ arbitrary = genBlock
+
+instance Arbitrary (MA.Script (MaryEra C_Crypto)) where
+ arbitrary = genMAScript
+
+instance Arbitrary (WitnessSet (MaryEra C_Crypto)) where
+ arbitrary = genWitnessSet
+
+instance Arbitrary (Mary.PolicyID (MaryEra C_Crypto)) where
+ arbitrary = Mary.PolicyID <$> arbitrary
+
+instance Arbitrary Mary.AssetID where
+ arbitrary = Mary.AssetID <$> arbitrary
+
+instance Arbitrary (Mary.Value (MaryEra C_Crypto)) where
+ arbitrary = Mary.Value <$> arbitrary <*> arbitrary
+
+{-------------------------------------------------------------------------------
+ AllegraEra Generators
+-------------------------------------------------------------------------------}
+
+instance
+ (Mock c) =>
+ EraGen (AllegraEra c)
+ where
+ genScript = genMAScript
+
+instance Arbitrary (MA.TxBody (AllegraEra C_Crypto)) where
+ arbitrary = genTxBody
+
+instance Arbitrary (Tx (AllegraEra C_Crypto)) where
+ arbitrary = genTx
+
+instance Arbitrary (Block (AllegraEra C_Crypto)) where
+ arbitrary = genBlock
+
+instance Arbitrary (MA.Script (AllegraEra C_Crypto)) where
+ arbitrary = genMAScript
+
+instance Arbitrary (WitnessSet (AllegraEra C_Crypto)) where
+ arbitrary = genWitnessSet
+
+instance Arbitrary ValidityInterval where
+ arbitrary = genericArbitraryU
+ shrink = genericShrink

shelley/chain-and-ledger/shelley-spec-ledger-test/shelley-spec-ledger-test.cabal

@@ -39,6 +39,7 @@ library
  Test.Shelley.Spec.Ledger.Generator.Utxo
  Test.Shelley.Spec.Ledger.Orphans
  Test.Shelley.Spec.Ledger.Serialisation.Generators
+ Test.Shelley.Spec.Ledger.Serialisation.EraIndepGenerators
  Test.Shelley.Spec.Ledger.Serialisation.Generators.Bootstrap
  Test.Shelley.Spec.Ledger.Serialisation.Generators.Genesis
  Test.Shelley.Spec.Ledger.Shrinkers