From f634a894e254f4c2e2341dc0f3912e9c01240f3c Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Sun, 4 Feb 2024 13:52:54 +0100
Subject: Add support for derivation links

---
 bffe/server.scm     |  6 ++++--
 bffe/view/build.scm | 11 +++++++++--
 2 files changed, 13 insertions(+), 4 deletions(-)

diff --git a/bffe/server.scm b/bffe/server.scm
index 76f8212..65b49b5 100644
--- a/bffe/server.scm
+++ b/bffe/server.scm
@@ -418,7 +418,8 @@
                           event-source
                           #:key
                           title
-                          (template-directory (%config 'template-dir)))
+                          (template-directory (%config 'template-dir))
+                          (derivation-link-target (const #f)))
 
   (define handle-static-assets
     (if (string-prefix? (%store-prefix)
@@ -520,7 +521,8 @@
            (else
             (render-html
              #:sxml (build title
-                           (json->scm body)))))))
+                           (json->scm body)
+                           derivation-link-target))))))
       (('GET "agent" agent-id)
        (let ((response
               body
diff --git a/bffe/view/build.scm b/bffe/view/build.scm
index be33467..a9cf84a 100644
--- a/bffe/view/build.scm
+++ b/bffe/view/build.scm
@@ -7,7 +7,7 @@
   #:use-module ((guix store) #:select (%store-prefix))
   #:export (build))
 
-(define (build title build-details)
+(define (build title build-details derivation-link-target)
   (layout
    #:title (string-append
             "Build " (assoc-ref build-details "uuid") " — " title)
@@ -15,7 +15,14 @@
    `((main
       (dl
        (dt "Derivation")
-       (dd ,(assoc-ref build-details "derivation-name"))
+       (dd ,(let* ((derivation-name (assoc-ref build-details "derivation-name"))
+                   (derivation-link
+                    (derivation-link-target derivation-name
+                                            build-details)))
+              (if derivation-link
+                  `(a (@ (href ,derivation-link))
+                      ,derivation-name)
+                  derivation-name)))
 
        (dt "Tags")
        (dd (ul
-- 
cgit v1.2.3