Replace queryCommitteState with new queryCommitteeMembersState

and adapt to new filter options
IntersectMBO · Oct 24, 2023 · 408df38 · 408df38
1 parent 1f3c509
commit 408df38
Show file tree

Hide file tree

Showing 4 changed files with 67 additions and 13 deletions.
diff --git 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
@@ -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
@@ -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
@@ -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)