Use fibers for refreshing issue and branch data

3 files changed, 28 insertions, 23 deletions

diff --git a/guix-qa-frontpage/branch.scm b/guix-qa-frontpage/branch.scm
index 7ce6ef5..719b350 100644
--- a/guix-qa-frontpage/branch.scm
+++ b/guix-qa-frontpage/branch.scm
@@ -28,6 +28,8 @@
                 #:select (with-time-logging))
   #:use-module ((guix build syscalls)
                 #:select (set-thread-name))
+  #:use-module (fibers)
+  #:use-module (guix-qa-frontpage utils)
   #:use-module (guix-qa-frontpage mumi)
   #:use-module (guix-qa-frontpage git-repository)
   #:use-module (guix-qa-frontpage guix-data-service)
@@ -41,7 +43,7 @@
 
             get-systems-with-low-substitute-availability
 
-            start-refresh-non-patch-branches-data-thread))
+            start-refresh-non-patch-branches-data-fiber))
 
 (define (list-non-master-branches)
   (define (issue-title->branch title)
@@ -308,8 +310,8 @@
                 (vector->list substitute-availability))
                "availability"))))
 
-(define (start-refresh-non-patch-branches-data-thread database
-                                                      metrics-registry)
+(define (start-refresh-non-patch-branches-data-fiber database
+                                                     metrics-registry)
   (define frequency
     (* 30 60))
 
@@ -361,7 +363,9 @@
   (define (refresh-data)
     (simple-format (current-error-port)
                    "refreshing non-patch branches data...\n")
-    (update-repository!)
+    (non-blocking
+     (lambda ()
+       (update-repository!)))
 
     (let ((branches
            (with-sqlite-cache
@@ -378,8 +382,7 @@
                 (list-branches-url 2))))
             #:ttl 0)))
 
-      (n-par-for-each
-       1
+      (for-each
        (lambda (branch)
          (let ((branch-name
                 (assoc-ref branch "name")))
@@ -437,13 +440,8 @@
        "master"
        master-branch-substitute-availability)))
 
-  (call-with-new-thread
+  (spawn-fiber
    (lambda ()
-     (catch 'system-error
-       (lambda ()
-         (set-thread-name "branch data refresh"))
-       (const #t))
-
      (while #t
        (let ((start-time (current-time)))
          (with-exception-handler
diff --git a/guix-qa-frontpage/issue.scm b/guix-qa-frontpage/issue.scm
index 6ceb733..94267a5 100644
--- a/guix-qa-frontpage/issue.scm
+++ b/guix-qa-frontpage/issue.scm
@@ -26,6 +26,8 @@
                 #:select (with-time-logging))
   #:use-module ((guix build syscalls)
                 #:select (set-thread-name))
+  #:use-module (fibers)
+  #:use-module (guix-qa-frontpage utils)
   #:use-module (guix-qa-frontpage database)
   #:use-module (guix-qa-frontpage manage-builds)
   #:use-module (guix-qa-frontpage manage-patch-branches)
@@ -40,7 +42,7 @@
             issue-patches-overall-status
 
             issue-data
-            start-refresh-patch-branches-data-thread))
+            start-refresh-patch-branches-data-fiber))
 
 (define reviewed-looks-good-status 'reviewed-looks-good)
 (define good-status 'important-checks-passing)
@@ -303,7 +305,7 @@
      builds-missing?
      comparison-details)))
 
-(define* (start-refresh-patch-branches-data-thread
+(define* (start-refresh-patch-branches-data-fiber
           database
           metrics-registry
           #:key number-of-series-to-refresh)
@@ -326,10 +328,11 @@
                 (take latest-series number-of-series-to-refresh)
                 latest-series)))
 
-      (update-repository!)
+      (non-blocking
+       (lambda ()
+         (update-repository!)))
 
-      (n-par-for-each
-       5
+      (fibers-batch-for-each
        (match-lambda
          ((issue-number . series-data)
           (with-exception-handler
@@ -385,15 +388,11 @@
                  #:args (list issue-number)
                  #:ttl 0)))
             #:unwind? #t)))
+       5
        series-to-refresh)))
 
-  (call-with-new-thread
+  (spawn-fiber
    (lambda ()
-     (catch 'system-error
-       (lambda ()
-         (set-thread-name "data refresh"))
-       (const #t))
-
      (while #t
        (let ((start-time (current-time)))
          (with-exception-handler
diff --git a/guix-qa-frontpage/server.scm b/guix-qa-frontpage/server.scm
index 58262dc..ccfa985 100644
--- a/guix-qa-frontpage/server.scm
+++ b/guix-qa-frontpage/server.scm
@@ -847,6 +847,14 @@ has no patches or has been closed.")
           (%fiberized-submit-build
            (fiberize submit-build #:parallelism 8))
 
+          (start-refresh-patch-branches-data-fiber
+           database
+           metrics-registry
+           #:number-of-series-to-refresh patch-issues-to-show)
+
+          (start-refresh-non-patch-branches-data-fiber database
+                                                       metrics-registry)
+
           (when submit-builds?
             (start-submit-patch-builds-fiber database
                                              "http://127.0.0.1:8746"