Speed up Value generation for serialisation tests.

Rather than using prune, we instead use `valueFromList` to construct
these directly.

Also add some shrinkers for values.

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

@@ -15,6 +15,7 @@
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE ViewPatterns #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
 
 module Test.Cardano.Ledger.ShelleyMA.Serialisation.Generators
@@ -30,16 +31,23 @@ import Cardano.Ledger.Allegra (AllegraEra)
 import Cardano.Ledger.Era (Era (..))
 import Cardano.Ledger.Mary (MaryEra)
 import qualified Cardano.Ledger.Mary.Value as ConcreteValue
-import qualified Cardano.Ledger.Mary.Value as Mary (AssetName (..), PolicyID (..), Value (..))
+import qualified Cardano.Ledger.Mary.Value as Mary
+ ( AssetName (..),
+ PolicyID (..),
+ Value (..),
+ )
 import Cardano.Ledger.ShelleyMA (ShelleyMAEra)
 import qualified Cardano.Ledger.ShelleyMA.Metadata as MA
 import qualified Cardano.Ledger.ShelleyMA.Rules.Utxo as MA.STS
 import Cardano.Ledger.ShelleyMA.Timelocks (Timelock (..), ValidityInterval (..))
 import qualified Cardano.Ledger.ShelleyMA.Timelocks as MA (Timelock (..))
 import qualified Cardano.Ledger.ShelleyMA.TxBody as MA (TxBody (..))
 import Data.Coerce (coerce)
-import Data.Sequence.Strict (StrictSeq,fromList)
+import Data.Int (Int64)
+import qualified Data.Map.Strict as Map
+import Data.Sequence.Strict (StrictSeq, fromList)
 import Data.Typeable (Typeable)
+import Data.Word (Word64)
 import Generic.Random (genericArbitraryU)
 import Shelley.Spec.Ledger.API hiding (SignedDSIGN, TxBody (..))
 import Test.QuickCheck
@@ -48,18 +56,17 @@ import Test.QuickCheck
  choose,
  genericShrink,
  listOf,
- vectorOf,
  oneof,
  resize,
  shrink,
+ vectorOf,
  )
 import Test.Shelley.Spec.Ledger.ConcreteCryptoTypes (Mock)
 import Test.Shelley.Spec.Ledger.Generator.MetaData (genMetaData')
 import Test.Shelley.Spec.Ledger.Serialisation.EraIndepGenerators ()
 import Test.Shelley.Spec.Ledger.Serialisation.Generators ()
 import Test.Tasty.QuickCheck (Gen)
 
-
 {-------------------------------------------------------------------------------
  ShelleyMAEra Generators
  Generators used for roundtrip tests, generated values are not
@@ -83,8 +90,18 @@ sizedTimelock 0 = (MA.RequireSignature . KeyHash . mkDummyHash) <$> arbitrary
 sizedTimelock n =
  oneof
  [ (MA.RequireSignature . KeyHash . mkDummyHash) <$> arbitrary,
- MA.RequireAllOf <$> (fromList <$> resize maxTimelockListLens (listOf (sizedTimelock (n -1)))),
- MA.RequireAnyOf <$> (fromList <$> resize maxTimelockListLens (listOf (sizedTimelock (n -1)))),
+ 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
@@ -112,15 +129,16 @@ instance
  arbitrary =
  genMetaData' >>= \case
  MetaData m ->
- do ss <- genScriptSeq ; pure (MA.Metadata m ss)
+ do ss <- genScriptSeq; pure (MA.Metadata m ss)
 
-genScriptSeq :: (Arbitrary (Timelock (ShelleyMAEra ma c))) => Gen(StrictSeq (Timelock (ShelleyMAEra ma c)))
+genScriptSeq ::
+ (Arbitrary (Timelock (ShelleyMAEra ma c))) =>
+ Gen (StrictSeq (Timelock (ShelleyMAEra ma c)))
 genScriptSeq = do
- n <- choose (0,3)
+ n <- choose (0, 3)
  l <- vectorOf n arbitrary
  pure (fromList l)
 
-
 {-------------------------------------------------------------------------------
  MaryEra Generators
 -------------------------------------------------------------------------------}
@@ -145,12 +163,42 @@ instance Mock c => Arbitrary (Mary.PolicyID (MaryEra c)) where
  arbitrary = Mary.PolicyID <$> arbitrary
 
 instance Mock c => Arbitrary (Mary.Value (MaryEra c)) where
- arbitrary = Mary.Value <$> (abs <$> arbitrary) <*> (ConcreteValue.prune . pointwiseAbs <$> arbitrary)
- where
- pointwiseAbs = fmap (fmap abs)
-
-genMintValues :: Mock c => Gen (Mary.Value (MaryEra c))
-genMintValues = Mary.Value 0 . ConcreteValue.prune <$> arbitrary
+ arbitrary = valueFromListBounded <$> arbitrary <*> arbitrary
+
+ shrink (Mary.Value ada assets) =
+ concat
+ [ -- Shrink the ADA value
+ flip Mary.Value assets <$> shrink ada,
+ -- Shrink the non-ADA assets by reducing the list length
+ Mary.Value
+ ada
+ <$> shrink assets
+ ]
+
+-- | When generating values for the mint field, we do two things:
+--
+-- - Fix the ADA value to 0
+-- - Allow both positive and negative quantities
+genMintValues :: forall c. Mock c => Gen (Mary.Value (MaryEra c))
+genMintValues = valueFromListBounded 0 <$> arbitraryBounded
+ where
+ arbitraryBounded =
+ fmap (\(a, b, c) -> (a, b, fromIntegral c))
+ <$> arbitrary @[(Mary.PolicyID (MaryEra c), Mary.AssetName, Int64)]
+
+-- | Variant on @valueFromList@ that makes sure that generated values stay
+-- bounded within the range of a `Word64`
+valueFromListBounded ::
+ Word64 ->
+ [(Mary.PolicyID era, Mary.AssetName, Word64)] ->
+ Mary.Value era
+valueFromListBounded (fromIntegral -> ada) =
+ foldr
+ (\(p, n, fromIntegral -> i) ans -> ConcreteValue.insert comb p n i ans)
+ (Mary.Value ada Map.empty)
+ where
+ comb :: Integer -> Integer -> Integer
+ comb a b = max (fromIntegral $ maxBound @Word64) (a + b)
 
 instance Arbitrary Mary.AssetName where
  arbitrary = Mary.AssetName <$> arbitrary

shelley/chain-and-ledger/shelley-spec-ledger-test/src/Test/Shelley/Spec/Ledger/Serialisation/EraIndepGenerators.hs

@@ -304,6 +304,7 @@ instance Arbitrary STS.VotingPeriod where
 instance Arbitrary Coin where
  -- Cannot be negative even though it is an 'Integer'
  arbitrary = Coin <$> choose (0, 1000)
+ shrink (Coin i) = Coin <$> shrink i
 
 instance Arbitrary DeltaCoin where
  arbitrary = DeltaCoin <$> choose (-1000, 1000)