diff options
| author | Christopher Baines <mail@cbaines.net> | 2020-01-05 11:59:58 +0000 |
|---|---|---|
| committer | Christopher Baines <mail@cbaines.net> | 2020-01-05 12:01:06 +0000 |
| commit | c388f3ee1350ed0cee9d31c4f53011449a17f828 (patch) | |
| tree | f4196cb8e5fba8bc733e620fee62b8b2447bc5ca | |
| parent | 726674486f2d9334bcf0b5a608fcfbf7a1327e70 (diff) | |
| download | data-service-c388f3ee1350ed0cee9d31c4f53011449a17f828.tar data-service-c388f3ee1350ed0cee9d31c4f53011449a17f828.tar.gz | |
Add a basic page for build servers
| -rw-r--r-- | guix-data-service/model/build-server.scm | 17 | ||||
| -rw-r--r-- | guix-data-service/web/build-server/controller.scm | 14 | ||||
| -rw-r--r-- | guix-data-service/web/build-server/html.scm | 24 |
3 files changed, 54 insertions, 1 deletions
diff --git a/guix-data-service/model/build-server.scm b/guix-data-service/model/build-server.scm index 40ac08b..44b4b7d 100644 --- a/guix-data-service/model/build-server.scm +++ b/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"))))) diff --git a/guix-data-service/web/build-server/controller.scm b/guix-data-service/web/build-server/controller.scm index 61aea91..29f8b7a 100644 --- a/guix-data-service/web/build-server/controller.scm +++ b/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 diff --git a/guix-data-service/web/build-server/html.scm b/guix-data-service/web/build-server/html.scm index 7cc4f8e..6936e79 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-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 |