ChainDB: minor refactorings/simplifications (#1543)

The commits are intended to be reviewed individually, see their commit
messages.

No semantic changes.

Author: amesgen

ouroboros-consensus/changelog.d/20250602_100145_alexander.esgen_small_opts.md

@@ -0,0 +1,3 @@
+### Breaking
+
+- ChainDB internals: changed type of `FollowerHandle.fhSwitchFork`.

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/ChainSel.hs

@@ -102,7 +102,6 @@ import Ouroboros.Network.AnchoredFragment
   , AnchoredSeq (..)
   )
 import qualified Ouroboros.Network.AnchoredFragment as AF
-import qualified Ouroboros.Network.AnchoredSeq as AS
 import Ouroboros.Network.Protocol.LocalStateQuery.Type (Target (..))
 
 -- | Perform the initial chain selection based on the tip of the ImmutableDB
@@ -947,12 +946,11 @@ chainSelectionForBlock cdb@CDB{..} blockCache hdr punish = electric $ withRegist
             AddingBlocks -> pure ()
             SwitchingToAFork -> do
               -- Update the followers
-              --
-              -- 'Follower.switchFork' needs to know the intersection point
-              -- (@ipoint@) between the old and the current chain.
-              let ipoint = castPoint $ Diff.getAnchorPoint chainDiff
               followerHandles <- Map.elems <$> readTVar cdbFollowers
-              forM_ followerHandles $ switchFollowerToFork curChain newChain ipoint
+              -- The suffix of @curChain@ that we are going to orphan by
+              -- adopting @chainDiff@.
+              let oldSuffix = AF.anchorNewest (getRollback chainDiff) curChain
+              forM_ followerHandles $ \hdl -> fhSwitchFork hdl oldSuffix
 
           return (curChain, newChain, events, prevTentativeHeader, newLedger)
     let mkTraceEvent = case chainSwitchType of
@@ -967,18 +965,6 @@ chainSelectionForBlock cdb@CDB{..} blockCache hdr punish = electric $ withRegist
 
     forkerClose newForker
    where
-    -- Given the current chain and the new chain as chain fragments, and the
-    -- intersection point (an optimization, since it has already been
-    -- computed when calling this function), returns a function that updates
-    -- the state of a follower via its handle.
-    switchFollowerToFork curChain newChain ipoint =
-      let oldPoints =
-            Set.fromList . fmap headerPoint . AS.toOldestFirst $
-              Diff.getSuffix $
-                Diff.diff newChain curChain
-       in assert (AF.withinFragmentBounds (castPoint ipoint) newChain) $
-            \followerHandle -> fhSwitchFork followerHandle ipoint oldPoints
-
     ValidatedChainDiff chainDiff newForker = vChainDiff
 
   -- \| We have a new block @b@ that doesn't fit onto the current chain, but
@@ -1174,9 +1160,8 @@ chainSelection chainSelEnv rr chainDiffs =
         writeTVar varTentativeHeader SNothing
         writeTVar varTentativeState tentativeSt
         forTentativeFollowers $ \followerHandle -> do
-          let curTipPoint = castPoint $ AF.headPoint curChain
-              oldPoints = Set.singleton $ headerPoint tentativeHeader
-          fhSwitchFork followerHandle curTipPoint oldPoints
+          let oldSuffix = AF.Empty (AF.headAnchor curChain) AF.:> tentativeHeader
+          fhSwitchFork followerHandle oldSuffix
       traceWith pipeliningTracer $ TrapTentativeHeader tentativeHeader
      where
       forTentativeFollowers f = getTentativeFollowers >>= mapM_ f

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/Follower.hs

@@ -25,8 +25,6 @@ import Data.Functor ((<&>))
 import Data.Functor.Identity (Identity (..))
 import qualified Data.Map.Strict as Map
 import Data.Maybe.Strict (StrictMaybe (..))
-import Data.Set (Set)
-import qualified Data.Set as Set
 import Ouroboros.Consensus.Block
 import Ouroboros.Consensus.Config
 import Ouroboros.Consensus.Storage.ChainDB.API
@@ -126,9 +124,8 @@ newFollower h registry chainType blockComponent = getEnv h $ \CDB{..} -> do
           -- 'closeAllFollowers' will empty that map already.
           followerState <- atomically $ readTVar varFollower
           closeFollowerState followerState
-      , fhSwitchFork = \ipoint oldPoints ->
-          modifyTVar varFollower $
-            switchFork ipoint oldPoints
+      , fhSwitchFork = \oldSuffix ->
+          modifyTVar varFollower $ switchFork oldSuffix
       }
 
 makeNewFollower ::
@@ -505,29 +502,27 @@ forward registry varFollower blockComponent CDB{..} =
                       writeTVar varFollower $
                         FollowerInImmutableDB (RollBackTo pt) immIt
                     return True
-            _otherwise -> case pointToWithOriginRealPoint pt of
+            _otherwise -> case pt of
               -- Genesis is always "in" the ImmutableDB
-              Origin -> do
+              GenesisPoint -> do
                 join $ atomically $ updateState FollowerInit
                 return True
-              NotOrigin pt' -> do
-                inImmutableDB <- ImmutableDB.hasBlock cdbImmutableDB pt'
-                if inImmutableDB
-                  then do
-                    immIt <-
-                      ImmutableDB.streamAfterKnownPoint
-                        cdbImmutableDB
-                        registry
-                        ((,) <$> getPoint <*> blockComponent)
-                        pt
-                    join $
-                      atomically $
-                        updateState $
-                          FollowerInImmutableDB (RollBackTo pt) immIt
-                    return True
-                  else
-                    -- The point is not in the current chain
-                    return False
+              BlockPoint{} ->
+                ImmutableDB.streamAfterPoint
+                  cdbImmutableDB
+                  registry
+                  ((,) <$> getPoint <*> blockComponent)
+                  pt
+                  >>= \case
+                    Right immIt -> do
+                      join $
+                        atomically $
+                          updateState $
+                            FollowerInImmutableDB (RollBackTo pt) immIt
+                      return True
+                    Left _ ->
+                      -- The point is not in the current chain
+                      return False
 
   -- \| Update the state of the follower to the given state. If the current
   -- state is 'FollowerInImmutableDB', close the ImmutableDB iterator to avoid
@@ -547,25 +542,26 @@ forward registry varFollower blockComponent CDB{..} =
 -- intersection point if it is.
 switchFork ::
   forall m blk b.
-  HasHeader blk =>
-  -- | Intersection point between the new and the old chain.
-  Point blk ->
-  -- | Set of points that are in the old chain and not in the
-  -- new chain.
-  Set (Point blk) ->
+  GetHeader blk =>
+  -- | Suffix of the old chain anchored at the intersection with the new chain.
+  AnchoredFragment (Header blk) ->
   FollowerState m blk b ->
   FollowerState m blk b
-switchFork ipoint oldPoints =
+switchFork oldSuffix =
   \case
     -- Roll back to the intersection point if and only if the position of the
     -- follower is not in the new chain, but was part of the volatile DB. By the
     -- invariant that the follower state is always in the current chain, it then
-    -- should be in `oldPoints`.
+    -- should be on `oldSuffix` (ignoring the anchor).
     FollowerInMem (RollBackTo pt)
-      | pt `Set.member` oldPoints -> FollowerInMem (RollBackTo ipoint)
+      | isOnOldSuffix pt -> FollowerInMem (RollBackTo ipoint)
     FollowerInMem (RollForwardFrom pt)
-      | pt `Set.member` oldPoints -> FollowerInMem (RollBackTo ipoint)
+      | isOnOldSuffix pt -> FollowerInMem (RollBackTo ipoint)
     followerState -> followerState
+ where
+  ipoint = castPoint $ AF.anchorPoint oldSuffix
+
+  isOnOldSuffix pt = AF.pointOnFragment (castPoint pt) oldSuffix
 
 -- | Close all open block and header 'Follower's.
 closeAllFollowers ::

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/Types.hs

@@ -87,7 +87,6 @@ import Data.Maybe (mapMaybe)
 import Data.Maybe.Strict (StrictMaybe (..))
 import Data.MultiSet (MultiSet)
 import qualified Data.MultiSet as MultiSet
-import Data.Set (Set)
 import Data.Typeable
 import Data.Void (Void)
 import Data.Word (Word64)
@@ -425,8 +424,11 @@ newtype FollowerKey = FollowerKey Word
 data FollowerHandle m blk = FollowerHandle
   { fhChainType :: ChainType
   -- ^ Whether we follow the tentative chain.
-  , fhSwitchFork :: Point blk -> Set (Point blk) -> STM m ()
+  , fhSwitchFork :: AnchoredFragment (Header blk) -> STM m ()
   -- ^ When we have switched to a fork, all open 'Follower's must be notified.
+  --
+  -- Receives the suffix of the old chain anchored at the intersection with the
+  -- new chain.
   , fhClose :: m ()
   -- ^ When closing the ChainDB, we must also close all open 'Follower's, as
   -- they might be holding on to resources.