diff --git a/integration/TransactionSpecs.hs b/integration/TransactionSpecs.hs index bd0d37d9483..7b6740bc7e1 100644 --- a/integration/TransactionSpecs.hs +++ b/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 diff --git a/src/Cardano/Wallet/API/V1/ReifyWalletError.hs b/src/Cardano/Wallet/API/V1/ReifyWalletError.hs index d4d4cd7b75d..cf6c961c6e1 100644 --- a/src/Cardano/Wallet/API/V1/ReifyWalletError.hs +++ b/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 -> diff --git a/src/Cardano/Wallet/Kernel/CoinSelection/FromGeneric.hs b/src/Cardano/Wallet/Kernel/CoinSelection/FromGeneric.hs index 11ec7ab5d65..035d66e358f 100644 --- a/src/Cardano/Wallet/Kernel/CoinSelection/FromGeneric.hs +++ b/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 diff --git a/src/Cardano/Wallet/Kernel/CoinSelection/Generic.hs b/src/Cardano/Wallet/Kernel/CoinSelection/Generic.hs index 95256e441e3..77e1fe24fed 100644 --- a/src/Cardano/Wallet/Kernel/CoinSelection/Generic.hs +++ b/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 diff --git a/src/Cardano/Wallet/Kernel/CoinSelection/Generic/Fees.hs b/src/Cardano/Wallet/Kernel/CoinSelection/Generic/Fees.hs index 9f9fe79f03f..1532f340960 100644 --- a/src/Cardano/Wallet/Kernel/CoinSelection/Generic/Fees.hs +++ b/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 -------------------------------------------------------------------------------} diff --git a/src/Cardano/Wallet/Kernel/CoinSelection/Generic/Random.hs b/src/Cardano/Wallet/Kernel/CoinSelection/Generic/Random.hs index cce5d2a3eed..49d92f52861 100644 --- a/src/Cardano/Wallet/Kernel/CoinSelection/Generic/Random.hs +++ b/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 -- diff --git a/src/Cardano/Wallet/Kernel/DB/Spec/Read.hs b/src/Cardano/Wallet/Kernel/DB/Spec/Read.hs index e33fd053d50..b69f3b7c5f1 100644 --- a/src/Cardano/Wallet/Kernel/DB/Spec/Read.hs +++ b/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 diff --git a/test/unit/Test/Spec/CoinSelection/Generators.hs b/test/unit/Test/Spec/CoinSelection/Generators.hs index 2d09de2065f..19b5e2b427f 100644 --- a/test/unit/Test/Spec/CoinSelection/Generators.hs +++ b/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