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/Process/Cli/Transaction.hs b/cardano-testnet/src/Testnet/Process/Cli/Transaction.hs index 0d32eebc626..935ea144cc8 100644 --- a/cardano-testnet/src/Testnet/Process/Cli/Transaction.hs +++ b/cardano-testnet/src/Testnet/Process/Cli/Transaction.hs @@ -1,26 +1,34 @@ {-# LANGUAGE DataKinds #-} +{-# LANGUAGE ScopedTypeVariables #-} module Testnet.Process.Cli.Transaction - ( signTx + ( mkSimpleSpendOutputsOnlyTx + , mkSpendOutputsOnlyTx + , signTx , submitTx , failToSubmitTx , retrieveTransactionId , SignedTx , TxBody + , TxOutAddress(..) , VoteFile ) where import Cardano.Api hiding (Certificate, TxBody) +import Cardano.Api.Ledger (Coin (unCoin)) 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 (()) +import Testnet.Components.Query (EpochStateView, findLargestUtxoForPaymentKey) import Testnet.Process.Run (execCli') import Testnet.Start.Types (anyEraToString) import Testnet.Types @@ -35,6 +43,95 @@ data TxBody data SignedTx +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 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. +mkSpendOutputsOnlyTx + :: HasCallStack + => 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. + -> [(TxOutAddress, Coin)] -- ^ List of pairs of transaction output addresses and amounts. + -> m (File TxBody In) +mkSpendOutputsOnlyTx execConfig epochStateView sbe work prefix srcWallet txOutputs = do + + txIn <- findLargestUtxoForPaymentKey epochStateView sbe srcWallet + fixedTxOuts :: [String] <- computeTxOuts + 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 + era = toCardanoEra sbe + cEra = AnyCardanoEra era + txBody = File (work prefix <> ".txbody") + srcAddress = T.unpack $ paymentKeyInfoAddr srcWallet + computeTxOuts = concat <$> sequence + [ case txOut of + 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 (unCoin amount) + , "--tx-out-reference-script-file", referenceScriptJSON + ] + | (txOut, amount) <- txOutputs + ] + +-- | 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. +mkSimpleSpendOutputsOnlyTx + :: HasCallStack + => 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. + -> Coin -- ^ Amount of ADA to transfer (in Lovelace). + -> m (File TxBody In) +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. -- -- This function takes five parameters: diff --git a/cardano-testnet/src/Testnet/TestEnumGenerator.hs b/cardano-testnet/src/Testnet/TestEnumGenerator.hs new file mode 100644 index 00000000000..8348532ab5a --- /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..e31822495b9 --- /dev/null +++ b/cardano-testnet/src/Testnet/TestQueryCmds.hs @@ -0,0 +1,25 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE TemplateHaskell #-} +{-# 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 (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 32ebe1d9108..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 @@ -1,6 +1,10 @@ {-# LANGUAGE DataKinds #-} +{-# LANGUAGE ExplicitNamespaces #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE NumericUnderscores #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -9,30 +13,56 @@ module Cardano.Testnet.Test.Cli.Query ) where import Cardano.Api +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), + 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 import Control.Monad (forM_) +import Control.Monad.Catch (MonadCatch) import qualified Data.Aeson 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 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.Configuration (eraToString) -import Testnet.Components.Query +import Testnet.Components.Query (checkDRepsNumber, getEpochStateView, + watchEpochStateUpdate, EpochStateView) +import qualified Testnet.Defaults as Defaults +import Testnet.Process.Cli.Transaction (TxOutAddress (ReferenceScriptAddress), + retrieveTransactionId, signTx, mkSimpleSpendOutputsOnlyTx, mkSpendOutputsOnlyTx, + 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 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 @@ -55,15 +85,21 @@ 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 } TestnetRuntime { testnetMagic , poolNodes , configurationFile + , wallets=wallet0:wallet1:_ } <- cardanoTestnetDefault fastTestnetOptions conf + let shelleyGeneisFile = work Defaults.defaultGenesisFilepath ShelleyEra + PoolNode{poolRuntime} <- H.headM poolNodes poolSprocket1 <- H.noteShow $ nodeSprocket poolRuntime execConfig <- mkExecConfig tempBaseAbsPath poolSprocket1 testnetMagic @@ -78,101 +114,283 @@ 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 + -- If we don't wait, the leadership-schedule test will say SPO has no stake + _ <- waitForEpochs epochStateView (EpochInterval 1) + + forallQueryCommands $ \case + + TestQueryLeadershipScheduleCmd -> + -- leadership-schedule + 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 + 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 -> + -- 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] + + TestQueryPoolStateCmd -> + -- pool-state + -- Already tested in TestQueryStakePoolsCmd and TestQueryStakeDistributionCmd + pure () + + 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 -> + -- stake-address-info + 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 -> + -- utxo + H.noteM_ $ execCli' execConfig [ eraName, "query", "utxo", "--whole-utxo" ] + + TestQueryLedgerStateCmd -> + -- ledger-state + H.noteM_ $ execCli' execConfig [ eraName, "query", "ledger-state" ] + + TestQueryProtocolStateCmd -> + -- protocol-state + H.noteM_ $ execCli' execConfig [ eraName, "query", "protocol-state" ] + + TestQueryStakeSnapshotCmd -> + -- stake-snapshot + H.noteM_ $ execCli' execConfig [ eraName, "query", "stake-snapshot", "--all-stake-pools" ] + + TestQueryKesPeriodInfoCmd -> + -- kes-period-info + -- This is tested in hprop_kes_period_info in Cardano.Testnet.Test.Cli.KesPeriodInfo + pure () + + TestQueryTxMempoolCmd -> + -- tx-mempool + 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 <- 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 + -- 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 -> + -- ref-script-size + do + -- Set up files and vars + refScriptSizeWork <- H.createDirectoryIfMissing $ work "ref-script-size-test" + 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 <- 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 + -- Wait until transaction is on chain and obtain transaction identifier + txId <- retrieveTransactionId execConfig signedTx + 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 ++ "#" ++ show (txIx :: Int) + , "--out-file", protocolParametersOutFile + ] + H.diffFileVsGoldenFile + protocolParametersOutFile + "test/cardano-testnet-test/files/golden/queries/refScriptSizeOut.json" + + TestQueryConstitutionCmd -> + -- constitution + do + output <- execCli' execConfig [ eraName, "query", "constitution" ] + H.diffVsGoldenFile output "test/cardano-testnet-test/files/golden/queries/queryConstitutionOut.json" + + 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" ] + 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 ] + 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 -> + -- drep-stake-distribution + H.noteM_ $ execCli' execConfig [ eraName, "query", "drep-stake-distribution", "--all-dreps" ] + + TestQueryCommitteeMembersStateCmd -> + -- committee-state + H.noteM_ $ execCli' execConfig [ eraName, "query", "committee-state" ] + + TestQueryTreasuryValueCmd -> do + -- treasury + H.noteM_ $ execCli' execConfig [ eraName, "query", "treasury" ] + + where + -- | 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 + + -- 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 + , 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 :: (HasCallStack, 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 + + verificationStakeKeyToStakeAddress :: Int -> VerificationKey StakeKey -> StakeAddress + verificationStakeKeyToStakeAddress testnetMagic delegatorVKey = + makeStakeAddress (fromNetworkMagic $ NetworkMagic $ fromIntegral testnetMagic) (StakeCredentialByKey $ verificationKeyHash delegatorVKey) + + 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 + 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 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": "" + } +} 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