Manually handle WAL checkpointing

SQLite's usual approach doesn't seem to always contain the size of the WAL, so
move this logic in to the application and regularly run a checkpoint.

3 files changed, 28 insertions, 0 deletions

diff --git a/guix-build-coordinator/coordinator.scm b/guix-build-coordinator/coordinator.scm
index 9a2dc89..4bda54a 100644
--- a/guix-build-coordinator/coordinator.scm
+++ b/guix-build-coordinator/coordinator.scm
@@ -203,6 +203,9 @@
        (lambda ()
          (run-fibers
           (lambda ()
+            (datastore-spawn-fibers
+             (build-coordinator-datastore build-coordinator))
+
             ;; Start the agent messaging server
             (match (uri-scheme agent-communication-uri)
               ('http
diff --git a/guix-build-coordinator/datastore.scm b/guix-build-coordinator/datastore.scm
index c1ad5ad..77c47ec 100644
--- a/guix-build-coordinator/datastore.scm
+++ b/guix-build-coordinator/datastore.scm
@@ -8,6 +8,7 @@
   #:export (database-uri->datastore
             datastore-find-build-output))
 
+(re-export datastore-spawn-fibers)
 (re-export datastore-update-metrics!)
 (re-export datastore-update)
 (re-export datastore-call-with-transaction)
diff --git a/guix-build-coordinator/datastore/sqlite.scm b/guix-build-coordinator/datastore/sqlite.scm
index b802f84..65dcba9 100644
--- a/guix-build-coordinator/datastore/sqlite.scm
+++ b/guix-build-coordinator/datastore/sqlite.scm
@@ -5,6 +5,7 @@
   #:use-module (ice-9 format)
   #:use-module (ice-9 threads)
   #:use-module (sqlite3)
+  #:use-module (fibers)
   #:use-module (prometheus)
   #:use-module (guix derivations)
   #:use-module (guix-build-coordinator utils)
@@ -12,6 +13,7 @@
   #:use-module (guix-build-coordinator config)
   #:use-module (guix-build-coordinator datastore abstract)
   #:export (sqlite-datastore
+            datastore-spawn-fibers
             datastore-update-metrics!
             datastore-update
             datastore-call-with-transaction
@@ -102,6 +104,7 @@
                (db-open database-file)))
           (sqlite-exec db "PRAGMA journal_mode=WAL;")
           (sqlite-exec db "PRAGMA busy_timeout = 5000;")
+          (sqlite-exec db "PRAGMA wal_autocheckpoint = -1;")
           (list db)))
 
       ;; Use a minimum of 2 and a maximum of 8 threads
@@ -158,6 +161,27 @@
 
     datastore))
 
+(define-method (datastore-spawn-fibers
+                (datastore <sqlite-datastore>))
+  (let* ((checkpoint-duration-metric-name
+          "datastore_wal_checkpoint_duration_seconds")
+         (metrics-registry
+          (slot-ref datastore 'metrics-registry)))
+
+    (spawn-fiber
+     (lambda ()
+       (while #t
+         (sleep (* 60 15))              ; 15 minutes
+         (call-with-worker-thread
+          (slot-ref datastore 'worker-writer-thread-channel)
+          (lambda (db)
+            (call-with-duration-metric
+             metrics-registry
+             checkpoint-duration-metric-name
+             (lambda ()
+               (sqlite-exec db "PRAGMA wal_checkpoint(RESTART);")))))))
+     #:parallel? #t)))
+
 (define-method (datastore-update-metrics!
                 (datastore <sqlite-datastore>))
   (let* ((db-filename