From d1a63a154e1b7232a631c84903c44c16160bb606 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Tue, 29 Oct 2024 14:27:29 -0400 Subject: [PATCH] Restore stable query cmds --- cardano-cli/src/Cardano/CLI/Commands.hs | 3 + .../src/Cardano/CLI/EraBased/Options/Query.hs | 130 ++++++++++++++++++ cardano-cli/src/Cardano/CLI/Options.hs | 10 ++ cardano-cli/src/Cardano/CLI/Run.hs | 7 + 4 files changed, 150 insertions(+) diff --git a/cardano-cli/src/Cardano/CLI/Commands.hs b/cardano-cli/src/Cardano/CLI/Commands.hs index 2cf9a9a54..a28ec9422 100644 --- a/cardano-cli/src/Cardano/CLI/Commands.hs +++ b/cardano-cli/src/Cardano/CLI/Commands.hs @@ -14,6 +14,7 @@ import Cardano.CLI.Commands.Node import Cardano.CLI.Commands.Ping (PingCmd (..)) import Cardano.CLI.Compatible.Commands import Cardano.CLI.EraBased.Commands +import Cardano.CLI.EraBased.Commands.Query import Cardano.CLI.Legacy.Commands import Options.Applicative.Types (ParserInfo (..), ParserPrefs (..)) @@ -32,6 +33,8 @@ data ClientCommand KeyCommands KeyCmds | -- | Era agnostic node commands NodeCommands NodeCmds + | -- | Query commands + forall era. QueryCommands (QueryCmds era) | -- | Legacy shelley-based Commands LegacyCmds LegacyCmds | CliPingCommand PingCmd diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Query.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Query.hs index e815a95b1..9f0185b91 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Options/Query.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Options/Query.hs @@ -5,6 +5,7 @@ module Cardano.CLI.EraBased.Options.Query ( pQueryCmds + , pQueryCmdsTopLevel ) where @@ -27,6 +28,135 @@ import qualified Options.Applicative as Opt {- HLINT ignore "Use <$>" -} {- HLINT ignore "Move brackets to avoid $" -} +pQueryCmdsTopLevel :: EnvCli -> Parser (QueryCmds ConwayEra) +pQueryCmdsTopLevel envCli = + asum + [ pProtocolParams envCli + , pTip envCli + , pStakePools envCli + , pStakeDistribution envCli + , pStakeAddressInfo envCli + , pUTxO envCli + , pLedgerState envCli + , pProtocolState envCli + , pStakeSnapshot envCli + , pPoolParams envCli + , pLeadershipSchedule envCli + , pKesPeriodInfo envCli + , pPoolState envCli + , pTxMempool envCli + , pSlotNumber envCli + ] + +pProtocolParams :: EnvCli -> Parser (QueryCmds era) +pProtocolParams envCli = + subParser "protocol-parameters" $ + Opt.info (pQueryProtocolParametersCmd envCli) $ + Opt.progDesc "Get the node's current protocol parameters" + +pTip :: EnvCli -> Parser (QueryCmds ConwayEra) +pTip envCli = + subParser "tip" $ + Opt.info (pQueryTipCmd ShelleyBasedEraConway envCli) $ + Opt.progDesc "Get the node's current tip (slot no, hash, block no)" + +pStakePools :: EnvCli -> Parser (QueryCmds ConwayEra) +pStakePools envCli = + subParser "stake-pools" $ + Opt.info (pQueryStakePoolsCmd ShelleyBasedEraConway envCli) $ + Opt.progDesc "Get the node's current set of stake pool ids" + +pStakeDistribution :: EnvCli -> Parser (QueryCmds ConwayEra) +pStakeDistribution envCli = + subParser "stake-distribution" $ + Opt.info (pQueryStakeDistributionCmd ShelleyBasedEraConway envCli) $ + Opt.progDesc "Get the node's current aggregated stake distribution" + +pStakeAddressInfo :: EnvCli -> Parser (QueryCmds ConwayEra) +pStakeAddressInfo envCli = + subParser "stake-address-info" $ + Opt.info (pQueryStakeAddressInfoCmd ShelleyBasedEraConway envCli) $ + Opt.progDesc $ + mconcat + [ "Get the current delegations and reward accounts filtered by stake address." + ] + +pUTxO :: EnvCli -> Parser (QueryCmds ConwayEra) +pUTxO envCli = + subParser "utxo" $ + Opt.info (pQueryUTxOCmd ShelleyBasedEraConway envCli) $ + Opt.progDesc $ + mconcat + [ "Get a portion of the current UTxO: by tx in, by address or the whole." + ] + +pLedgerState :: EnvCli -> Parser (QueryCmds ConwayEra) +pLedgerState envCli = + subParser "ledger-state" $ + Opt.info (pQueryLedgerStateCmd ShelleyBasedEraConway envCli) $ + Opt.progDesc $ + mconcat + [ "Dump the current ledger state of the node (Ledger.NewEpochState -- advanced command)" + ] + +pProtocolState :: EnvCli -> Parser (QueryCmds ConwayEra) +pProtocolState envCli = + subParser "protocol-state" $ + Opt.info (pQueryProtocolStateCmd ShelleyBasedEraConway envCli) $ + Opt.progDesc $ + mconcat + [ "Dump the current protocol state of the node (Ledger.ChainDepState -- advanced command)" + ] + +pStakeSnapshot :: EnvCli -> Parser (QueryCmds ConwayEra) +pStakeSnapshot envCli = + subParser "stake-snapshot" $ + Opt.info (pQueryStakeSnapshotCmd ShelleyBasedEraConway envCli) $ + Opt.progDesc $ + mconcat + [ "Obtain the three stake snapshots for a pool, plus the total active stake (advanced command)" + ] + +pPoolParams :: EnvCli -> Parser (QueryCmds ConwayEra) +pPoolParams envCli = + hiddenSubParser "pool-params" $ + Opt.info (pQueryPoolStateCmd ShelleyBasedEraConway envCli) $ + Opt.progDesc $ + mconcat + [ "DEPRECATED. Use query pool-state instead. Dump the pool parameters " + , "(Ledger.NewEpochState.esLState._delegationState._pState._pParams -- advanced command)" + ] + +pLeadershipSchedule :: EnvCli -> Parser (QueryCmds ConwayEra) +pLeadershipSchedule envCli = + subParser "leadership-schedule" $ + Opt.info (pLeadershipScheduleCmd ShelleyBasedEraConway envCli) $ + Opt.progDesc "Get the slots the node is expected to mint a block in (advanced command)" + +pKesPeriodInfo :: EnvCli -> Parser (QueryCmds ConwayEra) +pKesPeriodInfo envCli = + subParser "kes-period-info" $ + Opt.info (pKesPeriodInfoCmd ShelleyBasedEraConway envCli) $ + Opt.progDesc "Get information about the current KES period and your node's operational certificate." + +pPoolState :: EnvCli -> Parser (QueryCmds ConwayEra) +pPoolState envCli = + subParser "pool-state" $ + Opt.info (pQueryPoolStateCmd ShelleyBasedEraConway envCli) $ + Opt.progDesc "Dump the pool state" + +pTxMempool :: EnvCli -> Parser (QueryCmds era) +pTxMempool envCli = + subParser "tx-mempool" $ + Opt.info (pQueryTxMempoolCmd envCli) $ + Opt.progDesc "Local Mempool info" + +pSlotNumber :: EnvCli -> Parser (QueryCmds ConwayEra) +pSlotNumber envCli = + subParser "slot-number" $ + Opt.info (pQuerySlotNumberCmd ShelleyBasedEraConway envCli) $ + Opt.progDesc "Query slot number for UTC timestamp" + pQueryCmds :: () => ShelleyBasedEra era diff --git a/cardano-cli/src/Cardano/CLI/Options.hs b/cardano-cli/src/Cardano/CLI/Options.hs index 7b4364844..f57cdde3a 100644 --- a/cardano-cli/src/Cardano/CLI/Options.hs +++ b/cardano-cli/src/Cardano/CLI/Options.hs @@ -14,6 +14,7 @@ import Cardano.CLI.Compatible.Commands import Cardano.CLI.Environment (EnvCli) import Cardano.CLI.EraBased.Commands import Cardano.CLI.EraBased.Options.Common +import Cardano.CLI.EraBased.Options.Query (pQueryCmdsTopLevel) import Cardano.CLI.Legacy.Options (parseLegacyCmds) import Cardano.CLI.Options.Address import Cardano.CLI.Options.Debug @@ -60,6 +61,14 @@ addressCmdsTopLevel envCli = AddressCommand <$> pAddressCmds envCli nodeCmdsTopLevel :: Parser ClientCommand nodeCmdsTopLevel = NodeCommands <$> pNodeCmds +-- Queries actually depend on the node to client version which may coincide +-- with a hardfork but not necessarily. Therefore commands that are available +-- in the mainnet era will be exposed at the top level. Commands that are +-- introduced in an upcoming hardfork era will be gated behind the era argument. +-- Once the hardfork is completed we can move those gated commands to the top level. +queryCmdsTopLevel :: EnvCli -> Parser ClientCommand +queryCmdsTopLevel envCli = QueryCommands <$> pQueryCmdsTopLevel envCli + keyCmdsTopLevel :: Parser ClientCommand keyCmdsTopLevel = KeyCommands <$> pKeyCmds @@ -72,6 +81,7 @@ parseClientCommand envCli = [ addressCmdsTopLevel envCli , keyCmdsTopLevel , nodeCmdsTopLevel + , queryCmdsTopLevel envCli , parseLegacy envCli , parseByron envCli , parseAnyEra envCli diff --git a/cardano-cli/src/Cardano/CLI/Run.hs b/cardano-cli/src/Cardano/CLI/Run.hs index 5ba93976f..6269502e0 100644 --- a/cardano-cli/src/Cardano/CLI/Run.hs +++ b/cardano-cli/src/Cardano/CLI/Run.hs @@ -20,6 +20,7 @@ import Cardano.CLI.Compatible.Commands import Cardano.CLI.Compatible.Run import Cardano.CLI.EraBased.Commands import Cardano.CLI.EraBased.Run +import Cardano.CLI.EraBased.Run.Query import Cardano.CLI.Legacy.Commands import Cardano.CLI.Legacy.Run (runLegacyCmds) import Cardano.CLI.Render (customRenderHelp) @@ -35,6 +36,7 @@ import Cardano.CLI.Types.Errors.CmdError import Cardano.CLI.Types.Errors.HashCmdError import Cardano.CLI.Types.Errors.KeyCmdError import Cardano.CLI.Types.Errors.NodeCmdError +import Cardano.CLI.Types.Errors.QueryCmdError import Cardano.Git.Rev (gitRev) import Control.Monad (forM_) @@ -63,6 +65,7 @@ data ClientCommandErrors | HashCmdError HashCmdError | KeyCmdError KeyCmdError | NodeCmdError NodeCmdError + | QueryCmdError QueryCmdError | PingClientError PingClientCmdError | DebugCmdError DebugCmdError @@ -86,6 +89,8 @@ runClientCommand = \case firstExceptT KeyCmdError $ runKeyCmds cmds LegacyCmds cmds -> firstExceptT (CmdError (renderLegacyCommand cmds)) $ runLegacyCmds cmds + QueryCommands cmds -> + firstExceptT QueryCmdError $ runQueryCmds cmds CliPingCommand cmds -> firstExceptT PingClientError $ runPingCmd cmds CliDebugCmds cmds -> @@ -111,6 +116,8 @@ renderClientCommandError = \case renderNodeCmdError err KeyCmdError err -> renderKeyCmdError err + QueryCmdError err -> + renderQueryCmdError err PingClientError err -> renderPingClientCmdError err DebugCmdError err ->