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)
|
(define-module (guix-data-service model build)
|
||||||
#:use-module (ice-9 match)
|
#:use-module (ice-9 match)
|
||||||
#:use-module (squee)
|
#:use-module (squee)
|
||||||
|
#:use-module (json)
|
||||||
#:use-module (guix-data-service model utils)
|
#:use-module (guix-data-service model utils)
|
||||||
#:export (select-build-stats
|
#:export (select-build-stats
|
||||||
select-builds-with-context
|
select-builds-with-context
|
||||||
|
|
|
@ -32,6 +32,32 @@
|
||||||
#:use-module (guix-data-service web build-server html)
|
#:use-module (guix-data-service web build-server html)
|
||||||
#:export (build-server-controller))
|
#: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
|
(define (handle-build-event-submission parsed-query-parameters
|
||||||
build-server-id-string
|
build-server-id-string
|
||||||
body
|
body
|
||||||
|
@ -139,6 +165,15 @@
|
||||||
conn
|
conn
|
||||||
secret-key-base)
|
secret-key-base)
|
||||||
(match method-and-path-components
|
(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")
|
(('POST "build-server" build-server-id "build-events")
|
||||||
(let ((parsed-query-parameters
|
(let ((parsed-query-parameters
|
||||||
(parse-query-parameters
|
(parse-query-parameters
|
||||||
|
|
|
@ -16,9 +16,56 @@
|
||||||
;;; <http://www.gnu.org/licenses/>.
|
;;; <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
(define-module (guix-data-service web build-server html)
|
(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 view html)
|
||||||
#:use-module (guix-data-service web html-utils)
|
#: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)
|
(define (view-signing-key sexp)
|
||||||
(layout
|
(layout
|
||||||
|
|
Loading…
Reference in a new issue