Extract out parameters for runSelection into record type.

cardano-foundation · Sep 13, 2021 · 644804c · 644804c
1 parent 418ea3c
commit 644804c
Show file tree

Hide file tree

Showing 2 changed files with 67 additions and 24 deletions.
diff --git 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
@@ -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