Skip to content

Commit

Permalink
Fork genTokenBundleSmallRange into positive and non-positive variants.
Browse files Browse the repository at this point in the history
This change forks `genTokenBundleSmallRange` into two variants:

  - `genTokenBundleSmallRange`
     Generates token bundles where the ada quantity may be zero.

  - `genTokenBundleSmallRangePositive`
     Generates token bundles where the ada quantity is always non-zero.

This is necessary, as some QC properties require token bundles with ada
quantities of zero.

But coin selection QC properties typically require token bundles (within
transaction outputs) to have non-zero ada quantities.

This change also forks the associated shrinker function
`shrinkTokenBundleSmallRange` in a similar fashion.
  • Loading branch information
jonathanknowles committed Jan 15, 2021
1 parent 9f2e8fb commit 996234f
Show file tree
Hide file tree
Showing 2 changed files with 24 additions and 7 deletions.
21 changes: 19 additions & 2 deletions lib/core/src/Cardano/Wallet/Primitive/Types/TokenBundle/Gen.hs
Original file line number Diff line number Diff line change
@@ -1,12 +1,18 @@
module Cardano.Wallet.Primitive.Types.TokenBundle.Gen
( genTokenBundleSmallRange
, genTokenBundleSmallRangePositive
, shrinkTokenBundleSmallRange
, shrinkTokenBundleSmallRangePositive
) where

import Prelude

import Cardano.Wallet.Primitive.Types.Coin.Gen
( genCoinSmallPositive, shrinkCoinSmallPositive )
( genCoinSmall
, genCoinSmallPositive
, shrinkCoinSmall
, shrinkCoinSmallPositive
)
import Cardano.Wallet.Primitive.Types.TokenBundle
( TokenBundle (..) )
import Cardano.Wallet.Primitive.Types.TokenMap.Gen
Expand All @@ -22,11 +28,22 @@ import Test.QuickCheck.Extra

genTokenBundleSmallRange :: Gen TokenBundle
genTokenBundleSmallRange = TokenBundle
<$> genCoinSmallPositive
<$> genCoinSmall
<*> genTokenMapSmallRange

shrinkTokenBundleSmallRange :: TokenBundle -> [TokenBundle]
shrinkTokenBundleSmallRange (TokenBundle c m) =
uncurry TokenBundle <$> shrinkInterleaved
(c, shrinkCoinSmall)
(m, shrinkTokenMapSmallRange)

genTokenBundleSmallRangePositive :: Gen TokenBundle
genTokenBundleSmallRangePositive = TokenBundle
<$> genCoinSmallPositive
<*> genTokenMapSmallRange

shrinkTokenBundleSmallRangePositive :: TokenBundle -> [TokenBundle]
shrinkTokenBundleSmallRangePositive (TokenBundle c m) =
uncurry TokenBundle <$> shrinkInterleaved
(c, shrinkCoinSmallPositive)
(m, shrinkTokenMapSmallRange)
Original file line number Diff line number Diff line change
Expand Up @@ -38,7 +38,7 @@ import Cardano.Wallet.Primitive.Types.Coin
import Cardano.Wallet.Primitive.Types.TokenBundle
( TokenBundle )
import Cardano.Wallet.Primitive.Types.TokenBundle.Gen
( genTokenBundleSmallRange, shrinkTokenBundleSmallRange )
( genTokenBundleSmallRangePositive, shrinkTokenBundleSmallRangePositive )
import Cardano.Wallet.Primitive.Types.TokenMap
( AssetId (..) )
import Cardano.Wallet.Primitive.Types.TokenMap.Gen
Expand Down Expand Up @@ -518,8 +518,8 @@ genMakeChangeData = flip suchThat isValidMakeChangeData $ do
where
genTokenBundles :: Int -> Gen (NonEmpty TokenBundle)
genTokenBundles count = (:|)
<$> genTokenBundleSmallRange
<*> replicateM count genTokenBundleSmallRange
<$> genTokenBundleSmallRangePositive
<*> replicateM count genTokenBundleSmallRangePositive

prop_makeChange_identity
:: NonEmpty TokenBundle -> Property
Expand Down Expand Up @@ -762,8 +762,8 @@ instance Arbitrary (MockRoundRobinState TokenName Word8) where
shrink = shrinkMockRoundRobinState shrink

instance Arbitrary TokenBundle where
arbitrary = genTokenBundleSmallRange
shrink = shrinkTokenBundleSmallRange
arbitrary = genTokenBundleSmallRangePositive
shrink = shrinkTokenBundleSmallRangePositive

instance Arbitrary TokenQuantity where
arbitrary = genTokenQuantitySmallPositive
Expand Down

0 comments on commit 996234f

Please sign in to comment.