From f2d3a10f8b181f26b2143e4df014582b4fd44b66 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Cl=C3=A9ment=20Hurlin?= <clement.hurlin@moduscreate.com>
Date: Fri, 22 Nov 2024 16:14:00 +0100
Subject: [PATCH] Implement "query proposals"

---
 .../Cardano/CLI/EraBased/Commands/Query.hs    | 16 +++++++++++
 .../Cardano/CLI/EraBased/Options/Common.hs    | 27 +++++++++++++++++++
 .../src/Cardano/CLI/EraBased/Options/Query.hs | 23 ++++++++++++++++
 .../src/Cardano/CLI/EraBased/Run/Query.hs     | 26 ++++++++++++++++++
 4 files changed, 92 insertions(+)

diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Query.hs b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Query.hs
index 25e246fff1..dbb8969015 100644
--- a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Query.hs
+++ b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Query.hs
@@ -11,6 +11,7 @@ module Cardano.CLI.EraBased.Commands.Query
   , QueryProtocolParametersCmdArgs (..)
   , QueryTipCmdArgs (..)
   , QueryStakePoolsCmdArgs (..)
+  , QueryProposalsCmdArgs (..)
   , QueryStakeDistributionCmdArgs (..)
   , QueryStakeAddressInfoCmdArgs (..)
   , QueryUTxOCmdArgs (..)
@@ -32,6 +33,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 (..))
 
@@ -66,6 +68,7 @@ data QueryCmds era
   | QuerySPOStakeDistributionCmd !(QuerySPOStakeDistributionCmdArgs era)
   | QueryCommitteeMembersStateCmd !(QueryCommitteeMembersStateCmdArgs era)
   | QueryTreasuryValueCmd !(QueryTreasuryValueCmdArgs era)
+  | QueryProposalsCmd !(QueryProposalsCmdArgs era)
   deriving (Generic, Show)
 
 -- | Fields that are common to most queries
@@ -204,6 +207,17 @@ data QueryDRepStateCmdArgs era = QueryDRepStateCmdArgs
   }
   deriving Show
 
+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)
   , commons :: !QueryCommons
@@ -269,6 +283,8 @@ renderQueryCmds = \case
     "query slot-number"
   QueryRefScriptSizeCmd{} ->
     "query ref-script-size"
+  QueryProposalsCmd{} ->
+    "query proposals"
   QueryConstitutionCmd{} ->
     "constitution"
   QueryGovStateCmd{} ->
diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs
index 629c70d67b..20f6dad583 100644
--- a/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs
+++ b/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) $
diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Query.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Query.hs
index d2aee2378f..b322b17e08 100644
--- a/cardano-cli/src/Cardano/CLI/EraBased/Options/Query.hs
+++ b/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)
@@ -520,6 +521,28 @@ pQueryDRepStakeDistributionCmd era envCli = do
       <*> pAllOrOnlyDRepHashSource
       <*> pMaybeOutputFile
 
+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
diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Query.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Query.hs
index 8e8c16d471..c88f546df0 100644
--- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Query.hs
+++ b/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
   :: ()
@@ -1802,6 +1804,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