cbaines/guix-data-service
1
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Implement more support for builds from the Guix Build Coordinator

Browse source 
Builds from the Guix Build Coordinator might not have timestamps, and the id
from the build server is more important, as one build server can build the
same derivation many times.
This commit is contained in:
Christopher Baines 2020-06-28 21:54:11 +01:00
parent 879021f21f
commit 9192550331
5 changed files with 128 additions and 29 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -53,18 +53,25 @@
#f))))
(let* ((derivation-file-name
(assq-ref query-parameters 'derivation_file_name))
(build-server-build-id
(assq-ref query-parameters 'build_server_build_id))
(build
(select-build-by-build-server-and-derivation-file-name
conn
build-server-id
derivation-file-name)))
(if build-server-build-id
(select-build-by-build-server-and-build-server-build-id
conn
build-server-id
build-server-build-id)
(select-build-by-build-server-and-derivation-file-name
conn
build-server-id
derivation-file-name))))
(if build
(render-html
#:sxml
(view-build query-parameters
build
(if (string=?
(assoc-ref (last (vector->list (second build)))
(assoc-ref (last (vector->list (third build)))
"status")
"failed-dependency")
(select-required-builds-that-failed
@ -105,6 +112,9 @@
build-server-id
(map (lambda (item)
(assoc-ref item "derivation"))
items)
(map (lambda (item)
(assoc-ref item "build_id"))
items))))
(insert-build-statuses
conn
@ -212,7 +222,8 @@
(let ((parsed-query-parameters
(parse-query-parameters
request
`((derivation_file_name ,identity #:required)))))
`((derivation_file_name ,identity)
(build_server_build_id ,identity)))))
(render-build mime-types
conn
(string->number build-server-id)

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

@ -27,9 +27,6 @@
(define (view-build query-parameters
build
required-failed-builds)
(define derivation
(assq-ref query-parameters 'derivation_file_name))
(layout
#:body
`(,(header)
@ -43,13 +40,13 @@
(div
(@ (class "row"))
,@(match build
((url statuses)
((url derivation-file-name statuses)
`((div
(@ (class "col-sm-6"))
(dl
(@ (class "dl-horizontal"))
(dt "Derivation")
(dd ,(display-possible-store-item derivation))
(dd ,(display-possible-store-item derivation-file-name))
(dt "Build server URL")
(dd (a (@ (href ,url))
,url))))
@ -65,7 +62,10 @@
(tbody
,@(map (lambda (status)
`(tr
(td ,(assoc-ref status "timestamp"))
(td ,(let ((timestamp (assoc-ref status "timestamp")))
(if (eq? timestamp 'null)
"(unknown)"
timestamp)))
(td ,(build-status-span
(assoc-ref status "status")))))
(vector->list statuses)))))))))

21
guix-data-service/web/view/html.scm
View file

@ -631,15 +631,24 @@ time."
,(build-status-span "")))
(map
(match-lambda
((build-server-id build-server-url timestamp status)
((build-server-id build-server-url
build-server-build-id
timestamp status)
(define build-url
(if (string? build-server-build-id)
(simple-format
#f "/build-server/~A/build?build_server_build_id=~A"
build-server-id
build-server-build-id)
(simple-format
#f "/build-server/~A/build?derivation_file_name=~A"
build-server-id
(second derivation))))
`(div
(@ (class "text-center"))
(div
(a (@ (href
,(simple-format
#f "/build-server/~A/build?derivation_file_name=~A"
build-server-id
(second derivation))))
(a (@ (href ,build-url))
,(build-status-span status)))
(a (@ (style "display: inline-block; margin-top: 0.4em;")
(href ,(simple-format