Start adding support for branches

1 files changed, 61 insertions, 1 deletions

diff --git a/guix-qa-frontpage/guix-data-service.scm b/guix-qa-frontpage/guix-data-service.scm
index 96c427a..5b81379 100644
--- a/guix-qa-frontpage/guix-data-service.scm
+++ b/guix-qa-frontpage/guix-data-service.scm
@@ -12,7 +12,13 @@
             patch-series-derivation-changes
 
             patch-series-compare-url
-            patch-series-comparison))
+            patch-series-comparison
+
+            list-branches-url
+            list-branches
+
+            branch-derivation-changes-url
+            branch-derivation-changes))
 
 (define* (patch-series-derivation-changes-url series #:key systems)
   (define comparison-check
@@ -95,3 +101,57 @@
                  json-body)))))
    #:times 6
    #:delay 30))
+
+(define (list-branches-url repository-id)
+  (simple-format #f "https://data.qa.guix.gnu.org/repository/~A.json"
+                 repository-id))
+
+(define (list-branches url)
+  (retry-on-error
+   (lambda ()
+     (let-values (((response body)
+                   (http-get (string->uri url))))
+       (if (eq? (response-code response)
+                404)
+           #f
+           (let ((json-body
+                  (json-string->scm (utf8->string body))))
+             (if (assoc-ref json-body "error")
+                 #f
+                 (vector->list
+                  (assoc-ref json-body "branches")))))))
+   #:times 6
+   #:delay 30))
+
+(define* (branch-derivation-changes-url branch #:key systems)
+  (string-append
+   "https://data.qa.guix.gnu.org/compare-by-datetime/package-derivations.json?"
+   "base_branch=master"
+   "&target_branch=" branch
+   (string-join
+    (map (lambda (system)
+           (simple-format #f "&system=~A" system))
+         (or systems '()))
+    "")
+   "&target=none"
+   "&field=builds&limit_results=&all_results=on"))
+
+(define (branch-derivation-changes url)
+  (retry-on-error
+   (lambda ()
+     (let-values (((response body)
+                   (http-get (string->uri url))))
+       (if (eq? (response-code response)
+                404)
+           (values #f #f)
+           (let ((json-body
+                  (json-string->scm (utf8->string body))))
+             (if (assoc-ref json-body "error")
+                 (values #f #f)
+                 (values (vector->list
+                          (assoc-ref json-body
+                                     "derivation_changes"))
+                         (alist-delete "derivation_changes"
+                                       json-body)))))))
+   #:times 6
+   #:delay 30))