diff options
| -rw-r--r-- | Makefile.am | 2 | ||||
| -rw-r--r-- | bffe/server.scm | 44 | ||||
| -rw-r--r-- | bffe/view/agent.scm | 41 | ||||
| -rw-r--r-- | bffe/view/build.scm | 51 |
4 files changed, 126 insertions, 12 deletions
diff --git a/Makefile.am b/Makefile.am index bcbec65..0bbeb9e 100644 --- a/Makefile.am +++ b/Makefile.am @@ -31,6 +31,8 @@ SOURCES = \ bffe/server.scm \ bffe/view/util.scm \ bffe/view/home.scm \ + bffe/view/build.scm \ + bffe/view/agent.scm \ bffe/view/activity.scm install-data-local: diff --git a/bffe/server.scm b/bffe/server.scm index cf1fa30..4c24559 100644 --- a/bffe/server.scm +++ b/bffe/server.scm @@ -42,7 +42,7 @@ #:use-module (fibers channels) #:use-module (fibers conditions) #:use-module (fibers web server) - #:use-module (guix store) + #:use-module ((guix store) #:select (%store-prefix)) #:use-module ((guix build utils) #:select (dump-port)) #:use-module (guix-data-service web util) #:use-module ((guix-build-coordinator utils) @@ -53,6 +53,8 @@ #:use-module (guix-build-coordinator client-communication) #:use-module (bffe view util) #:use-module (bffe view home) + #:use-module (bffe view build) + #:use-module (bffe view agent) #:use-module (bffe view activity) #:export (start-bffe-web-server)) @@ -436,28 +438,46 @@ body (http-get (string->uri - (string-append event-source "/build/" uuid))))) - (render-json - (json-string->scm - (utf8->string body))))) + (string-append event-source "/build/" uuid + ;; ".json" + ))))) + (case (most-appropriate-mime-type + '(application/json text/html) + mime-types) + ((application/json) + (render-json + (json-string->scm + (utf8->string body)))) + (else + (render-html + #:sxml (build title + (json-string->scm + (utf8->string body)))))))) (('GET "agent" agent-id) (let ((response body (http-get (string->uri (string-append event-source "/agent/" agent-id))))) - (render-json - (json-string->scm - (utf8->string body))))) - (('GET "agent" agent-id (or "build-allocation-plan" - ;; TODO Remove underscore variant - "build_allocation_plan")) + (case (most-appropriate-mime-type + '(application/json text/html) + mime-types) + ((application/json) + (render-json + (json-string->scm + (utf8->string body)))) + (else + (render-html + #:sxml (agent title + (json-string->scm + (utf8->string body)))))))) + (('GET "agent" agent-id "build-allocation-plan") (let ((response body (http-get (string->uri (string-append event-source "/agent/" agent-id - "/build_allocation_plan"))))) + "/build-allocation-plan"))))) (render-json (json-string->scm (utf8->string body))))) diff --git a/bffe/view/agent.scm b/bffe/view/agent.scm new file mode 100644 index 0000000..e210402 --- /dev/null +++ b/bffe/view/agent.scm @@ -0,0 +1,41 @@ +(define-module (bffe view agent) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-19) + #:use-module (ice-9 match) + #:use-module (ice-9 format) + #:use-module (bffe view util) + #:use-module ((guix store) #:select (%store-prefix)) + #:export (agent)) + +(define (agent title agent-details) + (layout + #:title (string-append "Agent " + (assoc-ref agent-details "id") + " — " title) + #:body + `((main + (dl + (dt "Description") + (dd ,(assoc-ref agent-details "description")) + + (dt "Tags") + (dd (ul + ,@(map (lambda (tag) + `(li ,(assoc-ref tag "key") ": " + ,(assoc-ref tag "value"))) + (vector->list + (assoc-ref agent-details "tags"))))) + + (dt "Allocated builds") + (dl (ul + ,@(map (lambda (build) + `(li + (a (@ (href + ,(string-append "/build/" + (assoc-ref build "uuid")))) + ,(assoc-ref build "derivation_name") + " (derived priority: " + ,(assoc-ref build "derived_priority") + ")"))) + (vector->list + (assoc-ref agent-details "allocated_builds")))))))))) diff --git a/bffe/view/build.scm b/bffe/view/build.scm new file mode 100644 index 0000000..be33467 --- /dev/null +++ b/bffe/view/build.scm @@ -0,0 +1,51 @@ +(define-module (bffe view build) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-19) + #:use-module (ice-9 match) + #:use-module (ice-9 format) + #:use-module (bffe view util) + #:use-module ((guix store) #:select (%store-prefix)) + #:export (build)) + +(define (build title build-details) + (layout + #:title (string-append + "Build " (assoc-ref build-details "uuid") " — " title) + #:body + `((main + (dl + (dt "Derivation") + (dd ,(assoc-ref build-details "derivation-name")) + + (dt "Tags") + (dd (ul + ,@(map (lambda (tag) + `(li ,(assoc-ref tag "key") ": " + ,(assoc-ref tag "value"))) + (vector->list + (assoc-ref build-details "tags"))))) + + (dt "Submitted at") + (dd ,(assoc-ref build-details "created-at")) + + (dt "State") + (dd ,(if (assoc-ref build-details "cancelled") + "Canceled" + (if (assoc-ref build-details "processed") + (if (string=? (assoc-ref + (assoc-ref build-details "result") + "result") + "success") + "Succeeded" + "Failed") + "Pending"))) + + (dt "Priority") + (dd ,(assoc-ref build-details "priority"))) + + ,@(if (assoc-ref build-details "processed") + `((a (@ (href ,(string-append "/build/" + (assoc-ref build-details "uuid") + "/log"))) + "View build log")) + '()))))) |