Add GetRewardInfoPools local state query

… and try to add appropriate version numbers. NOTE: This depends on a new function `getRewardInfoPools` in `cardano-ledger-specs`
IntersectMBO · Oct 11, 2021 · 31a44bf · 31a44bf
1 parent e0ccbb7
commit 31a44bf
Show file tree

Hide file tree

Showing 6 changed files with 47 additions and 0 deletions.
diff --git a/ouroboros-consensus-cardano-test/test/Test/Consensus/Cardano/Golden.hs b/ouroboros-consensus-cardano-test/test/Test/Consensus/Cardano/Golden.hs
@@ -43,4 +43,5 @@ instance CardanoHardForkConstraints c
     CardanoNodeToClientVersion5 -> "CardanoNodeToClientVersion5"
     CardanoNodeToClientVersion6 -> "CardanoNodeToClientVersion6"
     CardanoNodeToClientVersion7 -> "CardanoNodeToClientVersion7"
+    CardanoNodeToClientVersion8 -> "CardanoNodeToClientVersion8"
     _                           -> error $ "Unknown version: " <> show blockVersion
diff --git a/ouroboros-consensus-cardano/src/Ouroboros/Consensus/Cardano/Node.hs b/ouroboros-consensus-cardano/src/Ouroboros/Consensus/Cardano/Node.hs
@@ -32,6 +32,7 @@ module Ouroboros.Consensus.Cardano.Node (
   , pattern CardanoNodeToClientVersion5
   , pattern CardanoNodeToClientVersion6
   , pattern CardanoNodeToClientVersion7
+  , pattern CardanoNodeToClientVersion8
   , pattern CardanoNodeToNodeVersion1
   , pattern CardanoNodeToNodeVersion2
   , pattern CardanoNodeToNodeVersion3
@@ -361,6 +362,21 @@ pattern CardanoNodeToClientVersion7 =
       :* Nil
       )
 
+-- | The hard fork enabled, and the Shelley, Allegra, Mary and Alonzo eras enabled
+-- Using 'ShelleyNodeToClientVersion5' for the Shelley-based eras , which
+-- enables new queries.
+pattern CardanoNodeToClientVersion8 :: BlockNodeToClientVersion (CardanoBlock c)
+pattern CardanoNodeToClientVersion8 =
+    HardForkNodeToClientEnabled
+      HardForkSpecificNodeToClientVersion2
+      (  EraNodeToClientEnabled ByronNodeToClientVersion1
+      :* EraNodeToClientEnabled ShelleyNodeToClientVersion5
+      :* EraNodeToClientEnabled ShelleyNodeToClientVersion5
+      :* EraNodeToClientEnabled ShelleyNodeToClientVersion5
+      :* EraNodeToClientEnabled ShelleyNodeToClientVersion5
+      :* Nil
+      )
+
 instance CardanoHardForkConstraints c
       => SupportedNetworkProtocolVersion (CardanoBlock c) where
   supportedNodeToNodeVersions _ = Map.fromList $
@@ -384,6 +400,7 @@ instance CardanoHardForkConstraints c
       , (NodeToClientV_8 , CardanoNodeToClientVersion6)
       , (NodeToClientV_9 , CardanoNodeToClientVersion7)
       , (NodeToClientV_10, CardanoNodeToClientVersion7)
+      , (NodeToClientV_11, CardanoNodeToClientVersion8)
       ]
 
   latestReleasedNodeVersion _prx = (Just NodeToNodeV_7, Just NodeToClientV_10)

diff --git a/ouroboros-consensus-shelley/src/Ouroboros/Consensus/Shelley/Ledger/NetworkProtocolVersion.hs b/ouroboros-consensus-shelley/src/Ouroboros/Consensus/Shelley/Ledger/NetworkProtocolVersion.hs
@@ -27,6 +27,9 @@ data ShelleyNodeToClientVersion =
 
     -- | New queries introduced
   | ShelleyNodeToClientVersion4
+
+    -- | New queries introduced: GetRewardInfoPools
+  | ShelleyNodeToClientVersion5
   deriving (Show, Eq, Ord, Enum, Bounded)
 
 instance HasNetworkProtocolVersion (ShelleyBlock era) where
@@ -52,6 +55,7 @@ instance SupportedNetworkProtocolVersion (ShelleyBlock era) where
         -- Shelley-only when introduced. However, we have retroactively claimed
         -- V_4 to enable 'ShelleyNodeToClientVersion3'.
       , (NodeToClientV_4, ShelleyNodeToClientVersion3)
+      , (NodeToClientV_5, ShelleyNodeToClientVersion5)
       ]
 
   latestReleasedNodeVersion = latestReleasedNodeVersionDefault
diff --git a/ouroboros-consensus-shelley/src/Ouroboros/Consensus/Shelley/Ledger/Query.hs b/ouroboros-consensus-shelley/src/Ouroboros/Consensus/Shelley/Ledger/Query.hs
@@ -180,6 +180,12 @@ data instance BlockQuery (ShelleyBlock era) :: Type -> Type where
                   (Map (SL.KeyHash 'SL.StakePool (EraCrypto era))
                        (SL.PoolParams (EraCrypto era)))
 
+  GetRewardInfoPools
+    :: BlockQuery (ShelleyBlock era)
+                  (SL.RewardParams,
+                    Map (SL.KeyHash 'SL.StakePool (EraCrypto era))
+                        (SL.RewardInfoPool))
+
   -- 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.
@@ -247,6 +253,8 @@ instance ShelleyBasedEra era => QueryLedger (ShelleyBlock era) where
           SL.getPools st
         GetStakePoolParams poolids ->
           SL.getPoolParameters st poolids
+        GetRewardInfoPools ->
+          SL.getRewardInfoPools globals st
     where
       lcfg    = configLedger $ getExtLedgerCfg cfg
       globals = shelleyLedgerGlobals lcfg
@@ -350,6 +358,10 @@ instance SameDepIndex (BlockQuery (ShelleyBlock era)) where
     = Nothing
   sameDepIndex (GetStakePoolParams _) _
     = Nothing
+  sameDepIndex GetRewardInfoPools GetRewardInfoPools
+    = Just Refl
+  sameDepIndex GetRewardInfoPools _
+    = Nothing
 
 deriving instance Eq   (BlockQuery (ShelleyBlock era) result)
 deriving instance Show (BlockQuery (ShelleyBlock era) result)
@@ -374,6 +386,7 @@ instance ShelleyBasedEra era => ShowQuery (BlockQuery (ShelleyBlock era)) where
       GetUTxOByTxIn {}                           -> show
       GetStakePools                              -> show
       GetStakePoolParams {}                      -> show
+      GetRewardInfoPools                         -> show
 
 -- | Is the given query supported by the given 'ShelleyNodeToClientVersion'?
 querySupportedVersion :: BlockQuery (ShelleyBlock era) result -> ShelleyNodeToClientVersion -> Bool
@@ -396,13 +409,15 @@ querySupportedVersion = \case
     GetUTxOByTxIn {}                           -> (>= v4)
     GetStakePools                              -> (>= v4)
     GetStakePoolParams {}                      -> (>= v4)
+    GetRewardInfoPools                         -> (>= v5)
     -- WARNING: when adding a new query, a new @ShelleyNodeToClientVersionX@
     -- must be added. See #2830 for a template on how to do this.
   where
     v1 = ShelleyNodeToClientVersion1
     v2 = ShelleyNodeToClientVersion2
     v3 = ShelleyNodeToClientVersion3
     v4 = ShelleyNodeToClientVersion4
+    v5 = ShelleyNodeToClientVersion5
 
 {-------------------------------------------------------------------------------
   Auxiliary
@@ -476,6 +491,8 @@ encodeShelleyQuery query = case query of
       CBOR.encodeListLen 1 <> CBOR.encodeWord8 16
     GetStakePoolParams poolids ->
       CBOR.encodeListLen 2 <> CBOR.encodeWord8 17 <> toCBOR poolids
+    GetRewardInfoPools ->
+      CBOR.encodeListLen 1 <> CBOR.encodeWord8 18
 
 decodeShelleyQuery ::
      ShelleyBasedEra era
@@ -502,6 +519,7 @@ decodeShelleyQuery = do
       (2, 15) -> SomeSecond . GetUTxOByTxIn <$> fromCBOR
       (1, 16) -> return $ SomeSecond GetStakePools
       (2, 17) -> SomeSecond . GetStakePoolParams <$> fromCBOR
+      (1, 18) -> return $ SomeSecond GetRewardInfoPools
       _       -> fail $
         "decodeShelleyQuery: invalid (len, tag): (" <>
         show len <> ", " <> show tag <> ")"
@@ -528,6 +546,7 @@ encodeShelleyResult query = case query of
     GetUTxOByTxIn {}                           -> toCBOR
     GetStakePools                              -> toCBOR
     GetStakePoolParams {}                      -> toCBOR
+    GetRewardInfoPools                         -> toCBOR
 
 decodeShelleyResult ::
      ShelleyBasedEra era
@@ -552,3 +571,4 @@ decodeShelleyResult query = case query of
     GetUTxOByTxIn {}                           -> fromCBOR
     GetStakePools                              -> fromCBOR
     GetStakePoolParams {}                      -> fromCBOR
+    GetRewardInfoPools                         -> fromCBOR
diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/Ledger/Query/Version.hs b/ouroboros-consensus/src/Ouroboros/Consensus/Ledger/Query/Version.hs
@@ -36,3 +36,4 @@ nodeToClientVersionToQueryVersion x = case x of
   NodeToClientV_8  -> TopLevelQueryDisabled
   NodeToClientV_9  -> QueryVersion1
   NodeToClientV_10 -> QueryVersion2
+  NodeToClientV_11 -> QueryVersion2
diff --git a/ouroboros-network/src/Ouroboros/Network/NodeToClient/Version.hs b/ouroboros-network/src/Ouroboros/Network/NodeToClient/Version.hs
@@ -43,6 +43,8 @@ data NodeToClientVersion
     -- ^ enabled @CardanoNodeToClientVersion7@, i.e., Alonzo
     | NodeToClientV_10
     -- ^ added 'GetChainBlockNo' and 'GetChainPoint' queries
+    | NodeToClientV_11
+    -- ^ added 'GetRewardInfoPools` Block query
   deriving (Eq, Ord, Enum, Bounded, Show, Typeable)
 
 -- | We set 16ths bit to distinguish `NodeToNodeVersion` and
@@ -65,6 +67,7 @@ nodeToClientVersionCodec = CodecCBORTerm { encodeTerm, decodeTerm }
       encodeTerm NodeToClientV_8  = CBOR.TInt (8  `setBit` nodeToClientVersionBit)
       encodeTerm NodeToClientV_9  = CBOR.TInt (9  `setBit` nodeToClientVersionBit)
       encodeTerm NodeToClientV_10 = CBOR.TInt (10 `setBit` nodeToClientVersionBit)
+      encodeTerm NodeToClientV_11 = CBOR.TInt (11 `setBit` nodeToClientVersionBit)
 
       decodeTerm (CBOR.TInt tag) =
        case ( tag `clearBit` nodeToClientVersionBit
@@ -80,6 +83,7 @@ nodeToClientVersionCodec = CodecCBORTerm { encodeTerm, decodeTerm }
         (8, True)  -> Right NodeToClientV_8
         (9, True)  -> Right NodeToClientV_9
         (10, True) -> Right NodeToClientV_10
+        (11, True) -> Right NodeToClientV_11
         (n, _)     -> Left ( T.pack "decode NodeToClientVersion: unknown tag: " <> T.pack (show tag)
                             , Just n)
       decodeTerm _  = Left ( T.pack "decode NodeToClientVersion: unexpected term"