tetsest

Author: carbolymer

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

@@ -250,7 +250,7 @@ import Cardano.Crypto.Hash qualified as Hash
 import Cardano.Ledger.Alonzo.Core qualified as Ledger
 import Cardano.Ledger.Api qualified as L
 import Cardano.Ledger.Binary qualified as Ledger
-import Cardano.Ledger.Credential as Ledger (Credential)
+import Cardano.Ledger.Credential qualified as Ledger (Credential)
 import Cardano.Ledger.Hashes qualified as L hiding (Hash)
 
 import Control.Exception (displayException)

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

@@ -11,7 +11,6 @@
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE UndecidableInstances #-}
 
 module Cardano.Api.Experimental.Tx.Internal.Fee
   ( FeeCalculationError (..)
@@ -537,7 +536,7 @@ calculateMinimumUTxO pp (TxOut txout) =
    in txOutWithMinCoin ^. L.coinTxOutL
 
 -- | Result of evaluating a signed transaction against the current ledger state.
-data TxEvaluationResult era = TxEvaluationResult
+data TxEvaluationResult era = Show (L.Value era) => TxEvaluationResult
   { txEvalFee :: L.Coin
   -- ^ Computed minimum fee for the transaction
   , txEvalExecutionUnits
@@ -547,7 +546,7 @@ data TxEvaluationResult era = TxEvaluationResult
   -- ^ Remaining balance (consumed - produced); mempty when balanced
   }
 
-deriving instance Show (L.Value era) => Show (TxEvaluationResult era)
+deriving instance Show (TxEvaluationResult era)
 
 -- | Evaluate a signed transaction: run all scripts, compute the minimum fee,
 -- and check the balance. This is a read-only diagnostic - it does not modify
@@ -587,7 +586,7 @@ evaluateTransaction systemStart epochInfo protocolParams poolIds stakeDelegDepos
             & L.witsTxL . L.rdmrsTxWitsL
               %~ \redeemers ->
                 L.Redeemers
-                  $ Map.mapWithKey
+                  . Map.mapWithKey
                     ( \purpose (datum, oldExUnits) ->
                         (datum, Map.findWithDefault oldExUnits purpose evaluatedExUnitsMap)
                     )
@@ -610,7 +609,7 @@ evaluateTransaction systemStart epochInfo protocolParams poolIds stakeDelegDepos
       }
  where
   isRegPool :: Ledger.KeyHash Ledger.StakePool -> Bool
-  isRegPool kh = Api.StakePoolKeyHash kh `Set.member` poolIds
+  isRegPool keyHash = Api.StakePoolKeyHash keyHash `Set.member` poolIds
 
   lookupDelegDeposit
     :: Ledger.Credential Ledger.Staking -> Maybe L.Coin

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

@@ -116,6 +116,9 @@ tests =
         , testProperty
             "script-free tx returns empty execution units map"
             prop_evaluateTransaction_no_scripts_empty_exunits
+        , testProperty
+            "balanced tx has mempty balance"
+            prop_evaluateTransaction_balanced_mempty
         ]
     ]
 
@@ -745,10 +748,16 @@ prop_makeTransactionBodyAutoBalance_balance_negative = H.property $ do
       H.annotate "Expected TxBodyErrorBalanceNegative but tx balanced successfully"
         >> H.failure
 
--- | A well-funded transaction returns a positive fee from 'evaluateTransaction'.
-prop_evaluateTransaction_positive_fee :: Property
-prop_evaluateTransaction_positive_fee = H.property $ do
-  (unsignedTx, utxo, _changeAddr) <- H.forAll $ genFundedSimpleTx Exp.ConwayEra
+-- | Evaluate a simple signed transaction, returning the result and UTxO.
+evalSimpleTx
+  :: Gen
+       ( Exp.TxEvaluationResult (Exp.LedgerEra Exp.ConwayEra)
+       , L.UTxO (Exp.LedgerEra Exp.ConwayEra)
+       , Exp.UnsignedTx (Exp.LedgerEra Exp.ConwayEra)
+       , L.Addr
+       )
+evalSimpleTx = do
+  (unsignedTx, utxo, changeAddr) <- genFundedSimpleTx Exp.ConwayEra
   let signedTx = Exp.signTx Exp.ConwayEra [] [] unsignedTx
       systemStart = Api.SystemStart $ Time.posixSecondsToUTCTime 0
       epochInfo =
@@ -764,13 +773,29 @@ prop_evaluateTransaction_positive_fee = H.property $ do
           mempty
           utxo
           signedTx
+  pure (result, utxo, unsignedTx, changeAddr)
+
+-- | A well-funded transaction returns a positive fee from 'evaluateTransaction'.
+prop_evaluateTransaction_positive_fee :: Property
+prop_evaluateTransaction_positive_fee = H.property $ do
+  (result, _utxo, _unsignedTx, _changeAddr) <- H.forAll evalSimpleTx
   H.assertWith (Exp.txEvalFee result) (> L.Coin 0)
 
 -- | A script-free transaction returns an empty execution units map.
 prop_evaluateTransaction_no_scripts_empty_exunits :: Property
 prop_evaluateTransaction_no_scripts_empty_exunits = H.property $ do
-  (unsignedTx, utxo, _changeAddr) <- H.forAll $ genFundedSimpleTx Exp.ConwayEra
-  let signedTx = Exp.signTx Exp.ConwayEra [] [] unsignedTx
+  (result, _utxo, _unsignedTx, _changeAddr) <- H.forAll evalSimpleTx
+  H.assertWith (Exp.txEvalExecutionUnits result) Map.null
+
+-- | A transaction balanced by 'calcMinFeeRecursive' has mempty balance
+-- when checked by 'evaluateSignedTx'.
+prop_evaluateTransaction_balanced_mempty :: Property
+prop_evaluateTransaction_balanced_mempty = H.property $ do
+  (unsignedTx, utxo, changeAddr) <- H.forAll $ genFundedSimpleTx Exp.ConwayEra
+  Exp.UnsignedTx balancedLedgerTx <-
+    H.leftFail $
+      Exp.calcMinFeeRecursive changeAddr unsignedTx utxo exampleProtocolParams mempty mempty mempty 0
+  let signedTx = Exp.SignedTx balancedLedgerTx
       systemStart = Api.SystemStart $ Time.posixSecondsToUTCTime 0
       epochInfo =
         Api.LedgerEpochInfo $
@@ -785,7 +810,7 @@ prop_evaluateTransaction_no_scripts_empty_exunits = H.property $ do
           mempty
           utxo
           signedTx
-  H.assertWith (Exp.txEvalExecutionUnits result) Map.null
+  Exp.txEvalBalance result H.=== mempty
 
 -- | Regression test for the bug where 'mapScriptWitnessesCertificates' silently
 -- dropped certs stored with a @Nothing@ witness (e.g. shelley stake registration