New --all-pools flag for query stake-snapshots command

Author: newhoggy

cardano-api/src/Cardano/Api/Orphans.hs

@@ -689,8 +689,6 @@ instance Crypto.Crypto crypto => ToJSON (VMap VB VP (Shelley.Credential 'Shelley
   toJSON = toJSON . fmap fromCompact . VMap.toMap
   toEncoding = toEncoding . fmap fromCompact . VMap.toMap
 
------
-
 instance Crypto.Crypto crypto => ToJSON (Consensus.StakeSnapshots crypto) where
   toJSON = object . stakeSnapshotsToPair
   toEncoding = pairs . mconcat . stakeSnapshotsToPair

cardano-cli/src/Cardano/CLI/Shelley/Commands.hs

@@ -361,7 +361,10 @@ data QueryCmd =
   | QueryUTxO' AnyConsensusModeParams QueryUTxOFilter NetworkId (Maybe OutputFile)
   | QueryDebugLedgerState' AnyConsensusModeParams NetworkId (Maybe OutputFile)
   | QueryProtocolState' AnyConsensusModeParams NetworkId (Maybe OutputFile)
-  | QueryStakeSnapshot' AnyConsensusModeParams NetworkId [Hash StakePoolKey]
+  | QueryStakeSnapshot'
+      AnyConsensusModeParams
+      NetworkId
+      (AllOrOnly [Hash StakePoolKey])
   | QueryKesPeriodInfo
       AnyConsensusModeParams
       NetworkId

cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs

@@ -990,11 +990,21 @@ pQueryCmd =
                             <*> pNetworkId
                             <*> pMaybeOutputFile
 
+    pAllPoolsOrOnly :: Parser (AllOrOnly [Hash StakePoolKey])
+    pAllPoolsOrOnly = pAll <|> pOnly
+      where pAll :: Parser (AllOrOnly [Hash StakePoolKey])
+            pAll = Opt.flag' All
+              (  Opt.long "all-pools"
+              <> Opt.help "Query for all pools"
+              )
+            pOnly :: Parser (AllOrOnly [Hash StakePoolKey])
+            pOnly = Only <$> many pStakePoolVerificationKeyHash
+
     pQueryStakeSnapshot :: Parser QueryCmd
     pQueryStakeSnapshot = QueryStakeSnapshot'
       <$> pConsensusModeParams
       <*> pNetworkId
-      <*> many pStakePoolVerificationKeyHash
+      <*> pAllPoolsOrOnly
 
     pQueryPoolState :: Parser QueryCmd
     pQueryPoolState = QueryPoolState'
@@ -2572,10 +2582,12 @@ pStakePoolVerificationKeyHash :: Parser (Hash StakePoolKey)
 pStakePoolVerificationKeyHash =
     Opt.option
       (pBech32StakePoolId <|> pHexStakePoolId)
-        (  Opt.long "stake-pool-id"
-        <> Opt.metavar "STAKE-POOL-ID"
-        <> Opt.help "Stake pool ID/verification key hash (either \
-                    \Bech32-encoded or hex-encoded)."
+        (   Opt.long "stake-pool-id"
+        <>  Opt.metavar "STAKE_POOL_ID"
+        <>  Opt.help
+            (   "Stake pool ID/verification key hash (either Bech32-encoded or hex-encoded).  "
+            <>  "Zero or more occurences of this option is allowed."
+            )
         )
   where
     pHexStakePoolId :: ReadM (Hash StakePoolKey)

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

@@ -25,7 +25,7 @@ module Cardano.CLI.Shelley.Run.Query
   , executeQuery
   ) where
 
-import           Cardano.Prelude
+import           Cardano.Prelude hiding (All)
 import           Prelude (String, id)
 
 import           Cardano.Api
@@ -186,8 +186,8 @@ runQueryCmd cmd =
       runQueryStakeAddressInfo consensusModeParams addr network mOutFile
     QueryDebugLedgerState' consensusModeParams network mOutFile ->
       runQueryLedgerState consensusModeParams network mOutFile
-    QueryStakeSnapshot' consensusModeParams network mPoolIds ->
-      runQueryStakeSnapshot consensusModeParams network mPoolIds
+    QueryStakeSnapshot' consensusModeParams network allOrOnlyPoolIds ->
+      runQueryStakeSnapshot consensusModeParams network allOrOnlyPoolIds
     QueryProtocolState' consensusModeParams network mOutFile ->
       runQueryProtocolState consensusModeParams network mOutFile
     QueryUTxO' consensusModeParams qFilter networkId mOutFile ->
@@ -670,9 +670,9 @@ runQueryTxMempool (AnyConsensusModeParams cModeParams) network query mOutFile =
 runQueryStakeSnapshot
   :: AnyConsensusModeParams
   -> NetworkId
-  -> [Hash StakePoolKey]
+  -> AllOrOnly [Hash StakePoolKey]
   -> ExceptT ShelleyQueryCmdError IO ()
-runQueryStakeSnapshot (AnyConsensusModeParams cModeParams) network mPoolIds = do
+runQueryStakeSnapshot (AnyConsensusModeParams cModeParams) network allOrOnlyPoolIds = do
   SocketPath sockPath <- firstExceptT ShelleyQueryCmdEnvVarSocketErr $ newExceptT readEnvSocketPath
   let localNodeConnInfo = LocalNodeConnectInfo cModeParams network sockPath
 
@@ -686,9 +686,12 @@ runQueryStakeSnapshot (AnyConsensusModeParams cModeParams) network mPoolIds = do
   eInMode <- toEraInMode era cMode
     & hoistMaybe (ShelleyQueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE)
 
-  let qInMode = QueryInEra eInMode . QueryInShelleyBasedEra sbe $ QueryStakeSnapshot $ case mPoolIds of
-        [] -> Nothing
-        _  -> Just $ Set.fromList mPoolIds
+  let qInMode = QueryInEra eInMode . QueryInShelleyBasedEra sbe $ QueryStakeSnapshot $ case allOrOnlyPoolIds of
+        All -> Nothing
+        Only poolIds -> Just $ Set.fromList poolIds
+  
+  liftIO $ IO.putStrLn $ "switch: " <> show allOrOnlyPoolIds
+  
   result <- executeQuery era cModeParams localNodeConnInfo qInMode
   obtainLedgerEraClassConstraints sbe writeStakeSnapshots result
 

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

@@ -38,6 +38,7 @@ module Cardano.CLI.Types
   , VerificationKeyFile (..)
   , Params (..)
   , RequiredSigner (..)
+  , AllOrOnly(..)
   ) where
 
 import           Cardano.Prelude hiding (Word64)
@@ -181,6 +182,8 @@ data OutputFormat
   | OutputFormatBech32
   deriving (Eq, Show)
 
+data AllOrOnly a = All | Only a deriving (Eq, Show)
+
 -- | This data structure is used to allow nicely formatted output in the query pool-params command.
 -- params are the current pool parameter settings, futureparams are new parameters, retiringEpoch is the
 -- epoch that has been set for pool retirement.  Any of these may be Nothing.