From 919255033121c0aeab6c4c16d58359a07b3408b5 Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Sun, 28 Jun 2020 21:54:11 +0100 Subject: 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. --- guix-data-service/builds.scm | 4 +- guix-data-service/model/build.scm | 97 ++++++++++++++++++++--- guix-data-service/web/build-server/controller.scm | 23 ++++-- guix-data-service/web/build-server/html.scm | 12 +-- guix-data-service/web/view/html.scm | 21 +++-- 5 files changed, 128 insertions(+), 29 deletions(-) (limited to 'guix-data-service') diff --git a/guix-data-service/builds.scm b/guix-data-service/builds.scm index c3421b9..20cf094 100644 --- a/guix-data-service/builds.scm +++ b/guix-data-service/builds.scm @@ -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 diff --git a/guix-data-service/model/build.scm b/guix-data-service/model/build.scm index 2a2cf99..9e81611 100644 --- a/guix-data-service/model/build.scm +++ b/guix-data-service/model/build.scm @@ -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)))) diff --git a/guix-data-service/web/build-server/controller.scm b/guix-data-service/web/build-server/controller.scm index c9db9a0..c68ef7d 100644 --- a/guix-data-service/web/build-server/controller.scm +++ b/guix-data-service/web/build-server/controller.scm @@ -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) diff --git a/guix-data-service/web/build-server/html.scm b/guix-data-service/web/build-server/html.scm index 319ab79..0078e8e 100644 --- a/guix-data-service/web/build-server/html.scm +++ b/guix-data-service/web/build-server/html.scm @@ -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))))))))) diff --git a/guix-data-service/web/view/html.scm b/guix-data-service/web/view/html.scm index d734cd0..cf5421a 100644 --- a/guix-data-service/web/view/html.scm +++ b/guix-data-service/web/view/html.scm @@ -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 -- cgit v1.2.3