Merge #3116

3116: Make wallet responsible for determining collateral suitability r=jonathanknowles a=jonathanknowles

## Issue Number

ADP-1411

## Background

The coin selection library is currently responsible for filtering the available UTxO set for entries that are suitable for use as collateral. However, this responsibility is actually delegated back to the wallet, as the **_wallet_** must provide a definition of the following function:
```hs
utxoSuitableForCollateral
    :: (TxIn, TxOut) -> Maybe Coin
    -- ^ Indicates whether an individual UTxO entry is suitable for use as
    -- a collateral input. This function should return a 'Coin' value if
    -- (and only if) the given UTxO is suitable for use as collateral.
```
The coin selection library merely **_applies_** this function as a **_filter_** on the set of available UTxO entries.

## Why this is a problem

The requirement to provide the `utxoSuitableForCollateral` function means that the coin selection library must depend on the `TxOut` type (as collateral suitability is a function of `Address`). Our goal is to evolve the coin selection library so that it does not depend on wallet-specific types like `TxOut`, `Address`, and `UTxO`.

## Changes made by this PR

This PR:

- [x] Removes the `utxoSuitableForCollateral` function from `SelectionConstraints`.
- [x] Makes the wallet fully responsible for identifying which UTxO entries are suitable for collateral, by requiring it to pre-filter the `utxoAvailableForCollateral` set.
- [x] Changes the type of `SelectionParams.utxoAvailableForCollateral` from `UTxO` to Map `TxIn Coin`, as collateral entries can never have non-ada assets.
- [x] Changes the type of `Selection.collateral` from `[(TxIn, TxOut)]` to `[(TxIn, Coin)]`.

## Notes

We will eventually replace all usages of `TxIn` in the coin selection library with a type parameter and `Ord` constraints (where appropriate). This PR is a step towards this goal.

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

lib/core/src/Cardano/Wallet.hs

@@ -315,8 +315,6 @@ import Cardano.Wallet.Primitive.AddressDiscovery.Shared
     , SharedState (..)
     , addCosignerAccXPub
     )
-import Cardano.Wallet.Primitive.Collateral
-    ( asCollateral )
 import Cardano.Wallet.Primitive.Migration
     ( MigrationPlan (..) )
 import Cardano.Wallet.Primitive.Model
@@ -1909,8 +1907,6 @@ selectAssets ctx pp params transform = do
                 intCast @Word16 @Int $ view #maximumCollateralInputCount pp
             , minimumCollateralPercentage =
                 view #minimumCollateralPercentage pp
-            , utxoSuitableForCollateral =
-                asCollateral . snd
             }
     let selectionParams = SelectionParams
             { assetsToMint =

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

@@ -1,4 +1,5 @@
 {-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE OverloadedLabels #-}
 {-# LANGUAGE RecordWildCards #-}
@@ -58,12 +59,10 @@ module Cardano.Wallet.CoinSelection
 
 import Cardano.Wallet.CoinSelection.Internal
     ( SelectionCollateralRequirement (..)
-    , SelectionConstraints (..)
     , SelectionError (..)
     , SelectionOutputError (..)
     , SelectionOutputSizeExceedsLimitError (..)
     , SelectionOutputTokenQuantityExceedsLimitError (..)
-    , SelectionParams (..)
     )
 import Cardano.Wallet.CoinSelection.Internal.Balance
     ( BalanceInsufficientError (..)
@@ -77,14 +76,20 @@ import Cardano.Wallet.CoinSelection.Internal.Balance
     )
 import Cardano.Wallet.CoinSelection.Internal.Collateral
     ( SelectionCollateralError )
+import Cardano.Wallet.Primitive.Collateral
+    ( asCollateral )
 import Cardano.Wallet.Primitive.Types.Coin
     ( Coin (..) )
 import Cardano.Wallet.Primitive.Types.TokenBundle
     ( TokenBundle )
 import Cardano.Wallet.Primitive.Types.TokenMap
     ( TokenMap )
 import Cardano.Wallet.Primitive.Types.Tx
-    ( TxIn, TxOut (..) )
+    ( TokenBundleSizeAssessment, TxIn, TxOut (..) )
+import Cardano.Wallet.Primitive.Types.UTxO
+    ( UTxO (..) )
+import Cardano.Wallet.Primitive.Types.UTxOSelection
+    ( UTxOSelection )
 import Control.Monad.Random.Class
     ( MonadRandom (..) )
 import Control.Monad.Trans.Except
@@ -99,16 +104,131 @@ import GHC.Generics
     ( Generic )
 import GHC.Stack
     ( HasCallStack )
+import Numeric.Natural
+    ( Natural )
 
 import Prelude
 
 import qualified Cardano.Wallet.CoinSelection.Internal as Internal
 import qualified Cardano.Wallet.Primitive.Types.TokenBundle as TokenBundle
+import qualified Cardano.Wallet.Primitive.Types.UTxO as UTxO
 import qualified Data.Foldable as F
+import qualified Data.Map.Strict as Map
 import qualified Data.Set as Set
 
 --------------------------------------------------------------------------------
--- Types
+-- Selection constraints
+--------------------------------------------------------------------------------
+
+-- | Specifies all constraints required for coin selection.
+--
+-- Selection constraints:
+--
+--    - are dependent on the current set of protocol parameters.
+--
+--    - are not specific to a given selection.
+--
+--    - place limits on the coin selection algorithm, enabling it to produce
+--      selections that are acceptable to the ledger.
+--
+data SelectionConstraints = SelectionConstraints
+    { assessTokenBundleSize
+        :: TokenBundle -> TokenBundleSizeAssessment
+        -- ^ Assesses the size of a token bundle relative to the upper limit of
+        -- what can be included in a transaction output. See documentation for
+        -- the 'TokenBundleSizeAssessor' type to learn about the expected
+        -- properties of this field.
+    , certificateDepositAmount
+        :: Coin
+        -- ^ Amount that should be taken from/returned back to the wallet for
+        -- each stake key registration/de-registration in the transaction.
+    , computeMinimumAdaQuantity
+        :: TokenMap -> Coin
+        -- ^ Computes the minimum ada quantity required for a given output.
+    , computeMinimumCost
+        :: SelectionSkeleton -> Coin
+        -- ^ Computes the minimum cost of a given selection skeleton.
+    , computeSelectionLimit
+        :: [TxOut] -> SelectionLimit
+        -- ^ Computes an upper bound for the number of ordinary inputs to
+        -- select, given a current set of outputs.
+    , maximumCollateralInputCount
+        :: Int
+        -- ^ Specifies an inclusive upper bound on the number of unique inputs
+        -- that can be selected as collateral.
+    , minimumCollateralPercentage
+        :: Natural
+        -- ^ Specifies the minimum required amount of collateral as a
+        -- percentage of the total transaction fee.
+    }
+    deriving Generic
+
+toInternalSelectionConstraints
+    :: SelectionConstraints -> Internal.SelectionConstraints
+toInternalSelectionConstraints SelectionConstraints {..} =
+    Internal.SelectionConstraints {..}
+
+--------------------------------------------------------------------------------
+-- Selection parameters
+--------------------------------------------------------------------------------
+
+-- | Specifies all parameters that are specific to a given selection.
+--
+data SelectionParams = SelectionParams
+    { assetsToBurn
+        :: !TokenMap
+        -- ^ Specifies a set of assets to burn.
+    , assetsToMint
+        :: !TokenMap
+        -- ^ Specifies a set of assets to mint.
+    , extraCoinIn
+        :: !Coin
+       -- ^ Specifies extra 'Coin' in.
+    , extraCoinOut
+        :: !Coin
+        -- ^ Specifies extra 'Coin' out.
+    , outputsToCover
+        :: ![TxOut]
+        -- ^ Specifies a set of outputs that must be paid for.
+    , rewardWithdrawal
+        :: !Coin
+        -- ^ Specifies the value of a withdrawal from a reward account.
+    , certificateDepositsTaken
+        :: !Natural
+        -- ^ Number of deposits for stake key registrations.
+    , certificateDepositsReturned
+        :: !Natural
+        -- ^ Number of deposits from stake key de-registrations.
+    , collateralRequirement
+        :: !SelectionCollateralRequirement
+        -- ^ Specifies the collateral requirement for this selection.
+    , utxoAvailableForCollateral
+        :: !UTxO
+        -- ^ Specifies a set of UTxOs that are available for selection as
+        -- collateral inputs.
+        --
+        -- This set is allowed to intersect with 'utxoAvailableForInputs',
+        -- since the ledger does not require that these sets are disjoint.
+    , utxoAvailableForInputs
+        :: !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)
+
+toInternalSelectionParams :: SelectionParams -> Internal.SelectionParams
+toInternalSelectionParams SelectionParams {..} =
+    Internal.SelectionParams
+        { utxoAvailableForCollateral =
+            Map.mapMaybe asCollateral $ unUTxO utxoAvailableForCollateral
+        , ..
+        }
+
+--------------------------------------------------------------------------------
+-- Selections
 --------------------------------------------------------------------------------
 
 -- | Represents a balanced selection.
@@ -147,9 +267,15 @@ data SelectionOf change = Selection
 --
 type Selection = SelectionOf TokenBundle
 
-toExternalSelection :: Internal.Selection -> Selection
-toExternalSelection Internal.Selection {..} =
-    Selection {..}
+toExternalSelection :: SelectionParams -> Internal.Selection -> Selection
+toExternalSelection ps Internal.Selection {..} =
+    Selection
+        { collateral = Map.toList $ unUTxO $
+            view #utxoAvailableForCollateral ps
+            `UTxO.restrictedBy`
+            Set.fromList (fst <$> collateral)
+        , ..
+        }
 
 toInternalSelection
     :: (change -> TokenBundle)
@@ -158,6 +284,7 @@ toInternalSelection
 toInternalSelection getChangeBundle Selection {..} =
     Internal.Selection
         { change = getChangeBundle <$> change
+        , collateral = fmap (view (#tokens . #coin)) <$> collateral
         , ..
         }
 
@@ -182,7 +309,10 @@ performSelection
     -> SelectionParams
     -> ExceptT SelectionError m Selection
 performSelection cs ps =
-    toExternalSelection <$> Internal.performSelection cs ps
+    toExternalSelection ps <$>
+    Internal.performSelection
+        (toInternalSelectionConstraints cs)
+        (toInternalSelectionParams ps)
 
 --------------------------------------------------------------------------------
 -- Selection deltas

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

@@ -84,8 +84,6 @@ import Cardano.Wallet.Primitive.Types.TokenQuantity
     ( TokenQuantity )
 import Cardano.Wallet.Primitive.Types.Tx
     ( TokenBundleSizeAssessment (..), TxIn, TxOut (..), txOutMaxTokenQuantity )
-import Cardano.Wallet.Primitive.Types.UTxO
-    ( UTxO (..) )
 import Cardano.Wallet.Primitive.Types.UTxOSelection
     ( UTxOSelection )
 import Control.Monad
@@ -109,7 +107,7 @@ import Data.List.NonEmpty
 import Data.Map.Strict
     ( Map )
 import Data.Maybe
-    ( isNothing, mapMaybe )
+    ( mapMaybe )
 import Data.Ratio
     ( (%) )
 import Data.Semigroup
@@ -125,7 +123,6 @@ import qualified Cardano.Wallet.CoinSelection.Internal.Balance as Balance
 import qualified Cardano.Wallet.CoinSelection.Internal.Collateral as Collateral
 import qualified Cardano.Wallet.Primitive.Types.TokenBundle as TokenBundle
 import qualified Cardano.Wallet.Primitive.Types.TokenMap as TokenMap
-import qualified Cardano.Wallet.Primitive.Types.UTxO as UTxO
 import qualified Cardano.Wallet.Primitive.Types.UTxOSelection as UTxOSelection
 import qualified Data.Foldable as F
 import qualified Data.List.NonEmpty as NE
@@ -175,11 +172,6 @@ data SelectionConstraints = SelectionConstraints
         :: Natural
         -- ^ Specifies the minimum required amount of collateral as a
         -- percentage of the total transaction fee.
-    , utxoSuitableForCollateral
-        :: (TxIn, TxOut) -> Maybe Coin
-        -- ^ Indicates whether an individual UTxO entry is suitable for use as
-        -- a collateral input. This function should return a 'Coin' value if
-        -- (and only if) the given UTxO is suitable for use as collateral.
     }
     deriving Generic
 
@@ -214,7 +206,7 @@ data SelectionParams = SelectionParams
         :: !SelectionCollateralRequirement
         -- ^ Specifies the collateral requirement for this selection.
     , utxoAvailableForCollateral
-        :: !UTxO
+        :: !(Map TxIn Coin)
         -- ^ Specifies a set of UTxOs that are available for selection as
         -- collateral inputs.
         --
@@ -248,7 +240,7 @@ data Selection = Selection
         :: !(NonEmpty (TxIn, TxOut))
         -- ^ Selected inputs.
     , collateral
-        :: ![(TxIn, TxOut)]
+        :: ![(TxIn, Coin)]
         -- ^ Selected collateral inputs.
     , outputs
         :: ![TxOut]
@@ -462,9 +454,7 @@ toCollateralConstraintsParams balanceResult (constraints, params) =
         }
     collateralParams = Collateral.SelectionParams
         { coinsAvailable =
-            Map.mapMaybeWithKey
-                (curry (view #utxoSuitableForCollateral constraints))
-                (unUTxO (view #utxoAvailableForCollateral params))
+            view #utxoAvailableForCollateral params
         , minimumSelectionAmount =
             computeMinimumCollateral ComputeMinimumCollateralParams
                 { minimumCollateralPercentage =
@@ -481,12 +471,9 @@ mkSelection
     -> Balance.SelectionResult
     -> Collateral.SelectionResult
     -> Selection
-mkSelection params balanceResult collateralResult = Selection
+mkSelection _params balanceResult collateralResult = Selection
     { inputs = view #inputsSelected balanceResult
-    , collateral = UTxO.toList $
-        view #utxoAvailableForCollateral params
-        `UTxO.restrictedBy`
-        Map.keysSet (view #coinsSelected collateralResult)
+    , collateral = Map.toList $ view #coinsSelected collateralResult
     , outputs = view #outputsCovered balanceResult
     , change = view #changeGenerated balanceResult
     , assetsToMint = view #assetsToMint balanceResult
@@ -663,25 +650,32 @@ verifySelectionCollateralSufficient cs ps selection =
 data FailureToVerifySelectionCollateralSuitable =
     FailureToVerifySelectionCollateralSuitable
     { collateralSelected
-        :: [(TxIn, TxOut)]
+        :: [(TxIn, Coin)]
     , collateralSelectedButUnsuitable
-        :: [(TxIn, TxOut)]
+        :: [(TxIn, Coin)]
     }
     deriving (Eq, Show)
 
 verifySelectionCollateralSuitable :: VerifySelection
-verifySelectionCollateralSuitable cs _ps selection =
+verifySelectionCollateralSuitable _cs ps selection =
     verify
         (null collateralSelectedButUnsuitable)
         (FailureToVerifySelectionCollateralSuitable {..})
   where
     collateralSelected =
         selection ^. #collateral
     collateralSelectedButUnsuitable =
-        filter utxoUnsuitableForCollateral collateralSelected
-
-    utxoUnsuitableForCollateral :: (TxIn, TxOut) -> Bool
-    utxoUnsuitableForCollateral = isNothing . (cs ^. #utxoSuitableForCollateral)
+        filter (not . utxoSuitableForCollateral) collateralSelected
+
+    -- Since the caller of 'performSelection' is responsible for verifying that
+    -- all entries within 'utxoAvailableForCollateral' are suitable for use as
+    -- collateral, here we merely verify that the selected entry is indeed a
+    -- member of this set.
+    utxoSuitableForCollateral :: (TxIn, Coin) -> Bool
+    utxoSuitableForCollateral (i, c) =
+        Map.singleton i c
+        `Map.isSubmapOf`
+        view #utxoAvailableForCollateral ps
 
 --------------------------------------------------------------------------------
 -- Selection verification: delta validity
@@ -1102,23 +1096,7 @@ verifySelectionCollateralError cs ps e =
     largestCombinationUnsuitableSubset :: Map TxIn Coin
     largestCombinationUnsuitableSubset = Map.withoutKeys
         (largestCombination)
-        (Map.keysSet largestCombinationSuitableSubset)
-      where
-        -- The largest reported combination of UTxOs, but with outputs fully
-        -- resolved according to the set of UTxOs originally made available
-        -- to the selection algorithm.
-        largestCombinationResolved :: Map TxIn TxOut
-        largestCombinationResolved = Map.restrictKeys
-            (unUTxO (ps ^. #utxoAvailableForCollateral))
-            (Map.keysSet largestCombination)
-
-        -- The subset of the largest reported combination that is suitable for
-        -- use as collateral. This set should be exactly the same size as the
-        -- reported largest combination.
-        largestCombinationSuitableSubset :: Map TxIn Coin
-        largestCombinationSuitableSubset = Map.mapMaybeWithKey
-            (curry (cs ^. #utxoSuitableForCollateral))
-            (largestCombinationResolved)
+        (Map.keysSet $ ps ^. #utxoAvailableForCollateral)
 
     maximumSelectionSize :: Int
     maximumSelectionSize = cs ^. #maximumCollateralInputCount
@@ -1280,10 +1258,7 @@ whenCollateralRequired params f
 -- | Computes the total amount of collateral within a selection.
 --
 selectionCollateral :: Selection -> Coin
-selectionCollateral selection =
-    F.foldMap
-        (view (#tokens . #coin) . snd)
-        (view #collateral selection)
+selectionCollateral = F.foldMap snd . view #collateral
 
 -- | Indicates whether or not a selection has sufficient collateral.
 --

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

@@ -248,7 +248,7 @@ import qualified Data.Maybe as Maybe
 import qualified Data.Set as Set
 
 spec :: Spec
-spec = describe "Cardano.Wallet.Primitive.CoinSelection.BalanceSpec" $
+spec = describe "Cardano.Wallet.CoinSelection.Internal.BalanceSpec" $
 
     modifyMaxSuccess (const 1000) $ do