From ac8a4c0b34385e05616cc53212cad85bbe7ea415 Mon Sep 17 00:00:00 2001 From: Carl Hammann Date: Fri, 10 Nov 2023 12:33:23 +0100 Subject: [PATCH] Add a query for vote delegatees (experimental) --- ...65234_carl.hammann_vote_delegatee_query.md | 23 ++++++++++++ .../Shelley/Ledger/NetworkProtocolVersion.hs | 2 +- .../Consensus/Shelley/Ledger/Query.hs | 36 +++++++++++++++++-- 3 files changed, 58 insertions(+), 3 deletions(-) create mode 100644 ouroboros-consensus-cardano/changelog.d/20231110_165234_carl.hammann_vote_delegatee_query.md diff --git a/ouroboros-consensus-cardano/changelog.d/20231110_165234_carl.hammann_vote_delegatee_query.md b/ouroboros-consensus-cardano/changelog.d/20231110_165234_carl.hammann_vote_delegatee_query.md new file mode 100644 index 0000000000..8ddbfdf0bd --- /dev/null +++ b/ouroboros-consensus-cardano/changelog.d/20231110_165234_carl.hammann_vote_delegatee_query.md @@ -0,0 +1,23 @@ + + + + + + +### Breaking + +- Add a query for vote delegatees: GetFilteredVoteDelegatees diff --git a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/NetworkProtocolVersion.hs b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/NetworkProtocolVersion.hs index 75443ad651..08eef0ebfb 100644 --- a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/NetworkProtocolVersion.hs +++ b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/NetworkProtocolVersion.hs @@ -35,7 +35,7 @@ data ShelleyNodeToClientVersion = -- | New queries introduced: GetStakeDelegDeposits | ShelleyNodeToClientVersion7 - -- | New queries introduced: GetConstitutionHash + -- | New queries introduced: GetConstitutionHash, GetFilteredVoteDelegatees | ShelleyNodeToClientVersion8 deriving (Show, Eq, Ord, Enum, Bounded) diff --git a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Query.hs b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Query.hs index 62b35af6c0..a7c29ffde1 100644 --- a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Query.hs +++ b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Query.hs @@ -49,8 +49,8 @@ import qualified Cardano.Ledger.Shelley.LedgerState as SL (RewardAccounts, import qualified Cardano.Ledger.Shelley.PParams as SL (emptyPPPUpdates) import qualified Cardano.Ledger.Shelley.RewardProvenance as SL (RewardProvenance) -import Cardano.Ledger.UMap (UMap (..), rdReward, umElemRDPair, - umElemSPool) +import Cardano.Ledger.UMap (UMap (..), rdReward, umElemDRep, + umElemRDPair, umElemSPool) import Codec.CBOR.Decoding (Decoder) import qualified Codec.CBOR.Decoding as CBOR import Codec.CBOR.Encoding (Encoding) @@ -102,6 +102,10 @@ type Delegations c = Map (SL.Credential 'SL.Staking c) (SL.KeyHash 'SL.StakePool c) +type VoteDelegatees c = + Map (SL.Credential 'SL.Staking c) + (SL.DRep c) + data instance BlockQuery (ShelleyBlock proto era) :: Type -> Type where GetLedgerTip :: BlockQuery (ShelleyBlock proto era) (Point (ShelleyBlock proto era)) GetEpochNo :: BlockQuery (ShelleyBlock proto era) EpochNo @@ -258,6 +262,10 @@ data instance BlockQuery (ShelleyBlock proto era) :: Type -> Type where -> Set SL.MemberStatus -> BlockQuery (ShelleyBlock proto era) (Maybe (SL.CommitteeMembersState (EraCrypto era))) + GetFilteredVoteDelegatees + :: Set (SL.Credential 'SL.Staking (EraCrypto era)) + -> BlockQuery (ShelleyBlock proto era) (VoteDelegatees (EraCrypto era)) + -- WARNING: please add new queries to the end of the list and stick to this -- order in all other pattern matches on queries. This helps in particular -- with the en/decoders, as we want the CBOR tags to be ordered. @@ -406,6 +414,8 @@ instance (ShelleyCompatible proto era, ProtoCrypto proto ~ crypto) => QueryLedge SL.queryDRepStakeDistr st dreps GetCommitteeMembersState coldCreds hotCreds statuses -> SL.queryCommitteeMembersState coldCreds hotCreds statuses st + GetFilteredVoteDelegatees stakeCreds -> + getFilteredVoteDelegatees st stakeCreds where lcfg = configLedger $ getExtLedgerCfg cfg globals = shelleyLedgerGlobals lcfg @@ -551,6 +561,12 @@ instance SameDepIndex (BlockQuery (ShelleyBlock proto era)) where sameDepIndex GetDRepStakeDistr{} _ = Nothing sameDepIndex GetCommitteeMembersState{} GetCommitteeMembersState{} = Just Refl sameDepIndex GetCommitteeMembersState{} _ = Nothing + sameDepIndex (GetFilteredVoteDelegatees stakeCreds) (GetFilteredVoteDelegatees stakeCreds') + | stakeCreds == stakeCreds' + = Just Refl + | otherwise + = Nothing + sameDepIndex GetFilteredVoteDelegatees {} _ = Nothing deriving instance Eq (BlockQuery (ShelleyBlock proto era) result) deriving instance Show (BlockQuery (ShelleyBlock proto era) result) @@ -585,6 +601,7 @@ instance ShelleyCompatible proto era => ShowQuery (BlockQuery (ShelleyBlock prot GetDRepState {} -> show GetDRepStakeDistr {} -> show GetCommitteeMembersState {} -> show + GetFilteredVoteDelegatees {} -> show -- | Is the given query supported by the given 'ShelleyNodeToClientVersion'? querySupportedVersion :: BlockQuery (ShelleyBlock proto era) result -> ShelleyNodeToClientVersion -> Bool @@ -617,6 +634,7 @@ querySupportedVersion = \case GetDRepState {} -> (>= v8) GetDRepStakeDistr {} -> (>= v8) GetCommitteeMembersState {} -> (>= v8) + GetFilteredVoteDelegatees {} -> (>= v8) -- WARNING: when adding a new query, a new @ShelleyNodeToClientVersionX@ -- must be added. See #2830 for a template on how to do this. where @@ -663,6 +681,15 @@ getFilteredDelegationsAndRewardAccounts ss creds = filteredRwdAcnts = Map.mapMaybe (\e -> fromCompact . rdReward <$> umElemRDPair e) umElemsRestricted +getFilteredVoteDelegatees :: + SL.NewEpochState era + -> Set (SL.Credential 'SL.Staking (EraCrypto era)) + -> VoteDelegatees (EraCrypto era) +getFilteredVoteDelegatees ss creds = Map.mapMaybe umElemDRep umElemsRestricted + where + UMap umElems _ = SL.dsUnified $ getDState ss + umElemsRestricted = Map.restrictKeys umElems creds + {------------------------------------------------------------------------------- Serialisation -------------------------------------------------------------------------------} @@ -727,6 +754,8 @@ encodeShelleyQuery query = case query of CBOR.encodeListLen 2 <> CBOR.encodeWord8 26 <> LC.toEraCBOR @era dreps GetCommitteeMembersState coldCreds hotCreds statuses -> CBOR.encodeListLen 4 <> CBOR.encodeWord8 27 <> toCBOR coldCreds <> toCBOR hotCreds <> LC.toEraCBOR @era statuses + GetFilteredVoteDelegatees stakeCreds -> + CBOR.encodeListLen 2 <> CBOR.encodeWord8 28 <> LC.toEraCBOR @era stakeCreds decodeShelleyQuery :: forall era proto. ShelleyBasedEra era @@ -767,6 +796,7 @@ decodeShelleyQuery = do hotCreds <- fromCBOR statuses <- LC.fromEraCBOR @era return $ SomeSecond $ GetCommitteeMembersState coldCreds hotCreds statuses + (2, 28) -> SomeSecond . GetFilteredVoteDelegatees <$> LC.fromEraCBOR @era _ -> fail $ "decodeShelleyQuery: invalid (len, tag): (" <> show len <> ", " <> show tag <> ")" @@ -804,6 +834,7 @@ encodeShelleyResult v query = case query of GetDRepState {} -> LC.toEraCBOR @era GetDRepStakeDistr {} -> LC.toEraCBOR @era GetCommitteeMembersState {} -> LC.toEraCBOR @era + GetFilteredVoteDelegatees {} -> LC.toEraCBOR @era decodeShelleyResult :: forall proto era result. ShelleyCompatible proto era @@ -839,6 +870,7 @@ decodeShelleyResult v query = case query of GetDRepState {} -> LC.fromEraCBOR @era GetDRepStakeDistr {} -> LC.fromEraCBOR @era GetCommitteeMembersState {} -> LC.fromEraCBOR @era + GetFilteredVoteDelegatees {} -> LC.fromEraCBOR @era currentPParamsEnDecoding :: forall era s.