Add a basic page for build servers

guix-data-service/model/build-server.scm

@@ -18,7 +18,8 @@
 (define-module (guix-data-service model build-server)
   #:use-module (ice-9 match)
   #:use-module (squee)
-  #:export (select-build-servers))
+  #:export (select-build-servers
+            select-build-server))
 
 (define (select-build-servers conn)
   (define query
@@ -34,3 +35,17 @@ ORDER BY id")
             url
             (string=? lookup-all-derivations "t"))))
    (exec-query conn query)))
+
+(define (select-build-server conn id)
+  (define query
+    "
+SELECT url, lookup_all_derivations
+FROM build_servers
+WHERE id = $1")
+
+  (match (exec-query conn query (list (number->string id)))
+    (()
+     #f)
+    (((url lookup_all_derivations))
+     (list url
+           (string=? lookup_all_derivations "t")))))

guix-data-service/web/build-server/controller.scm

@@ -25,6 +25,7 @@
   #:use-module (guix-data-service web query-parameters)
   #:use-module (guix-data-service jobs load-new-guix-revision)
   #:use-module (guix-data-service model build)
+  #:use-module (guix-data-service model build-server)
   #:use-module (guix-data-service model build-status)
   #:use-module (guix-data-service model nar)
   #:use-module (guix-data-service model build-server-token-seed)
@@ -77,6 +78,12 @@
                      "No build found for this build server and derivation.")
              #:code 404)))))
 
+(define (render-build-server mime-types
+                             build-server)
+  (render-html
+   #:sxml
+   (view-build-server build-server)))
+
 (define (handle-build-event-submission parsed-query-parameters
                                        build-server-id-string
                                        body
@@ -184,6 +191,13 @@
                                  conn
                                  secret-key-base)
   (match method-and-path-components
+    (('GET "build-server" build-server-id)
+     (let ((build-server (select-build-server conn (string->number
+                                                    build-server-id))))
+       (if build-server
+           (render-build-server mime-types
+                                build-server)
+           (general-not-found "Build server not found" ""))))
     (('GET "build-server" build-server-id "build")
      (let ((parsed-query-parameters
             (parse-query-parameters

guix-data-service/web/build-server/html.scm

@@ -20,6 +20,7 @@
   #:use-module (guix-data-service web view html)
   #:use-module (guix-data-service web html-utils)
   #:export (view-build
+            view-build-server
             view-signing-key))
 
 (define (view-build query-parameters
@@ -88,6 +89,29 @@
                          required-failed-builds))))))
             '())))))
 
+(define (view-build-server build-server)
+  (layout
+   #:body
+   `(,(header)
+     (div
+      (@ (class "container"))
+      (div
+       (@ (class "row"))
+       (div
+        (@ (class "col-sm-12"))
+        (h2 "Build server")
+        ,(match build-server
+           ((url lookup-all-derivations?)
+            `(dl
+              (@ (class "dl-horizontal"))
+              (dt "URL")
+              (dd (a (@ (href ,url))
+                     ,url))
+              (dt "Lookup all " (br) "derivations?")
+              (dd ,(if lookup-all-derivations?
+                       "Yes"
+                       "No")))))))))))
+
 (define (view-signing-key sexp)
   (layout
    #:body