Make the Guix Data Service to queue builds from configurable

1 files changed, 44 insertions, 22 deletions

diff --git a/scripts/guix-build-coordinator-queue-builds-from-guix-data-service.in b/scripts/guix-build-coordinator-queue-builds-from-guix-data-service.in
index bb8627f..d20d10b 100644
--- a/scripts/guix-build-coordinator-queue-builds-from-guix-data-service.in
+++ b/scripts/guix-build-coordinator-queue-builds-from-guix-data-service.in
@@ -34,8 +34,6 @@
              (guix-build-coordinator utils)
              (guix-build-coordinator client-communication))
 
-(define %guix-data-service-host "data.guix.gnu.org")
-
 (define %processed-commits-file "processed-revisions")
 
 ;; This gets populated from a file on startup
@@ -59,11 +57,12 @@
 (define processed-derivations-hash
   (make-hash-table 102400))
 
-(define* (guix-data-service-request path #:optional (query-parameters '()))
+(define* (guix-data-service-request guix-data-service
+                                    path
+                                    #:optional (query-parameters '()))
   (define uri
     (string->uri (string-append
-                  "https://"
-                  %guix-data-service-host
+                  guix-data-service
                   path
                   (if (null? query-parameters)
                       ""
@@ -83,8 +82,9 @@
    #:times 6
    #:delay 30))
 
-(define (unseen-revisions)
-  (let ((data (guix-data-service-request "/repository/1/branch/master.json")))
+(define (unseen-revisions guix-data-service)
+  (let ((data (guix-data-service-request guix-data-service
+                                         "/repository/1/branch/master.json")))
     (filter-map (lambda (entry)
                   (let ((commit (assoc-ref entry "commit-hash")))
                     (and (not (hash-ref processed-commits-hash
@@ -101,8 +101,11 @@
 
   (hash-set! processed-commits-hash commit #t))
 
-(define (channel-instance-derivations-for-commit commit system)
+(define (channel-instance-derivations-for-commit guix-data-service
+                                                 commit
+                                                 system)
   (let ((data (guix-data-service-request
+               guix-data-service
                (string-append "/revision/" commit "/channel-instances.json"))))
     (filter-map (lambda (entry)
                   (if (string=? system
@@ -112,8 +115,11 @@
                 (vector->list
                  (assoc-ref data "channel_instances")))))
 
-(define* (package-derivations-for-commit commit #:key system target)
+(define* (package-derivations-for-commit guix-data-service
+                                         commit
+                                         #:key system target)
   (let ((data (guix-data-service-request
+               guix-data-service
                (string-append "/revision/" commit "/package-derivations.json")
                `((system      . ,system)
                  (target      . ,target)
@@ -131,15 +137,14 @@
                          #t))
             derivations))
 
-(define* (submit-build coordinator derivation #:key (priority 0))
+(define* (submit-build coordinator guix-data-service derivation #:key (priority 0))
   (retry-on-error
    (lambda ()
      (let ((response
             (send-submit-build-request
              coordinator
              derivation
-             (list
-              (string-append "https://" %guix-data-service-host))
+             (list guix-data-service)
              #f
              priority
              #t
@@ -158,24 +163,33 @@
    #:times 30
    #:delay 30))
 
-(define (submit-builds-for-revision coordinator commit systems-and-targets)
+(define (submit-builds-for-revision coordinator
+                                    guix-data-service
+                                    commit
+                                    systems-and-targets)
   (simple-format #t "looking at revision ~A\n" commit)
   (for-each
    (match-lambda
      ((system . target)
       (for-each (lambda (derivation)
-                  (submit-build coordinator derivation #:priority 1000))
-                (channel-instance-derivations-for-commit commit system))
+                  (submit-build coordinator
+                                guix-data-service
+                                derivation
+                                #:priority 1000))
+                (channel-instance-derivations-for-commit guix-data-service
+                                                         commit
+                                                         system))
 
       (let ((unprocessed-package-derivations
              (filter (lambda (derivation)
                        (not (hash-ref processed-derivations-hash derivation)))
-                     (package-derivations-for-commit commit
+                     (package-derivations-for-commit guix-data-service
+                                                     commit
                                                      #:system system
                                                      #:target target))))
 
         (for-each (lambda (derivation)
-                    (submit-build coordinator derivation))
+                    (submit-build coordinator guix-data-service derivation))
                   unprocessed-package-derivations)
         (record-derivations-as-processed unprocessed-package-derivations))))
    systems-and-targets))
@@ -199,11 +213,16 @@
                 (lambda (opt name arg result)
                   (alist-cons 'coordinator
                               arg
-                              (alist-delete 'coordinator result))))))
-
+                              (alist-delete 'coordinator result))))
+        (option '("guix-data-service") #t #f
+                (lambda (opt name arg result)
+                  (alist-cons 'guix-data-service
+                              arg
+                              (alist-delete 'guix-data-service result))))))
 
 (define %option-defaults
-  '((coordinator . "http://127.0.0.1:8746")))
+  '((coordinator       . "http://127.0.0.1:8746")
+    (guix-data-service . "https://data.guix.gnu.org")))
 
 (define (parse-options options defaults args)
   (args-fold
@@ -224,7 +243,9 @@
                               %option-defaults
                               (cdr (program-arguments))))
          (systems-and-targets
-          (assq-ref opts 'systems-and-targets)))
+          (assq-ref opts 'systems-and-targets))
+         (guix-data-service
+          (assq-ref opts 'guix-data-service)))
 
     (unless systems-and-targets
       (simple-format (current-error-port)
@@ -234,10 +255,11 @@
     (while #t
       (for-each (lambda (commit)
                   (submit-builds-for-revision (assq-ref opts 'coordinator)
+                                              guix-data-service
                                               commit
                                               systems-and-targets)
                   (record-revision-as-processed commit))
-                (unseen-revisions))
+                (unseen-revisions guix-data-service))
 
       (simple-format #t "waiting before checking for new revisions...\n")
       (sleep 60))))