diff --git a/ouroboros-consensus-cardano/src/ouroboros-consensus-cardano/Ouroboros/Consensus/Cardano/Block.hs b/ouroboros-consensus-cardano/src/ouroboros-consensus-cardano/Ouroboros/Consensus/Cardano/Block.hs
index 2366ffc32d..9e32355b6d 100644
--- a/ouroboros-consensus-cardano/src/ouroboros-consensus-cardano/Ouroboros/Consensus/Cardano/Block.hs
+++ b/ouroboros-consensus-cardano/src/ouroboros-consensus-cardano/Ouroboros/Consensus/Cardano/Block.hs
@@ -1628,6 +1628,14 @@ instance
         (leiosClosureTxKeySets inner)
     _ -> emptyLedgerTables
 
+  leiosTxHashOfGenTx tx = case tx of
+    GenTxDijkstra inner -> leiosTxHashOfGenTx inner
+    _ -> Nothing
+
+  leiosTxBytesOfGenTx tx = case tx of
+    GenTxDijkstra inner -> leiosTxBytesOfGenTx inner
+    _ -> Nothing
+
 -----
 
 -- | We don't want to add the ResolveLeiosBlock sin-bin to SingleEraBlock, so we
diff --git a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Leios.hs b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Leios.hs
index 7535e3b1e2..fda5cbf8d9 100644
--- a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Leios.hs
+++ b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Leios.hs
@@ -11,6 +11,7 @@
 
 module Ouroboros.Consensus.Shelley.Ledger.Leios () where
 
+import Cardano.Binary (serialize')
 import qualified Cardano.Crypto.Hash as Crypto (hashToBytesShort)
 import Cardano.Ledger.Api (Tx)
 import Cardano.Ledger.Binary (decCBOR, decodeFullAnnotator)
@@ -38,7 +39,9 @@ import LeiosDemoLogic.Announcements.ElBimap (ElId (MkElId))
 import LeiosDemoTypes
   ( EbAnnouncement (..)
   , LeiosPoint (..)
+  , LeiosTx (..)
   , RbHash (..)
+  , hashLeiosTx
   )
 import Lens.Micro ((.~), (^.))
 import Ouroboros.Consensus.Block (ChainHash (..), blockPrevHash, toRawHash)
@@ -107,6 +110,13 @@ instance
   (PraosCrypto c, ShelleyCompatible (Praos c) DijkstraEra) =>
   ResolveLeiosBlock (ShelleyBlock (Praos c) DijkstraEra)
   where
+  -- The on-wire bytes and 'TxHash' a forged EB records for each tx (see
+  -- 'forgeLeiosEb'): 'serialize'' the tx, and hash exactly those bytes. Matching
+  -- this encoding is what lets the mempool key its txs by the same 'TxHash' an EB
+  -- lists, so the body-arrival mempool pull can find them.
+  leiosTxBytesOfGenTx (ShelleyTx _ tx) = Just (serialize' tx)
+  leiosTxHashOfGenTx (ShelleyTx _ tx) = Just (hashLeiosTx (MkLeiosTx (serialize' tx)))
+
   resolveLeiosClosure leiosDb ebHash = do
     mAnnouncedEb <-
       leiosDbLookupEbClosure
diff --git a/ouroboros-consensus-cardano/test/cardano-test/Test/ThreadNet/Leios.hs b/ouroboros-consensus-cardano/test/cardano-test/Test/ThreadNet/Leios.hs
index 3176a69bf4..25162c54d2 100644
--- a/ouroboros-consensus-cardano/test/cardano-test/Test/ThreadNet/Leios.hs
+++ b/ouroboros-consensus-cardano/test/cardano-test/Test/ThreadNet/Leios.hs
@@ -250,7 +250,7 @@ prop_leios seed =
     _ -> Nothing
 
   acquiredPoints = Set.fromList . flip mapMaybe leiosTraces $ \case
-    TraceLeiosBlockTxsAcquired point -> Just point
+    TraceLeiosBlockTxsAcquired point _age -> Just point
     _ -> Nothing
 
   -- An EB forged at slot @s@ is required to diffuse iff it has at least
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 2aad154b1d..0ff6359e04 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
@@ -71,6 +71,7 @@ import Data.Functor ((<&>))
 import Data.Hashable (Hashable)
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as Map
+import Data.Maybe.Strict (StrictMaybe (SJust))
 import qualified Data.Primitive.MutVar as Prim
 import qualified Data.Sequence as Seq
 import qualified Data.Set as Set
@@ -144,6 +145,7 @@ import Ouroboros.Consensus.Config (DiffusionPipeliningSupport (..))
 import Ouroboros.Consensus.HeaderValidation (HeaderWithTime)
 import Ouroboros.Consensus.Ledger.SupportsMempool
 import Ouroboros.Consensus.Ledger.SupportsProtocol
+import Ouroboros.Consensus.Mempool.API (getLeiosTxIndex)
 import Ouroboros.Consensus.MiniProtocol.BlockFetch.Server
 import Ouroboros.Consensus.MiniProtocol.ChainSync.Client
   ( ChainSyncStateView (..)
@@ -159,6 +161,7 @@ import Ouroboros.Consensus.NodeKernel
 import qualified Ouroboros.Consensus.Storage.ChainDB.API as ChainDB
 import Ouroboros.Consensus.Storage.LedgerDB.Forker
   ( ResolveLeiosBlock
+  , leiosTxBytesOfGenTx
   )
 import Ouroboros.Consensus.Storage.Serialisation (SerialisedHeader)
 import Ouroboros.Consensus.Util (ShowProxy, whenJust)
@@ -423,6 +426,7 @@ mkHandlers
                       (Just peer)
                       Leios.ReceivedViaChainSync
                       Announcements.DoRelay
+                      (SJust hdrSlotTime)
                       (Just (diffRelTime now hdrSlotTime))
                       ancHdr
               }
@@ -519,7 +523,7 @@ mkHandlers
                                 (Leios.ancHeader ancH)
                           )
                           -- central part of the processing
-                          ( \ancHdr (shouldRelay, age, (p, _sz)) -> do
+                          ( \ancHdr (shouldRelay, onset, age, (p, _sz)) -> do
                               traceWith tracer $
                                 MkTraceLeiosPeer $
                                   "MsgLeiosBlockAnnouncement new: " <> Leios.prettyLeiosPoint p
@@ -531,6 +535,7 @@ mkHandlers
                                 (Just peer)
                                 Leios.ReceivedViaLeiosNotify
                                 shouldRelay
+                                (SJust onset)
                                 (Just age)
                                 ancHdr
                           )
@@ -544,43 +549,17 @@ mkHandlers
                     Prim.writeMutVar peerStateVar (latestPruneSlot', peerSt2)
                   MsgLeiosBlockOffer point ebBytesSize -> do
                     traceWith tracer $ MkTraceLeiosPeer $ "MsgLeiosBlockOffer " <> Leios.prettyLeiosPoint point
-                    let MkLeiosPoint{pointEbHash = ebHash} = point
-                    -- TODO: EB announcements now record the authoritative
-                    -- (forger-signed) size via 'recordAnnouncedEb', but this
-                    -- offer handler is not integrated with them yet: it still
-                    -- builds fetch state directly from peer offers, whose sizes
-                    -- are not authoritative (the authoritative one lives in
-                    -- 'headerLeiosAnnouncement' on the parent RB header). Until
-                    -- the two are reconciled, the sanitisation below is the best
-                    -- we can do against malformed offers: drop a zero-sized
-                    -- offer outright (no honest forger ever announces a 0-byte
-                    -- EB) and refuse to overwrite an existing entry that shares
-                    -- the same content hash, so the first-seen (slot, size)
-                    -- wins. The per-peer 'offerings' below is still updated so
-                    -- the peer remains a valid serving candidate.
-                    MVar.modifyMVar_ getLeiosOutstanding $ \outstanding ->
-                      pure $
-                        if ebBytesSize == 0
-                          || Set.member ebHash (Leios.acquiredEbBodies outstanding)
-                          || any
-                            ((== ebHash) . pointEbHash)
-                            (Map.keys (Leios.missingEbBodies outstanding))
-                          then outstanding
-                          else
-                            outstanding
-                              { Leios.missingEbBodies =
-                                  Map.insert point ebBytesSize (Leios.missingEbBodies outstanding)
-                              }
-                    MVar.modifyMVar_ (Leios.offerings peerVars) $ \(offers1, offers2) -> do
-                      let !offers1' = Set.insert ebHash offers1
-                      pure (offers1', offers2)
-                    void $ MVar.tryPutMVar getLeiosReady ()
+                    -- TODO punish peer for a too-old offer, modulo clock/immtip skew.
+                    Leios.recordEbBodyOffer
+                      (getLeiosOutstanding, getLeiosReady)
+                      peerVars
+                      Leios.TxsClosureNotAlsoOffered
+                      (point, ebBytesSize)
                   MsgLeiosBlockTxsOffer p -> do
                     traceWith tracer $ MkTraceLeiosPeer $ "MsgLeiosBlockTxsOffer " <> Leios.prettyLeiosPoint p
-                    let MkLeiosPoint{pointEbHash = ebHash} = p
-                    MVar.modifyMVar_ (Leios.offerings peerVars) $ \(offers1, offers2) -> do
-                      let !offers2' = Set.insert ebHash offers2
-                      pure (offers1, offers2')
+                    -- A closure offer implies the body too.
+                    MVar.modifyMVar_ (Leios.offerings peerVars) $
+                      pure . Map.insertWith Leios.mergeOffer p Leios.TxsClosureAlsoOffered
                     void $ MVar.tryPutMVar getLeiosReady ()
                   MsgLeiosVotes vs -> do
                     traceWith tracer $ MkTraceLeiosPeer $ "MsgLeiosVotes " <> show vs
@@ -691,6 +670,11 @@ mkHandlers
                   (getLeiosOutstanding, getLeiosReady)
                   getLeiosTxCache
                   leiosConn
+                  systemTime
+                  ( Leios.mkMempoolPull
+                      (atomically (getLeiosTxIndex getMempool))
+                      (leiosTxBytesOfGenTx . txForgetValidated)
+                  )
                   (Leios.MkPeerId peer)
                   reqVar
                   responseQ
@@ -1130,7 +1114,7 @@ mkApps kernel rng Tracers{tTxLogicTracer = _, ..} mkCodecs ByteLimits{..} chainS
           csjConfig
           getDiffusionPipeliningSupport
         $ \csState ->
-          bracketLeiosPeer them $ \peerVars -> do
+          bracketLeiosPeer them isBigLedgerPeer $ \peerVars -> do
             (r, trailing) <-
               runPipelinedPeerWithLimitsRnd
                 (contramap (TraceLabelPeer them) tChainSyncTracer)
@@ -1399,9 +1383,10 @@ mkApps kernel rng Tracers{tTxLogicTracer = _, ..} mkCodecs ByteLimits{..} chainS
   -- teardown has refunded it.
   bracketLeiosPeer ::
     ConnectionId addrNTN ->
+    IsBigLedgerPeer ->
     (Leios.LeiosPeerVars m -> m a) ->
     m a
-  bracketLeiosPeer them =
+  bracketLeiosPeer them isBigLedgerPeer =
     bracket
       -- Get-or-create: any peer-vars mini-protocol can be the first to run and
       -- allocate; the others share the existing vars. No ref count: a hot peer's
@@ -1409,7 +1394,7 @@ mkApps kernel rng Tracers{tTxLogicTracer = _, ..} mkCodecs ByteLimits{..} chainS
       -- cleanup below, and the rest find it already gone (idempotent). A straggler
       -- that allocated its own entry cleans that up on its own exit.
       ( do
-          fresh <- Leios.newLeiosPeerVars
+          fresh <- Leios.newLeiosPeerVars isBigLedgerPeer
           atomically $ do
             peersVars <- LazySTM.readTVar (getLeiosPeersVars kernel)
             case Map.lookup pid peersVars of
@@ -1436,10 +1421,11 @@ mkApps kernel rng Tracers{tTxLogicTracer = _, ..} mkCodecs ByteLimits{..} chainS
     ExpandedInitiatorContext
       { eicConnectionId = them
       , eicControlMessage = controlMessageSTM
+      , eicIsBigLedgerPeer = isBigLedgerPeer
       }
     channel = do
       labelThisThread "LeiosNotifyClient"
-      bracketLeiosPeer them $ \peerVars -> do
+      bracketLeiosPeer them isBigLedgerPeer $ \peerVars -> do
         ((), trailing) <-
           runPipelinedPeerWithLimits
             (TraceLabelPeer them `contramap` tLeiosNotifyTracer)
@@ -1480,10 +1466,11 @@ mkApps kernel rng Tracers{tTxLogicTracer = _, ..} mkCodecs ByteLimits{..} chainS
     ExpandedInitiatorContext
       { eicConnectionId = them
       , eicControlMessage = controlMessageSTM
+      , eicIsBigLedgerPeer = isBigLedgerPeer
       }
     channel = do
       labelThisThread "LeiosFetchClient"
-      bracketLeiosPeer them $ \peerVars ->
+      bracketLeiosPeer them isBigLedgerPeer $ \peerVars ->
         withLeiosDb leiosDB $ \leiosConn -> do
           ((), trailing) <-
             runPipelinedPeerWithLimits
diff --git a/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/Node.hs b/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/Node.hs
index 01f16589b5..5b86d9d6f5 100644
--- a/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/Node.hs
+++ b/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/Node.hs
@@ -963,7 +963,8 @@ mkNodeKernelArgs
   leiosTxCache =
     do
       let (kaRng, rng') = splitGen rng
-          (psRng, _) = splitGen rng'
+          (psRng, rng'') = splitGen rng'
+          (lfRng, _) = splitGen rng''
       return
         NodeKernelArgs
           { tracers
@@ -997,6 +998,7 @@ mkNodeKernelArgs
           , txSubmissionInitDelay
           , leiosDB
           , leiosTxCache
+          , leiosFetchRng = lfRng
           }
 
 -- | We allow the user running the node to customise the 'NodeKernelArgs'
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 4fc244708d..dd70f25a73 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
@@ -54,8 +54,10 @@ import Data.Functor ((<&>))
 import Data.Hashable (Hashable)
 import Data.List.NonEmpty (NonEmpty)
 import qualified Data.Map.Strict as Map
+import qualified Data.Sequence.NonEmpty as NESeq
 import Data.Set (Set)
 import qualified Data.Set as Set
+import qualified Data.Set.NonEmpty as NESet
 import qualified Data.Text as Text
 import Data.Void (Void)
 import LeiosDemoDb
@@ -119,7 +121,6 @@ import Ouroboros.Consensus.Storage.ChainDB.API
 import qualified Ouroboros.Consensus.Storage.ChainDB.API as ChainDB
 import Ouroboros.Consensus.Storage.ChainDB.Init (InitChainDB)
 import qualified Ouroboros.Consensus.Storage.ChainDB.Init as InitChainDB
-import Ouroboros.Consensus.Util (whenJust)
 import Ouroboros.Consensus.Util.AnchoredFragment
   ( preferAnchoredCandidate
   )
@@ -294,6 +295,10 @@ data NodeKernelArgs m addrNTN addrNTC blk = NodeKernelArgs
   -- ^ The in-memory tx-presence index. Created in "Ouroboros.Consensus.Node"
   -- (before the ChainDB, so the ChainDB GC can prune it just before the LeiosDb)
   -- and threaded through here.
+  , leiosFetchRng :: StdGen
+  -- ^ Seeds the LeiosFetch decision loop's PRNG (see 'Leios.leiosFetchPrng'),
+  -- which shuffles job assignment to peers. An independent split of the node
+  -- generator, like 'keepAliveRng' / 'peerSharingRng'.
   }
 
 initNodeKernel ::
@@ -474,8 +479,7 @@ initNodeKernel
     -- announcements, LeiosFetch clients on response, etc.) 'tryPutMVar' on
     -- 'getLeiosReady' to schedule another iteration.
     void $
-      forkLinkedThread registry "NodeKernel.leiosFetchLogic" $ do
-        leiosConn <- snd <$> allocate registry (const (LeiosDb.open leiosDB)) LeiosDb.close
+      forkLinkedThread registry "NodeKernel.leiosFetchLogic" $
         forever $ do
           let leiosTr = leiosKernelTracer tracers
           traceWith leiosTr $ MkTraceLeiosKernel "leiosFetchLogic: wait for leios ready"
@@ -484,7 +488,7 @@ initNodeKernel
           leiosPeersVars <- LazySTM.readTVarIO getLeiosPeersVars
           offerings <- mapM (MVar.readMVar . Leios.offerings) leiosPeersVars
           let livePeers = Map.keysSet leiosPeersVars
-          newDecisions <- MVar.modifyMVar getLeiosOutstanding $ \outstanding -> do
+          (newRequests, offerDrops, outstandingStats) <- MVar.modifyMVar getLeiosOutstanding $ \outstanding -> do
             -- Re-read the live peers while holding the -- 'getLeiosOutstanding'
             -- lock. This is used to avoid losing an update to
             -- 'getLeiosOutstanding' that 'removePeerFromOutstanding' may have
@@ -493,13 +497,11 @@ initNodeKernel
             -- that just disconnected, since the replies would never arrive /AND/
             -- those requests would then remain in 'getLeiosOutstanding' forever.
             stillLivePeers <- LazySTM.readTVarIO getLeiosPeersVars
-            filteredOutstanding <-
-              Leios.filterMissingWork leiosConn outstanding
             -- FIXME(bladyjoker): Capping these 2 traces because they grow in tens of MBs. Let's make a separate event for them and use Cardano config to silence/voice them.
             traceWith leiosTr $
               MkTraceLeiosKernel $
                 "leiosFetchLogic: outstanding "
-                  <> take 1000 (Leios.prettyLeiosOutstanding filteredOutstanding)
+                  <> take 1000 (Leios.prettyLeiosOutstanding outstanding)
             traceWith leiosTr $
               MkTraceLeiosKernel $
                 "leiosFetchLogic: offerings "
@@ -508,17 +510,37 @@ initNodeKernel
             let mbCurrentSlot = case currentSlot of
                   CurrentSlot s -> Just s
                   CurrentSlotUnknown -> Nothing
-            let (!outstanding', decisions) =
+            let bigLedgerPeers = Map.map Leios.whetherBigLedgerPeer stillLivePeers
+            let (!outstanding', requests, offerDrops) =
                   Leios.leiosFetchLogicIteration
                     Leios.demoLeiosFetchStaticEnv
                     mbCurrentSlot
                     (Map.restrictKeys offerings (Map.keysSet stillLivePeers))
-                    filteredOutstanding
-            pure (outstanding', decisions)
+                    bigLedgerPeers
+                    outstanding
+            pure
+              ( outstanding'
+              ,
+                ( requests
+                , offerDrops
+                , Leios.leiosOutstandingStats (Map.size offerings) (map Map.size (Map.elems offerings)) outstanding'
+                )
+              )
+          -- Drop dead offers: exactly the EBs the decision pass found we already
+          -- fully hold (computed while it walked those offers -- no extra scan).
+          -- This is the timely offer-pruning; the imm-tip Watcher prune is a
+          -- backstop for when this loop is idle.
+          -- TODO this loop is rate-limited, so although a completing acquisition
+          -- wakes it via 'getLeiosReady', this can still lag until the next allowed
+          -- iteration; someday drop the offer at the acquiring moment itself.
+          forM_ (Map.toList offerDrops) $ \(dropPeer, dropped) ->
+            case Map.lookup dropPeer leiosPeersVars of
+              Nothing -> pure ()
+              Just vars ->
+                MVar.modifyMVar_ (Leios.offerings vars) $
+                  pure . (`Map.withoutKeys` NESet.toSet dropped)
           traceWith leiosTr $ MkTraceLeiosKernel "leiosFetchLogic: decided"
-          let newRequests =
-                Leios.packRequests Leios.demoLeiosFetchStaticEnv newDecisions
-              decisionsTargetedKeys = Map.keysSet newRequests
+          let decisionsTargetedKeys = Map.keysSet newRequests
               droppableKeys =
                 decisionsTargetedKeys `Set.difference` livePeers
           traceWith leiosTr $
@@ -534,11 +556,18 @@ initNodeKernel
                   ++ " peer-targeted decisions because target not in leiosPeersVars"
           (\f -> sequence_ $ Map.intersectionWith f leiosPeersVars newRequests) $ \vars reqs ->
             atomically $
-              StrictSTM.modifyTVar (Leios.requestsToSend vars) (<> reqs)
+              StrictSTM.modifyTVar (Leios.requestsToSend vars) (<> NESeq.toSeq reqs)
           iterationEnd <- getMonotonicTime
           let loopInterval = 0.5 :: SI.DiffTime
               duration = iterationEnd `diffTime` iterationStart
-          traceWith leiosTr $ MkTraceLeiosKernel $ "leiosFetchLogic: duration " ++ show duration
+          -- Structured, Loki-queryable telemetry for the decision loop: the
+          -- iteration's duration (the worst-case-latency signal the LeiosTxCache
+          -- bounds) and a size sample of the (now well-pruned) outstanding state.
+          traceWith leiosTr $
+            TraceLeiosFetchDecision
+              (realToFrac duration)
+              outstandingStats
+              (Leios.summarizeDecisions newRequests)
           threadDelay $ loopInterval - duration
 
     -- The Leios voting thread: when this node has a voting key, subscribe
@@ -558,16 +587,25 @@ initNodeKernel
           (topLevelConfigVotingKey cfg)
 
     void $
-      forkLinkedWatcher registry "NodeKernel.leiosPruneAnnouncements" $
+      forkLinkedWatcher registry "NodeKernel.leiosImmTipPrune" $
         Watcher
           { wFingerprint = id
           , wInitial = Nothing
           , wReader = getTipSlot . ledgerState <$> ChainDB.getImmutableLedger chainDB
           , wNotify = \case
               Origin -> pure ()
-              NotOrigin immTipSlot ->
+              NotOrigin immTipSlot -> do
                 MVar.modifyMVar_ getLeiosCentralState $
                   pure . Announcements.pruneCentralState immTipSlot
+                MVar.modifyMVar_ getLeiosOutstanding $
+                  pure . snd . Leios.pruneOutstandingToImmTip immTipSlot
+                -- Backstop offer-prune: offers are keyed by point (slot-ordered),
+                -- so drop the below-tip prefix directly. The fetch loop prunes
+                -- completed offers promptly; this catches offers it never reaches.
+                peersVars <- LazySTM.readTVarIO getLeiosPeersVars
+                forM_ peersVars $ \vars ->
+                  MVar.modifyMVar_ (Leios.offerings vars) $
+                    pure . Map.dropWhileAntitone ((< immTipSlot) . Leios.pointSlotNo)
           }
 
     return
@@ -637,6 +675,7 @@ data InternalState m addrNTN addrNTC blk = IS
   , cfg :: TopLevelConfig blk
   , registry :: ResourceRegistry m
   , btime :: BlockchainTime m
+  , systemTime :: SystemTime m
   , chainDB :: ChainDB m blk
   , blockFetchInterface ::
       BlockFetchConsensusInterface (ConnectionId addrNTN) (HeaderWithTime blk) blk m
@@ -679,6 +718,7 @@ initInternalState
     , cfg
     , blockFetchSize
     , btime
+    , systemTime
     , mempoolCapacityOverride
     , mempoolTimeoutConfig
     , gsmArgs
@@ -687,6 +727,7 @@ initInternalState
     , genesisArgs
     , leiosDB
     , leiosTxCache
+    , leiosFetchRng
     } = do
     varGsmState <- do
       let GsmNodeKernelArgs{..} = gsmArgs
@@ -710,7 +751,19 @@ initInternalState
     fetchClientRegistry <- newFetchClientRegistry
 
     leiosPeersVars <- LazySTM.newTVarIO Map.empty
-    leiosOutstanding <- MVar.newMVar Leios.emptyLeiosOutstanding
+    -- Seed 'acquiredEbBodiesPrunedSlot' from the immutable tip: everything at or
+    -- below it is already final, so an EB that old must read as 'tooOld' from the
+    -- outset -- not only once the first 'pruneOutstandingToImmTip' fires.
+    immTip <- getTipSlot . ledgerState <$> atomically (ChainDB.getImmutableLedger chainDB)
+    let !immTipSlot = case immTip of
+          Origin -> SlotNo 0
+          NotOrigin s -> s
+    leiosOutstanding <- do
+      acquiredClosures <-
+        LeiosDb.withLeiosDb leiosDB $ \leiosConn ->
+          LeiosDb.leiosDbScanCompleteEbClosuresNotOlderThanSlot leiosConn immTipSlot
+      MVar.newMVar $
+        Leios.initializeLeiosOutstanding leiosFetchRng acquiredClosures immTipSlot
     leiosReady <- MVar.newEmptyMVar
     leiosCentralState <- MVar.newMVar Announcements.emptyCentralState
 
@@ -785,34 +838,25 @@ forkBlockForging IS{..} (MkBlockForging blockForgingM) =
                     leiosVoteState
                     bf
                     leiosConn
-                    leiosTxCache
-                    announceForgedBlock
+                    ( \forgedHeader forgedEb ->
+                        Leios.onForgedLeiosEb
+                          (leiosKernelTracer tracers)
+                          leiosCentralState
+                          (leiosOutstanding, leiosReady)
+                          leiosTxCache
+                          leiosConn
+                          systemTime
+                          -- Safe here: the forge hands us a corresponding header
+                          -- and closure.
+                          (Leios.mkForgedAnnouncingHeader forgedHeader forgedEb)
+                          forgedEb
+                    )
                     currentSlot
     )
  where
   label :: String
   label = "NodeKernel.blockForging"
 
-  -- Relay this node's own freshly-forged EB announcement, if any, to downstream
-  -- peers via LeiosNotify. 'forge' invokes this right after forging and before
-  -- adoption — and, crucially, before persisting the EB body to the LeiosDb.
-  -- The relay is synchronous: writing the body is what offers the EB to peers,
-  -- so the announcement must be enqueued first, else a peer could receive the
-  -- offer before the announcement.
-  announceForgedBlock :: Header blk -> m ()
-  announceForgedBlock forgedHeader =
-    whenJust (Leios.mkAnnouncingHeader forgedHeader) $ \anc ->
-      MVar.modifyMVar_ leiosCentralState $ \cst ->
-        Announcements.onAnnouncementCentral
-          (contramap (Leios.traceNewAnnouncement Leios.ForgedLocally) (leiosKernelTracer tracers))
-          Leios.ancElId
-          (\_elSt -> pure ()) -- we forged the EB; nothing to fetch locally
-          cst
-          Nothing -- the source is this node, not an upstream peer
-          Announcements.DoRelay -- our newly forged block can't be too old
-          Nothing -- no wall-clock lateness for a locally-forged announcement
-          anc
-
   -- 'LeiosDbConnection' is not thread-safe, so we open one per
   -- forge-credentials thread (and close it when the thread exits).
   allocateForging = do
diff --git a/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/NodeKernel/Forge.hs b/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/NodeKernel/Forge.hs
index 4ad1fb3fbb..61700201c4 100644
--- a/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/NodeKernel/Forge.hs
+++ b/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/NodeKernel/Forge.hs
@@ -5,7 +5,6 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE OverloadedRecordDot #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
@@ -28,16 +27,11 @@ import Data.Proxy
 import LeiosDemoDb
   ( LeiosDbConnection (..)
   )
-import LeiosDemoLogic (recordForgedEbAndClosureInTxCache)
 import LeiosDemoTypes
   ( LeiosCert
-  , RbHash (MkRbHash)
-  , SerializedEbBody
   , TraceLeiosKernel (..)
-  , leiosEbBytesSize
   )
 import qualified LeiosDemoTypes as Leios
-import LeiosTxCache (LeiosTxCache)
 import LeiosUtils.CallTrace
   ( CallCtx
   , CallName
@@ -103,14 +97,13 @@ forge ::
   LeiosVoteState m ->
   BlockForging m blk ->
   LeiosDbConnection m ->
-  LeiosTxCache m () () SerializedEbBody ->
-  -- | Invoked with the freshly-forged block's header, after forging and
-  -- /before/ adoption, so the caller can act on the new block (e.g. concurrently
-  -- announce its EB) without adoption gating it.
-  (Header blk -> m ()) ->
+  -- | Invoked with the header and closure of each EB we forge, to ingest it
+  -- through the same handlers an upstream peer's messages (see
+  -- 'Leios.onForgedLeiosEb').
+  (Header blk -> Leios.ForgedLeiosEb -> m ()) ->
   SlotNo ->
   WithEarlyExit m ()
-forge forgeEventTracer forgeStateInfoTracer leiosTracer forgeCCtx cfg chainDB mempool leiosVoteState blockForging leiosConn leiosTxCache afterForge currentSlot = do
+forge forgeEventTracer forgeStateInfoTracer leiosTracer forgeCCtx cfg chainDB mempool leiosVoteState blockForging leiosConn onForgedLeiosEb currentSlot = do
   let trace :: TraceForgeEvent blk -> WithEarlyExit m ()
       trace =
         lift
@@ -267,29 +260,12 @@ forge forgeEventTracer forgeStateInfoTracer leiosTracer forgeCCtx cfg chainDB me
       snapSize
       rbTxsSize
 
-  -- Hand the freshly-forged block's header to the caller before adoption, so it
-  -- can act on it (e.g. relay its EB announcement) without adoption gating it.
-  lift $ afterForge (getHeader newBlock)
-
-  -- Persist the forged EB, but only /after/ 'afterForge' has relayed the
-  -- announcement: writing the body to the LeiosDb ('leiosDbInsertEbBody') is
-  -- what makes the EB offerable to peers, so deferring it past the relay
-  -- guarantees a downstream peer never receives the body offer before the
-  -- announcement.
-  --
-  -- Also register the body in the LeiosTxCache.
-  lift $ forM_ mForgedEb $ \forgedEb -> do
-    let ebPoint = forgedEb.point
-        ebSize = leiosEbBytesSize forgedEb.body
-    leiosDbInsertEbPoint leiosConn ebPoint ebSize
-    void $ leiosDbInsertEbBody leiosConn ebPoint forgedEb.body
-    void $ leiosDbInsertTxs leiosConn forgedEb.txClosure
-    traceWith leiosTracer $ TraceLeiosBlockStored{slot = currentSlot, eb = forgedEb.body}
-    recordForgedEbAndClosureInTxCache
-      leiosTracer
-      leiosTxCache
-      (MkRbHash (toRawHash (Proxy @blk) (blockHash newBlock)))
-      forgedEb
+  -- On a fundamental level, issuing a block is only slightly different than
+  -- receiving it from an upstream peer; we keep that explicit to limit the risk
+  -- of accidental discrepancies. 'onForgedLeiosEb' hands our freshly-forged EB's
+  -- announcement, body, and closure to the very handlers those mini-protocol
+  -- messages use.
+  lift $ forM_ mForgedEb $ onForgedLeiosEb (getHeader newBlock)
 
   forgeTrace'Via
     (const ())
diff --git a/ouroboros-consensus-diffusion/src/unstable-diffusion-testlib/Test/ThreadNet/Network.hs b/ouroboros-consensus-diffusion/src/unstable-diffusion-testlib/Test/ThreadNet/Network.hs
index 6ae9268f27..5c2cd2f06e 100644
--- a/ouroboros-consensus-diffusion/src/unstable-diffusion-testlib/Test/ThreadNet/Network.hs
+++ b/ouroboros-consensus-diffusion/src/unstable-diffusion-testlib/Test/ThreadNet/Network.hs
@@ -1089,7 +1089,8 @@ runThreadNetwork
             Seed s -> mkStdGen s
           (kaRng, rng') = splitGen rng
           (gsmRng, rng'') = splitGen rng'
-          (psRng, chainSyncRng) = splitGen rng''
+          (psRng, rng''') = splitGen rng''
+          (lfRng, chainSyncRng) = splitGen rng'''
       publicPeerSelectionStateVar <- makePublicPeerSelectionStateVar
 
       let nodeKernelArgs =
@@ -1153,6 +1154,7 @@ runThreadNetwork
               , txSubmissionInitDelay = NoTxSubmissionInitDelay
               , leiosDB = leiosDbHandle
               , leiosTxCache
+              , leiosFetchRng = lfRng
               }
 
       nodeKernel <- initNodeKernel nodeKernelArgs
diff --git a/ouroboros-consensus.cabal b/ouroboros-consensus.cabal
index 335045fc7f..f4a7df73ce 100644
--- a/ouroboros-consensus.cabal
+++ b/ouroboros-consensus.cabal
@@ -112,6 +112,7 @@ library
     LeiosDemoOnlyTestFetch
     LeiosDemoOnlyTestNotify
     LeiosDemoTypes
+    LeiosDemoTypes.LeiosJobs
     LeiosTxCache
     LeiosTxCache.API
     LeiosTxCache.Optimized
@@ -389,7 +390,6 @@ library
     diff-containers >=1.2,
     direct-sqlite,
     directory,
-    dlist,
     filelock,
     fingertree-rm >=1.0,
     fs-api ^>=0.4,
@@ -763,6 +763,7 @@ test-suite consensus-test
     Test.LeiosDemoDb
     Test.LeiosDemoLogic
     Test.LeiosDemoLogic.Announcements
+    Test.LeiosDemoLogic.Invariants
     Test.LeiosDemoTypes
     Test.LeiosTxCache.Optimized
     Test.LeiosTxCache.Optimized.MutableHashTable
@@ -791,7 +792,6 @@ test-suite consensus-test
     deepseq,
     diff-containers,
     directory,
-    dlist,
     file-embed,
     filepath,
     fingertree-rm,
@@ -1231,6 +1231,7 @@ library diffusion
     cardano-binary,
     cardano-diffusion:{api, cardano-diffusion, protocols},
     cardano-slotting,
+    cardano-strict-containers,
     cborg,
     containers,
     contra-tracer,
@@ -1242,6 +1243,7 @@ library diffusion
     measures,
     mtl,
     network-mux ^>=0.10,
+    nonempty-containers,
     ouroboros-consensus:{ouroboros-consensus, protocol},
     ouroboros-network:{api, framework, ouroboros-network, protocols},
     primitive,
diff --git a/ouroboros-consensus/bench/leios-db-bench/Main.hs b/ouroboros-consensus/bench/leios-db-bench/Main.hs
index 89e68a4571..38863f66d7 100644
--- a/ouroboros-consensus/bench/leios-db-bench/Main.hs
+++ b/ouroboros-consensus/bench/leios-db-bench/Main.hs
@@ -6,9 +6,6 @@
 --
 -- The following roles run concurrently against the same SQLite handle:
 --
--- * __Fetch logic__ (1 thread): configurable rounds of
---   'leiosDbFilterMissingEbBodies' + 'leiosDbFilterMissingTxs'.
---
 -- * __Fetch clients__ (configurable, default 3 threads): each inserts 20 fresh
 --   EBs via 'leiosDbInsertEbPoint' → 'leiosDbInsertEbBody' → 'leiosDbInsertTxs'.
 --
@@ -36,7 +33,7 @@ module Main (main) where
 
 import Cardano.Slotting.Slot (SlotNo (..))
 import Control.Concurrent.Async (async, mapConcurrently_, wait)
-import Control.Monad (forM, forM_, replicateM_, when)
+import Control.Monad (forM, forM_, when)
 import Control.Monad.Class.MonadTime.SI (diffTime, getMonotonicTime)
 import Control.Tracer (debugTracer, (>$<))
 import qualified Data.ByteString as BS
@@ -48,8 +45,6 @@ import LeiosDemoDb
   ( LeiosDbConnection
   , LeiosDbHandle (..)
   , leiosDbBatchRetrieveTxs
-  , leiosDbFilterMissingEbBodies
-  , leiosDbFilterMissingTxs
   , leiosDbGarbageCollect
   , leiosDbInsertEbBody
   , leiosDbInsertEbPoint
@@ -82,9 +77,6 @@ main = do
       , "  Total TXs         : " <> show (numPrePopulatedEbs * txsPerEb)
       , ""
       , "Concurrent workload per iteration:"
-      , "  Fetch logic     (×1): "
-          <> show numFetchLogicRounds
-          <> " rounds of filterMissingEbBodies (200+200) + filterMissingTxs (500+500)"
       , "  Fetch clients   (×" <> show numFetchClients <> "): 20 insertEbPoint/insertEbBody/insertTxs each"
       , "  Fetch servers   (×" <> show numFetchServers <> "): 30 lookupEbBody + 10 batchRetrieveTxs each"
       , "  Chain-sel reader(×1): " <> show numChainSelReads <> " lookupEbClosure calls"
@@ -115,10 +107,6 @@ numFetchClients = 3
 numFetchServers :: Int
 numFetchServers = 3
 
--- | Number of rounds the fetch logic thread performs per iteration.
-numFetchLogicRounds :: Int
-numFetchLogicRounds = 100
-
 -- | Number of chain-sel-shaped reader calls per iteration.
 numChainSelReads :: Int
 numChainSelReads = 50
@@ -140,12 +128,11 @@ benchConcurrentAll BenchEnv{beDb = db, bePoints = points, beWriterIdx = writerId
     atomicModifyIORef'
       writerIdxRef
       (\n -> (n + numFetchClients * ebsPerClient, n))
-  fl <- async (fetchLogic db points)
   cs <- async (chainSelReader db points)
   gc <- async (gcTicker db)
   clients <- forM (clientRanges startIdx) $ \range -> async (fetchClient db range)
   mapConcurrently_ (fetchServer db points) [0 .. numFetchServers - 1]
-  wait fl >> wait cs >> wait gc
+  wait cs >> wait gc
   forM_ clients wait
  where
   ebsPerClient = 20
@@ -154,20 +141,6 @@ benchConcurrentAll BenchEnv{beDb = db, bePoints = points, beWriterIdx = writerId
     | i <- [0 .. numFetchClients - 1]
     ]
 
--- | Mirrors the fetch logic loop: filters for missing EB bodies and TXs.
-fetchLogic :: LeiosDbHandle IO -> [LeiosPoint] -> IO ()
-fetchLogic db points =
-  withLeiosDb db $ \c ->
-    replicateM_ numFetchLogicRounds $ do
-      _ <- leiosDbFilterMissingEbBodies c (existingPoints ++ missingPoints)
-      _ <- leiosDbFilterMissingTxs c (existingHashes ++ missingHashes)
-      pure ()
- where
-  existingPoints = take 200 points
-  missingPoints = [genPoint i | i <- [10_000 .. 10_199]]
-  existingHashes = [genTxHash 0 i | i <- [0 .. 499]]
-  missingHashes = [genTxHash 10_000 i | i <- [0 .. 499]]
-
 -- | Mirrors a fetch client: inserts fresh EBs with full TX payloads.
 fetchClient :: LeiosDbHandle IO -> [Int] -> IO ()
 fetchClient db range =
diff --git a/ouroboros-consensus/bench/leios-txcache-bench/LeiosTxCache/Bench/SQLite.hs b/ouroboros-consensus/bench/leios-txcache-bench/LeiosTxCache/Bench/SQLite.hs
index 908a652456..4161cd15ef 100644
--- a/ouroboros-consensus/bench/leios-txcache-bench/LeiosTxCache/Bench/SQLite.hs
+++ b/ouroboros-consensus/bench/leios-txcache-bench/LeiosTxCache/Bench/SQLite.hs
@@ -121,9 +121,9 @@ newSQLiteLeiosTxCacheForQueries cacheSize nParams path = do
         LeiosTxCache
           { insertAnnouncement = \_slot _rbh _ebh -> pure (Set.empty, Set.empty)
           , evictOlderThan = \_boundary -> pure (Set.empty, Set.empty)
-          , insertBody = \_ebh _body -> pure Nothing
+          , insertBody = \_ebh _body _nil _snoc -> pure Nothing
           , lookupBody = \_ebh -> pure Nothing
-          , withLockedInsertUnappliedTx = \k -> do _ <- k () (\w _txh _ -> pure w); pure ()
+          , withLockedInsertUnappliedTx = \k -> do _ <- k () (\w _txh _sz _ -> pure w); pure mempty
           , withLockedInsertAppliedTx = \k -> do _ <- k () (\w _txh _ -> pure w); pure ()
           , withLookupTx = \k -> do
               (_, stmt) <- readIORef connRef
@@ -161,13 +161,13 @@ newSQLiteLeiosTxCacheWith pragmas path = do
     LeiosTxCache
       { insertAnnouncement = \_slot _rbh _ebh -> pure (Set.empty, Set.empty)
       , evictOlderThan = \_boundary -> pure (Set.empty, Set.empty)
-      , insertBody = \_ebh body -> do
+      , insertBody = \_ebh body _nil _snoc -> do
           DB.exec db "BEGIN;"
-          mapM_ insertOne (foldTxReferences (flip (:)) [] body)
+          mapM_ insertOne (foldTxReferences (\acc txh _sz -> txh : acc) [] body)
           DB.exec db "COMMIT;"
           pure Nothing
       , lookupBody = \_ebh -> pure Nothing
-      , withLockedInsertUnappliedTx = \k -> do _ <- k () (\w _txh _ -> pure w); pure ()
+      , withLockedInsertUnappliedTx = \k -> do _ <- k () (\w _txh _sz _ -> pure w); pure mempty
       , withLockedInsertAppliedTx = \k -> do _ <- k () (\w _txh _ -> pure w); pure ()
       , withLookupTx = \k -> k lookupOne
       }
diff --git a/ouroboros-consensus/bench/leios-txcache-bench/Main.hs b/ouroboros-consensus/bench/leios-txcache-bench/Main.hs
index 6553d732d7..8090748971 100644
--- a/ouroboros-consensus/bench/leios-txcache-bench/Main.hs
+++ b/ouroboros-consensus/bench/leios-txcache-bench/Main.hs
@@ -87,7 +87,11 @@ instance ReferencesTxsByHash BenchBody where
     n = BS.length bs `div` 32
     go !acc i
       | i >= n = acc
-      | otherwise = go (f acc (MkTxHash (BS.copy (BS.take 32 (BS.drop (i * 32) bs))))) (i + 1)
+      | otherwise =
+          go
+            (f acc (MkTxHash (BS.copy (BS.take 32 (BS.drop (i * 32) bs)))) dummySize)
+            (i + 1)
+    dummySize = 0
 
 type BenchCache = LeiosTxCache IO () () BenchBody
 
@@ -274,9 +278,9 @@ runBench (BenchTarget name popCache queryCache syncAfterPop coolBatch) = do
     timedNs $
       forM_ ebData $ \(ebh, rbh, slot, txhs, bs) -> do
         _ <- insertAnnouncement popCache slot rbh ebh
-        _ <- insertBody popCache ebh (BenchBody bs)
+        _ <- insertBody popCache ebh (BenchBody bs) () (\() _ _ _ -> ())
         withLockedInsertUnappliedTx popCache $ \z step ->
-          foldM (\ !acc txh -> step acc txh ()) z txhs
+          foldM (\ !acc txh -> step acc txh 0 ()) z txhs
   allocAfter <- bytesAllocated
   -- Flush population to disk (a no-op for the in-memory variants) so the query
   -- handle reads durable, coolable pages.
diff --git a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoDb/Common.hs b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoDb/Common.hs
index 6d043a9e7c..2386eb3cf0 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoDb/Common.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoDb/Common.hs
@@ -123,10 +123,6 @@ data LeiosDbConnection m = LeiosDbConnection
   --
   -- XXX: return type only used for tracing
   , leiosDbBatchRetrieveTxs :: HasCallStack => EbHash -> [Int] -> m [(Int, TxHash, Maybe ByteString)]
-  , leiosDbFilterMissingEbBodies :: HasCallStack => [LeiosPoint] -> m [LeiosPoint]
-  -- ^ Batch filter: returns the subset of input LeiosPoints whose EB bodies are missing.
-  , leiosDbFilterMissingTxs :: HasCallStack => [TxHash] -> m [TxHash]
-  -- ^ Batch filter: returns the subset of input TxHashes that we do NOT have.
   , leiosDbLookupEbClosure :: HasCallStack => EbHash -> m (Maybe [(TxHash, ByteString)])
   -- ^ Read the EB "closure": the tx hashes AND their tx bytes. Contrast
   -- with 'leiosDbLookupEbBody' which returns only hashes + sizes.
diff --git a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoDb/InMemory.hs b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoDb/InMemory.hs
index 0d1afc578d..c816893982 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoDb/InMemory.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoDb/InMemory.hs
@@ -121,8 +121,6 @@ newLeiosDBInMemoryWith stateVar = do
               , leiosDbInsertEbBody = imInsertEbBody stateVar notificationChan
               , leiosDbInsertTxs = imInsertTxs stateVar notificationChan
               , leiosDbBatchRetrieveTxs = imBatchRetrieveTxs stateVar
-              , leiosDbFilterMissingEbBodies = imFilterMissingEbBodies stateVar
-              , leiosDbFilterMissingTxs = imFilterMissingTxs stateVar
               , leiosDbLookupEbClosure = imLookupEbClosure stateVar
               }
       }
@@ -291,17 +289,6 @@ imBatchRetrieveTxs stateVar ebHash offsets = atomically $ do
         , Just entry <- [IntMap.lookup offset offsetMap]
         ]
 
-imFilterMissingEbBodies ::
-  IOLike m => StrictTVar m InMemoryLeiosDb -> [LeiosPoint] -> m [LeiosPoint]
-imFilterMissingEbBodies stateVar points = atomically $ do
-  state <- readTVar stateVar
-  pure [p | p <- points, not $ Map.member p.pointEbHash (imEbBodies state)]
-
-imFilterMissingTxs :: IOLike m => StrictTVar m InMemoryLeiosDb -> [TxHash] -> m [TxHash]
-imFilterMissingTxs stateVar txHashes = atomically $ do
-  state <- readTVar stateVar
-  pure [txHash | txHash <- txHashes, not $ Map.member txHash (imTxs state)]
-
 imLookupEbClosure ::
   IOLike m => StrictTVar m InMemoryLeiosDb -> EbHash -> m (Maybe [(TxHash, ByteString)])
 imLookupEbClosure stateVar ebHash = atomically $ do
diff --git a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoDb/SQLite.hs b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoDb/SQLite.hs
index b5b3ab28c4..d0be25ff9e 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoDb/SQLite.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoDb/SQLite.hs
@@ -36,7 +36,6 @@ import qualified Data.ByteString as BS
 import qualified Data.ByteString.Builder as BB
 import qualified Data.ByteString.Lazy as BSL
 import Data.Int (Int64)
-import qualified Data.Map.Strict as Map
 import qualified Data.Set as Set
 import Data.String (fromString)
 import Database.SQLite3
@@ -129,7 +128,6 @@ data Stmts = Stmts
   , stMarkNotifiedEbs :: !DB.Statement
   , stMarkPointNotified :: !DB.Statement
   , stBatchRetrieveTxs :: !DB.Statement
-  , stFilterMissingEbBodies :: !DB.Statement
   , stFilterMissingTxs :: !DB.Statement
   , stLookupEbClosure :: !DB.Statement
   , stScanCompleteEbsSince :: !DB.Statement
@@ -154,7 +152,6 @@ prepareStmts db = do
   stMarkNotifiedEbs <- dbPrepare db (fromString sql_mark_notified_ebs)
   stMarkPointNotified <- dbPrepare db (fromString sql_mark_point_notified)
   stBatchRetrieveTxs <- dbPrepare db (fromString sql_retrieve_from_ebTxs_json)
-  stFilterMissingEbBodies <- dbPrepare db (fromString sql_filter_missing_eb_bodies_json)
   stFilterMissingTxs <- dbPrepare db (fromString sql_filter_missing_txs_json)
   stLookupEbClosure <- dbPrepare db (fromString sql_lookup_eb_closure)
   stScanCompleteEbsSince <- dbPrepare db (fromString sql_scan_complete_ebs_since)
@@ -175,7 +172,6 @@ finalizeStmts Stmts{..} = do
   dbFinalize stMarkNotifiedEbs
   dbFinalize stMarkPointNotified
   dbFinalize stBatchRetrieveTxs
-  dbFinalize stFilterMissingEbBodies
   dbFinalize stFilterMissingTxs
   dbFinalize stLookupEbClosure
   dbFinalize stScanCompleteEbsSince
@@ -217,8 +213,6 @@ openSQLiteConnection tracer dbPath notificationChan = do
       , leiosDbInsertEbBody = sqlInsertEbBody tracer conn notify
       , leiosDbInsertTxs = sqlInsertTxs tracer conn notify
       , leiosDbBatchRetrieveTxs = sqlBatchRetrieveTxs conn
-      , leiosDbFilterMissingEbBodies = sqlFilterMissingEbBodies conn
-      , leiosDbFilterMissingTxs = sqlFilterMissingTxs conn
       , leiosDbLookupEbClosure = sqlLookupEbClosure conn
       }
 
@@ -420,28 +414,10 @@ sqlBatchRetrieveTxs conn ebHash offsets =
         let mbTxBytes = if txBytes == mempty then Nothing else Just txBytes
         loop ((offset, txHash, mbTxBytes) : acc)
 
--- | Batch-filter EB points against @ebTxs@. Passes ebHashes as a JSON
--- array of hex strings; SQL decodes with @unhex()@ so index lookups on
--- @ebTxs.ebHashBytes@ still fire.
-sqlFilterMissingEbBodies :: Conn -> [LeiosPoint] -> IO [LeiosPoint]
-sqlFilterMissingEbBodies conn points =
-  dbWithTransaction db $ useStmt stmt $ do
-    dbBindUtf8 stmt 1 (jsonHexArray (map ebHashBytes (Map.keys pointsByHash)))
-    loop []
- where
-  Conn{connDb = db, connStmts = Stmts{stFilterMissingEbBodies = stmt}} = conn
-  pointsByHash = Map.fromList [(p.pointEbHash, p) | p <- points]
-  loop acc =
-    dbStep stmt >>= \case
-      DB.Done -> pure (reverse acc)
-      DB.Row -> do
-        ebHash <- MkEbHash <$> DB.columnBlob stmt 0
-        case Map.lookup ebHash pointsByHash of
-          Just p -> loop (p : acc)
-          Nothing -> loop acc
-
--- | Batch-filter tx hashes against @txs@. Same idiom as
--- 'sqlFilterMissingEbBodies'.
+-- | Batch-filter tx hashes against @txs@: passes txHashes as a JSON array
+-- of hex strings; SQL decodes with @unhex()@ so index lookups on
+-- @txs.txHashBytes@ still fire. Used internally by 'sqlInsertTxs' to skip
+-- already-persisted txs.
 sqlFilterMissingTxs :: Conn -> [TxHash] -> IO [TxHash]
 sqlFilterMissingTxs conn txHashes =
   dbWithTransaction db $ useStmt stmt $ do
@@ -578,17 +554,9 @@ sql_insert_tx =
   "INSERT INTO txs (txHashBytes, txBytes, txBytesSize) VALUES (?, ?, ?)\n\
   \"
 
--- | Batch-filter ebHashes via JSON1. Parameter is a JSON array of hex
+-- | Batch-filter txHashes via JSON1. Parameter is a JSON array of hex
 -- strings; 'unhex(je.value)' decodes back into a BLOB comparable against
--- the indexed @ebTxs.ebHashBytes@ column.
-sql_filter_missing_eb_bodies_json :: String
-sql_filter_missing_eb_bodies_json =
-  "SELECT unhex(je.value) FROM json_each(?) je\n\
-  \WHERE NOT EXISTS (SELECT 1 FROM ebTxs e WHERE e.ebHashBytes = unhex(je.value))\n\
-  \"
-
--- | Batch-filter txHashes via JSON1. Same shape as
--- 'sql_filter_missing_eb_bodies_json'.
+-- the indexed @txs.txHashBytes@ column.
 sql_filter_missing_txs_json :: String
 sql_filter_missing_txs_json =
   "SELECT unhex(je.value) FROM json_each(?) je\n\
diff --git a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
index 5eb068db31..45f3786a68 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
@@ -19,27 +19,33 @@ import qualified Control.Concurrent.Class.MonadMVar as MVar
 import qualified Control.Concurrent.Class.MonadSTM as LazySTM
 import Control.Concurrent.Class.MonadSTM.Strict (StrictTVar)
 import qualified Control.Concurrent.Class.MonadSTM.Strict as StrictSTM
-import Control.Monad (foldM, forM_, when)
+import Control.Monad (foldM, forM_, unless, when)
 import Control.Monad.Class.MonadThrow (Exception, catch, throwIO)
 import Control.Monad.Except (runExcept)
 import Control.Monad.Primitive (PrimMonad, PrimState)
-import Control.Tracer (Tracer, contramap, traceWith)
+import Control.Tracer (Tracer, contramap, nullTracer, traceWith)
 import qualified Data.Bits as Bits
 import qualified Data.ByteString as BS
-import Data.DList (DList)
-import qualified Data.DList as DList
+import Data.Foldable (fold)
 import Data.Functor (void, (<&>))
-import Data.IntMap (IntMap)
 import qualified Data.IntMap as IntMap
+import qualified Data.IntMap.NonEmpty as NEIntMap
 import qualified Data.IntSet as IntSet
+import Data.IntSet.NonEmpty (NEIntSet)
+import qualified Data.IntSet.NonEmpty as NEIntSet
 import Data.List (unfoldr)
+import Data.List.NonEmpty (NonEmpty ((:|)), nonEmpty)
 import Data.Map (Map)
 import qualified Data.Map.Strict as Map
+import Data.Maybe.Strict (StrictMaybe (..), strictMaybeToMaybe)
 import Data.Proxy (Proxy (..))
 import Data.Sequence (Seq)
 import qualified Data.Sequence as Seq
+import Data.Sequence.NonEmpty (NESeq)
+import qualified Data.Sequence.NonEmpty as NESeq
 import Data.Set (Set)
 import qualified Data.Set as Set
+import qualified Data.Set.NonEmpty as NESet
 import Data.Time.Clock (NominalDiffTime)
 import qualified Data.Vector.Strict as V
 import qualified Data.Vector.Strict.Mutable as MV
@@ -47,8 +53,6 @@ import Data.Word (Word16, Word64)
 import LeiosDemoDb
   ( LeiosDbConnection
   , leiosDbBatchRetrieveTxs
-  , leiosDbFilterMissingEbBodies
-  , leiosDbFilterMissingTxs
   , leiosDbInsertEbBody
   , leiosDbInsertEbPoint
   , leiosDbInsertTxs
@@ -72,7 +76,8 @@ import LeiosDemoLogic.Announcements.Validate
   )
 import qualified LeiosDemoOnlyTestFetch as LF
 import LeiosDemoTypes
-  ( AnnouncementEquivocation (..)
+  ( AlsoOfferedTxsClosure (..)
+  , AnnouncementEquivocation (..)
   , AnnouncementFields (..)
   , AnnouncementSource (..)
   , BytesSize
@@ -92,6 +97,10 @@ import LeiosDemoTypes
   , TraceLeiosKernel (..)
   , TraceLeiosPeer (..)
   , TxHash (..)
+  , fetchArrivalEvicted
+  , fetchArrivalExtra
+  , fetchArrivalGood
+  , fetchArrivalInvalid
   , hashLeiosEb
   , hashLeiosTx
   , leiosEbBytesSize
@@ -99,6 +108,7 @@ import LeiosDemoTypes
   , maxTxsPerEb
   )
 import qualified LeiosDemoTypes as Leios
+import qualified LeiosDemoTypes.LeiosJobs as Jobs
 import LeiosTxCache (LeiosTxCache (..))
 import Ouroboros.Consensus.Block
   ( BlockProtocol
@@ -111,7 +121,8 @@ import Ouroboros.Consensus.Block
   , toRawHash
   )
 import Ouroboros.Consensus.BlockchainTime.WallClock.Types
-  ( SystemTime
+  ( RelativeTime
+  , SystemTime
   , diffRelTime
   , systemTimeCurrent
   )
@@ -127,6 +138,10 @@ import Ouroboros.Consensus.Storage.LedgerDB.Forker
   , ResolveLeiosBlock (..)
   )
 import Ouroboros.Consensus.Util.IOLike (IOLike)
+import Ouroboros.Network.PeerSelection.LedgerPeers.Type
+  ( IsBigLedgerPeer (..)
+  )
+import System.Random (StdGen)
 
 -- | Wrap an action with exception tracing. Catches the exception,
 -- traces it using the provided handler, and re-throws.
@@ -174,8 +189,18 @@ recordForgedEbAndClosureInTxCache ::
   m ()
 recordForgedEbAndClosureInTxCache tracer txCache rbh forgedEb = do
   _ <- txCache.insertAnnouncement point.pointSlotNo rbh point.pointEbHash
-  mSummary <- txCache.insertBody point.pointEbHash (Leios.serializeEbBody eb)
-  forM_ mSummary $ traceWith tracer . TraceLeiosTxCacheEbBody point
+  -- The forge path does not fetch, so it discards the miss set: a unit
+  -- accumulator and a no-op snoc.
+  mbSummary <-
+    fmap (fmap @Maybe (\(x, ()) -> x)) $
+      insertBody txCache point.pointEbHash (Leios.serializeEbBody eb) () (\() _ _ _ -> ())
+  -- A forged body holds its whole closure locally: every tx not already in the
+  -- cache came from our own mempool (that is where the forge selected them). There
+  -- is no actual mempool-pull stage, so attribute those txs -- @txsInEb - acquired@
+  -- -- to mempool hits directly, making the combined cache+mempool hit rate 100%.
+  forM_ mbSummary $ \summary ->
+    traceWith tracer $
+      TraceLeiosBodyHits point summary (Leios.ibsTxsInEb summary - Leios.ibsAcquired summary) 0
   withLockedInsertAppliedTx txCache $ \w0 step ->
     foldM (\w (txh, _sz) -> step w txh ()) w0 (leiosEbTxs eb)
  where
@@ -265,13 +290,7 @@ msgLeiosBlockTxsRequest _tracer leiosContext point bitmaps = do
       error $ "An offset exceeds the theoretical limit " <> show idxLimit
     when (not $ and $ zipWith (<) idxs (drop 1 idxs)) $ do
       error "Offsets not strictly ascending"
-  let nextOffset = \case
-        [] -> Nothing
-        (idx, bitmap) : k -> case popLeftmostOffset bitmap of
-          Nothing -> nextOffset k
-          Just (i, bitmap') ->
-            Just (64 * fromIntegral idx + i, (idx, bitmap') : k)
-      txOffsets = unfoldr nextOffset bitmaps
+  let txOffsets = bitmapOffsets bitmaps
   n <- do
     -- Use new db to batch retrieve transactions
     results <- leiosDbBatchRetrieveTxs leiosDbConn point.pointEbHash txOffsets
@@ -310,61 +329,20 @@ popLeftmostOffset = \case
 
 -----
 
-newtype LeiosFetchDecisions pid
-  = MkLeiosFetchDecisions
-      (Map (PeerId pid) (Map SlotNo (DList (TxHash, BytesSize, Map EbHash Int), DList (EbHash, BytesSize))))
-
-emptyLeiosFetchDecisions :: LeiosFetchDecisions pid
-emptyLeiosFetchDecisions = MkLeiosFetchDecisions Map.empty
-
--- | Filter outstanding work against the database.
--- Removes EB bodies and TXs that we already have in the DB.
--- This should be called before leiosFetchLogicIteration to avoid re-fetching.
+-- | Decide what to request from each peer right now
 --
--- NOTE: This is the minimal integration of DB filtering into the fetch logic.
--- The outstanding state tracks what we think is missing, but the DB is the
--- source of truth. This function reconciles the two by filtering out items
--- that have been acquired (possibly from other sources like forging).
-filterMissingWork ::
-  IOLike m =>
-  LeiosDbConnection m ->
-  LeiosOutstanding pid ->
-  m (LeiosOutstanding pid)
-filterMissingWork db outstanding = do
-  -- Ask DB which of our "missing" EBs are actually still missing
-  let ebPoints = Map.keys (Leios.missingEbBodies outstanding)
-  stillMissingPoints <- leiosDbFilterMissingEbBodies db ebPoints
-  let stillMissingPointSet = Set.fromList stillMissingPoints
-      filteredMissingEbBodies = Map.restrictKeys (Leios.missingEbBodies outstanding) stillMissingPointSet
-      acquiredEbHashes = [p.pointEbHash | p <- ebPoints, Set.notMember p stillMissingPointSet]
-  -- Ask DB which of our "missing" TXs are actually still missing
-  let allTxHashes =
-        Set.toList $
-          Set.fromList
-            [ txHash
-            | txs <- Map.elems (Leios.missingEbTxs outstanding)
-            , (txHash, _) <- IntMap.elems txs
-            ]
-  stillMissingTxs <- leiosDbFilterMissingTxs db allTxHashes
-  let stillMissingTxSet = Set.fromList stillMissingTxs
-      filteredMissingEbTxs =
-        Map.filter (not . IntMap.null) $
-          Map.map
-            (IntMap.filter (\(txHash, _) -> Set.member txHash stillMissingTxSet))
-            (Leios.missingEbTxs outstanding)
-      filteredReverseEbIndexByTx =
-        Map.filterWithKey
-          (\txHash _ -> Set.member txHash stillMissingTxSet)
-          (Leios.reverseEbIndexByTx outstanding)
-  pure $
-    outstanding
-      { Leios.missingEbBodies = filteredMissingEbBodies
-      , Leios.missingEbTxs = filteredMissingEbTxs
-      , Leios.reverseEbIndexByTx = filteredReverseEbIndexByTx
-      , Leios.acquiredEbBodies =
-          Leios.acquiredEbBodies outstanding `Set.union` Set.fromList acquiredEbHashes
-      }
-
+-- A big-ledger peer (per 'bigLedgerPeers') is fetched from aggressively: it has a
+-- larger per-peer byte budget, enough that a closure it offers is requested in
+-- full (the whole remaining job pool) at once.
+--
+-- NOTE that this does not read txs from the LeiosTxCache nor from the Mempool;
+-- that happened when the EB body arrived, in 'processLeiosBlock'. (TODO the
+-- LeiosFetch client could also check the LeiosTxCache and the Mempool just
+-- before it sends the request? The major cost is that doing so requires
+-- retaining the individual txs' hashes in memory and/or fetching them from
+-- disk, which adds complexity and\/or latency. At least with the /current/
+-- SQLite-based LeiosDb backend, that complexity and\/or latency is not the
+-- responsibility of the LeiosFetch logic.)
 leiosFetchLogicIteration ::
   forall pid.
   Ord pid =>
@@ -372,242 +350,324 @@ leiosFetchLogicIteration ::
   -- | The current slot, or 'Nothing' when it is not yet known (i.e. we are
   -- syncing), in which case we fetch freshest-last instead of freshest-first.
   Maybe SlotNo ->
-  Map (PeerId pid) (Set EbHash, Set EbHash) ->
+  Map (PeerId pid) (Map LeiosPoint AlsoOfferedTxsClosure) ->
+  -- | Which peers are big-ledger peers (a peer absent from this map is treated as
+  -- 'IsNotBigLedgerPeer').
+  Map (PeerId pid) IsBigLedgerPeer ->
   LeiosOutstanding pid ->
-  (LeiosOutstanding pid, LeiosFetchDecisions pid)
-leiosFetchLogicIteration env mbCurrentSlot offerings =
-  \acc ->
-    go1 acc emptyLeiosFetchDecisions $
-      expand $
-        prioritize $
-          Map.map Left (Leios.missingEbBodies acc) `Map.union` Map.map Right (Leios.missingEbTxs acc)
+  -- | The new outstanding state, the requests to send, and the offers to prune
+  ( LeiosOutstanding pid
+  , Map (PeerId pid) (NESeq LeiosFetchRequest)
+  , Map (PeerId pid) (NESet.NESet LeiosPoint)
+  )
+leiosFetchLogicIteration env mbCurrentSlot offerings bigLedgerPeers = \acc0 ->
+  -- One pass per peer. Bodies and tx-closure jobs compete on equal footing,
+  -- ranked by each EB's slot in 'ebState' (its greatest announcement slot), so
+  -- the freshest EBs are fetched first regardless of which half they still need.
+  -- Each peer's 'assignPeer' yields only its own requests and dead offers; fold
+  -- those into the per-peer maps here.
+  Map.foldlWithKey'
+    ( \(acc, reqs, drops) peerId offers ->
+        let isBig = Map.findWithDefault IsNotBigLedgerPeer peerId bigLedgerPeers
+            (acc', peerReqs, peerDrops) = assignPeer env mbCurrentSlot isBig peerId offers acc
+         in ( acc'
+            , case NESeq.nonEmptySeq peerReqs of
+                Nothing -> reqs
+                Just neReqs -> Map.insert peerId neReqs reqs
+            , case NESet.nonEmptySet peerDrops of
+                Nothing -> drops
+                Just nes -> Map.insert peerId nes drops
+            )
+    )
+    (acc0, Map.empty, Map.empty)
+    offerings
+
+-- | A peer's remaining outstanding-byte budget. The only "global limit" falls
+-- out as this per-peer cap multiplied by the peer count. That's good so that
+-- an adversarial peer can't occupy "too much" of some fixed global budget,
+-- thereby starving honest peers.
+--
+-- Big-ledger peers get a larger cap (so they can be asked for a whole EB closure
+-- at once), but still a bounded one -- even a stake-based peer might be adversarial.
+peerBudget ::
+  Ord pid => LeiosFetchStaticEnv -> IsBigLedgerPeer -> LeiosOutstanding pid -> PeerId pid -> Int
+peerBudget env isBig acc peerId =
+  fromIntegral cap
+    - fromIntegral (Map.findWithDefault 0 peerId (Leios.requestedBytesSizePerPeer acc))
  where
-  -- Once we know the current slot we fetch freshest-first; until then we are
-  -- syncing, so we fetch freshest-last (i.e. oldest-first) to make progress
-  -- from the tip of our chain forward.
-  prioritize m = case mbCurrentSlot of
-    Nothing -> Map.toAscList m
-    Just _currentSlot -> Map.toDescList m
-
-  expand = \case
-    [] -> []
-    (point, Left ebBytesSize) : vs -> Left (point, ebBytesSize) : expand vs
-    (point, Right v) : vs ->
-      [Right (point, txBytesSize, txHash) | (_txOffset, (txHash, txBytesSize)) <- IntMap.toAscList v]
-        <> expand vs
-
-  go1 ::
-    LeiosOutstanding pid ->
-    LeiosFetchDecisions pid ->
-    [Either (LeiosPoint, BytesSize) (LeiosPoint, BytesSize, TxHash)] ->
-    (LeiosOutstanding pid, LeiosFetchDecisions pid)
-  go1 !acc !accNew = \case
-    [] ->
-      (acc, accNew)
-    Left (point, ebBytesSize) : targets
-      | let peerIds :: Set (PeerId pid)
-            peerIds = Map.findWithDefault Set.empty point.pointEbHash (Leios.requestedEbPeers acc) ->
-          goEb2 acc accNew targets point ebBytesSize peerIds
-    Right (point, txBytesSize, txHash) : targets ->
-      let !txOffsets = case Map.lookup txHash (Leios.reverseEbIndexByTx acc) of
-            Nothing -> error "impossible!"
-            Just x -> x
-          peerIds :: Set (PeerId pid)
-          peerIds = Map.findWithDefault Set.empty txHash (Leios.requestedTxPeers acc)
-       in goTx2 acc accNew targets point txBytesSize txHash txOffsets peerIds
-
-  goEb2 !acc !accNew targets point ebBytesSize peerIds
-    | Leios.requestedBytesSize acc >= Leios.maxRequestedBytesSize env -- we can't request anything
-      =
-        (acc, accNew)
-    | Set.size peerIds < Leios.maxRequestsPerEb env -- we would like to request it from an additional peer
-    , Just peerId <- choosePeerEb peerIds acc point.pointEbHash =
-        -- there's a peer who offered it and we haven't already requested it from them
-        let accNew' =
-              MkLeiosFetchDecisions $
-                Map.insertWith
-                  (Map.unionWith (<>))
-                  peerId
-                  ( Map.singleton
-                      point.pointSlotNo
-                      (DList.empty, DList.singleton (point.pointEbHash, ebBytesSize))
-                  )
-                  (let MkLeiosFetchDecisions x = accNew in x)
-            acc' =
-              acc
-                { Leios.requestedEbPeers =
-                    Map.insertWith Set.union point.pointEbHash (Set.singleton peerId) (Leios.requestedEbPeers acc)
-                , Leios.requestedBytesSizePerPeer =
-                    Map.insertWith (+) peerId ebBytesSize (Leios.requestedBytesSizePerPeer acc)
-                , Leios.requestedBytesSize = ebBytesSize + Leios.requestedBytesSize acc
-                }
-            peerIds' = Set.insert peerId peerIds
-         in goEb2 acc' accNew' targets point ebBytesSize peerIds'
-    | otherwise =
-        go1 acc accNew targets
-
-  choosePeerEb :: Set (PeerId pid) -> LeiosOutstanding pid -> EbHash -> Maybe (PeerId pid)
-  choosePeerEb peerIds acc ebHash =
-    foldr (\a _ -> Just a) Nothing $
-      [ peerId
-      | (peerId, (ebHashes, _ebHashes)) <-
-          Map.toList $ -- TODO prioritize/shuffle?
-            (`Map.withoutKeys` peerIds) $ -- not already requested from this peer
-              offerings
-      , Map.findWithDefault 0 peerId (Leios.requestedBytesSizePerPeer acc)
-          <= Leios.maxRequestedBytesSizePerPeer env
-      , -- peer can be sent more requests
-      ebHash `Set.member` ebHashes -- peer has offered this EB body
-      ]
-
-  goTx2 ::
-    LeiosOutstanding pid ->
-    LeiosFetchDecisions pid ->
-    [Either (LeiosPoint, BytesSize) (LeiosPoint, BytesSize, TxHash)] ->
-    LeiosPoint ->
-    BytesSize ->
-    TxHash ->
-    Map EbHash (Int, BytesSize) ->
-    Set (PeerId pid) ->
-    (LeiosOutstanding pid, LeiosFetchDecisions pid)
-  goTx2 !acc !accNew targets point txBytesSize txHash txOffsets peerIds
-    | Leios.requestedBytesSize acc >= Leios.maxRequestedBytesSize env -- we can't request anything
-      =
-        (acc, accNew)
-    | Set.size peerIds < Leios.maxRequestsPerTx env -- we would like to request it from an additional peer
-    -- TODO if requests list priority, does this limit apply even if the
-    -- tx has only been requested at lower priorities?
-    , Just (peerId, txOffsets') <- choosePeerTx peerIds acc txOffsets txBytesSize =
-        -- there's a peer who offered it and we haven't already requested it from them
-        let accNew' =
-              MkLeiosFetchDecisions $
-                Map.insertWith
-                  (Map.unionWith (<>))
-                  peerId
-                  (Map.singleton point.pointSlotNo (DList.singleton (txHash, txBytesSize, txOffsets'), DList.empty))
-                  (let MkLeiosFetchDecisions x = accNew in x)
-            acc' =
-              acc
-                { Leios.requestedTxPeers =
-                    Map.insertWith Set.union txHash (Set.singleton peerId) (Leios.requestedTxPeers acc)
-                , Leios.requestedBytesSizePerPeer =
-                    Map.insertWith (+) peerId txBytesSize (Leios.requestedBytesSizePerPeer acc)
-                , Leios.requestedBytesSize = txBytesSize + Leios.requestedBytesSize acc
-                }
-            peerIds' = Set.insert peerId peerIds
-         in goTx2 acc' accNew' targets point txBytesSize txHash txOffsets peerIds'
-    | otherwise =
-        go1 acc accNew targets
-
-  choosePeerTx ::
-    Set (PeerId pid) ->
-    LeiosOutstanding pid ->
-    Map EbHash (Int, BytesSize) ->
-    BytesSize ->
-    Maybe (PeerId pid, Map EbHash Int)
-  choosePeerTx peerIds acc txOffsets targetTxBytesSize =
-    foldr (\a _ -> Just a) Nothing $
-      [ (peerId, Map.map fst txOffsetsMatching)
-      | (peerId, (_ebIds, ebIds)) <-
-          Map.toList $ -- TODO prioritize/shuffle?
-            (`Map.withoutKeys` peerIds) $ -- not already requested from this peer
-              offerings
-      , Map.findWithDefault 0 peerId (Leios.requestedBytesSizePerPeer acc)
-          <= Leios.maxRequestedBytesSizePerPeer env
-      , -- peer can be sent more requests
-      let txOffsets' = txOffsets `Map.restrictKeys` ebIds
-          -- Filter to entries whose recorded tx size matches the target's
-          -- authority. The recorded size in 'reverseEbIndexByTx' can disagree
-          -- across EBs (e.g. a malformed body delivered under a different EB
-          -- hash); a single tx hash uniquely determines content, so any entry
-          -- with a different size is bogus and must not carry the request.
-          txOffsetsMatching =
-            Map.filter (\(_, txBytesSize) -> txBytesSize == targetTxBytesSize) txOffsets'
-      , -- peer has offered at least one EB closure recording this
-      -- tx at the authoritative size
-      not (Map.null txOffsetsMatching)
-      ]
-
-packRequests ::
+  cap = case isBig of
+    IsBigLedgerPeer -> Leios.maxRequestedBytesSizePerBigLedgerPeer env
+    IsNotBigLedgerPeer -> Leios.maxRequestedBytesSizePerPeer env
+
+-- | Prioritize a peer's Leios offers
+--
+-- The offers are categorized into two tiers. The high-priority tier prioritizes
+-- /staler/ EBs (those with lesser slot numbers). The low-priority tier
+-- prioritizes /fresher/ EBs (those with greater slot numbers).
+--
+-- 'assignPeer' processes the high-priority tier first and then it carries over
+-- the resulting accumulator in order to process the low-priority tier.
+--
+-- When the node's ledger state is too old to know what the current slot is, all
+-- EBs are categorized as the high-priority tier, and the low-priority tier is
+-- empty.
+--
+-- When the current slot is known, the high-priority tier is only the freshest
+-- EBs, those no older than L = 3*L_hdr + L_vote + L_diff (ie whose slot is @>=
+-- currentSlot - L@). All EBs older than that are categorized as the
+-- low-priority tier.
+fetchPriorityTiers ::
+  Maybe SlotNo -> Word64 -> Map LeiosPoint v -> ([(LeiosPoint, v)], [(LeiosPoint, v)])
+fetchPriorityTiers mbCurrentSlot l offers =
+  (Map.toAscList highTier, Map.toDescList lowTier)
+ where
+  (highTier, lowTier) = case mbCurrentSlot of
+    Nothing -> (offers, Map.empty)
+    Just (SlotNo s) ->
+      -- @a + l < s@ (i.e. @a < S - L@) is the low tier, guarding underflow when
+      -- @S < L@; 'spanAntitone' relies on it being false-suffixed in slot order.
+      let (stale, fresh) = Map.spanAntitone (\p -> case p.pointSlotNo of SlotNo a -> a + l < s) offers
+       in (fresh, stale)
+
+-- | Walk this peer's offered points in priority order (see
+-- 'fetchPriorityTiers'), assigning requests to the peer until it's saturated at
+-- 'Leios.maxRequestedBytesSizePerPeer'. A big-ledger peer saturates instead at
+-- the larger 'Leios.maxRequestedBytesSizePerBigLedgerPeer', enough that a
+-- couple closures it offers can be entirely inflight at the same time (see
+-- 'assignClosure').
+--
+-- Offers beyond the saturation point are never visited, so aren't pruned this
+-- pass; that's fine because it's ephemeral and/or the other prune based on the
+-- imm-tip advancing is a backstop.
+assignPeer ::
+  Ord pid =>
   LeiosFetchStaticEnv ->
-  LeiosFetchDecisions pid ->
-  Map (PeerId pid) (Seq LeiosFetchRequest)
-packRequests env =
-  \(MkLeiosFetchDecisions x) -> Map.map goPeer x
+  Maybe SlotNo ->
+  IsBigLedgerPeer ->
+  PeerId pid ->
+  Map LeiosPoint AlsoOfferedTxsClosure ->
+  LeiosOutstanding pid ->
+  (LeiosOutstanding pid, Seq LeiosFetchRequest, Set LeiosPoint)
+assignPeer env mbCurrentSlot isBig peerId offers acc =
+  -- Walk the high-priority tier, then the low, threading the accumulator; the
+  -- second walk immediately short-circuits if the first already saturated the
+  -- peer.
+  go (go (acc, Seq.empty, Set.empty) highTier) lowTier
  where
-  goPeer =
-    Map.foldlWithKey
-      (\acc prio (txs, ebs) -> goPrioTx prio txs <> goPrioEb prio ebs <> acc)
-      -- TODO priority within same slot?
-      Seq.empty
-
-  goPrioEb prio ebs =
-    DList.foldr (Seq.:<|) Seq.empty $
-      DList.map
-        ( \(ebHash, ebBytesSize) ->
-            LeiosBlockRequest $ MkLeiosBlockRequest (MkLeiosPoint prio ebHash) ebBytesSize
-        )
-        ebs
-
-  goPrioTx prio txs =
-    Map.foldlWithKey
-      ( \acc ebHash txs' ->
-          goEb {- prio -}
-            (MkLeiosPoint prio ebHash)
-            0
-            IntMap.empty
-            0
-            DList.empty
-            (IntMap.toAscList txs')
-            <> acc
-      )
-      Seq.empty
-      -- group by EbId, sort by offset ascending
-      $ Map.fromListWith IntMap.union
-      $ [ (,) ebId $ IntMap.singleton txOffset (txHash, txBytesSize)
-        | (txHash, txBytesSize, txOffsets) <- DList.toList txs
-        , -- TODO somewhat arbitrarily choosing the freshest EbId here; merely
-        -- something simple and sufficient for the demo
-        let (ebId, txOffset) =
-              case Map.lookupMax txOffsets of
-                Nothing -> error "impossible!"
-                Just x -> x
-        ]
-
-  goEb ::
-    LeiosPoint ->
-    BytesSize ->
-    IntMap Word64 ->
-    Int ->
-    DList TxHash ->
-    [(Int, (TxHash, BytesSize))] ->
-    Seq LeiosFetchRequest
-  -- TODO the incoming indexes are ascending, so the IntMap accumulator could
-  -- be simplified away
-  goEb p !accTxBytesSize !accBitmaps !accN !accHashes = \case
-    [] -> if 0 < accN then Seq.singleton flush else Seq.empty
-    txsAgain@((txOffset, (txHash, txBytesSize)) : txs)
-      | Leios.maxRequestBytesSize env < accTxBytesSize' ->
-          flush Seq.:<| goEb p 0 IntMap.empty 0 DList.empty txsAgain
-      | otherwise
-      , let (q, r) = txOffset `divMod` 64 ->
-          goEb
-            p
-            accTxBytesSize'
-            (IntMap.insertWith (Bits..|.) q (Bits.bit (63 - r)) accBitmaps)
-            (accN + 1)
-            (accHashes `DList.snoc` txHash)
-            txs
-     where
-      accTxBytesSize' = accTxBytesSize + txBytesSize
+  (highTier, lowTier) = fetchPriorityTiers mbCurrentSlot (Leios.fetchPriorityWindowSlots env) offers
+
+  go st@(acc', _dec, _drops) = \case
+    [] -> st
+    (point, offerKind) : rest
+      | peerBudget env isBig acc' peerId <= 0 -> st
+      | otherwise -> go (classify point offerKind st) rest
+
+  classify point offerKind (acc1, dec1, drops) =
+    case Map.lookup ebHash (Leios.ebState acc1) of
+      Nothing ->
+        -- We are no longer tracking this EB (pruned off below the
+        -- imm-tip). This is an ephemeral state, mid prune, but go ahead and
+        -- prune it now.
+        pruneThisOffer
+      Just (Leios.MkEbState slot _onset fetchState) -> case (fetchState, offerKind) of
+        (Leios.BodyImminent, _) ->
+          -- Our forge is producing this EB, so we hold the whole datum (even
+          -- though it might not be inserted yet): never request it, and the
+          -- peer's offer is dead.
+          pruneThisOffer
+        (Leios.NoBody, TxsClosureNotAlsoOffered) ->
+          -- Body-only offer: request the body. If that's all that was
+          -- offered, prune it.
+          let (acc2, dec2) = assignBody peerId ebHash slot (acc1, dec1)
+           in (acc2, dec2, Set.insert point drops)
+        (Leios.NoBody, TxsClosureAlsoOffered) ->
+          -- Request the body now, but keep the offer: we will request the
+          -- closure from this peer once we hold the body.
+          let (acc2, dec2) = assignBody peerId ebHash slot (acc1, dec1)
+           in (acc2, dec2, drops)
+        (Leios.BodyAcquired _jobPool, TxsClosureNotAlsoOffered) ->
+          -- We hold the body and the peer never offered the closure, so it
+          -- can no longer help.
+          pruneThisOffer
+        (Leios.BodyAcquired jobPool, TxsClosureAlsoOffered)
+          | Jobs.nullLeiosJobPool jobPool ->
+              -- whole datum in hand: the closure offer is useless now too
+              pruneThisOffer
+          | otherwise ->
+              -- Still need the txs, and the peer offered the closure. If we
+              -- just now assign all remaining jobs to the peer, prune its
+              -- offer.
+              let ((acc2, dec2), MkWhetherPeerEbExhausted exhausted) =
+                    assignClosure env isBig peerId ebHash (acc1, dec1)
+               in (acc2, dec2, if not exhausted then drops else Set.insert point drops)
    where
-    flush =
-      LeiosBlockTxsRequest $
-        MkLeiosBlockTxsRequest
-          {- prio -}
-          p
-          [(fromIntegral idx, bitmap) | (idx, bitmap) <- IntMap.toAscList accBitmaps]
-          (V.fromListN accN $ DList.toList accHashes)
+    ebHash = point.pointEbHash
+
+    pruneThisOffer = (acc1, dec1, Set.insert point drops)
+
+-- | Request the EB body from this peer
+assignBody ::
+  Ord pid =>
+  PeerId pid ->
+  EbHash ->
+  SlotNo ->
+  (LeiosOutstanding pid, Seq LeiosFetchRequest) ->
+  (LeiosOutstanding pid, Seq LeiosFetchRequest)
+assignBody peerId ebHash slot st@(acc, dec)
+  | peerId `Set.member` Map.findWithDefault Set.empty ebHash (Leios.requestedEbPeers acc) =
+      -- unless we've already requested it from them
+      st
+  | otherwise =
+      case bodySize acc ebHash of
+        Nothing ->
+          -- another ephemeral case where 'ebState' has been pruned before the
+          -- offers have
+          st
+        Just size ->
+          let acc' =
+                acc
+                  { Leios.requestedEbPeers =
+                      Map.insertWith Set.union ebHash (Set.singleton peerId) (Leios.requestedEbPeers acc)
+                  , Leios.requestedBytesSizePerPeer =
+                      Map.insertWith (+) peerId size (Leios.requestedBytesSizePerPeer acc)
+                  }
+           in (acc', dec Seq.|> LeiosBlockRequest (MkLeiosBlockRequest (MkLeiosPoint slot ebHash) size))
+
+-- | Flag indicating whether all jobs matching a peer's offers are already
+-- inflight
+newtype WhetherPeerEbExhausted = MkWhetherPeerEbExhausted Bool
+
+-- | Request tx-closure jobs from this peer, the least-requested ones we haven't
+-- already requested from it. Keep adding jobs until the peer is saturated or
+-- there are no jobs left. Also returns whether there are no jobs left.
+assignClosure ::
+  Ord pid =>
+  LeiosFetchStaticEnv ->
+  IsBigLedgerPeer ->
+  PeerId pid ->
+  EbHash ->
+  (LeiosOutstanding pid, Seq LeiosFetchRequest) ->
+  ((LeiosOutstanding pid, Seq LeiosFetchRequest), WhetherPeerEbExhausted)
+assignClosure env isBig peerId ebHash st@(acc, dec) =
+  case Map.lookup ebHash (Leios.ebState acc) of
+    Nothing -> (st, MkWhetherPeerEbExhausted False)
+    Just (Leios.MkEbState _slot _onset Leios.NoBody) -> (st, MkWhetherPeerEbExhausted False)
+    Just (Leios.MkEbState _slot _onset Leios.BodyImminent) -> (st, MkWhetherPeerEbExhausted False)
+    Just (Leios.MkEbState slot onset (Leios.BodyAcquired jobPool)) ->
+      let inflightJobs =
+            maybe IntSet.empty NEIntSet.toSet $
+              Map.lookup ebHash =<< Map.lookup peerId (Leios.requestedJobsPerPeer acc)
+          -- A big-ledger peer gets a larger budget ('peerBudget'), enough for multiple
+          -- full EB closures at once, but still bounded.
+          --
+          -- There are no more than 184 jobs per EB, so picked can't be a /long/ list.
+          --
+          -- 'pickJobs' draws from the decision loop's own PRNG ('leiosFetchPrng');
+          -- its advanced state is written back below (unchanged when nothing is
+          -- picked, so the 'Nothing' branch's 'st' is correct as-is).
+          (picked, jobPool', prng', exhausted) =
+            pickJobs (Leios.leiosFetchPrng acc) inflightJobs jobPool (peerBudget env isBig acc peerId)
+       in flip (,) exhausted $ case nonEmpty picked of
+            Nothing -> st
+            Just nePicked ->
+              let acc' =
+                    acc
+                      { Leios.ebState =
+                          Map.insert
+                            ebHash
+                            (Leios.MkEbState slot onset (Leios.BodyAcquired jobPool'))
+                            (Leios.ebState acc)
+                      , Leios.requestedJobsPerPeer =
+                          Map.insertWith
+                            (Map.unionWith NEIntSet.union)
+                            peerId
+                            (Map.singleton ebHash $ NEIntSet.fromList $ fmap (\(Jobs.MkLeiosJobId i, _) -> i) nePicked)
+                            (Leios.requestedJobsPerPeer acc)
+                      , Leios.requestedBytesSizePerPeer =
+                          Map.insertWith
+                            (+)
+                            peerId
+                            (sum $ fmap (\(_, Jobs.MkLeiosJob _ bytes _) -> bytes) nePicked)
+                            (Leios.requestedBytesSizePerPeer acc)
+                      , Leios.leiosFetchPrng = prng'
+                      }
+                  reqs = batchTxsRequests env (MkLeiosPoint slot ebHash) nePicked
+               in (acc', dec <> Seq.fromList reqs)
+
+-- | The announced body size of an EB we are still missing. All points of a hash
+-- share the size, so any one still listed in 'missingEbBodies' serves.
+bodySize :: LeiosOutstanding pid -> EbHash -> Maybe BytesSize
+bodySize acc ebHash = do
+  slots <- Map.lookup ebHash (Leios.reverseSlotIndexByEbHash acc)
+  Map.lookup (MkLeiosPoint (NESet.findMin slots) ebHash) (Leios.missingEbBodies acc)
+
+-- | Take least-requested-available jobs until the budget is spent or
+-- there are no more jobs that aren't already assigned to this peer. Also
+-- returns true, in the latter case. Each pick carries the whole 'Jobs.LeiosJob'
+-- (id + commitment) so the request can validate its own response. The supplied
+-- PRNG shuffles which job is drawn within the least-requested bucket; its
+-- advanced state is returned so the caller can persist it.
+pickJobs ::
+  StdGen ->
+  IntSet.IntSet ->
+  Jobs.LeiosJobPool ->
+  Int ->
+  ([(Jobs.LeiosJobId, Jobs.LeiosJob)], Jobs.LeiosJobPool, StdGen, WhetherPeerEbExhausted)
+pickJobs prng0 inflightJobs0 jobPool0 budget0 =
+  go prng0 inflightJobs0 jobPool0 budget0 []
+ where
+  go prng inflightJobs jobPool budget acc
+    | budget <= 0 = (reverse acc, jobPool, prng, MkWhetherPeerEbExhausted False)
+    | otherwise = case Jobs.pickLeastRequestedJobExcept prng inflightJobs jobPool of
+        Nothing -> (reverse acc, jobPool, prng, MkWhetherPeerEbExhausted True)
+        Just (jid@(Jobs.MkLeiosJobId i), job@(Jobs.MkLeiosJob _offsets bytes _root), jobPool', prng') ->
+          go
+            prng'
+            (IntSet.insert i inflightJobs)
+            jobPool'
+            (budget - fromIntegral bytes)
+            ((jid, job) : acc)
+
+-- | Partition the picked jobs into requests, each within 'maxRequestBytesSize'
+-- (a lone job above the cap simply forms its own request). Each request carries
+-- the jobs it covers with their commitments; the wire bitmap is derived from the
+-- union of their offsets at send time. Order within a request is irrelevant
+-- (union offsets, set of ids, independent per-job validation).
+batchTxsRequests ::
+  LeiosFetchStaticEnv ->
+  LeiosPoint ->
+  NonEmpty (Jobs.LeiosJobId, Jobs.LeiosJob) ->
+  [LeiosFetchRequest]
+batchTxsRequests env point (j0 :| rest0) =
+  go j0 [] (jobBytes j0) rest0
+ where
+  cap = fromIntegral (Leios.maxRequestBytesSize env) :: Int
+  jobBytes (_jid, Jobs.MkLeiosJob _offs bytes _root) = fromIntegral bytes :: Int
+  -- 'accRev' are the batch's jobs after its seed; a batch is always non-empty.
+  -- 'NEIntMap.fromList' keys by the raw job id; the picks are distinct ids, so no
+  -- merge.
+  flush seed accRev =
+    LeiosBlockTxsRequest $
+      MkLeiosBlockTxsRequest
+        point
+        (NEIntMap.fromList (fmap (\(Jobs.MkLeiosJobId i, job) -> (i, job)) (seed :| reverse accRev)))
+  go seed accRev _curBytes [] = [flush seed accRev]
+  go seed accRev curBytes (j : rest)
+    | curBytes + jobBytes j > cap = flush seed accRev : go j [] (jobBytes j) rest
+    | otherwise = go seed (j : accRev) (curBytes + jobBytes j) rest
+
+-- | The offset set as the wire bitmap (chunk index, 64-bit mask).
+offsetsToBitmap :: IntSet.IntSet -> [(Word16, Word64)]
+offsetsToBitmap offsets =
+  [ (fromIntegral q, bm)
+  | (q, bm) <- IntMap.toAscList chunks
+  ]
+ where
+  chunks =
+    IntSet.foldr
+      (\off -> let (q, r) = off `divMod` 64 in IntMap.insertWith (Bits..|.) q (Bits.bit (63 - r)))
+      IntMap.empty
+      offsets
 
 -----
 
@@ -631,6 +691,12 @@ nextLeiosFetchClientCommand ::
   ) ->
   LeiosTxCache m () () SerializedEbBody ->
   LeiosDbConnection m ->
+  -- | For reporting each arriving EB's age (see 'processLeiosBlock').
+  SystemTime m ->
+  -- | Pull EB-body misses out of the local mempool; see 'processLeiosBlock'.
+  ( IntMap.IntMap (TxHash, BytesSize) ->
+    m (IntMap.IntMap (TxHash, BytesSize), Map TxHash BS.ByteString)
+  ) ->
   PeerId pid ->
   StrictTVar m (Seq LeiosFetchRequest) ->
   -- | Queue of responses received by the pipelined collector thread.
@@ -643,7 +709,7 @@ nextLeiosFetchClientCommand ::
         (m (Either () (LF.SomeLeiosFetchJob LeiosPoint LeiosEb LeiosTx m)))
         (Either () (LF.SomeLeiosFetchJob LeiosPoint LeiosEb LeiosTx m))
     )
-nextLeiosFetchClientCommand ktracer tracer stopSTM kernelVars txCache db peerId reqsVar responseQ = do
+nextLeiosFetchClientCommand ktracer tracer stopSTM kernelVars txCache db systemTime pullFromMempool peerId reqsVar responseQ = do
   drainResponses
   StrictSTM.atomically checkOrPeek >>= \case
     Right result -> pure $ Right result
@@ -655,9 +721,25 @@ nextLeiosFetchClientCommand ktracer tracer stopSTM kernelVars txCache db peerId
     pending <- StrictSTM.atomically $ LazySTM.flushTQueue responseQ
     forM_ pending $ \case
       PendingBlockResponse req eb ->
-        msgLeiosBlock ktracer tracer kernelVars txCache db peerId req eb
+        processLeiosBlock
+          ktracer
+          tracer
+          kernelVars
+          txCache
+          db
+          systemTime
+          pullFromMempool
+          (ReceivedBlockFrom peerId req)
+          eb
       PendingBlockTxsResponse req txs ->
-        msgLeiosBlockTxs ktracer tracer kernelVars txCache db peerId req txs
+        processLeiosBlockTxs
+          ktracer
+          tracer
+          kernelVars
+          txCache
+          db
+          systemTime
+          (ReceivedTxsFrom peerId req txs)
 
   -- Non-blocking: return 'Right result' if stop or a request is available,
   -- or 'Left ()' if we'd have to block (caller returns Left blockingLoop).
@@ -706,17 +788,55 @@ nextLeiosFetchClientCommand ktracer tracer stopSTM kernelVars txCache db peerId
             StrictSTM.atomically $
               LazySTM.writeTQueue responseQ (PendingBlockResponse req eb)
         )
-    LeiosBlockTxsRequest req@(MkLeiosBlockTxsRequest p bitmaps _txHashes) ->
-      LF.MkSomeLeiosFetchJob
-        (LF.MsgLeiosBlockTxsRequest p bitmaps)
-        ( pure $ \(LF.MsgLeiosBlockTxs _ _ txs) ->
-            StrictSTM.atomically $
-              LazySTM.writeTQueue responseQ (PendingBlockTxsResponse req txs)
-        )
+    LeiosBlockTxsRequest req@(MkLeiosBlockTxsRequest p jobs) ->
+      -- The wire request is just the point + bitmap; the bitmap is the union of
+      -- the covered jobs' offsets (the jobs and their commitments stay local).
+      let bitmaps = offsetsToBitmap (foldMap (\(Jobs.MkLeiosJob offs _ _) -> offs) jobs)
+       in LF.MkSomeLeiosFetchJob
+            (LF.MsgLeiosBlockTxsRequest p bitmaps)
+            ( pure $ \(LF.MsgLeiosBlockTxs _ _ txs) ->
+                StrictSTM.atomically $
+                  LazySTM.writeTQueue responseQ (PendingBlockTxsResponse req txs)
+            )
 
 -----
 
-msgLeiosBlock ::
+-- | Where an EB body being ingested came from. 'processLeiosBlock' and
+-- 'processLeiosBlockTxs' serve both a fetch response from a peer (carrying the
+-- request we are fulfilling) and our own forge; the arrival-specific behaviour a
+-- local forge skips is: refunding the peer's request budget, classifying/listing
+-- the missing txs (a forge holds its whole closure, so nothing is missing), and
+-- emitting fetch-arrival telemetry (which would otherwise pollute the metrics
+-- with self-produced data).
+data LeiosBlockSource pid
+  = ReceivedBlockFrom (PeerId pid) LeiosBlockRequest
+  | -- | A locally-forged EB, carrying the point the forge assigned it.
+    ForgedBlock !LeiosPoint
+
+-- | Like 'LeiosBlockSource', for a batch of EB txs. Each constructor carries its
+-- own tx bytes.
+data LeiosBlockTxsSource pid
+  = ReceivedTxsFrom (PeerId pid) LeiosBlockTxsRequest !(V.Vector LeiosTx)
+  | -- | Carries the forged EB's point and body (so the tx hashes come from the
+    -- body's 'leiosEbTxs', aligned by position with the closure bytes, rather
+    -- than being re-derived) and the closure bytes.
+    ForgedTxs !LeiosPoint !LeiosEb !(V.Vector LeiosTx)
+  | -- | Carries an EB's txs that 'processLeiosBlock' found in our local mempool
+    -- (so it removed them from the fetch job set), already paired with their
+    -- (known) tx hashes, to be ingested applied.
+    MempoolTxs !LeiosPoint !(Map TxHash BS.ByteString)
+
+-- | The age of an EB on arrival: the wall-clock elapsed from its recorded oldest
+-- announcement-slot onset (see 'Leios.ebStateOnset') to @now@, or 'Nothing' if
+-- the EB was never heralded by an announcement (an offer-only or self-forged
+-- body).
+ebPointAge :: RelativeTime -> Map EbHash Leios.EbState -> LeiosPoint -> Maybe NominalDiffTime
+ebPointAge now ebStates p = do
+  st <- Map.lookup p.pointEbHash ebStates
+  onset <- strictMaybeToMaybe (Leios.ebStateOnset st)
+  Just (diffRelTime now onset)
+
+processLeiosBlock ::
   ( Ord pid
   , IOLike m
   ) =>
@@ -727,86 +847,238 @@ msgLeiosBlock ::
   ) ->
   LeiosTxCache m () () SerializedEbBody ->
   LeiosDbConnection m ->
-  PeerId pid ->
-  LeiosBlockRequest ->
+  -- | For reporting the EB's age on arrival (now minus its recorded onset).
+  SystemTime m ->
+  -- | Pull the txs we already hold in our local mempool out of the given misses
+  -- (offset -> (tx hash, size)): returns the misses still to fetch from peers,
+  -- plus the mempool-found txs' bytes (which 'processLeiosBlock' ingests itself,
+  -- as its last step). See 'noMempoolPull' for the forge/test no-op.
+  ( IntMap.IntMap (TxHash, BytesSize) ->
+    m (IntMap.IntMap (TxHash, BytesSize), Map TxHash BS.ByteString)
+  ) ->
+  LeiosBlockSource pid ->
   LeiosEb ->
   m ()
-msgLeiosBlock ktracer tracer (outstandingVar, readyVar) txCache db peerId req eb = do
+processLeiosBlock ktracer tracer (outstandingVar, readyVar) txCache db systemTime pullFromMempool source eb = do
+  now <- systemTimeCurrent systemTime
   -- validate it
-  let MkLeiosBlockRequest point ebBytesSize = req
+  let (mbPeer, point, ebBytesSize) = case source of
+        ReceivedBlockFrom peerId (MkLeiosBlockRequest p sz) -> (Just peerId, p, sz)
+        ForgedBlock p -> (Nothing, p, leiosEbBytesSize eb)
   traceWith tracer $ MkTraceLeiosPeer $ "[start] MsgLeiosBlock " <> Leios.prettyLeiosPoint point
   let MkLeiosPoint _ebSlot ebHash = point
-  do
-    -- FIXME: 'ebBytesSize' here is the size we recorded from the peer
-    -- offer at 'MsgLeiosBlockOffer' time (carried through the request),
-    -- not the chain-authoritative 'leiosEbBytesSize' from the parent
-    -- RB's 'headerLeiosAnnouncement'. EB announcements are not yet
-    -- implemented; once they are, validate against the announced size
-    -- so that a peer cannot poison this check by sending a bad-size
-    -- offer first.
-    let ebBytesSize' = leiosEbBytesSize eb
-    when (ebBytesSize' /= ebBytesSize) $ do
-      error $ "MsgLeiosBlock size mismatch: " <> show (ebBytesSize', ebBytesSize)
-    let ebHash' = hashLeiosEb eb
-    when (ebHash' /= ebHash) $ do
-      error $ "MsgLeiosBlock hash mismatch: " <> show (ebHash', ebHash)
+  let ebBytesSize' = leiosEbBytesSize eb
+  -- A failed-validation body: attribute the whole body to 'fabInvalid'.
+  let invalidReply reason =
+        traceWith ktracer (TraceLeiosFetchBodyArrival (fetchArrivalInvalid ebBytesSize'))
+          >> error reason
+  case source of
+    -- A forge's body is self-produced; never validate it (so no 'error' path is
+    -- ever reachable for a locally-forged EB).
+    ForgedBlock{} -> pure ()
+    ReceivedBlockFrom{} -> do
+      -- FIXME: 'ebBytesSize' here is the size we recorded from the peer
+      -- offer at 'MsgLeiosBlockOffer' time (carried through the request),
+      -- not the chain-authoritative 'leiosEbBytesSize' from the parent
+      -- RB's 'headerLeiosAnnouncement'. EB announcements are not yet
+      -- implemented; once they are, validate against the announced size
+      -- so that a peer cannot poison this check by sending a bad-size
+      -- offer first.
+      when (ebBytesSize' /= ebBytesSize) $ do
+        invalidReply $ "MsgLeiosBlock size mismatch: " <> show (ebBytesSize', ebBytesSize)
+      let ebHash' = hashLeiosEb eb
+      when (ebHash' /= ebHash) $ do
+        invalidReply $ "MsgLeiosBlock hash mismatch: " <> show (ebHash', ebHash)
+      -- Reject an EB that lists the same tx hash at two offsets: malformed, and
+      -- it would otherwise have the tx fetched (and cache-counted) once per offset.
+      let MkLeiosEb v = eb
+          duplicateTxHashes =
+            Map.keys $
+              Map.filter (> (1 :: Int)) $
+                Map.fromListWith (+) [(txh, 1) | (txh, _) <- V.toList v]
+      when (not (null duplicateTxHashes)) $ do
+        invalidReply $ "MsgLeiosBlock duplicate tx hashes: " <> show duplicateTxHashes
   -- ingest it
-  MVar.modifyMVar_ outstandingVar $ \outstanding -> do
-    let novel = not $ Set.member ebHash (Leios.acquiredEbBodies outstanding)
-    when novel $ do
-      -- TODO don't hold the outstanding mvar during this IO
-      traceException tracer TraceLeiosPeerDbException $ do
-        -- FIXME: Once proper EB announcements are wired in, the point
-        -- MUST already be present here (announcement handling inserts
-        -- it) and this should become an assertion. Today we still tolerate
-        -- receiving an EB body without a prior announcement, so we insert
-        -- the point idempotently as a stop-gap and trace a warning.
-        traceWith ktracer $ TraceLeiosBlockPointMissing point
-        leiosDbInsertEbPoint db point ebBytesSize
-        completedByBody <- leiosDbInsertEbBody db point eb
-        mSummary <- txCache.insertBody ebHash (Leios.serializeEbBody eb)
-        forM_ mSummary $ traceWith ktracer . TraceLeiosTxCacheEbBody point
-        traceWith ktracer $ TraceLeiosBlockAcquired point
-        forM_ completedByBody $ traceWith ktracer . TraceLeiosBlockTxsAcquired
-    -- update NodeKernel state
-    --
-    -- 'refundEbRequest' reverses this peer's per-request accounting (but skips
-    -- it if the peer has already been cancelled in bulk by a disconnect); the
-    -- global acquisition state below is updated unconditionally, since we did
-    -- receive the EB.
-    let !outstanding' =
-          refundEbRequest peerId ebHash ebBytesSize $
-            if novel
-              then
-                outstanding
-                  { Leios.acquiredEbBodies = Set.insert ebHash (Leios.acquiredEbBodies outstanding)
-                  , Leios.missingEbBodies = Map.delete point (Leios.missingEbBodies outstanding)
-                  , Leios.blockingPerEb =
-                      Map.insert
-                        point
-                        (let MkLeiosEb v = eb in V.length v)
-                        (Leios.blockingPerEb outstanding)
-                  , Leios.missingEbTxs =
-                      Map.insert
-                        point
-                        ( V.ifoldl
-                            (\acc i x -> IntMap.insert i x acc)
-                            IntMap.empty
-                            (let MkLeiosEb v = eb in v)
-                        )
-                        (Leios.missingEbTxs outstanding)
-                  , Leios.reverseEbIndexByTx =
-                      V.ifoldl
-                        ( \acc i (txHash, txBytesSize) ->
-                            Map.insertWith Map.union txHash (Map.singleton ebHash (i, txBytesSize)) acc
-                        )
-                        (Leios.reverseEbIndexByTx outstanding)
-                        (let MkLeiosEb v = eb in v)
-                  }
-              else outstanding
-    pure outstanding'
+  (bodyClass, mempoolNotCache, mempoolAndCache) <- MVar.modifyMVar outstandingVar $ \outstanding -> do
+    let tooOld = point.pointSlotNo < Leios.acquiredEbBodiesPrunedSlot outstanding
+        novel = not $ maybe False Leios.ebStateHasBody (Map.lookup ebHash (Leios.ebState outstanding))
+        -- Always: this request is no longer in flight and we now have the body,
+        -- so drop the body-fetch bookkeeping ('refundEbRequest' reverses the
+        -- per-request accounting -- skipped if a disconnect already cancelled it
+        -- in bulk -- and we delete every point listing this body from
+        -- 'missingEbBodies'); and unless the EB is too old to matter, remember we
+        -- have it so we neither re-fetch nor re-offer it.
+        !outstandingCleaned =
+          ( case mbPeer of
+              Just peerId -> refundEbRequest peerId ebHash ebBytesSize
+              Nothing -> id
+          )
+            $ outstanding
+              { Leios.missingEbBodies =
+                  case Map.lookup ebHash (Leios.reverseSlotIndexByEbHash outstanding) of
+                    Nothing -> Leios.missingEbBodies outstanding
+                    Just slots ->
+                      foldr
+                        (\slot -> Map.delete (MkLeiosPoint slot ebHash))
+                        (Leios.missingEbBodies outstanding)
+                        slots
+              , Leios.reverseSlotIndexByEbHash =
+                  Map.delete ebHash (Leios.reverseSlotIndexByEbHash outstanding)
+              }
+    -- Persist and classify only a genuinely novel, still-relevant body. A
+    -- duplicate (already held) or a too-old arrival (its slot is below pruned
+    -- watermark, so 'novel' can't be trusted) is left at the bookkeeping above
+    -- -- in particular no second 'leiosDbInsertEbBody', hence no duplicate
+    -- 'AcquiredEb'/re-offer.
+    if tooOld || not novel
+      then
+        pure
+          ( outstandingCleaned
+          ,
+            ( (if tooOld then fetchArrivalEvicted else fetchArrivalExtra) $ ebBytesSize'
+            , Map.empty
+            , Map.empty
+            )
+          )
+      else do
+        -- TODO don't hold the outstanding mvar during this IO
+        mbTxCacheMissesFromBody <- traceException tracer TraceLeiosPeerDbException $ do
+          -- FIXME: Once proper EB announcements are wired in, the point
+          -- MUST already be present here (announcement handling inserts
+          -- it) and this should become an assertion. Today we still tolerate
+          -- receiving an EB body without a prior announcement, so we insert
+          -- the point idempotently as a stop-gap and trace a warning.
+          traceWith ktracer $ TraceLeiosBlockPointMissing point
+          leiosDbInsertEbPoint db point ebBytesSize
+          completedByBody <- leiosDbInsertEbBody db point eb
+          mbSummaryTxCacheMisses <-
+            insertBody
+              txCache
+              ebHash
+              (Leios.serializeEbBody eb)
+              IntMap.empty
+              (\acc i missingTxh sz -> IntMap.insert i (missingTxh, sz) acc)
+          traceWith ktracer $
+            TraceLeiosBlockAcquired point (ebPointAge now (Leios.ebState outstanding) point)
+          forM_ completedByBody $ \p ->
+            traceWith ktracer $
+              TraceLeiosBlockTxsAcquired p (ebPointAge now (Leios.ebState outstanding) p)
+          -- The 'TraceLeiosBodyHits' trace is deferred to after the mempool pull
+          -- below, so it can report the mempool-hit count alongside this cache
+          -- summary.
+          pure mbSummaryTxCacheMisses
+        (bodyClass, misses, mbBodyTxCacheSummary) <- case source of
+          -- A forge holds its whole closure, so nothing is missing. Its txs are
+          -- inserted (applied) by the subsequent 'processLeiosBlockTxs' call; the
+          -- 'insertBody' above only served to register the cache entries.
+          ForgedBlock{} -> pure (fetchArrivalGood ebBytesSize', IntMap.empty, Nothing)
+          ReceivedBlockFrom{} -> case mbTxCacheMissesFromBody of
+            -- 'BodyNotYetInserted': the announcement was present and we filled it.
+            Just (txCacheSummary, ms) -> pure (fetchArrivalGood ebBytesSize', ms, Just txCacheSummary)
+            Nothing -> do
+              -- Announcement absent (assumed present once, since evicted): the
+              -- cache insert was a no-op. Backstop: classify the txs directly to
+              -- build the misses. No cache summary, so no 'TraceLeiosBodyHits'.
+              let MkLeiosEb v = eb
+              ms <- withLookupTx txCache $ \look ->
+                V.ifoldM
+                  ( \acc i (txh, sz) -> do
+                      r <- look txh
+                      pure $ case r of
+                        Just{} -> acc
+                        Nothing -> IntMap.insert i (txh, sz) acc
+                  )
+                  IntMap.empty
+                  v
+              pure (fetchArrivalEvicted ebBytesSize', ms, Nothing)
+        -- Look the /full/ tx set up in our local mempool (not just the cache
+        -- misses), so txs in BOTH the mempool and the cache surface here: we prefer
+        -- to (re-)apply those from the mempool, since that is what sets their
+        -- Applied flag in the cache. All mempool hits are ingested below (the last
+        -- thing this function does); none of them become fetch jobs.
+        let MkLeiosEb ebTxs = eb
+            fullTxSet = IntMap.fromList (zip [0 ..] (V.toList ebTxs))
+        (notInMempool, mempoolHits) <- pullFromMempool fullTxSet
+        let cacheMissHashes = Set.fromList [txh | (txh, _sz) <- IntMap.elems misses]
+            -- in the mempool but not the cache: full ingest (DB + Applied cache).
+            mempoolNotCache = Map.restrictKeys mempoolHits cacheMissHashes
+            -- in both: already persisted, so we only mark them Applied in the cache.
+            mempoolAndCache = Map.withoutKeys mempoolHits cacheMissHashes
+            -- in neither the mempool nor the cache: the actual fetch set.
+            missedBoth = IntMap.intersection misses notInMempool
+        -- Report the body's cache+mempool hit picture: the cache summary, the full
+        -- mempool-resident count, and how many txs were in neither (so the combined
+        -- hit rate is @(txsInEb - missedBoth) / txsInEb@, avoiding double counting).
+        forM_ mbBodyTxCacheSummary $ \txCacheSummary ->
+          traceWith ktracer $
+            TraceLeiosBodyHits point txCacheSummary (Map.size mempoolHits) (IntMap.size missedBoth)
+        let !jobPool =
+              -- TODO should this calculation be deferred until the first offer
+              -- arrives?
+              -- each job commits to its covered tx hashes (so its response can be
+              -- validated without the body); 'missedBoth' is offset -> (tx hash,
+              -- on-wire size).
+              Jobs.mkLeiosJobPool
+                -- TODO thread the real 'LeiosFetchStaticEnv' rather than the demo one
+                (Leios.maxJobBytesSize Leios.demoLeiosFetchStaticEnv)
+                (Leios.maxJobTxCount Leios.demoLeiosFetchStaticEnv)
+                missedBoth
+            !outstanding' = Leios.insertAcquiredEbBody ebHash jobPool outstandingCleaned
+        pure (outstanding', (bodyClass, mempoolNotCache, mempoolAndCache))
   void $ MVar.tryPutMVar readyVar ()
+  case source of
+    ForgedBlock{} -> pure () -- self-produced: not a fetch arrival
+    ReceivedBlockFrom{} -> traceWith ktracer $ TraceLeiosFetchBodyArrival bodyClass
   traceWith tracer $ MkTraceLeiosPeer $ "[done] MsgLeiosBlock " <> Leios.prettyLeiosPoint point
+  -- Last: ingest the txs we found in our own mempool (they were removed from the
+  -- fetch job set above). This pays disk latency, so it's synchronous here.
+  --
+  -- Overlap (in both the mempool and the cache): already persisted in the DB, so
+  -- only upgrade them to Applied in the cache -- no (redundant) DB insert.
+  unless (Map.null mempoolAndCache) $
+    withLockedInsertAppliedTx txCache $ \w0 step ->
+      foldM (\w txh -> step w txh ()) w0 (Map.keys mempoolAndCache)
+  -- Mempool-only (not in the cache): full ingest into the DB and cache.
+  unless (Map.null mempoolNotCache) $
+    processLeiosBlockTxs
+      ktracer
+      tracer
+      (outstandingVar, readyVar)
+      txCache
+      db
+      systemTime
+      (MempoolTxs point mempoolNotCache)
+
+-- | The 'processLeiosBlock' mempool-pull for paths that never pull from the
+-- mempool (the forge, which already holds the whole closure, and tests): keep
+-- every miss and find nothing locally.
+noMempoolPull ::
+  Applicative m =>
+  IntMap.IntMap (TxHash, BytesSize) ->
+  m (IntMap.IntMap (TxHash, BytesSize), Map TxHash BS.ByteString)
+noMempoolPull misses = pure (misses, Map.empty)
+
+-- | Build a 'processLeiosBlock' mempool-pull from a read of the mempool's Leios
+-- tx index (keyed by 'TxHash') and an era-specific conversion of a found tx to
+-- its 'LeiosTx' bytes. A miss is removed from the still-to-fetch set only if it
+-- is present in the index /and/ converts (so a tx we can't turn into bytes is
+-- still fetched from peers, never lost). Polymorphic in the index's value type so
+-- this stays blk-agnostic.
+mkMempoolPull ::
+  Monad m =>
+  -- | Read the mempool's current Leios tx index.
+  m (Map TxHash vtx) ->
+  -- | The 'LeiosTx' bytes of a found tx, if it has them.
+  (vtx -> Maybe BS.ByteString) ->
+  IntMap.IntMap (TxHash, BytesSize) ->
+  m (IntMap.IntMap (TxHash, BytesSize), Map TxHash BS.ByteString)
+mkMempoolPull readIndex toBytes misses = do
+  idx <- readIndex
+  let missHashes = Set.fromList (map fst (IntMap.elems misses))
+      hits = Map.mapMaybe toBytes (Map.restrictKeys idx missHashes)
+      hitHashes = Map.keysSet hits
+      stillMissing = IntMap.filter (\(h, _sz) -> not (Set.member h hitHashes)) misses
+  pure (stillMissing, hits)
 
 -----
 
@@ -816,14 +1088,13 @@ delIf predicate x = if predicate x then Nothing else Just x
 -----
 
 -- | Cancel all of a peer's outstanding fetch requests in bulk, e.g. when it
--- disconnects: refund its share of the request budget and drop it from the
--- per-EB/per-tx request sets, so those items can be re-requested from other
+-- disconnects: refund its share of the request budget, drop it from the per-EB
+-- body request set ('requestedEbPeers'), and -- via the per-peer
+-- 'requestedJobsPerPeer' index -- decrement the multiplicity of every job it
+-- had in flight, so those bodies and jobs become re-requestable from other
 -- peers.
 --
--- Note this is O(size of the request maps): it scans 'requestedEbPeers' /
--- 'requestedTxPeers' for the peer rather than knowing its keys directly. A
--- future optimisation would track a per-peer in-flight set to make this
--- O(that peer's outstanding requests).
+-- TODO eliminate the linear scans
 removePeerFromOutstanding ::
   Ord pid =>
   PeerId pid ->
@@ -831,14 +1102,28 @@ removePeerFromOutstanding ::
   LeiosOutstanding pid
 removePeerFromOutstanding peerId o =
   o
-    { Leios.requestedBytesSize =
-        Leios.requestedBytesSize o - Map.findWithDefault 0 peerId (Leios.requestedBytesSizePerPeer o)
-    , Leios.requestedBytesSizePerPeer = Map.delete peerId (Leios.requestedBytesSizePerPeer o)
+    { Leios.requestedBytesSizePerPeer = Map.delete peerId (Leios.requestedBytesSizePerPeer o)
     , Leios.requestedEbPeers =
         Map.mapMaybe (delIf Set.null . Set.delete peerId) (Leios.requestedEbPeers o)
-    , Leios.requestedTxPeers =
-        Map.mapMaybe (delIf Set.null . Set.delete peerId) (Leios.requestedTxPeers o)
+    , Leios.requestedJobsPerPeer = Map.delete peerId (Leios.requestedJobsPerPeer o)
+    , Leios.ebState =
+        Map.foldrWithKey
+          (\ebHash jobIds -> Map.adjust (releaseJobs jobIds) ebHash)
+          (Leios.ebState o)
+          (Map.findWithDefault Map.empty peerId (Leios.requestedJobsPerPeer o))
     }
+ where
+  -- Decrement, in that EB's jobPool, the multiplicity of each job this peer held.
+  releaseJobs jobIds (Leios.MkEbState slot onset fetchState) =
+    Leios.MkEbState slot onset $ case fetchState of
+      Leios.NoBody -> Leios.NoBody
+      Leios.BodyImminent -> Leios.BodyImminent
+      Leios.BodyAcquired jobPool ->
+        Leios.BodyAcquired $!
+          NEIntSet.foldl'
+            (flip $ Jobs.unpickJob . Jobs.MkLeiosJobId)
+            jobPool
+            jobIds
 
 -----
 
@@ -848,7 +1133,7 @@ removePeerFromOutstanding peerId o =
 -- If the peer has already been cancelled in bulk (e.g. it disconnected and its
 -- requests were refunded en masse via its 'requestedBytesSizePerPeer' total),
 -- that entry is gone; re-applying the per-request refund here would
--- double-subtract 'requestedBytesSize' and underflow. So we gate on the peer
+-- double-subtract 'requestedBytesSizePerPeer' and underflow. So we gate on the peer
 -- still being present. The membership check, the refund, and the bulk
 -- cancellation all run within the same 'outstandingVar' critical section, so
 -- whichever happens first claims the refund and the other no-ops.
@@ -862,8 +1147,7 @@ refundEbRequest ::
 refundEbRequest peerId ebHash ebBytesSize o
   | Map.member peerId (Leios.requestedBytesSizePerPeer o) =
       o
-        { Leios.requestedBytesSize = Leios.requestedBytesSize o - ebBytesSize
-        , Leios.requestedBytesSizePerPeer =
+        { Leios.requestedBytesSizePerPeer =
             Map.update (\x -> delIf (== 0) (x - ebBytesSize)) peerId (Leios.requestedBytesSizePerPeer o)
         , Leios.requestedEbPeers =
             Map.update (delIf Set.null . Set.delete peerId) ebHash (Leios.requestedEbPeers o)
@@ -872,30 +1156,112 @@ refundEbRequest peerId ebHash ebBytesSize o
 
 -----
 
--- | Like 'refundEbRequest', but for a received batch of EB txs: installs the
--- already-computed 'requestedTxPeers'' (this peer removed from each requested
--- tx) and refunds the bytes, gated on the peer still being tracked (see
--- 'refundEbRequest').
+-- | Like 'refundEbRequest', but for a received batch of EB txs: refunds the
+-- bytes, gated on the peer still being tracked (see 'refundEbRequest'). The job
+-- bookkeeping (jobPool + this peer's in-flight set) is handled by 'completeTxRequest'.
 refundTxRequest ::
   Ord pid =>
   PeerId pid ->
-  Map TxHash (Set (PeerId pid)) ->
   BytesSize ->
   LeiosOutstanding pid ->
   LeiosOutstanding pid
-refundTxRequest peerId requestedTxPeers' txsBytesSize o
+refundTxRequest peerId txsBytesSize o
   | Map.member peerId (Leios.requestedBytesSizePerPeer o) =
       o
-        { Leios.requestedBytesSize = Leios.requestedBytesSize o - txsBytesSize
-        , Leios.requestedBytesSizePerPeer =
+        { Leios.requestedBytesSizePerPeer =
             Map.update (\x -> delIf (== 0) (x - txsBytesSize)) peerId (Leios.requestedBytesSizePerPeer o)
-        , Leios.requestedTxPeers = requestedTxPeers'
         }
   | otherwise = o
 
 -----
 
-msgLeiosBlockTxs ::
+-- | On a received tx batch, remove its now-fetched jobs: delete them from the
+-- EB's jobPool (they are done for /every/ peer) and from this peer's in-flight set,
+-- so neither this peer nor any other is asked for them again. Complements
+-- 'refundTxRequest', which handles only the per-peer byte accounting.
+completeTxRequest ::
+  Ord pid =>
+  PeerId pid ->
+  EbHash ->
+  NEIntSet ->
+  LeiosOutstanding pid ->
+  LeiosOutstanding pid
+completeTxRequest peerId ebHash jobIds o =
+  o
+    { Leios.ebState = Map.adjust completeInJobPool ebHash (Leios.ebState o)
+    , Leios.requestedJobsPerPeer =
+        Map.update (nonEmptyMap . Map.update dropJobs ebHash) peerId (Leios.requestedJobsPerPeer o)
+    }
+ where
+  completeInJobPool (Leios.MkEbState slot onset fetchState) =
+    Leios.MkEbState slot onset $ case fetchState of
+      Leios.NoBody -> Leios.NoBody
+      Leios.BodyImminent -> Leios.BodyImminent
+      Leios.BodyAcquired jobPool ->
+        Leios.BodyAcquired $!
+          NEIntSet.foldl' (flip $ Jobs.completeJob . Jobs.MkLeiosJobId) jobPool jobIds
+  dropJobs held =
+    NEIntSet.nonEmptySet (IntSet.difference (NEIntSet.toSet held) (NEIntSet.toSet jobIds))
+  nonEmptyMap m = if Map.null m then Nothing else Just m
+
+-- | Decode a tx-offset bitmap (@[(chunk index, 64-bit mask)]@) to ascending body
+-- offsets: the inverse of the fetch logic's 'offsetsToBitmap', and the exact
+-- decode the fetch server uses to pick which txs to send -- so the arrival
+-- handler derives its validation hashes in the peer's send order.
+bitmapOffsets :: [(Word16, Word64)] -> [Int]
+bitmapOffsets = unfoldr nextOffset
+ where
+  nextOffset = \case
+    [] -> Nothing
+    (idx, bitmap) : k -> case popLeftmostOffset bitmap of
+      Nothing -> nextOffset k
+      Just (i, bitmap') -> Just (64 * fromIntegral idx + i, (idx, bitmap') : k)
+
+-- | Cheap validation of one covered job against the commitment the request
+-- carries for it: its arriving txs match its offset count (popcount) and its
+-- total byte size.
+--
+-- Does /no/ hashing so that redundant\/"hedge" requests doesn't contend for
+-- CPU. A peer that over-sends to create extra work is punished even if we
+-- already did the (right amount of) CPU work for a peer that replied earlier,
+-- without pointlessly repeating that CPU work.
+checkJobSize ::
+  IntMap.IntMap (LeiosTx, BS.ByteString) ->
+  Jobs.LeiosJobId ->
+  Jobs.LeiosJob ->
+  Either String ()
+checkJobSize aligned (Jobs.MkLeiosJobId jid) (Jobs.MkLeiosJob offs expectedBytes _root)
+  | IntMap.size sub /= IntSet.size offs =
+      Left $ "MsgLeiosBlockTxs job " ++ show jid ++ " count mismatch"
+  | fromIntegral (sum [BS.length bs | (_tx, bs) <- IntMap.elems sub]) /= expectedBytes =
+      Left $ "MsgLeiosBlockTxs job " ++ show jid ++ " byte-size mismatch"
+  | otherwise = Right ()
+ where
+  -- just the txs from /this/ job
+  sub = IntMap.restrictKeys aligned offs
+
+-- | Content validation of one /pending/ job we intend to ingest: hash its
+-- arriving txs and check their root hash against the request's commitment,
+--
+-- Only runs for the first reply for a job. Runs /in addition to/
+-- 'checkJobSize'.
+ingestJob ::
+  IntMap.IntMap (LeiosTx, BS.ByteString) ->
+  Jobs.LeiosJobId ->
+  Jobs.LeiosJob ->
+  Either String [(TxHash, BS.ByteString)]
+ingestJob aligned (Jobs.MkLeiosJobId jid) (Jobs.MkLeiosJob offs _expectedBytes expectedRoot)
+  | Jobs.jobRootHashOfTxHashes (map fst hashed) /= expectedRoot =
+      Left $ "MsgLeiosBlockTxs job " ++ show jid ++ " root-hash mismatch"
+  | otherwise = Right hashed
+ where
+  -- 'IntMap.elems' is ascending by offset -- the order the root hash commits to.
+  hashed = [(hashLeiosTx tx, bs) | (tx, bs) <- IntMap.elems (IntMap.restrictKeys aligned offs)]
+
+-----
+
+processLeiosBlockTxs ::
+  forall pid m.
   ( Ord pid
   , IOLike m
   ) =>
@@ -906,141 +1272,202 @@ msgLeiosBlockTxs ::
   ) ->
   LeiosTxCache m () () SerializedEbBody ->
   LeiosDbConnection m ->
-  PeerId pid ->
-  LeiosBlockTxsRequest ->
-  V.Vector LeiosTx ->
+  -- | For reporting each completed closure's age on arrival.
+  SystemTime m ->
+  LeiosBlockTxsSource pid ->
   m ()
-msgLeiosBlockTxs ktracer tracer (outstandingVar, readyVar) txCache db peerId req txs = do
-  traceWith tracer $ MkTraceLeiosPeer $ "[start] " ++ Leios.prettyLeiosBlockTxsRequest req
-  -- validate it
-  -- TODO: could validate the returned point + bitmaps too (added to response recently)
-  let MkLeiosBlockTxsRequest point bitmaps txHashes = req
-  let ebHash = point.pointEbHash
-      txBytess = V.map cbor txs
-  do
-    when (V.length txs /= V.length txHashes) $ do
-      error $ "MsgLeiosBlockTxs length mismatch: " ++ show (V.length txs, V.length txHashes)
-    let txHashes' = V.map hashLeiosTx txs
-    when (txHashes' /= txHashes) $ do
-      let mismatches =
-            V.toList $
-              V.findIndices id $
-                V.zipWith (/=) txHashes txHashes'
-      error $ "MsgLeiosBlockTxs hash mismatches: " ++ show mismatches
-  let nextOffset = \case
-        [] -> Nothing
-        (idx, bitmap) : k -> case popLeftmostOffset bitmap of
-          Nothing -> nextOffset k
-          Just (i, bitmap') ->
-            Just (64 * fromIntegral idx + i, (idx, bitmap') : k)
-      offsets = unfoldr nextOffset bitmaps
-  -- ingest
-  traceException tracer TraceLeiosPeerDbException $ do
-    completed <- leiosDbInsertTxs db (V.toList $ V.zip txHashes txBytess)
-    forM_ completed $ traceWith ktracer . TraceLeiosBlockTxsAcquired
-    -- crucially: add the txs to the TxCacheIndex _after_ they've been written
-    -- to the LeiosDb, since it's currently what the TxCacheIndex is indexing
-    withLockedInsertUnappliedTx txCache $ \z step ->
-      foldM (\acc txh -> step acc txh ()) z txHashes
-  -- update NodeKernel state
-  MVar.modifyMVar_ outstandingVar $ \outstanding -> do
-    let (requestedTxPeers', reverseEbIndexByTx', txsBytesSize) =
-          ( \f ->
-              V.foldl
-                f
-                ( Leios.requestedTxPeers outstanding
-                , Leios.reverseEbIndexByTx outstanding
-                , 0
-                )
-                (txHashes `V.zip` txBytess)
-          )
-            $ \(!accReqs, !accOffsetss, !accSz) (txHash, txBytes) ->
-              ( Map.update (delIf Set.null . Set.delete peerId) txHash accReqs
-              , Map.update (delIf Map.null . Map.delete ebHash) txHash accOffsetss
-              , accSz + BS.length txBytes
-              )
-    let offsetsSet = IntSet.fromList offsets
-        -- the requests that this MsgLeiosBlockTxs was the first to resolve
-        beatOtherPeers =
-          (`IntMap.restrictKeys` offsetsSet) $
-            Map.findWithDefault IntMap.empty point (Leios.missingEbTxs outstanding)
-    -- 'refundTxRequest' reverses this peer's per-request accounting (but skips
-    -- it if the peer has already been cancelled in bulk by a disconnect); the
-    -- global state below is updated unconditionally, since we did receive the
-    -- txs.
-    let !outstanding' =
-          refundTxRequest peerId requestedTxPeers' (fromIntegral txsBytesSize) $
-            outstanding
-              { Leios.missingEbTxs =
-                  Map.update
-                    (delIf IntMap.null . (`IntMap.withoutKeys` offsetsSet))
-                    point
-                    (Leios.missingEbTxs outstanding)
-              , Leios.reverseEbIndexByTx = reverseEbIndexByTx'
-              , Leios.blockingPerEb =
-                  if IntMap.null beatOtherPeers
-                    then Leios.blockingPerEb outstanding
-                    else
-                      Map.alter
-                        ( \case
-                            Nothing -> Nothing
-                            Just x -> delIf (== 0) $ x - IntMap.size beatOtherPeers
-                        )
-                        point
-                        (Leios.blockingPerEb outstanding)
-              }
-    pure outstanding'
-  void $ MVar.tryPutMVar readyVar ()
-  traceWith tracer $ MkTraceLeiosPeer $ "[done] " ++ Leios.prettyLeiosBlockTxsRequest req
+processLeiosBlockTxs ktracer tracer (outstandingVar, readyVar) txCache db systemTime source = case source of
+  ForgedTxs _point eb txs -> do
+    now <- systemTimeCurrent systemTime
+    -- Ingest the whole closure (TODO even though we might already have some of
+    -- it).
+    --
+    -- No peer accounting, no arrival telemetry.
+    _ <-
+      id
+        $ ingestAcquiredTxs
+          now
+          Applied
+        $ V.toList (V.map fst (leiosEbTxs eb)) `zip` V.toList (V.map cbor txs)
+    void $ MVar.tryPutMVar readyVar ()
+  MempoolTxs _point hits -> do
+    now <- systemTimeCurrent systemTime
+    -- Txs found in our local mempool (so already-known-valid): ingest applied,
+    -- using the hashes we already have. No peer accounting, no arrival telemetry.
+    _ <- ingestAcquiredTxs now Applied (Map.toList hits)
+    void $ MVar.tryPutMVar readyVar ()
+  ReceivedTxsFrom peerId req@(MkLeiosBlockTxsRequest point jobs) txs -> do
+    now <- systemTimeCurrent systemTime
+    traceWith tracer $ MkTraceLeiosPeer $ "[start] " ++ Leios.prettyLeiosBlockTxsRequest req
+    let txBytess = V.map cbor txs
+        batchBytes = V.sum (V.map BS.length txBytess)
+        invalidReply :: String -> m a
+        invalidReply reason =
+          traceWith ktracer (TraceLeiosFetchTxsArrival (fetchArrivalInvalid (fromIntegral batchBytes)))
+            >> error reason
+        -- The union of the covered jobs' offsets, ascending -- the order the peer
+        -- decoded our bitmap into, so it aligns position-wise with the arriving
+        -- txs. No hashing here: 'aligned' is just @offset -> (tx, tx bytes)@.
+        offsetsSet = foldMap (\(Jobs.MkLeiosJob offs _ _) -> offs) jobs
+    when (V.length txs /= IntSet.size offsetsSet) $
+      invalidReply $
+        "MsgLeiosBlockTxs count mismatch: " ++ show (V.length txs, IntSet.size offsetsSet)
+    let aligned :: IntMap.IntMap (LeiosTx, BS.ByteString)
+        aligned = IntMap.fromList $ zip (IntSet.toAscList offsetsSet) (zip (V.toList txs) (V.toList txBytess))
+    -- Cheap checks (count + total bytes, no hashing) for every covered job, so an
+    -- over-send is caught and punished even for a job we have since completed.
+    -- 'foldrWithKey' short-circuits on the first rejection.
+    either invalidReply pure $
+      NEIntMap.foldrWithKey
+        (\i job acc -> checkJobSize aligned (Jobs.MkLeiosJobId i) job >> acc)
+        (Right ())
+        jobs
+    -- Only jobs still pending in the jobPool are content-validated (root hash) and
+    -- ingested; a redundant delivery of a completed job -- or a response for an EB
+    -- pruned mid-flight -- is discarded without hashing. Read the jobPool once; the
+    -- read-then-complete race is benign (completion is monotonic, and re-ingest is
+    -- idempotent).
+    outstanding0 <- MVar.readMVar outstandingVar
+    let pendingJobs = case Map.lookup point.pointEbHash (Leios.ebState outstanding0) of
+          Nothing ->
+            IntMap.empty
+          Just (Leios.MkEbState _slot _onset Leios.NoBody) ->
+            IntMap.empty
+          Just (Leios.MkEbState _slot _onset Leios.BodyImminent) ->
+            IntMap.empty
+          Just (Leios.MkEbState _slot _onset (Leios.BodyAcquired jobPool)) ->
+            Jobs.restrictToPending (NEIntMap.toMap jobs) jobPool
+        -- The covered jobs we won't ingest -- an earlier delivery already
+        -- completed them (or the EB was pruned). Their txs did arrive, and being
+        -- from a completed job they are already held, so account their (committed,
+        -- 'checkJobSize'-verified) bytes as 'fetchArrivalExtra'. This mirrors how a
+        -- concurrent duplicate delivery already lands in that bucket via the cache.
+        redundantExtra =
+          fetchArrivalExtra $
+            IntMap.foldr
+              (\(Jobs.MkLeiosJob _ bytes _) acc -> bytes + acc)
+              0
+              (IntMap.difference (NEIntMap.toMap jobs) pendingJobs)
+    toIngest <-
+      either invalidReply (pure . fold) $
+        IntMap.traverseWithKey (\i job -> ingestJob aligned (Jobs.MkLeiosJobId i) job) pendingJobs
+    -- ingest the validated txs (unapplied). 'txArrival' covers those; add the
+    -- redundant arrivals the cache never saw, so the trace reflects everything
+    -- that came off the wire.
+    txArrival <- ingestAcquiredTxs now Unapplied toIngest
+    traceWith ktracer $ TraceLeiosFetchTxsArrival (txArrival <> redundantExtra)
+    -- 'refundTxRequest' reverses this peer's per-request byte accounting (but skips
+    -- it if the peer was already cancelled in bulk by a disconnect);
+    -- 'completeTxRequest' removes the now-fetched jobs from the EB's job pool and
+    -- from this peer's in-flight set, so they are never re-requested.
+    MVar.modifyMVar_ outstandingVar $
+      pure
+        . completeTxRequest peerId point.pointEbHash (NEIntMap.keysSet jobs)
+        . refundTxRequest peerId (fromIntegral batchBytes)
+    void $ MVar.tryPutMVar readyVar ()
+    traceWith tracer $ MkTraceLeiosPeer $ "[done] " ++ Leios.prettyLeiosBlockTxsRequest req
+ where
+  -- Shared ingest for both sources: write the txs to the LeiosDb (which owns the
+  -- closure-acquired notification side-effect, and reports for the trace the EBs it
+  -- newly completed), then to the tx-cache. A forge's txs are 'Applied'
+  -- (known-valid, from a validated mempool); a peer's are 'Unapplied'. Returns the
+  -- arrival-bytes tally -- 'mempty' on the applied path, which emits no
+  -- fetch-arrival telemetry.
+  --
+  -- NB two peers delivering the same (redundantly-requested) job at once can both
+  -- ingest it: the jobPool read and 'completeTxRequest' aren't atomic across
+  -- threads. Harmless --- the DB insert is idempotent and the cache buckets each
+  -- tx by its prior state in one locked pass, tolerating duplicates.
+  ingestAcquiredTxs ::
+    RelativeTime -> WhetherApplied -> [(TxHash, BS.ByteString)] -> m Leios.FetchArrivalBytes
+  ingestAcquiredTxs now applied toIngest =
+    traceException tracer TraceLeiosPeerDbException $ do
+      completed <- leiosDbInsertTxs db toIngest
+      ebStates <- Leios.ebState <$> MVar.readMVar outstandingVar
+      forM_ completed $ \p ->
+        traceWith ktracer $ TraceLeiosBlockTxsAcquired p (ebPointAge now ebStates p)
+      case applied of
+        Applied -> do
+          withLockedInsertAppliedTx txCache $ \w0 step ->
+            foldM (\w (txh, _bs) -> step w txh ()) w0 toIngest
+          pure mempty
+        Unapplied ->
+          withLockedInsertUnappliedTx txCache $ \w0 step ->
+            foldM (\w (txh, bs) -> step w txh (fromIntegral (BS.length bs)) ()) w0 toIngest
+
+-- | Whether ingested txs are tagged applied (from our forge's validated mempool)
+-- or unapplied (fetched from a peer).
+data WhetherApplied = Applied | Unapplied
 
 -----
 
--- | Update a peer's LeiosFetch state as if its LeiosNotify client had offered
--- the given EB — i.e. as a 'MsgLeiosBlockOffer' (EB body) plus a
--- 'MsgLeiosBlockTxsOffer' (EB txs).
+-- | Record an offered EB body: mark it as something to fetch and mark the peer
+-- as a serving candidate, then wake the fetch logic. Shared by the explicit
+-- 'MsgLeiosBlockOffer' handler and by the CertRB roll-forward path in
+-- 'checkMsgRollForwardForLeiosOffers'.
 --
--- This is the LeiosFetch-side effect of a CertRB header arriving via ChainSync:
--- given the peer's (already-resolved) LeiosNotify vars and the EB the CertRB
--- certifies (the announcement recorded in the predecessor's chain-dep state,
--- plus the EB's on-the-wire body size), we record the body as missing and this
--- peer as offering both the body and its txs, then wake the fetch logic. (The
--- block-aware decision of /whether/ to call this — recognising the CertRB,
--- extracting its announcement, and waiting for the peer's LeiosNotify vars to
--- register — stays in 'checkMsgRollForwardForLeiosOffers'.)
-leiosCertRbOffer ::
+-- The body is /not/ added to 'missingEbBodies' if it is: too old (older than has already been pruned), already held (per
+-- 'ebStateHasBody' — the only "do we have it" test now, read in-lock with no
+-- cache lookup), already listed under this content hash, or zero-sized. Unless it
+-- is too old or zero-sized, the offer slot is folded into 'ebState' regardless.
+-- The offered size is not chain-authoritative (there are no EB announcements
+-- yet), so refusing to overwrite an existing same-hash entry makes the first-seen
+-- (slot, size) win, and a zero-sized offer — which no honest forger produces — is
+-- dropped. The per-peer offerings are updated regardless, so the peer stays a
+-- serving candidate.
+recordEbBodyOffer ::
   IOLike m =>
   ( MVar m (LeiosOutstanding pid)
   , MVar m ()
   ) ->
   LeiosPeerVars m ->
-  -- | The EB the CertRB certifies: its point and on-the-wire body size.
+  AlsoOfferedTxsClosure ->
+  -- | The offered EB: its point and on-the-wire body size.
   (LeiosPoint, BytesSize) ->
   m ()
-leiosCertRbOffer (outstandingVar, readyVar) peerVars (point, ebBytesSize) = do
-  let MkLeiosPoint _ebSlot ebHash = point
-  -- As if 'MsgLeiosBlockOffer': record the EB body as missing.
+recordEbBodyOffer (outstandingVar, readyVar) peerVars offeredClosure (point, ebBytesSize) = do
+  let MkLeiosPoint ebSlot ebHash = point
   MVar.modifyMVar_ outstandingVar $ \outstanding ->
-    pure $
-      if Set.member ebHash (Leios.acquiredEbBodies outstanding)
-        then outstanding
-        else
-          outstanding
-            { Leios.missingEbBodies =
-                Map.insert point ebBytesSize (Leios.missingEbBodies outstanding)
-            }
-  -- As if 'MsgLeiosBlockOffer' (body) and 'MsgLeiosBlockTxsOffer' (txs): record
-  -- this peer as offering both.
-  MVar.modifyMVar_ (Leios.offerings peerVars) $ \(offers1, offers2) -> do
-    let !offers1' = Set.insert ebHash offers1
-        !offers2' = Set.insert ebHash offers2
-    pure (offers1', offers2')
+    pure $!
+      let tooOld = ebSlot < Leios.acquiredEbBodiesPrunedSlot outstanding -- too old to fetch
+          malformed = ebBytesSize == 0 -- malformed offer
+          -- Offers are currently trusted, so this is evidence that the EB is
+          -- announced in this slot; fold it into 'ebState' regardless of whether
+          -- we go on to list the body for fetching.
+          --
+          -- TODO stop that, once offers are no longer trusted
+          outstanding'
+            | tooOld || malformed = outstanding
+            | otherwise = Leios.recordMaxAnnouncementSlot ebHash ebSlot SNothing outstanding
+          skip =
+            tooOld
+              || malformed
+              || maybe False Leios.ebStateHasBody (Map.lookup ebHash (Leios.ebState outstanding)) -- already have it
+              || Map.member ebHash (Leios.reverseSlotIndexByEbHash outstanding) -- already listed
+       in if skip
+            then outstanding'
+            else
+              outstanding'
+                { Leios.missingEbBodies =
+                    Map.insert point ebBytesSize (Leios.missingEbBodies outstanding')
+                , Leios.reverseSlotIndexByEbHash =
+                    Map.insertWith
+                      NESet.union
+                      ebHash
+                      (NESet.singleton ebSlot)
+                      (Leios.reverseSlotIndexByEbHash outstanding')
+                }
+  MVar.modifyMVar_ (Leios.offerings peerVars) $ \offers ->
+    -- store the offer as-is; 'mergeOffer' keeps the closure if either offer had it
+    pure $! Map.insertWith Leios.mergeOffer point offeredClosure offers
   void $ MVar.tryPutMVar readyVar ()
 
 -----
 
 -- | The offer-side handling of a 'MsgRollForward': when the header is a CertRB
 -- ('headerContainsLeiosCert'), record this peer as offering the EB it certifies
--- (via 'leiosCertRbOffer'), reading that EB from the predecessor's chain-dep
+-- (via 'recordEbBodyOffer', offering both its body and tx-closure), reading
+-- that EB from the predecessor's chain-dep
 -- state ('chainDepStateLeiosAnnouncement'), which the CertRB's own transition
 -- would overwrite. A no-op otherwise. The announcement-side handling of the same
 -- header is separate; see the ChainSync client's 'leiosMsgRollForwardCallback'.
@@ -1057,7 +1484,7 @@ checkMsgRollForwardForLeiosOffers ::
 checkMsgRollForwardForLeiosOffers kernelVars peerVars hdr cds =
   when (headerContainsLeiosCert hdr) $
     forM_ (protocolStateLeiosAnnouncement @blk cds) $ \announcement ->
-      leiosCertRbOffer kernelVars peerVars announcement
+      recordEbBodyOffer kernelVars peerVars TxsClosureAlsoOffered announcement
 
 -----
 
@@ -1089,6 +1516,17 @@ mkAnnouncingHeader h =
   headerLeiosAnnouncement h <&> \(MkLeiosPoint _ebSlot ebHash, ebBodySize) ->
     UnsafeMkAnnouncingHeader h (MkAnnouncementFields (headerElId h) ebHash ebBodySize)
 
+-- | The other safe constructor of an 'AnnouncingHeader': for a header we already
+-- know announces a specific EB because we forged it. Unlike 'mkAnnouncingHeader'
+-- it is total -- no parse of the header's announcement is needed, since the
+-- announcement fields come straight from the 'ForgedLeiosEb' whose EB the header
+-- announces by construction.
+mkForgedAnnouncingHeader ::
+  ResolveLeiosBlock blk => Header blk -> Leios.ForgedLeiosEb -> AnnouncingHeader blk
+mkForgedAnnouncingHeader h forgedEb =
+  UnsafeMkAnnouncingHeader h $
+    MkAnnouncementFields (headerElId h) forgedEb.point.pointEbHash (leiosEbBytesSize forgedEb.body)
+
 -- | The election of an 'AnnouncingHeader'.
 ancElId :: AnnouncingHeader blk -> ElId
 ancElId = announcementElection . ancAnnouncementFields
@@ -1109,6 +1547,12 @@ processAnnouncementCentrally ::
   Maybe peer ->
   AnnouncementSource ->
   ShouldRelay ->
+  -- | This announcement slot's wall-clock onset, if known
+  --
+  -- Recorded so the body\/closure arrival handlers can report the EB's
+  -- age. It's intentionally 'SNothing' for a self-forged EB, since these ages
+  -- are relevant to /diffusion/.
+  StrictMaybe RelativeTime ->
   Maybe NominalDiffTime ->
   AnnouncingHeader blk ->
   m ()
@@ -1120,6 +1564,7 @@ processAnnouncementCentrally
   source
   provenance
   shouldRelay
+  onset
   age
   ancHdr =
     MVar.modifyMVar_ centralVar $ \cst ->
@@ -1127,7 +1572,15 @@ processAnnouncementCentrally
         (contramap (traceNewAnnouncement provenance) kernelTracer)
         ancElId
         ( \_elSt -> do
-            recordAnnouncedEb kernelVars (point, Leios.announcementEbBodySize fields)
+            -- A received announcement lists the EB for fetching; one we forged is
+            -- instead marked 'BodyImminent' in 'ebState' so the fetch logic never
+            -- requests it -- even after a peer relays our own announcement back to
+            -- us. Marking it here, at announcement time, closes the window before
+            -- the body is persisted and before any such relay can arrive.
+            case provenance of
+              ForgedLocally -> markForged
+              ReceivedViaChainSync -> recordAnnounced
+              ReceivedViaLeiosNotify -> recordAnnounced
             recordAnnouncementInTxCache txCache ancHdr point
         )
         cst
@@ -1140,6 +1593,10 @@ processAnnouncementCentrally
     -- The announced EB's slot is the announcing header's own slot (see
     -- 'headerLeiosAnnouncement'); its ebHash is kept in 'ancAnnouncementFields'.
     point = MkLeiosPoint (blockSlot (ancHeader ancHdr)) (announcementEbHash fields)
+    recordAnnounced = recordAnnouncedEb kernelVars onset (point, Leios.announcementEbBodySize fields)
+    markForged =
+      MVar.modifyMVar_ (fst kernelVars) $
+        pure . Leios.markBodyImminent point.pointEbHash point.pointSlotNo
 
 -- | Thrown when a peer misbehaves on the announcement protocol; the ensuing
 -- thread death disconnects the peer. It carries the
@@ -1189,7 +1646,7 @@ announcementValidity ::
   m
     ( AnnouncementVerdict
         (AnnouncementInvalidity blk)
-        (ShouldRelay, NominalDiffTime, (LeiosPoint, BytesSize))
+        (ShouldRelay, RelativeTime, NominalDiffTime, (LeiosPoint, BytesSize))
     )
 announcementValidity systemTime futureCheck cfg immLedger hdr = do
   onset <- case futureCheck of
@@ -1222,34 +1679,50 @@ announcementValidity systemTime futureCheck cfg immLedger hdr = do
          in case validateAnnouncementHeader cfg immLedger hdr of
               Left inv -> VerdictInvalid inv
               Right (StaleOCIN, _v) -> VerdictIgnore
-              Right (FreshOCIN, v) -> VerdictProcess (shouldRelay, age, v)
+              Right (FreshOCIN, v) -> VerdictProcess (shouldRelay, onset, age, v)
 
--- | Record a validated, newly-announced EB body as missing, with its
--- authoritative (forger-signed) size. First-seen wins: a no-op if the body is
--- already acquired or already recorded.
+-- | Record a validated, newly-announced EB body as missing, unless its already
+-- pruned\/tracked\/acquired
 recordAnnouncedEb ::
   IOLike m =>
   ( MVar m (LeiosOutstanding pid)
   , MVar m ()
   ) ->
+  -- | This announcement slot's wall-clock onset, if known.
+  StrictMaybe RelativeTime ->
   (LeiosPoint, BytesSize) ->
   m ()
-recordAnnouncedEb (outstandingVar, readyVar) (point, ebBytesSize) = do
+recordAnnouncedEb (outstandingVar, readyVar) onset (point, ebBytesSize) = do
   changed <- MVar.modifyMVar outstandingVar (pure . upd)
   when changed $ void $ MVar.tryPutMVar readyVar ()
  where
-  MkLeiosPoint _ebSlot ebHash = point
+  MkLeiosPoint ebSlot ebHash = point
 
+  -- The same in-lock guard as 'recordEbBodyOffer' (too old / already held /
+  -- already listed). No cache lookup: 'ebState' is authoritative here.
   upd outstanding =
-    if Set.member ebHash (Leios.acquiredEbBodies outstanding)
-      || any ((== ebHash) . pointEbHash) (Map.keys (Leios.missingEbBodies outstanding))
-      then (outstanding, False)
-      else
-        flip (,) True $
-          outstanding
-            { Leios.missingEbBodies =
-                Map.insert point ebBytesSize (Leios.missingEbBodies outstanding)
-            }
+    let tooOld = ebSlot < Leios.acquiredEbBodiesPrunedSlot outstanding -- too old to fetch
+        !outstanding'
+          | tooOld = outstanding
+          | otherwise = Leios.recordMaxAnnouncementSlot ebHash ebSlot onset outstanding
+        skip =
+          tooOld
+            || maybe False Leios.ebStateHasBody (Map.lookup ebHash (Leios.ebState outstanding)) -- already have it
+            || Map.member ebHash (Leios.reverseSlotIndexByEbHash outstanding) -- already listed
+        !outstanding''
+          | skip = outstanding'
+          | otherwise =
+              outstanding'
+                { Leios.missingEbBodies =
+                    Map.insert point ebBytesSize (Leios.missingEbBodies outstanding')
+                , Leios.reverseSlotIndexByEbHash =
+                    Map.insertWith
+                      NESet.union
+                      ebHash
+                      (NESet.singleton ebSlot)
+                      (Leios.reverseSlotIndexByEbHash outstanding')
+                }
+     in (outstanding'', not skip)
 
 prunePeerStateToImmTip ::
   LedgerSupportsProtocol blk =>
@@ -1317,3 +1790,68 @@ maxAnnouncementAgeSend = 300 -- 5 minutes
 -- parameter?
 maxAnnouncementAgeRecv :: NominalDiffTime
 maxAnnouncementAgeRecv = 600 -- 10 minutes
+
+-----
+
+-- | The forge's counterpart to receiving an EB from an upstream peer: hand our
+-- own freshly-forged EB to the same three handlers a remote acquisition uses---
+-- announcement ('processAnnouncementCentrally', as 'ForgedLocally'), body
+-- ('processLeiosBlock'), then closure ('processLeiosBlockTxs')---with no peer.
+-- Keeping this similarity explicit is what makes forging an EB reconcile the
+-- outstanding fetch state exactly as receiving one does.
+--
+-- WARNING: the @Forge@ command interpreter in "Test.LeiosDemoLogic.Invariants"
+-- hand-replicates only this function's side-effects that alter the
+-- 'LeiosOutstanding' state. If you change here, keep it in sync there.
+onForgedLeiosEb ::
+  ( IOLike m
+  , ConvertRawHash blk
+  , HasHeader (Header blk)
+  , Ord pid
+  ) =>
+  Tracer m TraceLeiosKernel ->
+  MVar m (Announcements.CentralState m pid (AnnouncingHeader blk)) ->
+  ( MVar m (LeiosOutstanding pid)
+  , MVar m ()
+  ) ->
+  LeiosTxCache m () () SerializedEbBody ->
+  LeiosDbConnection m ->
+  -- | Threaded through to the body/closure handlers for age reporting
+  SystemTime m ->
+  -- | Built by the caller (see 'mkForgedAnnouncingHeader'), at the call site
+  -- nearest the forge where its correspondence to the closure is evident.
+  AnnouncingHeader blk ->
+  Leios.ForgedLeiosEb ->
+  m ()
+onForgedLeiosEb kernelTracer centralVar kv txCache db systemTime anc forgedEb = do
+  processAnnouncementCentrally
+    kernelTracer
+    centralVar
+    kv
+    txCache
+    Nothing
+    ForgedLocally
+    Announcements.DoRelay
+    SNothing -- a self-forged EB records no onset (kept out of the /diffusion/ events)
+    Nothing
+    anc
+  processLeiosBlock
+    kernelTracer
+    nullTracer
+    kv
+    txCache
+    db
+    systemTime
+    noMempoolPull -- the forge holds the whole closure
+    (ForgedBlock forgedEb.point)
+    forgedEb.body
+  processLeiosBlockTxs
+    kernelTracer
+    nullTracer
+    kv
+    txCache
+    db
+    systemTime
+    (ForgedTxs forgedEb.point forgedEb.body $ V.fromList $ map (MkLeiosTx . snd) $ forgedEb.txClosure)
+  traceWith kernelTracer $
+    TraceLeiosBlockStored{slot = forgedEb.point.pointSlotNo, eb = forgedEb.body}
diff --git a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs
index d7084b681b..76cbb04655 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs
@@ -17,7 +17,13 @@
 {-# LANGUAGE TypeApplications #-}
 {-# OPTIONS_GHC -Wno-partial-fields #-}
 
-module LeiosDemoTypes (module LeiosDemoTypes, module Cardano.Crypto.Leios) where
+module LeiosDemoTypes
+  ( module LeiosDemoTypes
+
+    -- * Re-exports
+  , module Cardano.Crypto.Leios
+  , module TxHashReexports
+  ) where
 
 import Cardano.Binary
   ( Decoder
@@ -55,8 +61,9 @@ import Cardano.Crypto.Leios
   )
 import Cardano.Crypto.Util (SignableRepresentation (..))
 import Cardano.Ledger.Core (EraTx, Tx, TxLevel (TopTx))
-import Cardano.Prelude (NFData, NonEmpty, toList, toString, (&))
+import Cardano.Prelude (NonEmpty, toList, toString, (&))
 import Cardano.Slotting.Slot (SlotNo (SlotNo), WithOrigin, withOrigin)
+import Cardano.Slotting.Time (RelativeTime)
 import Codec.Serialise (Serialise, decode, encode)
 import Control.Concurrent.Class.MonadMVar (MVar)
 import qualified Control.Concurrent.Class.MonadMVar as MVar
@@ -72,8 +79,9 @@ import qualified Data.ByteString.Char8 as BS8
 import qualified Data.ByteString.Short as SBS
 import Data.Fixed (Pico)
 import qualified Data.Foldable as F
-import Data.IntMap (IntMap)
-import qualified Data.IntMap as IntMap
+import Data.IntMap.NonEmpty (NEIntMap)
+import qualified Data.IntMap.NonEmpty as NEIntMap
+import Data.IntSet.NonEmpty (NEIntSet)
 import Data.List (sortOn)
 import Data.Map (Map)
 import qualified Data.Map.Strict as Map
@@ -100,6 +108,8 @@ import LeiosDemoOnlyTestFetch (LeiosFetch, Message (..))
 import qualified LeiosDemoOnlyTestFetch as LeiosFetch
 import LeiosDemoOnlyTestNotify (LeiosNotify, Message (..))
 import qualified LeiosDemoOnlyTestNotify as LeiosNotify
+import LeiosDemoTypes.LeiosJobs as TxHashReexports (TxHash (..), prettyTxHash)
+import qualified LeiosDemoTypes.LeiosJobs as Jobs
 import NoThunks.Class (OnlyCheckWhnfNamed (..))
 import qualified Numeric
 import Ouroboros.Consensus.Ledger.Basics (EmptyMK, LedgerState)
@@ -110,6 +120,10 @@ import Ouroboros.Consensus.Ledger.SupportsMempool
   )
 import Ouroboros.Consensus.Util (ShowProxy (..))
 import Ouroboros.Consensus.Util.IOLike (IOLike, NoThunks)
+import Ouroboros.Network.PeerSelection.LedgerPeers.Type
+  ( IsBigLedgerPeer (..)
+  )
+import System.Random (StdGen)
 import Text.Pretty.Simple (pShow)
 
 -- * Hashes and identities
@@ -164,16 +178,6 @@ instance SignableRepresentation RbHash where
     toStrictByteString $
       encodeRbHash point
 
-newtype TxHash = MkTxHash ByteString
-  deriving stock (Eq, Ord, Generic)
-  deriving anyclass (NFData, NoThunks)
-
-instance Show TxHash where
-  show = prettyTxHash
-
-prettyTxHash :: TxHash -> String
-prettyTxHash (MkTxHash bytes) = BS8.unpack (BS16.encode bytes)
-
 -- | Uniquely identifies an endorser block in Leios. Could use 'Block SlotNo
 -- EbHash' eventually, but a dedicated type is better to explore.
 data LeiosPoint = MkLeiosPoint {pointSlotNo :: SlotNo, pointEbHash :: EbHash}
@@ -319,19 +323,24 @@ data LeiosBlockRequest
       !BytesSize
 
 data LeiosBlockTxsRequest
-  = -- |
-    --
-    -- The hashes aren't sent to the peer, but they are used to validate the
-    -- response when it arrives.
+  = -- | A request for some of an EB's txs: its point and the 'Jobs.LeiosJob's it
+    -- covers, keyed by job id (so a request can't list a job twice), each with its
+    -- full commitment. Everything needed to validate the response is carried here,
+    -- so the reply handler needs no lookup into the (body-less) job pool -- and a
+    -- redundant response for a job that has since completed still validates. On
+    -- the wire only the offset bitmap goes to the peer; it is derived from the
+    -- union of the jobs' offsets (see the LeiosFetch client), not stored.
     MkLeiosBlockTxsRequest
       !LeiosPoint
-      [(Word16, Word64)]
-      !(Vector TxHash)
+      !(NEIntMap Jobs.LeiosJob)
 
 prettyLeiosBlockTxsRequest :: LeiosBlockTxsRequest -> String
-prettyLeiosBlockTxsRequest (MkLeiosBlockTxsRequest p bitmaps _txHashes) =
-  unwords $
-    "MsgLeiosBlockTxs" : prettyLeiosPoint p : map prettyBitmap bitmaps
+prettyLeiosBlockTxsRequest (MkLeiosBlockTxsRequest p jobs) =
+  unwords
+    [ "MsgLeiosBlockTxs"
+    , prettyLeiosPoint p
+    , "jobs=" <> show (toList (NEIntMap.keys jobs))
+    ]
 
 prettyBitmap :: (Word16, Word64) -> String
 prettyBitmap (idx, bitmap) =
@@ -349,9 +358,30 @@ prettyBitmap (idx, bitmap) =
 -- patterns of access to the "Ouroboros.Consensus.NodeKernel"'s shared state.
 --
 
+-- | Whether an EB offer also implies its tx-closure is on offer. A CertRB does
+-- (it certifies the whole EB); a bare 'MsgLeiosBlockOffer' does not -- the closure
+-- is offered separately, as a 'MsgLeiosBlockTxsOffer'. This is also the value we
+-- store per offered point: 'TxsClosureAlsoOffered' means the peer can serve the
+-- body /and/ the closure (a closure offer implies the body), while
+-- 'TxsClosureNotAlsoOffered' is body-only.
+data AlsoOfferedTxsClosure = TxsClosureAlsoOffered | TxsClosureNotAlsoOffered
+  deriving (Eq, Show)
+
+-- | Merge two offers for one point: the closure is on offer if either says so.
+mergeOffer :: AlsoOfferedTxsClosure -> AlsoOfferedTxsClosure -> AlsoOfferedTxsClosure
+mergeOffer TxsClosureAlsoOffered _ = TxsClosureAlsoOffered
+mergeOffer _ TxsClosureAlsoOffered = TxsClosureAlsoOffered
+mergeOffer _ _ = TxsClosureNotAlsoOffered
+
 data LeiosPeerVars m = MkLeiosPeerVars
-  { -- written to only by the LeiosNotify client (TODO and eviction)
-    offerings :: !(MVar m (Set EbHash, Set EbHash))
+  { whetherBigLedgerPeer :: !IsBigLedgerPeer
+  -- ^ fixed for the connection's lifetime; the fetch logic fetches more
+  -- aggressively from a big-ledger peer (see 'leiosFetchLogicIteration')
+  , offerings :: !(MVar m (Map LeiosPoint AlsoOfferedTxsClosure))
+  -- ^ the peer's current offers, keyed by point -- so the map is already in slot
+  -- order (freshest-first via 'Map.toDescList'), no dedup by EB hash needed
+  -- (honest announcements don't reuse a hash, and an adversary defeats such
+  -- dedup anyway). Written to only by the LeiosNotify client and eviction.
   , requestsToSend :: !(StrictTVar m (Seq LeiosFetchRequest))
   -- ^ written to by the fetch logic and the LeiosFetch client
   --
@@ -369,11 +399,11 @@ data LeiosPeerVars m = MkLeiosPeerVars
   -- the Diffusion Layer's control message to be actionable.
   }
 
-newLeiosPeerVars :: IOLike m => m (LeiosPeerVars m)
-newLeiosPeerVars = do
-  offerings <- MVar.newMVar (Set.empty, Set.empty)
+newLeiosPeerVars :: IOLike m => IsBigLedgerPeer -> m (LeiosPeerVars m)
+newLeiosPeerVars whetherBigLedgerPeer = do
+  offerings <- MVar.newMVar Map.empty
   requestsToSend <- StrictSTM.newTVarIO Seq.empty
-  pure MkLeiosPeerVars{offerings, requestsToSend}
+  pure MkLeiosPeerVars{whetherBigLedgerPeer, offerings, requestsToSend}
 
 -- | Main data structure used in the Leios fetching logic.
 --
@@ -383,168 +413,520 @@ newLeiosPeerVars = do
 --
 -- TODO: Potential simplifications once we have better test coverage:
 --
--- 1. With filterMissingWork now querying the DB before each fetch iteration,
---    we could simplify this structure to only track "offers" from peers rather
---    than "missing" items. The DB would be the source of truth for what we have,
---    and we'd filter offers against DB to find what to fetch.
---
--- 2. The acquiredEbBodies set is now redundant with DB - we update it in
---    filterMissingWork but could remove it entirely once we trust DB filtering.
---
--- 3. The reverseEbIndexByTx inverse index could be computed on-demand from missingEbTxs
---    rather than maintained incrementally, simplifying state updates.
---
--- 4. Consider separating "offer tracking" from "request tracking" into distinct
+-- 1. Consider separating "offer tracking" from "request tracking" into distinct
 --    data structures for clarity.
 data LeiosOutstanding pid = MkLeiosOutstanding
   { -- EB-level tracking
-    acquiredEbBodies :: !(Set EbHash)
-  -- ^ EB bodies we've successfully received/stored
-  , missingEbBodies :: !(Map LeiosPoint BytesSize)
-  -- ^ EB bodies still needed to be fetched (indexed by point and size)
-  -- Request tracking
-  , requestedEbPeers :: !(Map EbHash (Set (PeerId pid)))
-  -- ^ Which peers we've requested each EB from
-  , requestedTxPeers :: !(Map TxHash (Set (PeerId pid)))
-  -- ^ Which peers we've requested each TX from
-  , requestedBytesSizePerPeer :: !(Map (PeerId pid) BytesSize)
-  -- ^ Running total of bytes requested from each peer
-  , requestedBytesSize :: !BytesSize
-  -- ^ Total bytes requested across all peers
-  -- TX-level tracking
-  , missingEbTxs :: !(Map LeiosPoint (IntMap (TxHash, BytesSize)))
-  -- ^ The txs that still need to be sourced
-  --
-  -- * A @MsgLeiosBlock@ inserts into 'missingEbTxs' if that EB has never
-  --   been received before.
-  --
-  -- * Every @MsgLeiosBlockTxs@ deletes from 'missingEbTxs', but that delete
-  --   will be a no-op for all except the first to arrive carrying this EbTx.
-  --
-  -- TODO this is far too big for the heap
-  , reverseEbIndexByTx :: !(Map TxHash (Map EbHash (Int, BytesSize)))
-  -- ^ Inverse of missingEbTxs - for each TX, which EBs (and offsets) need it
-  --
-  -- TODO this is far too big for the heap
-  , blockingPerEb :: !(Map LeiosPoint Int)
-  -- ^ How many txs of each EB are not yet in the @txs@ table
+    ebState :: !(Map EbHash EbState)
+  -- ^ Per-EB state for every EB we have seen announced (or offered)
   --
-  -- These missing txs are blocking the node from sending @MsgLeiosBlockTxsOffer@
-  -- to its downstream peers.
+  -- TODO once offers are only valid if preceded by an announcement, then
+  -- 'ebState' and the @selfPeer@ field of
+  -- 'LeiosDemoLogic.Announcements.CentralState' are partially redundant
+  , ebsPerMaxAnnouncementSlot :: !(Map SlotNo (NESet EbHash))
+  -- ^ Slot-keyed reverse index of 'ebStateMaxSlot' on 'ebState'
   --
-  -- It's different from 'missingEbTxs' in two ways.
+  -- Used to accelerate pruning.
   --
-  -- * The heap footprint of 'blockingPerEb' doesn't scale with the number of
-  --   EbTxs.
+  -- TODO will also be redundant with by 'CentralState.selfPeer.live' once
+  -- offers are no longer trusted.
+  , acquiredEbBodiesPrunedSlot :: !SlotNo
+  -- ^ The slot 'ebState' has most recently been pruned up to (see
+  -- 'pruneOutstandingToImmTip').
   --
-  -- * 'blockingPerEb' is only decremented when txs are actually inserted
-  --   into the DB (via @MsgLeiosBlockTxs@ handling).
+  -- Used to robustly prevent re-inserting what has already been pruned out.
+  , missingEbBodies :: !(Map LeiosPoint BytesSize)
+  -- ^ EB bodies still needed to be fetched (indexed by point and size)
+  , reverseSlotIndexByEbHash :: !(Map EbHash (NESet SlotNo))
+  -- ^ Inverse of 'missingEbBodies' grouped by content hash: for each EbHash
+  -- listed there, the slots of the 'LeiosPoint's listing it. An EbHash is not
+  -- 1-to-1 with slots, so one body can be listed at several points; on acquiring
+  -- the body (keyed by hash) 'processLeiosBlock' must clear every such point, and
+  -- this index makes that a direct lookup rather than a scan of 'missingEbBodies'
+  -- (it likewise backs the "already listed?" check on the offer/announcement
+  -- paths). Kept in step with 'missingEbBodies' at every insert and delete.
+  , -- Request tracking
+    requestedEbPeers :: !(Map EbHash (Set (PeerId pid)))
+  -- ^ Which peers we've requested each EB from
   --
-  -- TODO: 'blockingPerEb' can go permanently stale for txs shared across EBs.
-  -- 'msgLeiosBlockTxs' only decrements the entry for the EB it was requesting;
-  -- a tx that also belongs to another EB B is then in the DB, so 'filterMissingWork'
-  -- drops it from B's missing set and B never fetches it itself -- so B's
-  -- 'blockingPerEb' is never decremented for that tx and stays > 0. This is
-  -- currently harmless only because nothing reads 'blockingPerEb' as a gate: the
-  -- downstream @MsgLeiosBlockTxsOffer@ is actually driven by the DB emitting
-  -- 'AcquiredEbTxs' for every EB its @completed@ computation finds finished
-  -- (cross-EB aware), not by this field. Before using 'blockingPerEb' to gate
-  -- anything, reconcile it against shared-tx arrivals (or derive it from the DB).
+  -- TODO add requestedEbsPerPeer :: !(Map (PeerId pid) (NESet EbHash)) to avoid
+  -- linear scan
+  , requestedBytesSizePerPeer :: !(Map (PeerId pid) BytesSize)
+  -- ^ Running total of bytes requested from each peer. This is the only
+  -- outstanding-byte limit: there is no global cap (the global bound falls out
+  -- as this per-peer cap times the peer count).
+  , requestedJobsPerPeer :: !(Map (PeerId pid) (Map EbHash NEIntSet))
+  -- ^ Per peer, per EB, the job ids it currently has in flight -- for
+  -- decrementing those multiplicities on disconnect
+  , leiosFetchPrng :: !StdGen
+  -- ^ The LeiosFetch decision loop's own PRNG, threaded through each iteration.
+  -- Used to shuffle which job is drawn when assigning tx-closure work to a peer
+  -- (a uniform pick within the least-requested multiplicity bucket), so job ids
+  -- aren't consumed in a fixed order. Seeded once at start-up.
   }
 
-emptyLeiosOutstanding :: LeiosOutstanding pid
-emptyLeiosOutstanding =
+-- | The empty outstanding state, given the slot it has already been pruned up
+-- to. The caller supplies the immutable-tip slot at startup so that a body at
+-- or below it reads as too old from the outset (see
+-- 'acquiredEbBodiesPrunedSlot' / 'pruneOutstandingToImmTip'), and the seed for
+-- the decision loop's PRNG (see 'leiosFetchPrng').
+emptyLeiosOutstanding :: StdGen -> SlotNo -> LeiosOutstanding pid
+emptyLeiosOutstanding prng prunedSlot =
   MkLeiosOutstanding
-    { acquiredEbBodies = Set.empty
+    { ebState = Map.empty
+    , ebsPerMaxAnnouncementSlot = Map.empty
+    , acquiredEbBodiesPrunedSlot = prunedSlot
     , missingEbBodies = Map.empty
+    , reverseSlotIndexByEbHash = Map.empty
     , requestedEbPeers = Map.empty
-    , requestedTxPeers = Map.empty
     , requestedBytesSizePerPeer = Map.empty
-    , requestedBytesSize = 0
-    , missingEbTxs = Map.empty
-    , reverseEbIndexByTx = Map.empty
-    , blockingPerEb = Map.empty
+    , requestedJobsPerPeer = Map.empty
+    , leiosFetchPrng = prng
+    }
+
+-- | Per-EB state tracked in 'ebState'
+data EbState
+  = -- | The greatest slot at which the EB has been announced (TODO or, for now,
+    -- offered); the wall-clock onset of its /oldest/ announcement slot (kept as the
+    -- minimum, so the body\/closure arrival handlers can report how old the EB was
+    -- when we first held it; 'SNothing' for an unheralded offer-only or self-forged
+    -- EB); and the current progress of fetching it.
+    MkEbState !SlotNo !(StrictMaybe RelativeTime) !EbFetchState
+  deriving (Eq, Show)
+
+-- | Whether we hold an EB's body, plus the forge's imminent case.
+data EbFetchState
+  = -- | Our own forge is producing this EB
+    --
+    -- Its body and closure are in our store already or will be imminently. The
+    -- fetch logic issues no requests for it and treats any peer offer as dead.
+    --
+    -- Distinct from 'NoBody' so we never fetch it, yet (like 'NoBody') reports
+    -- no body held, so the forged body is still recognised as novel and
+    -- persisted when it arrives; it becomes an ordinary 'BodyAcquired' at that
+    -- point. This lets "EB arriving from forge" and "EB arriving from peer" be
+    -- treated mostly the same way.
+    BodyImminent
+  | -- | We've only ever received an announcement, and our forge hasn't issued
+    -- this EB (though it potentially could in the future!)
+    NoBody
+  | -- | The job pool: the jobs not yet /requested/ (NB this can be empty even
+    -- before jobs have /arrived/).
+    --
+    -- The body itself is /not/ retained -- it lives in the LeiosDb, and each job
+    -- carries a 'Jobs.JobRootHash' commitment sufficient to validate its
+    -- response. Retaining up to ~10k bodies (each up to ~512 kB) would cost
+    -- gigabytes.
+    --
+    -- TODO the 'Jobs.LeiosJobPool' could be an 'MVar m LeiosJobPool' for per-EB
+    -- locking, at the cost of an 'm' parameter on
+    -- EbFetchState\/EbState\/LeiosOutstanding and a monadic body-acquire;
+    -- deferred.
+    BodyAcquired !Jobs.LeiosJobPool
+  deriving (Eq, Show)
+
+ebStateMaxSlot :: EbState -> SlotNo
+ebStateMaxSlot (MkEbState slot _onset _fetchState) = slot
+
+-- | The recorded onset of the EB's oldest announcement slot, if any (see
+-- 'MkEbState'); the arrival handlers use it to report the EB's age on arrival.
+ebStateOnset :: EbState -> StrictMaybe RelativeTime
+ebStateOnset (MkEbState _slot onset _fetchState) = onset
+
+-- | Whether we already hold the EB's body (the "do we have it?" test that the
+-- offer/announcement/arrival paths consult before fetching).
+ebStateHasBody :: EbState -> Bool
+ebStateHasBody (MkEbState _slot _onset fetchState) = case fetchState of
+  NoBody -> False
+  BodyImminent -> False
+  BodyAcquired{} -> True
+
+-- | A size summary of the LeiosFetch decision loop's working set
+--
+-- The stats are rather coarse because we forbid their calculation work to scale
+-- with EBs; it's either O(1) or scales based on the number of peers.
+data LeiosOutstandingStats = MkLeiosOutstandingStats
+  { losTracked :: !Int
+  -- ^ Total EBs in 'ebState' (should stay bounded by the pruning window; a
+  -- persistent climb signals a pruning leak).
+  , losMissingBodies :: !Int
+  -- ^ Size of 'missingEbBodies' (EB body points still to fetch) -- the body-fetch
+  -- backlog.
+  , losPeersInflight :: !Int
+  -- ^ Peers tracked in the outstanding-request byte map.
+  , losInflightBytesDesc :: !(Vector Int)
+  -- ^ Per-peer outstanding requested bytes, sorted descending -- the whole
+  -- distribution, so budget concentration across peers is visible. The peer
+  -- count is low, so materializing and sorting this is cheap.
+  , losOffersDesc :: !(Vector Int)
+  -- ^ Per-peer offer-set sizes, sorted descending -- the whole distribution.
+  -- Offers are not byte-budgeted, so a peer can pile them up between prunes; a
+  -- lone climbing head is the per-peer flood signal.
+  }
+  deriving (Eq, Show, Generic)
+
+-- | @offerSizes@ is each peer's current offer-set size (e.g.
+-- @map Map.size (Map.elems offerings)@ in the decision loop) and @numOfferingPeers@
+-- its length, passed separately as an O(1) 'Map.size' hint so the sorted vector
+-- is allocated exactly.
+leiosOutstandingStats :: Int -> [Int] -> LeiosOutstanding pid -> LeiosOutstandingStats
+leiosOutstandingStats numOfferingPeers offerSizes o =
+  MkLeiosOutstandingStats
+    { losTracked = Map.size (ebState o)
+    , losMissingBodies = Map.size (missingEbBodies o)
+    , losPeersInflight = Map.size inflightMap
+    , losInflightBytesDesc = inflightDesc
+    , losOffersDesc = offersDesc
     }
+ where
+  inflightMap = requestedBytesSizePerPeer o
+  inflightDesc =
+    V.fromListN
+      (Map.size inflightMap)
+      (sortOn Down (map fromIntegral (Map.elems inflightMap)))
+  offersDesc = V.fromListN numOfferingPeers (sortOn Down offerSizes)
+
+-- | Summary order-statistics of a distribution across peers, given as a
+-- /descending-sorted, non-negative/ 'Vector' (as 'losInflightBytesDesc' /
+-- 'losOffersDesc' are). All are cheap to derive, so the vector stays the source
+-- of truth and these are computed only when emitting telemetry.
+--
+-- The median is taken over the /non-zero/ values only, so peers currently
+-- holding nothing don't drag it toward zero.
+data PeerDistSummary = MkPeerDistSummary
+  { pdsNonzeroCount :: !Int
+  , pdsTotal :: !Int
+  , pdsTop1 :: !Int
+  , pdsTop2 :: !Int
+  , pdsTop3 :: !Int
+  , pdsTop4 :: !Int
+  , pdsTop5 :: !Int
+  , pdsNonzeroMedian :: !Int
+  }
 
--- | Pretty-print the per-peer 'offerings' map (one tuple per peer: the EB-body
--- offers and the EB-tx-closure offers it has sent). Each offered EB hash is
--- shown truncated.
-prettyOfferings :: Show pid => Map (PeerId pid) (Set EbHash, Set EbHash) -> String
+summarizePeerDist :: Vector Int -> PeerDistSummary
+summarizePeerDist desc =
+  MkPeerDistSummary
+    { pdsNonzeroCount = nz
+    , pdsTotal = V.sum desc
+    , pdsTop1 = nth 0
+    , pdsTop2 = nth 1
+    , pdsTop3 = nth 2
+    , pdsTop4 = nth 3
+    , pdsTop5 = nth 4
+    , pdsNonzeroMedian = median
+    }
+ where
+  n = V.length desc
+  nth i = if i < n then desc V.! i else 0
+  -- Descending-sorted and non-negative, so the non-zero values are the leading
+  -- prefix and the median index lands inside it.
+  nz = V.length (V.takeWhile (> 0) desc)
+  median
+    | nz == 0 = 0
+    | odd nz = desc V.! (nz `div` 2)
+    | otherwise = (desc V.! (nz `div` 2 - 1) + desc V.! (nz `div` 2)) `div` 2
+
+-- | Simple counts describing what one decision iteration issued -- bounded by the
+-- number of requests issued that iteration, never by the outstanding state. See
+-- 'TraceLeiosFetchDecision'.
+data LeiosDecisionStats = MkLeiosDecisionStats
+  { ldsPeers :: !Int
+  -- ^ Peers issued at least one request this iteration.
+  , ldsRequests :: !Int
+  -- ^ Total fetch requests issued.
+  , ldsBodyRequests :: !Int
+  -- ^ Of those, EB-body ('MsgLeiosBlock') requests; the rest are tx-batch
+  -- ('MsgLeiosBlockTxs') requests.
+  , ldsJobs :: !Int
+  -- ^ Total jobs across the tx-batch requests.
+  , ldsBodyBytes :: !Int
+  -- ^ Requested EB-body bytes (sum of the body requests' sizes).
+  , ldsTxBytes :: !Int
+  -- ^ Requested tx bytes (sum of the covered jobs' on-the-wire sizes).
+  }
+  deriving (Eq, Show, Generic)
+
+summarizeDecisions ::
+  Foldable t => Map k (t LeiosFetchRequest) -> LeiosDecisionStats
+summarizeDecisions decs =
+  MkLeiosDecisionStats
+    { ldsPeers = Map.size decs
+    , ldsRequests = length reqs
+    , ldsBodyRequests = length [() | LeiosBlockRequest{} <- reqs]
+    , ldsJobs = sum [NEIntMap.size jobs | LeiosBlockTxsRequest (MkLeiosBlockTxsRequest _ jobs) <- reqs]
+    , ldsBodyBytes = sum [fromIntegral sz | LeiosBlockRequest (MkLeiosBlockRequest _ sz) <- reqs]
+    , ldsTxBytes =
+        sum
+          [ fromIntegral b
+          | LeiosBlockTxsRequest (MkLeiosBlockTxsRequest _ jobs) <- reqs
+          , Jobs.MkLeiosJob _ b _ <- F.toList jobs
+          ]
+    }
+ where
+  reqs = concatMap toList (Map.elems decs)
+
+insertAcquiredEbBody ::
+  EbHash -> Jobs.LeiosJobPool -> LeiosOutstanding pid -> LeiosOutstanding pid
+insertAcquiredEbBody ebHash jobPool =
+  alterEbState ebHash $ \case
+    Nothing ->
+      -- The state must have been pruned before the MsgLeiosBlock
+      -- arrived. (Because we couldn't have sent a MsgLeiosBlockRequest if no
+      -- announcement had arrived.)
+      --
+      -- Because it was previously pruned, it should simply be ignored now.
+      Nothing
+    Just (MkEbState slot onset fetchState) -> case fetchState of
+      BodyAcquired{} -> Nothing
+      NoBody -> Just $ MkEbState slot onset (BodyAcquired jobPool)
+      BodyImminent ->
+        -- note that we ignore the given jobPool here
+        Just $ MkEbState slot onset (BodyAcquired Jobs.emptyLeiosJobPool)
+
+-- | Record that our own forge is producing this EB
+markBodyImminent ::
+  EbHash -> SlotNo -> LeiosOutstanding pid -> LeiosOutstanding pid
+markBodyImminent ebHash slot =
+  alterEbState ebHash $ \case
+    -- A self-forged EB records no onset: we produced it, so its arrival age is a
+    -- trivial ~0, not a diffusion-latency data point.
+    Nothing -> Just $ MkEbState slot SNothing BodyImminent
+    Just (MkEbState oldSlot onset fetchState) -> case fetchState of
+      NoBody -> Just $ MkEbState oldSlot onset BodyImminent
+      BodyImminent -> Nothing
+      BodyAcquired{} -> Just $ MkEbState oldSlot onset (BodyAcquired Jobs.emptyLeiosJobPool)
+
+-- | Record that the EB with this hash is referenced (announced or offered) at this
+-- slot, along with that slot's wall-clock onset if known.
+--
+-- The same EB (hash) can be referenced by several points; we keep the
+-- /greatest/ such slot, so the EB's state isn't pruned prematurely. The onset,
+-- in contrast, is kept as the /minimum/ (oldest announcement), so the arrival
+-- handlers report the age since the EB was first heralded. An offer carries no
+-- onset ('SNothing') and so never overrides one already recorded by an
+-- announcement.
+recordMaxAnnouncementSlot ::
+  EbHash -> SlotNo -> StrictMaybe RelativeTime -> LeiosOutstanding pid -> LeiosOutstanding pid
+recordMaxAnnouncementSlot ebHash slot onset =
+  alterEbState ebHash $ \mbOld -> case mbOld of
+    Nothing -> Just $ MkEbState slot onset NoBody
+    Just (MkEbState oldSlot oldOnset fetchState) ->
+      let newSlot = max slot oldSlot
+          newOnset = minOnset onset oldOnset
+       in if newSlot == oldSlot && newOnset == oldOnset
+            then Nothing
+            else Just $ MkEbState newSlot newOnset fetchState
+
+-- | Combine two onsets, keeping the earlier and treating 'SNothing' as absent.
+minOnset :: StrictMaybe RelativeTime -> StrictMaybe RelativeTime -> StrictMaybe RelativeTime
+minOnset SNothing y = y
+minOnset x SNothing = x
+minOnset (SJust a) (SJust b) = SJust (min a b)
+
+-- | Initialize the outstanding state
+--
+-- Its contents are only @'BodyAcquired' 'emptyLeiosJobPool'@ for the EBs the
+-- LeiosDb already holds /in full/: a complete tx closure whose announcer is no
+-- older than the immutable tip. Each is marked 'BodyAcquired' with an empty job
+-- pool so we neither re-fetch nor re-process (eg emit 'AcquiredEb') an EB whose
+-- closure we already have at start-up time.
+--
+-- Everything else in the LeiosDb is deliberately ignored here, and it's
+-- safe to do so:
+--
+--   * A merely body-held EB with a /partial/ closure is not seeded: an
+--     empty pool would strand its missing txs. Left absent, it is
+--     re-derived from a fresh announcement/offer, and the redundant body
+--     re-fetch + re-insert is idempotent (INSERT-OR-IGNORE / no-op on
+--     duplicate).
+--
+--   * Complete closures at or below the immutable tip are already final;
+--     they would read as @tooOld@ anyway, so there is nothing to track.
+--
+--   * For the "points" and "txs" SQL tables, the control paths that
+--     actually depend on them read the LeiosDb directly, never via this
+--     outstanding state.
+--
+-- The per-peer request-tracking fields must start empty regardless: there are
+-- no connections yet and nothing is in flight.
+--
+-- The 'cdbAcquiredLeiosEbs' field of the ChainDB (which gates ChainSel for
+-- CertRBs) is initialized in the exact same way: from
+-- 'LeiosDemoDb.leiosDbScanCompleteEbClosuresNotOlderThanSlot', already
+-- restricted to announcers no older than the immutable tip. And, it's
+-- necessarily initialized earlier, as part of the ChainDB. But for the sake of
+-- modularity/independence (see the TODO below), we're not reusing it to
+-- initialize 'LeiosOutstanding'.
+--
+-- TODO At the cost of more complexity here, we could initialize 'ebState'
+-- /and/ the LeiosTxCache to perfectly reflect the state of the LeiosDb on
+-- start-up. It's not clear that that's worthwhile for the MVP; /healthy/
+-- nodes shouldn't be frequently restarting.
+initializeLeiosOutstanding :: StdGen -> [LeiosPoint] -> SlotNo -> LeiosOutstanding pid
+initializeLeiosOutstanding prng points immTipSlot =
+  F.foldl' (flip seed1) (emptyLeiosOutstanding prng immTipSlot) points
+ where
+  seed1 (MkLeiosPoint slot ebHash) =
+    insertAcquiredEbBody ebHash Jobs.emptyLeiosJobPool
+      . recordMaxAnnouncementSlot ebHash slot SNothing
+
+-- | Upsert an EB's 'ebState' entry, keeping 'ebsPerMaxAnnouncementSlot' in step
+-- whenever the entry's max slot moves. The supplied function must be
+-- slot-monotonic (never lower the greatest slot), which both callers are.
+alterEbState ::
+  EbHash ->
+  -- | REQUIREMENT: must not reduce 'ebStateMaxSlot'
+  (Maybe EbState -> Maybe EbState) ->
+  LeiosOutstanding pid ->
+  LeiosOutstanding pid
+alterEbState ebHash f outstanding =
+  case Map.alterF upsert1 ebHash (ebState outstanding) of
+    (Nothing, _) -> outstanding
+    (Just (mbOldSlot, newSlot), ebState') ->
+      outstanding
+        { ebState = ebState'
+        , ebsPerMaxAnnouncementSlot =
+            if mbOldSlot == Just newSlot
+              then ebsPerMaxAnnouncementSlot outstanding -- max slot unchanged
+              else Map.insertWith NESet.union newSlot (NESet.singleton ebHash) $
+                case mbOldSlot of
+                  Nothing ->
+                    ebsPerMaxAnnouncementSlot outstanding
+                  Just oldSlot ->
+                    Map.update
+                      (NESet.nonEmptySet . NESet.delete ebHash)
+                      oldSlot
+                      (ebsPerMaxAnnouncementSlot outstanding)
+        }
+ where
+  -- One traversal of 'ebState': the pair functor carries whether the entry
+  -- changed at all and, if so, the prior and new greatest slots for the
+  -- reverse-index update.
+  upsert1 mbOld = case f mbOld of
+    Nothing -> (Nothing, mbOld)
+    Just new -> (Just (ebStateMaxSlot <$> mbOld, ebStateMaxSlot new), Just new)
+
+-- | Prune 'Outstanding' to the immutable tip, returning the EB hashes it dropped
+-- (so the caller can drop those same hashes from the peers' offers).
+--
+-- Uses the 'ebsPerMaxAnnouncementSlot' reverse index to drop the below-tip prefix
+-- directly (@spanAntitone@), rather than scanning the whole map.
+--
+-- TODO still more it could prune (e.g. abandoned in-flight EB requests).
+pruneOutstandingToImmTip :: SlotNo -> LeiosOutstanding pid -> (Set EbHash, LeiosOutstanding pid)
+pruneOutstandingToImmTip immTipSlot outstanding =
+  ( prunedHashes
+  , outstanding
+      { ebState = ebState outstanding `Map.withoutKeys` prunedHashes
+      , ebsPerMaxAnnouncementSlot = atOrAbove
+      , acquiredEbBodiesPrunedSlot = max (acquiredEbBodiesPrunedSlot outstanding) immTipSlot
+      , missingEbBodies = missingEbBodiesAtOrAbove
+      , reverseSlotIndexByEbHash = reverseSlotIndexByEbHash'
+      }
+  )
+ where
+  (below, atOrAbove) =
+    Map.spanAntitone (< immTipSlot) (ebsPerMaxAnnouncementSlot outstanding)
+  prunedHashes = Set.unions (map NESet.toSet (Map.elems below))
+
+  -- 'LeiosPoint' orders slot-first, so the below-tip points are a prefix.
+  (belowBodies, missingEbBodiesAtOrAbove) =
+    Map.spanAntitone
+      (\(MkLeiosPoint slot _ebHash) -> slot < immTipSlot)
+      (missingEbBodies outstanding)
+  -- Remove each dropped point's slot from its hash's reverse-index entry (which
+  -- exists, since the index is the exact inverse of 'missingEbBodies').
+  reverseSlotIndexByEbHash' =
+    foldr
+      (\(MkLeiosPoint slot ebHash) -> Map.update (NESet.nonEmptySet . NESet.delete slot) ebHash)
+      (reverseSlotIndexByEbHash outstanding)
+      (Map.keys belowBodies)
+
+-- | Pretty-print the per-peer 'offerings' map: for each peer, its offered points
+-- freshest-first, each tagged with the strongest kind offered. Hashes truncated.
+prettyOfferings :: Show pid => Map (PeerId pid) (Map LeiosPoint AlsoOfferedTxsClosure) -> String
 prettyOfferings m =
   unlines $
     map ("    [leios] " ++) $
-      [ show peer
-          ++ " bodies="
-          ++ shortSet bodies
-          ++ " closures="
-          ++ shortSet closures
-      | (peer, (bodies, closures)) <- Map.toList m
+      [ show peer ++ " " ++ shortOffers offers
+      | (peer, offers) <- Map.toList m
       ]
  where
-  shortSet s = case Set.toList s of
+  shortOffers offers = case Map.toDescList offers of
     [] -> "{}"
-    xs ->
+    points ->
       "{"
-        ++ unwords (map (take 8 . prettyEbHash) xs)
+        ++ unwords
+          [ show slot ++ ":" ++ take 8 (prettyEbHash h) ++ kindTag k
+          | (MkLeiosPoint slot h, k) <- points
+          ]
         ++ "}"
+  kindTag = \case
+    TxsClosureNotAlsoOffered -> "b"
+    TxsClosureAlsoOffered -> "c"
 
 prettyLeiosOutstanding :: LeiosOutstanding pid -> String
 prettyLeiosOutstanding x =
   unlines $
     map ("    [leios] " ++) $
-      [ "acquiredEbBodies = " ++ show (Set.size acquiredEbBodies)
+      [ "ebState = " ++ show (Map.size ebState)
       , "missingEbBodies = " ++ show (Map.size missingEbBodies)
+      , "reverseSlotIndexByEbHash = " ++ show (Map.size reverseSlotIndexByEbHash)
       , "requestedEbPeers = " ++ unwords (map prettyEbHash (Map.keys requestedEbPeers))
-      , "requestedTxPeers = " ++ unwords (map prettyTxHash (Map.keys requestedTxPeers))
       , "requestedBytesSizePerPeer = " ++ show (Map.elems requestedBytesSizePerPeer)
-      , "requestedBytesSize = " ++ show requestedBytesSize
-      , "missingEbTxs = "
-          ++ unwords [(prettyLeiosPoint k ++ "__" ++ show (IntMap.size v)) | (k, v) <- Map.toList missingEbTxs]
-      , "blockingPerEb = "
-          ++ unwords [(prettyLeiosPoint k ++ "__" ++ show c) | (k, c) <- Map.toList blockingPerEb]
       , ""
       ]
  where
   MkLeiosOutstanding
-    { acquiredEbBodies
+    { ebState
     , missingEbBodies
+    , reverseSlotIndexByEbHash
     , requestedEbPeers
-    , requestedTxPeers
     , requestedBytesSizePerPeer
-    , requestedBytesSize
-    , missingEbTxs
-    , blockingPerEb
     } = x
 
 -- TODO which of these limits are allowed to be exceeded by at most one
 -- request?
 data LeiosFetchStaticEnv = MkLeiosFetchStaticEnv
-  { maxRequestedBytesSize :: BytesSize
-  -- ^ At most this many outstanding bytes requested from all peers together
-  , maxRequestedBytesSizePerPeer :: BytesSize
-  -- ^ At most this many outstanding bytes requested from each peer
+  { maxRequestedBytesSizePerPeer :: BytesSize
+  -- ^ At most this many outstanding bytes requested from each non-big-ledger
+  -- peer
   , maxRequestBytesSize :: BytesSize
   -- ^ At most this many outstanding bytes per request
-  , maxRequestsPerEb :: Int
-  -- ^ At most this many outstanding requests for each EB body
-  , maxRequestsPerTx :: Int
-  -- ^ At most this many outstanding requests for each individual tx
+  , maxJobBytesSize :: BytesSize
+  -- ^ At most this many bytes of txs per job
+  , maxJobTxCount :: Int
+  -- ^ At most this many txs per job
+  , fetchPriorityWindowSlots :: Word64
+  -- ^ @L = 3*L_hdr + L_vote + L_diff@ (in slots): the window, ending at the
+  -- current slot, of EBs still worth voting on. Fetch prioritisation inverts to
+  -- oldest-first within it (see @fetchPriorityTiers@). ~14s on mainnet, ~10 on
+  -- the testnet.
+  --
+  -- TODO these are Leios protocol parameters (@L_hdr@/@L_vote@/@L_diff@) that
+  -- should be read from the ledger state and can change via on-chain governance;
+  -- static stub for now.
   , maxLeiosNotifyIngressQueue :: BytesSize
   -- ^ @maximumIngressQueue@ for LeiosNotify
   , maxLeiosFetchIngressQueue :: BytesSize
-  -- ^ @maximumIngressQueue@ for LeiosFetch
+  -- ^ @maximumIngressQueue@ for LeiosFetch. This is the concrete bound from
+  -- which 'maxRequestedBytesSizePerBigLedgerPeer' is derived: the scheduler
+  -- must never leave more requested-but-unconsumed response bytes outstanding
+  -- than this queue can hold, else the mux tears the connection down (see
+  -- @Network.Mux.Ingress@'s @IngressQueueOverRun@).
   }
 
 demoLeiosFetchStaticEnv :: LeiosFetchStaticEnv
 demoLeiosFetchStaticEnv =
   MkLeiosFetchStaticEnv
-    { maxRequestedBytesSize = 50 * million
-    , maxRequestedBytesSizePerPeer = 5 * million
+    { maxRequestedBytesSizePerPeer = 5 * million
     , maxRequestBytesSize = 500 * thousand
-    , maxRequestsPerEb = 2
-    , maxRequestsPerTx = 2
+    , maxJobBytesSize = 64 * thousandBase2
+    , maxJobTxCount = 20000 -- TODO do we want this to be low enough to matter?
+    , fetchPriorityWindowSlots = 10 -- TODO read dynamically from ledger state
     , maxLeiosNotifyIngressQueue = 1 * millionBase2
-    , maxLeiosFetchIngressQueue = 50 * millionBase2
+    , maxLeiosFetchIngressQueue = 5 * 12 * millionBase2
     }
  where
   million :: Num a => a
@@ -553,6 +935,23 @@ demoLeiosFetchStaticEnv =
   millionBase2 = 2 ^ (20 :: Int)
   thousand :: Num a => a
   thousand = 10 ^ (3 :: Int)
+  thousandBase2 :: Num a => a
+  thousandBase2 = 2 ^ (10 :: Int)
+
+-- | At most this many outstanding bytes requested from each big-ledger peer.
+--
+-- Derived from the concrete lower-level bound 'maxLeiosFetchIngressQueue': the
+-- scheduler may leave outstanding as many requested tx bytes as the LeiosFetch
+-- ingress queue can hold. The on-the-wire message framing that sits atop those
+-- tx bytes is covered by the +10% @addSafetyMargin@ the mux wiring applies to
+-- 'maxLeiosFetchIngressQueue' when it sets the actual @maximumIngressQueue@, so
+-- a full budget's worth of tx bytes plus framing still fits.
+--
+-- Larger than 'maxRequestedBytesSizePerPeer' so a high-stake peer can be asked
+-- for multiple whole EB closures at once, but still bounded (by the ingress
+-- queue) so an adversarial peer can't drown us.
+maxRequestedBytesSizePerBigLedgerPeer :: LeiosFetchStaticEnv -> BytesSize
+maxRequestedBytesSizePerBigLedgerPeer = maxLeiosFetchIngressQueue
 
 -- * LeiosTx newtype
 
@@ -912,9 +1311,9 @@ messageLeiosFetchToObject = \case
     "kind" .= Aeson.String "MsgDone"
 
 -- | Summary of an EB body inserted into the LeiosTxCache, for observability (see
--- 'TraceLeiosTxCacheEbBody'). The counts nest:
+-- 'TraceLeiosBodyHits'). The counts nest:
 -- @ibsTxsInEb >= ibsTracked >= ibsAcquired >= ibsValidated@.
-data InsertBodySummary = InsertBodySummary
+data LeiosTxCacheInsertBodySummary = MkLeiosTxCacheInsertBodySummary
   { ibsTxsInEb :: !Int
   -- ^ txs the EB body references
   , ibsTracked :: !Int
@@ -932,13 +1331,26 @@ data InsertBodySummary = InsertBodySummary
 
 data TraceLeiosKernel
   = MkTraceLeiosKernel String
-  | TraceLeiosBlockAcquired LeiosPoint
+  | -- | An EB body was first acquired
+    --
+    -- Carries how old the EB was on arrival, if it was preceded by an
+    -- announcement and not forged locally.
+    TraceLeiosBlockAcquired LeiosPoint (Maybe NominalDiffTime)
   | -- | The EB body was received but the point was not in the database. This is
     -- unexpected as the point should have been inserted during announcement handling.
     TraceLeiosBlockPointMissing LeiosPoint
-  | TraceLeiosBlockTxsAcquired LeiosPoint
-  | -- | An EB body was inserted into the LeiosTxCache; carries the insertion summary.
-    TraceLeiosTxCacheEbBody LeiosPoint InsertBodySummary
+  | -- | An EB's tx closure was first completed. Carries the EB's age on arrival,
+    -- as for 'TraceLeiosBlockAcquired'.
+    TraceLeiosBlockTxsAcquired LeiosPoint (Maybe NominalDiffTime)
+  | -- | An EB body was inserted into the LeiosTxCache
+    --
+    -- Carries the LeiosTxCache summary (cache hits), how many of its txs we found
+    -- in our local mempool (the /full/ mempool-resident count, which may overlap
+    -- the cache hits), and how many were in /neither/ and so must be fetched. The
+    -- combined cache+mempool hit rate is thus @(txsInEb - missedBoth) \/ txsInEb@;
+    -- using @missedBoth@ avoids double-counting the mempool\/cache overlap. The two
+    -- 'Int's are the mempool count then @missedBoth@.
+    TraceLeiosBodyHits LeiosPoint LeiosTxCacheInsertBodySummary Int Int
   | forall m. (Show m, TxMeasureMetrics m) => TraceLeiosBlockForged
       { slot :: SlotNo
       , eb :: LeiosEb
@@ -977,6 +1389,13 @@ data TraceLeiosKernel
       -- wall-clock onset to when this node counted it — when known (relayed
       -- announcements carry it; a locally-forged one does not).
       !(Maybe NominalDiffTime)
+  | -- | An arriving 'MsgLeiosBlock' (EB body) from an upstream peer
+    TraceLeiosFetchBodyArrival !FetchArrivalBytes
+  | -- | An arriving 'MsgLeiosBlockTxs' (tx batch) from an upstream peer
+    TraceLeiosFetchTxsArrival !FetchArrivalBytes
+  | -- | One completed iteration of the LeiosFetch decision logic: its wall-clock
+    -- duration and a size sample of the resulting 'LeiosOutstanding' state.
+    TraceLeiosFetchDecision !NominalDiffTime !LeiosOutstandingStats !LeiosDecisionStats
 
 -- | The data of a relayed EB announcement, shared by 'TraceLeiosPeerAnnouncement'
 -- and 'TraceLeiosAnnouncementAccepted'. A separate record so its selectors are
@@ -988,6 +1407,41 @@ data AnnouncementFields = MkAnnouncementFields
   }
   deriving (Eq, Show)
 
+-- | The bytes of one LeiosFetch arrival ('MsgLeiosBlock' or 'MsgLeiosBlockTxs'),
+-- partitioned by the arriving item's /prior/ state in the LeiosTxCache. The four
+-- fields sum to the message's total size.
+--
+-- See 'TraceLeiosFetchBodyArrival' and 'TraceLeiosFetchTxsArrival'.
+data FetchArrivalBytes = MkFetchArrivalBytes
+  { fabInvalid :: !BytesSize
+  -- ^ Bytes of an invalid message (the whole message).
+  , fabEvicted :: !BytesSize
+  -- ^ Bytes whose prior cache state was absent (assumed present once, since evicted).
+  , fabGood :: !BytesSize
+  -- ^ Bytes in the expected not-yet-inserted state.
+  , fabExtra :: !BytesSize
+  -- ^ Bytes already inserted (redundant).
+  }
+  deriving (Eq, Show)
+
+instance Semigroup FetchArrivalBytes where
+  MkFetchArrivalBytes a1 b1 c1 d1 <> MkFetchArrivalBytes a2 b2 c2 d2 =
+    MkFetchArrivalBytes (a1 + a2) (b1 + b2) (c1 + c2) (d1 + d2)
+
+instance Monoid FetchArrivalBytes where
+  mempty = MkFetchArrivalBytes 0 0 0 0
+
+-- | The message's whole size attributed to a single bucket, the rest zero.
+fetchArrivalInvalid
+  , fetchArrivalEvicted
+  , fetchArrivalGood
+  , fetchArrivalExtra ::
+    BytesSize -> FetchArrivalBytes
+fetchArrivalInvalid n = mempty{fabInvalid = n}
+fetchArrivalEvicted n = mempty{fabEvicted = n}
+fetchArrivalGood n = mempty{fabGood = n}
+fetchArrivalExtra n = mempty{fabExtra = n}
+
 -- | Whether the accepted announcement equivocates: a second, distinct header
 -- announcing an election that a prior header already announced. (The two
 -- headers can even announce the same EB hash and size and still equivocate,
@@ -1026,38 +1480,87 @@ deriving instance Show TraceLeiosKernel
 
 traceLeiosKernelToObject :: TraceLeiosKernel -> Aeson.Object
 traceLeiosKernelToObject = \case
+  TraceLeiosFetchBodyArrival fab ->
+    mconcat
+      [ "kind" .= Aeson.String "LeiosFetchBodyArrival"
+      , fabObject fab
+      ]
+  TraceLeiosFetchTxsArrival fab ->
+    mconcat
+      [ "kind" .= Aeson.String "LeiosFetchTxsArrival"
+      , fabObject fab
+      ]
+  TraceLeiosFetchDecision d stats dec ->
+    let inflight = summarizePeerDist (losInflightBytesDesc stats)
+        offers = summarizePeerDist (losOffersDesc stats)
+     in mconcat
+          [ "kind" .= Aeson.String "LeiosFetchDecision"
+          , "durationSeconds" .= (realToFrac d :: Double)
+          , "durationMillis" .= (realToFrac d * 1000 :: Double)
+          , "decisionPeers" .= ldsPeers dec
+          , "decisionRequests" .= ldsRequests dec
+          , "decisionBodyRequests" .= ldsBodyRequests dec
+          , "decisionJobs" .= ldsJobs dec
+          , "decisionBodyBytes" .= ldsBodyBytes dec
+          , "decisionTxBytes" .= ldsTxBytes dec
+          , "tracked" .= losTracked stats
+          , "missingBodies" .= losMissingBodies stats
+          , "peersInflight" .= losPeersInflight stats
+          , "inflightNonzeroCount" .= pdsNonzeroCount inflight
+          , "inflightTotal" .= pdsTotal inflight
+          , "inflightTop1" .= pdsTop1 inflight
+          , "inflightTop2" .= pdsTop2 inflight
+          , "inflightTop3" .= pdsTop3 inflight
+          , "inflightTop4" .= pdsTop4 inflight
+          , "inflightTop5" .= pdsTop5 inflight
+          , "inflightNonzeroMedian" .= pdsNonzeroMedian inflight
+          , "inflightDesc" .= V.toList (losInflightBytesDesc stats)
+          , "offersNonzeroCount" .= pdsNonzeroCount offers
+          , "offersTotal" .= pdsTotal offers
+          , "offersTop1" .= pdsTop1 offers
+          , "offersTop2" .= pdsTop2 offers
+          , "offersTop3" .= pdsTop3 offers
+          , "offersTop4" .= pdsTop4 offers
+          , "offersTop5" .= pdsTop5 offers
+          , "offersNonzeroMedian" .= pdsNonzeroMedian offers
+          , "offersDesc" .= V.toList (losOffersDesc stats)
+          ]
   MkTraceLeiosKernel s ->
     mconcat
       [ "kind" .= Aeson.String "LeiosKernelMsg"
       , "msg" .= s
       ]
-  TraceLeiosBlockAcquired (MkLeiosPoint (SlotNo ebSlot) ebHash) ->
-    mconcat
+  TraceLeiosBlockAcquired (MkLeiosPoint (SlotNo ebSlot) ebHash) mbAge ->
+    mconcat $
       [ "kind" .= Aeson.String "LeiosBlockAcquired"
       , "ebHash" .= prettyEbHash ebHash
       , "ebSlot" .= ebSlot
       ]
+        ++ foldMap (\age -> ["bodyAgeSeconds" .= (realToFrac age :: Double)]) mbAge
   TraceLeiosBlockPointMissing (MkLeiosPoint (SlotNo ebSlot) ebHash) ->
     mconcat
       [ "kind" .= Aeson.String "LeiosBlockPointMissing"
       , "ebHash" .= prettyEbHash ebHash
       , "ebSlot" .= ebSlot
       ]
-  TraceLeiosBlockTxsAcquired (MkLeiosPoint (SlotNo ebSlot) ebHash) ->
-    mconcat
+  TraceLeiosBlockTxsAcquired (MkLeiosPoint (SlotNo ebSlot) ebHash) mbAge ->
+    mconcat $
       [ "kind" .= Aeson.String "LeiosBlockTxsAcquired"
       , "ebHash" .= prettyEbHash ebHash
       , "ebSlot" .= ebSlot
       ]
-  TraceLeiosTxCacheEbBody (MkLeiosPoint (SlotNo ebSlot) ebHash) ibs ->
+        ++ foldMap (\age -> ["closureAgeSeconds" .= (realToFrac age :: Double)]) mbAge
+  TraceLeiosBodyHits (MkLeiosPoint (SlotNo ebSlot) ebHash) ibs mempoolHits missedBoth ->
     mconcat
-      [ "kind" .= Aeson.String "LeiosTxCacheEbBody"
+      [ "kind" .= Aeson.String "LeiosBodyHits"
       , "ebHash" .= prettyEbHash ebHash
       , "ebSlot" .= ebSlot
       , "txsInEb" .= ibsTxsInEb ibs
       , "tracked" .= ibsTracked ibs
       , "acquired" .= ibsAcquired ibs
       , "validated" .= ibsValidated ibs
+      , "mempoolHits" .= mempoolHits
+      , "missedBoth" .= missedBoth
       , "cacheTxCount" .= ibsCacheTxCount ibs
       , "cacheLoad" .= ibsCacheLoad ibs
       ]
@@ -1138,6 +1641,14 @@ traceLeiosKernelToObject = \case
       , announcementEquivocationToObject equivocation
       ]
         ++ foldMap (\age -> ["announcementAgeSeconds" .= (realToFrac age :: Double)]) mbAge
+ where
+  fabObject fab =
+    mconcat
+      [ "invalidBytes" .= fabInvalid fab
+      , "evictedBytes" .= fabEvicted fab
+      , "goodBytes" .= fabGood fab
+      , "extraBytes" .= fabExtra fab
+      ]
 
 announcementFieldsToObject :: AnnouncementFields -> Aeson.Object
 announcementFieldsToObject
diff --git a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes/LeiosJobs.hs b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes/LeiosJobs.hs
new file mode 100644
index 0000000000..be3ec26af7
--- /dev/null
+++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes/LeiosJobs.hs
@@ -0,0 +1,256 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE TypeApplications #-}
+
+-- | The unit of Leios tx-fetch work: 'LeiosJob's and the per-EB 'LeiosJobPool'
+-- that schedules them.
+--
+-- TO BE IMPORTED QUALIFIED
+--
+-- A leaf module (imported by "LeiosDemoTypes") so the pool's structural
+-- operations -- greedy partition, least-requested selection, multiplicity
+-- bookkeeping -- stay together, along with the 'TxHash' carrier and the
+-- 'JobRootHash' commitment it computes (so the fetch machinery can name tx hashes
+-- and their commitment without a cycle through "LeiosDemoTypes").
+--
+-- The key benefit of jobs is to minimize the bookkeeping footprint and churn.
+--
+-- TO BE IMPORTED QUALIFIED
+module LeiosDemoTypes.LeiosJobs (module LeiosDemoTypes.LeiosJobs) where
+
+import qualified Cardano.Crypto.Hash as Hash
+import Control.DeepSeq (NFData)
+import Data.ByteString (ByteString)
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Base16 as BS16
+import qualified Data.ByteString.Char8 as BS8
+import Data.IntMap.Strict (IntMap)
+import qualified Data.IntMap.Strict as IntMap
+import Data.IntSet (IntSet)
+import qualified Data.IntSet as IntSet
+import Data.IntSet.NonEmpty (NEIntSet)
+import qualified Data.IntSet.NonEmpty as NEIntSet
+import Data.Word (Word32)
+import GHC.Generics (Generic)
+import NoThunks.Class (NoThunks)
+import System.Random (StdGen, uniformR)
+
+-- | Hash of a Leios transaction (the 'Cardano.Crypto.Leios.HASH' of its bytes).
+newtype TxHash = MkTxHash ByteString
+  deriving stock (Eq, Ord, Generic)
+  deriving anyclass (NFData, NoThunks)
+
+instance Show TxHash where
+  show = prettyTxHash
+
+prettyTxHash :: TxHash -> String
+prettyTxHash (MkTxHash bytes) = BS8.unpack (BS16.encode bytes)
+
+-- | A job's commitment to which txs it covers: the Blake2b-256 hash of the
+-- concatenated tx hashes (in ascending offset order), via
+-- 'jobRootHashOfTxHashes'. It lets an arriving @MsgLeiosBlockTxs@ be validated
+-- against the job /without/ retaining the EB body -- crucial, since up to ~10k
+-- EBs (each up to ~512 kB) could have txs in flight at once, far too much to
+-- hold in memory.
+newtype JobRootHash = MkJobRootHash ByteString
+  deriving (Eq, Show)
+
+jobRootHashOfTxHashes :: [TxHash] -> JobRootHash
+jobRootHashOfTxHashes =
+  MkJobRootHash
+    . Hash.hashToBytes
+    . Hash.hashWith @Hash.Blake2b_256 id
+    . BS.concat
+    . map (\(MkTxHash bs) -> bs)
+
+-- | A unit of tx-fetch work: the EB-body offsets fetched by one
+-- @MsgLeiosBlockTxsRequest@ (a bitfield over the body's tx vector), the total
+-- on-the-wire byte size of those txs (for the fetch byte budget), and the
+-- 'JobRootHash' commitment used to validate the response.
+data LeiosJob
+  = -- TODO the offset set is immutable and only ever fully traversed, so a packed
+    -- bitfield (a strict ByteString or unboxed Word64 vector) would be more
+    -- compact than the 'IntSet' Patricia tree.
+    MkLeiosJob !IntSet !Word32 !JobRootHash
+  deriving (Eq, Show)
+
+-- | Identifies a 'LeiosJob' within its 'LeiosJobPool' (0-based, stable for the
+-- pool's lifetime).
+newtype LeiosJobId = MkLeiosJobId Int
+  deriving (Eq, Ord, Show)
+
+-- | How many peers currently have an in-flight request for a job.
+newtype LeiosJobMultiplicity = MkLeiosJobMultiplicity Int
+  deriving (Eq, Ord, Show)
+
+-- | A job together with its current in-flight multiplicity.
+data LeiosJobState = MkLeiosJobState !LeiosJob !LeiosJobMultiplicity
+  deriving (Eq, Show)
+
+-- | The not-yet-requested jobs for one acquired EB, plus a reverse index by
+-- multiplicity so a least-requested job is one 'IntMap.minView' away.
+--
+-- INVARIANT: 'jobsByMultiplicity' is the exact inverse of the multiplicities in
+-- 'jobs' -- every job id in 'jobs' sits in exactly the bucket named by its
+-- 'LeiosJobState' multiplicity.
+data LeiosJobPool = MkLeiosJobPool
+  { jobs :: !(IntMap LeiosJobState)
+  -- ^ keyed by 'LeiosJobId'
+  , jobsByMultiplicity :: !(IntMap NEIntSet)
+  -- ^ keyed by 'LeiosJobMultiplicity'
+  }
+  deriving (Eq, Show)
+
+-- | Partition the missing txs into jobs, greedily in offset order: a job grows
+-- until adding the next tx would exceed @maxJobBytes@ or @maxJobTxCount@, but
+-- always holds at least one tx (so an oversized tx would form a solo job, in
+-- the unintended case of max tx size exceeding max job size).
+--
+-- Each miss is its offset within the EB body mapped to its tx hash and its
+-- on-the-wire byte size. Each job's 'JobRootHash' commitment is computed here via
+-- 'jobRootHashOfTxHashes' over its covered tx hashes.
+mkLeiosJobPool ::
+  Word32 -> Int -> IntMap (TxHash, Word32) -> LeiosJobPool
+mkLeiosJobPool maxJobBytes maxJobTxCount misses =
+  MkLeiosJobPool
+    { jobs =
+        IntMap.fromList
+          [ (jid, MkLeiosJobState job (MkLeiosJobMultiplicity 0))
+          | (jid, job) <- ijbs
+          ]
+    , jobsByMultiplicity =
+        maybe IntMap.empty (IntMap.singleton 0) $
+          NEIntSet.nonEmptySet (IntSet.fromList (map fst ijbs))
+    }
+ where
+  ijbs = zip [0 ..] $ case IntMap.toAscList misses of
+    [] -> []
+    ((off0, (h0, sz0)) : rest) -> grow (IntSet.singleton off0) sz0 1 [h0] rest
+
+  flush !cur !bytes hashesRev = MkLeiosJob cur bytes (jobRootHashOfTxHashes (reverse hashesRev))
+
+  grow !cur !bytes !_count hashesRev [] = [flush cur bytes hashesRev]
+  grow !cur !bytes !count hashesRev ((off, (h, sz)) : rest)
+    | count < maxJobTxCount && bytes + sz <= maxJobBytes =
+        grow (IntSet.insert off cur) (bytes + sz) (count + 1) (h : hashesRev) rest
+    | otherwise = flush cur bytes hashesRev : grow (IntSet.singleton off) sz 1 [h] rest
+
+-- | No unfinished jobs remain -- the EB's whole tx-closure has been fetched.
+nullLeiosJobPool :: LeiosJobPool -> Bool
+nullLeiosJobPool = IntMap.null . jobs
+
+-- | The bitfield of an unfinished job, if it is still in the pool.
+lookupJob :: LeiosJobId -> LeiosJobPool -> Maybe LeiosJob
+lookupJob (MkLeiosJobId jid) pool =
+  (\(MkLeiosJobState job _multiplicity) -> job) <$> IntMap.lookup jid (jobs pool)
+
+-- | Restrict a map keyed by 'LeiosJobId' to the jobs still unfinished in the
+-- pool, dropping entries for jobs already 'completeJob'd. Lets the tx-arrival
+-- handler pick out, from a request's covered jobs, the ones we still need to
+-- ingest (a redundant delivery of a completed job is dropped).
+restrictToPending :: IntMap a -> LeiosJobPool -> IntMap a
+restrictToPending m pool = m `IntMap.intersection` jobs pool
+
+-- | The pool with no jobs -- nothing left to fetch.
+emptyLeiosJobPool :: LeiosJobPool
+emptyLeiosJobPool = MkLeiosJobPool IntMap.empty IntMap.empty
+
+-- | Select a least-requested unfinished job (fewest in-flight requests; ties
+-- broken uniformly at random via the supplied PRNG) whose id is /not/ in
+-- @excluded@, record one more in-flight request for it, and return its id, its
+-- bitfield, the updated pool, and the advanced PRNG. 'Nothing' if every
+-- unfinished job is excluded (or the pool is empty), in which case the caller
+-- keeps its own PRNG (nothing was drawn).
+--
+-- The caller passes the job ids this peer already has in flight for the EB, so a
+-- peer is never asked for the same job twice.
+pickLeastRequestedJobExcept ::
+  StdGen -> IntSet -> LeiosJobPool -> Maybe (LeiosJobId, LeiosJob, LeiosJobPool, StdGen)
+pickLeastRequestedJobExcept prng excluded pool =
+  case eligibleBucket of
+    Nothing -> Nothing
+    Just (m, diff) ->
+      -- Draw a uniform index into the eligible bucket's non-excluded jobs.
+      -- 'Data.IntSet' has no indexed access, but a bucket holds at most the ~184
+      -- jobs of one EB, so indexing the ascending list is cheap.
+      let (i, prng') = uniformR (0, IntSet.size diff - 1) prng
+          jid = IntSet.toAscList diff !! i
+       in case IntMap.alterF (bump1 m) jid (jobs pool) of
+            (Nothing, _) -> Nothing
+            (Just job, jobs') ->
+              Just
+                ( MkLeiosJobId jid
+                , job
+                , MkLeiosJobPool
+                    { jobs = jobs'
+                    , jobsByMultiplicity =
+                        bucketInsert (m + 1) jid (bucketDelete m jid (jobsByMultiplicity pool))
+                    }
+                , prng'
+                )
+ where
+  -- Walk multiplicity buckets low-to-high, stopping at the first whose
+  -- non-excluded jobs are non-empty; the caller draws a random one from that
+  -- 'IntSet' difference. 'foldrWithKey' visits ascending keys and is lazy in the
+  -- accumulator, so this stops at the first eligible bucket without materialising
+  -- the bucket list.
+  --
+  -- TODO if we wanted to enforce a limit on the multiplicity of /each job/,
+  -- it'd be easy to do so here: only visit the lower-multiplicity buckets
+  eligibleBucket =
+    IntMap.foldrWithKey
+      ( \m bucket rest ->
+          let diff = IntSet.difference (NEIntSet.toSet bucket) excluded
+           in if IntSet.null diff then rest else Just (m, diff)
+      )
+      Nothing
+      (jobsByMultiplicity pool)
+
+  -- Bump jid from bucket m to m+1, carrying its bitfield out in the same traversal.
+  bump1 _m Nothing = (Nothing, Nothing)
+  bump1 m (Just (MkLeiosJobState job _oldMultiplicity)) =
+    (Just job, Just (MkLeiosJobState job (MkLeiosJobMultiplicity (m + 1))))
+
+-- | Record one fewer in-flight request for a job (on disconnect). A no-op if the
+-- job is no longer in the pool.
+unpickJob :: LeiosJobId -> LeiosJobPool -> LeiosJobPool
+unpickJob (MkLeiosJobId jid) pool =
+  case IntMap.alterF decrement1 jid (jobs pool) of
+    (Nothing, _) -> pool
+    (Just (m, m'), jobs') ->
+      MkLeiosJobPool
+        { jobs = jobs'
+        , jobsByMultiplicity =
+            bucketInsert m' jid (bucketDelete m jid (jobsByMultiplicity pool))
+        }
+ where
+  -- One traversal of 'jobs': the pair functor carries the prior and new
+  -- multiplicities (for the reverse-index move) alongside the new value.
+  decrement1 Nothing = (Nothing, Nothing)
+  decrement1 (Just (MkLeiosJobState job (MkLeiosJobMultiplicity m))) =
+    let m' = m - 1
+     in (Just (m, m'), Just (MkLeiosJobState job (MkLeiosJobMultiplicity m')))
+
+-- | Remove a job from the pool entirely (on its response arriving).
+completeJob :: LeiosJobId -> LeiosJobPool -> LeiosJobPool
+completeJob (MkLeiosJobId jid) pool =
+  case IntMap.alterF delete1 jid (jobs pool) of
+    (Nothing, _) -> pool
+    (Just m, jobs') ->
+      MkLeiosJobPool
+        { jobs = jobs'
+        , jobsByMultiplicity = bucketDelete m jid (jobsByMultiplicity pool)
+        }
+ where
+  -- One traversal of 'jobs': carry out the removed job's multiplicity (for the
+  -- reverse-index delete) while deleting the entry.
+  delete1 Nothing = (Nothing, Nothing)
+  delete1 (Just (MkLeiosJobState _job (MkLeiosJobMultiplicity m))) = (Just m, Nothing)
+
+bucketDelete :: Int -> Int -> IntMap NEIntSet -> IntMap NEIntSet
+bucketDelete m jid = IntMap.update (NEIntSet.nonEmptySet . NEIntSet.delete jid) m
+
+bucketInsert :: Int -> Int -> IntMap NEIntSet -> IntMap NEIntSet
+bucketInsert m jid = IntMap.insertWith NEIntSet.union m (NEIntSet.singleton jid)
diff --git a/ouroboros-consensus/src/ouroboros-consensus/LeiosTxCache.hs b/ouroboros-consensus/src/ouroboros-consensus/LeiosTxCache.hs
index 26ccc2623d..26e926edcd 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/LeiosTxCache.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosTxCache.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE Rank2Types #-}
 
 -- | The LeiosTxCache tracks txs that were acquired because a /recent/ EB
@@ -8,11 +9,10 @@
 -- by the LeiosVoting thread).
 --
 -- The index is in-memory so that latency-critical consumers (LeiosFetch,
--- LeiosVoting) can query it with constantly low latency; its eventual purpose is
--- to /supplant/ the by-hash membership check that @filterMissingWork@ does
--- against the LeiosDb. The size of the LeiosTxCache is bounded first and foremost
--- by the requirement that its index fits comfortably in-memory, even in a worst
--- case.
+-- LeiosVoting) can query it with constantly low latency; it /supplants/ the
+-- by-hash membership check that the fetch logic would otherwise do against the
+-- LeiosDb. The size of the LeiosTxCache is bounded first and foremost by the
+-- requirement that its index fits comfortably in-memory, even in a worst case.
 --
 -- This module is the umbrella: it re-exports the "LeiosTxCache.API" interface
 -- and both handle factories, 'newPureLeiosTxCache' from
@@ -24,9 +24,6 @@
 -- (TODO This is written as if LeiosNotify writes announcements to the LeiosDb,
 -- but it doesn't already... and I'm not sure it will?)
 --
--- (This is written as if LeiosFetch already reads the LeiosTxCache, but it
--- doesn't yet. Remove this warning once it does.)
---
 -- - INVARIANT: an EB announcement in the LeiosTxCacheIndex is in the LeiosDb
 --
 -- - INVARIANT: 'LeiosTxCache.API.BodyAlreadyInserted' EbBody is in the LeiosDb
@@ -96,14 +93,20 @@ newPureLeiosTxCache = do
           MVar.modifyMVar var $ \idx ->
             let (idx', evEbs, evTxs) = Pure.evictOlderThan boundary idx
              in pure (idx', (evEbs, evTxs))
-      , insertBody = \ebh b ->
-          MVar.modifyMVar var $ \idx -> pure (Pure.insertBody ebh b idx)
+      , insertBody = \ebh b nil snoc ->
+          MVar.modifyMVar var $ \idx -> pure (Pure.insertBody ebh b nil snoc idx)
       , lookupBody = \ebh -> do
           idx <- MVar.readMVar var
           pure $! Pure.lookupBody ebh idx
       , withLockedInsertUnappliedTx = \k ->
-          MVar.modifyMVar_ var $ \idx ->
-            k idx (\idx' txh a -> pure $! Pure.insertUnappliedTx txh a idx')
+          MVar.modifyMVar var $ \idx ->
+            k
+              (idx, mempty)
+              ( \(!idx', !fab) txh sz a ->
+                  let (idx'', prior) = Pure.insertUnappliedTx txh a idx'
+                      fab' = fab <> bucketTxArrival prior sz
+                   in idx'' `seq` fab' `seq` pure (idx'', fab')
+              )
       , withLockedInsertAppliedTx = \k ->
           MVar.modifyMVar_ var $ \idx ->
             k idx (\idx' txh v -> pure $! Pure.insertAppliedTx txh v idx')
@@ -121,9 +124,9 @@ nullLeiosTxCache =
   LeiosTxCache
     { insertAnnouncement = \_slot _rbh _ebh -> pure (Set.empty, Set.empty)
     , evictOlderThan = \_boundary -> pure (Set.empty, Set.empty)
-    , insertBody = \_ebh _b -> pure Nothing
+    , insertBody = \_ebh _b _nil _snoc -> pure Nothing
     , lookupBody = \_ebh -> pure Nothing
-    , withLockedInsertUnappliedTx = \k -> k () (\w _txh _a -> pure w)
+    , withLockedInsertUnappliedTx = \k -> k mempty (\fab _txh sz _a -> pure (fab <> bucketTxArrival TxWasUntracked sz))
     , withLockedInsertAppliedTx = \k -> k () (\w _txh _v -> pure w)
     , withLookupTx = \k -> k (\_txh -> pure Nothing)
     }
diff --git a/ouroboros-consensus/src/ouroboros-consensus/LeiosTxCache/API.hs b/ouroboros-consensus/src/ouroboros-consensus/LeiosTxCache/API.hs
index d4b25db625..2c888dcb7a 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/LeiosTxCache/API.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosTxCache/API.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE Rank2Types #-}
 
 -- | The LeiosTxCache interface: the handle type and the small set of types
@@ -16,9 +17,13 @@ module LeiosTxCache.API
   , maxAnnouncementCount
 
     -- * Insert-body observability summary
-  , InsertBodySummary (..)
-  , mkInsertBodySummary
+  , LeiosTxCacheInsertBodySummary (..)
+  , mkLeiosTxCacheInsertBodySummary
   , worstCaseCacheTxCount
+
+    -- * Arrival classification
+  , TxArrivalPrior (..)
+  , bucketTxArrival
   ) where
 
 import Cardano.Slotting.Slot (SlotNo)
@@ -29,12 +34,17 @@ import Data.Set (Set)
 import qualified Data.Vector.Strict as V
 import Data.Word (Word8)
 import LeiosDemoTypes
-  ( EbHash
-  , InsertBodySummary (..)
+  ( BytesSize
+  , EbHash
+  , FetchArrivalBytes
+  , LeiosTxCacheInsertBodySummary (..)
   , RbHash
   , SerializedEbBody (..)
   , TxHash
   , decodeLeiosEb
+  , fetchArrivalEvicted
+  , fetchArrivalExtra
+  , fetchArrivalGood
   , leiosEbTxs
   , maxTxsPerEb
   )
@@ -59,34 +69,54 @@ data LeiosTxCache m a v b = LeiosTxCache
   -- index first is what guarantees it can never report a hit for a tx the LeiosDb
   -- has already dropped. Reverse the order and you arm the hit-prune hazard: a
   -- false hit ⇒ a skipped fetch ⇒ a silently-incomplete EB closure.
-  , insertBody :: EbHash -> b -> m (Maybe InsertBodySummary)
+  , insertBody ::
+      forall w.
+      EbHash ->
+      b ->
+      w ->
+      (w -> Int -> TxHash -> BytesSize -> w) ->
+      m (Maybe (LeiosTxCacheInsertBodySummary, w))
+  -- ^ Record that we hold this EB's body, bumping the refcount of each tx it
+  -- references. In the same pass, fold a caller-supplied accumulator over the
+  -- referenced txs that are /not yet acquired/ (the "misses"): starting from the
+  -- nil @w@ and extending it with the snoc @w -> offset -> 'TxHash' -> 'BytesSize'
+  -- -> w@, where @offset@ is the tx's position in the body. Returns the summary
+  -- and the built @w@, or 'Nothing' when the EB is unannounced or its body is
+  -- already inserted (a no-op, so nothing is folded).
   , lookupBody :: EbHash -> m (Maybe b)
   -- ^ The EB's body if we hold it (its 'BodyState' is 'BodyAlreadyInserted');
   -- 'Nothing' if the EB is untracked or only announced. Unlike a tx, an EB body
   -- pins itself: a hit means it is in the LeiosDb and stays there until the EB is
   -- pruned, so no cross-object reasoning is needed.
-  , withLockedInsertUnappliedTx :: (forall w. w -> (w -> TxHash -> a -> m w) -> m w) -> m ()
+  , withLockedInsertUnappliedTx ::
+      (forall w. w -> (w -> TxHash -> BytesSize -> a -> m w) -> m w) ->
+      m FetchArrivalBytes
   -- ^ Has exclusive write-access
+  --
+  -- The 'BytesSize' argument is only used to accumulate the
+  -- 'FetchArrivalBytes', which is only used for observability.
   , withLockedInsertAppliedTx :: (forall w. w -> (w -> TxHash -> v -> m w) -> m w) -> m ()
   -- ^ Has exclusive write-access
   , withLookupTx :: forall r. ((TxHash -> m (Maybe (Either a v))) -> m r) -> m r
-  -- ^ Does not not hold the lock
+  -- ^ Also holds the lock
   }
 
--- | A body @b@ from which the referenced txs can be enumerated by hash.
+-- | A body @b@ from which the referenced txs can be enumerated, each paired with
+-- its on-the-wire size, in body order.
 --
 -- The fold must visit each referenced 'TxHash' at most once per body (a valid EB
 -- body references a tx at most once), so that a body contributes exactly one to
--- each of its txs' refcounts.
+-- each of its txs' refcounts. Visiting in body order lets a consumer recover each
+-- tx's offset from its position in the fold.
 class ReferencesTxsByHash b where
-  foldTxReferences :: (r -> TxHash -> r) -> r -> b -> r
+  foldTxReferences :: (r -> TxHash -> BytesSize -> r) -> r -> b -> r
 
 -- | The production body type: 'SerializedEbBody' is decoded to enumerate its
 -- referenced txs. (The type lives in "LeiosDemoTypes"; the instance lives here,
 -- with the class, to keep it non-orphan.)
 instance ReferencesTxsByHash SerializedEbBody where
   foldTxReferences f z (MkSerializedEbBody sbs) =
-    V.foldl' (\acc (txh, _sz) -> f acc txh) z (leiosEbTxs eb)
+    V.foldl' (\acc (txh, sz) -> f acc txh sz) z (leiosEbTxs eb)
    where
     eb = case deserialiseFromBytes decodeLeiosEb (LBS.fromStrict (fromShort sbs)) of
       Right (_leftover, decoded) -> decoded
@@ -108,17 +138,35 @@ data BodyState b
     BodyNotYetInserted {-# UNPACK #-} !RefCount
   | BodyAlreadyInserted {-# UNPACK #-} !RefCount !b
 
+-- | A tx's state in the cache /before/ an unapplied insert, surfaced by the
+-- 'withLockedInsertUnappliedTx' step so a caller can classify an arriving tx.
+data TxArrivalPrior
+  = -- | Untracked: no held body references it (assumed present once, since evicted).
+    TxWasUntracked
+  | -- | Referenced by a held body but not yet acquired (the expected case).
+    TxWasNotYetInserted
+  | -- | Already acquired (inserted or validated); a redundant delivery.
+    TxWasAlreadyHeld
+  deriving (Eq, Show)
+
+-- | Bucket an arriving tx's bytes by its prior state (for 'FetchArrivalBytes').
+bucketTxArrival :: TxArrivalPrior -> BytesSize -> FetchArrivalBytes
+bucketTxArrival = \case
+  TxWasUntracked -> fetchArrivalEvicted
+  TxWasNotYetInserted -> fetchArrivalGood
+  TxWasAlreadyHeld -> fetchArrivalExtra
+
 -- | The worst-case number of txs the cache can hold: a full 'maxAnnouncementCount'
 -- window of EBs, each referencing the maximum 'maxTxsPerEb' distinct txs. The fixed
 -- denominator for the cache's load factor.
 worstCaseCacheTxCount :: Int
 worstCaseCacheTxCount = maxAnnouncementCount * maxTxsPerEb
 
--- | Build an 'InsertBodySummary' from the raw counts, computing the load factor
--- ('ibsCacheLoad') against 'worstCaseCacheTxCount'.
-mkInsertBodySummary :: Int -> Int -> Int -> Int -> Int -> InsertBodySummary
-mkInsertBodySummary txsInEb tracked acquired validated cacheTxCount =
-  InsertBodySummary
+-- | Build an 'LeiosTxCacheInsertBodySummary' from the raw counts, computing the
+-- load factor ('ibsCacheLoad') against 'worstCaseCacheTxCount'.
+mkLeiosTxCacheInsertBodySummary :: Int -> Int -> Int -> Int -> Int -> LeiosTxCacheInsertBodySummary
+mkLeiosTxCacheInsertBodySummary txsInEb tracked acquired validated cacheTxCount =
+  MkLeiosTxCacheInsertBodySummary
     { ibsTxsInEb = txsInEb
     , ibsTracked = tracked
     , ibsAcquired = acquired
diff --git a/ouroboros-consensus/src/ouroboros-consensus/LeiosTxCache/Optimized.hs b/ouroboros-consensus/src/ouroboros-consensus/LeiosTxCache/Optimized.hs
index 961a7e15e0..feaf046126 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/LeiosTxCache/Optimized.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosTxCache/Optimized.hs
@@ -29,14 +29,16 @@ import qualified Data.Map.Strict as Map
 import Data.Set (Set)
 import qualified Data.Set as Set
 import Data.Word (Word64)
-import LeiosDemoTypes (EbHash, RbHash, TxHash (..))
+import LeiosDemoTypes (BytesSize, EbHash, FetchArrivalBytes, RbHash, TxHash (..))
 import LeiosTxCache.API
   ( BodyState (..)
   , LeiosTxCache (..)
   , RefCount (..)
   , ReferencesTxsByHash (..)
+  , TxArrivalPrior (..)
+  , bucketTxArrival
   , maxAnnouncementCount
-  , mkInsertBodySummary
+  , mkLeiosTxCacheInsertBodySummary
   )
 import qualified LeiosTxCache.Optimized.MutableHashTable as HT
 import Ouroboros.Consensus.Util.IOLike (IOLike)
@@ -86,37 +88,40 @@ newHashTableLeiosTxCache nshift k0 k1 = do
           MVar.modifyMVar stateVar $ \st ->
             let st' = st{hsPrunedSlot = max (hsPrunedSlot st) boundary}
              in evictWhile ht (oldestIsStale (hsPrunedSlot st')) st' Set.empty Set.empty
-      , insertBody = \ebh b ->
+      , insertBody = \ebh b nil snoc ->
           MVar.modifyMVar stateVar $ \st ->
             case Map.lookup ebh (hsBodies st) of
               Nothing -> pure (st, Nothing)
               Just BodyAlreadyInserted{} -> pure (st, Nothing)
               Just (BodyNotYetInserted rc) -> do
-                -- bump each tx's refcount and classify its prior state in one pass
-                (n, tracked, acquired, validated) <-
+                -- bump each tx's refcount and classify its prior state in one
+                -- pass; snoc every not-yet-acquired tx (@da == 0@, a "miss") onto
+                -- the caller's accumulator at its body offset (@nn@)
+                (n, tracked, acquired, validated, w) <-
                   foldTxReferences
-                    ( \acc txh -> do
-                        (!nn, !tt, !aa, !vv) <- acc
+                    ( \acc txh sz -> do
+                        (!nn, !tt, !aa, !vv, !w) <- acc
                         (dt, da, dv) <- priorClass <$> bumpTx ht txh
-                        pure (nn + 1, tt + dt, aa + da, vv + dv)
+                        let w' = if da == 0 then snoc w nn txh sz else w
+                        pure (nn + 1, tt + dt, aa + da, vv + dv, w')
                     )
-                    (pure (0, 0, 0, 0))
+                    (pure (0, 0, 0, 0, nil))
                     b
                 cacheTxCount <- HT.size ht
                 let st' = st{hsBodies = Map.insert ebh (BodyAlreadyInserted rc b) (hsBodies st)}
-                pure (st', Just (mkInsertBodySummary n tracked acquired validated cacheTxCount))
+                pure (st', Just (mkLeiosTxCacheInsertBodySummary n tracked acquired validated cacheTxCount, w))
       , lookupBody = \ebh ->
           MVar.withMVar stateVar $ \st ->
             pure $ case Map.lookup ebh (hsBodies st) of
               Just (BodyAlreadyInserted _ b) -> Just b
               _ -> Nothing
       , withLockedInsertUnappliedTx = \k ->
-          MVar.modifyMVar_ stateVar $ \st -> do
-            _ <- k () (\_ txh _ -> setTag ht tagAlreadyInserted txh)
-            pure st
+          MVar.modifyMVar stateVar $ \st -> do
+            fab <- k mempty (\fab txh sz () -> setTag ht tagAlreadyInserted fab txh sz)
+            pure (st, fab)
       , withLockedInsertAppliedTx = \k ->
           MVar.modifyMVar_ stateVar $ \st -> do
-            _ <- k () (\_ txh _ -> setTag ht tagAlreadyValidated txh)
+            () <- k () (\() txh () -> setTag_ ht tagAlreadyValidated txh)
             pure st
       , withLookupTx = \k ->
           MVar.withMVar stateVar $ \_ -> k (lookupOne ht)
@@ -244,7 +249,7 @@ decBodyTxs ::
   #-}
 decBodyTxs ht =
   foldTxReferences
-    ( \act txh -> do
+    ( \act txh _sz -> do
         s <- act
         evicted <- decTx ht txh
         pure (if evicted then Set.insert txh s else s)
@@ -327,15 +332,42 @@ decTx ht txh = do
       | otherwise -> HT.insert ht key (mkVal (valRefcount w - 1) (valTag w)) >> pure False
 
 -- | Set a present tx's state tag, preserving its refcount; no-op if absent.
-setTag :: PrimMonad m => HT.MutableHashTable (PrimState m) -> Word64 -> TxHash -> m ()
-{-# SPECIALIZE setTag :: HT.MutableHashTable (PrimState IO) -> Word64 -> TxHash -> IO () #-}
-setTag ht tag txh = do
+setTag_ :: PrimMonad m => HT.MutableHashTable (PrimState m) -> Word64 -> TxHash -> m ()
+{-# SPECIALIZE setTag_ :: HT.MutableHashTable (PrimState IO) -> Word64 -> TxHash -> IO () #-}
+setTag_ ht tag txh = do
   let key = toKey txh
   mv <- HT.lookup ht key
   case mv of
     Nothing -> pure ()
     Just w -> HT.insert ht key (mkVal (valRefcount w) tag)
 
+-- | Like 'setTag', but also maintains a 'FetchArrivalBytes'
+setTag ::
+  PrimMonad m =>
+  HT.MutableHashTable (PrimState m) ->
+  Word64 ->
+  FetchArrivalBytes ->
+  TxHash ->
+  BytesSize ->
+  m FetchArrivalBytes
+{-# SPECIALIZE setTag ::
+  HT.MutableHashTable (PrimState IO) ->
+  Word64 ->
+  FetchArrivalBytes ->
+  TxHash ->
+  BytesSize ->
+  IO FetchArrivalBytes
+  #-}
+setTag ht tag fab txh sz = do
+  let key = toKey txh
+  mv <- HT.lookup ht key
+  case mv of
+    Nothing -> pure $! fab <> bucketTxArrival TxWasUntracked sz
+    Just w -> do
+      HT.insert ht key (mkVal (valRefcount w) tag)
+      let !cls = if valTag w == tagNotYetInserted then TxWasNotYetInserted else TxWasAlreadyHeld
+      pure $! fab <> bucketTxArrival cls sz
+
 lookupOne :: PrimMonad m => HT.MutableHashTable (PrimState m) -> TxHash -> m (Maybe (Either () ()))
 {-# SPECIALIZE lookupOne ::
   HT.MutableHashTable (PrimState IO) -> TxHash -> IO (Maybe (Either () ()))
diff --git a/ouroboros-consensus/src/ouroboros-consensus/LeiosTxCache/Reference.hs b/ouroboros-consensus/src/ouroboros-consensus/LeiosTxCache/Reference.hs
index 7b1f881ded..f1d753d072 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/LeiosTxCache/Reference.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosTxCache/Reference.hs
@@ -64,14 +64,15 @@ import qualified Data.Map.Strict as Map
 import Data.Maybe.Strict (StrictMaybe (..))
 import Data.Set (Set)
 import qualified Data.Set as Set
-import LeiosDemoTypes (EbHash, RbHash, TxHash)
+import LeiosDemoTypes (BytesSize, EbHash, RbHash, TxHash)
 import LeiosTxCache.API
   ( BodyState (..)
-  , InsertBodySummary
+  , LeiosTxCacheInsertBodySummary
   , RefCount (..)
   , ReferencesTxsByHash (..)
+  , TxArrivalPrior (..)
   , maxAnnouncementCount
-  , mkInsertBodySummary
+  , mkLeiosTxCacheInsertBodySummary
   )
 import qualified Lens.Micro as L
 import qualified Lens.Micro.Extras as L
@@ -290,7 +291,8 @@ decBody ebh bs ts = case Map.lookup ebh bs of
     SNothing ->
       let (ts', evTxs) = case b of
             BodyNotYetInserted _ -> (ts, Set.empty)
-            BodyAlreadyInserted _ body -> foldTxReferences decTx (ts, Set.empty) body
+            BodyAlreadyInserted _ body ->
+              foldTxReferences (\acc txh _sz -> decTx acc txh) (ts, Set.empty) body
        in (Map.delete ebh bs, ts', Set.singleton ebh, evTxs)
 
 decTx ::
@@ -313,14 +315,16 @@ insertBody ::
   ReferencesTxsByHash b =>
   EbHash ->
   b ->
+  w ->
+  (w -> Int -> TxHash -> BytesSize -> w) ->
   LeiosTxCacheIndex a v b ->
-  (LeiosTxCacheIndex a v b, Maybe InsertBodySummary)
-insertBody ebh body idx = case Map.lookup ebh (bodyState idx) of
+  (LeiosTxCacheIndex a v b, Maybe (LeiosTxCacheInsertBodySummary, w))
+insertBody ebh body nil snoc idx = case Map.lookup ebh (bodyState idx) of
   Nothing -> (idx, Nothing)
   Just BodyAlreadyInserted{} -> (idx, Nothing)
   Just (BodyNotYetInserted rc) ->
-    let ((n, tracked, acquired, validated), txState') =
-          foldTxReferences bumpTx ((0, 0, 0, 0), txState idx) body
+    let ((n, tracked, acquired, validated, w), txState') =
+          foldTxReferences bumpTx ((0, 0, 0, 0, nil), txState idx) body
         idx' =
           MkLeiosTxCacheIndex
             { announcementState = announcementState idx
@@ -329,35 +333,36 @@ insertBody ebh body idx = case Map.lookup ebh (bodyState idx) of
             , txState = txState'
             , prunedSlot = prunedSlot idx
             }
-     in (idx', Just (mkInsertBodySummary n tracked acquired validated (Map.size txState')))
+     in (idx', Just (mkLeiosTxCacheInsertBodySummary n tracked acquired validated (Map.size txState'), w))
  where
-  -- Bump each tx's refcount and, in the same pass, classify its /prior/ state so
-  -- the summary needs no second traversal.
-  bumpTx ((!nn, !tt, !aa, !vv), ts) txh =
-    let (dt, da, dv) = case Map.lookup txh ts of
-          Nothing -> (0, 0, 0) -- new: not yet tracked
-          Just (TxNotYetInserted _) -> (1, 0, 0) -- tracked, not acquired
-          Just (TxAlreadyInserted _ _) -> (1, 1, 0) -- acquired, not validated
-          Just (TxAlreadyValidated _ _) -> (1, 1, 1) -- acquired and validated
+  -- Bump each tx's refcount and, in the same pass, classify its /prior/ state:
+  -- the counts feed the summary, and every not-yet-acquired tx (a "miss") is
+  -- snoc'd onto the caller's accumulator at its body offset ('nn'), so no second
+  -- traversal is needed.
+  bumpTx ((!nn, !tt, !aa, !vv, !w), ts) txh sz =
+    let (dt, da, dv, miss) = case Map.lookup txh ts of
+          Nothing -> (0, 0, 0, True) -- new: not yet tracked
+          Just (TxNotYetInserted _) -> (1, 0, 0, True) -- tracked, not acquired
+          Just (TxAlreadyInserted _ _) -> (1, 1, 0, False) -- acquired, not validated
+          Just (TxAlreadyValidated _ _) -> (1, 1, 1, False) -- acquired and validated
         ts' =
           Map.alter
             (Just . maybe (TxNotYetInserted (MkRefCount 1)) (L.over txRefCountL incRefCount))
             txh
             ts
-     in ((nn + 1, tt + dt, aa + da, vv + dv), ts')
+        w' = if miss then snoc w nn txh sz else w
+     in ((nn + 1, tt + dt, aa + da, vv + dv, w'), ts')
 
--- | Record the payload of a fetched-but-not-yet-applied tx, without changing its
--- refcount. A no-op if no inserted body references this tx.
-insertUnappliedTx :: TxHash -> a -> LeiosTxCacheIndex a v b -> LeiosTxCacheIndex a v b
-insertUnappliedTx txh a idx =
-  MkLeiosTxCacheIndex
-    { announcementState = announcementState idx
-    , announcementCount = announcementCount idx
-    , bodyState = bodyState idx
-    , txState = Map.alter upd txh (txState idx)
-    , prunedSlot = prunedSlot idx
-    }
+-- | Record the payload of a fetched-but-not-yet-applied tx
+insertUnappliedTx ::
+  TxHash -> a -> LeiosTxCacheIndex a v b -> (LeiosTxCacheIndex a v b, TxArrivalPrior)
+insertUnappliedTx txh a idx = (idx{txState = txState'}, prior)
  where
+  (prior, txState') = Map.alterF (\mv -> (classify mv, upd mv)) txh (txState idx)
+  classify = \case
+    Nothing -> TxWasUntracked
+    Just (TxNotYetInserted _) -> TxWasNotYetInserted
+    Just _ -> TxWasAlreadyHeld
   upd Nothing = Nothing
   upd (Just tx) = Just (TxAlreadyInserted (L.view txRefCountL tx) a)
 
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Mempool/API.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Mempool/API.hs
index d13c077e8f..96e63989b5 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Mempool/API.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Mempool/API.hs
@@ -50,9 +50,11 @@ module Ouroboros.Consensus.Mempool.API
 
 import Data.DerivingVia (InstantiatedAt (..))
 import qualified Data.List.NonEmpty as NE
+import Data.Map.Strict (Map)
 import Data.Measure (Measure)
 import qualified Data.Measure
 import GHC.Generics (Generic)
+import LeiosDemoTypes.LeiosJobs (TxHash)
 import NoThunks.Class
 import Ouroboros.Consensus.Block (ChainHash, Point, SlotNo)
 import Ouroboros.Consensus.Ledger.Abstract
@@ -231,6 +233,10 @@ data Mempool m blk = Mempool
   -- removed because they have become invalid.
   --
   -- This capacity excludes the `mempoolTimeoutCapacity`.
+  , getLeiosTxIndex :: STM m (Map TxHash (Validated (GenTx blk)))
+  -- ^ The current mempool contents indexed by Leios EB-tx hash: lets the Leios
+  -- fetch logic find an EB's referenced txs in our mempool by hash. Empty in a
+  -- non-Leios setup (see 'ResolveLeiosBlock'\''s @leiosTxHashOfGenTx@).
   , testTryAddTx ::
       DiffTime ->
       AddTxOnBehalfOf ->
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Mempool/Impl/Common.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Mempool/Impl/Common.hs
index ef6b1058d5..a40e676a28 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Mempool/Impl/Common.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Mempool/Impl/Common.hs
@@ -54,12 +54,16 @@ import qualified Data.Aeson.Key as AesonKey
 import Data.Bifunctor (second)
 import qualified Data.Foldable as Foldable
 import qualified Data.List.NonEmpty as NE
+import Data.Map.Strict (Map)
+import qualified Data.Map.Strict as Map
+import Data.Maybe.Strict (StrictMaybe (..), maybeToStrictMaybe, strictMaybe)
 import Data.Set (Set)
 import qualified Data.Set as Set
 import qualified Data.Text as Text
 import Data.Typeable
 import Data.Word (Word64)
 import GHC.Generics (Generic)
+import LeiosDemoTypes.LeiosJobs (TxHash)
 import NoThunks.Class
 import Ouroboros.Consensus.Block
 import Ouroboros.Consensus.HeaderValidation
@@ -92,6 +96,11 @@ import Ouroboros.Network.Protocol.LocalStateQuery.Type
 data ValidatedTxWithDiffs blk = ValidatedTxWithDiffs
   { validatedTx :: !(Validated (GenTx blk))
   , validatedTxDiffs :: !(LedgerTables (TickedLedgerState blk) DiffMK)
+  , validatedTxLeiosHash :: !(StrictMaybe TxHash)
+  -- ^ Cached here so it isn't computed on every resync.
+  --
+  -- 'SNothing' for txs that can't be in a Leios block (eg when the Mempool is
+  -- in a Cardano era in which Leios is not enabled).
   }
   deriving Generic
 
@@ -121,6 +130,13 @@ data InternalState blk = IS
   -- 'MempoolSnapshot' (see 'snapshotHasTx').
   --
   -- This should always be in-sync with the transactions in 'isTxs'.
+  , isLeiosTxIndex :: !(Map TxHash (Validated (GenTx blk)))
+  -- ^ The mempool's transactions indexed by their Leios EB-tx hash (a hash of a
+  -- /different/ preimage than 'GenTxId', so 'isTxIds' can't answer it). Lets the
+  -- Leios fetch logic find an EB's referenced txs in our mempool by hash without
+  -- rescanning. Maintained in lockstep with 'isTxs' via the block's
+  -- 'ResolveLeiosBlock' @leiosTxHashOfGenTx@; empty when that returns 'Nothing'
+  -- for every tx (i.e. a non-Leios setup).
   , isTxKeys :: !(LedgerTables (LedgerState blk) KeysMK)
   -- ^ The cached set of keys needed for the transactions
   -- currently in the mempool.
@@ -213,6 +229,7 @@ initInternalState capacityOverride lastTicketNo cfg slot st =
   IS
     { isTxs = TxSeq.Empty
     , isTxIds = Set.empty
+    , isLeiosTxIndex = Map.empty
     , isTxKeys = emptyLedgerTables
     , isTxValues = emptyLedgerTables
     , isLedgerState = st
@@ -362,7 +379,7 @@ tickLedgerState cfg (ForgeInUnknownSlot st) =
 -- | Extend 'InternalState' with a new transaction (one which we have not
 -- previously validated) that may or may not be valid in this ledger state.
 validateNewTransaction ::
-  (LedgerSupportsMempool blk, HasTxId (GenTx blk)) =>
+  (LedgerSupportsMempool blk, HasTxId (GenTx blk), ResolveLeiosBlock blk) =>
   LedgerConfig blk ->
   WhetherToIntervene ->
   GenTx blk ->
@@ -388,12 +405,13 @@ validateNewTransaction cfg wti tx txsz origValues st is =
             { isTxs =
                 isTxs
                   :> TxTicket
-                    (ValidatedTxWithDiffs vtx (projectLedgerTables st'))
+                    (ValidatedTxWithDiffs vtx (projectLedgerTables st') leiosHash)
                     nextTicketNo
                     (MkTxMeasureWithDiffTime txsz dur)
             , isTxKeys = isTxKeys <> getTransactionKeySets tx
             , isTxValues = ltliftA2 unionValues isTxValues origValues
             , isTxIds = Set.insert (txId tx) isTxIds
+            , isLeiosTxIndex = strictMaybe id (\h -> Map.insert h vtx) leiosHash isLeiosTxIndex
             , isLedgerState = prependMempoolDiffs isLedgerState st'
             , isLastTicketNo = nextTicketNo
             }
@@ -402,6 +420,7 @@ validateNewTransaction cfg wti tx txsz origValues st is =
   IS
     { isTxs
     , isTxIds
+    , isLeiosTxIndex
     , isTxKeys
     , isTxValues
     , isLedgerState
@@ -411,6 +430,8 @@ validateNewTransaction cfg wti tx txsz origValues st is =
 
   nextTicketNo = succ isLastTicketNo
 
+  leiosHash = maybeToStrictMaybe (leiosTxHashOfGenTx tx)
+
 -- | Revalidate the given transactions against the given ticked ledger state,
 -- producing a new 'InternalState'.
 --
@@ -501,6 +522,14 @@ revalidateTxsFor' frk capacityOverride cfg slot (RevalidateTxsResult cand remove
       cand
         { isTxs = Foldable.foldl' (:>) (isTxs cand) (map unwrap validDelta)
         , isTxIds = isTxIds cand <> Set.fromList (map (txId . txForgetValidated . fst3) validDelta)
+        , isLeiosTxIndex =
+            -- Reuse each survivor's memoized hash (carried through 'reapplyTxs'' in
+            -- the per-tx payload) -- never recompute it on a resync.
+            isLeiosTxIndex cand
+              <> Map.fromList
+                [ (h, vtx)
+                | (vtx, _df, (_tk, _tz, SJust h)) <- validDelta
+                ]
         , isTxKeys = isTxKeys cand <> survivorKeys
         , -- REVIEW(utxo-hd): incremental value cache. Equal to the from-scratch
           -- @restrictValuesMK (isTxValues cand `union` deltaValues) (allKeys)@:
@@ -522,8 +551,8 @@ revalidateTxsFor' frk capacityOverride cfg slot (RevalidateTxsResult cand remove
         }
   pure $ RevalidateTxsResult newIS (removedSoFar ++ errDelta)
  where
-  wrap (TxTicket (ValidatedTxWithDiffs tx df) tk tz) = (tx, df, (tk, tz))
-  unwrap (tx, df, (tk, tz)) = TxTicket (ValidatedTxWithDiffs tx df) tk tz
+  wrap (TxTicket (ValidatedTxWithDiffs tx df mh) tk tz) = (tx, df, (tk, tz, mh))
+  unwrap (tx, df, (tk, tz, mh)) = TxTicket (ValidatedTxWithDiffs tx df mh) tk tz
   fst3 (x, _, _) = x
   snd3 (_, x, _) = x
 
@@ -561,6 +590,9 @@ computeSnapshot capacityOverride cfg slot st values lastTicketNo txTickets =
         IS
           { isTxs = TxSeq.fromList $ map unwrap validatedTxs
           , isTxIds = Set.fromList $ map (txId . txForgetValidated . fst3) validatedTxs
+          , -- The Leios index is read from the committed state, never from a
+            -- 'getSnapshotFor' snapshot, so leave it empty here.
+            isLeiosTxIndex = Map.empty
           , -- These two can be empty since we don't need the resulting
             -- values at all when making a snapshot, as we won't update
             -- the internal state.
@@ -578,8 +610,8 @@ computeSnapshot capacityOverride cfg slot st values lastTicketNo txTickets =
           }
  where
   fst3 (x, _, _) = x
-  wrap = (\(TxTicket (ValidatedTxWithDiffs tx df) tk tz) -> (tx, (), (df, tk, tz)))
-  unwrap = (\(tx, (), (df, tk, tz)) -> (TxTicket (ValidatedTxWithDiffs tx df) tk tz))
+  wrap = (\(TxTicket (ValidatedTxWithDiffs tx df mh) tk tz) -> (tx, (), (df, tk, tz, mh)))
+  unwrap = (\(tx, (), (df, tk, tz, mh)) -> (TxTicket (ValidatedTxWithDiffs tx df mh) tk tz))
 
 {-------------------------------------------------------------------------------
   Conversions
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Mempool/Init.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Mempool/Init.hs
index 6b696af015..96e33f590d 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Mempool/Init.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Mempool/Init.hs
@@ -20,6 +20,7 @@ import Ouroboros.Consensus.Mempool.Capacity
 import Ouroboros.Consensus.Mempool.Impl.Common
 import Ouroboros.Consensus.Mempool.Query
 import Ouroboros.Consensus.Mempool.Update
+import Ouroboros.Consensus.Storage.LedgerDB.Forker (ResolveLeiosBlock)
 import Ouroboros.Consensus.Util.IOLike
 import Ouroboros.Consensus.Util.STM
 import Ouroboros.Network.Block (Point)
@@ -36,6 +37,7 @@ openMempool ::
   , LedgerSupportsMempool blk
   , HasTxId (GenTx blk)
   , ValidateEnvelope blk
+  , ResolveLeiosBlock blk
   ) =>
   ResourceRegistry m ->
   LedgerInterface m blk ->
@@ -91,6 +93,7 @@ openMempoolWithoutSyncThread ::
   , LedgerSupportsMempool blk
   , HasTxId (GenTx blk)
   , ValidateEnvelope blk
+  , ResolveLeiosBlock blk
   ) =>
   LedgerInterface m blk ->
   LedgerConfig blk ->
@@ -107,6 +110,7 @@ mkMempool ::
   , LedgerSupportsMempool blk
   , HasTxId (GenTx blk)
   , ValidateEnvelope blk
+  , ResolveLeiosBlock blk
   ) =>
   MempoolEnv m blk -> Mempool m blk
 mkMempool mpEnv =
@@ -117,6 +121,7 @@ mkMempool mpEnv =
     , getSnapshotFor = implGetSnapshotFor mpEnv
     , getSnapshotForNoCache = implGetSnapshotForNoCache mpEnv
     , getCapacity = isCapacity <$> readTMVar istate
+    , getLeiosTxIndex = isLeiosTxIndex <$> readTMVar istate
     , testSyncWithLedger = implSyncWithLedger snapshotFromIS mpEnv
     , testTryAddTx = implAddTx mpEnv . TestingAddTx
     }
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Mempool/Update.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Mempool/Update.hs
index 5c2ffd321a..e57ce88c8d 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Mempool/Update.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Mempool/Update.hs
@@ -67,6 +67,7 @@ implAddTx ::
   , MonadTimer m
   , LedgerSupportsMempool blk
   , HasTxId (GenTx blk)
+  , ResolveLeiosBlock blk
   ) =>
   MempoolEnv m blk ->
   WhichAddTx f ->
@@ -176,6 +177,7 @@ doAddTx ::
   forall m blk f.
   ( LedgerSupportsMempool blk
   , HasTxId (GenTx blk)
+  , ResolveLeiosBlock blk
   , IOLike m
   , MonadTimer m
   ) =>
@@ -303,6 +305,7 @@ doAddTx mpEnv caller wti tx = do
 pureTryAddTx ::
   ( LedgerSupportsMempool blk
   , HasTxId (GenTx blk)
+  , ResolveLeiosBlock blk
   ) =>
   MempoolEnv m blk ->
   -- | The ledger configuration.
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/Forker.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/Forker.hs
index 418b0e4532..2693a147be 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/Forker.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/Forker.hs
@@ -71,6 +71,7 @@ import Control.Monad.Except
   , runExcept
   )
 import Data.Bifunctor (first)
+import qualified Data.ByteString as Strict
 import Data.Functor ((<&>))
 import Data.Kind
 import Data.List.NonEmpty (NonEmpty)
@@ -89,6 +90,7 @@ import LeiosDemoTypes
   , LeiosExtValidationError (..)
   , LeiosPoint (..)
   , RbHash
+  , TxHash
   , minCertificationThreshold
   , verifyLeiosCert
   )
@@ -912,6 +914,19 @@ class ResolveLeiosBlock blk where
   announcingRbHash :: blk -> Maybe RbHash
   announcingRbHash _ = Nothing
 
+  -- | The Leios EB-tx hash of a mempool tx, if this block's txs are Leios txs.
+  -- Lets the mempool index its contents by the hash an EB references (see
+  -- 'Ouroboros.Consensus.Mempool.API.getLeiosTxIndex'). 'Nothing' (the default)
+  -- for non-Leios eras.
+  leiosTxHashOfGenTx :: GenTx blk -> Maybe TxHash
+  leiosTxHashOfGenTx _ = Nothing
+
+  -- | The 'LeiosTx' wire bytes of a mempool tx (the preimage of
+  -- 'leiosTxHashOfGenTx'), if any -- what the Leios fetch logic ingests when it
+  -- finds an EB's tx in our mempool. 'Nothing' (the default) for non-Leios eras.
+  leiosTxBytesOfGenTx :: GenTx blk -> Maybe Strict.ByteString
+  leiosTxBytesOfGenTx _ = Nothing
+
 -- | Resolve and inline EB closure transactions as announced on the previous
 -- header. NOTE: This produces a block that would fail full validation.
 resolveLeiosBlock ::
diff --git a/ouroboros-consensus/src/unstable-mempool-test-utils/Test/Consensus/Mempool/Mocked.hs b/ouroboros-consensus/src/unstable-mempool-test-utils/Test/Consensus/Mempool/Mocked.hs
index 046d8ae9be..0e384f169b 100644
--- a/ouroboros-consensus/src/unstable-mempool-test-utils/Test/Consensus/Mempool/Mocked.hs
+++ b/ouroboros-consensus/src/unstable-mempool-test-utils/Test/Consensus/Mempool/Mocked.hs
@@ -73,6 +73,7 @@ openMockedMempool ::
   ( Ledger.LedgerSupportsMempool blk
   , Ledger.HasTxId (Ledger.GenTx blk)
   , Header.ValidateEnvelope blk
+  , ResolveLeiosBlock blk
   ) =>
   Mempool.MempoolCapacityBytesOverride ->
   Tracer IO (Mempool.TraceEventMempool blk) ->
diff --git a/ouroboros-consensus/test/consensus-test/Main.hs b/ouroboros-consensus/test/consensus-test/Main.hs
index 68278c6e34..522e48935c 100644
--- a/ouroboros-consensus/test/consensus-test/Main.hs
+++ b/ouroboros-consensus/test/consensus-test/Main.hs
@@ -26,6 +26,7 @@ import qualified Test.Consensus.Util.Versioned (tests)
 import qualified Test.LeiosDemoDb (tests)
 import qualified Test.LeiosDemoLogic (tests)
 import qualified Test.LeiosDemoLogic.Announcements (tests)
+import qualified Test.LeiosDemoLogic.Invariants (tests)
 import qualified Test.LeiosDemoTypes (tests)
 import qualified Test.LeiosTxCache.Optimized (tests)
 import qualified Test.LeiosTxCache.Optimized.MutableHashTable (tests)
@@ -87,6 +88,7 @@ tests =
         , Test.LeiosDemoDb.tests
         , Test.LeiosDemoLogic.tests
         , Test.LeiosDemoLogic.Announcements.tests
+        , Test.LeiosDemoLogic.Invariants.tests
         , Test.LeiosTxCache.Optimized.tests
         , Test.LeiosTxCache.Optimized.MutableHashTable.tests
         , Test.LeiosTxCache.Reference.tests
diff --git a/ouroboros-consensus/test/consensus-test/Test/Consensus/Mempool/StateMachine.hs b/ouroboros-consensus/test/consensus-test/Test/Consensus/Mempool/StateMachine.hs
index 7fe968555b..ba72eb8ba7 100644
--- a/ouroboros-consensus/test/consensus-test/Test/Consensus/Mempool/StateMachine.hs
+++ b/ouroboros-consensus/test/consensus-test/Test/Consensus/Mempool/StateMachine.hs
@@ -613,6 +613,7 @@ mkSUT ::
   , MonadTimer m
   , LedgerSupportsProtocol blk
   , LedgerSupportsMempool blk
+  , ResolveLeiosBlock blk
   , HasTxId (GenTx blk)
   ) =>
   LedgerConfig blk ->
diff --git a/ouroboros-consensus/test/consensus-test/Test/LeiosDemoDb.hs b/ouroboros-consensus/test/consensus-test/Test/LeiosDemoDb.hs
index db5ffcee1e..a9b14c7490 100644
--- a/ouroboros-consensus/test/consensus-test/Test/LeiosDemoDb.hs
+++ b/ouroboros-consensus/test/consensus-test/Test/LeiosDemoDb.hs
@@ -31,8 +31,6 @@ import LeiosDemoDb
   ( LeiosDbHandle (..)
   , LeiosEbNotification (..)
   , leiosDbBatchRetrieveTxs
-  , leiosDbFilterMissingEbBodies
-  , leiosDbFilterMissingTxs
   , leiosDbInsertEbBody
   , leiosDbInsertEbPoint
   , leiosDbInsertTxs
@@ -143,16 +141,6 @@ mkTestGroups impl =
       , testCase "same EB hash at multiple slots notifies each completion" $
           withFreshDb impl test_multipleSlotsSameHash
       ]
-  , testGroup
-      "filterMissingEbBodies"
-      [ testProperty "empty input returns empty" $ prop_filterEbBodiesEmpty impl
-      , testProperty "returns only missing EBs" $ prop_filterEbBodiesCorrect impl
-      ]
-  , testGroup
-      "filterMissingTxs"
-      [ testProperty "empty input returns empty" $ prop_filterTxsEmpty impl
-      , testProperty "returns only missing TXs" $ prop_filterTxsCorrect impl
-      ]
   , testGroup
       "lookupEbClosure"
       [ testProperty "complete EB returns Just with tx data" $ prop_completedEbComplete impl
@@ -739,76 +727,6 @@ assertOfferBlockTxs expectedPoint = \case
   AcquiredEb _ _ ->
     assertFailure "expected AcquiredEbTxs, got AcquiredEb"
 
--- * Property tests for filterHaveEbBodies
-
--- | Property: filtering empty list returns empty list.
-prop_filterEbBodiesEmpty :: DbImpl -> Property
-prop_filterEbBodiesEmpty impl =
-  ioProperty $ withFreshDb impl $ \db -> withLeiosDb db $ \con -> do
-    result <- leiosDbFilterMissingEbBodies con []
-    pure $ result === []
-
--- | Property: filter returns exactly the EBs whose bodies are missing.
-prop_filterEbBodiesCorrect :: DbImpl -> Property
-prop_filterEbBodiesCorrect impl =
-  forAll (chooseInt (1, 20)) $ \numEbs ->
-    forAll (replicateM numEbs (genPointAndEb 5)) $ \pointsAndEbs ->
-      forAllBlind (sublistOf pointsAndEbs) $ \toInsert ->
-        ioProperty $
-          withFreshDb impl $ \db ->
-            withLeiosDb db $ \con -> do
-              -- Insert some EBs (those in toInsert will have bodies)
-              forM_ toInsert $ \(point, eb) -> do
-                leiosDbInsertEbPoint con point (leiosEbBytesSize eb)
-                void $ leiosDbInsertEbBody con point eb
-              -- Also insert points without bodies for the rest
-              let withoutBodies = filter (`notElem` toInsert) pointsAndEbs
-              forM_ withoutBodies $ \(point, eb) ->
-                leiosDbInsertEbPoint con point (leiosEbBytesSize eb)
-              -- Filter should return the ones WITHOUT bodies
-              let allPoints = [p | (p, _) <- pointsAndEbs]
-                  expectedMissing = [p | (p, _) <- withoutBodies]
-              (result, filterTime) <- timed $ leiosDbFilterMissingEbBodies con allPoints
-              pure $
-                conjoin
-                  [ length result === length expectedMissing
-                  , all (`elem` expectedMissing) result === True
-                  , all (`elem` result) expectedMissing === True
-                  ]
-                  & tabulate "filterMissingEbBodies" [timeBucket filterTime]
-                  & tabulate "numEbs" [magnitudeBucket numEbs]
-
--- * Property tests for filterMissingTxs
-
--- | Property: filtering empty list returns empty list.
-prop_filterTxsEmpty :: DbImpl -> Property
-prop_filterTxsEmpty impl =
-  ioProperty $ withFreshDb impl $ \db -> withLeiosDb db $ \con -> do
-    result <- leiosDbFilterMissingTxs con []
-    pure $ result === []
-
--- | Property: filter returns exactly the TXs we do NOT have.
-prop_filterTxsCorrect :: DbImpl -> Property
-prop_filterTxsCorrect impl =
-  forAll (chooseInt (1, 50)) $ \numTxs ->
-    forAllBlind (replicateM numTxs genTxHash) $ \txHashes ->
-      forAllBlind (sublistOf txHashes) $ \toInsert ->
-        ioProperty $ withFreshDb impl $ \db -> withLeiosDb db $ \con -> do
-          -- Insert some TXs
-          forM_ toInsert $ \txHash ->
-            leiosDbInsertTxs con [(txHash, maxTxBytesZero)]
-          -- Filter should return the ones NOT inserted
-          let expectedMissing = filter (`notElem` toInsert) txHashes
-          (result, filterTime) <- timed $ leiosDbFilterMissingTxs con txHashes
-          pure $
-            conjoin
-              [ length result === length expectedMissing
-              , all (`elem` expectedMissing) result === True
-              , all (`elem` result) expectedMissing === True
-              ]
-              & tabulate "filterMissingTxs" [timeBucket filterTime]
-              & tabulate "numTxs" [magnitudeBucket numTxs]
-
 -- * Property tests for lookupEbClosure
 
 -- | Property: complete EB (all txs inserted) returns Just with correct tx data.
diff --git a/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic.hs b/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic.hs
index d5dfe86c6e..282a1ab46a 100644
--- a/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic.hs
+++ b/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic.hs
@@ -6,8 +6,8 @@
 --
 -- Each test is a small data fixture built via the 'Scenario' DSL
 -- below: start from an 'empty' scenario, layer in missing work
--- ('withMissingBody', 'withMissingTx') and peer offers
--- ('offersBody', 'offersTxs'), then run and assert on the resulting
+-- ('withMissingBody') and peer offers
+-- ('offersBody'), then run and assert on the resulting
 -- decisions. The DSL chains via '&' (`x & f = f x`), keeping each
 -- test ~5 lines so the scenario reads top-to-bottom.
 --
@@ -21,26 +21,31 @@ module Test.LeiosDemoLogic (tests) where
 
 import Cardano.Slotting.Slot (SlotNo (..))
 import qualified Data.ByteString as BS
-import qualified Data.DList as DList
+import Data.Foldable (toList)
 import Data.Function ((&))
-import qualified Data.IntMap.Strict as IntMap
 import qualified Data.Map.Strict as Map
+import Data.Maybe.Strict (StrictMaybe (SNothing))
+import Data.Sequence.NonEmpty (NESeq)
 import qualified Data.Set as Set
-import LeiosDemoLogic
-  ( LeiosFetchDecisions (..)
-  , leiosFetchLogicIteration
-  )
+import qualified Data.Set.NonEmpty as NESet
+import LeiosDemoLogic (fetchPriorityTiers, leiosFetchLogicIteration)
 import LeiosDemoTypes
-  ( BytesSize
+  ( AlsoOfferedTxsClosure (..)
+  , BytesSize
   , EbHash (..)
+  , LeiosBlockRequest (..)
+  , LeiosFetchRequest (..)
   , LeiosFetchStaticEnv (..)
   , LeiosOutstanding (..)
   , LeiosPoint (..)
   , PeerId (..)
-  , TxHash (..)
   , demoLeiosFetchStaticEnv
   , emptyLeiosOutstanding
+  , markBodyImminent
+  , mergeOffer
+  , recordMaxAnnouncementSlot
   )
+import System.Random (mkStdGen)
 import Test.Tasty (TestTree, testGroup)
 import Test.Tasty.HUnit (assertFailure, testCase, (@?=))
 
@@ -54,28 +59,37 @@ tests =
             test_singleMissingBody
         , testCase "no request when no peer offers the body" $
             test_bodyNoOffer
-        , testCase "per-EB request cap blocks further selection" $
-            test_bodyPerEbCap
-        , testCase "two offering peers both selected (up to cap)" $
+        , testCase "a peer already asked for a body is not asked again" $
+            test_bodyAlreadyRequestedPeerSkipped
+        , testCase "both offering peers are selected (no per-EB cap)" $
             test_bodyTwoPeersOffer
-        , testCase "global byte budget exhausted blocks further selection" $
-            test_globalByteBudget
         , testCase "per-peer byte budget exhausted skips that peer" $
             test_perPeerByteBudget
         ]
     , testGroup
-        "EB tx fetch"
-        [ testCase "single missing tx with one offering peer issues one request" $
-            test_singleMissingTx
-        , testCase "per-tx request cap blocks further selection" $
-            test_txPerTxCap
-        , testCase "tx referenced in multiple EBs, peer offering only target is selected" $
-            test_txTwoEbsSinglePeerOffer
-        , testCase "tx referenced in two EBs of different recorded size, peer offering both is selected" $
-            test_txTwoEbsDifferentSize
+        "self-forged EB"
+        [ testCase "an offer of a self-forged EB is never re-fetched" $
+            test_forgedEbOfferIgnored
+        ]
+    , testGroup
+        "fetch priority"
+        [ testCase "freshest window oldest-first, then rest freshest-first" $
+            test_fetchPriorityOrder
         ]
     ]
 
+-- | With current slot S=100 and window L=10, EBs at slot >= 90 (the voting
+-- window) are prioritised oldest-first, EBs beyond S trail that first tier, and
+-- everything older is freshest-first.
+test_fetchPriorityOrder :: IO ()
+test_fetchPriorityOrder =
+  map (unSlot . (.pointSlotNo) . fst) (hi ++ lo)
+    @?= [90, 95, 100, 101, 105, 89, 50, 0]
+ where
+  (hi, lo) = fetchPriorityTiers (Just (SlotNo 100)) 10 offers
+  offers = Map.fromList [(point a 'x', ()) | a <- [0, 105, 90, 50, 100, 89, 101, 95]]
+  unSlot (SlotNo n) = n
+
 ------------------------------------------------------------
 -- Scenarios
 ------------------------------------------------------------
@@ -85,16 +99,16 @@ tests =
 -- meaning beyond identity.
 type Pid = Int
 
-peerA, peerB, peerC :: Pid
+peerA, peerB, _peerC :: Pid
 peerA = 0
 peerB = 1
-peerC = 2
+_peerC = 2
 
 test_singleMissingBody :: IO ()
 test_singleMissingBody =
   empty
     & withMissingBody (point 1 'a') 1024
-    & offersBody peerA [eb 'a']
+    & offersBody peerA [point 1 'a']
     & runIteration
     & assertBodyRequest peerA (point 1 'a') 1024
 
@@ -102,53 +116,29 @@ test_bodyNoOffer :: IO ()
 test_bodyNoOffer =
   empty
     & withMissingBody (point 1 'a') 1024
-    & offersTxs peerA [eb 'a'] -- offers tx-closure, not the body
+    & offersBody peerA [point 1 'b'] -- peer offers a different EB, not the one we need
     & runIteration
     & assertNoRequests
 
-test_bodyPerEbCap :: IO ()
-test_bodyPerEbCap =
+test_bodyAlreadyRequestedPeerSkipped :: IO ()
+test_bodyAlreadyRequestedPeerSkipped =
   empty
     & withMissingBody (point 1 'a') 1024
-    & alreadyRequestedEbFrom (eb 'a') [peerA, peerB] -- default cap = 2
-    & offersBody peerC [eb 'a']
-    & runIteration
-    & assertNoRequests
-
-test_singleMissingTx :: IO ()
-test_singleMissingTx =
-  empty
-    & withMissingTx (point 1 'a') 0 (tx 'x') 500
-    & offersTxs peerA [eb 'a']
-    & runIteration
-    & assertTxRequest peerA (point 1 'a') (tx 'x')
-
-test_txPerTxCap :: IO ()
-test_txPerTxCap =
-  empty
-    & withMissingTx (point 1 'a') 0 (tx 'x') 500
-    & alreadyRequestedTxFrom (tx 'x') [peerA, peerB] -- default cap = 2
-    & offersTxs peerC [eb 'a']
+    & alreadyRequestedEbFrom (eb 'a') [peerA] -- already in flight from peerA
+    & offersBody peerA [point 1 'a'] -- so peerA is not asked again
+    & offersBody peerB [point 1 'a'] -- but a fresh offering peer is
     & runIteration
-    & assertNoRequests
+    & assertRequestPeers [peerB]
 
 test_bodyTwoPeersOffer :: IO ()
 test_bodyTwoPeersOffer =
   empty
     & withMissingBody (point 1 'a') 1024
-    & offersBody peerA [eb 'a']
-    & offersBody peerB [eb 'a']
-    & runIteration
-    & assertRequestPeers [peerA, peerB]
-
-test_globalByteBudget :: IO ()
-test_globalByteBudget =
-  empty
-    & withMissingBody (point 1 'a') 1024
-    & withTotalRequestedBytes (maxRequestedBytesSize demoLeiosFetchStaticEnv)
-    & offersBody peerA [eb 'a']
+    & offersBody peerA [point 1 'a']
+    & offersBody peerB [point 1 'a']
     & runIteration
-    & assertNoRequests
+    -- both peers offer; with no per-EB cap the body is requested from both
+    & assertRequestPeerCount 2
 
 test_perPeerByteBudget :: IO ()
 test_perPeerByteBudget =
@@ -157,42 +147,23 @@ test_perPeerByteBudget =
     & withRequestedBytesPerPeer
       peerA
       (maxRequestedBytesSizePerPeer demoLeiosFetchStaticEnv + 1)
-    & offersBody peerA [eb 'a']
-    & offersBody peerB [eb 'a']
+    & offersBody peerA [point 1 'a']
+    & offersBody peerB [point 1 'a']
     & runIteration
     & assertRequestPeers [peerB]
 
--- | Tx X is referenced in two EBs (A and B), but the peer only
--- offers the tx-closure of EB A (the target). Expected: request
--- targets the peer with offset taken from A's entry.
-test_txTwoEbsSinglePeerOffer :: IO ()
-test_txTwoEbsSinglePeerOffer =
-  empty
-    & withMissingTx (point 1 'a') 0 (tx 'x') 100
-    & alsoReferencedInEb (tx 'x') (eb 'b') 7 100 -- same recorded size in B
-    & offersTxs peerA [eb 'a']
-    & runIteration
-    & assertTxRequest peerA (point 1 'a') (tx 'x')
-
--- | Tx X is referenced in EB A (size 100) and EB B (size 200) —
--- inconsistent sizes for the same content hash, e.g. one peer
--- delivered a malformed body for the other EB before the cap on
--- size-validation was tightened. Peer P offers the tx-closure of
--- BOTH. The gate must still issue the request: the target EB is A,
--- the recorded size on A is the authority, and B's stale/wrong
--- entry must not veto the selection.
---
--- Today the size predicate at 'choosePeerTx' (LeiosDemoLogic.hs:403)
--- uses @Map.lookupMax txOffsets'@, which picks whichever EB hash is
--- bytewise-larger; on disagreement the request is silently dropped.
-test_txTwoEbsDifferentSize :: IO ()
-test_txTwoEbsDifferentSize =
+-- | Regression for the devnet crash where a node re-fetched an EB it had just
+-- forged: the redundant closure acquisition emitted a second 'AcquiredEbTxs',
+-- which 'runLeiosVoting' rejected ('AlreadyKnown') and died on. The forge marks
+-- the EB in 'ebState' (as 'BodyImminent'), so the fetch logic must drop any peer
+-- offer of it -- even a full body+closure offer -- rather than request it.
+test_forgedEbOfferIgnored :: IO ()
+test_forgedEbOfferIgnored =
   empty
-    & withMissingTx (point 1 'a') 0 (tx 'x') 100
-    & alsoReferencedInEb (tx 'x') (eb 'b') 7 200 -- different recorded size
-    & offersTxs peerA [eb 'a', eb 'b']
+    & withForgedEb (point 1 'a')
+    & offersBodyAndClosure peerA [point 1 'a']
     & runIteration
-    & assertTxRequest peerA (point 1 'a') (tx 'x')
+    & assertNoRequests
 
 ------------------------------------------------------------
 -- Scenario DSL
@@ -201,7 +172,7 @@ test_txTwoEbsDifferentSize =
 -- | A test fixture: static env, peer offerings, outstanding work.
 data Scenario pid = Scenario
   { scEnv :: !LeiosFetchStaticEnv
-  , scOfferings :: !(Map.Map (PeerId pid) (Set.Set EbHash, Set.Set EbHash))
+  , scOfferings :: !(Map.Map (PeerId pid) (Map.Map LeiosPoint AlsoOfferedTxsClosure))
   , scOutstanding :: !(LeiosOutstanding pid)
   }
 
@@ -210,38 +181,28 @@ empty =
   Scenario
     { scEnv = demoLeiosFetchStaticEnv
     , scOfferings = Map.empty
-    , scOutstanding = emptyLeiosOutstanding
+    , scOutstanding = emptyLeiosOutstanding (mkStdGen 0) (SlotNo 0)
     }
 
 -- | Outstanding-work combinators -----------------------------------------
 withMissingBody :: LeiosPoint -> BytesSize -> Scenario pid -> Scenario pid
-withMissingBody p size =
+withMissingBody p@(MkLeiosPoint slot ebHash) size =
   onOutstanding $ \o ->
-    o{missingEbBodies = Map.insert p size (missingEbBodies o)}
-
-withMissingTx ::
-  LeiosPoint ->
-  Int -> -- offset within the EB
-  TxHash ->
-  BytesSize ->
-  Scenario pid ->
-  Scenario pid
-withMissingTx p offset h size =
-  onOutstanding $ \o ->
-    o
-      { missingEbTxs =
-          Map.insertWith
-            IntMap.union
-            p
-            (IntMap.singleton offset (h, size))
-            (missingEbTxs o)
-      , reverseEbIndexByTx =
-          Map.insertWith
-            Map.union
-            h
-            (Map.singleton p.pointEbHash (offset, size))
-            (reverseEbIndexByTx o)
-      }
+    -- Seed everything the announce path would: the missing-body point and its
+    -- reverse index, plus (via 'recordMaxAnnouncementSlot') the 'ebState' NoBody
+    -- entry that the fetch loop now drives bodies off of.
+    recordMaxAnnouncementSlot ebHash slot SNothing $
+      o
+        { missingEbBodies = Map.insert p size (missingEbBodies o)
+        , reverseSlotIndexByEbHash =
+            Map.insertWith NESet.union ebHash (NESet.singleton slot) (reverseSlotIndexByEbHash o)
+        }
+
+-- | Mark an EB as one our own forge produced -- the 'BodyImminent' 'ebState'
+-- entry that 'onForgedLeiosEb' installs at announcement time.
+withForgedEb :: LeiosPoint -> Scenario pid -> Scenario pid
+withForgedEb (MkLeiosPoint slot ebHash) =
+  onOutstanding $ markBodyImminent ebHash slot
 
 alreadyRequestedEbFrom :: Ord pid => EbHash -> [pid] -> Scenario pid -> Scenario pid
 alreadyRequestedEbFrom ebHash pids =
@@ -255,42 +216,6 @@ alreadyRequestedEbFrom ebHash pids =
             (requestedEbPeers o)
       }
 
-alreadyRequestedTxFrom :: Ord pid => TxHash -> [pid] -> Scenario pid -> Scenario pid
-alreadyRequestedTxFrom txHash pids =
-  onOutstanding $ \o ->
-    o
-      { requestedTxPeers =
-          Map.insertWith
-            Set.union
-            txHash
-            (Set.fromList (map MkPeerId pids))
-            (requestedTxPeers o)
-      }
-
--- | Tag a tx as also referenced by another EB at the given offset
--- and recorded size, without adding the EB to 'missingEbTxs'.
--- 'choosePeerTx' consults 'reverseEbIndexByTx' for "which EBs does
--- this tx appear in?" when evaluating peer offerings; this helper
--- lets us seed that cross-reference.
-alsoReferencedInEb ::
-  TxHash -> EbHash -> Int -> BytesSize -> Scenario pid -> Scenario pid
-alsoReferencedInEb txHash ebHash offset size =
-  onOutstanding $ \o ->
-    o
-      { reverseEbIndexByTx =
-          Map.insertWith
-            Map.union
-            txHash
-            (Map.singleton ebHash (offset, size))
-            (reverseEbIndexByTx o)
-      }
-
--- | Set the global in-flight byte total. Use with the env's cap to
--- test the global byte budget.
-withTotalRequestedBytes :: BytesSize -> Scenario pid -> Scenario pid
-withTotalRequestedBytes n =
-  onOutstanding $ \o -> o{requestedBytesSize = n}
-
 -- | Set a per-peer in-flight byte total. Use with the env's per-peer
 -- cap to test the per-peer byte budget.
 withRequestedBytesPerPeer ::
@@ -304,31 +229,26 @@ withRequestedBytesPerPeer pid n =
 
 -- | Per-peer offer combinators -------------------------------------------
 
--- | Peer @p@ offers the body of these EBs.
-offersBody :: Ord pid => pid -> [EbHash] -> Scenario pid -> Scenario pid
-offersBody pid ebs =
-  insertOffering (MkPeerId pid) (Set.fromList ebs) Set.empty
+-- | Peer @p@ offers the body (only) of these points.
+offersBody :: Ord pid => pid -> [LeiosPoint] -> Scenario pid -> Scenario pid
+offersBody pid points =
+  insertOffering (MkPeerId pid) (Map.fromList [(p, TxsClosureNotAlsoOffered) | p <- points])
 
--- | Peer @p@ offers the tx-closure of these EBs.
-offersTxs :: Ord pid => pid -> [EbHash] -> Scenario pid -> Scenario pid
-offersTxs pid ebs =
-  insertOffering (MkPeerId pid) Set.empty (Set.fromList ebs)
+-- | Peer @p@ offers both the body and the tx-closure of these points.
+offersBodyAndClosure :: Ord pid => pid -> [LeiosPoint] -> Scenario pid -> Scenario pid
+offersBodyAndClosure pid points =
+  insertOffering (MkPeerId pid) (Map.fromList [(p, TxsClosureAlsoOffered) | p <- points])
 
 insertOffering ::
   Ord pid =>
   PeerId pid ->
-  Set.Set EbHash ->
-  Set.Set EbHash ->
+  Map.Map LeiosPoint AlsoOfferedTxsClosure ->
   Scenario pid ->
   Scenario pid
-insertOffering pid bodies txs sc =
+insertOffering pid offers sc =
   sc
     { scOfferings =
-        Map.insertWith
-          (\(a, b) (c, d) -> (a <> c, b <> d))
-          pid
-          (bodies, txs)
-          (scOfferings sc)
+        Map.insertWith (Map.unionWith mergeOffer) pid offers (scOfferings sc)
     }
 
 -- | Internal: lift a function on 'LeiosOutstanding' to one on 'Scenario'.
@@ -339,11 +259,18 @@ onOutstanding ::
 onOutstanding f sc = sc{scOutstanding = f (scOutstanding sc)}
 
 -- | Run the iteration and project the decisions.
-runIteration :: Ord pid => Scenario pid -> LeiosFetchDecisions pid
+--
+-- (The tx side of the fetch logic is disarmed, so only EB-body requests are
+-- emitted; the old tx-soundness check is gone with it.)
+runIteration :: Ord pid => Scenario pid -> Map.Map (PeerId pid) (NESeq LeiosFetchRequest)
 runIteration sc =
-  -- A known current slot selects freshest-first (i.e. youngest-first), which is
-  -- the ordering these scenarios were written against.
-  snd $ leiosFetchLogicIteration sc.scEnv (Just minBound) sc.scOfferings sc.scOutstanding
+  -- Any known current slot suffices here: these scenarios don't depend on the
+  -- offer-visit order (the priority order is tested by 'test_fetchPriorityOrder').
+  let (_out, reqs, _drops) =
+        -- No big-ledger peers in these scenarios (the aggressive-fetch path is
+        -- exercised in "Test.LeiosDemoLogic.Invariants").
+        leiosFetchLogicIteration sc.scEnv (Just minBound) sc.scOfferings Map.empty sc.scOutstanding
+   in reqs
 
 ------------------------------------------------------------
 -- Assertions
@@ -354,43 +281,32 @@ assertBodyRequest ::
   pid ->
   LeiosPoint ->
   BytesSize ->
-  LeiosFetchDecisions pid ->
+  Map.Map (PeerId pid) (NESeq LeiosFetchRequest) ->
   IO ()
-assertBodyRequest pid p size (MkLeiosFetchDecisions m) =
+assertBodyRequest pid p size m =
   case Map.lookup (MkPeerId pid) m of
     Nothing -> assertFailure $ "no request for peer " <> show pid
-    Just slotMap -> case Map.lookup p.pointSlotNo slotMap of
-      Nothing -> assertFailure "no request at expected slot"
-      Just (_txs, bodies) ->
-        DList.toList bodies @?= [(p.pointEbHash, size)]
+    Just reqs ->
+      [ (pt.pointEbHash, sz)
+      | LeiosBlockRequest (MkLeiosBlockRequest pt sz) <- toList reqs
+      ]
+        @?= [(p.pointEbHash, size)]
 
-assertTxRequest ::
-  (Ord pid, Show pid) =>
-  pid ->
-  LeiosPoint ->
-  TxHash ->
-  LeiosFetchDecisions pid ->
-  IO ()
-assertTxRequest pid p txHash (MkLeiosFetchDecisions m) =
-  case Map.lookup (MkPeerId pid) m of
-    Nothing -> assertFailure $ "no request for peer " <> show pid
-    Just slotMap -> case Map.lookup p.pointSlotNo slotMap of
-      Nothing -> assertFailure "no request at expected slot"
-      Just (txs, _bodies) -> case DList.toList txs of
-        [(h, _size, _offsets)] -> h @?= txHash
-        xs -> assertFailure $ "expected one tx request, got " <> show (length xs)
+assertNoRequests :: (Ord pid, Show pid) => Map.Map (PeerId pid) (NESeq LeiosFetchRequest) -> IO ()
+assertNoRequests m = Map.keys m @?= []
 
-assertNoRequests :: (Ord pid, Show pid) => LeiosFetchDecisions pid -> IO ()
-assertNoRequests (MkLeiosFetchDecisions m) = Map.keys m @?= []
-
--- | Assert that the decision set has requests targeting exactly the
--- given set of peers (regardless of what each request is).
+-- | Assert that requests target exactly the given set of peers (regardless of
+-- what each request is).
 assertRequestPeers ::
   (Ord pid, Show pid) =>
-  [pid] -> LeiosFetchDecisions pid -> IO ()
-assertRequestPeers expected (MkLeiosFetchDecisions m) =
+  [pid] -> Map.Map (PeerId pid) (NESeq LeiosFetchRequest) -> IO ()
+assertRequestPeers expected m =
   Set.fromList (Map.keys m) @?= Set.fromList (map MkPeerId expected)
 
+-- | Assert how many distinct peers received a request.
+assertRequestPeerCount :: Int -> Map.Map (PeerId pid) (NESeq LeiosFetchRequest) -> IO ()
+assertRequestPeerCount n m = Map.size m @?= n
+
 ------------------------------------------------------------
 -- Fixture helpers
 ------------------------------------------------------------
@@ -403,7 +319,3 @@ point slot c = MkLeiosPoint (SlotNo (fromIntegral slot)) (eb c)
 -- | Distinct EB hash from a Char.
 eb :: Char -> EbHash
 eb c = MkEbHash $ BS.pack $ replicate 32 (fromIntegral (fromEnum c))
-
--- | Distinct tx hash from a Char.
-tx :: Char -> TxHash
-tx c = MkTxHash $ BS.pack $ replicate 32 (fromIntegral (fromEnum c))
diff --git a/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic/Invariants.hs b/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic/Invariants.hs
new file mode 100644
index 0000000000..89f8d93a2a
--- /dev/null
+++ b/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic/Invariants.hs
@@ -0,0 +1,795 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedRecordDot #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+-- | Sequence-level invariant tests for the Leios fetch state.
+--
+-- The sibling "Test.LeiosDemoLogic" checks that the /pure/ decision function
+-- makes the right choice at a single instant. This module instead drives the
+-- /real, effectful/ handlers ('processLeiosBlock', 'processLeiosBlockTxs',
+-- 'recordAnnouncedEb', 'leiosFetchLogicIteration') over sequences of interleaved
+-- message arrivals and decisions, in 'IOSim' against an in-memory 'LeiosDb', a
+-- 'nullLeiosTxCache', and plain 'MVar's — then asserts that a state invariant
+-- holds after every step.
+--
+-- NOTE. The EbTxs side of the fetch logic is being rewritten from scratch, so the
+-- old missing-tx \/ reverse-index regression is gone. What remains checks the
+-- EB-body side: after each command the 'ebState' reverse-index invariant must
+-- hold, and — belt and suspenders — a 'Decide' is forced through the real fetch
+-- logic so a stray @impossible!@ surfaces.
+--
+-- NOTE. A second regression lives here too: the fetch logic must never request
+-- an EB body it already holds. That storm — a held body being re-listed and
+-- re-requested — is what 'prop_neverRefetchesHeldBody' guards against; after each
+-- 'Decide' it checks that no body just requested is one we already hold.
+-- Phrasing it as "already held" rather than a request count is what makes it
+-- correct given there is no per-EB request cap: requesting a not-yet-held body
+-- from several peers is fine; re-requesting a held one is not.
+module Test.LeiosDemoLogic.Invariants (tests) where
+
+import Cardano.Slotting.Slot (SlotNo (SlotNo))
+import Control.Concurrent.Class.MonadMVar
+  ( MVar
+  , modifyMVar_
+  , newEmptyMVar
+  , newMVar
+  , readMVar
+  )
+import Control.Monad.Class.MonadAsync (concurrently_)
+import Control.Monad.Class.MonadTest (exploreRaces)
+import Control.Monad.Class.MonadThrow (SomeException, try)
+import Control.Monad.IOSim (IOSim, exploreSimTrace, runSimOrThrow, traceResult)
+import Control.Tracer (nullTracer)
+import qualified Data.ByteString as BS
+import Data.Foldable (toList)
+import qualified Data.IntMap.Strict as IntMap
+import qualified Data.IntSet as IntSet
+import qualified Data.Map.Strict as Map
+import Data.Maybe.Strict (StrictMaybe (SJust, SNothing))
+import Data.Sequence.NonEmpty (NESeq)
+import qualified Data.Set as Set
+import qualified Data.Set.NonEmpty as NESet
+import qualified Data.Vector.Strict as V
+import Data.Void (Void, absurd)
+import LeiosDemoDb (withLeiosDb)
+import qualified LeiosDemoDb as LeiosDb
+import LeiosDemoLogic
+  ( LeiosBlockSource (..)
+  , LeiosBlockTxsSource (..)
+  , leiosFetchLogicIteration
+  , noMempoolPull
+  , processLeiosBlock
+  , processLeiosBlockTxs
+  , recordAnnouncedEb
+  , recordEbBodyOffer
+  )
+import LeiosDemoTypes
+  ( AlsoOfferedTxsClosure (..)
+  , BytesSize
+  , EbHash
+  , LeiosBlockRequest (..)
+  , LeiosEb (..)
+  , LeiosOutstanding (..)
+  , LeiosPeerVars
+  , LeiosPoint (..)
+  , LeiosTx (..)
+  , PeerId (..)
+  , TxHash
+  , demoLeiosFetchStaticEnv
+  , emptyLeiosOutstanding
+  , hashLeiosEb
+  , hashLeiosTx
+  , leiosEbBytesSize
+  , newLeiosPeerVars
+  )
+import qualified LeiosDemoTypes as Leios
+import qualified LeiosDemoTypes.LeiosJobs as Jobs
+import LeiosTxCache (LeiosTxCache, newPureLeiosTxCache, nullLeiosTxCache)
+import Ouroboros.Consensus.BlockchainTime.WallClock.Types
+  ( RelativeTime (..)
+  , SystemTime (..)
+  )
+import Ouroboros.Consensus.Util.IOLike (IOLike, evaluate)
+import Ouroboros.Network.PeerSelection.LedgerPeers.Type
+  ( IsBigLedgerPeer (..)
+  )
+import System.Random (mkStdGen)
+import Test.QuickCheck
+import Test.Tasty (TestTree, testGroup)
+import Test.Tasty.HUnit (assertBool, testCase, (@?=))
+import Test.Tasty.QuickCheck (testProperty)
+import Test.Util.Orphans.IOLike ()
+import Test.Util.TestEnv (adjustQuickCheckTests)
+
+tests :: TestTree
+tests =
+  -- 10x whatever '--quickcheck-tests' supplies, for every property below.
+  adjustQuickCheckTests (* 10) $
+    testGroup
+      "LeiosDemoLogic.Invariants"
+      [ testGroup
+          "curated sequences"
+          [ testCase "forge purges a body it already holds (offered first)" $
+              runCmdsReFetchViolations reproForgeAfterOffer @?= Right []
+          , testCase "an offer of a self-forged EB is not re-fetched (forged first)" $
+              runCmdsReFetchViolations reproForgeThenOffer @?= Right []
+          ]
+      , testCase "acquired EB kept until its greatest slot is below the immutable tip" $ do
+          let eb = ebOf [0, 1]
+              h = hashLeiosEb eb
+              -- an empty job pool suffices here
+              jobPool = Jobs.mkLeiosJobPool 1000 10 mempty
+              -- announce at slot 5, then again at the smaller slot 3, and acquire
+              o =
+                Leios.insertAcquiredEbBody h jobPool $
+                  Leios.recordMaxAnnouncementSlot h (SlotNo 3) SNothing $
+                    Leios.recordMaxAnnouncementSlot h (SlotNo 5) SNothing $
+                      (emptyLeiosOutstanding (mkStdGen 0) (SlotNo 0) :: LeiosOutstanding Int)
+          -- the greater slot is retained, not the last-recorded one
+          Map.lookup h (Leios.ebState o)
+            @?= Just (Leios.MkEbState (SlotNo 5) SNothing (Leios.BodyAcquired jobPool))
+          -- kept while the greatest slot (5) is at/above the immutable tip (4)
+          Map.lookup h (Leios.ebState (snd (Leios.pruneOutstandingToImmTip (SlotNo 4) o)))
+            @?= Just (Leios.MkEbState (SlotNo 5) SNothing (Leios.BodyAcquired jobPool))
+          -- dropped once the greatest slot (5) is below the immutable tip (6)
+          Map.lookup h (Leios.ebState (snd (Leios.pruneOutstandingToImmTip (SlotNo 6) o)))
+            @?= Nothing
+      , testCase "an announcement raises a forged EB's max slot (so it isn't pruned early)" $ do
+          let h = hashLeiosEb (ebOf [0, 1])
+              -- forge at slot 5, then a peer announces the same EB at the later slot 10
+              o =
+                Leios.recordMaxAnnouncementSlot h (SlotNo 10) SNothing $
+                  Leios.markBodyImminent h (SlotNo 5) $
+                    (emptyLeiosOutstanding (mkStdGen 0) (SlotNo 0) :: LeiosOutstanding Int)
+          -- the announcement raised the slot to 10, keeping the forged state
+          Map.lookup h (Leios.ebState o) @?= Just (Leios.MkEbState (SlotNo 10) SNothing Leios.BodyImminent)
+          -- so it survives pruning up to slot 9, and is dropped only past slot 10
+          Map.member h (Leios.ebState (snd (Leios.pruneOutstandingToImmTip (SlotNo 9) o))) @?= True
+          Map.member h (Leios.ebState (snd (Leios.pruneOutstandingToImmTip (SlotNo 11) o))) @?= False
+      , testCase "an announcement's onset is recorded (earliest kept); an offer never clobbers it" $ do
+          let h = hashLeiosEb (ebOf [0, 1])
+              t3 = RelativeTime 3
+              t5 = RelativeTime 5
+              base = emptyLeiosOutstanding (mkStdGen 0) (SlotNo 0) :: LeiosOutstanding Int
+              onsetOf o = Leios.ebStateOnset <$> Map.lookup h (Leios.ebState o)
+          -- an announcement records its slot's onset
+          onsetOf (Leios.recordMaxAnnouncementSlot h (SlotNo 5) (SJust t5) base)
+            @?= Just (SJust t5)
+          -- a later announcement (greater slot, earlier onset) keeps the earlier onset
+          onsetOf
+            ( Leios.recordMaxAnnouncementSlot h (SlotNo 8) (SJust t3) $
+                Leios.recordMaxAnnouncementSlot h (SlotNo 5) (SJust t5) base
+            )
+            @?= Just (SJust t3)
+          -- an offer (no onset) bumps the slot but never clobbers a recorded onset
+          onsetOf
+            ( Leios.recordMaxAnnouncementSlot h (SlotNo 9) SNothing $
+                Leios.recordMaxAnnouncementSlot h (SlotNo 5) (SJust t5) base
+            )
+            @?= Just (SJust t5)
+          -- a self-forged EB records no onset (kept out of the age panels)
+          onsetOf (Leios.markBodyImminent h (SlotNo 5) base)
+            @?= Just SNothing
+      , testCase "start-up seeding marks each completed EB held, with an empty pool" $ do
+          let ebA = [0, 1] :: TestEb
+              ebB = [2, 3] :: TestEb
+              hA = hashLeiosEb (ebOf ebA)
+              hB = hashLeiosEb (ebOf ebB)
+              -- The complete-closure scan yields points: ebA listed at two slots (5
+              -- and 8), ebB at slot 6.
+              points = [pointOf ebA 5, pointOf ebA 8, pointOf ebB 6]
+              immTipSlot = SlotNo 4
+              o = Leios.initializeLeiosOutstanding (mkStdGen 0) points immTipSlot :: LeiosOutstanding Int
+          -- each completed EB is held with an empty job pool: nothing left to fetch
+          Map.lookup hB (Leios.ebState o)
+            @?= Just (Leios.MkEbState (SlotNo 6) SNothing (Leios.BodyAcquired Jobs.emptyLeiosJobPool))
+          -- and when one EB is listed at several points, its greatest slot wins (8, not 5)
+          Map.lookup hA (Leios.ebState o)
+            @?= Just (Leios.MkEbState (SlotNo 8) SNothing (Leios.BodyAcquired Jobs.emptyLeiosJobPool))
+          -- so every seeded EB reports as held ...
+          all Leios.ebStateHasBody (Map.elems (Leios.ebState o)) @?= True
+          -- ... nothing is listed for fetch (empty pools, no missing bodies) ...
+          Leios.missingEbBodies o @?= Map.empty
+          Leios.reverseSlotIndexByEbHash o @?= Map.empty
+          -- ... no requests are outstanding (there are no connections at start-up) ...
+          Leios.requestedBytesSizePerPeer o @?= Map.empty
+          Leios.requestedEbPeers o @?= Map.empty
+          Leios.requestedJobsPerPeer o @?= Map.empty
+          -- ... and the pruning watermark is seeded from the immutable tip
+          Leios.acquiredEbBodiesPrunedSlot o @?= immTipSlot
+      , testCase "start-up seeding: a peer's offer of a seeded EB is not re-fetched" $ do
+          let ebA = [0, 1] :: TestEb
+              ebB = [2, 3] :: TestEb
+              points = [pointOf ebA 8, pointOf ebB 6]
+              o = Leios.initializeLeiosOutstanding (mkStdGen 0) points (SlotNo 4) :: LeiosOutstanding Int
+              peerId = MkPeerId (0 :: Int)
+              -- a peer offers every seeded EB, body and closure
+              offerings = Map.singleton peerId (referencedOffers o)
+              (_out', decs, _drops) =
+                leiosFetchLogicIteration demoLeiosFetchStaticEnv (Just (SlotNo 10)) offerings Map.empty o
+          -- no body is re-requested (the whole point of the seed) ...
+          ebBodyRequestHashes decs @?= []
+          -- ... and with empty pools there is nothing at all to request
+          Map.null decs @?= True
+      , testCase "a big-ledger peer has a larger, but still finite, closure budget" $ do
+          let ids = [0, 1, 2, 3, 4] :: TestEb
+              h = hashLeiosEb (ebOf ids)
+              point = pointOf ids 10
+              misses = IntMap.fromList [(off, (txHashOf i, txSizeOf i)) | (off, i) <- zip [0 ..] ids]
+              jobPool =
+                Jobs.mkLeiosJobPool
+                  (Leios.maxJobBytesSize demoLeiosFetchStaticEnv)
+                  (Leios.maxJobTxCount demoLeiosFetchStaticEnv)
+                  misses
+              peerId = MkPeerId (0 :: Int)
+              offers = Map.singleton peerId (Map.singleton point TxsClosureAlsoOffered)
+              ordinaryCap = Leios.maxRequestedBytesSizePerPeer demoLeiosFetchStaticEnv
+              bigLedgerCap = Leios.maxRequestedBytesSizePerBigLedgerPeer demoLeiosFetchStaticEnv
+              -- hold the body (so the pool is live), with the peer's in-flight bytes
+              -- preloaded to 'used'
+              run bigLedgerPeers used =
+                let outstanding =
+                      (\o -> o{Leios.requestedBytesSizePerPeer = Map.singleton peerId used}) $
+                        Leios.insertAcquiredEbBody h jobPool $
+                          Leios.recordMaxAnnouncementSlot h (SlotNo 10) SNothing $
+                            (emptyLeiosOutstanding (mkStdGen 0) (SlotNo 0) :: LeiosOutstanding Int)
+                    (_o, reqs, _d) =
+                      leiosFetchLogicIteration
+                        demoLeiosFetchStaticEnv
+                        (Just (SlotNo 11))
+                        offers
+                        bigLedgerPeers
+                        outstanding
+                 in requestedOffsets reqs
+              ordinary = Map.empty
+              bigLedger = Map.singleton peerId IsBigLedgerPeer
+          -- past the ordinary cap, an ordinary peer is asked for nothing ...
+          run ordinary (ordinaryCap + 1) @?= IntSet.empty
+          -- ... but a big-ledger peer still has budget for the whole pool at once
+          run bigLedger (ordinaryCap + 1) @?= IntSet.fromList ids
+          -- past even the big-ledger cap, though, a big-ledger peer is bounded too
+          run bigLedger (bigLedgerCap + 1) @?= IntSet.empty
+      , testCase "job assignment draws within the least-requested bucket, at random, respecting exclusions" $ do
+          let misses = IntMap.fromList [(off, (txHashOf off, txSizeOf off)) | off <- [0 .. 5]]
+              -- 'maxJobTxCount' 1 makes each tx its own job, so job ids 0..5 all
+              -- start at multiplicity 0 (one bucket).
+              pool0 = Jobs.mkLeiosJobPool 1000000 1 misses
+              pickId pool excluded s =
+                case Jobs.pickLeastRequestedJobExcept (mkStdGen s) excluded pool of
+                  Just (Jobs.MkLeiosJobId i, _job, _pool', _prng') -> Just i
+                  Nothing -> Nothing
+          -- across seeds the draw isn't pinned to the lowest id, and every draw is
+          -- a real job id.
+          let drawn = Set.fromList [i | s <- [0 .. 99 :: Int], Just i <- [pickId pool0 IntSet.empty s]]
+          assertBool "shuffles: more than one distinct job is drawn" (Set.size drawn > 1)
+          assertBool "only ever draws real job ids" (drawn `Set.isSubsetOf` Set.fromList [0 .. 5])
+          -- an excluded job is never drawn: exclude all but job 5.
+          Set.fromList
+            [i | s <- [0 .. 50 :: Int], Just i <- [pickId pool0 (IntSet.fromList [0, 1, 2, 3, 4]) s]]
+            @?= Set.singleton 5
+          -- the least-requested bucket wins regardless of the draw: force job 0 to
+          -- multiplicity 1 (by excluding the rest), then an unrestricted draw comes
+          -- only from the still-least-requested jobs 1..5, never job 0.
+          let pool1 = case Jobs.pickLeastRequestedJobExcept (mkStdGen 0) (IntSet.fromList [1, 2, 3, 4, 5]) pool0 of
+                Just (_jid, _job, p, _prng') -> p
+                Nothing -> error "forced pick of the sole non-excluded job failed"
+              drawnFromPool1 = Set.fromList [i | s <- [0 .. 50 :: Int], Just i <- [pickId pool1 IntSet.empty s]]
+          assertBool
+            "least-requested bucket wins: job 0 (multiplicity 1) is not drawn"
+            (not (0 `Set.member` drawnFromPool1))
+          assertBool "still shuffles among the least-requested jobs" (Set.size drawnFromPool1 > 1)
+      , testCase "prune drops below-tip missing-body points and keeps the reverse index in sync" $ do
+          let hA = hashLeiosEb (ebOf [0, 1]) -- to be listed at slots 3 and 10
+              hB = hashLeiosEb (ebOf [2, 3]) -- to be listed at slot 3 only
+              pointAt slot h = MkLeiosPoint (SlotNo slot) h
+              o0 :: LeiosOutstanding Int
+              o0 =
+                (emptyLeiosOutstanding (mkStdGen 0) (SlotNo 0))
+                  { Leios.missingEbBodies =
+                      Map.fromList [(pointAt 3 hA, 10), (pointAt 10 hA, 10), (pointAt 3 hB, 20)]
+                  , Leios.reverseSlotIndexByEbHash =
+                      Map.fromList
+                        [ (hA, NESet.insert (SlotNo 3) (NESet.singleton (SlotNo 10)))
+                        , (hB, NESet.singleton (SlotNo 3))
+                        ]
+                  }
+              o = snd (Leios.pruneOutstandingToImmTip (SlotNo 5) o0)
+          -- hA's slot-3 point is dropped, its slot-10 point kept
+          Map.lookup (pointAt 3 hA) (Leios.missingEbBodies o) @?= Nothing
+          Map.lookup (pointAt 10 hA) (Leios.missingEbBodies o) @?= Just 10
+          -- hB was listed only at slot 3, so it drops out entirely
+          Map.lookup (pointAt 3 hB) (Leios.missingEbBodies o) @?= Nothing
+          Map.size (Leios.missingEbBodies o) @?= 1
+          -- the reverse index stays the exact inverse: hA at slot 10 only, hB gone
+          Map.lookup hA (Leios.reverseSlotIndexByEbHash o) @?= Just (NESet.singleton (SlotNo 10))
+          Map.lookup hB (Leios.reverseSlotIndexByEbHash o) @?= Nothing
+      , testProperty
+          "ebState stays in sync with ebsPerMaxAnnouncementSlot across arbitrary sequences"
+          prop_invariants
+      , testProperty
+          "the fetch logic never requests an already-held EB body"
+          prop_neverRefetchesHeldBody
+      , testProperty
+          "a concurrent offer and body arrival never leave a held EB body listed (IOSimPOR)"
+          prop_neverRefetchesHeldBodyConcurrent
+      ]
+
+------------------------------------------------------------
+-- Commands
+------------------------------------------------------------
+
+-- | A test EB is a list of (globally distinct) tx ids; the same list means the
+-- same 'LeiosEb', hence the same 'EbHash' — so the same EB announced at two
+-- slots is genuinely one hash at two 'LeiosPoint's (the crash arming).
+type TestEb = [Int]
+
+data Cmd
+  = -- | @recordAnnouncedEb@: announce this EB at this slot.
+    Announce TestEb Word
+  | -- | @recordEbBodyOffer@: a peer offers this EB body at this slot.
+    Offer TestEb Word
+  | -- | @processLeiosBlock@: the EB body arrives for that point.
+    ArriveBody TestEb Word
+  | -- | Disarmed: the EbTxs side is being rewritten from scratch, so tx delivery
+    -- has no command for now (uninhabited).
+    ArriveTx Void
+  | -- | @leiosFetchLogicIteration@ at this current slot.
+    Decide Word
+  | -- | The forge produces this EB: drives 'processLeiosBlock'/'processLeiosBlockTxs'
+    -- with 'ForgedBlock'/'ForgedTxs' (as 'onForgedLeiosEb' does), reconciling the
+    -- outstanding state exactly as a remote acquisition would.
+    Forge TestEb Word
+  deriving (Eq, Show)
+
+------------------------------------------------------------
+-- Self-consistent EB/tx construction
+--
+-- The handlers validate @hashLeiosEb eb == ebHash@ and @hashLeiosTx tx ==
+-- txHash@, so we derive hashes from the bytes rather than inventing them.
+------------------------------------------------------------
+
+txBytesOf :: Int -> BS.ByteString
+txBytesOf i = BS.pack (fromIntegral (i + 1) : replicate 31 0)
+
+leiosTxOf :: Int -> LeiosTx
+leiosTxOf = MkLeiosTx . txBytesOf
+
+txHashOf :: Int -> TxHash
+txHashOf = hashLeiosTx . leiosTxOf
+
+txSizeOf :: Int -> BytesSize
+txSizeOf = fromIntegral . BS.length . txBytesOf
+
+-- | A stub clock for the handlers: the suite never asserts on EB age, and these
+-- EBs are never heralded, so the age always comes out 'Nothing' regardless.
+dummySystemTime :: Applicative m => SystemTime m
+dummySystemTime =
+  SystemTime
+    { systemTimeCurrent = pure (RelativeTime 0)
+    , systemTimeWait = pure ()
+    }
+
+ebOf :: TestEb -> LeiosEb
+ebOf ids = MkLeiosEb (V.fromList [(txHashOf i, txSizeOf i) | i <- ids])
+
+pointOf :: TestEb -> Word -> LeiosPoint
+pointOf ids slot = MkLeiosPoint (fromIntegral slot) (hashLeiosEb (ebOf ids))
+
+------------------------------------------------------------
+-- Harness
+------------------------------------------------------------
+
+-- | Run a command sequence in 'IOSim' against in-memory dependencies, checking
+-- the invariant after each command. 'Left' names the first failing command.
+runCmds :: [Cmd] -> Either String ()
+runCmds = (() <$) . runCmdsReFetchViolations
+
+-- | Like 'runCmds', but on success also return the EB bodies that the fetch
+-- logic requested despite already holding them (i.e. despite 'ebStateHasBody'),
+-- gathered across all 'Decide's. That list is the
+-- re-fetch-storm regression signal: it must be empty. See
+-- 'prop_neverRefetchesHeldBody'.
+runCmdsReFetchViolations :: [Cmd] -> Either String [EbHash]
+runCmdsReFetchViolations cmds = runSimOrThrow (go cmds)
+ where
+  go :: forall s. [Cmd] -> IOSim s (Either String [EbHash])
+  go cs0 = do
+    dbHandle <- LeiosDb.newLeiosDBInMemory
+    withLeiosDb dbHandle $ \conn -> do
+      outstandingVar <- newMVar (emptyLeiosOutstanding (mkStdGen 0) (SlotNo 0))
+      readyVar <- newEmptyMVar
+      peerVars <- newLeiosPeerVars IsNotBigLedgerPeer
+      let kv = (outstandingVar, readyVar)
+          txCache = nullLeiosTxCache
+          peerId = MkPeerId (0 :: Int)
+          loop acc [] = pure (Right acc)
+          loop acc (c : cs) = do
+            r <-
+              try (applyCmd conn txCache kv peerVars peerId c) ::
+                IOSim s (Either SomeException [EbHash])
+            case r of
+              Left e -> pure (Left ("exception on " <> show c <> ": " <> show e))
+              Right violations -> do
+                outstanding <- readMVar outstandingVar
+                case checkInvariant outstanding of
+                  Left msg -> pure (Left (msg <> " (after " <> show c <> ")"))
+                  Right () -> loop (acc <> violations) cs
+      loop [] cs0
+
+-- | Apply a command, returning any EB bodies it requested that are already held
+-- (per 'ebStateHasBody') — the re-fetch-storm violation. Empty for everything
+-- but a misbehaving 'Decide'.
+applyCmd ::
+  forall s.
+  LeiosDb.LeiosDbConnection (IOSim s) ->
+  LeiosTxCache (IOSim s) () () Leios.SerializedEbBody ->
+  (MVar (IOSim s) (LeiosOutstanding Int), MVar (IOSim s) ()) ->
+  LeiosPeerVars (IOSim s) ->
+  PeerId Int ->
+  Cmd ->
+  IOSim s [EbHash]
+applyCmd conn txCache kv peerVars peerId = \case
+  Announce ids slot -> do
+    -- These invariants are about the fetch bookkeeping, which never reads the
+    -- onset; only the voting path needs it.
+    recordAnnouncedEb kv SNothing (pointOf ids slot, leiosEbBytesSize (ebOf ids))
+    pure []
+  Offer ids slot -> do
+    recordEbBodyOffer
+      kv
+      peerVars
+      TxsClosureNotAlsoOffered
+      (pointOf ids slot, leiosEbBytesSize (ebOf ids))
+    pure []
+  ArriveBody ids slot -> do
+    let eb = ebOf ids
+        req = MkLeiosBlockRequest (pointOf ids slot) (leiosEbBytesSize eb)
+    processLeiosBlock
+      nullTracer
+      nullTracer
+      kv
+      txCache
+      conn
+      dummySystemTime
+      noMempoolPull
+      (ReceivedBlockFrom peerId req)
+      eb
+    pure []
+  ArriveTx v -> absurd v
+  Forge ids slot -> do
+    let eb = ebOf ids
+        point = pointOf ids slot
+    -- Replicate 'onForgedLeiosEb''s effect on 'outstanding': its 'ForgedLocally'
+    -- announcement marks the EB 'BodyImminent' (via 'markBodyImminent'), then the
+    -- body and closure arrive. That mark is what stops a later peer offer of our
+    -- own EB from being re-fetched -- without it a forge-first sequence would leave
+    -- 'ebState' untouched (as it did pre-fix, causing the crash).
+    --
+    -- We can't just call 'onForgedLeiosEb' because it needs a concrete @blk@ with a
+    -- real 'AnnouncingHeader' and a 'CentralState' -- the whole announcement stack
+    -- this suite deliberately avoids.
+    --
+    -- WARNING: this hand-replicates 'onForgedLeiosEb'; if that function's effect on
+    -- 'outstanding' changes, mirror it here or this regression coverage goes stale
+    -- silently.
+    modifyMVar_ (fst kv) (pure . Leios.markBodyImminent point.pointEbHash point.pointSlotNo)
+    processLeiosBlock
+      nullTracer
+      nullTracer
+      kv
+      txCache
+      conn
+      dummySystemTime
+      noMempoolPull
+      (ForgedBlock point)
+      eb
+    processLeiosBlockTxs
+      nullTracer
+      nullTracer
+      kv
+      txCache
+      conn
+      dummySystemTime
+      (ForgedTxs point eb $ V.fromList $ map leiosTxOf ids)
+    pure []
+  Decide slot -> do
+    outstanding <- readMVar (fst kv)
+    let offerings = Map.singleton peerId (referencedOffers outstanding)
+        -- The generated peer is not a big-ledger peer; the aggressive-fetch path
+        -- has its own dedicated test below.
+        (out', decs, _drops) =
+          leiosFetchLogicIteration
+            demoLeiosFetchStaticEnv
+            (Just (fromIntegral slot))
+            offerings
+            Map.empty
+            outstanding
+    -- Force the fetch logic so any 'impossible!' surfaces (caught by 'go').
+    -- Forcing @out'@ to WHNF drives 'go1' to completion (its reverse lookups);
+    -- 'forceDecisions' additionally forces the per-request offset lookups.
+    _ <- evaluate out'
+    _ <- evaluate (forceDecisions decs)
+    modifyMVar_ (fst kv) (\_ -> pure out')
+    -- Regression: the fetch logic must not request a body we already hold.
+    -- Return any it did (empty when well-behaved).
+    let held = Map.keysSet (Map.filter Leios.ebStateHasBody (Leios.ebState outstanding))
+    pure (filter (\h -> Set.member h held) (ebBodyRequestHashes decs))
+
+-- | Offer every EB the outstanding state tracks, at its 'ebStateMaxSlot' and as
+-- 'TxsClosureAlsoOffered' (which implies the body too) -- an all-offering peer, so
+-- the fetch logic can act on whichever half each EB still needs.
+referencedOffers :: LeiosOutstanding Int -> Map.Map Leios.LeiosPoint Leios.AlsoOfferedTxsClosure
+referencedOffers o =
+  Map.fromList
+    [ (Leios.MkLeiosPoint (Leios.ebStateMaxSlot s) h, Leios.TxsClosureAlsoOffered)
+    | (h, s) <- Map.toList (Leios.ebState o)
+    ]
+
+-- | Force the requests to a scalar, so any @impossible!@ hidden in a thunk
+-- surfaces when the caller 'evaluate's it. Touches each tx request's covered
+-- job offsets and each EB request's size.
+forceDecisions :: Map.Map peer (NESeq Leios.LeiosFetchRequest) -> Int
+forceDecisions m =
+  sum [reqScore req | reqs <- Map.elems m, req <- toList reqs]
+ where
+  reqScore = \case
+    Leios.LeiosBlockRequest (Leios.MkLeiosBlockRequest _p sz) -> fromIntegral sz
+    Leios.LeiosBlockTxsRequest (Leios.MkLeiosBlockTxsRequest _p jobs) ->
+      sum
+        [ off
+        | Jobs.MkLeiosJob offs _bytes _root <- toList jobs
+        , off <- IntSet.toList offs
+        ]
+
+-- | The 'EbHash'es the requests fetch an EB body for (one entry per request; with
+-- no per-EB cap, an EB may appear once per offering peer).
+ebBodyRequestHashes :: Map.Map peer (NESeq Leios.LeiosFetchRequest) -> [EbHash]
+ebBodyRequestHashes m =
+  [ p.pointEbHash
+  | reqs <- Map.elems m
+  , Leios.LeiosBlockRequest (Leios.MkLeiosBlockRequest p _sz) <- toList reqs
+  ]
+
+-- | The union of every tx offset the requests fetch, across all peers.
+requestedOffsets :: Map.Map peer (NESeq Leios.LeiosFetchRequest) -> IntSet.IntSet
+requestedOffsets m =
+  IntSet.unions
+    [ offs
+    | reqs <- Map.elems m
+    , Leios.LeiosBlockTxsRequest (Leios.MkLeiosBlockTxsRequest _p jobs) <- toList reqs
+    , Jobs.MkLeiosJob offs _bytes _root <- toList jobs
+    ]
+
+------------------------------------------------------------
+-- The invariant
+------------------------------------------------------------
+
+-- | 'ebsPerMaxAnnouncementSlot' must be the exact inverse of the greatest-slot
+-- field of 'ebState' (the reverse index 'pruneOutstandingToImmTip' prunes by).
+--
+-- (The old missing-tx \/ reverse-index invariant is gone with the EbTxs rewrite.)
+checkInvariant :: LeiosOutstanding Int -> Either String ()
+checkInvariant o =
+  if Leios.ebsPerMaxAnnouncementSlot o == inverseOfMax
+    then Right ()
+    else
+      Left
+        ( "ebsPerMaxAnnouncementSlot desynced from ebState: "
+            <> show (Leios.ebsPerMaxAnnouncementSlot o, inverseOfMax)
+        )
+ where
+  inverseOfMax =
+    Map.fromListWith
+      NESet.union
+      [ (Leios.ebStateMaxSlot s, NESet.singleton h)
+      | (h, s) <- Map.toList (Leios.ebState o)
+      ]
+
+------------------------------------------------------------
+-- Curated repros
+------------------------------------------------------------
+
+-- | A peer offers an EB body; we forge the same EB before the offered body
+-- arrives. Forging must purge the offered body from 'missingEbBodies' (its
+-- 'ebState' now reads 'BodyAcquired'), so the fetch logic never re-requests a body
+-- we already hold. Pre-fix the forge recorded the body as acquired without purging,
+-- so the 'Decide' re-fetched it.
+reproForgeAfterOffer :: [Cmd]
+reproForgeAfterOffer =
+  [ Offer [0, 1] 10
+  , Forge [0, 1] 12
+  , Decide 13
+  ]
+
+-- | The devnet crash order: we forge an EB, then a peer offers that same EB back
+-- (e.g. relaying our own announcement). The forge marked it 'BodyImminent' (the
+-- body arrival then makes it 'BodyAcquired'), so the offer must be dropped, never
+-- re-fetched. Pre-fix the re-fetch re-acquired the closure, emitting a duplicate
+-- 'AcquiredEbTxs' that killed 'runLeiosVoting' with 'AlreadyKnown'.
+reproForgeThenOffer :: [Cmd]
+reproForgeThenOffer =
+  [ Forge [0, 1] 12
+  , Offer [0, 1] 12
+  , Decide 13
+  ]
+
+------------------------------------------------------------
+-- Property
+------------------------------------------------------------
+
+worldEbs :: [TestEb]
+worldEbs = [[0, 1], [1, 2], [0], [2, 3, 4]]
+
+worldSlots :: [Word]
+worldSlots = [10, 11, 12]
+
+genCmd :: Gen Cmd
+genCmd = do
+  ids <- elements worldEbs
+  slot <- elements worldSlots
+  oneof
+    [ pure (Announce ids slot)
+    , pure (Offer ids slot)
+    , pure (ArriveBody ids slot)
+    , pure (Forge ids slot)
+    , Decide <$> elements worldSlots
+    ]
+
+------------------------------------------------------------
+-- Coverage
+------------------------------------------------------------
+
+isForge :: Cmd -> Bool
+isForge Forge{} = True
+isForge _ = False
+
+cmdName :: Cmd -> String
+cmdName = \case
+  Announce{} -> "Announce"
+  Offer{} -> "Offer"
+  ArriveBody{} -> "ArriveBody"
+  ArriveTx{} -> "ArriveTx"
+  Forge{} -> "Forge"
+  Decide{} -> "Decide"
+
+-- | An EB made known (offer \/ announce \/ body arrival) and later forged: the
+-- body forge hazard, where forging must purge the earlier listing.
+listedThenForged :: [Cmd] -> Bool
+listedThenForged cmds =
+  or
+    [ Just ids `elem` map listing (take i cmds)
+    | (i, Forge ids _) <- zip [0 :: Int ..] cmds
+    ]
+ where
+  listing = \case
+    Offer x _ -> Just x
+    Announce x _ -> Just x
+    ArriveBody x _ -> Just x
+    _ -> Nothing
+
+-- | Coverage shared by the generated properties: the command mix, and whether
+-- the two forge hazards were actually generated -- so the properties are visibly
+-- non-vacuous.
+coverage :: Testable prop => [Cmd] -> prop -> Property
+coverage cmds prop =
+  tabulate "commands" (map cmdName cmds) $
+    classify (any isForge cmds) "has a Forge" $
+      cover 15 (listedThenForged cmds) "listed then forged (body hazard)" $
+        property prop
+
+prop_invariants :: Property
+prop_invariants =
+  forAllShrink (listOf genCmd) (shrinkList (const [])) $ \cmds ->
+    coverage cmds (runCmds cmds === Right ())
+
+-- | Regression for the EB-body re-fetch storm: over any interleaving of
+-- announces, offers, and body/tx arrivals, the fetch logic must never request an
+-- EB body it already holds (one whose 'ebState' reads 'BodyAcquired'). The storm was precisely
+-- this — a held body re-listed and re-requested indefinitely.
+--
+-- Stated as "already held" rather than a request count, since there is no per-EB
+-- request cap: requesting a not-yet-held body from several peers is fine;
+-- re-requesting a held one is not. (With 'nullLeiosTxCache', the
+-- old LeiosTxCache-based "do we have it?" check would see nothing held and
+-- re-list/re-request endlessly; the 'ebStateHasBody' check is cache-independent.)
+prop_neverRefetchesHeldBody :: Property
+prop_neverRefetchesHeldBody =
+  forAllShrink (listOf genCmd) (shrinkList (const [])) $ \cmds ->
+    coverage cmds $
+      case runCmdsReFetchViolations cmds of
+        Left msg -> counterexample msg (property False)
+        Right violations ->
+          counterexample
+            ("fetch requested already-held EB bodies: " ++ show violations)
+            (null violations)
+
+------------------------------------------------------------
+-- Concurrent (IOSimPOR) regression
+------------------------------------------------------------
+
+-- Unlike the rest of this module, this scenario calls the handlers directly
+-- rather than through the 'Cmd' interpreter ('applyCmd'). Two reasons: a race
+-- has no use for 'Decide' -- we assert on the state directly -- and 'applyCmd'
+-- runs 'Decide' as a read-then-blind-overwrite that is only sound
+-- single-threaded (a concurrent write would be silently clobbered); and spelling
+-- the handlers out keeps the lock structure this test exists to probe -- the body
+-- arrival's purge-then-acquire, which must be a single 'outstandingVar' critical
+-- section even though it also touches the separate cache lock -- in plain view at
+-- the race site.
+
+-- | The sequential 'prop_neverRefetchesHeldBody' generates event /sequences/ but
+-- runs each handler to completion, so it can't reproduce an interleaving that
+-- splits one handler's critical section around a concurrent update to the shared
+-- state. This scenario runs three handlers for the /same EB hash at three
+-- different slots/ as genuinely concurrent threads over the shared MVars — an
+-- offer (slot 10), an announcement (slot 11), and a body arrival (slot 12, which
+-- inserts the body into the pure 'newPureLeiosTxCache' -- a lock distinct from the
+-- outstanding lock -- while holding the outstanding lock) — and uses IOSimPOR to
+-- explore every interleaving.
+--
+-- An 'EbHash' is not 1-to-1 with slots, so this is exactly the shape that armed
+-- the storm: whichever listing wins is recorded at its own slot, and the arrival
+-- (at yet another slot) must clear it /by hash/, not by point. In every
+-- interleaving the state invariant "a held EB body is never still listed for
+-- fetching" must hold, which is what stops a later decision from re-requesting
+-- it.
+--
+-- With the shipped fix each handler's "held?"/"listed?" test and its state update
+-- are one 'outstandingVar' critical section, and acquisition purges every point
+-- sharing the hash via 'reverseSlotIndexByEbHash', so no interleaving can violate
+-- this; the test guards against regressing either half (moving a check back out
+-- of the lock, or reverting to a delete-by-point that misses the other slots).
+prop_neverRefetchesHeldBodyConcurrent :: Property
+prop_neverRefetchesHeldBodyConcurrent =
+  exploreSimTrace id (exploreRaces *> raceSameHashMultiSlot) $ \_ tr ->
+    case traceResult False tr of
+      Right prop -> prop
+      Left e -> counterexample ("Failure: " <> show e) False
+
+-- | An offer, an announcement, and a body arrival walk into a bar...
+--
+-- All for the same EB hash but at three distinct slots, run concurrently over
+-- shared state; the returned 'Property' is the invariant "no held EB body is
+-- still listed for fetching".
+raceSameHashMultiSlot :: forall m. IOLike m => m Property
+raceSameHashMultiSlot = do
+  dbHandle <- LeiosDb.newLeiosDBInMemory
+  withLeiosDb dbHandle $ \conn -> do
+    outstandingVar <- newMVar (emptyLeiosOutstanding (mkStdGen 0) (SlotNo 0))
+    readyVar <- newEmptyMVar
+    peerVars <- newLeiosPeerVars IsNotBigLedgerPeer
+    txCache <- newPureLeiosTxCache
+    let kv = (outstandingVar, readyVar)
+        peerId = MkPeerId (0 :: Int)
+        ids = [0, 1] :: TestEb
+        eb = ebOf ids
+        ebBytesSize = leiosEbBytesSize eb
+        -- One hash (same ids), three different slots.
+        offerPoint = pointOf ids 10
+        announcePoint = pointOf ids 11
+        arrivalPoint = pointOf ids 12
+    concurrently_
+      (recordEbBodyOffer kv peerVars TxsClosureNotAlsoOffered (offerPoint, ebBytesSize))
+      ( concurrently_
+          (recordAnnouncedEb kv SNothing (announcePoint, ebBytesSize))
+          ( processLeiosBlock
+              nullTracer
+              nullTracer
+              kv
+              txCache
+              conn
+              dummySystemTime
+              noMempoolPull
+              (ReceivedBlockFrom peerId (MkLeiosBlockRequest arrivalPoint ebBytesSize))
+              eb
+          )
+      )
+    outstanding <- readMVar outstandingVar
+    let held = Map.keysSet (Map.filter Leios.ebStateHasBody (Leios.ebState outstanding))
+        listed =
+          Set.fromList (map (.pointEbHash) (Map.keys (Leios.missingEbBodies outstanding)))
+        heldAndListed = Set.toList (Set.intersection held listed)
+    pure $
+      counterexample
+        ("held EB body still listed for fetching: " <> show heldAndListed)
+        (null heldAndListed)
diff --git a/ouroboros-consensus/test/consensus-test/Test/LeiosTxCache/Optimized.hs b/ouroboros-consensus/test/consensus-test/Test/LeiosTxCache/Optimized.hs
index 2e1617fc92..3312bcf083 100644
--- a/ouroboros-consensus/test/consensus-test/Test/LeiosTxCache/Optimized.hs
+++ b/ouroboros-consensus/test/consensus-test/Test/LeiosTxCache/Optimized.hs
@@ -1,5 +1,3 @@
-{-# LANGUAGE BangPatterns #-}
-
 -- | Observational-equivalence test for the mutable 'LeiosTxCache' handle: run
 -- the same random op sequence (announcements, bodies, tx inserts) through both
 -- 'newPureLeiosTxCache' and 'newHashTableLeiosTxCache' and require that they
@@ -20,7 +18,7 @@ import qualified Data.ByteString as BS
 import qualified Data.List as List
 import Data.Set (Set)
 import Data.Word (Word64, Word8)
-import LeiosDemoTypes (EbHash (..), RbHash (..), TxHash (..))
+import LeiosDemoTypes (BytesSize, EbHash (..), FetchArrivalBytes, RbHash (..), TxHash (..))
 import LeiosTxCache (LeiosTxCache (..), ReferencesTxsByHash (..), newPureLeiosTxCache)
 import LeiosTxCache.Optimized (newHashTableLeiosTxCache)
 import Test.LeiosTxCache.Optimized.MutableHashTable (Config (..), genConfig, salt0, salt1)
@@ -60,7 +58,10 @@ newtype TestBody = TestBody [TxHash]
   deriving (Eq, Show)
 
 instance ReferencesTxsByHash TestBody where
-  foldTxReferences f z (TestBody hs) = List.foldl' f z hs
+  foldTxReferences f z (TestBody hs) =
+    List.foldl' (\acc txh -> f acc txh dummySize) z hs
+   where
+    dummySize = 0
 
 -- A 32-byte tx hash (the mutable table reads exactly 32 bytes).
 txhOf :: Word8 -> TxHash
@@ -80,19 +81,29 @@ data Op
   | OpEvict !Word64
   deriving Show
 
--- | Apply an op, returning the eviction sets (the only observable output of an
--- op) when it is an announcement or an 'evictOlderThan'.
-applyOp :: H -> Op -> IO (Maybe (Set EbHash, Set TxHash))
+-- | Apply an op, returning its observable output: the eviction sets for an
+-- announcement or 'evictOlderThan', and the 'FetchArrivalBytes' for an unapplied
+-- insert. Both impls must agree on both (see 'prop_equiv').
+applyOp :: H -> Op -> IO (Maybe (Set EbHash, Set TxHash), Maybe FetchArrivalBytes)
 applyOp h op = case op of
-  OpAnnounce s r e -> Just <$> insertAnnouncement h (SlotNo s) (rbhOf r) (ebhOf e)
-  OpEvict boundary -> Just <$> evictOlderThan h (SlotNo boundary)
-  OpBody e ts -> insertBody h (ebhOf e) (TestBody (map txhOf ts)) >> pure Nothing
+  OpAnnounce s r e -> evicted <$> insertAnnouncement h (SlotNo s) (rbhOf r) (ebhOf e)
+  OpEvict boundary -> evicted <$> evictOlderThan h (SlotNo boundary)
+  OpBody e ts ->
+    insertBody h (ebhOf e) (TestBody (map txhOf ts)) () (\() _ _ _ -> ()) >> pure (Nothing, Nothing)
   OpUnapplied ts ->
-    withLockedInsertUnappliedTx h (\z step -> foldM (\acc t -> step acc (txhOf t) ()) z ts)
-      >> pure Nothing
+    arrival
+      <$> withLockedInsertUnappliedTx h (\z step -> foldM (\acc t -> step acc (txhOf t) (szOf t) ()) z ts)
   OpApplied ts ->
     withLockedInsertAppliedTx h (\z step -> foldM (\acc t -> step acc (txhOf t) ()) z ts)
-      >> pure Nothing
+      >> pure (Nothing, Nothing)
+ where
+  evicted x = (Just x, Nothing)
+  arrival fab = (Nothing, Just fab)
+
+-- | A deterministic per-tx size, so both impls bucket identical bytes into the
+-- 'FetchArrivalBytes' and any classification mismatch shows up as a difference.
+szOf :: Word8 -> BytesSize
+szOf t = 1 + fromIntegral t
 
 sweepLookup :: H -> [Word8] -> IO [Maybe (Either () ())]
 sweepLookup h txs = withLookupTx h (\look -> mapM (look . txhOf) txs)
diff --git a/ouroboros-consensus/test/consensus-test/Test/LeiosTxCache/Reference.hs b/ouroboros-consensus/test/consensus-test/Test/LeiosTxCache/Reference.hs
index 53bbebb57d..e2a2656df5 100644
--- a/ouroboros-consensus/test/consensus-test/Test/LeiosTxCache/Reference.hs
+++ b/ouroboros-consensus/test/consensus-test/Test/LeiosTxCache/Reference.hs
@@ -1,5 +1,3 @@
-{-# LANGUAGE TypeApplications #-}
-
 -- | Tests for the pure 'LeiosTxCacheIndex': announcement/body/tx reference
 -- counting and the 'maxAnnouncementCount' eviction cascade.
 --
@@ -96,7 +94,10 @@ newtype TestBody = TestBody [TxHash]
   deriving (Eq, Show)
 
 instance ReferencesTxsByHash TestBody where
-  foldTxReferences f z (TestBody hs) = List.foldl' f z hs
+  foldTxReferences f z (TestBody hs) =
+    List.foldl' (\acc txh -> f acc txh dummySize) z hs
+   where
+    dummySize = 0
 
 empty :: Idx
 empty = emptyLeiosTxCacheIndex
@@ -115,7 +116,7 @@ ann :: Word64 -> Word8 -> Word8 -> Idx -> Idx
 ann s r e idx = let (idx', _, _) = insertAnnouncement (SlotNo s) (mkRbHash r) (mkEbHash e) idx in idx'
 
 body :: Word8 -> [Word8] -> Idx -> Idx
-body e ts idx = fst (insertBody (mkEbHash e) (TestBody (map mkTxHash ts)) idx)
+body e ts idx = fst (insertBody (mkEbHash e) (TestBody (map mkTxHash ts)) () (\() _ _ _ -> ()) idx)
 
 -- | Announce EBs 1..n, each at its own slot and with its own RB hash.
 annN :: Int -> Idx -> Idx
@@ -192,7 +193,7 @@ test_lookupBodyEvicted = do
 
 test_unapplied :: Assertion
 test_unapplied =
-  lookupTx (mkTxHash 10) (insertUnappliedTx (mkTxHash 10) 7 (body 1 [10] (ann 1 1 1 empty)))
+  lookupTx (mkTxHash 10) (fst (insertUnappliedTx (mkTxHash 10) 7 (body 1 [10] (ann 1 1 1 empty))))
     @?= Just (Left 7)
 
 test_applied :: Assertion
@@ -202,12 +203,12 @@ test_applied =
 
 test_txUnreferenced :: Assertion
 test_txUnreferenced =
-  lookupTx (mkTxHash 10) (insertUnappliedTx (mkTxHash 10) 7 empty) @?= Nothing
+  lookupTx (mkTxHash 10) (fst (insertUnappliedTx (mkTxHash 10) 7 empty)) @?= Nothing
 
 test_preserveRc :: Assertion
 test_preserveRc = do
   let idx0 = body 2 [10] (body 1 [10] (ann 2 2 2 (ann 1 1 1 empty)))
-      idx = insertUnappliedTx (mkTxHash 10) 7 idx0
+      idx = fst (insertUnappliedTx (mkTxHash 10) 7 idx0)
   (txRC 10 idx, lookupTx (mkTxHash 10) idx) @?= (Just (MkRefCount 2), Just (Left 7))
 
 {-------------------------------------------------------------------------------
@@ -336,7 +337,7 @@ applyOp :: Op -> Idx -> Idx
 applyOp op = case op of
   OpAnn s r e -> ann s r e
   OpBody e ts -> body e ts
-  OpUnappliedTx t -> insertUnappliedTx (mkTxHash t) 0
+  OpUnappliedTx t -> fst . insertUnappliedTx (mkTxHash t) 0
   OpAppliedTx t -> insertAppliedTx (mkTxHash t) 0
 
 genW :: Num a => Int -> Int -> Gen a
@@ -375,7 +376,7 @@ rcInt :: RefCount -> Int
 rcInt (MkRefCount w) = fromIntegral w
 
 txHashesOf :: ReferencesTxsByHash b => b -> [TxHash]
-txHashesOf = foldTxReferences (flip (:)) []
+txHashesOf = foldTxReferences (\acc txh _sz -> txh : acc) []
 
 -- | After any sequence of ops the maintained refcounts agree with the refcounts
 -- recomputed from first principles: a body's refcount is the number of retained