From bd4afe0ce586cabd533c594caa89a2b052aba94a Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Marcin=20W=C3=B3jtowicz?= <marcin.wojtowicz@iohk.io>
Date: Sat, 30 Mar 2024 22:56:03 +0100
Subject: [PATCH] Adds new query for a snapshot of big ledger peers

This change introduces a new query tag and handler
to support retrieval of a snapshot of big ledger peers
from the current tip of a node.
---
 cardano-api/internal/Cardano/Api/Query.hs      | 13 +++++++++++++
 cardano-api/internal/Cardano/Api/Query/Expr.hs |  9 +++++++++
 cardano-api/src/Cardano/Api.hs                 |  1 +
 3 files changed, 23 insertions(+)

diff --git a/cardano-api/internal/Cardano/Api/Query.hs b/cardano-api/internal/Cardano/Api/Query.hs
index 4fa03c05e0..032d7e7534 100644
--- a/cardano-api/internal/Cardano/Api/Query.hs
+++ b/cardano-api/internal/Cardano/Api/Query.hs
@@ -124,6 +124,7 @@ import qualified Ouroboros.Consensus.Protocol.Abstract as Consensus
 import qualified Ouroboros.Consensus.Shelley.Ledger as Consensus
 import           Ouroboros.Network.Block (Serialised (..))
 import           Ouroboros.Network.NodeToClient.Version (NodeToClientVersion (..))
+import           Ouroboros.Network.PeerSelection.LedgerPeers.Type (LedgerPeerSnapshot)
 import           Ouroboros.Network.Protocol.LocalStateQuery.Client (Some (..))
 
 import           Control.Monad.Trans.Except
@@ -324,6 +325,9 @@ data QueryInShelleyBasedEra era result where
     :: Set StakeCredential
     -> QueryInShelleyBasedEra era (Map StakeCredential (Ledger.DRep StandardCrypto))
 
+  QueryLedgerPeerSnapshot
+    :: QueryInShelleyBasedEra era (Serialised LedgerPeerSnapshot)
+
 
 -- | Mapping for queries in Shelley-based eras returning minimal node-to-client protocol versions. More
 -- information about queries versioning can be found:
@@ -342,6 +346,7 @@ instance NodeToClientVersionOf (QueryInShelleyBasedEra era result) where
   nodeToClientVersionOf QueryDebugLedgerState = NodeToClientV_9
   nodeToClientVersionOf QueryProtocolState = NodeToClientV_9
   nodeToClientVersionOf QueryCurrentEpochState = NodeToClientV_9
+  nodeToClientVersionOf QueryLedgerPeerSnapshot = NodeToClientV_9
   -- Babbage >= v13
   nodeToClientVersionOf (QueryPoolState _) = NodeToClientV_14
   nodeToClientVersionOf (QueryPoolDistribution _) = NodeToClientV_14
@@ -705,6 +710,9 @@ toConsensusQueryShelleyBased sbe = \case
       creds' :: Set (Shelley.Credential Shelley.Staking StandardCrypto)
       creds' = Set.map toShelleyStakeCredential creds
 
+  QueryLedgerPeerSnapshot ->
+    Some (consensusQueryInEraInMode era (Consensus.GetCBOR Consensus.GetBigLedgerPeerSnapshot))
+
   where
     era = shelleyBasedToCardanoEra sbe
 
@@ -969,6 +977,11 @@ fromConsensusQueryResultShelleyBased _ QueryStakeVoteDelegatees{} q' delegs' =
         -> Map.mapKeys fromShelleyStakeCredential delegs'
       _ -> fromConsensusQueryResultMismatch
 
+fromConsensusQueryResultShelleyBased _ QueryLedgerPeerSnapshot q' serLedgerPeerSnapshot =
+    case q' of
+      Consensus.GetCBOR Consensus.GetBigLedgerPeerSnapshot -> serLedgerPeerSnapshot
+      _ -> 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
index ed019c9582..21e0b538be 100644
--- a/cardano-api/internal/Cardano/Api/Query/Expr.hs
+++ b/cardano-api/internal/Cardano/Api/Query/Expr.hs
@@ -25,6 +25,7 @@ module Cardano.Api.Query.Expr
   , queryStakeSnapshot
   , querySystemStart
   , queryUtxo
+  , queryLedgerPeerSnapshot
   , L.MemberStatus (..)
   , L.CommitteeMembersState (..)
   , queryCommitteeMembersState
@@ -60,6 +61,8 @@ import qualified Cardano.Ledger.Keys as L
 import           Cardano.Ledger.SafeHash
 import           Cardano.Slotting.Slot
 import           Ouroboros.Consensus.HardFork.Combinator.AcrossEras as Consensus
+import           Ouroboros.Network.Block (Serialised)
+import           Ouroboros.Network.PeerSelection.LedgerPeers (LedgerPeerSnapshot)
 
 import           Data.Map (Map)
 import           Data.Set (Set)
@@ -98,6 +101,12 @@ queryDebugLedgerState :: ()
 queryDebugLedgerState sbe =
   queryExpr $ QueryInEra $ QueryInShelleyBasedEra sbe QueryDebugLedgerState
 
+queryLedgerPeerSnapshot :: ()
+  => ShelleyBasedEra era
+  -> LocalStateQueryExpr block point QueryInMode r IO (Either UnsupportedNtcVersionError (Either EraMismatch (Serialised LedgerPeerSnapshot)))
+queryLedgerPeerSnapshot sbe =
+  queryExpr $ QueryInEra $ QueryInShelleyBasedEra sbe QueryLedgerPeerSnapshot
+
 queryEraHistory :: ()
   => LocalStateQueryExpr block point QueryInMode r IO (Either UnsupportedNtcVersionError  EraHistory)
 queryEraHistory =
diff --git a/cardano-api/src/Cardano/Api.hs b/cardano-api/src/Cardano/Api.hs
index c1a1ca326c..2a06dd3698 100644
--- a/cardano-api/src/Cardano/Api.hs
+++ b/cardano-api/src/Cardano/Api.hs
@@ -947,6 +947,7 @@ module Cardano.Api (
     queryCurrentEpochState,
     queryCurrentEra,
     queryDebugLedgerState,
+    queryLedgerPeerSnapshot,
     queryEpoch,
     queryConstitutionHash,
     queryEraHistory,