Add UseLedgerCloseToTip

Also adds lpGetPeersAfterSafeSlot consensus interface function
IntersectMBO · Jun 16, 2023 · f84f508 · f84f508
1 parent 130d7aa
commit f84f508
Show file tree

Hide file tree

Showing 4 changed files with 49 additions and 6 deletions.
diff --git a/ouroboros-network/CHANGELOG.md b/ouroboros-network/CHANGELOG.md
@@ -2,6 +2,19 @@
 
 ## 0.7.0.1
 
+### Breaking changes
+
+* Added `UseLedgerCloseToTip` to `UseLedger` type .
+
+  This is part of the effort of getting rid of `UseLedgerAfter` and use an automatic way 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, `lpGetPeersAfterSafeSlot` 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,24 @@ 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.
+      --
+      lpGetPeers :: SlotNo -> STM m (Maybe [(PoolStake, NonEmpty RelayAccessPoint)]),
+
+      -- | Return ledger peer information from a safe slot number.
+      --
+      -- The concrete implementation of this function comes from the consensus
+      -- layer. It plays a crucial role in managing these peers, by distributing
+      -- the load among locally configured root peers to ledger peers.
+      --
+      -- It's important to use this functionality carefully. We should not
+      -- start leveraging ledger peers unless it's absolutely safe. While the
+      -- likelihood of a successful long-range attack by a powerful adversary is
+      -- relatively low, precautions should be taken to avoid becoming a victim.
+      --
+      lpGetPeersAfterSafeSlot :: STM m (Maybe [(PoolStake, NonEmpty RelayAccessPoint)])
     }
 
 -- | Trace LedgerPeers events.
@@ -249,6 +268,11 @@ 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
+                                     peers_m <- atomically lpGetPeersAfterSafeSlot
+                                     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 (Just (Map.elems (accPoolStake sps))))
 
     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 (Just (Map.elems (accPoolStake lps))))
 
             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)
+                                            (return Nothing)
               }
 
           shouldChainSyncExit :: StrictTVar m (Maybe BlockNo) -> BlockHeader -> m Bool