Support for serialization of peer snapshot:

This change adds ToCBOR and FromCBOR instances that are necessary
to serialize a snapshot of ledger peers.

ouroboros-network-api/CHANGELOG.md

@@ -9,6 +9,8 @@
 * Transplanted `accBigPoolStake` and `reRelativeStake` from ouroboros-network
   `LedgerPeers` module to expose functionality that facilitates serializing
   of big ledger peers via LocalStateQuery miniprotocol.
+* Added `ToCBOR` and `FromCBOR` instance definitions for `RelayAccessPoint`
+  in support of upcoming serialization of (big) ledger peers.
 
 ## 0.7.1.0 -- 2024-03-14
 

ouroboros-network-api/ouroboros-network-api.cabal

@@ -66,6 +66,7 @@ library
                        serialise         >=0.2   && <0.3,
                        text              >=1.2 && <2.2,
 
+                       cardano-binary,
                        cardano-slotting,
                        cardano-strict-containers,
                        contra-tracer,

ouroboros-network-api/src/Ouroboros/Network/PeerSelection/LedgerPeers/Type.hs

@@ -18,6 +18,7 @@ module Ouroboros.Network.PeerSelection.LedgerPeers.Type
   , isLedgerPeersEnabled
   ) where
 
+import Cardano.Binary (FromCBOR, ToCBOR)
 import Cardano.Slotting.Slot (SlotNo (..), WithOrigin)
 import Control.Concurrent.Class.MonadSTM
 import Control.DeepSeq (NFData (..))
@@ -51,7 +52,7 @@ isLedgerPeersEnabled UseLedgerPeers {}  = True
 --
 newtype PoolStake = PoolStake { unPoolStake :: Rational }
   deriving (Eq, Ord, Show)
-  deriving newtype (Fractional, Num, NFData)
+  deriving newtype (Fractional, Num, NFData, ToCBOR, FromCBOR)
 
 -- | The accumulated relative stake of a stake pool, like PoolStake but it also includes the
 -- relative stake of all preceding pools. A value in the range [0, 1].

ouroboros-network-api/src/Ouroboros/Network/PeerSelection/RelayAccessPoint.hs

@@ -1,7 +1,9 @@
 {-# LANGUAGE BangPatterns      #-}
+{-# LANGUAGE LambdaCase        #-}
 {-# LANGUAGE NamedFieldPuns    #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PatternSynonyms   #-}
+{-# LANGUAGE TypeApplications  #-}
 {-# LANGUAGE ViewPatterns      #-}
 
 module Ouroboros.Network.PeerSelection.RelayAccessPoint
@@ -13,6 +15,7 @@ module Ouroboros.Network.PeerSelection.RelayAccessPoint
   ) where
 
 import Control.DeepSeq (NFData (..))
+import Control.Monad (when)
 
 import Data.Aeson
 import Data.IP qualified as IP
@@ -21,6 +24,7 @@ import Data.Text qualified as Text
 import Data.Text.Encoding (decodeUtf8, encodeUtf8)
 import Text.Read (readMaybe)
 
+import Cardano.Binary
 import Network.DNS qualified as DNS
 import Network.Socket qualified as Socket
 
@@ -53,6 +57,49 @@ data RelayAccessPoint = RelayAccessDomain  !DNS.Domain !Socket.PortNumber
                       | RelayAccessAddress !IP.IP      !Socket.PortNumber
   deriving (Eq, Ord)
 
+-- | These instances are used to serialize 'LedgerPeerSnapshot'
+-- consensus LocalStateQuery server which uses these instances
+-- for all its query responses. It appears they provide some improved
+-- debugging diagnostics over Serialize instances.
+instance ToCBOR RelayAccessPoint where
+  toCBOR = \case
+    RelayAccessDomain domain port ->
+         encodeListLen 3
+      <> encodeWord8 0
+      <> serialize' port
+      <> toCBOR domain
+    RelayAccessAddress (IP.IPv4 ipv4) port ->
+         encodeListLen 3
+      <> encodeWord8 1
+      <> serialize' port
+      <> toCBOR (IP.fromIPv4 ipv4)
+    RelayAccessAddress (IP.IPv6 ip6) port ->
+         encodeListLen 3
+      <> encodeWord8 2
+      <> serialize' port
+      <> toCBOR (IP.fromIPv6 ip6)
+    where
+      serialize' = toCBOR . toInteger
+
+instance FromCBOR RelayAccessPoint where
+  fromCBOR = do
+    listLen <- decodeListLen
+    when (listLen /= 3) . fail $    "Unrecognized RelayAccessPoint list length "
+                                 <> show listLen
+    constructorTag <- decodeWord8
+    port <- fromInteger <$> fromCBOR @Integer
+    case constructorTag of
+      0 -> do
+        domain <- fromCBOR
+        return $ RelayAccessDomain domain port
+      1 -> do
+        ip4 <- IP.IPv4 . IP.toIPv4 <$> fromCBOR
+        return $ RelayAccessAddress ip4 port
+      2 -> do
+        ip6 <- IP.IPv6 . IP.toIPv6 <$> fromCBOR
+        return $ RelayAccessAddress ip6 port
+      _ -> fail $ "Unrecognized RelayAccessPoint tag: " <> show constructorTag
+
 instance Show RelayAccessPoint where
     show (RelayAccessDomain domain port) =
       "RelayAccessDomain " ++ show domain ++ " " ++ show port