From 65f2f21d3acad30caf490e69c46f0c73e74c324c Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Fri, 28 Feb 2020 20:58:21 +0000
Subject: [PATCH] Support customising the latest branch revision max processes

This makes it possible to set a higher or lower value depending on what you
want.
---
 guix-data-service/jobs.scm                | 26 +++++++++++++----------
 scripts/guix-data-service-process-jobs.in | 10 ++++++++-
 2 files changed, 24 insertions(+), 12 deletions(-)

diff --git a/guix-data-service/jobs.scm b/guix-data-service/jobs.scm
index 31440ba..d770d34 100644
--- a/guix-data-service/jobs.scm
+++ b/guix-data-service/jobs.scm
@@ -24,7 +24,8 @@
 
             default-max-processes))
 
-(define* (process-jobs conn #:key max-processes)
+(define* (process-jobs conn #:key max-processes
+                       latest-branch-revision-max-processes)
   (define (fetch-new-jobs)
     (fetch-unlocked-jobs conn))
 
@@ -44,7 +45,9 @@
   (process-jobs-concurrently fetch-new-jobs
                              process-job
                              handle-job-failure
-                             #:max-processes max-processes))
+                             #:max-processes max-processes
+                             #:priority-max-processes
+                             latest-branch-revision-max-processes))
 
 (define default-max-processes
   (max (round (/ (current-processor-count)
@@ -55,12 +58,15 @@
   (* (* 60 60) ;; 1 hour in seconds
      24))
 
-(define* (process-jobs-concurrently fetch-new-jobs
-                                    process-job
-                                    handle-job-failure
-                                    #:key (max-processes
-                                           default-max-processes)
-                                    (timeout default-timeout))
+(define* (process-jobs-concurrently
+          fetch-new-jobs
+          process-job
+          handle-job-failure
+          #:key
+          (max-processes default-max-processes)
+          (priority-max-processes (* 2 max-processes))
+          (timeout default-timeout))
+
   (define processes
     (make-hash-table))
 
@@ -156,9 +162,7 @@
                   (hash-count (const #t) processes)))
              (when (< current-processes
                       (if priority?
-                          ;; For priority jobs, burst up to twice the number
-                          ;; of max processes
-                          (* 2 max-processes)
+                          priority-max-processes
                           max-processes))
                (fork-and-process-job (list job-id))))))
         jobs)))
diff --git a/scripts/guix-data-service-process-jobs.in b/scripts/guix-data-service-process-jobs.in
index 5161a34..4a7af52 100644
--- a/scripts/guix-data-service-process-jobs.in
+++ b/scripts/guix-data-service-process-jobs.in
@@ -35,6 +35,11 @@
   (list (option '("max-processes") #t #f
                 (lambda (opt name arg result)
                   (alist-cons 'max-processes
+                              (string->number arg)
+                              result)))
+        (option '("latest-branch-revision-max-processes") #t #f
+                (lambda (opt name arg result)
+                  (alist-cons 'latest-branch-revision-max-processes
                               (string->number arg)
                               result)))))
 
@@ -62,4 +67,7 @@
    (lambda (conn)
      (simple-format #t "Ready to process jobs...\n")
      (process-jobs conn
-                   #:max-processes (assq-ref opts 'max-processes)))))
+                   #:max-processes (assq-ref opts 'max-processes)
+                   #:latest-branch-revision-max-processes
+                   (or (assq-ref opts 'latest-branch-revision-max-processes)
+                       (* 2 (assq-ref opts 'max-processes)))))))