Get more data from mumi

Query the open status so that Patchwork isn't relied on for that. Also switch
to querying the tags in bulk.

3 files changed, 69 insertions, 25 deletions

diff --git a/guix-qa-frontpage/mumi.scm b/guix-qa-frontpage/mumi.scm
index d1d7839..bef358d 100644
--- a/guix-qa-frontpage/mumi.scm
+++ b/guix-qa-frontpage/mumi.scm
@@ -18,8 +18,13 @@
 
 (define-module (guix-qa-frontpage mumi)
   #:use-module (srfi srfi-1)
+  #:use-module (ice-9 match)
   #:use-module (kolam http)
-  #:export (mumi-issue-tags))
+  #:use-module ((guix-data-service utils) #:select (chunk-for-each!))
+  #:export (mumi-issue-tags
+            mumi-issue-open?
+
+            mumi-bulk-issues))
 
 (define (mumi-issue-tags number)
   (with-exception-handler
@@ -37,3 +42,43 @@
          (assoc-ref (cdr (first response))
                     "tags"))))
     #:unwind? #t))
+
+(define (mumi-issue-open? number)
+  (let ((response
+         (graphql-http-get "https://issues.guix.gnu.org/graphql"
+                           `(document (query (#(issue #:number ,number) open))))))
+    (assoc-ref (cdr (first response))
+               "open")))
+
+(define (mumi-bulk-issues numbers)
+  (let ((number-to-data
+         (make-hash-table)))
+
+    (chunk-for-each!
+     (lambda (chunk)
+       (let ((response
+              (graphql-http-get
+               "https://issues.guix.gnu.org/graphql"
+               `(document
+                 ,@(map (lambda (number)
+                          `(query (#(issue #:number ,number)
+                                   number title open severity tags)))
+                        chunk)))))
+
+         (for-each
+          (lambda (res)
+            (let ((data (cdr res)))
+              (hash-set! number-to-data
+                         (assoc-ref data "number")
+                         `((title . ,(assoc-ref data "title"))
+                           (open? . ,(assoc-ref data "open"))
+                           (tags . ,(vector->list
+                                     (assoc-ref data "tags")))
+                           (severity . ,(assoc-ref data "severity"))))))
+          response)))
+     30
+     (list-copy numbers))
+
+    (map (lambda (number)
+           (hash-ref number-to-data number))
+         numbers)))
diff --git a/guix-qa-frontpage/patchwork.scm b/guix-qa-frontpage/patchwork.scm
index 69949e2..cd5bc26 100644
--- a/guix-qa-frontpage/patchwork.scm
+++ b/guix-qa-frontpage/patchwork.scm
@@ -9,6 +9,7 @@
   #:use-module (web request)
   #:use-module (web response)
   #:use-module (guix-build-coordinator utils)
+  #:use-module (guix-qa-frontpage mumi)
   #:export (%patchwork-instance
 
             patchwork-patches
@@ -150,11 +151,20 @@
                   ("patches" . (,patch))))))))
      (patchwork-patches #:patchwork patchwork))
 
-    (sort!
-     (hash-map->list cons result)
-     (lambda (a b)
-       (> (first a)
-          (first b))))))
+    (let* ((data (hash-map->list cons result))
+           (mumi-data (mumi-bulk-issues
+                       (map first data))))
+      (sort!
+       (filter-map (lambda (data mumi)
+                     (if (assq-ref mumi 'open?)
+                         `(,@data
+                           (mumi . ,mumi))
+                         #f))
+                   data
+                   mumi-data)
+       (lambda (a b)
+         (> (first a)
+            (first b)))))))
 
 (define (patchwork-patch-checks checks-url)
   ;; Patchwork uses http URIs, so convert here to avoid the redirect
diff --git a/guix-qa-frontpage/server.scm b/guix-qa-frontpage/server.scm
index e914c00..b3ebddf 100644
--- a/guix-qa-frontpage/server.scm
+++ b/guix-qa-frontpage/server.scm
@@ -283,13 +283,7 @@
                                 'latest-patchwork-series-by-issue
                                 latest-patchwork-series-by-issue
                                 #:ttl 1200)
-                               (string->number number)))
-             (mumi-tags (with-sqlite-cache
-                         database
-                         'mumi-issue-tags
-                         mumi-issue-tags
-                         #:args (list number)
-                         #:ttl 60)))
+                               (string->number number))))
          (if series
              (let ((derivation-changes
                     change-details
@@ -331,7 +325,8 @@
                (render-html
                 #:sxml (issue-view number
                                    series
-                                   mumi-tags
+                                   (assq-ref (assq-ref series 'mumi)
+                                             'tags)
                                    derivation-changes
                                    change-details
                                    comparison-details)))
@@ -426,23 +421,17 @@ port. Also, the port used can be changed by passing the --port option.\n"
                               'derivation-changes
                               patch-series-derivation-changes
                               #:args (list url)
-                              #:ttl (* 60 20)))))
-                         (mumi-tags
-                          (with-sqlite-cache
-                           database
-                           'mumi-issue-tags
-                           mumi-issue-tags
-                           #:args (list (car series))
-                           #:ttl 60)))
+                              #:ttl (* 60 20))))))
 
                      (and derivation-changes
-                          mumi-tags
                           (with-sqlite-cache
                            database
                            'issue-patches-overall-status
                            (lambda (id)
-                             (issue-patches-overall-status derivation-changes
-                                                           mumi-tags))
+                             (issue-patches-overall-status
+                              derivation-changes
+                              (assq-ref (assq-ref series 'mumi)
+                                        'tags)))
                            #:args (list (car series))
                            #:ttl 0)))))
              latest-series