diff options
| author | Christopher Baines <mail@cbaines.net> | 2020-02-01 13:12:01 +0100 |
|---|---|---|
| committer | Christopher Baines <mail@cbaines.net> | 2020-02-01 13:12:01 +0100 |
| commit | 6bc753dd0e3f277128a1fe0687720fd1e66b430f (patch) | |
| tree | e51c18b0f3058f123ce0ee5130851fe3a800c983 | |
| parent | e5e9442b44ec03918501d85f991b65cd5bb545c6 (diff) | |
| download | data-service-6bc753dd0e3f277128a1fe0687720fd1e66b430f.tar data-service-6bc753dd0e3f277128a1fe0687720fd1e66b430f.tar.gz | |
Add a build servers page
| -rw-r--r-- | guix-data-service/web/build-server/controller.scm | 10 | ||||
| -rw-r--r-- | guix-data-service/web/build-server/html.scm | 26 | ||||
| -rw-r--r-- | guix-data-service/web/controller.scm | 2 |
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)) |