Added new UseLedgerCloseToTip flag value

Adds readSafeSlotToUseLedgerPeers consensus interface function
IntersectMBO · May 16, 2023 · 1b9a8f4 · 1b9a8f4
1 parent 130d7aa
commit 1b9a8f4
Show file tree

Hide file tree

Showing 4 changed files with 57 additions and 6 deletions.
diff --git a/ouroboros-network/CHANGELOG.md b/ouroboros-network/CHANGELOG.md
@@ -2,6 +2,21 @@
 
 ## 0.7.0.1
 
+### Breaking changes
+
+* Added new value to `UseLedgerAfter` flag: `UseLedgerCloseToTip`.
+
+  This will be used in order to distribute the load of locally
+  configured root peers to ledger peers. However this needs to be done
+  carefully, one shouldn't start using ledger peers if it's not safe to
+  do so. A good time to switch and start using ledger peers is determined
+  by choosing the point so that the probability that a 50% stake
+  adversarial would be chosen k times to produce a block is sufficiently
+  low.
+
+- Given the text above, a new ledger peers consensus interface function `readSafeSlotToUseLedgerPeers`
+  was added.
+
 ### Non-breaking changes
 
 * Updated to use `ouroboros-network-api-0.5.0.0`.

diff --git a/ouroboros-network/src/Ouroboros/Network/PeerSelection/LedgerPeers.hs b/ouroboros-network/src/Ouroboros/Network/PeerSelection/LedgerPeers.hs
@@ -51,7 +51,10 @@ import           Ouroboros.Network.PeerSelection.RootPeersDNS
 import           Text.Printf
 
 -- | Only use the ledger after the given slot number.
-data UseLedgerAfter = DontUseLedger | UseLedgerAfter SlotNo deriving (Eq, Show)
+data UseLedgerAfter = DontUseLedger
+                    | UseLedgerAfter SlotNo
+                    | UseLedgerCloseToTip
+                    deriving (Eq, Show)
 
 isLedgerPeersEnabled :: UseLedgerAfter -> Bool
 isLedgerPeersEnabled DontUseLedger = False
@@ -63,8 +66,29 @@ data IsLedgerPeer = IsLedgerPeer | IsNotLedgerPeer
 
 newtype NumberOfPeers = NumberOfPeers Word16 deriving Show
 
-newtype LedgerPeersConsensusInterface m = LedgerPeersConsensusInterface {
-      lpGetPeers :: SlotNo -> STM m (Maybe [(PoolStake, NonEmpty RelayAccessPoint)])
+data LedgerPeersConsensusInterface m = LedgerPeersConsensusInterface {
+      -- | Return ledger peer information from given slot number.
+      --
+      -- If the slot number provided is greater than our current tip this should
+      -- return Nothing. Given this, this function only returns Just values if
+      -- the node's current tip is caught up with the given slot number.
+      --
+      lpGetPeers :: SlotNo -> STM m (Maybe [(PoolStake, NonEmpty RelayAccessPoint)]),
+
+      -- | The consensus layer functionality that the management of local root
+      -- peers vs ledger peers logic requires.
+      --
+      -- This will be used in order to distribute the load of locally
+      -- configured root peers to ledger peers. However this needs to be done
+      -- carefully, one shouldn't start using ledger peers if it's not safe to
+      -- do so. A good time to switch and start using ledger peers is determined
+      -- by choosing the point so that the probability that a 50% stake
+      -- adversarial would be chosen k times to produce a block is sufficiently
+      -- low.
+      --
+      -- | Read the slot after which is safe to use ledger peers.
+      --
+      readSafeSlotToUseLedgerPeers :: STM m SlotNo
     }
 
 -- | Trace LedgerPeers events.
@@ -249,6 +273,12 @@ ledgerPeersThread inRng toPeerAddr tracer readUseLedgerAfter LedgerPeersConsensu
                                      let peers = maybe Map.empty accPoolStake peers_m
                                      traceWith tracer $ FetchingNewLedgerState $ Map.size peers
                                      return (peers, now)
+                                   UseLedgerCloseToTip -> do
+                                     safeSlot <- atomically readSafeSlotToUseLedgerPeers
+                                     peers_m <- atomically $ lpGetPeers safeSlot
+                                     let peers = maybe Map.empty accPoolStake peers_m
+                                     traceWith tracer $ FetchingNewLedgerState $ Map.size peers
+                                     return (peers, now)
 
                              else do
                                  traceWith tracer $ ReusingLedgerState (Map.size peerMap) age

diff --git a/ouroboros-network/test/Test/LedgerPeers.hs b/ouroboros-network/test/Test/LedgerPeers.hs
@@ -124,7 +124,10 @@ prop_pick100 seed =
                                         ]
                 )
           where
-            interface = LedgerPeersConsensusInterface $ \_ -> pure (Just (Map.elems (accPoolStake sps)))
+            interface =
+              LedgerPeersConsensusInterface
+                (\_ -> pure (Just (Map.elems (accPoolStake sps))))
+                (pure (-1))
 
     in ioProperty $ do
         tr' <- evaluateTrace (runSimTrace sim)
@@ -162,7 +165,9 @@ prop_pick (LedgerPools lps) count seed =
                 )
           where
             interface :: LedgerPeersConsensusInterface (IOSim s)
-            interface = LedgerPeersConsensusInterface $ \_ -> pure (Just (Map.elems (accPoolStake lps)))
+            interface = LedgerPeersConsensusInterface
+                          (\_ -> pure (Just (Map.elems (accPoolStake lps))))
+                          (pure (-1))
 
             domainMap :: Map Domain (Set IP)
             domainMap = Map.fromList [("relay.iohk.example", Set.singleton (read "2.2.2.2"))]

diff --git a/ouroboros-network/test/Test/Ouroboros/Network/Testnet/Simulation/Node.hs b/ouroboros-network/test/Test/Ouroboros/Network/Testnet/Simulation/Node.hs
@@ -883,7 +883,8 @@ diffusionSimulation
               , NodeKernel.iDomainMap         = dMapVar
               , NodeKernel.iLedgerPeersConsensusInterface
                                         = LedgerPeersConsensusInterface
-                                        $ \_ -> return Nothing
+                                            (\_ -> return Nothing)
+                                            (pure (-1))
               }
 
           shouldChainSyncExit :: StrictTVar m (Maybe BlockNo) -> BlockHeader -> m Bool