Hoist multi-asset balance check out of calcMinFeeRecursive loop

Author: Jimbo4350

cardano-api/src/Cardano/Api/Experimental/Tx/Internal/Fee.hs

@@ -698,27 +698,24 @@ instance Error FeeCalculationError where
 -- (i.e. @inputs + mint + withdrawals + refunds = outputs + fee + deposits@
 -- for all value components: ADA and every native token).
 --
+-- Before entering the iterative loop the multi-asset balance is checked.
+-- Because fee adjustments only affect ADA, a negative multi-asset balance
+-- is unrecoverable and the function returns 'NonAdaAssetsUnbalanced'
+-- immediately.
+--
 -- On each iteration the balance is computed via 'evaluateTransactionBalance'
 -- and the minimum fee via @calcMinFeeTx@. The function then proceeds based
 -- on the following cases, evaluated in order:
 --
--- * __Case 1 – Negative multi-asset balance__: The outputs demand more of a
---   native token than is available from inputs and minting. This is
---   unrecoverable because fee adjustments only affect ADA — they cannot
---   change the multi-asset balance. Remedy: provide additional inputs
---   containing the deficit tokens, mint the missing amount, or reduce the
---   token quantities in the outputs.
---   Returns 'NonAdaAssetsUnbalanced'.
---
--- * __Case 2 – Fee converged, balance is zero__: The transaction is fully
+-- * __Case 1 – Fee converged, balance is zero__: The transaction is fully
 --   balanced. Before returning, all outputs are checked against the minimum
 --   UTxO requirement ('MinUTxONotMet'). Note: a 'MinUTxONotMet' error at
---   this point typically means that Case 3 distributed surplus multi-assets
+--   this point typically means that Case 2 distributed surplus multi-assets
 --   to an output on a prior iteration but there was not enough ADA surplus
 --   to satisfy the increased @coinPerUTxOByte@ requirement for that output.
 --   The remedy is to provide additional ADA inputs.
 --
--- * __Case 3 – Fee converged, non-zero balance__: There is surplus or
+-- * __Case 2 – Fee converged, non-zero balance__: There is surplus or
 --   deficit ADA, excess multi-assets (e.g. from minting), or both. A new
 --   change output is created at the provided change address with the
 --   balance and appended to the end of the existing outputs; if a change
@@ -729,7 +726,7 @@ instance Error FeeCalculationError where
 --   required fee, and must also satisfy the minimum UTxO
 --   (@coinPerUTxOByte@) constraint.
 --
--- * __Case 4 – Fee has not converged__: The fee field is set to the newly
+-- * __Case 3 – Fee has not converged__: The fee field is set to the newly
 --   computed minimum fee and the function recurses.
 --
 -- A maximum iteration limit (currently 50) guards against non-termination.
@@ -757,8 +754,29 @@ calcMinFeeRecursive
   -> Int
   -- ^ Number of extra key hashes for native scripts
   -> Either FeeCalculationError (UnsignedTx (LedgerEra era))
-calcMinFeeRecursive changeAddr = go maxIterations
+calcMinFeeRecursive 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 =
+      Left $ NonAdaAssetsUnbalanced multiAssets
+  | otherwise =
+      go
+        maxIterations
+        unsignedTx
+        utxo
+        pparams
+        poolids
+        stakeDelegDeposits
+        drepDelegDeposits
+        nExtraWitnesses
  where
+  initialBalance = evaluateTransactionBalance pparams poolids stakeDelegDeposits drepDelegDeposits utxo unsignedTx
+  multiAssets = getMultiAssets (useEra @era) initialBalance
+  -- Check whether any native token quantity is negative.
+  -- ADA is zeroed out so it doesn't influence the check.
+  multiAssetIsNegative =
+    obtainCommonConstraints (useEra @era) $
+      not (L.pointwise (>=) (L.MaryValue (L.Coin 0) multiAssets) mempty)
   maxIterations :: Int
   maxIterations = 50
 
@@ -773,32 +791,26 @@ calcMinFeeRecursive changeAddr = go maxIterations
     -> Int
     -> Either FeeCalculationError (UnsignedTx (LedgerEra era))
   go 0 _ _ _ _ _ _ _ = Left FeeCalculationDidNotConverge
-  go n unSignTx@(UnsignedTx ledgerTx) utxo pparams poolids stakeDelegDeposits drepDelegDeposits nExtraWitnesses
-    | multiAssetIsNegative =
-        -- Case 1
-        Left $ NonAdaAssetsUnbalanced (getMultiAssets (useEra @era) txBalanceValue)
+  go n unSignTx@(UnsignedTx ledgerTx) utxo' pparams' poolids' stakeDelegDeposits' drepDelegDeposits' nExtraWitnesses'
     | minFee == txBodyFee && L.isZero txBalanceValue = do
-        -- Case 2
+        -- Case 1
         let outs = toList $ ledgerTx ^. L.bodyTxL . L.outputsTxBodyL
-        mapM_ (checkOutputMinUTxO pparams) outs
+        mapM_ (checkOutputMinUTxO pparams') outs
         return unSignTx
     | minFee == txBodyFee = do
-        -- Case 3
+        -- Case 2
         balancedOuts <- balanceTxOuts @era changeAddr txBalanceValue unSignTx
         let updatedTx = UnsignedTx (ledgerTx & L.bodyTxL . L.outputsTxBodyL .~ balancedOuts)
-        go (n - 1) updatedTx utxo pparams poolids stakeDelegDeposits drepDelegDeposits nExtraWitnesses
+        go (n - 1) updatedTx utxo' pparams' poolids' stakeDelegDeposits' drepDelegDeposits' nExtraWitnesses'
     | otherwise =
-        -- Case 4
+        -- Case 3
         let newTx = UnsignedTx (ledgerTx & L.bodyTxL . L.feeTxBodyL .~ minFee)
-         in go (n - 1) newTx utxo pparams poolids stakeDelegDeposits drepDelegDeposits nExtraWitnesses
+         in go (n - 1) newTx utxo' pparams' poolids' stakeDelegDeposits' drepDelegDeposits' nExtraWitnesses'
    where
-    minFee = obtainCommonConstraints (useEra @era) $ L.calcMinFeeTx utxo pparams ledgerTx nExtraWitnesses
+    minFee = obtainCommonConstraints (useEra @era) $ L.calcMinFeeTx utxo' pparams' ledgerTx nExtraWitnesses'
     txBodyFee = ledgerTx ^. L.bodyTxL . L.feeTxBodyL
-    txBalanceValue = evaluateTransactionBalance pparams poolids stakeDelegDeposits drepDelegDeposits utxo unSignTx
-    txBalanceCoin = L.coin txBalanceValue
-    multiAssetIsNegative =
-      obtainCommonConstraints (useEra @era) $
-        not (L.pointwise (>=) txBalanceValue (L.inject txBalanceCoin))
+    txBalanceValue =
+      evaluateTransactionBalance pparams' poolids' stakeDelegDeposits' drepDelegDeposits' utxo' unSignTx
 
 checkOutputMinUTxO
   :: forall era