Pull get-issue-branch-base-and-target-refs out

3 files changed, 48 insertions, 42 deletions

diff --git a/guix-qa-frontpage/guix-data-service.scm b/guix-qa-frontpage/guix-data-service.scm
index 700bd2e..427fd2f 100644
--- a/guix-qa-frontpage/guix-data-service.scm
+++ b/guix-qa-frontpage/guix-data-service.scm
@@ -34,21 +34,18 @@
   guix-data-service-error?
   (response-body guix-data-service-error-response-body))
 
-(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 base-and-target-refs #:key systems)
+  (string-append
+   "https://data.qa.guix.gnu.org/compare/package-derivations.json?"
+   "base_commit=" (assq-ref base-and-target-refs 'base)
+   "&target_commit=" (assq-ref base-and-target-refs '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)
diff --git a/guix-qa-frontpage/manage-builds.scm b/guix-qa-frontpage/manage-builds.scm
index e6ce039..8be33ca 100644
--- a/guix-qa-frontpage/manage-builds.scm
+++ b/guix-qa-frontpage/manage-builds.scm
@@ -9,6 +9,7 @@
   #:use-module (guix-qa-frontpage database)
   #:use-module (guix-qa-frontpage patchwork)
   #:use-module (guix-qa-frontpage guix-data-service)
+  #:use-module (guix-qa-frontpage manage-patch-branches)
   #:export (%systems-to-submit-builds-for
 
             builds-missing-for-derivation-changes?
@@ -49,9 +50,12 @@
                          issue-number)
 
           (let ((derivation-changes-url
-                 (patch-series-derivation-changes-url
-                  issue-number
-                  #:systems %systems-to-submit-builds-for)))
+                 (and=>
+                  (get-issue-branch-base-and-target-refs issue-number)
+                  (lambda (base-and-target-refs)
+                    (patch-series-derivation-changes-url
+                     base-and-target-refs
+                     #:systems %systems-to-submit-builds-for)))))
 
             (if derivation-changes-url
                 (let ((derivation-changes
diff --git a/guix-qa-frontpage/server.scm b/guix-qa-frontpage/server.scm
index 65c5330..15a5052 100644
--- a/guix-qa-frontpage/server.scm
+++ b/guix-qa-frontpage/server.scm
@@ -40,6 +40,7 @@
   #: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 manage-patch-branches)
   #:use-module (guix-qa-frontpage guix-data-service)
   #:use-module (guix-qa-frontpage view util)
   #:use-module (guix-qa-frontpage view home)
@@ -296,26 +297,29 @@
                     change-details
                     (call-with-values
                         (lambda ()
-                          (and=> (patch-series-derivation-changes-url
-                                  number
-                                  #:systems %systems-to-submit-builds-for)
-                                 (lambda (url)
-                                   (with-exception-handler
-                                       (lambda (exn)
-                                         (simple-format
-                                          (current-error-port)
-                                          "exception fetching derivation changes: ~A\n"
-                                          exn)
+                          (and=>
+                           (get-issue-branch-base-and-target-refs number)
+                           (lambda (base-and-target-refs)
+                             (with-exception-handler
+                                 (lambda (exn)
+                                   (simple-format
+                                    (current-error-port)
+                                    "exception fetching derivation changes: ~A\n"
+                                    exn)
 
-                                         (values #f #f))
-                                     (lambda ()
-                                       (with-sqlite-cache
-                                        database
-                                        'derivation-changes
-                                        patch-series-derivation-changes
-                                        #:args (list url)
-                                        #:ttl 6000))
-                                     #:unwind? #t))))
+                                   (values #f #f))
+                               (lambda ()
+                                 (with-sqlite-cache
+                                  database
+                                  'derivation-changes
+                                  patch-series-derivation-changes
+                                  #:args
+                                  (list
+                                   (patch-series-derivation-changes-url
+                                    base-and-target-refs
+                                    #:systems %systems-to-submit-builds-for))
+                                  #:ttl 6000))
+                               #:unwind? #t))))
                       (lambda res
                         (match res
                           ((#f)
@@ -453,15 +457,16 @@ port. Also, the port used can be changed by passing the --port option.\n"
                       #f)
                   (lambda ()
                     (and=>
-                     (patch-series-derivation-changes-url
-                      (car series)
-                      #:systems %systems-to-submit-builds-for)
-                     (lambda (url)
+                     (get-issue-branch-base-and-target-refs (car series))
+                     (lambda (base-and-target-refs)
                        (with-sqlite-cache
                         database
                         'derivation-changes
                         patch-series-derivation-changes
-                        #:args (list url)
+                        #:args
+                        (list (patch-series-derivation-changes-url
+                               base-and-target-refs
+                               #:systems %systems-to-submit-builds-for))
                         #:ttl (* 60 20)))))
                   #:unwind? #t)))