From b593b9c1c30dc417364be55e04aba9cb25e3c68f Mon Sep 17 00:00:00 2001
From: Damian Nadales <damian.nadales@iohk.io>
Date: Fri, 27 Sep 2024 13:13:39 +0200
Subject: [PATCH 01/11] Add changelog fragments

---
 ...5151_damian.nadales_1260_remove_cdbFutureBlocks.md |  8 ++++++++
 ...1047_damian.nadales_1260_remove_cdbFutureBlocks.md |  7 +++++++
 ...5606_damian.nadales_1260_remove_cdbFutureBlocks.md | 11 +++++++++++
 3 files changed, 26 insertions(+)
 create mode 100644 ouroboros-consensus-cardano/changelog.d/20240927_125151_damian.nadales_1260_remove_cdbFutureBlocks.md
 create mode 100644 ouroboros-consensus-diffusion/changelog.d/20240927_131047_damian.nadales_1260_remove_cdbFutureBlocks.md
 create mode 100644 ouroboros-consensus/changelog.d/20240927_125606_damian.nadales_1260_remove_cdbFutureBlocks.md

diff --git a/ouroboros-consensus-cardano/changelog.d/20240927_125151_damian.nadales_1260_remove_cdbFutureBlocks.md b/ouroboros-consensus-cardano/changelog.d/20240927_125151_damian.nadales_1260_remove_cdbFutureBlocks.md
new file mode 100644
index 0000000000..a6ed3391fe
--- /dev/null
+++ b/ouroboros-consensus-cardano/changelog.d/20240927_125151_damian.nadales_1260_remove_cdbFutureBlocks.md
@@ -0,0 +1,8 @@
+### Breaking
+
+- Remove `CheckInFuture m blk` from `openChainDB`.
+
+### Non-Breaking
+
+- Remove references to `Ouroboros.Consensus.Fragment.InFuture`.
+- Adapt the code to account for the removed `cdbFutureBlocks` and related fields.
diff --git a/ouroboros-consensus-diffusion/changelog.d/20240927_131047_damian.nadales_1260_remove_cdbFutureBlocks.md b/ouroboros-consensus-diffusion/changelog.d/20240927_131047_damian.nadales_1260_remove_cdbFutureBlocks.md
new file mode 100644
index 0000000000..d490d9ba11
--- /dev/null
+++ b/ouroboros-consensus-diffusion/changelog.d/20240927_131047_damian.nadales_1260_remove_cdbFutureBlocks.md
@@ -0,0 +1,7 @@
+### Breaking
+
+- Remove `CheckInFuture m blk` argument from `openChainDB`.
+
+### Patch
+
+- Remove references to `Ouroboros.Consensus.Fragment.InFuture`.
diff --git a/ouroboros-consensus/changelog.d/20240927_125606_damian.nadales_1260_remove_cdbFutureBlocks.md b/ouroboros-consensus/changelog.d/20240927_125606_damian.nadales_1260_remove_cdbFutureBlocks.md
new file mode 100644
index 0000000000..5c7dc6b6d9
--- /dev/null
+++ b/ouroboros-consensus/changelog.d/20240927_125606_damian.nadales_1260_remove_cdbFutureBlocks.md
@@ -0,0 +1,11 @@
+### Breaking
+
+- Remove `cdbFutureBlocks` from `ChainDbEnv`.
+- Remove `BlockInTheFuture`, `ChainSelectionForFutureBlock`, `CandidateContainsFutureBlocks`, and `CandidateContainsFutureBlocksExceedingClockSkew` from `TraceAddBlockEvent`.
+- Remove `cdbCheckInFuture` from `CBD`.
+- Remove `cdbsCheckInFuture` from `ChainDbSpecificArgs`.
+- Remove `CheckInFuture m blk` argument from `completeChainDbArgs`.
+- Remove `CheckInFuture m blk` argument from `initialChainSelection`.
+- Remove `cdbsCheckInFuture` from `ChainDbSpecificArgs`.
+- Delete module `Ouroboros.Consensus.Fragment.InFuture`. `ClockSkew` functions live now in `Ouroboros.Consensus.MiniProtocol.ChainSync.Client.InFutureCheck`.
+* Remove `InFutureExceedsClockSkew` from `ValidationError`.

From 949f6b2d0910f92901aa9577f526dce7f2cb16aa Mon Sep 17 00:00:00 2001
From: Damian Nadales <damian.nadales@iohk.io>
Date: Thu, 26 Sep 2024 14:38:19 +0200
Subject: [PATCH 02/11] Remove `cdbFutureBlocks`

After https://github.com/IntersectMBO/ouroboros-consensus/pull/525, the `cdbFutureBlocks` field became unnecessary, as we now delay headers until they are no longer from the (near) future.
---
 .../Consensus/Storage/ChainDB/Impl.hs         |   5 -
 .../Storage/ChainDB/Impl/ChainSel.hs          | 247 ++++--------------
 .../Consensus/Storage/ChainDB/Impl/Types.hs   |  56 ----
 3 files changed, 58 insertions(+), 250 deletions(-)

diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl.hs
index 6709a6cffa..87dca9f1f4 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl.hs
@@ -144,7 +144,6 @@ openDBInternal args launchBgTasks = runWithTempRegistry $ do
       traceWith tracer $ TraceOpenEvent OpenedLgrDB
 
       varInvalid      <- newTVarIO (WithFingerprint Map.empty (Fingerprint 0))
-      varFutureBlocks <- newTVarIO Map.empty
 
       let initChainSelTracer = contramap TraceInitChainSelEvent tracer
 
@@ -157,8 +156,6 @@ openDBInternal args launchBgTasks = runWithTempRegistry $ do
                           initChainSelTracer
                           (Args.cdbsTopLevelConfig cdbSpecificArgs)
                           varInvalid
-                          varFutureBlocks
-                          (Args.cdbsCheckInFuture cdbSpecificArgs)
                           (void initialLoE)
       traceWith initChainSelTracer InitialChainSelected
 
@@ -197,9 +194,7 @@ openDBInternal args launchBgTasks = runWithTempRegistry $ do
                     , cdbGcDelay         = Args.cdbsGcDelay cdbSpecificArgs
                     , cdbGcInterval      = Args.cdbsGcInterval cdbSpecificArgs
                     , cdbKillBgThreads   = varKillBgThreads
-                    , cdbCheckInFuture   = Args.cdbsCheckInFuture cdbSpecificArgs
                     , cdbChainSelQueue   = chainSelQueue
-                    , cdbFutureBlocks    = varFutureBlocks
                     , cdbLoE             = Args.cdbsLoE cdbSpecificArgs
                     }
       h <- fmap CDBHandle $ newTVarIO $ ChainDbOpen env
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/ChainSel.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/ChainSel.hs
index 66afcca5a4..2f27a0137a 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/ChainSel.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/ChainSel.hs
@@ -21,7 +21,7 @@ module Ouroboros.Consensus.Storage.ChainDB.Impl.ChainSel (
   ) where
 
 import           Control.Exception (assert)
-import           Control.Monad (forM, forM_, unless, void, when)
+import           Control.Monad (forM, forM_, void, when)
 import           Control.Monad.Except ()
 import           Control.Monad.Trans.Class (lift)
 import           Control.Monad.Trans.State.Strict
@@ -29,7 +29,7 @@ import           Control.Tracer (Tracer, nullTracer, traceWith)
 import           Data.Foldable (for_)
 import           Data.Function (on)
 import           Data.Functor.Contravariant ((>$<))
-import           Data.List (partition, sortBy)
+import           Data.List (sortBy)
 import           Data.List.NonEmpty (NonEmpty)
 import qualified Data.List.NonEmpty as NE
 import           Data.Map.Strict (Map)
@@ -43,8 +43,6 @@ import           Ouroboros.Consensus.Block
 import           Ouroboros.Consensus.Config
 import           Ouroboros.Consensus.Fragment.Diff (ChainDiff (..))
 import qualified Ouroboros.Consensus.Fragment.Diff as Diff
-import           Ouroboros.Consensus.Fragment.InFuture (CheckInFuture (..))
-import qualified Ouroboros.Consensus.Fragment.InFuture as InFuture
 import           Ouroboros.Consensus.Fragment.Validated (ValidatedFragment)
 import qualified Ouroboros.Consensus.Fragment.Validated as VF
 import           Ouroboros.Consensus.Fragment.ValidatedDiff
@@ -92,7 +90,6 @@ import qualified Ouroboros.Network.AnchoredSeq as AS
 --
 -- Returns the chosen validated chain and corresponding ledger.
 --
--- See "## Initialization" in ChainDB.md.
 initialChainSelection ::
      forall m blk.
      ( IOLike m
@@ -105,14 +102,29 @@ initialChainSelection ::
   -> Tracer m (TraceInitChainSelEvent blk)
   -> TopLevelConfig blk
   -> StrictTVar m (WithFingerprint (InvalidBlocks blk))
-  -> StrictTVar m (FutureBlocks m blk)
-  -> CheckInFuture m blk
   -> LoE ()
   -> m (ChainAndLedger blk)
 initialChainSelection immutableDB volatileDB lgrDB tracer cfg varInvalid
-                      varFutureBlocks futureCheck loE = do
-    -- We follow the steps from section "## Initialization" in ChainDB.md
-
+                      loE = do
+    -- TODO: Improve the user experience by trimming any potential
+    -- blocks from the future from the VolatileDB.
+    --
+    -- When we perform chain selection, it is theoretically possible
+    -- that the blocks in the VolatileDB are from the future, if for
+    -- some reason the clock of the node was set back (by a
+    -- significant amount of time). This is a rare situation, but can
+    -- arise for instance if the clock of the node was set in the
+    -- **far** future. In this case, node will be disconnected from
+    -- other peers when diffusing these blocks. Once the node is
+    -- restarted with a synchronized clock, it will diffuse said
+    -- blocks from the future again (assuming they're still from the
+    -- future after restart), which will cause other nodes to
+    -- disconnect. By trimming blocks from the future from the
+    -- VolatileDB we can prevent this inconvenient, albeit extremely
+    -- rare, situation. However, it does not pose any security risk,
+    -- and a node operator can correct the problem by either wiping
+    -- out the VolatileDB or waiting enough time until the blocks are
+    -- not from the **far** future anymore.
     (i :: Anchor blk, succsOf, ledger) <- atomically $ do
       invalid <- forgetFingerprint <$> readTVar varInvalid
       (,,)
@@ -218,8 +230,6 @@ initialChainSelection immutableDB volatileDB lgrDB tracer cfg varInvalid
             { lgrDB
             , bcfg
             , varInvalid
-            , varFutureBlocks
-            , futureCheck
             , blockCache = BlockCache.empty
             , curChainAndLedger
             , validationTracer = InitChainSelValidation >$< tracer
@@ -337,24 +347,14 @@ chainSelSync cdb@CDB {..} (ChainSelAddBlock BlockToAdd { blockToAdd = b, .. }) =
 
     -- We follow the steps from section "## Adding a block" in ChainDB.md
 
-    -- Note: we call 'chainSelectionForFutureBlocks' in all branches instead
-    -- of once, before branching, because we want to do it /after/ writing the
-    -- block to the VolatileDB and delivering the 'varBlockWrittenToDisk'
-    -- promise, as this is the promise the BlockFetch client waits for.
-    -- Otherwise, the BlockFetch client would have to wait for
-    -- 'chainSelectionForFutureBlocks'.
-
-    -- ### Ignore
-    newTip <- if
+    if
       | olderThanK hdr isEBB immBlockNo -> do
         lift $ traceWith addBlockTracer $ IgnoreBlockOlderThanK (blockRealPoint b)
         lift $ deliverWrittenToDisk False
-        chainSelectionForFutureBlocks cdb BlockCache.empty
 
       | isMember (blockHash b) -> do
         lift $ traceWith addBlockTracer $ IgnoreBlockAlreadyInVolatileDB (blockRealPoint b)
         lift $ deliverWrittenToDisk True
-        chainSelectionForFutureBlocks cdb BlockCache.empty
 
       | Just (InvalidBlockInfo reason _) <- Map.lookup (blockHash b) invalid -> do
         lift $ traceWith addBlockTracer $ IgnoreInvalidBlock (blockRealPoint b) reason
@@ -366,21 +366,22 @@ chainSelSync cdb@CDB {..} (ChainSelAddBlock BlockToAdd { blockToAdd = b, .. }) =
           blockPunish
           InvalidBlockPunishment.BlockItself
 
-        chainSelectionForFutureBlocks cdb BlockCache.empty
-
       -- The remaining cases
       | otherwise -> do
         let traceEv = AddedBlockToVolatileDB (blockRealPoint b) (blockNo b) isEBB
         lift $ encloseWith (traceEv >$< addBlockTracer) $
           VolatileDB.putBlock cdbVolatileDB b
         lift $ deliverWrittenToDisk True
+        -- REVIEW: would the tip returned by
+        --
+        -- > chainSelectionForBlock cdb (BlockCache.singleton b) hdr blockPunish
+        --
+        -- equal
+        --
+        -- > Query.getTipPoint cdb
+        void $ chainSelectionForBlock cdb (BlockCache.singleton b) hdr blockPunish
 
-        let blockCache = BlockCache.singleton b
-        -- Do chain selection for future blocks before chain selection for the
-        -- new block. When some future blocks are now older than the current
-        -- block, we will do chain selection in a more chronological order.
-        void $ chainSelectionForFutureBlocks cdb blockCache
-        chainSelectionForBlock cdb blockCache hdr blockPunish
+    newTip <- lift $ atomically $ Query.getTipPoint cdb
 
     lift $ deliverProcessed newTip
   where
@@ -443,32 +444,6 @@ olderThanK hdr isEBB immBlockNo
 data ChainSwitchType = AddingBlocks | SwitchingToAFork
   deriving (Show, Eq)
 
--- | Return the new tip.
-chainSelectionForFutureBlocks ::
-     ( IOLike m
-     , LedgerSupportsProtocol blk
-     , BlockSupportsDiffusionPipelining blk
-     , InspectLedger blk
-     , HasHardForkHistory blk
-     , HasCallStack
-     )
-  => ChainDbEnv m blk -> BlockCache blk -> Electric m (Point blk)
-chainSelectionForFutureBlocks cdb@CDB{..} blockCache = do
-    -- Get 'cdbFutureBlocks' and empty the map in the TVar. It will be
-    -- repopulated with the blocks that are still from the future (but not the
-    -- ones no longer from the future) during chain selection for those
-    -- blocks.
-    futureBlockHeaders <- lift $ atomically $ do
-      futureBlocks <- readTVar cdbFutureBlocks
-      writeTVar cdbFutureBlocks Map.empty
-      return $ Map.elems futureBlocks
-    forM_ futureBlockHeaders $ \(hdr, punish) -> do
-      lift $ traceWith tracer $ ChainSelectionForFutureBlock (headerRealPoint hdr)
-      chainSelectionForBlock cdb blockCache hdr punish
-    lift $ atomically $ Query.getTipPoint cdb
-  where
-    tracer = TraceAddBlockEvent >$< cdbTracer
-
 -- | Trigger chain selection for the given block.
 --
 -- PRECONDITION: the block is in the VolatileDB.
@@ -620,13 +595,11 @@ chainSelectionForBlock cdb@CDB{..} blockCache hdr punish = electric $ do
       { lgrDB                 = cdbLgrDB
       , bcfg                  = configBlock cdbTopLevelConfig
       , varInvalid            = cdbInvalid
-      , varFutureBlocks       = cdbFutureBlocks
       , varTentativeState     = cdbTentativeState
       , varTentativeHeader    = cdbTentativeHeader
       , getTentativeFollowers =
               filter ((TentativeChain ==) . fhChainType) . Map.elems
           <$> readTVar cdbFollowers
-      , futureCheck           = cdbCheckInFuture
       , blockCache            = blockCache
       , curChainAndLedger     = curChainAndLedger
       , validationTracer      =
@@ -976,18 +949,16 @@ data ChainSelEnv m blk = ChainSelEnv
     , pipeliningTracer      :: Tracer m (TracePipeliningEvent blk)
     , bcfg                  :: BlockConfig blk
     , varInvalid            :: StrictTVar m (WithFingerprint (InvalidBlocks blk))
-    , varFutureBlocks       :: StrictTVar m (FutureBlocks m blk)
     , varTentativeState     :: StrictTVar m (TentativeHeaderState blk)
     , varTentativeHeader    :: StrictTVar m (StrictMaybe (Header blk))
     , getTentativeFollowers :: STM m [FollowerHandle m blk]
-    , futureCheck           :: CheckInFuture m blk
     , blockCache            :: BlockCache blk
     , curChainAndLedger     :: ChainAndLedger blk
       -- | The block that this chain selection invocation is processing, and the
       -- punish action for the peer that sent that block; see
       -- 'InvalidBlockPunishment'.
       --
-      -- Two notable subtleties:
+      -- One subtlety:
       --
       -- o If a BlockFetch client adds an invalid block but that block isn't
       --   part of any desirable paths through the VolDB, then we won't attempt
@@ -996,14 +967,9 @@ data ChainSelEnv m blk = ChainSelEnv
       --   our focus to a another peer offering better blocks and so this peer
       --   is no longer causing us BlockFetch work.
       --
-      -- o If the block is frome the future but with clock skew, we'll add it to
-      --   'varFutureBlocks'. We retain the punishment information, so that if
-      --   the peer is still active once we do process that block, we're still
-      --   able to punish them.
-      --
-      -- Thus invalid blocks can be skipped entirely or somewhat-arbitrarily
-      -- delayed. This is part of the reason we bothered to restrict the
-      -- expressiveness of the 'InvalidBlockPunishment' combiantors.
+      -- Thus invalid blocks can be skipped entirely. This is part of
+      -- the reason we bothered to restrict the expressiveness of the
+      -- 'InvalidBlockPunishment' combinators.
     , punish                :: Maybe (RealPoint blk, InvalidBlockPunishment m)
     }
 
@@ -1072,8 +1038,8 @@ chainSelection chainSelEnv chainDiffs =
           ValidPrefix candidate' -> do
             whenJust mTentativeHeader clearTentativeHeader
             -- Prefix of the candidate because it contained rejected blocks
-            -- (invalid blocks and/or blocks from the future). Note that the
-            -- spec says go back to candidate selection, see [^whyGoBack],
+            -- (invalid blocks). Note that the
+            -- spec says go back to candidate selection,
             -- because there might still be some candidates that contain the
             -- same rejected block. To simplify the control flow, we do it
             -- differently: instead of recomputing the candidates taking
@@ -1132,20 +1098,15 @@ chainSelection chainSelEnv chainDiffs =
     -- blocks. Discard them if they are truncated so much that they are no
     -- longer preferred over the current chain.
     --
-    -- A block is rejected if:
-    --
-    -- * It is invalid (present in 'varInvalid', i.e., 'cdbInvalid').
-    -- * It is from the future (present in 'varFutureBlocks', i.e.,
-    --   'cdbFutureBlocks').
+    -- A block is rejected if it is invalid (present in 'varInvalid',
+    -- i.e., 'cdbInvalid').
     truncateRejectedBlocks ::
          [ChainDiff (Header blk)]
       -> m [ChainDiff (Header blk)]
     truncateRejectedBlocks cands = do
-      (invalid, futureBlocks) <-
-        atomically $ (,) <$> readTVar varInvalid <*> readTVar varFutureBlocks
+      invalid <- atomically $ readTVar varInvalid
       let isRejected hdr =
                Map.member (headerHash hdr) (forgetFingerprint invalid)
-            || Map.member (headerHash hdr) futureBlocks
       return $ filter (preferAnchoredCandidate bcfg curChain . Diff.getSuffix)
              $ map (Diff.takeWhileOldest (not . isRejected)) cands
 
@@ -1168,15 +1129,14 @@ chainSelection chainSelEnv chainDiffs =
 
 -- | Result of 'validateCandidate'.
 data ValidationResult blk =
-      -- | The entire candidate fragment was valid. No blocks were from the
-      -- future.
+      -- | The entire candidate fragment was valid.
       FullyValid (ValidatedChainDiff (Header blk) (LedgerDB' blk))
 
-      -- | The candidate fragment contained invalid blocks and/or blocks from
-      -- the future that had to be truncated from the fragment.
+      -- | The candidate fragment contained invalid blocks that had to
+      -- be truncated from the fragment.
     | ValidPrefix (ChainDiff (Header blk))
 
-      -- | After truncating the invalid blocks or blocks from the future from
+      -- | After truncating the invalid blocks from
       -- the 'ChainDiff', it no longer contains enough blocks in its suffix to
       -- compensate for the number of blocks it wants to roll back.
     | InsufficientSuffix
@@ -1274,89 +1234,7 @@ ledgerValidateCandidate chainSelEnv chainDiff@(ChainDiff rollback suffix) =
           (Map.insert hash (InvalidBlockInfo (ValidationError e) slot) invalid)
           (succ fp)
 
--- | Truncate any future headers from the candidate 'ValidatedChainDiff'.
---
--- Future headers that don't exceed the clock skew
--- ('inFutureExceedsClockSkew') are added to 'cdbFutureBlocks'.
---
--- Future headers that exceed the clock skew are added to 'cdbInvalid' with
--- 'InFutureExceedsClockSkew' as the reason.
---
--- When truncation happened, 'Left' is returned, otherwise 'Right'.
-futureCheckCandidate ::
-     forall m blk. (IOLike m, LedgerSupportsProtocol blk)
-  => ChainSelEnv m blk
-  -> ValidatedChainDiff (Header blk) (LedgerDB' blk)
-  -> m (Either (ChainDiff (Header blk))
-               (ValidatedChainDiff (Header blk) (LedgerDB' blk)))
-futureCheckCandidate chainSelEnv validatedChainDiff =
-    checkInFuture futureCheck validatedSuffix >>= \case
-
-      (suffix', []) ->
-        -- If no headers are in the future, then the fragment must be untouched
-        assert (AF.headPoint suffix == AF.headPoint suffix') $
-        return $ Right validatedChainDiff
-
-      (suffix', inFuture) -> do
-        let (exceedClockSkew, inNearFuture) =
-              partition InFuture.inFutureExceedsClockSkew inFuture
-        -- Record future blocks
-        unless (null inNearFuture) $ do
-          let futureBlocks = Map.fromList
-                [ (headerHash hdr, (hdr, InFuture.inFuturePunish x))
-                | x <- inNearFuture
-                , let hdr = InFuture.inFutureHeader x
-                ]
-          atomically $ modifyTVar varFutureBlocks $ flip Map.union futureBlocks
-          -- Trace the original @suffix@, as it contains the headers from the
-          -- future
-          traceWith validationTracer $
-            CandidateContainsFutureBlocks
-              suffix
-              (InFuture.inFutureHeader <$> inNearFuture)
-
-        -- Record any blocks exceeding the clock skew as invalid
-        unless (null exceedClockSkew) $ do
-          let invalidHeaders = InFuture.inFutureHeader <$> exceedClockSkew
-              invalidBlocks  = Map.fromList
-                [ (headerHash hdr, info)
-                | hdr <- invalidHeaders
-                , let reason = InFutureExceedsClockSkew (headerRealPoint hdr)
-                      info   = InvalidBlockInfo reason (blockSlot hdr)
-                ]
-          atomically $ modifyTVar varInvalid $ \(WithFingerprint invalid fp) ->
-            WithFingerprint (Map.union invalid invalidBlocks) (succ fp)
-          traceWith validationTracer $
-            CandidateContainsFutureBlocksExceedingClockSkew
-              -- Trace the original @suffix@, as it contains the headers
-              -- from the future
-              suffix
-              invalidHeaders
-
-          -- It's possible the block's prefix is invalid, but we can't know for
-          -- sure. So we use 'InvalidBlockPunishment.BlockItself' to be more
-          -- conservative.
-          forM_ exceedClockSkew $ \x -> do
-            InvalidBlockPunishment.enact
-              (InFuture.inFuturePunish x)
-              InvalidBlockPunishment.BlockItself
-
-        -- Truncate the original 'ChainDiff' to match the truncated
-        -- 'AnchoredFragment'.
-        return $ Left $ Diff.truncate (castPoint (AF.headPoint suffix')) chainDiff
-  where
-    ChainSelEnv { validationTracer, varInvalid, varFutureBlocks, futureCheck } =
-      chainSelEnv
-
-    ValidatedChainDiff chainDiff@(ChainDiff _ suffix) _ = validatedChainDiff
-
-    validatedSuffix :: ValidatedFragment (Header blk) (LedgerState blk)
-    validatedSuffix =
-      ledgerState . LgrDB.ledgerDbCurrent <$>
-      ValidatedDiff.toValidatedFragment validatedChainDiff
-
--- | Validate a candidate chain using 'ledgerValidateCandidate' and
--- 'futureCheck'.
+-- | Validate a candidate chain using 'ledgerValidateCandidate'.
 validateCandidate ::
      ( IOLike m
      , LedgerSupportsProtocol blk
@@ -1370,28 +1248,19 @@ validateCandidate chainSelEnv chainDiff =
       validatedChainDiff
         | ValidatedDiff.rollbackExceedsSuffix validatedChainDiff
         -> return InsufficientSuffix
+
+        | AF.length (Diff.getSuffix chainDiff) == AF.length (Diff.getSuffix chainDiff')
+        -- No truncation
+        -> return $ FullyValid validatedChainDiff
+
         | otherwise
-        -> futureCheckCandidate chainSelEnv validatedChainDiff >>= \case
-          Left chainDiff'
-              | Diff.rollbackExceedsSuffix chainDiff'
-              -> return InsufficientSuffix
-              | otherwise
-              -> return $ ValidPrefix chainDiff'
-          Right validatedChainDiff'
-              | ValidatedDiff.rollbackExceedsSuffix validatedChainDiff'
-              -> return InsufficientSuffix
-              | AF.length (Diff.getSuffix chainDiff) ==
-                AF.length (Diff.getSuffix chainDiff')
-                -- No truncation
-              -> return $ FullyValid validatedChainDiff'
-              | otherwise
-                -- In case of invalid blocks but no blocks from the future, we
-                -- throw away the ledger corresponding to the truncated
-                -- fragment and will have to validate it again, even when it's
-                -- the sole candidate.
-              -> return $ ValidPrefix chainDiff'
-            where
-              chainDiff' = ValidatedDiff.getChainDiff validatedChainDiff'
+        -- In case of invalid blocks, we throw away the ledger
+        -- corresponding to the truncated fragment and will have to
+        -- validate it again, even when it's the sole candidate.
+        -> return $ ValidPrefix chainDiff'
+
+        where
+          chainDiff' = ValidatedDiff.getChainDiff validatedChainDiff
 
 {-------------------------------------------------------------------------------
   'ChainAndLedger'
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/Types.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/Types.hs
index 33fe5d4321..e48755c091 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/Types.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/Types.hs
@@ -39,8 +39,6 @@ module Ouroboros.Consensus.Storage.ChainDB.Impl.Types (
     -- * Invalid blocks
   , InvalidBlockInfo (..)
   , InvalidBlocks
-    -- * Future blocks
-  , FutureBlocks
     -- * Blocks to add
   , BlockToAdd (..)
   , ChainSelMessage (..)
@@ -79,7 +77,6 @@ import           NoThunks.Class (OnlyCheckWhnfNamed (..))
 import           Ouroboros.Consensus.Block
 import           Ouroboros.Consensus.Config
 import           Ouroboros.Consensus.Fragment.Diff (ChainDiff)
-import           Ouroboros.Consensus.Fragment.InFuture (CheckInFuture)
 import           Ouroboros.Consensus.Ledger.Extended (ExtValidationError)
 import           Ouroboros.Consensus.Ledger.Inspect
 import           Ouroboros.Consensus.Ledger.SupportsProtocol
@@ -248,27 +245,8 @@ data ChainDbEnv m blk = CDB
     -- garbage collections.
   , cdbKillBgThreads   :: !(StrictTVar m (m ()))
     -- ^ A handle to kill the background threads.
-  , cdbCheckInFuture   :: !(CheckInFuture m blk)
   , cdbChainSelQueue   :: !(ChainSelQueue m blk)
     -- ^ Queue of blocks that still have to be added.
-  , cdbFutureBlocks    :: !(StrictTVar m (FutureBlocks m blk))
-    -- ^ Blocks from the future
-    --
-    -- Blocks that were added to the ChainDB but that were from the future
-    -- according to 'CheckInFuture', without exceeding the clock skew
-    -- ('inFutureExceedsClockSkew'). Blocks exceeding the clock skew are
-    -- considered to be invalid ('InFutureExceedsClockSkew') and will be added
-    -- 'cdbInvalid'.
-    --
-    -- Whenever a block is added to the ChainDB, we first trigger chain
-    -- selection for all the blocks in this map so that blocks no longer from
-    -- the future can get adopted. Note that when no blocks are added to the
-    -- ChainDB, we will /not/ actively trigger chain selection for the blocks
-    -- in this map.
-    --
-    -- The number of blocks from the future is bounded by the number of
-    -- upstream peers multiplied by the max clock skew divided by the slot
-    -- length.
   , cdbLoE             :: !(m (LoE (AnchoredFragment (Header blk))))
     -- ^ Configure the Limit on Eagerness. If this is 'LoEEnabled', it contains
     -- an action that returns the LoE fragment, which indicates the latest rollback
@@ -426,16 +404,6 @@ data InvalidBlockInfo blk = InvalidBlockInfo
   , invalidBlockSlotNo :: !SlotNo
   } deriving (Eq, Show, Generic, NoThunks)
 
-{-------------------------------------------------------------------------------
-  Future blocks
--------------------------------------------------------------------------------}
-
--- | Blocks from the future for which we still need to trigger chain
--- selection.
---
--- See 'cdbFutureBlocks' for more info.
-type FutureBlocks m blk = Map (HeaderHash blk) (Header blk, InvalidBlockPunishment m)
-
 {-------------------------------------------------------------------------------
   Blocks to add
 -------------------------------------------------------------------------------}
@@ -666,10 +634,6 @@ data TraceAddBlockEvent blk =
     -- | ChainSel will reprocess blocks that were postponed by the LoE.
   | PoppedReprocessLoEBlocksFromQueue
 
-    -- | The block is from the future, i.e., its slot number is greater than
-    -- the current slot (the second argument).
-  | BlockInTheFuture (RealPoint blk) SlotNo
-
     -- | A block was added to the Volatile DB
   | AddedBlockToVolatileDB (RealPoint blk) BlockNo IsEBB Enclosing
 
@@ -709,11 +673,6 @@ data TraceAddBlockEvent blk =
     -- | An event traced during validating performed while adding a block.
   | AddBlockValidation (TraceValidationEvent blk)
 
-    -- | Run chain selection for a block that was previously from the future.
-    -- This is done for all blocks from the future each time a new block is
-    -- added.
-  | ChainSelectionForFutureBlock (RealPoint blk)
-
     -- | The tentative header (in the context of diffusion pipelining) has been
     -- updated.
   | PipeliningEvent (TracePipeliningEvent blk)
@@ -744,21 +703,6 @@ data TraceValidationEvent blk =
     -- | A candidate chain was valid.
   | ValidCandidate (AnchoredFragment (Header blk))
 
-    -- | Candidate contains headers from the future which do no exceed the
-    -- clock skew.
-  | CandidateContainsFutureBlocks
-      (AnchoredFragment (Header blk))
-      -- ^ Candidate chain containing headers from the future
-      [Header blk]
-      -- ^ Headers from the future, not exceeding clock skew
-
-    -- | Candidate contains headers from the future which exceed the
-    -- clock skew, making them invalid.
-  | CandidateContainsFutureBlocksExceedingClockSkew
-      (AnchoredFragment (Header blk))
-      -- ^ Candidate chain containing headers from the future
-      [Header blk]
-      -- ^ Headers from the future, exceeding clock skew
   | UpdateLedgerDbTraceEvent (UpdateLedgerDbTraceEvent blk)
   deriving (Generic)
 

From 232f60791f8ffcd79229308e2730f998af141ade Mon Sep 17 00:00:00 2001
From: Damian Nadales <damian.nadales@iohk.io>
Date: Fri, 27 Sep 2024 11:32:45 +0200
Subject: [PATCH 03/11] Remove obsolete module
 `Ouroboros.Consensus.Fragment.InFuture`

---
 .../Cardano/Tools/DBAnalyser/Run.hs           |   2 -
 .../Cardano/Tools/DBSynthesizer/Run.hs        |   2 -
 .../Ouroboros/Consensus/Node.hs               |  18 +-
 .../Test/ThreadNet/Network.hs                 |  17 +-
 .../bench/ChainSync-client-bench/Main.hs      |   3 +-
 ouroboros-consensus/ouroboros-consensus.cabal |   1 -
 .../Ouroboros/Consensus/Fragment/InFuture.hs  | 204 ------------------
 .../ChainSync/Client/InFutureCheck.hs         |  45 +++-
 .../Consensus/Storage/ChainDB/Impl/Args.hs    |   9 +-
 .../Test/Util/ChainDB.hs                      |   4 -
 .../Test/Util/Orphans/Arbitrary.hs            |  11 +-
 .../MiniProtocol/ChainSync/Client.hs          |   4 +-
 .../Ouroboros/Storage/ChainDB/StateMachine.hs |  10 +-
 13 files changed, 65 insertions(+), 265 deletions(-)
 delete mode 100644 ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Fragment/InFuture.hs

diff --git a/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/DBAnalyser/Run.hs b/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/DBAnalyser/Run.hs
index 043d084da3..f896ef4e01 100644
--- a/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/DBAnalyser/Run.hs
+++ b/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/DBAnalyser/Run.hs
@@ -18,7 +18,6 @@ import           Data.Singletons (Sing, SingI (..))
 import qualified Debug.Trace as Debug
 import           Ouroboros.Consensus.Block
 import           Ouroboros.Consensus.Config
-import qualified Ouroboros.Consensus.Fragment.InFuture as InFuture
 import           Ouroboros.Consensus.Ledger.Extended
 import qualified Ouroboros.Consensus.Ledger.SupportsMempool as LedgerSupportsMempool
                      (HasTxs)
@@ -65,7 +64,6 @@ analyse DBAnalyserConfig{analysis, confLimit, dbDir, selectDB, validation, verbo
               $ updateTracer chainDBTracer
               $ completeChainDbArgs
                   registry
-                  InFuture.dontCheck
                   cfg
                   genesisLedger
                   chunkInfo
diff --git a/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/DBSynthesizer/Run.hs b/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/DBSynthesizer/Run.hs
index 2fc13d581f..cc88fbd694 100644
--- a/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/DBSynthesizer/Run.hs
+++ b/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/DBSynthesizer/Run.hs
@@ -26,7 +26,6 @@ import qualified Data.Set as Set
 import           Ouroboros.Consensus.Cardano.Block
 import           Ouroboros.Consensus.Cardano.Node
 import           Ouroboros.Consensus.Config (TopLevelConfig, configStorage)
-import qualified Ouroboros.Consensus.Fragment.InFuture as InFuture (dontCheck)
 import qualified Ouroboros.Consensus.Node as Node (stdMkChainDbHasFS)
 import qualified Ouroboros.Consensus.Node.InitStorage as Node
                      (nodeImmutableDbChunkInfo)
@@ -127,7 +126,6 @@ synthesize genTxs DBSynthesizerConfig{confOptions, confShelleyGenesis, confDbDir
             dbArgs      =
              ChainDB.completeChainDbArgs
               registry
-              InFuture.dontCheck
               pInfoConfig
               pInfoInitLedger
               chunkInfo
diff --git a/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/Node.hs b/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/Node.hs
index 4e835a5233..2f7427958b 100644
--- a/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/Node.hs
+++ b/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/Node.hs
@@ -79,9 +79,6 @@ import           Ouroboros.Consensus.Block
 import           Ouroboros.Consensus.BlockchainTime hiding (getSystemStart)
 import           Ouroboros.Consensus.Config
 import           Ouroboros.Consensus.Config.SupportsNode
-import           Ouroboros.Consensus.Fragment.InFuture (CheckInFuture,
-                     ClockSkew)
-import qualified Ouroboros.Consensus.Fragment.InFuture as InFuture
 import           Ouroboros.Consensus.Ledger.Extended (ExtLedgerState (..))
 import           Ouroboros.Consensus.MiniProtocol.ChainSync.Client.HistoricityCheck
                      (HistoricityCheck)
@@ -289,7 +286,7 @@ data LowLevelRunNodeArgs m addrNTN addrNTC versionDataNTN versionDataNTC blk
     , llrnMaxCaughtUpAge :: NominalDiffTime
 
       -- | Maximum clock skew
-    , llrnMaxClockSkew :: ClockSkew
+    , llrnMaxClockSkew :: InFutureCheck.ClockSkew
 
     , llrnPublicPeerSelectionStateVar :: StrictSTM.StrictTVar m (Diffusion.PublicPeerSelectionState addrNTN)
     }
@@ -436,12 +433,6 @@ runWith RunNodeArgs{..} encAddrNtN decAddrNtN LowLevelRunNodeArgs{..} =
                            systemStart
                            (blockchainTimeTracer rnTraceConsensus)
 
-            inFuture :: CheckInFuture m blk
-            inFuture = InFuture.reference
-                         (configLedger cfg)
-                         llrnMaxClockSkew
-                         systemTime
-
         (genesisArgs, setLoEinChainDbArgs) <-
           mkGenesisNodeKernelArgs llrnGenesisConfig
 
@@ -458,7 +449,6 @@ runWith RunNodeArgs{..} encAddrNtN decAddrNtN LowLevelRunNodeArgs{..} =
 
         (chainDB, finalArgs) <- openChainDB
                      registry
-                     inFuture
                      cfg
                      initLedger
                      llrnMkImmutableHasFS
@@ -719,7 +709,6 @@ stdWithCheckedDB pb tracer databasePath networkMagic body = do
 openChainDB ::
      forall m blk. (RunNode blk, IOLike m)
   => ResourceRegistry m
-  -> CheckInFuture m blk
   -> TopLevelConfig blk
   -> ExtLedgerState blk
      -- ^ Initial ledger
@@ -732,10 +721,9 @@ openChainDB ::
   -> (Complete ChainDbArgs m blk -> Complete ChainDbArgs m blk)
       -- ^ Customise the 'ChainDbArgs'
   -> m (ChainDB m blk, Complete ChainDbArgs m blk)
-openChainDB registry inFuture cfg initLedger fsImm fsVol defArgs customiseArgs =
+openChainDB registry cfg initLedger fsImm fsVol defArgs customiseArgs =
    let args = customiseArgs $ ChainDB.completeChainDbArgs
                registry
-               inFuture
                cfg
                initLedger
                (nodeImmutableDbChunkInfo (configStorage cfg))
@@ -964,7 +952,7 @@ stdLowLevelRunNodeArgsIO RunNodeArgs{ rnProtocolInfo
           stdWithCheckedDB (Proxy @blk) srnTraceChainDB (immutableDbPath srnDatabasePath) networkMagic
       , llrnMaxCaughtUpAge = secondsToNominalDiffTime $ 20 * 60   -- 20 min
       , llrnMaxClockSkew =
-          InFuture.defaultClockSkew
+          InFutureCheck.defaultClockSkew
       , llrnPublicPeerSelectionStateVar =
           Diffusion.daPublicPeerSelectionVar srnDiffusionArguments
       }
diff --git a/ouroboros-consensus-diffusion/src/unstable-diffusion-testlib/Test/ThreadNet/Network.hs b/ouroboros-consensus-diffusion/src/unstable-diffusion-testlib/Test/ThreadNet/Network.hs
index 09f1b4c0c2..eb58519102 100644
--- a/ouroboros-consensus-diffusion/src/unstable-diffusion-testlib/Test/ThreadNet/Network.hs
+++ b/ouroboros-consensus-diffusion/src/unstable-diffusion-testlib/Test/ThreadNet/Network.hs
@@ -65,7 +65,6 @@ import qualified Network.TypedProtocol.Codec as Codec
 import           Ouroboros.Consensus.Block
 import           Ouroboros.Consensus.BlockchainTime
 import           Ouroboros.Consensus.Config
-import qualified Ouroboros.Consensus.Fragment.InFuture as InFuture
 import           Ouroboros.Consensus.Ledger.Abstract
 import           Ouroboros.Consensus.Ledger.Extended
 import           Ouroboros.Consensus.Ledger.Inspect
@@ -699,8 +698,7 @@ runThreadNetwork systemTime ThreadNetworkArgs
 
         void $ addTxs mempool txs
 
-    mkArgs :: OracularClock m
-           -> ResourceRegistry m
+    mkArgs :: ResourceRegistry m
            -> TopLevelConfig blk
            -> ExtLedgerState blk
            -> Tracer m (RealPoint blk, ExtValidationError blk)
@@ -716,7 +714,7 @@ runThreadNetwork systemTime ThreadNetworkArgs
            -> CoreNodeId
            -> ChainDbArgs Identity m blk
     mkArgs
-      clock registry
+      registry
       cfg initLedger
       invalidTracer addTracer selTracer updatesTracer pipeliningTracer
       nodeDBs _coreNodeId =
@@ -740,11 +738,8 @@ runThreadNetwork systemTime ThreadNetworkArgs
                       LedgerDB.lgrTracer = TraceSnapshotEvent >$< tr
                     }
                 , cdbsArgs = (cdbsArgs args) {
-                      cdbsCheckInFuture  = InFuture.reference (configLedger cfg)
-                                        InFuture.defaultClockSkew
-                                        (OracularClock.finiteSystemTime clock)
-                      -- TODO: Vary cdbsGcDelay, cdbsGcInterval, cdbsBlockToAddSize
-                    , cdbsGcDelay = 0
+                     -- TODO: Vary cdbsGcDelay, cdbsGcInterval, cdbsBlockToAddSize
+                      cdbsGcDelay = 0
                     , cdbsTracer = instrumentationTracer <> nullDebugTracer
                     }
                 }
@@ -826,7 +821,7 @@ runThreadNetwork systemTime ThreadNetworkArgs
           headerAddTracer  = wrapTracer $ nodeEventsHeaderAdds nodeInfoEvents
           pipeliningTracer = nodeEventsPipelining nodeInfoEvents
       let chainDbArgs = mkArgs
-            clock registry
+            registry
             pInfoConfig pInfoInitLedger
             invalidTracer
             addTracer
@@ -1004,7 +999,7 @@ runThreadNetwork systemTime ThreadNetworkArgs
             , initChainDB             = nodeInitChainDB
             , chainSyncFutureCheck    =
                   InFutureCheck.realHeaderInFutureCheck
-                    InFuture.defaultClockSkew
+                    InFutureCheck.defaultClockSkew
                     (OracularClock.finiteSystemTime clock)
             , chainSyncHistoricityCheck = \_getGsmState -> HistoricityCheck.noCheck
             , blockFetchSize          = estimateBlockSize
diff --git a/ouroboros-consensus/bench/ChainSync-client-bench/Main.hs b/ouroboros-consensus/bench/ChainSync-client-bench/Main.hs
index 04b6e5ca20..07e2507967 100644
--- a/ouroboros-consensus/bench/ChainSync-client-bench/Main.hs
+++ b/ouroboros-consensus/bench/ChainSync-client-bench/Main.hs
@@ -17,13 +17,14 @@ import           Network.TypedProtocol.Driver.Simple
 import           Ouroboros.Consensus.Block
 import           Ouroboros.Consensus.BlockchainTime
 import           Ouroboros.Consensus.Config
-import           Ouroboros.Consensus.Fragment.InFuture (clockSkewInSeconds)
 import qualified Ouroboros.Consensus.HardFork.History as HardFork
 import qualified Ouroboros.Consensus.HeaderStateHistory as HeaderStateHistory
 import qualified Ouroboros.Consensus.HeaderValidation as HV
 import qualified Ouroboros.Consensus.Ledger.Extended as Extended
 import qualified Ouroboros.Consensus.MiniProtocol.ChainSync.Client as CSClient
 import qualified Ouroboros.Consensus.MiniProtocol.ChainSync.Client.HistoricityCheck as HistoricityCheck
+import           Ouroboros.Consensus.MiniProtocol.ChainSync.Client.InFutureCheck
+                     (clockSkewInSeconds)
 import qualified Ouroboros.Consensus.MiniProtocol.ChainSync.Client.InFutureCheck as InFutureCheck
 import           Ouroboros.Consensus.MiniProtocol.ChainSync.Server
                      (chainSyncServerForFollower)
diff --git a/ouroboros-consensus/ouroboros-consensus.cabal b/ouroboros-consensus/ouroboros-consensus.cabal
index 61948d6787..774a787b19 100644
--- a/ouroboros-consensus/ouroboros-consensus.cabal
+++ b/ouroboros-consensus/ouroboros-consensus.cabal
@@ -90,7 +90,6 @@ library
     Ouroboros.Consensus.Config.SupportsNode
     Ouroboros.Consensus.Forecast
     Ouroboros.Consensus.Fragment.Diff
-    Ouroboros.Consensus.Fragment.InFuture
     Ouroboros.Consensus.Fragment.Validated
     Ouroboros.Consensus.Fragment.ValidatedDiff
     Ouroboros.Consensus.Genesis.Governor
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Fragment/InFuture.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Fragment/InFuture.hs
deleted file mode 100644
index 31d4019ef2..0000000000
--- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Fragment/InFuture.hs
+++ /dev/null
@@ -1,204 +0,0 @@
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE DerivingVia #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-
--- | Intended for qualified import
---
--- > import Ouroboros.Consensus.Fragment.InFuture (CheckInFuture(..), ClockSkew(..))
--- > import qualified Ouroboros.Consensus.Fragment.InFuture as InFuture
-module Ouroboros.Consensus.Fragment.InFuture (
-    CheckInFuture (..)
-  , InFuture (..)
-  , reference
-    -- * Clock skew
-  , clockSkewInSeconds
-  , defaultClockSkew
-    -- ** not exporting the constructor
-  , ClockSkew
-  , unClockSkew
-    -- * Testing
-  , dontCheck
-  , miracle
-  ) where
-
-import           Control.Monad.Class.MonadSTM
-import           Data.Bifunctor
-import           Data.Time (NominalDiffTime)
-import           Data.Word
-import           NoThunks.Class (NoThunks, OnlyCheckWhnfNamed (..))
-import           Ouroboros.Consensus.Block
-import           Ouroboros.Consensus.BlockchainTime
-import           Ouroboros.Consensus.Fragment.Validated (ValidatedFragment)
-import qualified Ouroboros.Consensus.Fragment.Validated as VF
-import           Ouroboros.Consensus.HardFork.Abstract
-import qualified Ouroboros.Consensus.HardFork.History as HF
-import           Ouroboros.Consensus.Ledger.Abstract
-import           Ouroboros.Consensus.Storage.ChainDB.API.Types.InvalidBlockPunishment
-                     (InvalidBlockPunishment)
-import qualified Ouroboros.Consensus.Storage.ChainDB.API.Types.InvalidBlockPunishment as InvalidBlockPunishment
-import           Ouroboros.Consensus.Util.Time
-import           Ouroboros.Network.AnchoredFragment (AnchoredFragment,
-                     AnchoredSeq (Empty, (:>)))
-
-data CheckInFuture m blk = CheckInFuture {
-       -- | POSTCONDITION:
-       --
-       -- > checkInFuture vf >>= \(af, fut) ->
-       -- >   validatedFragment vf == af <=> null fut
-       checkInFuture :: ValidatedFragment (Header blk) (LedgerState blk)
-                     -> m (AnchoredFragment (Header blk), [InFuture m blk])
-    }
-  deriving NoThunks
-       via OnlyCheckWhnfNamed "CheckInFuture" (CheckInFuture m blk)
-
--- | Header of block that we found to be in the future
-data InFuture m blk = InFuture {
-      -- | The header itself
-      inFutureHeader           :: Header blk
-
-      -- | Whether or not this header exceeded the allowed clock skew
-      --
-      -- Headers that do exceed the clock skew should be considered invalid.
-    , inFutureExceedsClockSkew :: Bool
-
-      -- | 'Ouroboros.Consensus.Storage.ChainDB.Impl.Types.blockPunish'
-    , inFuturePunish           :: InvalidBlockPunishment m
-    }
-
-{-------------------------------------------------------------------------------
-  Clock skew
--------------------------------------------------------------------------------}
-
--- | Maximum permissible clock skew
---
--- When running NTP, systems clocks will never be perfectly synchronized. The
--- maximum clock skew records how much of a difference we consider acceptable.
---
--- For example. Suppose
---
--- * Two nodes A and B
--- * A's clock is 0.5 ahead of B's
--- * A produces a block and sends it to B
--- * When B translates the 'SlotNo' of that block to a time, it may find that
---   it is 0.5 seconds ahead of its current clock (worst case).
---
--- The maximum permissible clock skew decides if B will consider this block to
--- be valid (even if it will not yet consider it for chain seleciton) or as
--- invalid (and disconnect from A, since A is sending it invalid blocks).
---
--- Use 'defaultClockSkew' when unsure.
-newtype ClockSkew = ClockSkew { unClockSkew :: NominalDiffTime }
-  deriving (Show, Eq, Ord)
-
--- | Default maximum permissible clock skew
---
--- See 'ClockSkew' for details. We allow for 2 seconds skew by default.
-defaultClockSkew :: ClockSkew
-defaultClockSkew = clockSkewInSeconds 2
-
--- | Specify maximum clock skew in seconds
-clockSkewInSeconds :: Double -> ClockSkew
-clockSkewInSeconds = ClockSkew . secondsToNominalDiffTime
-
-{-------------------------------------------------------------------------------
-  Reference implementation
--------------------------------------------------------------------------------}
-
-reference :: forall m blk. (Monad m, UpdateLedger blk, HasHardForkHistory blk)
-          => LedgerConfig blk
-          -> ClockSkew
-          -> SystemTime m
-          -> CheckInFuture m blk
-reference cfg (ClockSkew clockSkew) SystemTime{..} = CheckInFuture {
-      checkInFuture = \validated -> do
-        now <- systemTimeCurrent
-        -- Since we have the ledger state /after/ the fragment, the derived
-        -- summary can be used to check all of the blocks in the fragment
-        return $
-          checkFragment
-            (hardForkSummary cfg (VF.validatedLedger validated))
-            now
-            (VF.validatedFragment validated)
-    }
-  where
-    checkFragment :: HF.Summary (HardForkIndices blk)
-                  -> RelativeTime
-                  -> AnchoredFragment (Header blk)
-                  -> (AnchoredFragment (Header blk), [InFuture m blk])
-    checkFragment summary now = go
-      where
-        -- We work from newest to oldest, because as soon as we reach any block
-        -- that is not ahead of @no@, the older blocks certainly aren't either.
-        go :: AnchoredFragment (Header blk)
-           -> (AnchoredFragment (Header blk), [InFuture m blk])
-        go (Empty a) = (Empty a, [])
-        go (hs :> h) =
-            case HF.runQuery
-                   (HF.slotToWallclock (blockSlot h))
-                   summary of
-              Left _err ->
-                error "CheckInFuture.reference: impossible"
-              Right (hdrTime, _) ->
-                if hdrTime > now then
-                  second (inFuture h hdrTime:) $ go hs
-                else
-                  (hs :> h, [])
-
-        inFuture :: Header blk -> RelativeTime -> InFuture m blk
-        inFuture hdr hdrTime = InFuture {
-              inFutureHeader           = hdr
-            , inFutureExceedsClockSkew = (hdrTime `diffRelTime` now)
-                                       > clockSkew
-            , inFuturePunish           = InvalidBlockPunishment.noPunishment
-            }
-
-{-------------------------------------------------------------------------------
-  Test infrastructure
--------------------------------------------------------------------------------}
-
--- | Trivial 'InFuture' check that doesn't do any check at all
---
--- This is useful for testing and tools such as the DB converter.
-dontCheck :: Monad m => CheckInFuture m blk
-dontCheck = CheckInFuture {
-      checkInFuture = \validated -> return (VF.validatedFragment validated, [])
-    }
-
--- | If by some miracle we have a function that can always tell us what the
--- correct slot is, implementing 'CheckInFuture' is easy
---
--- NOTE: Use of 'miracle' in tests means that none of the hard fork
--- infrastructure for converting slots to time is tested.
-miracle :: forall m blk. (MonadSTM m, HasHeader (Header blk))
-        => STM m SlotNo          -- ^ Get current slot
-        -> Word64                -- ^ Maximum clock skew (in terms of slots)
-        -> CheckInFuture m blk
-miracle oracle clockSkew = CheckInFuture {
-      checkInFuture = \validated -> do
-        now <- atomically $ oracle
-        return $ checkFragment now (VF.validatedFragment validated)
-    }
-  where
-    checkFragment :: SlotNo
-                  -> AnchoredFragment (Header blk)
-                  -> (AnchoredFragment (Header blk), [InFuture m blk])
-    checkFragment now = go
-      where
-        go :: AnchoredFragment (Header blk)
-           -> (AnchoredFragment (Header blk), [InFuture m blk])
-        go (Empty a) = (Empty a, [])
-        go (hs :> h) =
-            if blockSlot h > now then
-              second (inFuture h:) $ go hs
-            else
-              (hs :> h, [])
-
-        inFuture :: Header blk -> InFuture m blk
-        inFuture hdr = InFuture {
-              inFutureHeader           = hdr
-            , inFutureExceedsClockSkew = HF.countSlots (blockSlot hdr) now
-                                       > clockSkew
-            , inFuturePunish           = InvalidBlockPunishment.noPunishment
-            }
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/MiniProtocol/ChainSync/Client/InFutureCheck.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/MiniProtocol/ChainSync/Client/InFutureCheck.hs
index be0115d892..052aede894 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/MiniProtocol/ChainSync/Client/InFutureCheck.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/MiniProtocol/ChainSync/Client/InFutureCheck.hs
@@ -12,6 +12,12 @@ module Ouroboros.Consensus.MiniProtocol.ChainSync.Client.InFutureCheck (
     -- * Real Implementation
   , HeaderArrivalException (..)
   , realHeaderInFutureCheck
+    -- * Clock skew
+  , clockSkewInSeconds
+  , defaultClockSkew
+    -- ** not exporting the constructor
+  , ClockSkew
+  , unClockSkew
   ) where
 
 import           Control.Exception (Exception)
@@ -27,14 +33,14 @@ import           Ouroboros.Consensus.Block.RealPoint (RealPoint,
                      headerRealPoint, realPointSlot)
 import           Ouroboros.Consensus.BlockchainTime.WallClock.Types
                      (RelativeTime, SystemTime, diffRelTime, systemTimeCurrent)
-import           Ouroboros.Consensus.Fragment.InFuture (ClockSkew, unClockSkew)
 import           Ouroboros.Consensus.HardFork.Abstract (HasHardForkHistory,
                      hardForkSummary)
 import           Ouroboros.Consensus.HardFork.History (PastHorizonException)
 import           Ouroboros.Consensus.HardFork.History.Qry (runQuery,
                      slotToWallclock)
 import           Ouroboros.Consensus.Ledger.Basics (LedgerConfig, LedgerState)
-import           Ouroboros.Consensus.Util.Time (nominalDelay)
+import           Ouroboros.Consensus.Util.Time (nominalDelay,
+                     secondsToNominalDiffTime)
 import           Ouroboros.Network.Block (HasHeader)
 
 {-------------------------------------------------------------------------------
@@ -152,3 +158,38 @@ realHeaderInFutureCheck skew systemTime =
           -- no exception if within skew
           pure onset
   }
+
+{-------------------------------------------------------------------------------
+  Clock skew
+-------------------------------------------------------------------------------}
+
+-- | Maximum permissible clock skew
+--
+-- When running NTP, systems clocks will never be perfectly synchronized. The
+-- maximum clock skew records how much of a difference we consider acceptable.
+--
+-- For example. Suppose
+--
+-- * Two nodes A and B
+-- * A's clock is 0.5 ahead of B's
+-- * A produces a block and sends it to B
+-- * When B translates the 'SlotNo' of that block to a time, it may find that
+--   it is 0.5 seconds ahead of its current clock (worst case).
+--
+-- The maximum permissible clock skew decides if B will consider this block to
+-- be valid (even if it will not yet consider it for chain seleciton) or as
+-- invalid (and disconnect from A, since A is sending it invalid blocks).
+--
+-- Use 'defaultClockSkew' when unsure.
+newtype ClockSkew = ClockSkew { unClockSkew :: NominalDiffTime }
+  deriving (Show, Eq, Ord)
+
+-- | Default maximum permissible clock skew
+--
+-- See 'ClockSkew' for details. We allow for 5 seconds skew by default.
+defaultClockSkew :: ClockSkew
+defaultClockSkew = clockSkewInSeconds 5
+
+-- | Specify maximum clock skew in seconds
+clockSkewInSeconds :: Double -> ClockSkew
+clockSkewInSeconds = ClockSkew . secondsToNominalDiffTime
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/Args.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/Args.hs
index f95aadee7d..9b88506e0b 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/Args.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/Args.hs
@@ -24,7 +24,6 @@ import           Data.Kind
 import           Data.Time.Clock (secondsToDiffTime)
 import           Ouroboros.Consensus.Block
 import           Ouroboros.Consensus.Config
-import           Ouroboros.Consensus.Fragment.InFuture (CheckInFuture)
 import           Ouroboros.Consensus.Ledger.Extended
 import           Ouroboros.Consensus.Protocol.Abstract
 import           Ouroboros.Consensus.Storage.ChainDB.API (GetLoEFragment,
@@ -64,7 +63,6 @@ data ChainDbSpecificArgs f m blk = ChainDbSpecificArgs {
       -- is the maximum number of blocks that could be kept in memory at the
       -- same time when the background thread processing the blocks can't keep
       -- up.
-    , cdbsCheckInFuture   :: HKD f (CheckInFuture m blk)
     , cdbsGcDelay         :: DiffTime
       -- ^ Delay between copying a block to the ImmutableDB and triggering a
       -- garbage collection for the corresponding slot on the VolatileDB.
@@ -92,7 +90,6 @@ data ChainDbSpecificArgs f m blk = ChainDbSpecificArgs {
 --
 -- * 'cdbsTracer'
 -- * 'cdbsRegistry'
--- * 'cdbsCheckInFuture'
 --
 -- We a 'cdbsGcDelay' of 60 seconds and a 'cdbsGcInterval' of 10 seconds, this
 -- means (see the properties in "Test.Ouroboros.Storage.ChainDB.GcSchedule"):
@@ -111,7 +108,6 @@ data ChainDbSpecificArgs f m blk = ChainDbSpecificArgs {
 defaultSpecificArgs :: Monad m => Incomplete ChainDbSpecificArgs m blk
 defaultSpecificArgs = ChainDbSpecificArgs {
       cdbsBlocksToAddSize = 10
-    , cdbsCheckInFuture   = noDefault
     , cdbsGcDelay         = secondsToDiffTime 60
     , cdbsGcInterval      = secondsToDiffTime 10
     , cdbsRegistry        = noDefault
@@ -151,7 +147,6 @@ ensureValidateAll args =
 completeChainDbArgs ::
      forall m blk. (ConsensusProtocol (BlockProtocol blk), IOLike m)
   => ResourceRegistry m
-  -> CheckInFuture m blk
   -> TopLevelConfig blk
   -> ExtLedgerState blk
      -- ^ Initial ledger
@@ -167,7 +162,6 @@ completeChainDbArgs ::
   -> Complete ChainDbArgs m blk
 completeChainDbArgs
   registry
-  cdbsCheckInFuture
   cdbsTopLevelConfig
   initLedger
   immChunkInfo
@@ -194,8 +188,7 @@ completeChainDbArgs
           , LedgerDB.lgrConfig     = LedgerDB.configLedgerDb cdbsTopLevelConfig
           }
       , cdbsArgs = (cdbsArgs defArgs) {
-            cdbsCheckInFuture
-          , cdbsRegistry       = registry
+            cdbsRegistry       = registry
           , cdbsTopLevelConfig
           , cdbsHasFSGsmDB     = mkVolFS $ RelativeMountPoint "gsm"
           }
diff --git a/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/ChainDB.hs b/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/ChainDB.hs
index 95d1ba6835..b81819ecd6 100644
--- a/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/ChainDB.hs
+++ b/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/ChainDB.hs
@@ -18,8 +18,6 @@ import           Control.Tracer (nullTracer)
 import           Ouroboros.Consensus.Block.Abstract
 import           Ouroboros.Consensus.Config
                      (TopLevelConfig (topLevelConfigLedger), configCodec)
-import           Ouroboros.Consensus.Fragment.InFuture (CheckInFuture (..))
-import qualified Ouroboros.Consensus.Fragment.Validated as VF
 import           Ouroboros.Consensus.HardFork.History.EraParams (eraEpochSize)
 import           Ouroboros.Consensus.Ledger.Extended (ExtLedgerState)
 import           Ouroboros.Consensus.Protocol.Abstract
@@ -123,8 +121,6 @@ fromMinimalChainDbArgs MinimalChainDbArgs {..} = ChainDbArgs {
         }
     , cdbsArgs = ChainDbSpecificArgs {
           cdbsBlocksToAddSize = 1
-        , cdbsCheckInFuture   = CheckInFuture $ \vf -> pure (VF.validatedFragment vf, [])
-          -- Blocks are never in the future
         , cdbsGcDelay         = 1
         , cdbsHasFSGsmDB      = SomeHasFS $ simHasFS (nodeDBsGsm mcdbNodeDBs)
         , cdbsGcInterval      = 1
diff --git a/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/Orphans/Arbitrary.hs b/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/Orphans/Arbitrary.hs
index 39173fc01e..52e2cfed17 100644
--- a/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/Orphans/Arbitrary.hs
+++ b/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/Orphans/Arbitrary.hs
@@ -37,8 +37,6 @@ import           Data.Time
 import           Data.Word (Word64)
 import           Ouroboros.Consensus.Block
 import           Ouroboros.Consensus.BlockchainTime
-import           Ouroboros.Consensus.Fragment.InFuture (ClockSkew)
-import qualified Ouroboros.Consensus.Fragment.InFuture as InFuture
 import           Ouroboros.Consensus.HardFork.Combinator (HardForkBlock,
                      HardForkChainDepState, HardForkState (..),
                      LedgerEraInfo (..), LedgerState (..), Mismatch (..),
@@ -51,6 +49,9 @@ import           Ouroboros.Consensus.HeaderValidation (TipInfo)
 import           Ouroboros.Consensus.Ledger.Abstract
 import           Ouroboros.Consensus.Ledger.Query
 import           Ouroboros.Consensus.Ledger.SupportsMempool
+import           Ouroboros.Consensus.MiniProtocol.ChainSync.Client.InFutureCheck
+                     (ClockSkew)
+import qualified Ouroboros.Consensus.MiniProtocol.ChainSync.Client.InFutureCheck as InFutureCheck
 import           Ouroboros.Consensus.Node.ProtocolInfo
 import           Ouroboros.Consensus.Protocol.Abstract (ChainDepState)
 import           Ouroboros.Consensus.Storage.ChainDB.API (LoE (..))
@@ -147,7 +148,7 @@ instance Arbitrary ChunkSlot where
   shrink    = genericShrink
 
 instance Arbitrary ClockSkew where
-  arbitrary = InFuture.clockSkewInSeconds <$> choose (0, 5)
+  arbitrary = InFutureCheck.clockSkewInSeconds <$> choose (0, 5)
   shrink skew = concat [
      -- Shrink to some simple values, including 0
      -- (it would be useful to know if a test fails only when having non-zero
@@ -157,8 +158,8 @@ instance Arbitrary ClockSkew where
      ]
     where
       skew0, skew1 :: ClockSkew
-      skew0 = InFuture.clockSkewInSeconds 0
-      skew1 = InFuture.clockSkewInSeconds 1
+      skew0 = InFutureCheck.clockSkewInSeconds 0
+      skew1 = InFutureCheck.clockSkewInSeconds 1
 
 deriving newtype instance Arbitrary SizeInBytes
 
diff --git a/ouroboros-consensus/test/consensus-test/Test/Consensus/MiniProtocol/ChainSync/Client.hs b/ouroboros-consensus/test/consensus-test/Test/Consensus/MiniProtocol/ChainSync/Client.hs
index 0905fc375f..a0b104f9e9 100644
--- a/ouroboros-consensus/test/consensus-test/Test/Consensus/MiniProtocol/ChainSync/Client.hs
+++ b/ouroboros-consensus/test/consensus-test/Test/Consensus/MiniProtocol/ChainSync/Client.hs
@@ -73,8 +73,6 @@ import           Network.TypedProtocol.Driver.Simple
 import           Ouroboros.Consensus.Block
 import           Ouroboros.Consensus.BlockchainTime
 import           Ouroboros.Consensus.Config
-import           Ouroboros.Consensus.Fragment.InFuture (ClockSkew,
-                     clockSkewInSeconds, unClockSkew)
 import qualified Ouroboros.Consensus.HardFork.History as HardFork
 import           Ouroboros.Consensus.HeaderStateHistory
                      (HeaderStateHistory (..))
@@ -92,6 +90,8 @@ import           Ouroboros.Consensus.MiniProtocol.ChainSync.Client
 import           Ouroboros.Consensus.MiniProtocol.ChainSync.Client.HistoricityCheck
                      (HistoricityCheck, HistoricityCutoff (..))
 import qualified Ouroboros.Consensus.MiniProtocol.ChainSync.Client.HistoricityCheck as HistoricityCheck
+import           Ouroboros.Consensus.MiniProtocol.ChainSync.Client.InFutureCheck
+                     (ClockSkew, clockSkewInSeconds, unClockSkew)
 import qualified Ouroboros.Consensus.MiniProtocol.ChainSync.Client.InFutureCheck as InFutureCheck
 import           Ouroboros.Consensus.Node.GsmState (GsmState (Syncing))
 import           Ouroboros.Consensus.Node.NetworkProtocolVersion
diff --git a/ouroboros-consensus/test/storage-test/Test/Ouroboros/Storage/ChainDB/StateMachine.hs b/ouroboros-consensus/test/storage-test/Test/Ouroboros/Storage/ChainDB/StateMachine.hs
index 2eacc254b7..8782585318 100644
--- a/ouroboros-consensus/test/storage-test/Test/Ouroboros/Storage/ChainDB/StateMachine.hs
+++ b/ouroboros-consensus/test/storage-test/Test/Ouroboros/Storage/ChainDB/StateMachine.hs
@@ -107,7 +107,6 @@ import           GHC.Generics (Generic)
 import           NoThunks.Class (AllowThunk (..))
 import           Ouroboros.Consensus.Block
 import           Ouroboros.Consensus.Config
-import qualified Ouroboros.Consensus.Fragment.InFuture as InFuture
 import           Ouroboros.Consensus.HardFork.Abstract
 import           Ouroboros.Consensus.HeaderValidation
 import           Ouroboros.Consensus.Ledger.Abstract
@@ -1564,8 +1563,6 @@ runCmdsLockstep loe maxClockSkew (SmallChunkInfo chunkInfo) cmds =
                    threadRegistry
                    nodeDBs
                    tracer
-                   maxClockSkew
-                   varCurSlot
                    (loe $> varLoEFragment)
 
       (hist, model, res, trace) <- bracket
@@ -1711,11 +1708,9 @@ mkArgs :: IOLike m
        -> ResourceRegistry m
        -> NodeDBs (StrictTMVar m MockFS)
        -> CT.Tracer m (TraceEvent Blk)
-       -> MaxClockSkew
-       -> StrictTVar m SlotNo
        -> LoE (StrictTVar m (AnchoredFragment (Header Blk)))
        -> ChainDbArgs Identity m Blk
-mkArgs cfg chunkInfo initLedger registry nodeDBs tracer (MaxClockSkew maxClockSkew) varCurSlot varLoEFragment =
+mkArgs cfg chunkInfo initLedger registry nodeDBs tracer varLoEFragment =
   let args = fromMinimalChainDbArgs MinimalChainDbArgs {
             mcdbTopLevelConfig = cfg
           , mcdbChunkInfo = chunkInfo
@@ -1725,8 +1720,7 @@ mkArgs cfg chunkInfo initLedger registry nodeDBs tracer (MaxClockSkew maxClockSk
           }
   in ChainDB.updateTracer tracer $
       args { cdbsArgs = (cdbsArgs args) {
-               ChainDB.cdbsCheckInFuture = InFuture.miracle (readTVar varCurSlot) maxClockSkew
-             , ChainDB.cdbsBlocksToAddSize = 2
+               ChainDB.cdbsBlocksToAddSize = 2
              , ChainDB.cdbsLoE = traverse (atomically . readTVar) varLoEFragment
              }
            , cdbImmDbArgs = (cdbImmDbArgs args) {

From 78343cbab5211b43a05ea007e456343d96fd219c Mon Sep 17 00:00:00 2001
From: Damian Nadales <damian.nadales@iohk.io>
Date: Fri, 27 Sep 2024 12:06:46 +0200
Subject: [PATCH 04/11] Add a section in our documentation describing how
 blocks from the future are handled

---
 .../HandlingBlocksFromTheFuture.md            | 42 +++++++++++++++++++
 docs/website/sidebars.js                      |  1 +
 2 files changed, 43 insertions(+)
 create mode 100644 docs/website/contents/for-developers/HandlingBlocksFromTheFuture.md

diff --git a/docs/website/contents/for-developers/HandlingBlocksFromTheFuture.md b/docs/website/contents/for-developers/HandlingBlocksFromTheFuture.md
new file mode 100644
index 0000000000..2e698315ab
--- /dev/null
+++ b/docs/website/contents/for-developers/HandlingBlocksFromTheFuture.md
@@ -0,0 +1,42 @@
+#  Blocks from the future
+
+A node can receive a block whose slot is ahead of the current slot. We call such **blocks from the future**.
+
+The Praos protocol ignores chains with blocks from the future during chain selection.
+It assumes nodes have perfectly synchronized clocks, which is not realistic due to imperfections in protocols like NTP and leap seconds.
+In practice, a clock skew of up to 2 seconds is considered acceptable.
+Our implementation differentiates between blocks from the near future and those from the far future:
+
+- A block is from the near future if the onset of its slot is ahead of the wall clock, but only by at most the admissible clock skew. Despite being from the future, these blocks are assumed to potentially have been minted by honest nodes.
+- A block is from the far future if the onset of its slot is ahead of the wall clock by more than the admissible clock skew.  By assumption, these blocks cannot have been minted by an honest node.
+
+# Handling blocks from the future
+
+As of [#525](https://github.com/IntersectMBO/ouroboros-consensus/pull/525):
+
+- When receiving a header from the **near** future in `ChainSync`, an artificial delay is introduced until the header is no longer from the future.
+Only then it is validated and the corresponding block body is downloaded and added to the `ChainDB` for chain selection, where it is not considered to be from the future due to the previous artificial delay.
+- When receiving a header from the far future, we immediately disconnect from the corresponding peer.
+
+### During initialization
+
+Since we now delay the headers until they are no longer from the **near future**, a caught up node will never contain blocks from the future in the `VolatileDB`, according to its own clock.
+However, there are two caveats:
+- Clock rewinds can violate this property. In particular the node [will error](https://github.com/IntersectMBO/ouroboros-consensus/blob/4488656439e78c572c3dce0f7ed2cf98f61c65bb/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/BlockchainTime/WallClock/HardFork.hs#L138-L146) when we rewind the clock by more than [20 seconds](https://github.com/IntersectMBO/ouroboros-consensus/blob/4488656439e78c572c3dce0f7ed2cf98f61c65bb/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/Node.hs#L485).
+- The node clock might be set in the future relative to the rest of the nodes in the network.
+Thus, it is possible that after restarting a node with a clock set in the future, and setting the clock back so that the clock is now synchronized with the rest of the network, the blocks in the `VolatileDB` are regarded as blocks from the future.
+
+When initializing the `ChainDB` we do not check if blocks in the `VolatileDB` are from the future. This presents two inconveniences:
+
+- When the node diffuses these blocks from the **far** future, it will be disconnected from other peers.
+- The node [will not forge](https://github.com/IntersectMBO/ouroboros-consensus/blob/16fa8754be24f26eddef006c03ba945ea00e3566/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/NodeKernel.hs#L708) a block on top of a block from the future, thus missing its chance to lead in the slot.
+
+These problems can be solved by wiping out the `VolatileDB` in this situation.
+However, note this is an extremely rare situation: the clock of the node would have to have been set quite far in the future, as shutting down a node and restarting it already takes a significant amount of time.
+
+In the future we might delete blocks from the future from the `VolatileDB` to improve the user experience and robustness of the initialization logic. For now it does not seem worthwhile to handle that rare case. (Downstream/bidirectional peers will disconnect from such a node, but only until enough time has passed that its `VolatileDB` does not contain blocks from the future anymore.)
+
+# References
+
+- [Original issue that prompted the fix](https://github.com/IntersectMBO/ouroboros-network/issues/4251)
+- [Blocks from the future (Incident report)](https://updates.cardano.intersectmbo.org/2024-09-07-incident)
diff --git a/docs/website/sidebars.js b/docs/website/sidebars.js
index 884a943c30..12e6a7c82a 100644
--- a/docs/website/sidebars.js
+++ b/docs/website/sidebars.js
@@ -50,6 +50,7 @@ const sidebars = {
         'for-developers/TechnicalReports',
         'for-developers/PreflightGuide',
         'for-developers/NodeTasks',
+        'for-developers/HandlingBlocksFromTheFuture'
       ]
     },
   ]

From 28dde8d5c8929de18966384403c5655fbf745969 Mon Sep 17 00:00:00 2001
From: Damian Nadales <damian.nadales@iohk.io>
Date: Wed, 9 Oct 2024 14:15:26 +0200
Subject: [PATCH 05/11] Change `chainSelectionForBlock` so that it returns `()`

... instead of the new tip.

Chain selection uses `Query.getTipPoint` instead of `chainSelectionForBlock`.
---
 .../Storage/ChainDB/Impl/ChainSel.hs          | 38 ++++++-------------
 1 file changed, 11 insertions(+), 27 deletions(-)

diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/ChainSel.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/ChainSel.hs
index 2f27a0137a..b0dcdc26a4 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/ChainSel.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/ChainSel.hs
@@ -21,7 +21,7 @@ module Ouroboros.Consensus.Storage.ChainDB.Impl.ChainSel (
   ) where
 
 import           Control.Exception (assert)
-import           Control.Monad (forM, forM_, void, when)
+import           Control.Monad (forM, forM_, when)
 import           Control.Monad.Except ()
 import           Control.Monad.Trans.Class (lift)
 import           Control.Monad.Trans.State.Strict
@@ -334,7 +334,7 @@ chainSelSync cdb@CDB{..} (ChainSelReprocessLoEBlocks varProcessed) = do
                 _ -> VolatileDB.getKnownBlockComponent cdbVolatileDB GetHeader hash
         loeHeaders <- lift (mapM getHeaderFromHash loeHashes)
         for_ loeHeaders $ \hdr ->
-          void (chainSelectionForBlock cdb BlockCache.empty hdr noPunishment)
+          chainSelectionForBlock cdb BlockCache.empty hdr noPunishment
     lift $ atomically $ putTMVar varProcessed ()
 
 chainSelSync cdb@CDB {..} (ChainSelAddBlock BlockToAdd { blockToAdd = b, .. }) = do
@@ -372,14 +372,7 @@ chainSelSync cdb@CDB {..} (ChainSelAddBlock BlockToAdd { blockToAdd = b, .. }) =
         lift $ encloseWith (traceEv >$< addBlockTracer) $
           VolatileDB.putBlock cdbVolatileDB b
         lift $ deliverWrittenToDisk True
-        -- REVIEW: would the tip returned by
-        --
-        -- > chainSelectionForBlock cdb (BlockCache.singleton b) hdr blockPunish
-        --
-        -- equal
-        --
-        -- > Query.getTipPoint cdb
-        void $ chainSelectionForBlock cdb (BlockCache.singleton b) hdr blockPunish
+        chainSelectionForBlock cdb (BlockCache.singleton b) hdr blockPunish
 
     newTip <- lift $ atomically $ Query.getTipPoint cdb
 
@@ -450,8 +443,6 @@ data ChainSwitchType = AddingBlocks | SwitchingToAFork
 --
 -- PRECONDITION: the slot of the block <= the current (wall) slot
 --
--- The new tip of the current chain is returned.
---
 -- = Constructing candidate fragments
 --
 -- The VolatileDB keeps a \"successors\" map in memory, telling us the hashes
@@ -489,7 +480,7 @@ chainSelectionForBlock ::
   -> BlockCache blk
   -> Header blk
   -> InvalidBlockPunishment m
-  -> Electric m (Point blk)
+  -> Electric m ()
 chainSelectionForBlock cdb@CDB{..} blockCache hdr punish = electric $ do
     (invalid, succsOf', lookupBlockInfo, lookupBlockInfo', curChain, tipPoint, ledgerDB)
       <- atomically $ do
@@ -541,7 +532,6 @@ chainSelectionForBlock cdb@CDB{..} blockCache hdr punish = electric $ do
       -- block is older than @k@.
       | olderThanK hdr isEBB immBlockNo -> do
         traceWith addBlockTracer $ IgnoreBlockOlderThanK p
-        return tipPoint
 
       -- The block is invalid
       | Just (InvalidBlockInfo reason _) <- Map.lookup (headerHash hdr) invalid -> do
@@ -553,8 +543,6 @@ chainSelectionForBlock cdb@CDB{..} blockCache hdr punish = electric $ do
           punish
           InvalidBlockPunishment.BlockItself
 
-        return tipPoint
-
       -- The block fits onto the end of our current chain
       | pointHash tipPoint == headerPrevHash hdr -> do
         -- ### Add to current chain
@@ -572,7 +560,6 @@ chainSelectionForBlock cdb@CDB{..} blockCache hdr punish = electric $ do
       | otherwise -> do
         -- ### Store but don't change the current chain
         traceWith addBlockTracer (StoreButDontChange p)
-        return tipPoint
 
     -- Note that we may have extended the chain, but have not trimmed it to
     -- @k@ blocks/headers. That is the job of the background thread, which
@@ -618,7 +605,7 @@ chainSelectionForBlock cdb@CDB{..} blockCache hdr punish = electric $ do
          -- ^ The current chain and ledger
       -> LoE (AnchoredFragment (Header blk))
          -- ^ LoE fragment
-      -> m (Point blk)
+      -> m ()
     addToCurrentChain succsOf curChainAndLedger loeFrag = do
         -- Extensions of @B@ that do not exceed the LoE
         let suffixesAfterB = Paths.maximalCandidates succsOf Nothing (realPointToPoint p)
@@ -658,11 +645,11 @@ chainSelectionForBlock cdb@CDB{..} blockCache hdr punish = electric $ do
         -- candidate will be a two-block (the EBB and the new block)
         -- extension of the current chain.
         case chainDiffs of
-          Nothing          -> return curTip
+          Nothing          -> return ()
           Just chainDiffs' ->
             chainSelection chainSelEnv chainDiffs' >>= \case
               Nothing ->
-                return curTip
+                return ()
               Just validatedChainDiff ->
                 switchTo
                   validatedChainDiff
@@ -671,7 +658,6 @@ chainSelectionForBlock cdb@CDB{..} blockCache hdr punish = electric $ do
       where
         chainSelEnv = mkChainSelEnv curChainAndLedger
         curChain    = VF.validatedFragment curChainAndLedger
-        curTip      = castPoint $ AF.headPoint curChain
         curHead     = AF.headAnchor curChain
 
     -- | Trim the given candidate fragment to respect the LoE.
@@ -730,7 +716,7 @@ chainSelectionForBlock cdb@CDB{..} blockCache hdr punish = electric $ do
          -- ^ LoE fragment
       -> ChainDiff (HeaderFields blk)
          -- ^ Header fields for @(x,b]@
-      -> m (Point blk)
+      -> m ()
     switchToAFork succsOf lookupBlockInfo curChainAndLedger loeFrag diff = do
         -- We use a cache to avoid reading the headers from disk multiple
         -- times in case they're part of multiple forks that go through @b@.
@@ -765,11 +751,11 @@ chainSelectionForBlock cdb@CDB{..} blockCache hdr punish = electric $ do
 
         case NE.nonEmpty chainDiffs of
           -- No candidates preferred over the current chain
-          Nothing          -> return curTip
+          Nothing          -> return ()
           Just chainDiffs' ->
             chainSelection chainSelEnv chainDiffs' >>= \case
               Nothing                 ->
-                return curTip
+                return ()
               Just validatedChainDiff ->
                 switchTo
                   validatedChainDiff
@@ -778,7 +764,6 @@ chainSelectionForBlock cdb@CDB{..} blockCache hdr punish = electric $ do
       where
         chainSelEnv = mkChainSelEnv curChainAndLedger
         curChain    = VF.validatedFragment curChainAndLedger
-        curTip      = castPoint $ AF.headPoint curChain
 
     mkSelectionChangedInfo ::
          AnchoredFragment (Header blk) -- ^ old chain
@@ -835,7 +820,7 @@ chainSelectionForBlock cdb@CDB{..} blockCache hdr punish = electric $ do
       -> StrictTVar m (StrictMaybe (Header blk))
          -- ^ Tentative header
       -> ChainSwitchType
-      -> m (Point blk)
+      -> m ()
     switchTo vChainDiff varTentativeHeader chainSwitchType = do
         traceWith addBlockTracer $
             ChangingSelection
@@ -891,7 +876,6 @@ chainSelectionForBlock cdb@CDB{..} blockCache hdr punish = electric $ do
         whenJust (strictMaybeToMaybe prevTentativeHeader) $ traceWith $
           PipeliningEvent . OutdatedTentativeHeader >$< addBlockTracer
 
-        return $ castPoint $ AF.headPoint newChain
       where
         -- Given the current chain and the new chain as chain fragments, and the
         -- intersection point (an optimization, since it has already been

From 5d01e90f869e54b30265b0bda8dd69207bf38bf9 Mon Sep 17 00:00:00 2001
From: Damian Nadales <damian.nadales@iohk.io>
Date: Wed, 9 Oct 2024 18:37:04 +0200
Subject: [PATCH 06/11] Add a precondition to `addBlock` and `addBlockAsync`

The precondition states we never add blocks from the future.
---
 .../HandlingBlocksFromTheFuture.md               |  2 ++
 .../Ouroboros/Consensus/Storage/ChainDB/API.hs   | 12 ++++++++++++
 .../Consensus/Storage/ChainDB/Impl/ChainSel.hs   | 16 ++++++++++------
 3 files changed, 24 insertions(+), 6 deletions(-)

diff --git a/docs/website/contents/for-developers/HandlingBlocksFromTheFuture.md b/docs/website/contents/for-developers/HandlingBlocksFromTheFuture.md
index 2e698315ab..3a4cbb769f 100644
--- a/docs/website/contents/for-developers/HandlingBlocksFromTheFuture.md
+++ b/docs/website/contents/for-developers/HandlingBlocksFromTheFuture.md
@@ -18,6 +18,8 @@ As of [#525](https://github.com/IntersectMBO/ouroboros-consensus/pull/525):
 Only then it is validated and the corresponding block body is downloaded and added to the `ChainDB` for chain selection, where it is not considered to be from the future due to the previous artificial delay.
 - When receiving a header from the far future, we immediately disconnect from the corresponding peer.
 
+In addition, we never forge atop a block from the future (which was the case even before [#525](https://github.com/IntersectMBO/ouroboros-consensus/pull/525).
+
 ### During initialization
 
 Since we now delay the headers until they are no longer from the **near future**, a caught up node will never contain blocks from the future in the `VolatileDB`, according to its own clock.
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/API.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/API.hs
index db7577e835..594fb35a69 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/API.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/API.hs
@@ -134,6 +134,15 @@ data ChainDB m blk = ChainDB {
       -- use 'addBlock' to add the block synchronously.
       --
       -- NOTE: back pressure can be applied when overloaded.
+      --
+      -- PRECONDITON: the block to be added must not be from the future.
+      --
+      -- The current code ensures that the two sources of blocks
+      -- ('ChainSync' and forging) do not allow blocks from the future,
+      -- however this is not guaranteed when during initialization if the
+      -- VolatileDB contains blocks from the future. See:
+      -- https://github.com/IntersectMBO/ouroboros-consensus/blob/main/docs/website/contents/for-developers/HandlingBlocksFromTheFuture.md#handling-blocks-from-the-future
+      --
       addBlockAsync      :: InvalidBlockPunishment m -> blk -> m (AddBlockPromise m blk)
 
       -- | Trigger reprocessing of blocks postponed by the LoE.
@@ -440,6 +449,9 @@ addBlockWaitWrittenToDisk chainDB punish blk = do
 -- block died, in that case 'FailedToAddBlock' will be returned.
 --
 -- Note: this is a partial function, only to support tests.
+--
+-- PRECONDITION: the block to be added must not be from the future. See 'addBlockAsync'.
+--
 addBlock :: IOLike m => ChainDB m blk -> InvalidBlockPunishment m -> blk -> m (AddBlockResult blk)
 addBlock chainDB punish blk = do
     promise <- addBlockAsync chainDB punish blk
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/ChainSel.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/ChainSel.hs
index b0dcdc26a4..f88e38165e 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/ChainSel.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/ChainSel.hs
@@ -249,12 +249,12 @@ initialChainSelection immutableDB volatileDB lgrDB tracer cfg varInvalid
 --
 -- When the queue is full, this function will still block.
 --
--- An important advantage of this asynchronous approach over a synchronous
--- approach is that it doesn't have the following disadvantage: when a thread
--- adding a block to the ChainDB is killed, which can happen when
--- disconnecting from the corresponding node, we might have written the block
--- to disk, but not updated the corresponding in-memory state (e.g., that of
--- the VolatileDB), leaving both out of sync.
+-- Compared to a synchronous approach, the asynchronous counterpart
+-- doesn't have the following disadvantage: when a thread adding a
+-- block to the ChainDB is killed, which can happen when disconnecting
+-- from the corresponding node, we might have written the block to
+-- disk, but not updated the corresponding in-memory state (e.g., that
+-- of the VolatileDB), leaving both out of sync.
 --
 -- With this asynchronous approach, threads adding blocks asynchronously can
 -- be killed without worries, the background thread processing the blocks
@@ -263,6 +263,10 @@ initialChainSelection immutableDB volatileDB lgrDB tracer cfg varInvalid
 -- in-memory state, it can't get out of sync with the file system state. On
 -- the next startup, a correct in-memory state will be reconstructed from the
 -- file system state.
+--
+-- PRECONDITON: the block to be added must not be from the future.
+-- See 'Ouroboros.Consensus.Storage.ChainDB.API.addBlockAsync'.
+--
 addBlockAsync ::
      forall m blk. (IOLike m, HasHeader blk)
   => ChainDbEnv m blk

From 4220761cf843744e5dd6f690fa722e1853a4ae17 Mon Sep 17 00:00:00 2001
From: Damian Nadales <damian.nadales@iohk.io>
Date: Fri, 11 Oct 2024 11:47:03 +0200
Subject: [PATCH 07/11] Remove the `AddFutureBlock` command

The `ChainDB` state machine model does not need to take the block
slots into account, as a result this part of the logic has been
removed from the model and tests.
---
 .../Test/Ouroboros/Storage/ChainDB/Model.hs   |  87 +------------
 .../Ouroboros/Storage/ChainDB/Model/Test.hs   |   4 +-
 .../Ouroboros/Storage/ChainDB/StateMachine.hs | 117 +++---------------
 .../ChainDB/StateMachine/Utils/RunOnRepl.hs   |  10 +-
 .../Test/Ouroboros/Storage/ChainDB/Unit.hs    |   7 +-
 5 files changed, 29 insertions(+), 196 deletions(-)

diff --git a/ouroboros-consensus/test/storage-test/Test/Ouroboros/Storage/ChainDB/Model.hs b/ouroboros-consensus/test/storage-test/Test/Ouroboros/Storage/ChainDB/Model.hs
index e9c9cb5c05..6e1ba15770 100644
--- a/ouroboros-consensus/test/storage-test/Test/Ouroboros/Storage/ChainDB/Model.hs
+++ b/ouroboros-consensus/test/storage-test/Test/Ouroboros/Storage/ChainDB/Model.hs
@@ -27,8 +27,6 @@ module Test.Ouroboros.Storage.ChainDB.Model (
     -- * Queries
   , currentChain
   , currentLedger
-  , currentSlot
-  , futureBlocks
   , getBlock
   , getBlockByPoint
   , getBlockComponentByPoint
@@ -44,7 +42,6 @@ module Test.Ouroboros.Storage.ChainDB.Model (
   , isOpen
   , isValid
   , lastK
-  , maxClockSkew
   , tipBlock
   , tipPoint
   , volatileChain
@@ -61,7 +58,6 @@ module Test.Ouroboros.Storage.ChainDB.Model (
   , ModelSupportsBlock
     -- * Exported for testing purposes
   , ShouldGarbageCollect (GarbageCollect, DoNotGarbageCollect)
-  , advanceCurSlot
   , between
   , blocks
   , chains
@@ -140,10 +136,7 @@ data Model blk = Model {
     , iterators        :: Map IteratorId [blk]
     , valid            :: Set (HeaderHash blk)
     , invalid          :: InvalidBlocks blk
-    , currentSlot      :: SlotNo
     , loeFragment      :: LoE (AnchoredFragment blk)
-    , maxClockSkew     :: Word64
-      -- ^ Max clock skew in terms of slots. A static configuration parameter.
     , isOpen           :: Bool
       -- ^ While the model tracks whether it is closed or not, the queries and
       -- other functions in this module ignore this for simplicity. The mock
@@ -180,10 +173,6 @@ immutableDbBlocks Model { immutableDbChain } = Map.fromList $
 blocks :: HasHeader blk => Model blk -> Map (HeaderHash blk) blk
 blocks m = volatileDbBlocks m <> immutableDbBlocks m
 
-futureBlocks :: HasHeader blk => Model blk -> Map (HeaderHash blk) blk
-futureBlocks m =
-    Map.filter ((currentSlot m <) . blockSlot) (volatileDbBlocks m)
-
 currentChain :: Model blk -> Chain blk
 currentChain = CPS.producerChain . cps
 
@@ -373,9 +362,8 @@ empty ::
      HasHeader blk
   => LoE ()
   -> ExtLedgerState blk
-  -> Word64   -- ^ Max clock skew in number of blocks
   -> Model blk
-empty loe initLedger maxClockSkew = Model {
+empty loe initLedger = Model {
       volatileDbBlocks = Map.empty
     , immutableDbChain = Chain.Genesis
     , cps              = CPS.initChainProducerState Chain.Genesis
@@ -384,19 +372,10 @@ empty loe initLedger maxClockSkew = Model {
     , iterators        = Map.empty
     , valid            = Set.empty
     , invalid          = Map.empty
-    , currentSlot      = 0
-    , maxClockSkew     = maxClockSkew
     , isOpen           = True
     , loeFragment      = loe $> Fragment.Empty Fragment.AnchorGenesis
     }
 
--- | Advance the 'currentSlot' of the model to the given 'SlotNo' if the
--- current slot of the model < the given 'SlotNo'.
-advanceCurSlot ::
-     SlotNo  -- ^ The new current slot
-  -> Model blk -> Model blk
-advanceCurSlot curSlot m = m { currentSlot = curSlot `max` currentSlot m }
-
 addBlock :: forall blk. LedgerSupportsProtocol blk
          => TopLevelConfig blk
          -> blk
@@ -431,8 +410,6 @@ chainSelection cfg m = Model {
     , iterators        = iterators  m
     , valid            = valid'
     , invalid          = invalid'
-    , currentSlot      = currentSlot  m
-    , maxClockSkew     = maxClockSkew m
     , isOpen           = True
     , loeFragment      = loeFragment m
     }
@@ -747,7 +724,7 @@ validate :: forall blk. LedgerSupportsProtocol blk
          -> Model blk
          -> Chain blk
          -> ValidatedChain blk
-validate cfg Model { currentSlot, maxClockSkew, initLedger, invalid } chain =
+validate cfg Model { initLedger, invalid } chain =
     go initLedger Genesis (Chain.toOldestFirst chain)
   where
     mkInvalid :: blk -> InvalidBlockReason blk -> InvalidBlocks blk
@@ -777,68 +754,10 @@ validate cfg Model { currentSlot, maxClockSkew, initLedger, invalid } chain =
           | Map.member (blockHash b) invalid
           -> ValidatedChain validPrefix ledger invalid
 
-          -- Block is in the future and exceeds the clock skew, it is
-          -- considered to be invalid
-          | blockSlot b > SlotNo (unSlotNo currentSlot + maxClockSkew)
-          -> ValidatedChain
-               validPrefix
-               ledger
-               (invalid <>
-                mkInvalid b (InFutureExceedsClockSkew (blockRealPoint b)))
-
-          -- Block is in the future but doesn't exceed the clock skew. It will
-          -- not be part of the chain, but we have to continue validation,
-          -- because the real implementation validates before truncating
-          -- future blocks, and we try to detect the same invalid blocks as
-          -- the real implementation.
-          | blockSlot b > currentSlot
-          -> ValidatedChain
-               validPrefix
-               ledger
-               (invalid <>
-                findInvalidBlockInTheFuture ledger' bs')
-
-          -- Block not in the future, this is the good path
+          -- This is the good path
           | otherwise
           -> go ledger' (validPrefix :> b) bs'
 
-    -- | Take the following chain:
-    --
-    -- A (valid) -> B (future) -> C (future) -> D (invalid)
-    --
-    -- where B and C are from the future, but don't exceed the max clock skew,
-    -- and D is invalid according to the ledger.
-    --
-    -- The real implementation would detect that B and C are from the future
-    -- (not exceeding clock skew), but it would also find that D is invalid
-    -- according to the ledger and record that. This is because the
-    -- implementation first validates using the ledger and then does the
-    -- future check, restarting chain selection for any invalid candidates and
-    -- revalidating them.
-    --
-    -- To keep things simple, we don't restart chain selection in this model,
-    -- so we want to return the 'ValidatedChain' corresponding to A, but we
-    -- also have to continue validating the future blocks B and C so that we
-    -- encounter D. That's why 'findInvalidBlockInTheFuture' is called in 'go'
-    -- when a block from the future is encountered.
-    --
-    -- Note that ledger validation stops at the first invalid block, so this
-    -- function should find 0 or 1 invalid blocks.
-    findInvalidBlockInTheFuture
-      :: ExtLedgerState blk
-      -> [blk]
-      -> InvalidBlocks blk
-    findInvalidBlockInTheFuture ledger = \case
-      []    -> Map.empty
-      b:bs' -> case runExcept (tickThenApply (ExtLedgerCfg cfg) b ledger) of
-        Left e        -> mkInvalid b (ValidationError e)
-        Right ledger'
-          | blockSlot b > SlotNo (unSlotNo currentSlot + maxClockSkew)
-          -> mkInvalid b (InFutureExceedsClockSkew (blockRealPoint b)) <>
-             findInvalidBlockInTheFuture ledger' bs'
-          | otherwise
-          -> findInvalidBlockInTheFuture ledger' bs'
-
 chains :: forall blk. (GetPrevHash blk)
        => Map (HeaderHash blk) blk -> [Chain blk]
 chains bs = go Chain.Genesis
diff --git a/ouroboros-consensus/test/storage-test/Test/Ouroboros/Storage/ChainDB/Model/Test.hs b/ouroboros-consensus/test/storage-test/Test/Ouroboros/Storage/ChainDB/Model/Test.hs
index e70f88d9bc..631c4c593d 100644
--- a/ouroboros-consensus/test/storage-test/Test/Ouroboros/Storage/ChainDB/Model/Test.hs
+++ b/ouroboros-consensus/test/storage-test/Test/Ouroboros/Storage/ChainDB/Model/Test.hs
@@ -49,11 +49,9 @@ tests = testGroup "Model" [
     ]
 
 addBlocks :: LoE () -> [TestBlock] -> M.Model TestBlock
-addBlocks loe blks = M.addBlocks cfg blks m
+addBlocks loe blks = M.addBlocks cfg blks (M.empty loe testInitExtLedger)
   where
     cfg = singleNodeTestConfig
-    -- Set the current slot to 'maxBound' so that no block is in the future
-    m   = M.advanceCurSlot maxBound (M.empty loe testInitExtLedger 0)
 
 prop_getBlock_addBlock :: LoE () -> BlockTree -> Permutation -> Property
 prop_getBlock_addBlock loe bt p =
diff --git a/ouroboros-consensus/test/storage-test/Test/Ouroboros/Storage/ChainDB/StateMachine.hs b/ouroboros-consensus/test/storage-test/Test/Ouroboros/Storage/ChainDB/StateMachine.hs
index 8782585318..d7aad8fbef 100644
--- a/ouroboros-consensus/test/storage-test/Test/Ouroboros/Storage/ChainDB/StateMachine.hs
+++ b/ouroboros-consensus/test/storage-test/Test/Ouroboros/Storage/ChainDB/StateMachine.hs
@@ -34,16 +34,6 @@
 --   volatile DB for the storage proper and /they/ have extensive disk corruption
 --   tests, so we don't need to repeat that here).
 --
--- Note that it is important to tests blocks with a @SlotNo@ ahead of the
--- wallclock separately, because the Ouroboros protocol says such blocks should
--- not be adopted, but we do want to allow for some clock skew in upstream nodes;
--- this means that such "blocks from the future" are stored without being added to
--- the chain just yet, to be considered later. Moreover, we have to be very careful
--- in how we do this "from the future" check; for example, if the ledger state is
--- far behind the wallclock, we might not have sufficient knowledge to translate
--- the wallclock to a @SlotNo@, although we /can/ always translate the @SlotNo@
--- at the tip of the chain to a @UTCTime@.
---
 module Test.Ouroboros.Storage.ChainDB.StateMachine (
     -- * Commands
     At (..)
@@ -56,7 +46,6 @@ module Test.Ouroboros.Storage.ChainDB.StateMachine (
   , Resp (..)
   , Success (..)
     -- * Model
-  , MaxClockSkew (..)
   , Model
   , ShouldGarbageCollect (..)
     -- * Running the model
@@ -101,7 +90,7 @@ import           Data.Proxy
 import           Data.TreeDiff
 import           Data.Typeable
 import           Data.Void (Void)
-import           Data.Word (Word16, Word64)
+import           Data.Word (Word16)
 import qualified Generics.SOP as SOP
 import           GHC.Generics (Generic)
 import           NoThunks.Class (AllowThunk (..))
@@ -174,10 +163,6 @@ data Cmd blk it flr
   = AddBlock       blk
     -- ^ Advance the current slot to the block's slot (unless smaller than the
     -- current slot), add the block and run chain selection.
-  | AddFutureBlock blk SlotNo
-    -- ^ Advance the current slot to the given slot, which is guaranteed to be
-    -- smaller than the block's slot number (such that the block is from the
-    -- future) and larger or equal to the current slot, and add the block.
   | GetCurrentChain
   | GetLedgerDB
   | GetTipBlock
@@ -395,7 +380,6 @@ run :: forall m blk.
 run env@ChainDBEnv { varDB, .. } cmd =
     readTVarIO varDB >>= \st@ChainDBState { chainDB = ChainDB{..}, internal } -> case cmd of
       AddBlock blk             -> Point               <$> (advanceAndAdd st (blockSlot blk) blk)
-      AddFutureBlock blk s     -> Point               <$> (advanceAndAdd st s               blk)
       GetCurrentChain          -> Chain               <$> atomically getCurrentChain
       GetLedgerDB              -> LedgerDB            <$> atomically getLedgerDB
       GetTipBlock              -> MbBlock             <$> getTipBlock
@@ -591,24 +575,6 @@ instance Eq IsValidResult where
         (Nothing, Just _)  -> True
         (Just _,  Nothing) -> False
 
-{-------------------------------------------------------------------------------
-  Max clock skew
--------------------------------------------------------------------------------}
-
--- | Max clock skew in number of slots
-newtype MaxClockSkew = MaxClockSkew Word64
-  deriving (Eq, Show)
-
-instance Arbitrary MaxClockSkew where
-  -- TODO make sure no blocks from the future exceed the max clock skew:
-  -- <https://github.com/IntersectMBO/ouroboros-network/issues/2232>
-  arbitrary = return $ MaxClockSkew 100000
-  -- arbitrary = MaxClockSkew <$> choose (0, 3)
-  -- -- We're only interested in 0 or 1
-  -- shrink (MaxClockSkew 0) = []
-  -- shrink (MaxClockSkew 1) = []
-  -- shrink (MaxClockSkew _) = MaxClockSkew <$> [0, 1]
-
 {-------------------------------------------------------------------------------
   Instantiating the semantics
 -------------------------------------------------------------------------------}
@@ -638,8 +604,7 @@ runPure :: forall blk.
         -> DBModel         blk
         -> (Resp           blk IteratorId FollowerId, DBModel blk)
 runPure cfg = \case
-    AddBlock blk             -> ok  Point               $ update  (advanceAndAdd (blockSlot blk) blk)
-    AddFutureBlock blk s     -> ok  Point               $ update  (advanceAndAdd s               blk)
+    AddBlock blk             -> ok  Point               $ update  (add blk)
     GetCurrentChain          -> ok  Chain               $ query   (Model.volatileChain k getHeader)
     GetLedgerDB              -> ok  LedgerDB            $ query   (Model.getLedgerDB cfg)
     GetTipBlock              -> ok  MbBlock             $ query    Model.tipBlock
@@ -678,9 +643,9 @@ runPure cfg = \case
   where
     k = configSecurityParam cfg
 
-    advanceAndAdd slot blk m = (Model.tipPoint m', m')
+    add blk m = (Model.tipPoint m', m')
       where
-        m' = Model.addBlock cfg blk $ Model.advanceCurSlot slot m
+        m' = Model.addBlock cfg blk m
 
     iter = either UnknownRange Iter
     mbGCedAllComponents = MbGCedAllComponents . MaybeGCedBlock False
@@ -772,10 +737,9 @@ initModel :: HasHeader blk
           => LoE ()
           -> TopLevelConfig blk
           -> ExtLedgerState blk
-          -> MaxClockSkew
           -> Model blk m r
-initModel loe cfg initLedger (MaxClockSkew maxClockSkew) = Model
-  { dbModel        = Model.empty loe initLedger maxClockSkew
+initModel loe cfg initLedger = Model
+  { dbModel        = Model.empty loe initLedger
   , knownIters     = RE.empty
   , knownFollowers = RE.empty
   , modelConfig    = QSM.Opaque cfg
@@ -1004,13 +968,7 @@ generator loe genBlock m@Model {..} = At <$> frequency
 
     genGetIsValid :: Gen (Cmd blk it flr)
     genGetIsValid =
-      GetIsValid <$> genRealPoint `suchThat` \(RealPoint _ hash) ->
-        -- Ignore blocks from the future, since the real implementation might
-        -- have validated them before detecting they're from the future,
-        -- whereas the model won't include them in the output of
-        -- 'Model.getIsValid' (which uses 'Model.validChains').
-        Map.notMember hash (Model.futureBlocks dbModel)
-
+      GetIsValid <$> genRealPoint
     genGetBlockComponent :: Gen (Cmd blk it flr)
     genGetBlockComponent = do
       pt <- genRealPoint
@@ -1018,18 +976,7 @@ generator loe genBlock m@Model {..} = At <$> frequency
         then GetGCedBlockComponent pt
         else GetBlockComponent     pt
 
-    genAddBlock = do
-      let curSlot = Model.currentSlot dbModel
-      blk <- genBlock m
-      if blockSlot blk > Model.currentSlot dbModel
-        -- When the slot of the block is in the future, we can either advance
-        -- the current time ('AddBlock') or choose to add a block from the
-        -- future ('AddFutureBlock')
-        then frequency
-          [ (1, return $ AddBlock blk)
-          , (1, AddFutureBlock blk <$> chooseSlot curSlot (blockSlot blk - 1))
-          ]
-        else return $ AddBlock blk
+    genAddBlock = AddBlock <$> genBlock m
 
     genBounds :: Gen (StreamFrom blk, StreamTo blk)
     genBounds = frequency
@@ -1139,24 +1086,7 @@ precondition Model {..} (At cmd) =
      -- functionality, which does not include error paths.
      Stream from to           -> isValidIterator from to
      Reopen                   -> Not $ Boolean (Model.isOpen dbModel)
-     -- To be in the future, @blockSlot blk@ must be greater than @slot@.
-     --
-     -- We do not allow multiple future blocks with the same block number, as
-     -- the real implementation might have to switch between forks when they
-     -- are no longer in the future, whereas the model will pick the right
-     -- chain directly. This causes followers to go out of sync.
-     -- https://github.com/IntersectMBO/ouroboros-network/issues/2234
-     AddFutureBlock blk s     -> s .>= Model.currentSlot dbModel .&&
-                                 blockSlot blk .> s .&&
-                                 Not (futureBlockWithSameBlockNo (blockNo blk))
      WipeVolatileDB           -> Boolean $ Model.isOpen dbModel
-     -- We don't allow 'GetIsValid' for blocks from the future, since the real
-     -- implementation might have validated them before detecting they're from
-     -- the future, whereas the model won't include them in the output of
-     -- 'Model.getIsValid' (which uses 'Model.validChains').
-     GetIsValid pt            -> Boolean $
-                                   Map.notMember (realPointHash pt)
-                                                 (Model.futureBlocks dbModel)
      _                        -> Top
   where
     garbageCollectable :: RealPoint blk -> Logic
@@ -1167,11 +1097,6 @@ precondition Model {..} (At cmd) =
     garbageCollectableIteratorNext it = Boolean $
       Model.garbageCollectableIteratorNext secParam dbModel (knownIters RE.! it)
 
-    futureBlockWithSameBlockNo :: BlockNo -> Logic
-    futureBlockWithSameBlockNo no =
-        Not $ exists (Map.elems (Model.futureBlocks dbModel)) $ \futureBlock ->
-          blockNo futureBlock .== no
-
     cfg :: TopLevelConfig blk
     cfg = unOpaque modelConfig
 
@@ -1236,13 +1161,12 @@ sm :: TestConstraints blk
    -> BlockGen                  blk IO
    -> TopLevelConfig            blk
    -> ExtLedgerState            blk
-   -> MaxClockSkew
    -> StateMachine (Model       blk IO)
                    (At Cmd      blk IO)
                                     IO
                    (At Resp     blk IO)
-sm loe env genBlock cfg initLedger maxClockSkew = StateMachine
-  { initModel     = initModel loe cfg initLedger maxClockSkew
+sm loe env genBlock cfg initLedger = StateMachine
+  { initModel     = initModel loe cfg initLedger
   , transition    = transition
   , precondition  = precondition
   , postcondition = postcondition
@@ -1502,30 +1426,27 @@ envUnused :: ChainDBEnv m blk
 envUnused = error "ChainDBEnv used during command generation"
 
 smUnused :: LoE ()
-         -> MaxClockSkew
          -> ImmutableDB.ChunkInfo
          -> StateMachine (Model Blk IO) (At Cmd Blk IO) IO (At Resp Blk IO)
-smUnused loe maxClockSkew chunkInfo =
+smUnused loe chunkInfo =
     sm
       loe
       envUnused
       (genBlk chunkInfo)
       (mkTestCfg chunkInfo)
       testInitExtLedger
-      maxClockSkew
 
-prop_sequential :: LoE () -> MaxClockSkew -> SmallChunkInfo -> Property
-prop_sequential loe maxClockSkew smallChunkInfo@(SmallChunkInfo chunkInfo)  =
-    forAllCommands (smUnused loe maxClockSkew chunkInfo) Nothing $
-      runCmdsLockstep loe maxClockSkew smallChunkInfo
+prop_sequential :: LoE () -> SmallChunkInfo -> Property
+prop_sequential loe smallChunkInfo@(SmallChunkInfo chunkInfo)  =
+    forAllCommands (smUnused loe chunkInfo) Nothing $
+      runCmdsLockstep loe smallChunkInfo
 
 runCmdsLockstep ::
      LoE ()
-  -> MaxClockSkew
   -> SmallChunkInfo
   -> QSM.Commands (At Cmd Blk IO) (At Resp Blk IO)
   -> Property
-runCmdsLockstep loe maxClockSkew (SmallChunkInfo chunkInfo) cmds =
+runCmdsLockstep loe (SmallChunkInfo chunkInfo) cmds =
     QC.monadicIO $ do
         let
           -- Current test case command names.
@@ -1533,10 +1454,10 @@ runCmdsLockstep loe maxClockSkew (SmallChunkInfo chunkInfo) cmds =
           ctcCmdNames = fmap (show . cmdName . QSM.getCommand) $ QSM.unCommands cmds
 
         (hist, prop) <- QC.run $ test cmds
-        prettyCommands (smUnused loe maxClockSkew chunkInfo) hist
+        prettyCommands (smUnused loe chunkInfo) hist
           $ tabulate
               "Tags"
-              (map show $ tag (execCmds (QSM.initModel (smUnused loe maxClockSkew chunkInfo)) cmds))
+              (map show $ tag (execCmds (QSM.initModel (smUnused loe chunkInfo)) cmds))
           $ tabulate "Command sequence length" [show $ length ctcCmdNames]
           $ tabulate "Commands"                ctcCmdNames
           $ prop
@@ -1582,7 +1503,7 @@ runCmdsLockstep loe maxClockSkew (SmallChunkInfo chunkInfo) cmds =
                 , varLoEFragment
                 , args
                 }
-              sm' = sm loe env (genBlk chunkInfo) testCfg testInitExtLedger maxClockSkew
+              sm' = sm loe env (genBlk chunkInfo) testCfg testInitExtLedger
           (hist, model, res) <- QSM.runCommands' sm' cmds'
           trace <- getTrace
           return (hist, model, res, trace)
diff --git a/ouroboros-consensus/test/storage-test/Test/Ouroboros/Storage/ChainDB/StateMachine/Utils/RunOnRepl.hs b/ouroboros-consensus/test/storage-test/Test/Ouroboros/Storage/ChainDB/StateMachine/Utils/RunOnRepl.hs
index 5db0846fee..1e819b886f 100644
--- a/ouroboros-consensus/test/storage-test/Test/Ouroboros/Storage/ChainDB/StateMachine/Utils/RunOnRepl.hs
+++ b/ouroboros-consensus/test/storage-test/Test/Ouroboros/Storage/ChainDB/StateMachine/Utils/RunOnRepl.hs
@@ -50,7 +50,6 @@ module Test.Ouroboros.Storage.ChainDB.StateMachine.Utils.RunOnRepl (
   , Var (Var)
     -- ** ChainDB.StateMachine re-exports
   , Cmd (..)
-  , MaxClockSkew (MaxClockSkew)
   , Resp (..)
   , Success (..)
   , runCmdsLockstep
@@ -89,8 +88,8 @@ import           Ouroboros.Network.Point (Block (..))
 import qualified Ouroboros.Network.Point as Point
 import qualified Test.Ouroboros.Storage.ChainDB.StateMachine as StateMachine
 import           Test.Ouroboros.Storage.ChainDB.StateMachine (Cmd (..),
-                     FollowerRef, IterRef, MaxClockSkew (MaxClockSkew),
-                     Resp (..), Success (..), runCmdsLockstep)
+                     FollowerRef, IterRef, Resp (..), Success (..),
+                     runCmdsLockstep)
 import           Test.Ouroboros.Storage.Orphans ()
 import           Test.Ouroboros.Storage.TestBlock (ChainLength (ChainLength),
                      EBB (EBB, RegularBlock), TestBlock (..), TestBody (..),
@@ -115,9 +114,8 @@ pattern Command cmd rsp xs =
 
 quickCheckCmdsLockStep ::
      LoE ()
-  -> MaxClockSkew
   -> SmallChunkInfo
   -> Commands (StateMachine.At Cmd TestBlock IO) (StateMachine.At Resp TestBlock IO)
   -> IO ()
-quickCheckCmdsLockStep loe maxClockSkew chunkInfo cmds =
-  quickCheck $ runCmdsLockstep loe maxClockSkew chunkInfo cmds
+quickCheckCmdsLockStep loe chunkInfo cmds =
+  quickCheck $ runCmdsLockstep loe chunkInfo cmds
diff --git a/ouroboros-consensus/test/storage-test/Test/Ouroboros/Storage/ChainDB/Unit.hs b/ouroboros-consensus/test/storage-test/Test/Ouroboros/Storage/ChainDB/Unit.hs
index 5a58f41015..d82b1c58d0 100644
--- a/ouroboros-consensus/test/storage-test/Test/Ouroboros/Storage/ChainDB/Unit.hs
+++ b/ouroboros-consensus/test/storage-test/Test/Ouroboros/Storage/ChainDB/Unit.hs
@@ -19,12 +19,10 @@ import           Control.Monad (replicateM, unless, void)
 import           Control.Monad.Except (Except, ExceptT, MonadError, runExcept,
                      runExceptT, throwError)
 import           Control.Monad.Reader (MonadReader, ReaderT, ask, runReaderT)
-import           Control.Monad.State (MonadState, StateT, evalStateT, get,
-                     modify, put)
+import           Control.Monad.State (MonadState, StateT, evalStateT, get, put)
 import           Control.Monad.Trans.Class (lift)
 import           Control.ResourceRegistry (closeRegistry, unsafeNewRegistry)
 import           Data.Maybe (isJust)
-import           Ouroboros.Consensus.Block.Abstract (blockSlot)
 import           Ouroboros.Consensus.Block.RealPoint
                      (pointToWithOriginRealPoint)
 import           Ouroboros.Consensus.Config (TopLevelConfig,
@@ -222,7 +220,7 @@ runModelIO :: API.LoE () -> ModelM TestBlock a -> IO ()
 runModelIO loe expr = toAssertion (runModel newModel topLevelConfig expr)
   where
     chunkInfo      = ImmutableDB.simpleChunkInfo 100
-    newModel       = Model.empty loe testInitExtLedger 0
+    newModel       = Model.empty loe testInitExtLedger
     topLevelConfig = mkTestCfg chunkInfo
 
 
@@ -348,7 +346,6 @@ instance (Model.ModelSupportsBlock blk, LedgerSupportsProtocol blk)
   addBlock blk = do
     -- Ensure that blocks are not characterized as invalid because they are
     -- from the future.
-    modify $ \model -> model { Model.currentSlot = blockSlot blk }
     withModelContext $ \model cfg -> ((), Model.addBlock cfg blk model)
     pure blk
 

From 8c057496a9e9776ef4adccfb392f8492bb126a18 Mon Sep 17 00:00:00 2001
From: Damian Nadales <damian.nadales@iohk.io>
Date: Fri, 11 Oct 2024 12:04:23 +0200
Subject: [PATCH 08/11] Correct a comment stating that the `ImmutableDB`
 truncates blocks from the future

---
 .../Ouroboros/Consensus/Node/ErrorPolicy.hs                | 7 +------
 .../Ouroboros/Consensus/Node/RethrowPolicy.hs              | 7 +------
 2 files changed, 2 insertions(+), 12 deletions(-)

diff --git a/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/Node/ErrorPolicy.hs b/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/Node/ErrorPolicy.hs
index 4d59c2c423..4ff689017c 100644
--- a/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/Node/ErrorPolicy.hs
+++ b/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/Node/ErrorPolicy.hs
@@ -70,12 +70,7 @@ consensusErrorPolicy pb = ErrorPolicies {
               ImmutableDB.UnexpectedFailure{} -> Just shutdownNode
         , ErrorPolicy $ \(_ :: FsError) -> Just shutdownNode
 
-          -- When the system clock moved back, we have to restart the node,
-          -- because the ImmutableDB validation might have to truncate some
-          -- blocks from the future. Note that a full validation is not
-          -- required, as the default validation (most recent epoch) will keep
-          -- on truncating epochs until a block that is not from the future is
-          -- found.
+          -- When the system clock moved back, we have to restart the node.
         , ErrorPolicy $ \(_ :: SystemClockMovedBackException) -> Just shutdownNode
 
           -- Some chain DB errors are indicative of a bug in our code, others
diff --git a/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/Node/RethrowPolicy.hs b/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/Node/RethrowPolicy.hs
index 767833fb35..4261ac8193 100644
--- a/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/Node/RethrowPolicy.hs
+++ b/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/Node/RethrowPolicy.hs
@@ -64,12 +64,7 @@ consensusRethrowPolicy pb =
             ImmutableDB.UnexpectedFailure{} -> shutdownNode)
    <> mkRethrowPolicy (\_ctx (_ :: FsError) -> shutdownNode)
 
-      -- When the system clock moved back, we have to restart the node,
-      -- because the ImmutableDB validation might have to truncate some
-      -- blocks from the future. Note that a full validation is not
-      -- required, as the default validation (most recent epoch) will keep
-      -- on truncating epochs until a block that is not from the future is
-      -- found.
+      -- When the system clock moved back, we have to restart the node.
     <> mkRethrowPolicy (\_ctx (_ :: SystemClockMovedBackException) -> shutdownNode)
 
        -- Some chain DB errors are indicative of a bug in our code, others

From 40ac1b98b7d8fd14f497330344f2150bb5741c7a Mon Sep 17 00:00:00 2001
From: Damian Nadales <damian.nadales@iohk.io>
Date: Fri, 11 Oct 2024 13:28:28 +0200
Subject: [PATCH 09/11] Remove `InFutureExceedsClockSkew`

---
 .../Ouroboros/Consensus/Storage/ChainDB/API.hs            | 8 --------
 1 file changed, 8 deletions(-)

diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/API.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/API.hs
index 594fb35a69..0683520c16 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/API.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/API.hs
@@ -690,14 +690,6 @@ streamFrom from db registry blockComponent = do
 data InvalidBlockReason blk
   = ValidationError !(ExtValidationError blk)
     -- ^ The ledger found the block to be invalid.
-  | InFutureExceedsClockSkew !(RealPoint blk)
-    -- ^ The block's slot is in the future, exceeding the allowed clock skew.
-    --
-    -- Possible causes, order by decreasing likelihood:
-    --
-    -- 1. Our clock is behind (significantly more likely than the others)
-    -- 2. Their clock is ahead
-    -- 3. It's intentional, i.e., an attack
   deriving (Eq, Show, Generic)
 
 instance LedgerSupportsProtocol blk

From 3f88dc00e8c5774f28fdaa713142e1bd3bf8f8f3 Mon Sep 17 00:00:00 2001
From: Damian Nadales <damian.nadales@iohk.io>
Date: Fri, 11 Oct 2024 21:40:53 +0200
Subject: [PATCH 10/11] Correct the comment stating under which conditions ...

we might forge atop a block form the future
---
 .../Ouroboros/Consensus/NodeKernel.hs                     | 8 ++++++--
 1 file changed, 6 insertions(+), 2 deletions(-)

diff --git a/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/NodeKernel.hs b/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/NodeKernel.hs
index aa4df6ccec..224cba0d08 100644
--- a/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/NodeKernel.hs
+++ b/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/NodeKernel.hs
@@ -693,10 +693,14 @@ mkCurrentBlockContext currentSlot c = case c of
       LT -> Right $ blockContextFromPrevHeader hdr
 
       -- The block at the tip of our chain has a slot that lies in the
-      -- future. Although the chain DB does not adopt future blocks, if the
+      -- future. Although the chain DB should not contain blocks from the
+      -- future, if the volatile DB contained such blocks on startup
+      -- (due to a node clock misconfiguration) this invariant may be
+      -- violated. See: https://github.com/IntersectMBO/ouroboros-consensus/blob/main/docs/website/contents/for-developers/HandlingBlocksFromTheFuture.md#handling-blocks-from-the-future
+      -- Also note that if the
       -- system is under heavy load, it is possible (though unlikely) that
       -- one or more slots have passed after @currentSlot@ that we got from
-      -- @onSlotChange@ and and before we queried the chain DB for the block
+      -- @onSlotChange@ and before we queried the chain DB for the block
       -- at its tip. At the moment, we simply don't produce a block if this
       -- happens.
 

From 21ab657f76fd5d848aee4ec1adee910b93f51d49 Mon Sep 17 00:00:00 2001
From: Damian Nadales <damian.nadales@iohk.io>
Date: Fri, 11 Oct 2024 22:07:55 +0200
Subject: [PATCH 11/11] Remove the `InvalidBlockReason` data type

... since it was only wrapping up an `ExtValidationError` value.
---
 .../Ouroboros/Consensus/Node/Tracers.hs         |  5 +++--
 .../bench/ChainSync-client-bench/Main.hs        |  2 +-
 ...amian.nadales_1260_remove_cdbFutureBlocks.md |  2 +-
 .../Consensus/MiniProtocol/ChainSync/Client.hs  | 16 +++++++---------
 .../Ouroboros/Consensus/Storage/ChainDB/API.hs  | 17 +----------------
 .../Consensus/Storage/ChainDB/Impl/ChainSel.hs  |  4 ++--
 .../Consensus/Storage/ChainDB/Impl/Query.hs     |  4 ++--
 .../Consensus/Storage/ChainDB/Impl/Types.hs     |  8 ++++----
 .../Test/Util/Orphans/ToExpr.hs                 |  5 -----
 .../Consensus/MiniProtocol/ChainSync/Client.hs  |  3 ---
 .../Test/Ouroboros/Storage/ChainDB/Model.hs     | 13 ++++++-------
 11 files changed, 27 insertions(+), 52 deletions(-)

diff --git a/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/Node/Tracers.hs b/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/Node/Tracers.hs
index e41da95bd2..e56e7924f9 100644
--- a/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/Node/Tracers.hs
+++ b/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/Node/Tracers.hs
@@ -24,13 +24,14 @@ import           Ouroboros.Consensus.Block
 import           Ouroboros.Consensus.BlockchainTime
 import           Ouroboros.Consensus.Forecast (OutsideForecastRange)
 import           Ouroboros.Consensus.Genesis.Governor (TraceGDDEvent)
+import           Ouroboros.Consensus.Ledger.Extended (ExtValidationError)
 import           Ouroboros.Consensus.Ledger.SupportsMempool
 import           Ouroboros.Consensus.Ledger.SupportsProtocol
 import           Ouroboros.Consensus.Mempool (MempoolSize, TraceEventMempool)
 import           Ouroboros.Consensus.MiniProtocol.BlockFetch.Server
                      (TraceBlockFetchServerEvent)
 import           Ouroboros.Consensus.MiniProtocol.ChainSync.Client
-                     (InvalidBlockReason, TraceChainSyncClientEvent)
+                     (TraceChainSyncClientEvent)
 import           Ouroboros.Consensus.MiniProtocol.ChainSync.Server
                      (TraceChainSyncServerEvent)
 import           Ouroboros.Consensus.MiniProtocol.LocalTxSubmission.Server
@@ -343,7 +344,7 @@ data TraceForgeEvent blk
     -- | We forged a block that is invalid according to the ledger in the
     -- ChainDB. This means there is an inconsistency between the mempool
     -- validation and the ledger validation. This is a serious error!
-  | TraceForgedInvalidBlock SlotNo blk (InvalidBlockReason blk)
+  | TraceForgedInvalidBlock SlotNo blk (ExtValidationError blk)
 
     -- | We adopted the block we produced, we also trace the transactions
     -- that were adopted.
diff --git a/ouroboros-consensus/bench/ChainSync-client-bench/Main.hs b/ouroboros-consensus/bench/ChainSync-client-bench/Main.hs
index 07e2507967..ae1d4ba124 100644
--- a/ouroboros-consensus/bench/ChainSync-client-bench/Main.hs
+++ b/ouroboros-consensus/bench/ChainSync-client-bench/Main.hs
@@ -159,7 +159,7 @@ oneBenchRun
 -- | No invalid blocks in this benchmark
 invalidBlock ::
     WithFingerprint
-        (HeaderHash blk -> Maybe (ChainDB.InvalidBlockReason blk))
+        (HeaderHash blk -> Maybe (Extended.ExtValidationError blk))
 invalidBlock =
     WithFingerprint isInvalidBlock fp
   where
diff --git a/ouroboros-consensus/changelog.d/20240927_125606_damian.nadales_1260_remove_cdbFutureBlocks.md b/ouroboros-consensus/changelog.d/20240927_125606_damian.nadales_1260_remove_cdbFutureBlocks.md
index 5c7dc6b6d9..930a57bc66 100644
--- a/ouroboros-consensus/changelog.d/20240927_125606_damian.nadales_1260_remove_cdbFutureBlocks.md
+++ b/ouroboros-consensus/changelog.d/20240927_125606_damian.nadales_1260_remove_cdbFutureBlocks.md
@@ -8,4 +8,4 @@
 - Remove `CheckInFuture m blk` argument from `initialChainSelection`.
 - Remove `cdbsCheckInFuture` from `ChainDbSpecificArgs`.
 - Delete module `Ouroboros.Consensus.Fragment.InFuture`. `ClockSkew` functions live now in `Ouroboros.Consensus.MiniProtocol.ChainSync.Client.InFutureCheck`.
-* Remove `InFutureExceedsClockSkew` from `ValidationError`.
+* Remove ``InvalidBlockReason`, since it was now simply wrapping up `ExtValidationError`.
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/MiniProtocol/ChainSync/Client.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/MiniProtocol/ChainSync/Client.hs
index 239c049d02..ae0edd3420 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/MiniProtocol/ChainSync/Client.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/MiniProtocol/ChainSync/Client.hs
@@ -60,7 +60,6 @@ module Ouroboros.Consensus.MiniProtocol.ChainSync.Client (
   , ChainSyncLoPBucketConfig (..)
   , ChainSyncLoPBucketEnabledConfig (..)
     -- * Trace events
-  , InvalidBlockReason
   , TraceChainSyncClientEvent (..)
     -- * State shared with other components
   , ChainSyncClientHandle (..)
@@ -114,8 +113,7 @@ import           Ouroboros.Consensus.MiniProtocol.ChainSync.Client.State
 import           Ouroboros.Consensus.Node.GsmState (GsmState (..))
 import           Ouroboros.Consensus.Node.NetworkProtocolVersion
 import           Ouroboros.Consensus.Protocol.Abstract
-import           Ouroboros.Consensus.Storage.ChainDB (ChainDB,
-                     InvalidBlockReason)
+import           Ouroboros.Consensus.Storage.ChainDB (ChainDB)
 import qualified Ouroboros.Consensus.Storage.ChainDB as ChainDB
 import           Ouroboros.Consensus.Util
 import           Ouroboros.Consensus.Util.AnchoredFragment (cross)
@@ -158,7 +156,7 @@ data ChainDbView m blk = ChainDbView {
     getIsInvalidBlock ::
       STM m
           (WithFingerprint
-              (HeaderHash blk -> Maybe (InvalidBlockReason blk)))
+              (HeaderHash blk -> Maybe (ExtValidationError blk)))
   }
 
 -- | Configuration of the leaky bucket when it is enabled.
@@ -1984,12 +1982,12 @@ invalidBlockRejector ::
   => Tracer m (TraceChainSyncClientEvent blk)
   -> NodeToNodeVersion
   -> DiffusionPipeliningSupport
-  -> STM m (WithFingerprint (HeaderHash blk -> Maybe (InvalidBlockReason blk)))
+  -> STM m (WithFingerprint (HeaderHash blk -> Maybe (ExtValidationError blk)))
      -- ^ Get the invalid block checker
   -> STM m (AnchoredFragment (Header blk))
      -- ^ Get the candidate
   -> Watcher m
-         (WithFingerprint (HeaderHash blk -> Maybe (InvalidBlockReason blk)))
+         (WithFingerprint (HeaderHash blk -> Maybe (ExtValidationError blk)))
          Fingerprint
 invalidBlockRejector tracer _version pipelining getIsInvalidBlock getCandidate =
     Watcher {
@@ -1999,7 +1997,7 @@ invalidBlockRejector tracer _version pipelining getIsInvalidBlock getCandidate =
       , wReader      = getIsInvalidBlock
       }
   where
-    checkInvalid :: (HeaderHash blk -> Maybe (InvalidBlockReason blk)) -> m ()
+    checkInvalid :: (HeaderHash blk -> Maybe (ExtValidationError blk)) -> m ()
     checkInvalid isInvalidBlock = do
         theirFrag <- atomically getCandidate
         -- The invalid block is likely to be a more recent block, so check from
@@ -2019,7 +2017,7 @@ invalidBlockRejector tracer _version pipelining getIsInvalidBlock getCandidate =
             )
           $ AF.toNewestFirst theirFrag
 
-    disconnect :: Header blk -> InvalidBlockReason blk -> m ()
+    disconnect :: Header blk -> ExtValidationError blk -> m ()
     disconnect invalidHeader reason = do
         let ex =
                 InvalidBlock
@@ -2157,7 +2155,7 @@ data ChainSyncClientException =
         (HeaderHash blk)
         -- ^ Invalid block. If pipelining was negotiated, this can be
         -- different from the previous argument.
-        (InvalidBlockReason blk)
+        (ExtValidationError blk)
     -- ^ The upstream node's chain contained a block that we know is invalid.
   |
     InFutureHeaderExceedsClockSkew !InFutureCheck.HeaderArrivalException
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/API.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/API.hs
index 0683520c16..6cc5b59668 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/API.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/API.hs
@@ -51,8 +51,6 @@ module Ouroboros.Consensus.Storage.ChainDB.API (
   , streamFrom
   , traverseIterator
   , validBounds
-    -- * Invalid block reason
-  , InvalidBlockReason (..)
     -- * Followers
   , ChainType (..)
   , Follower (..)
@@ -347,7 +345,7 @@ data ChainDB m blk = ChainDB {
       -- In particular, this affects the watcher in 'bracketChainSyncClient',
       -- which rechecks the blocks in all candidate chains whenever a new
       -- invalid block is detected. These blocks are likely to be valid.
-    , getIsInvalidBlock :: STM m (WithFingerprint (HeaderHash blk -> Maybe (InvalidBlockReason blk)))
+    , getIsInvalidBlock :: STM m (WithFingerprint (HeaderHash blk -> Maybe (ExtValidationError blk)))
 
     , closeDB            :: m ()
 
@@ -682,19 +680,6 @@ streamFrom from db registry blockComponent = do
           Right it -> return it
           Left  e  -> error $ "failed to stream from genesis to tip: " <> show e
 
-{-------------------------------------------------------------------------------
-  Invalid block reason
--------------------------------------------------------------------------------}
-
--- | The reason why a block is invalid.
-data InvalidBlockReason blk
-  = ValidationError !(ExtValidationError blk)
-    -- ^ The ledger found the block to be invalid.
-  deriving (Eq, Show, Generic)
-
-instance LedgerSupportsProtocol blk
-      => NoThunks (InvalidBlockReason blk)
-
 {-------------------------------------------------------------------------------
   Followers
 -------------------------------------------------------------------------------}
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/ChainSel.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/ChainSel.hs
index f88e38165e..e3f0e2036d 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/ChainSel.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/ChainSel.hs
@@ -56,7 +56,7 @@ import           Ouroboros.Consensus.Ledger.Inspect
 import           Ouroboros.Consensus.Ledger.SupportsProtocol
 import           Ouroboros.Consensus.Storage.ChainDB.API (AddBlockPromise (..),
                      AddBlockResult (..), BlockComponent (..), ChainType (..),
-                     InvalidBlockReason (..), LoE (..))
+                     LoE (..))
 import           Ouroboros.Consensus.Storage.ChainDB.API.Types.InvalidBlockPunishment
                      (InvalidBlockPunishment, noPunishment)
 import qualified Ouroboros.Consensus.Storage.ChainDB.API.Types.InvalidBlockPunishment as InvalidBlockPunishment
@@ -1219,7 +1219,7 @@ ledgerValidateCandidate chainSelEnv chainDiff@(ChainDiff rollback suffix) =
     addInvalidBlock e (RealPoint slot hash) = atomically $
       modifyTVar varInvalid $ \(WithFingerprint invalid fp) ->
         WithFingerprint
-          (Map.insert hash (InvalidBlockInfo (ValidationError e) slot) invalid)
+          (Map.insert hash (InvalidBlockInfo e slot) invalid)
           (succ fp)
 
 -- | Validate a candidate chain using 'ledgerValidateCandidate'.
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/Query.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/Query.hs
index 934edfbae1..5bea8cd37c 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/Query.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/Query.hs
@@ -36,7 +36,7 @@ import           Ouroboros.Consensus.Ledger.Abstract (IsLedger, LedgerState)
 import           Ouroboros.Consensus.Ledger.Extended
 import           Ouroboros.Consensus.Protocol.Abstract
 import           Ouroboros.Consensus.Storage.ChainDB.API (BlockComponent (..),
-                     ChainDbFailure (..), InvalidBlockReason)
+                     ChainDbFailure (..))
 import qualified Ouroboros.Consensus.Storage.ChainDB.Impl.LgrDB as LgrDB
 import           Ouroboros.Consensus.Storage.ChainDB.Impl.Types
 import           Ouroboros.Consensus.Storage.ImmutableDB (ImmutableDB)
@@ -177,7 +177,7 @@ getIsFetched CDB{..} = basedOnHash <$> VolatileDB.getIsMember cdbVolatileDB
 getIsInvalidBlock ::
      forall m blk. (IOLike m, HasHeader blk)
   => ChainDbEnv m blk
-  -> STM m (WithFingerprint (HeaderHash blk -> Maybe (InvalidBlockReason blk)))
+  -> STM m (WithFingerprint (HeaderHash blk -> Maybe (ExtValidationError blk)))
 getIsInvalidBlock CDB{..} =
   fmap (fmap (fmap invalidBlockReason) . flip Map.lookup) <$> readTVar cdbInvalid
 
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/Types.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/Types.hs
index e48755c091..2eaaad37aa 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/Types.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/Types.hs
@@ -83,8 +83,8 @@ import           Ouroboros.Consensus.Ledger.SupportsProtocol
 import           Ouroboros.Consensus.Protocol.Abstract
 import           Ouroboros.Consensus.Storage.ChainDB.API (AddBlockPromise (..),
                      AddBlockResult (..), ChainDbError (..),
-                     ChainSelectionPromise (..), ChainType, InvalidBlockReason,
-                     LoE, StreamFrom, StreamTo, UnknownRange)
+                     ChainSelectionPromise (..), ChainType, LoE, StreamFrom,
+                     StreamTo, UnknownRange)
 import           Ouroboros.Consensus.Storage.ChainDB.API.Types.InvalidBlockPunishment
                      (InvalidBlockPunishment)
 import           Ouroboros.Consensus.Storage.ChainDB.Impl.LgrDB (LgrDB,
@@ -400,7 +400,7 @@ type InvalidBlocks blk = Map (HeaderHash blk) (InvalidBlockInfo blk)
 -- VolatileDB for some slot @s@, the hashes older or equal to @s@ can be
 -- removed from this map.
 data InvalidBlockInfo blk = InvalidBlockInfo
-  { invalidBlockReason :: !(InvalidBlockReason blk)
+  { invalidBlockReason :: !(ExtValidationError blk)
   , invalidBlockSlotNo :: !SlotNo
   } deriving (Eq, Show, Generic, NoThunks)
 
@@ -617,7 +617,7 @@ data TraceAddBlockEvent blk =
   | IgnoreBlockAlreadyInVolatileDB (RealPoint blk)
 
     -- | A block that is know to be invalid was ignored.
-  | IgnoreInvalidBlock (RealPoint blk) (InvalidBlockReason blk)
+  | IgnoreInvalidBlock (RealPoint blk) (ExtValidationError blk)
 
     -- | The block was added to the queue and will be added to the ChainDB by
     -- the background thread. The size of the queue is included.
diff --git a/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/Orphans/ToExpr.hs b/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/Orphans/ToExpr.hs
index 391114cbd1..fc76d4036c 100644
--- a/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/Orphans/ToExpr.hs
+++ b/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/Orphans/ToExpr.hs
@@ -18,7 +18,6 @@ import           Ouroboros.Consensus.HeaderValidation
 import           Ouroboros.Consensus.Ledger.Abstract
 import           Ouroboros.Consensus.Ledger.Extended
 import           Ouroboros.Consensus.Protocol.Abstract
-import           Ouroboros.Consensus.Storage.ChainDB (InvalidBlockReason)
 import           Ouroboros.Consensus.Storage.ChainDB.API (LoE (..))
 import           Ouroboros.Consensus.Storage.ChainDB.Impl.LgrDB
 import           Ouroboros.Consensus.Storage.ImmutableDB
@@ -113,7 +112,3 @@ deriving instance ( ToExpr blk
                   )
                  => ToExpr (ChainProducerState blk)
 deriving instance ToExpr a => ToExpr (WithFingerprint a)
-deriving instance ( ToExpr (HeaderHash blk)
-                  , ToExpr (ExtValidationError blk)
-                  )
-                 => ToExpr (InvalidBlockReason blk)
diff --git a/ouroboros-consensus/test/consensus-test/Test/Consensus/MiniProtocol/ChainSync/Client.hs b/ouroboros-consensus/test/consensus-test/Test/Consensus/MiniProtocol/ChainSync/Client.hs
index a0b104f9e9..60c5ebdc31 100644
--- a/ouroboros-consensus/test/consensus-test/Test/Consensus/MiniProtocol/ChainSync/Client.hs
+++ b/ouroboros-consensus/test/consensus-test/Test/Consensus/MiniProtocol/ChainSync/Client.hs
@@ -99,8 +99,6 @@ import           Ouroboros.Consensus.Node.NetworkProtocolVersion
 import           Ouroboros.Consensus.Node.ProtocolInfo
 import           Ouroboros.Consensus.NodeId
 import           Ouroboros.Consensus.Protocol.BFT
-import           Ouroboros.Consensus.Storage.ChainDB.API
-                     (InvalidBlockReason (ValidationError))
 import           Ouroboros.Consensus.Util (lastMaybe, whenJust)
 import           Ouroboros.Consensus.Util.Condense
 import           Ouroboros.Consensus.Util.IOLike
@@ -384,7 +382,6 @@ runChainSync skew securityParam (ClientUpdates clientUpdates)
               let isInvalidBlock hash =
                     if hash `Set.member` knownInvalid
                     then Just
-                       . ValidationError
                        . ExtValidationErrorLedger
                        $ TestBlock.InvalidBlock
                     else Nothing
diff --git a/ouroboros-consensus/test/storage-test/Test/Ouroboros/Storage/ChainDB/Model.hs b/ouroboros-consensus/test/storage-test/Test/Ouroboros/Storage/ChainDB/Model.hs
index 6e1ba15770..458ac62bb1 100644
--- a/ouroboros-consensus/test/storage-test/Test/Ouroboros/Storage/ChainDB/Model.hs
+++ b/ouroboros-consensus/test/storage-test/Test/Ouroboros/Storage/ChainDB/Model.hs
@@ -104,9 +104,9 @@ import           Ouroboros.Consensus.Protocol.Abstract
 import           Ouroboros.Consensus.Protocol.MockChainSel
 import           Ouroboros.Consensus.Storage.ChainDB.API (AddBlockPromise (..),
                      AddBlockResult (..), BlockComponent (..),
-                     ChainDbError (..), InvalidBlockReason (..),
-                     IteratorResult (..), LoE (..), StreamFrom (..),
-                     StreamTo (..), UnknownRange (..), validBounds)
+                     ChainDbError (..), IteratorResult (..), LoE (..),
+                     StreamFrom (..), StreamTo (..), UnknownRange (..),
+                     validBounds)
 import           Ouroboros.Consensus.Storage.ChainDB.Impl.ChainSel (olderThanK)
 import           Ouroboros.Consensus.Storage.LedgerDB
 import           Ouroboros.Consensus.Util (repeatedly)
@@ -154,7 +154,6 @@ deriving instance ( ToExpr blk
                   , ToExpr (Chain blk)
                   , ToExpr (ChainProducerState blk)
                   , ToExpr (ExtLedgerState blk)
-                  , ToExpr (InvalidBlockReason blk)
                   )
                  => ToExpr (Model blk)
 
@@ -705,7 +704,7 @@ class ( HasHeader blk
   Internal auxiliary
 -------------------------------------------------------------------------------}
 
-type InvalidBlocks blk = Map (HeaderHash blk) (InvalidBlockReason blk, SlotNo)
+type InvalidBlocks blk = Map (HeaderHash blk) (ExtValidationError blk, SlotNo)
 
 -- | Result of 'validate', also used internally.
 data ValidatedChain blk =
@@ -727,7 +726,7 @@ validate :: forall blk. LedgerSupportsProtocol blk
 validate cfg Model { initLedger, invalid } chain =
     go initLedger Genesis (Chain.toOldestFirst chain)
   where
-    mkInvalid :: blk -> InvalidBlockReason blk -> InvalidBlocks blk
+    mkInvalid :: blk -> ExtValidationError blk -> InvalidBlocks blk
     mkInvalid b reason =
       Map.singleton (blockHash b) (reason, blockSlot b)
 
@@ -744,7 +743,7 @@ validate cfg Model { initLedger, invalid } chain =
           -> ValidatedChain
                validPrefix
                ledger
-               (invalid <> mkInvalid b (ValidationError e))
+               (invalid <> mkInvalid b e)
 
         -- Valid block according to the ledger
         Right ledger'