add unit tests showing how withdrawal impacts the random coin selection

lib/core/src/Cardano/Wallet/Api/Server.hs

@@ -1878,10 +1878,9 @@ instance Buildable e => LiftHandler (ErrCoinSelection e) where
                 ]
         ErrInputsDepleted ->
             apiError err403 InputsDepleted $ mconcat
-                [ "I had to select inputs to construct the "
-                , "requested transaction. Unfortunately, one output of the "
-                , "transaction depleted all available inputs. "
-                , "Try sending a smaller amount."
+                [ "I cannot select enough UTxO from your wallet to construct "
+                , "an adequate transaction. Try sending a smaller amount or "
+                , "increasing the number of available UTxO."
                 ]
         ErrInvalidSelection e ->
             apiError err403 InvalidCoinSelection $ pretty e

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

@@ -20,6 +20,7 @@ module Cardano.Wallet.Primitive.CoinSelection
     , outputBalance
     , changeBalance
     , feeBalance
+    , totalBalance
     , proportionallyTo
     , ErrCoinSelection (..)
     , CoinSelectionOptions (..)
@@ -28,9 +29,11 @@ module Cardano.Wallet.Primitive.CoinSelection
 import Prelude
 
 import Cardano.Wallet.Primitive.Types
-    ( Coin (..), TxIn, TxOut (..) )
+    ( Coin (..), TxIn, TxOut (..), balance' )
 import Data.List
     ( foldl' )
+import Data.Quantity
+    ( Quantity (..) )
 import Data.Ratio
     ( Ratio, denominator, numerator )
 import Data.Word
@@ -120,6 +123,10 @@ changeBalance = foldl' addCoin 0 . change
 feeBalance :: CoinSelection -> Word64
 feeBalance sel = inputBalance sel - outputBalance sel - changeBalance sel
 
+-- | Total UTxO balance + withdrawal.
+totalBalance :: Quantity "lovelace" Word64 -> [(TxIn, TxOut)] -> Word64
+totalBalance (Quantity withdraw) inps = balance' inps + withdraw
+
 addTxOut :: Integral a => a -> TxOut -> a
 addTxOut total = addCoin total . coin
 

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

@@ -17,9 +17,13 @@ module Cardano.Wallet.Primitive.CoinSelection.LargestFirst (
 import Prelude
 
 import Cardano.Wallet.Primitive.CoinSelection
-    ( CoinSelection (..), CoinSelectionOptions (..), ErrCoinSelection (..) )
+    ( CoinSelection (..)
+    , CoinSelectionOptions (..)
+    , ErrCoinSelection (..)
+    , totalBalance
+    )
 import Cardano.Wallet.Primitive.Types
-    ( Coin (..), TxIn, TxOut (..), UTxO (..), balance )
+    ( Coin (..), TxIn, TxOut (..), UTxO (..) )
 import Control.Arrow
     ( left )
 import Control.Monad
@@ -50,7 +54,7 @@ largestFirst
     -> Quantity "lovelace" Word64
     -> UTxO
     -> ExceptT (ErrCoinSelection e) m (CoinSelection, UTxO)
-largestFirst opt outs _withdrawals utxo = do
+largestFirst opt outs withdraw utxo = do
     let descending = L.sortOn (Down . coin) . NE.toList
     let nOuts = fromIntegral $ NE.length outs
     let maxN = fromIntegral $ maximumNumberOfInputs opt (fromIntegral nOuts)
@@ -65,11 +69,15 @@ largestFirst opt outs _withdrawals utxo = do
             guard s $> (s, UTxO $ Map.fromList utxo')
         Nothing -> do
             let moneyRequested = sum $ (getCoin . coin) <$> (descending outs)
-            let utxoBalance = fromIntegral $ balance utxo
+            let utxoList = Map.toList $ getUTxO utxo
+            let total = totalBalance withdraw utxoList
             let nUtxo = fromIntegral $ Map.size $ getUTxO utxo
 
-            when (utxoBalance < moneyRequested)
-                $ throwE $ ErrNotEnoughMoney utxoBalance moneyRequested
+            when (null utxoList)
+                $ throwE ErrInputsDepleted
+
+            when (total < moneyRequested)
+                $ throwE $ ErrNotEnoughMoney total moneyRequested
 
             when (nUtxo < nOuts)
                 $ throwE $ ErrUtxoNotEnoughFragmented nUtxo nOuts

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

@@ -22,19 +22,12 @@ import Cardano.Wallet.Primitive.CoinSelection
     , CoinSelectionOptions (..)
     , ErrCoinSelection (..)
     , proportionallyTo
+    , totalBalance
     )
 import Cardano.Wallet.Primitive.CoinSelection.LargestFirst
     ( largestFirst )
 import Cardano.Wallet.Primitive.Types
-    ( Coin (..)
-    , TxIn
-    , TxOut (..)
-    , UTxO (..)
-    , balance'
-    , distance
-    , invariant
-    , pickRandom
-    )
+    ( Coin (..), TxIn, TxOut (..), UTxO (..), distance, invariant, pickRandom )
 import Control.Arrow
     ( left )
 import Control.Monad
@@ -55,10 +48,10 @@ import Data.Ord
     ( comparing )
 import Data.Quantity
     ( Quantity (..) )
-import Data.Word
-    ( Word64 )
 import Data.Ratio
     ( (%) )
+import Data.Word
+    ( Word64 )
 
 import qualified Data.List as L
 import qualified Data.List.NonEmpty as NE
@@ -178,10 +171,16 @@ makeSelection withdraw (maxNumInputs, utxo0, selection) txout = do
     coverRandomly (inps, utxo)
         | L.length inps > fromIntegral maxNumInputs =
             MaybeT $ return Nothing
-        | totalBalance withdraw inps >= targetMin (mkTargetRange txout) =
+        | currentBalance >= targetMin (mkTargetRange txout) =
             MaybeT $ return $ Just (inps, utxo)
         | otherwise = do
             pickRandomT utxo >>= \(io, utxo') -> coverRandomly (io:inps, utxo')
+      where
+        -- Withdrawal can only count towards the input balance if there's been
+        -- at least one selected input.
+        currentBalance
+            | null inps && null selection = totalBalance (Quantity 0) inps
+            | otherwise = totalBalance withdraw inps
 
 -- | Perform an improvement to random selection on a given output.
 improveTxOut
@@ -196,7 +195,7 @@ improveTxOut (maxN0, selection, utxo0) (withdraw, inps0, txout) = do
         , selection <> mempty
             { inputs = inps
             , outputs = [txout]
-            , change = mkChange txout inps
+            , change = mkChange withdraw txout inps
             , withdrawal = getQuantity withdraw
             }
         , utxo
@@ -242,13 +241,6 @@ improveTxOut (maxN0, selection, utxo0) (withdraw, inps0, txout) = do
                                  Internals
 -------------------------------------------------------------------------------}
 
--- | Total UTxO balance + withdrawal. The withdrawal only counts towards the
--- balance if there's at least one input.
-totalBalance :: Quantity "lovelace" Word64 -> [(TxIn, TxOut)] -> Word64
-totalBalance (Quantity withdraw) inps
-    | null inps = 0
-    | otherwise = balance' inps + withdraw
-
 -- | Re-wrap 'pickRandom' in a 'MaybeT' monad
 pickRandomT :: MonadRandom m => UTxO -> MaybeT m ((TxIn, TxOut), UTxO)
 pickRandomT =
@@ -266,12 +258,12 @@ mkTargetRange (TxOut _ (Coin c)) = TargetRange
 -- of inputs.
 --
 -- > pre-condition: the output must be smaller (or eq) than the sum of inputs
-mkChange :: TxOut -> [(TxIn, TxOut)] -> [Coin]
-mkChange (TxOut _ (Coin out)) inps =
+mkChange :: Quantity "lovelace" Word64 -> TxOut -> [(TxIn, TxOut)] -> [Coin]
+mkChange withdraw (TxOut _ (Coin out)) inps =
     let
         selected = invariant
             "mkChange: output is smaller than selected inputs!"
-            (balance' inps)
+            (totalBalance withdraw inps)
             (>= out)
         Coin maxCoinValue = maxBound
     in

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

@@ -163,6 +163,95 @@ spec = do
                 , totalWithdrawal = 0
                 })
 
+        coinSelectionUnitTest random "withdrawal simple"
+            (Right $ CoinSelectionResult
+                { rsInputs = [1]
+                , rsChange = []
+                , rsOutputs = [2]
+                })
+            (CoinSelectionFixture
+                { maxNumOfInputs = 100
+                , validateSelection = noValidation
+                , utxoInputs = [1]
+                , txOutputs = 2 :| []
+                , totalWithdrawal = 1
+                })
+
+        coinSelectionUnitTest random "withdrawal multi-output"
+            (Right $ CoinSelectionResult
+                { rsInputs = [1,1]
+                , rsChange = []
+                , rsOutputs = [2,2]
+                })
+            (CoinSelectionFixture
+                { maxNumOfInputs = 100
+                , validateSelection = noValidation
+                , utxoInputs = [1,1]
+                , txOutputs = 2 :| [2]
+                , totalWithdrawal = 2
+                })
+
+        coinSelectionUnitTest random "withdrawal not even"
+            -- 10 Ada available as withdrawal
+            --
+            -- - 7 Ada goes to the first output (10/14 * 10 ~= 7)
+            -- - 2 Ada goes to the other output ( 4/14 * 10 ~= 2)
+            (Right $ CoinSelectionResult
+                { rsInputs = [5,5]
+                , rsChange = [2,3]
+                , rsOutputs = [10, 4]
+                })
+            (CoinSelectionFixture
+                { maxNumOfInputs = 100
+                , validateSelection = noValidation
+                , utxoInputs = [5,5]
+                , txOutputs = 10 :| [4]
+                , totalWithdrawal = 10
+                })
+
+        coinSelectionUnitTest random "withdrawal cover next output"
+            -- 20 Ada available as withdrawal
+            --
+            -- - 10 Ada goes to the first output
+            -- - 10 Ada goes to the other output
+            --
+            -- The first output has to select an available input first, which
+            -- leaves no input for the second, but it can be covered with the
+            -- withdrawal.
+            (Right $ CoinSelectionResult
+                { rsInputs = [1]
+                , rsChange = [1]
+                , rsOutputs = [10, 10]
+                })
+            (CoinSelectionFixture
+                { maxNumOfInputs = 100
+                , validateSelection = noValidation
+                , utxoInputs = [1]
+                , txOutputs = 10 :| [10]
+                , totalWithdrawal = 20
+                })
+
+        coinSelectionUnitTest random "withdrawal requires at least one input"
+            (Left ErrInputsDepleted)
+            (CoinSelectionFixture
+                { maxNumOfInputs = 100
+                , validateSelection = noValidation
+                , utxoInputs = []
+                , txOutputs = 1 :| []
+                , totalWithdrawal = 10
+                })
+
+        coinSelectionUnitTest random "not enough funds, withdrawal correctly counted"
+            (Left $ ErrNotEnoughMoney 11 100)
+            (CoinSelectionFixture
+                { maxNumOfInputs = 100
+                , validateSelection = noValidation
+                , utxoInputs = [1]
+                , txOutputs = 100 :| []
+                , totalWithdrawal = 10
+                })
+
+
         coinSelectionUnitTest random "enough funds, proper fragmentation, inputs depleted"
             (Left ErrInputsDepleted)
             (CoinSelectionFixture