01/02: hydra: bayfront: Have the bffe show derivation and tag links.

[Christopher Baines]

cbaines pushed a commit to branch master
in repository maintenance.

commit 33c891ebe3bdc864dea7d75ce26707e964d5cc43
Author: Christopher Baines <mail@cbaines.net>
AuthorDate: Thu Mar 7 14:53:15 2024 +0000

    hydra: bayfront: Have the bffe show derivation and tag links.
    
    These'll appear on the build pages on bordeaux.guix.gnu.org.
    
    * hydra/bayfront.scm (%bffe-configuration): Include config for
    derivation and tag links.
---
 hydra/bayfront.scm | 39 +++++++++++++++++++++++++++++++++++++--
 1 file changed, 37 insertions(+), 2 deletions(-)

diff --git a/hydra/bayfront.scm b/hydra/bayfront.scm
index 081339d..45375cc 100644
--- a/hydra/bayfront.scm
+++ b/hydra/bayfront.scm
@@ -1278,6 +1278,16 @@ proxy_set_header  Via  $via;"
                    0)))
                 (else
                  0)))))
+
+        (define (build-tag build-details key)
+          (let ((tag
+                 ((@ (srfi srfi-1) find)
+                  (lambda (tag)
+                    (string=? (assoc-ref tag "key") key))
+                  (vector->list
+                   (assoc-ref build-details "tags")))))
+            (assoc-ref tag "value")))
+
         (list
          #:build
          (list
@@ -1307,10 +1317,35 @@ proxy_set_header  Via  $via;"
            (build-priority priority-for-derivation)
            (data-service-build-server-id 2)))
          #:web-server-args
-         '(#:controller-args
+         `(#:controller-args
            (#:title "bordeaux.guix.gnu.org"
             #:template-directory #$(local-file "nginx/html/bordeaux"
-                                               #:recursive? #t))))))))
+                                               #:recursive? #t)
+            #:derivation-link-target
+            ,(lambda (derivation-name context)
+               (and=> (build-tag context "branch")
+                      (lambda (branch)
+                        (simple-format
+                         #f
+                         "https://~A.guix.gnu.org~A";
+                         (if (string=? branch "master")
+                             "data"
+                             "data.qa")
+                         derivation-name))))
+            #:tag-link-target
+            ,(lambda (key value context)
+               (cond
+                ((string=? key "revision")
+                 (and=> (build-tag context "branch")
+                        (lambda (branch)
+                          (simple-format
+                           #f
+                           "https://~A.guix.gnu.org/revision/~A";
+                           (if (string=? branch "master")
+                               "data"
+                               "data.qa")
+                           value))))
+                (else #f))))))))))
 
 
 ;;;