aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Makefile.am2
-rw-r--r--bffe/server.scm44
-rw-r--r--bffe/view/agent.scm41
-rw-r--r--bffe/view/build.scm51
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"))
+ '())))))