Make some SQLite related improvements

Don't keep database connections around forever as this relates to cached query
plans, and also run the optimize pragma when closing connections.

4 files changed, 72 insertions, 38 deletions

diff --git a/guix-build-coordinator/coordinator.scm b/guix-build-coordinator/coordinator.scm
index 9c4fc09..7841502 100644
--- a/guix-build-coordinator/coordinator.scm
+++ b/guix-build-coordinator/coordinator.scm
@@ -483,7 +483,9 @@
                      (allocate-builds build-coordinator))
                    (metric-increment success-counter-metric))
                  (lambda (key . args)
-                   (backtrace))))
+                   (backtrace)))
+               (datastore-optimize
+                (build-coordinator-datastore build-coordinator)))
              #:unwind? #t))
          #:buckets ((@@ (prometheus) exponential-histogram-buckets) ; TODO
                     #:start 1
diff --git a/guix-build-coordinator/datastore.scm b/guix-build-coordinator/datastore.scm
index 0f072ac..613de36 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-optimize)
 (re-export datastore-spawn-fibers)
 (re-export datastore-initialise-metrics!)
 (re-export datastore-update-metrics!)
diff --git a/guix-build-coordinator/datastore/sqlite.scm b/guix-build-coordinator/datastore/sqlite.scm
index 6cdfc6b..0bcde1e 100644
--- a/guix-build-coordinator/datastore/sqlite.scm
+++ b/guix-build-coordinator/datastore/sqlite.scm
@@ -15,6 +15,7 @@
   #:use-module (guix-build-coordinator config)
   #:use-module (guix-build-coordinator datastore abstract)
   #:export (sqlite-datastore
+            datastore-optimize
             datastore-spawn-fibers
             datastore-initialise-metrics!
             datastore-update-metrics!
@@ -128,6 +129,14 @@
                (db-open database-file #:write? #f)))
           (sqlite-exec db "PRAGMA busy_timeout = 5000;")
           (list db)))
+      #:destructor
+      (let ((reader-thread-destructor-counter
+             (make-gauge-metric metrics-registry
+                                "datastore_reader_thread_close_total")))
+        (lambda (db)
+          (metric-increment reader-thread-destructor-counter)
+          (sqlite-close db)))
+      #:lifetime 50000
 
       ;; Use a minimum of 2 and a maximum of 8 threads
       #:parallelism
@@ -160,6 +169,14 @@
                (db-open database-file)))
           (sqlite-exec db "PRAGMA busy_timeout = 5000;")
           (list db)))
+      #:destructor
+      (lambda (db)
+        (db-optimize db
+                     database-file
+                     metrics-registry)
+
+        (sqlite-close db))
+      #:lifetime 500
 
       ;; SQLite doesn't support parallel writes
       #:parallelism 1
@@ -182,51 +199,65 @@
 
     datastore))
 
-(define-method (datastore-spawn-fibers
-                (datastore <sqlite-datastore>))
+(define (db-optimize db db-filename metrics-registry)
   (define (wal-size)
-    (let* ((db-filename
-            (slot-ref datastore 'database-file))
-           (db-wal-filename
-            (string-append db-filename "-wal")))
+    (let ((db-wal-filename
+           (string-append db-filename "-wal")))
 
       (stat:size (stat db-wal-filename))))
 
   (define MiB (* (expt 2 20) 1.))
   (define wal-size-threshold
-    (* 100 MiB))
+    (* 5 MiB))
 
-  (let* ((checkpoint-duration-metric-name
-          "datastore_wal_checkpoint_duration_seconds")
-         (metrics-registry
-          (slot-ref datastore 'metrics-registry)))
+  (let ((checkpoint-duration-metric-name
+         "datastore_wal_checkpoint_duration_seconds"))
 
-    (spawn-fiber
+    (when (> (wal-size) wal-size-threshold)
+      (call-with-duration-metric
+       metrics-registry
+       checkpoint-duration-metric-name
+       (lambda ()
+         (sqlite-exec db "PRAGMA wal_checkpoint(TRUNCATE);"))))
+
+    (call-with-duration-metric
+     metrics-registry
+     "datastore_optimize_duration_seconds"
      (lambda ()
-       (while #t
-         (sleep (* 60 15))              ; 15 minutes
-         (with-exception-handler
-             (lambda (exn)
-               (simple-format (current-error-port)
-                              "exception when performing WAL checkpoint: ~A\n"
-                              exn))
-           (lambda ()
-             (retry-on-error
-              (lambda ()
-                (call-with-worker-thread
-                 (slot-ref datastore 'worker-writer-thread-channel)
-                 (lambda (db)
-                   (call-with-duration-metric
-                    metrics-registry
-                    checkpoint-duration-metric-name
-                    (lambda ()
-                      (if (> (wal-size) wal-size-threshold)
-                          (sqlite-exec db "PRAGMA wal_checkpoint(TRUNCATE);")
-                          (sqlite-exec db "PRAGMA wal_checkpoint(RESTART);")))))))
-              #:times 5
-              #:delay 5))
-           #:unwind? #t)))
-     #:parallel? #t)))
+       (sqlite-exec db
+                    "
+PRAGMA analysis_limit=1000;
+PRAGMA optimize;")))))
+
+(define-method (datastore-optimize
+                (datastore <sqlite-datastore>))
+  (retry-on-error
+   (lambda ()
+     (call-with-worker-thread
+      (slot-ref datastore 'worker-writer-thread-channel)
+      (lambda (db)
+        (db-optimize
+         db
+         (slot-ref datastore 'database-file)
+         (slot-ref datastore 'metrics-registry)))))
+   #:times 5
+   #:delay 5))
+
+(define-method (datastore-spawn-fibers
+                (datastore <sqlite-datastore>))
+  (spawn-fiber
+   (lambda ()
+     (while #t
+       (sleep (* 60 5))                 ; 5 minutes
+       (with-exception-handler
+           (lambda (exn)
+             (simple-format (current-error-port)
+                            "exception when performing WAL checkpoint: ~A\n"
+                            exn))
+         (lambda ()
+           (datastore-optimize datastore))
+         #:unwind? #t)))
+   #:parallel? #t))
 
 (define-method (datastore-initialise-metrics!
                 (datastore <sqlite-datastore>))
diff --git a/guix-build-coordinator/utils/fibers.scm b/guix-build-coordinator/utils/fibers.scm
index 99941ad..f260682 100644
--- a/guix-build-coordinator/utils/fibers.scm
+++ b/guix-build-coordinator/utils/fibers.scm
@@ -62,7 +62,7 @@ arguments of the worker thread procedure."
                                   #f)))
                       (loop #f))))
               (when destructor
-                (apply destructor args)
+                (apply destructor args))
               (init (initializer))))))
        (iota parallelism))
       channel)))