From 586a393dcd917be14f0807b6eae9d522a9187516 Mon Sep 17 00:00:00 2001 From: Mateusz Galazyn Date: Tue, 5 May 2026 14:53:05 +0200 Subject: [PATCH 1/4] Fix swapped fee constant and coefficients in test --- .../cardano-testnet-test/Cardano/Testnet/Test/Rpc/Query.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Rpc/Query.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Rpc/Query.hs index 417f0a35e2e..cd50359ac4a 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Rpc/Query.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Rpc/Query.hs @@ -107,9 +107,9 @@ hprop_rpc_query_pparams = integrationRetryWorkspace 2 "rpc-query-pparams" $ \tem pparams ^. L.ppCoinsPerUTxOByteL . to L.unCoinPerByte . to L.fromCompact . to L.unCoin ===^ chainParams ^. U5c.coinsPerUtxoByte . to utxoRpcBigIntToInteger pparams ^. L.ppMaxTxSizeL === chainParams ^. U5c.maxTxSize . to fromIntegral - pparams ^. L.ppTxFeeFixedL ===^ chainParams ^. U5c.minFeeCoefficient . to (fmap L.Coin . utxoRpcBigIntToInteger) + pparams ^. L.ppTxFeeFixedL ===^ chainParams ^. U5c.minFeeConstant . to utxoRpcBigIntToInteger pparams ^. L.ppTxFeePerByteL . to L.unCoinPerByte . to L.fromCompact . to L.unCoin - ===^ chainParams ^. U5c.minFeeConstant . to utxoRpcBigIntToInteger + ===^ chainParams ^. U5c.minFeeCoefficient . to (fmap L.Coin . utxoRpcBigIntToInteger) pparams ^. L.ppMaxBBSizeL === chainParams ^. U5c.maxBlockBodySize . to fromIntegral pparams ^. L.ppMaxBHSizeL === chainParams ^. U5c.maxBlockHeaderSize . to fromIntegral pparams ^. L.ppKeyDepositL ===^ chainParams ^. U5c.stakeKeyDeposit . to (fmap L.Coin . utxoRpcBigIntToInteger) From cd90ce90267bb895a6eb801dd422651daa09725c Mon Sep 17 00:00:00 2001 From: Mateusz Galazyn Date: Tue, 5 May 2026 16:15:47 +0200 Subject: [PATCH 2/4] wip --- cardano-testnet/cardano-testnet.cabal | 1 + .../Cardano/Testnet/Test/Rpc/Eval.hs | 189 ++++++++++++++++++ .../cardano-testnet-test.hs | 2 + 3 files changed, 192 insertions(+) create mode 100644 cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Rpc/Eval.hs diff --git a/cardano-testnet/cardano-testnet.cabal b/cardano-testnet/cardano-testnet.cabal index 43b7a3cea20..84300efdebd 100644 --- a/cardano-testnet/cardano-testnet.cabal +++ b/cardano-testnet/cardano-testnet.cabal @@ -236,6 +236,7 @@ test-suite cardano-testnet-test Cardano.Testnet.Test.Gov.TreasuryDonation Cardano.Testnet.Test.Gov.TreasuryGrowth Cardano.Testnet.Test.Gov.TreasuryWithdrawal + Cardano.Testnet.Test.Rpc.Eval Cardano.Testnet.Test.Rpc.Query Cardano.Testnet.Test.Rpc.Transaction Cardano.Testnet.Test.Misc diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Rpc/Eval.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Rpc/Eval.hs new file mode 100644 index 00000000000..e197da67a09 --- /dev/null +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Rpc/Eval.hs @@ -0,0 +1,189 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE NumericUnderscores #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeOperators #-} + +-- | Run with: +-- @TASTY_PATTERN='/RPC Eval Tx/' cabal test cardano-testnet-test@ +module Cardano.Testnet.Test.Rpc.Eval + ( hprop_rpc_eval_tx + ) +where + +import Cardano.Api + +import qualified Cardano.Rpc.Client as Rpc +import qualified Cardano.Rpc.Proto.Api.UtxoRpc.Query as U5c +import qualified Cardano.Rpc.Proto.Api.UtxoRpc.Submit as U5c +import qualified Cardano.Rpc.Proto.Api.UtxoRpc.Submit as UtxoRpc +import Cardano.Rpc.Server.Internal.UtxoRpc.Type (utxoRpcBigIntToInteger) +import Cardano.Testnet + +import Prelude + +import Control.Monad.Trans.Control (liftBaseOp) +import Data.Default.Class +import qualified Data.Text as T +import Lens.Micro + +import Testnet.Components.Query (TestnetWaitPeriod (..), findLargestUtxoForPaymentKey, + getEpochStateView, retryUntilJustM) +import Testnet.Defaults (plutusV3Script) +import Testnet.Process.Run (execCli') +import Testnet.Property.Util (integrationRetryWorkspace) +import Testnet.Types + +import Hedgehog +import qualified Hedgehog as H +import qualified Hedgehog.Extras.Test.Base as H +import qualified Hedgehog.Extras.Test.File as H +import qualified Hedgehog.Extras.Test.TestWatchdog as H + +-- | Evaluate a Plutus V3 spending transaction via the gRPC evalTx endpoint and +-- verify that the response contains a valid fee, non-zero execution units, one +-- redeemer, and no errors. +hprop_rpc_eval_tx :: Property +hprop_rpc_eval_tx = integrationRetryWorkspace 2 "rpc-eval-tx" $ \tempAbsBasePath' -> H.runWithDefaultWatchdog_ $ do + conf@Conf{tempAbsPath} <- mkConf tempAbsBasePath' + let tempAbsPath' = unTmpAbsPath tempAbsPath + work <- H.createDirectoryIfMissing $ tempAbsPath' "work" + + let tempBaseAbsPath = makeTmpBaseAbsPath $ TmpAbsolutePath tempAbsPath' + (ceo, eraProxy) = + (conwayBasedEra, asType) :: era ~ ConwayEra => (ConwayEraOnwards era, AsType era) + sbe = convert ceo + anyEra = AnyCardanoEra $ toCardanoEra sbe + creationOptions = def{creationEra = AnyShelleyBasedEra sbe} + runtimeOptions = def{runtimeEnableRpc = RpcEnabled} + + TestnetRuntime + { configurationFile + , testnetMagic + , testnetNodes = node : _ + , wallets = wallet0 : wallet1 : _ + } <- + createAndRunTestnet creationOptions runtimeOptions conf + + poolSprocket <- H.noteShow $ nodeSprocket node + execConfig <- mkExecConfig tempBaseAbsPath poolSprocket testnetMagic + epochStateView <- getEpochStateView configurationFile $ nodeSocketPath node + rpcSocket <- H.note . unFile $ nodeRpcSocketPath node + + let utxoSKeyFile = signingKeyFp $ paymentKeyInfoPair wallet0 + utxoSKeyFile1 = signingKeyFp $ paymentKeyInfoPair wallet1 + + ------------------------------------ + -- Write Plutus V3 always-succeeds script + ------------------------------------ + plutusScriptFile <- H.note $ work "always-succeeds.plutusV3" + H.writeFile plutusScriptFile $ T.unpack plutusV3Script + + plutusSpendingScriptAddr <- + execCli' execConfig + [ "latest", "address", "build" + , "--payment-script-file", plutusScriptFile + ] + + scriptDatumHash <- filter (/= '\n') <$> + execCli' execConfig + [ "latest", "transaction", "hash-script-data" + , "--script-data-value", "0" + ] + + ------------------------------------ + -- 1. Fund the script address + ------------------------------------ + txinFund <- findLargestUtxoForPaymentKey epochStateView sbe wallet0 + + let fundTxBody = work "fund-script-tx-body" + fundTx = work "fund-script-tx" + + void $ execCli' execConfig + [ anyEraToString anyEra, "transaction", "build" + , "--change-address", T.unpack $ paymentKeyInfoAddr wallet0 + , "--tx-in", T.unpack $ renderTxIn txinFund + , "--tx-out", plutusSpendingScriptAddr <> "+" <> show @Int 5_000_000 + , "--tx-out-datum-hash", scriptDatumHash + , "--out-file", fundTxBody + ] + + void $ execCli' execConfig + [ "latest", "transaction", "sign" + , "--tx-body-file", fundTxBody + , "--signing-key-file", utxoSKeyFile + , "--out-file", fundTx + ] + + void $ execCli' execConfig + [ "latest", "transaction", "submit" + , "--tx-file", fundTx + ] + + ------------------------------------ + -- 2. Wait for the script UTxO, find collateral + ------------------------------------ + plutusScriptTxIn <- fmap fst . retryUntilJustM epochStateView (WaitForBlocks 3) $ + findLargestUtxoWithAddress epochStateView sbe $ T.pack plutusSpendingScriptAddr + + txinCollateral <- findLargestUtxoForPaymentKey epochStateView sbe wallet1 + + ------------------------------------ + -- 3. Build and sign the spending tx + ------------------------------------ + let spendTxBody = work "spend-script-tx-body" + spendTx = work "spend-script-tx" + + void $ execCli' execConfig + [ anyEraToString anyEra, "transaction", "build" + , "--change-address", T.unpack $ paymentKeyInfoAddr wallet1 + , "--tx-in-collateral", T.unpack $ renderTxIn txinCollateral + , "--tx-in", T.unpack $ renderTxIn plutusScriptTxIn + , "--tx-in-script-file", plutusScriptFile + , "--tx-in-datum-value", "0" + , "--tx-in-redeemer-value", "0" + , "--out-file", spendTxBody + ] + + void $ execCli' execConfig + [ "latest", "transaction", "sign" + , "--tx-body-file", spendTxBody + , "--signing-key-file", utxoSKeyFile1 + , "--out-file", spendTx + ] + + ------------------------------------ + -- 4. Read signed tx and call evalTx + ------------------------------------ + signedTx <- + H.leftFailM . H.evalIO $ + readFileTextEnvelope (AsTx eraProxy) (File spendTx) + + let rpcServer = Rpc.ServerUnix rpcSocket + evalRequest = + def & U5c.tx . U5c.raw .~ serialiseToCBOR signedTx + + liftBaseOp (Rpc.withConnection def rpcServer) $ \conn -> do + evalResponse <- H.noteShowM . H.evalIO $ + Rpc.nonStreaming conn (Rpc.rpc @(Rpc.Protobuf UtxoRpc.SubmitService "evalTx")) evalRequest + + let txEval = evalResponse ^. U5c.report . U5c.cardano + + ------------------------------------ + -- 5. Assertions + ------------------------------------ + H.note_ "Fee should be positive" + evalFee <- H.leftFail $ txEval ^. U5c.fee . to utxoRpcBigIntToInteger + H.assertWith evalFee (> 0) + + H.note_ "Aggregate execution units should be positive" + H.assertWith (txEval ^. U5c.exUnits . U5c.steps) (> 0) + H.assertWith (txEval ^. U5c.exUnits . U5c.memory) (> 0) + + H.note_ "One redeemer for the spend purpose" + H.assertWith (txEval ^. U5c.redeemers) (\rs -> length rs == 1) + + H.note_ "No evaluation errors" + H.assertWith (txEval ^. U5c.errors) null diff --git a/cardano-testnet/test/cardano-testnet-test/cardano-testnet-test.hs b/cardano-testnet/test/cardano-testnet-test/cardano-testnet-test.hs index c6d4a936dfd..efca09a8631 100644 --- a/cardano-testnet/test/cardano-testnet-test/cardano-testnet-test.hs +++ b/cardano-testnet/test/cardano-testnet-test/cardano-testnet-test.hs @@ -34,6 +34,7 @@ import qualified Cardano.Testnet.Test.Gov.TreasuryDonation as Gov import qualified Cardano.Testnet.Test.Gov.TreasuryWithdrawal as Gov import qualified Cardano.Testnet.Test.MainnetParams import qualified Cardano.Testnet.Test.Node.Shutdown +import qualified Cardano.Testnet.Test.Rpc.Eval import qualified Cardano.Testnet.Test.Rpc.Query import qualified Cardano.Testnet.Test.Rpc.Transaction import qualified Cardano.Testnet.Test.RunTestnet @@ -145,6 +146,7 @@ tests = do , T.testGroup "RPC" [ ignoreOnWindows "RPC Query Protocol Params" Cardano.Testnet.Test.Rpc.Query.hprop_rpc_query_pparams , ignoreOnWindows "RPC Transaction Submit" Cardano.Testnet.Test.Rpc.Transaction.hprop_rpc_transaction + , ignoreOnWindows "RPC Eval Tx" Cardano.Testnet.Test.Rpc.Eval.hprop_rpc_eval_tx ] ] From e23cbf141a84d3617a3970fb1bfce3e4aac74102 Mon Sep 17 00:00:00 2001 From: Mateusz Galazyn Date: Wed, 6 May 2026 08:16:09 +0200 Subject: [PATCH 3/4] langlemangle --- .../Cardano/Testnet/Test/Rpc/Eval.hs | 121 ++++++++++++++++-- .../Cardano/Testnet/Test/Rpc/Query.hs | 5 +- 2 files changed, 111 insertions(+), 15 deletions(-) diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Rpc/Eval.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Rpc/Eval.hs index e197da67a09..0531c879112 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Rpc/Eval.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Rpc/Eval.hs @@ -14,26 +14,30 @@ module Cardano.Testnet.Test.Rpc.Eval where import Cardano.Api +import qualified Cardano.Api.Ledger as L +import Cardano.Api.Plutus (examplePlutusScriptAlwaysFails) import qualified Cardano.Rpc.Client as Rpc -import qualified Cardano.Rpc.Proto.Api.UtxoRpc.Query as U5c +import qualified Cardano.Rpc.Proto.Api.UtxoRpc.Query as U5c hiding (cardano, tx) import qualified Cardano.Rpc.Proto.Api.UtxoRpc.Submit as U5c -import qualified Cardano.Rpc.Proto.Api.UtxoRpc.Submit as UtxoRpc import Cardano.Rpc.Server.Internal.UtxoRpc.Type (utxoRpcBigIntToInteger) import Cardano.Testnet import Prelude +import Control.Monad (void) import Control.Monad.Trans.Control (liftBaseOp) import Data.Default.Class import qualified Data.Text as T import Lens.Micro +import System.FilePath (()) import Testnet.Components.Query (TestnetWaitPeriod (..), findLargestUtxoForPaymentKey, - getEpochStateView, retryUntilJustM) + findLargestUtxoWithAddress, getEpochStateView, retryUntilJustM) import Testnet.Defaults (plutusV3Script) -import Testnet.Process.Run (execCli') +import Testnet.Process.Run (execCli', mkExecConfig) import Testnet.Property.Util (integrationRetryWorkspace) +import Testnet.Start.Types (anyEraToString) import Testnet.Types import Hedgehog @@ -52,8 +56,7 @@ hprop_rpc_eval_tx = integrationRetryWorkspace 2 "rpc-eval-tx" $ \tempAbsBasePath work <- H.createDirectoryIfMissing $ tempAbsPath' "work" let tempBaseAbsPath = makeTmpBaseAbsPath $ TmpAbsolutePath tempAbsPath' - (ceo, eraProxy) = - (conwayBasedEra, asType) :: era ~ ConwayEra => (ConwayEraOnwards era, AsType era) + ceo = conwayBasedEra @ConwayEra sbe = convert ceo anyEra = AnyCardanoEra $ toCardanoEra sbe creationOptions = def{creationEra = AnyShelleyBasedEra sbe} @@ -159,31 +162,123 @@ hprop_rpc_eval_tx = integrationRetryWorkspace 2 "rpc-eval-tx" $ \tempAbsBasePath ------------------------------------ signedTx <- H.leftFailM . H.evalIO $ - readFileTextEnvelope (AsTx eraProxy) (File spendTx) + readFileTextEnvelope @(Tx ConwayEra) (File spendTx) - let rpcServer = Rpc.ServerUnix rpcSocket + let TxFeeExplicit _ cliFee = txFee . getTxBodyContent $ getTxBody signedTx + rpcServer = Rpc.ServerUnix rpcSocket evalRequest = def & U5c.tx . U5c.raw .~ serialiseToCBOR signedTx liftBaseOp (Rpc.withConnection def rpcServer) $ \conn -> do evalResponse <- H.noteShowM . H.evalIO $ - Rpc.nonStreaming conn (Rpc.rpc @(Rpc.Protobuf UtxoRpc.SubmitService "evalTx")) evalRequest + Rpc.nonStreaming conn (Rpc.rpc @(Rpc.Protobuf U5c.SubmitService "evalTx")) evalRequest let txEval = evalResponse ^. U5c.report . U5c.cardano ------------------------------------ -- 5. Assertions ------------------------------------ - H.note_ "Fee should be positive" + H.note_ "EvalTx fee should match the CLI-computed fee" evalFee <- H.leftFail $ txEval ^. U5c.fee . to utxoRpcBigIntToInteger - H.assertWith evalFee (> 0) + evalFee === L.unCoin cliFee H.note_ "Aggregate execution units should be positive" H.assertWith (txEval ^. U5c.exUnits . U5c.steps) (> 0) H.assertWith (txEval ^. U5c.exUnits . U5c.memory) (> 0) - H.note_ "One redeemer for the spend purpose" - H.assertWith (txEval ^. U5c.redeemers) (\rs -> length rs == 1) + H.note_ "One redeemer for the spend purpose at index 0" + let redeemers = txEval ^. U5c.redeemers + H.assertWith redeemers $ \rs -> length rs == 1 + head redeemers ^. U5c.purpose === U5c.REDEEMER_PURPOSE_SPEND + head redeemers ^. U5c.index === 0 H.note_ "No evaluation errors" H.assertWith (txEval ^. U5c.errors) null + + H.note_ "No script traces from always-succeeds script" + H.assertWith (txEval ^. U5c.traces) null + + ------------------------------------ + -- 6. Failure path: always-fails script + ------------------------------------ + let failScript = PlutusScript PlutusScriptV1 $ examplePlutusScriptAlwaysFails WitCtxTxIn + failScriptFile <- H.note $ work "always-fails.plutusV1" + H.leftFailM . H.evalIO $ + writeFileTextEnvelope (File failScriptFile) Nothing failScript + + failScriptAddr <- + execCli' execConfig + [ "latest", "address", "build" + , "--payment-script-file", failScriptFile + ] + + txinFund2 <- findLargestUtxoForPaymentKey epochStateView sbe wallet0 + + let fundFailTxBody = work "fund-fail-script-tx-body" + fundFailTx = work "fund-fail-script-tx" + + void $ execCli' execConfig + [ anyEraToString anyEra, "transaction", "build" + , "--change-address", T.unpack $ paymentKeyInfoAddr wallet0 + , "--tx-in", T.unpack $ renderTxIn txinFund2 + , "--tx-out", failScriptAddr <> "+" <> show @Int 5_000_000 + , "--tx-out-datum-hash", scriptDatumHash + , "--out-file", fundFailTxBody + ] + + void $ execCli' execConfig + [ "latest", "transaction", "sign" + , "--tx-body-file", fundFailTxBody + , "--signing-key-file", utxoSKeyFile + , "--out-file", fundFailTx + ] + + void $ execCli' execConfig + [ "latest", "transaction", "submit" + , "--tx-file", fundFailTx + ] + + failScriptTxIn <- fmap fst . retryUntilJustM epochStateView (WaitForBlocks 3) $ + findLargestUtxoWithAddress epochStateView sbe $ T.pack failScriptAddr + + let failSpendTxBody = work "fail-spend-tx-body" + failSpendTx = work "fail-spend-tx" + + void $ execCli' execConfig + [ anyEraToString anyEra, "transaction", "build-raw" + , "--tx-in", T.unpack $ renderTxIn failScriptTxIn + , "--tx-in-collateral", T.unpack $ renderTxIn txinCollateral + , "--tx-in-script-file", failScriptFile + , "--tx-in-datum-value", "0" + , "--tx-in-redeemer-value", "0" + , "--tx-in-execution-units", "(10000000000,10000000)" + , "--tx-out", T.unpack (paymentKeyInfoAddr wallet1) <> "+4700000" + , "--fee", "300000" + , "--out-file", failSpendTxBody + ] + + void $ execCli' execConfig + [ "latest", "transaction", "sign" + , "--tx-body-file", failSpendTxBody + , "--signing-key-file", utxoSKeyFile1 + , "--out-file", failSpendTx + ] + + failSignedTx <- + H.leftFailM . H.evalIO $ + readFileTextEnvelope @(Tx ConwayEra) (File failSpendTx) + + let failEvalRequest = + def & U5c.tx . U5c.raw .~ serialiseToCBOR failSignedTx + + liftBaseOp (Rpc.withConnection def rpcServer) $ \conn -> do + failEvalResponse <- H.noteShowM . H.evalIO $ + Rpc.nonStreaming conn (Rpc.rpc @(Rpc.Protobuf U5c.SubmitService "evalTx")) failEvalRequest + + let failTxEval = failEvalResponse ^. U5c.report . U5c.cardano + + H.note_ "Errors should be non-empty for always-fails script" + H.assertWith (failTxEval ^. U5c.errors) $ not . null + + H.note_ "Redeemers should be empty for failed evaluation" + H.assertWith (failTxEval ^. U5c.redeemers) null diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Rpc/Query.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Rpc/Query.hs index cd50359ac4a..dae5afac1ca 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Rpc/Query.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Rpc/Query.hs @@ -107,9 +107,10 @@ hprop_rpc_query_pparams = integrationRetryWorkspace 2 "rpc-query-pparams" $ \tem pparams ^. L.ppCoinsPerUTxOByteL . to L.unCoinPerByte . to L.fromCompact . to L.unCoin ===^ chainParams ^. U5c.coinsPerUtxoByte . to utxoRpcBigIntToInteger pparams ^. L.ppMaxTxSizeL === chainParams ^. U5c.maxTxSize . to fromIntegral - pparams ^. L.ppTxFeeFixedL ===^ chainParams ^. U5c.minFeeConstant . to utxoRpcBigIntToInteger + pparams ^. L.ppTxFeeFixedL . to L.unCoin + ===^ chainParams ^. U5c.minFeeConstant . to utxoRpcBigIntToInteger pparams ^. L.ppTxFeePerByteL . to L.unCoinPerByte . to L.fromCompact . to L.unCoin - ===^ chainParams ^. U5c.minFeeCoefficient . to (fmap L.Coin . utxoRpcBigIntToInteger) + ===^ chainParams ^. U5c.minFeeCoefficient . to utxoRpcBigIntToInteger pparams ^. L.ppMaxBBSizeL === chainParams ^. U5c.maxBlockBodySize . to fromIntegral pparams ^. L.ppMaxBHSizeL === chainParams ^. U5c.maxBlockHeaderSize . to fromIntegral pparams ^. L.ppKeyDepositL ===^ chainParams ^. U5c.stakeKeyDeposit . to (fmap L.Coin . utxoRpcBigIntToInteger) From 28f8c48212ee9a60c8baa982b648bc0726783200 Mon Sep 17 00:00:00 2001 From: Mateusz Galazyn Date: Fri, 8 May 2026 11:25:52 +0200 Subject: [PATCH 4/4] langlemangle2 --- cabal.project | 17 + .../src/Cardano/Node/Tracing/Tracers/Rpc.hs | 24 ++ .../Cardano/Testnet/Test/Rpc/Eval.hs | 391 +++++++++++------- .../Cardano/Testnet/Test/Rpc/Transaction.hs | 2 +- 4 files changed, 283 insertions(+), 151 deletions(-) diff --git a/cabal.project b/cabal.project index 7d699e8d362..1037cfb49bc 100644 --- a/cabal.project +++ b/cabal.project @@ -91,3 +91,20 @@ allow-newer: -- Do NOT add more source-repository-package stanzas here unless they are strictly -- temporary! Please read the section in CONTRIBUTING about updating dependencies. +source-repository-package + type: git + location: https://github.com/intersectmbo/cardano-api.git + tag: 1ad558ffb8fd9f8b00bb81c42ae4428575dbca34 + --sha256: 1x6lhnnyp5393myx08yfyriwnpz0f9y0g303nbq9hzh92yzyhi6b + subdir: + cardano-api + cardano-rpc + +source-repository-package + type: git + location: https://github.com/input-output-hk/cardano-cli.git + tag: 66edca364e7c128f95faf6717f6d0391f7518301 + --sha256: 13in641rswzs7qiac6fj6abv8xd2yvrcm58lav5553wz8s9sxfxm + subdir: + cardano-cli + diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/Rpc.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/Rpc.hs index d81458625fb..f9781f5efe6 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/Rpc.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/Rpc.hs @@ -35,6 +35,10 @@ instance LogFormatting TraceRpc where [ "queryName" .= String "ReadUtxos" , spanToObject s ] + TraceRpcQuerySearchUtxosSpan s -> + [ "queryName" .= String "SearchUtxos" + , spanToObject s + ] TraceRpcSubmit submitTrace -> ["kind" .= String "SubmitService"] <> case submitTrace of @@ -42,6 +46,8 @@ instance LogFormatting TraceRpc where TraceRpcSubmitTxDecodingError _ -> [] TraceRpcSubmitTxValidationError _ -> [] TraceRpcSubmitSpan s -> [spanToObject s] + TraceRpcEvalTxDecodingError _ -> [] + TraceRpcEvalTxSpan s -> [spanToObject s] forHuman = docToText . pretty @@ -50,7 +56,9 @@ instance LogFormatting TraceRpc where -- query names here are taken from UTXORPC spec: https://utxorpc.org/query/intro/#operations TraceRpcQuery (TraceRpcQueryParamsSpan (SpanBegin _)) -> [CounterM "rpc.request.QueryService.ReadParams" Nothing] TraceRpcQuery (TraceRpcQueryReadUtxosSpan (SpanBegin _)) -> [CounterM "rpc.request.QueryService.ReadUtxos" Nothing] + TraceRpcQuery (TraceRpcQuerySearchUtxosSpan (SpanBegin _)) -> [CounterM "rpc.request.QueryService.SearchUtxos" Nothing] TraceRpcSubmit (TraceRpcSubmitSpan (SpanBegin _)) -> [CounterM "rpc.request.SubmitService.SubmitTx" Nothing] + TraceRpcSubmit (TraceRpcEvalTxSpan (SpanBegin _)) -> [CounterM "rpc.request.SubmitService.EvalTx" Nothing] _ -> [] instance MetaTrace TraceRpc where @@ -63,6 +71,7 @@ instance MetaTrace TraceRpc where : case queryTrace of TraceRpcQueryParamsSpan _ -> ["ReadParams", "Span"] TraceRpcQueryReadUtxosSpan _ -> ["ReadUtxos", "Span"] + TraceRpcQuerySearchUtxosSpan _ -> ["SearchUtxos", "Span"] TraceRpcSubmit submitTrace -> "SubmitService" : case submitTrace of @@ -70,16 +79,21 @@ instance MetaTrace TraceRpc where TraceRpcSubmitTxDecodingError _ -> ["TxDecodingError"] TraceRpcSubmitTxValidationError _ -> ["TxValidationError"] TraceRpcSubmitSpan _ -> ["SubmitTx", "Span"] + TraceRpcEvalTxDecodingError _ -> ["EvalTxDecodingError"] + TraceRpcEvalTxSpan _ -> ["EvalTx", "Span"] severityFor (Namespace _ nsInner) _ = case nsInner of ["FatalError"] -> Just Error -- RPC server startup errors ["Error"] -> Just Debug -- those are normal operation errors, like request errors, hide them by default ["QueryService", "ReadParams", "Span"] -> Just Debug ["QueryService", "ReadUtxos", "Span"] -> Just Debug + ["QueryService", "SearchUtxos", "Span"] -> Just Debug ["SubmitService", "SubmitTx", "Span"] -> Just Debug + ["SubmitService", "EvalTx", "Span"] -> Just Debug ["SubmitService", "N2cConnectionError"] -> Just Warning -- this is a more serious error, this shouldn't happen ["SubmitService", "TxDecodingError"] -> Just Debug -- request error ["SubmitService", "TxValidationError"] -> Just Debug -- request error + ["SubmitService", "EvalTxDecodingError"] -> Just Debug -- request error _ -> Nothing documentFor (Namespace _ nsInner) = case nsInner of @@ -87,12 +101,15 @@ instance MetaTrace TraceRpc where ["Error"] -> Just "Normal operation errors such as request errors. Those are not harmful to the RPC server itself." ["QueryService", "ReadParams", "Span"] -> Just "Span for the ReadParams UTXORPC method." ["QueryService", "ReadUtxos", "Span"] -> Just "Span for the ReadUtxos UTXORPC method." + ["QueryService", "SearchUtxos", "Span"] -> Just "Span for the SearchUtxos UTXORPC method." ["SubmitService", "SubmitTx", "Span"] -> Just "Span for the SubmitTx UTXORPC method." + ["SubmitService", "EvalTx", "Span"] -> Just "Span for the EvalTx UTXORPC method." ["SubmitService", "N2cConnectionError"] -> Just "Node connection error. This should not happen, as this means that there is an issue in cardano-rpc configuration." ["SubmitService", "TxDecodingError"] -> Just "A regular request error, when submitted transaction decoding fails." ["SubmitService", "TxValidationError"] -> Just "A regular request error, when submitted transaction is invalid." + ["SubmitService", "EvalTxDecodingError"] -> Just "A regular request error, when evalTx transaction decoding fails." _ -> Nothing metricsDocFor (Namespace _ nsInner) = case nsInner of @@ -100,8 +117,12 @@ instance MetaTrace TraceRpc where [("rpc.request.QueryService.ReadParams", "Span for the ReadParams UTXORPC method.")] ["QueryService", "ReadUtxos", "Span"] -> [("rpc.request.QueryService.ReadUtxos", "Span for the ReadUtxos UTXORPC method.")] + ["QueryService", "SearchUtxos", "Span"] -> + [("rpc.request.QueryService.SearchUtxos", "Span for the SearchUtxos UTXORPC method.")] ["SubmitService", "SubmitTx", "Span"] -> [("rpc.request.SubmitService.SubmitTx", "Span for the SubmitTx UTXORPC method.")] + ["SubmitService", "EvalTx", "Span"] -> + [("rpc.request.SubmitService.EvalTx", "Span for the EvalTx UTXORPC method.")] _ -> [] allNamespaces = @@ -110,10 +131,13 @@ instance MetaTrace TraceRpc where , ["Error"] , ["QueryService", "ReadParams", "Span"] , ["QueryService", "ReadUtxos", "Span"] + , ["QueryService", "SearchUtxos", "Span"] , ["SubmitService", "SubmitTx", "Span"] + , ["SubmitService", "EvalTx", "Span"] , ["SubmitService", "N2cConnectionError"] , ["SubmitService", "TxDecodingError"] , ["SubmitService", "TxValidationError"] + , ["SubmitService", "EvalTxDecodingError"] ] -- helper functions diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Rpc/Eval.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Rpc/Eval.hs index 0531c879112..afadd9e6699 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Rpc/Eval.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Rpc/Eval.hs @@ -1,10 +1,10 @@ {-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NumericUnderscores #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} -{-# LANGUAGE TypeOperators #-} -- | Run with: -- @TASTY_PATTERN='/RPC Eval Tx/' cabal test cardano-testnet-test@ @@ -15,10 +15,10 @@ where import Cardano.Api import qualified Cardano.Api.Ledger as L -import Cardano.Api.Plutus (examplePlutusScriptAlwaysFails) +import Cardano.Rpc.Client (Proto (..)) import qualified Cardano.Rpc.Client as Rpc -import qualified Cardano.Rpc.Proto.Api.UtxoRpc.Query as U5c hiding (cardano, tx) +import qualified Cardano.Rpc.Proto.Api.UtxoRpc.Query as U5c hiding (cardano) import qualified Cardano.Rpc.Proto.Api.UtxoRpc.Submit as U5c import Cardano.Rpc.Server.Internal.UtxoRpc.Type (utxoRpcBigIntToInteger) import Cardano.Testnet @@ -26,9 +26,12 @@ import Cardano.Testnet import Prelude import Control.Monad (void) -import Control.Monad.Trans.Control (liftBaseOp) +import Control.Monad.Catch (MonadCatch) +import Control.Monad.Trans.Control (MonadBaseControl, liftBaseOp) import Data.Default.Class +import qualified Data.Map.Strict as Map import qualified Data.Text as T +import GHC.Stack (HasCallStack, withFrozenCallStack) import Lens.Micro import System.FilePath (()) @@ -75,7 +78,8 @@ hprop_rpc_eval_tx = integrationRetryWorkspace 2 "rpc-eval-tx" $ \tempAbsBasePath epochStateView <- getEpochStateView configurationFile $ nodeSocketPath node rpcSocket <- H.note . unFile $ nodeRpcSocketPath node - let utxoSKeyFile = signingKeyFp $ paymentKeyInfoPair wallet0 + let rpcServer = Rpc.ServerUnix rpcSocket + utxoSKeyFile = signingKeyFp $ paymentKeyInfoPair wallet0 utxoSKeyFile1 = signingKeyFp $ paymentKeyInfoPair wallet1 ------------------------------------ @@ -85,17 +89,27 @@ hprop_rpc_eval_tx = integrationRetryWorkspace 2 "rpc-eval-tx" $ \tempAbsBasePath H.writeFile plutusScriptFile $ T.unpack plutusV3Script plutusSpendingScriptAddr <- - execCli' execConfig - [ "latest", "address", "build" - , "--payment-script-file", plutusScriptFile - ] - - scriptDatumHash <- filter (/= '\n') <$> - execCli' execConfig - [ "latest", "transaction", "hash-script-data" - , "--script-data-value", "0" + execCli' + execConfig + [ "latest" + , "address" + , "build" + , "--payment-script-file" , plutusScriptFile ] + scriptDatumHash <- + filter (/= '\n') + <$> execCli' + execConfig + [ "latest" + , "transaction" + , "hash-script-data" + , "--script-data-value" + , "0" + ] + + -- Send ADA to the script address with a datum hash, creating a script-locked + -- UTxO that the spending transaction can later reference with a redeemer. ------------------------------------ -- 1. Fund the script address ------------------------------------ @@ -104,32 +118,67 @@ hprop_rpc_eval_tx = integrationRetryWorkspace 2 "rpc-eval-tx" $ \tempAbsBasePath let fundTxBody = work "fund-script-tx-body" fundTx = work "fund-script-tx" - void $ execCli' execConfig - [ anyEraToString anyEra, "transaction", "build" - , "--change-address", T.unpack $ paymentKeyInfoAddr wallet0 - , "--tx-in", T.unpack $ renderTxIn txinFund - , "--tx-out", plutusSpendingScriptAddr <> "+" <> show @Int 5_000_000 - , "--tx-out-datum-hash", scriptDatumHash - , "--out-file", fundTxBody - ] - - void $ execCli' execConfig - [ "latest", "transaction", "sign" - , "--tx-body-file", fundTxBody - , "--signing-key-file", utxoSKeyFile - , "--out-file", fundTx - ] - - void $ execCli' execConfig - [ "latest", "transaction", "submit" - , "--tx-file", fundTx - ] + void $ + execCli' + execConfig + [ anyEraToString anyEra + , "transaction" + , "build" + , "--change-address" , T.unpack $ paymentKeyInfoAddr wallet0 + , "--tx-in" , T.unpack $ renderTxIn txinFund + , "--tx-out" , plutusSpendingScriptAddr <> "+" <> show @Int 5_000_000 + , "--tx-out-datum-hash" , scriptDatumHash + , "--out-file" , fundTxBody + ] + + void $ + execCli' + execConfig + [ "latest" + , "transaction" + , "sign" + , "--tx-body-file" , fundTxBody + , "--signing-key-file" , utxoSKeyFile + , "--out-file" , fundTx + ] + + ------------------------------------ + -- 1b. EvalTx on the funding tx (no scripts) + ------------------------------------ + (fundSignedTx, fundTxEval) <- evalTxFile sbe rpcServer fundTx + + let TxFeeExplicit _ fundCliFee = txFee . getTxBodyContent $ getTxBody fundSignedTx + + H.note_ "EvalTx minimum fee should not exceed the CLI-computed fee" + fundEvalFee <- H.leftFail $ fundTxEval ^. U5c.fee . to utxoRpcBigIntToInteger + H.assertWith fundEvalFee (<= L.unCoin fundCliFee) + + H.note_ "No execution units for a plain key-witnessed transaction" + fundTxEval ^. U5c.exUnits . U5c.steps === 0 + fundTxEval ^. U5c.exUnits . U5c.memory === 0 + + H.note_ "No redeemers for a plain key-witnessed transaction" + fundTxEval ^. U5c.redeemers === [] + + H.note_ "No evaluation errors" + fundTxEval ^. U5c.errors === [] + + void $ + execCli' + execConfig + [ "latest" + , "transaction" + , "submit" + , "--tx-file" , fundTx + ] ------------------------------------ -- 2. Wait for the script UTxO, find collateral ------------------------------------ - plutusScriptTxIn <- fmap fst . retryUntilJustM epochStateView (WaitForBlocks 3) $ - findLargestUtxoWithAddress epochStateView sbe $ T.pack plutusSpendingScriptAddr + plutusScriptTxIn <- + fmap fst . retryUntilJustM epochStateView (WaitForBlocks 3) $ + findLargestUtxoWithAddress epochStateView sbe $ + T.pack plutusSpendingScriptAddr txinCollateral <- findLargestUtxoForPaymentKey epochStateView sbe wallet1 @@ -139,67 +188,63 @@ hprop_rpc_eval_tx = integrationRetryWorkspace 2 "rpc-eval-tx" $ \tempAbsBasePath let spendTxBody = work "spend-script-tx-body" spendTx = work "spend-script-tx" - void $ execCli' execConfig - [ anyEraToString anyEra, "transaction", "build" - , "--change-address", T.unpack $ paymentKeyInfoAddr wallet1 - , "--tx-in-collateral", T.unpack $ renderTxIn txinCollateral - , "--tx-in", T.unpack $ renderTxIn plutusScriptTxIn - , "--tx-in-script-file", plutusScriptFile - , "--tx-in-datum-value", "0" - , "--tx-in-redeemer-value", "0" - , "--out-file", spendTxBody - ] - - void $ execCli' execConfig - [ "latest", "transaction", "sign" - , "--tx-body-file", spendTxBody - , "--signing-key-file", utxoSKeyFile1 - , "--out-file", spendTx - ] + void $ + execCli' + execConfig + [ anyEraToString anyEra + , "transaction" + , "build" + , "--change-address" , T.unpack $ paymentKeyInfoAddr wallet1 + , "--tx-in-collateral" , T.unpack $ renderTxIn txinCollateral + , "--tx-in" , T.unpack $ renderTxIn plutusScriptTxIn + , "--tx-in-script-file" , plutusScriptFile + , "--tx-in-datum-value" , "0" + , "--tx-in-redeemer-value" , "0" + , "--out-file" , spendTxBody + ] + + void $ + execCli' + execConfig + [ "latest" + , "transaction" + , "sign" + , "--tx-body-file" , spendTxBody + , "--signing-key-file" , utxoSKeyFile1 + , "--out-file" , spendTx + ] ------------------------------------ - -- 4. Read signed tx and call evalTx + -- 4. EvalTx on the spending tx (Plutus V3 always-succeeds) ------------------------------------ - signedTx <- - H.leftFailM . H.evalIO $ - readFileTextEnvelope @(Tx ConwayEra) (File spendTx) + (signedTx, txEval) <- evalTxFile sbe rpcServer spendTx let TxFeeExplicit _ cliFee = txFee . getTxBodyContent $ getTxBody signedTx - rpcServer = Rpc.ServerUnix rpcSocket - evalRequest = - def & U5c.tx . U5c.raw .~ serialiseToCBOR signedTx - - liftBaseOp (Rpc.withConnection def rpcServer) $ \conn -> do - evalResponse <- H.noteShowM . H.evalIO $ - Rpc.nonStreaming conn (Rpc.rpc @(Rpc.Protobuf U5c.SubmitService "evalTx")) evalRequest - - let txEval = evalResponse ^. U5c.report . U5c.cardano + ShelleyTx _ ledgerTx = signedTx - ------------------------------------ - -- 5. Assertions - ------------------------------------ - H.note_ "EvalTx fee should match the CLI-computed fee" - evalFee <- H.leftFail $ txEval ^. U5c.fee . to utxoRpcBigIntToInteger - evalFee === L.unCoin cliFee + H.note_ "EvalTx minimum fee should not exceed the CLI-computed fee" + evalFee <- H.leftFail $ txEval ^. U5c.fee . to utxoRpcBigIntToInteger + H.assertWith evalFee (<= L.unCoin cliFee) - H.note_ "Aggregate execution units should be positive" - H.assertWith (txEval ^. U5c.exUnits . U5c.steps) (> 0) - H.assertWith (txEval ^. U5c.exUnits . U5c.memory) (> 0) + H.note_ "Execution units should match the transaction" + (_, L.ExUnits txMem txSteps) <- H.headM . Map.elems . L.unRedeemers $ ledgerTx ^. L.witsTxL . L.rdmrsTxWitsL + txEval ^. U5c.exUnits . U5c.steps === fromIntegral txSteps + txEval ^. U5c.exUnits . U5c.memory === fromIntegral txMem - H.note_ "One redeemer for the spend purpose at index 0" - let redeemers = txEval ^. U5c.redeemers - H.assertWith redeemers $ \rs -> length rs == 1 - head redeemers ^. U5c.purpose === U5c.REDEEMER_PURPOSE_SPEND - head redeemers ^. U5c.index === 0 + H.note_ "One redeemer for the spend purpose at index 0" + let redeemers = txEval ^. U5c.redeemers + length redeemers === 1 + redeemer0 <- H.headM redeemers + redeemer0 ^. U5c.purpose === Proto U5c.REDEEMER_PURPOSE_SPEND + redeemer0 ^. U5c.index === 0 + redeemer0 ^. U5c.exUnits . U5c.steps === fromIntegral txSteps + redeemer0 ^. U5c.exUnits . U5c.memory === fromIntegral txMem - H.note_ "No evaluation errors" - H.assertWith (txEval ^. U5c.errors) null - - H.note_ "No script traces from always-succeeds script" - H.assertWith (txEval ^. U5c.traces) null + H.note_ "No evaluation errors" + txEval ^. U5c.errors === [] ------------------------------------ - -- 6. Failure path: always-fails script + -- 5. Failure path: always-fails script ------------------------------------ let failScript = PlutusScript PlutusScriptV1 $ examplePlutusScriptAlwaysFails WitCtxTxIn failScriptFile <- H.note $ work "always-fails.plutusV1" @@ -207,9 +252,12 @@ hprop_rpc_eval_tx = integrationRetryWorkspace 2 "rpc-eval-tx" $ \tempAbsBasePath writeFileTextEnvelope (File failScriptFile) Nothing failScript failScriptAddr <- - execCli' execConfig - [ "latest", "address", "build" - , "--payment-script-file", failScriptFile + execCli' + execConfig + [ "latest" + , "address" + , "build" + , "--payment-script-file" , failScriptFile ] txinFund2 <- findLargestUtxoForPaymentKey epochStateView sbe wallet0 @@ -217,68 +265,111 @@ hprop_rpc_eval_tx = integrationRetryWorkspace 2 "rpc-eval-tx" $ \tempAbsBasePath let fundFailTxBody = work "fund-fail-script-tx-body" fundFailTx = work "fund-fail-script-tx" - void $ execCli' execConfig - [ anyEraToString anyEra, "transaction", "build" - , "--change-address", T.unpack $ paymentKeyInfoAddr wallet0 - , "--tx-in", T.unpack $ renderTxIn txinFund2 - , "--tx-out", failScriptAddr <> "+" <> show @Int 5_000_000 - , "--tx-out-datum-hash", scriptDatumHash - , "--out-file", fundFailTxBody - ] - - void $ execCli' execConfig - [ "latest", "transaction", "sign" - , "--tx-body-file", fundFailTxBody - , "--signing-key-file", utxoSKeyFile - , "--out-file", fundFailTx - ] - - void $ execCli' execConfig - [ "latest", "transaction", "submit" - , "--tx-file", fundFailTx - ] - - failScriptTxIn <- fmap fst . retryUntilJustM epochStateView (WaitForBlocks 3) $ - findLargestUtxoWithAddress epochStateView sbe $ T.pack failScriptAddr + void $ + execCli' + execConfig + [ anyEraToString anyEra + , "transaction" + , "build" + , "--change-address" , T.unpack $ paymentKeyInfoAddr wallet0 + , "--tx-in" , T.unpack $ renderTxIn txinFund2 + , "--tx-out" , failScriptAddr <> "+" <> show @Int 5_000_000 + , "--tx-out-datum-hash" , scriptDatumHash + , "--out-file" , fundFailTxBody + ] + + void $ + execCli' + execConfig + [ "latest" + , "transaction" + , "sign" + , "--tx-body-file" , fundFailTxBody + , "--signing-key-file" , utxoSKeyFile + , "--out-file" , fundFailTx + ] + + void $ + execCli' + execConfig + [ "latest" + , "transaction" + , "submit" + , "--tx-file" , fundFailTx + ] + failScriptTxIn <- + fmap fst . retryUntilJustM epochStateView (WaitForBlocks 3) $ + findLargestUtxoWithAddress epochStateView sbe $ + T.pack failScriptAddr + + txinCollateral2 <- findLargestUtxoForPaymentKey epochStateView sbe wallet1 + + protocolParamsFile <- H.note $ work "protocol-params.json" + void $ + execCli' + execConfig + [ "latest" + , "query" + , "protocol-parameters" + , "--out-file" , protocolParamsFile + ] + + -- Use build-raw because `transaction build` would reject the always-fails script. let failSpendTxBody = work "fail-spend-tx-body" failSpendTx = work "fail-spend-tx" - void $ execCli' execConfig - [ anyEraToString anyEra, "transaction", "build-raw" - , "--tx-in", T.unpack $ renderTxIn failScriptTxIn - , "--tx-in-collateral", T.unpack $ renderTxIn txinCollateral - , "--tx-in-script-file", failScriptFile - , "--tx-in-datum-value", "0" - , "--tx-in-redeemer-value", "0" - , "--tx-in-execution-units", "(10000000000,10000000)" - , "--tx-out", T.unpack (paymentKeyInfoAddr wallet1) <> "+4700000" - , "--fee", "300000" - , "--out-file", failSpendTxBody - ] - - void $ execCli' execConfig - [ "latest", "transaction", "sign" - , "--tx-body-file", failSpendTxBody - , "--signing-key-file", utxoSKeyFile1 - , "--out-file", failSpendTx - ] - - failSignedTx <- - H.leftFailM . H.evalIO $ - readFileTextEnvelope @(Tx ConwayEra) (File failSpendTx) - - let failEvalRequest = - def & U5c.tx . U5c.raw .~ serialiseToCBOR failSignedTx - - liftBaseOp (Rpc.withConnection def rpcServer) $ \conn -> do - failEvalResponse <- H.noteShowM . H.evalIO $ - Rpc.nonStreaming conn (Rpc.rpc @(Rpc.Protobuf U5c.SubmitService "evalTx")) failEvalRequest - - let failTxEval = failEvalResponse ^. U5c.report . U5c.cardano - - H.note_ "Errors should be non-empty for always-fails script" - H.assertWith (failTxEval ^. U5c.errors) $ not . null - - H.note_ "Redeemers should be empty for failed evaluation" - H.assertWith (failTxEval ^. U5c.redeemers) null + void $ + execCli' + execConfig + [ anyEraToString anyEra + , "transaction" + , "build-raw" + , "--tx-in" , T.unpack $ renderTxIn failScriptTxIn + , "--tx-in-collateral" , T.unpack $ renderTxIn txinCollateral2 + , "--tx-in-script-file" , failScriptFile + , "--tx-in-datum-value" , "0" + , "--tx-in-redeemer-value" , "0" + , "--tx-in-execution-units" , "(10000000000,10000000)" + , "--tx-out" , T.unpack (paymentKeyInfoAddr wallet1) <> "+4700000" + , "--fee" , "300000" + , "--protocol-params-file" , protocolParamsFile + , "--out-file" , failSpendTxBody + ] + + void $ + execCli' + execConfig + [ "latest" + , "transaction" + , "sign" + , "--tx-body-file" , failSpendTxBody + , "--signing-key-file" , utxoSKeyFile1 + , "--out-file" , failSpendTx + ] + + ------------------------------------ + -- 5b. EvalTx on the always-fails spending tx + ------------------------------------ + (_, failTxEval) <- evalTxFile sbe rpcServer failSpendTx + + H.note_ "Evaluation errors for always-fails script" + failTxEval ^. U5c.errors /== [] + +-- | Read a signed transaction from a file and evaluate it via the gRPC evalTx +-- endpoint, returning the decoded transaction and the TxEval result. +evalTxFile + :: (HasCallStack, MonadBaseControl IO m, MonadCatch m, MonadIO m, MonadTest m) + => ShelleyBasedEra era + -> Rpc.Server + -> FilePath + -> m (Tx era, Proto U5c.TxEval) +evalTxFile sbe' rpcServer txFile = withFrozenCallStack $ do + textEnvelope <- H.leftFailM . H.evalIO $ readTextEnvelopeFromFile txFile + signedTx <- H.leftFail $ shelleyBasedEraConstraints sbe' $ deserialiseFromTextEnvelope textEnvelope + let request = def & U5c.tx . U5c.raw .~ textEnvelopeRawCBOR textEnvelope + (response :: Proto U5c.EvalTxResponse) <- + liftBaseOp (Rpc.withConnection def rpcServer) $ \conn -> + H.noteShowPrettyM . H.evalIO $ + Rpc.nonStreaming conn (Rpc.rpc @(Rpc.Protobuf U5c.SubmitService "evalTx")) request + pure (signedTx, response ^. U5c.report . U5c.cardano) diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Rpc/Transaction.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Rpc/Transaction.hs index e01cedeafd4..fedff59acbf 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Rpc/Transaction.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Rpc/Transaction.hs @@ -17,7 +17,7 @@ import qualified Cardano.Api.Ledger as L import Cardano.Rpc.Client (Proto) import qualified Cardano.Rpc.Client as Rpc -import qualified Cardano.Rpc.Proto.Api.UtxoRpc.Query as U5c hiding (cardano, items, tx) +import qualified Cardano.Rpc.Proto.Api.UtxoRpc.Query as U5c hiding (cardano, tx) import qualified Cardano.Rpc.Proto.Api.UtxoRpc.Query as UtxoRpc import qualified Cardano.Rpc.Proto.Api.UtxoRpc.Submit as U5c import qualified Cardano.Rpc.Proto.Api.UtxoRpc.Submit as UtxoRpc