Set the intersection of the ChainSync server when starting a dynamo

ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/PeerSimulator/Trace.hs

@@ -33,7 +33,8 @@ import           Ouroboros.Consensus.MiniProtocol.ChainSync.Client.Jumping
                      (Instruction (..), JumpResult (..), JumpInstruction (..))
 import           Ouroboros.Consensus.MiniProtocol.ChainSync.Client.State
                      (ChainSyncJumpingJumperState (..),
-                     ChainSyncJumpingState (..), JumpInfo (..))
+                     ChainSyncJumpingState (..), JumpInfo (..),
+                     DynamoInitState (..))
 import           Ouroboros.Consensus.Storage.ChainDB.API (LoE (..))
 import qualified Ouroboros.Consensus.Storage.ChainDB.Impl as ChainDB
 import           Ouroboros.Consensus.Storage.ChainDB.Impl.Types
@@ -224,7 +225,11 @@ traceSchedulerEventTestBlockWith setTickTime tracer0 _tracer = \case
 
     traceJumpingState :: ChainSyncJumpingState m TestBlock -> String
     traceJumpingState = \case
-      Dynamo lastJump -> "Dynamo " ++ terseWithOrigin show lastJump
+      Dynamo initState lastJump ->
+        let showInitState = case initState of
+              DynamoStarting ji -> terseJumpInfo ji
+              DynamoStarted -> "Nothing"
+         in unwords ["Dynamo", showInitState, terseWithOrigin show lastJump]
       Objector initState goodJumpInfo badPoint -> unwords
           [ "Objector"
           , show initState

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/MiniProtocol/ChainSync/Client/Jumping.hs

@@ -177,7 +177,9 @@ import           Ouroboros.Consensus.MiniProtocol.ChainSync.Client.State
                      (ChainSyncClientHandle (..),
                      ChainSyncJumpingJumperState (..),
                      ChainSyncJumpingState (..), ChainSyncState (..),
-                     JumpInfo (..), ObjectorInitState (..))
+                     JumpInfo (..),
+                     DynamoInitState (..),
+                     ObjectorInitState (..))
 import           Ouroboros.Consensus.Util.IOLike hiding (handle)
 import qualified Ouroboros.Network.AnchoredFragment as AF
 
@@ -367,7 +369,10 @@ nextInstruction ::
 nextInstruction context = whenEnabled context RunNormally $
   readTVar (cschJumping (handle context)) >>= \case
     Disengaged -> pure RunNormally
-    Dynamo{} -> pure RunNormally
+    Dynamo (DynamoStarting goodJumpInfo) _ ->
+      pure $ JumpInstruction $ JumpToGoodPoint goodJumpInfo
+    Dynamo DynamoStarted _ ->
+      pure RunNormally
     Objector Starting goodJump _ -> do
       pure $ JumpInstruction $ JumpToGoodPoint goodJump
     Objector Started _ _ -> pure RunNormally
@@ -403,7 +408,7 @@ onRollForward context point = whenEnabled context () $
       | otherwise -> pure ()
     Disengaged -> pure ()
     Jumper{} -> pure ()
-    Dynamo lastJumpSlot
+    Dynamo _ lastJumpSlot
       | let jumpBoundaryPlus1 = jumpSize context + succWithOrigin lastJumpSlot
       , succWithOrigin (pointSlot point) >= jumpBoundaryPlus1 -> do
           mJumpInfo <- readTVar (cschJumpInfo (handle context))
@@ -413,7 +418,7 @@ onRollForward context point = whenEnabled context () $
     setJumps Nothing = error "onRollForward: Dynamo without jump info"
     setJumps (Just jumpInfo) = do
         writeTVar (cschJumping (handle context)) $
-          Dynamo $ pointSlot $ AF.headPoint $ jTheirFragment jumpInfo
+          Dynamo DynamoStarted $ pointSlot $ AF.headPoint $ jTheirFragment jumpInfo
         handles <- readTVar (handlesVar context)
         forM_ (Map.elems handles) $ \h ->
           readTVar (cschJumping h) >>= \case
@@ -443,7 +448,7 @@ onRollBackward context slot = whenEnabled context () $
       | otherwise -> pure ()
     Disengaged -> pure ()
     Jumper{} -> pure ()
-    Dynamo lastJumpSlot
+    Dynamo _ lastJumpSlot
       | slot < lastJumpSlot -> do
           disengage (handle context)
           electNewDynamo (stripContext context)
@@ -483,14 +488,30 @@ onAwaitReply context = whenEnabled context () $
 -- objector, which might update many TVars.
 processJumpResult :: forall m peer blk.
   ( MonadSTM m,
+    Eq peer,
     LedgerSupportsProtocol blk
   ) =>
   PeerContext m peer blk ->
   JumpResult blk ->
   STM m ()
 processJumpResult context jumpResult = whenEnabled context () $
   readTVar (cschJumping (handle context)) >>= \case
-    Dynamo _ -> pure ()
+    Dynamo DynamoStarting{} lastJumpSlot ->
+      case jumpResult of
+        AcceptedJump (JumpToGoodPoint jumpInfo) -> do
+          writeTVar (cschJumping (handle context)) $
+            Dynamo DynamoStarted lastJumpSlot
+          updateChainSyncState (handle context) jumpInfo
+        RejectedJump JumpToGoodPoint{} -> do
+          disengage (handle context)
+          electNewDynamo (stripContext context)
+
+        -- Not interesting in the dynamo state
+        AcceptedJump JumpTo{} -> pure ()
+        RejectedJump JumpTo{} -> pure ()
+
+    Dynamo DynamoStarted _lastJumpSlot -> pure ()
+
     Disengaged -> pure ()
     Objector Starting goodJump badPoint ->
       case jumpResult of
@@ -563,6 +584,7 @@ processJumpResult context jumpResult = whenEnabled context () $
       let fragment = jTheirFragment jump
       modifyTVar (cschState handle) $ \csState ->
         csState {csCandidate = fragment, csLatestSlot = Just (AF.headSlot fragment) }
+      writeTVar (cschJumpInfo handle) $ Just jump
 
     mkGoodJumpInfo :: Maybe (JumpInfo blk) -> JumpInfo blk -> JumpInfo blk
     mkGoodJumpInfo mGoodJumpInfo badJumpInfo = do
@@ -637,8 +659,8 @@ getDynamo handlesVar = do
   handles <- Map.elems <$> readTVar handlesVar
   findM (\handle -> isDynamo <$> readTVar (cschJumping handle)) handles
   where
-    isDynamo (Dynamo _) = True
-    isDynamo _          = False
+    isDynamo Dynamo{} = True
+    isDynamo _        = False
 
 -- | Disengage a peer, meaning that it will no longer be asked to jump or
 -- act as dynamo or objector.
@@ -676,7 +698,7 @@ registerClient context peer csState mkHandle = do
   csjState <- getDynamo (handlesVar context) >>= \case
     Nothing -> do
       fragment <- csCandidate <$> readTVar csState
-      pure $ Dynamo $ pointSlot $ AF.anchorPoint fragment
+      pure $ Dynamo DynamoStarted $ pointSlot $ AF.anchorPoint fragment
     Just handle -> do
       mJustInfo <- readTVar (cschJumpInfo handle)
       newJumper mJustInfo (Happy Nothing)
@@ -701,7 +723,7 @@ unregisterClient context = do
     Disengaged -> pure ()
     Jumper{} -> pure ()
     Objector{} -> electNewObjector context'
-    Dynamo _ -> electNewDynamo context'
+    Dynamo{} -> electNewDynamo context'
 
 -- | Choose an unspecified new non-idling dynamo and demote all other peers to
 -- jumpers.
@@ -722,12 +744,14 @@ electNewDynamo context = do
       mJumpInfo <- readTVar (cschJumpInfo dynamo)
       -- We assume no rollbacks are possible earlier than the anchor of the
       -- candidate fragment
+      let dynamoInitState = maybe DynamoStarted DynamoStarting mJumpInfo
       writeTVar (cschJumping dynamo) $
-        Dynamo $ pointSlot $ AF.headPoint fragment
+        Dynamo dynamoInitState $ pointSlot $ AF.headPoint fragment
+      -- Demote all other peers to jumpers
       forM_ peerStates $ \(peer, st) ->
         when (peer /= dynId) $ do
           jumpingState <- readTVar (cschJumping st)
-          when (not (isDisengaged jumpingState)) $ do
+          when (not (isDisengaged jumpingState)) $
             newJumper mJumpInfo (Happy Nothing)
               >>= writeTVar (cschJumping st)
   where

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/MiniProtocol/ChainSync/Client/State.hs

@@ -13,6 +13,7 @@ module Ouroboros.Consensus.MiniProtocol.ChainSync.Client.State (
   , ChainSyncJumpingState (..)
   , ChainSyncState (..)
   , JumpInfo (..)
+  , DynamoInitState (..)
   , ObjectorInitState (..)
   ) where
 
@@ -87,6 +88,19 @@ deriving anyclass instance (
   NoThunks (Header blk)
   ) => NoThunks (ChainSyncClientHandle m blk)
 
+data DynamoInitState blk
+  = -- | The dynamo has not yet started jumping and we first need to jump to the
+    -- given jump info to set the intersection of the ChainSync server.
+    DynamoStarting !(JumpInfo blk)
+  | DynamoStarted
+  deriving (Generic)
+
+deriving anyclass instance
+  ( HasHeader blk,
+    LedgerSupportsProtocol blk,
+    NoThunks (Header blk)
+  ) => NoThunks (DynamoInitState blk)
+
 data ObjectorInitState
   = -- | The objector still needs to set the intersection of the ChainSync
     -- server before resuming retrieval of headers.
@@ -102,6 +116,7 @@ data ChainSyncJumpingState m blk
     -- honest, but the goal of the algorithm is to eventually have an honest,
     -- alert peer as dynamo.
     Dynamo
+      (DynamoInitState blk)
       -- | The last slot at which we triggered jumps for the jumpers.
       !(WithOrigin SlotNo)
   | -- | The objector, of which there is at most one, also runs normal