Add registered DRep stake distribution query

libs/cardano-ledger-api/CHANGELOG.md

@@ -2,6 +2,7 @@
 
 ## 1.10.0.0
 
+* Added `queryRegisteredDRepStakeDistr` state query
 * Remove deprecated `RewardAcnt`, `mkRwdAcnt`, `serialiseRewardAcnt` and `deserialiseRewardAcnt`.
 * Added `queryStakePoolDefaultVote` state query and its return type `DefaultVote`
 

libs/cardano-ledger-api/src/Cardano/Ledger/Api/State/Query.hs

@@ -23,6 +23,9 @@ module Cardano.Ledger.Api.State.Query (
   -- * @GetDRepStakeDistr@
   queryDRepStakeDistr,
 
+  -- * @GetRegisteredDRepStakeDistr@
+  queryRegisteredDRepStakeDistr,
+
   -- * @GetSPOStakeDistr@
   querySPOStakeDistr,
 
@@ -69,8 +72,8 @@ import Cardano.Ledger.Api.State.Query.CommitteeMembersState (
  )
 import Cardano.Ledger.BaseTypes (EpochNo, strictMaybeToMaybe)
 import Cardano.Ledger.CertState
-import Cardano.Ledger.Coin (Coin)
-import Cardano.Ledger.Compactible (fromCompact)
+import Cardano.Ledger.Coin (Coin (..), CompactForm (..))
+import Cardano.Ledger.Compactible (fromCompact, toCompact)
 import Cardano.Ledger.Conway.Governance (
   Committee (committeeMembers),
   Constitution (constitutionAnchor),
@@ -86,6 +89,7 @@ import Cardano.Ledger.Conway.Governance (
   defaultStakePoolVote,
   ensCommitteeL,
   finishDRepPulser,
+  proposalsDeposits,
   psDRepDistr,
   psPoolDistr,
   psProposalsL,
@@ -101,14 +105,15 @@ import Cardano.Ledger.Shelley.LedgerState
 import Cardano.Ledger.UMap (
   StakeCredentials (scRewards, scSPools),
   UMap,
+  addCompact,
   dRepMap,
   domRestrictedStakeCredentials,
  )
 import Control.Monad (guard)
 import Data.Foldable (foldMap')
 import Data.Map (Map)
 import qualified Data.Map.Strict as Map
-import Data.Maybe (isJust)
+import Data.Maybe (fromJust, fromMaybe, isJust)
 import Data.Sequence (Seq (..))
 import qualified Data.Sequence as Seq
 import Data.Sequence.Strict (StrictSeq (..))
@@ -185,6 +190,41 @@ queryDRepStakeDistr nes creds
   where
     distr = psDRepDistr . fst $ finishedPulserState nes
 
+-- | Query the stake distribution of the registered DReps. This does not
+-- include the @AlwaysAbstain@ and @NoConfidence@ DReps.
+queryRegisteredDRepStakeDistr ::
+  ConwayEraGov era =>
+  NewEpochState era ->
+  -- | Specify DRep Ids whose stake distribution should be returned. When this set is
+  -- empty, distributions for all of the registered DReps will be returned.
+  Set (Credential 'DRepRole (EraCrypto era)) ->
+  Map (Credential 'DRepRole (EraCrypto era)) Coin
+queryRegisteredDRepStakeDistr nes creds
+  | null creds = distr
+  | otherwise = distr `Map.restrictKeys` creds
+  where
+    distr = Map.map fromCompact $ Map.foldlWithKey' computeDistr mempty registeredDReps
+    registeredDReps = nes ^. nesEsL . esLStateL . lsCertStateL . certVStateL . vsDRepsL
+    computeDistr distrAcc stakeCred (DRepState {..}) =
+      Map.insert
+        stakeCred
+        (addCompact (fromJust $ toCompact drepDeposit) $ totalDelegations drepDelegs)
+        distrAcc
+    totalDelegations =
+      Set.foldl'
+        (\acc c -> addCompact acc $ stakeAndDeposits c incrStake pDeposits)
+        (CompactCoin 0)
+    incrStake = nes ^. nesEsL . epochStateIncrStakeDistrL
+    pDeposits = proposalsDeposits $ nes ^. newEpochStateGovStateL . proposalsGovStateL
+    stakeAndDeposits stakeCred stakeDistr proposalDeposits =
+      addCompact
+        (stake stakeCred stakeDistr)
+        (proposalDeposit stakeCred proposalDeposits)
+    stake stakeCred stakeDistr =
+      fromMaybe (CompactCoin 0) $ Map.lookup stakeCred stakeDistr
+    proposalDeposit stakeCred proposalDeposits =
+      fromMaybe (CompactCoin 0) $ Map.lookup stakeCred proposalDeposits
+
 -- | Query pool stake distribution.
 querySPOStakeDistr ::
   ConwayEraGov era =>