Serialisation generators for Mary/Allegra

Resolves CAD-1845

* Extract EraIndepGenerators from the ShelleyEra serialisation generators so that we can re-use EraIndep as a base for ShelleyMAEra serialisation generators
* Specialise Shelley Era generators to ShelleyEra (rather than just the `ShelleyTest` constraint) - otherwise we'd have Overlapping Instances between Shelley/MA
* ShelleyMAEra generators are fixed to MaryEra C_Crypto and AllegraEra C_Crypto

Note - the following to be done in subsequent commits:

* implement a non-trivial TimeLock generator
* 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,272 @@
+{-# 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.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 qualified Cardano.Ledger.ShelleyMA.Rules.Utxo as MA.STS
+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 Control.State.Transition.Extended (PredicateFailure)
+import Generic.Random (genericArbitraryU)
+import Shelley.Spec.Ledger.API hiding (SignedDSIGN, TxBody (..))
+import qualified Shelley.Spec.Ledger.STS.Ledger as STS
+import qualified Shelley.Spec.Ledger.STS.Ledgers as STS
+import qualified Shelley.Spec.Ledger.STS.Utxow as STS
+import Test.QuickCheck
+ ( Arbitrary,
+ arbitrary,
+ genericShrink,
+ oneof,
+ shrink,
+ )
+import Test.Shelley.Spec.Ledger.ConcreteCryptoTypes (Mock)
+import Test.Shelley.Spec.Ledger.Serialisation.EraIndepGenerators
+ ( genBlock,
+ genTx,
+ )
+import Test.Tasty.QuickCheck (Gen)
+
+{-------------------------------------------------------------------------------
+ ShelleyMAEra Generators
+
+ Generators used for roundtrip tests, generated values are not
+ necessarily valid
+-------------------------------------------------------------------------------}
+
+genTxBody ::
+ ( ShelleyBased era,
+ Mock (Crypto era),
+ Abstract.TxBody era ~ MA.TxBody era,
+ Arbitrary (Abstract.Value era)
+ ) =>
+ Gen (MA.TxBody era)
+genTxBody =
+ MA.TxBody
+ <$> arbitrary
+ <*> arbitrary
+ <*> arbitrary
+ <*> arbitrary
+ <*> arbitrary
+ <*> arbitrary
+ <*> arbitrary
+ <*> arbitrary
+ <*> arbitrary
+
+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
+ ]
+
+{-------------------------------------------------------------------------------
+ MaryEra Generators
+-------------------------------------------------------------------------------}
+
+instance
+ ( Mock c,
+ PraosCrypto c,
+ Arbitrary (Abstract.Value (MaryEra c))
+ ) =>
+ Arbitrary (MA.TxBody (MaryEra c))
+ where
+ arbitrary = genTxBody
+
+instance
+ ( Mock c,
+ PraosCrypto c,
+ Arbitrary (Abstract.Value (MaryEra c)),
+ Arbitrary (Abstract.Script (MaryEra c))
+ ) =>
+ Arbitrary (Tx (MaryEra c))
+ where
+ arbitrary = genTx
+
+instance
+ ( Mock c,
+ PraosCrypto c
+ ) =>
+ Arbitrary (Block (MaryEra c))
+ where
+ arbitrary = genBlock
+
+instance
+ ( Mock c,
+ PraosCrypto c
+ ) =>
+ Arbitrary (MA.Script (MaryEra c))
+ where
+ arbitrary = genMAScript
+
+instance
+ ( Mock c,
+ PraosCrypto c,
+ Arbitrary (Abstract.Value (MaryEra c)),
+ Arbitrary (Abstract.Script (MaryEra c))
+ ) =>
+ Arbitrary (Mary.PolicyID (MaryEra c))
+ where
+ arbitrary = Mary.PolicyID <$> arbitrary
+
+instance
+ ( Mock c,
+ PraosCrypto c,
+ Arbitrary (Abstract.Value (MaryEra c)),
+ Arbitrary (Abstract.Script (MaryEra c))
+ ) =>
+ Arbitrary (Mary.Value (MaryEra c))
+ where
+ arbitrary = Mary.Value <$> arbitrary <*> arbitrary
+
+instance Arbitrary Mary.AssetID where
+ arbitrary = Mary.AssetID <$> arbitrary
+
+instance
+ ( Mock c,
+ PraosCrypto c,
+ PredicateFailure (UTXO (MaryEra c)) ~ MA.STS.UtxoPredicateFailure (MaryEra c)
+ ) =>
+ Arbitrary (MA.STS.UtxoPredicateFailure (MaryEra c))
+ where
+ arbitrary = genericArbitraryU
+
+instance
+ ( Mock c,
+ PraosCrypto c,
+ Arbitrary (STS.PredicateFailure (UTXO (MaryEra c)))
+ ) =>
+ Arbitrary (STS.UtxowPredicateFailure (MaryEra c))
+ where
+ arbitrary = genericArbitraryU
+ shrink = genericShrink
+
+instance
+ ( Mock c,
+ PraosCrypto c,
+ Arbitrary (STS.PredicateFailure (DELEGS (MaryEra c))),
+ Arbitrary (STS.PredicateFailure (UTXOW (MaryEra c)))
+ ) =>
+ Arbitrary (STS.LedgerPredicateFailure (MaryEra c))
+ where
+ arbitrary = genericArbitraryU
+ shrink = genericShrink
+
+instance
+ ( Mock c,
+ PraosCrypto c,
+ Arbitrary (STS.PredicateFailure (LEDGER (MaryEra c)))
+ ) =>
+ Arbitrary (STS.LedgersPredicateFailure (MaryEra c))
+ where
+ arbitrary = genericArbitraryU
+ shrink = genericShrink
+
+{-------------------------------------------------------------------------------
+ AllegraEra Generators
+-------------------------------------------------------------------------------}
+
+instance
+ ( Mock c,
+ PraosCrypto c,
+ Arbitrary (Abstract.Value (AllegraEra c))
+ ) =>
+ Arbitrary (MA.TxBody (AllegraEra c))
+ where
+ arbitrary = genTxBody
+
+instance
+ ( Mock c,
+ PraosCrypto c,
+ Arbitrary (Abstract.Value (AllegraEra c)),
+ Arbitrary (Abstract.Script (AllegraEra c))
+ ) =>
+ Arbitrary (Tx (AllegraEra c))
+ where
+ arbitrary = genTx
+
+instance
+ ( Mock c,
+ PraosCrypto c,
+ Arbitrary (Abstract.Value (AllegraEra c)),
+ Arbitrary (Abstract.Script (AllegraEra c))
+ ) =>
+ Arbitrary (Block (AllegraEra c))
+ where
+ arbitrary = genBlock
+
+instance
+ ( Mock c,
+ PraosCrypto c,
+ Arbitrary (Abstract.Script (AllegraEra c))
+ ) =>
+ Arbitrary (MA.Script (AllegraEra c))
+ where
+ arbitrary = genMAScript
+
+instance Arbitrary ValidityInterval where
+ arbitrary = genericArbitraryU
+ shrink = genericShrink
+
+instance
+ ( Mock c,
+ PraosCrypto c,
+ PredicateFailure (UTXO (AllegraEra c)) ~ MA.STS.UtxoPredicateFailure (AllegraEra c)
+ ) =>
+ Arbitrary (MA.STS.UtxoPredicateFailure (AllegraEra c))
+ where
+ arbitrary = genericArbitraryU
+
+instance
+ ( Mock c,
+ PraosCrypto c,
+ Arbitrary (STS.PredicateFailure (UTXO (AllegraEra c)))
+ ) =>
+ Arbitrary (STS.UtxowPredicateFailure (AllegraEra c))
+ where
+ arbitrary = genericArbitraryU
+ shrink = genericShrink
+
+instance
+ ( Mock c,
+ PraosCrypto c,
+ Arbitrary (STS.PredicateFailure (DELEGS (AllegraEra c))),
+ Arbitrary (STS.PredicateFailure (UTXOW (AllegraEra c)))
+ ) =>
+ Arbitrary (STS.LedgerPredicateFailure (AllegraEra c))
+ where
+ arbitrary = genericArbitraryU
+ shrink = genericShrink
+
+instance
+ ( Mock c,
+ PraosCrypto c,
+ Arbitrary (STS.PredicateFailure (LEDGER (AllegraEra c)))
+ ) =>
+ Arbitrary (STS.LedgersPredicateFailure (AllegraEra c))
+ 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