From 04bd8aa0d46aa67bbb7e67bc13fd1923f5c321bb Mon Sep 17 00:00:00 2001 From: teodanciu Date: Tue, 24 Oct 2023 13:53:54 +0100 Subject: [PATCH] Replace queryCommitteState with new queryCommitteeMembersState and adapt to new filter options --- .../Cardano/CLI/EraBased/Commands/Query.hs | 16 ++++++++-- .../src/Cardano/CLI/EraBased/Options/Query.hs | 28 ++++++++++++++++- .../src/Cardano/CLI/EraBased/Run/Query.hs | 30 ++++++++++++------- .../Cardano/CLI/Types/Errors/QueryCmdError.hs | 6 ++++ 4 files changed, 67 insertions(+), 13 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Query.hs b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Query.hs index 173c0c2fdf..27075b9ba4 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Query.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Query.hs @@ -5,6 +5,7 @@ module Cardano.CLI.EraBased.Commands.Query ( QueryCmds (..) + , QueryCommitteeMembersStateCmdArgs(..) , QueryLeadershipScheduleCmdArgs(..) , QueryProtocolParametersCmdArgs(..) , QueryConstitutionHashCmdArgs(..) @@ -55,7 +56,7 @@ data QueryCmds era | QueryGovStateCmd !(QueryNoArgCmdArgs era) | QueryDRepStateCmd !(QueryDRepStateCmdArgs era) | QueryDRepStakeDistributionCmd !(QueryDRepStakeDistributionCmdArgs era) - | QueryCommitteeStateCmd !(QueryNoArgCmdArgs era) + | QueryCommitteeMembersStateCmd !(QueryCommitteeMembersStateCmdArgs era) deriving (Generic, Show) data QueryLeadershipScheduleCmdArgs = QueryLeadershipScheduleCmdArgs @@ -199,6 +200,17 @@ data QueryDRepStakeDistributionCmdArgs era = QueryDRepStakeDistributionCmdArgs , mOutFile :: !(Maybe (File () Out)) } deriving Show +data QueryCommitteeMembersStateCmdArgs era = QueryCommitteeMembersStateCmdArgs + { eon :: !(ConwayEraOnwards era) + , nodeSocketPath :: !SocketPath + , consensusModeParams :: !AnyConsensusModeParams + , networkId :: !NetworkId + , committeeColdKeys :: ![VerificationKeyOrHashOrFile CommitteeColdKey] + , committeeHotKeys :: ![VerificationKeyOrHashOrFile CommitteeHotKey] + , memberStatuses :: ![MemberStatus] + , mOutFile :: !(Maybe (File () Out)) + } deriving Show + renderQueryCmds :: QueryCmds era -> Text renderQueryCmds = \case QueryLeadershipScheduleCmd {} -> @@ -239,7 +251,7 @@ renderQueryCmds = \case "drep-state" QueryDRepStakeDistributionCmd {} -> "drep-stake-distribution" - QueryCommitteeStateCmd {} -> + QueryCommitteeMembersStateCmd {} -> "committee-state" renderTxMempoolQuery :: TxMempoolQuery -> Text diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Query.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Query.hs index ea09c516f6..4bb9bd1da7 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Options/Query.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Options/Query.hs @@ -15,6 +15,7 @@ import Cardano.CLI.EraBased.Commands.Query import Cardano.CLI.EraBased.Options.Common import Cardano.CLI.Types.Common +import qualified Data.Text as Text (toLower, unpack) import Data.Foldable import Options.Applicative hiding (help, str) import qualified Options.Applicative as Opt @@ -351,8 +352,33 @@ pQueryGetCommitteeStateCmd era envCli = do w <- forEraMaybeEon era pure $ subParser "committee-state" - $ Opt.info (QueryCommitteeStateCmd <$> pQueryNoArgCmdArgs w envCli) + $ Opt.info (QueryCommitteeMembersStateCmd <$> pQueryCommitteeMembersStateArgs w) $ Opt.progDesc "Get the committee state" + where + pQueryCommitteeMembersStateArgs :: ConwayEraOnwards era -> Parser (QueryCommitteeMembersStateCmdArgs era) + pQueryCommitteeMembersStateArgs w = QueryCommitteeMembersStateCmdArgs w + <$> pSocketPath envCli + <*> pConsensusModeParams + <*> pNetworkId envCli + <*> many pCommitteeColdVerificationKeyOrHashOrFile + <*> many pCommitteeHotKeyOrHashOrFile + <*> many pMemberStatus + <*> optional pOutputFile + pMemberStatus :: Parser MemberStatus + pMemberStatus = + Opt.option readerMemberStatus $ mconcat + [ Opt.long "memberstatus" + , Opt.metavar "MEMBER_STATUS" + , Opt.help "Member status filter: active/expired/unrecognized" + ] + readerMemberStatus :: ReadM MemberStatus + readerMemberStatus = do + v <- Opt.str + case Text.toLower v of + "active" -> pure Active + "expired" -> pure Expired + "unrecognized" -> pure Unrecognized + _ -> fail ("Unrecognized status: " <> Text.unpack v) pQueryNoArgCmdArgs :: () => ConwayEraOnwards era diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Query.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Query.hs index cd8e309272..6a856c5cab 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Query.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Query.hs @@ -129,7 +129,7 @@ runQueryCmds = \case Cmd.QueryGovStateCmd args -> runQueryGovState args Cmd.QueryDRepStateCmd args -> runQueryDRepState args Cmd.QueryDRepStakeDistributionCmd args -> runQueryDRepStakeDistribution args - Cmd.QueryCommitteeStateCmd args -> runQueryCommitteeState args + Cmd.QueryCommitteeMembersStateCmd args -> runQueryCommitteeMembersState args runQueryConstitutionHashCmd :: () => Cmd.QueryConstitutionHashCmdArgs @@ -1540,29 +1540,39 @@ runQueryDRepStakeDistribution writeOutput mOutFile $ Map.assocs drepStakeDistribution -runQueryCommitteeState - :: Cmd.QueryNoArgCmdArgs era +runQueryCommitteeMembersState + :: Cmd.QueryCommitteeMembersStateCmdArgs era -> ExceptT QueryCmdError IO () -runQueryCommitteeState - Cmd.QueryNoArgCmdArgs +runQueryCommitteeMembersState + Cmd.QueryCommitteeMembersStateCmdArgs { Cmd.eon , Cmd.nodeSocketPath , Cmd.consensusModeParams = AnyConsensusModeParams cModeParams , Cmd.networkId , Cmd.mOutFile - } - = conwayEraOnwardsConstraints eon $ do + , Cmd.committeeColdKeys = coldCredKeys + , Cmd.committeeHotKeys = hotCredKeys + , Cmd.memberStatuses = memberStatuses + } = conwayEraOnwardsConstraints eon $ do let localNodeConnInfo = LocalNodeConnectInfo cModeParams networkId nodeSocketPath sbe = conwayEraOnwardsToShelleyBasedEra eon cEra = conwayEraOnwardsToCardanoEra eon cMode = consensusModeOnly cModeParams + let coldKeysFromVerKeyHashOrFile = + firstExceptT QueryCmdColdKeyError . getCommitteeColdCredentialFromVerKeyHashOrFile + coldKeys <- Set.fromList <$> mapM coldKeysFromVerKeyHashOrFile coldCredKeys + + let hotKeysFromVerKeyHashOrFile = + firstExceptT QueryCmdHotKeyError . getCommitteeHotCredentialFromVerKeyHashOrFile + hotKeys <- Set.fromList <$> mapM hotKeysFromVerKeyHashOrFile hotCredKeys + eraInMode <- toEraInMode cEra cMode & hoistMaybe (QueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) (AnyCardanoEra cEra)) - committeeState <- runQuery localNodeConnInfo $ queryCommitteeState eraInMode sbe - writeOutput mOutFile $ - Map.assocs $ committeeState ^. Ledger.csCommitteeCredsL + committeeState <- runQuery localNodeConnInfo $ + queryCommitteeMembersState eraInMode sbe coldKeys hotKeys (Set.fromList memberStatuses) + writeOutput mOutFile committeeState runQuery :: LocalNodeConnectInfo mode -> LocalStateQueryExpr diff --git a/cardano-cli/src/Cardano/CLI/Types/Errors/QueryCmdError.hs b/cardano-cli/src/Cardano/CLI/Types/Errors/QueryCmdError.hs index 82ddb5605d..6d82c0d49e 100644 --- a/cardano-cli/src/Cardano/CLI/Types/Errors/QueryCmdError.hs +++ b/cardano-cli/src/Cardano/CLI/Types/Errors/QueryCmdError.hs @@ -56,6 +56,8 @@ data QueryCmdError | QueryCmdUnsupportedNtcVersion !UnsupportedNtcVersionError | QueryCmdProtocolParameterConversionError !ProtocolParametersConversionError | QueryCmdDRepKeyError !(FileError InputDecodeError) + | QueryCmdColdKeyError !(FileError InputDecodeError) + | QueryCmdHotKeyError !(FileError InputDecodeError) deriving Show renderQueryCmdError :: QueryCmdError -> Text @@ -94,3 +96,7 @@ renderQueryCmdError = \case QueryCmdConvenienceError qce -> renderQueryConvenienceError qce QueryCmdDRepKeyError e -> "Error reading delegation representative key: " <> Text.pack (displayError e) + QueryCmdColdKeyError e -> + "Error reading cold key: " <> Text.pack (displayError e) + QueryCmdHotKeyError e -> + "Error reading cold key: " <> Text.pack (displayError e)