feat: balance tx fails fast on txcoll or collRet

lib/core/src/Cardano/Api/Gen.hs

@@ -16,15 +16,14 @@ module Cardano.Api.Gen
     , genAssetIdNoAda
     , genAssetName
     , genByronKeyWitness
+    , genCertIx
     , genCostModel
     , genCostModels
     , genEncodingBoundaryLovelace
     , genEpochNo
     , genExecutionUnitPrices
     , genExecutionUnits
     , genExtraKeyWitnesses
-    , genTxIx
-    , genCertIx
     , genLovelace
     , genMIRPot
     , genMIRTarget
@@ -75,17 +74,20 @@ module Cardano.Api.Gen
     , genTxForBalancing
     , genTxId
     , genTxIn
-    , genTxInEra
     , genTxIndex
+    , genTxInEra
     , genTxInsCollateral
+    , genTxIx
     , genTxMetadata
     , genTxMetadataInEra
     , genTxMetadataValue
     , genTxMintValue
     , genTxOut
     , genTxOutDatum
     , genTxOutValue
+    , genTxReturnCollateral
     , genTxScriptValidity
+    , genTxTotalCollateral
     , genTxValidityLowerBound
     , genTxValidityRange
     , genTxValidityUpperBound
@@ -98,9 +100,9 @@ module Cardano.Api.Gen
     , genVerificationKeyHash
     , genWithdrawalInfo
     , genWitness
+    , genWitnesses
     , genWitnessNetworkIdOrByronAddress
     , genWitnessStake
-    , genWitnesses
     ) where
 
 import Prelude
@@ -400,12 +402,30 @@ genExtraKeyWitnesses :: CardanoEra era -> Gen (TxExtraKeyWitnesses era)
 genExtraKeyWitnesses era =
     case extraKeyWitnessesSupportedInEra era of
         Nothing -> pure TxExtraKeyWitnessesNone
-        Just supported  -> oneof
+        Just supported -> oneof
             [ pure TxExtraKeyWitnessesNone
             , TxExtraKeyWitnesses supported
               <$> scale (`div` 3) (listOf (genVerificationKeyHash AsPaymentKey))
             ]
 
+genTxTotalCollateral :: CardanoEra era -> Gen (TxTotalCollateral era)
+genTxTotalCollateral era =
+    case totalAndReturnCollateralSupportedInEra era of
+        Nothing -> pure TxTotalCollateralNone
+        Just supported -> oneof
+            [ pure TxTotalCollateralNone
+            , TxTotalCollateral supported <$> genLovelace
+            ]
+
+genTxReturnCollateral :: CardanoEra era -> Gen (TxReturnCollateral ctx era)
+genTxReturnCollateral era =
+    case totalAndReturnCollateralSupportedInEra era of
+        Nothing -> pure TxReturnCollateralNone
+        Just supported -> oneof
+            [ pure TxReturnCollateralNone
+            , TxReturnCollateral supported <$> genTxOut era
+            ]
+
 genPlutusScript :: PlutusScriptVersion lang -> Gen (PlutusScript lang)
 genPlutusScript _ =
     -- We make no attempt to create a valid script
@@ -1330,6 +1350,8 @@ genTxBodyContent era = do
     txMintValue <- genTxMintValue era
     txScriptValidity <- genTxScriptValidity era
     txExtraKeyWits <- genExtraKeyWitnesses era
+    txTotalCollateral <- genTxTotalCollateral era
+    txReturnCollateral <- genTxReturnCollateral era
 
     let
         txBody = TxBodyContent
@@ -1344,10 +1366,8 @@ genTxBodyContent era = do
             -- TODO add proper generator, perhaps as part of ADP-1655
             , Api.txInsReference = TxInsReferenceNone
 
-            -- TODO add proper generators, perhaps as part of ADP-1653
-            , Api.txTotalCollateral = TxTotalCollateralNone
-            , Api.txReturnCollateral = TxReturnCollateralNone
-
+            , Api.txTotalCollateral
+            , Api.txReturnCollateral
             , Api.txFee
             , Api.txValidityRange
             , Api.txMetadata

lib/core/src/Cardano/Wallet.hs

@@ -1593,6 +1593,8 @@ balanceTransactionWithSelectionStrategy
     ptx@(PartialTx partialTx externalInputs redeemers)
     = do
     guardExistingCollateral partialTx
+    guardExistingTotalCollateral partialTx
+    guardExistingReturnCollateral partialTx
     guardZeroAdaOutputs (extractOutputsFromTx $ toSealed partialTx)
     guardConflictingWithdrawalNetworks partialTx
 
@@ -1851,6 +1853,18 @@ balanceTransactionWithSelectionStrategy
             Cardano.TxInsCollateral _ _ ->
                 throwE ErrBalanceTxExistingCollateral
 
+    guardExistingTotalCollateral (Cardano.Tx (Cardano.TxBody body) _) =
+        case Cardano.txTotalCollateral body of
+            Cardano.TxTotalCollateralNone -> return ()
+            Cardano.TxTotalCollateral _ _ ->
+               throwE ErrBalanceTxExistingTotalCollateral
+
+    guardExistingReturnCollateral (Cardano.Tx (Cardano.TxBody body) _) =
+        case Cardano.txReturnCollateral body of
+            Cardano.TxReturnCollateralNone -> return ()
+            Cardano.TxReturnCollateral _ _ ->
+               throwE ErrBalanceTxExistingReturnCollateral
+
     -- | Select assets to cover the specified balance and fee.
     --
     -- If the transaction contains redeemers, the function will also ensure the
@@ -3436,6 +3450,8 @@ data ErrBalanceTx
     | ErrBalanceTxSelectAssets ErrSelectAssets
     | ErrBalanceTxMaxSizeLimitExceeded
     | ErrBalanceTxExistingCollateral
+    | ErrBalanceTxExistingTotalCollateral
+    | ErrBalanceTxExistingReturnCollateral
     | ErrBalanceTxConflictingNetworks
     | ErrBalanceTxAssignRedeemers ErrAssignRedeemers
     | ErrBalanceTxInternalError ErrBalanceTxInternalError

lib/core/src/Cardano/Wallet/Api/Server.hs

@@ -4522,10 +4522,10 @@ instance IsServerError ErrDecodeTx where
 instance IsServerError ErrBalanceTx where
     toServerError = \case
         ErrByronTxNotSupported ->
-            apiError err403 CreatedInvalidTransaction
+            apiError err403 BalanceTxByronNotSupported
                 "Balancing Byron transactions is not supported."
         ErrBalanceTxUpdateError (ErrExistingKeyWitnesses n) ->
-            apiError err403 CreatedInvalidTransaction $ mconcat
+            apiError err403 BalanceTxExistingKeyWitnesses $ mconcat
                 [ "The transaction could not be balanced, because it contains "
                 , T.pack (show n), " "
                 , "existing key-witnesses which would be invalid after "
@@ -4535,34 +4535,45 @@ instance IsServerError ErrBalanceTx where
         ErrBalanceTxSelectAssets err -> toServerError err
         ErrBalanceTxAssignRedeemers err -> toServerError err
         ErrBalanceTxConflictingNetworks ->
-            apiError err403 CreatedInvalidTransaction $ mconcat
-                [ "There are withdrawals for multiple networks (e.g. both "
-                , "mainnet and testnet) in the provided transaction. This "
+            apiError err403 BalanceTxConflictingNetworks $ T.unwords
+                [ "There are withdrawals for multiple networks (e.g. both"
+                , "mainnet and testnet) in the provided transaction. This"
                 , "makes no sense, and I'm confused."
                 ]
         ErrBalanceTxExistingCollateral ->
-            apiError err403 CreatedInvalidTransaction $ mconcat
-                [ "I cannot balance transactions with pre-defined collateral."
+            apiError err403 BalanceTxExistingCollateral
+                "I cannot balance transactions with pre-defined collateral."
+
+        ErrBalanceTxExistingTotalCollateral ->
+            apiError err403 BalanceTxExistingTotalCollateral $ T.unwords
+                [ "I cannot balance transactions"
+                , "with pre-defined total collateral."
+                ]
+        ErrBalanceTxExistingReturnCollateral ->
+            apiError err403 BalanceTxExistingReturnCollateral $ T.unwords
+                [ "Balancing transactions with pre-defined"
+                , "collateral return outputs is not yet supported."
                 ]
         ErrBalanceTxZeroAdaOutput ->
-            apiError err501 CreatedInvalidTransaction $ mconcat
-                [ "I don't currently support balancing transactions containing "
-                , "one or more zero ada outputs. In the future I might be able "
+            apiError err501 BalanceTxZeroAdaOutput $ T.unwords
+                [ "I don't currently support balancing transactions containing"
+                , "one or more zero-ada outputs. In the future I might be able"
                 , "to increase the values to the minimum allowed ada value."
                 ]
         ErrBalanceTxInternalError (ErrFailedBalancing v) ->
-            apiError err500 CreatedInvalidTransaction $ mconcat
-                [ "I have somehow failed to balance the transaction. The balance"
-                , " is " <> T.pack (show v)
+            apiError err500 BalanceTxInternalError $ T.unwords
+                [ "I have somehow failed to balance the transaction."
+                , "The balance is"
+                , T.pack (show v)
                 ]
         ErrBalanceTxInternalError (ErrUnderestimatedFee c _) ->
-            apiError err500 CreatedInvalidTransaction $ mconcat
-                [ "I have somehow underestimated the fee of the transaction "
-                , " by " <> pretty c
+            apiError err500 BalanceTxUnderestimatedFee $ T.unwords
+                [ "I have somehow underestimated the fee of the transaction by"
+                , pretty c
                 , "and cannot finish balancing."
                 ]
         ErrBalanceTxMaxSizeLimitExceeded ->
-            apiError err403 CreatedInvalidTransaction $ mconcat
+            apiError err403 BalanceTxMaxSizeLimitExceeded $ T.unwords
                 [ "I was not able to balance the transaction without exceeding"
                 , "the maximum transaction size."
                 ]

lib/core/src/Cardano/Wallet/Api/Types.hs

@@ -1669,6 +1669,16 @@ data ApiErrorCode
     | AssetNameTooLong
     | AssetNotPresent
     | BadRequest
+    | BalanceTxByronNotSupported
+    | BalanceTxConflictingNetworks
+    | BalanceTxExistingCollateral
+    | BalanceTxExistingKeyWitnesses
+    | BalanceTxExistingReturnCollateral
+    | BalanceTxExistingTotalCollateral
+    | BalanceTxInternalError
+    | BalanceTxMaxSizeLimitExceeded
+    | BalanceTxUnderestimatedFee
+    | BalanceTxZeroAdaOutput
     | CannotCoverFee
     | CreatedInvalidTransaction
     | CreatedMultiaccountTransaction

lib/core/test/unit/Cardano/Wallet/Api/TypesSpec.hs

@@ -1099,25 +1099,25 @@ spec = parallel $ do
                     }
             in
                 x' === x .&&. show x' === show x
-        it "WalletPutPassphraseData" $ property $ \case 
-                WalletPutPassphraseData  (Left x) -> 
+        it "WalletPutPassphraseData" $ property $ \case
+                WalletPutPassphraseData  (Left x) ->
                     let
                         x' = WalletPutPassphraseOldPassphraseData
-                            { oldPassphrase = oldPassphrase 
+                            { oldPassphrase = oldPassphrase
                                 (x :: WalletPutPassphraseOldPassphraseData)
-                            , newPassphrase = newPassphrase 
+                            , newPassphrase = newPassphrase
                                 (x :: WalletPutPassphraseOldPassphraseData)
                             }
                     in
                         x' === x .&&. show x' === show x
-                WalletPutPassphraseData  (Right x) -> 
+                WalletPutPassphraseData  (Right x) ->
                     let
                         x' = Api.WalletPutPassphraseMnemonicData
                             { mnemonicSentence = mnemonicSentence
                                 (x :: WalletPutPassphraseMnemonicData)
                             ,  mnemonicSecondFactor  = mnemonicSecondFactor
                                 (x :: WalletPutPassphraseMnemonicData)
-                            , newPassphrase = newPassphrase 
+                            , newPassphrase = newPassphrase
                                 (x :: WalletPutPassphraseMnemonicData)
                             }
                     in

lib/shelley/cardano-wallet.cabal

@@ -246,6 +246,7 @@ test-suite unit
     , cardano-crypto-class
     , cardano-crypto-wrapper
     , cardano-ledger-alonzo
+    , cardano-ledger-babbage
     , cardano-ledger-byron
     , cardano-ledger-core
     , cardano-numeric