Translate possible cases of ErrBalanceTx to ErrCreatePayment

lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Pure/State/Payment.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
 module Cardano.Wallet.Deposit.Pure.State.Payment
@@ -9,12 +10,16 @@ module Cardano.Wallet.Deposit.Pure.State.Payment
     , createPaymentTxBody
     , CurrentEraResolvedTx
     , resolveCurrentEraTx
+    , translateBalanceTxError
     ) where
 
 import Prelude hiding
     ( lookup
     )
 
+import Cardano.Ledger.Val
+    ( isAdaOnly
+    )
 import Cardano.Wallet.Deposit.Pure.State.Submissions
     ( availableUTxO
     )
@@ -29,8 +34,21 @@ import Cardano.Wallet.Deposit.Read
     ( Address
     )
 import Cardano.Wallet.Deposit.Write
-    ( Tx
+    ( Coin
+    , Tx
     , TxBody (..)
+    , Value
+    )
+import Cardano.Wallet.Primitive.Types.Tx.Constraints
+    ( TxSize (..)
+    )
+import Cardano.Wallet.Read
+    ( AssetID (AdaID)
+    , Coin (..)
+    , fromEraValue
+    , injectCoin
+    , lookupAssetID
+    , toMaryValue
     )
 import Control.Monad.Trans.Except
     ( runExceptT
@@ -41,10 +59,21 @@ import Data.Bifunctor
 import Data.Digest.CRC32
     ( crc32
     )
+import Data.Fixed
+    ( E6
+    , Fixed
+    )
+import Data.Text
+    ( Text
+    )
 import Data.Text.Class.Extended
     ( ToText (..)
     )
+import Numeric.Natural
+    ( Natural
+    )
 
+import qualified Cardano.Read.Ledger.Value as Read.L
 import qualified Cardano.Wallet.Deposit.Pure.Address as Address
 import qualified Cardano.Wallet.Deposit.Read as Read
 import qualified Cardano.Wallet.Deposit.Write as Write
@@ -55,15 +84,143 @@ import qualified Data.Text as T
 
 data ErrCreatePayment
     = ErrCreatePaymentNotRecentEra (Read.EraValue Read.Era)
-    | ErrCreatePaymentBalanceTx (Write.ErrBalanceTx Write.Conway)
+    | ErrNotEnoughAda { shortfall :: Value }
+    | ErrEmptyUTxO
+
+    | ErrTxOutAdaInsufficient { outputIx :: Int, suggestedMinimum :: Coin }
+
+    -- | Only possible when sending (non-ada) assets.
+    | ErrTxOutValueSizeExceedsLimit { outputIx :: Int }
+
+    -- | Only possible when sending (non-ada) assets.
+    | ErrTxOutTokenQuantityExceedsLimit
+        { outputIx :: Int
+        , quantity :: Natural
+        , quantityMaxBound :: Natural
+        }
+
+    -- | The final balanced tx was too big. Either because the payload was too
+    -- big to begin with, or because we failed to select enough inputs without
+    -- making it too big, e.g. due to the UTxO containing lots of dust.
+    --
+    -- We should ideally split out 'TooManyPayments' from this error.
+    -- We should ideally also be able to create payments even when dust causes
+    -- us to need preparatory txs.
+    | ErrTxMaxSizeLimitExceeded{ size :: TxSize, maxSize :: TxSize }
     deriving (Eq, Show)
 
+translateBalanceTxError :: Write.ErrBalanceTx Write.Conway -> ErrCreatePayment
+translateBalanceTxError = \case
+    Write.ErrBalanceTxAssetsInsufficient
+        Write.ErrBalanceTxAssetsInsufficientError{shortfall} ->
+            ErrNotEnoughAda
+                { shortfall = fromLedgerValue shortfall
+                }
+    Write.ErrBalanceTxMaxSizeLimitExceeded{size, maxSize} ->
+            ErrTxMaxSizeLimitExceeded{size, maxSize}
+    Write.ErrBalanceTxExistingKeyWitnesses _ ->
+        impossible "ErrBalanceTxExistingKeyWitnesses"
+    Write.ErrBalanceTxExistingCollateral ->
+        impossible "ErrBalanceTxExistingCollateral"
+    Write.ErrBalanceTxExistingTotalCollateral ->
+        impossible "ErrBalanceTxExistingTotalCollateral"
+    Write.ErrBalanceTxExistingReturnCollateral ->
+        impossible "ErrBalanceTxExistingReturnCollateral"
+    Write.ErrBalanceTxInsufficientCollateral _ ->
+        impossible "ErrBalanceTxInsufficientCollateral"
+    Write.ErrBalanceTxAssignRedeemers _ ->
+        impossible "ErrBalanceTxAssignRedeemers"
+    Write.ErrBalanceTxInternalError e ->
+        impossible $ show e
+    Write.ErrBalanceTxInputResolutionConflicts _ ->
+        -- We are never creating partialTxs with pre-selected inputs, which
+        -- means this is impossible.
+        impossible "conflicting input resolution"
+    Write.ErrBalanceTxUnresolvedInputs _ ->
+        -- We are never creating partialTxs with pre-selected inputs, which
+        -- means this is impossible.
+        impossible "unresolved inputs"
+    Write.ErrBalanceTxUnresolvedRefunds _ ->
+        impossible "unresolved refunds"
+    Write.ErrBalanceTxOutputError (Write.ErrBalanceTxOutputErrorOf ix info) -> case info of
+        Write.ErrBalanceTxOutputAdaQuantityInsufficient{minimumExpectedCoin} ->
+            ErrTxOutAdaInsufficient
+                { outputIx = ix
+                , suggestedMinimum = minimumExpectedCoin
+                }
+        Write.ErrBalanceTxOutputSizeExceedsLimit{} ->
+            ErrTxOutValueSizeExceedsLimit
+                { outputIx = ix
+                }
+        Write.ErrBalanceTxOutputTokenQuantityExceedsLimit{quantity, quantityMaxBound} ->
+            ErrTxOutTokenQuantityExceedsLimit
+                { outputIx = ix
+                , quantity
+                , quantityMaxBound
+                }
+    Write.ErrBalanceTxUnableToCreateChange
+        Write.ErrBalanceTxUnableToCreateChangeError{shortfall} ->
+        ErrNotEnoughAda
+            { shortfall = injectCoin shortfall
+            }
+    Write.ErrBalanceTxUnableToCreateInput ->
+        ErrEmptyUTxO
+
+  where
+    fromLedgerValue v = fromEraValue (Read.L.Value v :: Read.L.Value Write.Conway)
+
+    impossible :: String -> a
+    impossible reason = error $ "impossible: translateBalanceTxError: " <> reason
+
 instance ToText ErrCreatePayment where
     toText = \case
         ErrCreatePaymentNotRecentEra era ->
-            "Cannot create a payment in the era: " <> T.pack (show era)
-        ErrCreatePaymentBalanceTx err ->
-            "Cannot create a payment: " <> T.pack (show err)
+            "Cannot create a payment in the era: " <> showT era
+        ErrNotEnoughAda{shortfall} -> T.unwords
+            [ "Insufficient funds. Shortfall: ", prettyValue shortfall
+            ]
+        ErrEmptyUTxO -> "Wallet has no funds"
+        ErrTxOutAdaInsufficient{outputIx, suggestedMinimum} -> T.unwords
+            [ "Ada amount in output " <> showT outputIx
+            , "is below the required minimum."
+            , "Suggested minimum amount:", prettyCoin suggestedMinimum
+            ]
+        ErrTxMaxSizeLimitExceeded{size, maxSize} -> T.unlines
+            [ "Exceeded the maximum size limit when creating the transaction."
+                <> " (size: ", prettyTxSize size, " max size: ", prettyTxSize maxSize <> ")"
+            , "\nPotential solutions:"
+            , "1) Make fewer payments at the same time."
+            , "2) Send smaller amounts of ada in total."
+            , "3) Fund wallet with more ada."
+            , "4) Make preparatory payments to yourself to coalesce dust into"
+            , "larger UTxOs."
+            ]
+        ErrTxOutValueSizeExceedsLimit{outputIx} -> T.unwords
+            [ "The size of the value of output", showT outputIx, "is too large."
+            , "Try sending fewer assets or splitting them over multiple outputs."
+            ]
+        ErrTxOutTokenQuantityExceedsLimit{outputIx, quantity, quantityMaxBound} -> T.unwords
+            [ "The asset quantity of ", showT quantity, "in output"
+            , showT outputIx, ", is larger than the maximum allowed"
+            , "limit", showT quantityMaxBound <> "."
+            ]
+      where
+        showT :: Show a => a -> Text
+        showT = T.pack . show
+
+        prettyTxSize :: TxSize -> Text
+        prettyTxSize (TxSize s) = T.pack (show s)
+
+        prettyValue :: Value -> Text
+        prettyValue v
+            | isAdaOnly (toMaryValue v) = prettyCoin (CoinC $ lookupAssetID AdaID v)
+            | otherwise                 = T.pack (show v)
+
+        prettyCoin :: Coin -> Text
+        prettyCoin c = T.pack (show c') <> "₳"
+          where
+            c' :: Fixed E6
+            c' = toEnum $ fromEnum c
 
 type CurrentEraResolvedTx = ResolvedTx Read.Conway
 
@@ -93,7 +250,7 @@ createPaymentTxBody
     state =
         case Read.theEra :: Read.Era era of
             Read.Conway ->
-                first ErrCreatePaymentBalanceTx
+                first translateBalanceTxError
                     $ flip resolveCurrentEraTx state
                         <$> createPaymentConway
                             pparams

lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Write.hs

@@ -16,6 +16,7 @@ module Cardano.Wallet.Deposit.Write
     , TxBody (..)
     , TxIn
     , TxOut
+    , Coin
 
       -- * Transaction balancing
     , Write.IsRecentEra
@@ -31,6 +32,13 @@ module Cardano.Wallet.Deposit.Write
     , toConwayUTxO
     , Write.PartialTx (..)
     , Write.ErrBalanceTx (..)
+    , Write.ErrBalanceTxAssetsInsufficientError (..)
+    , Write.ErrBalanceTxInsufficientCollateralError (..)
+    , Write.ErrBalanceTxInternalError (..)
+    , Write.ErrBalanceTxOutputError (..)
+    , Write.ErrBalanceTxOutputErrorInfo (..)
+    , Write.ErrBalanceTxUnableToCreateChangeError (..)
+    , Write.ErrAssignRedeemers (..)
     , Write.balanceTx
 
       -- * Signing
@@ -53,6 +61,9 @@ module Cardano.Wallet.Deposit.Write
 
 import Prelude
 
+import Cardano.Ledger.Coin
+    ( Coin
+    )
 import Cardano.Read.Ledger.Tx.Output
     ( Output (..)
     )