aboutsummaryrefslogtreecommitdiff
path: root/guix-data-service
diff options
context:
space:
mode:
authorChristopher Baines <mail@cbaines.net>2020-02-01 13:12:01 +0100
committerChristopher Baines <mail@cbaines.net>2020-02-01 13:12:01 +0100
commit6bc753dd0e3f277128a1fe0687720fd1e66b430f (patch)
treee51c18b0f3058f123ce0ee5130851fe3a800c983 /guix-data-service
parente5e9442b44ec03918501d85f991b65cd5bb545c6 (diff)
downloaddata-service-6bc753dd0e3f277128a1fe0687720fd1e66b430f.tar
data-service-6bc753dd0e3f277128a1fe0687720fd1e66b430f.tar.gz
Add a build servers page
Diffstat (limited to 'guix-data-service')
-rw-r--r--guix-data-service/web/build-server/controller.scm10
-rw-r--r--guix-data-service/web/build-server/html.scm26
-rw-r--r--guix-data-service/web/controller.scm2
3 files changed, 38 insertions, 0 deletions
diff --git a/guix-data-service/web/build-server/controller.scm b/guix-data-service/web/build-server/controller.scm
index 29f8b7a..c9db9a0 100644
--- a/guix-data-service/web/build-server/controller.scm
+++ b/guix-data-service/web/build-server/controller.scm
@@ -78,6 +78,12 @@
"No build found for this build server and derivation.")
#:code 404)))))
+(define (render-build-servers mime-types
+ build-servers)
+ (render-html
+ #:sxml
+ (view-build-servers build-servers)))
+
(define (render-build-server mime-types
build-server)
(render-html
@@ -191,6 +197,10 @@
conn
secret-key-base)
(match method-and-path-components
+ (('GET "build-servers")
+ (let ((build-servers (select-build-servers conn)))
+ (render-build-servers mime-types
+ build-servers)))
(('GET "build-server" build-server-id)
(let ((build-server (select-build-server conn (string->number
build-server-id))))
diff --git a/guix-data-service/web/build-server/html.scm b/guix-data-service/web/build-server/html.scm
index 6936e79..bb15e11 100644
--- a/guix-data-service/web/build-server/html.scm
+++ b/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-servers
view-build-server
view-signing-key))
@@ -89,6 +90,31 @@
required-failed-builds))))))
'())))))
+(define (view-build-servers build-servers)
+ (layout
+ #:body
+ `(,(header)
+ (div
+ (@ (class "container"))
+ (div
+ (@ (class "row"))
+ (div
+ (@ (class "col-sm-12"))
+ (h2 "Build servers")
+ ,@(map
+ (match-lambda
+ ((id 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")))))
+ build-servers)))))))
+
(define (view-build-server build-server)
(layout
#:body
diff --git a/guix-data-service/web/controller.scm b/guix-data-service/web/controller.scm
index 1eb4f20..f8903c9 100644
--- a/guix-data-service/web/controller.scm
+++ b/guix-data-service/web/controller.scm
@@ -315,6 +315,8 @@
(not-found (request-uri request))))
(('GET "gnu" "store" filename "narinfos")
(render-narinfos conn filename))
+ (('GET "build-servers")
+ (delegate-to-with-secret-key-base build-server-controller))
(((or 'GET 'POST) "build-server" _ ...)
(delegate-to-with-secret-key-base build-server-controller))
(('GET "compare" _ ...) (delegate-to compare-controller))