Extend CannotCoverFee error

cardano-foundation · Apr 9, 2019 · ecd5b66 · ecd5b66
1 parent b7defd8
commit ecd5b66
Show file tree

Hide file tree

Showing 2 changed files with 9 additions and 9 deletions.
diff --git a/src/Cardano/Wallet/CoinSelection.hs b/src/Cardano/Wallet/CoinSelection.hs
@@ -86,8 +86,9 @@ data FeeOptions = FeeOptions
     } deriving (Generic)
 
 data FeeError =
-     CannotCoverFee
+     CannotCoverFee Word64
     -- ^ UTxO exhausted during fee covering
+    -- We record what amount missed to cover the fee
     | OutOfBoundFee Word64 Word64
     -- ^ Excessive actual fee compared to estimated fee
     -- We record the actual fee as well as estimated fee

diff --git a/src/Cardano/Wallet/CoinSelection/Fee.hs b/src/Cardano/Wallet/CoinSelection/Fee.hs
@@ -109,16 +109,15 @@ senderPaysFee opt utxo  = go
         removeDust = L.filter (> (dustThreshold opt))
 
         reduceChangeOutputs
-            :: ([Coin] -> [Coin])
-            -> Coin
+            :: Coin
             -> [Coin]
             -> ([Coin], Coin)
-        reduceChangeOutputs f totalFee chgs =
-            case (filter (/= Coin 0) . f) chgs of
+        reduceChangeOutputs totalFee chgs =
+            case (filter (/= Coin 0) . removeDust) chgs of
                 [] ->
-                    (f chgs, totalFee)
+                    (removeDust chgs, totalFee)
                 xs ->
-                    bimap f (Coin . sum . map getCoin)
+                    bimap removeDust (Coin . sum . map getCoin)
                     $ L.unzip
                     $ map reduceSingleChange
                     $ divvyFee totalFee xs
@@ -145,7 +144,7 @@ senderPaysFee opt utxo  = go
 
             -- 2/ Substract fee from all change outputs, proportionally to their value.
             let (chgs', remainingFee) =
-                    reduceChangeOutputs removeDust upperBound chgs
+                    reduceChangeOutputs upperBound chgs
 
             -- 3.1/
             -- Should the change cover the fee, we're (almost) good. By removing
@@ -171,7 +170,7 @@ senderPaysFee opt utxo  = go
                 remFee <- lift $ runMaybeT $ coverRemainingFee remainingFee utxo
                 case remFee of
                     Nothing ->
-                        throwE CannotCoverFee
+                        throwE $ CannotCoverFee (getCoin remainingFee)
                     Just inps' -> do
                         let extraChange = splitChange (currentBalance inps') chgs
                         pure $ CoinSelection (inps <> inps') outs extraChange