From 959242d91c746848ad310327461080a98f100ad3 Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Mon, 16 Aug 2021 09:12:24 +0000 Subject: [PATCH] Generate UTxO sets (and indices) according to the size parameter. This commit necessitates a few small adjustments to coverage conditions. --- .../Wallet/Primitive/Types/UTxO/Gen.hs | 18 +++++----- .../Wallet/Primitive/Types/UTxOIndex/Gen.hs | 17 +++++---- .../CoinSelection/MA/RoundRobinSpec.hs | 17 ++++----- .../Wallet/Primitive/Types/UTxOIndexSpec.hs | 35 ++++++++++--------- 4 files changed, 43 insertions(+), 44 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 df4ddea6140..85fda99af70 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 @@ -21,27 +21,27 @@ import Cardano.Wallet.Primitive.Types.UTxO import Control.Monad ( replicateM ) import Test.QuickCheck - ( Gen, choose, frequency, shrinkList ) + ( Gen, choose, frequency, 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 +genUTxO :: Gen UTxO +genUTxO = sized $ \size -> do entryCount <- frequency [ (1, pure 0) , (1, pure 1) - , (32, choose (2, 64)) + , (32, choose (2, (max 2 size))) ] UTxO . Map.fromList <$> replicateM entryCount genEntrySmallRange -shrinkUTxOSmall :: UTxO -> [UTxO] -shrinkUTxOSmall +shrinkUTxO :: UTxO -> [UTxO] +shrinkUTxO = take 16 . fmap (UTxO . Map.fromList) . shrinkList shrinkEntrySmallRange 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 544fb8fa27e..2b8a29a841a 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 @@ -177,6 +173,7 @@ import Test.QuickCheck , label , oneof , property + , scale , shrinkList , sublistOf , suchThat @@ -583,8 +580,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 +3530,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 +3538,8 @@ instance Arbitrary (Large UTxOIndex) where -- No shrinking instance Arbitrary (Small UTxOIndex) where - arbitrary = Small <$> genUTxOIndexSmall - shrink = fmap Small . shrinkUTxOIndexSmall . getSmall + arbitrary = Small <$> (scale (* 2) 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 c963ca50676..d8bc2a69356 100644 --- a/lib/core/test/unit/Cardano/Wallet/Primitive/Types/UTxOIndexSpec.hs +++ b/lib/core/test/unit/Cardano/Wallet/Primitive/Types/UTxOIndexSpec.hs @@ -26,7 +26,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 @@ -58,8 +58,10 @@ import Test.QuickCheck , counterexample , cover , forAll + , forAllBlind , oneof , property + , resize , stdConfidence , suchThat , withMaxSuccess @@ -231,9 +233,9 @@ prop_toList_fromSequence u = prop_delete_balance :: TxIn -> UTxOIndex -> Property prop_delete_balance i u = checkCoverage $ - cover 30 (UTxOIndex.member i u) + cover 20 (UTxOIndex.member i u) "input is a member of the index" $ - cover 30 (not $ UTxOIndex.member i u) + cover 20 (not $ UTxOIndex.member i u) "input is not a member of the index" $ UTxOIndex.balance (UTxOIndex.delete i u) === expected where @@ -250,9 +252,9 @@ prop_delete_lookup i u = prop_delete_size :: TxIn -> UTxOIndex -> Property prop_delete_size i u = checkCoverage $ - cover 30 (UTxOIndex.member i u) + cover 20 (UTxOIndex.member i u) "input is a member of the index" $ - cover 30 (not $ UTxOIndex.member i u) + cover 20 (not $ UTxOIndex.member i u) "input is not a member of the index" $ UTxOIndex.size (UTxOIndex.delete i u) === expected where @@ -272,9 +274,9 @@ prop_insert_assets i o u = prop_insert_balance :: TxIn -> TxOut -> UTxOIndex -> Property prop_insert_balance i o u = checkCoverage $ - cover 30 (UTxOIndex.member i u) + cover 20 (UTxOIndex.member i u) "input is already a member of the index" $ - cover 30 (not $ UTxOIndex.member i u) + cover 20 (not $ UTxOIndex.member i u) "input is not already a member of the index" $ UTxOIndex.balance (UTxOIndex.insert i o u) === expected where @@ -287,9 +289,9 @@ prop_insert_balance i o u = prop_insert_delete :: TxIn -> TxOut -> UTxOIndex -> Property prop_insert_delete i o u = checkCoverage $ - cover 30 (UTxOIndex.member i u) + cover 20 (UTxOIndex.member i u) "input is already a member of the index" $ - cover 30 (not $ UTxOIndex.member i u) + cover 20 (not $ UTxOIndex.member i u) "input is not already a member of the index" $ UTxOIndex.delete i (UTxOIndex.insert i o u) === expected where @@ -303,9 +305,9 @@ prop_insert_lookup i o u = prop_insert_size :: TxIn -> TxOut -> UTxOIndex -> Property prop_insert_size i o u = checkCoverage $ - cover 30 (UTxOIndex.member i u) + cover 20 (UTxOIndex.member i u) "input is already a member of the index" $ - cover 30 (not $ UTxOIndex.member i u) + cover 20 (not $ UTxOIndex.member i u) "input is not already a member of the index" $ UTxOIndex.size (UTxOIndex.insert i o u) === expected where @@ -540,8 +542,9 @@ prop_selectRandom_all_withAssetOnly u a = checkCoverage $ monadicIO $ do -- | Verify that priority order is respected when selecting with more than -- one filter. -- -prop_selectRandomWithPriority :: UTxOIndex -> Property -prop_selectRandomWithPriority u = +prop_selectRandomWithPriority :: Property +prop_selectRandomWithPriority = + forAllBlind (resize 64 genUTxOIndex) $ \u -> forAll (genAssetId) $ \a1 -> forAll (genAssetId `suchThat` (/= a1)) $ \a2 -> checkCoverage $ monadicIO $ do @@ -553,7 +556,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" @@ -689,8 +692,8 @@ instance Arbitrary AssetId where shrink = shrinkAssetId instance Arbitrary UTxOIndex where - arbitrary = genUTxOIndexSmall - shrink = shrinkUTxOIndexSmall + arbitrary = genUTxOIndex + shrink = shrinkUTxOIndex instance Arbitrary TxIn where arbitrary = genTxInSmallRange