Instrument more of the database writes

1 files changed, 74 insertions, 55 deletions

diff --git a/guix-build-coordinator/datastore/sqlite.scm b/guix-build-coordinator/datastore/sqlite.scm
index 330ff3d..c4e9123 100644
--- a/guix-build-coordinator/datastore/sqlite.scm
+++ b/guix-build-coordinator/datastore/sqlite.scm
@@ -264,10 +264,14 @@ WHERE agent_id = :agent_id AND password = :password"
 (define-method (datastore-store-derivation
                 (datastore <sqlite-datastore>)
                 derivation)
-  (datastore-call-with-transaction
+  (call-with-time-tracking
    datastore
-   (lambda (db)
-     (insert-derivation-and-return-outputs db derivation)))
+   "store_derivation"
+   (lambda ()
+     (datastore-call-with-transaction
+      datastore
+      (lambda (db)
+        (insert-derivation-and-return-outputs db derivation)))))
   #t)
 
 (define-method (datastore-list-related-derivations-with-no-build-for-outputs
@@ -478,13 +482,16 @@ INSERT INTO build_tags (build_id, tag_id) VALUES (:build_id, :tag_id)"
      "build-submitted"
      (list build-id)))
 
-  (datastore-call-with-transaction
+  (call-with-time-tracking
    datastore
-   (lambda (db)
-     (insert-build db uuid derivation-name priority)
-     (handle-inserting-unprocessed-hook-event db uuid)
-     (unless (null? tags)
-       (insert-tags db uuid tags))))
+   "store_build"
+   (datastore-call-with-transaction
+    datastore
+    (lambda (db)
+      (insert-build db uuid derivation-name priority)
+      (handle-inserting-unprocessed-hook-event db uuid)
+      (unless (null? tags)
+        (insert-tags db uuid tags)))))
   #t)
 
 (define-method (datastore-count-build-results
@@ -635,19 +642,23 @@ VALUES "
          "build-failure")
      (list build-id)))
 
-  (datastore-call-with-transaction
+  (call-with-time-tracking
    datastore
-   (lambda (db)
-     (insert-build-result db build-id agent-id result failure-reason)
-     (remove-build-allocation db build-id agent-id)
-     (mark-build-as-processed db build-id end-time)
-     ;; This logic should be part of the coordinator, but it's here to be
-     ;; inside the transaction
-     (handle-inserting-unprocessed-hook-event db build-id result)
-     (when (string=? result "success")
-       (delete-relevant-outputs-from-unbuilt-outputs db build-id))
-     (when output-metadata
-       (store-output-metadata db build-id output-metadata))))
+   "store_build_result"
+   (lambda ()
+     (datastore-call-with-transaction
+      datastore
+      (lambda (db)
+        (insert-build-result db build-id agent-id result failure-reason)
+        (remove-build-allocation db build-id agent-id)
+        (mark-build-as-processed db build-id end-time)
+        ;; This logic should be part of the coordinator, but it's here to be
+        ;; inside the transaction
+        (handle-inserting-unprocessed-hook-event db build-id result)
+        (when (string=? result "success")
+          (delete-relevant-outputs-from-unbuilt-outputs db build-id))
+        (when output-metadata
+          (store-output-metadata db build-id output-metadata))))))
   #t)
 
 (define-method (datastore-store-build-start
@@ -768,18 +779,22 @@ INSERT INTO setup_failure_missing_inputs (
      (list build-id
            missing-inputs)))
 
-  (datastore-call-with-transaction
+  (call-with-time-tracking
    datastore
-   (lambda (db)
-     (let ((setup-failure-id
-            (insert-setup-failure-and-remove-allocation db
-                                                        build-id
-                                                        agent-id
-                                                        "missing_inputs")))
-       (insert-missing-inputs db setup-failure-id missing-inputs))
-     ;; This logic should be part of the coordinator, but it's here to be
-     ;; inside the transaction
-     (handle-inserting-unprocessed-hook-event db build-id missing-inputs)))
+   "store_setup_failure_missing_inputs"
+   (lambda ()
+     (datastore-call-with-transaction
+      datastore
+      (lambda (db)
+        (let ((setup-failure-id
+               (insert-setup-failure-and-remove-allocation db
+                                                           build-id
+                                                           agent-id
+                                                           "missing_inputs")))
+          (insert-missing-inputs db setup-failure-id missing-inputs))
+        ;; This logic should be part of the coordinator, but it's here to be
+        ;; inside the transaction
+        (handle-inserting-unprocessed-hook-event db build-id missing-inputs)))))
   #t)
 
 (define-method (datastore-list-setup-failure-missing-inputs
@@ -1760,30 +1775,34 @@ WHERE agent_id = :agent_id"
 
         result)))
 
-  (datastore-call-with-transaction
+  (call-with-time-tracking
    datastore
-   (lambda (db)
-     (let* ((initially-allocated-builds
-             (select-allocated-builds db agent-id))
-            (start-count
-             (length initially-allocated-builds))
-            (target-count (or max-builds
-                              (+ start-count
-                                 deprecated-requested-count))))
-       (if (< start-count target-count)
-           (let ((new-builds
-                  (allocate-several-builds db
-                                           agent-id
-                                           (- target-count start-count))))
-             ;; Previously allocate builds just returned newly allocated
-             ;; builds, but if max-builds is provided, return all the
-             ;; builds. This means the agent can handle this in a idempotent
-             ;; manor.
-             (if max-builds
-                 (append initially-allocated-builds
-                         new-builds)
-                 new-builds))
-           '())))))
+   "allocate_builds_to_agent"
+   (lambda ()
+     (datastore-call-with-transaction
+      datastore
+      (lambda (db)
+        (let* ((initially-allocated-builds
+                (select-allocated-builds db agent-id))
+               (start-count
+                (length initially-allocated-builds))
+               (target-count (or max-builds
+                                 (+ start-count
+                                    deprecated-requested-count))))
+          (if (< start-count target-count)
+              (let ((new-builds
+                     (allocate-several-builds db
+                                              agent-id
+                                              (- target-count start-count))))
+                ;; Previously allocate builds just returned newly allocated
+                ;; builds, but if max-builds is provided, return all the
+                ;; builds. This means the agent can handle this in a idempotent
+                ;; manor.
+                (if max-builds
+                    (append initially-allocated-builds
+                            new-builds)
+                    new-builds))
+              '())))))))
 
 (define-method (datastore-list-allocation-plan-builds
                 (datastore <sqlite-datastore>)