From 84398c4e284402b3a5bc8bea6085d51773616235 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      |  9 +++++++++
 cardano-api/internal/Cardano/Api/Query/Expr.hs | 17 +++++++++++++++--
 cardano-api/src/Cardano/Api.hs                 |  1 +
 3 files changed, 25 insertions(+), 2 deletions(-)

diff --git a/cardano-api/internal/Cardano/Api/Query.hs b/cardano-api/internal/Cardano/Api/Query.hs
index 011e10eec9..7a1ec5d21e 100644
--- a/cardano-api/internal/Cardano/Api/Query.hs
+++ b/cardano-api/internal/Cardano/Api/Query.hs
@@ -293,6 +293,8 @@ data QueryInShelleyBasedEra era result where
   QueryStakeVoteDelegatees
     :: 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:
@@ -311,6 +313,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
@@ -692,6 +695,8 @@ toConsensusQueryShelleyBased sbe = \case
    where
     creds' :: Set (Shelley.Credential Shelley.Staking StandardCrypto)
     creds' = Set.map toShelleyStakeCredential creds
+  QueryLedgerPeerSnapshot ->
+    Some (consensusQueryInEraInMode era (Consensus.GetCBOR Consensus.GetBigLedgerPeerSnapshot))
  where
   era = toCardanoEra sbe
 
@@ -968,6 +973,10 @@ fromConsensusQueryResultShelleyBased sbe sbeQuery q' r' =
         Consensus.GetFilteredVoteDelegatees{} ->
           Map.mapKeys fromShelleyStakeCredential r'
         _ -> 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 9615951f25..d5e2924a6f 100644
--- a/cardano-api/internal/Cardano/Api/Query/Expr.hs
+++ b/cardano-api/internal/Cardano/Api/Query/Expr.hs
@@ -26,6 +26,7 @@ module Cardano.Api.Query.Expr
   , queryStakeSnapshot
   , querySystemStart
   , queryUtxo
+  , queryLedgerPeerSnapshot
   , L.MemberStatus (..)
   , L.CommitteeMembersState (..)
   , queryCommitteeMembersState
@@ -131,6 +132,19 @@ 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)
@@ -302,8 +316,7 @@ queryStakePoolParameters
       (Either UnsupportedNtcVersionError (Either EraMismatch (Map PoolId StakePoolParameters)))
 queryStakePoolParameters sbe poolIds
   | S.null poolIds = pure . pure $ pure mempty
-  | otherwise =
-      queryExpr $ QueryInEra $ QueryInShelleyBasedEra sbe $ QueryStakePoolParameters poolIds
+  | otherwise = queryExpr $ QueryInEra $ QueryInShelleyBasedEra sbe $ QueryStakePoolParameters poolIds
 
 queryStakePools
   :: ()
diff --git a/cardano-api/src/Cardano/Api.hs b/cardano-api/src/Cardano/Api.hs
index 0a7b772ada..8fee2128c8 100644
--- a/cardano-api/src/Cardano/Api.hs
+++ b/cardano-api/src/Cardano/Api.hs
@@ -941,6 +941,7 @@ module Cardano.Api
   , queryCurrentEpochState
   , queryCurrentEra
   , queryDebugLedgerState
+  , queryLedgerPeerSnapshot
   , queryEpoch
   , queryConstitutionHash
   , queryEraHistory