Further tweak fetching narinfos

Move the batching to the database, which should reduce memory usage while
removing the limit on the number of fetched narinfos.

guix-data-service/model/nar.scm

@@ -381,7 +381,9 @@ ORDER BY COUNT(*) DESC")
           build-server-id
           guix-revision-commits
           #:key
-          build-success-after)
+          build-success-after
+          after-id
+          (limit 2000))
   (define query
     (string-append
      "
@@ -440,16 +442,25 @@ WHERE derivation_output_details.path NOT IN (
                        ",")
           ")
   )"))
+     (if after-id
+         (string-append
+          "
+  AND derivation_output_details.id > " after-id)
+         "")
      "
-ORDER BY derivation_output_details.id DESC
+ORDER BY derivation_output_details.id ASC"
-LIMIT 100000"))
+     (if limit
+         (string-append
+          "
+LIMIT " (number->string limit))
+         "")))
 
-  (map car (exec-query conn
+  (exec-query conn
-                       query
+              query
-                       `(,(number->string build-server-id)
+              `(,(number->string build-server-id)
-                         ,@(if build-success-after
+                ,@(if build-success-after
-                               (list (date->string build-success-after "~1 ~3"))
+                      (list (date->string build-success-after "~1 ~3"))
-                               '())))))
+                      '()))))
 
 (define (select-nars-for-output conn output-file-name)
   (define query

guix-data-service/substitutes.scm

@@ -50,7 +50,6 @@
               (simple-format #t "\nQuerying ~A\n" url)
               (catch #t
                 (lambda ()
-                  (simple-format #t "\nFetching narinfo files\n")
                   (fetch-narinfo-files conn id url revision-commits
                                        #:specific-outputs
                                        outputs))
@@ -69,56 +68,67 @@
 (define* (fetch-narinfo-files conn build-server-id build-server-url
                               revision-commits
                               #:key specific-outputs)
-  (define outputs
+  (let loop ((last-id #f)
-    (or specific-outputs
+             (requests 0)
-        (select-outputs-without-known-nar-entries
+             (success-responses 0))
-         conn
+    (let ((outputs-chunk
-         build-server-id
+           (or specific-outputs
-         revision-commits
+               (select-outputs-without-known-nar-entries
-         #:build-success-after
+                conn
-         (if (null? revision-commits)
+                build-server-id
-             (time-utc->date
+                revision-commits
-              (subtract-duration (current-time)
+                #:build-success-after
-                                 (make-time time-duration 0 (* 60 5)))
+                (if (null? revision-commits)
-              0)                        ; tz-offset
+                    (time-utc->date
-             #f))))
+                     (subtract-duration (current-time)
+                                        (make-time time-duration 0 (* 60 5)))
+                     0)                        ; tz-offset
+                    #f)
+                #:after-id last-id))))
 
-  (simple-format #t "Querying ~A outputs\n"
+      (unless (null? outputs-chunk)
-                 (length outputs))
+        (let* ((narinfos
+                (lookup-narinfos (string-trim-right build-server-url #\/)
+                                 (map car outputs-chunk)))
+               (narinfos-count
+                (length narinfos))
+               (total-requested
+                (+ requests (length outputs-chunk)))
+               (total-narinfos
+                (+ success-responses narinfos-count)))
 
-  (chunk-for-each!
+          (simple-format #t "Fetched ~A narinfos from ~A (total requested: ~A, total narinfos: ~A)\n"
-   (lambda (outputs-chunk)
+                         (length narinfos)
-     (let ((narinfos
+                         build-server-url
-            (lookup-narinfos (string-trim-right build-server-url #\/)
+                         total-requested
-                             outputs-chunk)))
+                         total-narinfos)
 
-       (simple-format #t "Got ~A narinfo files\n"
+          (let ((filtered-narinfos
-                      (length narinfos))
+                 (filter-map
+                  (lambda (narinfo)
+                    (if (> (narinfo-size narinfo)
+                           %narinfo-max-size)
+                        (begin
+                          (simple-format (current-error-port)
+                                         "narinfo ~A has excessive size ~A\n"
+                                         (narinfo-path narinfo)
+                                         (narinfo-size narinfo))
+                          #f)
+                        narinfo))
+                  narinfos)))
 
-       (let ((filtered-narinfos
+            (unless (null? filtered-narinfos)
-              (filter-map
+              (with-postgresql-transaction
-               (lambda (narinfo)
-                 (if (> (narinfo-size narinfo)
-                        %narinfo-max-size)
-                     (begin
-                       (simple-format (current-error-port)
-                                      "narinfo ~A has excessive size ~A\n"
-                                      (narinfo-path narinfo)
-                                      (narinfo-size narinfo))
-                       #f)
-                     narinfo))
-               narinfos)))
-
-         (unless (null? filtered-narinfos)
-           (with-postgresql-transaction
-            conn
-            (lambda (conn)
-              (record-narinfo-details-and-return-ids
                conn
-               build-server-id
+               (lambda (conn)
-               filtered-narinfos)))))))
+                 (record-narinfo-details-and-return-ids
-   2000
+                  conn
-   outputs))
+                  build-server-id
+                  filtered-narinfos)))))
+
+          (loop (second (last outputs-chunk))
+                total-requested
+                total-narinfos))))))
 
 (define (start-substitute-query-thread)
   (call-with-new-thread