Query substitutes for latest processed revisions periodically

This is a step towards having up to date substitute availability data.

guix-data-service/substitutes.scm

@@ -19,12 +19,16 @@
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-19)
   #:use-module (ice-9 match)
+  #:use-module (ice-9 threads)
   #:use-module (guix substitutes)
   #:use-module (guix narinfo)
   #:use-module (guix-data-service database)
   #:use-module (guix-data-service model build-server)
+  #:use-module (guix-data-service model git-branch)
+  #:use-module (guix-data-service model git-repository)
   #:use-module (guix-data-service model nar)
-  #:export (query-build-server-substitutes))
+  #:export (query-build-server-substitutes
+            start-substitute-query-thread))
 
 (define verbose-output?
   (make-parameter #f))
@@ -34,7 +38,6 @@
                                          #:key verbose?)
   (parameterize
       ((verbose-output? verbose?))
-    (while #t
     (let ((build-servers (select-build-servers conn)))
       (for-each
        (match-lambda
@@ -55,7 +58,7 @@
                    (current-error-port)
                    "exception in query-build-server: ~A ~A\n"
                    key args)))))))
-         build-servers)))))
+       build-servers))))
 
 (define %narinfo-max-size
   (- (expt 2 (- (* 8 8) ;; 8 bytes
@@ -110,3 +113,40 @@
             conn
             build-server-id
             filtered-narinfos)))))))
+
+(define (start-substitute-query-thread)
+  (call-with-new-thread
+   (lambda ()
+     (while #t
+       (with-exception-handler
+           (lambda (exn)
+             (simple-format (current-error-port)
+                            "exception when querying substitutes: ~A\n"
+                            exn))
+         (lambda ()
+           (with-postgresql-connection
+            "substitute-query-thread"
+            (lambda (conn)
+              (for-each
+               (match-lambda
+                 ((git-repository-id rest ...)
+                  (for-each
+                   (match-lambda
+                     ((branch-name rest ...)
+                      (and=> (latest-processed-commit-for-branch
+                              conn
+                              (number->string git-repository-id)
+                              branch-name)
+                             (lambda (commit)
+                               (query-build-server-substitutes
+                                conn
+                                #f ;; All build servers
+                                (list commit)
+                                #f)))))
+                   (all-branches-with-most-recent-commit
+                    conn
+                    git-repository-id))))
+               (all-git-repositories conn))))
+
+           (simple-format #t "finished checking substitutes, now sleeping\n")
+           (sleep (* 60 30))))))))

scripts/guix-data-service.in

@@ -33,6 +33,7 @@
              (guix pki)
              (guix-data-service config)
              (guix-data-service database)
+             (guix-data-service substitutes)
              (guix-data-service web server)
              (guix-data-service web controller)
              (guix-data-service web nar controller))
@@ -227,6 +228,8 @@
                  (%show-error-details
                   (assoc-ref opts 'show-error-details)))
 
+    (start-substitute-query-thread)
+
     ;; Provide some visual space between the startup output and the server
     ;; starting
     (simple-format #t "\n\nStarting the server on http://~A:~A/\n\n"