Change utxoAvailable to type UTxOSelection in SelectionParams.

This commit allows callers of `CoinSelection.performSelection` to
specify an initial selection of UTxO entries as a subset of the total
UTxO available.

While existing tests all still pass, further work will be required to
verify that `performSelection` behaves as expected if the initial UTxO
selection is non-empty.

lib/core/src/Cardano/Wallet.hs

@@ -520,6 +520,7 @@ import qualified Cardano.Wallet.Primitive.Types.Coin as Coin
 import qualified Cardano.Wallet.Primitive.Types.TokenBundle as TokenBundle
 import qualified Cardano.Wallet.Primitive.Types.TokenMap as TokenMap
 import qualified Cardano.Wallet.Primitive.Types.UTxOIndex as UTxOIndex
+import qualified Cardano.Wallet.Primitive.Types.UTxOSelection as UTxOSelection
 import qualified Data.ByteArray as BA
 import qualified Data.Foldable as F
 import qualified Data.List as L
@@ -1458,7 +1459,7 @@ selectAssets ctx (utxoAvailable, cp, pending) txCtx outputs transform = do
                 case view #txDelegationAction txCtx of
                     Just (RegisterKeyAndJoin _) -> 1
                     _ -> 0
-            , utxoAvailable
+            , utxoAvailable = UTxOSelection.fromIndex utxoAvailable
             }
     case mSel of
         Left e -> liftIO $

lib/core/src/Cardano/Wallet/Primitive/CoinSelection.hs

@@ -68,8 +68,8 @@ import Cardano.Wallet.Primitive.Types.Tx
     , TxOut
     , txOutMaxTokenQuantity
     )
-import Cardano.Wallet.Primitive.Types.UTxOIndex
-    ( UTxOIndex )
+import Cardano.Wallet.Primitive.Types.UTxOSelection
+    ( UTxOSelection )
 import Control.Monad.Random.Class
     ( MonadRandom )
 import Control.Monad.Trans.Except
@@ -271,10 +271,12 @@ data SelectionParams = SelectionParams
         :: !Natural
         -- ^ Number of deposits from stake key de-registrations.
     , utxoAvailable
-        :: !UTxOIndex
-        -- ^ Specifies the set of all available UTxO entries. The algorithm
-        -- will choose entries from this set when selecting ordinary inputs
-        -- and collateral inputs.
+        :: !UTxOSelection
+        -- ^ Specifies a set of UTxOs that are available for selection as
+        -- ordinary inputs and optionally, a subset that has already been
+        -- selected.
+        --
+        -- Further entries from this set will be selected to cover any deficit.
     }
     deriving (Eq, Generic, Show)
 

lib/core/src/Cardano/Wallet/Primitive/CoinSelection/Balance.hs

@@ -232,8 +232,11 @@ data SelectionParamsOf outputs = SelectionParams
         :: !outputs
         -- ^ The complete set of outputs to be covered.
     , utxoAvailable
-        :: !UTxOIndex
-        -- ^ A UTxO set from which inputs can be selected.
+        :: !UTxOSelection
+        -- ^ Specifies a set of UTxOs that are available for selection as
+        -- inputs and optionally, a subset that has already been selected.
+        --
+        -- Further entries from this set will be selected to cover any deficit.
     , extraCoinSource
         :: !Coin
         -- ^ An extra source of ada.
@@ -289,7 +292,8 @@ data UTxOBalanceSufficiencyInfo = UTxOBalanceSufficiencyInfo
 computeUTxOBalanceAvailable
     :: SelectionParamsOf (f TxOut)
     -> TokenBundle
-computeUTxOBalanceAvailable = UTxOIndex.balance . view #utxoAvailable
+computeUTxOBalanceAvailable =
+    UTxOSelection.availableBalance . view #utxoAvailable
 
 -- | Computes the balance of UTxO entries required to be selected.
 --
@@ -1050,7 +1054,7 @@ performSelectionNonEmpty constraints params
 data RunSelectionParams = RunSelectionParams
     { selectionLimit :: SelectionLimit
         -- ^ A limit to adhere to when performing a selection.
-    , utxoAvailable :: UTxOIndex
+    , utxoAvailable :: UTxOSelection
         -- ^ UTxO entries available for selection.
     , minimumBalance :: TokenBundle
         -- ^ Minimum balance to cover.
@@ -1076,17 +1080,14 @@ runSelectionNonEmptyWith selectSingleEntry result =
 runSelection
     :: forall m. MonadRandom m => RunSelectionParams -> m UTxOSelection
 runSelection params =
-    runRoundRobinM initialState UTxOSelection.fromNonEmpty selectors
+    runRoundRobinM utxoAvailable UTxOSelection.fromNonEmpty selectors
   where
     RunSelectionParams
         { selectionLimit
         , utxoAvailable
         , minimumBalance
         } = params
 
-    initialState :: UTxOSelection
-    initialState = UTxOSelection.fromIndex utxoAvailable
-
     -- NOTE: We run the 'coinSelector' last, because we know that every input
     -- necessarily has a non-zero ada amount. By running the other selectors
     -- first, we increase the probability that the coin selector will be able

lib/core/test/unit/Cardano/Wallet/Primitive/CoinSelection/BalanceSpec.hs

@@ -620,7 +620,7 @@ genSelectionParams genUTxOIndex' = do
     (assetsToMint, assetsToBurn) <- genAssetsToMintAndBurn utxoAvailable
     pure $ SelectionParams
         { outputsToCover
-        , utxoAvailable
+        , utxoAvailable = UTxOSelection.fromIndex utxoAvailable
         , extraCoinSource
         , extraCoinSink
         , assetsToMint
@@ -642,7 +642,7 @@ shrinkSelectionParams :: SelectionParams -> [SelectionParams]
 shrinkSelectionParams =
     shrinkMapBy tupleToParams paramsToTuple $ liftShrink6
         (shrinkList shrinkTxOut)
-        (shrinkUTxOIndex)
+        (shrinkUTxOSelection)
         (shrinkCoin)
         (shrinkCoin)
         (shrinkTokenMap)
@@ -741,8 +741,8 @@ prop_performSelection_small mockConstraints (Blind (Small params)) =
   where
     utxoHasAtLeastOneAsset = not
         . Set.null
-        . UTxOIndex.assets
-        $ view #utxoAvailable params
+        . TokenBundle.getAssets
+        $ computeUTxOBalanceAvailable params
 
     outputsHaveAtLeastOneAsset =
         not . Set.null $ TokenBundle.getAssets outputTokens
@@ -847,7 +847,8 @@ prop_performSelection_huge_inner utxoAvailable mockConstraints (Large params) =
     withMaxSuccess 5 $
     prop_performSelection mockConstraints (Blind params') (const id)
   where
-    params' = params & set #utxoAvailable utxoAvailable
+    params' = params & set #utxoAvailable
+        (UTxOSelection.fromIndex utxoAvailable)
 
 prop_performSelection
     :: MockSelectionConstraints
@@ -877,7 +878,6 @@ prop_performSelection mockConstraints (Blind params) coverage =
 
     SelectionParams
         { outputsToCover
-        , utxoAvailable
         , extraCoinSource
         , extraCoinSink
         , assetsToMint
@@ -908,8 +908,8 @@ prop_performSelection mockConstraints (Blind params) coverage =
             "selectionHasValidSurplus constraints result"
             (selectionHasValidSurplus constraints result)
         assertOnSuccess
-            "utxoSelected `UTxO.isSubsetOf` UTxOIndex.toUTxO utxoAvailable"
-            (utxoSelected `UTxO.isSubsetOf` UTxOIndex.toUTxO utxoAvailable)
+            "utxoSelectedIsSubsetOfAvailable"
+            (utxoSelectedIsSubsetOfAvailable)
         assertOnSuccess
             "view #outputsCovered result == view #outputsToCover params"
             (view #outputsCovered result == view #outputsToCover params)
@@ -934,11 +934,15 @@ prop_performSelection mockConstraints (Blind params) coverage =
                 assert True
       where
         assertOnSuccess = assertWith . (<>) "onSuccess: "
-        utxoSelected :: UTxO
-        utxoSelected = UTxO
-            $ Map.fromList
-            $ F.toList
-            $ view #inputsSelected result
+
+        utxoSelectedIsSubsetOfAvailable :: Bool
+        utxoSelectedIsSubsetOfAvailable =
+            selected `UTxO.isSubsetOf` available
+          where
+            available = UTxOSelection.availableUTxO $
+                view #utxoAvailable params
+            selected = UTxO $ Map.fromList $ F.toList $
+                view #inputsSelected result
 
     onFailure = \case
         BalanceInsufficient e ->
@@ -1043,8 +1047,8 @@ prop_performSelection mockConstraints (Blind params) coverage =
             assertWith . (<>) "onUnableToConstructChange: "
 
     onEmptyUTxO = assertWith
-        "utxoAvailable == UTxOIndex.empty"
-        (utxoAvailable == UTxOIndex.empty)
+        "view #utxoAvailable params == UTxOSelection.empty"
+        (view #utxoAvailable params == UTxOSelection.empty)
 
     selectionLimit = view #computeSelectionLimit constraints $
         F.toList outputsToCover
@@ -1210,7 +1214,7 @@ prop_runSelection_UTxO_empty balanceRequested = monadicIO $ do
     result <- run $ runSelection
         RunSelectionParams
             { selectionLimit = NoLimit
-            , utxoAvailable = UTxOIndex.empty
+            , utxoAvailable = UTxOSelection.fromIndex UTxOIndex.empty
             , minimumBalance = balanceRequested
             }
     let balanceSelected = UTxOSelection.selectedBalance result
@@ -1229,7 +1233,7 @@ prop_runSelection_UTxO_notEnough (Small index) = monadicIO $ do
     result <- run $ runSelection
         RunSelectionParams
             { selectionLimit = NoLimit
-            , utxoAvailable = index
+            , utxoAvailable = UTxOSelection.fromIndex index
             , minimumBalance = balanceRequested
             }
     let balanceSelected = UTxOSelection.selectedBalance result
@@ -1251,7 +1255,7 @@ prop_runSelection_UTxO_exactlyEnough (Small index) = monadicIO $ do
     result <- run $ runSelection
         RunSelectionParams
             { selectionLimit = NoLimit
-            , utxoAvailable = index
+            , utxoAvailable = UTxOSelection.fromIndex index
             , minimumBalance = balanceRequested
             }
     let balanceSelected = UTxOSelection.selectedBalance result
@@ -1277,7 +1281,7 @@ prop_runSelection_UTxO_moreThanEnough (Small index) = monadicIO $ do
     result <- run $ runSelection
         RunSelectionParams
             { selectionLimit = NoLimit
-            , utxoAvailable = index
+            , utxoAvailable = UTxOSelection.fromIndex index
             , minimumBalance = balanceRequested
             }
     let balanceSelected = UTxOSelection.selectedBalance result
@@ -1321,7 +1325,7 @@ prop_runSelection_UTxO_muchMoreThanEnough (Blind (Large index)) =
         result <- run $ runSelection
             RunSelectionParams
                 { selectionLimit = NoLimit
-                , utxoAvailable = index
+                , utxoAvailable = UTxOSelection.fromIndex index
                 , minimumBalance = balanceRequested
                 }
         let balanceSelected = UTxOSelection.selectedBalance result
@@ -1646,8 +1650,11 @@ encodeBoundaryTestCriteria c = SelectionParams
         zipWith TxOut
             (dummyAddresses)
             (uncurry TokenBundle.fromFlatList <$> boundaryTestOutputs c)
-    , utxoAvailable = UTxOIndex.fromSequence $ zip dummyTxIns $
-        zipWith TxOut
+    , utxoAvailable =
+        UTxOSelection.fromIndex
+        $ UTxOIndex.fromSequence
+        $ zip dummyTxIns
+        $ zipWith TxOut
             (dummyAddresses)
             (uncurry TokenBundle.fromFlatList <$> boundaryTestUTxO c)
     , extraCoinSource =