Merge #4058

4058: Support UtxoNotEnoughFragmented error r=KtorZ a=paweljakubas

Add multioutput integration tests

Fix Lens accesses and confusion between WalAddress vs WalletAddress vs V1 Address

## Description

This is backport of cardano-foundation/cardano-wallet#190

## Linked issue

<!--- Put here the relevant issue from YouTrack -->



Co-authored-by: Pawel Jakubas <[email protected]>

Author: iohk-bors[bot]

CHANGELOG.md

@@ -1,6 +1,6 @@
 # CHANGELOG
 
-## Cardano SL 3.0.0 
+## Cardano SL 3.0.0
 
 ### Fixes
 
@@ -29,7 +29,7 @@
 
 - Additional node settings exposed through the wallet backend API in `/api/v1/node-settings`. This is in order to align and be on-par with the new node monitoring API. [#4045](https://github.com/input-output-hk/cardano-sl/pull/4045)
   Added settings:
-    - `slotId`: The current slot and epoch 
+    - `slotId`: The current slot and epoch
     - `slotCount`: The number of slots per epoch
     - `maxTxSize`: The largest allowed transaction size in bytes
     - `feePolicy`: The fee policy, in flat Lovelace and variable Lovelace/byte
@@ -269,6 +269,9 @@
 - Add a test which checks if the configuration can be correctly parsed
     - [CDEC-405](https://iohk.myjetbrains.com/youtrack/issue/CDEC-405) [#3175](https://github.com/input-output-hk/cardano-sl/pull/3175)
 
+- Add Utxo not enough fragmentation error handling and multi-output transaction tests
+    - [cardano-wallet#190](https://github.com/input-output-hk/cardano-wallet/issues/190) [#4058](https://github.com/input-output-hk/cardano-sl/pull/4058)
+
 ### Documentation
 
 - Make an inventory of existing wallet errors and exceptions ([CBR-307](https://iohk.myjetbrains.com/youtrack/issue/CO-307))

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

@@ -306,6 +306,9 @@ newTransactionError e = case e of
     Kernel.NewTransactionInvalidTxIn ->
             V1.SignedTxSubmitError "NewTransactionInvalidTxIn"
 
+    (Kernel.NewTransactionNotEnoughUtxoFragmentation (Kernel.NumberOfMissingUtxos missingUtxo)) ->
+        V1.UtxoNotEnoughFragmented (V1.ErrUtxoNotEnoughFragmented missingUtxo V1.msgUtxoNotEnoughFragmented)
+
 redeemAdaError :: RedeemAdaError -> V1.WalletError
 redeemAdaError e = case e of
     (RedeemAdaError e') -> case e' of

wallet/src/Cardano/Wallet/API/V1/Swagger.hs

@@ -335,7 +335,7 @@ $errors
 
     -- 'UnsupportedMimeTypeError'
     , mkRow fmtErr $ UnsupportedMimeTypePresent "Expected Content-Type's main MIME-type to be 'application/json'."
-
+    , mkRow fmtErr $ UtxoNotEnoughFragmented (ErrUtxoNotEnoughFragmented 1 msgUtxoNotEnoughFragmented)
     -- TODO 'MnemonicError' ?
     ]
   mkRow fmt err = T.intercalate "|" (fmt err)
@@ -684,6 +684,40 @@ curl -X POST https://localhost:8090/api/v1/transactions \
 ```
 
 
+About UTXO Fragmentation
+------------------------
+
+As described in [Sending Money to Multiple Recipients](#section/Common-Use-Cases/Sending-Money-to-Multiple-Recipients), it is possible to send ada to more than one destination. Cardano only allows a given UTXO to cover at most one single transaction output. As a result,
+when the number of transaction outputs is greater than the number the API returns a `UtxoNotEnoughFragmented` error which
+looks like the following
+```
+{
+    "status": "error",
+    "diagnostic": {
+        "details": {
+            "help": "Utxo is not enough fragmented to handle the number of outputs of this transaction. Query /api/v1/wallets/{walletId}/statistics/utxos endpoint for more information",
+            "missingUtxos": 1
+        }
+    },
+    "message": "UtxoNotEnoughFragmented"
+}
+```
+
+To make sure the source account has a sufficient level of UTXO fragmentation (i.e. number of UTXOs),
+please monitor the state of the UTXOs as described in [Getting UTXO Statistics](#section/Common-Use-Cases/Getting-Utxo-Statistics). The
+number of wallet UTXOs should be no less than the transaction outputs, and the sum of all UTXOs should be enough to cover the total
+transaction amount, including fees.
+
+Contrary to a classic accounting model, there's no such thing as spending _part of a UTXO_, and one has to wait for a transaction to be included in a
+block before spending the remaining change. This is very similar to using bank notes: one can't spend a USD 20 bill at two different shops at the same time,
+even if it is enough to cover both purchases — one has to wait for change from the first transaction before making the second one.
+There's no "ideal" level of fragmentation; it depends on one's needs. However, the more UTXOs that are available, the higher the concurrency capacity
+of one's wallet, allowing multiple transactions to be made at the same time.
+
+Similarly, there's no practical maximum number of UTXOs, but there is nevertheless a maximum transaction size. By having many small UTXOs,
+one is taking the risk of hitting that restriction, should too many inputs be selected to fill a transaction. The only way to
+work around this is to make multiple smaller transactions.
+
 Estimating Transaction Fees
 ---------------------------
 

wallet/src/Cardano/Wallet/API/V1/Types.hs

@@ -106,6 +106,8 @@ module Cardano.Wallet.API.V1.Types (
   -- * Wallet Errors
   , WalletError(..)
   , ErrNotEnoughMoney(..)
+  , ErrUtxoNotEnoughFragmented(..)
+  , msgUtxoNotEnoughFragmented
   , toServantError
   , toHttpErrorStatus
   , module Cardano.Wallet.Types.UtxoStatistics
@@ -1883,6 +1885,21 @@ instance FromJSON ErrNotEnoughMoney where
             when (msg /= sformat build (ErrAvailableBalanceIsInsufficient 0)) mempty
             ErrAvailableBalanceIsInsufficient <$> (o .: "availableBalance")
 
+data ErrUtxoNotEnoughFragmented = ErrUtxoNotEnoughFragmented {
+      theMissingUtxos :: !Int
+    , theHelp         :: !Text
+    } deriving (Eq, Generic, Show)
+
+
+msgUtxoNotEnoughFragmented :: Text
+msgUtxoNotEnoughFragmented = "Utxo is not enough fragmented to handle the number of outputs of this transaction. Query /api/v1/wallets/{walletId}/statistics/utxos endpoint for more information"
+
+deriveJSON Aeson.defaultOptions ''ErrUtxoNotEnoughFragmented
+
+instance Buildable ErrUtxoNotEnoughFragmented where
+    build (ErrUtxoNotEnoughFragmented missingUtxos _ ) =
+        bprint ("Missing "%build%" utxo(s) to accommodate all outputs of the transaction") missingUtxos
+
 
 -- | Type representing any error which might be thrown by wallet.
 --
@@ -1948,6 +1965,9 @@ data WalletError =
     | RequestThrottled !Word64
     -- ^ The request has been throttled. The 'Word64' is a count of microseconds
     -- until the user should retry.
+    | UtxoNotEnoughFragmented !ErrUtxoNotEnoughFragmented
+    -- ^ available Utxo is not enough fragmented, ie., there is more outputs of transaction than
+    -- utxos
     deriving (Generic, Show, Eq)
 
 deriveGeneric ''WalletError
@@ -1990,6 +2010,9 @@ instance Arbitrary WalletError where
         , NodeIsStillSyncing <$> arbitrary
         , CannotCreateAddress <$> arbitraryText
         , RequestThrottled <$> arbitrary
+        , UtxoNotEnoughFragmented <$> Gen.oneof
+          [ ErrUtxoNotEnoughFragmented <$> Gen.choose (1, 10) <*> arbitrary
+          ]
         ]
       where
         arbitraryText :: Gen Text
@@ -2046,7 +2069,8 @@ instance Buildable WalletError where
             bprint "Cannot create derivation path for new address, for external wallet."
         RequestThrottled _ ->
             bprint "You've made too many requests too soon, and this one was throttled."
-
+        UtxoNotEnoughFragmented x ->
+            bprint build x
 
 -- | Convert wallet errors to Servant errors
 instance ToServantError WalletError where
@@ -2089,6 +2113,8 @@ instance ToServantError WalletError where
             err500
         RequestThrottled{} ->
             err400 { errHTTPCode = 429 }
+        UtxoNotEnoughFragmented{} ->
+            err403
 
 -- | Declare the key used to wrap the diagnostic payload, if any
 instance HasDiagnostic WalletError where
@@ -2131,3 +2157,5 @@ instance HasDiagnostic WalletError where
             "msg"
         RequestThrottled{} ->
             "microsecondsUntilRetry"
+        UtxoNotEnoughFragmented{} ->
+            "details"

wallet/src/Cardano/Wallet/Kernel/Transactions.hs

@@ -10,6 +10,7 @@ module Cardano.Wallet.Kernel.Transactions (
     , PaymentError(..)
     , EstimateFeesError(..)
     , RedeemAdaError(..)
+    , NumberOfMissingUtxos(..)
     , cardanoFee
     , mkStdTx
     , prepareUnsignedTxWithSources
@@ -85,13 +86,24 @@ import           UTxO.Util (shuffleNE)
   Generating payments and estimating fees
 -------------------------------------------------------------------------------}
 
+data NumberOfMissingUtxos = NumberOfMissingUtxos Int
+
+instance Buildable NumberOfMissingUtxos where
+    build (NumberOfMissingUtxos number) =
+        bprint ("NumberOfMissingUtxos " % build) number
+
+instance Arbitrary NumberOfMissingUtxos where
+    arbitrary = oneof [ NumberOfMissingUtxos <$> arbitrary
+                      ]
+
 data NewTransactionError =
     NewTransactionUnknownAccount UnknownHdAccount
   | NewTransactionUnknownAddress UnknownHdAddress
   | NewTransactionErrorCoinSelectionFailed CoinSelHardErr
   | NewTransactionErrorCreateAddressFailed Kernel.CreateAddressError
   | NewTransactionErrorSignTxFailed SignTransactionError
   | NewTransactionInvalidTxIn
+  | NewTransactionNotEnoughUtxoFragmentation NumberOfMissingUtxos
 
 instance Buildable NewTransactionError where
     build (NewTransactionUnknownAccount err) =
@@ -106,6 +118,9 @@ instance Buildable NewTransactionError where
         bprint ("NewTransactionErrorSignTxFailed " % build) err
     build NewTransactionInvalidTxIn =
         bprint "NewTransactionInvalidTxIn"
+    build (NewTransactionNotEnoughUtxoFragmentation err) =
+        bprint ("NewTransactionNotEnoughUtxoFragmentation" % build) err
+
 
 instance Arbitrary NewTransactionError where
     arbitrary = oneof [
@@ -117,6 +132,7 @@ instance Arbitrary NewTransactionError where
       , NewTransactionErrorCreateAddressFailed <$> arbitrary
       , NewTransactionErrorSignTxFailed <$> arbitrary
       , pure NewTransactionInvalidTxIn
+      , NewTransactionNotEnoughUtxoFragmentation <$> arbitrary
       ]
 
 data PaymentError = PaymentNewTransactionError NewTransactionError
@@ -214,6 +230,9 @@ newUnsignedTransaction ActiveWallet{..} options accountId payees = runExceptT $
     availableUtxo <- withExceptT NewTransactionUnknownAccount $ exceptT $
                        currentAvailableUtxo snapshot accountId
 
+    withExceptT NewTransactionNotEnoughUtxoFragmentation $ exceptT $
+        checkUtxoFragmentation payees availableUtxo
+
     -- STEP 1: Run coin selection.
     CoinSelFinalResult inputs outputs coins <-
       withExceptT NewTransactionErrorCoinSelectionFailed $ ExceptT $
@@ -247,6 +266,19 @@ newUnsignedTransaction ActiveWallet{..} options accountId payees = runExceptT $
     toTxOut :: (Address, Coin) -> TxOutAux
     toTxOut (a, c) = TxOutAux (TxOut a c)
 
+    checkUtxoFragmentation
+        :: NonEmpty (Address, Coin)
+        -> Utxo
+        -> Either NumberOfMissingUtxos ()
+    checkUtxoFragmentation outputs inputs =
+        let numberOfUtxo = Map.size inputs
+            numberOfOutputs = NonEmpty.length outputs
+            diff = numberOfOutputs - numberOfUtxo
+        in if diff > 0 then
+            Left $ NumberOfMissingUtxos diff
+           else
+            Right ()
+
 -- | Creates a new unsigned transaction.
 --
 -- NOTE: this function does /not/ perform a payment, it just creates a new

wallet/test/integration/Test/Integration/Framework/DSL.hs

@@ -37,6 +37,7 @@ module Test.Integration.Framework.DSL
     , defaultAccountId
     , defaultAssuranceLevel
     , defaultDistribution
+    , customDistribution
     , defaultGroupingPolicy
     , defaultPage
     , defaultPerPage
@@ -72,6 +73,8 @@ module Test.Integration.Framework.DSL
     , ($-)
     , (</>)
     , (!!)
+    , addresses
+    , walAddresses
     , amount
     , assuranceLevel
     , backupPhrase
@@ -106,6 +109,7 @@ import           Data.Generics.Internal.VL.Lens (lens)
 import           Data.Generics.Product.Fields (field)
 import           Data.Generics.Product.Typed (HasType, typed)
 import           Data.List ((!!))
+import qualified Data.List.NonEmpty as NonEmpty
 import qualified Data.Map.Strict as Map
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as T
@@ -268,6 +272,21 @@ defaultDistribution
 defaultDistribution c s = pure $
     PaymentDistribution (V1 $ head $ s ^. typed) (V1 $ mkCoin c)
 
+customDistribution
+    :: NonEmpty (Account, Word64)
+    -> NonEmpty PaymentDistribution
+customDistribution payees =
+    let recepientWalAddresses =
+            NonEmpty.fromList
+            $ map (view walAddresses)
+            $ concatMap (view addresses . fst)
+            $ payees
+
+    in NonEmpty.zipWith
+       PaymentDistribution
+       recepientWalAddresses
+       (map ((\coin -> V1 $ mkCoin coin) . snd) payees)
+
 defaultGroupingPolicy :: Maybe (V1 InputSelectionPolicy)
 defaultGroupingPolicy = Nothing
 
@@ -386,6 +405,11 @@ walletName = typed
 spendingPasswordLastUpdate :: Lens' Wallet (V1 Timestamp)
 spendingPasswordLastUpdate = field @"walSpendingPasswordLastUpdate"
 
+addresses :: HasType [WalletAddress] s => Lens' s [WalletAddress]
+addresses = typed
+
+walAddresses :: HasType (V1 Address) s => Lens' s (V1 Address)
+walAddresses = typed
 
 --
 -- EXPECTATIONS