Initial commit

1 files changed, 46 insertions, 0 deletions

diff --git a/guix-qa-frontpage/patchwork.scm b/guix-qa-frontpage/patchwork.scm
new file mode 100644
index 0000000..0910566
--- /dev/null
+++ b/guix-qa-frontpage/patchwork.scm
@@ -0,0 +1,46 @@
+(define-module (guix-qa-frontpage patchwork)
+  #:use-module (srfi srfi-11)
+  #:use-module (rnrs bytevectors)
+  #:use-module (json)
+  #:use-module (web uri)
+  #:use-module (web client)
+  #:use-module (web request)
+  #:use-module (web response)
+  #:use-module (guix-build-coordinator utils)
+  #:export (%patchwork-instance
+
+            patchwork-patches))
+
+(define %patchwork-instance
+  (make-parameter "https://patches.guix-patches.cbaines.net"))
+
+(define* (patchwork-patches
+          #:key patchwork
+          (archived? #f)
+          (order "-id")
+          (states '("1" "2" "7" "11")))
+
+  (define initial-uri
+    (string->uri
+     (string-append (or patchwork
+                        (%patchwork-instance))
+                    "/api/patches/?"
+                    "order=" order "&"
+                    "archived=" (if archived? "true" "false") "&"
+                    (string-join
+                     (map (lambda (state)
+                            (string-append "state=" state))
+                          states)
+                     "&"))))
+
+  (define (make-request uri)
+    (let-values (((response body)
+                  (http-request uri
+                                #:decode-body? #f)))
+      (values
+       (and body (json-string->scm (utf8->string body)))
+       response)))
+
+  (retry-on-error (lambda () (make-request initial-uri))
+                  #:times 9
+                  #:delay 10))