Implement "query proposals"

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

@@ -10,6 +10,7 @@ module Cardano.CLI.EraBased.Commands.Query
   , QueryProtocolParametersCmdArgs (..)
   , QueryTipCmdArgs (..)
   , QueryStakePoolsCmdArgs (..)
+  , QueryProposalsCmdArgs (..)
   , QueryStakeDistributionCmdArgs (..)
   , QueryStakeAddressInfoCmdArgs (..)
   , QueryUTxOCmdArgs (..)
@@ -31,6 +32,7 @@ module Cardano.CLI.EraBased.Commands.Query
   )
 where
 
+import qualified Cardano.Api.Ledger as L
 import qualified Cardano.Api.Network as Consensus
 import           Cardano.Api.Shelley hiding (QueryInShelleyBasedEra (..))
 
@@ -65,6 +67,7 @@ data QueryCmds era
   | QuerySPOStakeDistributionCmd !(QuerySPOStakeDistributionCmdArgs era)
   | QueryCommitteeMembersStateCmd !(QueryCommitteeMembersStateCmdArgs era)
   | QueryTreasuryValueCmd !(QueryTreasuryValueCmdArgs era)
+  | QueryProposalsCmd !(QueryProposalsCmdArgs era)
   deriving (Generic, Show)
 
 data QueryLeadershipScheduleCmdArgs = QueryLeadershipScheduleCmdArgs
@@ -239,6 +242,19 @@ data QueryDRepStateCmdArgs era = QueryDRepStateCmdArgs
   }
   deriving Show
 
+-- TODO @smelc Add a record sharing the common fields of all these requests
+
+data QueryProposalsCmdArgs era = QueryProposalsCmdArgs
+  { eon :: !(ConwayEraOnwards era)
+  , nodeSocketPath :: !SocketPath
+  , consensusModeParams :: !ConsensusModeParams
+  , networkId :: !NetworkId
+  , govActionIds :: !(AllOrOnly (L.GovActionId L.StandardCrypto))
+  , target :: !(Consensus.Target ChainPoint)
+  , mOutFile :: !(Maybe (File () Out))
+  }
+  deriving Show
+
 data QueryDRepStakeDistributionCmdArgs era = QueryDRepStakeDistributionCmdArgs
   { eon :: !(ConwayEraOnwards era)
   , nodeSocketPath :: !SocketPath
@@ -316,6 +332,8 @@ renderQueryCmds = \case
     "query slot-number"
   QueryRefScriptSizeCmd{} ->
     "query ref-script-size"
+  QueryProposalsCmd{} ->
+    "query proposals"
   QueryConstitutionCmd{} ->
     "constitution"
   QueryGovStateCmd{} ->

cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs

@@ -3483,6 +3483,33 @@ pAllOrOnlySPOHashSource = pAll <|> pOnly
         , Opt.help "Query for all DReps."
         ]
 
+pAllOrOnlyGovActionIds
+  :: ()
+  => ConwayEraOnwards era
+  -> Parser (AllOrOnly (L.GovActionId (L.StandardCrypto)))
+pAllOrOnlyGovActionIds era = pAll <|> pOnly
+ where
+  pOnly = Only <$> (pGovActionIds era)
+  pAll =
+    Opt.flag' All $
+      mconcat
+        [ Opt.long "all-proposals"
+        , Opt.help "Query for all governance proposals."
+        ]
+
+pGovActionIds
+  :: forall era
+   . ()
+  => ConwayEraOnwards era
+  -> Parser [L.GovActionId (L.StandardCrypto)]
+pGovActionIds era = conwayEraOnwardsConstraints era (some pLedgerGovernanceAction)
+ where
+  pLedgerGovernanceAction :: Parser (L.GovActionId L.StandardCrypto)
+  pLedgerGovernanceAction = uncurry L.GovActionId <$> pairParser
+
+  pairParser :: Parser (L.TxId L.StandardCrypto, L.GovActionIx)
+  pairParser = (bimap toShelleyTxId L.GovActionIx) <$> pGovernanceActionId
+
 pDRepVerificationKeyHash :: Parser (Hash DRepKey)
 pDRepVerificationKeyHash =
   Opt.option (rBech32KeyHash AsDRepKey <|> rHexHash AsDRepKey Nothing) $

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

@@ -268,6 +268,7 @@ pQueryCmds era envCli =
     , pQuerySPOStakeDistributionCmd era envCli
     , pQueryGetCommitteeStateCmd era envCli
     , pQueryTreasuryValueCmd era envCli
+    , pQueryProposalsCmd era envCli
     ]
 
 pQueryProtocolParametersCmd :: EnvCli -> Parser (QueryCmds era)
@@ -565,6 +566,28 @@ pQueryDRepStakeDistributionCmd era envCli = do
       <*> pTarget era
       <*> optional pOutputFile
 
+pQueryProposalsCmd
+  :: ()
+  => ShelleyBasedEra era
+  -> EnvCli
+  -> Maybe (Parser (QueryCmds era))
+pQueryProposalsCmd era envCli = do
+  w <- forShelleyBasedEraMaybeEon era
+  pure $
+    subParser "proposals" $
+      Opt.info (QueryProposalsCmd <$> pQueryProposalsCmdArgs w) $
+        Opt.progDesc "Get the governance proposals."
+ where
+  pQueryProposalsCmdArgs :: ConwayEraOnwards era -> Parser (QueryProposalsCmdArgs era)
+  pQueryProposalsCmdArgs w =
+    QueryProposalsCmdArgs w
+      <$> pSocketPath envCli
+      <*> pConsensusModeParams
+      <*> pNetworkId envCli
+      <*> (pAllOrOnlyGovActionIds w)
+      <*> pTarget era
+      <*> optional pOutputFile
+
 pQuerySPOStakeDistributionCmd
   :: ()
   => ShelleyBasedEra era

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

@@ -75,6 +75,7 @@ import qualified Data.List as List
 import           Data.Map.Strict (Map)
 import qualified Data.Map.Strict as Map
 import           Data.Proxy (Proxy (..))
+import qualified Data.Sequence as Seq
 import           Data.Set (Set)
 import qualified Data.Set as Set
 import           Data.String
@@ -117,6 +118,7 @@ runQueryCmds = \case
   Cmd.QuerySPOStakeDistributionCmd args -> runQuerySPOStakeDistribution args
   Cmd.QueryCommitteeMembersStateCmd args -> runQueryCommitteeMembersState args
   Cmd.QueryTreasuryValueCmd args -> runQueryTreasuryValue args
+  Cmd.QueryProposalsCmd args -> runQueryProposals args
 
 runQueryProtocolParametersCmd
   :: ()
@@ -1738,6 +1740,30 @@ runQueryTreasuryValue
           writeLazyByteStringFile outFile $
             LBS.pack treasuryString
 
+runQueryProposals
+  :: Cmd.QueryProposalsCmdArgs era
+  -> ExceptT QueryCmdError IO ()
+runQueryProposals
+  Cmd.QueryProposalsCmdArgs
+    { Cmd.eon
+    , Cmd.nodeSocketPath
+    , Cmd.consensusModeParams
+    , Cmd.networkId
+    , Cmd.govActionIds = govActionIds'
+    , Cmd.target
+    , Cmd.mOutFile
+    } = conwayEraOnwardsConstraints eon $ do
+    let localNodeConnInfo = LocalNodeConnectInfo consensusModeParams networkId nodeSocketPath
+
+    let govActionIds = case govActionIds' of
+          All -> []
+          Only l -> l
+
+    govActionStates :: (Seq.Seq (L.GovActionState (ShelleyLedgerEra era))) <-
+      runQuery localNodeConnInfo target $ queryProposals eon $ Set.fromList govActionIds
+
+    writeOutput mOutFile govActionStates
+
 runQuery
   :: LocalNodeConnectInfo
   -> Consensus.Target ChainPoint