Log procedures if they take more than 2 seconds within a transaction

To better understand what's taking a while when writing to the database.

1 files changed, 25 insertions, 7 deletions

diff --git a/guix-build-coordinator/datastore/sqlite.scm b/guix-build-coordinator/datastore/sqlite.scm
index b3ffdd4..1eeac2b 100644
--- a/guix-build-coordinator/datastore/sqlite.scm
+++ b/guix-build-coordinator/datastore/sqlite.scm
@@ -391,13 +391,31 @@ PRAGMA optimize;")))))
                            'worker-reader-thread-channel
                            'worker-writer-thread-channel))
    (lambda (db)
-     (if duration-metric-name
-         (call-with-time-tracking
-          datastore
-          duration-metric-name
-          (lambda ()
-            (run-proc-within-transaction db)))
-         (run-proc-within-transaction db)))))
+     (let ((start-time (get-internal-real-time)))
+       (call-with-values
+           (lambda ()
+             (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))))
+
+           (apply values vals)))))))
 
 (define-method (datastore-find-agent
                 (datastore <sqlite-datastore>)