From e09bc606f25bad11b39c9fae49139ac03b88697c Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Sun, 6 Dec 2020 10:58:21 +0000
Subject: Fix using sqlite-reset in a few queries

Rather than calling sqlite-reset before reading the rows, call sqlite-reset
after. I think this is important to stop SQLite getting stuck because the
statement is still live even though it's not being read from after these
procedures return.

Assuming I've got the ordering right, I think using sqlite-fold-right directly
is simpler code as well.
---
 src/cuirass/database.scm | 135 ++++++++++++++++++++++++-----------------------
 1 file changed, 70 insertions(+), 65 deletions(-)

diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm
index 587dc2d..3d86c1b 100644
--- a/src/cuirass/database.scm
+++ b/src/cuirass/database.scm
@@ -899,26 +899,28 @@ LIMIT :nr;"))
                              (#f -1)
                              (x x)))
                      (query->bind-arguments (assq-ref filters 'query))))
-      (sqlite-reset stmt)
-      (let loop ((rows (sqlite-fold-right cons '() stmt))
-                 (builds '()))
-        (match rows
-          (() (reverse builds))
-          ((#(id timestamp starttime stoptime log status job-name
-                 system nix-name specification) . rest)
-           (loop rest
-                 (cons `((#:id . ,id)
-                         (#:timestamp . ,timestamp)
-                         (#:starttime . ,starttime)
-                         (#:stoptime . ,stoptime)
-                         (#:log . ,log)
-                         (#:status . ,status)
-                         (#:job-name . ,job-name)
-                         (#:system . ,system)
-                         (#:nix-name . ,nix-name)
-                         (#:specification . ,specification)
-                         (#:buildproducts . ,(db-get-build-products id)))
-                       builds))))))))
+      (let ((builds
+             (sqlite-fold-right
+              (lambda (row result)
+                (match row
+                  (#(id timestamp starttime stoptime log status job-name
+                        system nix-name specification)
+                   (cons `((#:id . ,id)
+                           (#:timestamp . ,timestamp)
+                           (#:starttime . ,starttime)
+                           (#:stoptime . ,stoptime)
+                           (#:log . ,log)
+                           (#:status . ,status)
+                           (#:job-name . ,job-name)
+                           (#:system . ,system)
+                           (#:nix-name . ,nix-name)
+                           (#:specification . ,specification)
+                           (#:buildproducts . ,(db-get-build-products id)))
+                         result))))
+              '()
+              stmt)))
+        (sqlite-reset stmt)
+        builds))))
 
 (define (db-get-builds filters)
   "Retrieve all builds in the database which are matched by given FILTERS.
@@ -1053,39 +1055,40 @@ ORDER BY ~a;"
                                       name)
                                   value))))
                 filters)
-
-      (sqlite-reset stmt)
-      (let loop ((rows (sqlite-fold-right cons '() stmt))
-                 (builds '()))
-        (match rows
-          (() (reverse builds))
-          ((#(derivation id timestamp starttime stoptime log status job-name
-                         system nix-name eval-id specification
-                         outputs-name outputs-path
-                         products-id products-type products-file-size
-                         products-checksum products-path) . rest)
-           (loop rest
-                 (cons `((#:derivation . ,derivation)
-                         (#:id . ,id)
-                         (#:timestamp . ,timestamp)
-                         (#:starttime . ,starttime)
-                         (#:stoptime . ,stoptime)
-                         (#:log . ,log)
-                         (#:status . ,status)
-                         (#:job-name . ,job-name)
-                         (#:system . ,system)
-                         (#:nix-name . ,nix-name)
-                         (#:eval-id . ,eval-id)
-                         (#:specification . ,specification)
-                         (#:outputs . ,(format-outputs outputs-name
-                                                       outputs-path))
-                         (#:buildproducts .
-                          ,(format-build-products products-id
-                                                  products-type
-                                                  products-file-size
-                                                  products-checksum
-                                                  products-path)))
-                       builds))))))))
+      (let ((builds
+             (sqlite-fold-right
+              (lambda (row result)
+                (match row
+                  (#(derivation id timestamp starttime stoptime log status job-name
+                                system nix-name eval-id specification
+                                outputs-name outputs-path
+                                products-id products-type products-file-size
+                                products-checksum products-path)
+                   (cons `((#:derivation . ,derivation)
+                           (#:id . ,id)
+                           (#:timestamp . ,timestamp)
+                           (#:starttime . ,starttime)
+                           (#:stoptime . ,stoptime)
+                           (#:log . ,log)
+                           (#:status . ,status)
+                           (#:job-name . ,job-name)
+                           (#:system . ,system)
+                           (#:nix-name . ,nix-name)
+                           (#:eval-id . ,eval-id)
+                           (#:specification . ,specification)
+                           (#:outputs . ,(format-outputs outputs-name
+                                                         outputs-path))
+                           (#:buildproducts .
+                            ,(format-build-products products-id
+                                                    products-type
+                                                    products-file-size
+                                                    products-checksum
+                                                    products-path)))
+                         result))))
+              '()
+              stmt)))
+        (sqlite-reset stmt)
+        builds))))
 
 (define (db-get-build derivation-or-id)
   "Retrieve a build in the database which corresponds to DERIVATION-OR-ID."
@@ -1142,18 +1145,20 @@ LIMIT :nr;")
        #:nr (match (assq-ref filters 'nr)
               (#f -1)
               (x x)))
-      (sqlite-reset stmt)
-      (let loop ((rows (sqlite-fold-right cons '() stmt))
-                 (events '()))
-        (match rows
-          (() (reverse events))
-          ((#(id type timestamp event_json) . rest)
-           (loop rest
-                 (cons `((#:id . ,id)
-                         (#:type . ,type)
-                         (#:timestamp . ,timestamp)
-                         (#:event_json . ,event_json))
-                       events))))))))
+      (let ((events
+             (sqlite-fold-right
+              (lambda (row result)
+                (match row
+                  (#(id type timestamp event_json)
+                   (cons `((#:id . ,id)
+                           (#:type . ,type)
+                           (#:timestamp . ,timestamp)
+                           (#:event_json . ,event_json))
+                         result))))
+              '()
+              stmt)))
+        (sqlite-reset stmt)
+        events))))
 
 (define (db-delete-events-with-ids-<=-to id)
   (with-db-writer-worker-thread db
-- 
cgit v1.2.3