diff options
| author | Christopher Baines <mail@cbaines.net> | 2023-10-15 12:19:28 +0100 |
|---|---|---|
| committer | Christopher Baines <mail@cbaines.net> | 2023-10-15 12:19:28 +0100 |
| commit | f7d2b0edb0aab71178df3fcb24e0dddab6dbd1ea (patch) | |
| tree | 584a45ebf8a06f4baf4d1105e1806ba4a8a2094f | |
| parent | 41ae60bbb755591526953d15e2cf7519bf42b4d4 (diff) | |
| download | qa-frontpage-f7d2b0edb0aab71178df3fcb24e0dddab6dbd1ea.tar qa-frontpage-f7d2b0edb0aab71178df3fcb24e0dddab6dbd1ea.tar.gz | |
Provide a fallback approach for branch builds
Where the comparison between the master branch isn't available, but the branch
revision has been processed.
| -rw-r--r-- | guix-qa-frontpage/guix-data-service.scm | 20 | ||||
| -rw-r--r-- | guix-qa-frontpage/manage-builds.scm | 85 |
2 files changed, 81 insertions, 24 deletions
diff --git a/guix-qa-frontpage/guix-data-service.scm b/guix-qa-frontpage/guix-data-service.scm index 03bb39d..cd26518 100644 --- a/guix-qa-frontpage/guix-data-service.scm +++ b/guix-qa-frontpage/guix-data-service.scm @@ -21,6 +21,10 @@ guix-data-service-error->sexp + guix-data-service-request + + package-derivations-url + compare-package-derivations-url compare-package-cross-derivations-url compare-package-derivations @@ -166,6 +170,22 @@ (< (guix-data-service-error-response-code exn) 500)))))) +(define* (package-derivations-url commit + #:key system target + no-build-from-build-server) + (string-append + "https://data.qa.guix.gnu.org/revision/" + commit + "/package-derivations.json?" + "system=" system + "&target=" target + "&field=" "(no-additional-fields)" + "&all_results=" "on" + (if no-build-from-build-server + (string-append + "&no_build_from_build_server=" no-build-from-build-server) + ""))) + (define* (compare-package-derivations-url base-and-target-refs #:key systems) (string-append "https://data.qa.guix.gnu.org/compare/package-derivations.json?" diff --git a/guix-qa-frontpage/manage-builds.scm b/guix-qa-frontpage/manage-builds.scm index 7408e7d..3dca456 100644 --- a/guix-qa-frontpage/manage-builds.scm +++ b/guix-qa-frontpage/manage-builds.scm @@ -276,31 +276,68 @@ #:ttl 0)) #:unwind? #t))) - (when derivation-changes-data - (let ((target-commit - (assoc-ref - (assoc-ref - (assoc-ref derivation-changes-data - "revisions") - "target") - "commit"))) + (if derivation-changes-data + (let ((target-commit + (assoc-ref + (assoc-ref + (assoc-ref derivation-changes-data + "revisions") + "target") + "commit"))) + + (insert-into-builds-to-cancel-later database + "branch" + branch) + (let ((derivations-and-priorities + build-ids-to-keep-set + (derivation-changes->builds-to-keep-and-submit + derivation-changes-data + priority))) + (submit-builds-for-category build-coordinator + guix-data-service + 'branch + branch + derivations-and-priorities + build-ids-to-keep-set + target-commit + #:threads 4))) + (begin + (simple-format + (current-error-port) + "attempting to submit builds for all derivations for branch ~A\n" + branch) - (insert-into-builds-to-cancel-later database - "branch" - branch) - (let ((derivations-and-priorities - build-ids-to-keep-set - (derivation-changes->builds-to-keep-and-submit - derivation-changes-data - priority))) - (submit-builds-for-category build-coordinator - guix-data-service - 'branch - branch - derivations-and-priorities - build-ids-to-keep-set - target-commit - #:threads 4))))) + (let ((derivations-and-priorities + (fold + (lambda (system result) + (vector-fold-right + (lambda (_ result derivation) + (cons + (list + (assoc-ref derivation "derivation") + (if (number? priority) + priority + (priority derivation))) + result)) + result + (assoc-ref + (guix-data-service-request + (package-derivations-url + branch-commit + #:system system + #:target "" + #:no-build-from-build-server "2")) + "derivations"))) + '() + %systems-to-submit-builds-for))) + (submit-builds-for-category build-coordinator + guix-data-service + 'branch + branch + derivations-and-priorities + (set) + branch-commit + #:threads 4))))) (simple-format #t "no derivation changes url for branch ~A\n" branch)))) |