From 8a773f9acae00d3973bd738a26033ca4dab1584d Mon Sep 17 00:00:00 2001 From: Sebastian Nagel Date: Wed, 26 Aug 2026 23:46:27 +0200 Subject: [PATCH 1/3] LeiosDb: fix the page_size pragma, and render TraceLeiosDb totally 'page_size' was set after 'journal_mode = WAL', and SQLite cannot change the page size of a database already in WAL mode -- so the 32768 was a silent no-op and every run so far used the 4096 default. Reordered, and pinned at 4096 rather than restored to 32768: measured with the larger page actually in effect, a devnet run reached 35x WAL amplification (34 GiB of log for 0.97 GiB of data) against ~18x for the same workload at 4096. The WAL is a page-level redo log, so a commit rewrites each dirtied page whole, and both hot indexes are keyed by hash, so writes scatter -- the page count barely falls as the page grows, the bytes just multiply. Also spells out 'wal_autocheckpoint = 1000'. It is SQLite's own default, so this changes nothing, but it is the thing that actually keeps the log bounded and it is worth having somewhere a reader can find it. Separately, hardening rather than a fix: 'traceLeiosKernelToObject' matched the inner 'TraceLeiosDb' constructors itself, so a new one would be a runtime "Non-exhaustive patterns" while rendering -- which surfaces only as an "Error rendering trace message" line and drops the event. Delegating to a total 'jsonLeiosDb' makes that a compile error instead. --- .../ouroboros-consensus/LeiosDemoDb/SQLite.hs | 20 ++++++++++++++++--- .../src/ouroboros-consensus/LeiosDemoTypes.hs | 17 ++++++++++------ 2 files changed, 28 insertions(+), 9 deletions(-) diff --git a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoDb/SQLite.hs b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoDb/SQLite.hs index d0be25ff9e..b117c616d9 100644 --- a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoDb/SQLite.hs +++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoDb/SQLite.hs @@ -193,10 +193,24 @@ openSQLiteConnection tracer dbPath notificationChan = do shouldInitSchema <- not <$> doesFileExist dbPath db <- open2 (fromString dbPath) [SQLOpenReadWrite, SQLOpenCreate] SQLVFSDefault traverse_ (dbExec db) $ - [ "pragma journal_mode = WAL;" - , "pragma synchronous = normal;" - , "pragma page_size = 32768;" + [ "pragma synchronous = normal;" + , -- Must precede 'journal_mode': SQLite cannot change the page size of a + -- database already in WAL mode, so the order this list used to have left + -- the setting a silent no-op and every run so far on the 4096 default. + -- Which is where it belongs anyway. Measured: a devnet run with 32768 + -- actually in effect reached 35x WAL amplification (34 GiB of log for 0.97 + -- GiB of data) against ~18x for the same workload at 4096. The WAL is a + -- page-level redo log, so a commit rewrites each dirtied page whole, and + -- both hot indexes are keyed by hash, so writes scatter -- the page count + -- barely falls as the page grows, the bytes just multiply. + "pragma page_size = 4096;" , "pragma mmap_size = 268435500;" + , "pragma journal_mode = WAL;" + , -- SQLite's own default, spelled out because it is what keeps the log + -- bounded: passive checkpoints reset the WAL every 1000 frames, provided + -- no connection is sitting on a stale read snapshot. One that is will + -- freeze back-fill indefinitely; see 'dbWithWriteTransaction'. + "pragma wal_autocheckpoint = 1000;" ] when shouldInitSchema $ dbExec db (fromString sql_schema) diff --git a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs index b2d88e8dcb..547391e076 100644 --- a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs +++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs @@ -1492,6 +1492,16 @@ data LeiosNotVotedReason deriving instance Show TraceLeiosKernel +-- | Render a 'TraceLeiosDb'. +jsonLeiosDb :: TraceLeiosDb -> Aeson.Object +jsonLeiosDb = \case + TraceLeiosDbInsertCollision table key -> + mconcat + [ "kind" .= Aeson.String "LeiosDbInsertCollision" + , "table" .= table + , "key" .= key + ] + traceLeiosKernelToObject :: TraceLeiosKernel -> Aeson.Object traceLeiosKernelToObject = \case TraceLeiosFetchBodyArrival fab -> @@ -1652,12 +1662,7 @@ traceLeiosKernelToObject = \case ] TraceLeiosDbException e -> jsonLeiosDbException e - TraceLeiosDb (TraceLeiosDbInsertCollision table key) -> - mconcat - [ "kind" .= Aeson.String "LeiosDbInsertCollision" - , "table" .= table - , "key" .= key - ] + TraceLeiosDb ev -> jsonLeiosDb ev TraceLeiosCertifiedAndAnnounced slotNo rbHash -> mconcat [ "kind" .= Aeson.String "LeiosCertifiedAndAnnounced" From 372f03ee17e1cd5c967f9928495d019b60cf01e9 Mon Sep 17 00:00:00 2001 From: Sebastian Nagel Date: Thu, 27 Aug 2026 21:52:03 +0200 Subject: [PATCH 2/3] LeiosDb: let SQLite do the waiting, and never give up on it No 'busy_timeout' was set, so SQLite refused a contended lock immediately and every wait happened in an application loop whose Nth sleep was 100us * N -- cumulative 100us * N(N+1)/2. The EB-body insert distribution matched that curve exactly: median 1 599 ms (N~178), max 18 435 ms (N~607), for 90 ms of actual work. By attempt 300 a single sleep was 30 ms, so the writer slept through most of the window it was waiting for, and steady contention became seconds of latency. 'busy_timeout = 1000' now does the waiting in C, retrying tightly instead of sleeping through the gap. That is safe here precisely because writers take the lock at BEGIN and hold no snapshot while they wait. Waiting for the write lock is unbounded. Giving up means throwing, and a throw on this path kills the Leios threads: at a three-attempt ceiling a lock held for three seconds took a devnet node down, and losing one of three block producers stopped certification for the rest of the run. Nothing is held while waiting, so the cost of waiting is latency and the cost of not waiting is the node. Past 'busyStuckAfter' attempts -- about half a minute of no progress -- it reports 'TraceLeiosDbBusyStuck' at Critical severity and keeps waiting. Statements retried inside an open transaction stay bounded by 'maxBusyRetries', since a transaction that waits there does hold its snapshot, which is what pins the WAL and starves back-fill. 'TraceLeiosDbBusyRetry' reports the ordinary case, with attempt number and accumulated wait. Note it is a floor on contention rather than a measure of it: an attempt that waits inside the C handler and then succeeds is not traced. --- .../ouroboros-consensus/LeiosDemoDb/SQLite.hs | 125 ++++++++++++++---- .../ouroboros-consensus/LeiosDemoDb/Trace.hs | 15 +++ .../src/ouroboros-consensus/LeiosDemoTypes.hs | 12 ++ 3 files changed, 124 insertions(+), 28 deletions(-) diff --git a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoDb/SQLite.hs b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoDb/SQLite.hs index b117c616d9..8b65cf264e 100644 --- a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoDb/SQLite.hs +++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoDb/SQLite.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE BangPatterns #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedRecordDot #-} @@ -44,6 +45,7 @@ import Database.SQLite3 , open2 ) import qualified Database.SQLite3.Direct as DB +import GHC.Clock (getMonotonicTime) import GHC.Stack (HasCallStack) import qualified GHC.Stack import LeiosDemoDb.Common @@ -136,6 +138,8 @@ data Stmts = Stmts data Conn = Conn { connDb :: !DB.Database , connStmts :: !Stmts + , connTracer :: !(Tracer IO TraceLeiosDb) + -- ^ So the write path can report exhausting SQLite's own busy timeout. } -- | Prepare every statement 'Stmts' names. Order is not observable. @@ -193,7 +197,17 @@ openSQLiteConnection tracer dbPath notificationChan = do shouldInitSchema <- not <$> doesFileExist dbPath db <- open2 (fromString dbPath) [SQLOpenReadWrite, SQLOpenCreate] SQLVFSDefault traverse_ (dbExec db) $ - [ "pragma synchronous = normal;" + [ -- First, before any pragma that takes a lock -- 'journal_mode' does. Until + -- this runs the timeout is zero, so a contended lock is refused outright + -- rather than waited for, and opening a second connection to a busy + -- database fails where it should merely be slow. + -- + -- Let SQLite do that waiting in C, retrying tightly rather than sleeping + -- through the window it is waiting for. Safe because writers take the lock + -- at BEGIN, so nothing waits here holding a snapshot; see + -- 'dbWithWriteTransaction'. + "pragma busy_timeout = 1000;" + , "pragma synchronous = normal;" , -- Must precede 'journal_mode': SQLite cannot change the page size of a -- database already in WAL mode, so the order this list used to have left -- the setting a silent no-op and every run so far on the 4096 default. @@ -215,7 +229,7 @@ openSQLiteConnection tracer dbPath notificationChan = do when shouldInitSchema $ dbExec db (fromString sql_schema) stmts <- prepareStmts db - let conn = Conn{connDb = db, connStmts = stmts} + let conn = Conn{connDb = db, connStmts = stmts, connTracer = tracer} notify = atomically . writeTChan notificationChan pure $ LeiosDbConnection @@ -277,13 +291,13 @@ sqlLookupEbBody conn ebHash = sqlInsertEbPoint :: Conn -> LeiosPoint -> BytesSize -> IO () sqlInsertEbPoint conn point ebBytesSize = - dbWithWriteTransaction db $ useStmt stmt $ do + dbWithWriteTransaction conn $ useStmt stmt $ do dbBindInt64 stmt 1 (fromIntegral $ unSlotNo point.pointSlotNo) dbBindBlob stmt 2 point.pointEbHash.ebHashBytes dbBindInt64 stmt 3 (fromIntegral ebBytesSize) dbStep1 stmt where - Conn{connDb = db, connStmts = Stmts{stInsertEbPoint = stmt}} = conn + Conn{connStmts = Stmts{stInsertEbPoint = stmt}} = conn -- | Persist an EB body. The point MUST already be present (inserted -- via 'sqlInsertEbPoint' on the announcement path). @@ -297,7 +311,7 @@ sqlInsertEbBody :: sqlInsertEbBody tracer conn notify point eb = do when (null items) $ error "leiosDbInsertEbBody: empty EB body (programmer error)" - completedNow <- dbWithWriteTransaction db $ do + completedNow <- dbWithWriteTransaction conn $ do forM_ items $ \(txOffset, txHash, txBytesSize) -> useStmt stInsertEbTxsRow $ do dbBindBlob stInsertEbTxsRow 1 point.pointEbHash.ebHashBytes dbBindInt64 stInsertEbTxsRow 2 (fromIntegral txOffset) @@ -330,7 +344,7 @@ sqlInsertEbBody tracer conn notify point eb = do where items = leiosEbBodyItems eb ebBytesSize = leiosEbBytesSize eb - Conn{connDb = db, connStmts} = conn + Conn{connStmts} = conn Stmts { stInsertEbTxsRow , stInitMissingCount @@ -363,7 +377,7 @@ sqlInsertTxs _tracer conn notify txs = do -- hashes; attempting the INSERT and catching a constraint violation -- still pays the bind + PK-lookup + reset cost per row. missing <- Set.fromList <$> sqlFilterMissingTxs conn (map fst txs) - completed <- dbWithWriteTransaction db $ do + completed <- dbWithWriteTransaction conn $ do -- 'dbStepInsert' still handles the rare race where a concurrent -- writer inserted the same hash between the filter above and the -- INSERT below. @@ -395,7 +409,7 @@ sqlInsertTxs _tracer conn notify txs = do forM_ completed $ \point -> notify (AcquiredEbTxs point) pure completed where - Conn{connDb = db, connStmts} = conn + Conn{connStmts} = conn Stmts{stInsertTx, stDecrMissingCount, stFindCompleteEbs, stMarkNotifiedEbs} = connStmts novel missing = filter (\(h, _) -> h `Set.member` missing) txs @@ -684,8 +698,56 @@ dbWithTransaction = dbWithTransactionAs "BEGIN" -- transaction's snapshot is stale for good: the only remedy is to roll back and -- start over. Taking the lock at BEGIN removes the upgrade, so contention -- surfaces here instead, where waiting actually resolves it. -dbWithWriteTransaction :: HasCallStack => DB.Database -> IO a -> IO a -dbWithWriteTransaction = dbWithTransactionAs "BEGIN IMMEDIATE" +dbWithWriteTransaction :: HasCallStack => Conn -> IO a -> IO a +dbWithWriteTransaction conn k = getMonotonicTime >>= go 0 + where + Conn{connDb = db, connTracer = tracer} = conn + + -- After this many refusals, a write transaction is no longer merely + -- contended. + -- + -- This picks which constructor gets traced and nothing else. Crossing it does + -- not change how long we wait, does not throw, and does not abandon anything + -- -- 'dbWithWriteTransaction' retries forever either way. It exists only so + -- that the severity in the log matches the severity of the situation. + -- + -- Each attempt is a full 'busy_timeout', so this is about half a minute of one + -- writer making no progress, re-traced every half minute it stays that way. + busyStuckAfter = 30 + + go !attempt t0 = + fmap (first fst) (DB.exec db (fromString "BEGIN IMMEDIATE")) >>= \case + Left DB.ErrorBusy -> do + -- Unbounded, deliberately. Nothing is held while waiting here -- that is + -- the whole point of taking the lock at BEGIN -- so waiting costs + -- latency and nothing else, whereas giving up throws, and a throw on + -- this path kills the Leios threads outright. Past + -- 'busyStuckAfter' attempts that is no longer ordinary contention, so + -- say so at a severity someone will notice, and keep waiting. + -- + -- The wait is measured, not accumulated: most of it happens inside + -- SQLite's own busy handler, so summing the sleeps below would report a + -- fraction of the truth and disagree with the log timestamps. + now <- getMonotonicTime + let n = attempt + 1 + waitedMs = 1000 * (now - t0) + traceWith tracer $ + if n >= busyStuckAfter && n `mod` busyStuckAfter == 0 + then TraceLeiosDbBusyStuck n waitedMs + else TraceLeiosDbBusyRetry n waitedMs + busyBackoff + go n t0 + Left e -> throwDbException db e + Right () -> + fmap fst $ + generalBracket + (pure ()) + ( \() -> \case + MonadThrow.ExitCaseSuccess _ -> dbExec db (fromString "COMMIT") + MonadThrow.ExitCaseException _ -> dbExec db (fromString "ROLLBACK") + MonadThrow.ExitCaseAbort -> dbExec db (fromString "ROLLBACK") + ) + (\() -> k) dbWithTransactionAs :: HasCallStack => String -> DB.Database -> IO a -> IO a dbWithTransactionAs begin db k = @@ -720,10 +782,7 @@ dbStepInsert stmt = go n io = io >>= \case Left DB.ErrorBusy -> do - let retryNum = maxBusyRetries - n - baseDelay = 100 - jitter <- (`mod` baseDelay) <$> randomIO - threadDelay (baseDelay * retryNum + jitter) + busyBackoff go (n - 1) io Left DB.ErrorConstraint -> pure False Left e -> DB.getStatementDatabase stmt >>= \db -> throwDbException db e @@ -753,15 +812,31 @@ dbStepInsertOrTrace tracer table key stmt = do -- ** Error "handling" --- | How many times a busy operation is re-attempted before it throws. +-- | How many times a busy statement is re-attempted /after/ SQLite's own +-- 'busy_timeout' has already expired on that attempt, before it throws. -- --- The backoff below grows linearly, so the total wait grows with the square of --- this: at 10000 it was about 83 minutes, which is indistinguishable from --- hanging. 1000 gives roughly 50 s in total with a longest single sleep near --- 100 ms, which outlasts any transient contention while still surfacing a real --- deadlock inside a minute. +-- Exhausting these throws 'LeiosDbException', which no caller catches: it leaves +-- the Leios thread it was raised in, and the node dies. That is the intent. +-- Unlike 'dbWithWriteTransaction', these retries happen /inside/ an open +-- transaction, so waiting is not free -- the transaction holds its snapshot +-- throughout, and a connection that sits on a stale snapshot indefinitely is +-- exactly what pins the WAL and stops back-fill. Half a minute of a statement +-- refusing inside a transaction is not contention, it is a deadlock, and dying +-- is better than silently wedging the log. +-- +-- With 'busy_timeout' doing the real waiting, each attempt costs about a +-- timeout, so the ceiling is linear -- roughly 30 s -- rather than the quadratic +-- 83 minutes the escalating sleep used to reach at the old value of 10000. maxBusyRetries :: Int -maxBusyRetries = 1000 +maxBusyRetries = 30 + +-- | A short fixed pause between attempts. +-- +-- Deliberately not escalating. +busyBackoff :: IO () +busyBackoff = do + jitter <- (`mod` 5000) <$> randomIO + threadDelay (20000 + jitter) -- | Execute a database action that may return an error. If the error is -- 'DB.ErrorBusy', retry up to 'maxBusyRetries' times with linear backoff and @@ -776,14 +851,8 @@ withDie db = go maxBusyRetries Right x -> pure x go n io = io >>= \case - -- TODO: Expose and use sqlite3_busy_timeout instead Left DB.ErrorBusy -> do - -- Linear backoff with jitter: base delay increases each retry, plus - -- random jitter up to the base delay, with a 0.1ms floor. - let retryNum = maxBusyRetries - n - baseDelay = 100 - jitter <- (`mod` baseDelay) <$> randomIO - threadDelay (baseDelay * retryNum + jitter) + busyBackoff go (n - 1) io Left e -> throwDbException db e Right x -> pure x diff --git a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoDb/Trace.hs b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoDb/Trace.hs index ae399ed925..865e017278 100644 --- a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoDb/Trace.hs +++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoDb/Trace.hs @@ -5,4 +5,19 @@ data TraceLeiosDb -- offending row was silently ignored. Fields: table name, then a -- human-readable description of the colliding key. TraceLeiosDbInsertCollision String String + | -- | A write transaction could not take the write lock within SQLite's own + -- 'busy_timeout' and is being re-attempted. Fields: attempt number, and the + -- total milliseconds waited so far. + -- + -- Should be rare: the C-level handler already waited a full timeout, so this + -- means the lock was held for longer than that. A steady stream of these is + -- the signal that the write path is saturated. + TraceLeiosDbBusyRetry Int Double + | -- | A write transaction has been waiting far longer than contention + -- explains. Fields as for 'TraceLeiosDbBusyRetry'. + -- + -- Repeated, not terminal: the wait is unbounded by design, since giving up + -- means throwing, and throwing here kills the Leios threads. A node that is + -- merely slow should stay a node that is merely slow. + TraceLeiosDbBusyStuck Int Double deriving Show diff --git a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs index 547391e076..e3e1a07e4c 100644 --- a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs +++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoTypes.hs @@ -1501,6 +1501,18 @@ jsonLeiosDb = \case , "table" .= table , "key" .= key ] + TraceLeiosDbBusyRetry attempt waitedMs -> + mconcat + [ "kind" .= Aeson.String "LeiosDbBusyRetry" + , "attempt" .= attempt + , "waitedMs" .= waitedMs + ] + TraceLeiosDbBusyStuck attempt waitedMs -> + mconcat + [ "kind" .= Aeson.String "LeiosDbBusyStuck" + , "attempt" .= attempt + , "waitedMs" .= waitedMs + ] traceLeiosKernelToObject :: TraceLeiosKernel -> Aeson.Object traceLeiosKernelToObject = \case From 2a18f2567551d30b919ecf8274d721b388ed6826 Mon Sep 17 00:00:00 2001 From: Sebastian Nagel Date: Thu, 27 Aug 2026 23:29:16 +0200 Subject: [PATCH 3/3] LeiosDb: index the txs an EB is waiting for, not every tx it mentions 'idx_ebTxs_txHashBytes' existed for one query: decrementing 'missingTxCount' for the EBs referencing a tx that just arrived. It covered every (EB, tx) pair ever seen -- 4.99M entries for 1.07M distinct hashes, each stored 4.7 times on average and up to 43 -- and it was almost the entire write cost of the database. Measured on a 4M-row table, one 13568-row EB body insert generated 61.0 MiB of WAL with that index and 1.8 MiB without: 4.5 KiB of log per 70-byte row, because each random-hash insertion dirties its own page while the PK's insertions land adjacent. It was also 60% of the on-disk size, and the reason a body ingest that should take 90ms was taking seconds once the index outgrew the page cache. But an arriving tx can only complete EBs that were still /waiting/ for it. EBs that already held it counted it as present when their body landed, so indexing them is dead weight. That set is small by construction, and in a devnet where closures overlap completely it is empty. So the resolution between ebs and txs is now two tables. 'ebTxs' keeps the ordered body -- serving stays a PK range scan plus a join, unchanged -- and a new 'ebsMissingTxs' holds only the pairs an EB still lacks, populated by one anti-join when the body is inserted and retired as the txs arrive. Both sides move in the same transaction, so an arrival can never see the rows without the count or the reverse. The decrement reads the small table; its cost is proportional to outstanding work rather than to history, and it shrinks as work completes where the index only ever grew. Measured with the full new logic at the same scale: 1.8 MiB of WAL per EB with nothing missing, 3.2 MiB with 2% missing, against 61.0 MiB before. Semantics verified against the notified sentinel, re-inserted txs, and the all-present body. Note this changes the schema with no migration, so an existing database is not readable by this version. Still open: pruning. Neither table is pruned today, so an EB that never completes retains its waiting rows; it wants the same age-based rule as the rest, applied to both tables together, and 'idx_ebsMissingTxs_ebHashBytes' is there to support it. --- .../ouroboros-consensus/LeiosDemoDb/SQLite.hs | 76 ++++++++++++++++--- 1 file changed, 66 insertions(+), 10 deletions(-) diff --git a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoDb/SQLite.hs b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoDb/SQLite.hs index 8b65cf264e..a0820a6aab 100644 --- a/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoDb/SQLite.hs +++ b/ouroboros-consensus/src/ouroboros-consensus/LeiosDemoDb/SQLite.hs @@ -126,6 +126,8 @@ data Stmts = Stmts , stInitMissingCount :: !DB.Statement , stInsertTx :: !DB.Statement , stDecrMissingCount :: !DB.Statement + , stInsertMissingTxs :: !DB.Statement + , stDeleteMissingTxs :: !DB.Statement , stFindCompleteEbs :: !DB.Statement , stMarkNotifiedEbs :: !DB.Statement , stMarkPointNotified :: !DB.Statement @@ -152,6 +154,8 @@ prepareStmts db = do stInitMissingCount <- dbPrepare db (fromString sql_init_missing_tx_count) stInsertTx <- dbPrepare db (fromString sql_insert_tx) stDecrMissingCount <- dbPrepare db (fromString sql_decrement_missing_tx_count) + stInsertMissingTxs <- dbPrepare db (fromString sql_insert_missing_txs) + stDeleteMissingTxs <- dbPrepare db (fromString sql_delete_missing_txs) stFindCompleteEbs <- dbPrepare db (fromString sql_find_complete_ebs) stMarkNotifiedEbs <- dbPrepare db (fromString sql_mark_notified_ebs) stMarkPointNotified <- dbPrepare db (fromString sql_mark_point_notified) @@ -172,6 +176,8 @@ finalizeStmts Stmts{..} = do dbFinalize stInitMissingCount dbFinalize stInsertTx dbFinalize stDecrMissingCount + dbFinalize stInsertMissingTxs + dbFinalize stDeleteMissingTxs dbFinalize stFindCompleteEbs dbFinalize stMarkNotifiedEbs dbFinalize stMarkPointNotified @@ -322,6 +328,12 @@ sqlInsertEbBody tracer conn notify point eb = do "ebTxs" (show point.pointEbHash <> "@" <> show txOffset) stInsertEbTxsRow + -- Record which of this body's txs we still lack, then count them. Both in + -- this transaction, so an arrival can never see the rows without the count + -- or the other way round. + useStmt stInsertMissingTxs $ do + dbBindBlob stInsertMissingTxs 1 point.pointEbHash.ebHashBytes + dbStep1 stInsertMissingTxs -- Initialize missingTxCount and read the resulting value via -- @RETURNING missingTxCount@. Only /this/ point's row can have -- transitioned to 0 as a consequence of the insert above. @@ -347,6 +359,7 @@ sqlInsertEbBody tracer conn notify point eb = do Conn{connStmts} = conn Stmts { stInsertEbTxsRow + , stInsertMissingTxs , stInitMissingCount , stMarkPointNotified } = connStmts @@ -389,9 +402,14 @@ sqlInsertTxs _tracer conn notify txs = do dbBindBlob stInsertTx 2 txBytes dbBindInt64 stInsertTx 3 txBytesSize dbStepInsert stInsertTx - when inserted $ useStmt stDecrMissingCount $ do - dbBindBlob stDecrMissingCount 1 txHashBytes - dbStep1 stDecrMissingCount + when inserted $ do + useStmt stDecrMissingCount $ do + dbBindBlob stDecrMissingCount 1 txHashBytes + dbStep1 stDecrMissingCount + -- Strictly after the decrement, which reads these rows. + useStmt stDeleteMissingTxs $ do + dbBindBlob stDeleteMissingTxs 1 txHashBytes + dbStep1 stDeleteMissingTxs -- Find newly-complete EBs (missingTxCount reached 0) completed <- useStmt stFindCompleteEbs $ do let loop acc = @@ -410,7 +428,13 @@ sqlInsertTxs _tracer conn notify txs = do pure completed where Conn{connStmts} = conn - Stmts{stInsertTx, stDecrMissingCount, stFindCompleteEbs, stMarkNotifiedEbs} = connStmts + Stmts + { stInsertTx + , stDecrMissingCount + , stDeleteMissingTxs + , stFindCompleteEbs + , stMarkNotifiedEbs + } = connStmts novel missing = filter (\(h, _) -> h `Set.member` missing) txs -- | Retrieve tx bytes for a batch of @(ebHash, txOffset)@ points. Passes @@ -527,7 +551,12 @@ sql_schema = , " txBytesSize INTEGER NOT NULL," , " PRIMARY KEY (ebHashBytes, txOffset)" , ");" - , "CREATE INDEX idx_ebTxs_txHashBytes ON ebTxs(txHashBytes);" + , "CREATE TABLE ebsMissingTxs (" + , " txHashBytes BLOB NOT NULL," + , " ebHashBytes BLOB NOT NULL," + , " PRIMARY KEY (txHashBytes, ebHashBytes)" + , ");" + , "CREATE INDEX idx_ebsMissingTxs_ebHashBytes ON ebsMissingTxs(ebHashBytes);" , "CREATE TABLE txs (" , " txHashBytes BLOB NOT NULL PRIMARY KEY," , " txBytes BLOB NOT NULL," @@ -602,12 +631,41 @@ sql_mark_notified_ebs :: String sql_mark_notified_ebs = "UPDATE ebs SET missingTxCount = -1 WHERE missingTxCount = 0" --- | Decrement missingTxCount for all EBs referencing the given txHash. +-- | Decrement missingTxCount for every EB still /waiting/ on the given txHash. +-- +-- Uses 'ebsMissingTxs' rather than 'ebTxs', which makes this more efficient +-- than a full scan of 'ebTxs' in the average case. +-- +-- Must be paired with 'sql_delete_missing_txs' in the same transaction. +-- -- Parameter 1: txHashBytes sql_decrement_missing_tx_count :: String sql_decrement_missing_tx_count = "UPDATE ebs SET missingTxCount = missingTxCount - 1\n\ - \WHERE ebHashBytes IN (SELECT ebHashBytes FROM ebTxs WHERE txHashBytes = ?)\n\ + \WHERE ebHashBytes IN (SELECT ebHashBytes FROM ebsMissingTxs WHERE txHashBytes = ?)\n\ + \" + +-- | Retire the waiting rows for a tx that has just landed. +-- Parameter 1: txHashBytes +sql_delete_missing_txs :: String +sql_delete_missing_txs = + "DELETE FROM ebsMissingTxs WHERE txHashBytes = ?" + +-- | Record which of a freshly-inserted body's txs we do not yet hold. +-- +-- One anti-join over the EB's own 'ebTxs' range -- the same work +-- 'sql_init_missing_tx_count' used to do to produce a count, now materialised so +-- that the arrival side reads the rows instead of recomputing them. Paying it +-- here rather than on every tx arrival is what earns the index removal: this +-- runs once per body, against ~4.7 times per tx for the old reverse lookup. +-- +-- Parameter 1: ebHashBytes +sql_insert_missing_txs :: String +sql_insert_missing_txs = + "INSERT OR IGNORE INTO ebsMissingTxs (txHashBytes, ebHashBytes)\n\ + \SELECT e.txHashBytes, e.ebHashBytes FROM ebTxs e\n\ + \LEFT JOIN txs t ON e.txHashBytes = t.txHashBytes\n\ + \WHERE e.ebHashBytes = ? AND t.txHashBytes IS NULL\n\ \" -- | Initialize missingTxCount after EB body is inserted, returning the @@ -621,9 +679,7 @@ sql_decrement_missing_tx_count = sql_init_missing_tx_count :: String sql_init_missing_tx_count = "UPDATE ebs SET missingTxCount = (\n\ - \ SELECT COUNT(*) FROM ebTxs e\n\ - \ LEFT JOIN txs t ON e.txHashBytes = t.txHashBytes\n\ - \ WHERE e.ebHashBytes = ? AND t.txHashBytes IS NULL\n\ + \ SELECT COUNT(*) FROM ebsMissingTxs WHERE ebHashBytes = ?\n\ \) WHERE ebHashBytes = ? AND ebSlot = ?\n\ \RETURNING missingTxCount\n\ \"