Improve delay logging in datastore-call-with-transaction

Make sure to log the delay in the calling thread.

1 files changed, 33 insertions, 29 deletions

diff --git a/guix-build-coordinator/datastore/sqlite.scm b/guix-build-coordinator/datastore/sqlite.scm
index a09bde7..55f3215 100644
--- a/guix-build-coordinator/datastore/sqlite.scm
+++ b/guix-build-coordinator/datastore/sqlite.scm
@@ -397,36 +397,40 @@ PRAGMA optimize;")))))
                   (sqlite-exec db "COMMIT TRANSACTION;")
                   (apply values vals))))))))
 
-  (call-with-worker-thread
-   (slot-ref datastore (if readonly?
-                           'worker-reader-thread-channel
-                           'worker-writer-thread-channel))
-   (lambda (db)
-     (let ((start-time (get-internal-real-time)))
-       (call-with-values
-           (lambda ()
-             (if duration-metric-name
-                 (call-with-time-tracking
-                  datastore
-                  duration-metric-name
+  (match (call-with-worker-thread
+          (slot-ref datastore (if readonly?
+                                  'worker-reader-thread-channel
+                                  'worker-writer-thread-channel))
+          (lambda (db)
+            (let ((start-time (get-internal-real-time)))
+              (call-with-values
                   (lambda ()
-                    (run-proc-within-transaction db)))
-                 (run-proc-within-transaction db)))
-         (lambda vals
-           (let ((duration-seconds
-                  (/ (- (get-internal-real-time) start-time)
-                     internal-time-units-per-second)))
-             (when (and (not readonly?)
-                        (> duration-seconds 2))
-               (display
-                (format
-                 #f
-                 "warning: ~a:\n  took ~4f seconds in transaction\n"
-                 proc
-                 duration-seconds)
-                (current-error-port))))
-
-           (apply values vals)))))))
+                    (if duration-metric-name
+                        (call-with-time-tracking
+                         datastore
+                         duration-metric-name
+                         (lambda ()
+                           (run-proc-within-transaction db)))
+                        (run-proc-within-transaction db)))
+                (lambda vals
+                  (let ((duration-seconds
+                         (/ (- (get-internal-real-time) start-time)
+                            internal-time-units-per-second)))
+                    (when (and (not readonly?)
+                               (> duration-seconds 2))
+                      (display
+                       (format
+                        #f
+                        "warning: ~a:\n  took ~4f seconds in transaction\n"
+                        proc
+                        duration-seconds)
+                       (current-error-port)))
+
+                    (cons duration-seconds vals)))))))
+    ((duration vals ...)
+     (log-delay proc duration)
+
+     (apply values vals))))
 
 (define-method (datastore-find-agent
                 (datastore <sqlite-datastore>)