Switch to using the git repository for comparison information

Rather than storing the revisions in Patchwork checks.

6 files changed, 53 insertions, 103 deletions

diff --git a/guix-dev.scm b/guix-dev.scm
index 6d7566d..a8d574e 100644
--- a/guix-dev.scm
+++ b/guix-dev.scm
@@ -53,6 +53,7 @@
          guile-json-4
          guile-fibers-1.1
          guile-kolam
+         guile-git
          guile-readline
          guile-prometheus
          guix-build-coordinator
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