[CBR-464] Make caller responsible for handling result of 'findRandomO…

…utput'

The rational here is that, the outcome may depend of the context. We use this function in
multiple places where running out of UTxO may have a different meaning. Therefore, instead
of introducing the 'UtxoDepleted' error, we return a raw Maybe and let the caller decides
what error should be thrown (here, most likely: CannotCoverFee or UtxoExhausted)

src/Cardano/Wallet/API/V1/ReifyWalletError.hs

@@ -273,9 +273,6 @@ newTransactionError e = case e of
                   Nothing ->
                       V1.UnknownError $ (sformat build ex)
 
-          CoinSelHardErrUtxoDepleted ->
-            V1.NotEnoughMoney (V1.ErrAvailableBalanceIsInsufficient 0)
-
     (Kernel.NewTransactionErrorCreateAddressFailed e') ->
         createAddressErrorKernel e'
 

src/Cardano/Wallet/Kernel/CoinSelection/FromGeneric.hs

@@ -239,7 +239,7 @@ repack (txIn, aux) = (Core.toaOut aux, txIn)
 
 -- | Pick an element from the UTxO to cover any remaining fee
 type PickUtxo m = Core.Coin  -- ^ Fee to still cover
-               -> CoinSelT Core.Utxo CoinSelHardErr m (Core.TxIn, Core.TxOutAux)
+               -> CoinSelT Core.Utxo CoinSelHardErr m (Maybe (Core.TxIn, Core.TxOutAux))
 
 data CoinSelFinalResult = CoinSelFinalResult {
       csrInputs  :: NonEmpty (Core.TxIn, Core.TxOutAux)
@@ -288,7 +288,6 @@ runCoinSelT opts pickUtxo policy request utxo = do
     policy' :: CoinSelT Core.Utxo CoinSelHardErr m
                  ([CoinSelResult Cardano], SelectedUtxo Cardano)
     policy' = do
-        when (Map.null utxo) $ throwError CoinSelHardErrUtxoDepleted
         mapM_ validateOutput request
         css <- intInputGrouping (csoInputGrouping opts)
         -- We adjust for fees /after/ potentially dealing with grouping
@@ -387,10 +386,10 @@ largestFirst opts maxInps =
     pickUtxo val = search . Map.toList =<< get
       where
         search :: [(Core.TxIn, Core.TxOutAux)]
-               -> CoinSelT Core.Utxo CoinSelHardErr m (Core.TxIn, Core.TxOutAux)
+               -> CoinSelT Core.Utxo CoinSelHardErr m (Maybe (Core.TxIn, Core.TxOutAux))
         search [] = throwError CoinSelHardErrCannotCoverFee
         search ((i, o):ios)
-          | Core.txOutValue (Core.toaOut o) >= val = return (i, o)
+          | Core.txOutValue (Core.toaOut o) >= val = return $ Just (i, o)
           | otherwise                              = search ios
 
 

src/Cardano/Wallet/Kernel/CoinSelection/Generic.hs

@@ -73,7 +73,6 @@ import qualified Data.Map.Strict as Map
 import qualified Data.Set as Set
 import           Formatting (bprint, build, (%))
 import qualified Formatting.Buildable
-import           Test.QuickCheck (Arbitrary (..))
 
 import           Cardano.Wallet.Kernel.Util.StrictStateT
 import           UTxO.Util (withoutKeys)
@@ -302,15 +301,6 @@ data CoinSelHardErr =
     -- See also 'CoinSelHardErrCannotCoverFee'
   | CoinSelHardErrUtxoExhausted Text Text
 
-    -- | UTxO depleted using input selection.
-    --
-    -- This occurs when there's actually no UTxO to pick from in a first place,
-    -- like an edge-case of CoinSelHardErrUtxoExhausted (which suggests that we
-    -- could at least start selecting UTxO).
-  | CoinSelHardErrUtxoDepleted
-
-instance Arbitrary CoinSelHardErr where
-    arbitrary = pure CoinSelHardErrUtxoDepleted
 
 -- | The input selection request failed
 --
@@ -656,8 +646,6 @@ instance Buildable CoinSelHardErr where
     )
     bal
     val
-  build (CoinSelHardErrUtxoDepleted) = bprint
-    ( "CoinSelHardErrUtxoDepleted" )
 
 instance CoinSelDom dom => Buildable (Fee dom) where
   build = bprint build . getFee

src/Cardano/Wallet/Kernel/CoinSelection/Generic/Fees.hs

@@ -41,7 +41,7 @@ data FeeOptions dom = FeeOptions {
 adjustForFees :: forall utxo m. (CoinSelDom (Dom utxo), Monad m)
               => FeeOptions (Dom utxo)
               -> (Value (Dom utxo) ->
-                   CoinSelT utxo CoinSelHardErr m (UtxoEntry (Dom utxo)))
+                   CoinSelT utxo CoinSelHardErr m (Maybe (UtxoEntry (Dom utxo))))
               -> [CoinSelResult (Dom utxo)]
               -> CoinSelT utxo CoinSelHardErr m
                    ([CoinSelResult (Dom utxo)], SelectedUtxo (Dom utxo))
@@ -81,7 +81,7 @@ receiverPaysFee totalFee =
 
 senderPaysFee :: (Monad m, CoinSelDom (Dom utxo))
               => (Value (Dom utxo) ->
-                   CoinSelT utxo CoinSelHardErr m (UtxoEntry (Dom utxo)))
+                   CoinSelT utxo CoinSelHardErr m (Maybe (UtxoEntry (Dom utxo))))
               -> Fee (Dom utxo)
               -> [CoinSelResult (Dom utxo)]
               -> CoinSelT utxo CoinSelHardErr m
@@ -91,25 +91,18 @@ senderPaysFee pickUtxo totalFee css = do
     (css', ) <$> coverRemainingFee pickUtxo remainingFee
 
 coverRemainingFee :: forall utxo m. (Monad m, CoinSelDom (Dom utxo))
-                  => (Value (Dom utxo) -> CoinSelT utxo CoinSelHardErr m (UtxoEntry (Dom utxo)))
+                  => (Value (Dom utxo) -> CoinSelT utxo CoinSelHardErr m (Maybe (UtxoEntry (Dom utxo))))
                   -> Fee (Dom utxo)
                   -> CoinSelT utxo CoinSelHardErr m (SelectedUtxo (Dom utxo))
 coverRemainingFee pickUtxo fee = go emptySelection
   where
-    -- | In this context, @CoinSelHardErrUtxoDepleted@ might be thrown by
-    -- `pickUtxo` as we iterate which here means that we are running out of
-    -- UTxOs to cover the fee, and therefore, remap the error accordingly.
-    remapUtxoDepleted :: CoinSelHardErr -> CoinSelHardErr
-    remapUtxoDepleted CoinSelHardErrUtxoDepleted = CoinSelHardErrCannotCoverFee
-    remapUtxoDepleted err                        = err
-
     go :: SelectedUtxo (Dom utxo)
        -> CoinSelT utxo CoinSelHardErr m (SelectedUtxo (Dom utxo))
     go !acc
       | selectedBalance acc >= getFee fee = return acc
       | otherwise = do
-          io <- (pickUtxo $ unsafeValueSub (getFee fee) (selectedBalance acc))
-                `catchError` (throwError . remapUtxoDepleted)
+          mio <- (pickUtxo $ unsafeValueSub (getFee fee) (selectedBalance acc))
+          io  <- maybe (throwError CoinSelHardErrCannotCoverFee) return mio
           go (select io acc)
 
 -- | Attempt to pay the fee from change outputs, returning any fee remaining

src/Cardano/Wallet/Kernel/CoinSelection/Generic/Random.hs

@@ -33,10 +33,23 @@ random :: forall utxo m. (MonadRandom m, PickFromUtxo utxo)
        -> Word64              -- ^ Maximum number of inputs
        -> [Output (Dom utxo)] -- ^ Outputs to include
        -> CoinSelT utxo CoinSelHardErr m [CoinSelResult (Dom utxo)]
-random privacyMode = coinSelPerGoal $ \maxNumInputs goal ->
-    defCoinSelResult goal <$>
-      inRange maxNumInputs (target privacyMode (outVal goal))
+random privacyMode initMaxNumInputs goals = do
+    balance <- gets utxoBalance
+    when (balance == valueZero) $ throwError (errUtxoExhausted balance)
+    coinSelPerGoal selection initMaxNumInputs goals
   where
+    errUtxoExhausted :: Value (Dom utxo) -> CoinSelHardErr
+    errUtxoExhausted balance = CoinSelHardErrUtxoExhausted
+        (pretty balance)
+        (pretty $ unsafeValueSum $ map outVal goals)
+
+    selection
+        :: Word64
+        -> Output (Dom utxo)
+        -> CoinSelT utxo CoinSelHardErr m (CoinSelResult (Dom utxo))
+    selection maxNumInputs goal = defCoinSelResult goal
+        <$> inRange maxNumInputs (target privacyMode (outVal goal))
+
     target :: PrivacyMode -> Value (Dom utxo) -> TargetRange (Dom utxo)
     target PrivacyModeOn  val = fromMaybe (target PrivacyModeOff val)
                                           (idealRange val)
@@ -183,12 +196,9 @@ improve maxNumInputs targetAim targetMax = go
 
 -- | Select a random output
 findRandomOutput :: (MonadRandom m, PickFromUtxo utxo)
-                 => CoinSelT utxo CoinSelHardErr m (UtxoEntry (Dom utxo))
-findRandomOutput = do
-    mIO <- tryFindRandomOutput Just
-    case mIO of
-      Just io -> return io
-      Nothing -> throwError CoinSelHardErrUtxoDepleted
+                 => CoinSelT utxo e m (Maybe (UtxoEntry (Dom utxo)))
+findRandomOutput =
+    tryFindRandomOutput Just
 
 -- | Find a random output, and return it if it satisfies the predicate
 --

src/Cardano/Wallet/Kernel/Transactions.hs

@@ -97,7 +97,10 @@ instance Buildable NewTransactionError where
 instance Arbitrary NewTransactionError where
     arbitrary = oneof [
         NewTransactionUnknownAccount <$> arbitrary
-      , NewTransactionErrorCoinSelectionFailed <$> arbitrary
+      , NewTransactionErrorCoinSelectionFailed <$> oneof
+            [ pure $ CoinSelHardErrUtxoExhausted "0 coin(s)" "14 coin(s)"
+            , pure CoinSelHardErrCannotCoverFee
+            ]
       , NewTransactionErrorCreateAddressFailed <$> arbitrary
       , NewTransactionErrorSignTxFailed <$> arbitrary
       , pure NewTransactionInvalidTxIn

test/unit/Test/Spec/CoinSelection.hs

@@ -377,7 +377,6 @@ paymentFailedWith utxo payees res extraChecks =
 
 notEnoughMoney :: CoinSelHardErr -> Bool
 notEnoughMoney (CoinSelHardErrUtxoExhausted _ _) = True
-notEnoughMoney CoinSelHardErrUtxoDepleted        = True
 notEnoughMoney _                                 = False
 
 outputWasRedeem :: CoinSelHardErr -> Bool