From 9c80e654c6dd0b2c1a3d5f1a9c61cb3ba14f1b32 Mon Sep 17 00:00:00 2001 From: Mateusz Galazyn Date: Fri, 10 May 2024 18:09:47 +0200 Subject: [PATCH] Make plutus spending script less flaky --- cardano-testnet/src/Testnet/Types.hs | 16 ++--- .../Cardano/Testnet/Test/Cli/Conway/Plutus.hs | 66 +++++-------------- 2 files changed, 26 insertions(+), 56 deletions(-) diff --git a/cardano-testnet/src/Testnet/Types.hs b/cardano-testnet/src/Testnet/Types.hs index 21ef1344249..db0c15a6182 100644 --- a/cardano-testnet/src/Testnet/Types.hs +++ b/cardano-testnet/src/Testnet/Types.hs @@ -105,6 +105,14 @@ data TestnetRuntime = TestnetRuntime poolSprockets :: TestnetRuntime -> [Sprocket] poolSprockets = fmap (nodeSprocket . poolRuntime) . poolNodes +data PoolNode = PoolNode + { poolRuntime :: NodeRuntime + , poolKeys :: PoolNodeKeys + } + +poolNodeStdout :: PoolNode -> FilePath +poolNodeStdout = nodeStdout . poolRuntime + data NodeRuntime = NodeRuntime { nodeName :: !String , nodeIpv4 :: !Text @@ -119,14 +127,6 @@ data NodeRuntime = NodeRuntime nodeSocketPath :: NodeRuntime -> SocketPath nodeSocketPath = File . H.sprocketSystemName . nodeSprocket -data PoolNode = PoolNode - { poolRuntime :: NodeRuntime - , poolKeys :: PoolNodeKeys - } - -poolNodeStdout :: PoolNode -> FilePath -poolNodeStdout = nodeStdout . poolRuntime - data ColdPoolKey data StakingKey data SpoColdKey diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Conway/Plutus.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Conway/Plutus.hs index 97ce1d7071e..8a60974f369 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Conway/Plutus.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Conway/Plutus.hs @@ -11,23 +11,24 @@ module Cardano.Testnet.Test.Cli.Conway.Plutus ) where import Cardano.Api +import qualified Cardano.Api.Ledger as L import Cardano.Testnet import Prelude import Control.Monad (void) -import qualified Data.Map.Strict as Map import qualified Data.Text as Text import System.FilePath (()) import qualified System.Info as SYS import Testnet.Components.Configuration +import Testnet.Components.Query import Testnet.Components.TestWatchdog import Testnet.Defaults import Testnet.Process.Cli.SPO import Testnet.Process.Run (execCli', mkExecConfig) -import Testnet.Property.Util (decodeEraUTxO, integrationWorkspace) +import Testnet.Property.Util (integrationWorkspace) import Testnet.Types import Hedgehog (Property) @@ -55,37 +56,27 @@ hprop_plutus_v3 = integrationWorkspace "all-plutus-script-purposes" $ \tempAbsBa era = toCardanoEra sbe anyEra = AnyCardanoEra era options = cardanoDefaultTestnetOptions - { cardanoNodes = cardanoDefaultTestnetNodeOptions - , cardanoSlotLength = 0.1 - , cardanoNodeEra = anyEra -- TODO: We should only support the latest era and the upcoming era - } + { cardanoNodeEra = anyEra -- TODO: We should only support the latest era and the upcoming era + } + TestnetRuntime - { testnetMagic + { configurationFile + , testnetMagic , poolNodes , wallets=wallet0:wallet1:_ } <- cardanoTestnetDefault options conf - poolNode1 <- H.headM poolNodes - poolSprocket1 <- H.noteShow $ nodeSprocket $ poolRuntime poolNode1 + PoolNode{poolRuntime} <- H.headM poolNodes + poolSprocket1 <- H.noteShow $ nodeSprocket poolRuntime execConfig <- mkExecConfig tempBaseAbsPath poolSprocket1 testnetMagic H.noteShow_ wallet0 let utxoAddr = Text.unpack $ paymentKeyInfoAddr wallet0 - utxoAddr2 = Text.unpack $ paymentKeyInfoAddr wallet1 utxoSKeyFile = signingKeyFp $ paymentKeyInfoPair wallet0 utxoSKeyFile2 = signingKeyFp $ paymentKeyInfoPair wallet1 + socketPath = nodeSocketPath poolRuntime - void $ execCli' execConfig - [ anyEraToString anyEra, "query", "utxo" - , "--address", utxoAddr - , "--cardano-mode" - , "--out-file", work "utxo-1.json" - ] - utxo1Json <- H.leftFailM . H.readJsonFile $ work "utxo-1.json" - UTxO utxo1 <- H.noteShowM $ decodeEraUTxO sbe utxo1Json - - let keys1 = Map.keys utxo1 - H.note_ $ "keys1: " <> show (length keys1) - txin1 <- H.noteShowM $ H.headM keys1 + epochStateView <- getEpochStateView configurationFile socketPath + txin1 <- findLargestUtxoForPaymentKey epochStateView sbe wallet0 plutusMintingScript <- H.note $ work "always-succeeds-non-spending-script.plutusV3" H.writeFile plutusMintingScript $ Text.unpack plutusV3NonSpendingScript @@ -151,34 +142,13 @@ hprop_plutus_v3 = integrationWorkspace "all-plutus-script-purposes" $ \tempAbsBa , "--tx-file", sendAdaToScriptAddressTx ] - H.threadDelay 10_000_000 - -- 2. Successfully spend conway spending script - void $ execCli' execConfig - [ anyEraToString anyEra, "query", "utxo" - , "--address", utxoAddr2 - , "--cardano-mode" - , "--out-file", work "utxo-2.json" - ] - utxo2Json <- H.leftFailM . H.readJsonFile $ work "utxo-2.json" - UTxO utxo2 <- H.noteShowM $ decodeEraUTxO sbe utxo2Json - - let keys2 = Map.keys utxo2 - H.note_ $ "keys2: " <> show (length keys2) - txinCollateral <- H.noteShowM $ H.headM keys2 - - void $ execCli' execConfig - [ anyEraToString anyEra, "query", "utxo" - , "--address", plutusSpendingScriptAddr - , "--cardano-mode" - , "--out-file", work "plutus-script-utxo.json" - ] - utxoPlutusJson <- H.leftFailM . H.readJsonFile $ work "plutus-script-utxo.json" - UTxO utxoPlutus <- H.noteShowM $ decodeEraUTxO sbe utxoPlutusJson + _ <- waitForEpochs epochStateView (L.EpochInterval 1) - let keys3 = Map.keys utxoPlutus - H.note_ $ "keys3: " <> show (length keys3) + -- 2. Successfully spend conway spending script + txinCollateral <- findLargestUtxoForPaymentKey epochStateView sbe wallet1 + plutusScriptTxIn <- fmap fst . H.nothingFailM $ + findLargestUtxoWithAddress epochStateView sbe $ Text.pack plutusSpendingScriptAddr - plutusScriptTxIn <- H.noteShowM $ H.headM keys3 let spendScriptUTxOTxBody = work "spend-script-utxo-tx-body" spendScriptUTxOTx = work "spend-script-utxo-tx" mintValue = mconcat ["5 ", mintingPolicyId, ".", assetName]