Allow nesting transactions in code

You can't actually nest transactions, so just track if one is in progress, and
don't attempt to start a transaction if that's the case.

1 files changed, 20 insertions, 13 deletions

diff --git a/guix-build-coordinator/datastore/sqlite.scm b/guix-build-coordinator/datastore/sqlite.scm
index b49ba92..8e23633 100644
--- a/guix-build-coordinator/datastore/sqlite.scm
+++ b/guix-build-coordinator/datastore/sqlite.scm
@@ -305,25 +305,32 @@
           result))
       (thunk)))
 
+(define %current-transaction-proc
+  (make-parameter #f))
+
 (define* (datastore-call-with-transaction datastore proc
                                           #:key
                                           readonly?
                                           duration-metric-name)
   (define (run-proc-within-transaction db)
-    (sqlite-exec db "BEGIN TRANSACTION;")
-    (with-exception-handler
-        (lambda (exn)
-          (simple-format (current-error-port)
-                         "error: sqlite rolling back transaction\n")
-          (sqlite-exec db "ROLLBACK TRANSACTION;")
-          (raise-exception exn))
-      (lambda ()
-        (call-with-values
+    (if (%current-transaction-proc)
+        (proc db)                       ; already in transaction
+        (begin
+          (sqlite-exec db "BEGIN TRANSACTION;")
+          (with-exception-handler
+              (lambda (exn)
+                (simple-format (current-error-port)
+                               "error: sqlite rolling back transaction\n")
+                (sqlite-exec db "ROLLBACK TRANSACTION;")
+                (raise-exception exn))
             (lambda ()
-              (proc db))
-          (lambda vals
-            (sqlite-exec db "COMMIT TRANSACTION;")
-            (apply values vals))))))
+              (call-with-values
+                  (lambda ()
+                    (parameterize ((%current-transaction-proc proc))
+                      (proc db)))
+                (lambda vals
+                  (sqlite-exec db "COMMIT TRANSACTION;")
+                  (apply values vals))))))))
 
   (call-with-worker-thread
    (slot-ref datastore (if readonly?