Guard against network id mismatches

.changes/20260804_011228_cardano-cli_pablo.lamela_check_network_id.yml

@@ -0,0 +1,6 @@
+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

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,13 +212,15 @@ 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
     Cardano.CLI.Type.Error.RegistrationError
     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
@@ -265,6 +268,7 @@ library
     deepseq,
     directory,
     exceptions,
+    extra,
     filepath,
     formatting,
     generic-lens,

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

cardano-cli/src/Cardano/CLI/EraBased/Query/Run.hs

@@ -60,11 +60,13 @@ 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 (checkNodeNetworkId)
 import Cardano.CLI.Read
   ( getHashFromStakePoolKeyHashSource
   )
 import Cardano.CLI.Type.Common
 import Cardano.CLI.Type.Error.QueryCmdError
+import Cardano.CLI.Type.Error.StakeAddressNetworkIdMismatchError
 import Cardano.CLI.Type.Key
   ( readDRepCredential
   , readSPOCredential
@@ -107,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
   :: ()
@@ -1016,8 +1020,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 $ executeLocalStateQueryExpr nodeConnInfo target $ runExceptT $ do
         AnyCardanoEra cEra <- easyRunQueryCurrentEra
 

cardano-cli/src/Cardano/CLI/EraBased/Transaction/Run.hs

@@ -64,6 +64,7 @@ import Cardano.CLI.EraBased.Transaction.Internal.HashCheck
   , checkVotingProcedureHashes
   )
 import Cardano.CLI.Json.Encode qualified as Json
+import Cardano.CLI.LocalStateQuery (checkNodeNetworkId)
 import Cardano.CLI.Orphan ()
 import Cardano.CLI.Read
 import Cardano.CLI.Type.Common
@@ -159,6 +160,8 @@ runTransactionBuildCmd
     , isCborOutCanonical
     , buildOutputOptions
     } = do
+    checkNodeNetworkId nodeConnInfo
+
     let eon = convert currentEra
         era' = toCardanoEra eon
 
@@ -1504,7 +1507,8 @@ runTransactionCalculatePlutusScriptCostCmd
 
     (AnyCardanoEra nodeEra, systemStart, eraHistory, txEraUtxo, pparams) <-
       case nodeContextInfoSource of
-        NodeConnectionInfo nodeConnInfo ->
+        NodeConnectionInfo nodeConnInfo -> do
+          checkNodeNetworkId nodeConnInfo
           lift
             ( executeLocalStateQueryExpr nodeConnInfo Consensus.VolatileTip $ do
                 eCurrentEra <- queryCurrentEra

cardano-cli/src/Cardano/CLI/LocalStateQuery.hs

@@ -0,0 +1,55 @@
+{-# LANGUAGE TypeApplications #-}
+
+module Cardano.CLI.LocalStateQuery
+  ( checkNodeNetworkId
+  )
+where
+
+import Cardano.Api
+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)
+
+-- | 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.
+--
+-- 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
+-- necessary queries): the absence of an answer is not treated as a mismatch.
+queryNodeNetworkId
+  :: LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO (Maybe NetworkId)
+queryNodeNetworkId = runMaybeT $ do
+  AnyCardanoEra era <- MaybeT $ eitherToMaybe <$> queryCurrentEra
+  sbe <- MaybeT . pure $ forEraMaybeEon era
+  genesisParameters <- MaybeT $ (eitherToMaybe >=> eitherToMaybe) <$> queryGenesisParameters sbe
+  pure $ protocolParamNetworkId genesisParameters

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

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