Merge #2829

2829: Rewrite generators to use the QC size parameter r=jonathanknowles a=jonathanknowles

### Issue Number

Follow-up from #2768
Supports work for #2819 

### Comments

This PR adjusts generators for the following types to use the QC size parameter:
- `Address`
- `Hash "Tx"`
- `TxIndex` (`Word32`)
- `TxIn`
- `TxOut`
- `UTxO`
- `UTxOIndex`

Some minor adjustments to coverage conditions were necessary (but surprisingly few).

This PR also:
- Adds the module `UTxO.Gen`, so that we can generate values of `UTxO` without having to generate indices (which add extra overhead), and redefines the `UTxOIndex` generators in terms of these generators.
- Adds the functions `genSized2` and `genSized2With`, which restore size linearity to generators of compound values (those defined in terms of other generators).

Co-authored-by: Jonathan Knowles <[email protected]>

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:

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

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

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.

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)

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

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
@@ -43,13 +42,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 +56,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

lib/core/src/Cardano/Wallet/Primitive/Types/Tx/Gen.hs

@@ -1,22 +1,22 @@
 {-# LANGUAGE DataKinds #-}
 
 module Cardano.Wallet.Primitive.Types.Tx.Gen
-    ( genTxHashSmallRange
-    , genTxIndexSmallRange
-    , genTxInSmallRange
+    ( genTxHash
+    , genTxIndex
+    , genTxIn
     , genTxInLargeRange
-    , genTxOutSmallRange
-    , shrinkTxHashSmallRange
-    , shrinkTxIndexSmallRange
-    , shrinkTxInSmallRange
-    , shrinkTxOutSmallRange
+    , genTxOut
+    , shrinkTxHash
+    , shrinkTxIndex
+    , shrinkTxIn
+    , shrinkTxOut
     )
     where
 
 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
@@ -36,30 +36,30 @@ 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 )
+    ( genSized2With, shrinkInterleaved )
 
 import qualified Cardano.Wallet.Primitive.Types.TokenBundle as TokenBundle
 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)
@@ -69,32 +69,30 @@ 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)
+-- Transaction inputs generated according to the size parameter
 --------------------------------------------------------------------------------
 
-genTxInSmallRange :: Gen TxIn
-genTxInSmallRange = TxIn
-    <$> genTxHashSmallRange
-    <*> genTxIndexSmallRange
+genTxIn :: Gen TxIn
+genTxIn = genSized2With TxIn genTxHash genTxIndex
 
-shrinkTxInSmallRange :: TxIn -> [TxIn]
-shrinkTxInSmallRange (TxIn h i) = uncurry TxIn <$> shrinkInterleaved
-    (h, shrinkTxHashSmallRange)
-    (i, shrinkTxIndexSmallRange)
+shrinkTxIn :: TxIn -> [TxIn]
+shrinkTxIn (TxIn h i) = uncurry TxIn <$> shrinkInterleaved
+    (h, shrinkTxHash)
+    (i, shrinkTxIndex)
 
 --------------------------------------------------------------------------------
 -- Transaction inputs chosen from a large range (to minimize collisions)
@@ -105,20 +103,20 @@ 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)
+-- Transaction outputs generated according to the size parameter
 --------------------------------------------------------------------------------
 
-genTxOutSmallRange :: Gen TxOut
-genTxOutSmallRange = TxOut
-    <$> genAddressSmallRange
+genTxOut :: Gen TxOut
+genTxOut = TxOut
+    <$> genAddress
     <*> genTokenBundleSmallRange `suchThat` tokenBundleHasNonZeroCoin
 
-shrinkTxOutSmallRange :: TxOut -> [TxOut]
-shrinkTxOutSmallRange (TxOut a b) = uncurry TxOut <$> shrinkInterleaved
-    (a, shrinkAddressSmallRange)
+shrinkTxOut :: TxOut -> [TxOut]
+shrinkTxOut (TxOut a b) = uncurry TxOut <$> shrinkInterleaved
+    (a, shrinkAddress)
     (b, filter tokenBundleHasNonZeroCoin . shrinkTokenBundleSmallRange)
 
 tokenBundleHasNonZeroCoin :: TokenBundle -> Bool
@@ -128,7 +126,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

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.

lib/core/src/Cardano/Wallet/Primitive/Types/UTxO/Gen.hs

@@ -0,0 +1,68 @@
+module Cardano.Wallet.Primitive.Types.UTxO.Gen
+    ( genUTxO
+    , genUTxOLarge
+    , genUTxOLargeN
+    , shrinkUTxO
+    ) 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, shrinkList, sized )
+import Test.QuickCheck.Extra
+    ( shrinkInterleaved )
+
+import qualified Data.Map.Strict as Map
+
+--------------------------------------------------------------------------------
+-- UTxO sets generated according to the size parameter
+--------------------------------------------------------------------------------
+
+genUTxO :: Gen UTxO
+genUTxO = sized $ \size -> do
+    entryCount <- choose (0, size)
+    UTxO . Map.fromList <$> replicateM entryCount genEntry
+
+shrinkUTxO :: UTxO -> [UTxO]
+shrinkUTxO
+    = take 16
+    . fmap (UTxO . Map.fromList)
+    . shrinkList shrinkEntry
+    . Map.toList
+    . unUTxO
+
+genEntry :: Gen (TxIn, TxOut)
+genEntry = (,) <$> genTxIn <*> genTxOut
+
+shrinkEntry :: (TxIn, TxOut) -> [(TxIn, TxOut)]
+shrinkEntry (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