Add property tests for calcMinFeeRecursive

Three Hedgehog properties in Test.Cardano.Api.Experimental verify the
key invariants of the recursive fee calculator:

- well-funded transaction always succeeds and produces a positive fee
- fee calculation is idempotent (result is a fixed point)
- underfunded transaction (outputs exceed inputs) always returns
  NotEnoughAda with a negative deficit coin

Two lovelace-only generators drive the tests: one with
generous UTxO funding (5–20 ADA input, 1–3 ADA output) and one where
the output deliberately exceeds the input (0.5–2 ADA vs 5–10 ADA).

Author: Jimbo4350

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

@@ -660,7 +660,10 @@ evaluateTransactionFee
 evaluateTransactionFee pp (UnsignedTx tx) keywitcount byronwitcount refScriptsSize =
   L.estimateMinFeeTx pp tx (fromIntegral keywitcount) (fromIntegral byronwitcount) refScriptsSize
 
-newtype RecursiveFeeCalculationError = NotEnoughAda Coin deriving (Show, Eq)
+data RecursiveFeeCalculationError
+  = NotEnoughAda Coin
+  | NoTxOuts
+  deriving (Show, Eq)
 
 instance Error RecursiveFeeCalculationError where
   prettyError (NotEnoughAda balance) =
@@ -669,13 +672,9 @@ instance Error RecursiveFeeCalculationError where
       , pretty balance
       , "\nThis means that the transaction does not have enough ada to cover the fees. The usual solution is to provide more inputs, or inputs with more ada."
       ]
+  prettyError NoTxOuts =
+    "The transaction has no outputs. At least one output is required to balance the transaction."
 
--- The assumption here is that we are spending a single UTxO
--- When the fee changes we must also adjust the outputs.
--- We will make two outputs, one for the change (if any)
--- and one for the destination address.
--- Currently this still overestimates by 2332 lovelace
--- in the case of a simple utxo spending only tx.
 calcMinFeeRecursive
   :: forall era
    . IsEra era
@@ -690,10 +689,10 @@ calcMinFeeRecursive unSignTx@(UnsignedTx ledgerTx) utxo pparams nExtraWitnesses
       -- We have reached the minimum fee but there isn't a guarantee that
       -- the inputs/outputs are balanced
       return unSignTx
-  | minFee == txBodyFee && txBalanceCoin > 0 =
+  | minFee == txBodyFee && txBalanceCoin > 0 = do
       -- We have a surplus balance so we modify the outputs to include it.
-      let balancedOuts = balanceTxOuts txBalanceValue unSignTx
-          updatedTx = UnsignedTx (ledgerTx & L.bodyTxL . L.outputsTxBodyL .~ Seq.fromList balancedOuts)
+      balancedOuts <- balanceTxOuts txBalanceValue unSignTx
+      let updatedTx = UnsignedTx (ledgerTx & L.bodyTxL . L.outputsTxBodyL .~ Seq.fromList balancedOuts)
        in return updatedTx
   | txBalanceCoin < 0 = Left $ NotEnoughAda txBalanceCoin
   | otherwise =
@@ -708,13 +707,14 @@ calcMinFeeRecursive unSignTx@(UnsignedTx ledgerTx) utxo pparams nExtraWitnesses
 balanceTxOuts
   :: L.Value (LedgerEra era)
   -> UnsignedTx (LedgerEra era)
-  -> [L.TxOut (LedgerEra era)]
+  -> Either RecursiveFeeCalculationError [L.TxOut (LedgerEra era)]
 balanceTxOuts txBalance (UnsignedTx tx) =
   let outs = toList $ tx ^. L.bodyTxL . L.outputsTxBodyL
-      split = List.uncons outs
-      (h, rest) = maybe (error "calcMinFeeRecursive: No outs!") id split
-      updatedout = h & L.valueTxOutL %~ (<> txBalance)
-   in updatedout : rest
+   in case List.uncons outs of
+        Nothing -> Left NoTxOuts
+        Just (h, rest) ->
+          let updatedout = h & L.valueTxOutL %~ (<> txBalance)
+           in Right $ updatedout : rest
 
 -- Essentially we check for the existence of collateral inputs. If they exist we
 -- create a fictitious collateral return output. Why? Because we need to put dummy values

cardano-api/test/cardano-api-test/Test/Cardano/Api/Experimental.hs

@@ -44,13 +44,14 @@ import Data.Time qualified as Time
 import Data.Time.Clock.POSIX qualified as Time
 import Lens.Micro
 
-import Test.Gen.Cardano.Api.Typed (genTx)
+import Test.Gen.Cardano.Api.Typed (genAddressInEra, genTx, genTxIn)
 
 import Hedgehog (Gen, Property)
 import Hedgehog qualified as H
 import Hedgehog.Extras qualified as H
 import Hedgehog.Gen qualified as Gen
 import Hedgehog.Internal.Property qualified as H
+import Hedgehog.Range qualified as Range
 import Test.Tasty (TestTree, testGroup)
 import Test.Tasty.Hedgehog (testProperty)
 
@@ -77,6 +78,18 @@ tests =
     , testProperty
         "Roundtrip SerialiseAsRawBytes SignedTx"
         prop_roundtrip_serialise_as_raw_bytes_signed_tx
+    , testGroup
+        "calcMinFeeRecursive"
+        [ testProperty
+            "well-funded transaction always succeeds"
+            prop_calcMinFeeRecursive_well_funded_succeeds
+        , testProperty
+            "fee calculation is idempotent"
+            prop_calcMinFeeRecursive_fee_fixpoint
+        , testProperty
+            "underfunded transaction (outputs exceed inputs) always fails"
+            prop_calcMinFeeRecursive_insufficient_funds
+        ]
     ]
 
 prop_created_transaction_with_both_apis_are_the_same :: Property
@@ -494,3 +507,106 @@ prop_roundtrip_serialise_as_raw_bytes_signed_tx = H.withTests (H.TestLimit 20) $
       signedTx
       (Text.decodeUtf8 . Api.serialiseToRawBytesHex)
       (first show . Api.deserialiseFromRawBytesHex . Text.encodeUtf8)
+
+-- ---------------------------------------------------------------------------
+-- Property tests for calcMinFeeRecursive
+-- ---------------------------------------------------------------------------
+
+-- | Generates a simple lovelace-only transaction with generous UTxO funding.
+-- UTxO has 5-20 ADA, the single output has 1-3 ADA, leaving 2-19 ADA of
+-- surplus that covers any realistic fee.
+genFundedSimpleTx
+  :: Exp.Era era
+  -> Gen
+       ( Exp.UnsignedTx (Exp.LedgerEra era)
+       , L.UTxO (Exp.LedgerEra era)
+       )
+genFundedSimpleTx era = do
+  let sbe = convert era
+  txIn <- genTxIn
+  addr <- Api.toShelleyAddr <$> genAddressInEra sbe
+  fundingCoin <- L.Coin <$> Gen.integral (Range.linear 5_000_000 20_000_000)
+  sendCoin <- L.Coin <$> Gen.integral (Range.linear 1_000_000 3_000_000)
+  let ledgerTxIn = Api.toShelleyTxIn txIn
+      fundingTxOut =
+        Exp.obtainCommonConstraints era $
+          L.mkBasicTxOut addr (L.MaryValue fundingCoin mempty)
+      utxo = L.UTxO $ Map.singleton ledgerTxIn fundingTxOut
+      sendTxOut =
+        Exp.obtainCommonConstraints era $
+          Exp.TxOut $
+            Exp.obtainCommonConstraints era $
+              Ledger.mkBasicTxOut addr (L.MaryValue sendCoin mempty)
+      txBodyContent =
+        Exp.defaultTxBodyContent
+          & Exp.setTxIns [(txIn, Exp.AnyKeyWitnessPlaceholder)]
+          & Exp.setTxOuts [sendTxOut]
+          & Exp.setTxFee 0
+  return (Exp.makeUnsignedTx era txBodyContent, utxo)
+
+-- | Generates a simple lovelace-only transaction where the single output
+-- (5-10 ADA) greatly exceeds the UTxO funding (0.5-2 ADA).
+genUnderfundedTx
+  :: forall era
+   . Exp.Era era
+  -> Gen
+       ( Exp.UnsignedTx (Exp.LedgerEra era)
+       , L.UTxO (Exp.LedgerEra era)
+       )
+genUnderfundedTx era = do
+  let sbe = convert era
+  txIn <- genTxIn
+  addr <- Api.toShelleyAddr <$> genAddressInEra sbe
+  fundingCoin <- L.Coin <$> Gen.integral (Range.linear 500_000 2_000_000)
+  sendCoin <- L.Coin <$> Gen.integral (Range.linear 5_000_000 10_000_000)
+  let ledgerTxIn = Api.toShelleyTxIn txIn
+      fundingTxOut =
+        Exp.obtainCommonConstraints era $
+          L.mkBasicTxOut addr (L.MaryValue fundingCoin mempty)
+      utxo = L.UTxO $ Map.singleton ledgerTxIn fundingTxOut
+      sendTxOut =
+        Exp.obtainCommonConstraints era $
+          Exp.TxOut $
+            Exp.obtainCommonConstraints era $
+              Ledger.mkBasicTxOut addr (L.MaryValue sendCoin mempty)
+      txBodyContent =
+        Exp.defaultTxBodyContent
+          & Exp.setTxIns [(txIn, Exp.AnyKeyWitnessPlaceholder)]
+          & Exp.setTxOuts [sendTxOut]
+          & Exp.setTxFee 0
+  return (Exp.makeUnsignedTx era txBodyContent, utxo)
+
+-- | A well-funded transaction (UTxO >> output + fee) always produces a
+-- successful positive fee calculation.
+prop_calcMinFeeRecursive_well_funded_succeeds :: Property
+prop_calcMinFeeRecursive_well_funded_succeeds = H.property $ do
+  (unsignedTx, utxo) <- H.forAll $ genFundedSimpleTx Exp.ConwayEra
+  case Exp.calcMinFeeRecursive unsignedTx utxo exampleProtocolParams 0 of
+    Left err -> H.annotateShow err >> H.failure
+    Right (Exp.UnsignedTx resultLedgerTx) -> do
+      let resultFee = resultLedgerTx ^. L.bodyTxL . L.feeTxBodyL
+      H.assert $ resultFee > L.Coin 0
+
+-- | 'calcMinFeeRecursive' is idempotent: applying it to its own result
+-- yields the same 'UnsignedTx'.  This confirms the fee has reached a
+-- fixed point and that any surplus was already distributed to outputs.
+prop_calcMinFeeRecursive_fee_fixpoint :: Property
+prop_calcMinFeeRecursive_fee_fixpoint = H.property $ do
+  (unsignedTx, utxo) <- H.forAll $ genFundedSimpleTx Exp.ConwayEra
+  case Exp.calcMinFeeRecursive unsignedTx utxo exampleProtocolParams 0 of
+    Left _ -> H.success
+    Right resultTx -> do
+      secondResult <-
+        H.evalEither $
+          Exp.calcMinFeeRecursive resultTx utxo exampleProtocolParams 0
+      resultTx H.=== secondResult
+
+-- | When the outputs exceed the UTxO value the function returns
+-- 'Left (NotEnoughAda _)' with a negative deficit coin.
+prop_calcMinFeeRecursive_insufficient_funds :: Property
+prop_calcMinFeeRecursive_insufficient_funds = H.property $ do
+  (unsignedTx, utxo) <- H.forAll $ genUnderfundedTx Exp.ConwayEra
+  case Exp.calcMinFeeRecursive unsignedTx utxo exampleProtocolParams 0 of
+    Left (Exp.NotEnoughAda deficit) -> H.assert $ deficit < L.Coin 0
+    Left Exp.NoTxOuts -> H.annotate "Unexpected NoTxOuts error" >> H.failure
+    Right _ -> H.failure