[CBR-464] Make sure we throw correct UtxoExhausted when needed

Note that this revert a few things introduced in input-output-hk/cardano-sl#3704 & input-output-hk/cardano-sl#3672.
We moved the zero-output check from divvyFee to its callers as it
makes more sense. Also, with the introduction of `Maybe` in the
`PickUtxo` signature, we can remove the corner-case check for
empty UTxO which now correctly get caught by layers below.

Author: KtorZ

integration/TransactionSpecs.hs

@@ -171,36 +171,20 @@ transactionSpecs wRef wc = beforeAll_ (setupLogging "wallet-new_transactionSpecs
                         <> " error, got: "
                         <> show err
 
-        randomTest "fails if you spend more money than your available balance" 1 $ do
-            wallet <- run $ sampleWallet wRef wc
-            (toAcct, toAddr) <- run $ firstAccountAndId wc wallet
-
-            let payment = Payment
-                    { pmtSource =  PaymentSource
-                        { psWalletId = walId wallet
-                        , psAccountIndex = accIndex toAcct
-                        }
-                    , pmtDestinations = pure PaymentDistribution
-                        { pdAddress = addrId toAddr
-                        , pdAmount = tooMuchCash (accAmount toAcct)
-                        }
-                    , pmtGroupingPolicy = Nothing
-                    , pmtSpendingPassword = Nothing
-                    }
-                tooMuchCash (V1 c) = V1 (Core.mkCoin (Core.getCoin c * 2))
-            etxn <- run $ postTransaction wc payment
-            err <- liftIO (etxn `shouldPrism` _Left)
-            case err of
-                ClientWalletError (NotEnoughMoney (ErrAvailableBalanceIsInsufficient _)) ->
-                    return ()
+        randomTest "fails if you don't have any money" 1 $ run $ do
+            (wallet, account) <- fixtureWallet Nothing
+            resp <- makePayment (Core.mkCoin 14) (wallet, account) =<< getRandomAddress
+            let err = NotEnoughMoney (ErrAvailableBalanceIsInsufficient 0)
+            expectFailure (ClientWalletError err) resp
 
-                _ ->
-                    liftIO $ expectationFailure $
-                        "Expected 'NotEnoughMoney ~ ErrAvailableBalanceIsInsufficient', got: "
-                        <> show err
+        randomTest "fails if you spend more money than your available balance" 1 $ run $ do
+            (wallet, account) <- fixtureWallet (Just $ Core.mkCoin 42)
+            resp <- makePayment (Core.mkCoin 10000) (wallet, account) =<< getRandomAddress
+            let err = NotEnoughMoney (ErrAvailableBalanceIsInsufficient 42)
+            expectFailure (ClientWalletError err) resp
 
         randomTest "fails if you can't cover fee with a transaction" 1 $ run $ do
-            (wallet, account) <- fixtureWallet (Core.mkCoin 42)
+            (wallet, account) <- fixtureWallet (Just $ Core.mkCoin 42)
             resp <- makePayment (Core.mkCoin 42) (wallet, account) =<< getRandomAddress
             let err = NotEnoughMoney ErrCannotCoverFee
             expectFailure (ClientWalletError err) resp
@@ -277,15 +261,18 @@ transactionSpecs wRef wc = beforeAll_ (setupLogging "wallet-new_transactionSpecs
         return (unV1 $ addrId toAddr)
 
     fixtureWallet
-        :: Core.Coin
+        :: Maybe Core.Coin
         -> IO (Wallet, Account)
-    fixtureWallet coin = do
+    fixtureWallet mcoin = do
         genesis <- genesisWallet wc
         (genesisAccount, _) <- firstAccountAndId wc genesis
         wallet <- randomWallet CreateWallet >>= createWalletCheck wc
         (account, address) <- firstAccountAndId wc wallet
-        txn <- makePayment coin (genesis, genesisAccount) (unV1 $ addrId address) >>= shouldPrismFlipped _Right
-        pollTransactions wc (walId wallet) (accIndex account) (txId txn)
+        case mcoin of
+            Nothing   -> return ()
+            Just coin -> do
+                txn <- makePayment coin (genesis, genesisAccount) (unV1 $ addrId address) >>= shouldPrismFlipped _Right
+                pollTransactions wc (walId wallet) (accIndex account) (txId txn)
         return (wallet, account)
 
     expectFailure
@@ -295,4 +282,4 @@ transactionSpecs wRef wc = beforeAll_ (setupLogging "wallet-new_transactionSpecs
         -> IO ()
     expectFailure want eresp = do
         resp <- eresp `shouldPrism` _Left
-        want `shouldBe` resp
+        resp `shouldBe` want

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

@@ -11,6 +11,7 @@ import qualified Data.Text as T
 import           Formatting (build, sformat)
 import           Universum
 
+import qualified Data.Char as C
 import           Pos.Core (decodeTextAddress)
 
 import           Cardano.Wallet.API.V1.Types (V1 (..))
@@ -267,7 +268,8 @@ newTransactionError e = case e of
                 V1.TooBigTransaction
 
           ex@(CoinSelHardErrUtxoExhausted balance _payment) ->
-              case (readMaybe $ T.unpack balance) of
+              -- NOTE balance & payment are "prettified" coins representation (e.g. "42 coin(s)")
+              case (readMaybe $ T.unpack $ T.dropWhileEnd (not . C.isDigit) balance) of
                   Just coin ->
                       V1.NotEnoughMoney (V1.ErrAvailableBalanceIsInsufficient coin)
                   Nothing ->

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

@@ -238,8 +238,12 @@ 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 (Maybe (Core.TxIn, Core.TxOutAux))
+--
+-- NOTE: This cannot fail (as suggested by `forall e.`) but still runs in
+-- `CoinSelT` for conveniency; this way, it interfaces quite nicely with other
+-- functions.
+type PickUtxo m = forall e. Core.Coin  -- ^ Fee to still cover
+               -> CoinSelT Core.Utxo e m (Maybe (Core.TxIn, Core.TxOutAux))
 
 data CoinSelFinalResult = CoinSelFinalResult {
       csrInputs  :: NonEmpty (Core.TxIn, Core.TxOutAux)
@@ -385,9 +389,9 @@ largestFirst opts maxInps =
     pickUtxo :: PickUtxo m
     pickUtxo val = search . Map.toList =<< get
       where
-        search :: [(Core.TxIn, Core.TxOutAux)]
-               -> CoinSelT Core.Utxo CoinSelHardErr m (Maybe (Core.TxIn, Core.TxOutAux))
-        search [] = throwError CoinSelHardErrCannotCoverFee
+        search :: forall e. [(Core.TxIn, Core.TxOutAux)]
+               -> CoinSelT Core.Utxo e m (Maybe (Core.TxIn, Core.TxOutAux))
+        search [] = return Nothing
         search ((i, o):ios)
           | Core.txOutValue (Core.toaOut o) >= val = return $ Just (i, o)
           | otherwise                              = search ios

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

@@ -582,28 +582,18 @@ nLargestFromListBy f n = \xs ->
 
 -- | 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.
+-- Pre-condition 1: The given outputs list shouldn't be empty
+-- Pre-condition 2: None of the outputs should be null
 divvyFee :: forall dom a. CoinSelDom dom
           => (a -> Value dom) -> Fee dom -> [a] -> [(Fee dom, a)]
-divvyFee _ _   []                     = error "divvyFee: empty list"
-divvyFee f fee [a] | f a == valueZero = [(fee, a)]
-divvyFee f fee as                     = map (\a -> (feeForOut a, a)) as
+divvyFee _ _   []                             = error "divvyFee: empty list"
+divvyFee f _ as | any ((== valueZero) . f) as = error "divvyFee: some outputs are null"
+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 =
-        let
-            total = unsafeValueSum (map f as)
-        in
-            if total == valueZero then
-                error "divyyFee: invalid set of coins, total is 0"
-            else
-                total
+    totalOut = unsafeValueSum (map f as)
 
     -- The ratio will be between 0 and 1 so cannot overflow
     feeForOut :: a -> Fee dom

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

@@ -124,7 +124,7 @@ feeFromChange :: forall dom. CoinSelDom dom
               -> [CoinSelResult dom]
               -> ([CoinSelResult dom], Fee dom)
 feeFromChange totalFee =
-      bimap identity unsafeFeeSum
+    bimap identity unsafeFeeSum
     . unzip
     . map go
     . divvyFee (outVal . coinSelRequest) totalFee
@@ -143,13 +143,15 @@ feeFromChange totalFee =
 -- as unchanged as possible
 reduceChangeOutputs :: forall dom. CoinSelDom dom
                     => Fee dom -> [Value dom] -> ([Value dom], Fee dom)
-reduceChangeOutputs totalFee [] = ([], totalFee)
 reduceChangeOutputs totalFee cs =
-      bimap identity unsafeFeeSum
-    . unzip
-    . map go
-    . divvyFee identity totalFee
-    $ cs
+    case divvyFeeSafe identity totalFee cs of
+        Nothing ->
+            (cs, totalFee)
+        Just xs ->
+            bimap identity unsafeFeeSum
+            . unzip
+            . map go
+            $ xs
   where
     -- Reduce single change output, returning remaining fee
     go :: (Fee dom, Value dom) -> (Value dom, Fee dom)
@@ -171,6 +173,19 @@ feeUpperBound FeeOptions{..} css =
     numInputs = fromIntegral $ sum (map (sizeToWord . coinSelInputSize) css)
     outputs   = concatMap coinSelOutputs css
 
+-- | divvy fee across outputs, discarding zero-output if any. Returns `Nothing`
+-- when there's no more outputs after filtering, in which case, we just can't
+-- divvy fee.
+divvyFeeSafe
+    :: forall dom a. CoinSelDom dom
+    => (a -> Value dom)
+    -> Fee dom
+    -> [a]
+    -> Maybe [(Fee dom, a)]
+divvyFeeSafe f fee as = case filter ((/= valueZero) . f) as of
+    []  -> Nothing
+    as' -> Just (divvyFee f fee as')
+
 {-------------------------------------------------------------------------------
   Pretty-printing
 -------------------------------------------------------------------------------}

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

@@ -33,23 +33,10 @@ 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 initMaxNumInputs goals = do
-    balance <- gets utxoBalance
-    when (balance == valueZero) $ throwError (errUtxoExhausted balance)
-    coinSelPerGoal selection initMaxNumInputs goals
+random privacyMode = coinSelPerGoal $ \maxNumInputs goal ->
+    defCoinSelResult goal <$>
+      inRange maxNumInputs (target privacyMode (outVal goal))
   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)
@@ -111,18 +98,27 @@ atLeastNoFallback :: forall utxo m. (PickFromUtxo utxo, MonadRandom m)
                   => Word64
                   -> Value (Dom utxo)
                   -> CoinSelT utxo CoinSelErr m (SelectedUtxo (Dom utxo))
-atLeastNoFallback maxNumInputs targetMin = go emptySelection
+atLeastNoFallback maxNumInputs targetMin = do
+    balance <- gets utxoBalance
+    go emptySelection balance
   where
     go :: SelectedUtxo (Dom utxo)
+       -> Value (Dom utxo)
        -> CoinSelT utxo CoinSelErr m (SelectedUtxo (Dom utxo))
-    go selected
+    go selected balance
       | sizeToWord (selectedSize selected) > maxNumInputs =
           throwError $ CoinSelErrSoft CoinSelSoftErr
       | selectedBalance selected >= targetMin =
           return selected
       | otherwise = do
-          io <- mapCoinSelErr CoinSelErrHard $ findRandomOutput
-          go $ select io selected
+          io <- findRandomOutput >>= maybe (throwError $ errUtxoExhausted balance) return
+          go (select io selected) balance
+
+    errUtxoExhausted :: Value (Dom utxo) -> CoinSelErr
+    errUtxoExhausted balance =
+        CoinSelErrHard $ CoinSelHardErrUtxoExhausted
+            (pretty balance)
+            (pretty targetMin)
 
 -- | Select random additional inputs with the aim of improving the change amount
 --

src/Cardano/Wallet/Kernel/DB/Spec/Read.hs

@@ -56,9 +56,7 @@ cpAvailableBalance :: IsCheckpoint c => c -> Core.Coin
 cpAvailableBalance c =
     fromMaybe subCoinErr balance'
   where
-    pendingIns   = Set.union
-        (Pending.txIns $ c ^. cpPending)
-        (Pending.txIns $ c ^. cpForeign)
+    pendingIns   = Pending.txIns $ c ^. cpPending
     spentUtxo    = Core.utxoRestrictToInputs (c ^. cpUtxo) pendingIns
     spentBalance = Core.unsafeIntegerToCoin $ Core.utxoBalance spentUtxo
     balance'     = Core.subCoin (c ^. cpUtxoBalance) spentBalance

test/unit/Test/Spec/CoinSelection/Generators.hs

@@ -267,7 +267,7 @@ utxoSmallestEntry utxo =
 genPayees :: Core.Utxo -> Pay -> Gen (NonEmpty Core.TxOut)
 genPayees utxo payment = do
     let balance            = toLovelaces payment
-        halfOfUtxoSmallest = (Core.getCoin $ utxoSmallestEntry utxo) `div` 2
+        halfOfUtxoSmallest = max 1 $ (Core.getCoin $ utxoSmallestEntry utxo) `div` 2
     genTxOut StakeGenOptions {
                stakeMaxValue         = Just (Core.mkCoin halfOfUtxoSmallest)
              , stakeGenerationTarget = AtLeast