diff --git a/cardano-api/src/Cardano/Api/Experimental/Tx/Internal/Fee.hs b/cardano-api/src/Cardano/Api/Experimental/Tx/Internal/Fee.hs index 7ce8ebf6d5..4aa90b05cd 100644 --- a/cardano-api/src/Cardano/Api/Experimental/Tx/Internal/Fee.hs +++ b/cardano-api/src/Cardano/Api/Experimental/Tx/Internal/Fee.hs @@ -25,6 +25,7 @@ module Cardano.Api.Experimental.Tx.Internal.Fee , indexWitnessedTxProposalProcedures , makeTransactionBodyAutoBalance -- Internal + , calcMinFeeRecursiveWith , toUnsigned ) where @@ -754,7 +755,38 @@ calcMinFeeRecursive -> Int -- ^ Number of extra key hashes for native scripts -> Either FeeCalculationError (UnsignedTx (LedgerEra era)) -calcMinFeeRecursive changeAddr unsignedTx utxo pparams poolids stakeDelegDeposits drepDelegDeposits nExtraWitnesses +calcMinFeeRecursive = calcMinFeeRecursiveWith 50 + +-- | Like 'calcMinFeeRecursive' but with a configurable maximum iteration +-- limit. Exported for testing purposes to exercise the +-- 'FeeCalculationDidNotConverge' error path by passing a small limit. +calcMinFeeRecursiveWith + :: forall era + . IsEra era + => Int + -- ^ Maximum number of iterations before returning + -- 'FeeCalculationDidNotConverge'. 'calcMinFeeRecursive' uses 50. + -> L.Addr + -- ^ Change address. Any surplus value (ADA and/or native tokens) is + -- sent to a new output at this address, appended at the end of the + -- existing outputs. + -> UnsignedTx (LedgerEra era) + -> L.UTxO (LedgerEra era) + -> L.PParams (LedgerEra era) + -> Set PoolId + -- ^ The set of registered stake pools. Pool registrations for pools + -- already in this set are treated as re-registrations (no deposit + -- required on the produced side). + -> Map StakeCredential L.Coin + -- ^ Deposits for stake credentials being deregistered in this + -- transaction. These are counted as refunds on the consumed side. + -> Map (Ledger.Credential Ledger.DRepRole) L.Coin + -- ^ Deposits for DRep credentials being deregistered in this + -- transaction. These are counted as refunds on the consumed side. + -> Int + -- ^ Number of extra key hashes for native scripts + -> Either FeeCalculationError (UnsignedTx (LedgerEra era)) +calcMinFeeRecursiveWith maxIterations changeAddr unsignedTx utxo pparams poolids stakeDelegDeposits drepDelegDeposits nExtraWitnesses -- If multi-assets are non-negative initially, they stay non-negative across -- iterations (only ADA and fee change), so check once upfront. | multiAssetIsNegative = @@ -777,8 +809,6 @@ calcMinFeeRecursive changeAddr unsignedTx utxo pparams poolids stakeDelegDeposit multiAssetIsNegative = obtainCommonConstraints (useEra @era) $ not (L.pointwise (>=) (L.MaryValue (L.Coin 0) multiAssets) mempty) - maxIterations :: Int - maxIterations = 50 go :: Int diff --git a/cardano-api/test/cardano-api-test/Test/Cardano/Api/Experimental.hs b/cardano-api/test/cardano-api-test/Test/Cardano/Api/Experimental.hs index e69f5058fb..85210da312 100644 --- a/cardano-api/test/cardano-api-test/Test/Cardano/Api/Experimental.hs +++ b/cardano-api/test/cardano-api-test/Test/Cardano/Api/Experimental.hs @@ -14,6 +14,7 @@ import Cardano.Api qualified as Api import Cardano.Api.Experimental qualified as Exp import Cardano.Api.Experimental.Era (convert) import Cardano.Api.Experimental.Tx qualified as Exp +import Cardano.Api.Experimental.Tx.Internal.Fee (calcMinFeeRecursiveWith) import Cardano.Api.Genesis qualified as Genesis import Cardano.Api.Ledger qualified as L import Cardano.Api.Ledger qualified as Ledger @@ -106,6 +107,9 @@ tests = , testProperty "Tiny surplus consumed by fee increase yields NotEnoughAda" prop_calcMinFeeRecursive_tiny_surplus_not_enough_ada + , testProperty + "iteration limit exhausted returns FeeCalculationDidNotConverge" + prop_calcMinFeeRecursive_did_not_converge ] ] @@ -981,3 +985,36 @@ prop_calcMinFeeRecursive_tiny_surplus_not_enough_ada = H.property $ do H.assert $ actual < required Left err -> H.annotateShow err >> H.failure Right _ -> H.annotate "Expected NotEnoughAda or MinUTxONotMet but tx balanced successfully" >> H.failure + +-- --------------------------------------------------------------------------- +-- Iteration limit: FeeCalculationDidNotConverge +-- --------------------------------------------------------------------------- + +-- | When the maximum iteration count is set to 1 and the transaction starts +-- with a zero fee, the first iteration updates the fee field (Case 3) but +-- immediately exhausts the budget, so the function must return +-- 'FeeCalculationDidNotConverge'. +-- +-- This test uses 'calcMinFeeRecursiveWith' (the internal variant that exposes +-- the iteration limit) to reliably exercise the error path without requiring +-- a pathological transaction that genuinely fails to converge under the +-- default 50-iteration limit. +prop_calcMinFeeRecursive_did_not_converge :: Property +prop_calcMinFeeRecursive_did_not_converge = H.property $ do + (unsignedTx, utxo, changeAddr) <- H.forAll $ genFundedSimpleTx Exp.ConwayEra + -- maxIterations = 1: the first iteration sets the fee (Case 3) and then + -- the counter hits 0, returning FeeCalculationDidNotConverge. + let result = + calcMinFeeRecursiveWith + 1 + changeAddr + unsignedTx + utxo + exampleProtocolParams + mempty + mempty + mempty + 0 + case result of + Left Exp.FeeCalculationDidNotConverge -> H.success + other -> H.annotateShow other >> H.failure