diff options
| -rw-r--r-- | guix-data-service/builds.scm | 4 | ||||
| -rw-r--r-- | guix-data-service/model/build.scm | 97 | ||||
| -rw-r--r-- | guix-data-service/web/build-server/controller.scm | 23 | ||||
| -rw-r--r-- | guix-data-service/web/build-server/html.scm | 12 | ||||
| -rw-r--r-- | guix-data-service/web/view/html.scm | 21 |
5 files changed, 128 insertions, 29 deletions
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 |