From f8460c36a923e7be8e9d1f680a14d50d2b28fdcf Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Tue, 25 Apr 2023 16:36:55 +0100
Subject: Use #:duration-logger in datastore-call-with-transaction

Rather than duplicating what it does.
---
 guix-build-coordinator/datastore/sqlite.scm | 65 +++++++++++------------------
 1 file changed, 25 insertions(+), 40 deletions(-)

(limited to 'guix-build-coordinator/datastore')

diff --git a/guix-build-coordinator/datastore/sqlite.scm b/guix-build-coordinator/datastore/sqlite.scm
index ec52cb4..a37c97c 100644
--- a/guix-build-coordinator/datastore/sqlite.scm
+++ b/guix-build-coordinator/datastore/sqlite.scm
@@ -555,7 +555,7 @@ PRAGMA optimize;")
                           (raise-exception exn))))
                 (lambda ()
                   (parameterize ((%current-transaction-proc proc))
-                    (proc-with-duration-timing db)))
+                    (proc db)))
                 #:unwind? #t))
           (lambda vals
             (let loop ((success? (attempt-commit)))
@@ -566,45 +566,30 @@ PRAGMA optimize;")
         ;; Database is busy, so retry
         (run-proc-within-transaction db)))
 
-  (define (proc-with-duration-timing 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 ()
-                   (proc db)))
-                (proc 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))))))
-
-  (match (call-with-worker-thread
-          (slot-ref datastore (if readonly?
-                                  'worker-reader-thread-channel
-                                  'worker-writer-thread-channel))
-          (lambda (db)
-            (if (%current-transaction-proc)
-                (proc-with-duration-timing db) ; already in transaction
-                (run-proc-within-transaction db))))
-    ((duration vals ...)
-     (log-delay proc duration)
-
-     (apply values vals))))
+  (call-with-worker-thread
+   (slot-ref datastore (if readonly?
+                           'worker-reader-thread-channel
+                           'worker-writer-thread-channel))
+   (lambda (db)
+     (if (%current-transaction-proc)
+         (proc db) ; already in transaction
+         (run-proc-within-transaction db)))
+   #:duration-logger
+   (lambda (duration-seconds)
+     (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))
+
+       (when duration-metric-name
+         (metric-observe-duration datastore
+                                  duration-metric-name
+                                  duration-seconds))))))
 
 (define-method (datastore-find-agent
                 (datastore <sqlite-datastore>)
-- 
cgit v1.2.3