diff options
Diffstat (limited to 'guix-qa-frontpage')
| -rw-r--r-- | guix-qa-frontpage/guix-data-service.scm | 75 | ||||
| -rw-r--r-- | guix-qa-frontpage/manage-builds.scm | 9 | ||||
| -rw-r--r-- | guix-qa-frontpage/manage-patch-branches.scm | 21 | ||||
| -rw-r--r-- | guix-qa-frontpage/patchwork.scm | 26 | ||||
| -rw-r--r-- | guix-qa-frontpage/server.scm | 24 |
5 files changed, 52 insertions, 103 deletions
diff --git a/guix-qa-frontpage/guix-data-service.scm b/guix-qa-frontpage/guix-data-service.scm index 9674b18..5b6dd20 100644 --- a/guix-qa-frontpage/guix-data-service.scm +++ b/guix-qa-frontpage/guix-data-service.scm @@ -10,6 +10,7 @@ #:use-module (json) #:use-module (guix-build-coordinator utils) #:use-module (guix-qa-frontpage patchwork) + #:use-module (guix-qa-frontpage manage-patch-branches) #:export (&guix-data-service-error guix-data-service-error? guix-data-service-error-response-body @@ -33,34 +34,21 @@ guix-data-service-error? (response-body guix-data-service-error-response-body)) -(define* (patch-series-derivation-changes-url checks #:key systems) - (define comparison-check - (match (sort (filter (lambda (check) - (string=? (assoc-ref check "context") - "comparison")) - checks) - (lambda (a b) - (string>? (assoc-ref a "date") - (assoc-ref b "date")))) - ((first . rest) first) - (() #f))) - - (and comparison-check - (let ((url-query-params - (uri-query - (string->uri - (assoc-ref comparison-check "target_url"))))) - - (string-append - "https://data.qa.guix.gnu.org/compare/package-derivations.json?" - url-query-params - (string-join - (map (lambda (system) - (simple-format #f "&system=~A" system)) - (or systems '())) - "") - "&target=none" - "&field=builds&limit_results=&all_results=on")))) +(define* (patch-series-derivation-changes-url issue-number #:key systems) + (and=> + (get-issue-branch-base-and-target-refs issue-number) + (lambda (base-and-target) + (string-append + "https://data.qa.guix.gnu.org/compare/package-derivations.json?" + "base_commit=" (assq-ref base-and-target 'base) + "&target_commit=" (assq-ref base-and-target 'target) + (string-join + (map (lambda (system) + (simple-format #f "&system=~A" system)) + (or systems '())) + "") + "&target=none" + "&field=builds&limit_results=&all_results=on")))) (define (patch-series-derivation-changes url) (let-values (((response body) @@ -85,29 +73,14 @@ (alist-delete "derivation_changes" json-body))))))) -(define (patch-series-compare-url series) - (define comparison-check - (match (sort (filter (lambda (check) - (string=? (assoc-ref check "context") - "comparison")) - (patchwork-patch-checks - (assoc-ref (first (assoc-ref series "patches")) - "checks"))) - (lambda (a b) - (string>? (assoc-ref a "date") - (assoc-ref b "date")))) - ((first . rest) first) - (() #f))) - - (and comparison-check - (let ((url-query-params - (uri-query - (string->uri - (assoc-ref comparison-check "target_url"))))) - - (string-append - "https://data.qa.guix.gnu.org/compare.json?" - url-query-params)))) +(define (patch-series-compare-url issue-number) + (and=> + (get-issue-branch-base-and-target-refs issue-number) + (lambda (base-and-target) + (string-append + "https://data.qa.guix.gnu.org/compare.json?" + "base_commit=" (assq-ref base-and-target 'base) + "&target_commit=" (assq-ref base-and-target 'target))))) (define (patch-series-comparison url) (retry-on-error diff --git a/guix-qa-frontpage/manage-builds.scm b/guix-qa-frontpage/manage-builds.scm index 73259a8..e6ce039 100644 --- a/guix-qa-frontpage/manage-builds.scm +++ b/guix-qa-frontpage/manage-builds.scm @@ -50,14 +50,7 @@ (let ((derivation-changes-url (patch-series-derivation-changes-url - (with-sqlite-cache - database - 'patchwork-patch-checks - patchwork-patch-checks - #:args (list - (assoc-ref (first (assoc-ref series "patches")) - "checks")) - #:ttl 0) + issue-number #:systems %systems-to-submit-builds-for))) (if derivation-changes-url diff --git a/guix-qa-frontpage/manage-patch-branches.scm b/guix-qa-frontpage/manage-patch-branches.scm index a7e376d..b48bfa4 100644 --- a/guix-qa-frontpage/manage-patch-branches.scm +++ b/guix-qa-frontpage/manage-patch-branches.scm @@ -19,7 +19,9 @@ #:use-module (guix-qa-frontpage git-repository) #:use-module (guix-qa-frontpage patchwork) #:use-module (guix-qa-frontpage guix-data-service) - #:export (start-manage-patch-branches-thread)) + #:export (start-manage-patch-branches-thread + + get-issue-branch-base-and-target-refs)) (define (run . args) (simple-format (current-error-port) @@ -50,6 +52,21 @@ (cons (match:substring issue-number-match 1) branches)))))))))) +(define (get-issue-branch-base-and-target-refs issue) + (define base-tag + (simple-format #f "base-for-issue-~A" issue)) + + (define target-branch + (simple-format #f "patches/issue-~A" issue)) + + (let ((base (get-commit base-tag)) + (target (get-commit target-branch))) + + (and base + target + `((base . ,base) + (target . ,target))))) + (define* (pwclient-check-create patch-id #:key @@ -268,7 +285,7 @@ (string->number issue-number))) (comparison-url (and series - (patch-series-compare-url series)))) + (patch-series-compare-url issue-number)))) (with-exception-handler (lambda (exn) (if (and diff --git a/guix-qa-frontpage/patchwork.scm b/guix-qa-frontpage/patchwork.scm index fedf849..ffb7292 100644 --- a/guix-qa-frontpage/patchwork.scm +++ b/guix-qa-frontpage/patchwork.scm @@ -13,9 +13,7 @@ #:export (%patchwork-instance patchwork-patches - latest-patchwork-series-by-issue - - patchwork-patch-checks)) + latest-patchwork-series-by-issue)) (define %patchwork-instance (make-parameter "https://patches.guix-patches.cbaines.net")) @@ -165,25 +163,3 @@ (lambda (a b) (> (first a) (first b))))))) - -(define (patchwork-patch-checks checks-url) - ;; Patchwork uses http URIs, so convert here to avoid the redirect - (define https-uri - (string->uri - (string-append - "https:" - (string-join - (drop (string-split checks-url #\:) 1) - ":")))) - - (define (make-request) - (let-values (((response body) - (http-request https-uri - #:decode-body? #f))) - (vector->list - (json-string->scm (utf8->string body))))) - - (retry-on-error make-request - #:times 10 - #:delay 5)) - diff --git a/guix-qa-frontpage/server.scm b/guix-qa-frontpage/server.scm index c564ed6..bbf5e5a 100644 --- a/guix-qa-frontpage/server.scm +++ b/guix-qa-frontpage/server.scm @@ -38,6 +38,7 @@ #:use-module (guix-qa-frontpage patchwork) #:use-module (guix-qa-frontpage mumi) #:use-module (guix-qa-frontpage issue) + #:use-module (guix-qa-frontpage git-repository) #:use-module (guix-qa-frontpage manage-builds) #:use-module (guix-qa-frontpage guix-data-service) #:use-module (guix-qa-frontpage view util) @@ -296,14 +297,7 @@ (call-with-values (lambda () (and=> (patch-series-derivation-changes-url - (with-sqlite-cache - database - 'patchwork-patch-checks - patchwork-patch-checks - #:args (list - (assoc-ref (first (assoc-ref series "patches")) - "checks")) - #:ttl 1200) + number #:systems %systems-to-submit-builds-for) (lambda (url) (with-exception-handler @@ -329,7 +323,7 @@ (_ (apply values res)))))) (comparison-details (and=> - (patch-series-compare-url series) + (patch-series-compare-url number) (lambda (url) (with-exception-handler (lambda (exn) @@ -428,6 +422,9 @@ port. Also, the port used can be changed by passing the --port option.\n" number-of-series-to-refresh) (take latest-series number-of-series-to-refresh) latest-series))) + + (update-repository!) + (n-par-for-each 2 (lambda (series) @@ -456,14 +453,7 @@ port. Also, the port used can be changed by passing the --port option.\n" (lambda () (and=> (patch-series-derivation-changes-url - (with-sqlite-cache - database - 'patchwork-patch-checks - patchwork-patch-checks - #:args (list - (assoc-ref (first (assoc-ref series "patches")) - "checks")) - #:ttl 0) + (car series) #:systems %systems-to-submit-builds-for) (lambda (url) (with-sqlite-cache |