New query GetPoolDistr

Author: newhoggy

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

@@ -31,7 +31,7 @@ data ShelleyNodeToClientVersion =
     -- | New queries introduced: GetRewardInfoPools
   | ShelleyNodeToClientVersion5
 
-    -- | New queries introduced: GetPoolState
+    -- | New queries introduced: GetPoolDistr, GetPoolState
   | ShelleyNodeToClientVersion6
   deriving (Show, Eq, Ord, Enum, Bounded)
 

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

@@ -193,6 +193,11 @@ data instance BlockQuery (ShelleyBlock proto era) :: Type -> Type where
     -> BlockQuery (ShelleyBlock proto era)
                   (SL.PState (EraCrypto era))
 
+  GetPoolDistr
+    :: Maybe (Set (SL.KeyHash 'SL.StakePool (EraCrypto era)))
+    -> BlockQuery (ShelleyBlock proto era)
+                  (SL.PoolDistr (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.
@@ -273,6 +278,11 @@ instance ShelleyCompatible proto era => QueryLedger (ShelleyBlock proto era) whe
                 , SL._retiring = Map.restrictKeys (SL._retiring dpsPState) poolIds
                 }
             Nothing -> dpsPState
+        GetPoolDistr mPoolIds ->
+          let poolDistr = SL.calculatePoolDistr . SL._pstakeSet . SL.esSnapshots $ getEpochState st in
+          case mPoolIds of
+            Just poolIds -> SL.PoolDistr $ Map.restrictKeys (SL.unPoolDistr poolDistr) poolIds
+            Nothing -> poolDistr
     where
       lcfg    = configLedger $ getExtLedgerCfg cfg
       globals = shelleyLedgerGlobals lcfg
@@ -287,6 +297,8 @@ instance ShelleyCompatible proto era => QueryLedger (ShelleyBlock proto era) whe
       hst = headerState ext
       st  = shelleyLedgerState lst
 
+
+
 instance SameDepIndex (BlockQuery (ShelleyBlock proto era)) where
   sameDepIndex GetLedgerTip GetLedgerTip
     = Just Refl
@@ -387,6 +399,13 @@ instance SameDepIndex (BlockQuery (ShelleyBlock proto era)) where
     = Nothing
   sameDepIndex (GetPoolState _) _
     = Nothing
+  sameDepIndex (GetPoolDistr poolids) (GetPoolDistr poolids')
+    | poolids == poolids'
+    = Just Refl
+    | otherwise
+    = Nothing
+  sameDepIndex (GetPoolDistr _) _
+    = Nothing
 
 deriving instance Eq   (BlockQuery (ShelleyBlock proto era) result)
 deriving instance Show (BlockQuery (ShelleyBlock proto era) result)
@@ -413,6 +432,7 @@ instance ShelleyCompatible proto era => ShowQuery (BlockQuery (ShelleyBlock prot
       GetStakePoolParams {}                      -> show
       GetRewardInfoPools                         -> show
       GetPoolState {}                            -> show
+      GetPoolDistr {}                            -> show
 
 -- | Is the given query supported by the given 'ShelleyNodeToClientVersion'?
 querySupportedVersion :: BlockQuery (ShelleyBlock proto era) result -> ShelleyNodeToClientVersion -> Bool
@@ -437,6 +457,7 @@ querySupportedVersion = \case
     GetStakePoolParams {}                      -> (>= v4)
     GetRewardInfoPools                         -> (>= v5)
     GetPoolState {}                            -> (>= v6)
+    GetPoolDistr {}                            -> (>= v6)
     -- WARNING: when adding a new query, a new @ShelleyNodeToClientVersionX@
     -- must be added. See #2830 for a template on how to do this.
   where
@@ -524,6 +545,8 @@ encodeShelleyQuery query = case query of
       CBOR.encodeListLen 1 <> CBOR.encodeWord8 18
     GetPoolState poolids ->
       CBOR.encodeListLen 2 <> CBOR.encodeWord8 19 <> toCBOR poolids
+    GetPoolDistr poolids ->
+      CBOR.encodeListLen 2 <> CBOR.encodeWord8 20 <> toCBOR poolids
 
 decodeShelleyQuery ::
      ShelleyBasedEra era
@@ -552,6 +575,7 @@ decodeShelleyQuery = do
       (2, 17) -> SomeSecond . GetStakePoolParams <$> fromCBOR
       (1, 18) -> return $ SomeSecond GetRewardInfoPools
       (2, 19) -> SomeSecond . GetPoolState <$> fromCBOR
+      (2, 20) -> SomeSecond . GetPoolDistr <$> fromCBOR
       _       -> fail $
         "decodeShelleyQuery: invalid (len, tag): (" <>
         show len <> ", " <> show tag <> ")"
@@ -580,6 +604,7 @@ encodeShelleyResult query = case query of
     GetStakePoolParams {}                      -> toCBOR
     GetRewardInfoPools                         -> toCBOR
     GetPoolState {}                            -> toCBOR
+    GetPoolDistr {}                            -> toCBOR
 
 decodeShelleyResult ::
      ShelleyCompatible proto era
@@ -606,3 +631,4 @@ decodeShelleyResult query = case query of
     GetStakePoolParams {}                      -> fromCBOR
     GetRewardInfoPools                         -> fromCBOR
     GetPoolState {}                            -> fromCBOR
+    GetPoolDistr {}                            -> fromCBOR

ouroboros-consensus/docs/interface-CHANGELOG.md

@@ -56,6 +56,13 @@ may appear out of chronological order.
 The internals of each entry are organized similar to
 https://keepachangelog.com/en/1.1.0/, adapted to our plan explained above.
 
+## Circa 2022-08-01
+
+### Added
+
+- `GetPoolDistr`: Get the pool distribution for the given stake pool ids
+  New addition to client version `NodeToClientV_14`
+
 ## Circa 2022-07-20
 
 ### Fixed

ouroboros-network/src/Ouroboros/Network/NodeToClient/Version.hs

@@ -35,7 +35,7 @@ data NodeToClientVersion
     | NodeToClientV_13
     -- ^ enabled @CardanoNodeToClientVersion9@, i.e., Babbage
     | NodeToClientV_14
-    -- ^ added @GetPoolState
+    -- ^ added @GetPoolDistr, @GetPoolState
   deriving (Eq, Ord, Enum, Bounded, Show, Typeable)
 
 -- | We set 16ths bit to distinguish `NodeToNodeVersion` and