diff options
| -rw-r--r-- | guix-qa-frontpage/branch.scm | 16 | ||||
| -rw-r--r-- | guix-qa-frontpage/guix-data-service.scm | 45 | ||||
| -rw-r--r-- | guix-qa-frontpage/manage-builds.scm | 3 | ||||
| -rw-r--r-- | guix-qa-frontpage/server.scm | 2 | ||||
| -rw-r--r-- | guix-qa-frontpage/view/branch.scm | 5 |
5 files changed, 51 insertions, 20 deletions
diff --git a/guix-qa-frontpage/branch.scm b/guix-qa-frontpage/branch.scm index 56a194c..a9463e5 100644 --- a/guix-qa-frontpage/branch.scm +++ b/guix-qa-frontpage/branch.scm @@ -105,7 +105,7 @@ (string=? (assoc-ref branch "commit") ""))) (list-branches - (list-branches-url 2)))))) + (list-branches-url %data-service-guix-repository-id)))))) (let* ((initial-ordered-branches (stable-sort branches @@ -280,11 +280,19 @@ (define* (master-branch-data) (let* ((substitute-availability (package-substitute-availability - "https://data.qa.guix.gnu.org/repository/2/branch/master/latest-processed-revision/package-substitute-availability.json")) + (string-append + %data-service-url-base + "/repository/" + (number->string %data-service-guix-repository-id) + "/branch/master/latest-processed-revision/package-substitute-availability.json"))) (package-reproducibility (guix-data-service-request - "https://data.qa.guix.gnu.org/repository/2/branch/master/latest-processed-revision/package-reproducibility.json")) + (string-append + %data-service-url-base + "/repository/" + (number->string %data-service-guix-repository-id) + "/branch/master/latest-processed-revision/package-reproducibility.json"))) (systems-with-low-substitute-availability (get-systems-with-low-substitute-availability @@ -399,7 +407,7 @@ (string-prefix? "version-" (assoc-ref branch "name")))) (list-branches - (list-branches-url 2)))) + (list-branches-url %data-service-guix-repository-id)))) #:ttl 0))) (for-each diff --git a/guix-qa-frontpage/guix-data-service.scm b/guix-qa-frontpage/guix-data-service.scm index 3530d89..d931c3f 100644 --- a/guix-qa-frontpage/guix-data-service.scm +++ b/guix-qa-frontpage/guix-data-service.scm @@ -15,7 +15,10 @@ #:use-module (guix-qa-frontpage utils) #:use-module (guix-qa-frontpage patchwork) #:use-module (guix-qa-frontpage manage-patch-branches) - #:export (&guix-data-service-error + #:export (%data-service-url-base + %data-service-guix-repository-id + + &guix-data-service-error guix-data-service-error? guix-data-service-error-response-body guix-data-service-error-response-code @@ -54,6 +57,11 @@ package-reproducibility-url)) +(define %data-service-url-base + "https://data.qa.guix.gnu.org") + +(define %data-service-guix-repository-id 1) + (define-exception-type &guix-data-service-error &error make-guix-data-service-error guix-data-service-error? @@ -211,7 +219,8 @@ #:key system target no-build-from-build-server) (string-append - "https://data.qa.guix.gnu.org/revision/" + %data-service-url-base + "/revision/" commit "/package-derivations.json?" "system=" system @@ -225,7 +234,8 @@ (define* (compare-package-derivations-url base-and-target-refs #:key systems) (string-append - "https://data.qa.guix.gnu.org/compare/package-derivations.json?" + %data-service-url-base + "/compare/package-derivations.json?" "base_commit=" (assq-ref base-and-target-refs 'base) "&target_commit=" (assq-ref base-and-target-refs 'target) (string-join @@ -238,7 +248,8 @@ (define* (compare-package-cross-derivations-url base-and-target-refs #:key systems) (string-append - "https://data.qa.guix.gnu.org/compare/package-derivations.json?" + %data-service-url-base + "/compare/package-derivations.json?" "base_commit=" (assq-ref base-and-target-refs 'base) "&target_commit=" (assq-ref base-and-target-refs 'target) (string-join @@ -257,7 +268,8 @@ (define* (revision-comparison-url base-and-target-refs #:key (json? #t)) (string-append - "https://data.qa.guix.gnu.org/compare" + %data-service-url-base + "/compare" (if json? ".json" "") "?" "base_commit=" (assq-ref base-and-target-refs 'base) @@ -267,7 +279,8 @@ (guix-data-service-request url)) (define (list-branches-url repository-id) - (simple-format #f "https://data.qa.guix.gnu.org/repository/~A.json" + (simple-format #f "~A/repository/~A.json" + %data-service-url-base repository-id)) (define (list-branches url) @@ -280,8 +293,9 @@ (let ((json-body (guix-data-service-request (string-append - "https://data.qa.guix.gnu.org" - "/repository/2" + %data-service-url-base + "/repository/" + (number->string %data-service-guix-repository-id) "/branch/" branch "/latest-processed-revision.json")))) (assoc-ref @@ -291,7 +305,8 @@ (define (branch-revisions-url repository-id branch-name) (simple-format #f - "https://data.qa.guix.gnu.org/repository/~A/branch/~A.json" + "~A/repository/~A/branch/~A.json" + %data-service-url-base repository-id branch-name)) @@ -304,7 +319,8 @@ (define* (revision-details-url commit) (simple-format #f - "https://data.qa.guix.gnu.org/revision/~A.json" + "~A/revision/~A.json" + %data-service-url-base commit)) (define (revision-details url) @@ -313,7 +329,8 @@ (define* (revision-system-tests-url commit #:key (system "x86_64-linux")) (simple-format #f - "https://data.qa.guix.gnu.org/revision/~A/system-tests.json?system=~A" + "~A/revision/~A/system-tests.json?system=~A" + %data-service-url-base commit system)) @@ -326,7 +343,8 @@ (define* (package-substitute-availability-url commit) (simple-format #f - "https://data.qa.guix.gnu.org/revision/~A/package-substitute-availability.json" + "~A/revision/~A/package-substitute-availability.json" + %data-service-url-base commit)) (define (package-substitute-availability url) @@ -339,5 +357,6 @@ (define* (package-reproducibility-url commit) (simple-format #f - "https://data.qa.guix.gnu.org/revision/~A/package-reproducibility.json" + "~A/revision/~A/package-reproducibility.json" + %data-service-url-base commit)) diff --git a/guix-qa-frontpage/manage-builds.scm b/guix-qa-frontpage/manage-builds.scm index c5c514b..e55c27c 100644 --- a/guix-qa-frontpage/manage-builds.scm +++ b/guix-qa-frontpage/manage-builds.scm @@ -886,7 +886,8 @@ (assoc-ref revision-details "commit-hash") #f)) (branch-revisions - (branch-revisions-url 2 "master")))) + (branch-revisions-url %data-service-guix-repository-id + "master")))) (recent-processed-revision-commits (if (> (length processed-revision-commits) 5) diff --git a/guix-qa-frontpage/server.scm b/guix-qa-frontpage/server.scm index 24c030b..d67dd51 100644 --- a/guix-qa-frontpage/server.scm +++ b/guix-qa-frontpage/server.scm @@ -165,7 +165,7 @@ 'branches (lambda () (list-branches - (list-branches-url 2))) + (list-branches-url %data-service-guix-repository-id))) #:ttl 60))) (render-html #:sxml diff --git a/guix-qa-frontpage/view/branch.scm b/guix-qa-frontpage/view/branch.scm index a6a6436..d7c93f7 100644 --- a/guix-qa-frontpage/view/branch.scm +++ b/guix-qa-frontpage/view/branch.scm @@ -5,6 +5,7 @@ #:use-module (ice-9 format) #:use-module ((guix-data-service model utils) #:select (group-to-alist)) #:use-module (guix-qa-frontpage manage-builds) + #:use-module (guix-qa-frontpage guix-data-service) #:use-module (guix-qa-frontpage derivation-changes) #:use-module (guix-qa-frontpage view util) #:use-module (guix-qa-frontpage view shared) @@ -53,7 +54,9 @@ td.bad { "View Git branch")) (li (a (@ (href ,(simple-format - #f "https://data.qa.guix.gnu.org/repository/2/branch/~A" + #f "~A/repository/~A/branch/~A" + %data-service-url-base + %data-service-guix-repository-id branch))) "View branch with Guix Data Service")))) |