Improve the linking to build servers

Add a build-url function that returns the URL to use, and use this where
appropriate.

5 files changed, 37 insertions, 30 deletions

diff --git a/guix-data-service/model/build.scm b/guix-data-service/model/build.scm
index b9ba241..ac1e870 100644
--- a/guix-data-service/model/build.scm
+++ b/guix-data-service/model/build.scm
@@ -19,6 +19,7 @@
   #:use-module (ice-9 match)
   #:use-module (squee)
   #:use-module (json)
+  #:use-module (guix-data-service database)
   #:use-module (guix-data-service model utils)
   #:export (select-build-stats
             select-builds-with-context
@@ -145,7 +146,8 @@ ORDER BY status"))
   (define query
     (string-append
      "
-SELECT builds.id, build_servers.url, derivations.file_name,
+SELECT builds.id, build_servers.url,
+       builds.build_server_build_id, derivations.file_name,
        latest_build_status.timestamp, latest_build_status.status
 FROM builds
 INNER JOIN build_servers ON build_servers.id = builds.build_server_id
@@ -181,17 +183,17 @@ ON latest_build_status.build_id = builds.id
 ORDER BY latest_build_status.timestamp DESC
 LIMIT 100"))
 
-  (exec-query conn
-              query
-              `(,@(if revision-commit
-                      (list revision-commit)
-                      '())
-                ,@(if system
-                      (list system)
-                      '())
-                ,@(if target
-                      (list target)
-                      '()))))
+  (exec-query-with-null-handling conn
+                                 query
+                                 `(,@(if revision-commit
+                                         (list revision-commit)
+                                         '())
+                                   ,@(if system
+                                         (list system)
+                                         '())
+                                   ,@(if target
+                                         (list target)
+                                         '()))))
 
 (define (select-builds-with-context-by-derivation-file-name
          conn derivation-file-name)
diff --git a/guix-data-service/web/build/html.scm b/guix-data-service/web/build/html.scm
index c3d7c90..fdbfd7e 100644
--- a/guix-data-service/web/build/html.scm
+++ b/guix-data-service/web/build/html.scm
@@ -103,14 +103,15 @@
          (tbody
           ,@(map
              (match-lambda
-               ((build-id build-server-url derivation-file-name
+               ((build-id build-server-url build-server-build-id
+                          derivation-file-name
                           timestamp status)
                 `(tr
                   (td (@ (class "text-center"))
                       (a (@ (href
-                             ,(simple-format
-                               #f "/build-server/~A/build?derivation_file_name=~A"
+                             ,(build-url
                                (assoc-ref build-server-options build-server-url)
+                               build-server-build-id
                                derivation-file-name)))
                          ,(build-status-span status)))
                   (td (a (@ (href ,derivation-file-name))
diff --git a/guix-data-service/web/html-utils.scm b/guix-data-service/web/html-utils.scm
index 6286b8f..bdafae3 100644
--- a/guix-data-service/web/html-utils.scm
+++ b/guix-data-service/web/html-utils.scm
@@ -25,6 +25,7 @@
 
             build-status-value->display-string
             build-status-span
+            build-url
             build-status-alist->build-icon))
 
 (define (sexp-div sexp)
@@ -67,6 +68,17 @@
      ("" . "Unknown"))
    value))
 
+(define (build-url build-server-id build-server-build-id derivation-file-name)
+  (if (string? build-server-build-id)
+      (simple-format
+       #f "/build-server/~A/build?build_server_build_id=~A"
+       build-server-id
+       build-server-build-id)
+      (simple-format
+       #f "/build-server/~A/build?derivation_file_name=~A"
+       build-server-id
+       derivation-file-name)))
+
 (define (build-status-span status)
   `(span (@ (class ,(string-append
                      "label label-"
diff --git a/guix-data-service/web/revision/html.scm b/guix-data-service/web/revision/html.scm
index 60c6466..b2622b3 100644
--- a/guix-data-service/web/revision/html.scm
+++ b/guix-data-service/web/revision/html.scm
@@ -1929,14 +1929,15 @@ figure {
          (tbody
           ,@(map
              (match-lambda
-               ((build-id build-server-url derivation-file-name
+               ((build-id build-server-url build-server-build-id
+                          derivation-file-name
                           timestamp status)
                 `(tr
                   (td (@ (class "text-center"))
                       (a (@ (href
-                             ,(simple-format
-                               #f "/build-server/~A/build?derivation_file_name=~A"
+                             ,(build-url
                                (assoc-ref build-server-options build-server-url)
+                               build-server-build-id
                                derivation-file-name)))
                          ,(build-status-span status)))
                   (td (a (@ (href ,derivation-file-name))
diff --git a/guix-data-service/web/view/html.scm b/guix-data-service/web/view/html.scm
index cf5421a..9dcd7aa 100644
--- a/guix-data-service/web/view/html.scm
+++ b/guix-data-service/web/view/html.scm
@@ -634,21 +634,12 @@ time."
                  ((build-server-id build-server-url
                                    build-server-build-id
                                    timestamp status)
-                  (define build-url
-                    (if (string? build-server-build-id)
-                        (simple-format
-                         #f "/build-server/~A/build?build_server_build_id=~A"
-                         build-server-id
-                         build-server-build-id)
-                        (simple-format
-                         #f "/build-server/~A/build?derivation_file_name=~A"
-                         build-server-id
-                         (second derivation))))
-
                   `(div
                     (@ (class "text-center"))
                     (div
-                     (a (@ (href ,build-url))
+                     (a (@ (href ,(build-url build-server-id
+                                             build-server-build-id
+                                             (second derivation))))
                         ,(build-status-span status)))
                     (a (@ (style "display: inline-block; margin-top: 0.4em;")
                           (href ,(simple-format