mirror of
git://git.savannah.gnu.org/guix/data-service.git
synced 2023-12-14 03:23:03 +01:00
Add a page for each build
This commit is contained in:
parent
a59f352046
commit
308d1d7102
3 changed files with 84 additions and 1 deletions
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue