diff options
Diffstat (limited to 'guix-data-service')
| -rw-r--r-- | guix-data-service/model/build.scm | 1 | ||||
| -rw-r--r-- | guix-data-service/web/build-server/controller.scm | 35 | ||||
| -rw-r--r-- | guix-data-service/web/build-server/html.scm | 49 |
3 files changed, 84 insertions, 1 deletions
diff --git a/guix-data-service/model/build.scm b/guix-data-service/model/build.scm index 6670246..44fdc94 100644 --- a/guix-data-service/model/build.scm +++ b/guix-data-service/model/build.scm @@ -1,6 +1,7 @@ (define-module (guix-data-service model build) #:use-module (ice-9 match) #:use-module (squee) + #:use-module (json) #:use-module (guix-data-service model utils) #:export (select-build-stats select-builds-with-context diff --git a/guix-data-service/web/build-server/controller.scm b/guix-data-service/web/build-server/controller.scm index 4ac84dd..accadd2 100644 --- a/guix-data-service/web/build-server/controller.scm +++ b/guix-data-service/web/build-server/controller.scm @@ -32,6 +32,32 @@ #:use-module (guix-data-service web build-server html) #:export (build-server-controller)) +(define (render-build mime-types + conn + build-server-id + query-parameters) + (if (any-invalid-query-parameters? query-parameters) + (case (most-appropriate-mime-type + '(application/json text/html) + mime-types) + ((application/json) + (render-json + `((error . "invalid query")))) + (else + (render-html + #:sxml (view-build query-parameters)))) + (let* ((derivation-file-name + (assq-ref query-parameters 'derivation_file_name)) + (build + (select-build-by-build-server-and-derivation-file-name + conn + build-server-id + derivation-file-name))) + (render-html + #:sxml + (view-build query-parameters + build))))) + (define (handle-build-event-submission parsed-query-parameters build-server-id-string body @@ -139,6 +165,15 @@ conn secret-key-base) (match method-and-path-components + (('GET "build-server" build-server-id "build") + (let ((parsed-query-parameters + (parse-query-parameters + request + `((derivation_file_name ,identity #:required))))) + (render-build mime-types + conn + (string->number build-server-id) + parsed-query-parameters))) (('POST "build-server" build-server-id "build-events") (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 9bb70eb..44c9936 100644 --- a/guix-data-service/web/build-server/html.scm +++ b/guix-data-service/web/build-server/html.scm @@ -16,9 +16,56 @@ ;;; <http://www.gnu.org/licenses/>. (define-module (guix-data-service web build-server html) + #:use-module (ice-9 match) #:use-module (guix-data-service web view html) #:use-module (guix-data-service web html-utils) - #:export (view-signing-key)) + #:export (view-build + view-signing-key)) + +(define (view-build query-parameters + build) + (define derivation + (assq-ref query-parameters 'derivation_file_name)) + + (layout + #:body + `(,(header) + (div + (@ (class "container")) + (div + (@ (class "row")) + (div + (@ (class "col-sm-12")) + (h1 "Build"))) + (div + (@ (class "row")) + ,@(match build + ((url statuses) + `((div + (@ (class "col-sm-6")) + (dl + (@ (class "dl-horizontal")) + (dt "Derivation") + (dd ,(display-possible-store-item derivation)) + (dt "Build server URL") + (dd (a (@ (href ,url)) + ,url)))) + (div + (@ (class "col-sm-6")) + (h3 "Timeline") + (table + (@ (class "table")) + (thead + (tr + (th "Timestamp") + (th "Status"))) + (tbody + ,@(map (lambda (status) + `(tr + (td ,(assoc-ref status "timestamp")) + (td ,(build-status-span + (assoc-ref status "status"))))) + (vector->list statuses))))))))))))) (define (view-signing-key sexp) (layout |