Add a query for vote delegatees

IntersectMBO · Nov 13, 2023 · e9b768f · e9b768f
1 parent 2e5de18
commit e9b768f
Show file tree

Hide file tree

Showing 3 changed files with 27 additions and 0 deletions.
diff --git a/cardano-api/internal/Cardano/Api/Query.hs b/cardano-api/internal/Cardano/Api/Query.hs
@@ -320,6 +320,10 @@ data QueryInShelleyBasedEra era result where
     -> Set L.MemberStatus
     -> QueryInShelleyBasedEra era (Maybe (L.CommitteeMembersState StandardCrypto))
 
+  QueryStakeVoteDelegatees
+    :: Set StakeCredential
+    -> QueryInShelleyBasedEra era (Map StakeCredential (Ledger.DRep StandardCrypto))
+
 
 instance NodeToClientVersionOf (QueryInShelleyBasedEra era result) where
   nodeToClientVersionOf QueryEpoch = NodeToClientV_9
@@ -343,6 +347,7 @@ instance NodeToClientVersionOf (QueryInShelleyBasedEra era result) where
   nodeToClientVersionOf QueryDRepState{} = NodeToClientV_16
   nodeToClientVersionOf QueryDRepStakeDistr{} = NodeToClientV_16
   nodeToClientVersionOf QueryCommitteeMembersState{} = NodeToClientV_16
+  nodeToClientVersionOf QueryStakeVoteDelegatees{} = NodeToClientV_16
 
 deriving instance Show (QueryInShelleyBasedEra era result)
 
@@ -672,6 +677,13 @@ toConsensusQueryShelleyBased sbe = \case
   QueryCommitteeMembersState coldCreds hotCreds statuses ->
     Some (consensusQueryInEraInMode era (Consensus.GetCommitteeMembersState coldCreds hotCreds statuses))
 
+  QueryStakeVoteDelegatees creds ->
+    Some (consensusQueryInEraInMode era
+            (Consensus.GetFilteredVoteDelegatees creds'))
+    where
+      creds' :: Set (Shelley.Credential Shelley.Staking StandardCrypto)
+      creds' = Set.map toShelleyStakeCredential creds
+
   where
     era = shelleyBasedToCardanoEra sbe
 
@@ -932,6 +944,12 @@ fromConsensusQueryResultShelleyBased _ QueryCommitteeMembersState{} q' committee
     Consensus.GetCommitteeMembersState{} -> committeeMembersState'
     _                                    -> fromConsensusQueryResultMismatch
 
+fromConsensusQueryResultShelleyBased _ QueryStakeVoteDelegatees{} q' delegs' =
+    case q' of
+      Consensus.GetFilteredVoteDelegatees {}
+        -> Map.mapKeys fromShelleyStakeCredential delegs' 
+      _ -> fromConsensusQueryResultMismatch
+
 -- | This should /only/ happen if we messed up the mapping in 'toConsensusQuery'
 -- and 'fromConsensusQueryResult' so they are inconsistent with each other.
 --

diff --git a/cardano-api/internal/Cardano/Api/Query/Expr.hs b/cardano-api/internal/Cardano/Api/Query/Expr.hs
@@ -31,6 +31,7 @@ module Cardano.Api.Query.Expr
   , queryDRepStakeDistribution
   , queryDRepState
   , queryGovState
+  , queryStakeVoteDelegatees
   ) where
 
 import           Cardano.Api.Address
@@ -236,3 +237,10 @@ queryCommitteeMembersState :: ()
   -> LocalStateQueryExpr block point QueryInMode r IO (Either UnsupportedNtcVersionError (Either EraMismatch (Maybe (L.CommitteeMembersState L.StandardCrypto))))
 queryCommitteeMembersState sbe coldCreds hotCreds statuses =
   queryExpr $ QueryInEra $ QueryInShelleyBasedEra sbe (QueryCommitteeMembersState coldCreds hotCreds statuses)
+
+queryStakeVoteDelegatees :: ()
+  => ShelleyBasedEra era
+  -> Set StakeCredential
+  -> LocalStateQueryExpr block point QueryInMode r IO (Either UnsupportedNtcVersionError (Either EraMismatch (Map StakeCredential (L.DRep L.StandardCrypto))))
+queryStakeVoteDelegatees sbe stakeCredentials =
+  queryExpr $ QueryInEra $ QueryInShelleyBasedEra sbe $ QueryStakeVoteDelegatees stakeCredentials
diff --git a/cardano-api/src/Cardano/Api.hs b/cardano-api/src/Cardano/Api.hs
@@ -963,6 +963,7 @@ module Cardano.Api (
     queryDRepState,
     queryDRepStakeDistribution,
     queryCommitteeMembersState,
+    queryStakeVoteDelegatees,
 
     -- ** Committee State Query
     MemberStatus (..),