Merge branch 'main' into felix-lipski/remove-cardano-ledger-imports

IntersectMBO · Feb 13, 2024 · b2bdfe1 · b2bdfe1
2 parents 9c4ea75 + 61cf8da
commit b2bdfe1
Show file tree

Hide file tree

Showing 5 changed files with 51 additions and 9 deletions.
diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Query.hs b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Query.hs
@@ -25,6 +25,7 @@ module Cardano.CLI.EraBased.Commands.Query
   , QueryDRepStateCmdArgs(..)
   , QueryDRepStakeDistributionCmdArgs(..)
   , renderQueryCmds
+  , IncludeStake (..)
   ) where
 
 import           Cardano.Api.Shelley hiding (QueryInShelleyBasedEra (..))
@@ -203,10 +204,16 @@ data QueryDRepStateCmdArgs era = QueryDRepStateCmdArgs
   , consensusModeParams :: !ConsensusModeParams
   , networkId           :: !NetworkId
   , drepKeys            :: !(AllOrOnly (VerificationKeyOrHashOrFile DRepKey))
+  , includeStake        :: !IncludeStake
   , target              :: !(Consensus.Target ChainPoint)
   , mOutFile            :: !(Maybe (File () Out))
   } deriving Show
 
+-- | Whether to include the stake, as queried by drep-stake-distribution, in
+-- the output of drep-state. This is (computationally) expensive, but sometimes
+-- convenient.
+data IncludeStake = WithStake | NoStake deriving Show
+
 data QueryDRepStakeDistributionCmdArgs era = QueryDRepStakeDistributionCmdArgs
   { eon                 :: !(ConwayEraOnwards era)
   , nodeSocketPath      :: !SocketPath

diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Query.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Query.hs
@@ -335,6 +335,16 @@ pQueryDRepStateCmd era envCli = do
         <*> pConsensusModeParams
         <*> pNetworkId envCli
         <*> pAllOrOnlyDRepVerificationKeyOrHashOrFile
+        <*> Opt.flag WithStake NoStake (mconcat
+              [ Opt.long "include-stake"
+              , Opt.help $ mconcat
+                 [ "Also return the stake associated with each DRep. "
+                 , "The result is the same as with \"drep-stake-distribution\"; "
+                 , "this is a convenience option to obtain all information concerning a DRep at once. "
+                 , "This is a potentially expensive query."
+                 ]
+              ]
+            )
         <*> pTarget era
         <*> optional pOutputFile
 

diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Query.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Query.hs
@@ -8,6 +8,7 @@
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeOperators #-}
 
@@ -112,7 +113,8 @@ runQueryCmds = \case
   Cmd.QueryStakePoolsCmd            args -> runQueryStakePoolsCmd args
   Cmd.QueryStakeDistributionCmd     args -> runQueryStakeDistributionCmd args
   Cmd.QueryStakeAddressInfoCmd      args -> runQueryStakeAddressInfoCmd args
-  Cmd.QueryLedgerStateCmd           args -> runQueryLedgerStateCmd args
+  Cmd.Query
+  StateCmd           args -> runQueryLedgerStateCmd args
   Cmd.QueryStakeSnapshotCmd         args -> runQueryStakeSnapshotCmd args
   Cmd.QueryProtocolStateCmd         args -> runQueryProtocolStateCmd args
   Cmd.QueryUTxOCmd                  args -> runQueryUTxOCmd args
@@ -1424,6 +1426,7 @@ runQueryDRepState
       , Cmd.consensusModeParams
       , Cmd.networkId
       , Cmd.drepKeys = drepKeys'
+      , Cmd.includeStake
       , Cmd.target
       , Cmd.mOutFile
       } = conwayEraOnwardsConstraints eon $ do
@@ -1432,17 +1435,32 @@ runQueryDRepState
   let drepKeys = case drepKeys' of
                    All -> []
                    Only l -> l
-  drepCreds <- Set.fromList <$> mapM (firstExceptT QueryCmdDRepKeyError . getDRepCredentialFromVerKeyHashOrFile) drepKeys
+  drepCreds <- mapM (firstExceptT QueryCmdDRepKeyError . getDRepCredentialFromVerKeyHashOrFile) drepKeys
+
+  drepState <- runQuery localNodeConnInfo target $ queryDRepState eon $ Set.fromList drepCreds
+
+  drepStakeDistribution <-
+    case includeStake of
+      Cmd.WithStake -> runQuery localNodeConnInfo target $
+        queryDRepStakeDistribution eon (Set.fromList $ Ledger.DRepCredential <$> drepCreds)
+      Cmd.NoStake -> return mempty
 
-  drepState <- runQuery localNodeConnInfo target $ queryDRepState eon drepCreds
   writeOutput mOutFile $
-    second drepStateToJson <$> Map.assocs drepState
+    drepStateToJson drepStakeDistribution <$> Map.assocs drepState
   where
-    drepStateToJson ds = A.object
-      [ "expiry" .= (ds ^. L.drepExpiryL)
-      , "anchor" .= (ds ^. L.drepAnchorL)
-      , "deposit" .= (ds ^. L.drepDepositL)
-      ]
+    drepStateToJson stakeDistr (cred, ds) = (cred,) . A.object $
+      if Map.null stakeDistr
+      then
+        [ "expiry" .= (ds ^. L.drepExpiryL)
+        , "anchor" .= (ds ^. L.drepAnchorL)
+        , "deposit" .= (ds ^. L.drepDepositL)
+        ]
+      else
+        [ "expiry" .= (ds ^. L.drepExpiryL)
+        , "anchor" .= (ds ^. L.drepAnchorL)
+        , "deposit" .= (ds ^. L.drepDepositL)
+        , "stake" .= Map.lookup (L.DRepCredential cred) stakeDistr
+        ]
 
 runQueryDRepStakeDistribution
   :: Cmd.QueryDRepStakeDistributionCmdArgs era

diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help.cli
@@ -6743,6 +6743,7 @@ Usage: cardano-cli conway query drep-state --socket-path SOCKET_PATH
                                              | --drep-key-hash HASH
                                              )
                                              )
+                                             [--include-stake]
                                              [--volatile-tip | --immutable-tip]
                                              [--out-file FILE]
 

diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_query_drep-state.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_query_drep-state.cli
@@ -11,6 +11,7 @@ Usage: cardano-cli conway query drep-state --socket-path SOCKET_PATH
                                              | --drep-key-hash HASH
                                              )
                                              )
+                                             [--include-stake]
                                              [--volatile-tip | --immutable-tip]
                                              [--out-file FILE]
 
@@ -37,6 +38,11 @@ Available options:
                            Filepath of the DRep verification key.
   --drep-key-hash HASH     DRep verification key hash (either Bech32-encoded or
                            hex-encoded).
+  --include-stake          Also return the stake associated with each DRep. The
+                           result is the same as with "drep-stake-distribution";
+                           this is a convenience option to obtain all
+                           information concerning a DRep at once. This is a
+                           potentially expensive query.
   --volatile-tip           Use the volatile tip as a target. (This is the
                            default)
   --immutable-tip          Use the immutable tip as a target.