Implement more support for builds from the Guix Build Coordinator

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

View file

@ -284,6 +284,7 @@ WHERE derivation_output_details.path = $1"
conn
build-server-id
derivation
#f
#:derivation-output-details-set-id
(match
(vhash-assoc
@ -333,7 +334,8 @@ WHERE derivation_output_details.path = $1"
(let ((build-id
(ensure-build-exists conn
build-server-id
(assoc-ref data "derivation"))))
(assoc-ref data "derivation")
#f)))
(insert-build-statuses-from-data
conn
build-server-id

View file

@ -23,6 +23,7 @@
#:export (select-build-stats
select-builds-with-context
select-builds-with-context-by-derivation-file-name
select-build-by-build-server-and-build-server-build-id
select-build-by-build-server-and-derivation-file-name
select-required-builds-that-failed
update-builds-derivation-output-details-set-id
@ -198,6 +199,7 @@ LIMIT 100"))
"
SELECT build_servers.id,
build_servers.url,
builds.build_server_build_id,
latest_build_status.timestamp,
latest_build_status.status
FROM builds
@ -219,11 +221,50 @@ ORDER BY latest_build_status.timestamp DESC")
(exec-query conn query (list derivation-file-name)))
(define (select-build-by-build-server-and-build-server-build-id
conn build-server-id build-server-build-id)
(define query
"
SELECT build_servers.url,
builds.derivation_file_name,
JSON_AGG(
json_build_object(
'timestamp', build_status.timestamp,
'status', build_status.status
)
ORDER BY build_status.timestamp
) AS statuses
FROM builds
INNER JOIN build_servers
ON build_servers.id = builds.build_server_id
INNER JOIN build_status
ON builds.id = build_status.build_id
INNER JOIN derivations_by_output_details_set
ON builds.derivation_output_details_set_id =
derivations_by_output_details_set.derivation_output_details_set_id
INNER JOIN derivations
ON derivations.id = derivations_by_output_details_set.derivation_id
WHERE build_server_id = $1 AND
builds.build_server_build_id = $2
GROUP BY build_servers.url, builds.derivation_file_name")
(match (exec-query conn
query
(list (number->string build-server-id)
build-server-build-id))
(((build-server-url derivation-file-name statuses-json))
(list build-server-url
derivation-file-name
(json-string->scm statuses-json)))
(()
#f)))
(define (select-build-by-build-server-and-derivation-file-name
conn build-server-id derivation-file-name)
(define query
"
SELECT build_servers.url,
builds.derivation_file_name,
JSON_AGG(
json_build_object(
'timestamp', build_status.timestamp,
@ -243,14 +284,17 @@ INNER JOIN derivations
ON derivations.id = derivations_by_output_details_set.derivation_id
WHERE build_server_id = $1 AND
derivations.file_name = $2
GROUP BY build_servers.url")
GROUP BY build_servers.url, builds.derivation_file_name")
(match (exec-query conn
query
(list (number->string build-server-id)
derivation-file-name))
(((build-server-url statuses-json))
(((build-server-url derivation-file-name statuses-json))
;; Returning the derivation-file-name is for consistency with
;; select-build-by-build-server-and-build-server-build-id
(list build-server-url
derivation-file-name
(json-string->scm statuses-json)))
(()
#f)))
@ -310,6 +354,23 @@ WHERE build_server_id = $1 AND derivation_file_name = $2")
(_
#f)))
(define (select-build-id-by-build-server-and-build-server-build-id
conn build-server-id build-server-build-id)
(define query
"
SELECT id
FROM builds
WHERE build_server_id = $1 AND build_server_build_id = $2")
(match (exec-query conn
query
(list (number->string build-server-id)
build-server-build-id))
(((id))
(string->number id))
(_
#f)))
(define (update-builds-derivation-output-details-set-id conn derivation-file-names)
(exec-query
conn
@ -344,16 +405,21 @@ WHERE derivations.file_name = $1"
(_
#f)))
(define (insert-builds conn build-server-id derivation-file-names)
(define (insert-builds conn build-server-id derivation-file-names
build-server-build-ids)
(let ((build-ids
(insert-missing-data-and-return-all-ids
conn
"builds"
'(build_server_id derivation_file_name)
(map (lambda (derivation-file-name)
'(build_server_id derivation_file_name build_server_build_id)
(map (lambda (derivation-file-name build-server-build-id)
(list build-server-id
derivation-file-name))
derivation-file-names)
derivation-file-name
(if (string? build-server-build-id)
build-server-build-id
'())))
derivation-file-names
build-server-build-ids)
#:delete-duplicates? #t)))
(exec-query
@ -375,13 +441,15 @@ UPDATE builds SET derivation_output_details_set_id = (
build-ids))
(define* (insert-build conn build-server-id derivation-file-name
build-server-build-id
#:key derivation-output-details-set-id)
(match (exec-query
conn
(string-append
"
INSERT INTO builds
(build_server_id, derivation_file_name, derivation_output_details_set_id)
(build_server_id, derivation_file_name, derivation_output_details_set_id,
build_server_build_id)
VALUES ("
(number->string build-server-id)
", "
@ -396,6 +464,10 @@ VALUES ("
derivation-file-name))
number->string)
"NULL")
", "
(or (and=> build-server-build-id
quote-string)
"NULL")
")
RETURNING (id)"))
(((id))
@ -404,10 +476,14 @@ RETURNING (id)"))
(define* (ensure-build-exists conn
build-server-id
derivation-file-name
build-server-build-id
#:key derivation-output-details-set-id)
(let ((existing-build-id
(select-build-id-by-build-server-and-derivation-file-name
conn build-server-id derivation-file-name)))
(if build-server-build-id
(select-build-id-by-build-server-and-build-server-build-id
conn build-server-id build-server-build-id)
(select-build-id-by-build-server-and-derivation-file-name
conn build-server-id derivation-file-name))))
(if existing-build-id
(begin
@ -423,5 +499,6 @@ WHERE builds.id = $1 AND derivation_output_details_set_id IS NULL"
(insert-build conn
build-server-id
derivation-file-name
build-server-build-id
#:derivation-output-details-set-id
derivation-output-details-set-id))))

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)

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

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