Add tx fee check to hprop_transaction

IntersectMBO · Apr 3, 2024 · ecf1ef4 · ecf1ef4
1 parent 4beaff3
commit ecf1ef4
Showing 1 changed file with 15 additions and 1 deletion.
diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Babbage/Transaction.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Babbage/Transaction.hs
@@ -13,7 +13,9 @@ module Cardano.Testnet.Test.Cli.Babbage.Transaction
 import           Cardano.Api
 import qualified Cardano.Api.Ledger as L
 import qualified Cardano.Api.Ledger.Lens as A
+import           Cardano.Api.Shelley
 
+import qualified Cardano.Ledger.Core as L
 import           Cardano.Testnet
 
 import           Prelude
@@ -84,6 +86,14 @@ hprop_transaction = H.integrationRetryWorkspace 0 "babbage-transaction" $ \tempA
     , "--tx-out", Text.unpack (paymentKeyInfoAddr wallet0) <> "+" <> show @Int 5_000_001
     , "--out-file", txbodyFp
     ]
+  cddlUnwitnessedTx <- H.readJsonFileOk txbodyFp
+  apiTx <- H.evalEither $ deserialiseTxLedgerCddl sbe cddlUnwitnessedTx
+  let txFee = L.unCoin $ extractTxFee apiTx
+
+  -- This is the current calculated fee.
+  -- It's a sanity check to see if anything has
+  -- changed regarding fee calculation.
+  228 H.=== txFee
 
   void $ execCli' execConfig
     [ "babbage", "transaction", "sign"
@@ -97,6 +107,7 @@ hprop_transaction = H.integrationRetryWorkspace 0 "babbage-transaction" $ \tempA
     , "--tx-file", txbodySignedFp
     ]
 
+
   H.byDurationM 1 15 "Expected UTxO found" $ do
     void $ execCli' execConfig
       [ "babbage", "query", "utxo"
@@ -108,7 +119,6 @@ hprop_transaction = H.integrationRetryWorkspace 0 "babbage-transaction" $ \tempA
     utxo2Json <- H.leftFailM . H.readJsonFile $ work </> "utxo-2.json"
     UTxO utxo2 <- H.noteShowM $ decodeEraUTxO sbe utxo2Json
     txouts2 <- H.noteShow $ L.unCoin . txOutValueLovelace . txOutValue . snd <$> Map.toList utxo2
-
     H.assert $ 5_000_001 `List.elem` txouts2
 
 txOutValue :: TxOut ctx era -> TxOutValue era
@@ -118,3 +128,7 @@ txOutValueLovelace ::TxOutValue era -> L.Coin
 txOutValueLovelace = \case
   TxOutValueShelleyBased sbe v -> v ^. A.adaAssetL sbe
   TxOutValueByron v -> v
+
+extractTxFee :: Tx era -> L.Coin
+extractTxFee (ShelleyTx sbe ledgerTx) =
+  shelleyBasedEraConstraints sbe $ ledgerTx ^. (L.bodyTxL . L.feeTxBodyL)