Skip to content

Commit

Permalink
Serialisation generators for Mary/Allegra
Browse files Browse the repository at this point in the history 
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
  • Loading branch information
@uroboros
uroboros committed Nov 6, 2020
1 parent 2f8da1a commit ec7640b
Show file tree
Hide file tree
Showing 11 changed files with 1,122 additions and 805 deletions.
16 changes: 14 additions & 2 deletions shelley-ma/shelley-ma-test/cardano-ledger-shelley-ma-test.cabal
View file
Original file line number Diff line number Diff line change
Expand Up @@ -20,11 +20,10 @@ source-repository head
library
exposed-modules:
Test.Cardano.Ledger.ShelleyMA.TestEra
Test.Cardano.Ledger.ShelleyMA.Serialisation.Generators
Test.Cardano.Ledger.ShelleyMA.TxBody
Test.Cardano.Ledger.ShelleyMA.Serialisation.Timelocks
Test.Cardano.Ledger.ShelleyMA.Serialisation.Coders

Test.Cardano.Ledger.ShelleyMA.Serialisation.Generators
-- other-extensions:
build-depends:
array,
Expand All @@ -33,9 +32,13 @@ library
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,
Expand All @@ -50,6 +53,7 @@ library
tasty-quickcheck,
tasty,
text,
QuickCheck >= 2.13.2,
hs-source-dirs: src
ghc-options:
-Wall
Expand Down Expand Up @@ -82,12 +86,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,
Expand All @@ -102,3 +112,5 @@ test-suite cardano-ledger-shelley-ma-test
tasty-hunit,
tasty-quickcheck,
tasty,
text,
QuickCheck,
270 changes: 239 additions & 31 deletions shelley-ma/shelley-ma-test/src/Test/Cardano/Ledger/ShelleyMA/Serialisation/Generators.hs
View file
Original file line number Diff line number Diff line change
@@ -1,51 +1,259 @@
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

{-# OPTIONS_GHC -Wno-orphans #-} -- orphan Arbitrary instances

-- | This module is usually imported for its Arbitrary instances
module Test.Cardano.Ledger.ShelleyMA.Serialisation.Generators where
module Test.Cardano.Ledger.ShelleyMA.Serialisation.Generators
( sizedTimelock,
maxTimelockDepth,
)
where

import Cardano.Slotting.Slot (SlotNo (..))
import Cardano.Ledger.Era(Era(..))
import Cardano.Ledger.ShelleyMA.Timelocks
( Timelock (RequireSignature, RequireAllOf, RequireAnyOf, RequireMOf, RequireTimeExpire, RequireTimeStart),
import Cardano.Binary
( toCBOR,
)
import Cardano.Crypto.Hash (HashAlgorithm, hashWithSerialiser)
import qualified Cardano.Crypto.Hash as Hash
import Cardano.Ledger.Allegra (AllegraEra)
import qualified Cardano.Ledger.Core as Abstract
import Cardano.Ledger.Era (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 qualified Cardano.Ledger.ShelleyMA.Scripts as MA (Timelock (..))
import Cardano.Ledger.ShelleyMA.Timelocks (Timelock (..), ValidityInterval)
import qualified Cardano.Ledger.ShelleyMA.TxBody as MA (TxBody (..))
import Data.ByteString.Char8 (ByteString)
import Data.Coerce (coerce)
import Data.Sequence.Strict (StrictSeq, fromList)
import Generic.Random (genericArbitraryU)
import Shelley.Spec.Ledger.API hiding (SignedDSIGN, TxBody (..))
import Shelley.Spec.Ledger.Coin (DeltaCoin)
import Shelley.Spec.Ledger.MetaData (MetaDataHash)
import qualified Shelley.Spec.Ledger.STS.Ppup as STS
import Shelley.Spec.Ledger.Slot (SlotNo)
import Test.QuickCheck
( Arbitrary,
arbitrary,
choose,
genericShrink,
listOf,
oneof,
resize,
shrink,
)
import Data.Sequence.Strict (fromList)
import Shelley.Spec.Ledger.Keys (KeyHash (..))
import Shelley.Spec.Ledger.BaseTypes (StrictMaybe (SJust, SNothing))
import Test.Shelley.Spec.Ledger.Serialisation.Generators(mkDummyHash) -- imports arbitray instance for MultiSig
import Test.Tasty.QuickCheck hiding (scale)
import Test.Shelley.Spec.Ledger.ConcreteCryptoTypes (Mock)
import Test.Tasty.QuickCheck (Gen)

{-------------------------------------------------------------------------------
ShelleyMAEra Generators
-- ================================================================
Generators used for roundtrip tests, generated values are not
necessarily valid
-------------------------------------------------------------------------------}

-- ================================================================================
-- Some generators for Timelock
mkDummyHash :: forall h a. HashAlgorithm h => Int -> Hash.Hash h a
mkDummyHash = coerce . hashWithSerialiser @h toCBOR

genSlot :: Gen (StrictMaybe SlotNo)
genSlot = oneof [ pure SNothing, (SJust . SlotNo) <$> choose (0,10)]
genTxBody ::
( ShelleyBased era,
Arbitrary (Abstract.Value era),
Arbitrary (TxIn era),
Arbitrary (StrictSeq (TxOut era)),
Arbitrary (StrictSeq (DCert era)),
Arbitrary (Wdrl era),
Arbitrary Coin,
Arbitrary (StrictMaybe (Update era)),
Arbitrary (StrictMaybe (MetaDataHash era)),
Arbitrary (StrictMaybe SlotNo)
) =>
Gen (MA.TxBody era)
genTxBody =
MA.TxBody
<$> arbitrary
<*> arbitrary
<*> arbitrary
<*> arbitrary
<*> arbitrary
<*> arbitrary
<*> arbitrary
<*> arbitrary
<*> arbitrary

maxTimelockDepth :: Int
maxTimelockDepth = 3

maxTimelockListLens :: Int
maxTimelockListLens = 5

sizedTimelock :: (Era era) => Int -> Gen (Timelock era)
sizedTimelock 0 = (RequireSignature . KeyHash . mkDummyHash) <$> arbitrary
sizedTimelock ::
( Era era,
Arbitrary (StrictMaybe SlotNo)
) =>
Int ->
Gen (Timelock era)
sizedTimelock 0 = (MA.RequireSignature . KeyHash . mkDummyHash) <$> arbitrary
sizedTimelock n =
oneof
[ (RequireSignature . KeyHash . mkDummyHash) <$> arbitrary,
RequireAllOf <$> (fromList <$> resize maxTimelockListLens (listOf (sizedTimelock (n -1)))),
RequireAnyOf <$> (fromList <$> resize maxTimelockListLens (listOf (sizedTimelock (n -1)))),
do subs <- resize maxTimelockListLens (listOf (sizedTimelock (n -1)))
let i = length subs
RequireMOf <$> choose (0,i) <*> pure (fromList subs),
RequireTimeStart <$> genSlot,
RequireTimeExpire <$> genSlot
[ (MA.RequireSignature . KeyHash . mkDummyHash) <$> arbitrary,
MA.RequireAllOf <$> (fromList <$> resize maxTimelockListLens (listOf (sizedTimelock (n -1)))),
MA.RequireAnyOf <$> (fromList <$> resize maxTimelockListLens (listOf (sizedTimelock (n -1)))),
do
subs <- resize maxTimelockListLens (listOf (sizedTimelock (n -1)))
let i = length subs
MA.RequireMOf <$> choose (0, i) <*> pure (fromList subs),
RequireTimeStart <$> arbitrary,
RequireTimeExpire <$> arbitrary
]

instance (Era era) => Arbitrary (Timelock era) where
{-------------------------------------------------------------------------------
MaryEra Generators
-------------------------------------------------------------------------------}

instance
( Mock c,
PraosCrypto c,
Arbitrary (Abstract.Value (MaryEra c)),
Arbitrary (TxIn (MaryEra c)),
Arbitrary (StrictSeq (TxOut (MaryEra c))),
Arbitrary (StrictSeq (DCert (MaryEra c))),
Arbitrary (Wdrl (MaryEra c)),
Arbitrary Coin,
Arbitrary (StrictMaybe (Update (MaryEra c))),
Arbitrary (StrictMaybe (MetaDataHash (MaryEra c))),
Arbitrary (StrictMaybe SlotNo)
) =>
Arbitrary (MA.TxBody (MaryEra c))
where
arbitrary = genTxBody

instance
( Mock c,
PraosCrypto c,
Arbitrary (StrictMaybe SlotNo),
Arbitrary (MultiSig (MaryEra c))
) =>
Arbitrary (Timelock (MaryEra c))
where
arbitrary = sizedTimelock maxTimelockDepth

instance
( Mock c,
PraosCrypto c,
Arbitrary (Abstract.Value (MaryEra c)),
Arbitrary (Abstract.Script (MaryEra c)),
Arbitrary (ScriptHash (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 (ScriptHash (MaryEra c)),
Arbitrary ByteString
) =>
Arbitrary (Mary.Value (MaryEra c))
where
arbitrary = Mary.Value <$> arbitrary <*> arbitrary

instance
Arbitrary ByteString =>
Arbitrary Mary.AssetID
where
arbitrary = Mary.AssetID <$> arbitrary

instance
( Mock c,
PraosCrypto c,
Arbitrary (STS.PpupPredicateFailure (MaryEra c)),
Arbitrary (RewardAcnt (MaryEra c)),
Arbitrary (Addr (MaryEra c)),
Arbitrary (TxIn (MaryEra c)),
Arbitrary (MultiSig (MaryEra c)),
Arbitrary (ScriptHash (MaryEra c)),
Arbitrary (TxOut (MaryEra c)),
Arbitrary (StrictMaybe SlotNo),
Arbitrary SlotNo,
Arbitrary Coin,
Arbitrary ByteString,
Arbitrary Network
) =>
Arbitrary (MA.STS.UtxoPredicateFailure (MaryEra c))
where
arbitrary = genericArbitraryU

{-------------------------------------------------------------------------------
AllegraEra Generators
-------------------------------------------------------------------------------}

instance
( Mock c,
PraosCrypto c,
Arbitrary (Abstract.Value (AllegraEra c)),
Arbitrary (TxIn (AllegraEra c)),
Arbitrary (StrictSeq (TxOut (AllegraEra c))),
Arbitrary (StrictSeq (DCert (AllegraEra c))),
Arbitrary (Wdrl (AllegraEra c)),
Arbitrary (StrictMaybe (Update (AllegraEra c))),
Arbitrary (StrictMaybe (MetaDataHash (AllegraEra c))),
Arbitrary (StrictMaybe SlotNo)
) =>
Arbitrary (MA.TxBody (AllegraEra c))
where
arbitrary = genTxBody

instance
( Mock c,
PraosCrypto c,
Arbitrary (StrictMaybe SlotNo),
Arbitrary (MultiSig (AllegraEra c))
) =>
Arbitrary (Timelock (AllegraEra c))
where
arbitrary = sizedTimelock maxTimelockDepth

instance
Arbitrary (StrictMaybe SlotNo) =>
Arbitrary ValidityInterval
where
arbitrary = genericArbitraryU
shrink = genericShrink

instance
( Mock c,
PraosCrypto c,
Arbitrary (STS.PpupPredicateFailure (AllegraEra c)),
Arbitrary (RewardAcnt (AllegraEra c)),
Arbitrary (Addr (AllegraEra c)),
Arbitrary (TxIn (AllegraEra c)),
Arbitrary (MultiSig (AllegraEra c)),
Arbitrary (ScriptHash (AllegraEra c)),
Arbitrary (TxOut (AllegraEra c)),
Arbitrary (StrictMaybe SlotNo),
Arbitrary SlotNo,
Arbitrary Coin,
Arbitrary ByteString,
Arbitrary Network,
Arbitrary DeltaCoin
) =>
Arbitrary (MA.STS.UtxoPredicateFailure (AllegraEra c))
where
arbitrary = genericArbitraryU
Loading

0 comments on commit ec7640b

Please sign in to comment.