ChainDB: don't read the header at the ImmutableDB's tip on startup

Fixes #1594.
IntersectMBO · Feb 7, 2020 · 624b60a · 624b60a
1 parent 901b746
commit 624b60a
Show file tree

Hide file tree

Showing 3 changed files with 23 additions and 46 deletions.
diff --git a/ouroboros-consensus/src/Ouroboros/Storage/ChainDB/Impl.hs b/ouroboros-consensus/src/Ouroboros/Storage/ChainDB/Impl.hs
@@ -35,19 +35,15 @@ import           Control.Tracer
 import           Control.Monad.Class.MonadThrow (bracket)
 
 import qualified Ouroboros.Network.AnchoredFragment as AF
-import           Ouroboros.Network.Block (HasHeader (..), castPoint,
-                     genesisPoint)
+import           Ouroboros.Network.Block (castPoint)
 
-import           Ouroboros.Consensus.Block (headerPoint, toIsEBB)
+import           Ouroboros.Consensus.Block (toIsEBB)
 import           Ouroboros.Consensus.BlockchainTime (getCurrentSlot)
 import           Ouroboros.Consensus.Ledger.Abstract
 import           Ouroboros.Consensus.Util.IOLike
 import           Ouroboros.Consensus.Util.STM (Fingerprint (..),
                      WithFingerprint (..))
 
-import           Ouroboros.Storage.Common (EpochNo)
-import           Ouroboros.Storage.EpochInfo (epochInfoEpoch)
-
 import           Ouroboros.Storage.ChainDB.API
 
 import           Ouroboros.Storage.ChainDB.Impl.Args (ChainDbArgs, defaultArgs)
@@ -88,14 +84,8 @@ openDBInternal
   -> m (ChainDB m blk, Internal m blk)
 openDBInternal args launchBgTasks = do
     immDB <- ImmDB.openDB argsImmDb
-    -- In order to figure out the 'BlockNo' and 'Point' at the tip of the
-    -- ImmutableDB, we need to read the header at the tip of the ImmutableDB.
-    immDbTipHeader <- sequence =<< ImmDB.getBlockComponentAtTip immDB GetHeader
-    -- Note that 'immDbTipBlockNo' might not end up being the \"immutable\"
-    -- block(no), because the current chain computed from the VolatileDB could
-    -- be longer than @k@.
-    let immDbTipPoint = maybe genesisPoint headerPoint immDbTipHeader
-    immDbTipEpoch    <- maybe (return 0)   blockEpoch  immDbTipHeader
+    immDbTipPoint <- ImmDB.getPointAtTip immDB
+    immDbTipEpoch <- Reopen.pointToEpoch (Args.cdbEpochInfo args) immDbTipPoint
     traceWith tracer $ TraceOpenEvent $ OpenedImmDB
       { _immDbTip      = immDbTipPoint
       , _immDbTipEpoch = immDbTipEpoch
@@ -201,6 +191,3 @@ openDBInternal args launchBgTasks = do
   where
     tracer = Args.cdbTracer args
     (argsImmDb, argsVolDb, argsLgrDb, _) = Args.fromChainDbArgs args
-
-    blockEpoch :: forall b. HasHeader b => b -> m EpochNo
-    blockEpoch = epochInfoEpoch (Args.cdbEpochInfo args) . blockSlot
diff --git a/ouroboros-consensus/src/Ouroboros/Storage/ChainDB/Impl/ImmDB.hs b/ouroboros-consensus/src/Ouroboros/Storage/ChainDB/Impl/ImmDB.hs
@@ -23,7 +23,6 @@ module Ouroboros.Storage.ChainDB.Impl.ImmDB (
   , getSlotNoAtTip
   , getKnownBlockComponent
   , getBlockComponent
-  , getBlockComponentAtTip
   , getBlockComponentWithPoint
     -- * Appending a block
   , appendBlock
@@ -375,18 +374,6 @@ getBlockComponent db blockComponent epochOrSlot = withDB db $ \imm ->
   where
     blockComponent' = translateToRawDB (parse db) (addHdrEnv db) blockComponent
 
-getBlockComponentAtTip
-  :: (MonadCatch m, HasHeader blk, HasCallStack)
-  => ImmDB m blk -> BlockComponent (ChainDB m blk) b -> m (Maybe b)
-getBlockComponentAtTip db blockComponent = do
-    immTip <- withDB db $ \imm -> ImmDB.getTip imm
-    case forgetTipInfo <$> immTip of
-      TipGen -> return Nothing
-      Tip (ImmDB.EBB epoch) ->
-        Just <$> getKnownBlockComponent db blockComponent (Left epoch)
-      Tip (ImmDB.Block slot) ->
-        Just <$> getKnownBlockComponent db blockComponent (Right slot)
-
 -- | Return the block component of the block corresponding to the given point,
 -- if it is part of the ImmutableDB.
 --

diff --git a/ouroboros-consensus/src/Ouroboros/Storage/ChainDB/Impl/Reopen.hs b/ouroboros-consensus/src/Ouroboros/Storage/ChainDB/Impl/Reopen.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE FlexibleContexts    #-}
 {-# LANGUAGE LambdaCase          #-}
+{-# LANGUAGE PatternSynonyms     #-}
 {-# LANGUAGE RecordWildCards     #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
@@ -10,6 +11,8 @@ module Ouroboros.Storage.ChainDB.Impl.Reopen
   ( isOpen
   , closeDB
   , reopen
+    -- * Auxiliary
+  , pointToEpoch
   ) where
 
 import           Control.Monad (when)
@@ -20,19 +23,18 @@ import           Control.Monad.Class.MonadThrow
 import           Control.Tracer
 
 import qualified Ouroboros.Network.AnchoredFragment as AF
-import           Ouroboros.Network.Block (HasHeader (..), castPoint,
-                     genesisPoint)
+import           Ouroboros.Network.Block (pattern BlockPoint,
+                     pattern GenesisPoint, HasHeader (..), Point, castPoint)
 
-import           Ouroboros.Consensus.Block (Header, headerPoint)
+import           Ouroboros.Consensus.Block (Header)
 import           Ouroboros.Consensus.BlockchainTime (getCurrentSlot)
 import           Ouroboros.Consensus.Ledger.Abstract
 import           Ouroboros.Consensus.Util (whenJust)
 import           Ouroboros.Consensus.Util.IOLike
 
 import           Ouroboros.Storage.Common (EpochNo)
-import           Ouroboros.Storage.EpochInfo (epochInfoEpoch)
+import           Ouroboros.Storage.EpochInfo (EpochInfo, epochInfoEpoch)
 
-import           Ouroboros.Storage.ChainDB.API (BlockComponent (..))
 import qualified Ouroboros.Storage.ChainDB.Impl.Background as Background
 import           Ouroboros.Storage.ChainDB.Impl.ChainSel
 import qualified Ouroboros.Storage.ChainDB.Impl.ImmDB as ImmDB
@@ -111,18 +113,9 @@ reopen (CDBHandle varState) launchBgTasks = do
         -- TODO what will actually happen if an exception is thrown? What if
         -- recovery is triggered?
 
-        let blockEpoch :: forall b. HasHeader b => b -> m EpochNo
-            blockEpoch = epochInfoEpoch cdbEpochInfo . blockSlot
-
         ImmDB.reopen cdbImmDB
-        -- In order to figure out the 'BlockNo' and 'Point' at the tip of the
-        -- ImmutableDB, we need to read the header at the tip of the ImmutableDB.
-        immDbTipHeader <- sequence =<< ImmDB.getBlockComponentAtTip cdbImmDB GetHeader
-        -- Note that 'immDbTipBlockNo' might not end up being the \"immutable\"
-        -- block(no), because the current chain computed from the VolatileDB could
-        -- be longer than @k@.
-        let immDbTipPoint = maybe genesisPoint   headerPoint immDbTipHeader
-        immDbTipEpoch      <- maybe (return 0)     blockEpoch  immDbTipHeader
+        immDbTipPoint <- ImmDB.getPointAtTip cdbImmDB
+        immDbTipEpoch <- pointToEpoch cdbEpochInfo immDbTipPoint
         traceWith cdbTracer $ TraceOpenEvent $ OpenedImmDB
           { _immDbTip      = immDbTipPoint
           , _immDbTipEpoch = immDbTipEpoch
@@ -166,3 +159,13 @@ reopen (CDBHandle varState) launchBgTasks = do
           }
 
         when launchBgTasks $ Background.launchBgTasks env replayed
+
+
+{-------------------------------------------------------------------------------
+  Auxiliary
+-------------------------------------------------------------------------------}
+
+pointToEpoch :: Monad m => EpochInfo m -> Point blk -> m EpochNo
+pointToEpoch epochInfo = \case
+    GenesisPoint      -> return 0
+    BlockPoint slot _ -> epochInfoEpoch epochInfo slot