guix/data-service
2
0
Fork 0
mirror of git://git.savannah.gnu.org/guix/data-service.git synced 2023-12-14 03:23:03 +01:00
Code Issues Releases Wiki Activity

Add a page for each build

Browse source
This commit is contained in:
Christopher Baines 2019-12-15 10:33:45 +00:00
parent a59f352046
commit 308d1d7102
3 changed files with 84 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
guix-data-service/model/build.scm
View file

@ -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

35
guix-data-service/web/build-server/controller.scm
View file

@ -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

49
guix-data-service/web/build-server/html.scm
View file

@ -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