diff --git a/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Pure/State/Payment.hs b/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Pure/State/Payment.hs index df2013f37b3..8c5010ccb28 100644 --- a/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Pure/State/Payment.hs +++ b/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 diff --git a/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Write.hs b/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Write.hs index acea171ce3b..9d9784b3bf3 100644 --- a/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Write.hs +++ b/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 (..) )