Try much harder to truncate the WAL

I think when there are lots of long reads taking place, that can prevent
checkpointing and truncating the WAL, so allow waiting for much longer if this
seems to be the case.

1 files changed, 30 insertions, 19 deletions

diff --git a/guix-build-coordinator/datastore/sqlite.scm b/guix-build-coordinator/datastore/sqlite.scm
index e8d9f2a..b82cf74 100644
--- a/guix-build-coordinator/datastore/sqlite.scm
+++ b/guix-build-coordinator/datastore/sqlite.scm
@@ -246,6 +246,9 @@
   (define wal-size-threshold
     (* 5 MiB))
 
+  (define extreme-wal-size-threshold
+    (* 15 MiB))
+
   (and
    (let ((checkpoint-duration-metric-name
           "datastore_wal_checkpoint_duration_seconds"))
@@ -256,25 +259,33 @@
           metrics-registry
           checkpoint-duration-metric-name
           (lambda ()
-            (let ((statement
-                   (sqlite-prepare
-                    db
-                    "PRAGMA wal_checkpoint(TRUNCATE);")))
-              (match (sqlite-step-and-finalize statement)
-                (#(blocked? modified-page-count pages-moved-to-db)
-                 (if (= blocked? 1)
-                     (begin
-                       (simple-format
-                        (current-error-port)
-                        "warning: wal checkpoint blocked\n")
-                       #f)
-                     (begin
-                       (simple-format
-                        (current-error-port)
-                        "wal checkpoint completed (~A, ~A)\n"
-                        modified-page-count
-                        pages-moved-to-db)
-                       #t)))))))
+            (when (> (wal-size) extreme-wal-size-threshold)
+              ;; Since the WAL is really getting too big, wait for much longer
+              (sqlite-exec db "PRAGMA busy_timeout = 120000;"))
+
+            (let* ((statement
+                    (sqlite-prepare
+                     db
+                     "PRAGMA wal_checkpoint(TRUNCATE);"))
+                   (result
+                    (match (sqlite-step-and-finalize statement)
+                      (#(blocked? modified-page-count pages-moved-to-db)
+                       (if (= blocked? 1)
+                           (begin
+                             (simple-format
+                              (current-error-port)
+                              "warning: wal checkpoint blocked\n")
+                             #f)
+                           (begin
+                             (simple-format
+                              (current-error-port)
+                              "wal checkpoint completed (~A, ~A)\n"
+                              modified-page-count
+                              pages-moved-to-db)
+                             #t))))))
+              (sqlite-exec db "PRAGMA busy_timeout = 5000;")
+
+              result)))
          #t))
 
    (call-with-duration-metric