diff --git a/ouroboros-consensus-cardano/src/ouroboros-consensus-cardano/Ouroboros/Consensus/Cardano/ByronHFC.hs b/ouroboros-consensus-cardano/src/ouroboros-consensus-cardano/Ouroboros/Consensus/Cardano/ByronHFC.hs
index 140c633968..177176cecd 100644
--- a/ouroboros-consensus-cardano/src/ouroboros-consensus-cardano/Ouroboros/Consensus/Cardano/ByronHFC.hs
+++ b/ouroboros-consensus-cardano/src/ouroboros-consensus-cardano/Ouroboros/Consensus/Cardano/ByronHFC.hs
@@ -30,9 +30,11 @@ type ByronBlockHFC = HardForkBlock '[ByronBlock]
   NoHardForks instance
 -------------------------------------------------------------------------------}
 
-instance NoHardForks ByronBlock where
-  getEraParams cfg =
+instance ImmutableEraParams ByronBlock where
+  immutableEraParams cfg =
       byronEraParamsNeverHardForks (byronGenesisConfig (configBlock cfg))
+
+instance NoHardForks ByronBlock where
   toPartialLedgerConfig _ cfg = ByronPartialLedgerConfig {
         byronLedgerConfig    = cfg
       , byronTriggerHardFork = TriggerHardForkNotDuringThisExecution
diff --git a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/ShelleyHFC.hs b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/ShelleyHFC.hs
index 1527dc8c6c..4bc9085684 100644
--- a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/ShelleyHFC.hs
+++ b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/ShelleyHFC.hs
@@ -79,12 +79,16 @@ type ShelleyBlockHFC proto era = HardForkBlock '[ShelleyBlock proto era]
 
 instance ( ShelleyCompatible proto era
          , LedgerSupportsProtocol (ShelleyBlock proto era)
-         , TxLimits               (ShelleyBlock proto era)
-         ) => NoHardForks (ShelleyBlock proto era) where
-  getEraParams =
+         ) => ImmutableEraParams (ShelleyBlock proto era) where
+  immutableEraParams =
         shelleyEraParamsNeverHardForks
       . shelleyLedgerGenesis
       . configLedger
+
+instance ( ShelleyCompatible proto era
+         , LedgerSupportsProtocol (ShelleyBlock proto era)
+         , TxLimits               (ShelleyBlock proto era)
+         ) => NoHardForks (ShelleyBlock proto era) where
   toPartialLedgerConfig _ cfg = ShelleyPartialLedgerConfig {
         shelleyLedgerConfig    = cfg
       , shelleyTriggerHardFork = TriggerHardForkNotDuringThisExecution
diff --git a/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/Network/NodeToNode.hs b/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/Network/NodeToNode.hs
index f30ad37a31..1a0e8fcb2a 100644
--- a/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/Network/NodeToNode.hs
+++ b/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/Network/NodeToNode.hs
@@ -55,6 +55,7 @@ import           Data.Void (Void)
 import           Network.TypedProtocol.Codec
 import           Ouroboros.Consensus.Block
 import           Ouroboros.Consensus.Config (DiffusionPipeliningSupport (..))
+import           Ouroboros.Consensus.HeaderValidation (HeaderWithTime)
 import           Ouroboros.Consensus.Ledger.SupportsMempool
 import           Ouroboros.Consensus.Ledger.SupportsProtocol
 import           Ouroboros.Consensus.MiniProtocol.BlockFetch.Server
@@ -152,7 +153,7 @@ data Handlers m addr blk = Handlers {
         :: NodeToNodeVersion
         -> ControlMessageSTM m
         -> FetchedMetricsTracer m
-        -> BlockFetchClient (Header blk) blk m ()
+        -> BlockFetchClient (HeaderWithTime blk) blk m ()
 
     , hBlockFetchServer
         :: ConnectionId addr
diff --git a/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/Node/Genesis.hs b/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/Node/Genesis.hs
index d86bc6a4ec..1ff7e019ea 100644
--- a/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/Node/Genesis.hs
+++ b/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/Node/Genesis.hs
@@ -19,7 +19,9 @@ module Ouroboros.Consensus.Node.Genesis (
 
 import           Control.Monad (join)
 import           Data.Traversable (for)
+import           Data.Typeable (Typeable)
 import           Ouroboros.Consensus.Block
+import           Ouroboros.Consensus.HeaderValidation (HeaderWithTime (..))
 import           Ouroboros.Consensus.MiniProtocol.ChainSync.Client
                      (CSJConfig (..), CSJEnabledConfig (..),
                      ChainSyncLoPBucketConfig (..),
@@ -89,7 +91,7 @@ data GenesisNodeKernelArgs m blk = GenesisNodeKernelArgs {
 -- 'ChainDB.GetLoEFragment' that will be replaced via 'setGetLoEFragment') and a
 -- function to update the 'ChainDbArgs' accordingly.
 mkGenesisNodeKernelArgs ::
-     forall m blk. (IOLike m, GetHeader blk)
+     forall m blk. (IOLike m, GetHeader blk, Typeable blk)
   => GenesisConfig
   -> m ( GenesisNodeKernelArgs m blk
        , Complete ChainDbArgs m blk -> Complete ChainDbArgs m blk
@@ -113,9 +115,9 @@ mkGenesisNodeKernelArgs gcfg = do
 -- | Set 'gnkaGetLoEFragment' to the actual logic for determining the current
 -- LoE fragment.
 setGetLoEFragment ::
-     forall m blk. (IOLike m, GetHeader blk)
+     forall m blk. (IOLike m, GetHeader blk, Typeable blk)
   => STM m GSM.GsmState
-  -> STM m (AnchoredFragment (Header blk))
+  -> STM m (AnchoredFragment (HeaderWithTime blk))
      -- ^ The LoE fragment.
   -> StrictTVar m (ChainDB.GetLoEFragment m blk)
   -> m ()
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 224cba0d08..9698e57da5 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
@@ -11,6 +11,7 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
 
 module Ouroboros.Consensus.NodeKernel (
     -- * Node kernel
@@ -45,6 +46,7 @@ import           Data.List.NonEmpty (NonEmpty)
 import           Data.Map.Strict (Map)
 import           Data.Maybe (isJust, mapMaybe)
 import           Data.Proxy
+import qualified Data.Set as Set
 import qualified Data.Text as Text
 import           Data.Void (Void)
 import           Ouroboros.Consensus.Block hiding (blockMatchesHeader)
@@ -94,6 +96,7 @@ import           Ouroboros.Network.AnchoredFragment (AnchoredFragment,
 import qualified Ouroboros.Network.AnchoredFragment as AF
 import           Ouroboros.Network.Block (castTip, tipFromHeader)
 import           Ouroboros.Network.BlockFetch
+import qualified Ouroboros.Network.BlockFetch.ClientState as BF
 import           Ouroboros.Network.Diffusion (PublicPeerSelectionState)
 import           Ouroboros.Network.NodeToNode (ConnectionId,
                      MiniProtocolParameters (..))
@@ -131,7 +134,7 @@ data NodeKernel m addrNTN addrNTC blk = NodeKernel {
     , getTopLevelConfig       :: TopLevelConfig blk
 
       -- | The fetch client registry, used for the block fetch clients.
-    , getFetchClientRegistry  :: FetchClientRegistry (ConnectionId addrNTN) (Header blk) blk m
+    , getFetchClientRegistry  :: FetchClientRegistry (ConnectionId addrNTN) (HeaderWithTime blk) blk m
 
       -- | The fetch mode, used by diffusion.
       --
@@ -254,8 +257,8 @@ initNodeKernel args@NodeKernelArgs { registry, cfg, tracers
               , GSM.equivalent                = (==) `on` (AF.headPoint . fst)
               , GSM.getChainSyncStates        = fmap cschState <$> readTVar varChainSyncHandles
               , GSM.getCurrentSelection       = do
-                  headers        <- ChainDB.getCurrentChain  chainDB
-                  extLedgerState <- ChainDB.getCurrentLedger chainDB
+                  headers        <- ChainDB.getCurrentChainWithTime chainDB
+                  extLedgerState <- ChainDB.getCurrentLedger        chainDB
                   return (headers, ledgerState extLedgerState)
               , GSM.minCaughtUpDuration       = gsmMinCaughtUpDuration
               , GSM.setCaughtUpPersistentMark = \upd ->
@@ -309,8 +312,8 @@ initNodeKernel args@NodeKernelArgs { registry, cfg, tracers
     -- 'addFetchedBlock' whenever a new block is downloaded.
     void $ forkLinkedThread registry "NodeKernel.blockFetchLogic" $
       blockFetchLogic
-        (blockFetchDecisionTracer tracers)
-        (blockFetchClientTracer   tracers)
+        (contramap (map (fmap (fmap (map castPoint)))) $ blockFetchDecisionTracer tracers)
+        (contramap (fmap castTraceFetchClientState)    $ blockFetchClientTracer   tracers)
         blockFetchInterface
         fetchClientRegistry
         blockFetchConfiguration
@@ -344,6 +347,45 @@ initNodeKernel args@NodeKernelArgs { registry, cfg, tracers
           blockForging' <- traverse (forkBlockForging st) blockForging
           go blockForging'
 
+castTraceFetchClientState ::
+     forall blk. HasHeader (Header blk)
+  => TraceFetchClientState (HeaderWithTime blk) -> TraceFetchClientState (Header blk)
+castTraceFetchClientState = mapTraceFetchClientState hwtHeader
+
+mapTraceFetchClientState ::
+     (HeaderHash h1 ~ HeaderHash h2, HasHeader h2)
+  => (h1 -> h2) -> TraceFetchClientState h1 -> TraceFetchClientState h2
+mapTraceFetchClientState fheader = \case
+    AddedFetchRequest request inflight inflightLimits status -> AddedFetchRequest (frequest request) (finflight inflight) inflightLimits (fstatus status)
+
+    AcknowledgedFetchRequest request -> AcknowledgedFetchRequest (frequest request)
+
+    SendFetchRequest headers gsv -> SendFetchRequest (AF.mapAnchoredFragment fheader headers) gsv
+
+    StartedFetchBatch   range inflight inflightLimits status           -> StartedFetchBatch   (frange range) (finflight inflight) inflightLimits (fstatus status)
+    CompletedBlockFetch point inflight inflightLimits status time size -> CompletedBlockFetch (fpoint point) (finflight inflight) inflightLimits (fstatus status) time size
+    CompletedFetchBatch range inflight inflightLimits status           -> CompletedFetchBatch (frange range) (finflight inflight) inflightLimits (fstatus status)
+    RejectedFetchBatch  range inflight inflightLimits status           -> RejectedFetchBatch  (frange range) (finflight inflight) inflightLimits (fstatus status)
+
+    ClientTerminating i -> ClientTerminating i
+  where
+    frequest (BF.FetchRequest headers) = BF.FetchRequest $ map (AF.mapAnchoredFragment fheader) headers
+
+    finflight inflight = inflight { BF.peerFetchBlocksInFlight = fpoints (BF.peerFetchBlocksInFlight inflight) }
+
+    fstatus = \case
+      BF.PeerFetchStatusShutdown          -> BF.PeerFetchStatusShutdown
+      BF.PeerFetchStatusStarting          -> BF.PeerFetchStatusStarting
+      BF.PeerFetchStatusAberrant          -> BF.PeerFetchStatusAberrant
+      BF.PeerFetchStatusBusy              -> BF.PeerFetchStatusBusy
+      BF.PeerFetchStatusReady points idle -> BF.PeerFetchStatusReady (fpoints points) idle
+
+    fpoints = Set.mapMonotonic fpoint
+
+    frange (BF.ChainRange p1 p2) = BF.ChainRange (fpoint p1) (fpoint p2)
+
+    fpoint = castPoint
+
 {-------------------------------------------------------------------------------
   Internal node components
 -------------------------------------------------------------------------------}
@@ -354,8 +396,8 @@ data InternalState m addrNTN addrNTC blk = IS {
     , registry            :: ResourceRegistry m
     , btime               :: BlockchainTime m
     , chainDB             :: ChainDB m blk
-    , blockFetchInterface :: BlockFetchConsensusInterface (ConnectionId addrNTN) (Header blk) blk m
-    , fetchClientRegistry :: FetchClientRegistry (ConnectionId addrNTN) (Header blk) blk m
+    , blockFetchInterface :: BlockFetchConsensusInterface (ConnectionId addrNTN) (HeaderWithTime blk) blk m
+    , fetchClientRegistry :: FetchClientRegistry (ConnectionId addrNTN) (HeaderWithTime blk) blk m
     , varChainSyncHandles :: StrictTVar m (Map (ConnectionId addrNTN) (ChainSyncClientHandle m blk))
     , varGsmState         :: StrictTVar m GSM.GsmState
     , mempool             :: Mempool m blk
@@ -394,7 +436,7 @@ initInternalState NodeKernelArgs { tracers, chainDB, registry, cfg
 
     fetchClientRegistry <- newFetchClientRegistry
 
-    let getCandidates :: STM m (Map (ConnectionId addrNTN) (AnchoredFragment (Header blk)))
+    let getCandidates :: STM m (Map (ConnectionId addrNTN) (AnchoredFragment (HeaderWithTime blk)))
         getCandidates = viewChainSyncState varChainSyncHandles csCandidate
 
     slotForgeTimeOracle <- BlockFetchClientInterface.initSlotForgeTimeOracle cfg chainDB
@@ -403,7 +445,7 @@ initInternalState NodeKernelArgs { tracers, chainDB, registry, cfg
           (ChainDB.getCurrentChain chainDB)
           getUseBootstrapPeers
           (GSM.gsmStateToLedgerJudgement <$> readTVar varGsmState)
-        blockFetchInterface :: BlockFetchConsensusInterface (ConnectionId addrNTN) (Header blk) blk m
+        blockFetchInterface :: BlockFetchConsensusInterface (ConnectionId addrNTN) (HeaderWithTime blk) blk m
         blockFetchInterface = BlockFetchClientInterface.mkBlockFetchConsensusInterface
           (configBlock cfg)
           (BlockFetchClientInterface.defaultChainDbView chainDB)
diff --git a/ouroboros-consensus-diffusion/src/unstable-mock-testlib/Test/ThreadNet/Util/SimpleBlock.hs b/ouroboros-consensus-diffusion/src/unstable-mock-testlib/Test/ThreadNet/Util/SimpleBlock.hs
index 400bd6975c..105912d795 100644
--- a/ouroboros-consensus-diffusion/src/unstable-mock-testlib/Test/ThreadNet/Util/SimpleBlock.hs
+++ b/ouroboros-consensus-diffusion/src/unstable-mock-testlib/Test/ThreadNet/Util/SimpleBlock.hs
@@ -2,7 +2,7 @@
 
 module Test.ThreadNet.Util.SimpleBlock (prop_validSimpleBlock) where
 
-import           Data.Typeable
+import           Data.Typeable (Typeable)
 import           Ouroboros.Consensus.Block
 import           Ouroboros.Consensus.Mock.Ledger
 import           Ouroboros.Consensus.Util.Condense (condense)
diff --git a/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/Genesis/Tests/DensityDisconnect.hs b/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/Genesis/Tests/DensityDisconnect.hs
index e08b57e1f7..26e34bcf05 100644
--- a/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/Genesis/Tests/DensityDisconnect.hs
+++ b/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/Genesis/Tests/DensityDisconnect.hs
@@ -30,6 +30,7 @@ import           Ouroboros.Consensus.Config.SecurityParam
                      (SecurityParam (SecurityParam), maxRollbacks)
 import           Ouroboros.Consensus.Genesis.Governor (DensityBounds,
                      densityDisconnect, sharedCandidatePrefix)
+import           Ouroboros.Consensus.HeaderValidation (HeaderWithTime)
 import           Ouroboros.Consensus.MiniProtocol.ChainSync.Client
                      (ChainSyncClientException (DensityTooLow),
                      ChainSyncState (..))
@@ -59,13 +60,16 @@ import           Test.QuickCheck
 import           Test.QuickCheck.Extras (unsafeMapSuchThatJust)
 import           Test.Tasty
 import           Test.Tasty.QuickCheck
+import           Test.Util.HeaderValidation (attachSlotTimeToFragment)
 import           Test.Util.Orphans.IOLike ()
 import           Test.Util.PartialAccessors
-import           Test.Util.TersePrinting (terseHFragment, terseHeader)
-import           Test.Util.TestBlock (TestBlock)
+import           Test.Util.TersePrinting (terseHFragment, terseHWTFragment,
+                     terseHeader)
+import           Test.Util.TestBlock (TestBlock, singleNodeTestConfig)
 import           Test.Util.TestEnv (adjustQuickCheckMaxSize,
                      adjustQuickCheckTests)
 
+
 tests :: TestTree
 tests =
   adjustQuickCheckTests (* 4) $
@@ -87,9 +91,9 @@ data StaticCandidates =
   StaticCandidates {
     k        :: SecurityParam,
     sgen     :: GenesisWindow,
-    suffixes :: [(PeerId, AnchoredFragment (Header TestBlock))],
+    suffixes :: [(PeerId, AnchoredFragment (HeaderWithTime TestBlock))],
     tips     :: Map PeerId (Tip TestBlock),
-    loeFrag  :: AnchoredFragment (Header TestBlock)
+    loeFrag  :: AnchoredFragment (HeaderWithTime TestBlock)
   }
   deriving Show
 
@@ -112,7 +116,11 @@ staticCandidates GenesisTest {gtSecurityParam, gtGenesisWindow, gtBlockTree} =
       }
       where
         (loeFrag, suffixes) =
-          sharedCandidatePrefix curChain (second toHeaders <$> candidates)
+          sharedCandidatePrefix
+              curChain
+              (second (attachTimeUsingTestConfig . toHeaders)
+                <$> candidates
+              )
 
     selections = selection <$> branches
 
@@ -128,6 +136,15 @@ staticCandidates GenesisTest {gtSecurityParam, gtGenesisWindow, gtBlockTree} =
 
     branches = btBranches gtBlockTree
 
+-- | Attach a relative slot time to a fragment of headers using the
+-- 'singleNodeTestConfig'. Since 'k' is not used for time conversions,
+-- it is safe to use this configuration even if other 'k' values are
+-- used in the tests that call this function.
+attachTimeUsingTestConfig ::
+  AnchoredFragment (Header TestBlock) ->
+  AnchoredFragment (HeaderWithTime TestBlock)
+attachTimeUsingTestConfig = attachSlotTimeToFragment singleNodeTestConfig
+
 -- | Check that the GDD disconnects from some peers for each full Genesis window starting at any of a block tree's
 -- intersections, and that it's not the honest peer.
 prop_densityDisconnectStatic :: Property
@@ -139,7 +156,7 @@ prop_densityDisconnectStatic =
      counterexample "it should not disconnect the honest peers"
        (not $ any isHonestPeerId disconnect)
   where
-    mkState :: AnchoredFragment (Header TestBlock) -> ChainSyncState TestBlock
+    mkState :: AnchoredFragment (HeaderWithTime TestBlock) -> ChainSyncState TestBlock
     mkState frag =
       ChainSyncState {
         csCandidate = frag,
@@ -167,7 +184,7 @@ data EvolvingPeers =
     k        :: SecurityParam,
     sgen     :: GenesisWindow,
     peers    :: Peers EvolvingPeer,
-    loeFrag  :: AnchoredFragment (Header TestBlock),
+    loeFrag  :: AnchoredFragment (HeaderWithTime TestBlock),
     fullTree :: BlockTree TestBlock
   }
   deriving Show
@@ -227,7 +244,7 @@ data UpdateEvent = UpdateEvent {
   , bounds   :: [(PeerId, DensityBounds TestBlock)]
     -- | The current chains
   , tree     :: BlockTree (Header TestBlock)
-  , loeFrag  :: AnchoredFragment (Header TestBlock)
+  , loeFrag  :: AnchoredFragment (HeaderWithTime TestBlock)
   , curChain :: AnchoredFragment (Header TestBlock)
   }
 
@@ -240,7 +257,7 @@ prettyUpdateEvent UpdateEvent {target, added, killed, bounds, tree, loeFrag, cur
   [
     "Extended " ++ condense target ++ " with " ++ terseHeader added,
     "        disconnect: " ++ show killed,
-    "        LoE frag: " ++ terseHFragment loeFrag,
+    "        LoE frag: " ++ terseHWTFragment loeFrag,
     "        selection: " ++ terseHFragment curChain
   ]
   ++ prettyDensityBounds bounds
@@ -377,12 +394,17 @@ evolveBranches EvolvingPeers {k, sgen, peers = initialPeers, fullTree} =
         states =
           candidates <&> \ csCandidate ->
             ChainSyncState {
-              csCandidate,
+              csCandidate = attachTimeUsingTestConfig csCandidate,
               csIdling = False,
               csLatestSlot = SJust (AF.headSlot csCandidate)
             }
         -- Run GDD.
-        (loeFrag, suffixes) = sharedCandidatePrefix curChain (Map.toList candidates)
+        (loeFrag, suffixes) =
+          sharedCandidatePrefix
+             curChain
+             (Map.toList $
+               fmap attachTimeUsingTestConfig candidates
+             )
         (killedNow, bounds) = first Set.fromList $ densityDisconnect sgen k states suffixes loeFrag
         event = UpdateEvent {
           target,
@@ -415,7 +437,7 @@ peerInfo EvolvingPeers {k = SecurityParam k, sgen = GenesisWindow sgen, loeFrag}
   [
     "k: " <> show k,
     "sgen: " <> show sgen,
-    "loeFrag: " <> terseHFragment loeFrag
+    "loeFrag: " <> terseHWTFragment loeFrag
   ]
 
 -- | Tests that when GDD disconnects a peer, it continues to disconnect it when
diff --git a/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/PeerSimulator/BlockFetch.hs b/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/PeerSimulator/BlockFetch.hs
index def5645104..a3dc2cfaf9 100644
--- a/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/PeerSimulator/BlockFetch.hs
+++ b/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/PeerSimulator/BlockFetch.hs
@@ -30,6 +30,7 @@ import           Network.TypedProtocol.Codec (ActiveState, AnyMessage,
 import           Ouroboros.Consensus.Block (HasHeader)
 import           Ouroboros.Consensus.Block.Abstract (Header, Point (..))
 import           Ouroboros.Consensus.Config
+import           Ouroboros.Consensus.HeaderValidation (HeaderWithTime (..))
 import qualified Ouroboros.Consensus.MiniProtocol.BlockFetch.ClientInterface as BlockFetchClientInterface
 import           Ouroboros.Consensus.Node.ProtocolInfo
                      (NumCoreNodes (NumCoreNodes))
@@ -77,8 +78,8 @@ startBlockFetchLogic ::
   => ResourceRegistry m
   -> Tracer m (TraceEvent TestBlock)
   -> ChainDB m TestBlock
-  -> FetchClientRegistry PeerId (Header TestBlock) TestBlock m
-  -> STM m (Map PeerId (AnchoredFragment (Header TestBlock)))
+  -> FetchClientRegistry PeerId (HeaderWithTime TestBlock) TestBlock m
+  -> STM m (Map PeerId (AnchoredFragment (HeaderWithTime TestBlock)))
   -> m ()
 startBlockFetchLogic registry tracer chainDb fetchClientRegistry getCandidates = do
     let slotForgeTime :: BlockFetchClientInterface.SlotForgeTimeOracle m blk
@@ -130,10 +131,10 @@ startBlockFetchLogic registry tracer chainDb fetchClientRegistry getCandidates =
     decisionTracer = TraceOther . ("BlockFetchLogic | " ++) . show >$< tracer
 
 startKeepAliveThread ::
-     forall m peer blk.
+     forall m peer blk hdr.
      (Ord peer, IOLike m)
   => ResourceRegistry m
-  -> FetchClientRegistry peer (Header blk) blk m
+  -> FetchClientRegistry peer hdr blk m
   -> peer
   -> m ()
 startKeepAliveThread registry fetchClientRegistry peerId =
@@ -147,7 +148,7 @@ runBlockFetchClient ::
   -> PeerId
   -> BlockFetchTimeout
   -> StateViewTracers blk m
-  -> FetchClientRegistry PeerId (Header blk) blk m
+  -> FetchClientRegistry PeerId (HeaderWithTime blk) blk m
   -> ControlMessageSTM m
   -> Channel m (AnyMessage (BlockFetch blk (Point blk)))
      -- ^ Send and receive message via the given 'Channel'.
diff --git a/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/PeerSimulator/NodeLifecycle.hs b/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/PeerSimulator/NodeLifecycle.hs
index 60f7476286..5052200d74 100644
--- a/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/PeerSimulator/NodeLifecycle.hs
+++ b/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/PeerSimulator/NodeLifecycle.hs
@@ -18,8 +18,10 @@ import           Control.Tracer (Tracer (..), traceWith)
 import           Data.Functor (void)
 import           Data.Set (Set)
 import qualified Data.Set as Set
+import           Data.Typeable (Typeable)
 import           Ouroboros.Consensus.Block
 import           Ouroboros.Consensus.Config (TopLevelConfig (..))
+import           Ouroboros.Consensus.HeaderValidation (HeaderWithTime (..))
 import           Ouroboros.Consensus.Storage.ChainDB.API
 import qualified Ouroboros.Consensus.Storage.ChainDB.API as ChainDB
 import qualified Ouroboros.Consensus.Storage.ChainDB.Impl as ChainDB
@@ -88,7 +90,7 @@ data LiveResources blk m = LiveResources {
   , lrCdb      :: NodeDBs (StrictTMVar m MockFS)
 
     -- | The LoE fragment must be reset for each live interval.
-  , lrLoEVar   :: LoE (StrictTVar m (AnchoredFragment (Header blk)))
+  , lrLoEVar   :: LoE (StrictTVar m (AnchoredFragment (HeaderWithTime blk)))
   }
 
 data LiveInterval blk m = LiveInterval {
@@ -188,7 +190,7 @@ lifecycleStart start liResources liResult = do
 -- | Shut down the node by killing all its threads after extracting the
 -- persistent state used to restart the node later.
 lifecycleStop ::
-  (IOLike m, GetHeader blk) =>
+  (IOLike m, GetHeader blk, Typeable blk) =>
   LiveResources blk m ->
   LiveNode blk m ->
   m (LiveIntervalResult blk)
diff --git a/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/PeerSimulator/Run.hs b/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/PeerSimulator/Run.hs
index 1010c7eda3..dafd4ddb50 100644
--- a/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/PeerSimulator/Run.hs
+++ b/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/PeerSimulator/Run.hs
@@ -23,6 +23,7 @@ import qualified Data.Map.Strict as Map
 import           Ouroboros.Consensus.Block
 import           Ouroboros.Consensus.Config (TopLevelConfig (..))
 import           Ouroboros.Consensus.Genesis.Governor (gddWatcher)
+import           Ouroboros.Consensus.HeaderValidation (HeaderWithTime)
 import           Ouroboros.Consensus.Ledger.SupportsProtocol
                      (LedgerSupportsProtocol)
 import           Ouroboros.Consensus.MiniProtocol.ChainSync.Client
@@ -63,6 +64,7 @@ import           Test.Consensus.PointSchedule.NodeState (NodeState)
 import           Test.Consensus.PointSchedule.Peers (Peer (..), PeerId,
                      getPeerIds)
 import           Test.Util.ChainDB
+import           Test.Util.HeaderValidation (dropTimeFromFragment)
 import           Test.Util.Orphans.IOLike ()
 import           Test.Util.TestBlock (TestBlock)
 
@@ -140,7 +142,7 @@ startChainSyncConnectionThread ::
   Tracer m (TraceEvent blk) ->
   TopLevelConfig blk ->
   ChainDbView m blk ->
-  FetchClientRegistry PeerId (Header blk) blk m ->
+  FetchClientRegistry PeerId (HeaderWithTime blk) blk m ->
   SharedResources m blk ->
   ChainSyncResources m blk ->
   ChainSyncTimeout ->
@@ -180,7 +182,7 @@ startBlockFetchConnectionThread ::
   ResourceRegistry m ->
   Tracer m (TraceEvent blk) ->
   StateViewTracers blk m ->
-  FetchClientRegistry PeerId (Header blk) blk m ->
+  FetchClientRegistry PeerId (HeaderWithTime blk) blk m ->
   ControlMessageSTM m ->
   SharedResources m blk ->
   BlockFetchResources m blk ->
@@ -228,7 +230,7 @@ smartDelay _ node duration = do
 --
 -- TODO doc is outdated
 dispatchTick :: forall m blk.
-  IOLike m =>
+  (IOLike m, HasHeader (Header blk)) =>
   Tracer m (TraceSchedulerEvent blk) ->
   StrictTVar m (Map PeerId (ChainSyncClientHandle m blk)) ->
   Map PeerId (PeerResources m blk) ->
@@ -261,7 +263,7 @@ dispatchTick tracer varHandles peers lifecycle node (number, (duration, Peer pid
         duration
         (Peer pid state)
         currentChain
-        (CSClient.csCandidate <$> csState)
+        (dropTimeFromFragment . CSClient.csCandidate <$> csState)
         jumpingStates
 
 -- | Iterate over a 'PointSchedule', sending each tick to the associated peer in turn,
@@ -270,7 +272,7 @@ dispatchTick tracer varHandles peers lifecycle node (number, (duration, Peer pid
 -- This usually means for the ChainSync server to have sent the target header to the
 -- client.
 runScheduler ::
-  IOLike m =>
+  (IOLike m, HasHeader (Header blk)) =>
   Tracer m (TraceSchedulerEvent blk) ->
   StrictTVar m (Map PeerId (ChainSyncClientHandle m blk)) ->
   PointSchedule blk ->
@@ -298,7 +300,7 @@ runScheduler tracer varHandles ps@PointSchedule{psMinEndTime} peers lifecycle@No
 mkLoEVar ::
   IOLike m =>
   SchedulerConfig ->
-  m (LoE (StrictTVar m (AnchoredFragment (Header TestBlock))))
+  m (LoE (StrictTVar m (AnchoredFragment (HeaderWithTime TestBlock))))
 mkLoEVar SchedulerConfig {scEnableLoE}
   | scEnableLoE
   = LoEEnabled <$> newTVarIO (AF.Empty AF.AnchorGenesis)
@@ -317,7 +319,11 @@ mkStateTracer schedulerConfig GenesisTest {gtBlockTree} PeerSimulatorResources {
   , let getCandidates = viewChainSyncState psrHandles CSClient.csCandidate
         getCurrentChain = ChainDB.getCurrentChain chainDb
         getPoints = traverse readTVar (srCurrentState . prShared <$> psrPeers)
-  = peerSimStateDiagramSTMTracerDebug gtBlockTree getCurrentChain getCandidates getPoints
+  = peerSimStateDiagramSTMTracerDebug
+        gtBlockTree
+        getCurrentChain
+        (fmap (Map.map dropTimeFromFragment) getCandidates)
+        getPoints
   | otherwise
   = pure nullTracer
 
diff --git a/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/PeerSimulator/Trace.hs b/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/PeerSimulator/Trace.hs
index a1885f3064..31d955257b 100644
--- a/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/PeerSimulator/Trace.hs
+++ b/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/PeerSimulator/Trace.hs
@@ -29,6 +29,7 @@ import           Ouroboros.Consensus.Block (GenesisWindow (..), Header, Point,
                      WithOrigin (NotOrigin, Origin), succWithOrigin)
 import           Ouroboros.Consensus.Genesis.Governor (DensityBounds (..),
                      GDDDebugInfo (..), TraceGDDEvent (..))
+import           Ouroboros.Consensus.HeaderValidation (HeaderWithTime (..))
 import           Ouroboros.Consensus.MiniProtocol.ChainSync.Client
                      (TraceChainSyncClientEvent (..))
 import           Ouroboros.Consensus.MiniProtocol.ChainSync.Client.Jumping
@@ -52,8 +53,9 @@ import           Ouroboros.Network.Block (SlotNo (SlotNo), Tip, castPoint)
 import           Test.Consensus.PointSchedule.NodeState (NodeState)
 import           Test.Consensus.PointSchedule.Peers (Peer (Peer), PeerId)
 import           Test.Util.TersePrinting (terseAnchor, terseBlock,
-                     terseFragment, terseHFragment, terseHeader, tersePoint,
-                     terseRealPoint, terseTip, terseWithOrigin)
+                     terseFragment, terseHFragment, terseHWTFragment,
+                     terseHeader, tersePoint, terseRealPoint, terseTip,
+                     terseWithOrigin)
 import           Test.Util.TestBlock (TestBlock)
 import           Text.Printf (printf)
 
@@ -475,7 +477,7 @@ prettyDensityBounds bounds =
         -- the density comparison should not be applied to two peers if they share any headers after the LoE fragment.
         lastPoint =
           "point: " ++
-          tersePoint (castPoint @(Header TestBlock) @TestBlock (AF.lastPoint clippedFragment)) ++
+          tersePoint (castPoint @(HeaderWithTime TestBlock) @TestBlock (AF.lastPoint clippedFragment)) ++
           ", "
 
         showLatestSlot = \case
@@ -509,7 +511,7 @@ terseGDDEvent = \case
       [
       "      Candidate suffixes (bounds):"
       ] ++
-      showPeers (second (terseHFragment . clippedFragment) <$> bounds) ++
+      showPeers (second (terseHWTFragment . clippedFragment) <$> bounds) ++
       ["      Density bounds:"] ++
       prettyDensityBounds bounds ++
       ["      New candidate tips:"] ++
diff --git a/ouroboros-consensus-diffusion/test/consensus-test/Test/Util/TersePrinting.hs b/ouroboros-consensus-diffusion/test/consensus-test/Test/Util/TersePrinting.hs
index ff29cfc2ca..180ae0dd0b 100644
--- a/ouroboros-consensus-diffusion/test/consensus-test/Test/Util/TersePrinting.hs
+++ b/ouroboros-consensus-diffusion/test/consensus-test/Test/Util/TersePrinting.hs
@@ -8,6 +8,7 @@ module Test.Util.TersePrinting (
   , terseBlock
   , terseFragment
   , terseHFragment
+  , terseHWTFragment
   , terseHeader
   , terseMaybe
   , tersePoint
@@ -24,6 +25,7 @@ import           Ouroboros.Consensus.Block (Header,
                      Point (BlockPoint, GenesisPoint), RealPoint,
                      SlotNo (SlotNo), blockHash, blockNo, blockSlot,
                      realPointToPoint)
+import           Ouroboros.Consensus.HeaderValidation (HeaderWithTime (..))
 import           Ouroboros.Network.AnchoredFragment (Anchor, AnchoredFragment,
                      anchor, anchorToPoint, mapAnchoredFragment, toOldestFirst)
 import           Ouroboros.Network.Block (Tip (..))
@@ -118,6 +120,11 @@ terseFragment fragment =
 terseHFragment :: AnchoredFragment (Header TestBlock) -> String
 terseHFragment = terseFragment . mapAnchoredFragment (\(TestHeader block) -> block)
 
+-- | Same as 'terseFragment' for fragments of headers with time.
+--
+terseHWTFragment :: AnchoredFragment (HeaderWithTime TestBlock) -> String
+terseHWTFragment = terseHFragment . mapAnchoredFragment hwtHeader
+
 -- | Same as 'terseWithOrigin' for 'Maybe'.
 terseMaybe :: (a -> String) -> Maybe a -> String
 terseMaybe _ Nothing       = "X"
diff --git a/ouroboros-consensus/bench/ChainSync-client-bench/Main.hs b/ouroboros-consensus/bench/ChainSync-client-bench/Main.hs
index 62facd2089..e00381bcd1 100644
--- a/ouroboros-consensus/bench/ChainSync-client-bench/Main.hs
+++ b/ouroboros-consensus/bench/ChainSync-client-bench/Main.hs
@@ -75,7 +75,7 @@ main = withStdTerminalHandles $ mainWith $ \n -> do
 
 {-# INLINE oneBenchRun #-}
 oneBenchRun ::
-     StrictTVar IO (AnchoredFragment H)
+     StrictTVar IO (AnchoredFragment (HV.HeaderWithTime B))
   -> StrictTVar IO (Tip B)
   -> ChainDB.Follower IO B (ChainDB.WithPoint B H)
   -> Int
diff --git a/ouroboros-consensus/ouroboros-consensus.cabal b/ouroboros-consensus/ouroboros-consensus.cabal
index 774a787b19..6f44c62cda 100644
--- a/ouroboros-consensus/ouroboros-consensus.cabal
+++ b/ouroboros-consensus/ouroboros-consensus.cabal
@@ -349,6 +349,7 @@ library unstable-consensus-testlib
     Test.Util.FileLock
     Test.Util.HardFork.Future
     Test.Util.HardFork.OracularClock
+    Test.Util.HeaderValidation
     Test.Util.InvertedMap
     Test.Util.LogicalClock
     Test.Util.MockChain
@@ -391,6 +392,7 @@ library unstable-consensus-testlib
     cardano-binary:testlib,
     cardano-crypto-class,
     cardano-prelude,
+    cardano-slotting,
     cardano-slotting:testlib,
     cardano-strict-containers,
     cborg,
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Block/Abstract.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Block/Abstract.hs
index ff7f160206..89ce61ff5e 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Block/Abstract.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Block/Abstract.hs
@@ -18,6 +18,7 @@ module Ouroboros.Consensus.Block.Abstract (
   , blockPrevHash
     -- * Working with headers
   , GetHeader (..)
+  , GetHeader1 (..)
   , Header
   , blockIsEBB
   , blockToIsEBB
@@ -127,6 +128,7 @@ data family Header blk :: Type
 
 class HasHeader (Header blk) => GetHeader blk where
   getHeader          :: blk -> Header blk
+
   -- | Check whether the header is the header of the block.
   --
   -- For example, by checking whether the hash of the body stored in the
@@ -148,13 +150,18 @@ blockToIsEBB = headerToIsEBB . getHeader
 
 type instance BlockProtocol (Header blk) = BlockProtocol blk
 
+class GetHeader1 t where
+  getHeader1 :: t blk -> Header blk
+
+instance GetHeader1 Header where getHeader1 = id
+
 {-------------------------------------------------------------------------------
   Some automatic instances for 'Header'
 -------------------------------------------------------------------------------}
 
 type instance HeaderHash (Header blk) = HeaderHash blk
 
-instance HasHeader blk => StandardHash (Header blk)
+instance StandardHash blk => StandardHash (Header blk)
 
 -- | Get the 'HeaderFields' of a block, without requiring 'HasHeader blk'
 --
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Block/RealPoint.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Block/RealPoint.hs
index b539733c90..1c28ab3b52 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Block/RealPoint.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Block/RealPoint.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE CPP #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE OverloadedStrings #-}
@@ -87,17 +86,15 @@ blockRealPoint blk = RealPoint s h
     HeaderFields { headerFieldSlot = s, headerFieldHash = h } = getHeaderFields blk
 
 headerRealPoint ::
-    ( HasHeader (Header blk)
-#if __GLASGOW_HASKELL__ >= 904
--- GHC 9.4+ considers these constraints insufficient.
-    , HasHeader blk
-#endif
-    )
+       forall blk. HasHeader (Header blk)
     => Header blk
     -> RealPoint blk
 headerRealPoint hdr = RealPoint s h
   where
-    HeaderFields { headerFieldSlot = s, headerFieldHash = h } = getHeaderFields hdr
+    HeaderFields { headerFieldSlot = s, headerFieldHash = h } = hf
+
+    hf :: HeaderFields (Header blk)
+    hf = getHeaderFields hdr
 
 realPointToPoint :: RealPoint blk -> Point blk
 realPointToPoint (RealPoint s h) = BlockPoint s h
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Fragment/Diff.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Fragment/Diff.hs
index ab1611c3f8..3f292248b2 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Fragment/Diff.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Fragment/Diff.hs
@@ -21,6 +21,7 @@ module Ouroboros.Consensus.Fragment.Diff (
     -- * Application
   , apply
     -- * Manipulation
+  , Ouroboros.Consensus.Fragment.Diff.map
   , append
   , mapM
   , takeWhileOldest
@@ -166,6 +167,18 @@ takeWhileOldest ::
 takeWhileOldest accept (ChainDiff nbRollback suffix) =
     ChainDiff nbRollback (AF.takeWhileOldest accept suffix)
 
+map ::
+     forall a b.
+     ( HasHeader b
+     , HeaderHash a ~ HeaderHash b
+     )
+  => (a -> b)
+  -> ChainDiff a
+  -> ChainDiff b
+map f (ChainDiff rollback suffix) =
+    ChainDiff rollback
+  $ AF.mapAnchoredFragment f suffix
+
 mapM ::
      forall a b m.
      ( HasHeader b
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Genesis/Governor.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Genesis/Governor.hs
index a1cd17a3d1..a5dc31ad4d 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Genesis/Governor.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Genesis/Governor.hs
@@ -45,6 +45,7 @@ import           Data.Map.Strict (Map)
 import qualified Data.Map.Strict as Map
 import           Data.Maybe (mapMaybe, maybeToList)
 import           Data.Maybe.Strict (StrictMaybe)
+import           Data.Typeable (Typeable)
 import           Data.Word (Word64)
 import           Ouroboros.Consensus.Block
 import           Ouroboros.Consensus.Config (TopLevelConfig, configLedger,
@@ -54,6 +55,7 @@ import           Ouroboros.Consensus.Config.SecurityParam
 import           Ouroboros.Consensus.HardFork.Abstract (HasHardForkHistory (..))
 import           Ouroboros.Consensus.HardFork.History.Qry (qryFromExpr,
                      runQuery, slotToGenesisWindow)
+import           Ouroboros.Consensus.HeaderValidation (HeaderWithTime (..))
 import           Ouroboros.Consensus.Ledger.Extended (ExtLedgerState,
                      ledgerState)
 import           Ouroboros.Consensus.Ledger.SupportsProtocol
@@ -92,7 +94,7 @@ gddWatcher ::
      -- changes, and when 'Syncing', whenever any of the candidate fragments
      -- changes. Also, we use this to disconnect from peers with insufficient
      -- densities.
-  -> StrictTVar m (AnchoredFragment (Header blk))
+  -> StrictTVar m (AnchoredFragment (HeaderWithTime blk))
      -- ^ The LoE fragment. It starts at a (recent) immutable tip and ends at
      -- the common intersection of the candidate fragments.
   -> Watcher m
@@ -176,7 +178,7 @@ evaluateGDD ::
   => TopLevelConfig blk
   -> Tracer m (TraceGDDEvent peer blk)
   -> GDDStateView m blk peer
-  -> m (AnchoredFragment (Header blk))
+  -> m (AnchoredFragment (HeaderWithTime blk))
 evaluateGDD cfg tracer stateView = do
     let GDDStateView {
             gddCtxCurChain          = curChain
@@ -216,10 +218,19 @@ evaluateGDD cfg tracer stateView = do
       let
         (losingPeers, bounds) =
           densityDisconnect sgen (configSecurityParam cfg) states candidateSuffixes loeFrag
-        loeHead = AF.headAnchor loeFrag
+        loeHead = AF.castAnchor $ AF.headAnchor loeFrag
 
-      traceWith tracer $ TraceGDDDebug
-        GDDDebugInfo {sgen, curChain, bounds, candidates, candidateSuffixes, losingPeers, loeHead}
+        dropTimes = map (second (AF.mapAnchoredFragment hwtHeader))
+
+      traceWith tracer $ TraceGDDDebug $ GDDDebugInfo
+        { sgen
+        , curChain
+        , bounds
+        , candidates        = dropTimes candidates
+        , candidateSuffixes = dropTimes candidateSuffixes
+        , losingPeers
+        , loeHead
+        }
 
       whenJust (NE.nonEmpty losingPeers) $ \losingPeersNE -> do
         for_ losingPeersNE $ \peer -> killActions Map.! peer
@@ -235,13 +246,13 @@ evaluateGDD cfg tracer stateView = do
 -- The function also yields the suffixes of the intersection of @loeFrag@ with
 -- every candidate fragment.
 sharedCandidatePrefix ::
-  GetHeader blk =>
+  (GetHeader blk, Typeable blk) =>
   AnchoredFragment (Header blk) ->
-  [(peer, AnchoredFragment (Header blk))] ->
-  (AnchoredFragment (Header blk), [(peer, AnchoredFragment (Header blk))])
+  [(peer, AnchoredFragment (HeaderWithTime blk))] ->
+  (AnchoredFragment (HeaderWithTime blk), [(peer, AnchoredFragment (HeaderWithTime blk))])
 sharedCandidatePrefix curChain candidates =
   second getCompose $
-  stripCommonPrefix (AF.anchor curChain) $
+  stripCommonPrefix (AF.castAnchor $ AF.anchor curChain) $
   Compose immutableTipSuffixes
   where
     immutableTip = AF.anchorPoint curChain
@@ -260,7 +271,7 @@ sharedCandidatePrefix curChain candidates =
 
 data DensityBounds blk =
   DensityBounds {
-    clippedFragment :: AnchoredFragment (Header blk),
+    clippedFragment :: AnchoredFragment (HeaderWithTime blk),
     offersMoreThanK :: Bool,
     lowerBound      :: Word64,
     upperBound      :: Word64,
@@ -300,8 +311,8 @@ densityDisconnect ::
   => GenesisWindow
   -> SecurityParam
   -> Map peer (ChainSyncState blk)
-  -> [(peer, AnchoredFragment (Header blk))]
-  -> AnchoredFragment (Header blk)
+  -> [(peer, AnchoredFragment (HeaderWithTime blk))]
+  -> AnchoredFragment (HeaderWithTime blk)
   -> ([peer], [(peer, DensityBounds blk)])
 densityDisconnect (GenesisWindow sgen) (SecurityParam k) states candidateSuffixes loeFrag =
   (losingPeers, densityBounds)
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/Abstract/NoHardForks.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/Abstract/NoHardForks.hs
index 120ae8064e..575e257307 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/Abstract/NoHardForks.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/Abstract/NoHardForks.hs
@@ -1,6 +1,7 @@
 module Ouroboros.Consensus.HardFork.Combinator.Abstract.NoHardForks (
-    NoHardForks (..)
-  , noHardForksEpochInfo
+    ImmutableEraParams (..)
+  , NoHardForks (..)
+  , immutableEpochInfo
   ) where
 
 import           Cardano.Slotting.EpochInfo
@@ -15,28 +16,39 @@ import           Ouroboros.Consensus.Ledger.Abstract
   Blocks that don't /have/ any transitions
 -------------------------------------------------------------------------------}
 
-class SingleEraBlock blk => NoHardForks blk where
+-- | A block type for which the 'EraParams' will /never/ change
+--
+-- Technically, some application of
+-- 'Ouroboros.Consensus.HardFork.Combinator.Basics.HardForkBlock' could have an
+-- instance for this. But that would only be appropriate if two conditions were
+-- met.
+--
+-- * all the eras in that block have the same 'EraParams'
+--
+-- * all eras that will /ever/ be added to that block in the future will also
+--   have those same 'EraParams'
+class ImmutableEraParams blk where
   -- | Extract 'EraParams' from the top-level config
   --
   -- The HFC itself does not care about this, as it must be given the full shape
   -- across /all/ eras.
-  getEraParams :: TopLevelConfig blk -> EraParams
-
+  immutableEraParams :: TopLevelConfig blk -> EraParams
 
+class (SingleEraBlock blk, ImmutableEraParams blk) => NoHardForks blk where
   -- | Construct partial ledger config from full ledger config
   --
   -- See also 'toPartialConsensusConfig'
   toPartialLedgerConfig :: proxy blk
                         -> LedgerConfig blk -> PartialLedgerConfig blk
 
-noHardForksEpochInfo :: (Monad m, NoHardForks blk)
-                     => TopLevelConfig blk
-                     -> EpochInfo m
-noHardForksEpochInfo cfg =
+immutableEpochInfo :: (Monad m, ImmutableEraParams blk)
+                   => TopLevelConfig blk
+                   -> EpochInfo m
+immutableEpochInfo cfg =
       hoistEpochInfo (pure . runIdentity)
     $ fixedEpochInfo
         (History.eraEpochSize  params)
         (History.eraSlotLength params)
   where
     params :: EraParams
-    params = getEraParams cfg
+    params = immutableEraParams cfg
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/Embed/Unary.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/Embed/Unary.hs
index d182dbb22e..6c3437c9e1 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/Embed/Unary.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/Embed/Unary.hs
@@ -267,7 +267,7 @@ instance Isomorphic TopLevelConfig where
         emptyCheckpointsMap
     where
       ei :: EpochInfo (Except PastHorizonException)
-      ei = noHardForksEpochInfo $ project tlc
+      ei = immutableEpochInfo $ project tlc
 
       auxLedger :: LedgerConfig (HardForkBlock '[blk]) -> LedgerConfig blk
       auxLedger =
@@ -297,7 +297,7 @@ instance Isomorphic TopLevelConfig where
         (inject       $ configStorage   tlc)
         emptyCheckpointsMap
     where
-      eraParams = getEraParams tlc
+      eraParams = immutableEraParams tlc
 
       auxLedger :: LedgerConfig blk -> LedgerConfig (HardForkBlock '[blk])
       auxLedger cfg = HardForkLedgerConfig {
@@ -423,7 +423,7 @@ instance Functor m => Isomorphic (BlockForging m) where
                                    (inject cfg)
                                    sno
                                    (injTickedChainDepSt
-                                     (noHardForksEpochInfo cfg)
+                                     (immutableEpochInfo cfg)
                                      tickedChainDepSt)
       , checkCanForge    = \cfg sno tickedChainDepSt isLeader forgeStateInfo ->
                                first (project' (Proxy @(WrapCannotForge blk))) $
@@ -431,7 +431,7 @@ instance Functor m => Isomorphic (BlockForging m) where
                                    (inject cfg)
                                    sno
                                    (injTickedChainDepSt
-                                     (noHardForksEpochInfo cfg)
+                                     (immutableEpochInfo cfg)
                                      tickedChainDepSt)
                                    (inject' (Proxy @(WrapIsLeader blk)) isLeader)
                                    (inject' (Proxy @(WrapForgeStateInfo blk)) forgeStateInfo)
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HeaderValidation.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HeaderValidation.hs
index cff3545b16..9bfdccf610 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HeaderValidation.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HeaderValidation.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE DefaultSignatures #-}
 {-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE LambdaCase #-}
@@ -55,6 +56,9 @@ module Ouroboros.Consensus.HeaderValidation (
   , encodeHeaderState
     -- * Type family instances
   , Ticked (..)
+    -- * Header with time
+  , HeaderWithTime (..)
+  , mkHeaderWithTime
   ) where
 
 import           Cardano.Binary (enforceSize)
@@ -68,12 +72,18 @@ import           Data.Coerce
 import           Data.Kind (Type)
 import qualified Data.Map.Strict as Map
 import           Data.Proxy
+import           Data.Typeable (Typeable)
 import           Data.Void (Void)
 import           GHC.Generics (Generic)
 import           GHC.Stack (HasCallStack)
 import           NoThunks.Class (NoThunks)
 import           Ouroboros.Consensus.Block
+import           Ouroboros.Consensus.BlockchainTime (RelativeTime)
 import           Ouroboros.Consensus.Config
+import           Ouroboros.Consensus.HardFork.Abstract
+                     (HasHardForkHistory (hardForkSummary))
+import qualified Ouroboros.Consensus.HardFork.History.Qry as Qry
+import           Ouroboros.Consensus.Ledger.Basics
 import           Ouroboros.Consensus.Protocol.Abstract
 import           Ouroboros.Consensus.Ticked
 import           Ouroboros.Consensus.Util (whenJust)
@@ -237,10 +247,11 @@ data HeaderEnvelopeError blk =
   | OtherHeaderEnvelopeError !(OtherHeaderEnvelopeError blk)
   deriving (Generic)
 
-deriving instance (ValidateEnvelope blk) => Eq   (HeaderEnvelopeError blk)
-deriving instance (ValidateEnvelope blk) => Show (HeaderEnvelopeError blk)
-deriving instance (ValidateEnvelope blk)
-               => NoThunks (HeaderEnvelopeError blk)
+deriving instance (ValidateEnvelope blk) => Eq       (HeaderEnvelopeError blk)
+deriving instance (ValidateEnvelope blk) => Show     (HeaderEnvelopeError blk)
+deriving instance ( ValidateEnvelope blk
+                  , Typeable blk
+                  )                      => NoThunks (HeaderEnvelopeError blk)
 
 castHeaderEnvelopeError :: ( HeaderHash blk ~ HeaderHash blk'
                            , OtherHeaderEnvelopeError blk ~ OtherHeaderEnvelopeError blk'
@@ -499,6 +510,75 @@ deriving instance StandardHash blk => Eq   (TipInfoIsEBB blk)
 deriving instance StandardHash blk => Show (TipInfoIsEBB blk)
 deriving instance StandardHash blk => NoThunks (TipInfoIsEBB blk)
 
+{-------------------------------------------------------------------------------
+  Header with time
+-------------------------------------------------------------------------------}
+
+-- | A header paired with the time of the slot that it inhabits.
+--
+-- Note that the header's slot was translated to this time (in the ChainSync
+-- client) according to the header's chain. This clarification may be helpful,
+-- since it's possible that some other chain would translate that same slot to
+-- a different time.
+data HeaderWithTime blk = HeaderWithTime {
+    hwtHeader           :: !(Header blk)
+  , hwtSlotRelativeTime :: !RelativeTime
+  }
+  deriving (Generic)
+
+deriving stock instance (Eq (Header blk))
+                      => Eq (HeaderWithTime blk)
+deriving stock instance (Show (Header blk))
+                      => Show (HeaderWithTime blk)
+deriving anyclass instance (NoThunks (Header blk))
+                         => NoThunks (HeaderWithTime blk)
+
+type instance HeaderHash (HeaderWithTime blk) = HeaderHash (Header blk)
+
+instance ( Show (HeaderHash blk)
+         , Eq (HeaderHash blk)
+         , Ord (HeaderHash blk)
+         , Typeable (HeaderHash blk)
+         , NoThunks (HeaderHash blk)
+         ) => StandardHash (HeaderWithTime blk)
+
+instance ( HasHeader (Header blk)
+         , StandardHash (HeaderWithTime blk)
+         , Typeable blk
+         ) => HasHeader (HeaderWithTime blk) where
+  getHeaderFields =
+      castHeaderFields
+    . getHeaderFields
+    . hwtHeader
+
+instance GetHeader1 HeaderWithTime where
+  getHeader1 = hwtHeader
+
+-- | Convert 'Header' to 'HeaderWithTime'
+--
+-- PREREQ: The given ledger must be able to translate the slot of the given
+-- header.
+--
+-- This is INLINEed since the summary can usually be reused.
+mkHeaderWithTime ::
+      ( HasHardForkHistory blk
+      , HasHeader (Header blk)
+      )
+   => LedgerConfig blk
+   -> LedgerState blk
+   -> Header blk
+   -> HeaderWithTime blk
+{-# INLINE mkHeaderWithTime #-}
+mkHeaderWithTime cfg lst = \hdr ->
+    let summary       = hardForkSummary cfg lst
+        slot          = realPointSlot $ headerRealPoint hdr
+        qry           = Qry.slotToWallclock slot
+        (slotTime, _) = Qry.runQueryPure qry summary
+    in HeaderWithTime {
+        hwtHeader           = hdr
+      , hwtSlotRelativeTime = slotTime
+      }
+
 {-------------------------------------------------------------------------------
   Serialisation
 -------------------------------------------------------------------------------}
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/MiniProtocol/BlockFetch/ClientInterface.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/MiniProtocol/BlockFetch/ClientInterface.hs
index b0d5f1cbb1..e30a549aeb 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/MiniProtocol/BlockFetch/ClientInterface.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/MiniProtocol/BlockFetch/ClientInterface.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
@@ -24,6 +25,7 @@ import           Ouroboros.Consensus.Config
 import qualified Ouroboros.Consensus.Config.SupportsNode as SupportsNode
 import qualified Ouroboros.Consensus.HardFork.Abstract as History
 import qualified Ouroboros.Consensus.HardFork.History as History
+import           Ouroboros.Consensus.HeaderValidation (HeaderWithTime (..))
 import           Ouroboros.Consensus.Ledger.Abstract
 import           Ouroboros.Consensus.Ledger.Extended
 import           Ouroboros.Consensus.Storage.ChainDB.API (ChainDB)
@@ -48,7 +50,8 @@ import           Ouroboros.Network.SizeInBytes
 
 -- | Abstract over the ChainDB
 data ChainDbView m blk = ChainDbView {
-     getCurrentChain           :: STM m (AnchoredFragment (Header blk))
+     getCurrentChain           :: STM m (AnchoredFragment (Header         blk))
+   , getCurrentChainWithTime   :: STM m (AnchoredFragment (HeaderWithTime blk))
    , getIsFetched              :: STM m (Point blk -> Bool)
    , getMaxSlotNo              :: STM m MaxSlotNo
    , addBlockWaitWrittenToDisk :: InvalidBlockPunishment m -> blk -> m Bool
@@ -56,7 +59,8 @@ data ChainDbView m blk = ChainDbView {
 
 defaultChainDbView :: IOLike m => ChainDB m blk -> ChainDbView m blk
 defaultChainDbView chainDB = ChainDbView {
-    getCurrentChain           = ChainDB.getCurrentChain chainDB
+    getCurrentChain           = ChainDB.getCurrentChain         chainDB
+  , getCurrentChainWithTime   = ChainDB.getCurrentChainWithTime chainDB
   , getIsFetched              = ChainDB.getIsFetched chainDB
   , getMaxSlotNo              = ChainDB.getMaxSlotNo chainDB
   , addBlockWaitWrittenToDisk = ChainDB.addBlockWaitWrittenToDisk chainDB
@@ -170,29 +174,43 @@ mkBlockFetchConsensusInterface ::
      ( IOLike m
      , BlockSupportsDiffusionPipelining blk
      , BlockSupportsProtocol blk
+     , SupportsNode.ConfigSupportsNode blk
      )
   => BlockConfig blk
   -> ChainDbView m blk
-  -> STM m (Map peer (AnchoredFragment (Header blk)))
+  -> STM m (Map peer (AnchoredFragment (HeaderWithTime blk)))
   -> (Header blk -> SizeInBytes)
   -> SlotForgeTimeOracle m blk
      -- ^ Slot forge time, see 'headerForgeUTCTime' and 'blockForgeUTCTime'.
   -> STM m FetchMode
      -- ^ See 'readFetchMode'.
   -> DiffusionPipeliningSupport
-  -> BlockFetchConsensusInterface peer (Header blk) blk m
+  -> BlockFetchConsensusInterface peer (HeaderWithTime blk) blk m
 mkBlockFetchConsensusInterface
   bcfg chainDB getCandidates blockFetchSize slotForgeTime readFetchMode pipelining =
-    BlockFetchConsensusInterface {..}
+    BlockFetchConsensusInterface {
+        readCandidateChains
+      , readCurrentChain
+      , readFetchMode
+      , readFetchedBlocks
+      , mkAddFetchedBlock
+      , readFetchedMaxSlotNo
+      , plausibleCandidateChain
+      , compareCandidateChains
+      , blockFetchSize =  blockFetchSize . hwtHeader
+      , blockMatchesHeader
+      , headerForgeUTCTime
+      , blockForgeUTCTime
+    }
   where
-    blockMatchesHeader :: Header blk -> blk -> Bool
-    blockMatchesHeader = Block.blockMatchesHeader
+    blockMatchesHeader :: HeaderWithTime blk -> blk -> Bool
+    blockMatchesHeader hwt b = Block.blockMatchesHeader (hwtHeader hwt) b
 
-    readCandidateChains :: STM m (Map peer (AnchoredFragment (Header blk)))
+    readCandidateChains :: STM m (Map peer (AnchoredFragment (HeaderWithTime blk)))
     readCandidateChains = getCandidates
 
-    readCurrentChain :: STM m (AnchoredFragment (Header blk))
-    readCurrentChain = getCurrentChain chainDB
+    readCurrentChain :: STM m (AnchoredFragment (HeaderWithTime blk))
+    readCurrentChain = getCurrentChainWithTime chainDB
 
     readFetchedBlocks :: STM m (Point blk -> Bool)
     readFetchedBlocks = getIsFetched chainDB
@@ -271,8 +289,8 @@ mkBlockFetchConsensusInterface
     -- fragment, by the time the block fetch download logic considers the
     -- fragment, our current chain might have changed.
     plausibleCandidateChain :: HasCallStack
-                            => AnchoredFragment (Header blk)
-                            -> AnchoredFragment (Header blk)
+                            => AnchoredFragment (HeaderWithTime blk)
+                            -> AnchoredFragment (HeaderWithTime blk)
                             -> Bool
     plausibleCandidateChain ours cand
       -- 1. The ChainDB maintains the invariant that the anchor of our fragment
@@ -315,17 +333,22 @@ mkBlockFetchConsensusInterface
       = preferAnchoredCandidate bcfg ours cand
       where
         anchorBlockNoAndSlot ::
-             AnchoredFragment (Header blk)
+             AnchoredFragment (HeaderWithTime blk)
           -> (WithOrigin BlockNo, WithOrigin SlotNo)
         anchorBlockNoAndSlot frag =
             (AF.anchorToBlockNo a, AF.anchorToSlotNo a)
           where
             a = AF.anchor frag
 
-    compareCandidateChains :: AnchoredFragment (Header blk)
-                           -> AnchoredFragment (Header blk)
+    compareCandidateChains :: AnchoredFragment (HeaderWithTime blk)
+                           -> AnchoredFragment (HeaderWithTime blk)
                            -> Ordering
     compareCandidateChains = compareAnchoredFragments bcfg
 
-    headerForgeUTCTime = slotForgeTime . headerRealPoint . unFromConsensus
+    headerForgeUTCTime  = pure
+                        . fromRelativeTime (SupportsNode.getSystemStart bcfg)
+                        . hwtSlotRelativeTime
+                        . unFromConsensus
+
+    -- NOTE: Once https://github.com/IntersectMBO/ouroboros-network/pull/5009 is integrated we can remove this.
     blockForgeUTCTime  = slotForgeTime . blockRealPoint  . unFromConsensus
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 ae0edd3420..1627e1d8fe 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
@@ -116,7 +116,6 @@ import           Ouroboros.Consensus.Protocol.Abstract
 import           Ouroboros.Consensus.Storage.ChainDB (ChainDB)
 import qualified Ouroboros.Consensus.Storage.ChainDB as ChainDB
 import           Ouroboros.Consensus.Util
-import           Ouroboros.Consensus.Util.AnchoredFragment (cross)
 import           Ouroboros.Consensus.Util.Assert (assertWithMsg)
 import           Ouroboros.Consensus.Util.EarlyExit (WithEarlyExit, exitEarly)
 import qualified Ouroboros.Consensus.Util.EarlyExit as EarlyExit
@@ -298,7 +297,7 @@ noLoPBucket =
 -- 'bracketChainSyncClient'.
 data ChainSyncStateView m blk = ChainSyncStateView {
     -- | The current candidate fragment
-    csvSetCandidate  :: !(AnchoredFragment (Header blk) -> STM m ())
+    csvSetCandidate  :: !(AnchoredFragment (HeaderWithTime blk) -> STM m ())
 
     -- | Update the slot of the latest received header
   , csvSetLatestSlot :: !(WithOrigin SlotNo -> STM m ())
@@ -627,7 +626,7 @@ data KnownIntersectionState blk = KnownIntersectionState {
     -- 'theirFrag' forks off within the last @k@ headers/blocks of the
     -- 'ourFrag'.
   ,
-    theirFrag               :: !(AnchoredFragment (Header blk))
+    theirFrag               :: !(AnchoredFragment (HeaderWithTime blk))
     -- ^ The candidate, the synched fragment of their chain.
     --
     -- See the \"Candidate fragment size\" note above.
@@ -652,7 +651,7 @@ instance
   => NoThunks (KnownIntersectionState blk) where
     showTypeOf _ = show $ typeRep (Proxy @(KnownIntersectionState blk))
 
-checkKnownIntersectionInvariants ::
+checkKnownIntersectionInvariants :: forall blk.
     ( HasHeader blk
     , HasHeader (Header blk)
     , HasAnnTip blk
@@ -664,8 +663,10 @@ checkKnownIntersectionInvariants ::
 checkKnownIntersectionInvariants cfg kis
     -- 'theirHeaderStateHistory' invariant
     | let HeaderStateHistory snapshots = theirHeaderStateHistory
+          historyTips :: [WithOrigin (AnnTip blk)]
           historyTips  = headerStateTip . hswtHeaderState <$> AS.toOldestFirst snapshots
-          fragmentTips = NotOrigin . getAnnTip <$> AF.toOldestFirst theirFrag
+          fragmentTips :: [WithOrigin (AnnTip blk)]
+          fragmentTips = NotOrigin . getAnnTip . hwtHeader <$> AF.toOldestFirst theirFrag
 
           fragmentAnchorPoint = castPoint $ AF.anchorPoint theirFrag
           historyAnchorPoint  =
@@ -702,7 +703,7 @@ checkKnownIntersectionInvariants cfg kis
 
     | let ourFragAnchor   = AF.anchorPoint ourFrag
           theirFragAnchor = AF.anchorPoint theirFrag
-    , ourFragAnchor /= theirFragAnchor
+    , ourFragAnchor /= castPoint theirFragAnchor
     = throwError $ unwords
       [ "ourFrag and theirFrag have different anchor points:"
       , show ourFragAnchor
@@ -774,7 +775,7 @@ data DynamicEnv m blk = DynamicEnv {
     version             :: NodeToNodeVersion
   , controlMessageSTM   :: ControlMessageSTM m
   , headerMetricsTracer :: HeaderMetricsTracer m
-  , setCandidate        :: AnchoredFragment (Header blk) -> STM m ()
+  , setCandidate        :: AnchoredFragment (HeaderWithTime blk) -> STM m ()
   , setLatestSlot       :: WithOrigin SlotNo -> STM m ()
   , idling              :: Idling m
   , loPBucket           :: LoPBucket m
@@ -944,11 +945,12 @@ chainSyncClient cfgEnv dynEnv =
         -- ('rollBackward'), so we have nothing to do.
         let noChange = AF.headPoint ourFrag == AF.headPoint ourFrag'
 
-        return $ if noChange then StillIntersects () kis else
-            case cross ourFrag' theirFrag of
-                Nothing -> NoLongerIntersects
-
-                Just (intersection, trimmedCandidate) ->
+        return $ if noChange then StillIntersects () kis else do
+            case AF.intersectionPoint ourFrag' theirFrag of
+                Just intersection
+                  | Just (_, trimmedCandidate) <-
+                      AF.splitAfterPoint theirFrag (AF.anchorPoint ourFrag')
+                  ->
                     -- Even though our current chain changed it still
                     -- intersects with candidate fragment, so update the
                     -- 'ourFrag' field and trim the candidate fragment to the
@@ -975,6 +977,8 @@ chainSyncClient cfgEnv dynEnv =
                       , kBestBlockNo
                       }
 
+                _ -> NoLongerIntersects
+
 {-------------------------------------------------------------------------------
   (Re-)Establishing a common intersection
 -------------------------------------------------------------------------------}
@@ -1099,7 +1103,11 @@ findIntersectionTop cfgEnv dynEnv intEnv =
             (theirFrag, theirHeaderStateHistory) <- do
                 case attemptRollback
                          intersection
-                         (ourFrag, ourHeaderStateHistory)
+                         -- We only perform the linear computation
+                         -- required by 'withTime' once when finding
+                         -- an intersection with a peer, so this
+                         -- should not impact the performance.
+                         (ourFrag `withTime` ourHeaderStateHistory, ourHeaderStateHistory)
                   of
                     Just (c, d, _oldestRewound) -> return (c, d)
                     Nothing ->
@@ -1126,6 +1134,35 @@ findIntersectionTop cfgEnv dynEnv intEnv =
             continueWithState kis $
                 knownIntersectionStateTop cfgEnv dynEnv intEnv theirTip
 
+-- | Augment the given fragment of headers with the times specified in
+-- the given state history.
+--
+-- PRECONDITION: the fragment must be a prefix of the state history.
+--
+withTime ::
+     (Typeable blk, HasHeader (Header blk))
+  => AnchoredFragment (Header blk)
+  -> HeaderStateHistory blk
+  -> AnchoredFragment (HeaderWithTime blk)
+withTime fragment (HeaderStateHistory history) =
+    assertWithMsg (
+      if AF.length fragment == AF.length history
+      then Right ()
+      else Left $ "Fragment and history have different lengths (|fragment| = "
+                   ++ show (AF.length fragment)
+                   ++ ", |history| = " ++ show (AF.length history)
+                   ++ ")"
+      ) $
+    AF.fromOldestFirst
+        (AF.castAnchor $ AF.anchor fragment)
+        $ fmap addTimeToHeader $ zip (AF.toOldestFirst fragment) (AF.toOldestFirst history)
+  where
+     addTimeToHeader :: (Header blk, HeaderStateWithTime blk) -> HeaderWithTime blk
+     addTimeToHeader (hdr, hsWt) = HeaderWithTime {
+         hwtHeader = hdr
+       , hwtSlotRelativeTime = hswtSlotTime hsWt
+     }
+
 {-------------------------------------------------------------------------------
   Processing 'MsgRollForward' and 'MsgRollBackward'
 -------------------------------------------------------------------------------}
@@ -1819,7 +1856,11 @@ checkValid cfgEnv intEnv hdr hdrSlotTime theirTip kis ledgerView = do
                 disconnect
               $ HeaderError hdrPoint vErr (ourTipFromChain ourFrag) theirTip
 
-    let theirFrag' = theirFrag :> hdr
+    let
+        validatedHdr = HeaderWithTime { hwtHeader           = hdr
+                                      , hwtSlotRelativeTime = hdrSlotTime
+                                      }
+        theirFrag' = theirFrag :> validatedHdr
         -- Advance the most recent intersection if we have the same
         -- header on our fragment too. This is cheaper than recomputing
         -- the intersection from scratch.
@@ -1943,9 +1984,9 @@ attemptRollback ::
      , HasAnnTip blk
      )
   => Point blk
-  ->       (AnchoredFragment (Header blk), HeaderStateHistory blk)
+  ->       (AnchoredFragment (HeaderWithTime blk), HeaderStateHistory blk)
   -> Maybe
-       ( AnchoredFragment (Header blk)
+       ( AnchoredFragment (HeaderWithTime blk)
        , HeaderStateHistory blk
        , -- The state of the oldest header that was rolled back, if any.
          Maybe (HeaderStateWithTime blk)
@@ -1984,7 +2025,7 @@ invalidBlockRejector ::
   -> DiffusionPipeliningSupport
   -> STM m (WithFingerprint (HeaderHash blk -> Maybe (ExtValidationError blk)))
      -- ^ Get the invalid block checker
-  -> STM m (AnchoredFragment (Header blk))
+  -> STM m (AnchoredFragment (HeaderWithTime blk))
      -- ^ Get the candidate
   -> Watcher m
          (WithFingerprint (HeaderHash blk -> Maybe (ExtValidationError blk)))
@@ -2010,10 +2051,17 @@ invalidBlockRejector tracer _version pipelining getIsInvalidBlock getCandidate =
         -- tentative
         mapM_ (uncurry disconnect)
           $ firstJust
-                (\hdr -> (hdr,) <$> isInvalidBlock (headerHash hdr))
+                (\hdrWithTime ->
+                   let hdr = hwtHeader hdrWithTime in
+                     (hdr,) <$> isInvalidBlock (headerHash hdr)
+                )
           $ (   case pipelining of
-                    DiffusionPipeliningOn  -> drop 1
                     DiffusionPipeliningOff -> id
+                    DiffusionPipeliningOn  ->
+                      -- As mentioned in the comment above, if the
+                      -- header is tentative we skip the fragment tip,
+                      -- dropping the first element.
+                      drop 1
             )
           $ AF.toNewestFirst theirFrag
 
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/MiniProtocol/ChainSync/Client/Jumping.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/MiniProtocol/ChainSync/Client/Jumping.hs
index 4fe5f24a47..4d659abb00 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/MiniProtocol/ChainSync/Client/Jumping.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/MiniProtocol/ChainSync/Client/Jumping.hs
@@ -168,6 +168,7 @@ import           Data.Map.Strict (Map)
 import qualified Data.Map.Strict as Map
 import           Data.Maybe (catMaybes, fromMaybe)
 import           Data.Maybe.Strict (StrictMaybe (..))
+import           Data.Typeable (Typeable)
 import           GHC.Generics (Generic)
 import           Ouroboros.Consensus.Block (HasHeader (getHeaderFields), Header,
                      Point (..), castPoint, pointSlot, succWithOrigin)
@@ -305,8 +306,8 @@ data Instruction blk
     JumpInstruction !(JumpInstruction blk)
   deriving (Generic)
 
-deriving instance (HasHeader (Header blk), Eq (Header blk)) => Eq (Instruction blk)
-deriving instance (HasHeader (Header blk), Show (Header blk)) => Show (Instruction blk)
+deriving instance (Typeable blk, HasHeader (Header blk), Eq (Header blk)) => Eq (Instruction blk)
+deriving instance (Typeable blk, HasHeader (Header blk), Show (Header blk)) => Show (Instruction blk)
 deriving anyclass instance
   ( HasHeader blk,
     LedgerSupportsProtocol blk,
@@ -321,8 +322,8 @@ data JumpInstruction blk
     JumpToGoodPoint !(JumpInfo blk)
   deriving (Generic)
 
-deriving instance (HasHeader (Header blk), Eq (Header blk)) => Eq (JumpInstruction blk)
-instance (HasHeader (Header blk), Show (Header blk)) => Show (JumpInstruction blk) where
+deriving instance (Typeable blk, HasHeader (Header blk), Eq (Header blk)) => Eq (JumpInstruction blk)
+instance (Typeable blk, HasHeader (Header blk), Show (Header blk)) => Show (JumpInstruction blk) where
   showsPrec p = \case
     JumpTo jumpInfo ->
       showParen (p > 10) $ showString "JumpTo " . shows (AF.headPoint $ jTheirFragment jumpInfo)
@@ -341,8 +342,8 @@ data JumpResult blk
   | RejectedJump !(JumpInstruction blk)
   deriving (Generic)
 
-deriving instance (HasHeader (Header blk), Eq (Header blk)) => Eq (JumpResult blk)
-deriving instance (HasHeader (Header blk), Show (Header blk)) => Show (JumpResult blk)
+deriving instance (Typeable blk, HasHeader (Header blk), Eq (Header blk)) => Eq (JumpResult blk)
+deriving instance (Typeable blk, HasHeader (Header blk), Show (Header blk)) => Show (JumpResult blk)
 
 deriving anyclass instance
   ( HasHeader blk,
@@ -620,7 +621,7 @@ processJumpResult context jumpResult =
         -- intersection is the good point.
         -- Clear any subsequent jumps requested by the dynamo.
         writeTVar nextJumpVar Nothing
-        maybeElectNewObjector nextJumpVar goodJumpInfo (AF.headPoint badFragment)
+        maybeElectNewObjector nextJumpVar goodJumpInfo (AF.castPoint $ AF.headPoint badFragment)
       else do
         let middlePoint = len `div` 2
             theirFragment = AF.dropNewest middlePoint badFragment
@@ -629,6 +630,11 @@ processJumpResult context jumpResult =
         writeTVar (cschJumping (handle context)) $
           Jumper nextJumpVar (LookingForIntersection goodJumpInfo badJumpInfo)
 
+    maybeElectNewObjector ::
+         StrictTVar m (Maybe (JumpInfo blk))
+      -> JumpInfo blk
+      -> Point (Header blk)
+      -> STM m ()
     maybeElectNewObjector nextJumpVar goodJumpInfo badPoint = do
       findObjector (stripContext context) >>= \case
         Nothing ->
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/MiniProtocol/ChainSync/Client/State.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/MiniProtocol/ChainSync/Client/State.hs
index f850ccdf89..846e84d340 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/MiniProtocol/ChainSync/Client/State.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/MiniProtocol/ChainSync/Client/State.hs
@@ -22,10 +22,11 @@ module Ouroboros.Consensus.MiniProtocol.ChainSync.Client.State (
 import           Cardano.Slotting.Slot (SlotNo, WithOrigin)
 import           Data.Function (on)
 import           Data.Maybe.Strict (StrictMaybe (..))
-import           Data.Typeable (Proxy (..), typeRep)
+import           Data.Typeable (Proxy (..), Typeable, typeRep)
 import           GHC.Generics (Generic)
 import           Ouroboros.Consensus.Block (HasHeader, Header, Point)
 import           Ouroboros.Consensus.HeaderStateHistory (HeaderStateHistory)
+import           Ouroboros.Consensus.HeaderValidation (HeaderWithTime (..))
 import           Ouroboros.Consensus.Ledger.SupportsProtocol
                      (LedgerSupportsProtocol)
 import           Ouroboros.Consensus.Node.GsmState (GsmState)
@@ -39,8 +40,7 @@ import           Ouroboros.Network.AnchoredFragment (AnchoredFragment,
 data ChainSyncState blk = ChainSyncState {
 
     -- | The current candidate fragment.
-    csCandidate  :: !(AnchoredFragment (Header blk))
-
+    csCandidate  :: !(AnchoredFragment (HeaderWithTime blk))
     -- | Whether the last message sent by the peer was MsgAwaitReply.
     --
     -- This ChainSync client should ensure that its peer sets this flag while
@@ -183,12 +183,12 @@ deriving anyclass instance
 data JumpInfo blk = JumpInfo
   { jMostRecentIntersection  :: !(Point blk)
   , jOurFragment             :: !(AnchoredFragment (Header blk))
-  , jTheirFragment           :: !(AnchoredFragment (Header blk))
+  , jTheirFragment           :: !(AnchoredFragment (HeaderWithTime blk))
   , jTheirHeaderStateHistory :: !(HeaderStateHistory blk)
   }
   deriving (Generic)
 
-instance (HasHeader (Header blk)) => Eq (JumpInfo blk) where
+instance (HasHeader (Header blk), Typeable blk) => Eq (JumpInfo blk) where
   (==) = (==) `on` headPoint . jTheirFragment
 
 instance LedgerSupportsProtocol blk => NoThunks (JumpInfo blk) where
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 d905d6b240..09ee02b6dc 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
@@ -72,6 +72,7 @@ import           GHC.Generics (Generic)
 import           Ouroboros.Consensus.Block
 import           Ouroboros.Consensus.HeaderStateHistory
                      (HeaderStateHistory (..))
+import           Ouroboros.Consensus.HeaderValidation (HeaderWithTime (..))
 import           Ouroboros.Consensus.Ledger.Abstract
 import           Ouroboros.Consensus.Ledger.Extended
 import           Ouroboros.Consensus.Ledger.SupportsProtocol
@@ -177,6 +178,14 @@ data ChainDB m blk = ChainDB {
       -- fragment will move as the chain grows.
     , getCurrentChain    :: STM m (AnchoredFragment (Header blk))
 
+      -- | Exact same as 'getCurrentChain', except each header is annotated
+      -- with the 'RelativeTime' of the onset of its slot (translated according
+      -- to the chain it is on)
+      --
+      -- INVARIANT @'hwtHeader' <$> 'getCurrentChainWithTime' = 'getCurrentChain'@
+    , getCurrentChainWithTime
+                         :: STM m (AnchoredFragment (HeaderWithTime blk))
+
       -- | Return the LedgerDB containing the last @k@ ledger states.
     , getLedgerDB        :: STM m (LedgerDB' blk)
 
@@ -891,4 +900,4 @@ data LoE a =
 -- | Get the current LoE fragment (if the LoE is enabled), see 'LoE' for more
 -- details. This fragment must be anchored in a (recent) point on the immutable
 -- chain, just like candidate fragments.
-type GetLoEFragment m blk = m (LoE (AnchoredFragment (Header blk)))
+type GetLoEFragment m blk = m (LoE (AnchoredFragment (HeaderWithTime blk)))
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 87dca9f1f4..861eeb886b 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
@@ -46,8 +46,11 @@ import qualified Data.Map.Strict as Map
 import           Data.Maybe.Strict (StrictMaybe (..))
 import           GHC.Stack (HasCallStack)
 import           Ouroboros.Consensus.Block
+import           Ouroboros.Consensus.Config
 import qualified Ouroboros.Consensus.Fragment.Validated as VF
 import           Ouroboros.Consensus.HardFork.Abstract
+import           Ouroboros.Consensus.HeaderValidation (mkHeaderWithTime)
+import           Ouroboros.Consensus.Ledger.Extended (ledgerState)
 import           Ouroboros.Consensus.Ledger.Inspect
 import           Ouroboros.Consensus.Ledger.SupportsProtocol
 import           Ouroboros.Consensus.Storage.ChainDB.API (ChainDB)
@@ -162,8 +165,20 @@ openDBInternal args launchBgTasks = runWithTempRegistry $ do
       let chain  = VF.validatedFragment chainAndLedger
           ledger = VF.validatedLedger   chainAndLedger
 
+          lcfg = configLedger (Args.cdbsTopLevelConfig cdbSpecificArgs)
+
+          -- the tip ledger state can translate the slots of the volatile
+          -- headers
+          chainWithTime =
+            AF.mapAnchoredFragment
+              (mkHeaderWithTime
+                 lcfg
+                 (ledgerState (LgrDB.ledgerDbCurrent ledger))
+              )
+              chain
+
       atomically $ LgrDB.setCurrent lgrDB ledger
-      varChain           <- newTVarIO chain
+      varChain           <- newTVarWithInvariantIO checkInternalChain $ InternalChain chain chainWithTime
       varTentativeState  <- newTVarIO $ initialTentativeHeaderState (Proxy @blk)
       varTentativeHeader <- newTVarIO SNothing
       varIterators       <- newTVarIO Map.empty
@@ -202,6 +217,8 @@ openDBInternal args launchBgTasks = runWithTempRegistry $ do
             { addBlockAsync         = getEnv2    h ChainSel.addBlockAsync
             , chainSelAsync         = getEnv     h ChainSel.triggerChainSelectionAsync
             , getCurrentChain       = getEnvSTM  h Query.getCurrentChain
+            , getCurrentChainWithTime
+                                    = getEnvSTM  h Query.getCurrentChainWithTime
             , getLedgerDB           = getEnvSTM  h Query.getLedgerDB
             , getHeaderStateHistory = getEnvSTM  h Query.getHeaderStateHistory
             , getTipBlock           = getEnv     h Query.getTipBlock
@@ -290,7 +307,7 @@ closeDB (CDBHandle varState) = do
       ImmutableDB.closeDB cdbImmutableDB
       VolatileDB.closeDB cdbVolatileDB
 
-      chain <- atomically $ readTVar cdbChain
+      chain <- atomically $ icWithoutTime <$> readTVar cdbChain
 
       traceWith cdbTracer $ TraceOpenEvent $ ClosedDB
         (castPoint $ AF.anchorPoint chain)
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/Background.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/Background.hs
index aab651ccb1..26327df1c3 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/Background.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/Background.hs
@@ -132,7 +132,7 @@ copyToImmutableDB ::
   -> Electric m (WithOrigin SlotNo)
 copyToImmutableDB CDB{..} = electric $ do
     toCopy <- atomically $ do
-      curChain <- readTVar cdbChain
+      curChain <- icWithoutTime <$> readTVar cdbChain
       let nbToCopy = max 0 (AF.length curChain - fromIntegral k)
           toCopy :: [Point blk]
           toCopy = map headerPoint
@@ -179,12 +179,11 @@ copyToImmutableDB CDB{..} = electric $ do
     removeFromChain :: Point blk -> STM m ()
     removeFromChain pt = do
       -- The chain might have been extended in the meantime.
-      curChain <- readTVar cdbChain
-      case curChain of
-        hdr :< curChain'
+      readTVar cdbChain >>= \case
+        InternalChain (hdr :< newChain) (_hwt :< newChainWithTime)
           | headerPoint hdr == pt
-          -> writeTVar cdbChain curChain'
-        -- We're the only one removing things from 'curChain', so this cannot
+          -> writeTVar cdbChain $ InternalChain newChain newChainWithTime
+        -- We're the only one removing things from 'cdbChain', so this cannot
         -- happen if the precondition was satisfied.
         _ -> error "header to remove not on the current chain"
 
@@ -243,7 +242,7 @@ copyAndSnapshotRunner cdb@CDB{..} gcSchedule replayed fuse =
     loop mPrevSnapshot distance = do
       -- Wait for the chain to grow larger than @k@
       numToWrite <- atomically $ do
-        curChain <- readTVar cdbChain
+        curChain <- icWithoutTime <$> readTVar cdbChain
         check $ fromIntegral (AF.length curChain) > k
         return $ fromIntegral (AF.length curChain) - k
 
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 2a25cfcdd1..9bc9ef2855 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
@@ -6,6 +6,7 @@
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE UndecidableInstances #-}
 
 -- | Operations involving chain selection: the initial chain selection and
@@ -50,6 +51,8 @@ import           Ouroboros.Consensus.Fragment.ValidatedDiff
 import qualified Ouroboros.Consensus.Fragment.ValidatedDiff as ValidatedDiff
 import           Ouroboros.Consensus.HardFork.Abstract
 import qualified Ouroboros.Consensus.HardFork.History as History
+import           Ouroboros.Consensus.HeaderValidation (HeaderWithTime (..),
+                     mkHeaderWithTime)
 import           Ouroboros.Consensus.Ledger.Abstract
 import           Ouroboros.Consensus.Ledger.Extended
 import           Ouroboros.Consensus.Ledger.Inspect
@@ -521,6 +524,8 @@ chainSelectionForBlock cdb@CDB{..} blockCache hdr punish = electric $ do
       -- Trim the LoE fragment to be anchored in the immutable tip, ie the
       -- anchor of @curChain@. In particular, this establishes the property that
       -- it intersects with the current chain.
+      sanitizeLoEFrag :: AnchoredFragment (HeaderWithTime blk)
+                      -> AnchoredFragment (HeaderWithTime blk)
       sanitizeLoEFrag loeFrag0 =
         case AF.splitAfterPoint loeFrag0 (AF.anchorPoint curChain) of
             Just (_, frag) -> frag
@@ -529,11 +534,12 @@ chainSelectionForBlock cdb@CDB{..} blockCache hdr punish = electric $ do
             -- chain. This can temporarily be the case; we are conservative and
             -- use the empty fragment anchored at the immutable tip for chain
             -- selection.
-            Nothing        -> AF.Empty (AF.anchor curChain)
+            Nothing        ->  AF.Empty $ AF.castAnchor $ AF.anchor curChain
 
     loeFrag <- fmap sanitizeLoEFrag <$> cdbLoE
 
-    traceWith addBlockTracer (ChainSelectionLoEDebug curChain loeFrag)
+    traceWith addBlockTracer
+      (ChainSelectionLoEDebug curChain (AF.mapAnchoredFragment hwtHeader <$> loeFrag))
 
     if
       -- The chain might have grown since we added the block such that the
@@ -611,7 +617,7 @@ chainSelectionForBlock cdb@CDB{..} blockCache hdr punish = electric $ do
       => (ChainHash blk -> Set (HeaderHash blk))
       -> ChainAndLedger blk
          -- ^ The current chain and ledger
-      -> LoE (AnchoredFragment (Header blk))
+      -> LoE (AnchoredFragment (HeaderWithTime blk))
          -- ^ LoE fragment
       -> m ()
     addToCurrentChain succsOf curChainAndLedger loeFrag = do
@@ -689,7 +695,8 @@ chainSelectionForBlock cdb@CDB{..} blockCache hdr punish = electric $ do
     -- 1. The given 'ChainDiff' can apply on top of the given 'ChainAndLedger'.
     -- 2. The LoE fragment intersects with the current selection.
     trimToLoE ::
-      LoE (AnchoredFragment (Header blk)) ->
+      (HasHeader blk', HeaderHash blk ~ HeaderHash blk') =>
+      LoE (AnchoredFragment blk') ->
       ChainAndLedger blk ->
       ChainDiff (Header blk) ->
       ChainDiff (Header blk)
@@ -720,7 +727,7 @@ chainSelectionForBlock cdb@CDB{..} blockCache hdr punish = electric $ do
       -> LookupBlockInfo blk
       -> ChainAndLedger blk
          -- ^ The current chain (anchored at @i@) and ledger
-      -> LoE (AnchoredFragment (Header blk))
+      -> LoE (AnchoredFragment (HeaderWithTime blk))
          -- ^ LoE fragment
       -> ChainDiff (HeaderFields blk)
          -- ^ Header fields for @(x,b]@
@@ -837,14 +844,30 @@ chainSelectionForBlock cdb@CDB{..} blockCache hdr punish = electric $ do
           $ getSuffix
           $ getChainDiff vChainDiff
         (curChain, newChain, events, prevTentativeHeader) <- atomically $ do
-          curChain  <- readTVar         cdbChain -- Not Query.getCurrentChain!
+          InternalChain curChain curChainWithTime <- readTVar cdbChain
+             -- Not Query.getCurrentChain!
           curLedger <- LgrDB.getCurrent cdbLgrDB
           case Diff.apply curChain chainDiff of
             -- Impossible, as described in the docstring
             Nothing       ->
               error "chainDiff doesn't fit onto current chain"
             Just newChain -> do
-              writeTVar cdbChain newChain
+              let lcfg             = configLedger cdbTopLevelConfig
+                  diffWithTime     =
+                    -- the new ledger state can translate the slots of the new
+                    -- headers
+                    Diff.map
+                      (mkHeaderWithTime
+                         lcfg
+                         (ledgerState (LgrDB.ledgerDbCurrent newLedger))
+                      )
+                      chainDiff
+                  newChainWithTime =
+                    case Diff.apply curChainWithTime diffWithTime of
+                      Nothing -> error "chainDiff failed for HeaderWithTime"
+                      Just x  -> x
+
+              writeTVar        cdbChain $ InternalChain newChain newChainWithTime
               LgrDB.setCurrent cdbLgrDB newLedger
 
               -- Inspect the new ledger for potential problems
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/Follower.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/Follower.hs
index 8f6366e3f9..9dfd317cb3 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/Follower.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/Follower.hs
@@ -272,7 +272,7 @@ instructionHelper registry varFollower chainType blockComponent fromMaybeSTM CDB
     trace = traceWith (contramap TraceFollowerEvent cdbTracer)
 
     getCurrentChainByType = do
-        curChain <- readTVar cdbChain
+        curChain <- icWithoutTime <$> readTVar cdbChain
         case chainType of
           SelectedChain  -> pure curChain
           TentativeChain -> readTVar cdbTentativeHeader <&> \case
@@ -434,7 +434,7 @@ forward registry varFollower blockComponent CDB{..} = \pts -> do
     -- that happen to have not yet been copied over to the ImmutableDB.
     join $ atomically $
       findFirstPointOnChain
-        <$> readTVar cdbChain
+        <$> (icWithoutTime <$> readTVar cdbChain)
         <*> readTVar varFollower
         <*> ImmutableDB.getTipSlot cdbImmutableDB
         <*> pure pts
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 5bea8cd37c..dd39ad9b77 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
@@ -9,6 +9,7 @@ module Ouroboros.Consensus.Storage.ChainDB.Impl.Query (
     -- * Queries
     getBlockComponent
   , getCurrentChain
+  , getCurrentChainWithTime
   , getHeaderStateHistory
   , getIsFetched
   , getIsInvalidBlock
@@ -31,7 +32,8 @@ import           Ouroboros.Consensus.Config
 import           Ouroboros.Consensus.HardFork.Abstract (HasHardForkHistory (..))
 import           Ouroboros.Consensus.HeaderStateHistory
                      (HeaderStateHistory (..), mkHeaderStateWithTimeFromSummary)
-import           Ouroboros.Consensus.HeaderValidation (HasAnnTip)
+import           Ouroboros.Consensus.HeaderValidation (HasAnnTip,
+                     HeaderWithTime)
 import           Ouroboros.Consensus.Ledger.Abstract (IsLedger, LedgerState)
 import           Ouroboros.Consensus.Ledger.Extended
 import           Ouroboros.Consensus.Protocol.Abstract
@@ -75,7 +77,21 @@ getCurrentChain ::
   => ChainDbEnv m blk
   -> STM m (AnchoredFragment (Header blk))
 getCurrentChain CDB{..} =
-    AF.anchorNewest k <$> readTVar cdbChain
+    AF.anchorNewest k . icWithoutTime <$> readTVar cdbChain
+  where
+    SecurityParam k = configSecurityParam cdbTopLevelConfig
+
+-- | Same as 'getCurrentChain', /mutatis mutandi/.
+getCurrentChainWithTime ::
+     forall m blk.
+     ( IOLike m
+     , HasHeader (HeaderWithTime blk)
+     , ConsensusProtocol (BlockProtocol blk)
+     )
+  => ChainDbEnv m blk
+  -> STM m (AnchoredFragment (HeaderWithTime blk))
+getCurrentChainWithTime CDB{..} =
+    AF.anchorNewest k . icWithTime <$> readTVar cdbChain
   where
     SecurityParam k = configSecurityParam cdbTopLevelConfig
 
@@ -132,7 +148,7 @@ getTipHeader ::
   => ChainDbEnv m blk
   -> m (Maybe (Header blk))
 getTipHeader CDB{..} = do
-    anchorOrHdr <- AF.head <$> atomically (readTVar cdbChain)
+    anchorOrHdr <- AF.head . icWithoutTime <$> atomically (readTVar cdbChain)
     case anchorOrHdr of
       Right hdr   -> return $ Just hdr
       Left anchor ->
@@ -151,7 +167,7 @@ getTipPoint ::
      forall m blk. (IOLike m, HasHeader (Header blk))
   => ChainDbEnv m blk -> STM m (Point blk)
 getTipPoint CDB{..} =
-    (castPoint . AF.headPoint) <$> readTVar cdbChain
+    (castPoint . AF.headPoint . icWithoutTime) <$> readTVar cdbChain
 
 getBlockComponent ::
      forall m blk b. IOLike m
@@ -209,7 +225,7 @@ getMaxSlotNo CDB{..} = do
     -- contains block 9'. The ImmutableDB contains blocks 1-10. The max slot
     -- of the current chain will be 10 (being the anchor point of the empty
     -- current chain), while the max slot of the VolatileDB will be 9.
-    curChainMaxSlotNo <- maxSlotNoFromWithOrigin . AF.headSlot
+    curChainMaxSlotNo <- maxSlotNoFromWithOrigin . AF.headSlot . icWithoutTime
                      <$> readTVar cdbChain
     volatileDbMaxSlotNo    <- VolatileDB.getMaxSlotNo cdbVolatileDB
     return $ curChainMaxSlotNo `max` volatileDbMaxSlotNo
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 2eaaad37aa..b1da48d951 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
@@ -11,6 +11,8 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE UndecidableInstances #-}
 
 -- | Types used throughout the implementation: handle, state, environment,
@@ -28,6 +30,8 @@ module Ouroboros.Consensus.Storage.ChainDB.Impl.Types (
   , getEnvSTM1
     -- * Exposed internals for testing purposes
   , Internal (..)
+  , InternalChain (..)
+  , checkInternalChain
     -- * Iterator-related
   , IteratorKey (..)
     -- * Follower-related
@@ -77,6 +81,7 @@ import           NoThunks.Class (OnlyCheckWhnfNamed (..))
 import           Ouroboros.Consensus.Block
 import           Ouroboros.Consensus.Config
 import           Ouroboros.Consensus.Fragment.Diff (ChainDiff)
+import           Ouroboros.Consensus.HeaderValidation (HeaderWithTime (..))
 import           Ouroboros.Consensus.Ledger.Extended (ExtValidationError)
 import           Ouroboros.Consensus.Ledger.Inspect
 import           Ouroboros.Consensus.Ledger.SupportsProtocol
@@ -104,6 +109,7 @@ import           Ouroboros.Consensus.Util.Enclose (Enclosing, Enclosing' (..))
 import           Ouroboros.Consensus.Util.IOLike
 import           Ouroboros.Consensus.Util.STM (WithFingerprint)
 import           Ouroboros.Network.AnchoredFragment (AnchoredFragment)
+import qualified Ouroboros.Network.AnchoredFragment as AF
 import           Ouroboros.Network.Block (MaxSlotNo)
 
 -- | All the serialisation related constraints needed by the ChainDB.
@@ -166,11 +172,49 @@ data ChainDbState m blk
   | ChainDbClosed
   deriving (Generic, NoThunks)
 
+-- | The current chain, both without and with slot times
+--
+-- INVARIANT @'AF.mapAnchoredFragment' 'hwtHeader' . 'icWithTime' = 'icWithoutTime'@
+--
+-- The fragment with times is maintained separately --- but exactly in parallel
+-- --- for performance reasons and modularity reasons, trading a few thousand
+-- pointers to avoid extra allocation per use, more granular interfaces
+-- (notably
+-- 'Ouroboros.Network.BlockFetch.ConsensusInterface.BlockFetchConsensusInterface'),
+-- etc.
+data InternalChain blk = InternalChain
+  { icWithoutTime :: !(AnchoredFragment (Header         blk))
+  , icWithTime    :: !(AnchoredFragment (HeaderWithTime blk))
+  }
+  deriving (Generic)
+
+deriving instance (HasHeader blk, NoThunks (Header blk)) => NoThunks (InternalChain blk)
+
+checkInternalChain ::
+     forall blk. (HasHeader blk, HasHeader (Header blk))
+  => InternalChain blk
+  -> Maybe String
+checkInternalChain (InternalChain cur curWithTime) =
+    if cnv id cur == cnv hwtHeader curWithTime then Nothing else
+    Just $ unlines
+      [ "cdbChain and cdbChainWithTime were out of sync:"
+      , show (cnv id cur)
+      , show (cnv hwtHeader curWithTime)
+      ]
+  where
+    cnv ::
+         (HeaderHash h ~ HeaderHash blk)
+      => (h -> Header blk) -> AnchoredFragment h -> (Point blk, [Point blk])
+    cnv f af =
+      ( castPoint $ AF.anchorPoint af
+      , (headerPoint . f) `map` AF.toNewestFirst af
+      )
+
 data ChainDbEnv m blk = CDB
   { cdbImmutableDB     :: !(ImmutableDB m blk)
   , cdbVolatileDB      :: !(VolatileDB m blk)
   , cdbLgrDB           :: !(LgrDB m blk)
-  , cdbChain           :: !(StrictTVar m (AnchoredFragment (Header blk)))
+  , cdbChain           :: !(StrictTVar m (InternalChain blk))
     -- ^ Contains the current chain fragment.
     --
     -- INVARIANT: the anchor point of this fragment is the tip of the
@@ -247,7 +291,7 @@ data ChainDbEnv m blk = CDB
     -- ^ A handle to kill the background threads.
   , cdbChainSelQueue   :: !(ChainSelQueue m blk)
     -- ^ Queue of blocks that still have to be added.
-  , cdbLoE             :: !(m (LoE (AnchoredFragment (Header blk))))
+  , cdbLoE             :: !(m (LoE (AnchoredFragment (HeaderWithTime blk))))
     -- ^ Configure the Limit on Eagerness. If this is 'LoEEnabled', it contains
     -- an action that returns the LoE fragment, which indicates the latest rollback
     -- point, i.e. we are not allowed to select a chain from which we could not
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Util/AnchoredFragment.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Util/AnchoredFragment.hs
index a08d3bdc5c..87494bd549 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Util/AnchoredFragment.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Util/AnchoredFragment.hs
@@ -1,4 +1,6 @@
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
 
 -- | Utility functions on anchored fragments
 --
@@ -79,10 +81,15 @@ forksAtMostKBlocks k ours theirs = case ours `AF.intersect` theirs of
 -- these fragments intersect with our current chain, they must by transitivity
 -- also intersect each other.
 compareAnchoredFragments ::
-     forall blk. (BlockSupportsProtocol blk, HasCallStack)
+     forall blk h.
+     ( BlockSupportsProtocol blk
+     , HasCallStack
+     , GetHeader1 h
+     , HasHeader (h blk)
+     )
   => BlockConfig blk
-  -> AnchoredFragment (Header blk)
-  -> AnchoredFragment (Header blk)
+  -> AnchoredFragment (h blk)
+  -> AnchoredFragment (h blk)
   -> Ordering
 compareAnchoredFragments cfg frag1 frag2 =
     assertWithMsg (precondition frag1 frag2) $
@@ -98,19 +105,19 @@ compareAnchoredFragments cfg frag1 frag2 =
         -- fragments represent the same chain and are equally preferable. If
         -- not, the second chain is a strict extension of the first and is
         -- therefore strictly preferable.
-        if blockPoint tip' == AF.anchorToPoint anchor
+        if blockPoint tip' == AF.castPoint (AF.anchorToPoint anchor)
           then EQ
           else LT
       (_ :> tip, Empty anchor') ->
         -- This case is symmetric to the previous
-        if blockPoint tip == AF.anchorToPoint anchor'
+        if blockPoint tip == AF.castPoint (AF.anchorToPoint anchor')
           then EQ
           else GT
       (_ :> tip, _ :> tip') ->
         -- Case 4
         compare
-          (selectView cfg tip)
-          (selectView cfg tip')
+          (selectView cfg (getHeader1 tip ))
+          (selectView cfg (getHeader1 tip'))
 
 -- | Lift 'preferCandidate' to 'AnchoredFragment'
 --
@@ -123,28 +130,39 @@ compareAnchoredFragments cfg frag1 frag2 =
 -- from our tip, although the exact distance does not matter for
 -- 'compareAnchoredFragments').
 preferAnchoredCandidate ::
-     forall blk. (BlockSupportsProtocol blk, HasCallStack)
+     forall blk h h'.
+     ( BlockSupportsProtocol blk
+     , HasCallStack
+     , GetHeader1 h
+     , GetHeader1 h'
+     , HeaderHash (h blk) ~ HeaderHash (h' blk)
+     , HasHeader (h  blk)
+     , HasHeader (h' blk)
+     )
   => BlockConfig blk
-  -> AnchoredFragment (Header blk)      -- ^ Our chain
-  -> AnchoredFragment (Header blk)      -- ^ Candidate
+  -> AnchoredFragment (h  blk) -- ^ Our chain
+  -> AnchoredFragment (h' blk) -- ^ Candidate
   -> Bool
 preferAnchoredCandidate cfg ours cand =
     assertWithMsg (precondition ours cand) $
     case (ours, cand) of
       (_, Empty _) -> False
       (Empty ourAnchor, _ :> theirTip) ->
-        blockPoint theirTip /= AF.anchorToPoint ourAnchor
+        blockPoint theirTip /= castPoint (AF.anchorToPoint ourAnchor)
       (_ :> ourTip, _ :> theirTip) ->
         preferCandidate
           (projectChainOrderConfig cfg)
-          (selectView cfg ourTip)
-          (selectView cfg theirTip)
+          (selectView cfg (getHeader1 ourTip))
+          (selectView cfg (getHeader1 theirTip))
 
 -- For 'compareAnchoredFragment' and 'preferAnchoredCandidate'.
 precondition ::
-     GetHeader blk
-  => AnchoredFragment (Header blk)
-  -> AnchoredFragment (Header blk)
+     ( HeaderHash (h blk) ~ HeaderHash (h' blk)
+     , HasHeader (h  blk)
+     , HasHeader (h' blk)
+     )
+  => AnchoredFragment (h  blk)
+  -> AnchoredFragment (h' blk)
   -> Either String ()
 precondition frag1 frag2
   | not (AF.null frag1), not (AF.null frag2)
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Util/Orphans.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Util/Orphans.hs
index 06c2757d52..3f1ff1b92f 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Util/Orphans.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Util/Orphans.hs
@@ -19,14 +19,11 @@ import           Cardano.Ledger.Genesis (NoGenesis (..))
 import           Codec.CBOR.Decoding (Decoder)
 import           Codec.Serialise (Serialise (..))
 import           Control.Tracer (Tracer)
-import           Data.Bimap (Bimap)
-import qualified Data.Bimap as Bimap
 import           Data.IntPSQ (IntPSQ)
 import qualified Data.IntPSQ as PSQ
 import           Data.SOP.BasicFunctors
 import           NoThunks.Class (InspectHeap (..), InspectHeapNamed (..),
-                     NoThunks (..), OnlyCheckWhnfNamed (..), allNoThunks,
-                     noThunksInKeysAndValues)
+                     NoThunks (..), OnlyCheckWhnfNamed (..), allNoThunks)
 import           Ouroboros.Network.Util.ShowProxy
 import           System.FS.API (SomeHasFS)
 import           System.FS.API.Types (FsPath, Handle)
@@ -50,10 +47,6 @@ instance NoThunks (NoGenesis era) where
   showTypeOf _ = "NoGenesis"
   wNoThunks _ NoGenesis = return Nothing
 
-instance (NoThunks k, NoThunks v)
-      => NoThunks (Bimap k v) where
-  wNoThunks ctxt = noThunksInKeysAndValues ctxt . Bimap.toList
-
 instance ( NoThunks p
          , NoThunks v
          , Ord p
diff --git a/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/HeaderValidation.hs b/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/HeaderValidation.hs
new file mode 100644
index 0000000000..841df67fef
--- /dev/null
+++ b/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/HeaderValidation.hs
@@ -0,0 +1,52 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+
+module Test.Util.HeaderValidation (
+    -- * Enriching headers with a relative slot time
+    attachSlotTime
+  , attachSlotTimeToFragment
+  , dropTimeFromFragment
+  ) where
+
+import           Cardano.Slotting.EpochInfo.API (epochInfoSlotToRelativeTime)
+import           Data.Functor.Identity (runIdentity)
+import           Data.Typeable (Typeable)
+import           Ouroboros.Consensus.Block (Header, blockSlot)
+import           Ouroboros.Consensus.Config (TopLevelConfig)
+import           Ouroboros.Consensus.HardFork.Combinator.Abstract
+                     (ImmutableEraParams, immutableEpochInfo)
+import           Ouroboros.Consensus.HeaderValidation (HeaderWithTime (..))
+import           Ouroboros.Network.AnchoredFragment (AnchoredFragment)
+import qualified Ouroboros.Network.AnchoredFragment as AF
+
+{-------------------------------------------------------------------------------
+  Enriching headers with a relative slot time
+-------------------------------------------------------------------------------}
+
+dropTimeFromFragment :: (AF.HasHeader (Header blk))
+  => AnchoredFragment (HeaderWithTime blk)
+  -> AnchoredFragment (Header blk)
+dropTimeFromFragment  = AF.mapAnchoredFragment hwtHeader
+
+attachSlotTimeToFragment ::
+     ( AF.HasHeader (Header blk)
+     , Typeable blk
+     , ImmutableEraParams blk)
+  => TopLevelConfig blk
+  -> AnchoredFragment (Header blk)
+  -> AnchoredFragment (HeaderWithTime blk)
+attachSlotTimeToFragment cfg = AF.mapAnchoredFragment (attachSlotTime cfg)
+
+attachSlotTime ::
+     (AF.HasHeader (Header blk), ImmutableEraParams blk)
+  => TopLevelConfig blk
+  -> Header blk
+  -> HeaderWithTime blk
+attachSlotTime cfg hdr = HeaderWithTime {
+      hwtHeader           = hdr
+    , hwtSlotRelativeTime =
+        runIdentity $ epochInfoSlotToRelativeTime ei (blockSlot hdr)
+    }
+  where
+    ei = immutableEpochInfo cfg
diff --git a/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/TestBlock.hs b/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/TestBlock.hs
index 5ed7674f03..5560097ee5 100644
--- a/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/TestBlock.hs
+++ b/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/TestBlock.hs
@@ -114,6 +114,8 @@ import           Ouroboros.Consensus.BlockchainTime
 import           Ouroboros.Consensus.Config
 import           Ouroboros.Consensus.Forecast
 import           Ouroboros.Consensus.HardFork.Abstract
+import           Ouroboros.Consensus.HardFork.Combinator.Abstract
+                     (ImmutableEraParams (immutableEraParams))
 import qualified Ouroboros.Consensus.HardFork.History as HardFork
 import           Ouroboros.Consensus.HeaderValidation
 import           Ouroboros.Consensus.Ledger.Abstract
@@ -304,7 +306,7 @@ newtype instance Header (TestBlockWith ptype) =
 
 instance Typeable ptype => ShowProxy (Header (TestBlockWith ptype)) where
 
-instance (Typeable ptype, Eq ptype) => HasHeader (Header (TestBlockWith ptype)) where
+instance Typeable ptype => HasHeader (Header (TestBlockWith ptype)) where
   getHeaderFields (TestHeader TestBlockWith{..}) = HeaderFields {
         headerFieldHash    = tbHash
       , headerFieldSlot    = tbSlot
@@ -630,6 +632,9 @@ singleNodeTestConfigWith codecConfig storageConfig k genesisWindow = TopLevelCon
       tblcForecastRange = SNothing
     }
 
+instance ImmutableEraParams (TestBlockWith ptype) where
+    immutableEraParams = tblcHardForkParams . topLevelConfigLedger
+
 {-------------------------------------------------------------------------------
   Test blocks without payload
 -------------------------------------------------------------------------------}
diff --git a/ouroboros-consensus/test/consensus-test/Test/Consensus/MiniProtocol/BlockFetch/Client.hs b/ouroboros-consensus/test/consensus-test/Test/Consensus/MiniProtocol/BlockFetch/Client.hs
index c03639a6bb..ff26c53cf6 100644
--- a/ouroboros-consensus/test/consensus-test/Test/Consensus/MiniProtocol/BlockFetch/Client.hs
+++ b/ouroboros-consensus/test/consensus-test/Test/Consensus/MiniProtocol/BlockFetch/Client.hs
@@ -39,6 +39,7 @@ import           Network.TypedProtocol.Core (PeerRole (..))
 import qualified Network.TypedProtocol.Driver.Simple as Driver
 import           Ouroboros.Consensus.Block
 import           Ouroboros.Consensus.Config
+import           Ouroboros.Consensus.HeaderValidation (HeaderWithTime)
 import qualified Ouroboros.Consensus.MiniProtocol.BlockFetch.ClientInterface as BlockFetchClientInterface
 import           Ouroboros.Consensus.Node.ProtocolInfo (NumCoreNodes (..))
 import qualified Ouroboros.Consensus.Storage.ChainDB.API as ChainDB
@@ -72,6 +73,7 @@ import           Test.Tasty
 import           Test.Tasty.QuickCheck
 import           Test.Util.ChainDB
 import           Test.Util.ChainUpdates
+import           Test.Util.HeaderValidation (attachSlotTime)
 import qualified Test.Util.LogicalClock as LogicalClock
 import           Test.Util.LogicalClock (Tick (..))
 import           Test.Util.Orphans.IOLike ()
@@ -138,7 +140,10 @@ runBlockFetchTest BlockFetchClientTestSetup{..} = withRegistry \registry -> do
 
         blockFetchConsensusInterface =
           mkTestBlockFetchConsensusInterface
-            (Map.map (AF.mapAnchoredFragment getHeader) <$> getCandidates)
+            (Map.map
+                 (AF.mapAnchoredFragment (attachSlotTime topLevelConfig . getHeader))
+             <$> getCandidates
+            )
             chainDbView
 
     _ <- forkLinkedThread registry "BlockFetchLogic" $
@@ -230,6 +235,11 @@ runBlockFetchTest BlockFetchClientTestSetup{..} = withRegistry \registry -> do
 
     numCoreNodes = NumCoreNodes $ fromIntegral $ Map.size peerUpdates + 1
 
+    -- Needs to be larger than any chain length in this test, to ensure that
+    -- switching to any chain is never too deep.
+    securityParam  = SecurityParam 1000
+    topLevelConfig = singleNodeTestConfigWithK securityParam
+
     mkChainDbView ::
          ResourceRegistry m
       -> Tracer m String
@@ -255,26 +265,21 @@ runBlockFetchTest BlockFetchClientTestSetup{..} = withRegistry \registry -> do
         let -- Always return the empty chain such that the BlockFetch logic
             -- downloads all chains.
             getCurrentChain           = pure $ AF.Empty AF.AnchorGenesis
+            getCurrentChainWithTime   = pure $ AF.Empty AF.AnchorGenesis
             getIsFetched              = ChainDB.getIsFetched chainDB
             getMaxSlotNo              = ChainDB.getMaxSlotNo chainDB
             addBlockWaitWrittenToDisk = ChainDB.addBlockWaitWrittenToDisk chainDB
         pure BlockFetchClientInterface.ChainDbView {..}
       where
-        -- Needs to be larger than any chain length in this test, to ensure that
-        -- switching to any chain is never too deep.
-        securityParam  = SecurityParam 1000
-        topLevelConfig = singleNodeTestConfigWithK securityParam
-
         cdbTracer = Tracer \case
             ChainDBImpl.TraceAddBlockEvent ev ->
               traceWith tracer $ "ChainDB: " <> show ev
             _ -> pure ()
 
-
     mkTestBlockFetchConsensusInterface ::
-         STM m (Map PeerId (AnchoredFragment (Header TestBlock)))
+         STM m (Map PeerId (AnchoredFragment (HeaderWithTime TestBlock)))
       -> BlockFetchClientInterface.ChainDbView m TestBlock
-      -> BlockFetchConsensusInterface PeerId (Header TestBlock) TestBlock m
+      -> BlockFetchConsensusInterface PeerId (HeaderWithTime TestBlock) TestBlock m
     mkTestBlockFetchConsensusInterface getCandidates chainDbView =
         BlockFetchClientInterface.mkBlockFetchConsensusInterface
           (TestBlockConfig numCoreNodes)
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 60c5ebdc31..8f3226766e 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
@@ -128,6 +128,7 @@ import           Test.Tasty
 import           Test.Tasty.QuickCheck
 import           Test.Util.ChainUpdates (ChainUpdate (..), UpdateBehavior (..),
                      genChainUpdates, toChainUpdates)
+import           Test.Util.HeaderValidation (dropTimeFromFragment)
 import           Test.Util.LogicalClock (Tick (..))
 import           Test.Util.Orphans.Arbitrary ()
 import           Test.Util.Orphans.IOLike ()
@@ -588,7 +589,7 @@ runChainSync skew securityParam (ClientUpdates clientUpdates)
           finalClientChain
         , finalServerChain
         , mbResult
-        , syncedFragment   = AF.mapAnchoredFragment testHeader candidateFragment
+        , syncedFragment   = AF.mapAnchoredFragment testHeader (dropTimeFromFragment candidateFragment)
         , traceEvents
         }
   where
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 eed9f661ea..d8737209b7 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
@@ -97,6 +97,8 @@ import           NoThunks.Class (AllowThunk (..))
 import           Ouroboros.Consensus.Block
 import           Ouroboros.Consensus.Config
 import           Ouroboros.Consensus.HardFork.Abstract
+import           Ouroboros.Consensus.HardFork.Combinator.Abstract
+                     (ImmutableEraParams)
 import           Ouroboros.Consensus.HeaderValidation
 import           Ouroboros.Consensus.Ledger.Abstract
 import           Ouroboros.Consensus.Ledger.Extended
@@ -143,6 +145,7 @@ import           Test.Tasty (TestTree, testGroup)
 import           Test.Tasty.QuickCheck (testProperty)
 import           Test.Util.ChainDB
 import           Test.Util.ChunkInfo
+import           Test.Util.HeaderValidation (attachSlotTimeToFragment)
 import           Test.Util.Orphans.Arbitrary ()
 import           Test.Util.Orphans.ToExpr ()
 import           Test.Util.QuickCheck
@@ -314,6 +317,7 @@ type TestConstraints blk =
   , ConvertRawHash                    blk
   , HasHardForkHistory                blk
   , SerialiseDiskConstraints          blk
+  , ImmutableEraParams                blk
   )
 
 deriving instance (TestConstraints blk, Eq   it, Eq   flr)
@@ -347,7 +351,7 @@ data ChainDBEnv m blk = ChainDBEnv {
   , varVolatileDbFs :: StrictTMVar m MockFS
   , args            :: ChainDbArgs Identity m blk
     -- ^ Needed to reopen a ChainDB, i.e., open a new one.
-  , varLoEFragment  :: StrictTVar m (AnchoredFragment (Header blk))
+  , varLoEFragment  :: StrictTVar m (AnchoredFragment (HeaderWithTime blk))
   }
 
 open ::
@@ -374,10 +378,11 @@ close ChainDBState { chainDB, addBlockAsync } = do
 
 run :: forall m blk.
        (IOLike m, TestConstraints blk)
-    => ChainDBEnv m blk
-    ->    Cmd     blk (TestIterator m blk) (TestFollower m blk)
-    -> m (Success blk (TestIterator m blk) (TestFollower m blk))
-run env@ChainDBEnv { varDB, .. } cmd =
+    => TopLevelConfig blk
+    -> ChainDBEnv m   blk
+    ->    Cmd         blk (TestIterator m blk) (TestFollower m blk)
+    -> m (Success     blk (TestIterator m blk) (TestFollower m blk))
+run cfg env@ChainDBEnv { varDB, .. } cmd =
     readTVarIO varDB >>= \st@ChainDBState { chainDB = ChainDB{..}, internal } -> case cmd of
       AddBlock blk             -> Point               <$> (advanceAndAdd st (blockSlot blk) blk)
       GetCurrentChain          -> Chain               <$> atomically getCurrentChain
@@ -425,7 +430,7 @@ run env@ChainDBEnv { varDB, .. } cmd =
     updateLoE :: ChainDBState m blk -> AnchoredFragment blk -> m (Point blk)
     updateLoE ChainDBState { chainDB } frag = do
       let headersFrag = AF.mapAnchoredFragment getHeader frag
-      atomically $ writeTVar varLoEFragment headersFrag
+      atomically $ writeTVar varLoEFragment $ attachSlotTimeToFragment cfg headersFrag
       ChainDB.triggerChainSelection chainDB
       atomically $ getTipPoint chainDB
 
@@ -678,10 +683,11 @@ runPure cfg = \case
     openOrClosed f = first (Resp . Right . Unit) . f
 
 runIO :: TestConstraints blk
-      => ChainDBEnv IO blk
-      ->     Cmd  blk (TestIterator IO blk) (TestFollower IO blk)
+      => TopLevelConfig blk
+      -> ChainDBEnv IO blk
+      -> Cmd blk (TestIterator IO blk) (TestFollower IO blk)
       -> IO (Resp blk (TestIterator IO blk) (TestFollower IO blk))
-runIO env cmd = Resp <$> try (run env cmd)
+runIO cfg env cmd = Resp <$> try (run cfg env cmd)
 
 {-------------------------------------------------------------------------------
   Collect arguments
@@ -1161,12 +1167,13 @@ postcondition model cmd resp =
     ev = lockstep model cmd resp
 
 semantics :: forall blk. TestConstraints blk
-          => ChainDBEnv IO blk
+          => TopLevelConfig blk
+          -> ChainDBEnv IO blk
           -> At Cmd blk IO Concrete
           -> IO (At Resp blk IO Concrete)
-semantics env (At cmd) =
+semantics cfg env (At cmd) =
     At . (bimap (QSM.reference . QSM.Opaque) (QSM.reference . QSM.Opaque)) <$>
-    runIO env (bimap QSM.opaque QSM.opaque cmd)
+    runIO cfg env (bimap QSM.opaque QSM.opaque cmd)
 
 -- | The state machine proper
 sm :: TestConstraints blk
@@ -1186,7 +1193,7 @@ sm loe env genBlock cfg initLedger = StateMachine
   , postcondition = postcondition
   , generator     = Just . generator loe genBlock
   , shrinker      = shrinker
-  , semantics     = semantics env
+  , semantics     = semantics cfg env
   , mock          = mock
   , invariant     = Just $ invariant cfg
   , cleanup       = noCleanup
@@ -1643,7 +1650,7 @@ mkArgs :: IOLike m
        -> ResourceRegistry m
        -> NodeDBs (StrictTMVar m MockFS)
        -> CT.Tracer m (TraceEvent Blk)
-       -> LoE (StrictTVar m (AnchoredFragment (Header Blk)))
+       -> LoE (StrictTVar m (AnchoredFragment (HeaderWithTime Blk)))
        -> ChainDbArgs Identity m Blk
 mkArgs cfg chunkInfo initLedger registry nodeDBs tracer varLoEFragment =
   let args = fromMinimalChainDbArgs MinimalChainDbArgs {
diff --git a/ouroboros-consensus/test/storage-test/Test/Ouroboros/Storage/TestBlock.hs b/ouroboros-consensus/test/storage-test/Test/Ouroboros/Storage/TestBlock.hs
index 979dabf525..631f01d249 100644
--- a/ouroboros-consensus/test/storage-test/Test/Ouroboros/Storage/TestBlock.hs
+++ b/ouroboros-consensus/test/storage-test/Test/Ouroboros/Storage/TestBlock.hs
@@ -88,6 +88,8 @@ import           Ouroboros.Consensus.BlockchainTime
 import           Ouroboros.Consensus.Config
 import           Ouroboros.Consensus.Forecast
 import           Ouroboros.Consensus.HardFork.Abstract
+import           Ouroboros.Consensus.HardFork.Combinator.Abstract
+                     (ImmutableEraParams (immutableEraParams))
 import qualified Ouroboros.Consensus.HardFork.History as HardFork
 import           Ouroboros.Consensus.HardFork.History.EraParams
                      (EraParams (eraGenesisWin))
@@ -693,6 +695,9 @@ mkTestConfig k ChunkSize { chunkCanContainEBB, numRegularBlocks } =
       , eraGenesisWin = GenesisWindow (maxRollbacks k * 2)
       }
 
+instance ImmutableEraParams TestBlock where
+    immutableEraParams = topLevelConfigLedger
+
 {-------------------------------------------------------------------------------
   NestedCtxt
 -------------------------------------------------------------------------------}