diff options
| author | Christopher Baines <mail@cbaines.net> | 2022-07-08 13:48:08 +0100 |
|---|---|---|
| committer | Christopher Baines <mail@cbaines.net> | 2022-07-08 13:48:08 +0100 |
| commit | 788571f53f7d4ec8b46a48f05dec73ec7d46453f (patch) | |
| tree | a98a2d41b9cf081f6d4bc3e897cc7d75303031b4 | |
| parent | 6da5e8e67b4a5241243abbae812c4b9ba2bbb5cd (diff) | |
| download | data-service-788571f53f7d4ec8b46a48f05dec73ec7d46453f.tar data-service-788571f53f7d4ec8b46a48f05dec73ec7d46453f.tar.gz | |
Set builds derivation output details set id if information available
The build event information can now contain the derivation outputs, as well as
the name of the derivation. This allows the Guix Data Service to join builds
up with derivations, even if it doesn't know about the derivation being built.
| -rw-r--r-- | guix-data-service/model/build.scm | 26 | ||||
| -rw-r--r-- | guix-data-service/web/build-server/controller.scm | 32 |
2 files changed, 49 insertions, 9 deletions
diff --git a/guix-data-service/model/build.scm b/guix-data-service/model/build.scm index d6f911b..92d4969 100644 --- a/guix-data-service/model/build.scm +++ b/guix-data-service/model/build.scm @@ -23,6 +23,7 @@ #:use-module (json) #:use-module (guix-data-service database) #:use-module (guix-data-service model utils) + #:use-module (guix-data-service model derivation) #:use-module (guix-data-service model system) #:export (select-build-stats select-builds-with-context @@ -470,7 +471,10 @@ 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 + derivation-output-details-lists build-server-build-ids) (let ((build-ids (insert-missing-data-and-return-all-ids @@ -487,6 +491,26 @@ WHERE derivations.file_name = $1" build-server-build-ids) #:delete-duplicates? #t))) + (for-each + (lambda (build-id derivation-output-details) + (and=> + derivation-output-details + (lambda (details) + (let ((derivation-output-details-set-id + (derivation-output-details-ids->derivation-output-details-set-id + conn + (derivation-output-details->derivation-output-details-ids + conn + details)))) + (exec-query + conn + " +UPDATE builds SET derivation_output_details_set_id = $1 WHERE id = $2" + (list (number->string derivation-output-details-set-id) + (number->string build-id))))))) + build-ids + derivation-output-details-lists) + (exec-query conn (string-append diff --git a/guix-data-service/web/build-server/controller.scm b/guix-data-service/web/build-server/controller.scm index a91a1b0..73b105f 100644 --- a/guix-data-service/web/build-server/controller.scm +++ b/guix-data-service/web/build-server/controller.scm @@ -120,14 +120,30 @@ (define (handle-derivation-events conn items) (unless (null? items) (let ((build-ids - (insert-builds conn - build-server-id - (map (lambda (item) - (assoc-ref item "derivation")) - items) - (map (lambda (item) - (assoc-ref item "build_id")) - items)))) + (insert-builds + conn + build-server-id + (map (lambda (item) + (assoc-ref item "derivation")) + items) + (map (lambda (item) + (and=> + (assoc-ref item "derivation_outputs") + (lambda (outputs) + (map + (lambda (output) + `((path . ,(assoc-ref output "output")) + (hash_algorithm + . ,(or (assoc-ref output "hash_algorithm") + NULL)) + (hash . ,(or (assoc-ref output "hash") + NULL)) + (recursive . ,(assoc-ref output "recursive")))) + (vector->list outputs))))) + items) + (map (lambda (item) + (assoc-ref item "build_id")) + items)))) (insert-build-statuses conn build-ids |