From 0ad15b8ec92e8836f91c937ba27e4737754b822a Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Mon, 16 Aug 2021 08:04:18 +0000 Subject: [PATCH 01/13] Rename `getUTxO` deconstructor function to `unUTxO`. This is consistent with the convention for many other types. For example: - unCoin - unNegativeCoin - unNodePort - unPretty - unTokenQuantity The `un` prefix is arguably more consistent with the meaning, which is to *unwrap* a `UTxO` rather than to *get* a `UTxO`. --- lib/core/src/Cardano/Wallet.hs | 2 +- lib/core/src/Cardano/Wallet/DB/Model.hs | 4 ++-- lib/core/src/Cardano/Wallet/DB/Sqlite.hs | 2 +- .../src/Cardano/Wallet/Primitive/Delegation/UTxO.hs | 2 +- lib/core/src/Cardano/Wallet/Primitive/Types/UTxO.hs | 6 +++--- .../Wallet/Primitive/Types/UTxOIndex/Internal.hs | 2 +- .../Cardano/Wallet/Primitive/Types/UTxOIndexSpec.hs | 2 +- .../test/unit/Cardano/Wallet/Primitive/TypesSpec.hs | 4 ++-- .../unit/Cardano/Wallet/Shelley/TransactionSpec.hs | 12 ++++++------ 9 files changed, 18 insertions(+), 18 deletions(-) diff --git a/lib/core/src/Cardano/Wallet.hs b/lib/core/src/Cardano/Wallet.hs index 0f1df9925a7..688d83d35f7 100644 --- a/lib/core/src/Cardano/Wallet.hs +++ b/lib/core/src/Cardano/Wallet.hs @@ -794,7 +794,7 @@ getWalletUtxoSnapshot ctx wid = do (wallet, _, pending) <- withExceptT id (readWallet @ctx @s @k ctx wid) pp <- liftIO $ currentProtocolParameters nl let bundles = availableUTxO @s pending wallet - & getUTxO + & unUTxO & F.toList & fmap (view #tokens) pure $ pairBundleWithMinAdaQuantity pp <$> bundles diff --git a/lib/core/src/Cardano/Wallet/DB/Model.hs b/lib/core/src/Cardano/Wallet/DB/Model.hs index 27d6b4b6d98..29d0814d1f0 100644 --- a/lib/core/src/Cardano/Wallet/DB/Model.hs +++ b/lib/core/src/Cardano/Wallet/DB/Model.hs @@ -468,10 +468,10 @@ mReadTxHistory ti wid minWithdrawal order range mstatus db@(Database wallets txs , txInfoFee = fee tx , txInfoCollateral = - (\(inp, amt) -> (inp, amt, Map.lookup inp $ getUTxO $ utxo cp)) + (\(inp, amt) -> (inp, amt, Map.lookup inp $ unUTxO $ utxo cp)) <$> resolvedCollateral tx , txInfoInputs = - (\(inp, amt) -> (inp, amt, Map.lookup inp $ getUTxO $ utxo cp)) + (\(inp, amt) -> (inp, amt, Map.lookup inp $ unUTxO $ utxo cp)) <$> resolvedInputs tx , txInfoOutputs = outputs tx diff --git a/lib/core/src/Cardano/Wallet/DB/Sqlite.hs b/lib/core/src/Cardano/Wallet/DB/Sqlite.hs index 9a72c7e84eb..5785f947c1a 100644 --- a/lib/core/src/Cardano/Wallet/DB/Sqlite.hs +++ b/lib/core/src/Cardano/Wallet/DB/Sqlite.hs @@ -1761,7 +1761,7 @@ mkCheckpointEntity wid wal = , let tokenList = snd (TokenBundle.toFlatList tokens) , (AssetId policy token, quantity) <- tokenList ] - utxoMap = Map.assocs (W.getUTxO (W.utxo wal)) + utxoMap = Map.assocs (W.unUTxO (W.utxo wal)) -- note: TxIn records must already be sorted by order -- and TxOut records must already by sorted by index. diff --git a/lib/core/src/Cardano/Wallet/Primitive/Delegation/UTxO.hs b/lib/core/src/Cardano/Wallet/Primitive/Delegation/UTxO.hs index 2dfbce5a6a6..2805062a10f 100644 --- a/lib/core/src/Cardano/Wallet/Primitive/Delegation/UTxO.hs +++ b/lib/core/src/Cardano/Wallet/Primitive/Delegation/UTxO.hs @@ -30,7 +30,7 @@ stakeKeyCoinDistr -> UTxO -> Map (Maybe RewardAccount) Coin stakeKeyCoinDistr stakeRef = - Map.fromListWith (<>) . map classifyOut . Map.elems . getUTxO + Map.fromListWith (<>) . map classifyOut . Map.elems . unUTxO where classifyOut :: TxOut -> (Maybe RewardAccount, Coin) classifyOut (TxOut addr b) = (stakeRef addr, TokenBundle.getCoin b) diff --git a/lib/core/src/Cardano/Wallet/Primitive/Types/UTxO.hs b/lib/core/src/Cardano/Wallet/Primitive/Types/UTxO.hs index f697b8340bc..01adbaa393d 100644 --- a/lib/core/src/Cardano/Wallet/Primitive/Types/UTxO.hs +++ b/lib/core/src/Cardano/Wallet/Primitive/Types/UTxO.hs @@ -70,7 +70,7 @@ import qualified Data.List.NonEmpty as NE import qualified Data.Map.Strict as Map import qualified Data.Set as Set -newtype UTxO = UTxO { getUTxO :: Map TxIn TxOut } +newtype UTxO = UTxO { unUTxO :: Map TxIn TxOut } deriving stock (Show, Generic, Eq, Ord) deriving newtype (Semigroup, Monoid) @@ -102,7 +102,7 @@ instance Buildable UTxO where -- | Compute the balance of a UTxO balance :: UTxO -> TokenBundle balance = - Map.foldl' fn mempty . getUTxO + Map.foldl' fn mempty . unUTxO where fn :: TokenBundle -> TxOut -> TokenBundle fn tot out = tot `TB.add` view #tokens out @@ -208,7 +208,7 @@ log10 = Log10 -- | Compute UtxoStatistics from UTxOs computeUtxoStatistics :: BoundType -> UTxO -> UTxOStatistics computeUtxoStatistics btype = - computeStatistics (pure . unCoin . txOutCoin) btype . Map.elems . getUTxO + computeStatistics (pure . unCoin . txOutCoin) btype . Map.elems . unUTxO -- | A more generic function for computing UTxO statistics on some other type of -- data that maps to UTxO's values. diff --git a/lib/core/src/Cardano/Wallet/Primitive/Types/UTxOIndex/Internal.hs b/lib/core/src/Cardano/Wallet/Primitive/Types/UTxOIndex/Internal.hs index 91df57f25ec..657be0e9f7d 100644 --- a/lib/core/src/Cardano/Wallet/Primitive/Types/UTxOIndex/Internal.hs +++ b/lib/core/src/Cardano/Wallet/Primitive/Types/UTxOIndex/Internal.hs @@ -205,7 +205,7 @@ fromSequence = flip insertMany empty -- index from scratch, and therefore should only be used sparingly. -- fromUTxO :: UTxO -> UTxOIndex -fromUTxO = Map.foldlWithKey' (\u i o -> insertUnsafe i o u) empty . getUTxO +fromUTxO = Map.foldlWithKey' (\u i o -> insertUnsafe i o u) empty . unUTxO -------------------------------------------------------------------------------- -- Deconstruction diff --git a/lib/core/test/unit/Cardano/Wallet/Primitive/Types/UTxOIndexSpec.hs b/lib/core/test/unit/Cardano/Wallet/Primitive/Types/UTxOIndexSpec.hs index 91758ee1ca0..c6caa7ea46c 100644 --- a/lib/core/test/unit/Cardano/Wallet/Primitive/Types/UTxOIndexSpec.hs +++ b/lib/core/test/unit/Cardano/Wallet/Primitive/Types/UTxOIndexSpec.hs @@ -423,7 +423,7 @@ prop_selectRandom_one_withAdaOnly u = checkCoverage $ monadicIO $ do assert $ u /= u' where utxoHasNoAdaOnlyEntries = - Map.null $ Map.filter txOutIsAdaOnly $ getUTxO $ UTxOIndex.toUTxO u + Map.null $ Map.filter txOutIsAdaOnly $ unUTxO $ UTxOIndex.toUTxO u -- | Attempt to select a random element with a specific asset. -- diff --git a/lib/core/test/unit/Cardano/Wallet/Primitive/TypesSpec.hs b/lib/core/test/unit/Cardano/Wallet/Primitive/TypesSpec.hs index d97db2e138e..50137aac59b 100644 --- a/lib/core/test/unit/Cardano/Wallet/Primitive/TypesSpec.hs +++ b/lib/core/test/unit/Cardano/Wallet/Primitive/TypesSpec.hs @@ -905,7 +905,7 @@ prop_2_1_3 :: (Set TxOut, UTxO) -> Property prop_2_1_3 (outs, u) = cover 50 cond "u ⋂ outs ≠ ∅" (property prop) where - cond = not $ Set.fromList (Map.elems (getUTxO u)) `Set.disjoint` outs + cond = not $ Set.fromList (Map.elems (unUTxO u)) `Set.disjoint` outs prop = (u `restrictedTo` outs) `isSubsetOf` u prop_2_1_4 :: (Set TxIn, UTxO, UTxO) -> Property @@ -1042,7 +1042,7 @@ propUtxoWeightsEqualSize -> ShowFmt UTxO -> Property propUtxoWeightsEqualSize bType (ShowFmt utxo) = - sum (histElems bars) === fromIntegral (Map.size $ getUTxO utxo) + sum (histElems bars) === fromIntegral (Map.size $ unUTxO utxo) & cover 75 (utxo /= mempty) "UTxO /= empty" & counterexample ("Coefficients: " <> pretty (histElems bars)) where diff --git a/lib/shelley/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs b/lib/shelley/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs index e00f626a6cd..078695ad2e4 100644 --- a/lib/shelley/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs +++ b/lib/shelley/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs @@ -411,7 +411,7 @@ spec = do , changeGenerated = chgs , utxoRemaining = UTxOIndex.empty } - inps = Map.toList $ getUTxO utxo + inps = Map.toList $ unUTxO utxo it "1 input, 2 outputs" $ do let pairs = [dummyWit 0] let amtInp = 10000000 @@ -505,7 +505,7 @@ spec = do , changeGenerated = chgs , utxoRemaining = UTxOIndex.empty } - inps = Map.toList $ getUTxO utxo + inps = Map.toList $ unUTxO utxo it "1 input, 2 outputs" $ do let pairs = [dummyWit 0] let amtInp = 10000000 @@ -628,7 +628,7 @@ prop_decodeSignedShelleyTxRoundtrip -> Property prop_decodeSignedShelleyTxRoundtrip shelleyEra (DecodeShelleySetup utxo outs md slotNo pairs) = do let anyEra = Cardano.anyCardanoEra (Cardano.cardanoEra @era) - let inps = Map.toList $ getUTxO utxo + let inps = Map.toList $ unUTxO utxo let cs = mkSelection inps let fee = toCardanoLovelace $ selectionDelta txOutCoin cs let Right unsigned = mkUnsignedTx shelleyEra slotNo cs md mempty [] fee @@ -658,7 +658,7 @@ prop_decodeSignedByronTxRoundtrip prop_decodeSignedByronTxRoundtrip (DecodeByronSetup utxo outs slotNo ntwrk pairs) = do let era = Cardano.AnyCardanoEra Cardano.AllegraEra let shelleyEra = Cardano.ShelleyBasedEraAllegra - let inps = Map.toList $ getUTxO utxo + let inps = Map.toList $ unUTxO utxo let cs = mkSelection inps let fee = toCardanoLovelace $ selectionDelta txOutCoin cs let Right unsigned = mkUnsignedTx shelleyEra slotNo cs Nothing mempty [] fee @@ -731,7 +731,7 @@ instance Arbitrary DecodeShelleySetup where outs <- vectorOf n arbitrary md <- arbitrary slot <- arbitrary - let numInps = Map.size $ getUTxO utxo + let numInps = Map.size $ unUTxO utxo pairs <- vectorOf numInps arbitrary pure $ DecodeShelleySetup utxo outs md slot pairs @@ -747,7 +747,7 @@ instance Arbitrary DecodeByronSetup where n <- choose (1,10) outs <- vectorOf n arbitrary net <- arbitrary - let numInps = Map.size $ getUTxO utxo + let numInps = Map.size $ unUTxO utxo slot <- arbitrary pairs <- vectorOf numInps arbitrary pure $ DecodeByronSetup utxo outs slot net pairs From 09653167d79ab598b8886cd49ecf02d83ce22461 Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Tue, 17 Aug 2021 04:02:27 +0000 Subject: [PATCH 02/13] Add functions `genSized2` and `genSized2With`. These combinators make it possible to restore size linearity to generators composed of other generators that depend on the size parameter. --- lib/test-utils/src/Test/QuickCheck/Extra.hs | 40 +++++++++++++++++++++ 1 file changed, 40 insertions(+) diff --git a/lib/test-utils/src/Test/QuickCheck/Extra.hs b/lib/test-utils/src/Test/QuickCheck/Extra.hs index 119bc917ef6..a59ab81b478 100644 --- a/lib/test-utils/src/Test/QuickCheck/Extra.hs +++ b/lib/test-utils/src/Test/QuickCheck/Extra.hs @@ -10,6 +10,8 @@ module Test.QuickCheck.Extra ( reasonablySized , shrinkInterleaved + , genSized2 + , genSized2With ) where import Prelude @@ -38,6 +40,44 @@ import Test.QuickCheck reasonablySized :: Gen a -> Gen a reasonablySized = scale (ceiling . sqrt @Double . fromIntegral) +-- | Resizes a generator by taking the nth root of the size parameter. +-- +-- This combinator can restore size linearity to generators composed of 'n' +-- independent generators in the case that each generator generates values +-- from a range that depends on the size parameter. +-- +-- Example: +-- +-- Suppose that we have a single generator composed of **three** independent +-- generators, where each generator depends on the size parameter. +-- +-- If the current value of the size parameter is 1000, then to generate a range +-- of up to 1000 different composite values, we can resize each individual +-- generator so that it generates up to 10 different values: +-- +-- >>> genComposite = Composite +-- >>> <$> scaleToRoot 3 genA +-- >>> <*> scaleToRoot 3 genB +-- >>> <*> scaleToRoot 3 genC +-- +scaleToRoot :: Int -> Gen a -> Gen a +scaleToRoot n = scale + $ floor @Double @Int + . (** (1.0 / fromIntegral @Int @Double n)) + . fromIntegral @Int @Double + +-- | Generates a 2-tuple whose range depends linearly on the size parameter. +-- +genSized2 :: Gen a -> Gen b -> Gen (a, b) +genSized2 genA genB = (,) + <$> scaleToRoot 2 genA + <*> scaleToRoot 2 genB + +-- | Similar to 'genSized2', but with a custom constructor. +-- +genSized2With :: (a -> b -> c) -> Gen a -> Gen b -> Gen c +genSized2With f genA genB = uncurry f <$> genSized2 genA genB + -- | Shrink the given pair in interleaved fashion. -- -- Successive shrinks of the left and right hand sides are interleaved in the From 2b3d908188a74cad1f185f32f86381e3d56f8a53 Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Tue, 17 Aug 2021 04:04:25 +0000 Subject: [PATCH 03/13] Use `genSized2` to simplify implementation of `genAssetId`. --- .../Wallet/Primitive/Types/TokenMap/Gen.hs | 20 ++----------------- 1 file changed, 2 insertions(+), 18 deletions(-) diff --git a/lib/core/src/Cardano/Wallet/Primitive/Types/TokenMap/Gen.hs b/lib/core/src/Cardano/Wallet/Primitive/Types/TokenMap/Gen.hs index ad7c408e21c..2cb8f6d1958 100644 --- a/lib/core/src/Cardano/Wallet/Primitive/Types/TokenMap/Gen.hs +++ b/lib/core/src/Cardano/Wallet/Primitive/Types/TokenMap/Gen.hs @@ -43,13 +43,12 @@ import Test.QuickCheck , choose , functionMap , oneof - , resize , shrinkList , sized , variant ) import Test.QuickCheck.Extra - ( shrinkInterleaved ) + ( genSized2With, shrinkInterleaved ) import qualified Cardano.Wallet.Primitive.Types.TokenMap as TokenMap @@ -58,22 +57,7 @@ import qualified Cardano.Wallet.Primitive.Types.TokenMap as TokenMap -------------------------------------------------------------------------------- genAssetId :: Gen AssetId -genAssetId = sized $ \size -> do - -- Ideally, we want to choose asset identifiers from a range that scales - -- /linearly/ with the size parameter. - -- - -- However, since each asset identifier has /two/ components that are - -- generated /separately/, naively combining the generators for these two - -- components will give rise to a range of asset identifiers that scales - -- /quadratically/ with the size parameter, which is /not/ what we want. - -- - -- Therefore, we pass each individual generator a size parameter that - -- is the square root of the original. - -- - let sizeSquareRoot = max 1 $ ceiling $ sqrt $ fromIntegral @Int @Double size - AssetId - <$> resize sizeSquareRoot genTokenPolicyId - <*> resize sizeSquareRoot genTokenName +genAssetId = genSized2With AssetId genTokenPolicyId genTokenName shrinkAssetId :: AssetId -> [AssetId] shrinkAssetId (AssetId p t) = uncurry AssetId <$> shrinkInterleaved From 51a59b2a2b155d05c4f30398a6317cff2e81dd77 Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Tue, 17 Aug 2021 04:20:10 +0000 Subject: [PATCH 04/13] Generate values of `Address` according to the size parameter. --- .../Wallet/Primitive/Types/Address/Gen.hs | 22 +++++++++++-------- .../Cardano/Wallet/Primitive/Types/Tx/Gen.hs | 6 ++--- .../Cardano/Wallet/Primitive/MigrationSpec.hs | 4 ++-- lib/core/test/unit/Cardano/WalletSpec.hs | 4 ++-- 4 files changed, 20 insertions(+), 16 deletions(-) diff --git a/lib/core/src/Cardano/Wallet/Primitive/Types/Address/Gen.hs b/lib/core/src/Cardano/Wallet/Primitive/Types/Address/Gen.hs index 450dca41fb0..7bbfddab89f 100644 --- a/lib/core/src/Cardano/Wallet/Primitive/Types/Address/Gen.hs +++ b/lib/core/src/Cardano/Wallet/Primitive/Types/Address/Gen.hs @@ -1,6 +1,6 @@ module Cardano.Wallet.Primitive.Types.Address.Gen - ( genAddressSmallRange - , shrinkAddressSmallRange + ( genAddress + , shrinkAddress ) where @@ -9,22 +9,26 @@ import Prelude import Cardano.Wallet.Primitive.Types.Address ( Address (..) ) import Test.QuickCheck - ( Gen, elements ) + ( Gen, elements, sized ) import qualified Data.ByteString.Char8 as B8 -------------------------------------------------------------------------------- --- Addresses chosen from a small range (to allow collisions) +-- Addresses generated according to the size parameter -------------------------------------------------------------------------------- -genAddressSmallRange :: Gen (Address) -genAddressSmallRange = elements addresses +genAddress :: Gen (Address) +genAddress = sized $ \size -> elements $ take (max 1 size) addresses -shrinkAddressSmallRange :: Address -> [Address] -shrinkAddressSmallRange a = filter (< a) addresses +shrinkAddress :: Address -> [Address] +shrinkAddress a + | a == simplest = [] + | otherwise = [simplest] + where + simplest = head addresses addresses :: [Address] -addresses = mkAddress <$> ['0' .. '7'] +addresses = mkAddress <$> ['0' ..] -------------------------------------------------------------------------------- -- Internal utilities diff --git a/lib/core/src/Cardano/Wallet/Primitive/Types/Tx/Gen.hs b/lib/core/src/Cardano/Wallet/Primitive/Types/Tx/Gen.hs index 32c65c4fc1d..55702a1cc23 100644 --- a/lib/core/src/Cardano/Wallet/Primitive/Types/Tx/Gen.hs +++ b/lib/core/src/Cardano/Wallet/Primitive/Types/Tx/Gen.hs @@ -16,7 +16,7 @@ module Cardano.Wallet.Primitive.Types.Tx.Gen import Prelude import Cardano.Wallet.Primitive.Types.Address.Gen - ( genAddressSmallRange, shrinkAddressSmallRange ) + ( genAddress, shrinkAddress ) import Cardano.Wallet.Primitive.Types.Coin ( Coin (..) ) import Cardano.Wallet.Primitive.Types.Hash @@ -113,12 +113,12 @@ genTxInLargeRange = TxIn genTxOutSmallRange :: Gen TxOut genTxOutSmallRange = TxOut - <$> genAddressSmallRange + <$> genAddress <*> genTokenBundleSmallRange `suchThat` tokenBundleHasNonZeroCoin shrinkTxOutSmallRange :: TxOut -> [TxOut] shrinkTxOutSmallRange (TxOut a b) = uncurry TxOut <$> shrinkInterleaved - (a, shrinkAddressSmallRange) + (a, shrinkAddress) (b, filter tokenBundleHasNonZeroCoin . shrinkTokenBundleSmallRange) tokenBundleHasNonZeroCoin :: TokenBundle -> Bool diff --git a/lib/core/test/unit/Cardano/Wallet/Primitive/MigrationSpec.hs b/lib/core/test/unit/Cardano/Wallet/Primitive/MigrationSpec.hs index 917eb85147d..9e6828513d0 100644 --- a/lib/core/test/unit/Cardano/Wallet/Primitive/MigrationSpec.hs +++ b/lib/core/test/unit/Cardano/Wallet/Primitive/MigrationSpec.hs @@ -19,7 +19,7 @@ import Cardano.Wallet.Primitive.Migration.SelectionSpec , verify ) import Cardano.Wallet.Primitive.Types.Address.Gen - ( genAddressSmallRange ) + ( genAddress ) import Cardano.Wallet.Primitive.Types.Tx ( TxIn, TxOut (..) ) import Cardano.Wallet.Primitive.Types.Tx.Gen @@ -90,7 +90,7 @@ prop_createPlan_equivalent (Blind mockConstraints) = genTxOut :: Gen TxOut genTxOut = TxOut - <$> genAddressSmallRange + <$> genAddress <*> genTokenBundleMixed mockConstraints prop_createPlan_equivalent_inner diff --git a/lib/core/test/unit/Cardano/WalletSpec.hs b/lib/core/test/unit/Cardano/WalletSpec.hs index c7b0d4d285e..221ca135f50 100644 --- a/lib/core/test/unit/Cardano/WalletSpec.hs +++ b/lib/core/test/unit/Cardano/WalletSpec.hs @@ -106,7 +106,7 @@ import Cardano.Wallet.Primitive.Types import Cardano.Wallet.Primitive.Types.Address ( Address (..) ) import Cardano.Wallet.Primitive.Types.Address.Gen - ( genAddressSmallRange ) + ( genAddress ) import Cardano.Wallet.Primitive.Types.Coin ( Coin (..) ) import Cardano.Wallet.Primitive.Types.Coin.Gen @@ -1077,7 +1077,7 @@ genMigrationUTxO mockTxConstraints = do genTxOut :: Gen TxOut genTxOut = TxOut - <$> genAddressSmallRange + <$> genAddress <*> genTokenBundleMixed mockTxConstraints -- Tests that user-specified target addresses are assigned to generated outputs From f42ee991c07a598c86e12fb4339235934d49c1e9 Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Tue, 17 Aug 2021 04:24:47 +0000 Subject: [PATCH 05/13] Generate values of `Hash "Tx"` according to the size parameter. --- .../Cardano/Wallet/Primitive/Types/Tx/Gen.hs | 24 +++++++++---------- 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/lib/core/src/Cardano/Wallet/Primitive/Types/Tx/Gen.hs b/lib/core/src/Cardano/Wallet/Primitive/Types/Tx/Gen.hs index 55702a1cc23..b97148410db 100644 --- a/lib/core/src/Cardano/Wallet/Primitive/Types/Tx/Gen.hs +++ b/lib/core/src/Cardano/Wallet/Primitive/Types/Tx/Gen.hs @@ -1,12 +1,12 @@ {-# LANGUAGE DataKinds #-} module Cardano.Wallet.Primitive.Types.Tx.Gen - ( genTxHashSmallRange + ( genTxHash , genTxIndexSmallRange , genTxInSmallRange , genTxInLargeRange , genTxOutSmallRange - , shrinkTxHashSmallRange + , shrinkTxHash , shrinkTxIndexSmallRange , shrinkTxInSmallRange , shrinkTxOutSmallRange @@ -36,7 +36,7 @@ import Data.Text.Class import Data.Word ( Word32 ) import Test.QuickCheck - ( Gen, arbitrary, elements, suchThat ) + ( Gen, arbitrary, elements, sized, suchThat ) import Test.QuickCheck.Extra ( shrinkInterleaved ) @@ -45,21 +45,21 @@ import qualified Data.ByteString.Char8 as B8 import qualified Data.Text as T -------------------------------------------------------------------------------- --- Transaction hashes chosen from a small range (to allow collisions) +-- Transaction hashes generated according to the size parameter -------------------------------------------------------------------------------- -genTxHashSmallRange :: Gen (Hash "Tx") -genTxHashSmallRange = elements txHashes +genTxHash :: Gen (Hash "Tx") +genTxHash = sized $ \size -> elements $ take (max 1 size) txHashes -shrinkTxHashSmallRange :: Hash "Tx" -> [Hash "Tx"] -shrinkTxHashSmallRange x +shrinkTxHash :: Hash "Tx" -> [Hash "Tx"] +shrinkTxHash x | x == simplest = [] | otherwise = [simplest] where simplest = head txHashes txHashes :: [Hash "Tx"] -txHashes = mkTxHash <$> ['0' .. '7'] +txHashes = mkTxHash <$> ['0' .. '9'] <> ['A' .. 'F'] -------------------------------------------------------------------------------- -- Transaction hashes chosen from a large range (to minimize collisions) @@ -88,12 +88,12 @@ txIndices = [0 .. 7] genTxInSmallRange :: Gen TxIn genTxInSmallRange = TxIn - <$> genTxHashSmallRange + <$> genTxHash <*> genTxIndexSmallRange shrinkTxInSmallRange :: TxIn -> [TxIn] shrinkTxInSmallRange (TxIn h i) = uncurry TxIn <$> shrinkInterleaved - (h, shrinkTxHashSmallRange) + (h, shrinkTxHash) (i, shrinkTxIndexSmallRange) -------------------------------------------------------------------------------- @@ -128,7 +128,7 @@ tokenBundleHasNonZeroCoin b = TokenBundle.getCoin b /= Coin 0 -- Internal utilities -------------------------------------------------------------------------------- --- The input must be a character in the range [0-9] or [A-Z]. +-- The input must be a character in the range [0-9] or [A-F]. -- mkTxHash :: Char -> Hash "Tx" mkTxHash c From c8cc203ce5ad70bb9c2cd1e522a0e2cc43c231d8 Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Tue, 17 Aug 2021 04:27:22 +0000 Subject: [PATCH 06/13] Generate values of `TxIndex` according to the size parameter. --- .../Cardano/Wallet/Primitive/Types/Tx/Gen.hs | 24 +++++++++---------- 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/lib/core/src/Cardano/Wallet/Primitive/Types/Tx/Gen.hs b/lib/core/src/Cardano/Wallet/Primitive/Types/Tx/Gen.hs index b97148410db..d804f8b6260 100644 --- a/lib/core/src/Cardano/Wallet/Primitive/Types/Tx/Gen.hs +++ b/lib/core/src/Cardano/Wallet/Primitive/Types/Tx/Gen.hs @@ -2,12 +2,12 @@ module Cardano.Wallet.Primitive.Types.Tx.Gen ( genTxHash - , genTxIndexSmallRange + , genTxIndex , genTxInSmallRange , genTxInLargeRange , genTxOutSmallRange , shrinkTxHash - , shrinkTxIndexSmallRange + , shrinkTxIndex , shrinkTxInSmallRange , shrinkTxOutSmallRange ) @@ -69,18 +69,18 @@ genTxHashLargeRange :: Gen (Hash "Tx") genTxHashLargeRange = Hash . B8.pack <$> replicateM 32 arbitrary -------------------------------------------------------------------------------- --- Transaction indices chosen from a small range (to allow collisions) +-- Transaction indices generated according to the size parameter -------------------------------------------------------------------------------- -genTxIndexSmallRange :: Gen Word32 -genTxIndexSmallRange = elements txIndices +genTxIndex :: Gen Word32 +genTxIndex = sized $ \size -> elements $ take (max 1 size) txIndices -shrinkTxIndexSmallRange :: Word32 -> [Word32] -shrinkTxIndexSmallRange 0 = [] -shrinkTxIndexSmallRange _ = [0] +shrinkTxIndex :: Word32 -> [Word32] +shrinkTxIndex 0 = [] +shrinkTxIndex _ = [0] txIndices :: [Word32] -txIndices = [0 .. 7] +txIndices = [0 ..] -------------------------------------------------------------------------------- -- Transaction inputs chosen from a small range (to allow collisions) @@ -89,12 +89,12 @@ txIndices = [0 .. 7] genTxInSmallRange :: Gen TxIn genTxInSmallRange = TxIn <$> genTxHash - <*> genTxIndexSmallRange + <*> genTxIndex shrinkTxInSmallRange :: TxIn -> [TxIn] shrinkTxInSmallRange (TxIn h i) = uncurry TxIn <$> shrinkInterleaved (h, shrinkTxHash) - (i, shrinkTxIndexSmallRange) + (i, shrinkTxIndex) -------------------------------------------------------------------------------- -- Transaction inputs chosen from a large range (to minimize collisions) @@ -105,7 +105,7 @@ genTxInLargeRange = TxIn <$> genTxHashLargeRange -- Note that we don't need to choose indices from a large range, as hashes -- are already chosen from a large range: - <*> genTxIndexSmallRange + <*> genTxIndex -------------------------------------------------------------------------------- -- Transaction outputs chosen from a small range (to allow collisions) From 464312a7eeb72427e6e6a0ffd7efc0d84e29b3d1 Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Tue, 17 Aug 2021 04:31:20 +0000 Subject: [PATCH 07/13] Generate values of `TxIn` according to the size parameter. --- .../Cardano/Wallet/Primitive/Types/Tx/Gen.hs | 18 ++++++++---------- .../Wallet/Primitive/Types/UTxOIndexSpec.hs | 8 ++++---- 2 files changed, 12 insertions(+), 14 deletions(-) diff --git a/lib/core/src/Cardano/Wallet/Primitive/Types/Tx/Gen.hs b/lib/core/src/Cardano/Wallet/Primitive/Types/Tx/Gen.hs index d804f8b6260..7c1c6d31b2a 100644 --- a/lib/core/src/Cardano/Wallet/Primitive/Types/Tx/Gen.hs +++ b/lib/core/src/Cardano/Wallet/Primitive/Types/Tx/Gen.hs @@ -3,12 +3,12 @@ module Cardano.Wallet.Primitive.Types.Tx.Gen ( genTxHash , genTxIndex - , genTxInSmallRange + , genTxIn , genTxInLargeRange , genTxOutSmallRange , shrinkTxHash , shrinkTxIndex - , shrinkTxInSmallRange + , shrinkTxIn , shrinkTxOutSmallRange ) where @@ -38,7 +38,7 @@ import Data.Word import Test.QuickCheck ( Gen, arbitrary, elements, sized, suchThat ) import Test.QuickCheck.Extra - ( shrinkInterleaved ) + ( genSized2With, shrinkInterleaved ) import qualified Cardano.Wallet.Primitive.Types.TokenBundle as TokenBundle import qualified Data.ByteString.Char8 as B8 @@ -83,16 +83,14 @@ txIndices :: [Word32] txIndices = [0 ..] -------------------------------------------------------------------------------- --- Transaction inputs chosen from a small range (to allow collisions) +-- Transaction inputs generated according to the size parameter -------------------------------------------------------------------------------- -genTxInSmallRange :: Gen TxIn -genTxInSmallRange = TxIn - <$> genTxHash - <*> genTxIndex +genTxIn :: Gen TxIn +genTxIn = genSized2With TxIn genTxHash genTxIndex -shrinkTxInSmallRange :: TxIn -> [TxIn] -shrinkTxInSmallRange (TxIn h i) = uncurry TxIn <$> shrinkInterleaved +shrinkTxIn :: TxIn -> [TxIn] +shrinkTxIn (TxIn h i) = uncurry TxIn <$> shrinkInterleaved (h, shrinkTxHash) (i, shrinkTxIndex) diff --git a/lib/core/test/unit/Cardano/Wallet/Primitive/Types/UTxOIndexSpec.hs b/lib/core/test/unit/Cardano/Wallet/Primitive/Types/UTxOIndexSpec.hs index c6caa7ea46c..fc21ff6d233 100644 --- a/lib/core/test/unit/Cardano/Wallet/Primitive/Types/UTxOIndexSpec.hs +++ b/lib/core/test/unit/Cardano/Wallet/Primitive/Types/UTxOIndexSpec.hs @@ -18,9 +18,9 @@ import Cardano.Wallet.Primitive.Types.TokenMap.Gen import Cardano.Wallet.Primitive.Types.Tx ( TxIn, TxOut ) import Cardano.Wallet.Primitive.Types.Tx.Gen - ( genTxInSmallRange + ( genTxIn , genTxOutSmallRange - , shrinkTxInSmallRange + , shrinkTxIn , shrinkTxOutSmallRange ) import Cardano.Wallet.Primitive.Types.UTxO @@ -693,8 +693,8 @@ instance Arbitrary UTxOIndex where shrink = shrinkUTxOIndexSmall instance Arbitrary TxIn where - arbitrary = genTxInSmallRange - shrink = shrinkTxInSmallRange + arbitrary = genTxIn + shrink = shrinkTxIn instance Arbitrary TxOut where arbitrary = genTxOutSmallRange From 20dfa0241ab5106756b2a224ecfc2b3bb24cb5c1 Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Tue, 17 Aug 2021 04:34:13 +0000 Subject: [PATCH 08/13] Generate values of `TxOut` according to the size parameter. --- .../Cardano/Wallet/Primitive/Types/Tx/Gen.hs | 14 +++++++------- .../Wallet/Primitive/Types/UTxOIndex/Gen.hs | 17 ++++++----------- .../CoinSelection/MA/RoundRobinSpec.hs | 8 ++++---- .../Wallet/Primitive/Types/UTxOIndexSpec.hs | 10 +++------- 4 files changed, 20 insertions(+), 29 deletions(-) diff --git a/lib/core/src/Cardano/Wallet/Primitive/Types/Tx/Gen.hs b/lib/core/src/Cardano/Wallet/Primitive/Types/Tx/Gen.hs index 7c1c6d31b2a..de9cca8526b 100644 --- a/lib/core/src/Cardano/Wallet/Primitive/Types/Tx/Gen.hs +++ b/lib/core/src/Cardano/Wallet/Primitive/Types/Tx/Gen.hs @@ -5,11 +5,11 @@ module Cardano.Wallet.Primitive.Types.Tx.Gen , genTxIndex , genTxIn , genTxInLargeRange - , genTxOutSmallRange + , genTxOut , shrinkTxHash , shrinkTxIndex , shrinkTxIn - , shrinkTxOutSmallRange + , shrinkTxOut ) where @@ -106,16 +106,16 @@ genTxInLargeRange = TxIn <*> genTxIndex -------------------------------------------------------------------------------- --- Transaction outputs chosen from a small range (to allow collisions) +-- Transaction outputs generated according to the size parameter -------------------------------------------------------------------------------- -genTxOutSmallRange :: Gen TxOut -genTxOutSmallRange = TxOut +genTxOut :: Gen TxOut +genTxOut = TxOut <$> genAddress <*> genTokenBundleSmallRange `suchThat` tokenBundleHasNonZeroCoin -shrinkTxOutSmallRange :: TxOut -> [TxOut] -shrinkTxOutSmallRange (TxOut a b) = uncurry TxOut <$> shrinkInterleaved +shrinkTxOut :: TxOut -> [TxOut] +shrinkTxOut (TxOut a b) = uncurry TxOut <$> shrinkInterleaved (a, shrinkAddress) (b, filter tokenBundleHasNonZeroCoin . shrinkTokenBundleSmallRange) diff --git a/lib/core/src/Cardano/Wallet/Primitive/Types/UTxOIndex/Gen.hs b/lib/core/src/Cardano/Wallet/Primitive/Types/UTxOIndex/Gen.hs index 57dbbeb1b78..d223fd85303 100644 --- a/lib/core/src/Cardano/Wallet/Primitive/Types/UTxOIndex/Gen.hs +++ b/lib/core/src/Cardano/Wallet/Primitive/Types/UTxOIndex/Gen.hs @@ -10,12 +10,7 @@ import Prelude import Cardano.Wallet.Primitive.Types.Tx ( TxIn, TxOut ) import Cardano.Wallet.Primitive.Types.Tx.Gen - ( genTxInLargeRange - , genTxInSmallRange - , genTxOutSmallRange - , shrinkTxInSmallRange - , shrinkTxOutSmallRange - ) + ( genTxIn, genTxInLargeRange, genTxOut, shrinkTxIn, shrinkTxOut ) import Cardano.Wallet.Primitive.Types.UTxOIndex ( UTxOIndex ) import Control.Monad @@ -49,13 +44,13 @@ shrinkUTxOIndexSmall genEntrySmallRange :: Gen (TxIn, TxOut) genEntrySmallRange = (,) - <$> genTxInSmallRange - <*> genTxOutSmallRange + <$> genTxIn + <*> genTxOut shrinkEntrySmallRange :: (TxIn, TxOut) -> [(TxIn, TxOut)] shrinkEntrySmallRange (i, o) = uncurry (,) <$> shrinkInterleaved - (i, shrinkTxInSmallRange) - (o, shrinkTxOutSmallRange) + (i, shrinkTxIn) + (o, shrinkTxOut) -------------------------------------------------------------------------------- -- Large indices @@ -75,4 +70,4 @@ genEntryLargeRange = (,) <$> genTxInLargeRange -- Note that we don't need to choose outputs from a large range, as inputs -- are already chosen from a large range: - <*> genTxOutSmallRange + <*> genTxOut diff --git a/lib/core/test/unit/Cardano/Wallet/Primitive/CoinSelection/MA/RoundRobinSpec.hs b/lib/core/test/unit/Cardano/Wallet/Primitive/CoinSelection/MA/RoundRobinSpec.hs index 544fb8fa27e..7730f583a2c 100644 --- a/lib/core/test/unit/Cardano/Wallet/Primitive/CoinSelection/MA/RoundRobinSpec.hs +++ b/lib/core/test/unit/Cardano/Wallet/Primitive/CoinSelection/MA/RoundRobinSpec.hs @@ -104,7 +104,7 @@ import Cardano.Wallet.Primitive.Types.Tx , txOutMaxTokenQuantity ) import Cardano.Wallet.Primitive.Types.Tx.Gen - ( genTxOutSmallRange, shrinkTxOutSmallRange ) + ( genTxOut, shrinkTxOut ) import Cardano.Wallet.Primitive.Types.UTxOIndex ( SelectionFilter (..), UTxOIndex ) import Cardano.Wallet.Primitive.Types.UTxOIndex.Gen @@ -588,7 +588,7 @@ genSelectionCriteria genUTxOIndex = do outputCount <- max 1 <$> choose (1, UTxOIndex.size utxoAvailable `div` 8) outputsToCover <- NE.fromList <$> - replicateM outputCount genTxOutSmallRange + replicateM outputCount genTxOut selectionLimit <- frequency [ (5, pure NoLimit) , (1, pure $ MaximumInputLimit 0) @@ -3517,8 +3517,8 @@ instance Arbitrary TokenQuantity where shrink = shrinkTokenQuantityPositive instance Arbitrary TxOut where - arbitrary = genTxOutSmallRange - shrink = shrinkTxOutSmallRange + arbitrary = genTxOut + shrink = shrinkTxOut newtype Large a = Large { getLarge :: a } diff --git a/lib/core/test/unit/Cardano/Wallet/Primitive/Types/UTxOIndexSpec.hs b/lib/core/test/unit/Cardano/Wallet/Primitive/Types/UTxOIndexSpec.hs index fc21ff6d233..117e0f180ad 100644 --- a/lib/core/test/unit/Cardano/Wallet/Primitive/Types/UTxOIndexSpec.hs +++ b/lib/core/test/unit/Cardano/Wallet/Primitive/Types/UTxOIndexSpec.hs @@ -18,11 +18,7 @@ import Cardano.Wallet.Primitive.Types.TokenMap.Gen import Cardano.Wallet.Primitive.Types.Tx ( TxIn, TxOut ) import Cardano.Wallet.Primitive.Types.Tx.Gen - ( genTxIn - , genTxOutSmallRange - , shrinkTxIn - , shrinkTxOutSmallRange - ) + ( genTxIn, genTxOut, shrinkTxIn, shrinkTxOut ) import Cardano.Wallet.Primitive.Types.UTxO ( UTxO (..) ) import Cardano.Wallet.Primitive.Types.UTxOIndex.Gen @@ -697,8 +693,8 @@ instance Arbitrary TxIn where shrink = shrinkTxIn instance Arbitrary TxOut where - arbitrary = genTxOutSmallRange - shrink = shrinkTxOutSmallRange + arbitrary = genTxOut + shrink = shrinkTxOut instance Arbitrary SelectionFilter where arbitrary = genSelectionFilterSmallRange From 5852218cd325ca387b1db6cedc76f8ad645416b1 Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Mon, 16 Aug 2021 08:18:26 +0000 Subject: [PATCH 09/13] Create new module `Primitive.Types.UTxO.Gen`. This commit: - creates a new module `UTxO.Gen` which has generators and shrinkers for ordinary UTxO sets (without indices). - redefines the functions in `UTxOIndex.Gen` to reuse those in `UTxO.Gen`. We can now use the generators within `UTxO.Gen` to generate plain UTxO sets without having to generate indices (which carry more overhead). --- lib/core/cardano-wallet-core.cabal | 1 + .../Wallet/Primitive/Types/UTxO/Gen.hs | 74 +++++++++++++++++++ .../Wallet/Primitive/Types/UTxOIndex/Gen.hs | 51 ++----------- 3 files changed, 83 insertions(+), 43 deletions(-) create mode 100644 lib/core/src/Cardano/Wallet/Primitive/Types/UTxO/Gen.hs diff --git a/lib/core/cardano-wallet-core.cabal b/lib/core/cardano-wallet-core.cabal index 30fea112eec..a07744bd768 100644 --- a/lib/core/cardano-wallet-core.cabal +++ b/lib/core/cardano-wallet-core.cabal @@ -235,6 +235,7 @@ library Cardano.Wallet.Primitive.Types.TokenPolicy.Gen Cardano.Wallet.Primitive.Types.TokenQuantity.Gen Cardano.Wallet.Primitive.Types.Tx.Gen + Cardano.Wallet.Primitive.Types.UTxO.Gen Cardano.Wallet.Primitive.Types.UTxOIndex.Gen Cardano.Wallet.Gen other-modules: diff --git a/lib/core/src/Cardano/Wallet/Primitive/Types/UTxO/Gen.hs b/lib/core/src/Cardano/Wallet/Primitive/Types/UTxO/Gen.hs new file mode 100644 index 00000000000..3c62ccaf8b1 --- /dev/null +++ b/lib/core/src/Cardano/Wallet/Primitive/Types/UTxO/Gen.hs @@ -0,0 +1,74 @@ +module Cardano.Wallet.Primitive.Types.UTxO.Gen + ( genUTxOSmall + , genUTxOLarge + , genUTxOLargeN + , shrinkUTxOSmall + ) where + +import Prelude + +import Cardano.Wallet.Primitive.Types.Tx + ( TxIn, TxOut ) +import Cardano.Wallet.Primitive.Types.Tx.Gen + ( genTxIn, genTxInLargeRange, genTxOut, shrinkTxIn, shrinkTxOut ) +import Cardano.Wallet.Primitive.Types.UTxO + ( UTxO (..) ) +import Control.Monad + ( replicateM ) +import Test.QuickCheck + ( Gen, choose, frequency, shrinkList ) +import Test.QuickCheck.Extra + ( shrinkInterleaved ) + +import qualified Data.Map.Strict as Map + +-------------------------------------------------------------------------------- +-- Small UTxO sets +-------------------------------------------------------------------------------- + +genUTxOSmall :: Gen UTxO +genUTxOSmall = do + entryCount <- frequency + [ (1, pure 0) + , (1, pure 1) + , (32, choose (2, 64)) + ] + UTxO . Map.fromList <$> replicateM entryCount genEntrySmallRange + +shrinkUTxOSmall :: UTxO -> [UTxO] +shrinkUTxOSmall + = take 16 + . fmap (UTxO . Map.fromList) + . shrinkList shrinkEntrySmallRange + . Map.toList + . unUTxO + +genEntrySmallRange :: Gen (TxIn, TxOut) +genEntrySmallRange = (,) + <$> genTxIn + <*> genTxOut + +shrinkEntrySmallRange :: (TxIn, TxOut) -> [(TxIn, TxOut)] +shrinkEntrySmallRange (i, o) = uncurry (,) <$> shrinkInterleaved + (i, shrinkTxIn) + (o, shrinkTxOut) + +-------------------------------------------------------------------------------- +-- Large UTxO sets +-------------------------------------------------------------------------------- + +genUTxOLarge :: Gen UTxO +genUTxOLarge = do + entryCount <- choose (1024, 4096) + genUTxOLargeN entryCount + +genUTxOLargeN :: Int -> Gen UTxO +genUTxOLargeN entryCount = do + UTxO . Map.fromList <$> replicateM entryCount genEntryLargeRange + +genEntryLargeRange :: Gen (TxIn, TxOut) +genEntryLargeRange = (,) + <$> genTxInLargeRange + -- Note that we don't need to choose outputs from a large range, as inputs + -- are already chosen from a large range: + <*> genTxOut diff --git a/lib/core/src/Cardano/Wallet/Primitive/Types/UTxOIndex/Gen.hs b/lib/core/src/Cardano/Wallet/Primitive/Types/UTxOIndex/Gen.hs index d223fd85303..9310e4f1c7f 100644 --- a/lib/core/src/Cardano/Wallet/Primitive/Types/UTxOIndex/Gen.hs +++ b/lib/core/src/Cardano/Wallet/Primitive/Types/UTxOIndex/Gen.hs @@ -7,18 +7,12 @@ module Cardano.Wallet.Primitive.Types.UTxOIndex.Gen import Prelude -import Cardano.Wallet.Primitive.Types.Tx - ( TxIn, TxOut ) -import Cardano.Wallet.Primitive.Types.Tx.Gen - ( genTxIn, genTxInLargeRange, genTxOut, shrinkTxIn, shrinkTxOut ) +import Cardano.Wallet.Primitive.Types.UTxO.Gen + ( genUTxOLarge, genUTxOLargeN, genUTxOSmall, shrinkUTxOSmall ) import Cardano.Wallet.Primitive.Types.UTxOIndex ( UTxOIndex ) -import Control.Monad - ( replicateM ) import Test.QuickCheck - ( Gen, choose, frequency, shrinkList ) -import Test.QuickCheck.Extra - ( shrinkInterleaved ) + ( Gen ) import qualified Cardano.Wallet.Primitive.Types.UTxOIndex as UTxOIndex @@ -27,47 +21,18 @@ import qualified Cardano.Wallet.Primitive.Types.UTxOIndex as UTxOIndex -------------------------------------------------------------------------------- genUTxOIndexSmall :: Gen UTxOIndex -genUTxOIndexSmall = do - entryCount <- frequency - [ (1, pure 0) - , (1, pure 1) - , (32, choose (2, 64)) - ] - UTxOIndex.fromSequence <$> replicateM entryCount genEntrySmallRange +genUTxOIndexSmall = UTxOIndex.fromUTxO <$> genUTxOSmall shrinkUTxOIndexSmall :: UTxOIndex -> [UTxOIndex] -shrinkUTxOIndexSmall - = take 16 - . fmap UTxOIndex.fromSequence - . shrinkList shrinkEntrySmallRange - . UTxOIndex.toList - -genEntrySmallRange :: Gen (TxIn, TxOut) -genEntrySmallRange = (,) - <$> genTxIn - <*> genTxOut - -shrinkEntrySmallRange :: (TxIn, TxOut) -> [(TxIn, TxOut)] -shrinkEntrySmallRange (i, o) = uncurry (,) <$> shrinkInterleaved - (i, shrinkTxIn) - (o, shrinkTxOut) +shrinkUTxOIndexSmall = + fmap UTxOIndex.fromUTxO . shrinkUTxOSmall . UTxOIndex.toUTxO -------------------------------------------------------------------------------- -- Large indices -------------------------------------------------------------------------------- genUTxOIndexLarge :: Gen UTxOIndex -genUTxOIndexLarge = do - entryCount <- choose (1024, 4096) - genUTxOIndexLargeN entryCount +genUTxOIndexLarge = UTxOIndex.fromUTxO <$> genUTxOLarge genUTxOIndexLargeN :: Int -> Gen UTxOIndex -genUTxOIndexLargeN entryCount = do - UTxOIndex.fromSequence <$> replicateM entryCount genEntryLargeRange - -genEntryLargeRange :: Gen (TxIn, TxOut) -genEntryLargeRange = (,) - <$> genTxInLargeRange - -- Note that we don't need to choose outputs from a large range, as inputs - -- are already chosen from a large range: - <*> genTxOut +genUTxOIndexLargeN n = UTxOIndex.fromUTxO <$> genUTxOLargeN n From ac9d60062eb652a8819bbe4e222d255693c02fa1 Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Mon, 16 Aug 2021 09:12:24 +0000 Subject: [PATCH 10/13] Generate UTxO sets (and indices) according to the size parameter. --- .../Wallet/Primitive/Types/UTxO/Gen.hs | 36 ++++++++----------- .../Wallet/Primitive/Types/UTxOIndex/Gen.hs | 17 +++++---- .../CoinSelection/MA/RoundRobinSpec.hs | 16 ++++----- .../Wallet/Primitive/Types/UTxOIndexSpec.hs | 6 ++-- 4 files changed, 32 insertions(+), 43 deletions(-) diff --git a/lib/core/src/Cardano/Wallet/Primitive/Types/UTxO/Gen.hs b/lib/core/src/Cardano/Wallet/Primitive/Types/UTxO/Gen.hs index 3c62ccaf8b1..1bed7e5d871 100644 --- a/lib/core/src/Cardano/Wallet/Primitive/Types/UTxO/Gen.hs +++ b/lib/core/src/Cardano/Wallet/Primitive/Types/UTxO/Gen.hs @@ -1,8 +1,8 @@ module Cardano.Wallet.Primitive.Types.UTxO.Gen - ( genUTxOSmall + ( genUTxO , genUTxOLarge , genUTxOLargeN - , shrinkUTxOSmall + , shrinkUTxO ) where import Prelude @@ -16,40 +16,34 @@ import Cardano.Wallet.Primitive.Types.UTxO import Control.Monad ( replicateM ) import Test.QuickCheck - ( Gen, choose, frequency, shrinkList ) + ( Gen, choose, shrinkList, sized ) import Test.QuickCheck.Extra ( shrinkInterleaved ) import qualified Data.Map.Strict as Map -------------------------------------------------------------------------------- --- Small UTxO sets +-- UTxO sets generated according to the size parameter -------------------------------------------------------------------------------- -genUTxOSmall :: Gen UTxO -genUTxOSmall = do - entryCount <- frequency - [ (1, pure 0) - , (1, pure 1) - , (32, choose (2, 64)) - ] - UTxO . Map.fromList <$> replicateM entryCount genEntrySmallRange +genUTxO :: Gen UTxO +genUTxO = sized $ \size -> do + entryCount <- choose (0, size) + UTxO . Map.fromList <$> replicateM entryCount genEntry -shrinkUTxOSmall :: UTxO -> [UTxO] -shrinkUTxOSmall +shrinkUTxO :: UTxO -> [UTxO] +shrinkUTxO = take 16 . fmap (UTxO . Map.fromList) - . shrinkList shrinkEntrySmallRange + . shrinkList shrinkEntry . Map.toList . unUTxO -genEntrySmallRange :: Gen (TxIn, TxOut) -genEntrySmallRange = (,) - <$> genTxIn - <*> genTxOut +genEntry :: Gen (TxIn, TxOut) +genEntry = (,) <$> genTxIn <*> genTxOut -shrinkEntrySmallRange :: (TxIn, TxOut) -> [(TxIn, TxOut)] -shrinkEntrySmallRange (i, o) = uncurry (,) <$> shrinkInterleaved +shrinkEntry :: (TxIn, TxOut) -> [(TxIn, TxOut)] +shrinkEntry (i, o) = uncurry (,) <$> shrinkInterleaved (i, shrinkTxIn) (o, shrinkTxOut) diff --git a/lib/core/src/Cardano/Wallet/Primitive/Types/UTxOIndex/Gen.hs b/lib/core/src/Cardano/Wallet/Primitive/Types/UTxOIndex/Gen.hs index 9310e4f1c7f..f977a2cc72f 100644 --- a/lib/core/src/Cardano/Wallet/Primitive/Types/UTxOIndex/Gen.hs +++ b/lib/core/src/Cardano/Wallet/Primitive/Types/UTxOIndex/Gen.hs @@ -1,14 +1,14 @@ module Cardano.Wallet.Primitive.Types.UTxOIndex.Gen - ( genUTxOIndexSmall + ( genUTxOIndex , genUTxOIndexLarge , genUTxOIndexLargeN - , shrinkUTxOIndexSmall + , shrinkUTxOIndex ) where import Prelude import Cardano.Wallet.Primitive.Types.UTxO.Gen - ( genUTxOLarge, genUTxOLargeN, genUTxOSmall, shrinkUTxOSmall ) + ( genUTxO, genUTxOLarge, genUTxOLargeN, shrinkUTxO ) import Cardano.Wallet.Primitive.Types.UTxOIndex ( UTxOIndex ) import Test.QuickCheck @@ -17,15 +17,14 @@ import Test.QuickCheck import qualified Cardano.Wallet.Primitive.Types.UTxOIndex as UTxOIndex -------------------------------------------------------------------------------- --- Small indices +-- Indices generated according to the size parameter -------------------------------------------------------------------------------- -genUTxOIndexSmall :: Gen UTxOIndex -genUTxOIndexSmall = UTxOIndex.fromUTxO <$> genUTxOSmall +genUTxOIndex :: Gen UTxOIndex +genUTxOIndex = UTxOIndex.fromUTxO <$> genUTxO -shrinkUTxOIndexSmall :: UTxOIndex -> [UTxOIndex] -shrinkUTxOIndexSmall = - fmap UTxOIndex.fromUTxO . shrinkUTxOSmall . UTxOIndex.toUTxO +shrinkUTxOIndex :: UTxOIndex -> [UTxOIndex] +shrinkUTxOIndex = fmap UTxOIndex.fromUTxO . shrinkUTxO . UTxOIndex.toUTxO -------------------------------------------------------------------------------- -- Large indices diff --git a/lib/core/test/unit/Cardano/Wallet/Primitive/CoinSelection/MA/RoundRobinSpec.hs b/lib/core/test/unit/Cardano/Wallet/Primitive/CoinSelection/MA/RoundRobinSpec.hs index 7730f583a2c..8995051f12d 100644 --- a/lib/core/test/unit/Cardano/Wallet/Primitive/CoinSelection/MA/RoundRobinSpec.hs +++ b/lib/core/test/unit/Cardano/Wallet/Primitive/CoinSelection/MA/RoundRobinSpec.hs @@ -108,11 +108,7 @@ import Cardano.Wallet.Primitive.Types.Tx.Gen import Cardano.Wallet.Primitive.Types.UTxOIndex ( SelectionFilter (..), UTxOIndex ) import Cardano.Wallet.Primitive.Types.UTxOIndex.Gen - ( genUTxOIndexLarge - , genUTxOIndexLargeN - , genUTxOIndexSmall - , shrinkUTxOIndexSmall - ) + ( genUTxOIndex, genUTxOIndexLarge, genUTxOIndexLargeN, shrinkUTxOIndex ) import Control.Monad ( forM_, replicateM ) import Data.Bifunctor @@ -583,8 +579,8 @@ type PerformSelectionResult = Either SelectionError (SelectionResult TokenBundle) genSelectionCriteria :: Gen UTxOIndex -> Gen SelectionCriteria -genSelectionCriteria genUTxOIndex = do - utxoAvailable <- genUTxOIndex +genSelectionCriteria genUTxOIndex' = do + utxoAvailable <- genUTxOIndex' outputCount <- max 1 <$> choose (1, UTxOIndex.size utxoAvailable `div` 8) outputsToCover <- NE.fromList <$> @@ -3533,7 +3529,7 @@ instance Arbitrary (Large SelectionCriteria) where -- No shrinking instance Arbitrary (Small SelectionCriteria) where - arbitrary = Small <$> genSelectionCriteria genUTxOIndexSmall + arbitrary = Small <$> genSelectionCriteria genUTxOIndex -- No shrinking instance Arbitrary (Large UTxOIndex) where @@ -3541,8 +3537,8 @@ instance Arbitrary (Large UTxOIndex) where -- No shrinking instance Arbitrary (Small UTxOIndex) where - arbitrary = Small <$> genUTxOIndexSmall - shrink = fmap Small . shrinkUTxOIndexSmall . getSmall + arbitrary = Small <$> genUTxOIndex + shrink = fmap Small . shrinkUTxOIndex . getSmall instance Arbitrary Coin where arbitrary = genCoinPositive diff --git a/lib/core/test/unit/Cardano/Wallet/Primitive/Types/UTxOIndexSpec.hs b/lib/core/test/unit/Cardano/Wallet/Primitive/Types/UTxOIndexSpec.hs index 117e0f180ad..f44d99e4dd8 100644 --- a/lib/core/test/unit/Cardano/Wallet/Primitive/Types/UTxOIndexSpec.hs +++ b/lib/core/test/unit/Cardano/Wallet/Primitive/Types/UTxOIndexSpec.hs @@ -22,7 +22,7 @@ import Cardano.Wallet.Primitive.Types.Tx.Gen import Cardano.Wallet.Primitive.Types.UTxO ( UTxO (..) ) import Cardano.Wallet.Primitive.Types.UTxOIndex.Gen - ( genUTxOIndexSmall, shrinkUTxOIndexSmall ) + ( genUTxOIndex, shrinkUTxOIndex ) import Cardano.Wallet.Primitive.Types.UTxOIndex.Internal ( InvariantStatus (..), SelectionFilter (..), UTxOIndex, checkInvariant ) import Control.Monad.Random.Class @@ -685,8 +685,8 @@ instance Arbitrary AssetId where shrink = shrinkAssetId instance Arbitrary UTxOIndex where - arbitrary = genUTxOIndexSmall - shrink = shrinkUTxOIndexSmall + arbitrary = genUTxOIndex + shrink = shrinkUTxOIndex instance Arbitrary TxIn where arbitrary = genTxIn From df215cf42d8535a144b9f6a308701c88fc8cf498 Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Tue, 17 Aug 2021 05:42:38 +0000 Subject: [PATCH 11/13] Make adjustments to property test coverage conditions. This commit makes some small adjustments to coverage checks in light of recent changes to generators. --- .../Wallet/Primitive/CoinSelection/MA/RoundRobinSpec.hs | 4 ++-- .../test/unit/Cardano/Wallet/Primitive/Types/UTxOIndexSpec.hs | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/lib/core/test/unit/Cardano/Wallet/Primitive/CoinSelection/MA/RoundRobinSpec.hs b/lib/core/test/unit/Cardano/Wallet/Primitive/CoinSelection/MA/RoundRobinSpec.hs index 8995051f12d..c40f5a45f01 100644 --- a/lib/core/test/unit/Cardano/Wallet/Primitive/CoinSelection/MA/RoundRobinSpec.hs +++ b/lib/core/test/unit/Cardano/Wallet/Primitive/CoinSelection/MA/RoundRobinSpec.hs @@ -448,9 +448,9 @@ prop_Small_UTxOIndex_coverage (Small index) = -- Entry counts: $ cover 1 (entryCount == 0) "UTxO set size = 0 entries" - $ cover 60 (entryCount > 16) + $ cover 40 (entryCount > 16) "UTxO set size > 16 entries" - $ cover 20 (entryCount > 32) + $ cover 10 (entryCount > 32) "UTxO set size > 32 entries" True where diff --git a/lib/core/test/unit/Cardano/Wallet/Primitive/Types/UTxOIndexSpec.hs b/lib/core/test/unit/Cardano/Wallet/Primitive/Types/UTxOIndexSpec.hs index f44d99e4dd8..8316011837b 100644 --- a/lib/core/test/unit/Cardano/Wallet/Primitive/Types/UTxOIndexSpec.hs +++ b/lib/core/test/unit/Cardano/Wallet/Primitive/Types/UTxOIndexSpec.hs @@ -549,7 +549,7 @@ prop_selectRandomWithPriority u = "have match for asset 1 but not for asset 2" monitor $ cover 4 (not haveMatchForAsset1 && haveMatchForAsset2) "have match for asset 2 but not for asset 1" - monitor $ cover 4 (haveMatchForAsset1 && haveMatchForAsset2) + monitor $ cover 1 (haveMatchForAsset1 && haveMatchForAsset2) "have match for both asset 1 and asset 2" monitor $ cover 4 (not haveMatchForAsset1 && not haveMatchForAsset2) "have match for neither asset 1 nor asset 2" From a36f5eac52f048a83865b4e2ff18e8c4d0e90a8e Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Tue, 17 Aug 2021 06:32:22 +0000 Subject: [PATCH 12/13] Obey the wishes of `hlint`. --- lib/core/src/Cardano/Wallet/Primitive/Types/TokenMap/Gen.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/lib/core/src/Cardano/Wallet/Primitive/Types/TokenMap/Gen.hs b/lib/core/src/Cardano/Wallet/Primitive/Types/TokenMap/Gen.hs index 2cb8f6d1958..7b287c984d8 100644 --- a/lib/core/src/Cardano/Wallet/Primitive/Types/TokenMap/Gen.hs +++ b/lib/core/src/Cardano/Wallet/Primitive/Types/TokenMap/Gen.hs @@ -1,6 +1,5 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE TypeApplications #-} module Cardano.Wallet.Primitive.Types.TokenMap.Gen ( genAssetId From 175048952fedc287566a9c7090a296c4738a97f0 Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Tue, 17 Aug 2021 07:00:10 +0000 Subject: [PATCH 13/13] Fix test for `estimateMaxNumberOfInputs`. It's expected that these tests can fail after changes to generators. The new values are still within acceptable tolerances. --- .../test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/lib/shelley/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs b/lib/shelley/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs index 078695ad2e4..db59336f2ce 100644 --- a/lib/shelley/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs +++ b/lib/shelley/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs @@ -207,11 +207,11 @@ spec = do -- not the distribution of generated token bundles has changed. -- estimateMaxInputsTests @ShelleyKey - [(1,114),(5,107),(10,101),(20,87),(50,36)] + [(1,114),(5,109),(10,103),(20,91),(50,51)] estimateMaxInputsTests @ByronKey - [(1,73),(5,68),(10,64),(20,53),(50,17)] + [(1,73),(5,69),(10,65),(20,56),(50,27)] estimateMaxInputsTests @IcarusKey - [(1,73),(5,68),(10,64),(20,53),(50,17)] + [(1,73),(5,69),(10,65),(20,56),(50,27)] describe "fee calculations" $ do let pp :: ProtocolParameters