From 62113b8f65c05d557c16042000efa789ae9cb2fe Mon Sep 17 00:00:00 2001
From: Nicolas Frisby <nicolas.frisby@moduscreate.com>
Date: Mon, 10 Aug 2026 13:39:33 -0400
Subject: [PATCH 01/49] LeiosTxCache: best-effort prevention of spurious
 inserts into missingEbBodies

If we already have the EB body _and it's still marked as `BodyAlreadyInserted`
in the LeiosTxCache_, don't add it to `missingEbBodies`.
---
 .../Ouroboros/Consensus/Network/NodeToNode.hs | 28 ++++++++-----
 .../src/ouroboros-consensus/LeiosDemoLogic.hs | 40 ++++++++++++-------
 2 files changed, 42 insertions(+), 26 deletions(-)

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..690324f96f 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
@@ -126,6 +126,7 @@ import LeiosDemoTypes
   , TraceLeiosPeer (..)
   )
 import qualified LeiosDemoTypes as Leios
+import LeiosTxCache (lookupBody)
 import LeiosVoteState
   ( AddVoteResult (..)
   , LeiosVoteState (..)
@@ -404,6 +405,7 @@ mkHandlers
               , CsClient.getDiffusionPipeliningSupport = getDiffusionPipeliningSupport
               , CsClient.leiosMsgRollForwardCallback = \hdr hdrSlotTime cds -> do
                   Leios.checkMsgRollForwardForLeiosOffers
+                    getLeiosTxCache
                     (getLeiosOutstanding, getLeiosReady)
                     peerVars
                     hdr
@@ -558,19 +560,23 @@ mkHandlers
                     -- 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.
+                    mBody <- lookupBody getLeiosTxCache ebHash
                     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)
-                              }
+                        case mBody of
+                          Just{} -> outstanding -- we already hold this EB's body
+                          Nothing ->
+                            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)
diff --git a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
index 5eb068db31..4b16657030 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
@@ -1009,6 +1009,7 @@ msgLeiosBlockTxs ktracer tracer (outstandingVar, readyVar) txCache db peerId req
 -- register — stays in 'checkMsgRollForwardForLeiosOffers'.)
 leiosCertRbOffer ::
   IOLike m =>
+  LeiosTxCache m () () SerializedEbBody ->
   ( MVar m (LeiosOutstanding pid)
   , MVar m ()
   ) ->
@@ -1016,18 +1017,22 @@ leiosCertRbOffer ::
   -- | The EB the CertRB certifies: its point and on-the-wire body size.
   (LeiosPoint, BytesSize) ->
   m ()
-leiosCertRbOffer (outstandingVar, readyVar) peerVars (point, ebBytesSize) = do
+leiosCertRbOffer txCache (outstandingVar, readyVar) peerVars (point, ebBytesSize) = do
   let MkLeiosPoint _ebSlot ebHash = point
-  -- As if 'MsgLeiosBlockOffer': record the EB body as missing.
+  -- As if 'MsgLeiosBlockOffer': record the EB body as missing, unless we already
+  -- hold it.
+  mBody <- txCache.lookupBody ebHash
   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)
-            }
+      case mBody of
+        Just{} -> outstanding
+        Nothing
+          | Set.member ebHash (Leios.acquiredEbBodies outstanding) -> outstanding
+          | otherwise ->
+              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
@@ -1047,6 +1052,7 @@ leiosCertRbOffer (outstandingVar, readyVar) peerVars (point, ebBytesSize) = do
 checkMsgRollForwardForLeiosOffers ::
   forall blk pid m.
   (IOLike m, ResolveLeiosBlock blk) =>
+  LeiosTxCache m () () SerializedEbBody ->
   ( MVar m (LeiosOutstanding pid)
   , MVar m ()
   ) ->
@@ -1054,10 +1060,10 @@ checkMsgRollForwardForLeiosOffers ::
   Header blk ->
   ChainDepState (BlockProtocol blk) ->
   m ()
-checkMsgRollForwardForLeiosOffers kernelVars peerVars hdr cds =
+checkMsgRollForwardForLeiosOffers txCache kernelVars peerVars hdr cds =
   when (headerContainsLeiosCert hdr) $
     forM_ (protocolStateLeiosAnnouncement @blk cds) $ \announcement ->
-      leiosCertRbOffer kernelVars peerVars announcement
+      leiosCertRbOffer txCache kernelVars peerVars announcement
 
 -----
 
@@ -1127,7 +1133,7 @@ processAnnouncementCentrally
         (contramap (traceNewAnnouncement provenance) kernelTracer)
         ancElId
         ( \_elSt -> do
-            recordAnnouncedEb kernelVars (point, Leios.announcementEbBodySize fields)
+            recordAnnouncedEb txCache kernelVars (point, Leios.announcementEbBodySize fields)
             recordAnnouncementInTxCache txCache ancHdr point
         )
         cst
@@ -1229,14 +1235,18 @@ announcementValidity systemTime futureCheck cfg immLedger hdr = do
 -- already acquired or already recorded.
 recordAnnouncedEb ::
   IOLike m =>
+  LeiosTxCache m () () SerializedEbBody ->
   ( MVar m (LeiosOutstanding pid)
   , MVar m ()
   ) ->
   (LeiosPoint, BytesSize) ->
   m ()
-recordAnnouncedEb (outstandingVar, readyVar) (point, ebBytesSize) = do
-  changed <- MVar.modifyMVar outstandingVar (pure . upd)
-  when changed $ void $ MVar.tryPutMVar readyVar ()
+recordAnnouncedEb txCache (outstandingVar, readyVar) (point, ebBytesSize) =
+  txCache.lookupBody ebHash >>= \case
+    Just{} -> pure () -- we already hold this EB's body; nothing to fetch
+    Nothing -> do
+      changed <- MVar.modifyMVar outstandingVar (pure . upd)
+      when changed $ void $ MVar.tryPutMVar readyVar ()
  where
   MkLeiosPoint _ebSlot ebHash = point
 

From 02c8285c1561376f125378a9c6f0189b8044c699 Mon Sep 17 00:00:00 2001
From: Nicolas Frisby <nicolas.frisby@moduscreate.com>
Date: Mon, 10 Aug 2026 13:52:21 -0400
Subject: [PATCH 02/49] LeiosTxCache: best-effort prevention of spurious
 inserts into missingEbTxs

If we already have the tx _and it's still marked as `TxAlreadyInserted` in the
LeiosTxCache_, don't add it to `missingEbTxs`.
---
 .../src/ouroboros-consensus/LeiosDemoLogic.hs | 43 +++++++++++--------
 1 file changed, 24 insertions(+), 19 deletions(-)

diff --git a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
index 4b16657030..e709788b62 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
@@ -753,7 +753,10 @@ msgLeiosBlock ktracer tracer (outstandingVar, readyVar) txCache db peerId req eb
   -- ingest it
   MVar.modifyMVar_ outstandingVar $ \outstanding -> do
     let novel = not $ Set.member ebHash (Leios.acquiredEbBodies outstanding)
-    when novel $ do
+    -- When novel, persist the EB (LeiosDb before cache) and classify its txs
+    -- against the cache: 'insertBody' has run, so a cache hit is a tx already in
+    -- the LeiosDb pinned by this EB -- enqueue only the misses ('Nothing').
+    mbMisses <- if not novel then pure Nothing else 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
@@ -768,6 +771,18 @@ msgLeiosBlock ktracer tracer (outstandingVar, readyVar) txCache db peerId req eb
         forM_ mSummary $ traceWith ktracer . TraceLeiosTxCacheEbBody point
         traceWith ktracer $ TraceLeiosBlockAcquired point
         forM_ completedByBody $ traceWith ktracer . TraceLeiosBlockTxsAcquired
+      let MkLeiosEb v = eb
+      misses <- 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 (Just misses)
     -- update NodeKernel state
     --
     -- 'refundEbRequest' reverses this peer's per-request accounting (but skips
@@ -776,34 +791,24 @@ msgLeiosBlock ktracer tracer (outstandingVar, readyVar) txCache db peerId req eb
     -- receive the EB.
     let !outstanding' =
           refundEbRequest peerId ebHash ebBytesSize $
-            if novel
-              then
+            case mbMisses of
+              Nothing -> outstanding
+              Just misses ->
                 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)
+                      Map.insert point (IntMap.size misses) (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)
+                      Map.insert point misses (Leios.missingEbTxs outstanding)
                   , Leios.reverseEbIndexByTx =
-                      V.ifoldl
-                        ( \acc i (txHash, txBytesSize) ->
+                      IntMap.foldrWithKey
+                        ( \i (txHash, txBytesSize) acc ->
                             Map.insertWith Map.union txHash (Map.singleton ebHash (i, txBytesSize)) acc
                         )
                         (Leios.reverseEbIndexByTx outstanding)
-                        (let MkLeiosEb v = eb in v)
+                        misses
                   }
-              else outstanding
     pure outstanding'
   void $ MVar.tryPutMVar readyVar ()
   traceWith tracer $ MkTraceLeiosPeer $ "[done] MsgLeiosBlock " <> Leios.prettyLeiosPoint point

From 21872ebc623b0aff440d8beb1176d273b9d7b3c7 Mon Sep 17 00:00:00 2001
From: Nicolas Frisby <nicolas.frisby@moduscreate.com>
Date: Mon, 10 Aug 2026 13:55:00 -0400
Subject: [PATCH 03/49] LeiosTxCache: remove stale warning comment

---
 ouroboros-consensus/src/ouroboros-consensus/LeiosTxCache.hs | 3 ---
 1 file changed, 3 deletions(-)

diff --git a/ouroboros-consensus/src/ouroboros-consensus/LeiosTxCache.hs b/ouroboros-consensus/src/ouroboros-consensus/LeiosTxCache.hs
index 26ccc2623d..36a0528c83 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/LeiosTxCache.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosTxCache.hs
@@ -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

From ebaeb5a641db57fc437af3b01eacaa8fd93f42e4 Mon Sep 17 00:00:00 2001
From: Nicolas Frisby <nicolas.frisby@moduscreate.com>
Date: Mon, 10 Aug 2026 17:00:23 -0400
Subject: [PATCH 04/49] NodeKernel.Forge: improve formal parameter name

---
 .../Ouroboros/Consensus/NodeKernel/Forge.hs        | 14 +++++++-------
 1 file changed, 7 insertions(+), 7 deletions(-)

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..2d884d195c 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
@@ -110,7 +110,7 @@ forge ::
   (Header blk -> 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 leiosTxCache afterForgeBeforeInsert currentSlot = do
   let trace :: TraceForgeEvent blk -> WithEarlyExit m ()
       trace =
         lift
@@ -269,13 +269,13 @@ forge forgeEventTracer forgeStateInfoTracer leiosTracer forgeCCtx cfg chainDB me
 
   -- 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)
+  lift $ afterForgeBeforeInsert (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.
+  -- Persist the forged EB, but only /after/ 'afterForgeBeforeInsert' 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

From d4144679e42bb3f2cecaed47742fb2a4141547ed Mon Sep 17 00:00:00 2001
From: Nicolas Frisby <nicolas.frisby@moduscreate.com>
Date: Mon, 10 Aug 2026 17:18:51 -0400
Subject: [PATCH 05/49] LeiosFetch: remove filterMissingWork and
 acquiredEbBodies
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

The LeiosTxCache supplants the need for this functions. The corresponding checks
now has a (tunable) false miss rate, but it also now has in-memory latency
instead of requiring trips to the SQLite backing store.

Prior to this commit, the protototype's LeiosFetch decision loop reconciled its
outstanding set against the on-disk LeiosDb once per iteration (the function was
named `filterMissingWork`) — a synchronous by-hash membership probe sitting
directly on the path from "a peer offers an EB body/closure" to "we issue the
fetch request(s)." The `leios-txcache-bench` microbenchmark quantifies that
probe: for just a single (full) EB's transactions, the SQLite lookup runs about
10× slower than the in-memory index when its pages are warm and about 190×
slower when they're cold — hundreds of milliseconds versus on the order of a
millisecond.  Because that probe sat on the decision path, its execution time
was added to per-hop fetch latency on every hop of an EB body/closure: a steady
latency tax in the warm case, and — if an adversary can force the page cache
cold, which we cannot prove they cannot — a hundreds-of-milliseconds latency
spike in the cold case (multiple by the number of (full) in-flight EBs in whole
outstanding set).

This patch replaces the probe with the in-memory LeiosTxCache, so the decision
consults an always-ready in-memory index (about a millisecond, independent of DB
size and page-cache state) instead of waiting on the database. That shaving of
per-hop latency directly benefits Leios diffusion, which the security argument
depends on — and because the DB probe was the one per-iteration cost that could
spike ~unboundedly with DB size and cache state, removing it is a necessary step
toward running the fetch loop more often than its current meager 2 Hz.
---
 .../Ouroboros/Consensus/Network/NodeToNode.hs |  1 -
 .../Ouroboros/Consensus/NodeKernel.hs         |  9 +-
 .../bench/leios-db-bench/Main.hs              | 31 +------
 .../ouroboros-consensus/LeiosDemoDb/Common.hs |  4 -
 .../LeiosDemoDb/InMemory.hs                   | 13 ---
 .../ouroboros-consensus/LeiosDemoDb/SQLite.hs | 44 ++--------
 .../src/ouroboros-consensus/LeiosDemoLogic.hs | 78 +++---------------
 .../src/ouroboros-consensus/LeiosDemoTypes.hs | 29 ++-----
 .../src/ouroboros-consensus/LeiosTxCache.hs   |  9 +-
 .../test/consensus-test/Test/LeiosDemoDb.hs   | 82 -------------------
 10 files changed, 36 insertions(+), 264 deletions(-)

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 690324f96f..6016f9e96c 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
@@ -567,7 +567,6 @@ mkHandlers
                           Just{} -> outstanding -- we already hold this EB's body
                           Nothing ->
                             if ebBytesSize == 0
-                              || Set.member ebHash (Leios.acquiredEbBodies outstanding)
                               || any
                                 ((== ebHash) . pointEbHash)
                                 (Map.keys (Leios.missingEbBodies outstanding))
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..f340c56310 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
@@ -474,8 +474,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"
@@ -493,13 +492,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 "
@@ -513,7 +510,7 @@ initNodeKernel
                     Leios.demoLeiosFetchStaticEnv
                     mbCurrentSlot
                     (Map.restrictKeys offerings (Map.keysSet stillLivePeers))
-                    filteredOutstanding
+                    outstanding
             pure (outstanding', decisions)
           traceWith leiosTr $ MkTraceLeiosKernel "leiosFetchLogic: decided"
           let newRequests =
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/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 e709788b62..392ab3b857 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
@@ -35,6 +35,7 @@ import qualified Data.IntSet as IntSet
 import Data.List (unfoldr)
 import Data.Map (Map)
 import qualified Data.Map.Strict as Map
+import Data.Maybe (isNothing)
 import Data.Proxy (Proxy (..))
 import Data.Sequence (Seq)
 import qualified Data.Sequence as Seq
@@ -47,8 +48,6 @@ import Data.Word (Word16, Word64)
 import LeiosDemoDb
   ( LeiosDbConnection
   , leiosDbBatchRetrieveTxs
-  , leiosDbFilterMissingEbBodies
-  , leiosDbFilterMissingTxs
   , leiosDbInsertEbBody
   , leiosDbInsertEbPoint
   , leiosDbInsertTxs
@@ -317,54 +316,6 @@ newtype LeiosFetchDecisions pid
 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.
---
--- 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
-      }
-
 leiosFetchLogicIteration ::
   forall pid.
   Ord pid =>
@@ -752,10 +703,11 @@ msgLeiosBlock ktracer tracer (outstandingVar, readyVar) txCache db peerId req eb
       error $ "MsgLeiosBlock hash mismatch: " <> show (ebHash', ebHash)
   -- ingest it
   MVar.modifyMVar_ outstandingVar $ \outstanding -> do
-    let novel = not $ Set.member ebHash (Leios.acquiredEbBodies outstanding)
-    -- When novel, persist the EB (LeiosDb before cache) and classify its txs
-    -- against the cache: 'insertBody' has run, so a cache hit is a tx already in
-    -- the LeiosDb pinned by this EB -- enqueue only the misses ('Nothing').
+    -- Persist the EB (LeiosDb before cache) and classify its txs against the
+    -- cache, unless we already hold this EB's body (a 'lookupBody' hit). Since
+    -- 'insertBody' has run, a tx cache hit means that tx is already in the
+    -- LeiosDb pinned by this EB -- enqueue only the misses ('Nothing').
+    novel <- isNothing <$> txCache.lookupBody ebHash
     mbMisses <- if not novel then pure Nothing else do
       -- TODO don't hold the outstanding mvar during this IO
       traceException tracer TraceLeiosPeerDbException $ do
@@ -795,8 +747,7 @@ msgLeiosBlock ktracer tracer (outstandingVar, readyVar) txCache db peerId req eb
               Nothing -> outstanding
               Just misses ->
                 outstanding
-                  { Leios.acquiredEbBodies = Set.insert ebHash (Leios.acquiredEbBodies outstanding)
-                  , Leios.missingEbBodies = Map.delete point (Leios.missingEbBodies outstanding)
+                  { Leios.missingEbBodies = Map.delete point (Leios.missingEbBodies outstanding)
                   , Leios.blockingPerEb =
                       Map.insert point (IntMap.size misses) (Leios.blockingPerEb outstanding)
                   , Leios.missingEbTxs =
@@ -1031,13 +982,11 @@ leiosCertRbOffer txCache (outstandingVar, readyVar) peerVars (point, ebBytesSize
     pure $
       case mBody of
         Just{} -> outstanding
-        Nothing
-          | Set.member ebHash (Leios.acquiredEbBodies outstanding) -> outstanding
-          | otherwise ->
-              outstanding
-                { Leios.missingEbBodies =
-                    Map.insert point ebBytesSize (Leios.missingEbBodies outstanding)
-                }
+        Nothing ->
+          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
@@ -1256,8 +1205,7 @@ recordAnnouncedEb txCache (outstandingVar, readyVar) (point, ebBytesSize) =
   MkLeiosPoint _ebSlot ebHash = point
 
   upd outstanding =
-    if Set.member ebHash (Leios.acquiredEbBodies outstanding)
-      || any ((== ebHash) . pointEbHash) (Map.keys (Leios.missingEbBodies outstanding))
+    if any ((== ebHash) . pointEbHash) (Map.keys (Leios.missingEbBodies outstanding))
       then (outstanding, False)
       else
         flip (,) True $
diff --git a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs
index d7084b681b..cfbd078865 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs
@@ -383,24 +383,14 @@ 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
+-- 1. 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
+-- 2. 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)
+    missingEbBodies :: !(Map LeiosPoint BytesSize)
   -- ^ EB bodies still needed to be fetched (indexed by point and size)
   -- Request tracking
   , requestedEbPeers :: !(Map EbHash (Set (PeerId pid)))
@@ -442,8 +432,8 @@ data LeiosOutstanding pid = MkLeiosOutstanding
   --
   -- 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
+  -- a tx that also belongs to another EB B can reach the DB via a fetch
+  -- attributed to a different EB, so B never fetches it itself -- and 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
@@ -455,8 +445,7 @@ data LeiosOutstanding pid = MkLeiosOutstanding
 emptyLeiosOutstanding :: LeiosOutstanding pid
 emptyLeiosOutstanding =
   MkLeiosOutstanding
-    { acquiredEbBodies = Set.empty
-    , missingEbBodies = Map.empty
+    { missingEbBodies = Map.empty
     , requestedEbPeers = Map.empty
     , requestedTxPeers = Map.empty
     , requestedBytesSizePerPeer = Map.empty
@@ -492,8 +481,7 @@ prettyLeiosOutstanding :: LeiosOutstanding pid -> String
 prettyLeiosOutstanding x =
   unlines $
     map ("    [leios] " ++) $
-      [ "acquiredEbBodies = " ++ show (Set.size acquiredEbBodies)
-      , "missingEbBodies = " ++ show (Map.size missingEbBodies)
+      [ "missingEbBodies = " ++ show (Map.size missingEbBodies)
       , "requestedEbPeers = " ++ unwords (map prettyEbHash (Map.keys requestedEbPeers))
       , "requestedTxPeers = " ++ unwords (map prettyTxHash (Map.keys requestedTxPeers))
       , "requestedBytesSizePerPeer = " ++ show (Map.elems requestedBytesSizePerPeer)
@@ -506,8 +494,7 @@ prettyLeiosOutstanding x =
       ]
  where
   MkLeiosOutstanding
-    { acquiredEbBodies
-    , missingEbBodies
+    { missingEbBodies
     , requestedEbPeers
     , requestedTxPeers
     , requestedBytesSizePerPeer
diff --git a/ouroboros-consensus/src/ouroboros-consensus/LeiosTxCache.hs b/ouroboros-consensus/src/ouroboros-consensus/LeiosTxCache.hs
index 36a0528c83..b2cf53a3ce 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/LeiosTxCache.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosTxCache.hs
@@ -8,11 +8,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
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.

From 85b43318f154e8f9f4b9bb728876a0e35bd9762d Mon Sep 17 00:00:00 2001
From: Nicolas Frisby <nicolas.frisby@moduscreate.com>
Date: Mon, 10 Aug 2026 18:03:23 -0400
Subject: [PATCH 06/49] LeiosTxCache: fuse lookupTx into insertBody

The msgLeiosBlock handler always looks up the txs immediately after inserting
the body, so fuse those lookups with the body's ref count bumping pass (when
it's not a no-op).
---
 .../LeiosTxCache/Bench/SQLite.hs              |  6 +-
 .../bench/leios-txcache-bench/Main.hs         |  8 ++-
 .../src/ouroboros-consensus/LeiosDemoLogic.hs | 58 ++++++++++++-------
 .../src/ouroboros-consensus/LeiosTxCache.hs   |  6 +-
 .../ouroboros-consensus/LeiosTxCache/API.hs   | 28 +++++++--
 .../LeiosTxCache/Optimized.hs                 | 21 ++++---
 .../LeiosTxCache/Reference.hs                 | 38 +++++++-----
 .../Test/LeiosTxCache/Optimized.hs            |  7 ++-
 .../Test/LeiosTxCache/Reference.hs            |  9 ++-
 9 files changed, 116 insertions(+), 65 deletions(-)

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..8c338a3dfc 100644
--- a/ouroboros-consensus/bench/leios-txcache-bench/LeiosTxCache/Bench/SQLite.hs
+++ b/ouroboros-consensus/bench/leios-txcache-bench/LeiosTxCache/Bench/SQLite.hs
@@ -121,7 +121,7 @@ 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 ()
           , withLockedInsertAppliedTx = \k -> do _ <- k () (\w _txh _ -> pure w); pure ()
@@ -161,9 +161,9 @@ 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
diff --git a/ouroboros-consensus/bench/leios-txcache-bench/Main.hs b/ouroboros-consensus/bench/leios-txcache-bench/Main.hs
index 6553d732d7..2c9544c2c9 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,7 +278,7 @@ 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
   allocAfter <- bytesAllocated
diff --git a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
index 392ab3b857..0a78820b34 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
@@ -173,8 +173,12 @@ 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) () (\() _ _ _ -> ())
+  forM_ mbSummary $ traceWith tracer . TraceLeiosTxCacheEbBody point
   withLockedInsertAppliedTx txCache $ \w0 step ->
     foldM (\w (txh, _sz) -> step w txh ()) w0 (leiosEbTxs eb)
  where
@@ -703,14 +707,13 @@ msgLeiosBlock ktracer tracer (outstandingVar, readyVar) txCache db peerId req eb
       error $ "MsgLeiosBlock hash mismatch: " <> show (ebHash', ebHash)
   -- ingest it
   MVar.modifyMVar_ outstandingVar $ \outstanding -> do
-    -- Persist the EB (LeiosDb before cache) and classify its txs against the
-    -- cache, unless we already hold this EB's body (a 'lookupBody' hit). Since
-    -- 'insertBody' has run, a tx cache hit means that tx is already in the
-    -- LeiosDb pinned by this EB -- enqueue only the misses ('Nothing').
+    -- Skip if we already hold this EB's body (a 'lookupBody' hit); otherwise
+    -- persist it (LeiosDb before cache) and enqueue only the txs we still need to
+    -- fetch (the misses).
     novel <- isNothing <$> txCache.lookupBody ebHash
     mbMisses <- if not novel then pure Nothing else do
       -- TODO don't hold the outstanding mvar during this IO
-      traceException tracer TraceLeiosPeerDbException $ do
+      mbMisses <- 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
@@ -719,22 +722,35 @@ msgLeiosBlock ktracer tracer (outstandingVar, readyVar) txCache db peerId req eb
         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
+        mbSummaryMisses <-
+          insertBody
+            txCache
+            ebHash
+            (Leios.serializeEbBody eb)
+            IntMap.empty
+            (\acc i missingTxh sz -> IntMap.insert i (missingTxh, sz) acc)
+        forM_ mbSummaryMisses $ traceWith ktracer . TraceLeiosTxCacheEbBody point . fst
         traceWith ktracer $ TraceLeiosBlockAcquired point
         forM_ completedByBody $ traceWith ktracer . TraceLeiosBlockTxsAcquired
-      let MkLeiosEb v = eb
-      misses <- 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 (Just misses)
+        pure $ fmap snd mbSummaryMisses
+      case mbMisses of
+        Just misses -> pure (Just misses)
+        Nothing -> do
+          -- Backstop: body whose announcement is not in the LeiosTxCache (and
+          -- so its insert into the cache was a no-op). Classify its txs
+          -- directly.
+          let MkLeiosEb v = eb
+          misses <- 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 (Just misses)
     -- update NodeKernel state
     --
     -- 'refundEbRequest' reverses this peer's per-request accounting (but skips
diff --git a/ouroboros-consensus/src/ouroboros-consensus/LeiosTxCache.hs b/ouroboros-consensus/src/ouroboros-consensus/LeiosTxCache.hs
index b2cf53a3ce..027218fa84 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/LeiosTxCache.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosTxCache.hs
@@ -92,8 +92,8 @@ 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
@@ -117,7 +117,7 @@ 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)
     , withLockedInsertAppliedTx = \k -> k () (\w _txh _v -> pure w)
diff --git a/ouroboros-consensus/src/ouroboros-consensus/LeiosTxCache/API.hs b/ouroboros-consensus/src/ouroboros-consensus/LeiosTxCache/API.hs
index d4b25db625..96dd529c08 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/LeiosTxCache/API.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosTxCache/API.hs
@@ -29,7 +29,8 @@ import Data.Set (Set)
 import qualified Data.Vector.Strict as V
 import Data.Word (Word8)
 import LeiosDemoTypes
-  ( EbHash
+  ( BytesSize
+  , EbHash
   , InsertBodySummary (..)
   , RbHash
   , SerializedEbBody (..)
@@ -59,7 +60,20 @@ 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 (InsertBodySummary, 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
@@ -73,20 +87,22 @@ data LeiosTxCache m a v b = LeiosTxCache
   -- ^ Does not not hold 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
diff --git a/ouroboros-consensus/src/ouroboros-consensus/LeiosTxCache/Optimized.hs b/ouroboros-consensus/src/ouroboros-consensus/LeiosTxCache/Optimized.hs
index 961a7e15e0..9419b71255 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/LeiosTxCache/Optimized.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosTxCache/Optimized.hs
@@ -86,25 +86,28 @@ 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 (mkInsertBodySummary n tracked acquired validated cacheTxCount, w))
       , lookupBody = \ebh ->
           MVar.withMVar stateVar $ \st ->
             pure $ case Map.lookup ebh (hsBodies st) of
@@ -244,7 +247,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)
diff --git a/ouroboros-consensus/src/ouroboros-consensus/LeiosTxCache/Reference.hs b/ouroboros-consensus/src/ouroboros-consensus/LeiosTxCache/Reference.hs
index 7b1f881ded..d26ea16da3 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/LeiosTxCache/Reference.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosTxCache/Reference.hs
@@ -64,7 +64,7 @@ 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
@@ -290,7 +290,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 +314,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 (InsertBodySummary, 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,22 +332,25 @@ 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 (mkInsertBodySummary 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.
diff --git a/ouroboros-consensus/test/consensus-test/Test/LeiosTxCache/Optimized.hs b/ouroboros-consensus/test/consensus-test/Test/LeiosTxCache/Optimized.hs
index 2e1617fc92..65a1b87fc9 100644
--- a/ouroboros-consensus/test/consensus-test/Test/LeiosTxCache/Optimized.hs
+++ b/ouroboros-consensus/test/consensus-test/Test/LeiosTxCache/Optimized.hs
@@ -60,7 +60,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
@@ -86,7 +89,7 @@ applyOp :: H -> Op -> IO (Maybe (Set EbHash, Set TxHash))
 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
+  OpBody e ts -> insertBody h (ebhOf e) (TestBody (map txhOf ts)) () (\() _ _ _ -> ()) >> pure Nothing
   OpUnapplied ts ->
     withLockedInsertUnappliedTx h (\z step -> foldM (\acc t -> step acc (txhOf t) ()) z ts)
       >> pure Nothing
diff --git a/ouroboros-consensus/test/consensus-test/Test/LeiosTxCache/Reference.hs b/ouroboros-consensus/test/consensus-test/Test/LeiosTxCache/Reference.hs
index 53bbebb57d..c0401441b7 100644
--- a/ouroboros-consensus/test/consensus-test/Test/LeiosTxCache/Reference.hs
+++ b/ouroboros-consensus/test/consensus-test/Test/LeiosTxCache/Reference.hs
@@ -96,7 +96,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 +118,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
@@ -375,7 +378,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

From fe727a3e3e8665e51acc5bba68183d5d9de13209 Mon Sep 17 00:00:00 2001
From: Nicolas Frisby <nicolas.frisby@moduscreate.com>
Date: Mon, 10 Aug 2026 19:59:22 -0400
Subject: [PATCH 07/49] LeiosFetch: mitigate EbBodies with duplicate TxHashes

---
 .../src/ouroboros-consensus/LeiosDemoLogic.hs       | 13 +++++++++++--
 1 file changed, 11 insertions(+), 2 deletions(-)

diff --git a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
index 0a78820b34..c1caa11aa5 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
@@ -365,7 +365,7 @@ leiosFetchLogicIteration env mbCurrentSlot offerings =
           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!"
+            Nothing -> error "impossible! leiosFetchLogicIteration go1"
             Just x -> x
           peerIds :: Set (PeerId pid)
           peerIds = Map.findWithDefault Set.empty txHash (Leios.requestedTxPeers acc)
@@ -525,7 +525,7 @@ packRequests env =
         -- something simple and sufficient for the demo
         let (ebId, txOffset) =
               case Map.lookupMax txOffsets of
-                Nothing -> error "impossible!"
+                Nothing -> error "impossible! packRequests goPrioTx"
                 Just x -> x
         ]
 
@@ -705,6 +705,15 @@ msgLeiosBlock ktracer tracer (outstandingVar, readyVar) txCache db peerId req eb
     let ebHash' = hashLeiosEb eb
     when (ebHash' /= ebHash) $ do
       error $ "MsgLeiosBlock hash mismatch: " <> show (ebHash', ebHash)
+    -- Every referenced tx must be unique: 'reverseEbIndexByTx' records one
+    -- offset per (tx, EB), so a duplicate desyncs it from 'missingEbTxs'.
+    let MkLeiosEb v = eb
+        duplicateTxHashes =
+          Map.keys $
+            Map.filter (> (1 :: Int)) $
+              Map.fromListWith (+) [(txh, 1) | (txh, _) <- V.toList v]
+    when (not (null duplicateTxHashes)) $ do
+      error $ "MsgLeiosBlock duplicate tx hashes: " <> show duplicateTxHashes
   -- ingest it
   MVar.modifyMVar_ outstandingVar $ \outstanding -> do
     -- Skip if we already hold this EB's body (a 'lookupBody' hit); otherwise

From 088b800fbfdf3b54ae18ab0c6e12d87043a27e0f Mon Sep 17 00:00:00 2001
From: Nicolas Frisby <nicolas.frisby@moduscreate.com>
Date: Tue, 11 Aug 2026 10:30:12 -0400
Subject: [PATCH 08/49] LeiosFetch: TODOs for prioritization gap due to
 LeiosTxCache lookupBody guards

---
 .../Ouroboros/Consensus/Network/NodeToNode.hs   | 10 ++++++++--
 .../src/ouroboros-consensus/LeiosDemoLogic.hs   | 17 +++++++++++++++--
 2 files changed, 23 insertions(+), 4 deletions(-)

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 6016f9e96c..ba7473a112 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
@@ -560,10 +560,16 @@ mkHandlers
                     -- 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.
-                    mBody <- lookupBody getLeiosTxCache ebHash
+                    mbBody <- lookupBody getLeiosTxCache ebHash
                     MVar.modifyMVar_ getLeiosOutstanding $ \outstanding ->
                       pure $
-                        case mBody of
+                        case mbBody of
+                          -- TODO this prevents a greater-slotted offer for the
+                          -- same EbHash from increasing the effective priority
+                          --
+                          -- That's acceptable, since it's the announcement
+                          -- handler that should be setting priority, not the
+                          -- offer handler.
                           Just{} -> outstanding -- we already hold this EB's body
                           Nothing ->
                             if ebBytesSize == 0
diff --git a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
index c1caa11aa5..4ad5ed47d8 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
@@ -1002,10 +1002,12 @@ leiosCertRbOffer txCache (outstandingVar, readyVar) peerVars (point, ebBytesSize
   let MkLeiosPoint _ebSlot ebHash = point
   -- As if 'MsgLeiosBlockOffer': record the EB body as missing, unless we already
   -- hold it.
-  mBody <- txCache.lookupBody ebHash
+  mbBody <- txCache.lookupBody ebHash
   MVar.modifyMVar_ outstandingVar $ \outstanding ->
     pure $
-      case mBody of
+      case mbBody of
+        -- TODO this is the same concern as in the MsgLeiosBlockOffer handler
+        -- about ignoring a greater slot
         Just{} -> outstanding
         Nothing ->
           outstanding
@@ -1222,6 +1224,17 @@ recordAnnouncedEb ::
   m ()
 recordAnnouncedEb txCache (outstandingVar, readyVar) (point, ebBytesSize) =
   txCache.lookupBody ebHash >>= \case
+    -- TODO once LeiosFetch is announcement-sensitive: a fresher announcement for
+    -- an EB we already hold should still raise its freshest-first priority, which
+    -- this branch drops.
+    --
+    -- Note that that priority applies to the diffusion of this EB's closure
+    -- too.
+    --
+    -- We're accepting that infelicity for now; the imminent LeiosFetch rewrite
+    -- will address this. But this handler will be what takes care of it:
+    -- updating an EB closure's priority is the reponsibility of the
+    -- announcement handler.
     Just{} -> pure () -- we already hold this EB's body; nothing to fetch
     Nothing -> do
       changed <- MVar.modifyMVar outstandingVar (pure . upd)

From ab8a4e1c4282e00a43dbbb3a024a342b7c594691 Mon Sep 17 00:00:00 2001
From: Nicolas Frisby <nicolas.frisby@moduscreate.com>
Date: Tue, 11 Aug 2026 10:30:51 -0400
Subject: [PATCH 09/49] LeiosFetch: add regression tests for bug masked by
 filterMissingWork

---
 ouroboros-consensus.cabal                     |   1 +
 .../test/consensus-test/Main.hs               |   2 +
 .../Test/LeiosDemoLogic/Invariants.hs         | 336 ++++++++++++++++++
 3 files changed, 339 insertions(+)
 create mode 100644 ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic/Invariants.hs

diff --git a/ouroboros-consensus.cabal b/ouroboros-consensus.cabal
index 335045fc7f..51c5d07e88 100644
--- a/ouroboros-consensus.cabal
+++ b/ouroboros-consensus.cabal
@@ -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
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/LeiosDemoLogic/Invariants.hs b/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic/Invariants.hs
new file mode 100644
index 0000000000..28fc485f30
--- /dev/null
+++ b/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic/Invariants.hs
@@ -0,0 +1,336 @@
+{-# 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 ('msgLeiosBlock', 'msgLeiosBlockTxs',
+-- '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. This test suite initially exists as a specific regression tests: every
+-- tx tracked in 'Leios.missingEbTxs' must still be resolvable in
+-- 'Leios.reverseEbIndexByTx' (same keying 'leiosFetchLogicIteration' relies
+-- on). We check it structurally after each command, and — belt and suspenders —
+-- force a 'Decide' through the real fetch logic so a stray @impossible!@
+-- surfaces even if the structural check missed a shape.
+--
+-- NOTE. Offers are deliberately not a command, for now. A 'MsgLeiosBlockOffer'
+-- does two things: record the EB as missing (covered here by 'Announce') and
+-- populate the per-peer offerings map. It's simply not required for the current
+-- scope of these tests.
+module Test.LeiosDemoLogic.Invariants (tests) where
+
+import Control.Concurrent.Class.MonadMVar
+  ( MVar
+  , modifyMVar_
+  , newEmptyMVar
+  , newMVar
+  , readMVar
+  )
+import Control.Monad.Class.MonadThrow (SomeException, try)
+import Control.Monad.IOSim (IOSim, runSimOrThrow)
+import Control.Tracer (nullTracer)
+import qualified Data.Bits as Bits
+import qualified Data.ByteString as BS
+import qualified Data.DList as DList
+import qualified Data.IntMap.Strict as IntMap
+import qualified Data.Map.Strict as Map
+import qualified Data.Set as Set
+import qualified Data.Vector.Strict as V
+import Data.Word (Word16, Word64)
+import LeiosDemoDb (withLeiosDb)
+import qualified LeiosDemoDb as LeiosDb
+import LeiosDemoLogic
+  ( LeiosFetchDecisions (..)
+  , leiosFetchLogicIteration
+  , msgLeiosBlock
+  , msgLeiosBlockTxs
+  , recordAnnouncedEb
+  )
+import LeiosDemoTypes
+  ( BytesSize
+  , EbHash
+  , LeiosBlockRequest (..)
+  , LeiosBlockTxsRequest (..)
+  , LeiosEb (..)
+  , LeiosOutstanding (..)
+  , LeiosPoint (..)
+  , LeiosTx (..)
+  , PeerId (..)
+  , TxHash
+  , demoLeiosFetchStaticEnv
+  , emptyLeiosOutstanding
+  , hashLeiosEb
+  , hashLeiosTx
+  , leiosEbBytesSize
+  )
+import qualified LeiosDemoTypes as Leios
+import LeiosTxCache (LeiosTxCache, nullLeiosTxCache)
+import Ouroboros.Consensus.Util.IOLike (evaluate)
+import Test.QuickCheck
+import Test.Tasty (TestTree, testGroup)
+import Test.Tasty.HUnit (assertBool, assertFailure, testCase, (@?=))
+import Test.Tasty.QuickCheck (testProperty)
+import Test.Util.Orphans.IOLike ()
+
+tests :: TestTree
+tests =
+  testGroup
+    "LeiosDemoLogic.Invariants"
+    [ testGroup
+        "curated sequences"
+        [ testCase "same EB hash at two slots: delivery clears both" $
+            runCmds reproMultiSlot @?= Right ()
+        , testCase "tx shared across two EBs: delivery discharges both" $
+            case runCmds' reproSharedTx of
+              Left msg -> assertFailure msg
+              Right o ->
+                assertBool
+                  "shared tx still tracked as missing after delivery"
+                  (not (txStillMissing (txHashOf 1) o))
+        ]
+    , testProperty
+        "missingEbTxs stays in sync with reverseEbIndexByTx across arbitrary sequences"
+        prop_invariants
+    ]
+
+------------------------------------------------------------
+-- 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/offer this EB at this slot.
+    Announce TestEb Word
+  | -- | @msgLeiosBlock@: the EB body arrives for that point.
+    ArriveBody TestEb Word
+  | -- | @msgLeiosBlockTxs@: deliver the tx at this /index within the EB/.
+    ArriveTx TestEb Word Int
+  | -- | @leiosFetchLogicIteration@ at this current slot.
+    Decide 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
+
+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 sync invariant after each command. 'Left' names the first failing
+-- command; 'Right' returns the final outstanding state (for extra assertions).
+runCmds' :: [Cmd] -> Either String (LeiosOutstanding Int)
+runCmds' cmds = runSimOrThrow (go cmds)
+ where
+  go :: forall s. [Cmd] -> IOSim s (Either String (LeiosOutstanding Int))
+  go cs0 = do
+    dbHandle <- LeiosDb.newLeiosDBInMemory
+    withLeiosDb dbHandle $ \conn -> do
+      outstandingVar <- newMVar emptyLeiosOutstanding
+      readyVar <- newEmptyMVar
+      let kv = (outstandingVar, readyVar)
+          txCache = nullLeiosTxCache
+          peerId = MkPeerId (0 :: Int)
+          loop [] = Right <$> readMVar outstandingVar
+          loop (c : cs) = do
+            r <-
+              try (applyCmd conn txCache kv peerId c)
+                :: IOSim s (Either SomeException ())
+            case r of
+              Left e -> pure (Left ("exception on " <> show c <> ": " <> show e))
+              Right () -> do
+                outstanding <- readMVar outstandingVar
+                case checkInvariant outstanding of
+                  Left msg -> pure (Left (msg <> " (after " <> show c <> ")"))
+                  Right () -> loop cs
+      loop cs0
+
+-- | As 'runCmds'', but discarding the final state.
+runCmds :: [Cmd] -> Either String ()
+runCmds = fmap (const ()) . runCmds'
+
+applyCmd ::
+  forall s.
+  LeiosDb.LeiosDbConnection (IOSim s) ->
+  LeiosTxCache (IOSim s) () () Leios.SerializedEbBody ->
+  (MVar (IOSim s) (LeiosOutstanding Int), MVar (IOSim s) ()) ->
+  PeerId Int ->
+  Cmd ->
+  IOSim s ()
+applyCmd conn txCache kv peerId = \case
+  Announce ids slot ->
+    recordAnnouncedEb txCache kv (pointOf ids slot, leiosEbBytesSize (ebOf ids))
+  ArriveBody ids slot -> do
+    let eb = ebOf ids
+        req = MkLeiosBlockRequest (pointOf ids slot) (leiosEbBytesSize eb)
+    msgLeiosBlock nullTracer nullTracer kv txCache conn peerId req eb
+  ArriveTx ids slot idx -> do
+    let txId = ids !! idx
+        req =
+          MkLeiosBlockTxsRequest
+            (pointOf ids slot)
+            (offsetsToBitmaps [idx])
+            (V.singleton (txHashOf txId))
+    msgLeiosBlockTxs nullTracer nullTracer kv txCache conn peerId req (V.singleton (leiosTxOf txId))
+  Decide slot -> do
+    outstanding <- readMVar (fst kv)
+    let ebs = referencedEbs outstanding
+        offerings = Map.singleton peerId (ebs, ebs)
+        (out', decs) =
+          leiosFetchLogicIteration demoLeiosFetchStaticEnv (Just (fromIntegral slot)) offerings 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')
+
+-- | Every EbHash currently referenced by the outstanding state (bodies + txs),
+-- as an all-offering peer's body\/closure sets.
+referencedEbs :: LeiosOutstanding Int -> Set.Set EbHash
+referencedEbs o =
+  Set.fromList $
+    map (.pointEbHash) (Map.keys (Leios.missingEbBodies o))
+      <> map (.pointEbHash) (Map.keys (Leios.missingEbTxs o))
+
+-- | Force the decision structure, including each tx request's resolved offset
+-- (the @goTx2@ lookup), to a scalar.
+forceDecisions :: LeiosFetchDecisions pid -> Int
+forceDecisions (MkLeiosFetchDecisions m) =
+  sum
+    [ fromIntegral sz + sum (Map.elems ebOffsets)
+    | slotMap <- Map.elems m
+    , (txs, _ebs) <- Map.elems slotMap
+    , (_txHash, sz, ebOffsets) <- DList.toList txs
+    ]
+
+------------------------------------------------------------
+-- The invariant
+------------------------------------------------------------
+
+-- | Every tx tracked as missing must be resolvable in the reverse index at the
+-- exact (EbHash, slot, offset) 'go1'/'goTx2' will look it up by. Its violation
+-- is what @impossible! leiosFetchLogicIteration go1@ reports.
+checkInvariant :: LeiosOutstanding Int -> Either String ()
+checkInvariant o =
+  case
+    [ msg
+    | (p, txs) <- Map.toList (Leios.missingEbTxs o)
+    , (off, (txHash, _sz)) <- IntMap.toList txs
+    , Left msg <- [resolvable p off txHash]
+    ] of
+    [] -> Right ()
+    (msg : _) -> Left msg
+ where
+  rev = Leios.reverseEbIndexByTx o
+  resolvable p off txHash =
+    case Map.lookup txHash rev of
+      Nothing ->
+        Left ("missingEbTxs tx absent from reverseEbIndexByTx: " <> show (p.pointSlotNo, off))
+      Just ebm -> case Map.lookup (pointEbHash p) ebm of
+        Nothing -> Left ("reverseEbIndexByTx lacks this EB for a missing tx: " <> show p.pointSlotNo)
+        Just (off', _sz')
+          | off' == off -> Right ()
+          | otherwise -> Left ("reverseEbIndexByTx offset mismatch at " <> show p.pointSlotNo)
+
+-- | Is this tx still tracked as missing for any point? After a tx is delivered
+-- the deduping LeiosDb should discharge it for every EB that referenced it, so
+-- this is 'False' for a delivered tx.
+txStillMissing :: TxHash -> LeiosOutstanding Int -> Bool
+txStillMissing txHash o =
+  any (elem txHash . map fst . IntMap.elems) (Map.elems (Leios.missingEbTxs o))
+
+------------------------------------------------------------
+-- Curated repros
+------------------------------------------------------------
+
+-- | The same EB (hash) bodied at two slots; delivering its tx for one slot must
+-- clear it for the other too. Pre-fix, the second 'Decide' hits @impossible!@.
+reproMultiSlot :: [Cmd]
+reproMultiSlot =
+  [ ArriveBody [0] 10
+  , ArriveBody [0] 11
+  , Decide 11
+  , ArriveTx [0] 10 0
+  , Decide 11
+  ]
+
+-- | A tx shared by two distinct EBs; delivering it via one must discharge it
+-- for the other (the deduping-LeiosDb behaviour the fix relies on).
+reproSharedTx :: [Cmd]
+reproSharedTx =
+  [ ArriveBody [0, 1] 10
+  , ArriveBody [1, 2] 11
+  , Decide 12
+  , ArriveTx [0, 1] 10 1 -- deliver the shared tx (id 1)
+  , Decide 12
+  ]
+
+------------------------------------------------------------
+-- 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 (ArriveBody ids slot)
+    , ArriveTx ids slot <$> choose (0, length ids - 1)
+    , Decide <$> elements worldSlots
+    ]
+
+prop_invariants :: Property
+prop_invariants =
+  forAllShrink (listOf genCmd) (shrinkList (const [])) $ \cmds ->
+    runCmds cmds === Right ()
+
+offsetsToBitmaps :: [Int] -> [(Word16, Word64)]
+offsetsToBitmaps offs =
+  [ (fromIntegral q, bm)
+  | (q, bm) <-
+      IntMap.toAscList $
+        foldr
+          (\o -> let (q, r) = o `divMod` 64 in IntMap.insertWith (Bits..|.) q (Bits.bit (63 - r)))
+          IntMap.empty
+          offs
+  ]

From aef747f6882cfd4a7df63b7b1d718b442c8cad45 Mon Sep 17 00:00:00 2001
From: Nicolas Frisby <nicolas.frisby@moduscreate.com>
Date: Tue, 11 Aug 2026 06:11:26 -0400
Subject: [PATCH 10/49] LeiosFetch: only emit MsgLeiosBlockTxsRequest with a
 real LeiosPoint

`packedRequest` was the function that could violate it, but now the
`LeiosFetchDecisions` data type that carries the fetch decisions to
`packedRequest` no longer provides that degree of freedom: it's provides one
SlotNo-EbHash pair per tx, and a new test requires its real pair.

The LeiosFetch code was inherited from the exploratory burst demo in October
2025. One of the things that demo tried out was issuing requests for EBs where
the EbSlot accompanying the EbHash was not necessarily the slot of an
announcement of that hash, but instead the _potentially greater_ slot of a
_potentially different_ EB that shared that tx. In order to get a
higher-priority EB's tx, we could fetch it from a peer who hadn't even (yet)
offered that EB but had offered an EB that we know shares txs with it.

Subsequent LeiosFetch design ruled this optimization out; it's a DoS vector. If
the higher-priority EB is adversarial and withheld, then the victim might never
fetch the lower-priority honest EB's txs from its peers that would actually
serve them. If the peer had also offered the higher-priority EB, then the
request could simply list that hash instead.

Thus, it's not an actual loss to eliminate this optimization. This commit does
so because this complexity was muddling a bug hunt (next couple commits fix that
bug; `filterMissingWork` was masking it). When the reply arrives, the priority
was being interpreted as the EbHash's actual slot, which was arming the bug. As
of the bugfix, that wouldn't actually cause any problems anymore, but it's still
preferable to just remove the ultimately undesired feature's complexity.
---
 .../src/ouroboros-consensus/LeiosDemoLogic.hs | 52 ++++++++-----------
 .../consensus-test/Test/LeiosDemoLogic.hs     | 31 ++++++++++-
 .../Test/LeiosDemoLogic/Invariants.hs         |  4 +-
 3 files changed, 52 insertions(+), 35 deletions(-)

diff --git a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
index 4ad5ed47d8..5853edfadd 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
@@ -315,7 +315,7 @@ popLeftmostOffset = \case
 
 newtype LeiosFetchDecisions pid
   = MkLeiosFetchDecisions
-      (Map (PeerId pid) (Map SlotNo (DList (TxHash, BytesSize, Map EbHash Int), DList (EbHash, BytesSize))))
+      (Map (PeerId pid) (Map SlotNo (DList (TxHash, BytesSize, EbHash, Int), DList (EbHash, BytesSize))))
 
 emptyLeiosFetchDecisions :: LeiosFetchDecisions pid
 emptyLeiosFetchDecisions = MkLeiosFetchDecisions Map.empty
@@ -432,14 +432,18 @@ leiosFetchLogicIteration env mbCurrentSlot offerings =
     | 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' =
+    , Just peerId <- choosePeerTx peerIds acc point.pointEbHash =
+        -- there's a peer offering this EB's tx closure and we haven't already
+        -- requested it from them
+        let txOffset = case Map.lookup point.pointEbHash txOffsets of
+              Just (o, _) -> o
+              Nothing -> error "impossible! goTx2: target EB absent from its own reverse entry"
+            accNew' =
               MkLeiosFetchDecisions $
                 Map.insertWith
                   (Map.unionWith (<>))
                   peerId
-                  (Map.singleton point.pointSlotNo (DList.singleton (txHash, txBytesSize, txOffsets'), DList.empty))
+                  (Map.singleton point.pointSlotNo (DList.singleton (txHash, txBytesSize, point.pointEbHash, txOffset), DList.empty))
                   (let MkLeiosFetchDecisions x = accNew in x)
             acc' =
               acc
@@ -457,30 +461,19 @@ leiosFetchLogicIteration env mbCurrentSlot offerings =
   choosePeerTx ::
     Set (PeerId pid) ->
     LeiosOutstanding pid ->
-    Map EbHash (Int, BytesSize) ->
-    BytesSize ->
-    Maybe (PeerId pid, Map EbHash Int)
-  choosePeerTx peerIds acc txOffsets targetTxBytesSize =
+    EbHash ->
+    Maybe (PeerId pid)
+  choosePeerTx peerIds acc ebHash =
     foldr (\a _ -> Just a) Nothing $
-      [ (peerId, Map.map fst txOffsetsMatching)
-      | (peerId, (_ebIds, ebIds)) <-
+      [ peerId
+      | (peerId, (_bodies, closures)) <-
           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)
+      ebHash `Set.member` closures -- peer has offered this EB's tx closure
       ]
 
 packRequests ::
@@ -517,16 +510,13 @@ packRequests env =
             <> acc
       )
       Seq.empty
-      -- group by EbId, sort by offset ascending
+      -- group by EbHash, sort by offset ascending. 'prio' is the target point's
+      -- own slot and 'ebHash' its own EbHash (both filed by 'goTx2' from the same
+      -- point), so 'MkLeiosPoint prio ebHash' is a real point -- slot and hash
+      -- from the same EB.
       $ 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! packRequests goPrioTx"
-                Just x -> x
+      $ [ (ebHash, IntMap.singleton txOffset (txHash, txBytesSize))
+        | (txHash, txBytesSize, ebHash, txOffset) <- DList.toList txs
         ]
 
   goEb ::
diff --git a/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic.hs b/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic.hs
index d5dfe86c6e..0044b46fce 100644
--- a/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic.hs
+++ b/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic.hs
@@ -339,11 +339,38 @@ onOutstanding ::
 onOutstanding f sc = sc{scOutstanding = f (scOutstanding sc)}
 
 -- | Run the iteration and project the decisions.
+--
+-- Enforces a soundness invariant on the way out: every emitted tx decision must
+-- name a /real/ (slot, EB hash) for its tx -- one the scenario actually lists
+-- as missing that tx. A priority slot paired with an unrelated EB hash would be
+-- a \"Frankenstein\" point. The original Leios diffusion demo included that on
+-- purpose, but subsequent design has ruled that out, so this property bans it.
 runIteration :: Ord pid => Scenario pid -> LeiosFetchDecisions pid
 runIteration sc =
+  case unrealDecisions sc.scOutstanding decs of
+    [] -> decs
+    bad -> error $ "runIteration: decisions name a non-real (slot, EB, tx): " <> show bad
+ where
   -- 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
+  decs = snd $ leiosFetchLogicIteration sc.scEnv (Just minBound) sc.scOfferings sc.scOutstanding
+
+-- | Emitted tx decisions whose (slot, EB hash) the scenario does not list as
+-- missing that tx. 'runIteration' requires this to be empty.
+unrealDecisions ::
+  LeiosOutstanding pid -> LeiosFetchDecisions pid -> [(SlotNo, EbHash, TxHash)]
+unrealDecisions o (MkLeiosFetchDecisions m) =
+  [ (slot, ebHash, txHash)
+  | (_peer, slotMap) <- Map.toList m
+  , (slot, (txs, _bodies)) <- Map.toList slotMap
+  , (txHash, _sz, ebHash, _off) <- DList.toList txs
+  , txHash `notElem` txsMissingAt slot ebHash
+  ]
+ where
+  txsMissingAt slot ebHash =
+    map fst $
+      IntMap.elems $
+        Map.findWithDefault IntMap.empty (MkLeiosPoint slot ebHash) (missingEbTxs o)
 
 ------------------------------------------------------------
 -- Assertions
@@ -377,7 +404,7 @@ assertTxRequest pid p txHash (MkLeiosFetchDecisions m) =
     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
+        [(h, _size, _ebHash, _offset)] -> h @?= txHash
         xs -> assertFailure $ "expected one tx request, got " <> show (length xs)
 
 assertNoRequests :: (Ord pid, Show pid) => LeiosFetchDecisions pid -> IO ()
diff --git a/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic/Invariants.hs b/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic/Invariants.hs
index 28fc485f30..6901e99b68 100644
--- a/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic/Invariants.hs
+++ b/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic/Invariants.hs
@@ -230,10 +230,10 @@ referencedEbs o =
 forceDecisions :: LeiosFetchDecisions pid -> Int
 forceDecisions (MkLeiosFetchDecisions m) =
   sum
-    [ fromIntegral sz + sum (Map.elems ebOffsets)
+    [ offset + fromIntegral sz
     | slotMap <- Map.elems m
     , (txs, _ebs) <- Map.elems slotMap
-    , (_txHash, sz, ebOffsets) <- DList.toList txs
+    , (_txHash, sz, _ebHash, offset) <- DList.toList txs
     ]
 
 ------------------------------------------------------------

From f13afce92783a2c54ca37bfd9a57939cd5ec9d0b Mon Sep 17 00:00:00 2001
From: Nicolas Frisby <nicolas.frisby@moduscreate.com>
Date: Tue, 11 Aug 2026 08:41:42 -0400
Subject: [PATCH 11/49] LeiosFetch: bugfix, remove arrived tx from missingEbTxs
 _entirely_

Prior to this commit, the msgLeiosBlockTxs handler was only removing its arrived
tx hashs from `missingEbTxs` _for the slotNo_ carried by the
MsgLeiosBlockTxsRequest that incurred this reply. That has two consequences.

- First, it was causing a crash, since it resulted in `missingEbTxs` and
  `reverseEbIndexByTx` falling out of sync. (The tx was _completely_ deleted
  from `reverseEbIndexByTx`.)

- Second, the persistence in `missingEbTxs` would lead to additional
  requests. (Were it not for `filterMissingWork`, see below.)

But the Leios prototype's current LeiosDb and current LeiosFetch logic dedup EB
closures, so the arrival of a tx for one EB discharges it for all other EBs as
well. Additional requests for that tx shouldn't be redundantly sent on behalf of
those EBs.

If the LeiosDb didn't dedup EB closures, then this augmentation of the deletion
logic would still be correct, but something (eg the msgLeiosBlockTxs, the next
decision logic iteration, or etc) would need to _also_ store the arrived tx to
the closure of other EBs that reference it.

In the imminent LeiosFetch logic rewrite, we'll no longer be tracking the
overlap between EB closures, and this bugfix will be trampled. But until that
rewrite, this is a correct bugfix for the Leios prototype's current LeiosFetch
and its current LeiosDb.

Notes:

- This bug (both the crash and the redundant tx fetches) surfaced now because
  the recently removed `filterMissingWork` was masking it.
- For EB bodies, the LeiosFetch decisions are simple: they don't try to dedup.
  So, announcements of the same EB from multiple slots will arise in redundant
  fetches of the body. We consider that harmless for bodies.
    - Honest nodes will very rarely announce the same EB body, so this is not a
      worthwhile optimization---it's not part of the work-preservation argument.
    - An announcement is entirely free to pick which EB it announces, so this
      would be nothing more than an optimization, one the adversary could always
      trivially choose to avoid.
- In some sense, this commit supplants `95bff62b5c0ab0937dc03e964c9e24bc731b1399
  LeiosFetch: bugfix, only emit MsgLeiosBlockTxsRequest with a real LeiosPoint`,
  but in another sense, that other commit wasn't merely avoiding the crash.
---
 .../src/ouroboros-consensus/LeiosDemoLogic.hs | 69 ++++++++++++-------
 .../src/ouroboros-consensus/LeiosDemoTypes.hs |  7 +-
 .../consensus-test/Test/LeiosDemoLogic.hs     | 17 ++---
 .../Test/LeiosDemoLogic/Invariants.hs         | 38 +++-------
 4 files changed, 69 insertions(+), 62 deletions(-)

diff --git a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
index 5853edfadd..94285bb648 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
@@ -41,6 +41,8 @@ import Data.Sequence (Seq)
 import qualified Data.Sequence as Seq
 import Data.Set (Set)
 import qualified Data.Set as Set
+import Data.Set.NonEmpty (NESet)
+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
@@ -422,7 +424,7 @@ leiosFetchLogicIteration env mbCurrentSlot offerings =
     LeiosPoint ->
     BytesSize ->
     TxHash ->
-    Map EbHash (Int, BytesSize) ->
+    Map EbHash (NESet SlotNo, Int, BytesSize) ->
     Set (PeerId pid) ->
     (LeiosOutstanding pid, LeiosFetchDecisions pid)
   goTx2 !acc !accNew targets point txBytesSize txHash txOffsets peerIds
@@ -436,7 +438,7 @@ leiosFetchLogicIteration env mbCurrentSlot offerings =
         -- there's a peer offering this EB's tx closure and we haven't already
         -- requested it from them
         let txOffset = case Map.lookup point.pointEbHash txOffsets of
-              Just (o, _) -> o
+              Just (_slots, o, _) -> o
               Nothing -> error "impossible! goTx2: target EB absent from its own reverse entry"
             accNew' =
               MkLeiosFetchDecisions $
@@ -770,7 +772,11 @@ msgLeiosBlock ktracer tracer (outstandingVar, readyVar) txCache db peerId req eb
                   , Leios.reverseEbIndexByTx =
                       IntMap.foldrWithKey
                         ( \i (txHash, txBytesSize) acc ->
-                            Map.insertWith Map.union txHash (Map.singleton ebHash (i, txBytesSize)) acc
+                            Map.insertWith
+                              (Map.unionWith (\(s1, i1, z1) (s2, _, _) -> (s1 <> s2, i1, z1)))
+                              txHash
+                              (Map.singleton ebHash (NESet.singleton point.pointSlotNo, i, txBytesSize))
+                              acc
                         )
                         (Leios.reverseEbIndexByTx outstanding)
                         misses
@@ -886,8 +892,7 @@ msgLeiosBlockTxs ktracer tracer (outstandingVar, readyVar) txCache db peerId 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
+  let 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)
@@ -915,23 +920,41 @@ msgLeiosBlockTxs ktracer tracer (outstandingVar, readyVar) txCache db peerId req
       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
+    let removeTxFromMissing txHash mtxs =
+          case Map.lookup txHash (Leios.reverseEbIndexByTx outstanding) of
+            Nothing -> mtxs
+            Just ebsWithThisTx ->
+              Map.foldrWithKey
+                ( \ebHash (slotsWithThisEb, offset, _sz) acc ->
+                    foldr
+                      (\ebSlot ->
+                         Map.update
+                           (delIf IntMap.null . IntMap.delete offset)
+                           (MkLeiosPoint ebSlot ebHash)
+                      )
+                      acc
+                      slotsWithThisEb
                 )
-                (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
-              )
+                mtxs
+                ebsWithThisTx
+    let (requestedTxPeers', reverseEbIndexByTx', missingEbTxs', txsBytesSize) =
+          V.foldl'
+            ( \(!accReqs, !accRev, !accMtxs, !accSz) (txHash, txBytes) ->
+                ( Map.update (delIf Set.null . Set.delete peerId) txHash accReqs
+                , Map.delete txHash accRev   -- full delete from reverseEbIndexByTx
+                , removeTxFromMissing txHash accMtxs   -- full delete from missingEbTxs
+                , accSz + BS.length txBytes
+                )
+            )
+            ( Leios.requestedTxPeers outstanding
+            , Leios.reverseEbIndexByTx outstanding
+            , Leios.missingEbTxs outstanding
+            , 0
+            )
+            (txHashes `V.zip` txBytess)
     let offsetsSet = IntSet.fromList offsets
-        -- the requests that this MsgLeiosBlockTxs was the first to resolve
+        -- the requests this MsgLeiosBlockTxs was the first to resolve for this
+        -- point (kept only to keep the best-effort 'blockingPerEb' roughly current)
         beatOtherPeers =
           (`IntMap.restrictKeys` offsetsSet) $
             Map.findWithDefault IntMap.empty point (Leios.missingEbTxs outstanding)
@@ -942,11 +965,7 @@ msgLeiosBlockTxs ktracer tracer (outstandingVar, readyVar) txCache db peerId req
     let !outstanding' =
           refundTxRequest peerId requestedTxPeers' (fromIntegral txsBytesSize) $
             outstanding
-              { Leios.missingEbTxs =
-                  Map.update
-                    (delIf IntMap.null . (`IntMap.withoutKeys` offsetsSet))
-                    point
-                    (Leios.missingEbTxs outstanding)
+              { Leios.missingEbTxs = missingEbTxs'
               , Leios.reverseEbIndexByTx = reverseEbIndexByTx'
               , Leios.blockingPerEb =
                   if IntMap.null beatOtherPeers
diff --git a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs
index cfbd078865..7e9e81001f 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs
@@ -412,8 +412,11 @@ data LeiosOutstanding pid = MkLeiosOutstanding
   --   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
+  , reverseEbIndexByTx :: !(Map TxHash (Map EbHash (NESet SlotNo, Int, BytesSize)))
+  -- ^ Inverse of 'missingEbTxs': for each TX, the referencing EBs; per EB, its
+  -- offset+size (content, so stored once) and the 'NESet' of slots it was
+  -- announced at. On delivery a tx is removed entirely -- from here and from the
+  -- 'missingEbTxs' of every point that referenced it -- so the two stay in step.
   --
   -- TODO this is far too big for the heap
   , blockingPerEb :: !(Map LeiosPoint Int)
diff --git a/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic.hs b/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic.hs
index 0044b46fce..d351ce092d 100644
--- a/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic.hs
+++ b/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic.hs
@@ -26,6 +26,7 @@ import Data.Function ((&))
 import qualified Data.IntMap.Strict as IntMap
 import qualified Data.Map.Strict as Map
 import qualified Data.Set as Set
+import qualified Data.Set.NonEmpty as NESet
 import LeiosDemoLogic
   ( LeiosFetchDecisions (..)
   , leiosFetchLogicIteration
@@ -169,7 +170,7 @@ 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
+    & alsoReferencedInEb (tx 'x') (point 2 'b') 7 100 -- same recorded size in B
     & offersTxs peerA [eb 'a']
     & runIteration
     & assertTxRequest peerA (point 1 'a') (tx 'x')
@@ -189,7 +190,7 @@ test_txTwoEbsDifferentSize :: IO ()
 test_txTwoEbsDifferentSize =
   empty
     & withMissingTx (point 1 'a') 0 (tx 'x') 100
-    & alsoReferencedInEb (tx 'x') (eb 'b') 7 200 -- different recorded size
+    & alsoReferencedInEb (tx 'x') (point 2 'b') 7 200 -- different recorded size
     & offersTxs peerA [eb 'a', eb 'b']
     & runIteration
     & assertTxRequest peerA (point 1 'a') (tx 'x')
@@ -239,7 +240,7 @@ withMissingTx p offset h size =
           Map.insertWith
             Map.union
             h
-            (Map.singleton p.pointEbHash (offset, size))
+            (Map.singleton p.pointEbHash (NESet.singleton p.pointSlotNo, offset, size))
             (reverseEbIndexByTx o)
       }
 
@@ -267,21 +268,21 @@ alreadyRequestedTxFrom txHash 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'.
+-- | Tag a tx as also referenced by another EB point 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 =
+  TxHash -> LeiosPoint -> Int -> BytesSize -> Scenario pid -> Scenario pid
+alsoReferencedInEb txHash p offset size =
   onOutstanding $ \o ->
     o
       { reverseEbIndexByTx =
           Map.insertWith
             Map.union
             txHash
-            (Map.singleton ebHash (offset, size))
+            (Map.singleton p.pointEbHash (NESet.singleton p.pointSlotNo, offset, size))
             (reverseEbIndexByTx o)
       }
 
diff --git a/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic/Invariants.hs b/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic/Invariants.hs
index 6901e99b68..d4ad64c8fe 100644
--- a/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic/Invariants.hs
+++ b/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic/Invariants.hs
@@ -41,6 +41,7 @@ import qualified Data.DList as DList
 import qualified Data.IntMap.Strict as IntMap
 import qualified Data.Map.Strict as Map
 import qualified Data.Set as Set
+import qualified Data.Set.NonEmpty as NESet
 import qualified Data.Vector.Strict as V
 import Data.Word (Word16, Word64)
 import LeiosDemoDb (withLeiosDb)
@@ -74,7 +75,7 @@ import LeiosTxCache (LeiosTxCache, nullLeiosTxCache)
 import Ouroboros.Consensus.Util.IOLike (evaluate)
 import Test.QuickCheck
 import Test.Tasty (TestTree, testGroup)
-import Test.Tasty.HUnit (assertBool, assertFailure, testCase, (@?=))
+import Test.Tasty.HUnit (testCase, (@?=))
 import Test.Tasty.QuickCheck (testProperty)
 import Test.Util.Orphans.IOLike ()
 
@@ -87,12 +88,7 @@ tests =
         [ testCase "same EB hash at two slots: delivery clears both" $
             runCmds reproMultiSlot @?= Right ()
         , testCase "tx shared across two EBs: delivery discharges both" $
-            case runCmds' reproSharedTx of
-              Left msg -> assertFailure msg
-              Right o ->
-                assertBool
-                  "shared tx still tracked as missing after delivery"
-                  (not (txStillMissing (txHashOf 1) o))
+            runCmds reproSharedTx @?= Right ()
         ]
     , testProperty
         "missingEbTxs stays in sync with reverseEbIndexByTx across arbitrary sequences"
@@ -149,12 +145,11 @@ pointOf ids slot = MkLeiosPoint (fromIntegral slot) (hashLeiosEb (ebOf ids))
 ------------------------------------------------------------
 
 -- | Run a command sequence in 'IOSim' against in-memory dependencies, checking
--- the sync invariant after each command. 'Left' names the first failing
--- command; 'Right' returns the final outstanding state (for extra assertions).
-runCmds' :: [Cmd] -> Either String (LeiosOutstanding Int)
-runCmds' cmds = runSimOrThrow (go cmds)
+-- the invariant after each command. 'Left' names the first failing command.
+runCmds :: [Cmd] -> Either String ()
+runCmds cmds = runSimOrThrow (go cmds)
  where
-  go :: forall s. [Cmd] -> IOSim s (Either String (LeiosOutstanding Int))
+  go :: forall s. [Cmd] -> IOSim s (Either String ())
   go cs0 = do
     dbHandle <- LeiosDb.newLeiosDBInMemory
     withLeiosDb dbHandle $ \conn -> do
@@ -163,7 +158,7 @@ runCmds' cmds = runSimOrThrow (go cmds)
       let kv = (outstandingVar, readyVar)
           txCache = nullLeiosTxCache
           peerId = MkPeerId (0 :: Int)
-          loop [] = Right <$> readMVar outstandingVar
+          loop [] = pure (Right ())
           loop (c : cs) = do
             r <-
               try (applyCmd conn txCache kv peerId c)
@@ -177,10 +172,6 @@ runCmds' cmds = runSimOrThrow (go cmds)
                   Right () -> loop cs
       loop cs0
 
--- | As 'runCmds'', but discarding the final state.
-runCmds :: [Cmd] -> Either String ()
-runCmds = fmap (const ()) . runCmds'
-
 applyCmd ::
   forall s.
   LeiosDb.LeiosDbConnection (IOSim s) ->
@@ -261,16 +252,9 @@ checkInvariant o =
         Left ("missingEbTxs tx absent from reverseEbIndexByTx: " <> show (p.pointSlotNo, off))
       Just ebm -> case Map.lookup (pointEbHash p) ebm of
         Nothing -> Left ("reverseEbIndexByTx lacks this EB for a missing tx: " <> show p.pointSlotNo)
-        Just (off', _sz')
-          | off' == off -> Right ()
-          | otherwise -> Left ("reverseEbIndexByTx offset mismatch at " <> show p.pointSlotNo)
-
--- | Is this tx still tracked as missing for any point? After a tx is delivered
--- the deduping LeiosDb should discharge it for every EB that referenced it, so
--- this is 'False' for a delivered tx.
-txStillMissing :: TxHash -> LeiosOutstanding Int -> Bool
-txStillMissing txHash o =
-  any (elem txHash . map fst . IntMap.elems) (Map.elems (Leios.missingEbTxs o))
+        Just (slots, off', _sz')
+          | p.pointSlotNo `NESet.member` slots && off' == off -> Right ()
+          | otherwise -> Left ("reverseEbIndexByTx slot/offset mismatch at " <> show p.pointSlotNo)
 
 ------------------------------------------------------------
 -- Curated repros

From 934a0edf89d0082eb9803dda1eb2cafd0c32b8b4 Mon Sep 17 00:00:00 2001
From: Nicolas Frisby <nicolas.frisby@moduscreate.com>
Date: Wed, 12 Aug 2026 07:18:24 -0400
Subject: [PATCH 12/49] LeiosFetch: intro FetchArrivalBytes tracers, refactor
 as needed

---
 .../LeiosTxCache/Bench/SQLite.hs              |  4 +-
 .../bench/leios-txcache-bench/Main.hs         |  2 +-
 .../src/ouroboros-consensus/LeiosDemoLogic.hs | 67 ++++++++++++-------
 .../src/ouroboros-consensus/LeiosDemoTypes.hs | 54 +++++++++++++++
 .../src/ouroboros-consensus/LeiosTxCache.hs   | 10 ++-
 .../ouroboros-consensus/LeiosTxCache/API.hs   | 33 ++++++++-
 .../LeiosTxCache/Optimized.hs                 | 31 ++++++---
 .../LeiosTxCache/Reference.hs                 | 21 +++---
 .../Test/LeiosTxCache/Optimized.hs            | 30 ++++++---
 .../Test/LeiosTxCache/Reference.hs            |  8 +--
 10 files changed, 196 insertions(+), 64 deletions(-)

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 8c338a3dfc..4161cd15ef 100644
--- a/ouroboros-consensus/bench/leios-txcache-bench/LeiosTxCache/Bench/SQLite.hs
+++ b/ouroboros-consensus/bench/leios-txcache-bench/LeiosTxCache/Bench/SQLite.hs
@@ -123,7 +123,7 @@ newSQLiteLeiosTxCacheForQueries cacheSize nParams path = do
           , evictOlderThan = \_boundary -> pure (Set.empty, Set.empty)
           , 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
@@ -167,7 +167,7 @@ newSQLiteLeiosTxCacheWith pragmas path = do
           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 2c9544c2c9..767f486967 100644
--- a/ouroboros-consensus/bench/leios-txcache-bench/Main.hs
+++ b/ouroboros-consensus/bench/leios-txcache-bench/Main.hs
@@ -280,7 +280,7 @@ runBench (BenchTarget name popCache queryCache syncAfterPop coolBatch) = do
         _ <- insertAnnouncement popCache slot rbh ebh
         _ <- 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/LeiosDemoLogic.hs b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
index 94285bb648..6a01efa010 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
@@ -95,6 +95,10 @@ import LeiosDemoTypes
   , TxHash (..)
   , hashLeiosEb
   , hashLeiosTx
+  , fetchArrivalEvicted
+  , fetchArrivalExtra
+  , fetchArrivalGood
+  , fetchArrivalInvalid
   , leiosEbBytesSize
   , leiosEbTxs
   , maxTxsPerEb
@@ -683,6 +687,11 @@ msgLeiosBlock ktracer tracer (outstandingVar, readyVar) txCache db peerId req eb
   let MkLeiosBlockRequest point ebBytesSize = req
   traceWith tracer $ MkTraceLeiosPeer $ "[start] MsgLeiosBlock " <> Leios.prettyLeiosPoint point
   let MkLeiosPoint _ebSlot ebHash = point
+  let ebBytesSize' = leiosEbBytesSize eb
+  -- A failed-validation body: attribute the whole body to 'fabInvalid'.
+  let invalidReply reason =
+        traceWith ktracer (TraceLeiosFetchBodyArrival (fetchArrivalInvalid ebBytesSize'))
+          >> error reason
   do
     -- FIXME: 'ebBytesSize' here is the size we recorded from the peer
     -- offer at 'MsgLeiosBlockOffer' time (carried through the request),
@@ -691,12 +700,11 @@ msgLeiosBlock ktracer tracer (outstandingVar, readyVar) txCache db peerId req eb
     -- 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)
+      invalidReply $ "MsgLeiosBlock size mismatch: " <> show (ebBytesSize', ebBytesSize)
     let ebHash' = hashLeiosEb eb
     when (ebHash' /= ebHash) $ do
-      error $ "MsgLeiosBlock hash mismatch: " <> show (ebHash', ebHash)
+      invalidReply $ "MsgLeiosBlock hash mismatch: " <> show (ebHash', ebHash)
     -- Every referenced tx must be unique: 'reverseEbIndexByTx' records one
     -- offset per (tx, EB), so a duplicate desyncs it from 'missingEbTxs'.
     let MkLeiosEb v = eb
@@ -705,16 +713,13 @@ msgLeiosBlock ktracer tracer (outstandingVar, readyVar) txCache db peerId req eb
             Map.filter (> (1 :: Int)) $
               Map.fromListWith (+) [(txh, 1) | (txh, _) <- V.toList v]
     when (not (null duplicateTxHashes)) $ do
-      error $ "MsgLeiosBlock duplicate tx hashes: " <> show duplicateTxHashes
+      invalidReply $ "MsgLeiosBlock duplicate tx hashes: " <> show duplicateTxHashes
   -- ingest it
-  MVar.modifyMVar_ outstandingVar $ \outstanding -> do
-    -- Skip if we already hold this EB's body (a 'lookupBody' hit); otherwise
-    -- persist it (LeiosDb before cache) and enqueue only the txs we still need to
-    -- fetch (the misses).
+  bodyClass <- MVar.modifyMVar outstandingVar $ \outstanding -> do
     novel <- isNothing <$> txCache.lookupBody ebHash
-    mbMisses <- if not novel then pure Nothing else do
+    (bodyClass, mbMisses) <- if not novel then pure (fetchArrivalExtra ebBytesSize', Nothing) else do
       -- TODO don't hold the outstanding mvar during this IO
-      mbMisses <- traceException tracer TraceLeiosPeerDbException $ do
+      mbMissesFromBody <- 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
@@ -734,12 +739,13 @@ msgLeiosBlock ktracer tracer (outstandingVar, readyVar) txCache db peerId req eb
         traceWith ktracer $ TraceLeiosBlockAcquired point
         forM_ completedByBody $ traceWith ktracer . TraceLeiosBlockTxsAcquired
         pure $ fmap snd mbSummaryMisses
-      case mbMisses of
-        Just misses -> pure (Just misses)
+      case mbMissesFromBody of
+        -- 'BodyNotYetInserted': the announcement was present and we filled it.
+        Just misses -> pure (fetchArrivalGood ebBytesSize', Just misses)
         Nothing -> do
-          -- Backstop: body whose announcement is not in the LeiosTxCache (and
-          -- so its insert into the cache was a no-op). Classify its txs
-          -- directly.
+          -- Announcement absent (assumed present once, since evicted): the
+          -- cache insert was a no-op. Backstop: classify the txs directly to
+          -- build the misses.
           let MkLeiosEb v = eb
           misses <- withLookupTx txCache $ \look ->
             V.ifoldM
@@ -751,7 +757,7 @@ msgLeiosBlock ktracer tracer (outstandingVar, readyVar) txCache db peerId req eb
               )
               IntMap.empty
               v
-          pure (Just misses)
+          pure (fetchArrivalEvicted ebBytesSize', Just misses)
     -- update NodeKernel state
     --
     -- 'refundEbRequest' reverses this peer's per-request accounting (but skips
@@ -781,8 +787,9 @@ msgLeiosBlock ktracer tracer (outstandingVar, readyVar) txCache db peerId req eb
                         (Leios.reverseEbIndexByTx outstanding)
                         misses
                   }
-    pure outstanding'
+    pure (outstanding', bodyClass)
   void $ MVar.tryPutMVar readyVar ()
+  traceWith ktracer $ TraceLeiosFetchBodyArrival bodyClass
   traceWith tracer $ MkTraceLeiosPeer $ "[done] MsgLeiosBlock " <> Leios.prettyLeiosPoint point
 
 -----
@@ -893,16 +900,21 @@ msgLeiosBlockTxs ktracer tracer (outstandingVar, readyVar) txCache db peerId req
   -- TODO: could validate the returned point + bitmaps too (added to response recently)
   let MkLeiosBlockTxsRequest point bitmaps txHashes = req
   let txBytess = V.map cbor txs
+  let batchBytes = V.sum (V.map BS.length txBytess)
+  -- A failed-validation batch: attribute the whole batch to 'fabInvalid'.
+  let invalidReply reason =
+        traceWith ktracer (TraceLeiosFetchTxsArrival (fetchArrivalInvalid (fromIntegral batchBytes)))
+          >> error reason
   do
     when (V.length txs /= V.length txHashes) $ do
-      error $ "MsgLeiosBlockTxs length mismatch: " ++ show (V.length txs, V.length txHashes)
+      invalidReply $ "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
+      invalidReply $ "MsgLeiosBlockTxs hash mismatches: " ++ show mismatches
   let nextOffset = \case
         [] -> Nothing
         (idx, bitmap) : k -> case popLeftmostOffset bitmap of
@@ -911,13 +923,20 @@ msgLeiosBlockTxs ktracer tracer (outstandingVar, readyVar) txCache db peerId req
             Just (64 * fromIntegral idx + i, (idx, bitmap') : k)
       offsets = unfoldr nextOffset bitmaps
   -- ingest
-  traceException tracer TraceLeiosPeerDbException $ do
+  txArrival <- 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
+    -- crucially: insert the txs into the TxCacheIndex _after_ they've been
+    -- written to the LeiosDb, since that's what the TxCacheIndex currently
+    -- indexes. The handle buckets each tx's bytes by its prior state in the same
+    -- locked pass -- coherent under concurrent duplicate deliveries; the returned
+    -- partition sums to the batch size.
+    withLockedInsertUnappliedTx txCache $ \w0 step ->
+      V.foldM'
+        (\w (txh, sz) -> step w txh sz ())
+        w0
+        (V.zip txHashes (V.map (fromIntegral . BS.length) txBytess))
+  traceWith ktracer $ TraceLeiosFetchTxsArrival txArrival
   -- update NodeKernel state
   MVar.modifyMVar_ outstandingVar $ \outstanding -> do
     let removeTxFromMissing txHash mtxs =
diff --git a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs
index 7e9e81001f..882c9bbe21 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs
@@ -967,6 +967,10 @@ 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
 
 -- | The data of a relayed EB announcement, shared by 'TraceLeiosPeerAnnouncement'
 -- and 'TraceLeiosAnnouncementAccepted'. A separate record so its selectors are
@@ -978,6 +982,38 @@ 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,
@@ -1016,6 +1052,16 @@ 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
+      ]
   MkTraceLeiosKernel s ->
     mconcat
       [ "kind" .= Aeson.String "LeiosKernelMsg"
@@ -1128,6 +1174,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/LeiosTxCache.hs b/ouroboros-consensus/src/ouroboros-consensus/LeiosTxCache.hs
index 027218fa84..4acfa1df4c 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
@@ -98,8 +99,11 @@ newPureLeiosTxCache = 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')
@@ -119,7 +123,7 @@ nullLeiosTxCache =
     , evictOlderThan = \_boundary -> pure (Set.empty, Set.empty)
     , 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 96dd529c08..d2e5635e70 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
@@ -19,6 +20,10 @@ module LeiosTxCache.API
   , InsertBodySummary (..)
   , mkInsertBodySummary
   , worstCaseCacheTxCount
+
+    -- * Arrival classification
+  , TxArrivalPrior (..)
+  , bucketTxArrival
   ) where
 
 import Cardano.Slotting.Slot (SlotNo)
@@ -31,11 +36,15 @@ import Data.Word (Word8)
 import LeiosDemoTypes
   ( BytesSize
   , EbHash
+  , FetchArrivalBytes
   , InsertBodySummary (..)
   , RbHash
   , SerializedEbBody (..)
   , TxHash
   , decodeLeiosEb
+  , fetchArrivalEvicted
+  , fetchArrivalExtra
+  , fetchArrivalGood
   , leiosEbTxs
   , maxTxsPerEb
   )
@@ -79,8 +88,12 @@ data LeiosTxCache m a v b = LeiosTxCache
   -- '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
@@ -124,6 +137,24 @@ 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.
diff --git a/ouroboros-consensus/src/ouroboros-consensus/LeiosTxCache/Optimized.hs b/ouroboros-consensus/src/ouroboros-consensus/LeiosTxCache/Optimized.hs
index 9419b71255..88125e922f 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/LeiosTxCache/Optimized.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosTxCache/Optimized.hs
@@ -29,12 +29,14 @@ 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
   )
@@ -114,12 +116,12 @@ newHashTableLeiosTxCache nshift k0 k1 = do
               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 tagAlreadyValidated 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)
@@ -330,15 +332,28 @@ 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 ()
+{-# SPECIALISE 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
+{-# SPECIALISE 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 d26ea16da3..2cd97899f4 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/LeiosTxCache/Reference.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosTxCache/Reference.hs
@@ -70,6 +70,7 @@ import LeiosTxCache.API
   , InsertBodySummary
   , RefCount (..)
   , ReferencesTxsByHash (..)
+  , TxArrivalPrior (..)
   , maxAnnouncementCount
   , mkInsertBodySummary
   )
@@ -352,18 +353,16 @@ insertBody ebh body nil snoc idx = case Map.lookup ebh (bodyState idx) of
         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/test/consensus-test/Test/LeiosTxCache/Optimized.hs b/ouroboros-consensus/test/consensus-test/Test/LeiosTxCache/Optimized.hs
index 65a1b87fc9..a7ef95a666 100644
--- a/ouroboros-consensus/test/consensus-test/Test/LeiosTxCache/Optimized.hs
+++ b/ouroboros-consensus/test/consensus-test/Test/LeiosTxCache/Optimized.hs
@@ -20,7 +20,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)
@@ -83,19 +83,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 c0401441b7..dd2d129a49 100644
--- a/ouroboros-consensus/test/consensus-test/Test/LeiosTxCache/Reference.hs
+++ b/ouroboros-consensus/test/consensus-test/Test/LeiosTxCache/Reference.hs
@@ -195,7 +195,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
@@ -205,12 +205,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))
 
 {-------------------------------------------------------------------------------
@@ -339,7 +339,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

From fe86f9b3aab04495511005250f189863f0926d62 Mon Sep 17 00:00:00 2001
From: Nicolas Frisby <nicolas.frisby@moduscreate.com>
Date: Wed, 12 Aug 2026 07:33:10 -0400
Subject: [PATCH 13/49] LeiosFetch: make unit test more flexible

---
 .../LeiosTxCache/Optimized.hs                 |  2 +-
 .../consensus-test/Test/LeiosDemoLogic.hs     | 28 +++++++++++++------
 2 files changed, 21 insertions(+), 9 deletions(-)

diff --git a/ouroboros-consensus/src/ouroboros-consensus/LeiosTxCache/Optimized.hs b/ouroboros-consensus/src/ouroboros-consensus/LeiosTxCache/Optimized.hs
index 88125e922f..a79b0800a8 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/LeiosTxCache/Optimized.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosTxCache/Optimized.hs
@@ -117,7 +117,7 @@ newHashTableLeiosTxCache nshift k0 k1 = do
               _ -> Nothing
       , withLockedInsertUnappliedTx = \k ->
           MVar.modifyMVar stateVar $ \st -> do
-            fab <- k mempty (\fab txh sz () -> setTag ht tagAlreadyValidated fab txh sz)
+            fab <- k mempty (\fab txh sz () -> setTag ht tagAlreadyInserted fab txh sz)
             pure (st, fab)
       , withLockedInsertAppliedTx = \k ->
           MVar.modifyMVar_ stateVar $ \st -> do
diff --git a/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic.hs b/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic.hs
index d351ce092d..67745e3130 100644
--- a/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic.hs
+++ b/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic.hs
@@ -57,7 +57,7 @@ tests =
             test_bodyNoOffer
         , testCase "per-EB request cap blocks further selection" $
             test_bodyPerEbCap
-        , testCase "two offering peers both selected (up to cap)" $
+        , testCase "offering peers selected up to the per-EB cap" $
             test_bodyTwoPeersOffer
         , testCase "global byte budget exhausted blocks further selection" $
             test_globalByteBudget
@@ -86,10 +86,10 @@ 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 =
@@ -111,10 +111,12 @@ test_bodyPerEbCap :: IO ()
 test_bodyPerEbCap =
   empty
     & withMissingBody (point 1 'a') 1024
-    & alreadyRequestedEbFrom (eb 'a') [peerA, peerB] -- default cap = 2
-    & offersBody peerC [eb 'a']
+    & alreadyRequestedEbFrom (eb 'a') [0 .. ebCap - 1] -- the per-EB cap is used up
+    & offersBody ebCap [eb 'a'] -- so this additional peer is not selected
     & runIteration
     & assertNoRequests
+ where
+  ebCap = maxRequestsPerEb demoLeiosFetchStaticEnv
 
 test_singleMissingTx :: IO ()
 test_singleMissingTx =
@@ -128,10 +130,12 @@ 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']
+    & alreadyRequestedTxFrom (tx 'x') [0 .. txCap - 1] -- the per-tx cap is used up
+    & offersTxs txCap [eb 'a'] -- so this additional peer is not selected
     & runIteration
     & assertNoRequests
+ where
+  txCap = maxRequestsPerTx demoLeiosFetchStaticEnv
 
 test_bodyTwoPeersOffer :: IO ()
 test_bodyTwoPeersOffer =
@@ -140,7 +144,8 @@ test_bodyTwoPeersOffer =
     & offersBody peerA [eb 'a']
     & offersBody peerB [eb 'a']
     & runIteration
-    & assertRequestPeers [peerA, peerB]
+    -- two peers offer; the fetch logic selects up to the per-EB cap of them
+    & assertRequestPeerCount (min 2 (maxRequestsPerEb demoLeiosFetchStaticEnv))
 
 test_globalByteBudget :: IO ()
 test_globalByteBudget =
@@ -419,6 +424,13 @@ assertRequestPeers ::
 assertRequestPeers expected (MkLeiosFetchDecisions m) =
   Set.fromList (Map.keys m) @?= Set.fromList (map MkPeerId expected)
 
+-- | Assert how many distinct peers received a request. Order-independent, so it
+-- holds for any 'maxRequestsPerEb' \/ 'maxRequestsPerTx': at a cap below the
+-- number of offering peers, /which/ peers win is a selection-order detail, but
+-- the count is not.
+assertRequestPeerCount :: Int -> LeiosFetchDecisions pid -> IO ()
+assertRequestPeerCount n (MkLeiosFetchDecisions m) = Map.size m @?= n
+
 ------------------------------------------------------------
 -- Fixture helpers
 ------------------------------------------------------------

From a677bd3ab9769113aa5a99f0c0f561a177e229dd Mon Sep 17 00:00:00 2001
From: Nicolas Frisby <nicolas.frisby@moduscreate.com>
Date: Thu, 13 Aug 2026 09:09:30 -0400
Subject: [PATCH 14/49] LeiosFetch: reintroduce acquiredEbBodies instead of
 using LeiosTxCache

I erroneously removed acquiredEbBodies alongside filterMissingWork, replacing
_both_ with the LeiosTxCache. That was a mistake for at least these reasons:

- acquiredEbBodies had important relationships to data under the outstanding
  lock, and the LeiosTxCache is not under that lock, so using it instead
  requires multi-lock coordination. Unsurprisingly, the first attempt at that
  coordination was wrong/under-appreciated the challenge, and so had a bug: the
  missingEbBodies and LeiosTxCache could get out of sync in a way that resulted
  in the node constantly fetching an EB body over and over.

- acquiredEbBodies merely contains the points, so it's OK for it to include
  _all_ volatile EBs---we don't _need_ to accept the false negatives that the
  cache would bring.

However, replacing acquiredEbBodies with LeiosTxCache provided a couple of
improvements. So this commit not only reintroduces acquiredEbBodies but also
improves it in those same ways:

- It's now pruned as the immutable tip advances.
- It's directly updated by the forge (the filterMissingWork sledgehammer had
  been compensating for the old acquiredEbBodies not doing that).

Now that it's being pruned, some of its uses needed to be enriched to correctly
handle events (eg late message arrivals) related to data that has already been
pruned out; hence the addition of acquiredEbBodiesPrunedSlot.

-----

There were also some minor improvements done in passing.
---
 .../Ouroboros/Consensus/Network/NodeToNode.hs |  48 +---
 .../Ouroboros/Consensus/NodeKernel.hs         |  42 ++-
 .../src/ouroboros-consensus/LeiosDemoLogic.hs | 268 +++++++++++-------
 .../src/ouroboros-consensus/LeiosDemoTypes.hs |  54 +++-
 .../consensus-test/Test/LeiosDemoLogic.hs     |   2 +-
 .../Test/LeiosDemoLogic/Invariants.hs         |   3 +-
 6 files changed, 238 insertions(+), 179 deletions(-)

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 ba7473a112..0227829d91 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
@@ -126,7 +126,6 @@ import LeiosDemoTypes
   , TraceLeiosPeer (..)
   )
 import qualified LeiosDemoTypes as Leios
-import LeiosTxCache (lookupBody)
 import LeiosVoteState
   ( AddVoteResult (..)
   , LeiosVoteState (..)
@@ -405,7 +404,6 @@ mkHandlers
               , CsClient.getDiffusionPipeliningSupport = getDiffusionPipeliningSupport
               , CsClient.leiosMsgRollForwardCallback = \hdr hdrSlotTime cds -> do
                   Leios.checkMsgRollForwardForLeiosOffers
-                    getLeiosTxCache
                     (getLeiosOutstanding, getLeiosReady)
                     peerVars
                     hdr
@@ -546,46 +544,12 @@ 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.
-                    mbBody <- lookupBody getLeiosTxCache ebHash
-                    MVar.modifyMVar_ getLeiosOutstanding $ \outstanding ->
-                      pure $
-                        case mbBody of
-                          -- TODO this prevents a greater-slotted offer for the
-                          -- same EbHash from increasing the effective priority
-                          --
-                          -- That's acceptable, since it's the announcement
-                          -- handler that should be setting priority, not the
-                          -- offer handler.
-                          Just{} -> outstanding -- we already hold this EB's body
-                          Nothing ->
-                            if ebBytesSize == 0
-                              || 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
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 f340c56310..3ef9fba0a8 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
@@ -119,7 +119,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
   )
@@ -555,16 +554,18 @@ 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 . Leios.pruneOutstandingToImmTip immTipSlot
           }
 
     return
@@ -707,7 +708,14 @@ 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 <- MVar.newMVar (Leios.emptyLeiosOutstanding immTipSlot)
     leiosReady <- MVar.newEmptyMVar
     leiosCentralState <- MVar.newMVar Announcements.emptyCentralState
 
@@ -783,33 +791,17 @@ forkBlockForging IS{..} (MkBlockForging blockForgingM) =
                     bf
                     leiosConn
                     leiosTxCache
-                    announceForgedBlock
+                    ( Leios.processForgedAnnouncement
+                        (leiosKernelTracer tracers)
+                        leiosCentralState
+                        leiosOutstanding
+                    )
                     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/src/ouroboros-consensus/LeiosDemoLogic.hs b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
index 6a01efa010..95ebdb56a1 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
@@ -35,7 +35,6 @@ import qualified Data.IntSet as IntSet
 import Data.List (unfoldr)
 import Data.Map (Map)
 import qualified Data.Map.Strict as Map
-import Data.Maybe (isNothing)
 import Data.Proxy (Proxy (..))
 import Data.Sequence (Seq)
 import qualified Data.Sequence as Seq
@@ -716,78 +715,94 @@ msgLeiosBlock ktracer tracer (outstandingVar, readyVar) txCache db peerId req eb
       invalidReply $ "MsgLeiosBlock duplicate tx hashes: " <> show duplicateTxHashes
   -- ingest it
   bodyClass <- MVar.modifyMVar outstandingVar $ \outstanding -> do
-    novel <- isNothing <$> txCache.lookupBody ebHash
-    (bodyClass, mbMisses) <- if not novel then pure (fetchArrivalExtra ebBytesSize', Nothing) else do
-      -- TODO don't hold the outstanding mvar during this IO
-      mbMissesFromBody <- 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
-        mbSummaryMisses <-
-          insertBody
-            txCache
-            ebHash
-            (Leios.serializeEbBody eb)
-            IntMap.empty
-            (\acc i missingTxh sz -> IntMap.insert i (missingTxh, sz) acc)
-        forM_ mbSummaryMisses $ traceWith ktracer . TraceLeiosTxCacheEbBody point . fst
-        traceWith ktracer $ TraceLeiosBlockAcquired point
-        forM_ completedByBody $ traceWith ktracer . TraceLeiosBlockTxsAcquired
-        pure $ fmap snd mbSummaryMisses
-      case mbMissesFromBody of
-        -- 'BodyNotYetInserted': the announcement was present and we filled it.
-        Just misses -> pure (fetchArrivalGood ebBytesSize', Just misses)
-        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.
-          let MkLeiosEb v = eb
-          misses <- 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', Just misses)
-    -- 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' =
+    let tooOld = point.pointSlotNo < Leios.acquiredEbBodiesPrunedSlot outstanding
+        novel = not $ Map.member ebHash (Leios.acquiredEbBodies 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 the point 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 =
           refundEbRequest peerId ebHash ebBytesSize $
-            case mbMisses of
-              Nothing -> outstanding
-              Just misses ->
-                outstanding
-                  { Leios.missingEbBodies = Map.delete point (Leios.missingEbBodies outstanding)
-                  , Leios.blockingPerEb =
-                      Map.insert point (IntMap.size misses) (Leios.blockingPerEb outstanding)
-                  , Leios.missingEbTxs =
-                      Map.insert point misses (Leios.missingEbTxs outstanding)
-                  , Leios.reverseEbIndexByTx =
-                      IntMap.foldrWithKey
-                        ( \i (txHash, txBytesSize) acc ->
-                            Map.insertWith
-                              (Map.unionWith (\(s1, i1, z1) (s2, _, _) -> (s1 <> s2, i1, z1)))
-                              txHash
-                              (Map.singleton ebHash (NESet.singleton point.pointSlotNo, i, txBytesSize))
-                              acc
-                        )
-                        (Leios.reverseEbIndexByTx outstanding)
-                        misses
-                  }
-    pure (outstanding', bodyClass)
+            outstanding
+              { Leios.missingEbBodies = Map.delete point (Leios.missingEbBodies outstanding)
+              , Leios.acquiredEbBodies =
+                  if tooOld
+                    then Leios.acquiredEbBodies outstanding
+                    else Map.insert ebHash point.pointSlotNo (Leios.acquiredEbBodies outstanding)
+              }
+    -- Persist and classify only a genuinely novel, still-relevant body. A
+    -- duplicate (already in 'acquiredEbBodies') or a too-old arrival (its
+    -- 'acquiredEbBodies' slot has been pruned, 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'
+          )
+      else do
+        -- TODO don't hold the outstanding mvar during this IO
+        mbMissesFromBody <- 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
+          mbSummaryMisses <-
+            insertBody
+              txCache
+              ebHash
+              (Leios.serializeEbBody eb)
+              IntMap.empty
+              (\acc i missingTxh sz -> IntMap.insert i (missingTxh, sz) acc)
+          forM_ mbSummaryMisses $ traceWith ktracer . TraceLeiosTxCacheEbBody point . fst
+          traceWith ktracer $ TraceLeiosBlockAcquired point
+          forM_ completedByBody $ traceWith ktracer . TraceLeiosBlockTxsAcquired
+          pure $ fmap snd mbSummaryMisses
+        (bodyClass, misses) <- case mbMissesFromBody of
+          -- 'BodyNotYetInserted': the announcement was present and we filled it.
+          Just ms -> pure (fetchArrivalGood ebBytesSize', ms)
+          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.
+            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)
+        let !outstanding' =
+              outstandingCleaned
+                { Leios.blockingPerEb =
+                    Map.insert point (IntMap.size misses) (Leios.blockingPerEb outstandingCleaned)
+                , Leios.missingEbTxs =
+                    Map.insert point misses (Leios.missingEbTxs outstandingCleaned)
+                , Leios.reverseEbIndexByTx =
+                    IntMap.foldrWithKey
+                      ( \i (txHash, txBytesSize) acc ->
+                          Map.insertWith
+                            (Map.unionWith (\(s1, i1, z1) (s2, _, _) -> (s1 <> s2, i1, z1)))
+                            txHash
+                            (Map.singleton ebHash (NESet.singleton point.pointSlotNo, i, txBytesSize))
+                            acc
+                      )
+                      (Leios.reverseEbIndexByTx outstandingCleaned)
+                      misses
+                }
+        pure (outstanding', bodyClass)
   void $ MVar.tryPutMVar readyVar ()
   traceWith ktracer $ TraceLeiosFetchBodyArrival bodyClass
   traceWith tracer $ MkTraceLeiosPeer $ "[done] MsgLeiosBlock " <> Leios.prettyLeiosPoint point
@@ -1004,49 +1019,55 @@ msgLeiosBlockTxs ktracer tracer (outstandingVar, readyVar) txCache db peerId req
 
 -----
 
--- | 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).
+-- | 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'.
+data AlsoOfferedTxsClosure = TxsClosureAlsoOffered | TxsClosureNotAlsoOffered
+
+-- | 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 (at or below
+-- the slot 'acquiredEbBodies' has been pruned to), already recorded in
+-- 'acquiredEbBodies' (received or forged — the only "do we have it" test now,
+-- read in-lock with no cache lookup), already listed under this content hash, or
+-- zero-sized.
+-- 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 =>
-  LeiosTxCache m () () SerializedEbBody ->
   ( 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 txCache (outstandingVar, readyVar) peerVars (point, ebBytesSize) = do
-  let MkLeiosPoint _ebSlot ebHash = point
-  -- As if 'MsgLeiosBlockOffer': record the EB body as missing, unless we already
-  -- hold it.
-  mbBody <- txCache.lookupBody ebHash
+recordEbBodyOffer (outstandingVar, readyVar) peerVars offeredClosure (point, ebBytesSize) = do
+  let MkLeiosPoint ebSlot ebHash = point
   MVar.modifyMVar_ outstandingVar $ \outstanding ->
     pure $
-      case mbBody of
-        -- TODO this is the same concern as in the MsgLeiosBlockOffer handler
-        -- about ignoring a greater slot
-        Just{} -> outstanding
-        Nothing ->
+      if ebSlot < Leios.acquiredEbBodiesPrunedSlot outstanding -- too old to fetch
+        || ebBytesSize == 0 -- malformed offer
+        || Map.member ebHash (Leios.acquiredEbBodies outstanding) -- already have it
+        || any ((== ebHash) . pointEbHash) (Map.keys (Leios.missingEbBodies outstanding)) -- already listed
+        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
+        !offers2' = case offeredClosure of
+          TxsClosureAlsoOffered -> Set.insert ebHash offers2
+          TxsClosureNotAlsoOffered -> offers2
     pure (offers1', offers2')
   void $ MVar.tryPutMVar readyVar ()
 
@@ -1054,14 +1075,14 @@ leiosCertRbOffer txCache (outstandingVar, readyVar) peerVars (point, ebBytesSize
 
 -- | 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'.
 checkMsgRollForwardForLeiosOffers ::
   forall blk pid m.
   (IOLike m, ResolveLeiosBlock blk) =>
-  LeiosTxCache m () () SerializedEbBody ->
   ( MVar m (LeiosOutstanding pid)
   , MVar m ()
   ) ->
@@ -1069,10 +1090,10 @@ checkMsgRollForwardForLeiosOffers ::
   Header blk ->
   ChainDepState (BlockProtocol blk) ->
   m ()
-checkMsgRollForwardForLeiosOffers txCache kernelVars peerVars hdr cds =
+checkMsgRollForwardForLeiosOffers kernelVars peerVars hdr cds =
   when (headerContainsLeiosCert hdr) $
     forM_ (protocolStateLeiosAnnouncement @blk cds) $ \announcement ->
-      leiosCertRbOffer txCache kernelVars peerVars announcement
+      recordEbBodyOffer kernelVars peerVars TxsClosureAlsoOffered announcement
 
 -----
 
@@ -1156,6 +1177,44 @@ processAnnouncementCentrally
     -- 'headerLeiosAnnouncement'); its ebHash is kept in 'ancAnnouncementFields'.
     point = MkLeiosPoint (blockSlot (ancHeader ancHdr)) (announcementEbHash fields)
 
+-- | Process this node's own freshly-forged EB announcement: relay it centrally
+-- (as 'ForgedLocally', before the forge inserts the EB body — writing the body
+-- is what offers it, so a downstream peer never gets the offer before the
+-- announcement) and record the EB as acquired, so we neither re-fetch nor
+-- re-offer the body we just forged. A no-op for a forged block that announces no
+-- EB. 'forge' invokes this right after forging and before adoption (its
+-- 'afterForgeBeforeInsert' callback).
+processForgedAnnouncement ::
+  forall blk peer pid m.
+  (IOLike m, ResolveLeiosBlock blk, HasHeader (Header blk), Ord peer) =>
+  Tracer m TraceLeiosKernel ->
+  MVar m (Announcements.CentralState m peer (AnnouncingHeader blk)) ->
+  MVar m (LeiosOutstanding pid) ->
+  Header blk ->
+  m ()
+processForgedAnnouncement kernelTracer centralVar outstandingVar forgedHeader =
+  forM_ (mkAnnouncingHeader forgedHeader) $ \anc -> do
+    MVar.modifyMVar_ centralVar $ \cst ->
+      Announcements.onAnnouncementCentral
+        (contramap (traceNewAnnouncement ForgedLocally) kernelTracer)
+        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
+    -- Record the forged EB as acquired: don't fetch the body we're about to
+    -- insert, and don't re-offer it when an offer or its CertRB comes back.
+    MVar.modifyMVar_ outstandingVar $ \outstanding ->
+      let ebSlot = blockSlot (ancHeader anc)
+          ebHash = announcementEbHash (ancAnnouncementFields anc)
+       in pure $
+            outstanding
+              { Leios.acquiredEbBodies =
+                  Map.insert ebHash ebSlot (Leios.acquiredEbBodies outstanding)
+              }
+
 -- | Thrown when a peer misbehaves on the announcement protocol; the ensuing
 -- thread death disconnects the peer. It carries the
 -- 'ErrAnnouncement' verbatim (the @blk@ is existential); every
@@ -1271,7 +1330,8 @@ recordAnnouncedEb txCache (outstandingVar, readyVar) (point, ebBytesSize) =
   MkLeiosPoint _ebSlot ebHash = point
 
   upd outstanding =
-    if any ((== ebHash) . pointEbHash) (Map.keys (Leios.missingEbBodies outstanding))
+    if Map.member ebHash (Leios.acquiredEbBodies outstanding)
+      || any ((== ebHash) . pointEbHash) (Map.keys (Leios.missingEbBodies outstanding))
       then (outstanding, False)
       else
         flip (,) True $
diff --git a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs
index 882c9bbe21..78d226a129 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs
@@ -390,7 +390,20 @@ newLeiosPeerVars = do
 --    data structures for clarity.
 data LeiosOutstanding pid = MkLeiosOutstanding
   { -- EB-level tracking
-    missingEbBodies :: !(Map LeiosPoint BytesSize)
+    acquiredEbBodies :: !(Map EbHash SlotNo)
+  -- ^ The EB bodies we have already received, recorded by 'msgLeiosBlock' at
+  -- the moment of receipt, so that we neither re-fetch nor re-list one we
+  -- already hold. The 'SlotNo' is the EB's election slot; an entry is dropped
+  -- once that slot falls before the immutable tip (see
+  -- 'pruneOutstandingToImmTip'), below which the EB can never be requested
+  -- again, which keeps this bounded to the volatile window.
+  , acquiredEbBodiesPrunedSlot :: !SlotNo
+  -- ^ The slot 'acquiredEbBodies' has most recently been pruned up to (see
+  -- 'pruneOutstandingToImmTip'): entries below it have been dropped. Used as
+  -- the "too old" boundary by 'msgLeiosBlock' and the offer handler, so that
+  -- test agrees with what has actually been pruned (it reads this under the
+  -- same lock) rather than racing a separate read of the immutable tip.
+  , missingEbBodies :: !(Map LeiosPoint BytesSize)
   -- ^ EB bodies still needed to be fetched (indexed by point and size)
   -- Request tracking
   , requestedEbPeers :: !(Map EbHash (Set (PeerId pid)))
@@ -445,10 +458,16 @@ data LeiosOutstanding pid = MkLeiosOutstanding
   -- anything, reconcile it against shared-tx arrivals (or derive it from the DB).
   }
 
-emptyLeiosOutstanding :: LeiosOutstanding pid
-emptyLeiosOutstanding =
+-- | The empty outstanding state, given the slot 'acquiredEbBodies' is
+-- considered already 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').
+emptyLeiosOutstanding :: SlotNo -> LeiosOutstanding pid
+emptyLeiosOutstanding prunedSlot =
   MkLeiosOutstanding
-    { missingEbBodies = Map.empty
+    { acquiredEbBodies = Map.empty
+    , acquiredEbBodiesPrunedSlot = prunedSlot
+    , missingEbBodies = Map.empty
     , requestedEbPeers = Map.empty
     , requestedTxPeers = Map.empty
     , requestedBytesSizePerPeer = Map.empty
@@ -458,6 +477,27 @@ emptyLeiosOutstanding =
     , blockingPerEb = Map.empty
     }
 
+-- | Drop 'acquiredEbBodies' entries whose EB election slot is before the
+-- immutable tip. Such an EB can never be requested again, so the record of
+-- having it is no longer needed to suppress a fetch; this is what bounds
+-- 'acquiredEbBodies' to the volatile window. Safe only because the offer/
+-- announcement paths ignore an EB that old (so a pruned entry cannot be
+-- re-listed).
+--
+-- TODO this scans the whole map (potentially ~20k entries) on every
+-- immutable-tip advance. Maintain a slot-keyed reverse index (e.g.
+-- 'Map SlotNo (Set EbHash)') alongside 'acquiredEbBodies' so pruning drops the
+-- below-tip prefix directly instead of filtering the entire map.
+--
+-- TODO only prunes acqiuredEbBodies for now; there's plenty more for it to be
+-- pruning
+pruneOutstandingToImmTip :: SlotNo -> LeiosOutstanding pid -> LeiosOutstanding pid
+pruneOutstandingToImmTip immTipSlot outstanding =
+  outstanding
+    { acquiredEbBodies = Map.filter (>= immTipSlot) (acquiredEbBodies outstanding)
+    , acquiredEbBodiesPrunedSlot = max (acquiredEbBodiesPrunedSlot outstanding) immTipSlot
+    }
+
 -- | 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.
@@ -484,7 +524,8 @@ prettyLeiosOutstanding :: LeiosOutstanding pid -> String
 prettyLeiosOutstanding x =
   unlines $
     map ("    [leios] " ++) $
-      [ "missingEbBodies = " ++ show (Map.size missingEbBodies)
+      [ "acquiredEbBodies = " ++ show (Map.size acquiredEbBodies)
+      , "missingEbBodies = " ++ show (Map.size missingEbBodies)
       , "requestedEbPeers = " ++ unwords (map prettyEbHash (Map.keys requestedEbPeers))
       , "requestedTxPeers = " ++ unwords (map prettyTxHash (Map.keys requestedTxPeers))
       , "requestedBytesSizePerPeer = " ++ show (Map.elems requestedBytesSizePerPeer)
@@ -497,7 +538,8 @@ prettyLeiosOutstanding x =
       ]
  where
   MkLeiosOutstanding
-    { missingEbBodies
+    { acquiredEbBodies
+    , missingEbBodies
     , requestedEbPeers
     , requestedTxPeers
     , requestedBytesSizePerPeer
diff --git a/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic.hs b/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic.hs
index 67745e3130..215a1eae8b 100644
--- a/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic.hs
+++ b/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic.hs
@@ -216,7 +216,7 @@ empty =
   Scenario
     { scEnv = demoLeiosFetchStaticEnv
     , scOfferings = Map.empty
-    , scOutstanding = emptyLeiosOutstanding
+    , scOutstanding = emptyLeiosOutstanding (SlotNo 0)
     }
 
 -- | Outstanding-work combinators -----------------------------------------
diff --git a/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic/Invariants.hs b/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic/Invariants.hs
index d4ad64c8fe..1d4bb18ca4 100644
--- a/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic/Invariants.hs
+++ b/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic/Invariants.hs
@@ -25,6 +25,7 @@
 -- scope of these tests.
 module Test.LeiosDemoLogic.Invariants (tests) where
 
+import Cardano.Slotting.Slot (SlotNo (SlotNo))
 import Control.Concurrent.Class.MonadMVar
   ( MVar
   , modifyMVar_
@@ -153,7 +154,7 @@ runCmds cmds = runSimOrThrow (go cmds)
   go cs0 = do
     dbHandle <- LeiosDb.newLeiosDBInMemory
     withLeiosDb dbHandle $ \conn -> do
-      outstandingVar <- newMVar emptyLeiosOutstanding
+      outstandingVar <- newMVar (emptyLeiosOutstanding (SlotNo 0))
       readyVar <- newEmptyMVar
       let kv = (outstandingVar, readyVar)
           txCache = nullLeiosTxCache

From 75236e9fd44e4c38d3a223aeca49d3bf5c53b6ed Mon Sep 17 00:00:00 2001
From: Nicolas Frisby <nicolas.frisby@moduscreate.com>
Date: Thu, 13 Aug 2026 10:10:01 -0400
Subject: [PATCH 15/49] LeiosFetch: regression test, don't request EB bodies we
 already have

---
 .../Test/LeiosDemoLogic/Invariants.hs         | 202 ++++++++++++++++--
 1 file changed, 181 insertions(+), 21 deletions(-)

diff --git a/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic/Invariants.hs b/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic/Invariants.hs
index 1d4bb18ca4..ed00c97806 100644
--- a/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic/Invariants.hs
+++ b/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic/Invariants.hs
@@ -19,10 +19,13 @@
 -- force a 'Decide' through the real fetch logic so a stray @impossible!@
 -- surfaces even if the structural check missed a shape.
 --
--- NOTE. Offers are deliberately not a command, for now. A 'MsgLeiosBlockOffer'
--- does two things: record the EB as missing (covered here by 'Announce') and
--- populate the per-peer offerings map. It's simply not required for the current
--- scope of these tests.
+-- 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 already in 'acquiredEbBodies'.
+-- Phrasing it as "already held" rather than a request count keeps it correct if
+-- 'maxRequestsPerEb' rises above 1: 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))
@@ -33,8 +36,10 @@ import Control.Concurrent.Class.MonadMVar
   , 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, runSimOrThrow)
+import Control.Monad.IOSim (IOSim, exploreSimTrace, runSimOrThrow, traceResult)
 import Control.Tracer (nullTracer)
 import qualified Data.Bits as Bits
 import qualified Data.ByteString as BS
@@ -48,11 +53,13 @@ import Data.Word (Word16, Word64)
 import LeiosDemoDb (withLeiosDb)
 import qualified LeiosDemoDb as LeiosDb
 import LeiosDemoLogic
-  ( LeiosFetchDecisions (..)
+  ( AlsoOfferedTxsClosure (..)
+  , LeiosFetchDecisions (..)
   , leiosFetchLogicIteration
   , msgLeiosBlock
   , msgLeiosBlockTxs
   , recordAnnouncedEb
+  , recordEbBodyOffer
   )
 import LeiosDemoTypes
   ( BytesSize
@@ -61,6 +68,7 @@ import LeiosDemoTypes
   , LeiosBlockTxsRequest (..)
   , LeiosEb (..)
   , LeiosOutstanding (..)
+  , LeiosPeerVars
   , LeiosPoint (..)
   , LeiosTx (..)
   , PeerId (..)
@@ -70,10 +78,11 @@ import LeiosDemoTypes
   , hashLeiosEb
   , hashLeiosTx
   , leiosEbBytesSize
+  , newLeiosPeerVars
   )
 import qualified LeiosDemoTypes as Leios
-import LeiosTxCache (LeiosTxCache, nullLeiosTxCache)
-import Ouroboros.Consensus.Util.IOLike (evaluate)
+import LeiosTxCache (LeiosTxCache, newPureLeiosTxCache, nullLeiosTxCache)
+import Ouroboros.Consensus.Util.IOLike (IOLike, evaluate)
 import Test.QuickCheck
 import Test.Tasty (TestTree, testGroup)
 import Test.Tasty.HUnit (testCase, (@?=))
@@ -94,6 +103,12 @@ tests =
     , testProperty
         "missingEbTxs stays in sync with reverseEbIndexByTx 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
     ]
 
 ------------------------------------------------------------
@@ -106,8 +121,10 @@ tests =
 type TestEb = [Int]
 
 data Cmd
-  = -- | @recordAnnouncedEb@: announce/offer this EB at this slot.
+  = -- | @recordAnnouncedEb@: announce this EB at this slot.
     Announce TestEb Word
+  | -- | @recordEbBodyOffer@: a peer offers this EB body at this slot.
+    Offer TestEb Word
   | -- | @msgLeiosBlock@: the EB body arrives for that point.
     ArriveBody TestEb Word
   | -- | @msgLeiosBlockTxs@: deliver the tx at this /index within the EB/.
@@ -148,46 +165,64 @@ pointOf ids slot = MkLeiosPoint (fromIntegral slot) (hashLeiosEb (ebOf ids))
 -- | 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 cmds = runSimOrThrow (go cmds)
+runCmds = (() <$) . runCmdsReFetchViolations
+
+-- | Like 'runCmds', but on success also return the EB bodies that the fetch
+-- logic requested despite already holding them (i.e. despite being in
+-- 'acquiredEbBodies'), 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 ())
+  go :: forall s. [Cmd] -> IOSim s (Either String [EbHash])
   go cs0 = do
     dbHandle <- LeiosDb.newLeiosDBInMemory
     withLeiosDb dbHandle $ \conn -> do
       outstandingVar <- newMVar (emptyLeiosOutstanding (SlotNo 0))
       readyVar <- newEmptyMVar
+      peerVars <- newLeiosPeerVars
       let kv = (outstandingVar, readyVar)
           txCache = nullLeiosTxCache
           peerId = MkPeerId (0 :: Int)
-          loop [] = pure (Right ())
-          loop (c : cs) = do
+          loop acc [] = pure (Right acc)
+          loop acc (c : cs) = do
             r <-
-              try (applyCmd conn txCache kv peerId c)
-                :: IOSim s (Either SomeException ())
+              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 () -> do
+              Right violations -> do
                 outstanding <- readMVar outstandingVar
                 case checkInvariant outstanding of
                   Left msg -> pure (Left (msg <> " (after " <> show c <> ")"))
-                  Right () -> loop cs
-      loop cs0
+                  Right () -> loop (acc <> violations) cs
+      loop [] cs0
 
+-- | Apply a command, returning any EB bodies it requested that are already held
+-- (in 'acquiredEbBodies') — 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 ()
-applyCmd conn txCache kv peerId = \case
-  Announce ids slot ->
+  IOSim s [EbHash]
+applyCmd conn txCache kv peerVars peerId = \case
+  Announce ids slot -> do
     recordAnnouncedEb txCache kv (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)
     msgLeiosBlock nullTracer nullTracer kv txCache conn peerId req eb
+    pure []
   ArriveTx ids slot idx -> do
     let txId = ids !! idx
         req =
@@ -196,6 +231,7 @@ applyCmd conn txCache kv peerId = \case
             (offsetsToBitmaps [idx])
             (V.singleton (txHashOf txId))
     msgLeiosBlockTxs nullTracer nullTracer kv txCache conn peerId req (V.singleton (leiosTxOf txId))
+    pure []
   Decide slot -> do
     outstanding <- readMVar (fst kv)
     let ebs = referencedEbs outstanding
@@ -208,6 +244,10 @@ applyCmd conn txCache kv peerId = \case
     _ <- evaluate out'
     _ <- evaluate (forceDecisions decs)
     modifyMVar_ (fst kv) (\_ -> pure out')
+    -- Regression: the fetch logic must not request a body already in
+    -- 'acquiredEbBodies'. Return any it did (empty when well-behaved).
+    let held = Leios.acquiredEbBodies outstanding
+    pure (filter (\h -> Map.member h held) (ebBodyRequestHashes decs))
 
 -- | Every EbHash currently referenced by the outstanding state (bodies + txs),
 -- as an all-offering peer's body\/closure sets.
@@ -228,6 +268,16 @@ forceDecisions (MkLeiosFetchDecisions m) =
     , (_txHash, sz, _ebHash, offset) <- DList.toList txs
     ]
 
+-- | The 'EbHash'es a decision set issues an EB-body fetch request for (one entry
+-- per request; the fetch logic caps this at 'maxRequestsPerEb' per EB).
+ebBodyRequestHashes :: LeiosFetchDecisions pid -> [EbHash]
+ebBodyRequestHashes (MkLeiosFetchDecisions m) =
+  [ ebHash
+  | slotMap <- Map.elems m
+  , (_txs, ebReqs) <- Map.elems slotMap
+  , (ebHash, _sz) <- DList.toList ebReqs
+  ]
+
 ------------------------------------------------------------
 -- The invariant
 ------------------------------------------------------------
@@ -299,6 +349,7 @@ genCmd = do
   slot <- elements worldSlots
   oneof
     [ pure (Announce ids slot)
+    , pure (Offer ids slot)
     , pure (ArriveBody ids slot)
     , ArriveTx ids slot <$> choose (0, length ids - 1)
     , Decide <$> elements worldSlots
@@ -309,6 +360,115 @@ prop_invariants =
   forAllShrink (listOf genCmd) (shrinkList (const [])) $ \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 in 'acquiredEbBodies'). The storm was precisely
+-- this — a held body re-listed and re-requested indefinitely.
+--
+-- Stated as "already held" rather than a request count, so it stays correct if
+-- 'maxRequestsPerEb' rises above 1: 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 'acquiredEbBodies' check is cache-independent.)
+prop_neverRefetchesHeldBody :: Property
+prop_neverRefetchesHeldBody =
+  forAllShrink (listOf genCmd) (shrinkList (const [])) $ \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 two-lock structure this test exists to probe -- the
+-- shared cache, and the announcement path's cross-lock 'lookupBody' -- 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 a cross-lock race
+-- straddling a concurrent body insert. 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, whose "do we
+-- already hold it?" read hits the pure 'newPureLeiosTxCache', a lock distinct
+-- from the outstanding lock, before it touches the outstanding state), and a body
+-- arrival (slot 12, different from both) — 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 (SlotNo 0))
+    readyVar <- newEmptyMVar
+    peerVars <- newLeiosPeerVars
+    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 txCache kv (announcePoint, ebBytesSize))
+          ( msgLeiosBlock
+              nullTracer
+              nullTracer
+              kv
+              txCache
+              conn
+              peerId
+              (MkLeiosBlockRequest arrivalPoint ebBytesSize)
+              eb
+          )
+      )
+    outstanding <- readMVar outstandingVar
+    let held = Map.keysSet (Leios.acquiredEbBodies 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)
+
 offsetsToBitmaps :: [Int] -> [(Word16, Word64)]
 offsetsToBitmaps offs =
   [ (fromIntegral q, bm)

From f7f6c610c0a2e9e80f79070dd25821fd1cd6c07f Mon Sep 17 00:00:00 2001
From: Nicolas Frisby <nicolas.frisby@moduscreate.com>
Date: Thu, 13 Aug 2026 10:23:30 -0400
Subject: [PATCH 16/49] LeiosFetch: the deletion in msgLeiosBlock needs
 reverseSlotIndexByEbHash

---
 .../src/ouroboros-consensus/LeiosDemoLogic.hs | 35 +++++++++++++++----
 .../src/ouroboros-consensus/LeiosDemoTypes.hs | 11 ++++++
 2 files changed, 39 insertions(+), 7 deletions(-)

diff --git a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
index 95ebdb56a1..71f9875dd5 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
@@ -720,13 +720,22 @@ msgLeiosBlock ktracer tracer (outstandingVar, readyVar) txCache db peerId req eb
         -- 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 the point from 'missingEbBodies'); and unless
-        -- the EB is too old to matter, remember we have it so we neither
-        -- re-fetch nor re-offer 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 =
           refundEbRequest peerId ebHash ebBytesSize $
             outstanding
-              { Leios.missingEbBodies = Map.delete point (Leios.missingEbBodies 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)
               , Leios.acquiredEbBodies =
                   if tooOld
                     then Leios.acquiredEbBodies outstanding
@@ -1056,12 +1065,18 @@ recordEbBodyOffer (outstandingVar, readyVar) peerVars offeredClosure (point, ebB
       if ebSlot < Leios.acquiredEbBodiesPrunedSlot outstanding -- too old to fetch
         || ebBytesSize == 0 -- malformed offer
         || Map.member ebHash (Leios.acquiredEbBodies outstanding) -- already have it
-        || any ((== ebHash) . pointEbHash) (Map.keys (Leios.missingEbBodies outstanding)) -- already listed
+        || Map.member ebHash (Leios.reverseSlotIndexByEbHash outstanding) -- already listed
         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) $ \(offers1, offers2) -> do
     let !offers1' = Set.insert ebHash offers1
@@ -1327,17 +1342,23 @@ recordAnnouncedEb txCache (outstandingVar, readyVar) (point, ebBytesSize) =
       changed <- MVar.modifyMVar outstandingVar (pure . upd)
       when changed $ void $ MVar.tryPutMVar readyVar ()
  where
-  MkLeiosPoint _ebSlot ebHash = point
+  MkLeiosPoint ebSlot ebHash = point
 
   upd outstanding =
     if Map.member ebHash (Leios.acquiredEbBodies outstanding)
-      || any ((== ebHash) . pointEbHash) (Map.keys (Leios.missingEbBodies outstanding))
+      || Map.member ebHash (Leios.reverseSlotIndexByEbHash outstanding)
       then (outstanding, False)
       else
         flip (,) True $
           outstanding
             { Leios.missingEbBodies =
                 Map.insert point ebBytesSize (Leios.missingEbBodies outstanding)
+            , Leios.reverseSlotIndexByEbHash =
+                Map.insertWith
+                  NESet.union
+                  ebHash
+                  (NESet.singleton ebSlot)
+                  (Leios.reverseSlotIndexByEbHash outstanding)
             }
 
 prunePeerStateToImmTip ::
diff --git a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs
index 78d226a129..2ab374b7ab 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs
@@ -405,6 +405,14 @@ data LeiosOutstanding pid = MkLeiosOutstanding
   -- same lock) rather than racing a separate read of the immutable tip.
   , 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) 'msgLeiosBlock' 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
@@ -468,6 +476,7 @@ emptyLeiosOutstanding prunedSlot =
     { acquiredEbBodies = Map.empty
     , acquiredEbBodiesPrunedSlot = prunedSlot
     , missingEbBodies = Map.empty
+    , reverseSlotIndexByEbHash = Map.empty
     , requestedEbPeers = Map.empty
     , requestedTxPeers = Map.empty
     , requestedBytesSizePerPeer = Map.empty
@@ -526,6 +535,7 @@ prettyLeiosOutstanding x =
     map ("    [leios] " ++) $
       [ "acquiredEbBodies = " ++ show (Map.size acquiredEbBodies)
       , "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)
@@ -540,6 +550,7 @@ prettyLeiosOutstanding x =
   MkLeiosOutstanding
     { acquiredEbBodies
     , missingEbBodies
+    , reverseSlotIndexByEbHash
     , requestedEbPeers
     , requestedTxPeers
     , requestedBytesSizePerPeer

From 6e7c59fbacddefe480999c3a343e38a9fc69f85c Mon Sep 17 00:00:00 2001
From: Nicolas Frisby <nicolas.frisby@moduscreate.com>
Date: Thu, 13 Aug 2026 10:47:38 -0400
Subject: [PATCH 17/49] LeiosFetch: reintroduce the locking bug to prove
 regression test

With this commit, the relevant regression test fails.

```
      a concurrent offer and body arrival never leave a held EB body listed (IOSimPOR): FAIL (0.04s)
        *** Failed! Falsified (after 1 test):
        Schedule control: ControlAwait [ScheduleMod (Thread {2,2}.14) ControlDefault [Thread {2}.7,Thread {2}.8,Thread {1}.0,Thread {1}.1]]
        Thread {2,2} delayed at time Time 0s
          until after:
            Thread {1}
            Thread {2}

        held EB body still listed for fetching: [47f6c6404a56ea658d0b40e31c47eba73beaad3d3d71a5e61fc0e90ea48d6d99]
        Use --quickcheck-replay="(SMGen 17010102127566570440 17528764287311168251,0)" to reproduce.
        Use -p '/LeiosDemoLogic.Invariants/&&/a concurrent offer and body arrival never leave a held EB body listed (IOSimPOR)/' to rerun this test only.
```

That's because this commit (temorarily!) re-introduces the bug that was by
reintroducing acquireEbBodies.
---
 .../src/ouroboros-consensus/LeiosDemoLogic.hs      | 14 ++++++++++----
 1 file changed, 10 insertions(+), 4 deletions(-)

diff --git a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
index 71f9875dd5..967a487234 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
@@ -736,10 +736,9 @@ msgLeiosBlock ktracer tracer (outstandingVar, readyVar) txCache db peerId req eb
                             slots
               , Leios.reverseSlotIndexByEbHash =
                   Map.delete ebHash (Leios.reverseSlotIndexByEbHash outstanding)
-              , Leios.acquiredEbBodies =
-                  if tooOld
-                    then Leios.acquiredEbBodies outstanding
-                    else Map.insert ebHash point.pointSlotNo (Leios.acquiredEbBodies outstanding)
+              -- BUG INJECTION (temporary, revert me): 'acquiredEbBodies' is no
+              -- longer updated here. The acquisition is deferred to a second lock
+              -- grab below, so the purge and the acquire are no longer atomic.
               }
     -- Persist and classify only a genuinely novel, still-relevant body. A
     -- duplicate (already in 'acquiredEbBodies') or a too-old arrival (its
@@ -812,6 +811,13 @@ msgLeiosBlock ktracer tracer (outstandingVar, readyVar) txCache db peerId req eb
                       misses
                 }
         pure (outstanding', bodyClass)
+  -- BUG INJECTION (temporary, revert me): grab #2, the deferred acquire. Between
+  -- the purge in grab #1 and this insert, a concurrent offer sees the hash
+  -- neither held nor listed and relists it; then this marks it held, leaving it
+  -- held-and-listed. ('tooOld' never fires in these tests, so the unconditional
+  -- insert matches the original behaviour there.)
+  MVar.modifyMVar_ outstandingVar $ \o ->
+    pure $ o {Leios.acquiredEbBodies = Map.insert ebHash point.pointSlotNo (Leios.acquiredEbBodies o)}
   void $ MVar.tryPutMVar readyVar ()
   traceWith ktracer $ TraceLeiosFetchBodyArrival bodyClass
   traceWith tracer $ MkTraceLeiosPeer $ "[done] MsgLeiosBlock " <> Leios.prettyLeiosPoint point

From b42488a2337360575c1120699b8b0accc5c9e031 Mon Sep 17 00:00:00 2001
From: Nicolas Frisby <nicolas.frisby@moduscreate.com>
Date: Thu, 13 Aug 2026 10:51:07 -0400
Subject: [PATCH 18/49] Revert "LeiosFetch: reintroduce the locking bug to
 prove regression test"

This reverts commit 60345472159e4ac0e0569ac4368539a7a634fd50.
---
 .../src/ouroboros-consensus/LeiosDemoLogic.hs      | 14 ++++----------
 1 file changed, 4 insertions(+), 10 deletions(-)

diff --git a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
index 967a487234..71f9875dd5 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
@@ -736,9 +736,10 @@ msgLeiosBlock ktracer tracer (outstandingVar, readyVar) txCache db peerId req eb
                             slots
               , Leios.reverseSlotIndexByEbHash =
                   Map.delete ebHash (Leios.reverseSlotIndexByEbHash outstanding)
-              -- BUG INJECTION (temporary, revert me): 'acquiredEbBodies' is no
-              -- longer updated here. The acquisition is deferred to a second lock
-              -- grab below, so the purge and the acquire are no longer atomic.
+              , Leios.acquiredEbBodies =
+                  if tooOld
+                    then Leios.acquiredEbBodies outstanding
+                    else Map.insert ebHash point.pointSlotNo (Leios.acquiredEbBodies outstanding)
               }
     -- Persist and classify only a genuinely novel, still-relevant body. A
     -- duplicate (already in 'acquiredEbBodies') or a too-old arrival (its
@@ -811,13 +812,6 @@ msgLeiosBlock ktracer tracer (outstandingVar, readyVar) txCache db peerId req eb
                       misses
                 }
         pure (outstanding', bodyClass)
-  -- BUG INJECTION (temporary, revert me): grab #2, the deferred acquire. Between
-  -- the purge in grab #1 and this insert, a concurrent offer sees the hash
-  -- neither held nor listed and relists it; then this marks it held, leaving it
-  -- held-and-listed. ('tooOld' never fires in these tests, so the unconditional
-  -- insert matches the original behaviour there.)
-  MVar.modifyMVar_ outstandingVar $ \o ->
-    pure $ o {Leios.acquiredEbBodies = Map.insert ebHash point.pointSlotNo (Leios.acquiredEbBodies o)}
   void $ MVar.tryPutMVar readyVar ()
   traceWith ktracer $ TraceLeiosFetchBodyArrival bodyClass
   traceWith tracer $ MkTraceLeiosPeer $ "[done] MsgLeiosBlock " <> Leios.prettyLeiosPoint point

From b26c7690b7109f74898f53799934813c17d74902 Mon Sep 17 00:00:00 2001
From: Nicolas Frisby <nicolas.frisby@moduscreate.com>
Date: Thu, 13 Aug 2026 14:01:17 -0400
Subject: [PATCH 19/49] LeiosFetch & Forge: merge the announcement/body/closure
 handlers

The majority of each handler is now shared among the two sources of data:
upstream peers and our own forge.

This avoids code duplication and drift--we only have to get _most_ of the logic
(eg management of the LeiosFetch bookkeeping state) correct once and in one
place, since the forge is, in many ways, "just another source" for
announcements/bodies/closures.
---
 .../Ouroboros/Consensus/NodeKernel.hs         |  16 +-
 .../Ouroboros/Consensus/NodeKernel/Forge.hs   |  45 +-
 .../src/ouroboros-consensus/LeiosDemoLogic.hs | 466 +++++++++++-------
 .../src/ouroboros-consensus/LeiosDemoTypes.hs |   8 +-
 .../Test/LeiosDemoLogic/Invariants.hs         |  64 ++-
 5 files changed, 354 insertions(+), 245 deletions(-)

diff --git a/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/NodeKernel.hs b/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/NodeKernel.hs
index 3ef9fba0a8..542c2d03d3 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
@@ -790,11 +790,17 @@ forkBlockForging IS{..} (MkBlockForging blockForgingM) =
                     leiosVoteState
                     bf
                     leiosConn
-                    leiosTxCache
-                    ( Leios.processForgedAnnouncement
-                        (leiosKernelTracer tracers)
-                        leiosCentralState
-                        leiosOutstanding
+                    ( \forgedHeader forgedEb ->
+                        Leios.onForgedLeiosEb
+                          (leiosKernelTracer tracers)
+                          leiosCentralState
+                          (leiosOutstanding, leiosReady)
+                          leiosTxCache
+                          leiosConn
+                          -- Safe here: the forge hands us a corresponding header
+                          -- and closure.
+                          (Leios.mkForgedAnnouncingHeader forgedHeader forgedEb)
+                          forgedEb
                     )
                     currentSlot
     )
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 2d884d195c..8e002e0e17 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
@@ -28,16 +28,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 +98,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 afterForgeBeforeInsert 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 +261,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 $ afterForgeBeforeInsert (getHeader newBlock)
-
-  -- Persist the forged EB, but only /after/ 'afterForgeBeforeInsert' 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/src/ouroboros-consensus/LeiosDemoLogic.hs b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
index 71f9875dd5..ee2ec108e4 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
@@ -23,7 +23,7 @@ import Control.Monad (foldM, forM_, 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)
@@ -605,9 +605,9 @@ 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 (ReceivedBlockFrom peerId req) eb
       PendingBlockTxsResponse req txs ->
-        msgLeiosBlockTxs ktracer tracer kernelVars txCache db peerId req txs
+        processLeiosBlockTxs ktracer tracer kernelVars txCache db (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).
@@ -666,7 +666,28 @@ nextLeiosFetchClientCommand ktracer tracer stopSTM kernelVars txCache db peerId
 
 -----
 
-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 arrival
+-- panels 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. The tx bytes are the
+-- 'V.Vector LeiosTx' argument; 'ForgedTxs' additionally carries the forged EB's
+-- point and body so the tx hashes come from the body's 'leiosEbTxs' (aligned by
+-- position with the 'V.Vector LeiosTx') rather than being re-derived. Some of the
+-- carried fields are currently unused.
+data LeiosBlockTxsSource pid
+  = ReceivedTxsFrom (PeerId pid) LeiosBlockTxsRequest
+  | ForgedTxs !LeiosPoint !LeiosEb
+
+processLeiosBlock ::
   ( Ord pid
   , IOLike m
   ) =>
@@ -677,13 +698,14 @@ msgLeiosBlock ::
   ) ->
   LeiosTxCache m () () SerializedEbBody ->
   LeiosDbConnection m ->
-  PeerId pid ->
-  LeiosBlockRequest ->
+  LeiosBlockSource pid ->
   LeiosEb ->
   m ()
-msgLeiosBlock ktracer tracer (outstandingVar, readyVar) txCache db peerId req eb = do
+processLeiosBlock ktracer tracer (outstandingVar, readyVar) txCache db source eb = do
   -- 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
   let ebBytesSize' = leiosEbBytesSize eb
@@ -691,28 +713,32 @@ msgLeiosBlock ktracer tracer (outstandingVar, readyVar) txCache db peerId req eb
   let invalidReply reason =
         traceWith ktracer (TraceLeiosFetchBodyArrival (fetchArrivalInvalid ebBytesSize'))
           >> error reason
-  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)
-    -- Every referenced tx must be unique: 'reverseEbIndexByTx' records one
-    -- offset per (tx, EB), so a duplicate desyncs it from 'missingEbTxs'.
-    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
+  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)
+      -- Every referenced tx must be unique: 'reverseEbIndexByTx' records one
+      -- offset per (tx, EB), so a duplicate desyncs it from 'missingEbTxs'.
+      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
   bodyClass <- MVar.modifyMVar outstandingVar $ \outstanding -> do
     let tooOld = point.pointSlotNo < Leios.acquiredEbBodiesPrunedSlot outstanding
@@ -724,8 +750,11 @@ msgLeiosBlock ktracer tracer (outstandingVar, readyVar) txCache db peerId req eb
         -- 'missingEbBodies'); and unless the EB is too old to matter, remember we
         -- have it so we neither re-fetch nor re-offer it.
         !outstandingCleaned =
-          refundEbRequest peerId ebHash ebBytesSize $
-            outstanding
+          ( 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
@@ -774,25 +803,30 @@ msgLeiosBlock ktracer tracer (outstandingVar, readyVar) txCache db peerId req eb
           traceWith ktracer $ TraceLeiosBlockAcquired point
           forM_ completedByBody $ traceWith ktracer . TraceLeiosBlockTxsAcquired
           pure $ fmap snd mbSummaryMisses
-        (bodyClass, misses) <- case mbMissesFromBody of
-          -- 'BodyNotYetInserted': the announcement was present and we filled it.
-          Just ms -> pure (fetchArrivalGood ebBytesSize', ms)
-          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.
-            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)
+        (bodyClass, misses) <- 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)
+          ReceivedBlockFrom{} -> case mbMissesFromBody of
+            -- 'BodyNotYetInserted': the announcement was present and we filled it.
+            Just ms -> pure (fetchArrivalGood ebBytesSize', ms)
+            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.
+              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)
         let !outstanding' =
               outstandingCleaned
                 { Leios.blockingPerEb =
@@ -813,7 +847,9 @@ msgLeiosBlock ktracer tracer (outstandingVar, readyVar) txCache db peerId req eb
                 }
         pure (outstanding', bodyClass)
   void $ MVar.tryPutMVar readyVar ()
-  traceWith ktracer $ TraceLeiosFetchBodyArrival bodyClass
+  case source of
+    ForgedBlock{} -> pure () -- self-produced: not a fetch arrival
+    ReceivedBlockFrom{} -> traceWith ktracer $ TraceLeiosFetchBodyArrival bodyClass
   traceWith tracer $ MkTraceLeiosPeer $ "[done] MsgLeiosBlock " <> Leios.prettyLeiosPoint point
 
 -----
@@ -903,7 +939,7 @@ refundTxRequest peerId requestedTxPeers' txsBytesSize o
 
 -----
 
-msgLeiosBlockTxs ::
+processLeiosBlockTxs ::
   ( Ord pid
   , IOLike m
   ) =>
@@ -914,53 +950,57 @@ msgLeiosBlockTxs ::
   ) ->
   LeiosTxCache m () () SerializedEbBody ->
   LeiosDbConnection m ->
-  PeerId pid ->
-  LeiosBlockTxsRequest ->
+  LeiosBlockTxsSource pid ->
   V.Vector LeiosTx ->
   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
+processLeiosBlockTxs ktracer tracer (outstandingVar, readyVar) txCache db source txs = do
   let txBytess = V.map cbor txs
-  let batchBytes = V.sum (V.map BS.length txBytess)
-  -- A failed-validation batch: attribute the whole batch to 'fabInvalid'.
-  let invalidReply reason =
-        traceWith ktracer (TraceLeiosFetchTxsArrival (fetchArrivalInvalid (fromIntegral batchBytes)))
-          >> error reason
-  do
-    when (V.length txs /= V.length txHashes) $ do
-      invalidReply $ "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'
-      invalidReply $ "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
-  txArrival <- traceException tracer TraceLeiosPeerDbException $ do
+      batchBytes = V.sum (V.map BS.length txBytess)
+      -- The tx hashes: taken from the request for an arrival (and validated
+      -- below), derived from the txs themselves for a forge.
+      txHashes = case source of
+        ReceivedTxsFrom _ (MkLeiosBlockTxsRequest _ _ txHs) -> txHs
+        -- The body's tx list is position-aligned with the 'txs' vector, so use
+        -- its hashes rather than re-hashing the bytes we already hashed to forge.
+        ForgedTxs _ eb -> V.map fst (leiosEbTxs eb)
+  -- validate it (an arrival only; a forge's data is self-produced)
+  -- TODO: could validate the returned point + bitmaps too
+  case source of
+    ForgedTxs{} -> pure ()
+    ReceivedTxsFrom _ req -> do
+      traceWith tracer $ MkTraceLeiosPeer $ "[start] " ++ Leios.prettyLeiosBlockTxsRequest req
+      let invalidReply reason =
+            traceWith ktracer (TraceLeiosFetchTxsArrival (fetchArrivalInvalid (fromIntegral batchBytes)))
+              >> error reason
+      when (V.length txs /= V.length txHashes) $
+        invalidReply $ "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'
+        invalidReply $ "MsgLeiosBlockTxs hash mismatches: " ++ show mismatches
+  -- ingest: write to the LeiosDb, then the tx-cache. A forge tags its txs applied
+  -- (drawn from its validated mempool, so known-valid) and emits no fetch-arrival
+  -- telemetry; a peer's delivery tags them unapplied and is attributed to the
+  -- arrival panels. The cache insert follows the LeiosDb write, which is what the
+  -- index currently reflects.
+  traceException tracer TraceLeiosPeerDbException $ do
     completed <- leiosDbInsertTxs db (V.toList $ V.zip txHashes txBytess)
     forM_ completed $ traceWith ktracer . TraceLeiosBlockTxsAcquired
-    -- crucially: insert the txs into the TxCacheIndex _after_ they've been
-    -- written to the LeiosDb, since that's what the TxCacheIndex currently
-    -- indexes. The handle buckets each tx's bytes by its prior state in the same
-    -- locked pass -- coherent under concurrent duplicate deliveries; the returned
-    -- partition sums to the batch size.
-    withLockedInsertUnappliedTx txCache $ \w0 step ->
-      V.foldM'
-        (\w (txh, sz) -> step w txh sz ())
-        w0
-        (V.zip txHashes (V.map (fromIntegral . BS.length) txBytess))
-  traceWith ktracer $ TraceLeiosFetchTxsArrival txArrival
+    case source of
+      ForgedTxs{} ->
+        withLockedInsertAppliedTx txCache $ \w0 step ->
+          V.foldM' (\w txh -> step w txh ()) w0 txHashes
+      ReceivedTxsFrom{} -> do
+        -- The handle buckets each tx's bytes by its prior state in the same
+        -- locked pass -- coherent under concurrent duplicate deliveries; the
+        -- returned partition sums to the batch size.
+        txArrival <-
+          withLockedInsertUnappliedTx txCache $ \w0 step ->
+            V.foldM'
+              (\w (txh, sz) -> step w txh sz ())
+              w0
+              (V.zip txHashes (V.map (fromIntegral . BS.length) txBytess))
+        traceWith ktracer $ TraceLeiosFetchTxsArrival txArrival
   -- update NodeKernel state
   MVar.modifyMVar_ outstandingVar $ \outstanding -> do
     let removeTxFromMissing txHash mtxs =
@@ -970,43 +1010,61 @@ msgLeiosBlockTxs ktracer tracer (outstandingVar, readyVar) txCache db peerId req
               Map.foldrWithKey
                 ( \ebHash (slotsWithThisEb, offset, _sz) acc ->
                     foldr
-                      (\ebSlot ->
-                         Map.update
-                           (delIf IntMap.null . IntMap.delete offset)
-                           (MkLeiosPoint ebSlot ebHash)
+                      ( \ebSlot ->
+                          Map.update
+                            (delIf IntMap.null . IntMap.delete offset)
+                            (MkLeiosPoint ebSlot ebHash)
                       )
                       acc
                       slotsWithThisEb
                 )
                 mtxs
                 ebsWithThisTx
-    let (requestedTxPeers', reverseEbIndexByTx', missingEbTxs', txsBytesSize) =
+        -- Discharge the acquired txs by identity: remove each from 'missingEbTxs'
+        -- (every referencing point) and from 'reverseEbIndexByTx'. Shared by
+        -- arrivals and forges.
+        (reverseEbIndexByTx', missingEbTxs') =
           V.foldl'
-            ( \(!accReqs, !accRev, !accMtxs, !accSz) (txHash, txBytes) ->
-                ( Map.update (delIf Set.null . Set.delete peerId) txHash accReqs
-                , Map.delete txHash accRev   -- full delete from reverseEbIndexByTx
-                , removeTxFromMissing txHash accMtxs   -- full delete from missingEbTxs
-                , accSz + BS.length txBytes
+            ( \(!accRev, !accMtxs) txHash ->
+                ( Map.delete txHash accRev
+                , removeTxFromMissing txHash accMtxs
                 )
             )
-            ( Leios.requestedTxPeers outstanding
-            , Leios.reverseEbIndexByTx outstanding
-            , Leios.missingEbTxs outstanding
-            , 0
-            )
-            (txHashes `V.zip` txBytess)
-    let offsetsSet = IntSet.fromList offsets
-        -- the requests this MsgLeiosBlockTxs was the first to resolve for this
-        -- point (kept only to keep the best-effort 'blockingPerEb' roughly current)
-        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) $
+            (Leios.reverseEbIndexByTx outstanding, Leios.missingEbTxs outstanding)
+            txHashes
+    case source of
+      -- A forge answered no request and holds the whole closure, so there is no
+      -- peer budget to refund and no 'blockingPerEb' beat to record.
+      ForgedTxs{} ->
+        pure $
+          outstanding
+            { Leios.missingEbTxs = missingEbTxs'
+            , Leios.reverseEbIndexByTx = reverseEbIndexByTx'
+            }
+      ReceivedTxsFrom peerId (MkLeiosBlockTxsRequest point bitmaps _) -> do
+        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
+            -- Remove this peer from each delivered tx's requested-peers set.
+            requestedTxPeers' =
+              V.foldl'
+                (\acc txHash -> Map.update (delIf Set.null . Set.delete peerId) txHash acc)
+                (Leios.requestedTxPeers outstanding)
+                txHashes
+            offsetsSet = IntSet.fromList offsets
+            -- the requests this MsgLeiosBlockTxs was the first to resolve for this
+            -- point (kept only to keep the best-effort 'blockingPerEb' roughly current)
+            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 was already cancelled in bulk by a disconnect); the global
+        -- state below is updated unconditionally, since we did receive the txs.
+        pure $
+          refundTxRequest peerId requestedTxPeers' (fromIntegral batchBytes) $
             outstanding
               { Leios.missingEbTxs = missingEbTxs'
               , Leios.reverseEbIndexByTx = reverseEbIndexByTx'
@@ -1022,9 +1080,11 @@ msgLeiosBlockTxs ktracer tracer (outstandingVar, readyVar) txCache db peerId req
                         point
                         (Leios.blockingPerEb outstanding)
               }
-    pure outstanding'
   void $ MVar.tryPutMVar readyVar ()
-  traceWith tracer $ MkTraceLeiosPeer $ "[done] " ++ Leios.prettyLeiosBlockTxsRequest req
+  case source of
+    ForgedTxs{} -> pure ()
+    ReceivedTxsFrom _ req ->
+      traceWith tracer $ MkTraceLeiosPeer $ "[done] " ++ Leios.prettyLeiosBlockTxsRequest req
 
 -----
 
@@ -1140,6 +1200,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
@@ -1178,7 +1249,14 @@ processAnnouncementCentrally
         (contramap (traceNewAnnouncement provenance) kernelTracer)
         ancElId
         ( \_elSt -> do
-            recordAnnouncedEb txCache kernelVars (point, Leios.announcementEbBodySize fields)
+            -- Only a received announcement lists the EB for fetching; one we
+            -- forged is already held (the forge stores it via 'processLeiosBlock').
+            -- (A peer echoing our announcement back never re-enters this
+            -- first-sight callback -- our ForgedLocally sight already claimed it.)
+            case provenance of
+              ForgedLocally -> pure ()
+              ReceivedViaChainSync -> recordAnnounced
+              ReceivedViaLeiosNotify -> recordAnnounced
             recordAnnouncementInTxCache txCache ancHdr point
         )
         cst
@@ -1186,49 +1264,12 @@ processAnnouncementCentrally
         shouldRelay
         age
         ancHdr
-   where
-    fields = ancAnnouncementFields ancHdr
-    -- 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)
-
--- | Process this node's own freshly-forged EB announcement: relay it centrally
--- (as 'ForgedLocally', before the forge inserts the EB body — writing the body
--- is what offers it, so a downstream peer never gets the offer before the
--- announcement) and record the EB as acquired, so we neither re-fetch nor
--- re-offer the body we just forged. A no-op for a forged block that announces no
--- EB. 'forge' invokes this right after forging and before adoption (its
--- 'afterForgeBeforeInsert' callback).
-processForgedAnnouncement ::
-  forall blk peer pid m.
-  (IOLike m, ResolveLeiosBlock blk, HasHeader (Header blk), Ord peer) =>
-  Tracer m TraceLeiosKernel ->
-  MVar m (Announcements.CentralState m peer (AnnouncingHeader blk)) ->
-  MVar m (LeiosOutstanding pid) ->
-  Header blk ->
-  m ()
-processForgedAnnouncement kernelTracer centralVar outstandingVar forgedHeader =
-  forM_ (mkAnnouncingHeader forgedHeader) $ \anc -> do
-    MVar.modifyMVar_ centralVar $ \cst ->
-      Announcements.onAnnouncementCentral
-        (contramap (traceNewAnnouncement ForgedLocally) kernelTracer)
-        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
-    -- Record the forged EB as acquired: don't fetch the body we're about to
-    -- insert, and don't re-offer it when an offer or its CertRB comes back.
-    MVar.modifyMVar_ outstandingVar $ \outstanding ->
-      let ebSlot = blockSlot (ancHeader anc)
-          ebHash = announcementEbHash (ancAnnouncementFields anc)
-       in pure $
-            outstanding
-              { Leios.acquiredEbBodies =
-                  Map.insert ebHash ebSlot (Leios.acquiredEbBodies outstanding)
-              }
+ where
+  fields = ancAnnouncementFields ancHdr
+  -- 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 (point, Leios.announcementEbBodySize fields)
 
 -- | Thrown when a peer misbehaves on the announcement protocol; the ensuing
 -- thread death disconnects the peer. It carries the
@@ -1315,38 +1356,27 @@ announcementValidity systemTime futureCheck cfg immLedger hdr = do
 
 -- | 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.
+-- already acquired, already recorded, or too old (its slot is at or below the
+-- slot 'acquiredEbBodies' has been pruned to).
 recordAnnouncedEb ::
   IOLike m =>
-  LeiosTxCache m () () SerializedEbBody ->
   ( MVar m (LeiosOutstanding pid)
   , MVar m ()
   ) ->
   (LeiosPoint, BytesSize) ->
   m ()
-recordAnnouncedEb txCache (outstandingVar, readyVar) (point, ebBytesSize) =
-  txCache.lookupBody ebHash >>= \case
-    -- TODO once LeiosFetch is announcement-sensitive: a fresher announcement for
-    -- an EB we already hold should still raise its freshest-first priority, which
-    -- this branch drops.
-    --
-    -- Note that that priority applies to the diffusion of this EB's closure
-    -- too.
-    --
-    -- We're accepting that infelicity for now; the imminent LeiosFetch rewrite
-    -- will address this. But this handler will be what takes care of it:
-    -- updating an EB closure's priority is the reponsibility of the
-    -- announcement handler.
-    Just{} -> pure () -- we already hold this EB's body; nothing to fetch
-    Nothing -> do
-      changed <- MVar.modifyMVar outstandingVar (pure . upd)
-      when changed $ void $ MVar.tryPutMVar readyVar ()
+recordAnnouncedEb (outstandingVar, readyVar) (point, ebBytesSize) = do
+  changed <- MVar.modifyMVar outstandingVar (pure . upd)
+  when changed $ void $ MVar.tryPutMVar readyVar ()
  where
   MkLeiosPoint ebSlot ebHash = point
 
+  -- The same in-lock guard as 'recordEbBodyOffer' (too old / already held /
+  -- already listed). No cache lookup: 'acquiredEbBodies' is authoritative here.
   upd outstanding =
-    if Map.member ebHash (Leios.acquiredEbBodies outstanding)
-      || Map.member ebHash (Leios.reverseSlotIndexByEbHash outstanding)
+    if ebSlot < Leios.acquiredEbBodiesPrunedSlot outstanding -- too old to fetch
+      || Map.member ebHash (Leios.acquiredEbBodies outstanding) -- already have it
+      || Map.member ebHash (Leios.reverseSlotIndexByEbHash outstanding) -- already listed
       then (outstanding, False)
       else
         flip (,) True $
@@ -1427,3 +1457,59 @@ 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.
+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 ->
+  -- | 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 anc forgedEb = do
+  processAnnouncementCentrally
+    kernelTracer
+    centralVar
+    kv
+    txCache
+    Nothing
+    ForgedLocally
+    Announcements.DoRelay
+    Nothing
+    anc
+  processLeiosBlock
+    kernelTracer
+    nullTracer
+    kv
+    txCache
+    db
+    (ForgedBlock forgedEb.point)
+    forgedEb.body
+  processLeiosBlockTxs
+    kernelTracer
+    nullTracer
+    kv
+    txCache
+    db
+    (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 2ab374b7ab..4df21b1a46 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs
@@ -391,7 +391,7 @@ newLeiosPeerVars = do
 data LeiosOutstanding pid = MkLeiosOutstanding
   { -- EB-level tracking
     acquiredEbBodies :: !(Map EbHash SlotNo)
-  -- ^ The EB bodies we have already received, recorded by 'msgLeiosBlock' at
+  -- ^ The EB bodies we have already received, recorded by 'processLeiosBlock' at
   -- the moment of receipt, so that we neither re-fetch nor re-list one we
   -- already hold. The 'SlotNo' is the EB's election slot; an entry is dropped
   -- once that slot falls before the immutable tip (see
@@ -400,7 +400,7 @@ data LeiosOutstanding pid = MkLeiosOutstanding
   , acquiredEbBodiesPrunedSlot :: !SlotNo
   -- ^ The slot 'acquiredEbBodies' has most recently been pruned up to (see
   -- 'pruneOutstandingToImmTip'): entries below it have been dropped. Used as
-  -- the "too old" boundary by 'msgLeiosBlock' and the offer handler, so that
+  -- the "too old" boundary by 'processLeiosBlock' and the offer handler, so that
   -- test agrees with what has actually been pruned (it reads this under the
   -- same lock) rather than racing a separate read of the immutable tip.
   , missingEbBodies :: !(Map LeiosPoint BytesSize)
@@ -409,7 +409,7 @@ data LeiosOutstanding pid = MkLeiosOutstanding
   -- ^ 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) 'msgLeiosBlock' must clear every such point, and
+  -- 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.
@@ -455,7 +455,7 @@ data LeiosOutstanding pid = MkLeiosOutstanding
   --   into the DB (via @MsgLeiosBlockTxs@ handling).
   --
   -- TODO: 'blockingPerEb' can go permanently stale for txs shared across EBs.
-  -- 'msgLeiosBlockTxs' only decrements the entry for the EB it was requesting;
+  -- 'processLeiosBlockTxs' only decrements the entry for the EB it was requesting;
   -- a tx that also belongs to another EB B can reach the DB via a fetch
   -- attributed to a different EB, so B never fetches it itself -- and B's
   -- 'blockingPerEb' is never decremented for that tx and stays > 0. This is
diff --git a/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic/Invariants.hs b/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic/Invariants.hs
index ed00c97806..72710f2fb1 100644
--- a/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic/Invariants.hs
+++ b/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic/Invariants.hs
@@ -6,7 +6,7 @@
 --
 -- 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 ('msgLeiosBlock', 'msgLeiosBlockTxs',
+-- /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
@@ -54,10 +54,12 @@ import LeiosDemoDb (withLeiosDb)
 import qualified LeiosDemoDb as LeiosDb
 import LeiosDemoLogic
   ( AlsoOfferedTxsClosure (..)
+  , LeiosBlockSource (..)
+  , LeiosBlockTxsSource (..)
   , LeiosFetchDecisions (..)
   , leiosFetchLogicIteration
-  , msgLeiosBlock
-  , msgLeiosBlockTxs
+  , processLeiosBlock
+  , processLeiosBlockTxs
   , recordAnnouncedEb
   , recordEbBodyOffer
   )
@@ -99,6 +101,10 @@ tests =
             runCmds reproMultiSlot @?= Right ()
         , testCase "tx shared across two EBs: delivery discharges both" $
             runCmds reproSharedTx @?= Right ()
+        , testCase "forge purges a body it already holds (offered first)" $
+            runCmdsReFetchViolations reproForgeAfterOffer @?= Right []
+        , testCase "forge discharges a tx a peer EB still needs" $
+            runCmds reproForgeSharedTx @?= Right ()
         ]
     , testProperty
         "missingEbTxs stays in sync with reverseEbIndexByTx across arbitrary sequences"
@@ -125,12 +131,16 @@ data Cmd
     Announce TestEb Word
   | -- | @recordEbBodyOffer@: a peer offers this EB body at this slot.
     Offer TestEb Word
-  | -- | @msgLeiosBlock@: the EB body arrives for that point.
+  | -- | @processLeiosBlock@: the EB body arrives for that point.
     ArriveBody TestEb Word
-  | -- | @msgLeiosBlockTxs@: deliver the tx at this /index within the EB/.
+  | -- | @processLeiosBlockTxs@: deliver the tx at this /index within the EB/.
     ArriveTx TestEb Word Int
   | -- | @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)
 
 ------------------------------------------------------------
@@ -213,7 +223,7 @@ applyCmd ::
   IOSim s [EbHash]
 applyCmd conn txCache kv peerVars peerId = \case
   Announce ids slot -> do
-    recordAnnouncedEb txCache kv (pointOf ids slot, leiosEbBytesSize (ebOf ids))
+    recordAnnouncedEb kv (pointOf ids slot, leiosEbBytesSize (ebOf ids))
     pure []
   Offer ids slot -> do
     recordEbBodyOffer kv peerVars TxsClosureNotAlsoOffered (pointOf ids slot, leiosEbBytesSize (ebOf ids))
@@ -221,7 +231,7 @@ applyCmd conn txCache kv peerVars peerId = \case
   ArriveBody ids slot -> do
     let eb = ebOf ids
         req = MkLeiosBlockRequest (pointOf ids slot) (leiosEbBytesSize eb)
-    msgLeiosBlock nullTracer nullTracer kv txCache conn peerId req eb
+    processLeiosBlock nullTracer nullTracer kv txCache conn (ReceivedBlockFrom peerId req) eb
     pure []
   ArriveTx ids slot idx -> do
     let txId = ids !! idx
@@ -230,7 +240,15 @@ applyCmd conn txCache kv peerVars peerId = \case
             (pointOf ids slot)
             (offsetsToBitmaps [idx])
             (V.singleton (txHashOf txId))
-    msgLeiosBlockTxs nullTracer nullTracer kv txCache conn peerId req (V.singleton (leiosTxOf txId))
+    processLeiosBlockTxs nullTracer nullTracer kv txCache conn (ReceivedTxsFrom peerId req) (V.singleton (leiosTxOf txId))
+    pure []
+  Forge ids slot -> do
+    let eb = ebOf ids
+        point = pointOf ids slot
+    -- The outstanding-state half of 'onForgedLeiosEb'; the announcement it also
+    -- makes doesn't touch 'outstanding' for a 'ForgedLocally' source.
+    processLeiosBlock nullTracer nullTracer kv txCache conn (ForgedBlock point) eb
+    processLeiosBlockTxs nullTracer nullTracer kv txCache conn (ForgedTxs point eb) (V.fromList (map leiosTxOf ids))
     pure []
   Decide slot -> do
     outstanding <- readMVar (fst kv)
@@ -333,6 +351,28 @@ reproSharedTx =
   , Decide 12
   ]
 
+-- | A peer offers an EB body; we forge the same EB before the offered body
+-- arrives. Forging must purge the offered body from 'missingEbBodies' (it now
+-- lives in 'acquiredEbBodies'), 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
+  ]
+
+-- | A peer's EB still needs a tx that our own forged EB's closure supplies.
+-- Forging must discharge it from that EB's 'missingEbTxs' (as delivering it via
+-- 'ArriveTx' would), keeping the missing sets consistent.
+reproForgeSharedTx :: [Cmd]
+reproForgeSharedTx =
+  [ ArriveBody [1, 2] 10
+  , Forge [0, 1] 12
+  , Decide 13
+  ]
+
 ------------------------------------------------------------
 -- Property
 ------------------------------------------------------------
@@ -352,6 +392,7 @@ genCmd = do
     , pure (Offer ids slot)
     , pure (ArriveBody ids slot)
     , ArriveTx ids slot <$> choose (0, length ids - 1)
+    , pure (Forge ids slot)
     , Decide <$> elements worldSlots
     ]
 
@@ -447,15 +488,14 @@ raceSameHashMultiSlot = do
     concurrently_
       (recordEbBodyOffer kv peerVars TxsClosureNotAlsoOffered (offerPoint, ebBytesSize))
       ( concurrently_
-          (recordAnnouncedEb txCache kv (announcePoint, ebBytesSize))
-          ( msgLeiosBlock
+          (recordAnnouncedEb kv (announcePoint, ebBytesSize))
+          ( processLeiosBlock
               nullTracer
               nullTracer
               kv
               txCache
               conn
-              peerId
-              (MkLeiosBlockRequest arrivalPoint ebBytesSize)
+              (ReceivedBlockFrom peerId (MkLeiosBlockRequest arrivalPoint ebBytesSize))
               eb
           )
       )

From e1bba101ed8acc9fe03f3a2bfd506eab698a0b22 Mon Sep 17 00:00:00 2001
From: Nicolas Frisby <nicolas.frisby@moduscreate.com>
Date: Thu, 13 Aug 2026 14:16:43 -0400
Subject: [PATCH 20/49] LeiosFetch.Invariants: 10x tests and some coverage
 indicators

---
 .../Test/LeiosDemoLogic/Invariants.hs         | 72 ++++++++++++++++---
 1 file changed, 64 insertions(+), 8 deletions(-)

diff --git a/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic/Invariants.hs b/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic/Invariants.hs
index 72710f2fb1..6984674505 100644
--- a/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic/Invariants.hs
+++ b/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic/Invariants.hs
@@ -90,10 +90,12 @@ import Test.Tasty (TestTree, testGroup)
 import Test.Tasty.HUnit (testCase, (@?=))
 import Test.Tasty.QuickCheck (testProperty)
 import Test.Util.Orphans.IOLike ()
+import Test.Util.TestEnv (adjustQuickCheckTests)
 
 tests :: TestTree
 tests =
-  testGroup
+  -- 10x whatever '--quickcheck-tests' supplies, for every property below.
+  adjustQuickCheckTests (* 10) $ testGroup
     "LeiosDemoLogic.Invariants"
     [ testGroup
         "curated sequences"
@@ -396,10 +398,63 @@ genCmd = do
     , 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
+
+-- | A peer EB body arrived, then a /different/ EB sharing one of its txs is
+-- forged: the tx forge hazard, where forging must discharge the shared tx.
+arrivedThenForgedSharingTx :: [Cmd] -> Bool
+arrivedThenForgedSharingTx cmds =
+  or
+    [ arrivedIds /= ids && any (`elem` ids) arrivedIds
+    | (i, Forge ids _) <- zip [0 :: Int ..] cmds
+    , ArriveBody arrivedIds _ <- take i cmds
+    ]
+
+-- | 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)" $
+        cover 10 (arrivedThenForgedSharingTx cmds) "arrived then forged, shared tx (tx hazard)" $
+          property prop
+
 prop_invariants :: Property
 prop_invariants =
   forAllShrink (listOf genCmd) (shrinkList (const [])) $ \cmds ->
-    runCmds cmds === Right ()
+    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
@@ -414,12 +469,13 @@ prop_invariants =
 prop_neverRefetchesHeldBody :: Property
 prop_neverRefetchesHeldBody =
   forAllShrink (listOf genCmd) (shrinkList (const [])) $ \cmds ->
-    case runCmdsReFetchViolations cmds of
-      Left msg -> counterexample msg (property False)
-      Right violations ->
-        counterexample
-          ("fetch requested already-held EB bodies: " ++ show violations)
-          (null violations)
+    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

From 481629b58432d9c5867e5fb16c1921d03c674b37 Mon Sep 17 00:00:00 2001
From: Nicolas Frisby <nicolas.frisby@moduscreate.com>
Date: Tue, 11 Aug 2026 17:18:18 -0400
Subject: [PATCH 21/49] DONOTMERGE reduce fetch multiplicity to 1, for more
 obvious Grafana metrics

---
 ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs
index 4df21b1a46..9cb5e1209d 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs
@@ -584,8 +584,8 @@ demoLeiosFetchStaticEnv =
     { maxRequestedBytesSize = 50 * million
     , maxRequestedBytesSizePerPeer = 5 * million
     , maxRequestBytesSize = 500 * thousand
-    , maxRequestsPerEb = 2
-    , maxRequestsPerTx = 2
+    , maxRequestsPerEb = 1
+    , maxRequestsPerTx = 1
     , maxLeiosNotifyIngressQueue = 1 * millionBase2
     , maxLeiosFetchIngressQueue = 50 * millionBase2
     }

From 2d7c06c9cb5f3e91233806ed8ac2c627357b2279 Mon Sep 17 00:00:00 2001
From: Nicolas Frisby <nicolas.frisby@moduscreate.com>
Date: Fri, 14 Aug 2026 13:48:48 -0400
Subject: [PATCH 22/49] LeiosFetch: bugfix in EB announcement/body-arrival
 tracking

The refactor in this commit fixes two problems.

- Pruning of the list of already-arrived EB bodies is not sublinear.

- Younger announcements of the same EbHash will now forestall it from being
  pruned out the list of already-arrived EB bodies.
---
 .../src/ouroboros-consensus/LeiosDemoLogic.hs |  99 +++++-----
 .../src/ouroboros-consensus/LeiosDemoTypes.hs | 169 ++++++++++++++----
 .../Test/LeiosDemoLogic/Invariants.hs         | 110 +++++++++---
 3 files changed, 276 insertions(+), 102 deletions(-)

diff --git a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
index ee2ec108e4..ef3fb7078f 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
@@ -742,7 +742,7 @@ processLeiosBlock ktracer tracer (outstandingVar, readyVar) txCache db source eb
   -- ingest it
   bodyClass <- MVar.modifyMVar outstandingVar $ \outstanding -> do
     let tooOld = point.pointSlotNo < Leios.acquiredEbBodiesPrunedSlot outstanding
-        novel = not $ Map.member ebHash (Leios.acquiredEbBodies 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
@@ -754,6 +754,7 @@ processLeiosBlock ktracer tracer (outstandingVar, readyVar) txCache db source eb
               Just peerId -> refundEbRequest peerId ebHash ebBytesSize
               Nothing -> id
           )
+            $ (if tooOld then id else Leios.insertAcquiredEbBody ebHash)
             $ outstanding
               { Leios.missingEbBodies =
                   case Map.lookup ebHash (Leios.reverseSlotIndexByEbHash outstanding) of
@@ -765,16 +766,12 @@ processLeiosBlock ktracer tracer (outstandingVar, readyVar) txCache db source eb
                             slots
               , Leios.reverseSlotIndexByEbHash =
                   Map.delete ebHash (Leios.reverseSlotIndexByEbHash outstanding)
-              , Leios.acquiredEbBodies =
-                  if tooOld
-                    then Leios.acquiredEbBodies outstanding
-                    else Map.insert ebHash point.pointSlotNo (Leios.acquiredEbBodies outstanding)
               }
     -- Persist and classify only a genuinely novel, still-relevant body. A
-    -- duplicate (already in 'acquiredEbBodies') or a too-old arrival (its
-    -- 'acquiredEbBodies' slot has been pruned, so 'novel' can't be trusted) is
-    -- left at the bookkeeping above -- in particular no second
-    -- 'leiosDbInsertEbBody', hence no duplicate 'AcquiredEb'/re-offer.
+    -- 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
@@ -1098,11 +1095,10 @@ data AlsoOfferedTxsClosure = TxsClosureAlsoOffered | TxsClosureNotAlsoOffered
 -- 'MsgLeiosBlockOffer' handler and by the CertRB roll-forward path in
 -- 'checkMsgRollForwardForLeiosOffers'.
 --
--- The body is /not/ added to 'missingEbBodies' if it is: too old (at or below
--- the slot 'acquiredEbBodies' has been pruned to), already recorded in
--- 'acquiredEbBodies' (received or forged — the only "do we have it" test now,
--- read in-lock with no cache lookup), already listed under this content hash, or
--- zero-sized.
+-- 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
@@ -1121,22 +1117,32 @@ recordEbBodyOffer ::
 recordEbBodyOffer (outstandingVar, readyVar) peerVars offeredClosure (point, ebBytesSize) = do
   let MkLeiosPoint ebSlot ebHash = point
   MVar.modifyMVar_ outstandingVar $ \outstanding ->
-    pure $
-      if ebSlot < Leios.acquiredEbBodiesPrunedSlot outstanding -- too old to fetch
-        || ebBytesSize == 0 -- malformed offer
-        || Map.member ebHash (Leios.acquiredEbBodies outstanding) -- already have it
-        || Map.member ebHash (Leios.reverseSlotIndexByEbHash outstanding) -- already listed
-        then outstanding
-        else
-          outstanding
+    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 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)
+                Map.insert point ebBytesSize (Leios.missingEbBodies outstanding')
             , Leios.reverseSlotIndexByEbHash =
                 Map.insertWith
                   NESet.union
                   ebHash
                   (NESet.singleton ebSlot)
-                  (Leios.reverseSlotIndexByEbHash outstanding)
+                  (Leios.reverseSlotIndexByEbHash outstanding')
             }
   MVar.modifyMVar_ (Leios.offerings peerVars) $ \(offers1, offers2) -> do
     let !offers1' = Set.insert ebHash offers1
@@ -1354,10 +1360,8 @@ announcementValidity systemTime futureCheck cfg immLedger hdr = do
               Right (StaleOCIN, _v) -> VerdictIgnore
               Right (FreshOCIN, v) -> VerdictProcess (shouldRelay, 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, already recorded, or too old (its slot is at or below the
--- slot 'acquiredEbBodies' has been pruned to).
+-- | Record a validated, newly-announced EB body as missing, unless its already
+-- pruned\/tracked\/acquired
 recordAnnouncedEb ::
   IOLike m =>
   ( MVar m (LeiosOutstanding pid)
@@ -1372,24 +1376,29 @@ recordAnnouncedEb (outstandingVar, readyVar) (point, ebBytesSize) = do
   MkLeiosPoint ebSlot ebHash = point
 
   -- The same in-lock guard as 'recordEbBodyOffer' (too old / already held /
-  -- already listed). No cache lookup: 'acquiredEbBodies' is authoritative here.
+  -- already listed). No cache lookup: 'ebState' is authoritative here.
   upd outstanding =
-    if ebSlot < Leios.acquiredEbBodiesPrunedSlot outstanding -- too old to fetch
-      || Map.member ebHash (Leios.acquiredEbBodies outstanding) -- already have it
-      || Map.member ebHash (Leios.reverseSlotIndexByEbHash outstanding) -- already listed
-      then (outstanding, False)
-      else
-        flip (,) True $
-          outstanding
-            { Leios.missingEbBodies =
-                Map.insert point ebBytesSize (Leios.missingEbBodies outstanding)
-            , Leios.reverseSlotIndexByEbHash =
-                Map.insertWith
-                  NESet.union
-                  ebHash
-                  (NESet.singleton ebSlot)
-                  (Leios.reverseSlotIndexByEbHash outstanding)
-            }
+    let tooOld = ebSlot < Leios.acquiredEbBodiesPrunedSlot outstanding -- too old to fetch
+        !outstanding'
+          | tooOld = outstanding
+          | otherwise = Leios.recordMaxAnnouncementSlot ebHash ebSlot 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 =>
diff --git a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs
index 9cb5e1209d..78187192fb 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs
@@ -390,19 +390,24 @@ newLeiosPeerVars = do
 --    data structures for clarity.
 data LeiosOutstanding pid = MkLeiosOutstanding
   { -- EB-level tracking
-    acquiredEbBodies :: !(Map EbHash SlotNo)
-  -- ^ The EB bodies we have already received, recorded by 'processLeiosBlock' at
-  -- the moment of receipt, so that we neither re-fetch nor re-list one we
-  -- already hold. The 'SlotNo' is the EB's election slot; an entry is dropped
-  -- once that slot falls before the immutable tip (see
-  -- 'pruneOutstandingToImmTip'), below which the EB can never be requested
-  -- again, which keeps this bounded to the volatile window.
+    ebState :: !(Map EbHash EbState)
+  -- ^ Per-EB state for every EB we have seen announced (or offered)
+  --
+  -- 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'
+  --
+  -- Used to accelerate pruning.
+  --
+  -- TODO will also be redundant with by 'CentralState.selfPeer.live' once
+  -- offers are no longer trusted.
   , acquiredEbBodiesPrunedSlot :: !SlotNo
-  -- ^ The slot 'acquiredEbBodies' has most recently been pruned up to (see
-  -- 'pruneOutstandingToImmTip'): entries below it have been dropped. Used as
-  -- the "too old" boundary by 'processLeiosBlock' and the offer handler, so that
-  -- test agrees with what has actually been pruned (it reads this under the
-  -- same lock) rather than racing a separate read of the immutable tip.
+  -- ^ The slot 'ebState' has most recently been pruned up to (see
+  -- 'pruneOutstandingToImmTip').
+  --
+  -- 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))
@@ -413,6 +418,7 @@ data LeiosOutstanding pid = MkLeiosOutstanding
   -- 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
@@ -466,14 +472,15 @@ data LeiosOutstanding pid = MkLeiosOutstanding
   -- anything, reconcile it against shared-tx arrivals (or derive it from the DB).
   }
 
--- | The empty outstanding state, given the slot 'acquiredEbBodies' is
--- considered already 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
+-- | 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').
 emptyLeiosOutstanding :: SlotNo -> LeiosOutstanding pid
 emptyLeiosOutstanding prunedSlot =
   MkLeiosOutstanding
-    { acquiredEbBodies = Map.empty
+    { ebState = Map.empty
+    , ebsPerMaxAnnouncementSlot = Map.empty
     , acquiredEbBodiesPrunedSlot = prunedSlot
     , missingEbBodies = Map.empty
     , reverseSlotIndexByEbHash = Map.empty
@@ -486,26 +493,126 @@ emptyLeiosOutstanding prunedSlot =
     , blockingPerEb = Map.empty
     }
 
--- | Drop 'acquiredEbBodies' entries whose EB election slot is before the
--- immutable tip. Such an EB can never be requested again, so the record of
--- having it is no longer needed to suppress a fetch; this is what bounds
--- 'acquiredEbBodies' to the volatile window. Safe only because the offer/
--- announcement paths ignore an EB that old (so a pruned entry cannot be
--- re-listed).
+-- | Per-EB state tracked in 'ebState'
+data EbState =
+  -- | the greatest slot at which the EB has been announced (TODO or, for now,
+  -- offered), together with the current progress of fetching it
+  MkEbState !SlotNo !EbFetchState
+  deriving (Eq, Show)
+
+-- | Whether we hold an EB's body.
+data EbFetchState
+  = NoBody
+  | BodyAcquired
+  deriving (Eq, Show)
+
+ebStateMaxSlot :: EbState -> SlotNo
+ebStateMaxSlot (MkEbState slot _fetchState) = slot
+
+-- | 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 fetchState) = case fetchState of
+  NoBody -> False
+  BodyAcquired -> True
+
+insertAcquiredEbBody ::
+  EbHash -> LeiosOutstanding pid -> LeiosOutstanding pid
+insertAcquiredEbBody ebHash =
+  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 fetchState) -> case fetchState of
+      BodyAcquired -> Nothing
+      NoBody -> Just $ MkEbState slot BodyAcquired
+
+-- | Record that the EB with this hash is referenced (announced or offered) at this
+-- slot
 --
--- TODO this scans the whole map (potentially ~20k entries) on every
--- immutable-tip advance. Maintain a slot-keyed reverse index (e.g.
--- 'Map SlotNo (Set EbHash)') alongside 'acquiredEbBodies' so pruning drops the
--- below-tip prefix directly instead of filtering the entire map.
+-- 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.
+recordMaxAnnouncementSlot ::
+  EbHash -> SlotNo -> LeiosOutstanding pid -> LeiosOutstanding pid
+recordMaxAnnouncementSlot ebHash slot =
+  alterEbState ebHash $ \mbOld -> case mbOld of
+    Nothing -> Just $ MkEbState slot NoBody
+    Just (MkEbState oldSlot fetchState) ->
+      if slot <= oldSlot then Nothing else Just $ MkEbState slot fetchState
+
+-- | 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 ->
+  (Maybe EbState -> Maybe EbState) ->
+  -- ^ REQUIREMENT: must not reduce 'ebStateMaxSlot'
+  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
+--
+-- Uses the 'ebsPerMaxAnnouncementSlot' reverse index to drop the below-tip prefix
+-- directly (@spanAntitone@), rather than scanning the whole map.
 --
--- TODO only prunes acqiuredEbBodies for now; there's plenty more for it to be
--- pruning
+-- TODO still more it could prune (e.g. abandoned in-flight EB requests).
 pruneOutstandingToImmTip :: SlotNo -> LeiosOutstanding pid -> LeiosOutstanding pid
 pruneOutstandingToImmTip immTipSlot outstanding =
   outstanding
-    { acquiredEbBodies = Map.filter (>= immTipSlot) (acquiredEbBodies 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 (one tuple per peer: the EB-body
 -- offers and the EB-tx-closure offers it has sent). Each offered EB hash is
@@ -533,7 +640,7 @@ prettyLeiosOutstanding :: LeiosOutstanding pid -> String
 prettyLeiosOutstanding x =
   unlines $
     map ("    [leios] " ++) $
-      [ "acquiredEbBodies = " ++ show (Map.size acquiredEbBodies)
+      [ "ebState = " ++ show (Map.size ebState)
       , "missingEbBodies = " ++ show (Map.size missingEbBodies)
       , "reverseSlotIndexByEbHash = " ++ show (Map.size reverseSlotIndexByEbHash)
       , "requestedEbPeers = " ++ unwords (map prettyEbHash (Map.keys requestedEbPeers))
@@ -548,7 +655,7 @@ prettyLeiosOutstanding x =
       ]
  where
   MkLeiosOutstanding
-    { acquiredEbBodies
+    { ebState
     , missingEbBodies
     , reverseSlotIndexByEbHash
     , requestedEbPeers
diff --git a/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic/Invariants.hs b/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic/Invariants.hs
index 6984674505..e93516490f 100644
--- a/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic/Invariants.hs
+++ b/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic/Invariants.hs
@@ -22,7 +22,7 @@
 -- 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 already in 'acquiredEbBodies'.
+-- 'Decide' it checks that no body just requested is one we already hold.
 -- Phrasing it as "already held" rather than a request count keeps it correct if
 -- 'maxRequestsPerEb' rises above 1: requesting a not-yet-held body from several
 -- peers is fine; re-requesting a held one is not.
@@ -108,6 +108,47 @@ tests =
         , testCase "forge discharges a tx a peer EB still needs" $
             runCmds reproForgeSharedTx @?= Right ()
         ]
+    , testCase "acquired EB kept until its greatest slot is below the immutable tip" $ do
+        let h = hashLeiosEb (ebOf [0, 1])
+            -- announce at slot 5, then again at the smaller slot 3, and acquire
+            o =
+              Leios.insertAcquiredEbBody h $
+                Leios.recordMaxAnnouncementSlot h (SlotNo 3) $
+                  Leios.recordMaxAnnouncementSlot h (SlotNo 5) $
+                    (emptyLeiosOutstanding (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) Leios.BodyAcquired)
+        -- kept while the greatest slot (5) is at/above the immutable tip (4)
+        Map.lookup h (Leios.ebState (Leios.pruneOutstandingToImmTip (SlotNo 4) o))
+          @?= Just (Leios.MkEbState (SlotNo 5) Leios.BodyAcquired)
+        -- dropped once the greatest slot (5) is below the immutable tip (6)
+        Map.lookup h (Leios.ebState (Leios.pruneOutstandingToImmTip (SlotNo 6) o))
+          @?= Nothing
+    , 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 (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 = 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
         "missingEbTxs stays in sync with reverseEbIndexByTx across arbitrary sequences"
         prop_invariants
@@ -180,8 +221,8 @@ 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 being in
--- 'acquiredEbBodies'), gathered across all 'Decide's. That list is the
+-- 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]
@@ -212,7 +253,7 @@ runCmdsReFetchViolations cmds = runSimOrThrow (go cmds)
       loop [] cs0
 
 -- | Apply a command, returning any EB bodies it requested that are already held
--- (in 'acquiredEbBodies') — the re-fetch-storm violation. Empty for everything
+-- (per 'ebStateHasBody') — the re-fetch-storm violation. Empty for everything
 -- but a misbehaving 'Decide'.
 applyCmd ::
   forall s.
@@ -264,10 +305,10 @@ applyCmd conn txCache kv peerVars peerId = \case
     _ <- evaluate out'
     _ <- evaluate (forceDecisions decs)
     modifyMVar_ (fst kv) (\_ -> pure out')
-    -- Regression: the fetch logic must not request a body already in
-    -- 'acquiredEbBodies'. Return any it did (empty when well-behaved).
-    let held = Leios.acquiredEbBodies outstanding
-    pure (filter (\h -> Map.member h held) (ebBodyRequestHashes decs))
+    -- 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))
 
 -- | Every EbHash currently referenced by the outstanding state (bodies + txs),
 -- as an all-offering peer's body\/closure sets.
@@ -306,7 +347,8 @@ ebBodyRequestHashes (MkLeiosFetchDecisions m) =
 -- exact (EbHash, slot, offset) 'go1'/'goTx2' will look it up by. Its violation
 -- is what @impossible! leiosFetchLogicIteration go1@ reports.
 checkInvariant :: LeiosOutstanding Int -> Either String ()
-checkInvariant o =
+checkInvariant o = do
+  -- Every tx tracked as missing must be resolvable in the reverse index.
   case
     [ msg
     | (p, txs) <- Map.toList (Leios.missingEbTxs o)
@@ -315,8 +357,23 @@ checkInvariant o =
     ] of
     [] -> Right ()
     (msg : _) -> Left msg
+  -- 'ebsPerMaxAnnouncementSlot' must be the exact inverse of the greatest-slot
+  -- field of 'ebState' (the reverse index 'pruneOutstandingToImmTip' prunes by).
+  if Leios.ebsPerMaxAnnouncementSlot o == inverseOfMax
+    then Right ()
+    else
+      Left
+        ( "ebsPerMaxAnnouncementSlot desynced from ebState: "
+            <> show (Leios.ebsPerMaxAnnouncementSlot o, inverseOfMax)
+        )
  where
   rev = Leios.reverseEbIndexByTx o
+  inverseOfMax =
+    Map.fromListWith
+      NESet.union
+      [ (Leios.ebStateMaxSlot s, NESet.singleton h)
+      | (h, s) <- Map.toList (Leios.ebState o)
+      ]
   resolvable p off txHash =
     case Map.lookup txHash rev of
       Nothing ->
@@ -354,9 +411,9 @@ reproSharedTx =
   ]
 
 -- | A peer offers an EB body; we forge the same EB before the offered body
--- arrives. Forging must purge the offered body from 'missingEbBodies' (it now
--- lives in 'acquiredEbBodies'), so the fetch logic never re-requests a body we
--- already hold. Pre-fix the forge recorded the body as acquired without purging,
+-- 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 =
@@ -458,14 +515,14 @@ prop_invariants =
 
 -- | 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 in 'acquiredEbBodies'). The storm was precisely
+-- 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, so it stays correct if
 -- 'maxRequestsPerEb' rises above 1: 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 'acquiredEbBodies' check is cache-independent.)
+-- re-list/re-request endlessly; the 'ebStateHasBody' check is cache-independent.)
 prop_neverRefetchesHeldBody :: Property
 prop_neverRefetchesHeldBody =
   forAllShrink (listOf genCmd) (shrinkList (const [])) $ \cmds ->
@@ -486,19 +543,20 @@ prop_neverRefetchesHeldBody =
 -- 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 two-lock structure this test exists to probe -- the
--- shared cache, and the announcement path's cross-lock 'lookupBody' -- in plain
--- view at the race site.
+-- 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 a cross-lock race
--- straddling a concurrent body insert. 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, whose "do we
--- already hold it?" read hits the pure 'newPureLeiosTxCache', a lock distinct
--- from the outstanding lock, before it touches the outstanding state), and a body
--- arrival (slot 12, different from both) — and uses IOSimPOR to explore every
--- interleaving.
+-- 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
@@ -556,7 +614,7 @@ raceSameHashMultiSlot = do
           )
       )
     outstanding <- readMVar outstandingVar
-    let held = Map.keysSet (Leios.acquiredEbBodies outstanding)
+    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)

From 536b8891577c8dc7f6ffbe3ccda060fd769d5172 Mon Sep 17 00:00:00 2001
From: Nicolas Frisby <nicolas.frisby@moduscreate.com>
Date: Tue, 18 Aug 2026 16:23:41 -0400
Subject: [PATCH 23/49] LeiosFetch: delete blockingPerEb from LeiosOutstanding

This field was 1) unused---superseded by the missingTxCount column in the SQLite
database, eg---and 2) incorrectly maintained.
---
 .../src/ouroboros-consensus/LeiosDemoLogic.hs | 34 +++----------------
 .../src/ouroboros-consensus/LeiosDemoTypes.hs | 28 ---------------
 2 files changed, 4 insertions(+), 58 deletions(-)

diff --git a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
index ef3fb7078f..40be063e81 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
@@ -31,7 +31,6 @@ import qualified Data.DList as DList
 import Data.Functor (void, (<&>))
 import Data.IntMap (IntMap)
 import qualified Data.IntMap as IntMap
-import qualified Data.IntSet as IntSet
 import Data.List (unfoldr)
 import Data.Map (Map)
 import qualified Data.Map.Strict as Map
@@ -826,9 +825,7 @@ processLeiosBlock ktracer tracer (outstandingVar, readyVar) txCache db source eb
               pure (fetchArrivalEvicted ebBytesSize', ms)
         let !outstanding' =
               outstandingCleaned
-                { Leios.blockingPerEb =
-                    Map.insert point (IntMap.size misses) (Leios.blockingPerEb outstandingCleaned)
-                , Leios.missingEbTxs =
+                { Leios.missingEbTxs =
                     Map.insert point misses (Leios.missingEbTxs outstandingCleaned)
                 , Leios.reverseEbIndexByTx =
                     IntMap.foldrWithKey
@@ -1031,32 +1028,20 @@ processLeiosBlockTxs ktracer tracer (outstandingVar, readyVar) txCache db source
             txHashes
     case source of
       -- A forge answered no request and holds the whole closure, so there is no
-      -- peer budget to refund and no 'blockingPerEb' beat to record.
+      -- peer budget to refund
       ForgedTxs{} ->
         pure $
           outstanding
             { Leios.missingEbTxs = missingEbTxs'
             , Leios.reverseEbIndexByTx = reverseEbIndexByTx'
             }
-      ReceivedTxsFrom peerId (MkLeiosBlockTxsRequest point bitmaps _) -> do
-        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
-            -- Remove this peer from each delivered tx's requested-peers set.
+      ReceivedTxsFrom peerId _req -> do
+        let -- Remove this peer from each delivered tx's requested-peers set.
             requestedTxPeers' =
               V.foldl'
                 (\acc txHash -> Map.update (delIf Set.null . Set.delete peerId) txHash acc)
                 (Leios.requestedTxPeers outstanding)
                 txHashes
-            offsetsSet = IntSet.fromList offsets
-            -- the requests this MsgLeiosBlockTxs was the first to resolve for this
-            -- point (kept only to keep the best-effort 'blockingPerEb' roughly current)
-            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 was already cancelled in bulk by a disconnect); the global
         -- state below is updated unconditionally, since we did receive the txs.
@@ -1065,17 +1050,6 @@ processLeiosBlockTxs ktracer tracer (outstandingVar, readyVar) txCache db source
             outstanding
               { Leios.missingEbTxs = missingEbTxs'
               , 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)
               }
   void $ MVar.tryPutMVar readyVar ()
   case source of
diff --git a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs
index 78187192fb..20acd774e4 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs
@@ -446,30 +446,6 @@ data LeiosOutstanding pid = MkLeiosOutstanding
   -- 'missingEbTxs' of every point that referenced it -- so the two stay in step.
   --
   -- 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
-  --
-  -- These missing txs are blocking the node from sending @MsgLeiosBlockTxsOffer@
-  -- to its downstream peers.
-  --
-  -- It's different from 'missingEbTxs' in two ways.
-  --
-  -- * The heap footprint of 'blockingPerEb' doesn't scale with the number of
-  --   EbTxs.
-  --
-  -- * 'blockingPerEb' is only decremented when txs are actually inserted
-  --   into the DB (via @MsgLeiosBlockTxs@ handling).
-  --
-  -- TODO: 'blockingPerEb' can go permanently stale for txs shared across EBs.
-  -- 'processLeiosBlockTxs' only decrements the entry for the EB it was requesting;
-  -- a tx that also belongs to another EB B can reach the DB via a fetch
-  -- attributed to a different EB, so B never fetches it itself -- and 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).
   }
 
 -- | The empty outstanding state, given the slot it has already been pruned up
@@ -490,7 +466,6 @@ emptyLeiosOutstanding prunedSlot =
     , requestedBytesSize = 0
     , missingEbTxs = Map.empty
     , reverseEbIndexByTx = Map.empty
-    , blockingPerEb = Map.empty
     }
 
 -- | Per-EB state tracked in 'ebState'
@@ -649,8 +624,6 @@ prettyLeiosOutstanding x =
       , "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
@@ -663,7 +636,6 @@ prettyLeiosOutstanding x =
     , requestedBytesSizePerPeer
     , requestedBytesSize
     , missingEbTxs
-    , blockingPerEb
     } = x
 
 -- TODO which of these limits are allowed to be exceeded by at most one

From 91aba2cc48a627d451b9b1349315a8f5c7b3bbb6 Mon Sep 17 00:00:00 2001
From: Nicolas Frisby <nicolas.frisby@moduscreate.com>
Date: Tue, 18 Aug 2026 16:55:45 -0400
Subject: [PATCH 24/49] WIP delete EbTxs fields of LeiosOutstanding

---
 .../src/ouroboros-consensus/LeiosDemoLogic.hs | 104 +++---------------
 .../src/ouroboros-consensus/LeiosDemoTypes.hs |  36 +-----
 2 files changed, 19 insertions(+), 121 deletions(-)

diff --git a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
index 40be063e81..6b535c0c17 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
@@ -44,6 +44,7 @@ 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
+import Data.Void (absurd, Void)
 import Data.Word (Word16, Word64)
 import LeiosDemoDb
   ( LeiosDbConnection
@@ -339,7 +340,7 @@ leiosFetchLogicIteration env mbCurrentSlot offerings =
     go1 acc emptyLeiosFetchDecisions $
       expand $
         prioritize $
-          Map.map Left (Leios.missingEbBodies acc) `Map.union` Map.map Right (Leios.missingEbTxs acc)
+          Map.map Left (Leios.missingEbBodies acc) `Map.union` Map.map Right mempty
  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
@@ -351,14 +352,12 @@ leiosFetchLogicIteration env mbCurrentSlot offerings =
   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
+    (_point, Right x) : _vs -> absurd x
 
   go1 ::
     LeiosOutstanding pid ->
     LeiosFetchDecisions pid ->
-    [Either (LeiosPoint, BytesSize) (LeiosPoint, BytesSize, TxHash)] ->
+    [Either (LeiosPoint, BytesSize) Void] ->
     (LeiosOutstanding pid, LeiosFetchDecisions pid)
   go1 !acc !accNew = \case
     [] ->
@@ -367,13 +366,7 @@ leiosFetchLogicIteration env mbCurrentSlot offerings =
       | 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! leiosFetchLogicIteration go1"
-            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
+    Right x : _targets -> absurd x
 
   goEb2 !acc !accNew targets point ebBytesSize peerIds
     | Leios.requestedBytesSize acc >= Leios.maxRequestedBytesSize env -- we can't request anything
@@ -419,24 +412,24 @@ leiosFetchLogicIteration env mbCurrentSlot offerings =
       ebHash `Set.member` ebHashes -- peer has offered this EB body
       ]
 
-  goTx2 ::
+  _goTx2 ::
     LeiosOutstanding pid ->
     LeiosFetchDecisions pid ->
-    [Either (LeiosPoint, BytesSize) (LeiosPoint, BytesSize, TxHash)] ->
+    [Either (LeiosPoint, BytesSize) Void] ->
     LeiosPoint ->
     BytesSize ->
     TxHash ->
     Map EbHash (NESet SlotNo, Int, BytesSize) ->
     Set (PeerId pid) ->
     (LeiosOutstanding pid, LeiosFetchDecisions pid)
-  goTx2 !acc !accNew targets point txBytesSize txHash txOffsets peerIds
+  _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 <- choosePeerTx peerIds acc point.pointEbHash =
+    , Just peerId <- _choosePeerTx peerIds acc point.pointEbHash =
         -- there's a peer offering this EB's tx closure and we haven't already
         -- requested it from them
         let txOffset = case Map.lookup point.pointEbHash txOffsets of
@@ -451,23 +444,21 @@ leiosFetchLogicIteration env mbCurrentSlot offerings =
                   (let MkLeiosFetchDecisions x = accNew in x)
             acc' =
               acc
-                { Leios.requestedTxPeers =
-                    Map.insertWith Set.union txHash (Set.singleton peerId) (Leios.requestedTxPeers acc)
-                , Leios.requestedBytesSizePerPeer =
+                { 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'
+         in _goTx2 acc' accNew' targets point txBytesSize txHash txOffsets peerIds'
     | otherwise =
         go1 acc accNew targets
 
-  choosePeerTx ::
+  _choosePeerTx ::
     Set (PeerId pid) ->
     LeiosOutstanding pid ->
     EbHash ->
     Maybe (PeerId pid)
-  choosePeerTx peerIds acc ebHash =
+  _choosePeerTx peerIds acc ebHash =
     foldr (\a _ -> Just a) Nothing $
       [ peerId
       | (peerId, (_bodies, closures)) <-
@@ -515,7 +506,7 @@ packRequests env =
       )
       Seq.empty
       -- group by EbHash, sort by offset ascending. 'prio' is the target point's
-      -- own slot and 'ebHash' its own EbHash (both filed by 'goTx2' from the same
+      -- own slot and 'ebHash' its own EbHash (both filed by '_goTx2' from the same
       -- point), so 'MkLeiosPoint prio ebHash' is a real point -- slot and hash
       -- from the same EB.
       $ Map.fromListWith IntMap.union
@@ -799,7 +790,7 @@ processLeiosBlock ktracer tracer (outstandingVar, readyVar) txCache db source eb
           traceWith ktracer $ TraceLeiosBlockAcquired point
           forM_ completedByBody $ traceWith ktracer . TraceLeiosBlockTxsAcquired
           pure $ fmap snd mbSummaryMisses
-        (bodyClass, misses) <- case source of
+        (bodyClass, _misses) <- 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.
@@ -825,20 +816,6 @@ processLeiosBlock ktracer tracer (outstandingVar, readyVar) txCache db source eb
               pure (fetchArrivalEvicted ebBytesSize', ms)
         let !outstanding' =
               outstandingCleaned
-                { Leios.missingEbTxs =
-                    Map.insert point misses (Leios.missingEbTxs outstandingCleaned)
-                , Leios.reverseEbIndexByTx =
-                    IntMap.foldrWithKey
-                      ( \i (txHash, txBytesSize) acc ->
-                          Map.insertWith
-                            (Map.unionWith (\(s1, i1, z1) (s2, _, _) -> (s1 <> s2, i1, z1)))
-                            txHash
-                            (Map.singleton ebHash (NESet.singleton point.pointSlotNo, i, txBytesSize))
-                            acc
-                      )
-                      (Leios.reverseEbIndexByTx outstandingCleaned)
-                      misses
-                }
         pure (outstanding', bodyClass)
   void $ MVar.tryPutMVar readyVar ()
   case source of
@@ -874,8 +851,6 @@ removePeerFromOutstanding peerId 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)
     }
 
 -----
@@ -917,17 +892,15 @@ refundEbRequest peerId ebHash ebBytesSize o
 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 =
             Map.update (\x -> delIf (== 0) (x - txsBytesSize)) peerId (Leios.requestedBytesSizePerPeer o)
-        , Leios.requestedTxPeers = requestedTxPeers'
         }
   | otherwise = o
 
@@ -997,60 +970,17 @@ processLeiosBlockTxs ktracer tracer (outstandingVar, readyVar) txCache db source
         traceWith ktracer $ TraceLeiosFetchTxsArrival txArrival
   -- update NodeKernel state
   MVar.modifyMVar_ outstandingVar $ \outstanding -> do
-    let removeTxFromMissing txHash mtxs =
-          case Map.lookup txHash (Leios.reverseEbIndexByTx outstanding) of
-            Nothing -> mtxs
-            Just ebsWithThisTx ->
-              Map.foldrWithKey
-                ( \ebHash (slotsWithThisEb, offset, _sz) acc ->
-                    foldr
-                      ( \ebSlot ->
-                          Map.update
-                            (delIf IntMap.null . IntMap.delete offset)
-                            (MkLeiosPoint ebSlot ebHash)
-                      )
-                      acc
-                      slotsWithThisEb
-                )
-                mtxs
-                ebsWithThisTx
-        -- Discharge the acquired txs by identity: remove each from 'missingEbTxs'
-        -- (every referencing point) and from 'reverseEbIndexByTx'. Shared by
-        -- arrivals and forges.
-        (reverseEbIndexByTx', missingEbTxs') =
-          V.foldl'
-            ( \(!accRev, !accMtxs) txHash ->
-                ( Map.delete txHash accRev
-                , removeTxFromMissing txHash accMtxs
-                )
-            )
-            (Leios.reverseEbIndexByTx outstanding, Leios.missingEbTxs outstanding)
-            txHashes
     case source of
-      -- A forge answered no request and holds the whole closure, so there is no
-      -- peer budget to refund
       ForgedTxs{} ->
         pure $
           outstanding
-            { Leios.missingEbTxs = missingEbTxs'
-            , Leios.reverseEbIndexByTx = reverseEbIndexByTx'
-            }
       ReceivedTxsFrom peerId _req -> do
-        let -- Remove this peer from each delivered tx's requested-peers set.
-            requestedTxPeers' =
-              V.foldl'
-                (\acc txHash -> Map.update (delIf Set.null . Set.delete peerId) txHash acc)
-                (Leios.requestedTxPeers outstanding)
-                txHashes
         -- 'refundTxRequest' reverses this peer's per-request accounting (but skips
         -- it if the peer was already cancelled in bulk by a disconnect); the global
         -- state below is updated unconditionally, since we did receive the txs.
         pure $
-          refundTxRequest peerId requestedTxPeers' (fromIntegral batchBytes) $
+          refundTxRequest peerId (fromIntegral batchBytes) $
             outstanding
-              { Leios.missingEbTxs = missingEbTxs'
-              , Leios.reverseEbIndexByTx = reverseEbIndexByTx'
-              }
   void $ MVar.tryPutMVar readyVar ()
   case source of
     ForgedTxs{} -> pure ()
diff --git a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs
index 20acd774e4..52a52919e2 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs
@@ -72,8 +72,6 @@ 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.List (sortOn)
 import Data.Map (Map)
 import qualified Data.Map.Strict as Map
@@ -383,10 +381,7 @@ newLeiosPeerVars = do
 --
 -- TODO: Potential simplifications once we have better test coverage:
 --
--- 1. The reverseEbIndexByTx inverse index could be computed on-demand from missingEbTxs
---    rather than maintained incrementally, simplifying state updates.
---
--- 2. 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
@@ -422,30 +417,11 @@ data LeiosOutstanding pid = MkLeiosOutstanding
   -- 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 (NESet SlotNo, Int, BytesSize)))
-  -- ^ Inverse of 'missingEbTxs': for each TX, the referencing EBs; per EB, its
-  -- offset+size (content, so stored once) and the 'NESet' of slots it was
-  -- announced at. On delivery a tx is removed entirely -- from here and from the
-  -- 'missingEbTxs' of every point that referenced it -- so the two stay in step.
-  --
-  -- TODO this is far too big for the heap
+
   }
 
 -- | The empty outstanding state, given the slot it has already been pruned up
@@ -461,11 +437,8 @@ emptyLeiosOutstanding prunedSlot =
     , missingEbBodies = Map.empty
     , reverseSlotIndexByEbHash = Map.empty
     , requestedEbPeers = Map.empty
-    , requestedTxPeers = Map.empty
     , requestedBytesSizePerPeer = Map.empty
     , requestedBytesSize = 0
-    , missingEbTxs = Map.empty
-    , reverseEbIndexByTx = Map.empty
     }
 
 -- | Per-EB state tracked in 'ebState'
@@ -619,11 +592,8 @@ prettyLeiosOutstanding x =
       , "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]
       , ""
       ]
  where
@@ -632,10 +602,8 @@ prettyLeiosOutstanding x =
     , missingEbBodies
     , reverseSlotIndexByEbHash
     , requestedEbPeers
-    , requestedTxPeers
     , requestedBytesSizePerPeer
     , requestedBytesSize
-    , missingEbTxs
     } = x
 
 -- TODO which of these limits are allowed to be exceeded by at most one

From a8e09973ca389e7edaaf281460db87a003931ccb Mon Sep 17 00:00:00 2001
From: Nicolas Frisby <nicolas.frisby@moduscreate.com>
Date: Tue, 18 Aug 2026 17:18:43 -0400
Subject: [PATCH 25/49] WIP have Claude disable EbTxs fetch logic tests

---
 .../consensus-test/Test/LeiosDemoLogic.hs     | 179 +-----------------
 .../Test/LeiosDemoLogic/Invariants.hs         | 133 ++-----------
 2 files changed, 26 insertions(+), 286 deletions(-)

diff --git a/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic.hs b/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic.hs
index 215a1eae8b..d18a8d049d 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.
 --
@@ -23,10 +23,8 @@ import Cardano.Slotting.Slot (SlotNo (..))
 import qualified Data.ByteString as BS
 import qualified Data.DList as DList
 import Data.Function ((&))
-import qualified Data.IntMap.Strict as IntMap
 import qualified Data.Map.Strict as Map
 import qualified Data.Set as Set
-import qualified Data.Set.NonEmpty as NESet
 import LeiosDemoLogic
   ( LeiosFetchDecisions (..)
   , leiosFetchLogicIteration
@@ -38,7 +36,6 @@ import LeiosDemoTypes
   , LeiosOutstanding (..)
   , LeiosPoint (..)
   , PeerId (..)
-  , TxHash (..)
   , demoLeiosFetchStaticEnv
   , emptyLeiosOutstanding
   )
@@ -64,17 +61,6 @@ tests =
         , 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
-        ]
     ]
 
 ------------------------------------------------------------
@@ -103,7 +89,7 @@ test_bodyNoOffer :: IO ()
 test_bodyNoOffer =
   empty
     & withMissingBody (point 1 'a') 1024
-    & offersTxs peerA [eb 'a'] -- offers tx-closure, not the body
+    & offersBody peerA [eb 'b'] -- peer offers a different EB, not the one we need
     & runIteration
     & assertNoRequests
 
@@ -118,25 +104,6 @@ test_bodyPerEbCap =
  where
   ebCap = maxRequestsPerEb demoLeiosFetchStaticEnv
 
-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') [0 .. txCap - 1] -- the per-tx cap is used up
-    & offersTxs txCap [eb 'a'] -- so this additional peer is not selected
-    & runIteration
-    & assertNoRequests
- where
-  txCap = maxRequestsPerTx demoLeiosFetchStaticEnv
-
 test_bodyTwoPeersOffer :: IO ()
 test_bodyTwoPeersOffer =
   empty
@@ -168,38 +135,6 @@ test_perPeerByteBudget =
     & 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') (point 2 '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 =
-  empty
-    & withMissingTx (point 1 'a') 0 (tx 'x') 100
-    & alsoReferencedInEb (tx 'x') (point 2 'b') 7 200 -- different recorded size
-    & offersTxs peerA [eb 'a', eb 'b']
-    & runIteration
-    & assertTxRequest peerA (point 1 'a') (tx 'x')
-
 ------------------------------------------------------------
 -- Scenario DSL
 ------------------------------------------------------------
@@ -225,30 +160,6 @@ withMissingBody p 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 (NESet.singleton p.pointSlotNo, offset, size))
-            (reverseEbIndexByTx o)
-      }
-
 alreadyRequestedEbFrom :: Ord pid => EbHash -> [pid] -> Scenario pid -> Scenario pid
 alreadyRequestedEbFrom ebHash pids =
   onOutstanding $ \o ->
@@ -261,36 +172,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 point 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 -> LeiosPoint -> Int -> BytesSize -> Scenario pid -> Scenario pid
-alsoReferencedInEb txHash p offset size =
-  onOutstanding $ \o ->
-    o
-      { reverseEbIndexByTx =
-          Map.insertWith
-            Map.union
-            txHash
-            (Map.singleton p.pointEbHash (NESet.singleton p.pointSlotNo, 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
@@ -315,11 +196,6 @@ offersBody :: Ord pid => pid -> [EbHash] -> Scenario pid -> Scenario pid
 offersBody pid ebs =
   insertOffering (MkPeerId pid) (Set.fromList ebs) Set.empty
 
--- | 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)
-
 insertOffering ::
   Ord pid =>
   PeerId pid ->
@@ -346,37 +222,13 @@ onOutstanding f sc = sc{scOutstanding = f (scOutstanding sc)}
 
 -- | Run the iteration and project the decisions.
 --
--- Enforces a soundness invariant on the way out: every emitted tx decision must
--- name a /real/ (slot, EB hash) for its tx -- one the scenario actually lists
--- as missing that tx. A priority slot paired with an unrelated EB hash would be
--- a \"Frankenstein\" point. The original Leios diffusion demo included that on
--- purpose, but subsequent design has ruled that out, so this property bans it.
+-- (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 -> LeiosFetchDecisions pid
 runIteration sc =
-  case unrealDecisions sc.scOutstanding decs of
-    [] -> decs
-    bad -> error $ "runIteration: decisions name a non-real (slot, EB, tx): " <> show bad
- where
   -- A known current slot selects freshest-first (i.e. youngest-first), which is
   -- the ordering these scenarios were written against.
-  decs = snd $ leiosFetchLogicIteration sc.scEnv (Just minBound) sc.scOfferings sc.scOutstanding
-
--- | Emitted tx decisions whose (slot, EB hash) the scenario does not list as
--- missing that tx. 'runIteration' requires this to be empty.
-unrealDecisions ::
-  LeiosOutstanding pid -> LeiosFetchDecisions pid -> [(SlotNo, EbHash, TxHash)]
-unrealDecisions o (MkLeiosFetchDecisions m) =
-  [ (slot, ebHash, txHash)
-  | (_peer, slotMap) <- Map.toList m
-  , (slot, (txs, _bodies)) <- Map.toList slotMap
-  , (txHash, _sz, ebHash, _off) <- DList.toList txs
-  , txHash `notElem` txsMissingAt slot ebHash
-  ]
- where
-  txsMissingAt slot ebHash =
-    map fst $
-      IntMap.elems $
-        Map.findWithDefault IntMap.empty (MkLeiosPoint slot ebHash) (missingEbTxs o)
+  snd $ leiosFetchLogicIteration sc.scEnv (Just minBound) sc.scOfferings sc.scOutstanding
 
 ------------------------------------------------------------
 -- Assertions
@@ -397,22 +249,6 @@ assertBodyRequest pid p size (MkLeiosFetchDecisions m) =
       Just (_txs, bodies) ->
         DList.toList bodies @?= [(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, _ebHash, _offset)] -> h @?= txHash
-        xs -> assertFailure $ "expected one tx request, got " <> show (length xs)
-
 assertNoRequests :: (Ord pid, Show pid) => LeiosFetchDecisions pid -> IO ()
 assertNoRequests (MkLeiosFetchDecisions m) = Map.keys m @?= []
 
@@ -444,6 +280,3 @@ point slot c = MkLeiosPoint (SlotNo (fromIntegral slot)) (eb c)
 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
index e93516490f..5cee212238 100644
--- a/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic/Invariants.hs
+++ b/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic/Invariants.hs
@@ -12,12 +12,11 @@
 -- 'nullLeiosTxCache', and plain 'MVar's — then asserts that a state invariant
 -- holds after every step.
 --
--- NOTE. This test suite initially exists as a specific regression tests: every
--- tx tracked in 'Leios.missingEbTxs' must still be resolvable in
--- 'Leios.reverseEbIndexByTx' (same keying 'leiosFetchLogicIteration' relies
--- on). We check it structurally after each command, and — belt and suspenders —
--- force a 'Decide' through the real fetch logic so a stray @impossible!@
--- surfaces even if the structural check missed a shape.
+-- 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
@@ -41,15 +40,13 @@ 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.Bits as Bits
 import qualified Data.ByteString as BS
 import qualified Data.DList as DList
-import qualified Data.IntMap.Strict as IntMap
 import qualified Data.Map.Strict as Map
 import qualified Data.Set as Set
 import qualified Data.Set.NonEmpty as NESet
 import qualified Data.Vector.Strict as V
-import Data.Word (Word16, Word64)
+import Data.Void (Void, absurd)
 import LeiosDemoDb (withLeiosDb)
 import qualified LeiosDemoDb as LeiosDb
 import LeiosDemoLogic
@@ -67,7 +64,6 @@ import LeiosDemoTypes
   ( BytesSize
   , EbHash
   , LeiosBlockRequest (..)
-  , LeiosBlockTxsRequest (..)
   , LeiosEb (..)
   , LeiosOutstanding (..)
   , LeiosPeerVars
@@ -99,14 +95,8 @@ tests =
     "LeiosDemoLogic.Invariants"
     [ testGroup
         "curated sequences"
-        [ testCase "same EB hash at two slots: delivery clears both" $
-            runCmds reproMultiSlot @?= Right ()
-        , testCase "tx shared across two EBs: delivery discharges both" $
-            runCmds reproSharedTx @?= Right ()
-        , testCase "forge purges a body it already holds (offered first)" $
+        [ testCase "forge purges a body it already holds (offered first)" $
             runCmdsReFetchViolations reproForgeAfterOffer @?= Right []
-        , testCase "forge discharges a tx a peer EB still needs" $
-            runCmds reproForgeSharedTx @?= Right ()
         ]
     , testCase "acquired EB kept until its greatest slot is below the immutable tip" $ do
         let h = hashLeiosEb (ebOf [0, 1])
@@ -150,7 +140,7 @@ tests =
         Map.lookup hA (Leios.reverseSlotIndexByEbHash o) @?= Just (NESet.singleton (SlotNo 10))
         Map.lookup hB (Leios.reverseSlotIndexByEbHash o) @?= Nothing
     , testProperty
-        "missingEbTxs stays in sync with reverseEbIndexByTx across arbitrary sequences"
+        "ebState stays in sync with ebsPerMaxAnnouncementSlot across arbitrary sequences"
         prop_invariants
     , testProperty
         "the fetch logic never requests an already-held EB body"
@@ -176,8 +166,9 @@ data Cmd
     Offer TestEb Word
   | -- | @processLeiosBlock@: the EB body arrives for that point.
     ArriveBody TestEb Word
-  | -- | @processLeiosBlockTxs@: deliver the tx at this /index within the EB/.
-    ArriveTx TestEb Word Int
+  | -- | 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'
@@ -276,15 +267,7 @@ applyCmd conn txCache kv peerVars peerId = \case
         req = MkLeiosBlockRequest (pointOf ids slot) (leiosEbBytesSize eb)
     processLeiosBlock nullTracer nullTracer kv txCache conn (ReceivedBlockFrom peerId req) eb
     pure []
-  ArriveTx ids slot idx -> do
-    let txId = ids !! idx
-        req =
-          MkLeiosBlockTxsRequest
-            (pointOf ids slot)
-            (offsetsToBitmaps [idx])
-            (V.singleton (txHashOf txId))
-    processLeiosBlockTxs nullTracer nullTracer kv txCache conn (ReceivedTxsFrom peerId req) (V.singleton (leiosTxOf txId))
-    pure []
+  ArriveTx v -> absurd v
   Forge ids slot -> do
     let eb = ebOf ids
         point = pointOf ids slot
@@ -310,13 +293,12 @@ applyCmd conn txCache kv peerVars peerId = \case
     let held = Map.keysSet (Map.filter Leios.ebStateHasBody (Leios.ebState outstanding))
     pure (filter (\h -> Set.member h held) (ebBodyRequestHashes decs))
 
--- | Every EbHash currently referenced by the outstanding state (bodies + txs),
--- as an all-offering peer's body\/closure sets.
+-- | Every EbHash currently referenced by the outstanding state (bodies only, now
+-- that the EbTxs side is disarmed), as an all-offering peer's body\/closure sets.
 referencedEbs :: LeiosOutstanding Int -> Set.Set EbHash
 referencedEbs o =
   Set.fromList $
     map (.pointEbHash) (Map.keys (Leios.missingEbBodies o))
-      <> map (.pointEbHash) (Map.keys (Leios.missingEbTxs o))
 
 -- | Force the decision structure, including each tx request's resolved offset
 -- (the @goTx2@ lookup), to a scalar.
@@ -343,22 +325,12 @@ ebBodyRequestHashes (MkLeiosFetchDecisions m) =
 -- The invariant
 ------------------------------------------------------------
 
--- | Every tx tracked as missing must be resolvable in the reverse index at the
--- exact (EbHash, slot, offset) 'go1'/'goTx2' will look it up by. Its violation
--- is what @impossible! leiosFetchLogicIteration go1@ reports.
+-- | '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 = do
-  -- Every tx tracked as missing must be resolvable in the reverse index.
-  case
-    [ msg
-    | (p, txs) <- Map.toList (Leios.missingEbTxs o)
-    , (off, (txHash, _sz)) <- IntMap.toList txs
-    , Left msg <- [resolvable p off txHash]
-    ] of
-    [] -> Right ()
-    (msg : _) -> Left msg
-  -- 'ebsPerMaxAnnouncementSlot' must be the exact inverse of the greatest-slot
-  -- field of 'ebState' (the reverse index 'pruneOutstandingToImmTip' prunes by).
+checkInvariant o =
   if Leios.ebsPerMaxAnnouncementSlot o == inverseOfMax
     then Right ()
     else
@@ -367,49 +339,17 @@ checkInvariant o = do
             <> show (Leios.ebsPerMaxAnnouncementSlot o, inverseOfMax)
         )
  where
-  rev = Leios.reverseEbIndexByTx o
   inverseOfMax =
     Map.fromListWith
       NESet.union
       [ (Leios.ebStateMaxSlot s, NESet.singleton h)
       | (h, s) <- Map.toList (Leios.ebState o)
       ]
-  resolvable p off txHash =
-    case Map.lookup txHash rev of
-      Nothing ->
-        Left ("missingEbTxs tx absent from reverseEbIndexByTx: " <> show (p.pointSlotNo, off))
-      Just ebm -> case Map.lookup (pointEbHash p) ebm of
-        Nothing -> Left ("reverseEbIndexByTx lacks this EB for a missing tx: " <> show p.pointSlotNo)
-        Just (slots, off', _sz')
-          | p.pointSlotNo `NESet.member` slots && off' == off -> Right ()
-          | otherwise -> Left ("reverseEbIndexByTx slot/offset mismatch at " <> show p.pointSlotNo)
 
 ------------------------------------------------------------
 -- Curated repros
 ------------------------------------------------------------
 
--- | The same EB (hash) bodied at two slots; delivering its tx for one slot must
--- clear it for the other too. Pre-fix, the second 'Decide' hits @impossible!@.
-reproMultiSlot :: [Cmd]
-reproMultiSlot =
-  [ ArriveBody [0] 10
-  , ArriveBody [0] 11
-  , Decide 11
-  , ArriveTx [0] 10 0
-  , Decide 11
-  ]
-
--- | A tx shared by two distinct EBs; delivering it via one must discharge it
--- for the other (the deduping-LeiosDb behaviour the fix relies on).
-reproSharedTx :: [Cmd]
-reproSharedTx =
-  [ ArriveBody [0, 1] 10
-  , ArriveBody [1, 2] 11
-  , Decide 12
-  , ArriveTx [0, 1] 10 1 -- deliver the shared tx (id 1)
-  , Decide 12
-  ]
-
 -- | 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
@@ -422,16 +362,6 @@ reproForgeAfterOffer =
   , Decide 13
   ]
 
--- | A peer's EB still needs a tx that our own forged EB's closure supplies.
--- Forging must discharge it from that EB's 'missingEbTxs' (as delivering it via
--- 'ArriveTx' would), keeping the missing sets consistent.
-reproForgeSharedTx :: [Cmd]
-reproForgeSharedTx =
-  [ ArriveBody [1, 2] 10
-  , Forge [0, 1] 12
-  , Decide 13
-  ]
-
 ------------------------------------------------------------
 -- Property
 ------------------------------------------------------------
@@ -450,7 +380,6 @@ genCmd = do
     [ pure (Announce ids slot)
     , pure (Offer ids slot)
     , pure (ArriveBody ids slot)
-    , ArriveTx ids slot <$> choose (0, length ids - 1)
     , pure (Forge ids slot)
     , Decide <$> elements worldSlots
     ]
@@ -487,16 +416,6 @@ listedThenForged cmds =
     ArriveBody x _ -> Just x
     _ -> Nothing
 
--- | A peer EB body arrived, then a /different/ EB sharing one of its txs is
--- forged: the tx forge hazard, where forging must discharge the shared tx.
-arrivedThenForgedSharingTx :: [Cmd] -> Bool
-arrivedThenForgedSharingTx cmds =
-  or
-    [ arrivedIds /= ids && any (`elem` ids) arrivedIds
-    | (i, Forge ids _) <- zip [0 :: Int ..] cmds
-    , ArriveBody arrivedIds _ <- take i cmds
-    ]
-
 -- | 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.
@@ -505,8 +424,7 @@ coverage cmds prop =
   tabulate "commands" (map cmdName cmds) $
     classify (any isForge cmds) "has a Forge" $
       cover 15 (listedThenForged cmds) "listed then forged (body hazard)" $
-        cover 10 (arrivedThenForgedSharingTx cmds) "arrived then forged, shared tx (tx hazard)" $
-          property prop
+        property prop
 
 prop_invariants :: Property
 prop_invariants =
@@ -622,14 +540,3 @@ raceSameHashMultiSlot = do
       counterexample
         ("held EB body still listed for fetching: " <> show heldAndListed)
         (null heldAndListed)
-
-offsetsToBitmaps :: [Int] -> [(Word16, Word64)]
-offsetsToBitmaps offs =
-  [ (fromIntegral q, bm)
-  | (q, bm) <-
-      IntMap.toAscList $
-        foldr
-          (\o -> let (q, r) = o `divMod` 64 in IntMap.insertWith (Bits..|.) q (Bits.bit (63 - r)))
-          IntMap.empty
-          offs
-  ]

From 715428308adf03472cca7ed9cfb683fac94258cd Mon Sep 17 00:00:00 2001
From: Nicolas Frisby <nicolas.frisby@moduscreate.com>
Date: Tue, 18 Aug 2026 18:28:51 -0400
Subject: [PATCH 26/49] LeiosFetch: add LeiosDemoTypes.LeiosJobs module

---
 ouroboros-consensus.cabal                     |   1 +
 .../LeiosDemoTypes/LeiosJobs.hs               | 166 ++++++++++++++++++
 2 files changed, 167 insertions(+)
 create mode 100644 ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes/LeiosJobs.hs

diff --git a/ouroboros-consensus.cabal b/ouroboros-consensus.cabal
index 51c5d07e88..0a4249c219 100644
--- a/ouroboros-consensus.cabal
+++ b/ouroboros-consensus.cabal
@@ -112,6 +112,7 @@ library
     LeiosDemoOnlyTestFetch
     LeiosDemoOnlyTestNotify
     LeiosDemoTypes
+    LeiosDemoTypes.LeiosJobs
     LeiosTxCache
     LeiosTxCache.API
     LeiosTxCache.Optimized
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..fb819cf089
--- /dev/null
+++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes/LeiosJobs.hs
@@ -0,0 +1,166 @@
+{-# LANGUAGE BangPatterns #-}
+
+-- | 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 and depend only on 'IntMap'/'IntSet'.
+--
+-- 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 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)
+
+-- | A unit of tx-fetch work: the EB-body offsets fetched by one
+-- @MsgLeiosBlockTxsRequest@ -- a bitfield over the body's tx vector.
+newtype LeiosJob =
+    -- TODO 'LeiosJob' 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
+  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 unfinished jobs for one acquired EB, plus a reverse index by
+-- multiplicity so a least-requested job is one 'IntMap.lookupMin' 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 (each given by its offset within the EB body and
+-- its on-the-wire byte size) 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).
+mkLeiosJobPool :: Word32 -> Int -> IntMap Word32 -> LeiosJobPool
+mkLeiosJobPool maxJobBytes maxJobTxCount misses =
+  MkLeiosJobPool
+    { jobs =
+        IntMap.fromList
+          [ (jid, MkLeiosJobState (MkLeiosJob offs) (MkLeiosJobMultiplicity 0))
+          | (jid, offs) <- 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, sz0) : rest) -> grow (IntSet.singleton off0) sz0 1 rest
+
+  grow !cur !_bytes !_count [] = [cur]
+  grow !cur !bytes !count ((off, sz) : rest)
+    | count < maxJobTxCount && bytes + sz <= maxJobBytes =
+        grow (IntSet.insert off cur) (bytes + sz) (count + 1) rest
+    | otherwise = cur : grow (IntSet.singleton off) sz 1 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)
+
+-- | Select a least-requested unfinished job (fewest in-flight requests; ties by
+-- lowest job id), record one more in-flight request for it, and return its id,
+-- its bitfield, and the updated pool. 'Nothing' if the pool is empty.
+pickLeastRequestedJob :: LeiosJobPool -> Maybe (LeiosJobId, LeiosJob, LeiosJobPool)
+pickLeastRequestedJob pool =
+  case IntMap.lookupMin (jobsByMultiplicity pool) of
+    Nothing -> Nothing
+    Just (m, bucket) ->
+      let jid = NEIntSet.findMin bucket
+          -- Bump jid from bucket m to m+1, carrying its bitfield out in the same
+          -- traversal.
+          bump1 mbState = case mbState of
+            Nothing -> (Nothing, Nothing)
+            Just (MkLeiosJobState job _oldMultiplicity) ->
+              (Just job, Just (MkLeiosJobState job (MkLeiosJobMultiplicity (m + 1))))
+       in case IntMap.alterF bump1 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))
+                    }
+                )
+
+-- | Record one fewer in-flight request for a job (on disconnect). A no-op if the
+-- job is no longer in the pool.
+decrementJobMultiplicity :: LeiosJobId -> LeiosJobPool -> LeiosJobPool
+decrementJobMultiplicity (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)

From 0bfc9d032fbcbae21399dfa846bc0749ec719431 Mon Sep 17 00:00:00 2001
From: Nicolas Frisby <nicolas.frisby@moduscreate.com>
Date: Tue, 18 Aug 2026 19:11:21 -0400
Subject: [PATCH 27/49] LeiosFetch: initialize LeiosJobs on EB body arrival

---
 .../src/ouroboros-consensus/LeiosDemoLogic.hs | 15 ++++++---
 .../src/ouroboros-consensus/LeiosDemoTypes.hs | 33 +++++++++++++++----
 .../LeiosDemoTypes/LeiosJobs.hs               |  2 +-
 .../Test/LeiosDemoLogic/Invariants.hs         | 11 ++++---
 4 files changed, 45 insertions(+), 16 deletions(-)

diff --git a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
index 6b535c0c17..3be5076a4d 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
@@ -103,6 +103,7 @@ import LeiosDemoTypes
   , maxTxsPerEb
   )
 import qualified LeiosDemoTypes as Leios
+import qualified LeiosDemoTypes.LeiosJobs as Jobs
 import LeiosTxCache (LeiosTxCache (..))
 import Ouroboros.Consensus.Block
   ( BlockProtocol
@@ -744,7 +745,6 @@ processLeiosBlock ktracer tracer (outstandingVar, readyVar) txCache db source eb
               Just peerId -> refundEbRequest peerId ebHash ebBytesSize
               Nothing -> id
           )
-            $ (if tooOld then id else Leios.insertAcquiredEbBody ebHash)
             $ outstanding
               { Leios.missingEbBodies =
                   case Map.lookup ebHash (Leios.reverseSlotIndexByEbHash outstanding) of
@@ -790,7 +790,7 @@ processLeiosBlock ktracer tracer (outstandingVar, readyVar) txCache db source eb
           traceWith ktracer $ TraceLeiosBlockAcquired point
           forM_ completedByBody $ traceWith ktracer . TraceLeiosBlockTxsAcquired
           pure $ fmap snd mbSummaryMisses
-        (bodyClass, _misses) <- case source of
+        (bodyClass, misses) <- 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.
@@ -814,8 +814,15 @@ processLeiosBlock ktracer tracer (outstandingVar, readyVar) txCache db source eb
                   IntMap.empty
                   v
               pure (fetchArrivalEvicted ebBytesSize', ms)
-        let !outstanding' =
-              outstandingCleaned
+        let !pool =
+              -- TODO should this calculation be deferred until the first offer
+              -- arrives?
+              Jobs.mkLeiosJobPool
+                -- TODO thread the real 'LeiosFetchStaticEnv' rather than the demo one
+                (Leios.maxJobBytesSize Leios.demoLeiosFetchStaticEnv)
+                (Leios.maxJobTxCount Leios.demoLeiosFetchStaticEnv)
+                (IntMap.map snd misses)
+            !outstanding' = Leios.insertAcquiredEbBody ebHash eb pool outstandingCleaned
         pure (outstanding', bodyClass)
   void $ MVar.tryPutMVar readyVar ()
   case source of
diff --git a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs
index 52a52919e2..8b7eb30e95 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs
@@ -72,6 +72,7 @@ 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.IntSet.NonEmpty (NEIntSet)
 import Data.List (sortOn)
 import Data.Map (Map)
 import qualified Data.Map.Strict as Map
@@ -84,6 +85,7 @@ import Data.Set (Set)
 import qualified Data.Set as Set
 import Data.Set.NonEmpty (NESet)
 import qualified Data.Set.NonEmpty as NESet
+import qualified LeiosDemoTypes.LeiosJobs as Jobs
 import Data.String (fromString)
 import Data.Time.Clock (NominalDiffTime)
 import Data.Vector.Strict (Vector)
@@ -421,7 +423,9 @@ data LeiosOutstanding pid = MkLeiosOutstanding
   -- ^ Running total of bytes requested from each peer
   , requestedBytesSize :: !BytesSize
   -- ^ Total bytes requested across all peers
-
+  , requestedJobs :: !(Map (PeerId pid) (Map EbHash NEIntSet))
+  -- ^ Per peer, per EB, the job ids it currently has in flight -- for
+  -- decrementing those multiplicities on disconnect
   }
 
 -- | The empty outstanding state, given the slot it has already been pruned up
@@ -439,6 +443,7 @@ emptyLeiosOutstanding prunedSlot =
     , requestedEbPeers = Map.empty
     , requestedBytesSizePerPeer = Map.empty
     , requestedBytesSize = 0
+    , requestedJobs = Map.empty
     }
 
 -- | Per-EB state tracked in 'ebState'
@@ -451,7 +456,13 @@ data EbState =
 -- | Whether we hold an EB's body.
 data EbFetchState
   = NoBody
-  | BodyAcquired
+  | -- | The pool of jobs that have not been /requested/ yet (NB this can be
+    -- empty even before jobs have /arrived/)
+    --
+    -- 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 !LeiosEb !Jobs.LeiosJobPool
   deriving (Eq, Show)
 
 ebStateMaxSlot :: EbState -> SlotNo
@@ -462,11 +473,11 @@ ebStateMaxSlot (MkEbState slot _fetchState) = slot
 ebStateHasBody :: EbState -> Bool
 ebStateHasBody (MkEbState _slot fetchState) = case fetchState of
   NoBody -> False
-  BodyAcquired -> True
+  BodyAcquired{} -> True
 
 insertAcquiredEbBody ::
-  EbHash -> LeiosOutstanding pid -> LeiosOutstanding pid
-insertAcquiredEbBody ebHash =
+  EbHash -> LeiosEb -> Jobs.LeiosJobPool -> LeiosOutstanding pid -> LeiosOutstanding pid
+insertAcquiredEbBody ebHash body pool =
   alterEbState ebHash $ \case
     Nothing ->
       -- The state must have been pruned before the MsgLeiosBlock
@@ -476,8 +487,8 @@ insertAcquiredEbBody ebHash =
       -- Because it was previously pruned, it should simply be ignored now.
       Nothing
     Just (MkEbState slot fetchState) -> case fetchState of
-      BodyAcquired -> Nothing
-      NoBody -> Just $ MkEbState slot BodyAcquired
+      BodyAcquired{} -> Nothing
+      NoBody -> Just $ MkEbState slot (BodyAcquired body pool)
 
 -- | Record that the EB with this hash is referenced (announced or offered) at this
 -- slot
@@ -619,6 +630,10 @@ data LeiosFetchStaticEnv = MkLeiosFetchStaticEnv
   -- ^ 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
   , maxLeiosNotifyIngressQueue :: BytesSize
   -- ^ @maximumIngressQueue@ for LeiosNotify
   , maxLeiosFetchIngressQueue :: BytesSize
@@ -633,6 +648,8 @@ demoLeiosFetchStaticEnv =
     , maxRequestBytesSize = 500 * thousand
     , maxRequestsPerEb = 1
     , maxRequestsPerTx = 1
+    , maxJobBytesSize = 64 * thousandBase2
+    , maxJobTxCount = 20000   -- TODO do we want this to be low enough to matter?
     , maxLeiosNotifyIngressQueue = 1 * millionBase2
     , maxLeiosFetchIngressQueue = 50 * millionBase2
     }
@@ -643,6 +660,8 @@ demoLeiosFetchStaticEnv =
   millionBase2 = 2 ^ (20 :: Int)
   thousand :: Num a => a
   thousand = 10 ^ (3 :: Int)
+  thousandBase2 :: Num a => a
+  thousandBase2 = 2 ^ (10 :: Int)
 
 -- * LeiosTx newtype
 
diff --git a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes/LeiosJobs.hs b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes/LeiosJobs.hs
index fb819cf089..e6367c0215 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes/LeiosJobs.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes/LeiosJobs.hs
@@ -44,7 +44,7 @@ newtype LeiosJobMultiplicity = MkLeiosJobMultiplicity Int
 data LeiosJobState = MkLeiosJobState !LeiosJob !LeiosJobMultiplicity
   deriving (Eq, Show)
 
--- | The unfinished jobs for one acquired EB, plus a reverse index by
+-- | The not-yet-requested jobs for one acquired EB, plus a reverse index by
 -- multiplicity so a least-requested job is one 'IntMap.lookupMin' away.
 --
 -- INVARIANT: 'jobsByMultiplicity' is the exact inverse of the multiplicities in
diff --git a/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic/Invariants.hs b/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic/Invariants.hs
index 5cee212238..6d51047b0e 100644
--- a/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic/Invariants.hs
+++ b/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic/Invariants.hs
@@ -79,6 +79,7 @@ import LeiosDemoTypes
   , newLeiosPeerVars
   )
 import qualified LeiosDemoTypes as Leios
+import qualified LeiosDemoTypes.LeiosJobs as Jobs
 import LeiosTxCache (LeiosTxCache, newPureLeiosTxCache, nullLeiosTxCache)
 import Ouroboros.Consensus.Util.IOLike (IOLike, evaluate)
 import Test.QuickCheck
@@ -99,18 +100,20 @@ tests =
             runCmdsReFetchViolations reproForgeAfterOffer @?= Right []
         ]
     , testCase "acquired EB kept until its greatest slot is below the immutable tip" $ do
-        let h = hashLeiosEb (ebOf [0, 1])
+        let eb = ebOf [0, 1]
+            h = hashLeiosEb eb
+            pool = Jobs.mkLeiosJobPool 1000 10 mempty -- an empty pool suffices here
             -- announce at slot 5, then again at the smaller slot 3, and acquire
             o =
-              Leios.insertAcquiredEbBody h $
+              Leios.insertAcquiredEbBody h eb pool $
                 Leios.recordMaxAnnouncementSlot h (SlotNo 3) $
                   Leios.recordMaxAnnouncementSlot h (SlotNo 5) $
                     (emptyLeiosOutstanding (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) Leios.BodyAcquired)
+        Map.lookup h (Leios.ebState o) @?= Just (Leios.MkEbState (SlotNo 5) (Leios.BodyAcquired eb pool))
         -- kept while the greatest slot (5) is at/above the immutable tip (4)
         Map.lookup h (Leios.ebState (Leios.pruneOutstandingToImmTip (SlotNo 4) o))
-          @?= Just (Leios.MkEbState (SlotNo 5) Leios.BodyAcquired)
+          @?= Just (Leios.MkEbState (SlotNo 5) (Leios.BodyAcquired eb pool))
         -- dropped once the greatest slot (5) is below the immutable tip (6)
         Map.lookup h (Leios.ebState (Leios.pruneOutstandingToImmTip (SlotNo 6) o))
           @?= Nothing

From fe625c8bbb9f5822cb7602238e6ac85b3a20f5e8 Mon Sep 17 00:00:00 2001
From: Nicolas Frisby <nicolas.frisby@moduscreate.com>
Date: Tue, 18 Aug 2026 19:24:49 -0400
Subject: [PATCH 28/49] LeiosFetch: accelerate LeiosJobs prune on peer
 disconnect

---
 .../src/ouroboros-consensus/LeiosDemoLogic.hs | 29 +++++++++++++++----
 .../src/ouroboros-consensus/LeiosDemoTypes.hs |  7 +++--
 .../LeiosDemoTypes/LeiosJobs.hs               |  4 +--
 3 files changed, 30 insertions(+), 10 deletions(-)

diff --git a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
index 3be5076a4d..34ac78e1f9 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
@@ -31,6 +31,7 @@ import qualified Data.DList as DList
 import Data.Functor (void, (<&>))
 import Data.IntMap (IntMap)
 import qualified Data.IntMap as IntMap
+import qualified Data.IntSet.NonEmpty as NEIntSet
 import Data.List (unfoldr)
 import Data.Map (Map)
 import qualified Data.Map.Strict as Map
@@ -838,14 +839,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 ->
@@ -858,7 +858,24 @@ removePeerFromOutstanding peerId o =
     , Leios.requestedBytesSizePerPeer = Map.delete peerId (Leios.requestedBytesSizePerPeer o)
     , Leios.requestedEbPeers =
         Map.mapMaybe (delIf Set.null . Set.delete peerId) (Leios.requestedEbPeers 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 pool, the multiplicity of each job this peer held.
+  releaseJobs jobIds (Leios.MkEbState slot fetchState) =
+    Leios.MkEbState slot $ case fetchState of
+      Leios.NoBody -> Leios.NoBody
+      Leios.BodyAcquired body pool ->
+        Leios.BodyAcquired body $!
+          NEIntSet.foldl'
+            (flip $ Jobs.unpickJob . Jobs.MkLeiosJobId)
+            pool
+            jobIds
 
 -----
 
diff --git a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs
index 8b7eb30e95..839896919d 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs
@@ -419,11 +419,14 @@ data LeiosOutstanding pid = MkLeiosOutstanding
   -- Request tracking
   , requestedEbPeers :: !(Map EbHash (Set (PeerId pid)))
   -- ^ Which peers we've requested each EB from
+  --
+  -- 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
   , requestedBytesSize :: !BytesSize
   -- ^ Total bytes requested across all peers
-  , requestedJobs :: !(Map (PeerId pid) (Map EbHash NEIntSet))
+  , 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
   }
@@ -443,7 +446,7 @@ emptyLeiosOutstanding prunedSlot =
     , requestedEbPeers = Map.empty
     , requestedBytesSizePerPeer = Map.empty
     , requestedBytesSize = 0
-    , requestedJobs = Map.empty
+    , requestedJobsPerPeer = Map.empty
     }
 
 -- | Per-EB state tracked in 'ebState'
diff --git a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes/LeiosJobs.hs b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes/LeiosJobs.hs
index e6367c0215..19981dde84 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes/LeiosJobs.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes/LeiosJobs.hs
@@ -125,8 +125,8 @@ pickLeastRequestedJob pool =
 
 -- | Record one fewer in-flight request for a job (on disconnect). A no-op if the
 -- job is no longer in the pool.
-decrementJobMultiplicity :: LeiosJobId -> LeiosJobPool -> LeiosJobPool
-decrementJobMultiplicity (MkLeiosJobId jid) pool =
+unpickJob :: LeiosJobId -> LeiosJobPool -> LeiosJobPool
+unpickJob (MkLeiosJobId jid) pool =
   case IntMap.alterF decrement1 jid (jobs pool) of
     (Nothing, _) -> pool
     (Just (m, m'), jobs') ->

From 762af0655db6941dbf6c31777235878b3d371fb4 Mon Sep 17 00:00:00 2001
From: Nicolas Frisby <nicolas.frisby@moduscreate.com>
Date: Mon, 24 Aug 2026 08:22:23 -0400
Subject: [PATCH 29/49] LeiosFetch: beginning of major rewrite

Main idea: send fetch requests very aggressively.  We're on a very tight
deadline and cannot trust our peers. Thus, tail latency is our primary
concern. We cannot afford to deduplicate _requests_ because any time we spend
waiting on a withholding peer harms the tail latency. Our latency budget is so
tight that we don't have an patience, and so any affordably-aggressive timeout
would be so tight that it would cause false alarms from honest peers that are
hiccuping for otherwise-tolerable reasons.

Next refinement, in a subsequent commit: treat BigLedgerPeers specially, request
_all_ jobs from them at once (they're our only source of truth and they might be
intercontinental, so we need maximum utilization---again, for the sake of tail
latency).
---
 .../Ouroboros/Consensus/Network/NodeToNode.hs |   7 +-
 .../Ouroboros/Consensus/NodeKernel.hs         |  36 +-
 ouroboros-consensus.cabal                     |   3 +-
 .../src/ouroboros-consensus/LeiosDemoLogic.hs | 613 ++++++++++--------
 .../src/ouroboros-consensus/LeiosDemoTypes.hs | 115 ++--
 .../LeiosDemoTypes/LeiosJobs.hs               |  90 ++-
 .../consensus-test/Test/LeiosDemoLogic.hs     | 141 ++--
 .../Test/LeiosDemoLogic/Invariants.hs         |  80 +--
 8 files changed, 601 insertions(+), 484 deletions(-)

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 0227829d91..a4f48536b1 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
@@ -552,10 +552,9 @@ mkHandlers
                       (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
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 542c2d03d3..953c7e12cb 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
@@ -482,7 +484,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) <- 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
@@ -504,17 +506,28 @@ initNodeKernel
             let mbCurrentSlot = case currentSlot of
                   CurrentSlot s -> Just s
                   CurrentSlotUnknown -> Nothing
-            let (!outstanding', decisions) =
+            let (!outstanding', requests, offerDrops) =
                   Leios.leiosFetchLogicIteration
                     Leios.demoLeiosFetchStaticEnv
                     mbCurrentSlot
                     (Map.restrictKeys offerings (Map.keysSet stillLivePeers))
                     outstanding
-            pure (outstanding', decisions)
+            pure (outstanding', (requests, offerDrops))
+          -- 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 $
@@ -530,7 +543,7 @@ 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
@@ -565,7 +578,14 @@ initNodeKernel
                 MVar.modifyMVar_ getLeiosCentralState $
                   pure . Announcements.pruneCentralState immTipSlot
                 MVar.modifyMVar_ getLeiosOutstanding $
-                  pure . Leios.pruneOutstandingToImmTip immTipSlot
+                  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
diff --git a/ouroboros-consensus.cabal b/ouroboros-consensus.cabal
index 0a4249c219..e2eaf7cadb 100644
--- a/ouroboros-consensus.cabal
+++ b/ouroboros-consensus.cabal
@@ -390,7 +390,6 @@ library
     diff-containers >=1.2,
     direct-sqlite,
     directory,
-    dlist,
     filelock,
     fingertree-rm >=1.0,
     fs-api ^>=0.4,
@@ -793,7 +792,6 @@ test-suite consensus-test
     deepseq,
     diff-containers,
     directory,
-    dlist,
     file-embed,
     filepath,
     fingertree-rm,
@@ -1244,6 +1242,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/src/ouroboros-consensus/LeiosDemoLogic.hs b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
index 34ac78e1f9..fc778fa9bf 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
@@ -26,26 +26,26 @@ import Control.Monad.Primitive (PrimMonad, PrimState)
 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.Functor (void, (<&>))
-import Data.IntMap (IntMap)
 import qualified Data.IntMap as IntMap
+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.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 Data.Set.NonEmpty (NESet)
 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
-import Data.Void (absurd, Void)
 import Data.Word (Word16, Word64)
 import LeiosDemoDb
   ( LeiosDbConnection
@@ -76,6 +76,7 @@ import LeiosDemoTypes
   ( AnnouncementEquivocation (..)
   , AnnouncementFields (..)
   , AnnouncementSource (..)
+  , AlsoOfferedTxsClosure (..)
   , BytesSize
   , EbHash (..)
   , LeiosBlockRequest (..)
@@ -275,13 +276,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
@@ -320,13 +315,12 @@ popLeftmostOffset = \case
 
 -----
 
-newtype LeiosFetchDecisions pid
-  = MkLeiosFetchDecisions
-      (Map (PeerId pid) (Map SlotNo (DList (TxHash, BytesSize, EbHash, Int), DList (EbHash, BytesSize))))
-
-emptyLeiosFetchDecisions :: LeiosFetchDecisions pid
-emptyLeiosFetchDecisions = MkLeiosFetchDecisions Map.empty
-
+-- | Decide what to request from each peer right now
+--
+-- TODO even more aggressive requests for BigLedgerPeers (cf
+-- @eicIsBigLedgerPeer@)
+--
+-- TODO also pull txs from the Mempool
 leiosFetchLogicIteration ::
   forall pid.
   Ord pid =>
@@ -334,222 +328,252 @@ 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) ->
   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 mempty
- 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 x) : _vs -> absurd x
-
-  go1 ::
-    LeiosOutstanding pid ->
-    LeiosFetchDecisions pid ->
-    [Either (LeiosPoint, BytesSize) Void] ->
-    (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 x : _targets -> absurd x
-
-  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) Void] ->
-    LeiosPoint ->
-    BytesSize ->
-    TxHash ->
-    Map EbHash (NESet SlotNo, 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 <- _choosePeerTx peerIds acc point.pointEbHash =
-        -- there's a peer offering this EB's tx closure and we haven't already
-        -- requested it from them
-        let txOffset = case Map.lookup point.pointEbHash txOffsets of
-              Just (_slots, o, _) -> o
-              Nothing -> error "impossible! goTx2: target EB absent from its own reverse entry"
-            accNew' =
-              MkLeiosFetchDecisions $
-                Map.insertWith
-                  (Map.unionWith (<>))
-                  peerId
-                  (Map.singleton point.pointSlotNo (DList.singleton (txHash, txBytesSize, point.pointEbHash, txOffset), DList.empty))
-                  (let MkLeiosFetchDecisions x = accNew in x)
-            acc' =
-              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 ->
-    EbHash ->
-    Maybe (PeerId pid)
-  _choosePeerTx peerIds acc ebHash =
-    foldr (\a _ -> Just a) Nothing $
-      [ peerId
-      | (peerId, (_bodies, closures)) <-
-          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` closures -- peer has offered this EB's tx closure
-      ]
-
-packRequests ::
+  -- | 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 = \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 (acc', peerReqs, peerDrops) = assignPeer env mbCurrentSlot 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.
+peerBudget :: Ord pid => LeiosFetchStaticEnv -> LeiosOutstanding pid -> PeerId pid -> Int
+peerBudget env acc peerId =
+  fromIntegral (Leios.maxRequestedBytesSizePerPeer env)
+    - fromIntegral (Map.findWithDefault 0 peerId (Leios.requestedBytesSizePerPeer acc))
+
+-- | Walk this peer's offered points freshest-first (freshest-last while
+-- syncing), assigning requests to the peer until it's saturated at
+-- 'Leios.maxRequestedBytesSizePerPeer'.
+--
+-- Offered points below 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 ->
+  PeerId pid ->
+  Map LeiosPoint AlsoOfferedTxsClosure ->
+  LeiosOutstanding pid ->
+  (LeiosOutstanding pid, Seq LeiosFetchRequest, Set LeiosPoint)
+assignPeer env mbCurrentSlot peerId offers acc =
+  go (acc, Seq.empty, Set.empty) prioritized
  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 EbHash, sort by offset ascending. 'prio' is the target point's
-      -- own slot and 'ebHash' its own EbHash (both filed by '_goTx2' from the same
-      -- point), so 'MkLeiosPoint prio ebHash' is a real point -- slot and hash
-      -- from the same EB.
-      $ Map.fromListWith IntMap.union
-      $ [ (ebHash, IntMap.singleton txOffset (txHash, txBytesSize))
-        | (txHash, txBytesSize, ebHash, txOffset) <- DList.toList txs
-        ]
-
-  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
+  prioritized = case mbCurrentSlot of
+    Nothing -> Map.toAscList offers -- syncing: freshest-last
+    Just _currentSlot -> Map.toDescList offers -- freshest-first
+
+  go st@(acc', _dec, _drops) = \case
+    [] -> st
+    (point, offerKind) : rest
+      | peerBudget env 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 fetchState) -> case (fetchState, offerKind) of
+        (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 _body _jobPool, TxsClosureNotAlsoOffered) ->
+          -- We hold the body and the peer never offered the closure, so it
+          -- can no longer help.
+          pruneThisOffer
+        (Leios.BodyAcquired _body 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 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))
+
+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 ->
+  PeerId pid ->
+  EbHash ->
+  (LeiosOutstanding pid, Seq LeiosFetchRequest) ->
+  ((LeiosOutstanding pid, Seq LeiosFetchRequest), WhetherPeerEbExhausted)
+assignClosure env peerId ebHash st@(acc, dec) =
+  case Map.lookup ebHash (Leios.ebState acc) of
+    Nothing -> (st, MkWhetherPeerEbExhausted False)
+    Just (Leios.MkEbState _slot Leios.NoBody{}) -> (st, MkWhetherPeerEbExhausted False)
+    Just (Leios.MkEbState slot (Leios.BodyAcquired body jobPool)) ->
+      let inflightJobs =
+            maybe IntSet.empty NEIntSet.toSet $
+              Map.lookup ebHash =<< Map.lookup peerId (Leios.requestedJobsPerPeer acc)
+          -- there are no more than 184 jobs per EB, so picked can't be a /long/ list
+          (picked, jobPool', exhausted) = pickJobs inflightJobs jobPool (peerBudget env acc peerId)
+       in flip (,) exhausted $ case nonEmpty picked of
+            Nothing -> st
+            Just nePicked ->
+              let acc' =
+                    acc
+                      { Leios.ebState =
+                          Map.insert
+                            ebHash
+                            (Leios.MkEbState slot (Leios.BodyAcquired body jobPool'))
+                            (Leios.ebState acc)
+                      , Leios.requestedJobsPerPeer =
+                          Map.insertWith
+                            (Map.unionWith NEIntSet.union)
+                            peerId
+                            (Map.singleton ebHash $ neIntSetFromNonEmpty $ fmap (\(jid, _, _) -> jid) nePicked)
+                            (Leios.requestedJobsPerPeer acc)
+                      , Leios.requestedBytesSizePerPeer =
+                          Map.insertWith
+                            (+)
+                            peerId
+                            (sum $ fmap (\(_, _, bytes) -> bytes) nePicked)
+                            (Leios.requestedBytesSizePerPeer acc)
+                      }
+                  reqs = batchTxsRequests env (MkLeiosPoint slot ebHash) nePicked
+               in (acc', dec <> Seq.fromList reqs)
+  where
+    neIntSetFromNonEmpty :: NonEmpty Int -> NEIntSet
+    neIntSetFromNonEmpty (x :| xs) = NEIntSet.insertSet x $ IntSet.fromList xs
+
+-- | 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.
+pickJobs ::
+  IntSet.IntSet ->
+  Jobs.LeiosJobPool ->
+  Int ->
+  ([(Int, IntSet.IntSet, BytesSize)], Jobs.LeiosJobPool, WhetherPeerEbExhausted)
+pickJobs inflightJobs0 jobPool0 budget0 =
+  go inflightJobs0 jobPool0 budget0 []
+ where
+  go inflightJobs jobPool budget acc
+    | budget <= 0 = (reverse acc, jobPool, MkWhetherPeerEbExhausted False)
+    | otherwise = case Jobs.pickLeastRequestedJobExcept inflightJobs jobPool of
+        Nothing -> (reverse acc, jobPool, MkWhetherPeerEbExhausted True)
+        Just (Jobs.MkLeiosJobId jid, Jobs.MkLeiosJob offsets bytes, jobPool') ->
+          go
+            (IntSet.insert jid inflightJobs)
+            jobPool'
+            (budget - fromIntegral bytes)
+            ((jid, offsets, bytes) : acc)
+
+-- | Partition the N picked jobs (pick order) into M <= N requests, each within
+-- 'maxRequestBytesSize'. Seeding each batch from its first job keeps the
+-- accumulating job-id set non-empty, so no empty-batch handling is needed (a
+-- lone job above the cap simply forms its own request).
+batchTxsRequests :: LeiosFetchStaticEnv -> LeiosPoint -> NonEmpty (Int, IntSet.IntSet, BytesSize) -> [LeiosFetchRequest]
+batchTxsRequests env point ((jid0, offsets0, bytes0) :| rest0) =
+  go offsets0 (NEIntSet.singleton jid0) (fromIntegral bytes0) rest0
+ where
+  cap = fromIntegral (Leios.maxRequestBytesSize env) :: Int
+  go curOffsets curJids curBytes = \case
+    [] -> [flush curOffsets curJids]
+    (jid, offsets, bytes) : rest
+      | curBytes + fromIntegral bytes > cap ->
+          flush curOffsets curJids
+            : go offsets (NEIntSet.singleton jid) (fromIntegral bytes) rest
+      | otherwise ->
+          go
+            (IntSet.union offsets curOffsets)
+            (NEIntSet.insert jid curJids)
+            (curBytes + fromIntegral bytes)
+            rest
+  flush curOffsets curJids =
+    LeiosBlockTxsRequest (MkLeiosBlockTxsRequest point (offsetsToBitmap curOffsets) curJids)
+
+-- | 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
 
 -----
 
@@ -648,7 +672,7 @@ nextLeiosFetchClientCommand ktracer tracer stopSTM kernelVars txCache db peerId
             StrictSTM.atomically $
               LazySTM.writeTQueue responseQ (PendingBlockResponse req eb)
         )
-    LeiosBlockTxsRequest req@(MkLeiosBlockTxsRequest p bitmaps _txHashes) ->
+    LeiosBlockTxsRequest req@(MkLeiosBlockTxsRequest p bitmaps _jobIds) ->
       LF.MkSomeLeiosFetchJob
         (LF.MsgLeiosBlockTxsRequest p bitmaps)
         ( pure $ \(LF.MsgLeiosBlockTxs _ _ txs) ->
@@ -722,8 +746,8 @@ processLeiosBlock ktracer tracer (outstandingVar, readyVar) txCache db source eb
       let ebHash' = hashLeiosEb eb
       when (ebHash' /= ebHash) $ do
         invalidReply $ "MsgLeiosBlock hash mismatch: " <> show (ebHash', ebHash)
-      -- Every referenced tx must be unique: 'reverseEbIndexByTx' records one
-      -- offset per (tx, EB), so a duplicate desyncs it from 'missingEbTxs'.
+      -- 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 $
@@ -815,7 +839,7 @@ processLeiosBlock ktracer tracer (outstandingVar, readyVar) txCache db source eb
                   IntMap.empty
                   v
               pure (fetchArrivalEvicted ebBytesSize', ms)
-        let !pool =
+        let !jobPool =
               -- TODO should this calculation be deferred until the first offer
               -- arrives?
               Jobs.mkLeiosJobPool
@@ -823,7 +847,7 @@ processLeiosBlock ktracer tracer (outstandingVar, readyVar) txCache db source eb
                 (Leios.maxJobBytesSize Leios.demoLeiosFetchStaticEnv)
                 (Leios.maxJobTxCount Leios.demoLeiosFetchStaticEnv)
                 (IntMap.map snd misses)
-            !outstanding' = Leios.insertAcquiredEbBody ebHash eb pool outstandingCleaned
+            !outstanding' = Leios.insertAcquiredEbBody ebHash eb jobPool outstandingCleaned
         pure (outstanding', bodyClass)
   void $ MVar.tryPutMVar readyVar ()
   case source of
@@ -853,9 +877,7 @@ 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.requestedJobsPerPeer = Map.delete peerId (Leios.requestedJobsPerPeer o)
@@ -866,15 +888,15 @@ removePeerFromOutstanding peerId o =
           (Map.findWithDefault Map.empty peerId (Leios.requestedJobsPerPeer o))
     }
  where
-  -- Decrement, in that EB's pool, the multiplicity of each job this peer held.
+  -- Decrement, in that EB's jobPool, the multiplicity of each job this peer held.
   releaseJobs jobIds (Leios.MkEbState slot fetchState) =
     Leios.MkEbState slot $ case fetchState of
       Leios.NoBody -> Leios.NoBody
-      Leios.BodyAcquired body pool ->
+      Leios.BodyAcquired body jobPool ->
         Leios.BodyAcquired body $!
           NEIntSet.foldl'
             (flip $ Jobs.unpickJob . Jobs.MkLeiosJobId)
-            pool
+            jobPool
             jobIds
 
 -----
@@ -885,7 +907,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.
@@ -899,8 +921,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)
@@ -909,10 +930,9 @@ 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 ->
@@ -922,14 +942,56 @@ refundTxRequest ::
 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)
         }
   | otherwise = o
 
 -----
 
+-- | 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 fetchState) =
+    Leios.MkEbState slot $ case fetchState of
+      Leios.NoBody -> Leios.NoBody
+      Leios.BodyAcquired body jobPool ->
+        Leios.BodyAcquired body $!
+          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)
+
+-----
+
 processLeiosBlockTxs ::
   ( Ord pid
   , IOLike m
@@ -947,13 +1009,21 @@ processLeiosBlockTxs ::
 processLeiosBlockTxs ktracer tracer (outstandingVar, readyVar) txCache db source txs = do
   let txBytess = V.map cbor txs
       batchBytes = V.sum (V.map BS.length txBytess)
-      -- The tx hashes: taken from the request for an arrival (and validated
-      -- below), derived from the txs themselves for a forge.
-      txHashes = case source of
-        ReceivedTxsFrom _ (MkLeiosBlockTxsRequest _ _ txHs) -> txHs
-        -- The body's tx list is position-aligned with the 'txs' vector, so use
-        -- its hashes rather than re-hashing the bytes we already hashed to forge.
-        ForgedTxs _ eb -> V.map fst (leiosEbTxs eb)
+  -- The tx hashes: for a forge, from the body directly (position-aligned with the
+  -- 'txs' vector); for an arrival, by expanding the request's offset bitmap
+  -- against the EB body we hold (the request no longer carries the hashes).
+  -- Validated against the arrived txs below.
+  txHashes <- case source of
+    ForgedTxs _ eb -> pure $ V.map fst (leiosEbTxs eb)
+    ReceivedTxsFrom _ (MkLeiosBlockTxsRequest point bitmaps _jobIds) -> do
+      outstanding <- MVar.readMVar outstandingVar
+      case Map.lookup point.pointEbHash (Leios.ebState outstanding) of
+        Just (Leios.MkEbState _slot (Leios.BodyAcquired eb _jobPool)) ->
+          pure $ V.fromList [fst (leiosEbTxs eb V.! off) | off <- bitmapOffsets bitmaps]
+        _ ->
+          -- We only request txs for an EB whose body we hold; a body-prune race
+          -- could in principle reach here. TODO disconnecting is harsh.
+          error "MsgLeiosBlockTxs arrived but its EB body is no longer held"
   -- validate it (an arrival only; a forge's data is self-produced)
   -- TODO: could validate the returned point + bitmaps too
   case source of
@@ -998,13 +1068,15 @@ processLeiosBlockTxs ktracer tracer (outstandingVar, readyVar) txCache db source
       ForgedTxs{} ->
         pure $
           outstanding
-      ReceivedTxsFrom peerId _req -> do
-        -- 'refundTxRequest' reverses this peer's per-request accounting (but skips
-        -- it if the peer was already cancelled in bulk by a disconnect); the global
-        -- state below is updated unconditionally, since we did receive the txs.
+      ReceivedTxsFrom peerId (MkLeiosBlockTxsRequest point _bitmaps jobIds) -> do
+        -- '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 jobPool and
+        -- from this peer's in-flight set, so they are never re-requested.
         pure $
-          refundTxRequest peerId (fromIntegral batchBytes) $
-            outstanding
+          completeTxRequest peerId point.pointEbHash jobIds $
+            refundTxRequest peerId (fromIntegral batchBytes) $
+              outstanding
   void $ MVar.tryPutMVar readyVar ()
   case source of
     ForgedTxs{} -> pure ()
@@ -1013,10 +1085,6 @@ processLeiosBlockTxs ktracer tracer (outstandingVar, readyVar) txCache db source
 
 -----
 
--- | 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'.
-data AlsoOfferedTxsClosure = TxsClosureAlsoOffered | TxsClosureNotAlsoOffered
 
 -- | 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
@@ -1072,12 +1140,9 @@ recordEbBodyOffer (outstandingVar, readyVar) peerVars offeredClosure (point, ebB
                   (NESet.singleton ebSlot)
                   (Leios.reverseSlotIndexByEbHash outstanding')
             }
-  MVar.modifyMVar_ (Leios.offerings peerVars) $ \(offers1, offers2) -> do
-    let !offers1' = Set.insert ebHash offers1
-        !offers2' = case offeredClosure of
-          TxsClosureAlsoOffered -> Set.insert ebHash offers2
-          TxsClosureNotAlsoOffered -> offers2
-    pure (offers1', offers2')
+  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 ()
 
 -----
diff --git a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs
index 839896919d..9bf82112f1 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs
@@ -73,6 +73,7 @@ import qualified Data.ByteString.Short as SBS
 import Data.Fixed (Pico)
 import qualified Data.Foldable as F
 import Data.IntSet.NonEmpty (NEIntSet)
+import qualified Data.IntSet.NonEmpty as NEIntSet
 import Data.List (sortOn)
 import Data.Map (Map)
 import qualified Data.Map.Strict as Map
@@ -319,19 +320,23 @@ 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, the offset bitmap (the only
+    -- part sent to the peer), and the ids of the 'Jobs.LeiosJob's it covers. The
+    -- job ids are kept locally to 'Jobs.completeJob' on the response; the
+    -- validation hashes are re-derived from the body at arrival, so they are not
+    -- carried here.
     MkLeiosBlockTxsRequest
       !LeiosPoint
       [(Word16, Word64)]
-      !(Vector TxHash)
+      !NEIntSet
 
 prettyLeiosBlockTxsRequest :: LeiosBlockTxsRequest -> String
-prettyLeiosBlockTxsRequest (MkLeiosBlockTxsRequest p bitmaps _txHashes) =
+prettyLeiosBlockTxsRequest (MkLeiosBlockTxsRequest p bitmaps jobIds) =
   unwords $
-    "MsgLeiosBlockTxs" : prettyLeiosPoint p : map prettyBitmap bitmaps
+    "MsgLeiosBlockTxs"
+      : prettyLeiosPoint p
+      : ("jobs=" <> show (toList (NEIntSet.toList jobIds)))
+      : map prettyBitmap bitmaps
 
 prettyBitmap :: (Word16, Word64) -> String
 prettyBitmap (idx, bitmap) =
@@ -349,9 +354,27 @@ 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))
+  { 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
   --
@@ -371,7 +394,7 @@ data LeiosPeerVars m = MkLeiosPeerVars
 
 newLeiosPeerVars :: IOLike m => m (LeiosPeerVars m)
 newLeiosPeerVars = do
-  offerings <- MVar.newMVar (Set.empty, Set.empty)
+  offerings <- MVar.newMVar Map.empty
   requestsToSend <- StrictSTM.newTVarIO Seq.empty
   pure MkLeiosPeerVars{offerings, requestsToSend}
 
@@ -423,9 +446,9 @@ data LeiosOutstanding pid = MkLeiosOutstanding
   -- 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
-  , requestedBytesSize :: !BytesSize
-  -- ^ Total bytes requested across all peers
+  -- ^ 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
@@ -445,7 +468,6 @@ emptyLeiosOutstanding prunedSlot =
     , reverseSlotIndexByEbHash = Map.empty
     , requestedEbPeers = Map.empty
     , requestedBytesSizePerPeer = Map.empty
-    , requestedBytesSize = 0
     , requestedJobsPerPeer = Map.empty
     }
 
@@ -459,8 +481,8 @@ data EbState =
 -- | Whether we hold an EB's body.
 data EbFetchState
   = NoBody
-  | -- | The pool of jobs that have not been /requested/ yet (NB this can be
-    -- empty even before jobs have /arrived/)
+  | -- | The job pool: the jobs not yet /requested/ (NB this can be empty even
+    -- before jobs have /arrived/)
     --
     -- TODO the 'Jobs.LeiosJobPool' could be an 'MVar m LeiosJobPool' for per-EB
     -- locking, at the cost of an 'm' parameter on
@@ -480,7 +502,7 @@ ebStateHasBody (MkEbState _slot fetchState) = case fetchState of
 
 insertAcquiredEbBody ::
   EbHash -> LeiosEb -> Jobs.LeiosJobPool -> LeiosOutstanding pid -> LeiosOutstanding pid
-insertAcquiredEbBody ebHash body pool =
+insertAcquiredEbBody ebHash body jobPool =
   alterEbState ebHash $ \case
     Nothing ->
       -- The state must have been pruned before the MsgLeiosBlock
@@ -491,7 +513,7 @@ insertAcquiredEbBody ebHash body pool =
       Nothing
     Just (MkEbState slot fetchState) -> case fetchState of
       BodyAcquired{} -> Nothing
-      NoBody -> Just $ MkEbState slot (BodyAcquired body pool)
+      NoBody -> Just $ MkEbState slot (BodyAcquired body jobPool)
 
 -- | Record that the EB with this hash is referenced (announced or offered) at this
 -- slot
@@ -543,21 +565,24 @@ alterEbState ebHash f outstanding =
      Nothing -> (Nothing, mbOld)
      Just new -> (Just (ebStateMaxSlot <$> mbOld, ebStateMaxSlot new), Just new)
 
--- | Prune 'Outstanding' to the immutable tip
+-- | 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 -> LeiosOutstanding pid
+pruneOutstandingToImmTip :: SlotNo -> LeiosOutstanding pid -> (Set EbHash, LeiosOutstanding pid)
 pruneOutstandingToImmTip immTipSlot outstanding =
-  outstanding
-    { ebState = ebState outstanding `Map.withoutKeys` prunedHashes
-    , ebsPerMaxAnnouncementSlot = atOrAbove
-    , acquiredEbBodiesPrunedSlot = max (acquiredEbBodiesPrunedSlot outstanding) immTipSlot
-    , missingEbBodies = missingEbBodiesAtOrAbove
-    , reverseSlotIndexByEbHash = reverseSlotIndexByEbHash'
-    }
+  ( 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)
@@ -576,27 +601,28 @@ pruneOutstandingToImmTip immTipSlot outstanding =
       (reverseSlotIndexByEbHash outstanding)
       (Map.keys belowBodies)
 
--- | 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
+-- | 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 =
@@ -607,7 +633,6 @@ prettyLeiosOutstanding x =
       , "reverseSlotIndexByEbHash = " ++ show (Map.size reverseSlotIndexByEbHash)
       , "requestedEbPeers = " ++ unwords (map prettyEbHash (Map.keys requestedEbPeers))
       , "requestedBytesSizePerPeer = " ++ show (Map.elems requestedBytesSizePerPeer)
-      , "requestedBytesSize = " ++ show requestedBytesSize
       , ""
       ]
  where
@@ -617,15 +642,12 @@ prettyLeiosOutstanding x =
     , reverseSlotIndexByEbHash
     , requestedEbPeers
     , requestedBytesSizePerPeer
-    , requestedBytesSize
     } = 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
+  { maxRequestedBytesSizePerPeer :: BytesSize
   -- ^ At most this many outstanding bytes requested from each peer
   , maxRequestBytesSize :: BytesSize
   -- ^ At most this many outstanding bytes per request
@@ -646,8 +668,7 @@ data LeiosFetchStaticEnv = MkLeiosFetchStaticEnv
 demoLeiosFetchStaticEnv :: LeiosFetchStaticEnv
 demoLeiosFetchStaticEnv =
   MkLeiosFetchStaticEnv
-    { maxRequestedBytesSize = 50 * million
-    , maxRequestedBytesSizePerPeer = 5 * million
+    { maxRequestedBytesSizePerPeer = 5 * million
     , maxRequestBytesSize = 500 * thousand
     , maxRequestsPerEb = 1
     , maxRequestsPerTx = 1
diff --git a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes/LeiosJobs.hs b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes/LeiosJobs.hs
index 19981dde84..87b71e588a 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes/LeiosJobs.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes/LeiosJobs.hs
@@ -23,12 +23,13 @@ import qualified Data.IntSet.NonEmpty as NEIntSet
 import Data.Word (Word32)
 
 -- | A unit of tx-fetch work: the EB-body offsets fetched by one
--- @MsgLeiosBlockTxsRequest@ -- a bitfield over the body's tx vector.
-newtype LeiosJob =
-    -- TODO 'LeiosJob' is immutable and only ever fully traversed, so a packed
+-- @MsgLeiosBlockTxsRequest@ (a bitfield over the body's tx vector), plus the
+-- total on-the-wire byte size of those txs (for the fetch byte budget).
+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
+    MkLeiosJob !IntSet !Word32
   deriving (Eq, Show)
 
 -- | Identifies a 'LeiosJob' within its 'LeiosJobPool' (0-based, stable for the
@@ -45,7 +46,7 @@ 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.lookupMin' away.
+-- 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
@@ -68,8 +69,8 @@ mkLeiosJobPool maxJobBytes maxJobTxCount misses =
   MkLeiosJobPool
     { jobs =
         IntMap.fromList
-          [ (jid, MkLeiosJobState (MkLeiosJob offs) (MkLeiosJobMultiplicity 0))
-          | (jid, offs) <- ijbs
+          [ (jid, MkLeiosJobState (MkLeiosJob offs bytes) (MkLeiosJobMultiplicity 0))
+          | (jid, (offs, bytes)) <- ijbs
           ]
     , jobsByMultiplicity =
         maybe IntMap.empty (IntMap.singleton 0) $
@@ -80,11 +81,11 @@ mkLeiosJobPool maxJobBytes maxJobTxCount misses =
     [] -> []
     ((off0, sz0) : rest) -> grow (IntSet.singleton off0) sz0 1 rest
 
-  grow !cur !_bytes !_count [] = [cur]
+  grow !cur !bytes !_count [] = [(cur, bytes)]
   grow !cur !bytes !count ((off, sz) : rest)
     | count < maxJobTxCount && bytes + sz <= maxJobBytes =
         grow (IntSet.insert off cur) (bytes + sz) (count + 1) rest
-    | otherwise = cur : grow (IntSet.singleton off) sz 1 rest
+    | otherwise = (cur, bytes) : grow (IntSet.singleton off) sz 1 rest
 
 -- | No unfinished jobs remain -- the EB's whole tx-closure has been fetched.
 nullLeiosJobPool :: LeiosJobPool -> Bool
@@ -95,33 +96,54 @@ lookupJob :: LeiosJobId -> LeiosJobPool -> Maybe LeiosJob
 lookupJob (MkLeiosJobId jid) pool =
   (\(MkLeiosJobState job _multiplicity) -> job) <$> IntMap.lookup jid (jobs pool)
 
--- | Select a least-requested unfinished job (fewest in-flight requests; ties by
--- lowest job id), record one more in-flight request for it, and return its id,
--- its bitfield, and the updated pool. 'Nothing' if the pool is empty.
+-- | 'pickLeastRequestedJobExcept' with no exclusions.
 pickLeastRequestedJob :: LeiosJobPool -> Maybe (LeiosJobId, LeiosJob, LeiosJobPool)
-pickLeastRequestedJob pool =
-  case IntMap.lookupMin (jobsByMultiplicity pool) of
+pickLeastRequestedJob = pickLeastRequestedJobExcept IntSet.empty
+
+-- | Select a least-requested unfinished job (fewest in-flight requests; ties by
+-- lowest job id) whose id is /not/ in @excluded@, record one more in-flight
+-- request for it, and return its id, its bitfield, and the updated pool.
+-- 'Nothing' if every unfinished job is excluded (or the pool is empty).
+--
+-- 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 ::
+  IntSet -> LeiosJobPool -> Maybe (LeiosJobId, LeiosJob, LeiosJobPool)
+pickLeastRequestedJobExcept excluded pool =
+  case eligible of
     Nothing -> Nothing
-    Just (m, bucket) ->
-      let jid = NEIntSet.findMin bucket
-          -- Bump jid from bucket m to m+1, carrying its bitfield out in the same
-          -- traversal.
-          bump1 mbState = case mbState of
-            Nothing -> (Nothing, Nothing)
-            Just (MkLeiosJobState job _oldMultiplicity) ->
-              (Just job, Just (MkLeiosJobState job (MkLeiosJobMultiplicity (m + 1))))
-       in case IntMap.alterF bump1 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))
-                    }
-                )
+    Just (m, jid) ->
+      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))
+                }
+            )
+ where
+  -- Walk multiplicity buckets low-to-high; within a bucket take the lowest
+  -- non-excluded job id. Returns (bucket multiplicity, job id). 'foldrWithKey'
+  -- visits ascending keys and is lazy in the accumulator, so this stops at the
+  -- first eligible bucket without materialising the bucket list.
+  eligible =
+    IntMap.foldrWithKey
+      ( \m bucket rest ->
+          case fst <$> IntSet.minView (IntSet.difference (NEIntSet.toSet bucket) excluded) of
+            Just jid -> Just (m, jid)
+            Nothing -> rest
+      )
+      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.
diff --git a/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic.hs b/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic.hs
index d18a8d049d..47cdebbcb2 100644
--- a/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic.hs
+++ b/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic.hs
@@ -21,23 +21,27 @@ 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.Map.Strict as Map
+import Data.Sequence.NonEmpty (NESeq)
 import qualified Data.Set as Set
-import LeiosDemoLogic
-  ( LeiosFetchDecisions (..)
-  , leiosFetchLogicIteration
-  )
+import qualified Data.Set.NonEmpty as NESet
+import LeiosDemoLogic (leiosFetchLogicIteration)
 import LeiosDemoTypes
-  ( BytesSize
+  ( AlsoOfferedTxsClosure (..)
+  , BytesSize
   , EbHash (..)
+  , LeiosBlockRequest (..)
+  , LeiosFetchRequest (..)
   , LeiosFetchStaticEnv (..)
   , LeiosOutstanding (..)
   , LeiosPoint (..)
   , PeerId (..)
   , demoLeiosFetchStaticEnv
   , emptyLeiosOutstanding
+  , mergeOffer
+  , recordMaxAnnouncementSlot
   )
 import Test.Tasty (TestTree, testGroup)
 import Test.Tasty.HUnit (assertFailure, testCase, (@?=))
@@ -52,12 +56,10 @@ 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 "offering peers selected up to the per-EB 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
         ]
@@ -81,7 +83,7 @@ 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
 
@@ -89,39 +91,29 @@ test_bodyNoOffer :: IO ()
 test_bodyNoOffer =
   empty
     & withMissingBody (point 1 'a') 1024
-    & offersBody peerA [eb 'b'] -- peer offers a different EB, not the one we need
+    & 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') [0 .. ebCap - 1] -- the per-EB cap is used up
-    & offersBody ebCap [eb 'a'] -- so this additional peer is not selected
+    & 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
- where
-  ebCap = maxRequestsPerEb demoLeiosFetchStaticEnv
+    & assertRequestPeers [peerB]
 
 test_bodyTwoPeersOffer :: IO ()
 test_bodyTwoPeersOffer =
   empty
     & withMissingBody (point 1 'a') 1024
-    & offersBody peerA [eb 'a']
-    & offersBody peerB [eb 'a']
+    & offersBody peerA [point 1 'a']
+    & offersBody peerB [point 1 'a']
     & runIteration
-    -- two peers offer; the fetch logic selects up to the per-EB cap of them
-    & assertRequestPeerCount (min 2 (maxRequestsPerEb demoLeiosFetchStaticEnv))
-
-test_globalByteBudget :: IO ()
-test_globalByteBudget =
-  empty
-    & withMissingBody (point 1 'a') 1024
-    & withTotalRequestedBytes (maxRequestedBytesSize demoLeiosFetchStaticEnv)
-    & offersBody peerA [eb 'a']
-    & runIteration
-    & assertNoRequests
+    -- both peers offer; with no per-EB cap the body is requested from both
+    & assertRequestPeerCount 2
 
 test_perPeerByteBudget :: IO ()
 test_perPeerByteBudget =
@@ -130,8 +122,8 @@ 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]
 
@@ -142,7 +134,7 @@ test_perPeerByteBudget =
 -- | 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)
   }
 
@@ -156,9 +148,17 @@ empty =
 
 -- | 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)}
+    -- 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 $
+      o
+        { missingEbBodies = Map.insert p size (missingEbBodies o)
+        , reverseSlotIndexByEbHash =
+            Map.insertWith NESet.union ebHash (NESet.singleton slot) (reverseSlotIndexByEbHash o)
+        }
 
 alreadyRequestedEbFrom :: Ord pid => EbHash -> [pid] -> Scenario pid -> Scenario pid
 alreadyRequestedEbFrom ebHash pids =
@@ -172,12 +172,6 @@ alreadyRequestedEbFrom ebHash pids =
             (requestedEbPeers 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 ::
@@ -191,26 +185,21 @@ 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])
 
 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'.
@@ -224,11 +213,13 @@ onOutstanding f sc = sc{scOutstanding = f (scOutstanding sc)}
 --
 -- (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 -> LeiosFetchDecisions pid
+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
+  let (_out, reqs, _drops) =
+        leiosFetchLogicIteration sc.scEnv (Just minBound) sc.scOfferings sc.scOutstanding
+   in reqs
 
 ------------------------------------------------------------
 -- Assertions
@@ -239,33 +230,31 @@ 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)]
 
-assertNoRequests :: (Ord pid, Show pid) => LeiosFetchDecisions pid -> IO ()
-assertNoRequests (MkLeiosFetchDecisions m) = Map.keys m @?= []
+assertNoRequests :: (Ord pid, Show pid) => Map.Map (PeerId pid) (NESeq LeiosFetchRequest) -> IO ()
+assertNoRequests 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. Order-independent, so it
--- holds for any 'maxRequestsPerEb' \/ 'maxRequestsPerTx': at a cap below the
--- number of offering peers, /which/ peers win is a selection-order detail, but
--- the count is not.
-assertRequestPeerCount :: Int -> LeiosFetchDecisions pid -> IO ()
-assertRequestPeerCount n (MkLeiosFetchDecisions m) = Map.size m @?= n
+-- | 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
diff --git a/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic/Invariants.hs b/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic/Invariants.hs
index 6d51047b0e..4a9c42cb00 100644
--- a/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic/Invariants.hs
+++ b/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic/Invariants.hs
@@ -41,19 +41,18 @@ 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 qualified Data.DList as DList
+import Data.Foldable (toList)
 import qualified Data.Map.Strict as Map
 import qualified Data.Set as Set
 import qualified Data.Set.NonEmpty as NESet
+import Data.Sequence.NonEmpty (NESeq)
 import qualified Data.Vector.Strict as V
 import Data.Void (Void, absurd)
 import LeiosDemoDb (withLeiosDb)
 import qualified LeiosDemoDb as LeiosDb
 import LeiosDemoLogic
-  ( AlsoOfferedTxsClosure (..)
-  , LeiosBlockSource (..)
+  ( LeiosBlockSource (..)
   , LeiosBlockTxsSource (..)
-  , LeiosFetchDecisions (..)
   , leiosFetchLogicIteration
   , processLeiosBlock
   , processLeiosBlockTxs
@@ -61,7 +60,8 @@ import LeiosDemoLogic
   , recordEbBodyOffer
   )
 import LeiosDemoTypes
-  ( BytesSize
+  ( AlsoOfferedTxsClosure (..)
+  , BytesSize
   , EbHash
   , LeiosBlockRequest (..)
   , LeiosEb (..)
@@ -102,20 +102,20 @@ tests =
     , testCase "acquired EB kept until its greatest slot is below the immutable tip" $ do
         let eb = ebOf [0, 1]
             h = hashLeiosEb eb
-            pool = Jobs.mkLeiosJobPool 1000 10 mempty -- an empty pool suffices here
+            jobPool = Jobs.mkLeiosJobPool 1000 10 mempty -- an empty job pool suffices here
             -- announce at slot 5, then again at the smaller slot 3, and acquire
             o =
-              Leios.insertAcquiredEbBody h eb pool $
+              Leios.insertAcquiredEbBody h eb jobPool $
                 Leios.recordMaxAnnouncementSlot h (SlotNo 3) $
                   Leios.recordMaxAnnouncementSlot h (SlotNo 5) $
                     (emptyLeiosOutstanding (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) (Leios.BodyAcquired eb pool))
+        Map.lookup h (Leios.ebState o) @?= Just (Leios.MkEbState (SlotNo 5) (Leios.BodyAcquired eb jobPool))
         -- kept while the greatest slot (5) is at/above the immutable tip (4)
-        Map.lookup h (Leios.ebState (Leios.pruneOutstandingToImmTip (SlotNo 4) o))
-          @?= Just (Leios.MkEbState (SlotNo 5) (Leios.BodyAcquired eb pool))
+        Map.lookup h (Leios.ebState (snd (Leios.pruneOutstandingToImmTip (SlotNo 4) o)))
+          @?= Just (Leios.MkEbState (SlotNo 5) (Leios.BodyAcquired eb jobPool))
         -- dropped once the greatest slot (5) is below the immutable tip (6)
-        Map.lookup h (Leios.ebState (Leios.pruneOutstandingToImmTip (SlotNo 6) o))
+        Map.lookup h (Leios.ebState (snd (Leios.pruneOutstandingToImmTip (SlotNo 6) o)))
           @?= Nothing
     , 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
@@ -132,7 +132,7 @@ tests =
                       , (hB, NESet.singleton (SlotNo 3))
                       ]
                 }
-            o = Leios.pruneOutstandingToImmTip (SlotNo 5) o0
+            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
@@ -281,9 +281,8 @@ applyCmd conn txCache kv peerVars peerId = \case
     pure []
   Decide slot -> do
     outstanding <- readMVar (fst kv)
-    let ebs = referencedEbs outstanding
-        offerings = Map.singleton peerId (ebs, ebs)
-        (out', decs) =
+    let offerings = Map.singleton peerId (referencedOffers outstanding)
+        (out', decs, _drops) =
           leiosFetchLogicIteration demoLeiosFetchStaticEnv (Just (fromIntegral slot)) offerings outstanding
     -- Force the fetch logic so any 'impossible!' surfaces (caught by 'go').
     -- Forcing @out'@ to WHNF drives 'go1' to completion (its reverse lookups);
@@ -296,32 +295,35 @@ applyCmd conn txCache kv peerVars peerId = \case
     let held = Map.keysSet (Map.filter Leios.ebStateHasBody (Leios.ebState outstanding))
     pure (filter (\h -> Set.member h held) (ebBodyRequestHashes decs))
 
--- | Every EbHash currently referenced by the outstanding state (bodies only, now
--- that the EbTxs side is disarmed), as an all-offering peer's body\/closure sets.
-referencedEbs :: LeiosOutstanding Int -> Set.Set EbHash
-referencedEbs o =
-  Set.fromList $
-    map (.pointEbHash) (Map.keys (Leios.missingEbBodies o))
-
--- | Force the decision structure, including each tx request's resolved offset
--- (the @goTx2@ lookup), to a scalar.
-forceDecisions :: LeiosFetchDecisions pid -> Int
-forceDecisions (MkLeiosFetchDecisions m) =
-  sum
-    [ offset + fromIntegral sz
-    | slotMap <- Map.elems m
-    , (txs, _ebs) <- Map.elems slotMap
-    , (_txHash, sz, _ebHash, offset) <- DList.toList txs
+-- | 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)
     ]
 
--- | The 'EbHash'es a decision set issues an EB-body fetch request for (one entry
--- per request; the fetch logic caps this at 'maxRequestsPerEb' per EB).
-ebBodyRequestHashes :: LeiosFetchDecisions pid -> [EbHash]
-ebBodyRequestHashes (MkLeiosFetchDecisions m) =
-  [ ebHash
-  | slotMap <- Map.elems m
-  , (_txs, ebReqs) <- Map.elems slotMap
-  , (ebHash, _sz) <- DList.toList ebReqs
+-- | 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 offset
+-- bitmap 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 bitmaps _jobIds) ->
+      sum [fromIntegral idx + fromIntegral mask | (idx, mask) <- bitmaps]
+
+-- | 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
   ]
 
 ------------------------------------------------------------

From 694cf9e9bc2d41bffae9fa6e0aaa2ab25437d3bc Mon Sep 17 00:00:00 2001
From: Nicolas Frisby <nicolas.frisby@moduscreate.com>
Date: Mon, 24 Aug 2026 12:10:43 -0400
Subject: [PATCH 30/49] LeiosFetch: retain root hash per job instead of EB body

- Prior to this commit, we retained each EB body in memory until its closure
  fully arrived.

- For up to 10,000 EBs with up to 512 kB per body, that's up to ~5
  gigabytes---unjustifiable.

- We could retrieve them from disk, but then there's extra disk IO and/or caches
  to maintain, etc etc.

- Instead, we're storing at most one 32 byte hash per job, with at most 184 jobs
  per EB body, which is up to ~60 megabytes since there are up to 10000
  bodies. Affordable.

And since that's affordable, we have no need to _directly_ limit how many EBs
are inflight at any given time (neither globally nor with each peer); a nice
simplification.

A future version of the LeiosDb might require some the tx's byte-offsets within
the EB for storage. That might reintroduce the need for in-memory storage and
hence bounding the inflight EB count---but we don't already have that need.
---
 .../src/ouroboros-consensus/LeiosDemoLogic.hs | 313 +++++++++++-------
 .../src/ouroboros-consensus/LeiosDemoTypes.hs |  66 ++--
 .../LeiosDemoTypes/LeiosJobs.hs               |  80 ++++-
 .../Test/LeiosDemoLogic/Invariants.hs         |  22 +-
 4 files changed, 302 insertions(+), 179 deletions(-)

diff --git a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
index fc778fa9bf..ffd2ca1bcb 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
@@ -26,9 +26,11 @@ import Control.Monad.Primitive (PrimMonad, PrimState)
 import Control.Tracer (Tracer, contramap, nullTracer, traceWith)
 import qualified Data.Bits as Bits
 import qualified Data.ByteString as BS
+import Data.Foldable (fold)
 import Data.Functor (void, (<&>))
 import qualified Data.IntMap as IntMap
 import qualified Data.IntSet as IntSet
+import qualified Data.IntMap.NonEmpty as NEIntMap
 import Data.IntSet.NonEmpty (NEIntSet)
 import qualified Data.IntSet.NonEmpty as NEIntSet
 import Data.List (unfoldr)
@@ -411,11 +413,11 @@ assignPeer env mbCurrentSlot peerId offers acc =
           -- closure from this peer once we hold the body.
           let (acc2, dec2) = assignBody peerId ebHash slot (acc1, dec1)
            in (acc2, dec2, drops)
-        (Leios.BodyAcquired _body _jobPool, TxsClosureNotAlsoOffered) ->
+        (Leios.BodyAcquired _jobPool, TxsClosureNotAlsoOffered) ->
           -- We hold the body and the peer never offered the closure, so it
           -- can no longer help.
           pruneThisOffer
-        (Leios.BodyAcquired _body jobPool, TxsClosureAlsoOffered)
+        (Leios.BodyAcquired jobPool, TxsClosureAlsoOffered)
           | Jobs.nullLeiosJobPool jobPool ->
              -- whole datum in hand: the closure offer is useless now too
              pruneThisOffer
@@ -474,7 +476,7 @@ assignClosure env peerId ebHash st@(acc, dec) =
   case Map.lookup ebHash (Leios.ebState acc) of
     Nothing -> (st, MkWhetherPeerEbExhausted False)
     Just (Leios.MkEbState _slot Leios.NoBody{}) -> (st, MkWhetherPeerEbExhausted False)
-    Just (Leios.MkEbState slot (Leios.BodyAcquired body jobPool)) ->
+    Just (Leios.MkEbState slot (Leios.BodyAcquired jobPool)) ->
       let inflightJobs =
             maybe IntSet.empty NEIntSet.toSet $
               Map.lookup ebHash =<< Map.lookup peerId (Leios.requestedJobsPerPeer acc)
@@ -488,26 +490,23 @@ assignClosure env peerId ebHash st@(acc, dec) =
                       { Leios.ebState =
                           Map.insert
                             ebHash
-                            (Leios.MkEbState slot (Leios.BodyAcquired body jobPool'))
+                            (Leios.MkEbState slot (Leios.BodyAcquired jobPool'))
                             (Leios.ebState acc)
                       , Leios.requestedJobsPerPeer =
                           Map.insertWith
                             (Map.unionWith NEIntSet.union)
                             peerId
-                            (Map.singleton ebHash $ neIntSetFromNonEmpty $ fmap (\(jid, _, _) -> jid) nePicked)
+                            (Map.singleton ebHash $ NEIntSet.fromList $ fmap (\(Jobs.MkLeiosJobId i, _) -> i) nePicked)
                             (Leios.requestedJobsPerPeer acc)
                       , Leios.requestedBytesSizePerPeer =
                           Map.insertWith
                             (+)
                             peerId
-                            (sum $ fmap (\(_, _, bytes) -> bytes) nePicked)
+                            (sum $ fmap (\(_, Jobs.MkLeiosJob _ bytes _) -> bytes) nePicked)
                             (Leios.requestedBytesSizePerPeer acc)
                       }
                   reqs = batchTxsRequests env (MkLeiosPoint slot ebHash) nePicked
                in (acc', dec <> Seq.fromList reqs)
-  where
-    neIntSetFromNonEmpty :: NonEmpty Int -> NEIntSet
-    neIntSetFromNonEmpty (x :| xs) = NEIntSet.insertSet x $ IntSet.fromList xs
 
 -- | 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.
@@ -518,12 +517,13 @@ bodySize acc ebHash = do
 
 -- | 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.
+-- returns true, in the latter case. Each pick carries the whole 'Jobs.LeiosJob'
+-- (id + commitment) so the request can validate its own response.
 pickJobs ::
   IntSet.IntSet ->
   Jobs.LeiosJobPool ->
   Int ->
-  ([(Int, IntSet.IntSet, BytesSize)], Jobs.LeiosJobPool, WhetherPeerEbExhausted)
+  ([(Jobs.LeiosJobId, Jobs.LeiosJob)], Jobs.LeiosJobPool, WhetherPeerEbExhausted)
 pickJobs inflightJobs0 jobPool0 budget0 =
   go inflightJobs0 jobPool0 budget0 []
  where
@@ -531,36 +531,37 @@ pickJobs inflightJobs0 jobPool0 budget0 =
     | budget <= 0 = (reverse acc, jobPool, MkWhetherPeerEbExhausted False)
     | otherwise = case Jobs.pickLeastRequestedJobExcept inflightJobs jobPool of
         Nothing -> (reverse acc, jobPool, MkWhetherPeerEbExhausted True)
-        Just (Jobs.MkLeiosJobId jid, Jobs.MkLeiosJob offsets bytes, jobPool') ->
+        Just (jid@(Jobs.MkLeiosJobId i), job@(Jobs.MkLeiosJob _offsets bytes _root), jobPool') ->
           go
-            (IntSet.insert jid inflightJobs)
+            (IntSet.insert i inflightJobs)
             jobPool'
             (budget - fromIntegral bytes)
-            ((jid, offsets, bytes) : acc)
-
--- | Partition the N picked jobs (pick order) into M <= N requests, each within
--- 'maxRequestBytesSize'. Seeding each batch from its first job keeps the
--- accumulating job-id set non-empty, so no empty-batch handling is needed (a
--- lone job above the cap simply forms its own request).
-batchTxsRequests :: LeiosFetchStaticEnv -> LeiosPoint -> NonEmpty (Int, IntSet.IntSet, BytesSize) -> [LeiosFetchRequest]
-batchTxsRequests env point ((jid0, offsets0, bytes0) :| rest0) =
-  go offsets0 (NEIntSet.singleton jid0) (fromIntegral bytes0) rest0
+            ((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
-  go curOffsets curJids curBytes = \case
-    [] -> [flush curOffsets curJids]
-    (jid, offsets, bytes) : rest
-      | curBytes + fromIntegral bytes > cap ->
-          flush curOffsets curJids
-            : go offsets (NEIntSet.singleton jid) (fromIntegral bytes) rest
-      | otherwise ->
-          go
-            (IntSet.union offsets curOffsets)
-            (NEIntSet.insert jid curJids)
-            (curBytes + fromIntegral bytes)
-            rest
-  flush curOffsets curJids =
-    LeiosBlockTxsRequest (MkLeiosBlockTxsRequest point (offsetsToBitmap curOffsets) curJids)
+  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)]
@@ -672,13 +673,16 @@ nextLeiosFetchClientCommand ktracer tracer stopSTM kernelVars txCache db peerId
             StrictSTM.atomically $
               LazySTM.writeTQueue responseQ (PendingBlockResponse req eb)
         )
-    LeiosBlockTxsRequest req@(MkLeiosBlockTxsRequest p bitmaps _jobIds) ->
-      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)
+            )
 
 -----
 
@@ -842,12 +846,15 @@ processLeiosBlock ktracer tracer (outstandingVar, readyVar) txCache db source eb
         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); 'misses' 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)
-                (IntMap.map snd misses)
-            !outstanding' = Leios.insertAcquiredEbBody ebHash eb jobPool outstandingCleaned
+                misses
+            !outstanding' = Leios.insertAcquiredEbBody ebHash jobPool outstandingCleaned
         pure (outstanding', bodyClass)
   void $ MVar.tryPutMVar readyVar ()
   case source of
@@ -892,8 +899,8 @@ removePeerFromOutstanding peerId o =
   releaseJobs jobIds (Leios.MkEbState slot fetchState) =
     Leios.MkEbState slot $ case fetchState of
       Leios.NoBody -> Leios.NoBody
-      Leios.BodyAcquired body jobPool ->
-        Leios.BodyAcquired body $!
+      Leios.BodyAcquired jobPool ->
+        Leios.BodyAcquired $!
           NEIntSet.foldl'
             (flip $ Jobs.unpickJob . Jobs.MkLeiosJobId)
             jobPool
@@ -970,8 +977,8 @@ completeTxRequest peerId ebHash jobIds o =
   completeInJobPool (Leios.MkEbState slot fetchState) =
     Leios.MkEbState slot $ case fetchState of
       Leios.NoBody -> Leios.NoBody
-      Leios.BodyAcquired body jobPool ->
-        Leios.BodyAcquired body $!
+      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))
@@ -990,9 +997,51 @@ bitmapOffsets = unfoldr nextOffset
       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
   ) =>
@@ -1006,86 +1055,98 @@ processLeiosBlockTxs ::
   LeiosBlockTxsSource pid ->
   V.Vector LeiosTx ->
   m ()
-processLeiosBlockTxs ktracer tracer (outstandingVar, readyVar) txCache db source txs = do
-  let txBytess = V.map cbor txs
-      batchBytes = V.sum (V.map BS.length txBytess)
-  -- The tx hashes: for a forge, from the body directly (position-aligned with the
-  -- 'txs' vector); for an arrival, by expanding the request's offset bitmap
-  -- against the EB body we hold (the request no longer carries the hashes).
-  -- Validated against the arrived txs below.
-  txHashes <- case source of
-    ForgedTxs _ eb -> pure $ V.map fst (leiosEbTxs eb)
-    ReceivedTxsFrom _ (MkLeiosBlockTxsRequest point bitmaps _jobIds) -> do
-      outstanding <- MVar.readMVar outstandingVar
-      case Map.lookup point.pointEbHash (Leios.ebState outstanding) of
-        Just (Leios.MkEbState _slot (Leios.BodyAcquired eb _jobPool)) ->
-          pure $ V.fromList [fst (leiosEbTxs eb V.! off) | off <- bitmapOffsets bitmaps]
-        _ ->
-          -- We only request txs for an EB whose body we hold; a body-prune race
-          -- could in principle reach here. TODO disconnecting is harsh.
-          error "MsgLeiosBlockTxs arrived but its EB body is no longer held"
-  -- validate it (an arrival only; a forge's data is self-produced)
-  -- TODO: could validate the returned point + bitmaps too
-  case source of
-    ForgedTxs{} -> pure ()
-    ReceivedTxsFrom _ req -> do
-      traceWith tracer $ MkTraceLeiosPeer $ "[start] " ++ Leios.prettyLeiosBlockTxsRequest req
-      let invalidReply reason =
-            traceWith ktracer (TraceLeiosFetchTxsArrival (fetchArrivalInvalid (fromIntegral batchBytes)))
-              >> error reason
-      when (V.length txs /= V.length txHashes) $
-        invalidReply $ "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'
-        invalidReply $ "MsgLeiosBlockTxs hash mismatches: " ++ show mismatches
-  -- ingest: write to the LeiosDb, then the tx-cache. A forge tags its txs applied
-  -- (drawn from its validated mempool, so known-valid) and emits no fetch-arrival
-  -- telemetry; a peer's delivery tags them unapplied and is attributed to the
-  -- arrival panels. The cache insert follows the LeiosDb write, which is what the
-  -- index currently reflects.
-  traceException tracer TraceLeiosPeerDbException $ do
-    completed <- leiosDbInsertTxs db (V.toList $ V.zip txHashes txBytess)
-    forM_ completed $ traceWith ktracer . TraceLeiosBlockTxsAcquired
-    case source of
-      ForgedTxs{} ->
-        withLockedInsertAppliedTx txCache $ \w0 step ->
-          V.foldM' (\w txh -> step w txh ()) w0 txHashes
-      ReceivedTxsFrom{} -> do
-        -- The handle buckets each tx's bytes by its prior state in the same
-        -- locked pass -- coherent under concurrent duplicate deliveries; the
-        -- returned partition sums to the batch size.
-        txArrival <-
-          withLockedInsertUnappliedTx txCache $ \w0 step ->
-            V.foldM'
-              (\w (txh, sz) -> step w txh sz ())
-              w0
-              (V.zip txHashes (V.map (fromIntegral . BS.length) txBytess))
-        traceWith ktracer $ TraceLeiosFetchTxsArrival txArrival
-  -- update NodeKernel state
-  MVar.modifyMVar_ outstandingVar $ \outstanding -> do
-    case source of
-      ForgedTxs{} ->
-        pure $
-          outstanding
-      ReceivedTxsFrom peerId (MkLeiosBlockTxsRequest point _bitmaps jobIds) -> do
-        -- '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 jobPool and
-        -- from this peer's in-flight set, so they are never re-requested.
-        pure $
-          completeTxRequest peerId point.pointEbHash jobIds $
-            refundTxRequest peerId (fromIntegral batchBytes) $
-              outstanding
-  void $ MVar.tryPutMVar readyVar ()
-  case source of
-    ForgedTxs{} -> pure ()
-    ReceivedTxsFrom _ req ->
-      traceWith tracer $ MkTraceLeiosPeer $ "[done] " ++ Leios.prettyLeiosBlockTxsRequest req
+processLeiosBlockTxs ktracer tracer (outstandingVar, readyVar) txCache db source txs = case source of
+  ForgedTxs _point eb -> do
+    -- Self-produced: no validation, no fetch bookkeeping, no arrival telemetry.
+    -- The body is at hand, so the tx hashes come straight from it (position-aligned
+    -- with 'txs'), and the txs are tagged applied (drawn from a validated mempool).
+    let toIngest = zip (V.toList (V.map fst (leiosEbTxs eb))) (V.toList (V.map cbor txs))
+    traceException tracer TraceLeiosPeerDbException $ do
+      completed <- leiosDbInsertTxs db toIngest
+      forM_ completed $ traceWith ktracer . TraceLeiosBlockTxsAcquired
+      withLockedInsertAppliedTx txCache $ \w0 step ->
+        foldM (\w (txh, _bs) -> step w txh ()) w0 toIngest
+    void $ MVar.tryPutMVar readyVar ()
+  ReceivedTxsFrom peerId req@(MkLeiosBlockTxsRequest point jobs) -> do
+    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 Leios.NoBody) ->
+            IntMap.empty
+          Just (Leios.MkEbState _slot (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); the DB write precedes the cache
+    -- insert. The cache handle buckets each tx by its prior state in one locked
+    -- pass --- coherent under concurrent duplicate deliveries.
+    --
+    -- 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. That's harmless --- the DB insert is idempotent and the
+    -- cache tolerates duplicates --- so we accept it rather than add a
+    -- claim-under-lock step; only arrival telemetry double-counts.
+    traceException tracer TraceLeiosPeerDbException $ do
+      completed <- leiosDbInsertTxs db toIngest
+      forM_ completed $ traceWith ktracer . TraceLeiosBlockTxsAcquired
+      txArrival <-
+        withLockedInsertUnappliedTx txCache $ \w0 step ->
+          foldM (\w (txh, bs) -> step w txh (fromIntegral (BS.length bs)) ()) w0 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
 
 -----
 
-
 -- | 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
diff --git a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs
index 9bf82112f1..2ed38347c6 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,7 +61,7 @@ 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 Codec.Serialise (Serialise, decode, encode)
 import Control.Concurrent.Class.MonadMVar (MVar)
@@ -72,8 +78,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.NonEmpty (NEIntMap)
+import qualified Data.IntMap.NonEmpty as NEIntMap
 import Data.IntSet.NonEmpty (NEIntSet)
-import qualified Data.IntSet.NonEmpty as NEIntSet
 import Data.List (sortOn)
 import Data.Map (Map)
 import qualified Data.Map.Strict as Map
@@ -86,6 +93,7 @@ import Data.Set (Set)
 import qualified Data.Set as Set
 import Data.Set.NonEmpty (NESet)
 import qualified Data.Set.NonEmpty as NESet
+import LeiosDemoTypes.LeiosJobs as TxHashReexports (TxHash (..), prettyTxHash)
 import qualified LeiosDemoTypes.LeiosJobs as Jobs
 import Data.String (fromString)
 import Data.Time.Clock (NominalDiffTime)
@@ -165,16 +173,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}
@@ -320,23 +318,24 @@ data LeiosBlockRequest
       !BytesSize
 
 data LeiosBlockTxsRequest
-  = -- | A request for some of an EB's txs: its point, the offset bitmap (the only
-    -- part sent to the peer), and the ids of the 'Jobs.LeiosJob's it covers. The
-    -- job ids are kept locally to 'Jobs.completeJob' on the response; the
-    -- validation hashes are re-derived from the body at arrival, so they are not
-    -- carried here.
+  = -- | 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)]
-      !NEIntSet
+      !(NEIntMap Jobs.LeiosJob)
 
 prettyLeiosBlockTxsRequest :: LeiosBlockTxsRequest -> String
-prettyLeiosBlockTxsRequest (MkLeiosBlockTxsRequest p bitmaps jobIds) =
-  unwords $
-    "MsgLeiosBlockTxs"
-      : prettyLeiosPoint p
-      : ("jobs=" <> show (toList (NEIntSet.toList jobIds)))
-      : map prettyBitmap bitmaps
+prettyLeiosBlockTxsRequest (MkLeiosBlockTxsRequest p jobs) =
+  unwords
+    [ "MsgLeiosBlockTxs"
+    , prettyLeiosPoint p
+    , "jobs=" <> show (toList (NEIntMap.keys jobs))
+    ]
 
 prettyBitmap :: (Word16, Word64) -> String
 prettyBitmap (idx, bitmap) =
@@ -482,12 +481,17 @@ data EbState =
 data EbFetchState
   = NoBody
   | -- | The job pool: the jobs not yet /requested/ (NB this can be empty even
-    -- before jobs have /arrived/)
+    -- 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 !LeiosEb !Jobs.LeiosJobPool
+    BodyAcquired !Jobs.LeiosJobPool
   deriving (Eq, Show)
 
 ebStateMaxSlot :: EbState -> SlotNo
@@ -501,8 +505,8 @@ ebStateHasBody (MkEbState _slot fetchState) = case fetchState of
   BodyAcquired{} -> True
 
 insertAcquiredEbBody ::
-  EbHash -> LeiosEb -> Jobs.LeiosJobPool -> LeiosOutstanding pid -> LeiosOutstanding pid
-insertAcquiredEbBody ebHash body jobPool =
+  EbHash -> Jobs.LeiosJobPool -> LeiosOutstanding pid -> LeiosOutstanding pid
+insertAcquiredEbBody ebHash jobPool =
   alterEbState ebHash $ \case
     Nothing ->
       -- The state must have been pruned before the MsgLeiosBlock
@@ -513,7 +517,7 @@ insertAcquiredEbBody ebHash body jobPool =
       Nothing
     Just (MkEbState slot fetchState) -> case fetchState of
       BodyAcquired{} -> Nothing
-      NoBody -> Just $ MkEbState slot (BodyAcquired body jobPool)
+      NoBody -> Just $ MkEbState slot (BodyAcquired jobPool)
 
 -- | Record that the EB with this hash is referenced (announced or offered) at this
 -- slot
diff --git a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes/LeiosJobs.hs b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes/LeiosJobs.hs
index 87b71e588a..bb25c09f4a 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes/LeiosJobs.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes/LeiosJobs.hs
@@ -1,4 +1,8 @@
 {-# 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.
@@ -7,13 +11,21 @@
 --
 -- A leaf module (imported by "LeiosDemoTypes") so the pool's structural
 -- operations -- greedy partition, least-requested selection, multiplicity
--- bookkeeping -- stay together and depend only on 'IntMap'/'IntSet'.
+-- 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)
@@ -21,15 +33,42 @@ 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)
+
+-- | 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), plus the
--- total on-the-wire byte size of those txs (for the fetch byte budget).
+-- @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
+    MkLeiosJob !IntSet !Word32 !JobRootHash
   deriving (Eq, Show)
 
 -- | Identifies a 'LeiosJob' within its 'LeiosJobPool' (0-based, stable for the
@@ -59,18 +98,22 @@ data LeiosJobPool = MkLeiosJobPool
   }
   deriving (Eq, Show)
 
--- | Partition the missing txs (each given by its offset within the EB body and
--- its on-the-wire byte size) into jobs, greedily in offset order: a job grows
+-- | 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).
-mkLeiosJobPool :: Word32 -> Int -> IntMap Word32 -> LeiosJobPool
+--
+-- 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 (MkLeiosJob offs bytes) (MkLeiosJobMultiplicity 0))
-          | (jid, (offs, bytes)) <- ijbs
+          [ (jid, MkLeiosJobState job (MkLeiosJobMultiplicity 0))
+          | (jid, job) <- ijbs
           ]
     , jobsByMultiplicity =
         maybe IntMap.empty (IntMap.singleton 0) $
@@ -79,13 +122,15 @@ mkLeiosJobPool maxJobBytes maxJobTxCount misses =
  where
   ijbs = zip [0 ..] $ case IntMap.toAscList misses of
     [] -> []
-    ((off0, sz0) : rest) -> grow (IntSet.singleton off0) sz0 1 rest
+    ((off0, (h0, sz0)) : rest) -> grow (IntSet.singleton off0) sz0 1 [h0] rest
 
-  grow !cur !bytes !_count [] = [(cur, bytes)]
-  grow !cur !bytes !count ((off, sz) : 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) rest
-    | otherwise = (cur, bytes) : grow (IntSet.singleton off) sz 1 rest
+        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
@@ -96,6 +141,13 @@ 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
+
 -- | 'pickLeastRequestedJobExcept' with no exclusions.
 pickLeastRequestedJob :: LeiosJobPool -> Maybe (LeiosJobId, LeiosJob, LeiosJobPool)
 pickLeastRequestedJob = pickLeastRequestedJobExcept IntSet.empty
diff --git a/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic/Invariants.hs b/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic/Invariants.hs
index 4a9c42cb00..975caee854 100644
--- a/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic/Invariants.hs
+++ b/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic/Invariants.hs
@@ -42,6 +42,7 @@ 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.IntSet as IntSet
 import qualified Data.Map.Strict as Map
 import qualified Data.Set as Set
 import qualified Data.Set.NonEmpty as NESet
@@ -102,18 +103,19 @@ tests =
     , testCase "acquired EB kept until its greatest slot is below the immutable tip" $ do
         let eb = ebOf [0, 1]
             h = hashLeiosEb eb
-            jobPool = Jobs.mkLeiosJobPool 1000 10 mempty -- an empty job pool suffices here
+            -- 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 eb jobPool $
+              Leios.insertAcquiredEbBody h jobPool $
                 Leios.recordMaxAnnouncementSlot h (SlotNo 3) $
                   Leios.recordMaxAnnouncementSlot h (SlotNo 5) $
                     (emptyLeiosOutstanding (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) (Leios.BodyAcquired eb jobPool))
+        Map.lookup h (Leios.ebState o) @?= Just (Leios.MkEbState (SlotNo 5) (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) (Leios.BodyAcquired eb jobPool))
+          @?= Just (Leios.MkEbState (SlotNo 5) (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
@@ -306,16 +308,20 @@ referencedOffers 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 offset
--- bitmap and each EB request's size.
+-- 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 bitmaps _jobIds) ->
-      sum [fromIntegral idx + fromIntegral mask | (idx, mask) <- bitmaps]
+    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).

From 8e28006d415d4d8f579f9e72fd71a5ee211e1f1e Mon Sep 17 00:00:00 2001
From: Nicolas Frisby <nicolas.frisby@moduscreate.com>
Date: Mon, 24 Aug 2026 16:18:34 -0400
Subject: [PATCH 31/49] LeiosFetch: bugfix, avoid multiple AcquiredEbTxs
 notifications

The node was crashing shortly after announcing an EB. The error was raised
because the node was voting for the same announcement twice (which causes a
crash, at least currently). The node votes once per AcquiredEbTxs, and there
were two of those for EBs the node announces: one caused by the forge inserting
the body and the closure and the other by LeiosFetch also fetching the body a
second time, and seeing that its entire closure was present upon its
arrival. (LeiosDb.InMemory actually catches this and suppresses it, but SQLite
doesn't. Even so, it shouldn't be the responsibility of the LeiosDb to do so.)

The forge wasn't updating the LeiosOutstanding bookkeeping to record that the
body was already present. This commit fixes that.
---
 .../src/ouroboros-consensus/LeiosDemoLogic.hs | 97 +++++++++++++------
 .../src/ouroboros-consensus/LeiosDemoTypes.hs | 35 ++++++-
 .../LeiosDemoTypes/LeiosJobs.hs               |  4 +
 .../consensus-test/Test/LeiosDemoLogic.hs     | 30 ++++++
 .../Test/LeiosDemoLogic/Invariants.hs         | 42 +++++++-
 5 files changed, 172 insertions(+), 36 deletions(-)

diff --git a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
index ffd2ca1bcb..d8d38c919d 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
@@ -403,6 +403,11 @@ assignPeer env mbCurrentSlot peerId offers acc =
         -- prune it now.
         pruneThisOffer
       Just (Leios.MkEbState slot 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.
@@ -475,7 +480,8 @@ assignClosure ::
 assignClosure env peerId ebHash st@(acc, dec) =
   case Map.lookup ebHash (Leios.ebState acc) of
     Nothing -> (st, MkWhetherPeerEbExhausted False)
-    Just (Leios.MkEbState _slot Leios.NoBody{}) -> (st, MkWhetherPeerEbExhausted False)
+    Just (Leios.MkEbState _slot Leios.NoBody) -> (st, MkWhetherPeerEbExhausted False)
+    Just (Leios.MkEbState _slot Leios.BodyImminent) -> (st, MkWhetherPeerEbExhausted False)
     Just (Leios.MkEbState slot (Leios.BodyAcquired jobPool)) ->
       let inflightJobs =
             maybe IntSet.empty NEIntSet.toSet $
@@ -899,6 +905,7 @@ removePeerFromOutstanding peerId o =
   releaseJobs jobIds (Leios.MkEbState slot fetchState) =
     Leios.MkEbState slot $ case fetchState of
       Leios.NoBody -> Leios.NoBody
+      Leios.BodyImminent -> Leios.BodyImminent
       Leios.BodyAcquired jobPool ->
         Leios.BodyAcquired $!
           NEIntSet.foldl'
@@ -977,6 +984,7 @@ completeTxRequest peerId ebHash jobIds o =
   completeInJobPool (Leios.MkEbState slot fetchState) =
     Leios.MkEbState slot $ 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
@@ -1057,15 +1065,14 @@ processLeiosBlockTxs ::
   m ()
 processLeiosBlockTxs ktracer tracer (outstandingVar, readyVar) txCache db source txs = case source of
   ForgedTxs _point eb -> do
-    -- Self-produced: no validation, no fetch bookkeeping, no arrival telemetry.
-    -- The body is at hand, so the tx hashes come straight from it (position-aligned
-    -- with 'txs'), and the txs are tagged applied (drawn from a validated mempool).
-    let toIngest = zip (V.toList (V.map fst (leiosEbTxs eb))) (V.toList (V.map cbor txs))
-    traceException tracer TraceLeiosPeerDbException $ do
-      completed <- leiosDbInsertTxs db toIngest
-      forM_ completed $ traceWith ktracer . TraceLeiosBlockTxsAcquired
-      withLockedInsertAppliedTx txCache $ \w0 step ->
-        foldM (\w (txh, _bs) -> step w txh ()) w0 toIngest
+    -- Ingest the whole closure (TODO even though we might already have some of
+    -- it).
+    --
+    -- No peer accounting, no arrival telemetry.
+    _ <- id $
+        ingestAcquiredTxs
+          Applied
+      $ V.toList (V.map fst (leiosEbTxs eb)) `zip` V.toList (V.map cbor txs)
     void $ MVar.tryPutMVar readyVar ()
   ReceivedTxsFrom peerId req@(MkLeiosBlockTxsRequest point jobs) -> do
     traceWith tracer $ MkTraceLeiosPeer $ "[start] " ++ Leios.prettyLeiosBlockTxsRequest req
@@ -1102,6 +1109,8 @@ processLeiosBlockTxs ktracer tracer (outstandingVar, readyVar) txCache db source
             IntMap.empty
           Just (Leios.MkEbState _slot Leios.NoBody) ->
             IntMap.empty
+          Just (Leios.MkEbState _slot Leios.BodyImminent) ->
+            IntMap.empty
           Just (Leios.MkEbState _slot (Leios.BodyAcquired jobPool)) ->
             Jobs.restrictToPending (NEIntMap.toMap jobs) jobPool
         -- The covered jobs we won't ingest -- an earlier delivery already
@@ -1118,22 +1127,11 @@ processLeiosBlockTxs ktracer tracer (outstandingVar, readyVar) txCache db source
     toIngest <-
       either invalidReply (pure . fold) $
         IntMap.traverseWithKey (\i job -> ingestJob aligned (Jobs.MkLeiosJobId i) job) pendingJobs
-    -- ingest the validated txs (unapplied); the DB write precedes the cache
-    -- insert. The cache handle buckets each tx by its prior state in one locked
-    -- pass --- coherent under concurrent duplicate deliveries.
-    --
-    -- 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. That's harmless --- the DB insert is idempotent and the
-    -- cache tolerates duplicates --- so we accept it rather than add a
-    -- claim-under-lock step; only arrival telemetry double-counts.
-    traceException tracer TraceLeiosPeerDbException $ do
-      completed <- leiosDbInsertTxs db toIngest
-      forM_ completed $ traceWith ktracer . TraceLeiosBlockTxsAcquired
-      txArrival <-
-        withLockedInsertUnappliedTx txCache $ \w0 step ->
-          foldM (\w (txh, bs) -> step w txh (fromIntegral (BS.length bs)) ()) w0 toIngest
-      traceWith ktracer $ TraceLeiosFetchTxsArrival (txArrival <> redundantExtra)
+    -- 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 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
@@ -1144,6 +1142,35 @@ processLeiosBlockTxs ktracer tracer (outstandingVar, readyVar) txCache db source
         . 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 :: WhetherApplied -> [(TxHash, BS.ByteString)] -> m Leios.FetchArrivalBytes
+  ingestAcquiredTxs applied toIngest =
+    traceException tracer TraceLeiosPeerDbException $ do
+      completed <- leiosDbInsertTxs db toIngest
+      forM_ completed $ traceWith ktracer . TraceLeiosBlockTxsAcquired
+      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
 
 -----
 
@@ -1309,12 +1336,13 @@ processAnnouncementCentrally
         (contramap (traceNewAnnouncement provenance) kernelTracer)
         ancElId
         ( \_elSt -> do
-            -- Only a received announcement lists the EB for fetching; one we
-            -- forged is already held (the forge stores it via 'processLeiosBlock').
-            -- (A peer echoing our announcement back never re-enters this
-            -- first-sight callback -- our ForgedLocally sight already claimed it.)
+            -- 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 -> pure ()
+              ForgedLocally -> markForged
               ReceivedViaChainSync -> recordAnnounced
               ReceivedViaLeiosNotify -> recordAnnounced
             recordAnnouncementInTxCache txCache ancHdr point
@@ -1330,6 +1358,9 @@ processAnnouncementCentrally
   -- 'headerLeiosAnnouncement'); its ebHash is kept in 'ancAnnouncementFields'.
   point = MkLeiosPoint (blockSlot (ancHeader ancHdr)) (announcementEbHash fields)
   recordAnnounced = recordAnnouncedEb kernelVars (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
@@ -1529,6 +1560,10 @@ maxAnnouncementAgeRecv = 600 -- 10 minutes
 -- ('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
diff --git a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs
index 2ed38347c6..01ed4826c7 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs
@@ -477,9 +477,22 @@ data EbState =
   MkEbState !SlotNo !EbFetchState
   deriving (Eq, Show)
 
--- | Whether we hold an EB's body.
+-- | Whether we hold an EB's body, plus the forge's imminent case.
 data EbFetchState
-  = NoBody
+  = -- | 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/).
     --
@@ -490,7 +503,8 @@ data EbFetchState
     --
     -- 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.
+    -- EbFetchState\/EbState\/LeiosOutstanding and a monadic body-acquire;
+    -- deferred.
     BodyAcquired !Jobs.LeiosJobPool
   deriving (Eq, Show)
 
@@ -502,6 +516,7 @@ ebStateMaxSlot (MkEbState slot _fetchState) = slot
 ebStateHasBody :: EbState -> Bool
 ebStateHasBody (MkEbState _slot fetchState) = case fetchState of
   NoBody -> False
+  BodyImminent -> False
   BodyAcquired{} -> True
 
 insertAcquiredEbBody ::
@@ -518,6 +533,20 @@ insertAcquiredEbBody ebHash jobPool =
     Just (MkEbState slot fetchState) -> case fetchState of
       BodyAcquired{} -> Nothing
       NoBody -> Just $ MkEbState slot (BodyAcquired jobPool)
+      BodyImminent ->
+        -- note that we ignore the given jobPool here
+        Just $ MkEbState slot (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
+    Nothing -> Just $ MkEbState slot BodyImminent
+    Just (MkEbState oldSlot fetchState) -> case fetchState of
+      NoBody -> Just $ MkEbState oldSlot BodyImminent
+      BodyImminent -> Nothing
+      BodyAcquired{} -> Just $ MkEbState oldSlot (BodyAcquired Jobs.emptyLeiosJobPool)
 
 -- | Record that the EB with this hash is referenced (announced or offered) at this
 -- slot
diff --git a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes/LeiosJobs.hs b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes/LeiosJobs.hs
index bb25c09f4a..c3d6092764 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes/LeiosJobs.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes/LeiosJobs.hs
@@ -148,6 +148,10 @@ lookupJob (MkLeiosJobId jid) pool =
 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
+
 -- | 'pickLeastRequestedJobExcept' with no exclusions.
 pickLeastRequestedJob :: LeiosJobPool -> Maybe (LeiosJobId, LeiosJob, LeiosJobPool)
 pickLeastRequestedJob = pickLeastRequestedJobExcept IntSet.empty
diff --git a/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic.hs b/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic.hs
index 47cdebbcb2..2904e46f6b 100644
--- a/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic.hs
+++ b/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic.hs
@@ -40,6 +40,7 @@ import LeiosDemoTypes
   , PeerId (..)
   , demoLeiosFetchStaticEnv
   , emptyLeiosOutstanding
+  , markBodyImminent
   , mergeOffer
   , recordMaxAnnouncementSlot
   )
@@ -63,6 +64,11 @@ tests =
         , testCase "per-peer byte budget exhausted skips that peer" $
             test_perPeerByteBudget
         ]
+    , testGroup
+        "self-forged EB"
+        [ testCase "an offer of a self-forged EB is never re-fetched" $
+            test_forgedEbOfferIgnored
+        ]
     ]
 
 ------------------------------------------------------------
@@ -127,6 +133,19 @@ test_perPeerByteBudget =
     & runIteration
     & assertRequestPeers [peerB]
 
+-- | 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
+    & withForgedEb (point 1 'a')
+    & offersBodyAndClosure peerA [point 1 'a']
+    & runIteration
+    & assertNoRequests
+
 ------------------------------------------------------------
 -- Scenario DSL
 ------------------------------------------------------------
@@ -160,6 +179,12 @@ withMissingBody p@(MkLeiosPoint slot ebHash) size =
             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 =
   onOutstanding $ \o ->
@@ -190,6 +215,11 @@ offersBody :: Ord pid => pid -> [LeiosPoint] -> Scenario pid -> Scenario pid
 offersBody pid points =
   insertOffering (MkPeerId pid) (Map.fromList [(p, TxsClosureNotAlsoOffered) | p <- points])
 
+-- | 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 ->
diff --git a/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic/Invariants.hs b/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic/Invariants.hs
index 975caee854..34f233a410 100644
--- a/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic/Invariants.hs
+++ b/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic/Invariants.hs
@@ -99,6 +99,8 @@ tests =
         "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]
@@ -119,6 +121,18 @@ tests =
         -- 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) $
+                Leios.markBodyImminent h (SlotNo 5) $
+                  (emptyLeiosOutstanding (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) 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 "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
@@ -276,8 +290,20 @@ applyCmd conn txCache kv peerVars peerId = \case
   Forge ids slot -> do
     let eb = ebOf ids
         point = pointOf ids slot
-    -- The outstanding-state half of 'onForgedLeiosEb'; the announcement it also
-    -- makes doesn't touch 'outstanding' for a 'ForgedLocally' source.
+    -- 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 (ForgedBlock point) eb
     processLeiosBlockTxs nullTracer nullTracer kv txCache conn (ForgedTxs point eb) (V.fromList (map leiosTxOf ids))
     pure []
@@ -373,6 +399,18 @@ reproForgeAfterOffer =
   , 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
 ------------------------------------------------------------

From c162ce6365bee360c831000ee237c30719017874 Mon Sep 17 00:00:00 2001
From: Nicolas Frisby <nicolas.frisby@moduscreate.com>
Date: Mon, 24 Aug 2026 18:56:57 -0400
Subject: [PATCH 32/49] LeiosFetch: fetch aggressively from BigLedgerPeers

---
 .../Ouroboros/Consensus/Network/NodeToNode.hs | 13 +++--
 .../Ouroboros/Consensus/NodeKernel.hs         |  2 +
 .../src/ouroboros-consensus/LeiosDemoLogic.hs | 50 ++++++++++++-----
 .../src/ouroboros-consensus/LeiosDemoTypes.hs | 23 ++++++--
 .../consensus-test/Test/LeiosDemoLogic.hs     |  4 +-
 .../Test/LeiosDemoLogic/Invariants.hs         | 55 ++++++++++++++++++-
 6 files changed, 119 insertions(+), 28 deletions(-)

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 a4f48536b1..edef2bd675 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
@@ -1104,7 +1104,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)
@@ -1373,9 +1373,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
@@ -1383,7 +1384,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
@@ -1410,10 +1411,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)
@@ -1454,10 +1456,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/NodeKernel.hs b/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/NodeKernel.hs
index 953c7e12cb..4c0cff7515 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
@@ -506,11 +506,13 @@ initNodeKernel
             let mbCurrentSlot = case currentSlot of
                   CurrentSlot s -> Just s
                   CurrentSlotUnknown -> Nothing
+            let bigLedgerPeers = Map.map Leios.whetherBigLedgerPeer stillLivePeers
             let (!outstanding', requests, offerDrops) =
                   Leios.leiosFetchLogicIteration
                     Leios.demoLeiosFetchStaticEnv
                     mbCurrentSlot
                     (Map.restrictKeys offerings (Map.keysSet stillLivePeers))
+                    bigLedgerPeers
                     outstanding
             pure (outstanding', (requests, offerDrops))
           -- Drop dead offers: exactly the EBs the decision pass found we already
diff --git a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
index d8d38c919d..73749f35cc 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
@@ -136,6 +136,9 @@ import Ouroboros.Consensus.Storage.LedgerDB.Forker
   , ResolveLeiosBlock (..)
   )
 import Ouroboros.Consensus.Util.IOLike (IOLike)
+import Ouroboros.Network.PeerSelection.LedgerPeers.Type
+  ( IsBigLedgerPeer (..)
+  )
 
 -- | Wrap an action with exception tracing. Catches the exception,
 -- traces it using the provided handler, and re-throws.
@@ -319,8 +322,9 @@ popLeftmostOffset = \case
 
 -- | Decide what to request from each peer right now
 --
--- TODO even more aggressive requests for BigLedgerPeers (cf
--- @eicIsBigLedgerPeer@)
+-- 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.
 --
 -- TODO also pull txs from the Mempool
 leiosFetchLogicIteration ::
@@ -331,13 +335,16 @@ leiosFetchLogicIteration ::
   -- syncing), in which case we fetch freshest-last instead of freshest-first.
   Maybe SlotNo ->
   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 ->
   -- | 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 = \acc0 ->
+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.
@@ -345,7 +352,8 @@ leiosFetchLogicIteration env mbCurrentSlot offerings = \acc0 ->
   -- those into the per-peer maps here.
   Map.foldlWithKey'
     ( \(acc, reqs, drops) peerId offers ->
-        let (acc', peerReqs, peerDrops) = assignPeer env mbCurrentSlot peerId offers acc
+        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
@@ -362,14 +370,23 @@ leiosFetchLogicIteration env mbCurrentSlot offerings = \acc0 ->
 -- 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.
-peerBudget :: Ord pid => LeiosFetchStaticEnv -> LeiosOutstanding pid -> PeerId pid -> Int
-peerBudget env acc peerId =
-  fromIntegral (Leios.maxRequestedBytesSizePerPeer env)
+--
+-- 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
+  cap = case isBig of
+    IsBigLedgerPeer -> Leios.maxRequestedBytesSizePerBigLedgerPeer env
+    IsNotBigLedgerPeer -> Leios.maxRequestedBytesSizePerPeer env
 
 -- | Walk this peer's offered points freshest-first (freshest-last while
 -- syncing), assigning requests to the peer until it's saturated at
--- 'Leios.maxRequestedBytesSizePerPeer'.
+-- 'Leios.maxRequestedBytesSizePerPeer'. A big-ledger peer saturates at the larger
+-- 'Leios.maxRequestedBytesSizePerBigLedgerPeer', enough that a closure it offers
+-- is requested in full (see 'assignClosure').
 --
 -- Offered points below the saturation point are never visited, so aren't
 -- pruned this pass; that's fine because it's ephemeral and/or the other prune
@@ -378,11 +395,12 @@ assignPeer ::
   Ord pid =>
   LeiosFetchStaticEnv ->
   Maybe SlotNo ->
+  IsBigLedgerPeer ->
   PeerId pid ->
   Map LeiosPoint AlsoOfferedTxsClosure ->
   LeiosOutstanding pid ->
   (LeiosOutstanding pid, Seq LeiosFetchRequest, Set LeiosPoint)
-assignPeer env mbCurrentSlot peerId offers acc =
+assignPeer env mbCurrentSlot isBig peerId offers acc =
   go (acc, Seq.empty, Set.empty) prioritized
  where
   prioritized = case mbCurrentSlot of
@@ -392,7 +410,7 @@ assignPeer env mbCurrentSlot peerId offers acc =
   go st@(acc', _dec, _drops) = \case
     [] -> st
     (point, offerKind) : rest
-      | peerBudget env acc' peerId <= 0 -> st
+      | peerBudget env isBig acc' peerId <= 0 -> st
       | otherwise -> go (classify point offerKind st) rest
 
   classify point offerKind (acc1, dec1, drops) =
@@ -431,7 +449,7 @@ assignPeer env mbCurrentSlot peerId offers acc =
               -- just now assign all remaining jobs to the peer, prune its
               -- offer.
               let ((acc2, dec2), MkWhetherPeerEbExhausted exhausted) =
-                    assignClosure env peerId ebHash (acc1, dec1)
+                    assignClosure env isBig peerId ebHash (acc1, dec1)
                in (acc2, dec2, if not exhausted then drops else Set.insert point drops)
    where
     ebHash = point.pointEbHash
@@ -473,11 +491,12 @@ newtype WhetherPeerEbExhausted = MkWhetherPeerEbExhausted Bool
 assignClosure ::
   Ord pid =>
   LeiosFetchStaticEnv ->
+  IsBigLedgerPeer ->
   PeerId pid ->
   EbHash ->
   (LeiosOutstanding pid, Seq LeiosFetchRequest) ->
   ((LeiosOutstanding pid, Seq LeiosFetchRequest), WhetherPeerEbExhausted)
-assignClosure env peerId ebHash st@(acc, dec) =
+assignClosure env isBig peerId ebHash st@(acc, dec) =
   case Map.lookup ebHash (Leios.ebState acc) of
     Nothing -> (st, MkWhetherPeerEbExhausted False)
     Just (Leios.MkEbState _slot Leios.NoBody) -> (st, MkWhetherPeerEbExhausted False)
@@ -486,8 +505,11 @@ assignClosure env peerId ebHash st@(acc, dec) =
       let inflightJobs =
             maybe IntSet.empty NEIntSet.toSet $
               Map.lookup ebHash =<< Map.lookup peerId (Leios.requestedJobsPerPeer acc)
-          -- there are no more than 184 jobs per EB, so picked can't be a /long/ list
-          (picked, jobPool', exhausted) = pickJobs inflightJobs jobPool (peerBudget env acc peerId)
+          -- 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.
+          (picked, jobPool', exhausted) = pickJobs inflightJobs jobPool (peerBudget env isBig acc peerId)
        in flip (,) exhausted $ case nonEmpty picked of
             Nothing -> st
             Just nePicked ->
diff --git a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs
index 01ed4826c7..6fdd9be800 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs
@@ -119,6 +119,9 @@ 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 Text.Pretty.Simple (pShow)
 
 -- * Hashes and identities
@@ -369,7 +372,10 @@ mergeOffer _ TxsClosureAlsoOffered = TxsClosureAlsoOffered
 mergeOffer _ _ = TxsClosureNotAlsoOffered
 
 data LeiosPeerVars m = MkLeiosPeerVars
-  { offerings :: !(MVar m (Map LeiosPoint AlsoOfferedTxsClosure))
+  { 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
@@ -391,11 +397,11 @@ data LeiosPeerVars m = MkLeiosPeerVars
   -- the Diffusion Layer's control message to be actionable.
   }
 
-newLeiosPeerVars :: IOLike m => m (LeiosPeerVars m)
-newLeiosPeerVars = do
+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.
 --
@@ -681,7 +687,13 @@ prettyLeiosOutstanding x =
 -- request?
 data LeiosFetchStaticEnv = MkLeiosFetchStaticEnv
   { maxRequestedBytesSizePerPeer :: BytesSize
-  -- ^ At most this many outstanding bytes requested from each peer
+  -- ^ At most this many outstanding bytes requested from each non-big-ledger
+  -- peer
+  , maxRequestedBytesSizePerBigLedgerPeer :: BytesSize
+  -- ^ At most this many outstanding bytes requested from each big-ledger peer.
+  -- Larger than and overrides 'maxRequestedBytesSizePerPeer' so a high-stake
+  -- peer can be asked for multiple whole EB closures at once, but still bounded
+  -- so an adversarial peer can't drown us.
   , maxRequestBytesSize :: BytesSize
   -- ^ At most this many outstanding bytes per request
   , maxRequestsPerEb :: Int
@@ -702,6 +714,7 @@ demoLeiosFetchStaticEnv :: LeiosFetchStaticEnv
 demoLeiosFetchStaticEnv =
   MkLeiosFetchStaticEnv
     { maxRequestedBytesSizePerPeer = 5 * million
+    , maxRequestedBytesSizePerBigLedgerPeer = 5 * 12 * million
     , maxRequestBytesSize = 500 * thousand
     , maxRequestsPerEb = 1
     , maxRequestsPerTx = 1
diff --git a/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic.hs b/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic.hs
index 2904e46f6b..b95d067e01 100644
--- a/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic.hs
+++ b/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic.hs
@@ -248,7 +248,9 @@ runIteration sc =
   -- A known current slot selects freshest-first (i.e. youngest-first), which is
   -- the ordering these scenarios were written against.
   let (_out, reqs, _drops) =
-        leiosFetchLogicIteration sc.scEnv (Just minBound) sc.scOfferings sc.scOutstanding
+        -- 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
 
 ------------------------------------------------------------
diff --git a/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic/Invariants.hs b/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic/Invariants.hs
index 34f233a410..2b13112717 100644
--- a/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic/Invariants.hs
+++ b/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic/Invariants.hs
@@ -42,6 +42,7 @@ 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 qualified Data.Set as Set
@@ -83,6 +84,9 @@ import qualified LeiosDemoTypes as Leios
 import qualified LeiosDemoTypes.LeiosJobs as Jobs
 import LeiosTxCache (LeiosTxCache, newPureLeiosTxCache, nullLeiosTxCache)
 import Ouroboros.Consensus.Util.IOLike (IOLike, evaluate)
+import Ouroboros.Network.PeerSelection.LedgerPeers.Type
+  ( IsBigLedgerPeer (..)
+  )
 import Test.QuickCheck
 import Test.Tasty (TestTree, testGroup)
 import Test.Tasty.HUnit (testCase, (@?=))
@@ -133,6 +137,39 @@ tests =
         -- 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 "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) $
+                          (emptyLeiosOutstanding (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 "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
@@ -244,7 +281,7 @@ runCmdsReFetchViolations cmds = runSimOrThrow (go cmds)
     withLeiosDb dbHandle $ \conn -> do
       outstandingVar <- newMVar (emptyLeiosOutstanding (SlotNo 0))
       readyVar <- newEmptyMVar
-      peerVars <- newLeiosPeerVars
+      peerVars <- newLeiosPeerVars IsNotBigLedgerPeer
       let kv = (outstandingVar, readyVar)
           txCache = nullLeiosTxCache
           peerId = MkPeerId (0 :: Int)
@@ -310,8 +347,10 @@ applyCmd conn txCache kv peerVars peerId = \case
   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 outstanding
+          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.
@@ -358,6 +397,16 @@ ebBodyRequestHashes 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
 ------------------------------------------------------------
@@ -555,7 +604,7 @@ raceSameHashMultiSlot = do
   withLeiosDb dbHandle $ \conn -> do
     outstandingVar <- newMVar (emptyLeiosOutstanding (SlotNo 0))
     readyVar <- newEmptyMVar
-    peerVars <- newLeiosPeerVars
+    peerVars <- newLeiosPeerVars IsNotBigLedgerPeer
     txCache <- newPureLeiosTxCache
     let kv = (outstandingVar, readyVar)
         peerId = MkPeerId (0 :: Int)

From 10d03aa62f081ac175008487cc1fc588eac412f9 Mon Sep 17 00:00:00 2001
From: Nicolas Frisby <nicolas.frisby@moduscreate.com>
Date: Mon, 24 Aug 2026 19:02:05 -0400
Subject: [PATCH 33/49] LeiosFetch: remove now-dead maxRequestsPerEb and
 maxRequestsPerTx

---
 .../src/ouroboros-consensus/LeiosDemoTypes.hs        |  6 ------
 .../consensus-test/Test/LeiosDemoLogic/Invariants.hs | 12 ++++++------
 2 files changed, 6 insertions(+), 12 deletions(-)

diff --git a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs
index 6fdd9be800..ab67535ac1 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs
@@ -696,10 +696,6 @@ data LeiosFetchStaticEnv = MkLeiosFetchStaticEnv
   -- so an adversarial peer can't drown us.
   , 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
@@ -716,8 +712,6 @@ demoLeiosFetchStaticEnv =
     { maxRequestedBytesSizePerPeer = 5 * million
     , maxRequestedBytesSizePerBigLedgerPeer = 5 * 12 * million
     , maxRequestBytesSize = 500 * thousand
-    , maxRequestsPerEb = 1
-    , maxRequestsPerTx = 1
     , maxJobBytesSize = 64 * thousandBase2
     , maxJobTxCount = 20000   -- TODO do we want this to be low enough to matter?
     , maxLeiosNotifyIngressQueue = 1 * millionBase2
diff --git a/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic/Invariants.hs b/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic/Invariants.hs
index 2b13112717..158ebd34d5 100644
--- a/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic/Invariants.hs
+++ b/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic/Invariants.hs
@@ -22,9 +22,9 @@
 -- 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 keeps it correct if
--- 'maxRequestsPerEb' rises above 1: requesting a not-yet-held body from several
--- peers is fine; re-requesting a held one is not.
+-- 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))
@@ -534,9 +534,9 @@ prop_invariants =
 -- 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, so it stays correct if
--- 'maxRequestsPerEb' rises above 1: requesting a not-yet-held body from several
--- peers is fine; re-requesting a held one is not. (With 'nullLeiosTxCache', the
+-- 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

From 74c118e103144ea7c585e9b5069d38ec97b16b53 Mon Sep 17 00:00:00 2001
From: Nicolas Frisby <nicolas.frisby@moduscreate.com>
Date: Tue, 25 Aug 2026 09:18:29 -0400
Subject: [PATCH 34/49] LeiosFetch: check Mempool between checking LeiosTxCache
 and issuing LeiosJobs

---
 .../Ouroboros/Consensus/Network/NodeToNode.hs |   6 +
 .../src/ouroboros-consensus/LeiosDemoLogic.hs | 113 ++++++++++++++----
 .../Ouroboros/Consensus/Mempool/API.hs        |   6 +
 .../Consensus/Mempool/Impl/Common.hs          |  29 ++++-
 .../Ouroboros/Consensus/Mempool/Init.hs       |   6 +
 .../Ouroboros/Consensus/Mempool/Update.hs     |   5 +
 .../Consensus/Storage/LedgerDB/Forker.hs      |  15 +++
 .../Test/Consensus/Mempool/Mocked.hs          |   2 +
 .../Test/Consensus/Mempool/StateMachine.hs    |   1 +
 .../Test/LeiosDemoLogic/Invariants.hs         |   8 +-
 10 files changed, 162 insertions(+), 29 deletions(-)

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 edef2bd675..41bf60c239 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
@@ -152,6 +152,7 @@ import qualified Ouroboros.Consensus.MiniProtocol.ChainSync.Client as CsClient
 import Ouroboros.Consensus.MiniProtocol.ChainSync.Server
 import Ouroboros.Consensus.Node.ExitPolicy
 import Ouroboros.Consensus.Node.NetworkProtocolVersion
+import Ouroboros.Consensus.Mempool.API (getLeiosTxIndex)
 import Ouroboros.Consensus.Node.Run
 import Ouroboros.Consensus.Node.Serialisation
 import qualified Ouroboros.Consensus.Node.Tracers as Node
@@ -159,6 +160,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)
@@ -665,6 +667,10 @@ mkHandlers
                   (getLeiosOutstanding, getLeiosReady)
                   getLeiosTxCache
                   leiosConn
+                  ( Leios.mkMempoolPull
+                      (atomically (getLeiosTxIndex getMempool))
+                      (leiosTxBytesOfGenTx . txForgetValidated)
+                  )
                   (Leios.MkPeerId peer)
                   reqVar
                   responseQ
diff --git a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
index 73749f35cc..61d7657813 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
@@ -19,7 +19,7 @@ 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)
@@ -626,6 +626,10 @@ nextLeiosFetchClientCommand ::
   ) ->
   LeiosTxCache m () () SerializedEbBody ->
   LeiosDbConnection 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.
@@ -638,7 +642,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 pullFromMempool peerId reqsVar responseQ = do
   drainResponses
   StrictSTM.atomically checkOrPeek >>= \case
     Right result -> pure $ Right result
@@ -650,9 +654,9 @@ nextLeiosFetchClientCommand ktracer tracer stopSTM kernelVars txCache db peerId
     pending <- StrictSTM.atomically $ LazySTM.flushTQueue responseQ
     forM_ pending $ \case
       PendingBlockResponse req eb ->
-        processLeiosBlock ktracer tracer kernelVars txCache db (ReceivedBlockFrom peerId req) eb
+        processLeiosBlock ktracer tracer kernelVars txCache db pullFromMempool (ReceivedBlockFrom peerId req) eb
       PendingBlockTxsResponse req txs ->
-        processLeiosBlockTxs ktracer tracer kernelVars txCache db (ReceivedTxsFrom peerId req) txs
+        processLeiosBlockTxs ktracer tracer kernelVars txCache db (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).
@@ -726,14 +730,18 @@ data LeiosBlockSource pid
   | -- | A locally-forged EB, carrying the point the forge assigned it.
     ForgedBlock !LeiosPoint
 
--- | Like 'LeiosBlockSource', for a batch of EB txs. The tx bytes are the
--- 'V.Vector LeiosTx' argument; 'ForgedTxs' additionally carries the forged EB's
--- point and body so the tx hashes come from the body's 'leiosEbTxs' (aligned by
--- position with the 'V.Vector LeiosTx') rather than being re-derived. Some of the
--- carried fields are currently unused.
+-- | Like 'LeiosBlockSource', for a batch of EB txs. Each constructor carries its
+-- own tx bytes.
 data LeiosBlockTxsSource pid
-  = ReceivedTxsFrom (PeerId pid) LeiosBlockTxsRequest
-  | ForgedTxs !LeiosPoint !LeiosEb
+  = 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)
 
 processLeiosBlock ::
   ( Ord pid
@@ -746,10 +754,17 @@ processLeiosBlock ::
   ) ->
   LeiosTxCache m () () SerializedEbBody ->
   LeiosDbConnection 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 ()
-processLeiosBlock ktracer tracer (outstandingVar, readyVar) txCache db source eb = do
+processLeiosBlock ktracer tracer (outstandingVar, readyVar) txCache db pullFromMempool source eb = do
   -- validate it
   let (mbPeer, point, ebBytesSize) = case source of
         ReceivedBlockFrom peerId (MkLeiosBlockRequest p sz) -> (Just peerId, p, sz)
@@ -788,7 +803,7 @@ processLeiosBlock ktracer tracer (outstandingVar, readyVar) txCache db source eb
       when (not (null duplicateTxHashes)) $ do
         invalidReply $ "MsgLeiosBlock duplicate tx hashes: " <> show duplicateTxHashes
   -- ingest it
-  bodyClass <- MVar.modifyMVar outstandingVar $ \outstanding -> do
+  (bodyClass, mempoolHits) <- 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,
@@ -823,7 +838,9 @@ processLeiosBlock ktracer tracer (outstandingVar, readyVar) txCache db source eb
       then
         pure
           ( outstandingCleaned
-          , (if tooOld then fetchArrivalEvicted else fetchArrivalExtra) $ ebBytesSize'
+          , ( (if tooOld then fetchArrivalEvicted else fetchArrivalExtra) $ ebBytesSize'
+            , Map.empty
+            )
           )
       else do
         -- TODO don't hold the outstanding mvar during this IO
@@ -871,24 +888,70 @@ processLeiosBlock ktracer tracer (outstandingVar, readyVar) txCache db source eb
                   IntMap.empty
                   v
               pure (fetchArrivalEvicted ebBytesSize', ms)
+        -- Before allocating jobs, pull out the misses we already hold in our local
+        -- mempool: they never become fetch jobs; instead we ingest them ourselves
+        -- below (the last thing this function does).
+        (stillMissing, mempoolHits) <- pullFromMempool misses
         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); 'misses' is offset -> (tx hash,
+              -- validated without the body); 'stillMissing' 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)
-                misses
+                stillMissing
             !outstanding' = Leios.insertAcquiredEbBody ebHash jobPool outstandingCleaned
-        pure (outstanding', bodyClass)
+        pure (outstanding', (bodyClass, mempoolHits))
   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 into the DB and cache (they
+  -- were removed from the fetch job set above). This function already pays disk
+  -- latency, so doing it synchronously here is fine.
+  unless (Map.null mempoolHits) $
+    processLeiosBlockTxs
+      ktracer
+      tracer
+      (outstandingVar, readyVar)
+      txCache
+      db
+      (MempoolTxs point mempoolHits)
+
+-- | 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)
 
 -----
 
@@ -1083,10 +1146,9 @@ processLeiosBlockTxs ::
   LeiosTxCache m () () SerializedEbBody ->
   LeiosDbConnection m ->
   LeiosBlockTxsSource pid ->
-  V.Vector LeiosTx ->
   m ()
-processLeiosBlockTxs ktracer tracer (outstandingVar, readyVar) txCache db source txs = case source of
-  ForgedTxs _point eb -> do
+processLeiosBlockTxs ktracer tracer (outstandingVar, readyVar) txCache db source = case source of
+  ForgedTxs _point eb txs -> do
     -- Ingest the whole closure (TODO even though we might already have some of
     -- it).
     --
@@ -1096,7 +1158,12 @@ processLeiosBlockTxs ktracer tracer (outstandingVar, readyVar) txCache db source
           Applied
       $ V.toList (V.map fst (leiosEbTxs eb)) `zip` V.toList (V.map cbor txs)
     void $ MVar.tryPutMVar readyVar ()
-  ReceivedTxsFrom peerId req@(MkLeiosBlockTxsRequest point jobs) -> do
+  MempoolTxs _point hits -> do
+    -- 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 Applied (Map.toList hits)
+    void $ MVar.tryPutMVar readyVar ()
+  ReceivedTxsFrom peerId req@(MkLeiosBlockTxsRequest point jobs) txs -> do
     traceWith tracer $ MkTraceLeiosPeer $ "[start] " ++ Leios.prettyLeiosBlockTxsRequest req
     let txBytess = V.map cbor txs
         batchBytes = V.sum (V.map BS.length txBytess)
@@ -1621,6 +1688,7 @@ onForgedLeiosEb kernelTracer centralVar kv txCache db anc forgedEb = do
     kv
     txCache
     db
+    noMempoolPull -- the forge holds the whole closure
     (ForgedBlock forgedEb.point)
     forgedEb.body
   processLeiosBlockTxs
@@ -1629,7 +1697,6 @@ onForgedLeiosEb kernelTracer centralVar kv txCache db anc forgedEb = do
     kv
     txCache
     db
-    (ForgedTxs forgedEb.point forgedEb.body)
-    (V.fromList (map (MkLeiosTx . snd) forgedEb.txClosure))
+    (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/Ouroboros/Consensus/Mempool/API.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Mempool/API.hs
index d13c077e8f..29812ca7e1 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Mempool/API.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Mempool/API.hs
@@ -50,6 +50,7 @@ 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)
@@ -60,6 +61,7 @@ import Ouroboros.Consensus.Ledger.SupportsMempool
 import qualified Ouroboros.Consensus.Mempool.Capacity as Cap
 import Ouroboros.Consensus.Mempool.TxSeq (TicketNo, zeroTicketNo)
 import Ouroboros.Consensus.Util.IOLike
+import LeiosDemoTypes.LeiosJobs (TxHash)
 import Ouroboros.Network.Protocol.TxSubmission2.Type (SizeInBytes)
 
 {-------------------------------------------------------------------------------
@@ -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..46d4613b2f 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,15 @@ 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.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
@@ -121,6 +124,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 +223,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 +373,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 ->
@@ -394,6 +405,7 @@ validateNewTransaction cfg wti tx txsz origValues st is =
             , isTxKeys = isTxKeys <> getTransactionKeySets tx
             , isTxValues = ltliftA2 unionValues isTxValues origValues
             , isTxIds = Set.insert (txId tx) isTxIds
+            , isLeiosTxIndex = maybe id (\h -> Map.insert h vtx) (leiosTxHashOfGenTx tx) isLeiosTxIndex
             , isLedgerState = prependMempoolDiffs isLedgerState st'
             , isLastTicketNo = nextTicketNo
             }
@@ -402,6 +414,7 @@ validateNewTransaction cfg wti tx txsz origValues st is =
   IS
     { isTxs
     , isTxIds
+    , isLeiosTxIndex
     , isTxKeys
     , isTxValues
     , isLedgerState
@@ -420,7 +433,7 @@ validateNewTransaction cfg wti tx txsz origValues st is =
 -- some transactions and revalidate the remaining ones.
 revalidateTxsFor ::
   forall m blk.
-  (Monad m, LedgerSupportsMempool blk, HasTxId (GenTx blk)) =>
+  (Monad m, LedgerSupportsMempool blk, HasTxId (GenTx blk), ResolveLeiosBlock blk) =>
   -- | The forker to read the transactions' inputs from.
   ReadOnlyForker m (LedgerState blk) ->
   MempoolCapacityBytesOverride ->
@@ -463,7 +476,7 @@ revalidateTxsFor frk capacityOverride cfg slot st lastTicketNo removalGen txTick
 -- ('implSyncWithLedger').
 revalidateTxsFor' ::
   forall m blk.
-  (Monad m, LedgerSupportsMempool blk, HasTxId (GenTx blk)) =>
+  (Monad m, LedgerSupportsMempool blk, HasTxId (GenTx blk), ResolveLeiosBlock blk) =>
   -- | The forker to read the delta txs' inputs from.
   ReadOnlyForker m (LedgerState blk) ->
   MempoolCapacityBytesOverride ->
@@ -501,6 +514,13 @@ 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 =
+            isLeiosTxIndex cand
+              <> Map.fromList
+                [ (h, vtx)
+                | vtx <- map fst3 validDelta
+                , Just h <- [leiosTxHashOfGenTx (txForgetValidated vtx)]
+                ]
         , isTxKeys = isTxKeys cand <> survivorKeys
         , -- REVIEW(utxo-hd): incremental value cache. Equal to the from-scratch
           -- @restrictValuesMK (isTxValues cand `union` deltaValues) (allKeys)@:
@@ -561,6 +581,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.
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..b151ac0792 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 ->
@@ -57,6 +59,7 @@ forkSyncStateOnTipPointChange ::
   , LedgerSupportsMempool blk
   , HasTxId (GenTx blk)
   , ValidateEnvelope blk
+  , ResolveLeiosBlock blk
   ) =>
   MempoolEnv m blk ->
   ResourceRegistry m ->
@@ -91,6 +94,7 @@ openMempoolWithoutSyncThread ::
   , LedgerSupportsMempool blk
   , HasTxId (GenTx blk)
   , ValidateEnvelope blk
+  , ResolveLeiosBlock blk
   ) =>
   LedgerInterface m blk ->
   LedgerConfig blk ->
@@ -107,6 +111,7 @@ mkMempool ::
   , LedgerSupportsMempool blk
   , HasTxId (GenTx blk)
   , ValidateEnvelope blk
+  , ResolveLeiosBlock blk
   ) =>
   MempoolEnv m blk -> Mempool m blk
 mkMempool mpEnv =
@@ -117,6 +122,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..4b2d3d2fd5 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.
@@ -437,6 +440,7 @@ implRemoveTxsEvenIfValid ::
   ( IOLike m
   , LedgerSupportsMempool blk
   , HasTxId (GenTx blk)
+  , ResolveLeiosBlock blk
   ) =>
   MempoolEnv m blk ->
   NE.NonEmpty (GenTxId blk) ->
@@ -508,6 +512,7 @@ implSyncWithLedger ::
   , LedgerSupportsMempool blk
   , ValidateEnvelope blk
   , HasTxId (GenTx blk)
+  , ResolveLeiosBlock blk
   ) =>
   -- | This argument is only to be able to acquire a snapshot in the same
   -- atomically block as the re-sync when testing the mempool in the QSM
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..b3b87c58a6 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
@@ -81,6 +81,7 @@ import Data.Word
 import GHC.Generics
 import LeiosDemoDb (LeiosDbConnection)
 import LeiosDemoLogic.Announcements.ElBimap (ElId)
+import qualified Data.ByteString as Strict
 import LeiosDemoTypes
   ( BytesSize
   , EbHash
@@ -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..7b7948c1e3 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
@@ -29,6 +29,7 @@ import Control.Tracer (Tracer)
 import qualified Data.List.NonEmpty as NE
 import Ouroboros.Consensus.HeaderValidation as Header
 import Ouroboros.Consensus.Ledger.Basics
+import Ouroboros.Consensus.Storage.LedgerDB.Forker (ResolveLeiosBlock)
 import qualified Ouroboros.Consensus.Ledger.Basics as Ledger
 import qualified Ouroboros.Consensus.Ledger.SupportsMempool as Ledger
 import Ouroboros.Consensus.Ledger.Tables.Utils
@@ -73,6 +74,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/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/LeiosDemoLogic/Invariants.hs b/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic/Invariants.hs
index 158ebd34d5..5edd01a89f 100644
--- a/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic/Invariants.hs
+++ b/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic/Invariants.hs
@@ -56,6 +56,7 @@ import LeiosDemoLogic
   ( LeiosBlockSource (..)
   , LeiosBlockTxsSource (..)
   , leiosFetchLogicIteration
+  , noMempoolPull
   , processLeiosBlock
   , processLeiosBlockTxs
   , recordAnnouncedEb
@@ -321,7 +322,7 @@ applyCmd conn txCache kv peerVars peerId = \case
   ArriveBody ids slot -> do
     let eb = ebOf ids
         req = MkLeiosBlockRequest (pointOf ids slot) (leiosEbBytesSize eb)
-    processLeiosBlock nullTracer nullTracer kv txCache conn (ReceivedBlockFrom peerId req) eb
+    processLeiosBlock nullTracer nullTracer kv txCache conn noMempoolPull (ReceivedBlockFrom peerId req) eb
     pure []
   ArriveTx v -> absurd v
   Forge ids slot -> do
@@ -341,8 +342,8 @@ applyCmd conn txCache kv peerVars peerId = \case
     -- '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 (ForgedBlock point) eb
-    processLeiosBlockTxs nullTracer nullTracer kv txCache conn (ForgedTxs point eb) (V.fromList (map leiosTxOf ids))
+    processLeiosBlock nullTracer nullTracer kv txCache conn noMempoolPull (ForgedBlock point) eb
+    processLeiosBlockTxs nullTracer nullTracer kv txCache conn (ForgedTxs point eb $ V.fromList $ map leiosTxOf ids)
     pure []
   Decide slot -> do
     outstanding <- readMVar (fst kv)
@@ -625,6 +626,7 @@ raceSameHashMultiSlot = do
               kv
               txCache
               conn
+              noMempoolPull
               (ReceivedBlockFrom peerId (MkLeiosBlockRequest arrivalPoint ebBytesSize))
               eb
           )

From a387852ae0f74d0d1b91f5114f97ec7186292ec9 Mon Sep 17 00:00:00 2001
From: Nicolas Frisby <nicolas.frisby@moduscreate.com>
Date: Tue, 25 Aug 2026 09:42:02 -0400
Subject: [PATCH 35/49] Mempool: avoid recalculating the Leios TxHashes

---
 .../Consensus/Mempool/Impl/Common.hs          | 29 ++++++++++++-------
 .../Ouroboros/Consensus/Mempool/Init.hs       |  1 -
 .../Ouroboros/Consensus/Mempool/Update.hs     |  2 --
 .../Test/Consensus/Mempool/Mocked.hs          |  1 -
 4 files changed, 19 insertions(+), 14 deletions(-)

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 46d4613b2f..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
@@ -56,6 +56,7 @@ 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
@@ -95,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
 
@@ -399,13 +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 = maybe id (\h -> Map.insert h vtx) (leiosTxHashOfGenTx tx) isLeiosTxIndex
+            , isLeiosTxIndex = strictMaybe id (\h -> Map.insert h vtx) leiosHash isLeiosTxIndex
             , isLedgerState = prependMempoolDiffs isLedgerState st'
             , isLastTicketNo = nextTicketNo
             }
@@ -424,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'.
 --
@@ -433,7 +441,7 @@ validateNewTransaction cfg wti tx txsz origValues st is =
 -- some transactions and revalidate the remaining ones.
 revalidateTxsFor ::
   forall m blk.
-  (Monad m, LedgerSupportsMempool blk, HasTxId (GenTx blk), ResolveLeiosBlock blk) =>
+  (Monad m, LedgerSupportsMempool blk, HasTxId (GenTx blk)) =>
   -- | The forker to read the transactions' inputs from.
   ReadOnlyForker m (LedgerState blk) ->
   MempoolCapacityBytesOverride ->
@@ -476,7 +484,7 @@ revalidateTxsFor frk capacityOverride cfg slot st lastTicketNo removalGen txTick
 -- ('implSyncWithLedger').
 revalidateTxsFor' ::
   forall m blk.
-  (Monad m, LedgerSupportsMempool blk, HasTxId (GenTx blk), ResolveLeiosBlock blk) =>
+  (Monad m, LedgerSupportsMempool blk, HasTxId (GenTx blk)) =>
   -- | The forker to read the delta txs' inputs from.
   ReadOnlyForker m (LedgerState blk) ->
   MempoolCapacityBytesOverride ->
@@ -515,11 +523,12 @@ revalidateTxsFor' frk capacityOverride cfg slot (RevalidateTxsResult cand remove
         { 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 <- map fst3 validDelta
-                , Just h <- [leiosTxHashOfGenTx (txForgetValidated vtx)]
+                | (vtx, _df, (_tk, _tz, SJust h)) <- validDelta
                 ]
         , isTxKeys = isTxKeys cand <> survivorKeys
         , -- REVIEW(utxo-hd): incremental value cache. Equal to the from-scratch
@@ -542,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
 
@@ -601,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 b151ac0792..96e33f590d 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Mempool/Init.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Mempool/Init.hs
@@ -59,7 +59,6 @@ forkSyncStateOnTipPointChange ::
   , LedgerSupportsMempool blk
   , HasTxId (GenTx blk)
   , ValidateEnvelope blk
-  , ResolveLeiosBlock blk
   ) =>
   MempoolEnv m blk ->
   ResourceRegistry m ->
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 4b2d3d2fd5..e57ce88c8d 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Mempool/Update.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Mempool/Update.hs
@@ -440,7 +440,6 @@ implRemoveTxsEvenIfValid ::
   ( IOLike m
   , LedgerSupportsMempool blk
   , HasTxId (GenTx blk)
-  , ResolveLeiosBlock blk
   ) =>
   MempoolEnv m blk ->
   NE.NonEmpty (GenTxId blk) ->
@@ -512,7 +511,6 @@ implSyncWithLedger ::
   , LedgerSupportsMempool blk
   , ValidateEnvelope blk
   , HasTxId (GenTx blk)
-  , ResolveLeiosBlock blk
   ) =>
   -- | This argument is only to be able to acquire a snapshot in the same
   -- atomically block as the re-sync when testing the mempool in the QSM
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 7b7948c1e3..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
@@ -29,7 +29,6 @@ import Control.Tracer (Tracer)
 import qualified Data.List.NonEmpty as NE
 import Ouroboros.Consensus.HeaderValidation as Header
 import Ouroboros.Consensus.Ledger.Basics
-import Ouroboros.Consensus.Storage.LedgerDB.Forker (ResolveLeiosBlock)
 import qualified Ouroboros.Consensus.Ledger.Basics as Ledger
 import qualified Ouroboros.Consensus.Ledger.SupportsMempool as Ledger
 import Ouroboros.Consensus.Ledger.Tables.Utils

From bd309f76fdf426d8fea3d5bb88cda3d433323390 Mon Sep 17 00:00:00 2001
From: Nicolas Frisby <nicolas.frisby@moduscreate.com>
Date: Tue, 25 Aug 2026 10:13:55 -0400
Subject: [PATCH 36/49] LeiosFetch: two-tiered EB prioritization

It's grossly FreshestFirst, but the truly fresh EBs --- those younger than L
slots --- are prioritized StalestFirst.

So it's FreshestFirst except StalestFirst among the VeryFreshest.

Another way to specifiy it is that we have two tiers. The high-priority tier
contains the EBs younger than L, and, within that tier, the _stale_ EBs are
prioritized. The low-priority tier contains the EBs older than L, and, within
the tier, the _fresh_ EBs are prioritized.

So the the priority of the high tier over the low tier respects
FreshestFirst. And the priority within the low tier respects FreshestFirst. But
the priority within the high tier is instead StalestFirst.
---
 .../src/ouroboros-consensus/LeiosDemoLogic.hs | 48 +++++++++++++++----
 .../src/ouroboros-consensus/LeiosDemoTypes.hs | 10 ++++
 .../consensus-test/Test/LeiosDemoLogic.hs     | 23 +++++++--
 3 files changed, 69 insertions(+), 12 deletions(-)

diff --git a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
index 61d7657813..f86adb1fbb 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
@@ -382,11 +382,41 @@ peerBudget env isBig acc peerId =
     IsBigLedgerPeer -> Leios.maxRequestedBytesSizePerBigLedgerPeer env
     IsNotBigLedgerPeer -> Leios.maxRequestedBytesSizePerPeer env
 
--- | Walk this peer's offered points freshest-first (freshest-last while
--- syncing), assigning requests to the peer until it's saturated at
--- 'Leios.maxRequestedBytesSizePerPeer'. A big-ledger peer saturates at the larger
--- 'Leios.maxRequestedBytesSizePerBigLedgerPeer', enough that a closure it offers
--- is requested in full (see 'assignClosure').
+-- | 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 at the
+-- larger 'Leios.maxRequestedBytesSizePerBigLedgerPeer', enough that a closure
+-- it offers is requested in full (see 'assignClosure').
 --
 -- Offered points below the saturation point are never visited, so aren't
 -- pruned this pass; that's fine because it's ephemeral and/or the other prune
@@ -401,11 +431,11 @@ assignPeer ::
   LeiosOutstanding pid ->
   (LeiosOutstanding pid, Seq LeiosFetchRequest, Set LeiosPoint)
 assignPeer env mbCurrentSlot isBig peerId offers acc =
-  go (acc, Seq.empty, Set.empty) prioritized
+  -- Walk the high-priority tier, then the low, threading the accumulator; a
+  -- second walk short-circuits at once if the first exhausted the byte budget.
+  go (go (acc, Seq.empty, Set.empty) highTier) lowTier
  where
-  prioritized = case mbCurrentSlot of
-    Nothing -> Map.toAscList offers -- syncing: freshest-last
-    Just _currentSlot -> Map.toDescList offers -- freshest-first
+  (highTier, lowTier) = fetchPriorityTiers mbCurrentSlot (Leios.fetchPriorityWindowSlots env) offers
 
   go st@(acc', _dec, _drops) = \case
     [] -> st
diff --git a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs
index ab67535ac1..0418c98d66 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs
@@ -700,6 +700,15 @@ data LeiosFetchStaticEnv = MkLeiosFetchStaticEnv
   -- ^ 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
@@ -714,6 +723,7 @@ demoLeiosFetchStaticEnv =
     , maxRequestBytesSize = 500 * thousand
     , 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
     }
diff --git a/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic.hs b/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic.hs
index b95d067e01..ef7995344d 100644
--- a/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic.hs
+++ b/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic.hs
@@ -27,7 +27,7 @@ import qualified Data.Map.Strict as Map
 import Data.Sequence.NonEmpty (NESeq)
 import qualified Data.Set as Set
 import qualified Data.Set.NonEmpty as NESet
-import LeiosDemoLogic (leiosFetchLogicIteration)
+import LeiosDemoLogic (fetchPriorityTiers, leiosFetchLogicIteration)
 import LeiosDemoTypes
   ( AlsoOfferedTxsClosure (..)
   , BytesSize
@@ -69,8 +69,25 @@ tests =
         [ 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
 ------------------------------------------------------------
@@ -245,8 +262,8 @@ onOutstanding f sc = sc{scOutstanding = f (scOutstanding sc)}
 -- 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.
+  -- 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").

From 090ff7a7caea3aca1b94305b988257be5fc53406 Mon Sep 17 00:00:00 2001
From: Nicolas Frisby <nicolas.frisby@moduscreate.com>
Date: Tue, 25 Aug 2026 10:28:32 -0400
Subject: [PATCH 37/49] LeiosFetch: improve some comments

---
 .../src/ouroboros-consensus/LeiosDemoLogic.hs | 29 +++++++++++++------
 .../LeiosDemoTypes/LeiosJobs.hs               |  3 ++
 2 files changed, 23 insertions(+), 9 deletions(-)

diff --git a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
index f86adb1fbb..cf49d3160d 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
@@ -326,7 +326,14 @@ popLeftmostOffset = \case
 -- larger per-peer byte budget, enough that a closure it offers is requested in
 -- full (the whole remaining job pool) at once.
 --
--- TODO also pull txs from the Mempool
+-- 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 =>
@@ -414,13 +421,14 @@ fetchPriorityTiers mbCurrentSlot l offers =
 
 -- | 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 at the
--- larger 'Leios.maxRequestedBytesSizePerBigLedgerPeer', enough that a closure
--- it offers is requested in full (see 'assignClosure').
+-- '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').
 --
--- Offered points below 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.
+-- 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 ->
@@ -431,8 +439,9 @@ assignPeer ::
   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; a
-  -- second walk short-circuits at once if the first exhausted the byte budget.
+  -- 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
   (highTier, lowTier) = fetchPriorityTiers mbCurrentSlot (Leios.fetchPriorityWindowSlots env) offers
@@ -513,6 +522,8 @@ assignBody peerId ebHash slot st@(acc, dec)
                   }
            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
diff --git a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes/LeiosJobs.hs b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes/LeiosJobs.hs
index c3d6092764..4530cdcf35 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes/LeiosJobs.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes/LeiosJobs.hs
@@ -186,6 +186,9 @@ pickLeastRequestedJobExcept excluded pool =
   -- non-excluded job id. Returns (bucket multiplicity, job id). '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
   eligible =
     IntMap.foldrWithKey
       ( \m bucket rest ->

From 54d1857de029144da4a58d78af4d3d4955b95752 Mon Sep 17 00:00:00 2001
From: Nicolas Frisby <nicolas.frisby@moduscreate.com>
Date: Tue, 25 Aug 2026 10:57:51 -0400
Subject: [PATCH 38/49] LeiosFetch: remove unsafe degree of freedom in config

Remove maxRequestedBytesSizePerBigLedgerPeer and redefine it in terms of
maxLeiosFetchIngressQueue. They're not independent, and I couldn't see any use
to have the scheduling bound be tighter than the downstream buffer bound.
---
 .../src/ouroboros-consensus/LeiosDemoTypes.hs | 29 ++++++++++++++-----
 1 file changed, 21 insertions(+), 8 deletions(-)

diff --git a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs
index 0418c98d66..84c78f2129 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs
@@ -689,11 +689,6 @@ data LeiosFetchStaticEnv = MkLeiosFetchStaticEnv
   { maxRequestedBytesSizePerPeer :: BytesSize
   -- ^ At most this many outstanding bytes requested from each non-big-ledger
   -- peer
-  , maxRequestedBytesSizePerBigLedgerPeer :: BytesSize
-  -- ^ At most this many outstanding bytes requested from each big-ledger peer.
-  -- Larger than and overrides 'maxRequestedBytesSizePerPeer' so a high-stake
-  -- peer can be asked for multiple whole EB closures at once, but still bounded
-  -- so an adversarial peer can't drown us.
   , maxRequestBytesSize :: BytesSize
   -- ^ At most this many outstanding bytes per request
   , maxJobBytesSize :: BytesSize
@@ -712,20 +707,23 @@ data LeiosFetchStaticEnv = MkLeiosFetchStaticEnv
   , 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
     { maxRequestedBytesSizePerPeer = 5 * million
-    , maxRequestedBytesSizePerBigLedgerPeer = 5 * 12 * million
     , maxRequestBytesSize = 500 * thousand
     , 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
@@ -737,6 +735,21 @@ demoLeiosFetchStaticEnv =
   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
 
 -- | A wrapper around transaction bytes for the simple purpose of serving them.

From d4912da6cd7ba56f6f054c5c8db110c217c4bf2c Mon Sep 17 00:00:00 2001
From: Nicolas Frisby <nicolas.frisby@moduscreate.com>
Date: Tue, 25 Aug 2026 11:52:58 -0400
Subject: [PATCH 39/49] LeiosFetch: performance bugfix, warm-up the initial
 ebState somewhat

Before this commit, the initial LeiosOutstanding state after startup completely
ignored the initial contents of the (on-disk, persisted) LeiosDb. That's _sound_
but it might lead to a lot of unnecessary refetching on startup.

On the other hand, healthy (important) nodes shouldn't be restarting often.

This commit is a compromise with a high power-to-weight ratio: we initialize the
LeiosOutstanding state to not re-fetch/re-process the EBs we already
_completely_ processed.

We could do more, eg reprocess the EB bodies whose _entire_ closure we don't
have. And we could warm-up the LeiosTxCache. But that's all extra complexity
that's not obviously _necessary_ or even worthwhile yet.
---
 .../Ouroboros/Consensus/NodeKernel.hs         |  7 ++-
 .../src/ouroboros-consensus/LeiosDemoTypes.hs | 47 +++++++++++++++++++
 .../Test/LeiosDemoLogic/Invariants.hs         | 41 ++++++++++++++++
 3 files changed, 94 insertions(+), 1 deletion(-)

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 4c0cff7515..cf4cc342b4 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
@@ -737,7 +737,12 @@ initInternalState
     let !immTipSlot = case immTip of
           Origin -> SlotNo 0
           NotOrigin s -> s
-    leiosOutstanding <- MVar.newMVar (Leios.emptyLeiosOutstanding immTipSlot)
+    leiosOutstanding <- do
+      acquiredClosures <-
+        LeiosDb.withLeiosDb leiosDB $ \leiosConn ->
+          LeiosDb.leiosDbScanCompleteEbClosuresNotOlderThanSlot leiosConn immTipSlot
+      MVar.newMVar $
+        Leios.initializeLeiosOutstanding acquiredClosures immTipSlot
     leiosReady <- MVar.newEmptyMVar
     leiosCentralState <- MVar.newMVar Announcements.emptyCentralState
 
diff --git a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs
index 84c78f2129..b95785a859 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs
@@ -567,6 +567,53 @@ recordMaxAnnouncementSlot ebHash slot =
     Just (MkEbState oldSlot fetchState) ->
       if slot <= oldSlot then Nothing else Just $ MkEbState slot fetchState
 
+-- | 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 :: [LeiosPoint] -> SlotNo -> LeiosOutstanding pid
+initializeLeiosOutstanding points immTipSlot =
+  F.foldl' (flip seed1) (emptyLeiosOutstanding immTipSlot) points
+ where
+  seed1 (MkLeiosPoint slot ebHash) =
+    insertAcquiredEbBody ebHash Jobs.emptyLeiosJobPool
+      . recordMaxAnnouncementSlot ebHash slot
+
 -- | 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.
diff --git a/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic/Invariants.hs b/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic/Invariants.hs
index 5edd01a89f..95f52c4105 100644
--- a/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic/Invariants.hs
+++ b/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic/Invariants.hs
@@ -138,6 +138,47 @@ tests =
         -- 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 "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 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) (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) (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 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)

From e595d5685615e80fd5f1c73d997502e09e91d686 Mon Sep 17 00:00:00 2001
From: Nicolas Frisby <nicolas.frisby@moduscreate.com>
Date: Tue, 25 Aug 2026 15:11:02 -0400
Subject: [PATCH 40/49] LeiosFetch: add TraceLeiosFetchDecision, LeiosFetch
 decision iteration stats

The data include wall-clock duration of the iteration, bytes/counts about the
newly decided requests, and bytes/counts about the new LeiosOutstanding state.
---
 .../Ouroboros/Consensus/NodeKernel.hs         |   9 +-
 .../src/ouroboros-consensus/LeiosDemoTypes.hs | 163 ++++++++++++++++++
 2 files changed, 169 insertions(+), 3 deletions(-)

diff --git a/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/NodeKernel.hs b/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/NodeKernel.hs
index cf4cc342b4..1029b62409 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
@@ -484,7 +484,7 @@ initNodeKernel
           leiosPeersVars <- LazySTM.readTVarIO getLeiosPeersVars
           offerings <- mapM (MVar.readMVar . Leios.offerings) leiosPeersVars
           let livePeers = Map.keysSet leiosPeersVars
-          (newRequests, offerDrops) <- 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
@@ -514,7 +514,7 @@ initNodeKernel
                     (Map.restrictKeys offerings (Map.keysSet stillLivePeers))
                     bigLedgerPeers
                     outstanding
-            pure (outstanding', (requests, offerDrops))
+            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
@@ -549,7 +549,10 @@ initNodeKernel
           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
diff --git a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs
index b95785a859..43eb00c416 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs
@@ -525,6 +525,131 @@ ebStateHasBody (MkEbState _slot fetchState) = case fetchState of
   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
+  }
+
+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 =
@@ -1224,6 +1349,9 @@ data TraceLeiosKernel
     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
@@ -1315,6 +1443,41 @@ traceLeiosKernelToObject = \case
       [ "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"

From cac460885f210d87246de9feaaaa513abeb92460 Mon Sep 17 00:00:00 2001
From: Nicolas Frisby <nicolas.frisby@moduscreate.com>
Date: Tue, 25 Aug 2026 15:46:22 -0400
Subject: [PATCH 41/49] LeiosFetch: replace TraceLeiosTxCacheEbBody by
 TraceLeiosBodyHits

Key difference is that it also summarizes the Mempool hits not just the
LeiosTxCache hits.
---
 .../src/ouroboros-consensus/LeiosDemoLogic.hs | 29 ++++++++++++++-----
 .../src/ouroboros-consensus/LeiosDemoTypes.hs | 15 ++++++----
 2 files changed, 31 insertions(+), 13 deletions(-)

diff --git a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
index cf49d3160d..8f550030b3 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
@@ -191,7 +191,13 @@ recordForgedEbAndClosureInTxCache tracer txCache rbh forgedEb = do
   mbSummary <-
       fmap (fmap @Maybe (\(x, ()) -> x))
     $ insertBody txCache point.pointEbHash (Leios.serializeEbBody eb) () (\() _ _ _ -> ())
-  forM_ mbSummary $ traceWith tracer . TraceLeiosTxCacheEbBody point
+  -- 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)
   withLockedInsertAppliedTx txCache $ \w0 step ->
     foldM (\w (txh, _sz) -> step w txh ()) w0 (leiosEbTxs eb)
  where
@@ -901,22 +907,24 @@ processLeiosBlock ktracer tracer (outstandingVar, readyVar) txCache db pullFromM
               (Leios.serializeEbBody eb)
               IntMap.empty
               (\acc i missingTxh sz -> IntMap.insert i (missingTxh, sz) acc)
-          forM_ mbSummaryMisses $ traceWith ktracer . TraceLeiosTxCacheEbBody point . fst
           traceWith ktracer $ TraceLeiosBlockAcquired point
           forM_ completedByBody $ traceWith ktracer . TraceLeiosBlockTxsAcquired
-          pure $ fmap snd mbSummaryMisses
-        (bodyClass, misses) <- case source of
+          -- The 'TraceLeiosBodyHits' trace is deferred to after the mempool pull
+          -- below, so it can report the mempool-hit count alongside this cache
+          -- summary.
+          pure mbSummaryMisses
+        (bodyClass, misses, mbBodySummary) <- 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)
+          ForgedBlock{} -> pure (fetchArrivalGood ebBytesSize', IntMap.empty, Nothing)
           ReceivedBlockFrom{} -> case mbMissesFromBody of
             -- 'BodyNotYetInserted': the announcement was present and we filled it.
-            Just ms -> pure (fetchArrivalGood ebBytesSize', ms)
+            Just (summary, ms) -> pure (fetchArrivalGood ebBytesSize', ms, Just summary)
             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.
+              -- build the misses. No cache summary, so no 'TraceLeiosBodyHits'.
               let MkLeiosEb v = eb
               ms <- withLookupTx txCache $ \look ->
                 V.ifoldM
@@ -928,11 +936,16 @@ processLeiosBlock ktracer tracer (outstandingVar, readyVar) txCache db pullFromM
                   )
                   IntMap.empty
                   v
-              pure (fetchArrivalEvicted ebBytesSize', ms)
+              pure (fetchArrivalEvicted ebBytesSize', ms, Nothing)
         -- Before allocating jobs, pull out the misses we already hold in our local
         -- mempool: they never become fetch jobs; instead we ingest them ourselves
         -- below (the last thing this function does).
         (stillMissing, mempoolHits) <- pullFromMempool misses
+        -- Now that the mempool pull is done, report the body's combined
+        -- cache+mempool hit picture: the cache summary plus how many of the
+        -- cache-miss txs we found in our own mempool.
+        forM_ mbBodySummary $ \summary ->
+          traceWith ktracer $ TraceLeiosBodyHits point summary (Map.size mempoolHits)
         let !jobPool =
               -- TODO should this calculation be deferred until the first offer
               -- arrives?
diff --git a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs
index 43eb00c416..758fd01898 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs
@@ -1280,7 +1280,7 @@ 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
   { ibsTxsInEb :: !Int
@@ -1305,8 +1305,12 @@ data TraceLeiosKernel
     -- 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 body was inserted into the LeiosTxCache
+    --
+    -- Carries the LeiosTxCache summary (cache hits) and how many of the
+    -- /remaining/ txs we then found in our local mempool. Together these give
+    -- the combined cache+mempool hit rate on the body's arrival.
+    TraceLeiosBodyHits LeiosPoint InsertBodySummary Int
   | forall m. (Show m, TxMeasureMetrics m) => TraceLeiosBlockForged
       { slot :: SlotNo
       , eb :: LeiosEb
@@ -1501,15 +1505,16 @@ traceLeiosKernelToObject = \case
       , "ebHash" .= prettyEbHash ebHash
       , "ebSlot" .= ebSlot
       ]
-  TraceLeiosTxCacheEbBody (MkLeiosPoint (SlotNo ebSlot) ebHash) ibs ->
+  TraceLeiosBodyHits (MkLeiosPoint (SlotNo ebSlot) ebHash) ibs mempoolHits ->
     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
       , "cacheTxCount" .= ibsCacheTxCount ibs
       , "cacheLoad" .= ibsCacheLoad ibs
       ]

From 06013c72c26666e6f42f4fd2c8a24cdc8b576dd5 Mon Sep 17 00:00:00 2001
From: Nicolas Frisby <nicolas.frisby@moduscreate.com>
Date: Tue, 25 Aug 2026 16:23:17 -0400
Subject: [PATCH 42/49] LeiosTxCache: rename InsertBodySummary to
 LeiosTxCacheInsertBodySummary

Now that LeiosFetch also pulls from the Mempool, it's important for the name to
be less vague/surprising.
---
 .../src/ouroboros-consensus/LeiosDemoLogic.hs | 69 ++++++++++++-------
 .../src/ouroboros-consensus/LeiosDemoTypes.hs | 16 +++--
 .../ouroboros-consensus/LeiosTxCache/API.hs   | 18 ++---
 .../LeiosTxCache/Optimized.hs                 |  4 +-
 .../LeiosTxCache/Reference.hs                 |  8 +--
 5 files changed, 69 insertions(+), 46 deletions(-)

diff --git a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
index 8f550030b3..ceecea4fbe 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
@@ -197,7 +197,7 @@ recordForgedEbAndClosureInTxCache tracer txCache rbh forgedEb = do
   -- -- 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)
+      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
@@ -850,7 +850,7 @@ processLeiosBlock ktracer tracer (outstandingVar, readyVar) txCache db pullFromM
       when (not (null duplicateTxHashes)) $ do
         invalidReply $ "MsgLeiosBlock duplicate tx hashes: " <> show duplicateTxHashes
   -- ingest it
-  (bodyClass, mempoolHits) <- MVar.modifyMVar outstandingVar $ \outstanding -> do
+  (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,
@@ -886,12 +886,13 @@ processLeiosBlock ktracer tracer (outstandingVar, readyVar) txCache db pullFromM
         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
-        mbMissesFromBody <- traceException tracer TraceLeiosPeerDbException $ do
+        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
@@ -900,7 +901,7 @@ processLeiosBlock ktracer tracer (outstandingVar, readyVar) txCache db pullFromM
           traceWith ktracer $ TraceLeiosBlockPointMissing point
           leiosDbInsertEbPoint db point ebBytesSize
           completedByBody <- leiosDbInsertEbBody db point eb
-          mbSummaryMisses <-
+          mbSummaryTxCacheMisses <-
             insertBody
               txCache
               ebHash
@@ -912,15 +913,15 @@ processLeiosBlock ktracer tracer (outstandingVar, readyVar) txCache db pullFromM
           -- The 'TraceLeiosBodyHits' trace is deferred to after the mempool pull
           -- below, so it can report the mempool-hit count alongside this cache
           -- summary.
-          pure mbSummaryMisses
-        (bodyClass, misses, mbBodySummary) <- case source of
+          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 mbMissesFromBody of
+          ReceivedBlockFrom{} -> case mbTxCacheMissesFromBody of
             -- 'BodyNotYetInserted': the announcement was present and we filled it.
-            Just (summary, ms) -> pure (fetchArrivalGood ebBytesSize', ms, Just summary)
+            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
@@ -937,44 +938,62 @@ processLeiosBlock ktracer tracer (outstandingVar, readyVar) txCache db pullFromM
                   IntMap.empty
                   v
               pure (fetchArrivalEvicted ebBytesSize', ms, Nothing)
-        -- Before allocating jobs, pull out the misses we already hold in our local
-        -- mempool: they never become fetch jobs; instead we ingest them ourselves
-        -- below (the last thing this function does).
-        (stillMissing, mempoolHits) <- pullFromMempool misses
-        -- Now that the mempool pull is done, report the body's combined
-        -- cache+mempool hit picture: the cache summary plus how many of the
-        -- cache-miss txs we found in our own mempool.
-        forM_ mbBodySummary $ \summary ->
-          traceWith ktracer $ TraceLeiosBodyHits point summary (Map.size mempoolHits)
+        -- 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); 'stillMissing' is offset -> (tx hash,
+              -- 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)
-                stillMissing
+                missedBoth
             !outstanding' = Leios.insertAcquiredEbBody ebHash jobPool outstandingCleaned
-        pure (outstanding', (bodyClass, mempoolHits))
+        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 into the DB and cache (they
-  -- were removed from the fetch job set above). This function already pays disk
-  -- latency, so doing it synchronously here is fine.
-  unless (Map.null mempoolHits) $
+  -- 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
-      (MempoolTxs point mempoolHits)
+      (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
diff --git a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs
index 758fd01898..799a912123 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs
@@ -1282,7 +1282,7 @@ messageLeiosFetchToObject = \case
 -- | Summary of an EB body inserted into the LeiosTxCache, for observability (see
 -- 'TraceLeiosBodyHits'). The counts nest:
 -- @ibsTxsInEb >= ibsTracked >= ibsAcquired >= ibsValidated@.
-data InsertBodySummary = InsertBodySummary
+data LeiosTxCacheInsertBodySummary = MkLeiosTxCacheInsertBodySummary
   { ibsTxsInEb :: !Int
   -- ^ txs the EB body references
   , ibsTracked :: !Int
@@ -1307,10 +1307,13 @@ data TraceLeiosKernel
   | TraceLeiosBlockTxsAcquired LeiosPoint
   | -- | An EB body was inserted into the LeiosTxCache
     --
-    -- Carries the LeiosTxCache summary (cache hits) and how many of the
-    -- /remaining/ txs we then found in our local mempool. Together these give
-    -- the combined cache+mempool hit rate on the body's arrival.
-    TraceLeiosBodyHits LeiosPoint InsertBodySummary Int
+    -- 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
@@ -1505,7 +1508,7 @@ traceLeiosKernelToObject = \case
       , "ebHash" .= prettyEbHash ebHash
       , "ebSlot" .= ebSlot
       ]
-  TraceLeiosBodyHits (MkLeiosPoint (SlotNo ebSlot) ebHash) ibs mempoolHits ->
+  TraceLeiosBodyHits (MkLeiosPoint (SlotNo ebSlot) ebHash) ibs mempoolHits missedBoth ->
     mconcat
       [ "kind" .= Aeson.String "LeiosBodyHits"
       , "ebHash" .= prettyEbHash ebHash
@@ -1515,6 +1518,7 @@ traceLeiosKernelToObject = \case
       , "acquired" .= ibsAcquired ibs
       , "validated" .= ibsValidated ibs
       , "mempoolHits" .= mempoolHits
+      , "missedBoth" .= missedBoth
       , "cacheTxCount" .= ibsCacheTxCount ibs
       , "cacheLoad" .= ibsCacheLoad ibs
       ]
diff --git a/ouroboros-consensus/src/ouroboros-consensus/LeiosTxCache/API.hs b/ouroboros-consensus/src/ouroboros-consensus/LeiosTxCache/API.hs
index d2e5635e70..561d179728 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/LeiosTxCache/API.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosTxCache/API.hs
@@ -17,8 +17,8 @@ module LeiosTxCache.API
   , maxAnnouncementCount
 
     -- * Insert-body observability summary
-  , InsertBodySummary (..)
-  , mkInsertBodySummary
+  , LeiosTxCacheInsertBodySummary (..)
+  , mkLeiosTxCacheInsertBodySummary
   , worstCaseCacheTxCount
 
     -- * Arrival classification
@@ -37,7 +37,7 @@ import LeiosDemoTypes
   ( BytesSize
   , EbHash
   , FetchArrivalBytes
-  , InsertBodySummary (..)
+  , LeiosTxCacheInsertBodySummary (..)
   , RbHash
   , SerializedEbBody (..)
   , TxHash
@@ -75,7 +75,7 @@ data LeiosTxCache m a v b = LeiosTxCache
       b ->
       w ->
       (w -> Int -> TxHash -> BytesSize -> w) ->
-      m (Maybe (InsertBodySummary, 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
@@ -161,11 +161,11 @@ bucketTxArrival = \case
 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 a79b0800a8..c1f5ec95c3 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/LeiosTxCache/Optimized.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosTxCache/Optimized.hs
@@ -38,7 +38,7 @@ import LeiosTxCache.API
   , TxArrivalPrior (..)
   , bucketTxArrival
   , maxAnnouncementCount
-  , mkInsertBodySummary
+  , mkLeiosTxCacheInsertBodySummary
   )
 import qualified LeiosTxCache.Optimized.MutableHashTable as HT
 import Ouroboros.Consensus.Util.IOLike (IOLike)
@@ -109,7 +109,7 @@ newHashTableLeiosTxCache nshift k0 k1 = do
                     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, w))
+                pure (st', Just (mkLeiosTxCacheInsertBodySummary n tracked acquired validated cacheTxCount, w))
       , lookupBody = \ebh ->
           MVar.withMVar stateVar $ \st ->
             pure $ case Map.lookup ebh (hsBodies st) of
diff --git a/ouroboros-consensus/src/ouroboros-consensus/LeiosTxCache/Reference.hs b/ouroboros-consensus/src/ouroboros-consensus/LeiosTxCache/Reference.hs
index 2cd97899f4..f1d753d072 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/LeiosTxCache/Reference.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosTxCache/Reference.hs
@@ -67,12 +67,12 @@ import qualified Data.Set as Set
 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
@@ -318,7 +318,7 @@ insertBody ::
   w ->
   (w -> Int -> TxHash -> BytesSize -> w) ->
   LeiosTxCacheIndex a v b ->
-  (LeiosTxCacheIndex a v b, Maybe (InsertBodySummary, w))
+  (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)
@@ -333,7 +333,7 @@ insertBody ebh body nil snoc idx = case Map.lookup ebh (bodyState idx) of
             , txState = txState'
             , prunedSlot = prunedSlot idx
             }
-     in (idx', Just (mkInsertBodySummary n tracked acquired validated (Map.size txState'), w))
+     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:
   -- the counts feed the summary, and every not-yet-acquired tx (a "miss") is

From 73be98ba7b2b30c202bd30f0464b618963d4cb09 Mon Sep 17 00:00:00 2001
From: Nicolas Frisby <nicolas.frisby@moduscreate.com>
Date: Tue, 25 Aug 2026 16:55:51 -0400
Subject: [PATCH 43/49] LeiosTxCache: correct a false comment

---
 ouroboros-consensus/src/ouroboros-consensus/LeiosTxCache/API.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/ouroboros-consensus/src/ouroboros-consensus/LeiosTxCache/API.hs b/ouroboros-consensus/src/ouroboros-consensus/LeiosTxCache/API.hs
index 561d179728..f4e0993483 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/LeiosTxCache/API.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosTxCache/API.hs
@@ -97,7 +97,7 @@ data LeiosTxCache m a v b = LeiosTxCache
   , 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, each paired with

From 7972c17fba861e950c55ee752297afc2ea70941a Mon Sep 17 00:00:00 2001
From: Nicolas Frisby <nicolas.frisby@moduscreate.com>
Date: Tue, 25 Aug 2026 18:00:10 -0400
Subject: [PATCH 44/49] FIXUP stop defaulting leiosTx{Bytes,Hash}OfGenTx
 methods

---
 .../Ouroboros/Consensus/Cardano/Block.hs               |  8 ++++++++
 .../Ouroboros/Consensus/Shelley/Ledger/Leios.hs        | 10 ++++++++++
 2 files changed, 18 insertions(+)

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

From 831a3c0d4b5f4cc74ab419cbe80ed99be03a8187 Mon Sep 17 00:00:00 2001
From: Nicolas Frisby <nicolas.frisby@moduscreate.com>
Date: Tue, 25 Aug 2026 18:57:00 -0400
Subject: [PATCH 45/49] LeiosFetch: add age metrics to
 TraceLeiosBlock{,Txs}Acquired

---
 .../Ouroboros/Consensus/Network/NodeToNode.hs |   6 +-
 .../Ouroboros/Consensus/NodeKernel.hs         |   3 +
 ouroboros-consensus.cabal                     |   1 +
 .../src/ouroboros-consensus/LeiosDemoLogic.hs | 111 ++++++++++++------
 .../src/ouroboros-consensus/LeiosDemoTypes.hs |  85 ++++++++++----
 .../consensus-test/Test/LeiosDemoLogic.hs     |   3 +-
 .../Test/LeiosDemoLogic/Invariants.hs         |  63 ++++++++--
 7 files changed, 198 insertions(+), 74 deletions(-)

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 41bf60c239..66e89c6bb1 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
@@ -425,6 +426,7 @@ mkHandlers
                       (Just peer)
                       Leios.ReceivedViaChainSync
                       Announcements.DoRelay
+                      (SJust hdrSlotTime)
                       (Just (diffRelTime now hdrSlotTime))
                       ancHdr
               }
@@ -521,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
@@ -533,6 +535,7 @@ mkHandlers
                                 (Just peer)
                                 Leios.ReceivedViaLeiosNotify
                                 shouldRelay
+                                (SJust onset)
                                 (Just age)
                                 ancHdr
                           )
@@ -667,6 +670,7 @@ mkHandlers
                   (getLeiosOutstanding, getLeiosReady)
                   getLeiosTxCache
                   leiosConn
+                  systemTime
                   ( Leios.mkMempoolPull
                       (atomically (getLeiosTxIndex getMempool))
                       (leiosTxBytesOfGenTx . txForgetValidated)
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 1029b62409..f35aabd0b3 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
@@ -660,6 +660,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
@@ -702,6 +703,7 @@ initInternalState
     , cfg
     , blockFetchSize
     , btime
+    , systemTime
     , mempoolCapacityOverride
     , mempoolTimeoutConfig
     , gsmArgs
@@ -827,6 +829,7 @@ forkBlockForging IS{..} (MkBlockForging blockForgingM) =
                           (leiosOutstanding, leiosReady)
                           leiosTxCache
                           leiosConn
+                          systemTime
                           -- Safe here: the forge hands us a corresponding header
                           -- and closure.
                           (Leios.mkForgedAnnouncingHeader forgedHeader forgedEb)
diff --git a/ouroboros-consensus.cabal b/ouroboros-consensus.cabal
index e2eaf7cadb..f4a7df73ce 100644
--- a/ouroboros-consensus.cabal
+++ b/ouroboros-consensus.cabal
@@ -1231,6 +1231,7 @@ library diffusion
     cardano-binary,
     cardano-diffusion:{api, cardano-diffusion, protocols},
     cardano-slotting,
+    cardano-strict-containers,
     cborg,
     containers,
     contra-tracer,
diff --git a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
index ceecea4fbe..f5ed27337b 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
@@ -37,6 +37,7 @@ 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
@@ -120,7 +121,8 @@ import Ouroboros.Consensus.Block
   , toRawHash
   )
 import Ouroboros.Consensus.BlockchainTime.WallClock.Types
-  ( SystemTime
+  ( RelativeTime
+  , SystemTime
   , diffRelTime
   , systemTimeCurrent
   )
@@ -465,7 +467,7 @@ assignPeer env mbCurrentSlot isBig peerId offers acc =
         -- imm-tip). This is an ephemeral state, mid prune, but go ahead and
         -- prune it now.
         pruneThisOffer
-      Just (Leios.MkEbState slot fetchState) -> case (fetchState, offerKind) of
+      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
@@ -546,9 +548,9 @@ assignClosure ::
 assignClosure env isBig peerId ebHash st@(acc, dec) =
   case Map.lookup ebHash (Leios.ebState acc) of
     Nothing -> (st, MkWhetherPeerEbExhausted False)
-    Just (Leios.MkEbState _slot Leios.NoBody) -> (st, MkWhetherPeerEbExhausted False)
-    Just (Leios.MkEbState _slot Leios.BodyImminent) -> (st, MkWhetherPeerEbExhausted False)
-    Just (Leios.MkEbState slot (Leios.BodyAcquired jobPool)) ->
+    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)
@@ -565,7 +567,7 @@ assignClosure env isBig peerId ebHash st@(acc, dec) =
                       { Leios.ebState =
                           Map.insert
                             ebHash
-                            (Leios.MkEbState slot (Leios.BodyAcquired jobPool'))
+                            (Leios.MkEbState slot onset (Leios.BodyAcquired jobPool'))
                             (Leios.ebState acc)
                       , Leios.requestedJobsPerPeer =
                           Map.insertWith
@@ -673,6 +675,8 @@ 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)
@@ -689,7 +693,7 @@ nextLeiosFetchClientCommand ::
         (m (Either () (LF.SomeLeiosFetchJob LeiosPoint LeiosEb LeiosTx m)))
         (Either () (LF.SomeLeiosFetchJob LeiosPoint LeiosEb LeiosTx m))
     )
-nextLeiosFetchClientCommand ktracer tracer stopSTM kernelVars txCache db pullFromMempool 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
@@ -701,9 +705,9 @@ nextLeiosFetchClientCommand ktracer tracer stopSTM kernelVars txCache db pullFro
     pending <- StrictSTM.atomically $ LazySTM.flushTQueue responseQ
     forM_ pending $ \case
       PendingBlockResponse req eb ->
-        processLeiosBlock ktracer tracer kernelVars txCache db pullFromMempool (ReceivedBlockFrom peerId req) eb
+        processLeiosBlock ktracer tracer kernelVars txCache db systemTime pullFromMempool (ReceivedBlockFrom peerId req) eb
       PendingBlockTxsResponse req txs ->
-        processLeiosBlockTxs ktracer tracer kernelVars txCache db (ReceivedTxsFrom 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).
@@ -770,8 +774,8 @@ nextLeiosFetchClientCommand ktracer tracer stopSTM kernelVars txCache db pullFro
 -- 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 arrival
--- panels with self-produced data).
+-- 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.
@@ -790,6 +794,16 @@ data LeiosBlockTxsSource pid
     -- (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
@@ -801,6 +815,8 @@ processLeiosBlock ::
   ) ->
   LeiosTxCache m () () SerializedEbBody ->
   LeiosDbConnection m ->
+  -- | 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,
@@ -811,7 +827,8 @@ processLeiosBlock ::
   LeiosBlockSource pid ->
   LeiosEb ->
   m ()
-processLeiosBlock ktracer tracer (outstandingVar, readyVar) txCache db pullFromMempool source eb = do
+processLeiosBlock ktracer tracer (outstandingVar, readyVar) txCache db systemTime pullFromMempool source eb = do
+  now <- systemTimeCurrent systemTime
   -- validate it
   let (mbPeer, point, ebBytesSize) = case source of
         ReceivedBlockFrom peerId (MkLeiosBlockRequest p sz) -> (Just peerId, p, sz)
@@ -908,8 +925,11 @@ processLeiosBlock ktracer tracer (outstandingVar, readyVar) txCache db pullFromM
               (Leios.serializeEbBody eb)
               IntMap.empty
               (\acc i missingTxh sz -> IntMap.insert i (missingTxh, sz) acc)
-          traceWith ktracer $ TraceLeiosBlockAcquired point
-          forM_ completedByBody $ traceWith ktracer . TraceLeiosBlockTxsAcquired
+          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.
@@ -993,6 +1013,7 @@ processLeiosBlock ktracer tracer (outstandingVar, readyVar) txCache db pullFromM
       (outstandingVar, readyVar)
       txCache
       db
+      systemTime
       (MempoolTxs point mempoolNotCache)
 
 -- | The 'processLeiosBlock' mempool-pull for paths that never pull from the
@@ -1060,8 +1081,8 @@ removePeerFromOutstanding peerId o =
     }
  where
   -- Decrement, in that EB's jobPool, the multiplicity of each job this peer held.
-  releaseJobs jobIds (Leios.MkEbState slot fetchState) =
-    Leios.MkEbState slot $ case fetchState of
+  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 ->
@@ -1139,8 +1160,8 @@ completeTxRequest peerId ebHash jobIds o =
         Map.update (nonEmptyMap . Map.update dropJobs ebHash) peerId (Leios.requestedJobsPerPeer o)
     }
  where
-  completeInJobPool (Leios.MkEbState slot fetchState) =
-    Leios.MkEbState slot $ case fetchState of
+  completeInJobPool (Leios.MkEbState slot onset fetchState) =
+    Leios.MkEbState slot onset $ case fetchState of
       Leios.NoBody -> Leios.NoBody
       Leios.BodyImminent -> Leios.BodyImminent
       Leios.BodyAcquired jobPool ->
@@ -1218,25 +1239,31 @@ processLeiosBlockTxs ::
   ) ->
   LeiosTxCache m () () SerializedEbBody ->
   LeiosDbConnection m ->
+  -- | For reporting each completed closure's age on arrival.
+  SystemTime m ->
   LeiosBlockTxsSource pid ->
   m ()
-processLeiosBlockTxs ktracer tracer (outstandingVar, readyVar) txCache db source = case source of
+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 Applied (Map.toList hits)
+    _ <- 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)
@@ -1269,11 +1296,11 @@ processLeiosBlockTxs ktracer tracer (outstandingVar, readyVar) txCache db source
     let pendingJobs = case Map.lookup point.pointEbHash (Leios.ebState outstanding0) of
           Nothing ->
             IntMap.empty
-          Just (Leios.MkEbState _slot Leios.NoBody) ->
+          Just (Leios.MkEbState _slot _onset Leios.NoBody) ->
             IntMap.empty
-          Just (Leios.MkEbState _slot Leios.BodyImminent) ->
+          Just (Leios.MkEbState _slot _onset Leios.BodyImminent) ->
             IntMap.empty
-          Just (Leios.MkEbState _slot (Leios.BodyAcquired jobPool)) ->
+          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
@@ -1292,7 +1319,7 @@ processLeiosBlockTxs ktracer tracer (outstandingVar, readyVar) txCache db source
     -- 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 Unapplied toIngest
+    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);
@@ -1316,11 +1343,13 @@ processLeiosBlockTxs ktracer tracer (outstandingVar, readyVar) txCache db source
   -- 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 :: WhetherApplied -> [(TxHash, BS.ByteString)] -> m Leios.FetchArrivalBytes
-  ingestAcquiredTxs applied toIngest =
+  ingestAcquiredTxs :: RelativeTime -> WhetherApplied -> [(TxHash, BS.ByteString)] -> m Leios.FetchArrivalBytes
+  ingestAcquiredTxs now applied toIngest =
     traceException tracer TraceLeiosPeerDbException $ do
       completed <- leiosDbInsertTxs db toIngest
-      forM_ completed $ traceWith ktracer . TraceLeiosBlockTxsAcquired
+      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 ->
@@ -1373,7 +1402,7 @@ recordEbBodyOffer (outstandingVar, readyVar) peerVars offeredClosure (point, ebB
           -- TODO stop that, once offers are no longer trusted
           outstanding'
             | tooOld || malformed = outstanding
-            | otherwise = Leios.recordMaxAnnouncementSlot ebHash ebSlot outstanding
+            | otherwise = Leios.recordMaxAnnouncementSlot ebHash ebSlot SNothing outstanding
           skip =
             tooOld
             || malformed
@@ -1480,6 +1509,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 ()
@@ -1491,6 +1526,7 @@ processAnnouncementCentrally
   source
   provenance
   shouldRelay
+  onset
   age
   ancHdr =
     MVar.modifyMVar_ centralVar $ \cst ->
@@ -1519,7 +1555,7 @@ 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 (point, Leios.announcementEbBodySize fields)
+  recordAnnounced = recordAnnouncedEb kernelVars onset (point, Leios.announcementEbBodySize fields)
   markForged =
     MVar.modifyMVar_ (fst kernelVars) $
       pure . Leios.markBodyImminent point.pointEbHash point.pointSlotNo
@@ -1572,7 +1608,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
@@ -1605,7 +1641,7 @@ 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, unless its already
 -- pruned\/tracked\/acquired
@@ -1614,9 +1650,11 @@ recordAnnouncedEb ::
   ( 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
@@ -1628,7 +1666,7 @@ recordAnnouncedEb (outstandingVar, readyVar) (point, ebBytesSize) = do
     let tooOld = ebSlot < Leios.acquiredEbBodiesPrunedSlot outstanding -- too old to fetch
         !outstanding'
           | tooOld = outstanding
-          | otherwise = Leios.recordMaxAnnouncementSlot ebHash ebSlot outstanding
+          | otherwise = Leios.recordMaxAnnouncementSlot ebHash ebSlot onset outstanding
         skip =
           tooOld
           || maybe False Leios.ebStateHasBody (Map.lookup ebHash (Leios.ebState outstanding)) -- already have it
@@ -1739,12 +1777,14 @@ onForgedLeiosEb ::
   ) ->
   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 anc forgedEb = do
+onForgedLeiosEb kernelTracer centralVar kv txCache db systemTime anc forgedEb = do
   processAnnouncementCentrally
     kernelTracer
     centralVar
@@ -1753,6 +1793,7 @@ onForgedLeiosEb kernelTracer centralVar kv txCache db anc forgedEb = do
     Nothing
     ForgedLocally
     Announcements.DoRelay
+    SNothing -- a self-forged EB records no onset (kept out of the /diffusion/ events)
     Nothing
     anc
   processLeiosBlock
@@ -1761,6 +1802,7 @@ onForgedLeiosEb kernelTracer centralVar kv txCache db anc forgedEb = do
     kv
     txCache
     db
+    systemTime
     noMempoolPull -- the forge holds the whole closure
     (ForgedBlock forgedEb.point)
     forgedEb.body
@@ -1770,6 +1812,7 @@ onForgedLeiosEb kernelTracer centralVar kv txCache db anc forgedEb = do
     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 799a912123..0eca9dd24c 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs
@@ -96,6 +96,7 @@ import qualified Data.Set.NonEmpty as NESet
 import LeiosDemoTypes.LeiosJobs as TxHashReexports (TxHash (..), prettyTxHash)
 import qualified LeiosDemoTypes.LeiosJobs as Jobs
 import Data.String (fromString)
+import Cardano.Slotting.Time (RelativeTime)
 import Data.Time.Clock (NominalDiffTime)
 import Data.Vector.Strict (Vector)
 import qualified Data.Vector.Strict as V
@@ -478,9 +479,12 @@ emptyLeiosOutstanding prunedSlot =
 
 -- | Per-EB state tracked in 'ebState'
 data EbState =
-  -- | the greatest slot at which the EB has been announced (TODO or, for now,
-  -- offered), together with the current progress of fetching it
-  MkEbState !SlotNo !EbFetchState
+  -- | 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.
@@ -515,12 +519,17 @@ data EbFetchState
   deriving (Eq, Show)
 
 ebStateMaxSlot :: EbState -> SlotNo
-ebStateMaxSlot (MkEbState slot _fetchState) = slot
+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 fetchState) = case fetchState of
+ebStateHasBody (MkEbState _slot _onset fetchState) = case fetchState of
   NoBody -> False
   BodyImminent -> False
   BodyAcquired{} -> True
@@ -661,36 +670,52 @@ insertAcquiredEbBody ebHash jobPool =
       --
       -- Because it was previously pruned, it should simply be ignored now.
       Nothing
-    Just (MkEbState slot fetchState) -> case fetchState of
+    Just (MkEbState slot onset fetchState) -> case fetchState of
       BodyAcquired{} -> Nothing
-      NoBody -> Just $ MkEbState slot (BodyAcquired jobPool)
+      NoBody -> Just $ MkEbState slot onset (BodyAcquired jobPool)
       BodyImminent ->
         -- note that we ignore the given jobPool here
-        Just $ MkEbState slot (BodyAcquired Jobs.emptyLeiosJobPool)
+        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
-    Nothing -> Just $ MkEbState slot BodyImminent
-    Just (MkEbState oldSlot fetchState) -> case fetchState of
-      NoBody -> Just $ MkEbState oldSlot BodyImminent
+    -- 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 (BodyAcquired Jobs.emptyLeiosJobPool)
+      BodyAcquired{} -> Just $ MkEbState oldSlot onset (BodyAcquired Jobs.emptyLeiosJobPool)
 
 -- | Record that the EB with this hash is referenced (announced or offered) at this
--- slot
+-- 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.
+-- /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 -> LeiosOutstanding pid -> LeiosOutstanding pid
-recordMaxAnnouncementSlot ebHash slot =
+  EbHash -> SlotNo -> StrictMaybe RelativeTime -> LeiosOutstanding pid -> LeiosOutstanding pid
+recordMaxAnnouncementSlot ebHash slot onset =
   alterEbState ebHash $ \mbOld -> case mbOld of
-    Nothing -> Just $ MkEbState slot NoBody
-    Just (MkEbState oldSlot fetchState) ->
-      if slot <= oldSlot then Nothing else Just $ MkEbState slot fetchState
+    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
 --
@@ -737,7 +762,7 @@ initializeLeiosOutstanding points immTipSlot =
  where
   seed1 (MkLeiosPoint slot ebHash) =
     insertAcquiredEbBody ebHash Jobs.emptyLeiosJobPool
-      . recordMaxAnnouncementSlot ebHash slot
+      . 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
@@ -1300,11 +1325,17 @@ data LeiosTxCacheInsertBodySummary = MkLeiosTxCacheInsertBodySummary
 
 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'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
@@ -1490,24 +1521,26 @@ traceLeiosKernelToObject = \case
       [ "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
       ]
+        ++ foldMap (\age -> ["closureAgeSeconds" .= (realToFrac age :: Double)]) mbAge
   TraceLeiosBodyHits (MkLeiosPoint (SlotNo ebSlot) ebHash) ibs mempoolHits missedBoth ->
     mconcat
       [ "kind" .= Aeson.String "LeiosBodyHits"
diff --git a/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic.hs b/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic.hs
index ef7995344d..8663b2ae5d 100644
--- a/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic.hs
+++ b/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic.hs
@@ -24,6 +24,7 @@ import qualified Data.ByteString as BS
 import Data.Foldable (toList)
 import Data.Function ((&))
 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 qualified Data.Set.NonEmpty as NESet
@@ -189,7 +190,7 @@ withMissingBody p@(MkLeiosPoint slot ebHash) size =
     -- 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 $
+    recordMaxAnnouncementSlot ebHash slot SNothing $
       o
         { missingEbBodies = Map.insert p size (missingEbBodies o)
         , reverseSlotIndexByEbHash =
diff --git a/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic/Invariants.hs b/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic/Invariants.hs
index 95f52c4105..5e2b4ccf80 100644
--- a/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic/Invariants.hs
+++ b/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic/Invariants.hs
@@ -45,6 +45,7 @@ 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 qualified Data.Set as Set
 import qualified Data.Set.NonEmpty as NESet
 import Data.Sequence.NonEmpty (NESeq)
@@ -84,6 +85,10 @@ import LeiosDemoTypes
 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 (..)
@@ -115,14 +120,14 @@ tests =
             -- announce at slot 5, then again at the smaller slot 3, and acquire
             o =
               Leios.insertAcquiredEbBody h jobPool $
-                Leios.recordMaxAnnouncementSlot h (SlotNo 3) $
-                  Leios.recordMaxAnnouncementSlot h (SlotNo 5) $
+                Leios.recordMaxAnnouncementSlot h (SlotNo 3) SNothing $
+                  Leios.recordMaxAnnouncementSlot h (SlotNo 5) SNothing $
                     (emptyLeiosOutstanding (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) (Leios.BodyAcquired jobPool))
+        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) (Leios.BodyAcquired jobPool))
+          @?= 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
@@ -130,14 +135,38 @@ tests =
         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) $
+              Leios.recordMaxAnnouncementSlot h (SlotNo 10) SNothing $
                 Leios.markBodyImminent h (SlotNo 5) $
                   (emptyLeiosOutstanding (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) Leios.BodyImminent)
+        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 (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
@@ -150,10 +179,10 @@ tests =
             o = Leios.initializeLeiosOutstanding 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) (Leios.BodyAcquired Jobs.emptyLeiosJobPool))
+          @?= 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) (Leios.BodyAcquired Jobs.emptyLeiosJobPool))
+          @?= 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) ...
@@ -199,7 +228,7 @@ tests =
               let outstanding =
                     (\o -> o{Leios.requestedBytesSizePerPeer = Map.singleton peerId used}) $
                       Leios.insertAcquiredEbBody h jobPool $
-                        Leios.recordMaxAnnouncementSlot h (SlotNo 10) $
+                        Leios.recordMaxAnnouncementSlot h (SlotNo 10) SNothing $
                           (emptyLeiosOutstanding (SlotNo 0) :: LeiosOutstanding Int)
                   (_o, reqs, _d) =
                     leiosFetchLogicIteration demoLeiosFetchStaticEnv (Just (SlotNo 11)) offers bigLedgerPeers outstanding
@@ -294,6 +323,15 @@ 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])
 
@@ -363,7 +401,7 @@ applyCmd conn txCache kv peerVars peerId = \case
   ArriveBody ids slot -> do
     let eb = ebOf ids
         req = MkLeiosBlockRequest (pointOf ids slot) (leiosEbBytesSize eb)
-    processLeiosBlock nullTracer nullTracer kv txCache conn noMempoolPull (ReceivedBlockFrom peerId req) eb
+    processLeiosBlock nullTracer nullTracer kv txCache conn dummySystemTime noMempoolPull (ReceivedBlockFrom peerId req) eb
     pure []
   ArriveTx v -> absurd v
   Forge ids slot -> do
@@ -383,8 +421,8 @@ applyCmd conn txCache kv peerVars peerId = \case
     -- '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 noMempoolPull (ForgedBlock point) eb
-    processLeiosBlockTxs nullTracer nullTracer kv txCache conn (ForgedTxs point eb $ V.fromList $ map leiosTxOf ids)
+    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)
@@ -667,6 +705,7 @@ raceSameHashMultiSlot = do
               kv
               txCache
               conn
+              dummySystemTime
               noMempoolPull
               (ReceivedBlockFrom peerId (MkLeiosBlockRequest arrivalPoint ebBytesSize))
               eb

From 4e0146fab147f87ce0f535d3d82be885dee74d6e Mon Sep 17 00:00:00 2001
From: Sebastian Nagel <sebastian.nagel@ncoding.at>
Date: Fri, 28 Aug 2026 14:04:57 +0200
Subject: [PATCH 46/49] LeiosFetch: fix the test suites for the age arguments

Neither test suite compiled after the age metrics were added.

'recordAnnouncedEb' gained an announcement onset, so its two call sites in the
fetch invariants pass SNothing: those invariants are about the fetch bookkeeping,
which never reads the onset.

'TraceLeiosBlockTxsAcquired' gained the age, so the ThreadNet pattern that
collects acquired points ignores it. The ambiguous-type error two hundred lines
below was a cascade of that one -- with the pattern ill-typed, the element type
of 'acquiredPoints' could not be inferred.
---
 .../test/cardano-test/Test/ThreadNet/Leios.hs |   2 +-
 .../Test/LeiosDemoLogic/Invariants.hs         | 407 ++++++++++--------
 2 files changed, 226 insertions(+), 183 deletions(-)

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/test/consensus-test/Test/LeiosDemoLogic/Invariants.hs b/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic/Invariants.hs
index 5e2b4ccf80..19c56706d6 100644
--- a/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic/Invariants.hs
+++ b/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic/Invariants.hs
@@ -46,9 +46,9 @@ 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 Data.Sequence.NonEmpty (NESeq)
 import qualified Data.Vector.Strict as V
 import Data.Void (Void, absurd)
 import LeiosDemoDb (withLeiosDb)
@@ -103,179 +103,186 @@ 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 $
+  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 (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 (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 (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 (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 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 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 (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 "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 (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
-    ]
+          -- 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 (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 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 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 (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 "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 (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
@@ -368,8 +375,8 @@ runCmdsReFetchViolations cmds = runSimOrThrow (go cmds)
           loop acc [] = pure (Right acc)
           loop acc (c : cs) = do
             r <-
-              try (applyCmd conn txCache kv peerVars peerId c)
-                :: IOSim s (Either SomeException [EbHash])
+              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
@@ -393,15 +400,30 @@ applyCmd ::
   IOSim s [EbHash]
 applyCmd conn txCache kv peerVars peerId = \case
   Announce ids slot -> do
-    recordAnnouncedEb kv (pointOf ids slot, leiosEbBytesSize (ebOf ids))
+    -- 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))
+    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
+    processLeiosBlock
+      nullTracer
+      nullTracer
+      kv
+      txCache
+      conn
+      dummySystemTime
+      noMempoolPull
+      (ReceivedBlockFrom peerId req)
+      eb
     pure []
   ArriveTx v -> absurd v
   Forge ids slot -> do
@@ -421,8 +443,24 @@ applyCmd conn txCache kv peerVars peerId = \case
     -- '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)
+    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)
@@ -430,7 +468,12 @@ applyCmd conn txCache kv peerVars peerId = \case
         -- 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
+          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.
@@ -698,7 +741,7 @@ raceSameHashMultiSlot = do
     concurrently_
       (recordEbBodyOffer kv peerVars TxsClosureNotAlsoOffered (offerPoint, ebBytesSize))
       ( concurrently_
-          (recordAnnouncedEb kv (announcePoint, ebBytesSize))
+          (recordAnnouncedEb kv SNothing (announcePoint, ebBytesSize))
           ( processLeiosBlock
               nullTracer
               nullTracer

From c11d1c48bbed45076ec53450054a56105b2acce5 Mon Sep 17 00:00:00 2001
From: Sebastian Nagel <sebastian.nagel@ncoding.at>
Date: Fri, 28 Aug 2026 14:56:49 +0200
Subject: [PATCH 47/49] Apply fourmolu and cabal-gild

Output of scripts/ci/run-fourmolu.sh and scripts/ci/run-cabal-gild.sh, which CI
enforces. Mostly the layout of multi-line SPECIALISE pragmas, which fourmolu also
spells SPECIALIZE, plus stanza spacing in the cabal file.
---
 .../Ouroboros/Consensus/Network/NodeToNode.hs |   2 +-
 .../Ouroboros/Consensus/NodeKernel.hs         |  15 +-
 .../bench/leios-txcache-bench/Main.hs         |   6 +-
 .../src/ouroboros-consensus/LeiosDemoLogic.hs | 150 +++++++++++-------
 .../src/ouroboros-consensus/LeiosDemoTypes.hs |  87 +++++-----
 .../LeiosDemoTypes/LeiosJobs.hs               |  10 +-
 .../src/ouroboros-consensus/LeiosTxCache.hs   |  11 +-
 .../ouroboros-consensus/LeiosTxCache/API.hs   |   3 +-
 .../LeiosTxCache/Optimized.hs                 |  20 ++-
 .../Ouroboros/Consensus/Mempool/API.hs        |   2 +-
 .../Consensus/Storage/LedgerDB/Forker.hs      |   2 +-
 .../consensus-test/Test/LeiosDemoLogic.hs     |   1 -
 .../Test/LeiosTxCache/Optimized.hs            |   6 +-
 .../Test/LeiosTxCache/Reference.hs            |   6 +-
 14 files changed, 191 insertions(+), 130 deletions(-)

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 66e89c6bb1..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
@@ -145,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 (..)
@@ -153,7 +154,6 @@ import qualified Ouroboros.Consensus.MiniProtocol.ChainSync.Client as CsClient
 import Ouroboros.Consensus.MiniProtocol.ChainSync.Server
 import Ouroboros.Consensus.Node.ExitPolicy
 import Ouroboros.Consensus.Node.NetworkProtocolVersion
-import Ouroboros.Consensus.Mempool.API (getLeiosTxIndex)
 import Ouroboros.Consensus.Node.Run
 import Ouroboros.Consensus.Node.Serialisation
 import qualified Ouroboros.Consensus.Node.Tracers as Node
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 f35aabd0b3..78794871aa 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
@@ -514,7 +514,14 @@ initNodeKernel
                     (Map.restrictKeys offerings (Map.keysSet stillLivePeers))
                     bigLedgerPeers
                     outstanding
-            pure (outstanding', (requests, offerDrops, Leios.leiosOutstandingStats (Map.size offerings) (map Map.size (Map.elems offerings)) 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
@@ -552,7 +559,11 @@ initNodeKernel
           -- 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)
+          traceWith leiosTr $
+            TraceLeiosFetchDecision
+              (realToFrac duration)
+              outstandingStats
+              (Leios.summarizeDecisions newRequests)
           threadDelay $ loopInterval - duration
 
     -- The Leios voting thread: when this node has a voting key, subscribe
diff --git a/ouroboros-consensus/bench/leios-txcache-bench/Main.hs b/ouroboros-consensus/bench/leios-txcache-bench/Main.hs
index 767f486967..8090748971 100644
--- a/ouroboros-consensus/bench/leios-txcache-bench/Main.hs
+++ b/ouroboros-consensus/bench/leios-txcache-bench/Main.hs
@@ -88,9 +88,9 @@ instance ReferencesTxsByHash BenchBody where
     go !acc i
       | i >= n = acc
       | otherwise =
-        go
-          (f acc (MkTxHash (BS.copy (BS.take 32 (BS.drop (i * 32) bs)))) dummySize)
-          (i + 1)
+          go
+            (f acc (MkTxHash (BS.copy (BS.take 32 (BS.drop (i * 32) bs)))) dummySize)
+            (i + 1)
     dummySize = 0
 
 type BenchCache = LeiosTxCache IO () () BenchBody
diff --git a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
index f5ed27337b..9f236c9c6e 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
@@ -29,8 +29,8 @@ import qualified Data.ByteString as BS
 import Data.Foldable (fold)
 import Data.Functor (void, (<&>))
 import qualified Data.IntMap as IntMap
-import qualified Data.IntSet as IntSet
 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)
@@ -76,10 +76,10 @@ import LeiosDemoLogic.Announcements.Validate
   )
 import qualified LeiosDemoOnlyTestFetch as LF
 import LeiosDemoTypes
-  ( AnnouncementEquivocation (..)
+  ( AlsoOfferedTxsClosure (..)
+  , AnnouncementEquivocation (..)
   , AnnouncementFields (..)
   , AnnouncementSource (..)
-  , AlsoOfferedTxsClosure (..)
   , BytesSize
   , EbHash (..)
   , LeiosBlockRequest (..)
@@ -97,12 +97,12 @@ import LeiosDemoTypes
   , TraceLeiosKernel (..)
   , TraceLeiosPeer (..)
   , TxHash (..)
-  , hashLeiosEb
-  , hashLeiosTx
   , fetchArrivalEvicted
   , fetchArrivalExtra
   , fetchArrivalGood
   , fetchArrivalInvalid
+  , hashLeiosEb
+  , hashLeiosTx
   , leiosEbBytesSize
   , leiosEbTxs
   , maxTxsPerEb
@@ -191,8 +191,8 @@ recordForgedEbAndClosureInTxCache tracer txCache rbh forgedEb = do
   -- 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) () (\() _ _ _ -> ())
+    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@
@@ -388,7 +388,8 @@ leiosFetchLogicIteration env mbCurrentSlot offerings bigLedgerPeers = \acc0 ->
 --
 -- 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 ::
+  Ord pid => LeiosFetchStaticEnv -> IsBigLedgerPeer -> LeiosOutstanding pid -> PeerId pid -> Int
 peerBudget env isBig acc peerId =
   fromIntegral cap
     - fromIntegral (Map.findWithDefault 0 peerId (Leios.requestedBytesSizePerPeer acc))
@@ -489,8 +490,8 @@ assignPeer env mbCurrentSlot isBig peerId offers acc =
           pruneThisOffer
         (Leios.BodyAcquired jobPool, TxsClosureAlsoOffered)
           | Jobs.nullLeiosJobPool jobPool ->
-             -- whole datum in hand: the closure offer is useless now too
-             pruneThisOffer
+              -- 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
@@ -506,7 +507,8 @@ assignPeer env mbCurrentSlot isBig peerId offers acc =
 -- | Request the EB body from this peer
 assignBody ::
   Ord pid =>
-  PeerId pid -> EbHash ->
+  PeerId pid ->
+  EbHash ->
   SlotNo ->
   (LeiosOutstanding pid, Seq LeiosFetchRequest) ->
   (LeiosOutstanding pid, Seq LeiosFetchRequest)
@@ -621,7 +623,10 @@ pickJobs inflightJobs0 jobPool0 budget0 =
 -- 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]
+  LeiosFetchStaticEnv ->
+  LeiosPoint ->
+  NonEmpty (Jobs.LeiosJobId, Jobs.LeiosJob) ->
+  [LeiosFetchRequest]
 batchTxsRequests env point (j0 :| rest0) =
   go j0 [] (jobBytes j0) rest0
  where
@@ -705,9 +710,25 @@ nextLeiosFetchClientCommand ktracer tracer stopSTM kernelVars txCache db systemT
     pending <- StrictSTM.atomically $ LazySTM.flushTQueue responseQ
     forM_ pending $ \case
       PendingBlockResponse req eb ->
-        processLeiosBlock ktracer tracer kernelVars txCache db systemTime pullFromMempool (ReceivedBlockFrom peerId req) eb
+        processLeiosBlock
+          ktracer
+          tracer
+          kernelVars
+          txCache
+          db
+          systemTime
+          pullFromMempool
+          (ReceivedBlockFrom peerId req)
+          eb
       PendingBlockTxsResponse req txs ->
-        processLeiosBlockTxs ktracer tracer kernelVars txCache db systemTime (ReceivedTxsFrom 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).
@@ -884,12 +905,12 @@ processLeiosBlock ktracer tracer (outstandingVar, readyVar) txCache db systemTim
             $ 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
+                    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)
               }
@@ -902,7 +923,8 @@ processLeiosBlock ktracer tracer (outstandingVar, readyVar) txCache db systemTim
       then
         pure
           ( outstandingCleaned
-          , ( (if tooOld then fetchArrivalEvicted else fetchArrivalExtra) $ ebBytesSize'
+          ,
+            ( (if tooOld then fetchArrivalEvicted else fetchArrivalExtra) $ ebBytesSize'
             , Map.empty
             , Map.empty
             )
@@ -1250,11 +1272,12 @@ processLeiosBlockTxs ktracer tracer (outstandingVar, readyVar) txCache db system
     -- it).
     --
     -- No peer accounting, no arrival telemetry.
-    _ <- id $
-        ingestAcquiredTxs
+    _ <-
+      id
+        $ ingestAcquiredTxs
           now
           Applied
-      $ V.toList (V.map fst (leiosEbTxs eb)) `zip` V.toList (V.map cbor txs)
+        $ 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
@@ -1276,7 +1299,8 @@ processLeiosBlockTxs ktracer tracer (outstandingVar, readyVar) txCache db system
         -- 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)
+      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
@@ -1343,7 +1367,8 @@ processLeiosBlockTxs ktracer tracer (outstandingVar, readyVar) txCache db system
   -- 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 ::
+    RelativeTime -> WhetherApplied -> [(TxHash, BS.ByteString)] -> m Leios.FetchArrivalBytes
   ingestAcquiredTxs now applied toIngest =
     traceException tracer TraceLeiosPeerDbException $ do
       completed <- leiosDbInsertTxs db toIngest
@@ -1405,20 +1430,22 @@ recordEbBodyOffer (outstandingVar, readyVar) peerVars offeredClosure (point, ebB
             | 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')
-            }
+              || 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
@@ -1550,15 +1577,15 @@ processAnnouncementCentrally
         shouldRelay
         age
         ancHdr
- where
-  fields = ancAnnouncementFields ancHdr
-  -- 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
+   where
+    fields = ancAnnouncementFields ancHdr
+    -- 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
@@ -1669,20 +1696,21 @@ recordAnnouncedEb (outstandingVar, readyVar) onset (point, ebBytesSize) = do
           | 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
+            || 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')
-              }
+          | 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 ::
diff --git a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs
index 0eca9dd24c..a29d8cba15 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs
@@ -17,12 +17,12 @@
 {-# LANGUAGE TypeApplications #-}
 {-# OPTIONS_GHC -Wno-partial-fields #-}
 
-module LeiosDemoTypes (
-  module LeiosDemoTypes,
+module LeiosDemoTypes
+  ( module LeiosDemoTypes
 
-  -- * Re-exports
-  module Cardano.Crypto.Leios,
-  module TxHashReexports,
+    -- * Re-exports
+  , module Cardano.Crypto.Leios
+  , module TxHashReexports
   ) where
 
 import Cardano.Binary
@@ -63,6 +63,7 @@ import Cardano.Crypto.Util (SignableRepresentation (..))
 import Cardano.Ledger.Core (EraTx, Tx, TxLevel (TopTx))
 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
@@ -93,10 +94,7 @@ import Data.Set (Set)
 import qualified Data.Set as Set
 import Data.Set.NonEmpty (NESet)
 import qualified Data.Set.NonEmpty as NESet
-import LeiosDemoTypes.LeiosJobs as TxHashReexports (TxHash (..), prettyTxHash)
-import qualified LeiosDemoTypes.LeiosJobs as Jobs
 import Data.String (fromString)
-import Cardano.Slotting.Time (RelativeTime)
 import Data.Time.Clock (NominalDiffTime)
 import Data.Vector.Strict (Vector)
 import qualified Data.Vector.Strict as V
@@ -110,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)
@@ -444,9 +444,8 @@ data LeiosOutstanding pid = MkLeiosOutstanding
   -- 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)))
+  , -- Request tracking
+    requestedEbPeers :: !(Map EbHash (Set (PeerId pid)))
   -- ^ Which peers we've requested each EB from
   --
   -- TODO add requestedEbsPerPeer :: !(Map (PeerId pid) (NESet EbHash)) to avoid
@@ -478,13 +477,13 @@ emptyLeiosOutstanding prunedSlot =
     }
 
 -- | 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
+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.
@@ -769,8 +768,8 @@ initializeLeiosOutstanding points immTipSlot =
 -- slot-monotonic (never lower the greatest slot), which both callers are.
 alterEbState ::
   EbHash ->
+  -- | REQUIREMENT: must not reduce 'ebStateMaxSlot'
   (Maybe EbState -> Maybe EbState) ->
-  -- ^ REQUIREMENT: must not reduce 'ebStateMaxSlot'
   LeiosOutstanding pid ->
   LeiosOutstanding pid
 alterEbState ebHash f outstanding =
@@ -782,24 +781,23 @@ alterEbState ebHash f outstanding =
         , 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)
+              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)
+    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).
@@ -917,8 +915,8 @@ demoLeiosFetchStaticEnv =
     { maxRequestedBytesSizePerPeer = 5 * million
     , maxRequestBytesSize = 500 * thousand
     , maxJobBytesSize = 64 * thousandBase2
-    , maxJobTxCount = 20000   -- TODO do we want this to be low enough to matter?
-    , fetchPriorityWindowSlots = 10   -- TODO read dynamically from ledger state
+    , 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 = 5 * 12 * millionBase2
     }
@@ -1426,8 +1424,11 @@ 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
+  , fetchArrivalEvicted
+  , fetchArrivalGood
+  , fetchArrivalExtra ::
+    BytesSize -> FetchArrivalBytes
 fetchArrivalInvalid n = mempty{fabInvalid = n}
 fetchArrivalEvicted n = mempty{fabEvicted = n}
 fetchArrivalGood n = mempty{fabGood = n}
@@ -1632,14 +1633,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
-        ]
+ 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
index 4530cdcf35..4b2e175204 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes/LeiosJobs.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes/LeiosJobs.hs
@@ -58,14 +58,18 @@ newtype JobRootHash = MkJobRootHash ByteString
 
 jobRootHashOfTxHashes :: [TxHash] -> JobRootHash
 jobRootHashOfTxHashes =
-  MkJobRootHash . Hash.hashToBytes . Hash.hashWith @Hash.Blake2b_256 id . BS.concat . map (\(MkTxHash bs) -> bs)
+  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
+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
diff --git a/ouroboros-consensus/src/ouroboros-consensus/LeiosTxCache.hs b/ouroboros-consensus/src/ouroboros-consensus/LeiosTxCache.hs
index 4acfa1df4c..26e926edcd 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/LeiosTxCache.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosTxCache.hs
@@ -100,10 +100,13 @@ newPureLeiosTxCache = do
           pure $! Pure.lookupBody ebh idx
       , withLockedInsertUnappliedTx = \k ->
           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'))
+            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')
diff --git a/ouroboros-consensus/src/ouroboros-consensus/LeiosTxCache/API.hs b/ouroboros-consensus/src/ouroboros-consensus/LeiosTxCache/API.hs
index f4e0993483..2c888dcb7a 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/LeiosTxCache/API.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosTxCache/API.hs
@@ -89,7 +89,8 @@ data LeiosTxCache m a v b = LeiosTxCache
   -- 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 -> BytesSize -> a -> m w) -> m w) -> m FetchArrivalBytes
+      (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
diff --git a/ouroboros-consensus/src/ouroboros-consensus/LeiosTxCache/Optimized.hs b/ouroboros-consensus/src/ouroboros-consensus/LeiosTxCache/Optimized.hs
index c1f5ec95c3..feaf046126 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/LeiosTxCache/Optimized.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosTxCache/Optimized.hs
@@ -333,7 +333,7 @@ decTx ht txh = do
 
 -- | Set a present tx's state tag, preserving its refcount; no-op if absent.
 setTag_ :: PrimMonad m => HT.MutableHashTable (PrimState m) -> Word64 -> TxHash -> m ()
-{-# SPECIALISE setTag_ :: HT.MutableHashTable (PrimState IO) -> Word64 -> TxHash -> IO () #-}
+{-# SPECIALIZE setTag_ :: HT.MutableHashTable (PrimState IO) -> Word64 -> TxHash -> IO () #-}
 setTag_ ht tag txh = do
   let key = toKey txh
   mv <- HT.lookup ht key
@@ -342,8 +342,22 @@ setTag_ ht tag txh = do
     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
-{-# SPECIALISE setTag :: HT.MutableHashTable (PrimState IO) -> Word64 -> FetchArrivalBytes -> TxHash -> BytesSize -> IO 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
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 29812ca7e1..96e63989b5 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Mempool/API.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Mempool/API.hs
@@ -54,6 +54,7 @@ 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
@@ -61,7 +62,6 @@ import Ouroboros.Consensus.Ledger.SupportsMempool
 import qualified Ouroboros.Consensus.Mempool.Capacity as Cap
 import Ouroboros.Consensus.Mempool.TxSeq (TicketNo, zeroTicketNo)
 import Ouroboros.Consensus.Util.IOLike
-import LeiosDemoTypes.LeiosJobs (TxHash)
 import Ouroboros.Network.Protocol.TxSubmission2.Type (SizeInBytes)
 
 {-------------------------------------------------------------------------------
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 b3b87c58a6..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)
@@ -81,7 +82,6 @@ import Data.Word
 import GHC.Generics
 import LeiosDemoDb (LeiosDbConnection)
 import LeiosDemoLogic.Announcements.ElBimap (ElId)
-import qualified Data.ByteString as Strict
 import LeiosDemoTypes
   ( BytesSize
   , EbHash
diff --git a/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic.hs b/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic.hs
index 8663b2ae5d..1d92cb74f0 100644
--- a/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic.hs
+++ b/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic.hs
@@ -318,4 +318,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))
-
diff --git a/ouroboros-consensus/test/consensus-test/Test/LeiosTxCache/Optimized.hs b/ouroboros-consensus/test/consensus-test/Test/LeiosTxCache/Optimized.hs
index a7ef95a666..5f8c4ec959 100644
--- a/ouroboros-consensus/test/consensus-test/Test/LeiosTxCache/Optimized.hs
+++ b/ouroboros-consensus/test/consensus-test/Test/LeiosTxCache/Optimized.hs
@@ -61,9 +61,9 @@ newtype TestBody = TestBody [TxHash]
 
 instance ReferencesTxsByHash TestBody where
   foldTxReferences f z (TestBody hs) =
-      List.foldl' (\acc txh -> f acc txh dummySize) z hs
-    where
-      dummySize = 0
+    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
diff --git a/ouroboros-consensus/test/consensus-test/Test/LeiosTxCache/Reference.hs b/ouroboros-consensus/test/consensus-test/Test/LeiosTxCache/Reference.hs
index dd2d129a49..15cbac1f47 100644
--- a/ouroboros-consensus/test/consensus-test/Test/LeiosTxCache/Reference.hs
+++ b/ouroboros-consensus/test/consensus-test/Test/LeiosTxCache/Reference.hs
@@ -97,9 +97,9 @@ newtype TestBody = TestBody [TxHash]
 
 instance ReferencesTxsByHash TestBody where
   foldTxReferences f z (TestBody hs) =
-      List.foldl' (\acc txh -> f acc txh dummySize) z hs
-    where
-      dummySize = 0
+    List.foldl' (\acc txh -> f acc txh dummySize) z hs
+   where
+    dummySize = 0
 
 empty :: Idx
 empty = emptyLeiosTxCacheIndex

From df7d228a4d74ea8b4d249284039ec4b26b608cae Mon Sep 17 00:00:00 2001
From: Nicolas Frisby <nicolas.frisby@moduscreate.com>
Date: Wed, 26 Aug 2026 11:35:50 -0400
Subject: [PATCH 48/49] LeiosFetch: choose random JobId instead of minimum

---
 .../Ouroboros/Consensus/Node.hs               |  4 +-
 .../Ouroboros/Consensus/NodeKernel.hs         |  7 +-
 .../Test/ThreadNet/Network.hs                 |  4 +-
 .../src/ouroboros-consensus/LeiosDemoLogic.hs | 31 ++++++---
 .../src/ouroboros-consensus/LeiosDemoTypes.hs | 20 ++++--
 .../LeiosDemoTypes/LeiosJobs.hs               | 69 ++++++++++---------
 .../consensus-test/Test/LeiosDemoLogic.hs     |  3 +-
 .../Test/LeiosDemoLogic/Invariants.hs         | 50 +++++++++++---
 8 files changed, 126 insertions(+), 62 deletions(-)

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 78794871aa..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
@@ -295,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 ::
@@ -723,6 +727,7 @@ initInternalState
     , genesisArgs
     , leiosDB
     , leiosTxCache
+    , leiosFetchRng
     } = do
     varGsmState <- do
       let GsmNodeKernelArgs{..} = gsmArgs
@@ -758,7 +763,7 @@ initInternalState
         LeiosDb.withLeiosDb leiosDB $ \leiosConn ->
           LeiosDb.leiosDbScanCompleteEbClosuresNotOlderThanSlot leiosConn immTipSlot
       MVar.newMVar $
-        Leios.initializeLeiosOutstanding acquiredClosures immTipSlot
+        Leios.initializeLeiosOutstanding leiosFetchRng acquiredClosures immTipSlot
     leiosReady <- MVar.newEmptyMVar
     leiosCentralState <- MVar.newMVar Announcements.emptyCentralState
 
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/src/ouroboros-consensus/LeiosDemoLogic.hs b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
index 9f236c9c6e..45f3786a68 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoLogic.hs
@@ -141,6 +141,7 @@ 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.
@@ -560,7 +561,12 @@ assignClosure env isBig peerId ebHash st@(acc, dec) =
           -- 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.
-          (picked, jobPool', exhausted) = pickJobs inflightJobs jobPool (peerBudget env isBig acc peerId)
+          --
+          -- '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 ->
@@ -583,6 +589,7 @@ assignClosure env isBig peerId ebHash st@(acc, dec) =
                             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)
@@ -597,21 +604,25 @@ bodySize acc ebHash = do
 -- | 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.
+-- (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, WhetherPeerEbExhausted)
-pickJobs inflightJobs0 jobPool0 budget0 =
-  go inflightJobs0 jobPool0 budget0 []
+  ([(Jobs.LeiosJobId, Jobs.LeiosJob)], Jobs.LeiosJobPool, StdGen, WhetherPeerEbExhausted)
+pickJobs prng0 inflightJobs0 jobPool0 budget0 =
+  go prng0 inflightJobs0 jobPool0 budget0 []
  where
-  go inflightJobs jobPool budget acc
-    | budget <= 0 = (reverse acc, jobPool, MkWhetherPeerEbExhausted False)
-    | otherwise = case Jobs.pickLeastRequestedJobExcept inflightJobs jobPool of
-        Nothing -> (reverse acc, jobPool, MkWhetherPeerEbExhausted True)
-        Just (jid@(Jobs.MkLeiosJobId i), job@(Jobs.MkLeiosJob _offsets bytes _root), jobPool') ->
+  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)
diff --git a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs
index a29d8cba15..76cbb04655 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs
@@ -123,6 +123,7 @@ 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
@@ -457,14 +458,20 @@ data LeiosOutstanding pid = MkLeiosOutstanding
   , 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.
   }
 
 -- | 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').
-emptyLeiosOutstanding :: SlotNo -> LeiosOutstanding pid
-emptyLeiosOutstanding prunedSlot =
+-- 'acquiredEbBodiesPrunedSlot' / 'pruneOutstandingToImmTip'), and the seed for
+-- the decision loop's PRNG (see 'leiosFetchPrng').
+emptyLeiosOutstanding :: StdGen -> SlotNo -> LeiosOutstanding pid
+emptyLeiosOutstanding prng prunedSlot =
   MkLeiosOutstanding
     { ebState = Map.empty
     , ebsPerMaxAnnouncementSlot = Map.empty
@@ -474,6 +481,7 @@ emptyLeiosOutstanding prunedSlot =
     , requestedEbPeers = Map.empty
     , requestedBytesSizePerPeer = Map.empty
     , requestedJobsPerPeer = Map.empty
+    , leiosFetchPrng = prng
     }
 
 -- | Per-EB state tracked in 'ebState'
@@ -755,9 +763,9 @@ minOnset (SJust a) (SJust b) = SJust (min a b)
 -- /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 :: [LeiosPoint] -> SlotNo -> LeiosOutstanding pid
-initializeLeiosOutstanding points immTipSlot =
-  F.foldl' (flip seed1) (emptyLeiosOutstanding immTipSlot) points
+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
diff --git a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes/LeiosJobs.hs b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes/LeiosJobs.hs
index 4b2e175204..be3ec26af7 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes/LeiosJobs.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes/LeiosJobs.hs
@@ -35,6 +35,7 @@ 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
@@ -156,49 +157,53 @@ restrictToPending m pool = m `IntMap.intersection` jobs pool
 emptyLeiosJobPool :: LeiosJobPool
 emptyLeiosJobPool = MkLeiosJobPool IntMap.empty IntMap.empty
 
--- | 'pickLeastRequestedJobExcept' with no exclusions.
-pickLeastRequestedJob :: LeiosJobPool -> Maybe (LeiosJobId, LeiosJob, LeiosJobPool)
-pickLeastRequestedJob = pickLeastRequestedJobExcept IntSet.empty
-
--- | Select a least-requested unfinished job (fewest in-flight requests; ties by
--- lowest job id) whose id is /not/ in @excluded@, record one more in-flight
--- request for it, and return its id, its bitfield, and the updated pool.
--- 'Nothing' if every unfinished job is excluded (or the pool is 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 ::
-  IntSet -> LeiosJobPool -> Maybe (LeiosJobId, LeiosJob, LeiosJobPool)
-pickLeastRequestedJobExcept excluded pool =
-  case eligible of
+  StdGen -> IntSet -> LeiosJobPool -> Maybe (LeiosJobId, LeiosJob, LeiosJobPool, StdGen)
+pickLeastRequestedJobExcept prng excluded pool =
+  case eligibleBucket of
     Nothing -> Nothing
-    Just (m, jid) ->
-      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))
-                }
-            )
+    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; within a bucket take the lowest
-  -- non-excluded job id. Returns (bucket multiplicity, job id). 'foldrWithKey'
-  -- visits ascending keys and is lazy in the accumulator, so this stops at the
-  -- first eligible bucket without materialising the bucket list.
+  -- 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
-  eligible =
+  eligibleBucket =
     IntMap.foldrWithKey
       ( \m bucket rest ->
-          case fst <$> IntSet.minView (IntSet.difference (NEIntSet.toSet bucket) excluded) of
-            Just jid -> Just (m, jid)
-            Nothing -> rest
+          let diff = IntSet.difference (NEIntSet.toSet bucket) excluded
+           in if IntSet.null diff then rest else Just (m, diff)
       )
       Nothing
       (jobsByMultiplicity pool)
diff --git a/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic.hs b/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic.hs
index 1d92cb74f0..282a1ab46a 100644
--- a/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic.hs
+++ b/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic.hs
@@ -45,6 +45,7 @@ import LeiosDemoTypes
   , mergeOffer
   , recordMaxAnnouncementSlot
   )
+import System.Random (mkStdGen)
 import Test.Tasty (TestTree, testGroup)
 import Test.Tasty.HUnit (assertFailure, testCase, (@?=))
 
@@ -180,7 +181,7 @@ empty =
   Scenario
     { scEnv = demoLeiosFetchStaticEnv
     , scOfferings = Map.empty
-    , scOutstanding = emptyLeiosOutstanding (SlotNo 0)
+    , scOutstanding = emptyLeiosOutstanding (mkStdGen 0) (SlotNo 0)
     }
 
 -- | Outstanding-work combinators -----------------------------------------
diff --git a/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic/Invariants.hs b/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic/Invariants.hs
index 19c56706d6..89f8d93a2a 100644
--- a/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic/Invariants.hs
+++ b/ouroboros-consensus/test/consensus-test/Test/LeiosDemoLogic/Invariants.hs
@@ -93,9 +93,10 @@ 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 (testCase, (@?=))
+import Test.Tasty.HUnit (assertBool, testCase, (@?=))
 import Test.Tasty.QuickCheck (testProperty)
 import Test.Util.Orphans.IOLike ()
 import Test.Util.TestEnv (adjustQuickCheckTests)
@@ -123,7 +124,7 @@ tests =
                 Leios.insertAcquiredEbBody h jobPool $
                   Leios.recordMaxAnnouncementSlot h (SlotNo 3) SNothing $
                     Leios.recordMaxAnnouncementSlot h (SlotNo 5) SNothing $
-                      (emptyLeiosOutstanding (SlotNo 0) :: LeiosOutstanding Int)
+                      (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))
@@ -139,7 +140,7 @@ tests =
               o =
                 Leios.recordMaxAnnouncementSlot h (SlotNo 10) SNothing $
                   Leios.markBodyImminent h (SlotNo 5) $
-                    (emptyLeiosOutstanding (SlotNo 0) :: LeiosOutstanding Int)
+                    (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
@@ -149,7 +150,7 @@ tests =
           let h = hashLeiosEb (ebOf [0, 1])
               t3 = RelativeTime 3
               t5 = RelativeTime 5
-              base = emptyLeiosOutstanding (SlotNo 0) :: LeiosOutstanding Int
+              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)
@@ -178,7 +179,7 @@ tests =
               -- and 8), ebB at slot 6.
               points = [pointOf ebA 5, pointOf ebA 8, pointOf ebB 6]
               immTipSlot = SlotNo 4
-              o = Leios.initializeLeiosOutstanding points immTipSlot :: LeiosOutstanding Int
+              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))
@@ -200,7 +201,7 @@ tests =
           let ebA = [0, 1] :: TestEb
               ebB = [2, 3] :: TestEb
               points = [pointOf ebA 8, pointOf ebB 6]
-              o = Leios.initializeLeiosOutstanding points (SlotNo 4) :: LeiosOutstanding Int
+              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)
@@ -231,7 +232,7 @@ tests =
                       (\o -> o{Leios.requestedBytesSizePerPeer = Map.singleton peerId used}) $
                         Leios.insertAcquiredEbBody h jobPool $
                           Leios.recordMaxAnnouncementSlot h (SlotNo 10) SNothing $
-                            (emptyLeiosOutstanding (SlotNo 0) :: LeiosOutstanding Int)
+                            (emptyLeiosOutstanding (mkStdGen 0) (SlotNo 0) :: LeiosOutstanding Int)
                     (_o, reqs, _d) =
                       leiosFetchLogicIteration
                         demoLeiosFetchStaticEnv
@@ -248,13 +249,42 @@ tests =
           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 (SlotNo 0))
+                (emptyLeiosOutstanding (mkStdGen 0) (SlotNo 0))
                   { Leios.missingEbBodies =
                       Map.fromList [(pointAt 3 hA, 10), (pointAt 10 hA, 10), (pointAt 3 hB, 20)]
                   , Leios.reverseSlotIndexByEbHash =
@@ -366,7 +396,7 @@ runCmdsReFetchViolations cmds = runSimOrThrow (go cmds)
   go cs0 = do
     dbHandle <- LeiosDb.newLeiosDBInMemory
     withLeiosDb dbHandle $ \conn -> do
-      outstandingVar <- newMVar (emptyLeiosOutstanding (SlotNo 0))
+      outstandingVar <- newMVar (emptyLeiosOutstanding (mkStdGen 0) (SlotNo 0))
       readyVar <- newEmptyMVar
       peerVars <- newLeiosPeerVars IsNotBigLedgerPeer
       let kv = (outstandingVar, readyVar)
@@ -725,7 +755,7 @@ raceSameHashMultiSlot :: forall m. IOLike m => m Property
 raceSameHashMultiSlot = do
   dbHandle <- LeiosDb.newLeiosDBInMemory
   withLeiosDb dbHandle $ \conn -> do
-    outstandingVar <- newMVar (emptyLeiosOutstanding (SlotNo 0))
+    outstandingVar <- newMVar (emptyLeiosOutstanding (mkStdGen 0) (SlotNo 0))
     readyVar <- newEmptyMVar
     peerVars <- newLeiosPeerVars IsNotBigLedgerPeer
     txCache <- newPureLeiosTxCache

From 07fae705eb3bc417b5f71fe04f30a73b44b5f14f Mon Sep 17 00:00:00 2001
From: Nicolas Frisby <nicolas.frisby@moduscreate.com>
Date: Fri, 28 Aug 2026 13:15:27 -0400
Subject: [PATCH 49/49] LioesTxCache & Forge: remove unused LANGUAGE pragmas

---
 .../Ouroboros/Consensus/NodeKernel/Forge.hs                     | 1 -
 .../test/consensus-test/Test/LeiosTxCache/Optimized.hs          | 2 --
 .../test/consensus-test/Test/LeiosTxCache/Reference.hs          | 2 --
 3 files changed, 5 deletions(-)

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 8e002e0e17..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 #-}
diff --git a/ouroboros-consensus/test/consensus-test/Test/LeiosTxCache/Optimized.hs b/ouroboros-consensus/test/consensus-test/Test/LeiosTxCache/Optimized.hs
index 5f8c4ec959..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
diff --git a/ouroboros-consensus/test/consensus-test/Test/LeiosTxCache/Reference.hs b/ouroboros-consensus/test/consensus-test/Test/LeiosTxCache/Reference.hs
index 15cbac1f47..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.
 --