From 875fa527a8428b558c26039c305ac47b4628f0c6 Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Mon, 3 Feb 2025 17:27:00 +0100 Subject: [PATCH] Add test for ensuring calculating costs of transaction with simple script doesn't crash --- .../Test/Cli/Plutus/CostCalculation.hs | 162 +++++++++++++++++- .../cardano-testnet-test.hs | 1 + .../files/calculateSimpleScriptCost.json | 1 + 3 files changed, 159 insertions(+), 5 deletions(-) create mode 100644 cardano-testnet/test/cardano-testnet-test/files/calculateSimpleScriptCost.json diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Plutus/CostCalculation.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Plutus/CostCalculation.hs index 3fed19eb84a..84eaa16741f 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Plutus/CostCalculation.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Plutus/CostCalculation.hs @@ -1,18 +1,22 @@ {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NumericUnderscores #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} module Cardano.Testnet.Test.Cli.Plutus.CostCalculation ( hprop_ref_plutus_cost_calculation , hprop_included_plutus_cost_calculation + , hprop_included_simple_script_cost_calculation -- | Execute tests in this module with: -- @DISABLE_RETRIES=1 cabal run cardano-testnet-test -- -p "/Spec.hs.Spec.Ledger Events.Plutus.Cost Calc/"@ ) where import Cardano.Api (AnyCardanoEra (AnyCardanoEra), - AnyShelleyBasedEra (AnyShelleyBasedEra), File (File), MonadIO (liftIO), - ShelleyBasedEra (ShelleyBasedEraConway), ToCardanoEra (toCardanoEra), renderTxIn, - unFile) + AnyShelleyBasedEra (AnyShelleyBasedEra), ExceptT, File (File), MonadIO (liftIO), + ShelleyBasedEra (ShelleyBasedEraConway), + ToCardanoEra (toCardanoEra), deserialiseAnyVerificationKey, liftEither, + renderTxIn, unFile, verificationKeyHash, mapSomeAddressVerificationKey, serialiseToRawBytesHex) import Cardano.Api.Experimental (Some (Some)) import Cardano.Api.Ledger (EpochInterval (EpochInterval), unCoin) @@ -21,8 +25,16 @@ import Cardano.Testnet import Prelude import Control.Monad (void) +import Control.Monad.Except (runExceptT) +import Data.Aeson (Value, encodeFile) +import qualified Data.Aeson.KeyMap as KeyMap +import Data.Aeson.Types (Value (..), object) +import Data.Bifunctor (first) +import qualified Data.ByteString as BS import Data.Default.Class (Default (def)) +import Data.Text (Text) import qualified Data.Text as Text +import qualified Data.Vector as Vector import System.Directory (makeAbsolute) import System.FilePath (()) import qualified System.Info as SYS @@ -41,7 +53,9 @@ import Testnet.Process.Cli.Transaction (TxOutAddress (..), mkSpendOutp import Testnet.Process.Run (execCli', mkExecConfig) import Testnet.Property.Util (integrationRetryWorkspace) import Testnet.Start.Types (eraToString) -import Testnet.Types (PaymentKeyInfo (paymentKeyInfoAddr), paymentKeyInfoPair) +import Testnet.Types (PaymentKeyInfo (paymentKeyInfoAddr), paymentKeyInfoPair, + verificationKey) +import Data.Text.Encoding (decodeLatin1) -- @DISABLE_RETRIES=1 cabal run cardano-testnet-test -- -p "/Spec.hs.Spec.Ledger Events.Plutus.Cost Calc.Ref Script/"@ hprop_ref_plutus_cost_calculation :: Property @@ -287,7 +301,7 @@ hprop_included_plutus_cost_calculation = integrationRetryWorkspace 2 "included p submitTx execConfig cEra signedIncludedScript -- Calculate cost of the transaction - let includedScriptCostOutput = File $ includedScriptUnlock "unsigned-tx.tx" + let includedScriptCostOutput = File $ includedScriptUnlock "scriptCost.json" H.noteM_ $ execCli' execConfig @@ -300,3 +314,141 @@ hprop_included_plutus_cost_calculation = integrationRetryWorkspace 2 "included p H.diffFileVsGoldenFile (unFile includedScriptCostOutput) "test/cardano-testnet-test/files/calculatePlutusScriptCost.json" + +-- @DISABLE_RETRIES=1 cabal run cardano-testnet-test -- -p "/Spec.hs.Spec.Ledger Events.Plutus.Cost Calc.Simple Script/"@ +hprop_included_simple_script_cost_calculation :: Property +hprop_included_simple_script_cost_calculation = integrationRetryWorkspace 2 "included simple script" $ \tempAbsBasePath' -> H.runWithDefaultWatchdog_ $ do + H.note_ SYS.os + conf@Conf{tempAbsPath} <- mkConf tempAbsBasePath' + let tempAbsPath' = unTmpAbsPath tempAbsPath + work <- H.createDirectoryIfMissing $ tempAbsPath' "work" + + let + sbe = ShelleyBasedEraConway + era = toCardanoEra sbe + cEra = AnyCardanoEra era + eraName = eraToString era + tempBaseAbsPath = makeTmpBaseAbsPath $ TmpAbsolutePath tempAbsPath' + options = def{cardanoNodeEra = AnyShelleyBasedEra sbe} + + TestnetRuntime + { configurationFile + , testnetMagic + , testnetNodes + , wallets = wallet0 : wallet1 : _ + } <- + cardanoTestnetDefault options def conf + + poolNode1 <- H.headM testnetNodes + poolSprocket1 <- H.noteShow $ nodeSprocket poolNode1 + execConfig <- mkExecConfig tempBaseAbsPath poolSprocket1 testnetMagic + epochStateView <- getEpochStateView configurationFile (nodeSocketPath poolNode1) + + -- We write a simple script that allows any of the two payment keys to spend the money + + addrHash1 <- H.evalEitherM $ liftIO $ runExceptT $ paymentKeyInfoHash wallet0 + addrHash2 <- H.evalEitherM $ liftIO $ runExceptT $ paymentKeyInfoHash wallet1 + + simpleScriptLockWork <- H.createDirectoryIfMissing $ work "simple-script-lock" + let simpleScript = File $ simpleScriptLockWork "simple-script.json" + liftIO $ encodeFile (unFile simpleScript) $ generateSimpleAnyKeyScript [addrHash1, addrHash2] + + -- We now submit a transaction to the script address + let lockedAmount = 10_000_000 + enoughAmountForFees = 2_000_000 -- Needs to be more than min ada + + txBodySimpleScriptLock <- + mkSpendOutputsOnlyTx + execConfig + epochStateView + sbe + simpleScriptLockWork + "tx-body" + wallet0 + [(ScriptAddress simpleScript, lockedAmount, Nothing)] + + signedTxSimpleScriptLock <- + signTx + execConfig + cEra + simpleScriptLockWork + "signed-tx" + txBodySimpleScriptLock + [Some $ paymentKeyInfoPair wallet0] + submitTx execConfig cEra signedTxSimpleScriptLock + + -- Wait until transaction is on chain and obtain transaction identifier + txIdSimpleScriptLock <- retrieveTransactionId execConfig signedTxSimpleScriptLock + txIxSimpleScriptLock <- + H.evalMaybeM $ + watchEpochStateUpdate + epochStateView + (EpochInterval 2) + (getTxIx sbe txIdSimpleScriptLock lockedAmount) + + -- Create transaction that unlocks the simple script UTxO we just created + simpleScriptUnlockWork <- H.createDirectoryIfMissing $ work "simple-script-unlock" + let unsignedUnlockSimpleScript = File $ simpleScriptUnlockWork "unsigned-tx.tx" + + void $ + execCli' + execConfig + [ eraName + , "transaction", "build" + , "--change-address", Text.unpack $ paymentKeyInfoAddr wallet1 + , "--tx-in", txIdSimpleScriptLock <> "#" <> show txIxSimpleScriptLock + , "--tx-in-script-file", unFile simpleScript + , "--tx-out", Text.unpack (paymentKeyInfoAddr wallet1) <> "+" <> show (unCoin (lockedAmount - enoughAmountForFees)) + , "--witness-override", "2" + , "--out-file", unFile unsignedUnlockSimpleScript + ] + + signedScriptUnlock <- + signTx + execConfig + cEra + simpleScriptUnlockWork + "signed-tx" + unsignedUnlockSimpleScript + [Some $ paymentKeyInfoPair wallet1] + + submitTx execConfig cEra signedScriptUnlock + + -- Calculate cost of the transaction + + output <- + H.noteM $ + execCli' + execConfig + [ eraName + , "transaction", "calculate-plutus-script-cost" + , "--tx-file", unFile signedScriptUnlock + ] + + H.diffVsGoldenFile output "test/cardano-testnet-test/files/calculateSimpleScriptCost.json" + + where + generateSimpleAnyKeyScript :: [Text] -> Value + generateSimpleAnyKeyScript keyHashes = + object + [ ("type", "any") + , + ( "scripts" + , Array $ + Vector.fromList + [ Object $ + KeyMap.fromList + [ ("type", "sig") + , ("keyHash", String keyHash) + ] + | keyHash <- keyHashes + ] + ) + ] + + paymentKeyInfoHash :: PaymentKeyInfo -> ExceptT String IO Text + paymentKeyInfoHash wallet = do + vkBs <- liftIO $ BS.readFile (unFile $ verificationKey $ paymentKeyInfoPair wallet) + svk <- liftEither $ first show $ deserialiseAnyVerificationKey vkBs + return $ decodeLatin1 $ mapSomeAddressVerificationKey (serialiseToRawBytesHex . verificationKeyHash) svk + 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 e33c87ec422..9a294ca53d0 100644 --- a/cardano-testnet/test/cardano-testnet-test/cardano-testnet-test.hs +++ b/cardano-testnet/test/cardano-testnet-test/cardano-testnet-test.hs @@ -77,6 +77,7 @@ tests = do , T.testGroup "Cost Calc" [ ignoreOnWindows "Ref Script" Cardano.Testnet.Test.Cli.Plutus.CostCalculation.hprop_ref_plutus_cost_calculation , ignoreOnWindows "Normal Script" Cardano.Testnet.Test.Cli.Plutus.CostCalculation.hprop_included_plutus_cost_calculation + , ignoreOnWindows "Simple Script" Cardano.Testnet.Test.Cli.Plutus.CostCalculation.hprop_included_simple_script_cost_calculation ] ] ] diff --git a/cardano-testnet/test/cardano-testnet-test/files/calculateSimpleScriptCost.json b/cardano-testnet/test/cardano-testnet-test/files/calculateSimpleScriptCost.json new file mode 100644 index 00000000000..fe51488c706 --- /dev/null +++ b/cardano-testnet/test/cardano-testnet-test/files/calculateSimpleScriptCost.json @@ -0,0 +1 @@ +[]