Support for big ledger peer snapshot

This change introduces support for big ledger peers in the node.
A new optional entry in network topology JSON parser is added that is intended
to point to a path containing a serialized snapshot of big ledger peers
taken from some slot a priori. When present, this file is decoded
at node startup, or when a SIGHUP is triggered, and made available
to the diffusion layer via reading from a TVar.

cardano-node/ChangeLog.md

@@ -3,6 +3,11 @@
 ## Next version
 
 - Use p2p network stack by default, warn when using the legacy network stack.
+- Ledger peer snapshot path entry added to topology JSON parser,
+  which a new decoder function `readPeerSnapshotFile` processes
+  at startup and SIGHUP. Data is available to the diffusion layer
+  via TVar.
+
 
 ## 8.2.1 -- August 2023
 

cardano-node/cardano-node.cabal

@@ -145,6 +145,7 @@ library
                       , base16-bytestring
                       , bytestring
                       , cardano-api ^>= 8.44
+                      , cardano-binary
                       , cardano-crypto-class
                       , cardano-crypto-wrapper
                       , cardano-git-rev ^>=0.2.2

cardano-node/src/Cardano/Node/Configuration/TopologyP2P.hs

@@ -18,11 +18,13 @@ module Cardano.Node.Configuration.TopologyP2P
   , PeerAdvertise(..)
   , nodeAddressToSockAddr
   , readTopologyFile
+  , readPeerSnapshotFile
   , readTopologyFileOrError
   , rootConfigToRelayAccessPoint
   )
 where
 
+import           Cardano.Binary
 import           Cardano.Node.Configuration.NodeAddress
 import           Cardano.Node.Configuration.POM (NodeConfiguration (..))
 import           Cardano.Node.Configuration.Topology (TopologyError (..))
@@ -31,16 +33,20 @@ import           Cardano.Node.Types
 import           Cardano.Tracing.OrphanInstances.Network ()
 import           Ouroboros.Network.NodeToNode (PeerAdvertise (..))
 import           Ouroboros.Network.PeerSelection.Bootstrap (UseBootstrapPeers (..))
-import           Ouroboros.Network.PeerSelection.LedgerPeers.Type (UseLedgerPeers (..))
+import           Ouroboros.Network.PeerSelection.LedgerPeers.Type (LedgerPeerSnapshot (..),
+                   UseLedgerPeers (..))
 import           Ouroboros.Network.PeerSelection.PeerTrustable (PeerTrustable (..))
 import           Ouroboros.Network.PeerSelection.RelayAccessPoint (RelayAccessPoint (..))
 import           Ouroboros.Network.PeerSelection.State.LocalRootPeers (HotValency (..),
                    WarmValency (..))
 
+import           Codec.CBOR.Read
 import           Control.Applicative (Alternative (..))
+import           Control.DeepSeq
 import           Control.Exception (IOException)
 import qualified Control.Exception as Exception
 import           Control.Exception.Base (Exception (..))
+import           Control.Monad.Trans.Except.Extra
 import           "contra-tracer" Control.Tracer (Tracer, traceWith)
 import           Data.Aeson
 import           Data.Bifunctor (Bifunctor (..))
@@ -175,6 +181,7 @@ data NetworkTopology = RealNodeTopology { ntLocalRootPeersGroups :: !LocalRootPe
                                         , ntPublicRootPeers      :: ![PublicRootPeers]
                                         , ntUseLedgerPeers       :: !UseLedgerPeers
                                         , ntUseBootstrapPeers    :: !UseBootstrapPeers
+                                        , ntPeerSnapshotPath     :: !(Maybe PeerSnapshotFile)
                                         }
   deriving (Eq, Show)
 
@@ -183,7 +190,8 @@ instance FromJSON NetworkTopology where
                 RealNodeTopology <$> (o .: "localRoots"                                  )
                                  <*> (o .: "publicRoots"                                 )
                                  <*> (o .:? "useLedgerAfterSlot" .!= DontUseLedgerPeers  )
-                                 <*> (o .:? "bootstrapPeers" .!= DontUseBootstrapPeers)
+                                 <*> (o .:? "bootstrapPeers" .!= DontUseBootstrapPeers   )
+                                 <*> (o .:? "peerSnapshotFile")
 
 instance ToJSON NetworkTopology where
   toJSON top =
@@ -192,10 +200,12 @@ instance ToJSON NetworkTopology where
                        , ntPublicRootPeers
                        , ntUseLedgerPeers
                        , ntUseBootstrapPeers
+                       , ntPeerSnapshotPath
                        } -> object [ "localRoots"         .= ntLocalRootPeersGroups
                                    , "publicRoots"        .= ntPublicRootPeers
                                    , "useLedgerAfterSlot" .= ntUseLedgerPeers
                                    , "bootstrapPeers"     .= ntUseBootstrapPeers
+                                   , "peerSnapshotFile"   .= ntPeerSnapshotPath
                                    ]
 
 --
@@ -235,7 +245,8 @@ instance FromJSON (Legacy NetworkTopology) where
               RealNodeTopology <$> fmap getLegacy (o .: "LocalRoots")
                                <*> fmap getLegacy (o .: "PublicRoots")
                                <*> (o .:? "useLedgerAfterSlot" .!= DontUseLedgerPeers)
-                               <*> pure DontUseBootstrapPeers)
+                               <*> pure DontUseBootstrapPeers
+                               <*> pure Nothing)
 
 -- | Read the `NetworkTopology` configuration from the specified file.
 --
@@ -297,14 +308,24 @@ readTopologyFileOrError tr nc =
                            <> Text.unpack err)
              pure
 
+readPeerSnapshotFile :: PeerSnapshotFile -> IO LedgerPeerSnapshot
+readPeerSnapshotFile (PeerSnapshotFile psf) = either error pure =<< runExceptT
+  (handleLeftT (left . ("Cardano.Node.Configuration.TopologyP2P.readPeerSnapshotFile: " <>)) $ do
+    contents <- BS.readFile psf `catchIOExceptT` displayException
+    -- sweep it out eagerly
+    let tryDecode = force . deserialiseFromBytes fromCBOR . LBS.fromStrict $ contents
+    case tryDecode of
+      Left _ -> left "Peer snapshot file read but decode failed - incompatible or corrupted file?"
+      Right (_, lps) -> right lps)
+
 --
 -- Checking for chance of progress in bootstrap phase
 --
 
 -- | This function returns false if non-trustable peers are configured
 --
 isValidTrustedPeerConfiguration :: NetworkTopology -> Bool
-isValidTrustedPeerConfiguration (RealNodeTopology (LocalRootPeersGroups lprgs) _ _ ubp) =
+isValidTrustedPeerConfiguration (RealNodeTopology (LocalRootPeersGroups lprgs) _ _ ubp _) =
     case ubp of
       DontUseBootstrapPeers   -> True
       UseBootstrapPeers []    -> anyTrustable

cardano-node/src/Cardano/Node/Run.hs

@@ -8,8 +8,8 @@
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE PackageImports #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TupleSections #-}
+{-# LANGUAGE TypeApplications #-}
 
 {-# OPTIONS_GHC -Wno-unused-imports #-}
 
@@ -39,12 +39,14 @@ import           Control.Monad.Class.MonadThrow (MonadThrow (..))
 import           Control.Monad.IO.Class (MonadIO (..))
 import           Control.Monad.Trans.Except (ExceptT, runExceptT)
 import           Control.Monad.Trans.Except.Extra (left)
+import           Control.Monad.Trans.Maybe (MaybeT (..), mapMaybeT)
 import           "contra-tracer" Control.Tracer
 import           Data.Either (partitionEithers)
 import           Data.Map.Strict (Map)
 import qualified Data.Map.Strict as Map
 import           Data.Maybe (catMaybes, fromMaybe, mapMaybe)
 import           Data.Monoid (Last (..))
+import           Data.Foldable (traverse_)
 import           Data.Proxy (Proxy (..))
 import           Data.Text (Text, breakOn, pack)
 import qualified Data.Text as Text
@@ -125,7 +127,7 @@ import           Cardano.Node.TraceConstraints (TraceConstraints)
 import           Cardano.Tracing.Tracers
 import           Ouroboros.Network.PeerSelection.PeerSharing (PeerSharing (..))
 import           Ouroboros.Network.PeerSelection.State.LocalRootPeers (HotValency, WarmValency)
-import           Ouroboros.Network.PeerSelection.LedgerPeers.Type (UseLedgerPeers)
+import           Ouroboros.Network.PeerSelection.LedgerPeers.Type (LedgerPeerSnapshot (..), UseLedgerPeers)
 import           Ouroboros.Network.PeerSelection.PeerTrustable (PeerTrustable)
 import           Ouroboros.Network.PeerSelection.Bootstrap (UseBootstrapPeers)
 
@@ -420,16 +422,24 @@ handleSimpleNode blockType runP p2pMode tracers nc onKernel = do
         nt@TopologyP2P.RealNodeTopology
           { ntUseLedgerPeers
           , ntUseBootstrapPeers
+          , ntPeerSnapshotPath
           } <- TopologyP2P.readTopologyFileOrError (startupTracer tracers) nc
         let (localRoots, publicRoots) = producerAddresses nt
         traceWith (startupTracer tracers)
                 $ NetworkConfig localRoots
                                 publicRoots
                                 ntUseLedgerPeers
-        localRootsVar <- newTVarIO localRoots
-        publicRootsVar <- newTVarIO publicRoots
-        useLedgerVar   <- newTVarIO ntUseLedgerPeers
+                                ntPeerSnapshotPath
+        localRootsVar   <- newTVarIO localRoots
+        publicRootsVar  <- newTVarIO publicRoots
+        useLedgerVar    <- newTVarIO ntUseLedgerPeers
         useBootstrapVar <- newTVarIO ntUseBootstrapPeers
+        ledgerPeerSnapshotPathVar <- newTVarIO ntPeerSnapshotPath
+        ledgerPeerSnapshotVar <- newTVarIO =<< updateLedgerPeerSnapshot
+                                                (startupTracer tracers)
+                                                (readTVar ledgerPeerSnapshotPathVar)
+                                                (const . pure $ ())
+
         let nodeArgs = RunNodeArgs
               { rnTraceConsensus = consensusTracers tracers
               , rnTraceNTN       = nodeToNodeTracers tracers
@@ -462,6 +472,11 @@ handleSimpleNode blockType runP p2pMode tracers nc onKernel = do
                 updateTopologyConfiguration
                   (startupTracer tracers) nc
                   localRootsVar publicRootsVar useLedgerVar useBootstrapVar
+                  ledgerPeerSnapshotPathVar
+                void $ updateLedgerPeerSnapshot
+                  (startupTracer tracers)
+                  (readTVar ledgerPeerSnapshotPathVar)
+                  (writeTVar ledgerPeerSnapshotVar)
                 traceWith (startupTracer tracers) (BlockForgingUpdate NotEffective)
               )
               Nothing
@@ -473,13 +488,15 @@ handleSimpleNode blockType runP p2pMode tracers nc onKernel = do
                   (readTVar publicRootsVar)
                   (readTVar useLedgerVar)
                   (readTVar useBootstrapVar)
+                  (readTVar ledgerPeerSnapshotVar)
           in
           Node.run
             nodeArgs {
                 rnNodeKernelHook = \registry nodeKernel -> do
                   -- reinstall `SIGHUP` handler
                   installP2PSigHUPHandler (startupTracer tracers) blockType nc nodeKernel
                                           localRootsVar publicRootsVar useLedgerVar useBootstrapVar
+                                          ledgerPeerSnapshotPathVar
                   rnNodeKernelHook nodeArgs registry nodeKernel
             }
             StdRunNodeArgs
@@ -648,17 +665,19 @@ installP2PSigHUPHandler :: Tracer IO (StartupTrace blk)
                         -> StrictTVar IO (Map RelayAccessPoint PeerAdvertise)
                         -> StrictTVar IO UseLedgerPeers
                         -> StrictTVar IO UseBootstrapPeers
+                        -> StrictTVar IO (Maybe PeerSnapshotFile)
                         -> IO ()
 #ifndef UNIX
 installP2PSigHUPHandler _ _ _ _ _ _ _ _ = return ()
 #else
 installP2PSigHUPHandler startupTracer blockType nc nodeKernel localRootsVar publicRootsVar useLedgerVar
-                        useBootstrapPeersVar =
+                        useBootstrapPeersVar ledgerPeerSnapshotPathVar =
   void $ Signals.installHandler
     Signals.sigHUP
     (Signals.Catch $ do
       updateBlockForging startupTracer blockType nodeKernel nc
-      updateTopologyConfiguration startupTracer nc localRootsVar publicRootsVar useLedgerVar useBootstrapPeersVar
+      updateTopologyConfiguration startupTracer nc localRootsVar publicRootsVar
+                                  useLedgerVar useBootstrapPeersVar ledgerPeerSnapshotPathVar
     )
     Nothing
 #endif
@@ -743,9 +762,10 @@ updateTopologyConfiguration :: Tracer IO (StartupTrace blk)
                             -> StrictTVar IO (Map RelayAccessPoint PeerAdvertise)
                             -> StrictTVar IO UseLedgerPeers
                             -> StrictTVar IO UseBootstrapPeers
+                            -> StrictTVar IO (Maybe PeerSnapshotFile)
                             -> IO ()
 updateTopologyConfiguration startupTracer nc localRootsVar publicRootsVar useLedgerVar
-                            useBootsrapPeersVar = do
+                            useBootsrapPeersVar ledgerPeerSnapshotPathVar = do
     traceWith startupTracer NetworkConfigUpdate
     result <- try $ readTopologyFileOrError startupTracer nc
     case result of
@@ -755,17 +775,36 @@ updateTopologyConfiguration startupTracer nc localRootsVar publicRootsVar useLed
                 $ pack "Error reading topology configuration file:" <> err
       Right nt@RealNodeTopology { ntUseLedgerPeers
                                 , ntUseBootstrapPeers
+                                , ntPeerSnapshotPath
                                 } -> do
         let (localRoots, publicRoots) = producerAddresses nt
         traceWith startupTracer
-                $ NetworkConfig localRoots publicRoots ntUseLedgerPeers
+                $ NetworkConfig localRoots publicRoots ntUseLedgerPeers ntPeerSnapshotPath
         atomically $ do
           writeTVar localRootsVar localRoots
           writeTVar publicRootsVar publicRoots
           writeTVar useLedgerVar ntUseLedgerPeers
           writeTVar useBootsrapPeersVar ntUseBootstrapPeers
+          writeTVar ledgerPeerSnapshotPathVar ntPeerSnapshotPath
 #endif
 
+updateLedgerPeerSnapshot :: Tracer IO (StartupTrace blk)
+                         -> STM IO (Maybe PeerSnapshotFile)
+                         -> (Maybe LedgerPeerSnapshot -> STM IO ())
+                         -> IO (Maybe LedgerPeerSnapshot)
+updateLedgerPeerSnapshot startupTracer readLedgerPeerPath writeVar = runMaybeT $
+              (\io_m_lps -> do
+                  m_lps <- io_m_lps
+                  traverse_ (\(LedgerPeerSnapshot (wOrigin, _)) ->
+                               traceWith startupTracer
+                                         (LedgerPeerSnapshotLoaded wOrigin)) m_lps
+                  atomically . writeVar $ m_lps
+                  io_m_lps)
+              -- ^ ensures that snapshot payload TVar is updated to Nothing
+              -- if the path entry is removed from topology file sometime
+              -- before sighup
+  `mapMaybeT` (liftIO . readPeerSnapshotFile =<< MaybeT (atomically readLedgerPeerPath))
+
 --------------------------------------------------------------------------------
 -- Helper functions
 --------------------------------------------------------------------------------
@@ -823,6 +862,7 @@ mkP2PArguments
   -> STM IO (Map RelayAccessPoint PeerAdvertise)
   -> STM IO UseLedgerPeers
   -> STM IO UseBootstrapPeers
+  -> STM IO (Maybe LedgerPeerSnapshot)
   -> Diffusion.ExtraArguments 'Diffusion.P2P IO
 mkP2PArguments NodeConfiguration {
                  ncTargetNumberOfRootPeers,
@@ -839,13 +879,15 @@ mkP2PArguments NodeConfiguration {
                daReadLocalRootPeers
                daReadPublicRootPeers
                daReadUseLedgerPeers
-               daReadUseBootstrapPeers =
+               daReadUseBootstrapPeers
+               daReadLedgerPeerSnapshot =
     Diffusion.P2PArguments P2P.ArgumentsExtra
       { P2P.daPeerSelectionTargets
       , P2P.daReadLocalRootPeers
       , P2P.daReadPublicRootPeers
       , P2P.daReadUseLedgerPeers
       , P2P.daReadUseBootstrapPeers
+      , P2P.daReadLedgerPeerSnapshot
       , P2P.daProtocolIdleTimeout   = ncProtocolIdleTimeout
       , P2P.daTimeWaitTimeout       = ncTimeWaitTimeout
       , P2P.daDeadlineChurnInterval = 3300

cardano-node/src/Cardano/Node/Startup.hs

@@ -19,6 +19,8 @@ import           Cardano.Node.Configuration.POM (NodeConfiguration (..), ncProto
 import           Cardano.Node.Configuration.Socket
 import           Cardano.Node.Protocol (ProtocolInstantiationError)
 import           Cardano.Node.Protocol.Types (SomeConsensusProtocol (..))
+import           Cardano.Node.Types (PeerSnapshotFile)
+import           Cardano.Slotting.Slot (SlotNo, WithOrigin)
 import qualified Ouroboros.Consensus.BlockchainTime.WallClock.Types as WCT
 import           Ouroboros.Consensus.Cardano.Block
 import           Ouroboros.Consensus.Cardano.CanHardFork (shelleyLedgerConfig)
@@ -113,6 +115,7 @@ data StartupTrace blk =
   | NetworkConfig [(HotValency, WarmValency, Map RelayAccessPoint (PeerAdvertise, PeerTrustable))]
                   (Map RelayAccessPoint PeerAdvertise)
                   UseLedgerPeers
+                  (Maybe PeerSnapshotFile)
 
   -- | Warn when 'DisabledP2P' is set.
   | NonP2PWarning
@@ -131,6 +134,7 @@ data StartupTrace blk =
   | BIShelley BasicInfoShelleyBased
   | BIByron BasicInfoByron
   | BINetwork BasicInfoNetwork
+  | LedgerPeerSnapshotLoaded (WithOrigin SlotNo)
 
 data EnabledBlockForging = EnabledBlockForging
                          | DisabledBlockForging