Merge pull request #3704 from input-output-hk/KtorZ/CBR-462/fix-0-fee-transaction

[CBR-462] Fix 0 fee transaction

Author: adinapoli-iohk

wallet-new/src/Cardano/Wallet/Kernel/CoinSelection/Generic.hs

@@ -590,16 +590,30 @@ nLargestFromListBy f n = \xs ->
     dropOne (Just [_])    = Nothing
     dropOne (Just (_:as)) = Just as
 
--- | Proportionally divide the fee over each output
+-- | Proportionally divide the fee over each output.
+--
+-- There's a special 'edge-case' when the given input is a singleton list
+-- with one 0 coin. This is artifically created during input selection when
+-- the transaction's amount matches exactly the source's balance.
+-- In such case, we can't really compute any ratio for fees and simply return
+-- the whole fee back with the given change value.
 divvyFee :: forall dom a. CoinSelDom dom
           => (a -> Value dom) -> Fee dom -> [a] -> [(Fee dom, a)]
-divvyFee _ _   [] = error "divvyFee: empty list"
-divvyFee f fee as = map (\a -> (feeForOut a, a)) as
+divvyFee _ _   []                     = error "divvyFee: empty list"
+divvyFee f fee [a] | f a == valueZero = [(fee, a)]
+divvyFee f fee as                     = map (\a -> (feeForOut a, a)) as
   where
     -- All outputs are selected from well-formed UTxO, so their sum cannot
     -- overflow
     totalOut :: Value dom
-    totalOut = unsafeValueSum (map f as)
+    totalOut =
+        let
+            total = unsafeValueSum (map f as)
+        in
+            if total == valueZero then
+                error "divyyFee: invalid set of coins, total is 0"
+            else
+                total
 
     -- The ratio will be between 0 and 1 so cannot overflow
     feeForOut :: a -> Fee dom

wallet-new/src/Cardano/Wallet/Kernel/CoinSelection/Generic/Fees.hs

@@ -90,18 +90,26 @@ senderPaysFee pickUtxo totalFee css = do
     let (css', remainingFee) = feeFromChange totalFee css
     (css', ) <$> coverRemainingFee pickUtxo remainingFee
 
-coverRemainingFee :: forall utxo e m. (Monad m, CoinSelDom (Dom utxo))
-                  => (Value (Dom utxo) -> CoinSelT utxo e m (UtxoEntry (Dom utxo)))
+coverRemainingFee :: forall utxo m. (Monad m, CoinSelDom (Dom utxo))
+                  => (Value (Dom utxo) -> CoinSelT utxo CoinSelHardErr m (UtxoEntry (Dom utxo)))
                   -> Fee (Dom utxo)
-                  -> CoinSelT utxo e m (SelectedUtxo (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 e m (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)
+          io <- (pickUtxo $ unsafeValueSub (getFee fee) (selectedBalance acc))
+                `catchError` (throwError . remapUtxoDepleted)
           go (select io acc)
 
 -- | Attempt to pay the fee from change outputs, returning any fee remaining