Start tracking the duration of a few datastore functions

3 files changed, 72 insertions, 42 deletions

diff --git a/guix-build-coordinator/datastore.scm b/guix-build-coordinator/datastore.scm
index 7e5f502..5fec9e2 100644
--- a/guix-build-coordinator/datastore.scm
+++ b/guix-build-coordinator/datastore.scm
@@ -42,12 +42,14 @@
 (re-export datastore-allocate-builds-to-agent)
 (re-export datastore-list-allocation-plan-builds)
 
-(define (database-uri->datastore database)
+(define* (database-uri->datastore database
+                                  #:key
+                                  metrics-registry)
   (cond
    ((string-prefix? "pg://" database)
     (postgresql-datastore database))
    ((string-prefix? "sqlite://" database)
-    (sqlite-datastore database))
+    (sqlite-datastore database #:metrics-registry metrics-registry))
    (else
     (error
      (simple-format #f "Unknown database ~A" database)))))
diff --git a/guix-build-coordinator/datastore/sqlite.scm b/guix-build-coordinator/datastore/sqlite.scm
index b3f8def..97d86ba 100644
--- a/guix-build-coordinator/datastore/sqlite.scm
+++ b/guix-build-coordinator/datastore/sqlite.scm
@@ -7,6 +7,7 @@
   #:use-module (guix derivations)
   #:use-module (guix-build-coordinator utils)
   #:use-module (guix-build-coordinator config)
+  #:use-module (guix-build-coordinator metrics)
   #:use-module (guix-build-coordinator datastore abstract)
   #:export (sqlite-datastore
             datastore-update
@@ -46,9 +47,13 @@
 
 (define-class <sqlite-datastore> (<abstract-datastore>)
   database-file
-  worker-thread-channel)
+  worker-thread-channel
+  metrics-registry)
 
-(define* (sqlite-datastore database-uri #:key update-database?)
+(define* (sqlite-datastore database-uri
+                           #:key
+                           update-database?
+                           metrics-registry)
   (define database-file
     (string-drop database-uri
                  (string-length "sqlite://")))
@@ -59,6 +64,7 @@
   (let ((datastore (make <sqlite-datastore>)))
 
     (slot-set! datastore 'database-file database-file)
+    (slot-set! datastore 'metrics-registry metrics-registry)
 
     (slot-set!
      datastore
@@ -76,6 +82,18 @@
 
     datastore))
 
+(define (call-with-time-tracking datastore metric-name thunk)
+  (let* ((registry (slot-ref datastore 'metrics-registry))
+         (metric
+          (or (metrics-registry-fetch-metric registry metric-name)
+              (make-histogram-metric
+               registry
+               metric-name)))
+         (start-time (current-time)))
+    (let ((result (thunk)))
+      (metric-observe metric (- (current-time) start-time))
+      result)))
+
 (define-method (datastore-find-agent
                 (datastore <sqlite-datastore>)
                 uuid)
@@ -566,13 +584,17 @@ WHERE build_id = :build_id")))
 (define-method (datastore-list-builds-for-output
                 (datastore <sqlite-datastore>)
                 output)
-  (call-with-worker-thread
-   (slot-ref datastore 'worker-thread-channel)
-   (lambda (db)
-     (let ((statement
-            (sqlite-prepare
-             db
-             "
+  (call-with-time-tracking
+   datastore
+   "list_builds_for_output"
+   (lambda ()
+     (call-with-worker-thread
+      (slot-ref datastore 'worker-thread-channel)
+      (lambda (db)
+        (let ((statement
+               (sqlite-prepare
+                db
+                "
 SELECT uuid, builds.derivation_name, priority, processed, result
 FROM builds
 LEFT JOIN build_results
@@ -581,23 +603,23 @@ INNER JOIN derivation_outputs
   ON builds.derivation_name = derivation_outputs.derivation_name
 WHERE derivation_outputs.output = :output")))
 
-       (sqlite-bind-arguments
-        statement
-        #:output output)
+          (sqlite-bind-arguments
+           statement
+           #:output output)
 
-       (let ((result
-              (sqlite-map
-               (match-lambda
-                 (#(uuid derivation priority processed result)
-                  `((uuid            . ,uuid)
-                    (derivation      . ,derivation)
-                    (priority        . ,priority)
-                    (processed       . ,processed)
-                    (result          . ,result))))
-               statement)))
-         (sqlite-reset statement)
+          (let ((result
+                 (sqlite-map
+                  (match-lambda
+                    (#(uuid derivation priority processed result)
+                     `((uuid            . ,uuid)
+                       (derivation      . ,derivation)
+                       (priority        . ,priority)
+                       (processed       . ,processed)
+                       (result          . ,result))))
+                  statement)))
+            (sqlite-reset statement)
 
-         result)))))
+            result)))))))
 
 (define-method (datastore-list-builds-for-derivation
                 (datastore <sqlite-datastore>)
@@ -780,21 +802,25 @@ INSERT INTO build_allocation_plan (build_id, agent_id, ordering) VALUES "
        ", ")
       ";")))
 
-  (call-with-worker-thread
-   (slot-ref datastore 'worker-thread-channel)
-   (lambda (db)
-     (sqlite-exec db "BEGIN TRANSACTION;")
-     (with-exception-handler
-         (lambda (key . args)
-           (simple-format (current-error-port)
-                          "error: sqlite: ~A ~A\n"
-                          key args)
-           (sqlite-exec db "ROLLBACK TRANSACTION;"))
-       (lambda ()
-         (clear-current-plan db)
-         (unless (null? planned-builds)
-           (insert-new-plan db planned-builds))
-         (sqlite-exec db "COMMIT TRANSACTION;")))))
+  (call-with-time-tracking
+   datastore
+   "replace_build_allocation_plan_duration_seconds"
+   (lambda ()
+     (call-with-worker-thread
+      (slot-ref datastore 'worker-thread-channel)
+      (lambda (db)
+        (sqlite-exec db "BEGIN TRANSACTION;")
+        (with-exception-handler
+            (lambda (key . args)
+              (simple-format (current-error-port)
+                             "error: sqlite: ~A ~A\n"
+                             key args)
+              (sqlite-exec db "ROLLBACK TRANSACTION;"))
+          (lambda ()
+            (clear-current-plan db)
+            (unless (null? planned-builds)
+              (insert-new-plan db planned-builds))
+            (sqlite-exec db "COMMIT TRANSACTION;")))))))
   #t)
 
 (define-method (datastore-count-allocated-builds
diff --git a/scripts/guix-build-coordinator.in b/scripts/guix-build-coordinator.in
index 9d73ccc..38fdea9 100644
--- a/scripts/guix-build-coordinator.in
+++ b/scripts/guix-build-coordinator.in
@@ -228,7 +228,9 @@
                                        %base-option-defaults)
                                arguments))
           (datastore (database-uri->datastore
-                      (assq-ref opts 'database)))
+                      (assq-ref opts 'database)
+                      #:metrics-registry
+                      coordinator-metrics-registry))
           (hooks
            `((build-success        . ,(assq-ref opts 'build-success-hook))
              (build-failure        . ,(assq-ref opts 'build-failure-hook))