Add tx fee check to hprop_transaction

IntersectMBO · Apr 3, 2024 · 22a68df · 22a68df
1 parent 4beaff3
commit 22a68df
Showing 1 changed file with 21 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
@@ -14,14 +14,18 @@ import           Cardano.Api
 import qualified Cardano.Api.Ledger as L
 import qualified Cardano.Api.Ledger.Lens as A
 
+import qualified Cardano.Ledger.Core as L
 import           Cardano.Testnet
 
 import           Prelude
 
 import           Control.Monad (void)
+import           Data.Bifunctor (first)
 import qualified Data.List as List
 import qualified Data.Map as Map
 import qualified Data.Text as Text
+import           GHC.Stack
+import qualified GHC.Stack as GHC
 import           Lens.Micro
 import           System.FilePath ((</>))
 import qualified System.Info as SYS
@@ -47,6 +51,7 @@ hprop_transaction = H.integrationRetryWorkspace 0 "babbage-transaction" $ \tempA
   let
     sbe = ShelleyBasedEraBabbage
     era = toCardanoEra sbe
+    asBody = AsTxBody AsBabbageEra
     tempBaseAbsPath = makeTmpBaseAbsPath $ TmpAbsolutePath tempAbsPath'
     options = cardanoDefaultTestnetOptions
       { cardanoNodeEra = AnyCardanoEra era -- TODO: We should only support the latest era and the upcoming era
@@ -84,7 +89,11 @@ hprop_transaction = H.integrationRetryWorkspace 0 "babbage-transaction" $ \tempA
     , "--tx-out", Text.unpack (paymentKeyInfoAddr wallet0) <> "+" <> show @Int 5_000_001
     , "--out-file", txbodyFp
     ]
+  txBodyE <- liftIO $ readTextEnvelopeFile asBody txbodyFp
+  txBody <- H.evalEither txBodyE
+  let txFee = L.unCoin $ extractTxFee txBody
 
+  0 H.=== txFee
   void $ execCli' execConfig
     [ "babbage", "transaction", "sign"
     , "--tx-body-file", txbodyFp
@@ -97,6 +106,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 +118,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 +127,14 @@ txOutValueLovelace ::TxOutValue era -> L.Coin
 txOutValueLovelace = \case
   TxOutValueShelleyBased sbe v -> v ^. A.adaAssetL sbe
   TxOutValueByron v -> v
+
+readTextEnvelopeFile
+  :: (HasTextEnvelope a, HasCallStack)
+  => AsType a -> FilePath -> IO (Either String a)
+readTextEnvelopeFile asProxy fp = GHC.withFrozenCallStack $ do
+  first (docToString . prettyError) <$> readFileTextEnvelope asProxy (File fp)
+
+
+extractTxFee :: TxBody era -> L.Coin
+extractTxFee (ShelleyTxBody sbe ledgerTxBody _ _ _ _) =
+  shelleyBasedEraConstraints sbe $ ledgerTxBody ^. L.feeTxBodyL