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

4
guix-data-service/builds.scm
View file

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

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

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

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

@ -53,18 +53,25 @@
#f)))) #f))))
(let* ((derivation-file-name (let* ((derivation-file-name
(assq-ref query-parameters 'derivation_file_name)) (assq-ref query-parameters 'derivation_file_name))
(build-server-build-id
(assq-ref query-parameters 'build_server_build_id))
(build (build
(select-build-by-build-server-and-derivation-file-name (if build-server-build-id
conn (select-build-by-build-server-and-build-server-build-id
build-server-id conn
derivation-file-name))) 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 (if build
(render-html (render-html
#:sxml #:sxml
(view-build query-parameters (view-build query-parameters
build build
(if (string=? (if (string=?
(assoc-ref (last (vector->list (second build))) (assoc-ref (last (vector->list (third build)))
"status") "status")
"failed-dependency") "failed-dependency")
(select-required-builds-that-failed (select-required-builds-that-failed
@ -105,6 +112,9 @@
build-server-id build-server-id
(map (lambda (item) (map (lambda (item)
(assoc-ref item "derivation")) (assoc-ref item "derivation"))
items)
(map (lambda (item)
(assoc-ref item "build_id"))
items)))) items))))
(insert-build-statuses (insert-build-statuses
conn conn
@ -212,7 +222,8 @@
(let ((parsed-query-parameters (let ((parsed-query-parameters
(parse-query-parameters (parse-query-parameters
request request
`((derivation_file_name ,identity #:required))))) `((derivation_file_name ,identity)
(build_server_build_id ,identity)))))
(render-build mime-types (render-build mime-types
conn conn
(string->number build-server-id) (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 (define (view-build query-parameters
build build
required-failed-builds) required-failed-builds)
(define derivation
(assq-ref query-parameters 'derivation_file_name))
(layout (layout
#:body #:body
`(,(header) `(,(header)
@ -43,13 +40,13 @@
(div (div
(@ (class "row")) (@ (class "row"))
,@(match build ,@(match build
((url statuses) ((url derivation-file-name statuses)
`((div `((div
(@ (class "col-sm-6")) (@ (class "col-sm-6"))
(dl (dl
(@ (class "dl-horizontal")) (@ (class "dl-horizontal"))
(dt "Derivation") (dt "Derivation")
(dd ,(display-possible-store-item derivation)) (dd ,(display-possible-store-item derivation-file-name))
(dt "Build server URL") (dt "Build server URL")
(dd (a (@ (href ,url)) (dd (a (@ (href ,url))
,url)))) ,url))))
@ -65,7 +62,10 @@
(tbody (tbody
,@(map (lambda (status) ,@(map (lambda (status)
`(tr `(tr
(td ,(assoc-ref status "timestamp")) (td ,(let ((timestamp (assoc-ref status "timestamp")))
(if (eq? timestamp 'null)
"(unknown)"
timestamp)))
(td ,(build-status-span (td ,(build-status-span
(assoc-ref status "status"))))) (assoc-ref status "status")))))
(vector->list statuses))))))))) (vector->list statuses)))))))))

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

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