03/10: Add a view build link on the build page

[Christopher Baines]

cbaines pushed a commit to branch master
in repository data-service.

commit efb26a616dd374d73e4fbcce4652eac04bae2c38
Author: Christopher Baines <mail@cbaines.net>
AuthorDate: Wed Oct 21 19:26:18 2020 +0100

    Add a view build link on the build page
---
 guix-data-service/model/build.scm                 |  8 ++++++--
 guix-data-service/web/build-server/controller.scm |  3 ++-
 guix-data-service/web/build-server/html.scm       | 13 ++++++++++---
 3 files changed, 18 insertions(+), 6 deletions(-)

diff --git a/guix-data-service/model/build.scm 
b/guix-data-service/model/build.scm
index cd2eb54..8ec0af2 100644
--- a/guix-data-service/model/build.scm
+++ b/guix-data-service/model/build.scm
@@ -245,6 +245,7 @@ ORDER BY latest_build_status.timestamp DESC")
   (define query
     "
 SELECT build_servers.url,
+       builds.build_server_build_id,
        builds.derivation_file_name,
        (
          SELECT JSON_AGG(
@@ -273,8 +274,9 @@ GROUP BY builds.id, build_servers.url, 
builds.derivation_file_name")
                      query
                      (list (number->string build-server-id)
                            build-server-build-id))
-    (((build-server-url derivation-file-name statuses-json))
+    (((build-server-url build-server-build-id derivation-file-name 
statuses-json))
      (list build-server-url
+           build-server-build-id
            derivation-file-name
            (json-string->scm statuses-json)))
     (()
@@ -285,6 +287,7 @@ GROUP BY builds.id, build_servers.url, 
builds.derivation_file_name")
   (define query
     "
 SELECT build_servers.url,
+       builds.build_server_build_id,
        builds.derivation_file_name,
        (
          SELECT JSON_AGG(
@@ -313,10 +316,11 @@ GROUP BY builds.id, build_servers.url, 
builds.derivation_file_name")
                      query
                      (list (number->string build-server-id)
                            derivation-file-name))
-    (((build-server-url derivation-file-name statuses-json))
+    (((build-server-url build-server-build-id derivation-file-name 
statuses-json))
      ;; Returning the derivation-file-name is for consistency with
      ;; select-build-by-build-server-and-build-server-build-id
      (list build-server-url
+           build-server-build-id
            derivation-file-name
            (json-string->scm statuses-json)))
     (()
diff --git a/guix-data-service/web/build-server/controller.scm 
b/guix-data-service/web/build-server/controller.scm
index 9c185c6..8587278 100644
--- a/guix-data-service/web/build-server/controller.scm
+++ b/guix-data-service/web/build-server/controller.scm
@@ -74,7 +74,8 @@
              (view-build query-parameters
                          build
                          (match build
-                           ((url derivation-file-name statuses)
+                           ((build-server-url build-server-build-id
+                                              derivation-file-name statuses)
                             (if (member
                                  (assoc-ref (last (vector->list statuses))
                                             "status")
diff --git a/guix-data-service/web/build-server/html.scm 
b/guix-data-service/web/build-server/html.scm
index 0078e8e..f16a570 100644
--- a/guix-data-service/web/build-server/html.scm
+++ b/guix-data-service/web/build-server/html.scm
@@ -40,7 +40,8 @@
       (div
        (@ (class "row"))
        ,@(match build
-           ((url derivation-file-name statuses)
+           ((build-server-url build-server-build-id
+                              derivation-file-name statuses)
             `((div
                (@ (class "col-sm-6"))
                (dl
@@ -48,8 +49,14 @@
                 (dt "Derivation")
                 (dd ,(display-possible-store-item derivation-file-name))
                 (dt "Build server URL")
-                (dd (a (@ (href ,url))
-                       ,url))))
+                (dd (a (@ (href ,build-server-url))
+                       ,build-server-url)))
+               (a (@ (style "display: inline-block; margin-top: 0.4em;")
+                     (href ,(build-server-link-url
+                             build-server-url
+                             build-server-build-id
+                             derivation-file-name)))
+                  "View build on " ,build-server-url))
               (div
                (@ (class "col-sm-6"))
                (h3 "Timeline")