From 644804cc729103f542475c8ac557ac4061008f98 Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Sun, 12 Sep 2021 00:35:59 +0000 Subject: [PATCH] Extract out parameters for `runSelection` into record type. --- .../Wallet/Primitive/CoinSelection/Balance.hs | 44 +++++++++++------ .../Primitive/CoinSelection/BalanceSpec.hs | 47 +++++++++++++++---- 2 files changed, 67 insertions(+), 24 deletions(-) diff --git a/lib/core/src/Cardano/Wallet/Primitive/CoinSelection/Balance.hs b/lib/core/src/Cardano/Wallet/Primitive/CoinSelection/Balance.hs index 4589f978563..fb0394c78c9 100644 --- a/lib/core/src/Cardano/Wallet/Primitive/CoinSelection/Balance.hs +++ b/lib/core/src/Cardano/Wallet/Primitive/CoinSelection/Balance.hs @@ -54,6 +54,7 @@ module Cardano.Wallet.Primitive.CoinSelection.Balance -- * Running a selection (without making change) , runSelection + , RunSelectionParams (..) , SelectionState (..) -- * Running a selection step @@ -510,8 +511,12 @@ performSelection minCoinFor costFor bundleSizeAssessor criteria NE.fromList insufficientMinCoinValues | otherwise = do - state <- runSelection - selectionLimit extraCoinSource utxoAvailable balanceRequired + state <- runSelection RunSelectionParams + { selectionLimit + , extraCoinSource + , utxoAvailable + , minimumBalance = balanceRequired + } let balanceSelected = fullBalance (selected state) extraCoinSource if balanceRequired `leq` balanceSelected then makeChangeRepeatedly state @@ -867,26 +872,37 @@ data SelectionState = SelectionState } deriving (Eq, Generic, Show) -runSelection - :: forall m. MonadRandom m - => SelectionLimit +-- | Parameters for 'runSelection'. +-- +data RunSelectionParams = RunSelectionParams + { selectionLimit :: SelectionLimit -- ^ A limit to adhere to when performing a selection. - -> Maybe Coin + , extraCoinSource :: Maybe Coin -- ^ An extra source of ada, which can only be used after at least one -- input has been selected. - -> UTxOIndex + , utxoAvailable :: UTxOIndex -- ^ UTxO entries available for selection. - -> TokenBundle + , minimumBalance :: TokenBundle -- ^ Minimum balance to cover. - -> m SelectionState - -- ^ Final selection state. -runSelection limit mExtraCoinSource available minimumBalance = + } + deriving (Eq, Generic, Show) + +runSelection + :: forall m. MonadRandom m => RunSelectionParams -> m SelectionState +runSelection params = runRoundRobinM initialState selectors where + RunSelectionParams + { selectionLimit + , extraCoinSource + , utxoAvailable + , minimumBalance + } = params + initialState :: SelectionState initialState = SelectionState { selected = UTxOIndex.empty - , leftover = available + , leftover = utxoAvailable } -- NOTE: We run the 'coinSelector' last, because we know that every input @@ -898,9 +914,9 @@ runSelection limit mExtraCoinSource available minimumBalance = reverse (coinSelector : fmap assetSelector minimumAssetQuantities) where assetSelector = runSelectionStep . - assetSelectionLens limit + assetSelectionLens selectionLimit coinSelector = runSelectionStep $ - coinSelectionLens limit mExtraCoinSource minimumCoinQuantity + coinSelectionLens selectionLimit extraCoinSource minimumCoinQuantity (minimumCoinQuantity, minimumAssetQuantities) = TokenBundle.toFlatList minimumBalance diff --git a/lib/core/test/unit/Cardano/Wallet/Primitive/CoinSelection/BalanceSpec.hs b/lib/core/test/unit/Cardano/Wallet/Primitive/CoinSelection/BalanceSpec.hs index feb35c36476..20bd0d44e60 100644 --- a/lib/core/test/unit/Cardano/Wallet/Primitive/CoinSelection/BalanceSpec.hs +++ b/lib/core/test/unit/Cardano/Wallet/Primitive/CoinSelection/BalanceSpec.hs @@ -28,6 +28,7 @@ import Cardano.Wallet.Primitive.CoinSelection.Balance , InsufficientMinCoinValueError (..) , MakeChangeCriteria (..) , OutputsInsufficientError (..) + , RunSelectionParams (..) , SelectionCriteria (..) , SelectionError (..) , SelectionInsufficientError (..) @@ -129,7 +130,7 @@ import Data.Function import Data.Functor.Identity ( Identity (..) ) import Data.Generics.Internal.VL.Lens - ( view ) + ( set, view ) import Data.Generics.Labels () import Data.List.NonEmpty @@ -264,7 +265,8 @@ spec = describe "Cardano.Wallet.Primitive.CoinSelection.BalanceSpec" $ utxoAvailable <- generate (genUTxOIndexLargeN 50000) pure $ property $ \minCoin costFor (Large criteria) -> let - criteria' = Blind $ criteria { utxoAvailable } + criteria' = Blind $ + set #utxoAvailable utxoAvailable criteria in prop_performSelection minCoin costFor criteria' (const id) & withMaxSuccess 5 @@ -763,7 +765,7 @@ prop_performSelection_small minCoinValueFor costFor (Blind (Small criteria)) = utxoHasAtLeastOneAsset = not . Set.null . UTxOIndex.assets - $ utxoAvailable criteria + $ view #utxoAvailable criteria outputsHaveAtLeastOneAsset = not . Set.null $ TokenBundle.getAssets outputTokens @@ -779,7 +781,7 @@ prop_performSelection_small minCoinValueFor costFor (Blind (Small criteria)) = _ -> False selectionLimited :: Bool - selectionLimited = case selectionLimit criteria of + selectionLimited = case view #selectionLimit criteria of MaximumInputLimit _ -> True NoLimit -> False @@ -1080,7 +1082,7 @@ prop_performSelection minCoinValueFor costFor (Blind criteria) coverage = assertOnUnableToConstructChange "shortfall e > Coin 0" (shortfall e > Coin 0) - let criteria' = criteria { selectionLimit = NoLimit } + let criteria' = set #selectionLimit NoLimit criteria let assessBundleSize = mkBundleSizeAssessor NoBundleSizeLimit let performSelection' = performSelection @@ -1150,7 +1152,12 @@ prop_runSelection_UTxO_empty -> Property prop_runSelection_UTxO_empty extraSource balanceRequested = monadicIO $ do SelectionState {selected, leftover} <- - run $ runSelection NoLimit extraSource UTxOIndex.empty balanceRequested + run $ runSelection RunSelectionParams + { selectionLimit = NoLimit + , extraCoinSource = extraSource + , utxoAvailable = UTxOIndex.empty + , minimumBalance = balanceRequested + } let balanceSelected = view #balance selected let balanceLeftover = view #balance leftover assertWith @@ -1165,7 +1172,12 @@ prop_runSelection_UTxO_notEnough -> Property prop_runSelection_UTxO_notEnough (Small index) = monadicIO $ do SelectionState {selected, leftover} <- - run $ runSelection NoLimit Nothing index balanceRequested + run $ runSelection RunSelectionParams + { selectionLimit = NoLimit + , extraCoinSource = Nothing + , utxoAvailable = index + , minimumBalance = balanceRequested + } let balanceSelected = view #balance selected let balanceLeftover = view #balance leftover assertWith @@ -1184,7 +1196,12 @@ prop_runSelection_UTxO_exactlyEnough -> Property prop_runSelection_UTxO_exactlyEnough extraSource (Small index) = monadicIO $ do SelectionState {selected, leftover} <- - run $ runSelection NoLimit Nothing index balanceRequested + run $ runSelection RunSelectionParams + { selectionLimit = NoLimit + , extraCoinSource = Nothing + , utxoAvailable = index + , minimumBalance = balanceRequested + } let balanceSelected = view #balance selected let balanceLeftover = view #balance leftover assertWith @@ -1209,7 +1226,12 @@ prop_runSelection_UTxO_moreThanEnough -> Property prop_runSelection_UTxO_moreThanEnough extraSource (Small index) = monadicIO $ do SelectionState {selected, leftover} <- - run $ runSelection NoLimit extraSource index balanceRequested + run $ runSelection RunSelectionParams + { selectionLimit = NoLimit + , extraCoinSource = extraSource + , utxoAvailable = index + , minimumBalance = balanceRequested + } let balanceSelected = view #balance selected let balanceLeftover = view #balance leftover monitor $ cover 80 @@ -1250,7 +1272,12 @@ prop_runSelection_UTxO_muchMoreThanEnough extraSource (Blind (Large index)) = checkCoverage $ monadicIO $ do SelectionState {selected, leftover} <- - run $ runSelection NoLimit extraSource index balanceRequested + run $ runSelection RunSelectionParams + { selectionLimit = NoLimit + , extraCoinSource = extraSource + , utxoAvailable = index + , minimumBalance = balanceRequested + } let balanceSelected = view #balance selected let balanceLeftover = view #balance leftover monitor $ cover 80