From c735516211bd25233612f80b98cf7fc1fc9b2d4e Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Fri, 19 Jul 2024 03:05:16 +0200 Subject: [PATCH 01/16] Enforce we have one test per query type --- cardano-testnet/cardano-testnet.cabal | 3 + .../src/Testnet/TestEnumGenerator.hs | 44 +++ cardano-testnet/src/Testnet/TestQueryCmds.hs | 20 ++ .../Cardano/Testnet/Test/Cli/Query.hs | 261 +++++++++++------- 4 files changed, 233 insertions(+), 95 deletions(-) create mode 100644 cardano-testnet/src/Testnet/TestEnumGenerator.hs create mode 100644 cardano-testnet/src/Testnet/TestQueryCmds.hs diff --git a/cardano-testnet/cardano-testnet.cabal b/cardano-testnet/cardano-testnet.cabal index e0cec0cdff0..e9e3741f40d 100644 --- a/cardano-testnet/cardano-testnet.cabal +++ b/cardano-testnet/cardano-testnet.cabal @@ -82,6 +82,7 @@ library , tasty ^>= 1.5 , tasty-expected-failure , tasty-hedgehog + , template-haskell , temporary , text , time @@ -110,12 +111,14 @@ library Testnet.Start.Byron Testnet.Start.Types Testnet.SubmitApi + Testnet.TestQueryCmds Testnet.Types other-modules: Parsers.Cardano Parsers.Help Parsers.Version Testnet.Start.Cardano + Testnet.TestEnumGenerator Paths_cardano_testnet autogen-modules: Paths_cardano_testnet diff --git a/cardano-testnet/src/Testnet/TestEnumGenerator.hs b/cardano-testnet/src/Testnet/TestEnumGenerator.hs new file mode 100644 index 00000000000..2e6b2f1d243 --- /dev/null +++ b/cardano-testnet/src/Testnet/TestEnumGenerator.hs @@ -0,0 +1,44 @@ +module Testnet.TestEnumGenerator + ( genTestType + , genAllConstructorsList + ) where + +import Language.Haskell.TH (Body (NormalB), Con (..), Dec (DataD, ValD), Exp (ConE, ListE), + Info (TyConI), Name, Pat (VarP), Q, mkName, nameBase, reify) + +-- | Create a datatype with the same constructors as the given type, but with a "Test" prefix and no arguments. +-- For example, if the input type is 'Maybe', the output type will be 'TestMaybe', with constructors 'TestNothing' +-- and 'TestJust', but 'TestJust' will have no arguments. +genTestType :: Name -> Q [Dec] +genTestType typeName = do + TyConI (DataD _ _ _ _ constructors _) <- reify typeName + let newConstructors = map (makeSimpleConstructor . addTestPrefix) $ concatMap getConstructorName constructors + return [DataD [] (addTestPrefix typeName) [] Nothing newConstructors []] + where + addTestPrefix :: Name -> Name + addTestPrefix name = mkName $ "Test" ++ nameBase name + + makeSimpleConstructor :: Name -> Con + makeSimpleConstructor n = NormalC n [] + +-- | Generate a declaration with a list of all constructors of a type. For example, if the input type is 'Maybe', +-- the output will be 'allMaybeConstructors = [Nothing, Just]'. Obviously, this will only work if all constructors +-- have types that can be unified, like is the case with nullary constructors like the ones generated by 'genNewType'. +genAllConstructorsList :: Name -> Q [Dec] +genAllConstructorsList typeName = do + constructorList <- getAllConstructors typeName + return [ValD (VarP $ mkName $ "all" ++ nameBase typeName ++ "Constructors") (NormalB constructorList) []] + where + getAllConstructors :: Name -> Q Exp + getAllConstructors typeName' = do + TyConI (DataD _ _ _ _ constructors _) <- reify typeName' + return $ ListE $ map ConE $ concatMap getConstructorName constructors + +-- | Obtain the name or names from a constructor +getConstructorName :: Con -> [Name] +getConstructorName (NormalC na _) = [na] +getConstructorName (RecC na _) = [na] +getConstructorName (InfixC _ na _) = [na] +getConstructorName (ForallC _ _ con) = getConstructorName con +getConstructorName (GadtC nas _ _) = nas +getConstructorName (RecGadtC nas _ _) = nas diff --git a/cardano-testnet/src/Testnet/TestQueryCmds.hs b/cardano-testnet/src/Testnet/TestQueryCmds.hs new file mode 100644 index 00000000000..dbb6d76b723 --- /dev/null +++ b/cardano-testnet/src/Testnet/TestQueryCmds.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE GADTs #-} +{-# OPTIONS_GHC -Wno-missing-signatures #-} +{-# OPTIONS_GHC -Wno-unused-top-binds #-} + +module Testnet.TestQueryCmds + ( TestQueryCmds(..) + , forallQueryCommands + ) where + +import Cardano.CLI.EraBased.Commands.Query (QueryCmds (..)) + +import Testnet.TestEnumGenerator (genTestType, genAllConstructorsList) + +$(genTestType ''QueryCmds) + +$(genAllConstructorsList ''TestQueryCmds) + +forallQueryCommands :: Monad m => (TestQueryCmds -> m a) -> m () +forallQueryCommands f = mapM_ f allTestQueryCmdsConstructors diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Query.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Query.hs index 32ebe1d9108..4f5e35b3c8a 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Query.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Query.hs @@ -3,6 +3,7 @@ {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE LambdaCase #-} module Cardano.Testnet.Test.Cli.Query ( hprop_cli_queries @@ -29,6 +30,7 @@ import Testnet.Components.Configuration (eraToString) import Testnet.Components.Query import Testnet.Process.Run (execCli', execCliStdoutToJson, mkExecConfig) import Testnet.Property.Util (integrationWorkspace) +import Testnet.TestQueryCmds (TestQueryCmds (..), forallQueryCommands) import Testnet.Types import Hedgehog @@ -78,101 +80,170 @@ hprop_cli_queries = integrationWorkspace "cli-queries" $ \tempAbsBasePath' -> H. checkDRepsNumber epochStateView sbe 3 - -- protocol-parameters - do - -- to stdout - protocolParametersOut <- execCli' execConfig [ eraName, "query", "protocol-parameters" ] - H.diffVsGoldenFile - protocolParametersOut - "test/cardano-testnet-test/files/golden/queries/protocolParametersOut.txt" - -- protocol-parameters to a file - let protocolParametersOutFile = work "protocol-parameters-out.json" - H.noteM_ $ execCli' execConfig [ eraName, "query", "protocol-parameters" - , "--out-file", protocolParametersOutFile] - H.diffFileVsGoldenFile - protocolParametersOutFile - "test/cardano-testnet-test/files/golden/queries/protocolParametersFileOut.json" - - -- tip - do - -- to stdout - _ :: QueryTipLocalStateOutput <- H.noteShowM $ execCliStdoutToJson execConfig [ eraName, "query", "tip" ] - -- to a file - let tipOutFile = work "tip-out.json" - H.noteM_ $ execCli' execConfig [ eraName, "query", "tip" - , "--out-file", tipOutFile] - _ :: QueryTipLocalStateOutput <- H.readJsonFileOk tipOutFile - pure () - - -- stake-pools - do - -- to stdout - stakePoolsOut <- execCli' execConfig [ eraName, "query", "stake-pools" ] - H.assertWith stakePoolsOut $ \pools -> - length (lines pools) == 3 -- Because, by default, 3 stake pools are created - -- Light test of the query's answer, the ids should exist: - forM_ (lines stakePoolsOut) $ \stakePoolId -> do - execCli' execConfig [ eraName, "query", "pool-state" - , "--stake-pool-id", stakePoolId ] - -- to a file - let stakePoolsOutFile = work "stake-pools-out.json" - H.noteM_ $ execCli' execConfig [ eraName, "query", "stake-pools" , "--out-file", stakePoolsOutFile] - - -- stake-distribution - do - -- to stdout - stakeDistrOut <- execCli' execConfig [ eraName, "query", "stake-distribution" ] - -- stake addresses with stake - let stakeAddresses :: [(Text, Text)] = - map - ( bimap T.strip T.strip - . T.breakOn " " -- separate address and stake - . T.strip - . fromString ) - . drop 2 -- drop header - . lines - $ stakeDistrOut - H.assertWith stakeAddresses $ \sa -> - -- Because, by default, 3 stake pools are created - length sa == 3 - -- Light test of the query's answer, the ids should exist: - forM_ stakeAddresses $ \(stakePoolId, _) -> do - execCli' execConfig [ eraName, "query", "pool-state" - , "--stake-pool-id", T.unpack stakePoolId ] - -- to a file - let stakePoolsOutFile = work "stake-distribution-out.json" - H.noteM_ $ execCli' execConfig [ eraName, "query", "stake-distribution" - , "--out-file", stakePoolsOutFile] - - -- gov-state - do - -- to stdout - execCli' execConfig [ eraName, "query", "gov-state" ] - >>= - (`H.diffVsGoldenFile` - "test/cardano-testnet-test/files/golden/queries/govStateOut.json") - -- to a file - let govStateOutFile = work "gov-state-out.json" - H.noteM_ $ execCli' execConfig [ eraName, "query", "gov-state", "--out-file", govStateOutFile] - H.diffFileVsGoldenFile - govStateOutFile - "test/cardano-testnet-test/files/golden/queries/govStateOut.json" - - -- drep-state - do - -- to stdout - -- TODO: deserialize to a Haskell value when - -- https://github.com/IntersectMBO/cardano-cli/issues/606 is tackled - dreps :: Aeson.Value <- H.noteShowM $ execCliStdoutToJson execConfig [ eraName, "query", "drep-state", "--all-dreps"] - assertArrayOfSize dreps 3 - -- to a file - let drepStateOutFile = work "drep-state-out.json" - H.noteM_ $ execCli' execConfig [ eraName, "query", "drep-state", "--all-dreps" - , "--out-file", drepStateOutFile] - _ :: Aeson.Value <- H.readJsonFileOk drepStateOutFile - pure () - - H.success + forallQueryCommands (\case + + TestQueryLeadershipScheduleCmd -> do + -- leadership-schedule + pure () + + TestQueryProtocolParametersCmd -> + -- protocol-parameters + do + -- to stdout + protocolParametersOut <- execCli' execConfig [ eraName, "query", "protocol-parameters" ] + H.diffVsGoldenFile + protocolParametersOut + "test/cardano-testnet-test/files/golden/queries/protocolParametersOut.txt" + -- protocol-parameters to a file + let protocolParametersOutFile = work "protocol-parameters-out.json" + H.noteM_ $ execCli' execConfig [ eraName, "query", "protocol-parameters" + , "--out-file", protocolParametersOutFile ] + H.diffFileVsGoldenFile + protocolParametersOutFile + "test/cardano-testnet-test/files/golden/queries/protocolParametersFileOut.json" + + TestQueryConstitutionHashCmd -> do + -- constitution-hash + -- Currently disabled (not accessible from the command line) + pure () + + TestQueryTipCmd -> + -- tip + do + -- to stdout + _ :: QueryTipLocalStateOutput <- H.noteShowM $ execCliStdoutToJson execConfig [ eraName, "query", "tip" ] + -- to a file + let tipOutFile = work "tip-out.json" + H.noteM_ $ execCli' execConfig [ eraName, "query", "tip" + , "--out-file", tipOutFile ] + _ :: QueryTipLocalStateOutput <- H.readJsonFileOk tipOutFile + pure () + + TestQueryStakePoolsCmd -> + -- stake-pools + do + -- to stdout + stakePoolsOut <- execCli' execConfig [ eraName, "query", "stake-pools" ] + H.assertWith stakePoolsOut $ \pools -> + length (lines pools) == 3 -- Because, by default, 3 stake pools are created + -- Light test of the query's answer, the ids should exist: + forM_ (lines stakePoolsOut) $ \stakePoolId -> do + execCli' execConfig [ eraName, "query", "pool-state" + , "--stake-pool-id", stakePoolId ] + -- to a file + let stakePoolsOutFile = work "stake-pools-out.json" + H.noteM_ $ execCli' execConfig [ eraName, "query", "stake-pools" , "--out-file", stakePoolsOutFile] + + TestQueryStakeDistributionCmd -> + -- stake-distribution + do + -- to stdout + stakeDistrOut <- execCli' execConfig [ eraName, "query", "stake-distribution" ] + -- stake addresses with stake + let stakeAddresses :: [(Text, Text)] = + map + ( bimap T.strip T.strip + . T.breakOn " " -- separate address and stake + . T.strip + . fromString ) + . drop 2 -- drop header + . lines + $ stakeDistrOut + H.assertWith stakeAddresses $ \sa -> + -- Because, by default, 3 stake pools are created + length sa == 3 + -- Light test of the query's answer, the ids should exist: + forM_ stakeAddresses $ \(stakePoolId, _) -> do + execCli' execConfig [ eraName, "query", "pool-state" + , "--stake-pool-id", T.unpack stakePoolId ] + -- to a file + let stakePoolsOutFile = work "stake-distribution-out.json" + H.noteM_ $ execCli' execConfig [ eraName, "query", "stake-distribution" + , "--out-file", stakePoolsOutFile ] + + TestQueryStakeAddressInfoCmd -> do + -- stake-address-info + pure () + + TestQueryUTxOCmd -> do + -- utxo + pure () + + TestQueryLedgerStateCmd -> do + -- ledger-state + pure () + + TestQueryProtocolStateCmd -> do + -- protocol-state + pure () + + TestQueryStakeSnapshotCmd -> do + -- stake-snapshot + pure () + + TestQueryKesPeriodInfoCmd -> do + -- kes-period-info + pure () + + TestQueryPoolStateCmd -> do + -- pool-state + pure () + + TestQueryTxMempoolCmd -> do + -- tx-mempool + pure () + + TestQuerySlotNumberCmd -> do + -- slot-number + pure () + + TestQueryRefScriptSizeCmd -> do + -- ref-script-size + pure () + + TestQueryConstitutionCmd -> do + -- constitution + pure () + + TestQueryGovStateCmd -> + -- gov-state + do + -- to stdout + execCli' execConfig [ eraName, "query", "gov-state" ] + >>= + (`H.diffVsGoldenFile` + "test/cardano-testnet-test/files/golden/queries/govStateOut.json") + -- to a file + let govStateOutFile = work "gov-state-out.json" + H.noteM_ $ execCli' execConfig [ eraName, "query", "gov-state", "--out-file", govStateOutFile ] + H.diffFileVsGoldenFile + govStateOutFile + "test/cardano-testnet-test/files/golden/queries/govStateOut.json" + + TestQueryDRepStateCmd -> + -- drep-state + do + -- to stdout + -- TODO: deserialize to a Haskell value when + -- https://github.com/IntersectMBO/cardano-cli/issues/606 is tackled + dreps :: Aeson.Value <- H.noteShowM $ execCliStdoutToJson execConfig [ eraName, "query", "drep-state", "--all-dreps" ] + assertArrayOfSize dreps 3 + -- to a file + let drepStateOutFile = work "drep-state-out.json" + H.noteM_ $ execCli' execConfig [ eraName, "query", "drep-state", "--all-dreps" + , "--out-file", drepStateOutFile ] + _ :: Aeson.Value <- H.readJsonFileOk drepStateOutFile + pure () + + TestQueryDRepStakeDistributionCmd -> do + -- drep-stake-distribution + pure () + + TestQueryCommitteeMembersStateCmd -> do + -- committee-state + pure () + + ) -- | @assertArrayOfSize v n@ checks that the value is a JSON array of size @n@, -- otherwise it fails the test. From 07848728956f931b5f4af019ecf3de33486b5e19 Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Mon, 22 Jul 2024 20:24:31 +0200 Subject: [PATCH 02/16] Address flakiness in `query gov-state` test --- .../Cardano/Testnet/Test/Cli/Query.hs | 26 ++++++++++++++++--- .../files/golden/queries/govStateOut.json | 3 --- 2 files changed, 22 insertions(+), 7 deletions(-) diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Query.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Query.hs index 4f5e35b3c8a..9c72b190b9a 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Query.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Query.hs @@ -17,11 +17,14 @@ import Cardano.Testnet import Prelude import Control.Monad (forM_) +import Data.Aeson (eitherDecodeStrictText) import qualified Data.Aeson as Aeson +import qualified Data.Aeson.KeyMap as Aeson import Data.Bifunctor (bimap) import Data.String import Data.Text (Text) import qualified Data.Text as T +import Data.Text.Encoding (decodeUtf8) import qualified Data.Vector as Vector import GHC.Stack (HasCallStack) import System.FilePath (()) @@ -209,13 +212,13 @@ hprop_cli_queries = integrationWorkspace "cli-queries" $ \tempAbsBasePath' -> H. -- gov-state do -- to stdout - execCli' execConfig [ eraName, "query", "gov-state" ] - >>= - (`H.diffVsGoldenFile` - "test/cardano-testnet-test/files/golden/queries/govStateOut.json") + output <- execCli' execConfig [ eraName, "query", "gov-state" ] + patchedOutput <- H.evalEither $ patchGovStateOutput output + H.diffVsGoldenFile patchedOutput "test/cardano-testnet-test/files/golden/queries/govStateOut.json" -- to a file let govStateOutFile = work "gov-state-out.json" H.noteM_ $ execCli' execConfig [ eraName, "query", "gov-state", "--out-file", govStateOutFile ] + patchGovStateOutputFile govStateOutFile H.diffFileVsGoldenFile govStateOutFile "test/cardano-testnet-test/files/golden/queries/govStateOut.json" @@ -244,6 +247,21 @@ hprop_cli_queries = integrationWorkspace "cli-queries" $ \tempAbsBasePath' -> H. pure () ) + where + patchGovStateOutput :: String -> Either String String + patchGovStateOutput output = do + eOutput <- eitherDecodeStrictText (T.pack output) + return $ T.unpack $ decodeUtf8 $ prettyPrintJSON $ patchGovStateJSON eOutput + where + patchGovStateJSON :: Aeson.Object -> Aeson.Object + patchGovStateJSON o = Aeson.delete "futurePParams" o + + patchGovStateOutputFile :: (MonadTest m, MonadIO m) => FilePath -> m () + patchGovStateOutputFile fp = do + fileContents <- liftIO $ readFile fp + patchedOutput <- H.evalEither $ patchGovStateOutput fileContents + liftIO $ writeFile fp patchedOutput + -- | @assertArrayOfSize v n@ checks that the value is a JSON array of size @n@, -- otherwise it fails the test. diff --git a/cardano-testnet/test/cardano-testnet-test/files/golden/queries/govStateOut.json b/cardano-testnet/test/cardano-testnet-test/files/golden/queries/govStateOut.json index 12a7f523266..e8e53cac674 100644 --- a/cardano-testnet/test/cardano-testnet-test/files/golden/queries/govStateOut.json +++ b/cardano-testnet/test/cardano-testnet-test/files/golden/queries/govStateOut.json @@ -660,9 +660,6 @@ "txFeePerByte": 1, "utxoCostPerByte": 4310 }, - "futurePParams": { - "tag": "NoPParamsUpdate" - }, "nextRatifyState": { "enactedGovActions": [], "expiredGovActions": [], From ef6193ae24ab6bccc7bedcbda03b4abb3461c7bc Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Fri, 19 Jul 2024 22:48:05 +0200 Subject: [PATCH 03/16] Add test for `query leadership-schedule` --- .../Cardano/Testnet/Test/Cli/Query.hs | 31 +++++++++++++++++-- 1 file changed, 29 insertions(+), 2 deletions(-) diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Query.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Query.hs index 9c72b190b9a..3b3e2c96916 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Query.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Query.hs @@ -4,19 +4,24 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE FlexibleContexts #-} module Cardano.Testnet.Test.Cli.Query ( hprop_cli_queries ) where import Cardano.Api +import Cardano.Api.Ledger (EpochInterval(EpochInterval)) +import Cardano.Api.Shelley (StakePoolKey) +import Cardano.CLI.Types.Key (readVerificationKeyOrFile, VerificationKeyOrFile (VerificationKeyFilePath)) import Cardano.CLI.Types.Output (QueryTipLocalStateOutput) import Cardano.Testnet import Prelude import Control.Monad (forM_) +import Control.Monad.Catch (MonadCatch) import Data.Aeson (eitherDecodeStrictText) import qualified Data.Aeson as Aeson import qualified Data.Aeson.KeyMap as Aeson @@ -31,6 +36,7 @@ import System.FilePath (()) import Testnet.Components.Configuration (eraToString) import Testnet.Components.Query +import qualified Testnet.Defaults as Defaults import Testnet.Process.Run (execCli', execCliStdoutToJson, mkExecConfig) import Testnet.Property.Util (integrationWorkspace) import Testnet.TestQueryCmds (TestQueryCmds (..), forallQueryCommands) @@ -68,6 +74,8 @@ hprop_cli_queries = integrationWorkspace "cli-queries" $ \tempAbsBasePath' -> H. , configurationFile } <- cardanoTestnetDefault fastTestnetOptions conf + + let shelleyGeneisFile = work Defaults.defaultGenesisFilepath ShelleyEra PoolNode{poolRuntime} <- H.headM poolNodes poolSprocket1 <- H.noteShow $ nodeSprocket poolRuntime @@ -83,11 +91,22 @@ hprop_cli_queries = integrationWorkspace "cli-queries" $ \tempAbsBasePath' -> H. checkDRepsNumber epochStateView sbe 3 + -- If we don't wait, the leadershi-schedule test will say SPO has no stake + _ <- waitForEpochs epochStateView (EpochInterval 1) + forallQueryCommands (\case - TestQueryLeadershipScheduleCmd -> do + TestQueryLeadershipScheduleCmd -> -- leadership-schedule - pure () + do + let spoKeys = Defaults.defaultSpoKeys 1 + spoVerificationKey :: VerificationKey StakePoolKey <- readVerificationKeyFromFile AsStakePoolKey work $ verificationKey $ poolNodeKeysCold spoKeys + H.noteM_ $ execCli' execConfig [ eraName, "query", "leadership-schedule" + , "--genesis", shelleyGeneisFile + , "--stake-pool-verification-key", T.unpack $ serialiseToBech32 spoVerificationKey + , "--vrf-signing-key-file", unFile $ signingKey $ poolNodeKeysVrf spoKeys + , "--current" + ] TestQueryProtocolParametersCmd -> -- protocol-parameters @@ -256,6 +275,14 @@ hprop_cli_queries = integrationWorkspace "cli-queries" $ \tempAbsBasePath' -> H. patchGovStateJSON :: Aeson.Object -> Aeson.Object patchGovStateJSON o = Aeson.delete "futurePParams" o + readVerificationKeyFromFile :: (MonadIO m, MonadCatch m, MonadTest m, HasTextEnvelope (VerificationKey keyrole), SerialiseAsBech32 (VerificationKey keyrole)) + => AsType keyrole + -> FilePath + -> File content direction + -> m (VerificationKey keyrole) + readVerificationKeyFromFile asKey work = + H.evalEitherM . liftIO . runExceptT . readVerificationKeyOrFile asKey . VerificationKeyFilePath . File . (work ) . unFile + patchGovStateOutputFile :: (MonadTest m, MonadIO m) => FilePath -> m () patchGovStateOutputFile fp = do fileContents <- liftIO $ readFile fp From 1cb9aebdfdd04784141d427a1cfe7c4a622b59f5 Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Sat, 20 Jul 2024 01:19:32 +0200 Subject: [PATCH 04/16] Add test for `query stake-address-info` --- .../Cardano/Testnet/Test/Cli/Query.hs | 25 +++++++++++++------ 1 file changed, 18 insertions(+), 7 deletions(-) diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Query.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Query.hs index 3b3e2c96916..2580fc24528 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Query.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Query.hs @@ -12,7 +12,7 @@ module Cardano.Testnet.Test.Cli.Query import Cardano.Api import Cardano.Api.Ledger (EpochInterval(EpochInterval)) -import Cardano.Api.Shelley (StakePoolKey) +import Cardano.Api.Shelley (StakePoolKey, StakeCredential (StakeCredentialByKey)) import Cardano.CLI.Types.Key (readVerificationKeyOrFile, VerificationKeyOrFile (VerificationKeyFilePath)) import Cardano.CLI.Types.Output (QueryTipLocalStateOutput) @@ -156,6 +156,11 @@ hprop_cli_queries = integrationWorkspace "cli-queries" $ \tempAbsBasePath' -> H. let stakePoolsOutFile = work "stake-pools-out.json" H.noteM_ $ execCli' execConfig [ eraName, "query", "stake-pools" , "--out-file", stakePoolsOutFile] + TestQueryPoolStateCmd -> do + -- pool-state + -- Already tested in TestQueryStakePoolsCmd and TestQueryStakeDistributionCmd + pure () + TestQueryStakeDistributionCmd -> -- stake-distribution do @@ -183,9 +188,15 @@ hprop_cli_queries = integrationWorkspace "cli-queries" $ \tempAbsBasePath' -> H. H.noteM_ $ execCli' execConfig [ eraName, "query", "stake-distribution" , "--out-file", stakePoolsOutFile ] - TestQueryStakeAddressInfoCmd -> do + TestQueryStakeAddressInfoCmd -> -- stake-address-info - pure () + do + let delegatorKeys = Defaults.defaultDelegatorStakeKeyPair 1 + delegatorVKey :: VerificationKey StakeKey <- readVerificationKeyFromFile AsStakeKey work $ verificationKey delegatorKeys + let stakeAddress :: StakeAddress = verificationStakeKeyToStakeAddress testnetMagic delegatorVKey + H.noteM_ $ execCli' execConfig [ eraName, "query", "stake-address-info" + , "--address", T.unpack $ serialiseAddress stakeAddress + ] TestQueryUTxOCmd -> do -- utxo @@ -207,10 +218,6 @@ hprop_cli_queries = integrationWorkspace "cli-queries" $ \tempAbsBasePath' -> H. -- kes-period-info pure () - TestQueryPoolStateCmd -> do - -- pool-state - pure () - TestQueryTxMempoolCmd -> do -- tx-mempool pure () @@ -283,6 +290,10 @@ hprop_cli_queries = integrationWorkspace "cli-queries" $ \tempAbsBasePath' -> H. readVerificationKeyFromFile asKey work = H.evalEitherM . liftIO . runExceptT . readVerificationKeyOrFile asKey . VerificationKeyFilePath . File . (work ) . unFile + verificationStakeKeyToStakeAddress :: Int -> VerificationKey StakeKey -> StakeAddress + verificationStakeKeyToStakeAddress testnetMagic delegatorVKey = + makeStakeAddress (fromNetworkMagic $ NetworkMagic $ fromIntegral testnetMagic) (StakeCredentialByKey $ verificationKeyHash delegatorVKey) + patchGovStateOutputFile :: (MonadTest m, MonadIO m) => FilePath -> m () patchGovStateOutputFile fp = do fileContents <- liftIO $ readFile fp From b2e99ccc9039ea7e53258d402c6bf29d43e4946e Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Mon, 22 Jul 2024 17:59:32 +0200 Subject: [PATCH 05/16] Add tests for `query utxo`, `query ledger-state`, and `query protocol-state` --- .../Cardano/Testnet/Test/Cli/Query.hs | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Query.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Query.hs index 2580fc24528..dd6da3a1ef4 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Query.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Query.hs @@ -198,17 +198,17 @@ hprop_cli_queries = integrationWorkspace "cli-queries" $ \tempAbsBasePath' -> H. , "--address", T.unpack $ serialiseAddress stakeAddress ] - TestQueryUTxOCmd -> do + TestQueryUTxOCmd -> -- utxo - pure () + H.noteM_ $ execCli' execConfig [ eraName, "query", "utxo", "--whole-utxo" ] - TestQueryLedgerStateCmd -> do + TestQueryLedgerStateCmd -> -- ledger-state - pure () + H.noteM_ $ execCli' execConfig [ eraName, "query", "ledger-state" ] - TestQueryProtocolStateCmd -> do + TestQueryProtocolStateCmd -> -- protocol-state - pure () + H.noteM_ $ execCli' execConfig [ eraName, "query", "protocol-state" ] TestQueryStakeSnapshotCmd -> do -- stake-snapshot From 3304e84cac0c3ba10052ca099abb59f1d709487b Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Tue, 23 Jul 2024 00:21:11 +0200 Subject: [PATCH 06/16] Add test for `query stake-snapshot` and `query tx-mempool` --- .../src/Testnet/Process/Cli/Transaction.hs | 45 ++++++++++++++++++- .../Cardano/Testnet/Test/Cli/Query.hs | 27 ++++++++--- 2 files changed, 65 insertions(+), 7 deletions(-) diff --git a/cardano-testnet/src/Testnet/Process/Cli/Transaction.hs b/cardano-testnet/src/Testnet/Process/Cli/Transaction.hs index 0d32eebc626..4eec73e0e47 100644 --- a/cardano-testnet/src/Testnet/Process/Cli/Transaction.hs +++ b/cardano-testnet/src/Testnet/Process/Cli/Transaction.hs @@ -1,7 +1,8 @@ {-# LANGUAGE DataKinds #-} module Testnet.Process.Cli.Transaction - ( signTx + ( buildTransferTx + , signTx , submitTx , failToSubmitTx , retrieveTransactionId @@ -21,12 +22,15 @@ import GHC.IO.Exception (ExitCode (..)) import GHC.Stack import System.FilePath (()) +import Testnet.Components.Query (findLargestUtxoForPaymentKey, EpochStateView) import Testnet.Process.Run (execCli') import Testnet.Start.Types (anyEraToString) import Testnet.Types import Hedgehog (MonadTest) import qualified Hedgehog.Extras as H +import qualified Data.Text as T +import Data.Typeable (Typeable) -- Transaction signing data VoteFile @@ -35,6 +39,45 @@ data TxBody data SignedTx +-- | Calls @cardano-cli@ to sign a simple ADA transfer transaction using +-- the specified key pairs. +-- This function takes five parameters: +-- +-- Returns the generated @File TxBody In@ file path to the created unsigned +-- transaction file. +buildTransferTx + :: Typeable era + => H.MonadAssertion m + => MonadTest m + => MonadCatch m + => MonadIO m + => H.ExecConfig -- ^ Specifies the CLI execution configuration. + -> EpochStateView -- ^ Current epoch state view for transaction building. It can be obtained + -- using the 'getEpochStateView' function. + -> ShelleyBasedEra era -- ^ Witness for the current Cardano era. + -> FilePath -- ^ Base directory path where the unsigned transaction file will be stored. + -> String -- ^ Prefix for the output unsigned transaction file name. The extension will be @.txbody@. + -> PaymentKeyInfo -- ^ Payment key pair used for paying the transaction. + -> PaymentKeyInfo -- ^ Payment key of the recipient of the transaction. + -> Int -- ^ Amount of ADA to transfer (in Lovelace). + -> m (File TxBody In) +buildTransferTx execConfig epochStateView sbe work prefix srcWallet dstWallet amount = do + let era = toCardanoEra sbe + cEra = AnyCardanoEra era + txBody = File (work prefix <> ".txbody") + txin <- findLargestUtxoForPaymentKey epochStateView sbe srcWallet + void $ execCli' execConfig + [ anyEraToString cEra, "transaction", "build" + , "--change-address", srcAddress + , "--tx-in", T.unpack $ renderTxIn txin + , "--tx-out", destAddress <> "+" <> show amount + , "--out-file", unFile txBody + ] + return txBody + where + srcAddress = T.unpack $ paymentKeyInfoAddr srcWallet + destAddress = T.unpack $ paymentKeyInfoAddr dstWallet + -- | Calls @cardano-cli@ to signs a transaction body using the specified key pairs. -- -- This function takes five parameters: diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Query.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Query.hs index dd6da3a1ef4..c93dc6f6090 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Query.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Query.hs @@ -5,6 +5,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE NumericUnderscores #-} module Cardano.Testnet.Test.Cli.Query ( hprop_cli_queries @@ -37,6 +38,7 @@ import System.FilePath (()) import Testnet.Components.Configuration (eraToString) import Testnet.Components.Query import qualified Testnet.Defaults as Defaults +import Testnet.Process.Cli.Transaction (buildTransferTx, signTx, submitTx, retrieveTransactionId) import Testnet.Process.Run (execCli', execCliStdoutToJson, mkExecConfig) import Testnet.Property.Util (integrationWorkspace) import Testnet.TestQueryCmds (TestQueryCmds (..), forallQueryCommands) @@ -72,6 +74,7 @@ hprop_cli_queries = integrationWorkspace "cli-queries" $ \tempAbsBasePath' -> H. { testnetMagic , poolNodes , configurationFile + , wallets=wallet0:wallet1:_ } <- cardanoTestnetDefault fastTestnetOptions conf @@ -210,20 +213,32 @@ hprop_cli_queries = integrationWorkspace "cli-queries" $ \tempAbsBasePath' -> H. -- protocol-state H.noteM_ $ execCli' execConfig [ eraName, "query", "protocol-state" ] - TestQueryStakeSnapshotCmd -> do + TestQueryStakeSnapshotCmd -> -- stake-snapshot - pure () + H.noteM_ $ execCli' execConfig [ eraName, "query", "stake-snapshot", "--all-stake-pools" ] TestQueryKesPeriodInfoCmd -> do -- kes-period-info + -- This is tested in hprop_kes_period_info in Cardano.Testnet.Test.Cli.KesPeriodInfo pure () - TestQueryTxMempoolCmd -> do + TestQueryTxMempoolCmd -> -- tx-mempool - pure () - - TestQuerySlotNumberCmd -> do + do + H.noteM_ $ execCli' execConfig [ eraName, "query", "tx-mempool", "info" ] + H.noteM_ $ execCli' execConfig [ eraName, "query", "tx-mempool", "next-tx" ] + -- Now we create a transaction and check if it exists in the mempool + mempoolWork <- H.createDirectoryIfMissing $ work "mempool-test" + txBody <- buildTransferTx execConfig epochStateView sbe mempoolWork "tx-body" wallet0 wallet1 10_000_000 + signedTx <- signTx execConfig cEra mempoolWork "signed-tx" txBody [SomeKeyPair $ paymentKeyInfoPair wallet0] + submitTx execConfig cEra signedTx + txId <- retrieveTransactionId execConfig signedTx + -- And we check + H.noteM_ $ execCli' execConfig [ eraName, "query", "tx-mempool", "tx-exists", txId ] + + TestQuerySlotNumberCmd -> -- slot-number + -- This is tested in hprop_querySlotNumber in Cardano.Testnet.Test.Cli.QuerySlotNumber pure () TestQueryRefScriptSizeCmd -> do From 19027dba1c093874070367eb3775f83639f374bc Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Wed, 24 Jul 2024 01:11:45 +0200 Subject: [PATCH 07/16] Add test for `query ref-script-size` --- .../src/Testnet/Process/Cli/Transaction.hs | 76 +++++++++++++++---- .../Cardano/Testnet/Test/Cli/Query.hs | 27 ++++++- .../golden/queries/refScriptSizeOut.json | 3 + 3 files changed, 87 insertions(+), 19 deletions(-) create mode 100644 cardano-testnet/test/cardano-testnet-test/files/golden/queries/refScriptSizeOut.json diff --git a/cardano-testnet/src/Testnet/Process/Cli/Transaction.hs b/cardano-testnet/src/Testnet/Process/Cli/Transaction.hs index 4eec73e0e47..ee7692f7961 100644 --- a/cardano-testnet/src/Testnet/Process/Cli/Transaction.hs +++ b/cardano-testnet/src/Testnet/Process/Cli/Transaction.hs @@ -1,13 +1,16 @@ {-# LANGUAGE DataKinds #-} +{-# LANGUAGE ScopedTypeVariables #-} module Testnet.Process.Cli.Transaction - ( buildTransferTx + ( buildSimpleTransferTx + , buildTransferTx , signTx , submitTx , failToSubmitTx , retrieveTransactionId , SignedTx , TxBody + , TxOutAddress(..) , VoteFile ) where @@ -18,6 +21,8 @@ import Prelude import Control.Monad (void) import Control.Monad.Catch (MonadCatch) import Data.List (isInfixOf) +import qualified Data.Text as T +import Data.Typeable (Typeable) import GHC.IO.Exception (ExitCode (..)) import GHC.Stack import System.FilePath (()) @@ -29,8 +34,6 @@ import Testnet.Types import Hedgehog (MonadTest) import qualified Hedgehog.Extras as H -import qualified Data.Text as T -import Data.Typeable (Typeable) -- Transaction signing data VoteFile @@ -39,6 +42,11 @@ data TxBody data SignedTx +data ReferenceScriptJSON + +data TxOutAddress = PKAddress PaymentKeyInfo + | ReferenceScriptAddress (File ReferenceScriptJSON In) + -- | Calls @cardano-cli@ to sign a simple ADA transfer transaction using -- the specified key pairs. -- This function takes five parameters: @@ -58,25 +66,63 @@ buildTransferTx -> FilePath -- ^ Base directory path where the unsigned transaction file will be stored. -> String -- ^ Prefix for the output unsigned transaction file name. The extension will be @.txbody@. -> PaymentKeyInfo -- ^ Payment key pair used for paying the transaction. - -> PaymentKeyInfo -- ^ Payment key of the recipient of the transaction. - -> Int -- ^ Amount of ADA to transfer (in Lovelace). + -> [(TxOutAddress, Int)] -- ^ List of pairs of transaction output addresses and amounts. -> m (File TxBody In) -buildTransferTx execConfig epochStateView sbe work prefix srcWallet dstWallet amount = do - let era = toCardanoEra sbe - cEra = AnyCardanoEra era - txBody = File (work prefix <> ".txbody") - txin <- findLargestUtxoForPaymentKey epochStateView sbe srcWallet - void $ execCli' execConfig +buildTransferTx execConfig epochStateView sbe work prefix srcWallet txOutputs = do + + txIn <- findLargestUtxoForPaymentKey epochStateView sbe srcWallet + fixedTxOuts :: [String] <- computeTxOuts + void $ execCli' execConfig $ [ anyEraToString cEra, "transaction", "build" , "--change-address", srcAddress - , "--tx-in", T.unpack $ renderTxIn txin - , "--tx-out", destAddress <> "+" <> show amount - , "--out-file", unFile txBody + , "--tx-in", T.unpack $ renderTxIn txIn + ] ++ fixedTxOuts ++ + [ "--out-file", unFile txBody ] return txBody where + era = toCardanoEra sbe + cEra = AnyCardanoEra era + txBody = File (work prefix <> ".txbody") srcAddress = T.unpack $ paymentKeyInfoAddr srcWallet - destAddress = T.unpack $ paymentKeyInfoAddr dstWallet + computeTxOuts = concat <$> sequence + [ case txOut of + PKAddress dstWallet -> + return ["--tx-out", T.unpack (paymentKeyInfoAddr dstWallet) <> "+" ++ show amount ] + ReferenceScriptAddress (File referenceScriptJSON) -> do + scriptAddress <- execCli' execConfig [ anyEraToString cEra, "address", "build" + , "--payment-script-file", referenceScriptJSON + ] + return [ "--tx-out", scriptAddress <> "+" ++ show amount + , "--tx-out-reference-script-file", referenceScriptJSON + ] + | (txOut, amount) <- txOutputs + ] + +-- | Calls @cardano-cli@ to sign a simple ADA transfer transaction using +-- the specified key pairs. +-- This function takes five parameters: +-- +-- Returns the generated @File TxBody In@ file path to the created unsigned +-- transaction file. +buildSimpleTransferTx + :: Typeable era + => H.MonadAssertion m + => MonadTest m + => MonadCatch m + => MonadIO m + => H.ExecConfig -- ^ Specifies the CLI execution configuration. + -> EpochStateView -- ^ Current epoch state view for transaction building. It can be obtained + -- using the 'getEpochStateView' function. + -> ShelleyBasedEra era -- ^ Witness for the current Cardano era. + -> FilePath -- ^ Base directory path where the unsigned transaction file will be stored. + -> String -- ^ Prefix for the output unsigned transaction file name. The extension will be @.txbody@. + -> PaymentKeyInfo -- ^ Payment key pair used for paying the transaction. + -> PaymentKeyInfo -- ^ Payment key of the recipient of the transaction. + -> Int -- ^ Amount of ADA to transfer (in Lovelace). + -> m (File TxBody In) +buildSimpleTransferTx execConfig epochStateView sbe work prefix srcWallet dstWallet amount = + buildTransferTx execConfig epochStateView sbe work prefix srcWallet [(PKAddress dstWallet, amount)] -- | Calls @cardano-cli@ to signs a transaction body using the specified key pairs. -- diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Query.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Query.hs index c93dc6f6090..d6355c5f069 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Query.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Query.hs @@ -33,12 +33,13 @@ import qualified Data.Text as T import Data.Text.Encoding (decodeUtf8) import qualified Data.Vector as Vector import GHC.Stack (HasCallStack) +import System.Directory (makeAbsolute) import System.FilePath (()) import Testnet.Components.Configuration (eraToString) import Testnet.Components.Query import qualified Testnet.Defaults as Defaults -import Testnet.Process.Cli.Transaction (buildTransferTx, signTx, submitTx, retrieveTransactionId) +import Testnet.Process.Cli.Transaction (buildTransferTx, signTx, submitTx, retrieveTransactionId, buildSimpleTransferTx, TxOutAddress (ReferenceScriptAddress)) import Testnet.Process.Run (execCli', execCliStdoutToJson, mkExecConfig) import Testnet.Property.Util (integrationWorkspace) import Testnet.TestQueryCmds (TestQueryCmds (..), forallQueryCommands) @@ -229,7 +230,7 @@ hprop_cli_queries = integrationWorkspace "cli-queries" $ \tempAbsBasePath' -> H. H.noteM_ $ execCli' execConfig [ eraName, "query", "tx-mempool", "next-tx" ] -- Now we create a transaction and check if it exists in the mempool mempoolWork <- H.createDirectoryIfMissing $ work "mempool-test" - txBody <- buildTransferTx execConfig epochStateView sbe mempoolWork "tx-body" wallet0 wallet1 10_000_000 + txBody <- buildSimpleTransferTx execConfig epochStateView sbe mempoolWork "tx-body" wallet0 wallet1 10_000_000 signedTx <- signTx execConfig cEra mempoolWork "signed-tx" txBody [SomeKeyPair $ paymentKeyInfoPair wallet0] submitTx execConfig cEra signedTx txId <- retrieveTransactionId execConfig signedTx @@ -241,9 +242,27 @@ hprop_cli_queries = integrationWorkspace "cli-queries" $ \tempAbsBasePath' -> H. -- This is tested in hprop_querySlotNumber in Cardano.Testnet.Test.Cli.QuerySlotNumber pure () - TestQueryRefScriptSizeCmd -> do + TestQueryRefScriptSizeCmd -> -- ref-script-size - pure () + do + refScriptSizeWork <- H.createDirectoryIfMissing $ work "ref-script-size-test" + alwaysSucceedsSpendingPlutusPath <- File <$> liftIO (makeAbsolute "test/cardano-testnet-test/files/plutus/v3/always-succeeds.plutus") + let transferAmount = 10_000_000 + txBody <- buildTransferTx execConfig epochStateView sbe refScriptSizeWork "tx-body" wallet1 + [(ReferenceScriptAddress alwaysSucceedsSpendingPlutusPath, 10_000_000)] + signedTx <- signTx execConfig cEra refScriptSizeWork "signed-tx" txBody [SomeKeyPair $ paymentKeyInfoPair wallet1] + submitTx execConfig cEra signedTx + txId <- retrieveTransactionId execConfig signedTx + -- wait for one block before checking for the transaction + _ <- waitForBlocks epochStateView 1 + let protocolParametersOutFile = refScriptSizeWork "ref-script-size-out.json" + H.noteM_ $ execCli' execConfig [ eraName, "query", "ref-script-size" + , "--tx-in", txId ++ "#0" + , "--out-file", protocolParametersOutFile + ] + H.diffFileVsGoldenFile + protocolParametersOutFile + "test/cardano-testnet-test/files/golden/queries/refScriptSizeOut.json" TestQueryConstitutionCmd -> do -- constitution diff --git a/cardano-testnet/test/cardano-testnet-test/files/golden/queries/refScriptSizeOut.json b/cardano-testnet/test/cardano-testnet-test/files/golden/queries/refScriptSizeOut.json new file mode 100644 index 00000000000..00718e8e1f9 --- /dev/null +++ b/cardano-testnet/test/cardano-testnet-test/files/golden/queries/refScriptSizeOut.json @@ -0,0 +1,3 @@ +{ + "refInputScriptSize": 8 +} \ No newline at end of file From c04a62939a54ed7d4ffcd02f86fd172034ce3105 Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Thu, 25 Jul 2024 00:45:50 +0200 Subject: [PATCH 08/16] Improve wait for transaction and add tests Add tests for: - `query constitution` - `query drep-stake-distribution` - `query committee-state` --- .../src/Testnet/Process/Cli/Transaction.hs | 6 +- .../src/Testnet/TestEnumGenerator.hs | 4 +- cardano-testnet/src/Testnet/TestQueryCmds.hs | 6 +- .../Cardano/Testnet/Test/Cli/Query.hs | 78 +++++++++++++------ .../golden/queries/queryConstitutionOut.json | 6 ++ 5 files changed, 68 insertions(+), 32 deletions(-) create mode 100644 cardano-testnet/test/cardano-testnet-test/files/golden/queries/queryConstitutionOut.json diff --git a/cardano-testnet/src/Testnet/Process/Cli/Transaction.hs b/cardano-testnet/src/Testnet/Process/Cli/Transaction.hs index ee7692f7961..1a0bd8fa37d 100644 --- a/cardano-testnet/src/Testnet/Process/Cli/Transaction.hs +++ b/cardano-testnet/src/Testnet/Process/Cli/Transaction.hs @@ -27,7 +27,7 @@ import GHC.IO.Exception (ExitCode (..)) import GHC.Stack import System.FilePath (()) -import Testnet.Components.Query (findLargestUtxoForPaymentKey, EpochStateView) +import Testnet.Components.Query (EpochStateView, findLargestUtxoForPaymentKey) import Testnet.Process.Run (execCli') import Testnet.Start.Types (anyEraToString) import Testnet.Types @@ -50,7 +50,7 @@ data TxOutAddress = PKAddress PaymentKeyInfo -- | Calls @cardano-cli@ to sign a simple ADA transfer transaction using -- the specified key pairs. -- This function takes five parameters: --- +-- -- Returns the generated @File TxBody In@ file path to the created unsigned -- transaction file. buildTransferTx @@ -102,7 +102,7 @@ buildTransferTx execConfig epochStateView sbe work prefix srcWallet txOutputs = -- | Calls @cardano-cli@ to sign a simple ADA transfer transaction using -- the specified key pairs. -- This function takes five parameters: --- +-- -- Returns the generated @File TxBody In@ file path to the created unsigned -- transaction file. buildSimpleTransferTx diff --git a/cardano-testnet/src/Testnet/TestEnumGenerator.hs b/cardano-testnet/src/Testnet/TestEnumGenerator.hs index 2e6b2f1d243..8348532ab5a 100644 --- a/cardano-testnet/src/Testnet/TestEnumGenerator.hs +++ b/cardano-testnet/src/Testnet/TestEnumGenerator.hs @@ -3,8 +3,8 @@ module Testnet.TestEnumGenerator , genAllConstructorsList ) where -import Language.Haskell.TH (Body (NormalB), Con (..), Dec (DataD, ValD), Exp (ConE, ListE), - Info (TyConI), Name, Pat (VarP), Q, mkName, nameBase, reify) +import Language.Haskell.TH (Body (NormalB), Con (..), Dec (DataD, ValD), + Exp (ConE, ListE), Info (TyConI), Name, Pat (VarP), Q, mkName, nameBase, reify) -- | Create a datatype with the same constructors as the given type, but with a "Test" prefix and no arguments. -- For example, if the input type is 'Maybe', the output type will be 'TestMaybe', with constructors 'TestNothing' diff --git a/cardano-testnet/src/Testnet/TestQueryCmds.hs b/cardano-testnet/src/Testnet/TestQueryCmds.hs index dbb6d76b723..f6701fef307 100644 --- a/cardano-testnet/src/Testnet/TestQueryCmds.hs +++ b/cardano-testnet/src/Testnet/TestQueryCmds.hs @@ -1,5 +1,5 @@ -{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE GADTs #-} +{-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -Wno-missing-signatures #-} {-# OPTIONS_GHC -Wno-unused-top-binds #-} @@ -8,9 +8,9 @@ module Testnet.TestQueryCmds , forallQueryCommands ) where -import Cardano.CLI.EraBased.Commands.Query (QueryCmds (..)) +import Cardano.CLI.EraBased.Commands.Query (QueryCmds (..)) -import Testnet.TestEnumGenerator (genTestType, genAllConstructorsList) +import Testnet.TestEnumGenerator (genAllConstructorsList, genTestType) $(genTestType ''QueryCmds) diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Query.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Query.hs index d6355c5f069..49b640d2584 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Query.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Query.hs @@ -1,22 +1,31 @@ {-# LANGUAGE DataKinds #-} +{-# LANGUAGE ExplicitNamespaces #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE NumericUnderscores #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE NumericUnderscores #-} module Cardano.Testnet.Test.Cli.Query ( hprop_cli_queries ) where import Cardano.Api -import Cardano.Api.Ledger (EpochInterval(EpochInterval)) -import Cardano.Api.Shelley (StakePoolKey, StakeCredential (StakeCredentialByKey)) +import Cardano.Api.Ledger (Coin (Coin), EpochInterval (EpochInterval), extractHash) +import Cardano.Api.Shelley (StakeCredential (StakeCredentialByKey), StakePoolKey) -import Cardano.CLI.Types.Key (readVerificationKeyOrFile, VerificationKeyOrFile (VerificationKeyFilePath)) +import Cardano.CLI.Types.Key (VerificationKeyOrFile (VerificationKeyFilePath), + readVerificationKeyOrFile) import Cardano.CLI.Types.Output (QueryTipLocalStateOutput) +import Cardano.Crypto.Hash (hashToStringAsHex) +import qualified Cardano.Ledger.BaseTypes as L +import Cardano.Ledger.Core (valueTxOutL) +import Cardano.Ledger.Shelley.LedgerState (esLStateL, lsUTxOStateL, nesEpochStateL, + utxosUtxoL) +import qualified Cardano.Ledger.TxIn as L +import qualified Cardano.Ledger.UTxO as L import Cardano.Testnet import Prelude @@ -27,21 +36,27 @@ import Data.Aeson (eitherDecodeStrictText) import qualified Data.Aeson as Aeson import qualified Data.Aeson.KeyMap as Aeson import Data.Bifunctor (bimap) -import Data.String +import Data.Data (type (:~:) (Refl)) +import qualified Data.Map as Map +import Data.String (IsString (fromString)) import Data.Text (Text) import qualified Data.Text as T import Data.Text.Encoding (decodeUtf8) import qualified Data.Vector as Vector import GHC.Stack (HasCallStack) +import Lens.Micro ((^.)) import System.Directory (makeAbsolute) import System.FilePath (()) -import Testnet.Components.Configuration (eraToString) -import Testnet.Components.Query +import Testnet.Components.Query (checkDRepsNumber, getEpochStateView, + watchEpochStateUpdate) import qualified Testnet.Defaults as Defaults -import Testnet.Process.Cli.Transaction (buildTransferTx, signTx, submitTx, retrieveTransactionId, buildSimpleTransferTx, TxOutAddress (ReferenceScriptAddress)) +import Testnet.Process.Cli.Transaction (TxOutAddress (ReferenceScriptAddress), + buildSimpleTransferTx, buildTransferTx, retrieveTransactionId, signTx, submitTx) import Testnet.Process.Run (execCli', execCliStdoutToJson, mkExecConfig) +import Testnet.Property.Assert (assertErasEqual) import Testnet.Property.Util (integrationWorkspace) +import Testnet.Start.Types (eraToString) import Testnet.TestQueryCmds (TestQueryCmds (..), forallQueryCommands) import Testnet.Types @@ -78,7 +93,7 @@ hprop_cli_queries = integrationWorkspace "cli-queries" $ \tempAbsBasePath' -> H. , wallets=wallet0:wallet1:_ } <- cardanoTestnetDefault fastTestnetOptions conf - + let shelleyGeneisFile = work Defaults.defaultGenesisFilepath ShelleyEra PoolNode{poolRuntime} <- H.headM poolNodes @@ -128,7 +143,7 @@ hprop_cli_queries = integrationWorkspace "cli-queries" $ \tempAbsBasePath' -> H. protocolParametersOutFile "test/cardano-testnet-test/files/golden/queries/protocolParametersFileOut.json" - TestQueryConstitutionHashCmd -> do + TestQueryConstitutionHashCmd -> -- constitution-hash -- Currently disabled (not accessible from the command line) pure () @@ -160,7 +175,7 @@ hprop_cli_queries = integrationWorkspace "cli-queries" $ \tempAbsBasePath' -> H. let stakePoolsOutFile = work "stake-pools-out.json" H.noteM_ $ execCli' execConfig [ eraName, "query", "stake-pools" , "--out-file", stakePoolsOutFile] - TestQueryPoolStateCmd -> do + TestQueryPoolStateCmd -> -- pool-state -- Already tested in TestQueryStakePoolsCmd and TestQueryStakeDistributionCmd pure () @@ -218,7 +233,7 @@ hprop_cli_queries = integrationWorkspace "cli-queries" $ \tempAbsBasePath' -> H. -- stake-snapshot H.noteM_ $ execCli' execConfig [ eraName, "query", "stake-snapshot", "--all-stake-pools" ] - TestQueryKesPeriodInfoCmd -> do + TestQueryKesPeriodInfoCmd -> -- kes-period-info -- This is tested in hprop_kes_period_info in Cardano.Testnet.Test.Cli.KesPeriodInfo pure () @@ -245,28 +260,33 @@ hprop_cli_queries = integrationWorkspace "cli-queries" $ \tempAbsBasePath' -> H. TestQueryRefScriptSizeCmd -> -- ref-script-size do + -- Set up files and vars refScriptSizeWork <- H.createDirectoryIfMissing $ work "ref-script-size-test" alwaysSucceedsSpendingPlutusPath <- File <$> liftIO (makeAbsolute "test/cardano-testnet-test/files/plutus/v3/always-succeeds.plutus") let transferAmount = 10_000_000 + -- Submit a transaction to publish the reference script txBody <- buildTransferTx execConfig epochStateView sbe refScriptSizeWork "tx-body" wallet1 - [(ReferenceScriptAddress alwaysSucceedsSpendingPlutusPath, 10_000_000)] + [(ReferenceScriptAddress alwaysSucceedsSpendingPlutusPath, transferAmount)] signedTx <- signTx execConfig cEra refScriptSizeWork "signed-tx" txBody [SomeKeyPair $ paymentKeyInfoPair wallet1] submitTx execConfig cEra signedTx + -- Wait until transaction is on chain and obtain transaction identifier txId <- retrieveTransactionId execConfig signedTx - -- wait for one block before checking for the transaction - _ <- waitForBlocks epochStateView 1 + txIx <- H.evalMaybeM $ watchEpochStateUpdate epochStateView (EpochInterval 2) (getTxIx sbe txId transferAmount) + -- Query the reference script size let protocolParametersOutFile = refScriptSizeWork "ref-script-size-out.json" H.noteM_ $ execCli' execConfig [ eraName, "query", "ref-script-size" - , "--tx-in", txId ++ "#0" + , "--tx-in", txId ++ "#" ++ show (txIx :: Int) , "--out-file", protocolParametersOutFile ] H.diffFileVsGoldenFile protocolParametersOutFile "test/cardano-testnet-test/files/golden/queries/refScriptSizeOut.json" - TestQueryConstitutionCmd -> do + TestQueryConstitutionCmd -> -- constitution - pure () + do + output <- execCli' execConfig [ eraName, "query", "constitution" ] + H.diffVsGoldenFile output "test/cardano-testnet-test/files/golden/queries/queryConstitutionOut.json" TestQueryGovStateCmd -> -- gov-state @@ -298,13 +318,13 @@ hprop_cli_queries = integrationWorkspace "cli-queries" $ \tempAbsBasePath' -> H. _ :: Aeson.Value <- H.readJsonFileOk drepStateOutFile pure () - TestQueryDRepStakeDistributionCmd -> do + TestQueryDRepStakeDistributionCmd -> -- drep-stake-distribution - pure () + H.noteM_ $ execCli' execConfig [ eraName, "query", "drep-stake-distribution", "--all-dreps" ] - TestQueryCommitteeMembersStateCmd -> do + TestQueryCommitteeMembersStateCmd -> -- committee-state - pure () + H.noteM_ $ execCli' execConfig [ eraName, "query", "committee-state" ] ) where @@ -334,6 +354,16 @@ hprop_cli_queries = integrationWorkspace "cli-queries" $ \tempAbsBasePath' -> H. patchedOutput <- H.evalEither $ patchGovStateOutput fileContents liftIO $ writeFile fp patchedOutput + getTxIx :: forall m era. MonadTest m => ShelleyBasedEra era -> String -> Int -> (AnyNewEpochState, SlotNo, BlockNo) -> m (Maybe Int) + getTxIx sbe txId amount (AnyNewEpochState sbe' newEpochState, _, _) = do + Refl <- H.leftFail $ assertErasEqual sbe sbe' + shelleyBasedEraConstraints sbe' (do + return $ Map.foldlWithKey (\acc (L.TxIn (L.TxId thisTxId) (L.TxIx thisTxIx)) txOut -> + case acc of + Nothing | hashToStringAsHex (extractHash thisTxId) == txId && + valueToLovelace (fromLedgerValue sbe (txOut ^. valueTxOutL)) == Just (Coin (fromIntegral amount)) -> Just $ fromIntegral thisTxIx + | otherwise -> Nothing + x -> x) Nothing $ L.unUTxO $ newEpochState ^. nesEpochStateL . esLStateL . lsUTxOStateL . utxosUtxoL) -- | @assertArrayOfSize v n@ checks that the value is a JSON array of size @n@, -- otherwise it fails the test. diff --git a/cardano-testnet/test/cardano-testnet-test/files/golden/queries/queryConstitutionOut.json b/cardano-testnet/test/cardano-testnet-test/files/golden/queries/queryConstitutionOut.json new file mode 100644 index 00000000000..94ff4cd5522 --- /dev/null +++ b/cardano-testnet/test/cardano-testnet-test/files/golden/queries/queryConstitutionOut.json @@ -0,0 +1,6 @@ +{ + "anchor": { + "dataHash": "0000000000000000000000000000000000000000000000000000000000000000", + "url": "" + } +} From 2414f85ba501c75725f64ce3a21f7470e44a7337 Mon Sep 17 00:00:00 2001 From: Mateusz Galazyn Date: Thu, 25 Jul 2024 10:33:24 +0200 Subject: [PATCH 09/16] Add test for `query treasury` --- .../Cardano/Testnet/Test/Cli/Query.hs | 17 ++++++++++++++--- .../files/golden/queries/treasuryOut.txt | 1 + 2 files changed, 15 insertions(+), 3 deletions(-) create mode 100644 cardano-testnet/test/cardano-testnet-test/files/golden/queries/treasuryOut.txt diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Query.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Query.hs index 49b640d2584..95513183542 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Query.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Query.hs @@ -113,7 +113,7 @@ hprop_cli_queries = integrationWorkspace "cli-queries" $ \tempAbsBasePath' -> H. -- If we don't wait, the leadershi-schedule test will say SPO has no stake _ <- waitForEpochs epochStateView (EpochInterval 1) - forallQueryCommands (\case + forallQueryCommands $ \case TestQueryLeadershipScheduleCmd -> -- leadership-schedule @@ -326,7 +326,18 @@ hprop_cli_queries = integrationWorkspace "cli-queries" $ \tempAbsBasePath' -> H. -- committee-state H.noteM_ $ execCli' execConfig [ eraName, "query", "committee-state" ] - ) + TestQueryTreasuryValueCmd -> do + -- to stdout + execCli' execConfig [ eraName, "query", "treasury" ] + >>= + (`H.diffVsGoldenFile` + "test/cardano-testnet-test/files/golden/queries/treasuryOut.txt") + let treasuryOutFile = work "treasury-out.txt" + H.noteM_ $ execCli' execConfig [ eraName, "query", "treasury", "--out-file", treasuryOutFile] + H.diffFileVsGoldenFile + treasuryOutFile + "test/cardano-testnet-test/files/golden/queries/treasuryOut.txt" + where patchGovStateOutput :: String -> Either String String patchGovStateOutput output = do @@ -334,7 +345,7 @@ hprop_cli_queries = integrationWorkspace "cli-queries" $ \tempAbsBasePath' -> H. return $ T.unpack $ decodeUtf8 $ prettyPrintJSON $ patchGovStateJSON eOutput where patchGovStateJSON :: Aeson.Object -> Aeson.Object - patchGovStateJSON o = Aeson.delete "futurePParams" o + patchGovStateJSON = Aeson.delete "futurePParams" readVerificationKeyFromFile :: (MonadIO m, MonadCatch m, MonadTest m, HasTextEnvelope (VerificationKey keyrole), SerialiseAsBech32 (VerificationKey keyrole)) => AsType keyrole diff --git a/cardano-testnet/test/cardano-testnet-test/files/golden/queries/treasuryOut.txt b/cardano-testnet/test/cardano-testnet-test/files/golden/queries/treasuryOut.txt new file mode 100644 index 00000000000..c227083464f --- /dev/null +++ b/cardano-testnet/test/cardano-testnet-test/files/golden/queries/treasuryOut.txt @@ -0,0 +1 @@ +0 \ No newline at end of file From 3c3f39526df6f290be97ec9c75a5331d330e3b4a Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Thu, 25 Jul 2024 22:42:02 +0200 Subject: [PATCH 10/16] Add `HasCallStack` to some functions Co-authored-by: Mateusz Galazyn <228866+carbolymer@users.noreply.github.com> --- cardano-testnet/src/Testnet/Process/Cli/Transaction.hs | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/cardano-testnet/src/Testnet/Process/Cli/Transaction.hs b/cardano-testnet/src/Testnet/Process/Cli/Transaction.hs index 1a0bd8fa37d..9447f7803cd 100644 --- a/cardano-testnet/src/Testnet/Process/Cli/Transaction.hs +++ b/cardano-testnet/src/Testnet/Process/Cli/Transaction.hs @@ -54,7 +54,8 @@ data TxOutAddress = PKAddress PaymentKeyInfo -- Returns the generated @File TxBody In@ file path to the created unsigned -- transaction file. buildTransferTx - :: Typeable era + :: HasCallStack + => Typeable era => H.MonadAssertion m => MonadTest m => MonadCatch m @@ -106,7 +107,8 @@ buildTransferTx execConfig epochStateView sbe work prefix srcWallet txOutputs = -- Returns the generated @File TxBody In@ file path to the created unsigned -- transaction file. buildSimpleTransferTx - :: Typeable era + :: HasCallStack + => Typeable era => H.MonadAssertion m => MonadTest m => MonadCatch m From bba12629feae6596228c52cfdf4f12680dc2e072 Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Thu, 1 Aug 2024 14:31:32 +0200 Subject: [PATCH 11/16] Address reviews --- cardano-testnet/cardano-testnet.cabal | 1 + .../src/Testnet/Process/Cli/Transaction.hs | 41 ++++++++++--------- cardano-testnet/src/Testnet/TestQueryCmds.hs | 5 +++ .../Cardano/Testnet/Test/Cli/Query.hs | 22 +++++----- 4 files changed, 40 insertions(+), 29 deletions(-) diff --git a/cardano-testnet/cardano-testnet.cabal b/cardano-testnet/cardano-testnet.cabal index e9e3741f40d..46549038b69 100644 --- a/cardano-testnet/cardano-testnet.cabal +++ b/cardano-testnet/cardano-testnet.cabal @@ -230,6 +230,7 @@ test-suite cardano-testnet-test , containers , directory , exceptions + , extra , filepath , hedgehog , hedgehog-extras diff --git a/cardano-testnet/src/Testnet/Process/Cli/Transaction.hs b/cardano-testnet/src/Testnet/Process/Cli/Transaction.hs index 9447f7803cd..01576f57eec 100644 --- a/cardano-testnet/src/Testnet/Process/Cli/Transaction.hs +++ b/cardano-testnet/src/Testnet/Process/Cli/Transaction.hs @@ -2,8 +2,8 @@ {-# LANGUAGE ScopedTypeVariables #-} module Testnet.Process.Cli.Transaction - ( buildSimpleTransferTx - , buildTransferTx + ( simpleSpendOutputsOnlyTx + , spendOutputsOnlyTx , signTx , submitTx , failToSubmitTx @@ -15,6 +15,7 @@ module Testnet.Process.Cli.Transaction ) where import Cardano.Api hiding (Certificate, TxBody) +import Cardano.Api.Ledger (Coin (unCoin)) import Prelude @@ -44,16 +45,19 @@ data SignedTx data ReferenceScriptJSON -data TxOutAddress = PKAddress PaymentKeyInfo +data TxOutAddress = PubKeyAddress PaymentKeyInfo | ReferenceScriptAddress (File ReferenceScriptJSON In) + -- ^ The output will be created at the script address --- | Calls @cardano-cli@ to sign a simple ADA transfer transaction using --- the specified key pairs. --- This function takes five parameters: +-- | Calls @cardano-cli@ to build a simple ADA transfer transaction to +-- the specified outputs of the specified amount of ADA. In the case of +-- a reference script address, the output will be the corresponding script +-- address, and the script will be published as a reference script in +-- the output. -- -- Returns the generated @File TxBody In@ file path to the created unsigned -- transaction file. -buildTransferTx +spendOutputsOnlyTx :: HasCallStack => Typeable era => H.MonadAssertion m @@ -67,9 +71,9 @@ buildTransferTx -> FilePath -- ^ Base directory path where the unsigned transaction file will be stored. -> String -- ^ Prefix for the output unsigned transaction file name. The extension will be @.txbody@. -> PaymentKeyInfo -- ^ Payment key pair used for paying the transaction. - -> [(TxOutAddress, Int)] -- ^ List of pairs of transaction output addresses and amounts. + -> [(TxOutAddress, Coin)] -- ^ List of pairs of transaction output addresses and amounts. -> m (File TxBody In) -buildTransferTx execConfig epochStateView sbe work prefix srcWallet txOutputs = do +spendOutputsOnlyTx execConfig epochStateView sbe work prefix srcWallet txOutputs = do txIn <- findLargestUtxoForPaymentKey epochStateView sbe srcWallet fixedTxOuts :: [String] <- computeTxOuts @@ -88,25 +92,24 @@ buildTransferTx execConfig epochStateView sbe work prefix srcWallet txOutputs = srcAddress = T.unpack $ paymentKeyInfoAddr srcWallet computeTxOuts = concat <$> sequence [ case txOut of - PKAddress dstWallet -> - return ["--tx-out", T.unpack (paymentKeyInfoAddr dstWallet) <> "+" ++ show amount ] + PubKeyAddress dstWallet -> + return ["--tx-out", T.unpack (paymentKeyInfoAddr dstWallet) <> "+" ++ show (unCoin amount) ] ReferenceScriptAddress (File referenceScriptJSON) -> do scriptAddress <- execCli' execConfig [ anyEraToString cEra, "address", "build" , "--payment-script-file", referenceScriptJSON ] - return [ "--tx-out", scriptAddress <> "+" ++ show amount + return [ "--tx-out", scriptAddress <> "+" ++ show (unCoin amount) , "--tx-out-reference-script-file", referenceScriptJSON ] | (txOut, amount) <- txOutputs ] --- | Calls @cardano-cli@ to sign a simple ADA transfer transaction using --- the specified key pairs. --- This function takes five parameters: +-- | Calls @cardano-cli@ to build a simple ADA transfer transaction to +-- transfer to the specified recipient the specified amount of ADA. -- -- Returns the generated @File TxBody In@ file path to the created unsigned -- transaction file. -buildSimpleTransferTx +simpleSpendOutputsOnlyTx :: HasCallStack => Typeable era => H.MonadAssertion m @@ -121,10 +124,10 @@ buildSimpleTransferTx -> String -- ^ Prefix for the output unsigned transaction file name. The extension will be @.txbody@. -> PaymentKeyInfo -- ^ Payment key pair used for paying the transaction. -> PaymentKeyInfo -- ^ Payment key of the recipient of the transaction. - -> Int -- ^ Amount of ADA to transfer (in Lovelace). + -> Coin -- ^ Amount of ADA to transfer (in Lovelace). -> m (File TxBody In) -buildSimpleTransferTx execConfig epochStateView sbe work prefix srcWallet dstWallet amount = - buildTransferTx execConfig epochStateView sbe work prefix srcWallet [(PKAddress dstWallet, amount)] +simpleSpendOutputsOnlyTx execConfig epochStateView sbe work prefix srcWallet dstWallet amount = + spendOutputsOnlyTx execConfig epochStateView sbe work prefix srcWallet [(PubKeyAddress dstWallet, amount)] -- | Calls @cardano-cli@ to signs a transaction body using the specified key pairs. -- diff --git a/cardano-testnet/src/Testnet/TestQueryCmds.hs b/cardano-testnet/src/Testnet/TestQueryCmds.hs index f6701fef307..e31822495b9 100644 --- a/cardano-testnet/src/Testnet/TestQueryCmds.hs +++ b/cardano-testnet/src/Testnet/TestQueryCmds.hs @@ -12,9 +12,14 @@ import Cardano.CLI.EraBased.Commands.Query (QueryCmds (..)) import Testnet.TestEnumGenerator (genAllConstructorsList, genTestType) +-- | A datatype with the same constructors as 'QueryCmds', but with a "Test" prefix and no arguments. +-- The generated type is called 'TestQueryCmds'. $(genTestType ''QueryCmds) +-- | A list of all constructors of 'TestQueryCmds', which are nullary. +-- The generated list is called 'allTestQueryCmdsConstructors'. $(genAllConstructorsList ''TestQueryCmds) +-- | Maps a function over all constructors of 'TestQueryCmds' and sequences the results over a monad. forallQueryCommands :: Monad m => (TestQueryCmds -> m a) -> m () forallQueryCommands f = mapM_ f allTestQueryCmdsConstructors diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Query.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Query.hs index 95513183542..9a68187c027 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Query.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Query.hs @@ -37,6 +37,7 @@ import qualified Data.Aeson as Aeson import qualified Data.Aeson.KeyMap as Aeson import Data.Bifunctor (bimap) import Data.Data (type (:~:) (Refl)) +import Data.Either.Extra (mapLeft) import qualified Data.Map as Map import Data.String (IsString (fromString)) import Data.Text (Text) @@ -52,7 +53,8 @@ import Testnet.Components.Query (checkDRepsNumber, getEpochStateView, watchEpochStateUpdate) import qualified Testnet.Defaults as Defaults import Testnet.Process.Cli.Transaction (TxOutAddress (ReferenceScriptAddress), - buildSimpleTransferTx, buildTransferTx, retrieveTransactionId, signTx, submitTx) + retrieveTransactionId, signTx, simpleSpendOutputsOnlyTx, spendOutputsOnlyTx, + submitTx) import Testnet.Process.Run (execCli', execCliStdoutToJson, mkExecConfig) import Testnet.Property.Assert (assertErasEqual) import Testnet.Property.Util (integrationWorkspace) @@ -245,7 +247,7 @@ hprop_cli_queries = integrationWorkspace "cli-queries" $ \tempAbsBasePath' -> H. H.noteM_ $ execCli' execConfig [ eraName, "query", "tx-mempool", "next-tx" ] -- Now we create a transaction and check if it exists in the mempool mempoolWork <- H.createDirectoryIfMissing $ work "mempool-test" - txBody <- buildSimpleTransferTx execConfig epochStateView sbe mempoolWork "tx-body" wallet0 wallet1 10_000_000 + txBody <- simpleSpendOutputsOnlyTx execConfig epochStateView sbe mempoolWork "tx-body" wallet0 wallet1 10_000_000 signedTx <- signTx execConfig cEra mempoolWork "signed-tx" txBody [SomeKeyPair $ paymentKeyInfoPair wallet0] submitTx execConfig cEra signedTx txId <- retrieveTransactionId execConfig signedTx @@ -262,11 +264,11 @@ hprop_cli_queries = integrationWorkspace "cli-queries" $ \tempAbsBasePath' -> H. do -- Set up files and vars refScriptSizeWork <- H.createDirectoryIfMissing $ work "ref-script-size-test" - alwaysSucceedsSpendingPlutusPath <- File <$> liftIO (makeAbsolute "test/cardano-testnet-test/files/plutus/v3/always-succeeds.plutus") - let transferAmount = 10_000_000 + plutusV3Script <- File <$> liftIO (makeAbsolute "test/cardano-testnet-test/files/plutus/v3/always-succeeds.plutus") + let transferAmount = Coin 10_000_000 -- Submit a transaction to publish the reference script - txBody <- buildTransferTx execConfig epochStateView sbe refScriptSizeWork "tx-body" wallet1 - [(ReferenceScriptAddress alwaysSucceedsSpendingPlutusPath, transferAmount)] + txBody <- spendOutputsOnlyTx execConfig epochStateView sbe refScriptSizeWork "tx-body" wallet1 + [(ReferenceScriptAddress plutusV3Script, transferAmount)] signedTx <- signTx execConfig cEra refScriptSizeWork "signed-tx" txBody [SomeKeyPair $ paymentKeyInfoPair wallet1] submitTx execConfig cEra signedTx -- Wait until transaction is on chain and obtain transaction identifier @@ -339,9 +341,9 @@ hprop_cli_queries = integrationWorkspace "cli-queries" $ \tempAbsBasePath' -> H. "test/cardano-testnet-test/files/golden/queries/treasuryOut.txt" where - patchGovStateOutput :: String -> Either String String + patchGovStateOutput :: String -> Either JsonDecodeError String patchGovStateOutput output = do - eOutput <- eitherDecodeStrictText (T.pack output) + eOutput <- mapLeft JsonDecodeError $ eitherDecodeStrictText (T.pack output) return $ T.unpack $ decodeUtf8 $ prettyPrintJSON $ patchGovStateJSON eOutput where patchGovStateJSON :: Aeson.Object -> Aeson.Object @@ -365,14 +367,14 @@ hprop_cli_queries = integrationWorkspace "cli-queries" $ \tempAbsBasePath' -> H. patchedOutput <- H.evalEither $ patchGovStateOutput fileContents liftIO $ writeFile fp patchedOutput - getTxIx :: forall m era. MonadTest m => ShelleyBasedEra era -> String -> Int -> (AnyNewEpochState, SlotNo, BlockNo) -> m (Maybe Int) + getTxIx :: forall m era. MonadTest m => ShelleyBasedEra era -> String -> Coin -> (AnyNewEpochState, SlotNo, BlockNo) -> m (Maybe Int) getTxIx sbe txId amount (AnyNewEpochState sbe' newEpochState, _, _) = do Refl <- H.leftFail $ assertErasEqual sbe sbe' shelleyBasedEraConstraints sbe' (do return $ Map.foldlWithKey (\acc (L.TxIn (L.TxId thisTxId) (L.TxIx thisTxIx)) txOut -> case acc of Nothing | hashToStringAsHex (extractHash thisTxId) == txId && - valueToLovelace (fromLedgerValue sbe (txOut ^. valueTxOutL)) == Just (Coin (fromIntegral amount)) -> Just $ fromIntegral thisTxIx + valueToLovelace (fromLedgerValue sbe (txOut ^. valueTxOutL)) == Just amount -> Just $ fromIntegral thisTxIx | otherwise -> Nothing x -> x) Nothing $ L.unUTxO $ newEpochState ^. nesEpochStateL . esLStateL . lsUTxOStateL . utxosUtxoL) From 97106636920a615ffd04b20c986a14e4bcfa748c Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Fri, 2 Aug 2024 21:00:39 +0200 Subject: [PATCH 12/16] Remove golden file for treasury out because it is not deterministic --- .../Cardano/Testnet/Test/Cli/Query.hs | 12 ++---------- .../files/golden/queries/treasuryOut.txt | 1 - 2 files changed, 2 insertions(+), 11 deletions(-) delete mode 100644 cardano-testnet/test/cardano-testnet-test/files/golden/queries/treasuryOut.txt diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Query.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Query.hs index 9a68187c027..e02abfb3c2f 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Query.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Query.hs @@ -329,16 +329,8 @@ hprop_cli_queries = integrationWorkspace "cli-queries" $ \tempAbsBasePath' -> H. H.noteM_ $ execCli' execConfig [ eraName, "query", "committee-state" ] TestQueryTreasuryValueCmd -> do - -- to stdout - execCli' execConfig [ eraName, "query", "treasury" ] - >>= - (`H.diffVsGoldenFile` - "test/cardano-testnet-test/files/golden/queries/treasuryOut.txt") - let treasuryOutFile = work "treasury-out.txt" - H.noteM_ $ execCli' execConfig [ eraName, "query", "treasury", "--out-file", treasuryOutFile] - H.diffFileVsGoldenFile - treasuryOutFile - "test/cardano-testnet-test/files/golden/queries/treasuryOut.txt" + -- treasury + H.noteM_ $ execCli' execConfig [ eraName, "query", "treasury" ] where patchGovStateOutput :: String -> Either JsonDecodeError String diff --git a/cardano-testnet/test/cardano-testnet-test/files/golden/queries/treasuryOut.txt b/cardano-testnet/test/cardano-testnet-test/files/golden/queries/treasuryOut.txt deleted file mode 100644 index c227083464f..00000000000 --- a/cardano-testnet/test/cardano-testnet-test/files/golden/queries/treasuryOut.txt +++ /dev/null @@ -1 +0,0 @@ -0 \ No newline at end of file From 7b6f3f979577827f69a4f344b9f1868fc44db92c Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Thu, 1 Aug 2024 21:29:41 +0200 Subject: [PATCH 13/16] Replace patch with function that waits --- cardano-testnet/cardano-testnet.cabal | 1 - .../Cardano/Testnet/Test/Cli/Query.hs | 63 ++++++++++++------- .../files/golden/queries/govStateOut.json | 3 + 3 files changed, 43 insertions(+), 24 deletions(-) diff --git a/cardano-testnet/cardano-testnet.cabal b/cardano-testnet/cardano-testnet.cabal index 46549038b69..e9e3741f40d 100644 --- a/cardano-testnet/cardano-testnet.cabal +++ b/cardano-testnet/cardano-testnet.cabal @@ -230,7 +230,6 @@ test-suite cardano-testnet-test , containers , directory , exceptions - , extra , filepath , hedgehog , hedgehog-extras diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Query.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Query.hs index e02abfb3c2f..9da53ed5ff0 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Query.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Query.hs @@ -13,7 +13,9 @@ module Cardano.Testnet.Test.Cli.Query ) where import Cardano.Api -import Cardano.Api.Ledger (Coin (Coin), EpochInterval (EpochInterval), extractHash) +import qualified Cardano.Api.Genesis as Api +import Cardano.Api.Ledger (Coin (Coin), EpochInterval (EpochInterval), StandardCrypto, + extractHash, unboundRational) import Cardano.Api.Shelley (StakeCredential (StakeCredentialByKey), StakePoolKey) import Cardano.CLI.Types.Key (VerificationKeyOrFile (VerificationKeyFilePath), @@ -32,25 +34,21 @@ import Prelude import Control.Monad (forM_) import Control.Monad.Catch (MonadCatch) -import Data.Aeson (eitherDecodeStrictText) import qualified Data.Aeson as Aeson -import qualified Data.Aeson.KeyMap as Aeson import Data.Bifunctor (bimap) import Data.Data (type (:~:) (Refl)) -import Data.Either.Extra (mapLeft) import qualified Data.Map as Map import Data.String (IsString (fromString)) import Data.Text (Text) import qualified Data.Text as T -import Data.Text.Encoding (decodeUtf8) import qualified Data.Vector as Vector -import GHC.Stack (HasCallStack) +import GHC.Stack (HasCallStack, withFrozenCallStack) import Lens.Micro ((^.)) import System.Directory (makeAbsolute) import System.FilePath (()) import Testnet.Components.Query (checkDRepsNumber, getEpochStateView, - watchEpochStateUpdate) + watchEpochStateUpdate, EpochStateView) import qualified Testnet.Defaults as Defaults import Testnet.Process.Cli.Transaction (TxOutAddress (ReferenceScriptAddress), retrieveTransactionId, signTx, simpleSpendOutputsOnlyTx, spendOutputsOnlyTx, @@ -64,6 +62,7 @@ import Testnet.Types import Hedgehog import qualified Hedgehog as H +import Hedgehog.Extras (readJsonFile, MonadAssertion) import qualified Hedgehog.Extras as H import qualified Hedgehog.Extras.Test.Golden as H @@ -86,6 +85,7 @@ hprop_cli_queries = integrationWorkspace "cli-queries" $ \tempAbsBasePath' -> H. { cardanoEpochLength = 100 , cardanoSlotLength = 0.1 , cardanoNodeEra = cEra + , cardanoActiveSlotsCoeff = 0.5 } TestnetRuntime @@ -293,14 +293,16 @@ hprop_cli_queries = integrationWorkspace "cli-queries" $ \tempAbsBasePath' -> H. TestQueryGovStateCmd -> -- gov-state do + -- wait for the proposal stage to end + shelleyGenesisVal <- H.evalEitherM $ readJsonFile shelleyGeneisFile + newSlot <- waitForFuturePParamsToStabilise epochStateView shelleyGenesisVal + H.note_ $ "Current slot is: " ++ show newSlot -- to stdout output <- execCli' execConfig [ eraName, "query", "gov-state" ] - patchedOutput <- H.evalEither $ patchGovStateOutput output - H.diffVsGoldenFile patchedOutput "test/cardano-testnet-test/files/golden/queries/govStateOut.json" + H.diffVsGoldenFile output "test/cardano-testnet-test/files/golden/queries/govStateOut.json" -- to a file let govStateOutFile = work "gov-state-out.json" H.noteM_ $ execCli' execConfig [ eraName, "query", "gov-state", "--out-file", govStateOutFile ] - patchGovStateOutputFile govStateOutFile H.diffFileVsGoldenFile govStateOutFile "test/cardano-testnet-test/files/golden/queries/govStateOut.json" @@ -333,13 +335,34 @@ hprop_cli_queries = integrationWorkspace "cli-queries" $ \tempAbsBasePath' -> H. H.noteM_ $ execCli' execConfig [ eraName, "query", "treasury" ] where - patchGovStateOutput :: String -> Either JsonDecodeError String - patchGovStateOutput output = do - eOutput <- mapLeft JsonDecodeError $ eitherDecodeStrictText (T.pack output) - return $ T.unpack $ decodeUtf8 $ prettyPrintJSON $ patchGovStateJSON eOutput - where - patchGovStateJSON :: Aeson.Object -> Aeson.Object - patchGovStateJSON = Aeson.delete "futurePParams" + -- | Wait for the part of the epoch when futurePParams are known + waitForFuturePParamsToStabilise + :: HasCallStack + => MonadIO m + => MonadTest m + => MonadAssertion m + => MonadCatch m + => EpochStateView + -> ShelleyGenesis StandardCrypto + -> m SlotNo -- ^ The block number reached + waitForFuturePParamsToStabilise epochStateView shelleyGenesisConf = withFrozenCallStack $ + H.noteShowM . H.nothingFailM $ + watchEpochStateUpdate epochStateView (EpochInterval 2) $ \(_, slotNo, _) -> do + pure $ if areFuturePParamsStable shelleyGenesisConf slotNo + then Just slotNo + else Nothing + + areFuturePParamsStable :: ShelleyGenesis StandardCrypto -> SlotNo -> Bool + areFuturePParamsStable + ShelleyGenesis{ Api.sgActiveSlotsCoeff = activeSlotsCoeff + , Api.sgEpochLength = L.EpochSize epochLength + , Api.sgSecurityParam = securityParam + } + (SlotNo slotNo) = + let firstSlotOfEpoch = slotNo `div` epochLength * epochLength + slotsInEpochToWaitOut = ceiling (4 * fromIntegral securityParam / unboundRational activeSlotsCoeff) + 1 + minSlotInThisEpochToWaitTo = firstSlotOfEpoch + slotsInEpochToWaitOut + 1 + in slotNo >= minSlotInThisEpochToWaitTo readVerificationKeyFromFile :: (MonadIO m, MonadCatch m, MonadTest m, HasTextEnvelope (VerificationKey keyrole), SerialiseAsBech32 (VerificationKey keyrole)) => AsType keyrole @@ -353,12 +376,6 @@ hprop_cli_queries = integrationWorkspace "cli-queries" $ \tempAbsBasePath' -> H. verificationStakeKeyToStakeAddress testnetMagic delegatorVKey = makeStakeAddress (fromNetworkMagic $ NetworkMagic $ fromIntegral testnetMagic) (StakeCredentialByKey $ verificationKeyHash delegatorVKey) - patchGovStateOutputFile :: (MonadTest m, MonadIO m) => FilePath -> m () - patchGovStateOutputFile fp = do - fileContents <- liftIO $ readFile fp - patchedOutput <- H.evalEither $ patchGovStateOutput fileContents - liftIO $ writeFile fp patchedOutput - getTxIx :: forall m era. MonadTest m => ShelleyBasedEra era -> String -> Coin -> (AnyNewEpochState, SlotNo, BlockNo) -> m (Maybe Int) getTxIx sbe txId amount (AnyNewEpochState sbe' newEpochState, _, _) = do Refl <- H.leftFail $ assertErasEqual sbe sbe' diff --git a/cardano-testnet/test/cardano-testnet-test/files/golden/queries/govStateOut.json b/cardano-testnet/test/cardano-testnet-test/files/golden/queries/govStateOut.json index e8e53cac674..12a7f523266 100644 --- a/cardano-testnet/test/cardano-testnet-test/files/golden/queries/govStateOut.json +++ b/cardano-testnet/test/cardano-testnet-test/files/golden/queries/govStateOut.json @@ -660,6 +660,9 @@ "txFeePerByte": 1, "utxoCostPerByte": 4310 }, + "futurePParams": { + "tag": "NoPParamsUpdate" + }, "nextRatifyState": { "enactedGovActions": [], "expiredGovActions": [], From a43008d1583a5e55811da2e88c540c2d9bb40534 Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Mon, 5 Aug 2024 22:56:05 +0200 Subject: [PATCH 14/16] Apply suggestions from code review by @carbolymer Co-authored-by: Mateusz Galazyn <228866+carbolymer@users.noreply.github.com> --- .../src/Testnet/Process/Cli/Transaction.hs | 14 +++++++------- .../Cardano/Testnet/Test/Cli/Query.hs | 12 ++++++------ 2 files changed, 13 insertions(+), 13 deletions(-) diff --git a/cardano-testnet/src/Testnet/Process/Cli/Transaction.hs b/cardano-testnet/src/Testnet/Process/Cli/Transaction.hs index 01576f57eec..57599501cbc 100644 --- a/cardano-testnet/src/Testnet/Process/Cli/Transaction.hs +++ b/cardano-testnet/src/Testnet/Process/Cli/Transaction.hs @@ -2,8 +2,8 @@ {-# LANGUAGE ScopedTypeVariables #-} module Testnet.Process.Cli.Transaction - ( simpleSpendOutputsOnlyTx - , spendOutputsOnlyTx + ( mkSimpleSpendOutputsOnlyTx + , mkSpendOutputsOnlyTx , signTx , submitTx , failToSubmitTx @@ -57,7 +57,7 @@ data TxOutAddress = PubKeyAddress PaymentKeyInfo -- -- Returns the generated @File TxBody In@ file path to the created unsigned -- transaction file. -spendOutputsOnlyTx +mkSpendOutputsOnlyTx :: HasCallStack => Typeable era => H.MonadAssertion m @@ -73,7 +73,7 @@ spendOutputsOnlyTx -> PaymentKeyInfo -- ^ Payment key pair used for paying the transaction. -> [(TxOutAddress, Coin)] -- ^ List of pairs of transaction output addresses and amounts. -> m (File TxBody In) -spendOutputsOnlyTx execConfig epochStateView sbe work prefix srcWallet txOutputs = do +mkSpendOutputsOnlyTx execConfig epochStateView sbe work prefix srcWallet txOutputs = do txIn <- findLargestUtxoForPaymentKey epochStateView sbe srcWallet fixedTxOuts :: [String] <- computeTxOuts @@ -109,7 +109,7 @@ spendOutputsOnlyTx execConfig epochStateView sbe work prefix srcWallet txOutputs -- -- Returns the generated @File TxBody In@ file path to the created unsigned -- transaction file. -simpleSpendOutputsOnlyTx +mkSimpleSpendOutputsOnlyTx :: HasCallStack => Typeable era => H.MonadAssertion m @@ -126,8 +126,8 @@ simpleSpendOutputsOnlyTx -> PaymentKeyInfo -- ^ Payment key of the recipient of the transaction. -> Coin -- ^ Amount of ADA to transfer (in Lovelace). -> m (File TxBody In) -simpleSpendOutputsOnlyTx execConfig epochStateView sbe work prefix srcWallet dstWallet amount = - spendOutputsOnlyTx execConfig epochStateView sbe work prefix srcWallet [(PubKeyAddress dstWallet, amount)] +mkSimpleSpendOutputsOnlyTx execConfig epochStateView sbe work prefix srcWallet dstWallet amount = + mkSpendOutputsOnlyTx execConfig epochStateView sbe work prefix srcWallet [(PubKeyAddress dstWallet, amount)] -- | Calls @cardano-cli@ to signs a transaction body using the specified key pairs. -- diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Query.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Query.hs index 9da53ed5ff0..fedc162ce7f 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Query.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Query.hs @@ -51,7 +51,7 @@ import Testnet.Components.Query (checkDRepsNumber, getEpochStateView, watchEpochStateUpdate, EpochStateView) import qualified Testnet.Defaults as Defaults import Testnet.Process.Cli.Transaction (TxOutAddress (ReferenceScriptAddress), - retrieveTransactionId, signTx, simpleSpendOutputsOnlyTx, spendOutputsOnlyTx, + retrieveTransactionId, signTx, mkSimpleSpendOutputsOnlyTx, mkSpendOutputsOnlyTx, submitTx) import Testnet.Process.Run (execCli', execCliStdoutToJson, mkExecConfig) import Testnet.Property.Assert (assertErasEqual) @@ -112,7 +112,7 @@ hprop_cli_queries = integrationWorkspace "cli-queries" $ \tempAbsBasePath' -> H. checkDRepsNumber epochStateView sbe 3 - -- If we don't wait, the leadershi-schedule test will say SPO has no stake + -- If we don't wait, the leadership-schedule test will say SPO has no stake _ <- waitForEpochs epochStateView (EpochInterval 1) forallQueryCommands $ \case @@ -247,7 +247,7 @@ hprop_cli_queries = integrationWorkspace "cli-queries" $ \tempAbsBasePath' -> H. H.noteM_ $ execCli' execConfig [ eraName, "query", "tx-mempool", "next-tx" ] -- Now we create a transaction and check if it exists in the mempool mempoolWork <- H.createDirectoryIfMissing $ work "mempool-test" - txBody <- simpleSpendOutputsOnlyTx execConfig epochStateView sbe mempoolWork "tx-body" wallet0 wallet1 10_000_000 + txBody <- mkSimpleSpendOutputsOnlyTx execConfig epochStateView sbe mempoolWork "tx-body" wallet0 wallet1 10_000_000 signedTx <- signTx execConfig cEra mempoolWork "signed-tx" txBody [SomeKeyPair $ paymentKeyInfoPair wallet0] submitTx execConfig cEra signedTx txId <- retrieveTransactionId execConfig signedTx @@ -267,7 +267,7 @@ hprop_cli_queries = integrationWorkspace "cli-queries" $ \tempAbsBasePath' -> H. plutusV3Script <- File <$> liftIO (makeAbsolute "test/cardano-testnet-test/files/plutus/v3/always-succeeds.plutus") let transferAmount = Coin 10_000_000 -- Submit a transaction to publish the reference script - txBody <- spendOutputsOnlyTx execConfig epochStateView sbe refScriptSizeWork "tx-body" wallet1 + txBody <- mkSpendOutputsOnlyTx execConfig epochStateView sbe refScriptSizeWork "tx-body" wallet1 [(ReferenceScriptAddress plutusV3Script, transferAmount)] signedTx <- signTx execConfig cEra refScriptSizeWork "signed-tx" txBody [SomeKeyPair $ paymentKeyInfoPair wallet1] submitTx execConfig cEra signedTx @@ -364,7 +364,7 @@ hprop_cli_queries = integrationWorkspace "cli-queries" $ \tempAbsBasePath' -> H. minSlotInThisEpochToWaitTo = firstSlotOfEpoch + slotsInEpochToWaitOut + 1 in slotNo >= minSlotInThisEpochToWaitTo - readVerificationKeyFromFile :: (MonadIO m, MonadCatch m, MonadTest m, HasTextEnvelope (VerificationKey keyrole), SerialiseAsBech32 (VerificationKey keyrole)) + readVerificationKeyFromFile :: (HasCallStack, MonadIO m, MonadCatch m, MonadTest m, HasTextEnvelope (VerificationKey keyrole), SerialiseAsBech32 (VerificationKey keyrole)) => AsType keyrole -> FilePath -> File content direction @@ -376,7 +376,7 @@ hprop_cli_queries = integrationWorkspace "cli-queries" $ \tempAbsBasePath' -> H. verificationStakeKeyToStakeAddress testnetMagic delegatorVKey = makeStakeAddress (fromNetworkMagic $ NetworkMagic $ fromIntegral testnetMagic) (StakeCredentialByKey $ verificationKeyHash delegatorVKey) - getTxIx :: forall m era. MonadTest m => ShelleyBasedEra era -> String -> Coin -> (AnyNewEpochState, SlotNo, BlockNo) -> m (Maybe Int) + getTxIx :: forall m era. HasCallStack => MonadTest m => ShelleyBasedEra era -> String -> Coin -> (AnyNewEpochState, SlotNo, BlockNo) -> m (Maybe Int) getTxIx sbe txId amount (AnyNewEpochState sbe' newEpochState, _, _) = do Refl <- H.leftFail $ assertErasEqual sbe sbe' shelleyBasedEraConstraints sbe' (do From 99c17123b42ede790adbd186f8231ad48a8eaba0 Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Mon, 5 Aug 2024 23:35:34 +0200 Subject: [PATCH 15/16] Add comments to clarify the futurePParams issue --- .../cardano-testnet-test/Cardano/Testnet/Test/Cli/Query.hs | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Query.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Query.hs index fedc162ce7f..5c2844d3382 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Query.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Query.hs @@ -85,6 +85,8 @@ hprop_cli_queries = integrationWorkspace "cli-queries" $ \tempAbsBasePath' -> H. { cardanoEpochLength = 100 , cardanoSlotLength = 0.1 , cardanoNodeEra = cEra + -- We change slotCoeff because epochLength must be equal to: + -- securityParam * 10 / slotCoeff , cardanoActiveSlotsCoeff = 0.5 } @@ -352,6 +354,9 @@ hprop_cli_queries = integrationWorkspace "cli-queries" $ \tempAbsBasePath' -> H. then Just slotNo else Nothing + -- We wait till a slot after: 4 * securityParam / slotCoeff + -- If we query 'govState' before that we get 'PotentialPParamsUpdate' + -- in 'futurePParams' field areFuturePParamsStable :: ShelleyGenesis StandardCrypto -> SlotNo -> Bool areFuturePParamsStable ShelleyGenesis{ Api.sgActiveSlotsCoeff = activeSlotsCoeff From 9d7e0ace9841c54536741c1ee7f872530e84c36d Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Thu, 8 Aug 2024 10:48:47 +0200 Subject: [PATCH 16/16] Address comments by @Jimbo4350 --- .../src/Testnet/Process/Cli/Transaction.hs | 21 +++++++++++-------- 1 file changed, 12 insertions(+), 9 deletions(-) diff --git a/cardano-testnet/src/Testnet/Process/Cli/Transaction.hs b/cardano-testnet/src/Testnet/Process/Cli/Transaction.hs index 57599501cbc..935ea144cc8 100644 --- a/cardano-testnet/src/Testnet/Process/Cli/Transaction.hs +++ b/cardano-testnet/src/Testnet/Process/Cli/Transaction.hs @@ -48,12 +48,13 @@ data ReferenceScriptJSON data TxOutAddress = PubKeyAddress PaymentKeyInfo | ReferenceScriptAddress (File ReferenceScriptJSON In) -- ^ The output will be created at the script address + -- and the output will include the reference script. -- | Calls @cardano-cli@ to build a simple ADA transfer transaction to -- the specified outputs of the specified amount of ADA. In the case of --- a reference script address, the output will be the corresponding script --- address, and the script will be published as a reference script in --- the output. +-- a reference script address, the output will be created at the +-- corresponding script address, and the output will contain the reference +-- script. -- -- Returns the generated @File TxBody In@ file path to the created unsigned -- transaction file. @@ -77,12 +78,14 @@ mkSpendOutputsOnlyTx execConfig epochStateView sbe work prefix srcWallet txOutpu txIn <- findLargestUtxoForPaymentKey epochStateView sbe srcWallet fixedTxOuts :: [String] <- computeTxOuts - void $ execCli' execConfig $ - [ anyEraToString cEra, "transaction", "build" - , "--change-address", srcAddress - , "--tx-in", T.unpack $ renderTxIn txIn - ] ++ fixedTxOuts ++ - [ "--out-file", unFile txBody + void $ execCli' execConfig $ mconcat + [ [ anyEraToString cEra, "transaction", "build" + , "--change-address", srcAddress + , "--tx-in", T.unpack $ renderTxIn txIn + ] + , fixedTxOuts + , [ "--out-file", unFile txBody + ] ] return txBody where