From ee089a9e48a569e61134ceff5ccf96b945fed8a7 Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Mon, 10 Oct 2022 17:08:55 +0100
Subject: Tag builds when submitting them

In the queue builds from guix-data-service script. This is to help identifying
the source of the build.
---
 ...rdinator-queue-builds-from-guix-data-service.in | 30 ++++++++++++++++------
 1 file changed, 22 insertions(+), 8 deletions(-)

(limited to 'scripts')

diff --git a/scripts/guix-build-coordinator-queue-builds-from-guix-data-service.in b/scripts/guix-build-coordinator-queue-builds-from-guix-data-service.in
index dc072bf..318621c 100644
--- a/scripts/guix-build-coordinator-queue-builds-from-guix-data-service.in
+++ b/scripts/guix-build-coordinator-queue-builds-from-guix-data-service.in
@@ -160,7 +160,8 @@
              derivations)))
 
 (define* (submit-build coordinator guix-data-service derivation
-                       #:key (priority 0) (log-prefix ""))
+                       #:key (priority 0) (log-prefix "")
+                       (tags '()))
   (retry-on-error
    (lambda ()
      (let ((response
@@ -173,7 +174,7 @@
              #t
              #t
              #t
-             '())))
+             tags)))
        (let ((no-build-submitted-response
               (assoc-ref response "no-build-submitted")))
          (if no-build-submitted-response
@@ -192,7 +193,8 @@
                                      priority-for-derivation
                                      #:key (submit-builds-for-channel-instances?
                                             #t)
-                                     guix-data-service-build-server-id)
+                                     guix-data-service-build-server-id
+                                     branch)
   (log-msg 'INFO "looking at revision " commit)
   (par-for-each
    (match-lambda
@@ -212,7 +214,12 @@
                                     #:log-prefix
                                     (simple-format #f "channel instance (~A): ~A: "
                                                    system
-                                                   derivation)))
+                                                   derivation)
+                                    #:tags `((category . channel-instance)
+                                             (revision . ,commit)
+                                             ,@(if branch
+                                                   `((branch . ,branch))
+                                                   '()))))
                     (channel-instance-derivations-for-commit guix-data-service
                                                              commit
                                                              system))))
@@ -243,7 +250,12 @@
                                                              target)
                                     #:log-prefix
                                     (simple-format #f "package (~A=>~A): ~A: "
-                                                   system target derivation))))
+                                                   system target derivation)
+                                    #:tags `((category . package)
+                                             (revision . ,commit)
+                                             ,@(if branch
+                                                   `((branch . ,branch))
+                                                   '())))))
                   unprocessed-package-derivations)
         (record-derivations-as-processed unprocessed-package-derivations))))
    systems-and-targets))
@@ -418,7 +430,7 @@
         (((process-job-with-queue count-jobs count-threads list-jobs)
           (create-work-queue
            (assq-ref opts 'threads)
-           (lambda (commit)
+           (lambda (branch commit)
              (submit-builds-for-revision
               (assq-ref opts 'coordinator)
               guix-data-service
@@ -428,7 +440,8 @@
               #:submit-builds-for-channel-instances?
               (assq-ref opts 'fetch-channel-instance-derivations)
               #:guix-data-service-build-server-id
-              (assq-ref opts 'guix-data-service-build-server-id))
+              (assq-ref opts 'guix-data-service-build-server-id)
+              #:branch branch)
              (record-revision-as-processed processed-commits-file commit)))))
 
       (while #t
@@ -437,7 +450,8 @@
            (for-each
             (lambda (branch)
               (for-each
-               process-job-with-queue
+               (lambda (commit)
+                 (process-job-with-queue branch commit))
                (lset-difference
                 string=?
                 (unseen-revisions guix-data-service
-- 
cgit v1.2.3