Add vote delegatee to 'stake-address-info' output

IntersectMBO · Nov 13, 2023 · f2037b5 · f2037b5
1 parent ed4a1ef
commit f2037b5
Showing 1 changed file with 15 additions and 4 deletions.
diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Query.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Query.hs
@@ -40,6 +40,7 @@ module Cardano.CLI.EraBased.Run.Query
 import           Cardano.Api hiding (QueryInShelleyBasedEra (..))
 import qualified Cardano.Api as Api
 import           Cardano.Api.Byron hiding (QueryInShelleyBasedEra (..))
+import qualified Cardano.Api.Ledger as L
 import qualified Cardano.Api.Ledger as Ledger
 import           Cardano.Api.Shelley hiding (QueryInShelleyBasedEra (..))
 
@@ -820,11 +821,16 @@ runQueryStakeAddressInfoCmd
           & onLeft (left . QueryCmdUnsupportedNtcVersion)
           & onLeft (left . QueryCmdLocalStateQueryError . EraMismatchError)
 
+        stakeVoteDelegatees <- lift (queryStakeVoteDelegatees sbe stakeAddr)
+          & onLeft (left . QueryCmdUnsupportedNtcVersion)
+          & onLeft (left . QueryCmdLocalStateQueryError . EraMismatchError)
+
         return $ do
           writeStakeAddressInfo
             mOutFile
             (DelegationsAndRewards (stakeRewardAccountBalances, stakePools))
             (Map.mapKeys (makeStakeAddress networkId) stakeDelegDeposits)
+            (Map.mapKeys (makeStakeAddress networkId) stakeVoteDelegatees)
     )
     & onLeft (left . QueryCmdAcquireFailure)
     & onLeft left
@@ -835,37 +841,42 @@ writeStakeAddressInfo
   :: Maybe (File () Out)
   -> DelegationsAndRewards
   -> Map StakeAddress Lovelace -- ^ deposits
+  -> Map StakeAddress (L.DRep L.StandardCrypto) -- ^ vote delegatees
   -> ExceptT QueryCmdError IO ()
 writeStakeAddressInfo
   mOutFile
   (DelegationsAndRewards (stakeAccountBalances, stakePools))
-  stakeDelegDeposits =
+  stakeDelegDeposits
+  voteDelegatees =
     firstExceptT QueryCmdWriteFileError . newExceptT
       $ writeLazyByteStringOutput mOutFile (encodePretty jsonInfo)
  where
   jsonInfo :: [Aeson.Value]
   jsonInfo =
     map
-      (\(addr, mBalance, mPoolId, mDeposit) ->
+      (\(addr, mBalance, mPoolId, mDRep, mDeposit) ->
         Aeson.object
         [ "address" .= addr
         , "delegation" .= mPoolId
+        , "voteDelegation" .= mDRep
         , "rewardAccountBalance" .= mBalance
         , "delegationDeposit" .= mDeposit
         ]
       )
       merged
 
-  merged :: [(StakeAddress, Maybe Lovelace, Maybe PoolId, Maybe Lovelace)]
+  merged :: [(StakeAddress, Maybe Lovelace, Maybe PoolId, Maybe (L.DRep L.StandardCrypto), Maybe Lovelace)]
   merged =
-    [ (addr, mBalance, mPoolId, mDeposit)
+    [ (addr, mBalance, mPoolId, mDRep, mDeposit)
     | addr <- Set.toList (Set.unions [ Map.keysSet stakeAccountBalances
                                      , Map.keysSet stakePools
                                      , Map.keysSet stakeDelegDeposits
+                                     , Map.keysSet voteDelegatees
                                      ])
     , let mBalance = Map.lookup addr stakeAccountBalances
           mPoolId  = Map.lookup addr stakePools
           mDeposit = Map.lookup addr stakeDelegDeposits
+          mDRep = Map.lookup addr voteDelegatees
     ]
 
 writeLedgerState :: forall era ledgerera.