From 118f0da5e778e0386c84513bd6d29751bd241bc6 Mon Sep 17 00:00:00 2001 From: Pablo Lamela Seijas Date: Mon, 3 Aug 2026 23:49:09 +0000 Subject: [PATCH 1/5] Check the CLI network id against the network id of the node Every command that opens a local state query connection now checks, on that same connection, that the network id the CLI was given (via `--mainnet`, `--testnet-magic` or `CARDANO_NODE_NETWORK_ID`) matches the network id in the node's genesis, and fails with a dedicated `NodeNetworkIdMismatchError` otherwise. --- cardano-cli/cardano-cli.cabal | 2 + .../src/Cardano/CLI/EraBased/Query/Run.hs | 35 +++++------ .../Cardano/CLI/EraBased/Transaction/Run.hs | 18 +++--- .../src/Cardano/CLI/LocalStateQuery.hs | 58 +++++++++++++++++++ .../Type/Error/NodeNetworkIdMismatchError.hs | 37 ++++++++++++ 5 files changed, 126 insertions(+), 24 deletions(-) create mode 100644 cardano-cli/src/Cardano/CLI/LocalStateQuery.hs create mode 100644 cardano-cli/src/Cardano/CLI/Type/Error/NodeNetworkIdMismatchError.hs diff --git a/cardano-cli/cardano-cli.cabal b/cardano-cli/cardano-cli.cabal index 9e8529853b..33dda24292 100644 --- a/cardano-cli/cardano-cli.cabal +++ b/cardano-cli/cardano-cli.cabal @@ -180,6 +180,7 @@ library Cardano.CLI.Legacy.Genesis.Run Cardano.CLI.Legacy.Option Cardano.CLI.Legacy.Run + Cardano.CLI.LocalStateQuery Cardano.CLI.OS.Posix Cardano.CLI.Option Cardano.CLI.Option.Flag @@ -211,6 +212,7 @@ library Cardano.CLI.Type.Error.KeyCmdError Cardano.CLI.Type.Error.NodeCmdError Cardano.CLI.Type.Error.NodeEraMismatchError + Cardano.CLI.Type.Error.NodeNetworkIdMismatchError Cardano.CLI.Type.Error.PlutusScriptDecodeError Cardano.CLI.Type.Error.ProtocolParamsError Cardano.CLI.Type.Error.QueryCmdError diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Query/Run.hs b/cardano-cli/src/Cardano/CLI/EraBased/Query/Run.hs index 0e8497f96d..1a663fd232 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Query/Run.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Query/Run.hs @@ -37,7 +37,7 @@ module Cardano.CLI.EraBased.Query.Run ) where -import Cardano.Api hiding (QueryInShelleyBasedEra (..)) +import Cardano.Api hiding (QueryInShelleyBasedEra (..), executeLocalStateQueryExpr) import Cardano.Api qualified as Api import Cardano.Api.Consensus qualified as Consensus import Cardano.Api.Experimental (obtainCommonConstraints) @@ -60,6 +60,7 @@ import Cardano.CLI.EraBased.Genesis.Internal.Common import Cardano.CLI.EraBased.Query.Command qualified as Cmd import Cardano.CLI.Helper import Cardano.CLI.Json.Encode qualified as Json +import Cardano.CLI.LocalStateQuery (executeLocalStateQueryExprWithNetworkIdCheck) import Cardano.CLI.Read ( getHashFromStakePoolKeyHashSource ) @@ -222,7 +223,7 @@ runQueryTipCmd ) = do eLocalState <- fromEitherIOCli $ fmap sequence $ - executeLocalStateQueryExpr nodeConnInfo target $ + executeLocalStateQueryExprWithNetworkIdCheck nodeConnInfo target $ runExceptT $ do era <- lift queryCurrentEra & onLeft (left . QueryCmdUnsupportedNtcVersion) eraHistory <- lift queryEraHistory & onLeft (left . QueryCmdUnsupportedNtcVersion) @@ -329,7 +330,7 @@ runQueryUTxOCmd } ) = do fromEitherIOCli - ( executeLocalStateQueryExpr nodeConnInfo target $ runExceptT $ do + ( executeLocalStateQueryExprWithNetworkIdCheck nodeConnInfo target $ runExceptT $ do anyCEra@(AnyCardanoEra cEra) <- easyRunQueryCurrentEra case forEraInEonMaybe cEra id of @@ -360,7 +361,7 @@ runQueryKesPeriodInfoCmd output <- fromEitherIOCli - ( executeLocalStateQueryExpr nodeConnInfo target $ runExceptT $ do + ( executeLocalStateQueryExprWithNetworkIdCheck nodeConnInfo target $ runExceptT $ do AnyCardanoEra cEra <- easyRunQueryCurrentEra era <- supportedEra cEra @@ -654,7 +655,7 @@ runQueryPoolStateCmd , Cmd.mOutFile } = do fromEitherIOCli - ( executeLocalStateQueryExpr nodeConnInfo target $ runExceptT $ do + ( executeLocalStateQueryExprWithNetworkIdCheck nodeConnInfo target $ runExceptT $ do AnyCardanoEra cEra <- easyRunQueryCurrentEra era <- supportedEra cEra @@ -734,7 +735,7 @@ runQueryRefScriptSizeCmd , Cmd.outputFormat , Cmd.mOutFile } = do - r <- fromEitherIOCli $ executeLocalStateQueryExpr nodeConnInfo target $ runExceptT $ do + r <- fromEitherIOCli $ executeLocalStateQueryExprWithNetworkIdCheck nodeConnInfo target $ runExceptT $ do AnyCardanoEra cEra <- easyRunQueryCurrentEra era <- supportedEra cEra @@ -781,7 +782,7 @@ runQueryStakeSnapshotCmd , Cmd.mOutFile } = do fromEitherIOCli - ( executeLocalStateQueryExpr nodeConnInfo target $ runExceptT $ do + ( executeLocalStateQueryExprWithNetworkIdCheck nodeConnInfo target $ runExceptT $ do AnyCardanoEra cEra <- easyRunQueryCurrentEra era <- supportedEra cEra @@ -815,7 +816,7 @@ runQueryLedgerStateCmd ) = do output <- fromEitherIOCli - ( executeLocalStateQueryExpr nodeConnInfo target $ runExceptT $ do + ( executeLocalStateQueryExprWithNetworkIdCheck nodeConnInfo target $ runExceptT $ do AnyCardanoEra cEra <- easyRunQueryCurrentEra era <- supportedEra cEra @@ -888,7 +889,7 @@ runQueryLedgerPeerSnapshot } = do (SomeLedgerPeerSnapshot snapshot) <- (fromEitherIOCli . fromEitherIOCli) - ( executeLocalStateQueryExpr nodeConnInfo target $ runExceptT $ do + ( executeLocalStateQueryExprWithNetworkIdCheck nodeConnInfo target $ runExceptT $ do AnyCardanoEra cEra <- lift queryCurrentEra & onLeft (left . QueryCmdUnsupportedNtcVersion) @@ -932,7 +933,7 @@ runQueryProtocolStateCmd ) = do () <- fromEitherIOCli - ( executeLocalStateQueryExpr nodeConnInfo target $ runExceptT $ do + ( executeLocalStateQueryExprWithNetworkIdCheck nodeConnInfo target $ runExceptT $ do anyE@(AnyCardanoEra cEra) <- easyRunQueryCurrentEra era <- @@ -1018,7 +1019,7 @@ getQueryStakeAddressInfo } (StakeAddress _ addr) = do - lift $ executeLocalStateQueryExpr nodeConnInfo target $ runExceptT $ do + lift $ executeLocalStateQueryExprWithNetworkIdCheck nodeConnInfo target $ runExceptT $ do AnyCardanoEra cEra <- easyRunQueryCurrentEra era <- supportedEra cEra @@ -1283,7 +1284,7 @@ runQueryStakePoolsCmd , Cmd.mOutFile } = do fromEitherIOCli - ( executeLocalStateQueryExpr nodeConnInfo target $ runExceptT @QueryCmdError $ do + ( executeLocalStateQueryExprWithNetworkIdCheck nodeConnInfo target $ runExceptT @QueryCmdError $ do AnyCardanoEra cEra <- easyRunQueryCurrentEra era <- supportedEra cEra @@ -1355,7 +1356,7 @@ runQueryStakeDistributionCmd , Cmd.mOutFile } = do fromEitherIOCli - ( executeLocalStateQueryExpr nodeConnInfo target $ runExceptT $ do + ( executeLocalStateQueryExprWithNetworkIdCheck nodeConnInfo target $ runExceptT $ do AnyCardanoEra cEra <- easyRunQueryCurrentEra era <- supportedEra cEra @@ -1433,7 +1434,7 @@ runQueryLeadershipScheduleCmd fromExceptTCli . join $ lift - ( executeLocalStateQueryExpr nodeConnInfo target $ runExceptT $ do + ( executeLocalStateQueryExprWithNetworkIdCheck nodeConnInfo target $ runExceptT $ do AnyCardanoEra cEra <- easyRunQueryCurrentEra era <- supportedEra cEra @@ -1966,7 +1967,7 @@ runQueryEraHistoryCmd } = do eraHistory <- fromEitherIOCli - ( executeLocalStateQueryExpr nodeConnInfo target $ + ( executeLocalStateQueryExprWithNetworkIdCheck nodeConnInfo target $ runExceptT $ lift queryEraHistory & onLeft (left . QueryCmdUnsupportedNtcVersion) ) @@ -2029,7 +2030,7 @@ runQuery runQuery localNodeConnInfo target query = firstExceptT QueryCmdAcquireFailure - (newExceptT $ executeLocalStateQueryExpr localNodeConnInfo target query) + (newExceptT $ executeLocalStateQueryExprWithNetworkIdCheck localNodeConnInfo target query) & onLeft (left . QueryCmdUnsupportedNtcVersion) & onLeft (left . QueryCmdEraMismatch) @@ -2064,7 +2065,7 @@ utcTimeToSlotNo -> ExceptT QueryCmdError IO SlotNo utcTimeToSlotNo localNodeConnInfo target utcTime = lift - ( executeLocalStateQueryExpr localNodeConnInfo target $ runExceptT $ do + ( executeLocalStateQueryExprWithNetworkIdCheck localNodeConnInfo target $ runExceptT $ do systemStart <- easyRunQuerySystemStart eraHistory <- easyRunQueryEraHistory diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Transaction/Run.hs b/cardano-cli/src/Cardano/CLI/EraBased/Transaction/Run.hs index 305db84dc6..e68a1b0c60 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Transaction/Run.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Transaction/Run.hs @@ -29,7 +29,8 @@ module Cardano.CLI.EraBased.Transaction.Run where import Cardano.Api hiding - ( mkTxCertificates + ( executeLocalStateQueryExpr + , mkTxCertificates , txId , validateTxIns , validateTxInsCollateral @@ -64,6 +65,7 @@ import Cardano.CLI.EraBased.Transaction.Internal.HashCheck , checkVotingProcedureHashes ) import Cardano.CLI.Json.Encode qualified as Json +import Cardano.CLI.LocalStateQuery (executeLocalStateQueryExprWithNetworkIdCheck) import Cardano.CLI.Orphan () import Cardano.CLI.Read import Cardano.CLI.Type.Common @@ -238,7 +240,7 @@ runTransactionBuildCmd (balances, _) <- fromEitherIOCli - ( executeLocalStateQueryExpr + ( executeLocalStateQueryExprWithNetworkIdCheck nodeConnInfo Consensus.VolatileTip (queryStakeAddresses eon allAddrHashes networkId) @@ -272,12 +274,13 @@ runTransactionBuildCmd allTxInputs = inputsThatRequireWitnessing ++ allReferenceInputs ++ filteredTxinsc AnyCardanoEra nodeEra <- - fromEitherIOCli (executeLocalStateQueryExpr nodeConnInfo Consensus.VolatileTip queryCurrentEra) + fromEitherIOCli + (executeLocalStateQueryExprWithNetworkIdCheck nodeConnInfo Consensus.VolatileTip queryCurrentEra) & fromEitherCIOCli (txEraUtxo, _, eraHistory, systemStart, _, _, _, featuredCurrentTreasuryValueM) <- fromEitherIOCli - ( executeLocalStateQueryExpr + ( executeLocalStateQueryExprWithNetworkIdCheck nodeConnInfo Consensus.VolatileTip (queryStateForBalancedTx nodeEra allTxInputs []) @@ -1051,7 +1054,8 @@ runTxBuild } AnyCardanoEra nodeEra <- - lift (executeLocalStateQueryExpr localNodeConnInfo Consensus.VolatileTip queryCurrentEra) + lift + (executeLocalStateQueryExprWithNetworkIdCheck localNodeConnInfo Consensus.VolatileTip queryCurrentEra) & onLeft (left . TxCmdQueryConvenienceError . AcqFailure) & onLeft (left . TxCmdQueryConvenienceError . QceUnsupportedNtcVersion) @@ -1062,7 +1066,7 @@ runTxBuild let certsToQuery = obtainCommonConstraints (Exp.useEra @era) (fst <$> certsAndMaybeScriptWits) (txEraUtxo, pparams, eraHistory, systemStart, stakePools, stakeDelegDeposits, drepDelegDeposits, _) <- lift - ( executeLocalStateQueryExpr localNodeConnInfo Consensus.VolatileTip $ + ( executeLocalStateQueryExprWithNetworkIdCheck localNodeConnInfo Consensus.VolatileTip $ queryStateForBalancedTx nodeEra allTxInputs certsToQuery ) & onLeft (left . TxCmdQueryConvenienceError . AcqFailure) @@ -1506,7 +1510,7 @@ runTransactionCalculatePlutusScriptCostCmd case nodeContextInfoSource of NodeConnectionInfo nodeConnInfo -> lift - ( executeLocalStateQueryExpr nodeConnInfo Consensus.VolatileTip $ do + ( executeLocalStateQueryExprWithNetworkIdCheck nodeConnInfo Consensus.VolatileTip $ do eCurrentEra <- queryCurrentEra eSystemStart <- querySystemStart eEraHistory <- queryEraHistory diff --git a/cardano-cli/src/Cardano/CLI/LocalStateQuery.hs b/cardano-cli/src/Cardano/CLI/LocalStateQuery.hs new file mode 100644 index 0000000000..9e363689cc --- /dev/null +++ b/cardano-cli/src/Cardano/CLI/LocalStateQuery.hs @@ -0,0 +1,58 @@ +{-# LANGUAGE LambdaCase #-} + +module Cardano.CLI.LocalStateQuery + ( executeLocalStateQueryExprWithNetworkIdCheck + ) +where + +import Cardano.Api +import Cardano.Api.Network qualified as Consensus + +import Cardano.CLI.Compatible.Exception (throwCliError) +import Cardano.CLI.Type.Error.NodeNetworkIdMismatchError + +-- | Like 'executeLocalStateQueryExpr', but before running the given expression +-- it checks that the network id the CLI was given matches the network id in the +-- node's genesis, and throws a 'NodeNetworkIdMismatchError' otherwise. +-- +-- The node-to-client handshake only compares network magics, so a 'NetworkId' +-- with the right magic but the wrong tag (for example +-- @CARDANO_NODE_NETWORK_ID=764824073@ instead of @CARDANO_NODE_NETWORK_ID=mainnet@) +-- connects successfully and would otherwise make the CLI render addresses for +-- the wrong network. +executeLocalStateQueryExprWithNetworkIdCheck + :: LocalNodeConnectInfo + -> Consensus.Target ChainPoint + -> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a + -> IO (Either AcquiringFailure a) +executeLocalStateQueryExprWithNetworkIdCheck connectInfo target f = + executeLocalStateQueryExpr connectInfo target $ do + checkNodeNetworkId (localNodeNetworkId connectInfo) + f + +checkNodeNetworkId + :: NetworkId + -> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO () +checkNodeNetworkId cliNetId = + queryNodeNetworkId >>= \case + Just nodeNetId + | nodeNetId /= cliNetId -> + throwCliError $ NodeNetworkIdMismatchError cliNetId nodeNetId + _ -> pure () + +-- | The network id from the node's genesis, or 'Nothing' when it cannot be +-- obtained (the node is still in the Byron era, or it does not support the +-- necessary queries): the absence of an answer is not treated as a mismatch. +queryNodeNetworkId + :: LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO (Maybe NetworkId) +queryNodeNetworkId = + queryCurrentEra >>= \case + Left _unsupportedNtcVersion -> pure Nothing + Right (AnyCardanoEra era) -> + case forEraMaybeEon era of + Nothing -> pure Nothing + Just sbe -> + queryGenesisParameters sbe >>= \case + Right (Right genesisParameters) -> + pure . Just $ protocolParamNetworkId genesisParameters + _ -> pure Nothing diff --git a/cardano-cli/src/Cardano/CLI/Type/Error/NodeNetworkIdMismatchError.hs b/cardano-cli/src/Cardano/CLI/Type/Error/NodeNetworkIdMismatchError.hs new file mode 100644 index 0000000000..97a8ce1a6f --- /dev/null +++ b/cardano-cli/src/Cardano/CLI/Type/Error/NodeNetworkIdMismatchError.hs @@ -0,0 +1,37 @@ +module Cardano.CLI.Type.Error.NodeNetworkIdMismatchError + ( NodeNetworkIdMismatchError (..) + ) +where + +import Cardano.Api + +data NodeNetworkIdMismatchError = NodeNetworkIdMismatchError + { cliNetworkId :: !NetworkId + , nodeNetworkId :: !NetworkId + } + deriving Show + +instance Error NodeNetworkIdMismatchError where + prettyError (NodeNetworkIdMismatchError cli node) = + mconcat + [ "The network id given to the command does not match the network of the node: " + , "the command was given " + , renderNetworkId cli + , ", but the node is on " + , renderNetworkId node + , ".\n" + , "Specify " + , renderNetworkIdFlag node + , " (or set the CARDANO_NODE_NETWORK_ID environment variable accordingly), " + , "or connect to a node on the expected network." + ] + where + renderNetworkId :: NetworkId -> Doc ann + renderNetworkId Mainnet = "mainnet" + renderNetworkId (Testnet (NetworkMagic magic)) = + "a testnet with network magic " <> pretty magic + + renderNetworkIdFlag :: NetworkId -> Doc ann + renderNetworkIdFlag Mainnet = "--mainnet" + renderNetworkIdFlag (Testnet (NetworkMagic magic)) = + "--testnet-magic " <> pretty magic From 316ad1b6c5bf6eac01b415569ad83f490ecce653 Mon Sep 17 00:00:00 2001 From: Pablo Lamela Seijas Date: Tue, 4 Aug 2026 01:06:43 +0000 Subject: [PATCH 2/5] `query stake-address-info`: check the address against the network id The header of a stake address encodes whether it is a mainnet or a testnet address. `query stake-address-info` now fails with a dedicated `StakeAddressNetworkIdMismatchError` when that tag does not match the network id the CLI was given, instead of silently dropping the address's network tag and querying just the credential. --- cardano-cli/cardano-cli.cabal | 1 + .../src/Cardano/CLI/EraBased/Query/Run.hs | 6 ++- .../StakeAddressNetworkIdMismatchError.hs | 37 +++++++++++++++++++ .../cardano-cli-test/Test/Cli/Run/Query.hs | 37 ++++++++++++++++++- 4 files changed, 78 insertions(+), 3 deletions(-) create mode 100644 cardano-cli/src/Cardano/CLI/Type/Error/StakeAddressNetworkIdMismatchError.hs diff --git a/cardano-cli/cardano-cli.cabal b/cardano-cli/cardano-cli.cabal index 33dda24292..2658b1f117 100644 --- a/cardano-cli/cardano-cli.cabal +++ b/cardano-cli/cardano-cli.cabal @@ -220,6 +220,7 @@ library Cardano.CLI.Type.Error.ScriptDataError Cardano.CLI.Type.Error.ScriptDecodeError Cardano.CLI.Type.Error.StakeAddressDelegationError + Cardano.CLI.Type.Error.StakeAddressNetworkIdMismatchError Cardano.CLI.Type.Error.StakeAddressRegistrationError Cardano.CLI.Type.Error.StakeCredentialError Cardano.CLI.Type.Error.StakePoolCmdError diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Query/Run.hs b/cardano-cli/src/Cardano/CLI/EraBased/Query/Run.hs index 1a663fd232..48d4a16370 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Query/Run.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Query/Run.hs @@ -66,6 +66,7 @@ import Cardano.CLI.Read ) import Cardano.CLI.Type.Common import Cardano.CLI.Type.Error.QueryCmdError +import Cardano.CLI.Type.Error.StakeAddressNetworkIdMismatchError import Cardano.CLI.Type.Key ( readDRepCredential , readSPOCredential @@ -1017,8 +1018,11 @@ getQueryStakeAddressInfo { Cmd.nodeConnInfo = nodeConnInfo@LocalNodeConnectInfo{localNodeNetworkId = networkId} , Cmd.target } - (StakeAddress _ addr) = + sAddr@(StakeAddress addrNetwork addr) = do + when (addrNetwork /= toShelleyNetwork networkId) $ + throwCliError $ + StakeAddressNetworkIdMismatchError sAddr networkId lift $ executeLocalStateQueryExprWithNetworkIdCheck nodeConnInfo target $ runExceptT $ do AnyCardanoEra cEra <- easyRunQueryCurrentEra diff --git a/cardano-cli/src/Cardano/CLI/Type/Error/StakeAddressNetworkIdMismatchError.hs b/cardano-cli/src/Cardano/CLI/Type/Error/StakeAddressNetworkIdMismatchError.hs new file mode 100644 index 0000000000..8dd1c21e64 --- /dev/null +++ b/cardano-cli/src/Cardano/CLI/Type/Error/StakeAddressNetworkIdMismatchError.hs @@ -0,0 +1,37 @@ +module Cardano.CLI.Type.Error.StakeAddressNetworkIdMismatchError + ( StakeAddressNetworkIdMismatchError (..) + ) +where + +import Cardano.Api +import Cardano.Api.Ledger qualified as L + +data StakeAddressNetworkIdMismatchError = StakeAddressNetworkIdMismatchError + { stakeAddress :: !StakeAddress + , cliNetworkId :: !NetworkId + } + deriving Show + +instance Error StakeAddressNetworkIdMismatchError where + prettyError (StakeAddressNetworkIdMismatchError sAddr@(StakeAddress addrNetwork _) netId) = + mconcat + [ "The stake address " + , pretty (serialiseAddress sAddr) + , " is " + , renderNetwork addrNetwork + , ", but the command was given " + , renderNetworkId netId + , ".\n" + , "Check the network options (--mainnet, --testnet-magic, or the " + , "CARDANO_NODE_NETWORK_ID environment variable), or use a stake address " + , "for the expected network." + ] + where + renderNetwork :: L.Network -> Doc ann + renderNetwork L.Mainnet = "a mainnet stake address" + renderNetwork L.Testnet = "a testnet stake address" + + renderNetworkId :: NetworkId -> Doc ann + renderNetworkId Mainnet = "mainnet" + renderNetworkId (Testnet (NetworkMagic magic)) = + "a testnet with network magic " <> pretty magic diff --git a/cardano-cli/test/cardano-cli-test/Test/Cli/Run/Query.hs b/cardano-cli/test/cardano-cli-test/Test/Cli/Run/Query.hs index 2b2fcf405b..47a8cb65c5 100644 --- a/cardano-cli/test/cardano-cli-test/Test/Cli/Run/Query.hs +++ b/cardano-cli/test/cardano-cli-test/Test/Cli/Run/Query.hs @@ -1,15 +1,20 @@ module Test.Cli.Run.Query ( hprop_percentage + , hprop_query_stake_address_info_network_id_mismatch ) where import Cardano.CLI.EraBased.Query.Run qualified as Q import Cardano.Slotting.Time (RelativeTime (..)) -import Test.Cardano.CLI.Util (watchdogProp) +import Data.List (isInfixOf) +import System.Exit (ExitCode (..)) +import System.FilePath (()) + +import Test.Cardano.CLI.Util (execDetailCardanoCLI, watchdogProp) import Hedgehog (Property, (===)) -import Hedgehog.Extras.Test.Base qualified as H +import Hedgehog.Extras qualified as H hprop_percentage :: Property hprop_percentage = @@ -20,3 +25,31 @@ hprop_percentage = Q.percentage (RelativeTime 10) (RelativeTime 500) (RelativeTime 1000) === "51.05" Q.percentage (RelativeTime 10) (RelativeTime 0) (RelativeTime 1000) === "1.10" return () + +-- | The command must fail before attempting to connect to the node (the given +-- socket does not exist), because the mainnet stake address cannot match the +-- given testnet network id. +-- +-- Execute me with: +-- @cabal test cardano-cli-test --test-options '-p "/query stake address info network id mismatch/"'@ +hprop_query_stake_address_info_network_id_mismatch :: Property +hprop_query_stake_address_info_network_id_mismatch = + watchdogProp . H.propertyOnce $ H.moduleWorkspace "tmp" $ \tempDir -> do + (exitCode, _stdout, stderr) <- + H.noteShowM $ + execDetailCardanoCLI + [ "latest" + , "query" + , "stake-address-info" + , "--testnet-magic" + , "2" + , "--address" + , "stake1uxqmgfzls3vn7c7qlu3fdycz2nmh5p5sl2w7t7tfetp8evqacghf3" + , "--socket-path" + , tempDir "unused.socket" + ] + + exitCode === ExitFailure 1 + H.assertWith + stderr + ("is a mainnet stake address, but the command was given a testnet with network magic 2" `isInfixOf`) From d20bf2cdccc7b7f21a6cadd35d5df8df170e0082 Mon Sep 17 00:00:00 2001 From: Pablo Lamela Seijas Date: Tue, 4 Aug 2026 01:12:49 +0000 Subject: [PATCH 3/5] Add changelog fragment --- ...228_cardano-cli_pablo.lamela_check_network_id.yml | 12 ++++++++++++ 1 file changed, 12 insertions(+) create mode 100644 .changes/20260804_011228_cardano-cli_pablo.lamela_check_network_id.yml diff --git a/.changes/20260804_011228_cardano-cli_pablo.lamela_check_network_id.yml b/.changes/20260804_011228_cardano-cli_pablo.lamela_check_network_id.yml new file mode 100644 index 0000000000..3d0d0c8d03 --- /dev/null +++ b/.changes/20260804_011228_cardano-cli_pablo.lamela_check_network_id.yml @@ -0,0 +1,12 @@ +description: Commands that query a node now check that the network id given to + the CLI (`--mainnet`, `--testnet-magic`, or `CARDANO_NODE_NETWORK_ID`) matches + the network id in the node's genesis, so that for example + `CARDANO_NODE_NETWORK_ID=764824073` against a mainnet node no longer renders + addresses with a testnet prefix. Additionally, `query stake-address-info` now + fails when the given stake address does not match the network id, instead of + silently dropping the address's network tag. +kind: +- bugfix +- test +pr: 1405 +project: cardano-cli From af04b29e6f1a3dd6c1d4cbb14a65dbed72f5f035 Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Wed, 5 Aug 2026 00:19:29 +0200 Subject: [PATCH 4/5] Address review comments: flatten queryNodeNetworkId, reformat changelog Flatten queryNodeNetworkId into a linear MaybeT do-block using extra's eitherToMaybe, replacing the nested case-of staircase. Collapse the changelog fragment's description to one line, since a plain YAML scalar folds line breaks to spaces regardless of where the source wraps --- ...dano-cli_pablo.lamela_check_network_id.yml | 8 +------- cardano-cli/cardano-cli.cabal | 1 + .../src/Cardano/CLI/LocalStateQuery.hs | 20 +++++++++---------- 3 files changed, 11 insertions(+), 18 deletions(-) diff --git a/.changes/20260804_011228_cardano-cli_pablo.lamela_check_network_id.yml b/.changes/20260804_011228_cardano-cli_pablo.lamela_check_network_id.yml index 3d0d0c8d03..d49f3ce2f5 100644 --- a/.changes/20260804_011228_cardano-cli_pablo.lamela_check_network_id.yml +++ b/.changes/20260804_011228_cardano-cli_pablo.lamela_check_network_id.yml @@ -1,10 +1,4 @@ -description: Commands that query a node now check that the network id given to - the CLI (`--mainnet`, `--testnet-magic`, or `CARDANO_NODE_NETWORK_ID`) matches - the network id in the node's genesis, so that for example - `CARDANO_NODE_NETWORK_ID=764824073` against a mainnet node no longer renders - addresses with a testnet prefix. Additionally, `query stake-address-info` now - fails when the given stake address does not match the network id, instead of - silently dropping the address's network tag. +description: Commands that query a node now check that the network id given to the CLI (`--mainnet`, `--testnet-magic`, or `CARDANO_NODE_NETWORK_ID`) matches the network id in the node's genesis, so that for example `CARDANO_NODE_NETWORK_ID=764824073` against a mainnet node no longer renders addresses with a testnet prefix. Additionally, `query stake-address-info` now fails when the given stake address does not match the network id, instead of silently dropping the address's network tag. kind: - bugfix - test diff --git a/cardano-cli/cardano-cli.cabal b/cardano-cli/cardano-cli.cabal index 2658b1f117..0ea67c2c0a 100644 --- a/cardano-cli/cardano-cli.cabal +++ b/cardano-cli/cardano-cli.cabal @@ -268,6 +268,7 @@ library deepseq, directory, exceptions, + extra, filepath, formatting, generic-lens, diff --git a/cardano-cli/src/Cardano/CLI/LocalStateQuery.hs b/cardano-cli/src/Cardano/CLI/LocalStateQuery.hs index 9e363689cc..93c60043d8 100644 --- a/cardano-cli/src/Cardano/CLI/LocalStateQuery.hs +++ b/cardano-cli/src/Cardano/CLI/LocalStateQuery.hs @@ -11,6 +11,10 @@ import Cardano.Api.Network qualified as Consensus import Cardano.CLI.Compatible.Exception (throwCliError) import Cardano.CLI.Type.Error.NodeNetworkIdMismatchError +import Control.Monad ((>=>)) +import Control.Monad.Trans.Maybe (MaybeT (..)) +import Data.Either.Extra (eitherToMaybe) + -- | Like 'executeLocalStateQueryExpr', but before running the given expression -- it checks that the network id the CLI was given matches the network id in the -- node's genesis, and throws a 'NodeNetworkIdMismatchError' otherwise. @@ -45,14 +49,8 @@ checkNodeNetworkId cliNetId = -- necessary queries): the absence of an answer is not treated as a mismatch. queryNodeNetworkId :: LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO (Maybe NetworkId) -queryNodeNetworkId = - queryCurrentEra >>= \case - Left _unsupportedNtcVersion -> pure Nothing - Right (AnyCardanoEra era) -> - case forEraMaybeEon era of - Nothing -> pure Nothing - Just sbe -> - queryGenesisParameters sbe >>= \case - Right (Right genesisParameters) -> - pure . Just $ protocolParamNetworkId genesisParameters - _ -> pure Nothing +queryNodeNetworkId = runMaybeT $ do + AnyCardanoEra era <- MaybeT $ eitherToMaybe <$> queryCurrentEra + sbe <- MaybeT . pure $ forEraMaybeEon era + genesisParameters <- MaybeT $ (eitherToMaybe >=> eitherToMaybe) <$> queryGenesisParameters sbe + pure $ protocolParamNetworkId genesisParameters From d1e3ee982ddf39f8aa450e366faaa9785011bb86 Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Sat, 8 Aug 2026 01:26:50 +0200 Subject: [PATCH 5/5] Run the network id check once before each command Per review, replace the executeLocalStateQueryExprWithNetworkIdCheck wrapper with a standalone checkNodeNetworkId that runs a single query session: once before the case in runQueryCmds. If the node cannot be reached, the check passes silently and the command itself reports the connection problem, exactly as before. --- .../src/Cardano/CLI/EraBased/Query/Command.hs | 36 +++++++ .../src/Cardano/CLI/EraBased/Query/Run.hs | 96 ++++++++++--------- .../Cardano/CLI/EraBased/Transaction/Run.hs | 24 ++--- .../src/Cardano/CLI/LocalStateQuery.hs | 41 ++++---- 4 files changed, 117 insertions(+), 80 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Query/Command.hs b/cardano-cli/src/Cardano/CLI/EraBased/Query/Command.hs index 0d99998e98..8d68e6ae92 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Query/Command.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Query/Command.hs @@ -2,6 +2,7 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} module Cardano.CLI.EraBased.Query.Command ( QueryCmds (..) @@ -32,6 +33,7 @@ module Cardano.CLI.EraBased.Query.Command , QueryStakePoolDefaultVoteCmdArgs (..) , QueryEraHistoryCmdArgs (..) , renderQueryCmds + , queryCmdNodeConnInfo , IncludeStake (..) , CliLedgerPeers (..) ) @@ -358,3 +360,37 @@ renderTxMempoolQuery = \case TxMempoolQueryTxExists tx -> "tx-exists " <> serialiseToRawBytesHexText tx TxMempoolQueryNextTx -> "next-tx" TxMempoolQueryInfo -> "info" + +-- | The connection info for the node a query command talks to +queryCmdNodeConnInfo :: QueryCmds era -> LocalNodeConnectInfo +queryCmdNodeConnInfo = \case + QueryLeadershipScheduleCmd QueryLeadershipScheduleCmdArgs{commons} -> fromCommons commons + QueryProtocolParametersCmd QueryProtocolParametersCmdArgs{nodeConnInfo} -> nodeConnInfo + QueryTipCmd QueryTipCmdArgs{commons} -> fromCommons commons + QueryStakePoolsCmd QueryStakePoolsCmdArgs{commons} -> fromCommons commons + QueryStakeDistributionCmd QueryStakeDistributionCmdArgs{commons} -> fromCommons commons + QueryStakeAddressInfoCmd QueryStakeAddressInfoCmdArgs{commons} -> fromCommons commons + QueryUTxOCmd QueryUTxOCmdArgs{commons} -> fromCommons commons + QueryLedgerStateCmd QueryLedgerStateCmdArgs{commons} -> fromCommons commons + QueryProtocolStateCmd QueryProtocolStateCmdArgs{commons} -> fromCommons commons + QueryStakeSnapshotCmd QueryStakeSnapshotCmdArgs{commons} -> fromCommons commons + QueryKesPeriodInfoCmd QueryKesPeriodInfoCmdArgs{commons} -> fromCommons commons + QueryPoolStateCmd QueryPoolStateCmdArgs{commons} -> fromCommons commons + QueryTxMempoolCmd QueryTxMempoolCmdArgs{nodeConnInfo} -> nodeConnInfo + QuerySlotNumberCmd QuerySlotNumberCmdArgs{commons} -> fromCommons commons + QueryRefScriptSizeCmd QueryRefScriptSizeCmdArgs{commons} -> fromCommons commons + QueryConstitutionCmd QueryNoArgCmdArgs{commons} -> fromCommons commons + QueryGovStateCmd QueryNoArgCmdArgs{commons} -> fromCommons commons + QueryRatifyStateCmd QueryNoArgCmdArgs{commons} -> fromCommons commons + QueryFuturePParamsCmd QueryNoArgCmdArgs{commons} -> fromCommons commons + QueryDRepStateCmd QueryDRepStateCmdArgs{commons} -> fromCommons commons + QueryDRepStakeDistributionCmd QueryDRepStakeDistributionCmdArgs{commons} -> fromCommons commons + QuerySPOStakeDistributionCmd QuerySPOStakeDistributionCmdArgs{commons} -> fromCommons commons + QueryCommitteeMembersStateCmd QueryCommitteeMembersStateCmdArgs{commons} -> fromCommons commons + QueryTreasuryValueCmd QueryTreasuryValueCmdArgs{commons} -> fromCommons commons + QueryProposalsCmd QueryProposalsCmdArgs{commons} -> fromCommons commons + QueryLedgerPeerSnapshotCmd QueryLedgerPeerSnapshotCmdArgs{commons} -> fromCommons commons + QueryStakePoolDefaultVoteCmd QueryStakePoolDefaultVoteCmdArgs{commons} -> fromCommons commons + QueryEraHistoryCmd QueryEraHistoryCmdArgs{commons} -> fromCommons commons + where + fromCommons QueryCommons{nodeConnInfo} = nodeConnInfo diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Query/Run.hs b/cardano-cli/src/Cardano/CLI/EraBased/Query/Run.hs index 48d4a16370..ee87e7af34 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Query/Run.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Query/Run.hs @@ -37,7 +37,7 @@ module Cardano.CLI.EraBased.Query.Run ) where -import Cardano.Api hiding (QueryInShelleyBasedEra (..), executeLocalStateQueryExpr) +import Cardano.Api hiding (QueryInShelleyBasedEra (..)) import Cardano.Api qualified as Api import Cardano.Api.Consensus qualified as Consensus import Cardano.Api.Experimental (obtainCommonConstraints) @@ -60,7 +60,7 @@ import Cardano.CLI.EraBased.Genesis.Internal.Common import Cardano.CLI.EraBased.Query.Command qualified as Cmd import Cardano.CLI.Helper import Cardano.CLI.Json.Encode qualified as Json -import Cardano.CLI.LocalStateQuery (executeLocalStateQueryExprWithNetworkIdCheck) +import Cardano.CLI.LocalStateQuery (checkNodeNetworkId) import Cardano.CLI.Read ( getHashFromStakePoolKeyHashSource ) @@ -109,35 +109,37 @@ import Text.Printf (printf) import Vary runQueryCmds :: Cmd.QueryCmds era -> CIO e () -runQueryCmds = \case - Cmd.QueryCommitteeMembersStateCmd args -> runQueryCommitteeMembersState args - Cmd.QueryConstitutionCmd args -> runQueryConstitution args - Cmd.QueryDRepStakeDistributionCmd args -> runQueryDRepStakeDistribution args - Cmd.QueryDRepStateCmd args -> runQueryDRepState args - Cmd.QueryEraHistoryCmd args -> runQueryEraHistoryCmd args - Cmd.QueryFuturePParamsCmd args -> runQueryFuturePParams args - Cmd.QueryGovStateCmd args -> runQueryGovState args - Cmd.QueryKesPeriodInfoCmd args -> runQueryKesPeriodInfoCmd args - Cmd.QueryLeadershipScheduleCmd args -> runQueryLeadershipScheduleCmd args - Cmd.QueryLedgerPeerSnapshotCmd args -> runQueryLedgerPeerSnapshot args - Cmd.QueryLedgerStateCmd args -> runQueryLedgerStateCmd args - Cmd.QueryPoolStateCmd args -> runQueryPoolStateCmd args - Cmd.QueryProposalsCmd args -> runQueryProposals args - Cmd.QueryProtocolParametersCmd args -> runQueryProtocolParametersCmd args - Cmd.QueryProtocolStateCmd args -> runQueryProtocolStateCmd args - Cmd.QueryRatifyStateCmd args -> runQueryRatifyState args - Cmd.QueryRefScriptSizeCmd args -> runQueryRefScriptSizeCmd args - Cmd.QuerySlotNumberCmd args -> runQuerySlotNumberCmd args - Cmd.QuerySPOStakeDistributionCmd args -> runQuerySPOStakeDistribution args - Cmd.QueryStakeAddressInfoCmd args -> runQueryStakeAddressInfoCmd args - Cmd.QueryStakeDistributionCmd args -> runQueryStakeDistributionCmd args - Cmd.QueryStakePoolDefaultVoteCmd args -> runQueryStakePoolDefaultVote args - Cmd.QueryStakePoolsCmd args -> runQueryStakePoolsCmd args - Cmd.QueryStakeSnapshotCmd args -> runQueryStakeSnapshotCmd args - Cmd.QueryTipCmd args -> runQueryTipCmd args - Cmd.QueryTreasuryValueCmd args -> runQueryTreasuryValue args - Cmd.QueryTxMempoolCmd args -> runQueryTxMempoolCmd args - Cmd.QueryUTxOCmd args -> runQueryUTxOCmd args +runQueryCmds cmd = do + checkNodeNetworkId $ Cmd.queryCmdNodeConnInfo cmd + case cmd of + Cmd.QueryCommitteeMembersStateCmd args -> runQueryCommitteeMembersState args + Cmd.QueryConstitutionCmd args -> runQueryConstitution args + Cmd.QueryDRepStakeDistributionCmd args -> runQueryDRepStakeDistribution args + Cmd.QueryDRepStateCmd args -> runQueryDRepState args + Cmd.QueryEraHistoryCmd args -> runQueryEraHistoryCmd args + Cmd.QueryFuturePParamsCmd args -> runQueryFuturePParams args + Cmd.QueryGovStateCmd args -> runQueryGovState args + Cmd.QueryKesPeriodInfoCmd args -> runQueryKesPeriodInfoCmd args + Cmd.QueryLeadershipScheduleCmd args -> runQueryLeadershipScheduleCmd args + Cmd.QueryLedgerPeerSnapshotCmd args -> runQueryLedgerPeerSnapshot args + Cmd.QueryLedgerStateCmd args -> runQueryLedgerStateCmd args + Cmd.QueryPoolStateCmd args -> runQueryPoolStateCmd args + Cmd.QueryProposalsCmd args -> runQueryProposals args + Cmd.QueryProtocolParametersCmd args -> runQueryProtocolParametersCmd args + Cmd.QueryProtocolStateCmd args -> runQueryProtocolStateCmd args + Cmd.QueryRatifyStateCmd args -> runQueryRatifyState args + Cmd.QueryRefScriptSizeCmd args -> runQueryRefScriptSizeCmd args + Cmd.QuerySlotNumberCmd args -> runQuerySlotNumberCmd args + Cmd.QuerySPOStakeDistributionCmd args -> runQuerySPOStakeDistribution args + Cmd.QueryStakeAddressInfoCmd args -> runQueryStakeAddressInfoCmd args + Cmd.QueryStakeDistributionCmd args -> runQueryStakeDistributionCmd args + Cmd.QueryStakePoolDefaultVoteCmd args -> runQueryStakePoolDefaultVote args + Cmd.QueryStakePoolsCmd args -> runQueryStakePoolsCmd args + Cmd.QueryStakeSnapshotCmd args -> runQueryStakeSnapshotCmd args + Cmd.QueryTipCmd args -> runQueryTipCmd args + Cmd.QueryTreasuryValueCmd args -> runQueryTreasuryValue args + Cmd.QueryTxMempoolCmd args -> runQueryTxMempoolCmd args + Cmd.QueryUTxOCmd args -> runQueryUTxOCmd args runQueryProtocolParametersCmd :: () @@ -224,7 +226,7 @@ runQueryTipCmd ) = do eLocalState <- fromEitherIOCli $ fmap sequence $ - executeLocalStateQueryExprWithNetworkIdCheck nodeConnInfo target $ + executeLocalStateQueryExpr nodeConnInfo target $ runExceptT $ do era <- lift queryCurrentEra & onLeft (left . QueryCmdUnsupportedNtcVersion) eraHistory <- lift queryEraHistory & onLeft (left . QueryCmdUnsupportedNtcVersion) @@ -331,7 +333,7 @@ runQueryUTxOCmd } ) = do fromEitherIOCli - ( executeLocalStateQueryExprWithNetworkIdCheck nodeConnInfo target $ runExceptT $ do + ( executeLocalStateQueryExpr nodeConnInfo target $ runExceptT $ do anyCEra@(AnyCardanoEra cEra) <- easyRunQueryCurrentEra case forEraInEonMaybe cEra id of @@ -362,7 +364,7 @@ runQueryKesPeriodInfoCmd output <- fromEitherIOCli - ( executeLocalStateQueryExprWithNetworkIdCheck nodeConnInfo target $ runExceptT $ do + ( executeLocalStateQueryExpr nodeConnInfo target $ runExceptT $ do AnyCardanoEra cEra <- easyRunQueryCurrentEra era <- supportedEra cEra @@ -656,7 +658,7 @@ runQueryPoolStateCmd , Cmd.mOutFile } = do fromEitherIOCli - ( executeLocalStateQueryExprWithNetworkIdCheck nodeConnInfo target $ runExceptT $ do + ( executeLocalStateQueryExpr nodeConnInfo target $ runExceptT $ do AnyCardanoEra cEra <- easyRunQueryCurrentEra era <- supportedEra cEra @@ -736,7 +738,7 @@ runQueryRefScriptSizeCmd , Cmd.outputFormat , Cmd.mOutFile } = do - r <- fromEitherIOCli $ executeLocalStateQueryExprWithNetworkIdCheck nodeConnInfo target $ runExceptT $ do + r <- fromEitherIOCli $ executeLocalStateQueryExpr nodeConnInfo target $ runExceptT $ do AnyCardanoEra cEra <- easyRunQueryCurrentEra era <- supportedEra cEra @@ -783,7 +785,7 @@ runQueryStakeSnapshotCmd , Cmd.mOutFile } = do fromEitherIOCli - ( executeLocalStateQueryExprWithNetworkIdCheck nodeConnInfo target $ runExceptT $ do + ( executeLocalStateQueryExpr nodeConnInfo target $ runExceptT $ do AnyCardanoEra cEra <- easyRunQueryCurrentEra era <- supportedEra cEra @@ -817,7 +819,7 @@ runQueryLedgerStateCmd ) = do output <- fromEitherIOCli - ( executeLocalStateQueryExprWithNetworkIdCheck nodeConnInfo target $ runExceptT $ do + ( executeLocalStateQueryExpr nodeConnInfo target $ runExceptT $ do AnyCardanoEra cEra <- easyRunQueryCurrentEra era <- supportedEra cEra @@ -890,7 +892,7 @@ runQueryLedgerPeerSnapshot } = do (SomeLedgerPeerSnapshot snapshot) <- (fromEitherIOCli . fromEitherIOCli) - ( executeLocalStateQueryExprWithNetworkIdCheck nodeConnInfo target $ runExceptT $ do + ( executeLocalStateQueryExpr nodeConnInfo target $ runExceptT $ do AnyCardanoEra cEra <- lift queryCurrentEra & onLeft (left . QueryCmdUnsupportedNtcVersion) @@ -934,7 +936,7 @@ runQueryProtocolStateCmd ) = do () <- fromEitherIOCli - ( executeLocalStateQueryExprWithNetworkIdCheck nodeConnInfo target $ runExceptT $ do + ( executeLocalStateQueryExpr nodeConnInfo target $ runExceptT $ do anyE@(AnyCardanoEra cEra) <- easyRunQueryCurrentEra era <- @@ -1023,7 +1025,7 @@ getQueryStakeAddressInfo when (addrNetwork /= toShelleyNetwork networkId) $ throwCliError $ StakeAddressNetworkIdMismatchError sAddr networkId - lift $ executeLocalStateQueryExprWithNetworkIdCheck nodeConnInfo target $ runExceptT $ do + lift $ executeLocalStateQueryExpr nodeConnInfo target $ runExceptT $ do AnyCardanoEra cEra <- easyRunQueryCurrentEra era <- supportedEra cEra @@ -1288,7 +1290,7 @@ runQueryStakePoolsCmd , Cmd.mOutFile } = do fromEitherIOCli - ( executeLocalStateQueryExprWithNetworkIdCheck nodeConnInfo target $ runExceptT @QueryCmdError $ do + ( executeLocalStateQueryExpr nodeConnInfo target $ runExceptT @QueryCmdError $ do AnyCardanoEra cEra <- easyRunQueryCurrentEra era <- supportedEra cEra @@ -1360,7 +1362,7 @@ runQueryStakeDistributionCmd , Cmd.mOutFile } = do fromEitherIOCli - ( executeLocalStateQueryExprWithNetworkIdCheck nodeConnInfo target $ runExceptT $ do + ( executeLocalStateQueryExpr nodeConnInfo target $ runExceptT $ do AnyCardanoEra cEra <- easyRunQueryCurrentEra era <- supportedEra cEra @@ -1438,7 +1440,7 @@ runQueryLeadershipScheduleCmd fromExceptTCli . join $ lift - ( executeLocalStateQueryExprWithNetworkIdCheck nodeConnInfo target $ runExceptT $ do + ( executeLocalStateQueryExpr nodeConnInfo target $ runExceptT $ do AnyCardanoEra cEra <- easyRunQueryCurrentEra era <- supportedEra cEra @@ -1971,7 +1973,7 @@ runQueryEraHistoryCmd } = do eraHistory <- fromEitherIOCli - ( executeLocalStateQueryExprWithNetworkIdCheck nodeConnInfo target $ + ( executeLocalStateQueryExpr nodeConnInfo target $ runExceptT $ lift queryEraHistory & onLeft (left . QueryCmdUnsupportedNtcVersion) ) @@ -2034,7 +2036,7 @@ runQuery runQuery localNodeConnInfo target query = firstExceptT QueryCmdAcquireFailure - (newExceptT $ executeLocalStateQueryExprWithNetworkIdCheck localNodeConnInfo target query) + (newExceptT $ executeLocalStateQueryExpr localNodeConnInfo target query) & onLeft (left . QueryCmdUnsupportedNtcVersion) & onLeft (left . QueryCmdEraMismatch) @@ -2069,7 +2071,7 @@ utcTimeToSlotNo -> ExceptT QueryCmdError IO SlotNo utcTimeToSlotNo localNodeConnInfo target utcTime = lift - ( executeLocalStateQueryExprWithNetworkIdCheck localNodeConnInfo target $ runExceptT $ do + ( executeLocalStateQueryExpr localNodeConnInfo target $ runExceptT $ do systemStart <- easyRunQuerySystemStart eraHistory <- easyRunQueryEraHistory diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Transaction/Run.hs b/cardano-cli/src/Cardano/CLI/EraBased/Transaction/Run.hs index e68a1b0c60..2097e81363 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Transaction/Run.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Transaction/Run.hs @@ -29,8 +29,7 @@ module Cardano.CLI.EraBased.Transaction.Run where import Cardano.Api hiding - ( executeLocalStateQueryExpr - , mkTxCertificates + ( mkTxCertificates , txId , validateTxIns , validateTxInsCollateral @@ -65,7 +64,7 @@ import Cardano.CLI.EraBased.Transaction.Internal.HashCheck , checkVotingProcedureHashes ) import Cardano.CLI.Json.Encode qualified as Json -import Cardano.CLI.LocalStateQuery (executeLocalStateQueryExprWithNetworkIdCheck) +import Cardano.CLI.LocalStateQuery (checkNodeNetworkId) import Cardano.CLI.Orphan () import Cardano.CLI.Read import Cardano.CLI.Type.Common @@ -161,6 +160,8 @@ runTransactionBuildCmd , isCborOutCanonical , buildOutputOptions } = do + checkNodeNetworkId nodeConnInfo + let eon = convert currentEra era' = toCardanoEra eon @@ -240,7 +241,7 @@ runTransactionBuildCmd (balances, _) <- fromEitherIOCli - ( executeLocalStateQueryExprWithNetworkIdCheck + ( executeLocalStateQueryExpr nodeConnInfo Consensus.VolatileTip (queryStakeAddresses eon allAddrHashes networkId) @@ -274,13 +275,12 @@ runTransactionBuildCmd allTxInputs = inputsThatRequireWitnessing ++ allReferenceInputs ++ filteredTxinsc AnyCardanoEra nodeEra <- - fromEitherIOCli - (executeLocalStateQueryExprWithNetworkIdCheck nodeConnInfo Consensus.VolatileTip queryCurrentEra) + fromEitherIOCli (executeLocalStateQueryExpr nodeConnInfo Consensus.VolatileTip queryCurrentEra) & fromEitherCIOCli (txEraUtxo, _, eraHistory, systemStart, _, _, _, featuredCurrentTreasuryValueM) <- fromEitherIOCli - ( executeLocalStateQueryExprWithNetworkIdCheck + ( executeLocalStateQueryExpr nodeConnInfo Consensus.VolatileTip (queryStateForBalancedTx nodeEra allTxInputs []) @@ -1054,8 +1054,7 @@ runTxBuild } AnyCardanoEra nodeEra <- - lift - (executeLocalStateQueryExprWithNetworkIdCheck localNodeConnInfo Consensus.VolatileTip queryCurrentEra) + lift (executeLocalStateQueryExpr localNodeConnInfo Consensus.VolatileTip queryCurrentEra) & onLeft (left . TxCmdQueryConvenienceError . AcqFailure) & onLeft (left . TxCmdQueryConvenienceError . QceUnsupportedNtcVersion) @@ -1066,7 +1065,7 @@ runTxBuild let certsToQuery = obtainCommonConstraints (Exp.useEra @era) (fst <$> certsAndMaybeScriptWits) (txEraUtxo, pparams, eraHistory, systemStart, stakePools, stakeDelegDeposits, drepDelegDeposits, _) <- lift - ( executeLocalStateQueryExprWithNetworkIdCheck localNodeConnInfo Consensus.VolatileTip $ + ( executeLocalStateQueryExpr localNodeConnInfo Consensus.VolatileTip $ queryStateForBalancedTx nodeEra allTxInputs certsToQuery ) & onLeft (left . TxCmdQueryConvenienceError . AcqFailure) @@ -1508,9 +1507,10 @@ runTransactionCalculatePlutusScriptCostCmd (AnyCardanoEra nodeEra, systemStart, eraHistory, txEraUtxo, pparams) <- case nodeContextInfoSource of - NodeConnectionInfo nodeConnInfo -> + NodeConnectionInfo nodeConnInfo -> do + checkNodeNetworkId nodeConnInfo lift - ( executeLocalStateQueryExprWithNetworkIdCheck nodeConnInfo Consensus.VolatileTip $ do + ( executeLocalStateQueryExpr nodeConnInfo Consensus.VolatileTip $ do eCurrentEra <- queryCurrentEra eSystemStart <- querySystemStart eEraHistory <- queryEraHistory diff --git a/cardano-cli/src/Cardano/CLI/LocalStateQuery.hs b/cardano-cli/src/Cardano/CLI/LocalStateQuery.hs index 93c60043d8..24f4ebe46e 100644 --- a/cardano-cli/src/Cardano/CLI/LocalStateQuery.hs +++ b/cardano-cli/src/Cardano/CLI/LocalStateQuery.hs @@ -1,7 +1,7 @@ -{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE TypeApplications #-} module Cardano.CLI.LocalStateQuery - ( executeLocalStateQueryExprWithNetworkIdCheck + ( checkNodeNetworkId ) where @@ -11,38 +11,37 @@ import Cardano.Api.Network qualified as Consensus import Cardano.CLI.Compatible.Exception (throwCliError) import Cardano.CLI.Type.Error.NodeNetworkIdMismatchError +import Control.Exception (IOException, try) import Control.Monad ((>=>)) import Control.Monad.Trans.Maybe (MaybeT (..)) import Data.Either.Extra (eitherToMaybe) --- | Like 'executeLocalStateQueryExpr', but before running the given expression --- it checks that the network id the CLI was given matches the network id in the --- node's genesis, and throws a 'NodeNetworkIdMismatchError' otherwise. +-- | Check that the network id the CLI was given matches the network id in the +-- node's genesis, and throw a 'NodeNetworkIdMismatchError' otherwise. This is +-- meant to be run once, before a command that talks to the node. -- -- The node-to-client handshake only compares network magics, so a 'NetworkId' -- with the right magic but the wrong tag (for example -- @CARDANO_NODE_NETWORK_ID=764824073@ instead of @CARDANO_NODE_NETWORK_ID=mainnet@) -- connects successfully and would otherwise make the CLI render addresses for -- the wrong network. -executeLocalStateQueryExprWithNetworkIdCheck - :: LocalNodeConnectInfo - -> Consensus.Target ChainPoint - -> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a - -> IO (Either AcquiringFailure a) -executeLocalStateQueryExprWithNetworkIdCheck connectInfo target f = - executeLocalStateQueryExpr connectInfo target $ do - checkNodeNetworkId (localNodeNetworkId connectInfo) - f - -checkNodeNetworkId - :: NetworkId - -> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO () -checkNodeNetworkId cliNetId = - queryNodeNetworkId >>= \case - Just nodeNetId +-- +-- When there is no evidence of a mismatch (the node cannot be reached, it is +-- still in the Byron era, or it does not support the necessary queries) the +-- check passes, and connection problems are left to be reported by the command +-- itself. +checkNodeNetworkId :: MonadIO m => LocalNodeConnectInfo -> m () +checkNodeNetworkId connectInfo = do + result <- + liftIO . try @IOException $ + executeLocalStateQueryExpr connectInfo Consensus.VolatileTip queryNodeNetworkId + case result of + Right (Right (Just nodeNetId)) | nodeNetId /= cliNetId -> throwCliError $ NodeNetworkIdMismatchError cliNetId nodeNetId _ -> pure () + where + cliNetId = localNodeNetworkId connectInfo -- | The network id from the node's genesis, or 'Nothing' when it cannot be -- obtained (the node is still in the Byron era, or it does not support the