add support for new ledger state query for drep delegations.

Author: KtorZ

ouroboros-consensus-cardano/src/ouroboros-consensus-cardano/Ouroboros/Consensus/Cardano/Node.hs

@@ -44,6 +44,7 @@ module Ouroboros.Consensus.Cardano.Node
   , pattern CardanoNodeToClientVersion16
   , pattern CardanoNodeToClientVersion17
   , pattern CardanoNodeToClientVersion18
+  , pattern CardanoNodeToClientVersion19
   , pattern CardanoNodeToNodeVersion1
   , pattern CardanoNodeToNodeVersion2
   ) where
@@ -422,6 +423,21 @@ pattern CardanoNodeToClientVersion18 =
         :* Nil
       )
 
+pattern CardanoNodeToClientVersion19 :: BlockNodeToClientVersion (CardanoBlock c)
+pattern CardanoNodeToClientVersion19 =
+  HardForkNodeToClientEnabled
+    HardForkSpecificNodeToClientVersion3
+    ( EraNodeToClientEnabled ByronNodeToClientVersion1
+        :* EraNodeToClientEnabled ShelleyNodeToClientVersion15
+        :* EraNodeToClientEnabled ShelleyNodeToClientVersion15
+        :* EraNodeToClientEnabled ShelleyNodeToClientVersion15
+        :* EraNodeToClientEnabled ShelleyNodeToClientVersion15
+        :* EraNodeToClientEnabled ShelleyNodeToClientVersion15
+        :* EraNodeToClientEnabled ShelleyNodeToClientVersion15
+        :* EraNodeToClientEnabled ShelleyNodeToClientVersion15
+        :* Nil
+      )
+
 instance
   CardanoHardForkConstraints c =>
   SupportedNetworkProtocolVersion (CardanoBlock c)
@@ -441,9 +457,10 @@ instance
       , (NodeToClientV_20, CardanoNodeToClientVersion16)
       , (NodeToClientV_21, CardanoNodeToClientVersion17)
       , (NodeToClientV_22, CardanoNodeToClientVersion18)
+      , (NodeToClientV_23, CardanoNodeToClientVersion19)
       ]
 
-  latestReleasedNodeVersion _prx = (Just NodeToNodeV_15, Just NodeToClientV_22)
+  latestReleasedNodeVersion _prx = (Just NodeToNodeV_15, Just NodeToClientV_23)
 
 {-------------------------------------------------------------------------------
   ProtocolInfo

ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/NetworkProtocolVersion.hs

@@ -31,6 +31,8 @@ data ShelleyNodeToClientVersion
     ShelleyNodeToClientVersion13
   | -- | Support SRV in GetBigLedgerPeerSnapshot
     ShelleyNodeToClientVersion14
+    -- | New queries introduced: QueryDRepsDelegations
+  | ShelleyNodeToClientVersion15
   deriving (Show, Eq, Ord, Enum, Bounded)
 
 ledgerPeerSnapshotSupportsSRV :: ShelleyNodeToClientVersion -> LedgerPeerSnapshotSRVSupport
@@ -58,6 +60,7 @@ instance SupportedNetworkProtocolVersion (ShelleyBlock proto era) where
       , (NodeToClientV_20, ShelleyNodeToClientVersion12)
       , (NodeToClientV_21, ShelleyNodeToClientVersion13)
       , (NodeToClientV_22, ShelleyNodeToClientVersion14)
+      , (NodeToClientV_23, ShelleyNodeToClientVersion15)
       ]
 
   latestReleasedNodeVersion = latestReleasedNodeVersionDefault

ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Query.hs

@@ -365,6 +365,12 @@ data instance BlockQuery (ShelleyBlock proto era) fp result where
     BlockQuery (ShelleyBlock proto era) QFNoTables SL.PoolDistr
   GetMaxMajorProtocolVersion ::
     BlockQuery (ShelleyBlock proto era) QFNoTables MaxMajorProtVer
+  GetDRepDelegations ::
+    Set SL.DRep ->
+    BlockQuery
+      (ShelleyBlock proto era)
+      QFNoTables
+      (Map SL.DRep (Set (SL.Credential 'SL.Staking)))
 
 -- 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
@@ -533,6 +539,8 @@ instance
           . configConsensus
           . getExtLedgerCfg
           $ cfg
+      GetDRepDelegations dreps ->
+        SL.queryDRepDelegations st dreps
    where
     lcfg = configLedger $ getExtLedgerCfg cfg
     globals = shelleyLedgerGlobals lcfg
@@ -592,6 +600,7 @@ instance
     GetPoolDistr2{} -> (>= v13)
     GetStakeDistribution2{} -> (>= v13)
     GetMaxMajorProtocolVersion -> (>= v13)
+    GetDRepDelegations {} -> (>= v14)
    where
     -- WARNING: when adding a new query, a new @ShelleyNodeToClientVersionX@
     -- must be added. See #2830 for a template on how to do this.
@@ -602,6 +611,7 @@ instance
     v11 = ShelleyNodeToClientVersion11
     v12 = ShelleyNodeToClientVersion12
     v13 = ShelleyNodeToClientVersion13
+    v14 = ShelleyNodeToClientVersion14
 
 instance SameDepIndex2 (BlockQuery (ShelleyBlock proto era)) where
   sameDepIndex2 GetLedgerTip GetLedgerTip =
@@ -761,6 +771,12 @@ instance SameDepIndex2 (BlockQuery (ShelleyBlock proto era)) where
   sameDepIndex2 GetStakeDistribution2{} _ = Nothing
   sameDepIndex2 GetMaxMajorProtocolVersion{} GetMaxMajorProtocolVersion{} = Just Refl
   sameDepIndex2 GetMaxMajorProtocolVersion{} _ = Nothing
+  sameDepIndex2 (GetDRepDelegations dreps) (GetDRepDelegations dreps')
+    | dreps == dreps' =
+        Just Refl
+    | otherwise =
+        Nothing
+  sameDepIndex2 GetDRepDelegations{} _ = Nothing
 
 deriving instance Eq (BlockQuery (ShelleyBlock proto era) fp result)
 deriving instance Show (BlockQuery (ShelleyBlock proto era) fp result)
@@ -806,6 +822,7 @@ instance ShelleyCompatible proto era => ShowQuery (BlockQuery (ShelleyBlock prot
     GetPoolDistr2{} -> show
     GetStakeDistribution2{} -> show
     GetMaxMajorProtocolVersion{} -> show
+    GetDRepDelegations {} -> show
 
 {-------------------------------------------------------------------------------
   Auxiliary
@@ -930,6 +947,8 @@ encodeShelleyQuery query = case query of
     CBOR.encodeListLen 1 <> CBOR.encodeWord8 37
   GetMaxMajorProtocolVersion ->
     CBOR.encodeListLen 1 <> CBOR.encodeWord8 38
+  GetDRepDelegations dreps ->
+    CBOR.encodeListLen 2 <> CBOR.encodeWord8 39 <> LC.toEraCBOR @era dreps
 
 decodeShelleyQuery ::
   forall era proto.
@@ -1004,6 +1023,7 @@ decodeShelleyQuery = do
     (2, 36) -> SomeBlockQuery . GetPoolDistr2 <$> fromCBOR
     (1, 37) -> return $ SomeBlockQuery GetStakeDistribution2
     (1, 38) -> return $ SomeBlockQuery GetMaxMajorProtocolVersion
+    (2, 39) -> SomeBlockQuery . GetDRepDelegations <$> LC.fromEraCBOR @era
     _ -> failmsg "invalid"
 
 encodeShelleyResult ::
@@ -1053,6 +1073,7 @@ encodeShelleyResult v query = case query of
   GetPoolDistr2{} -> LC.toEraCBOR @era
   GetStakeDistribution2{} -> LC.toEraCBOR @era
   GetMaxMajorProtocolVersion -> toCBOR
+  GetDRepDelegations {} -> LC.toEraCBOR @era
 
 decodeShelleyResult ::
   forall proto era fp result.
@@ -1101,6 +1122,7 @@ decodeShelleyResult v query = case query of
   GetPoolDistr2{} -> LC.fromEraCBOR @era
   GetStakeDistribution2 -> LC.fromEraCBOR @era
   GetMaxMajorProtocolVersion -> fromCBOR
+  GetDRepDelegations {} -> LC.fromEraCBOR @era
 
 currentPParamsEnDecoding ::
   forall era s.

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Ledger/Query/Version.hs

@@ -28,3 +28,4 @@ nodeToClientVersionToQueryVersion x = case x of
   NodeToClientV_20 -> QueryVersion3
   NodeToClientV_21 -> QueryVersion3
   NodeToClientV_22 -> QueryVersion3
+  NodeToClientV_23 -> QueryVersion3