Change listing builds to work as a stream

Both in terms of getting the data from the database, and sending it to the
client.

This avoids the use of the after-id and ordering by id when listing builds,
which makes listing builds faster. It does mean that the database reads may
last for a while (which can be a problem), but maybe that can be addressed in
other ways.

1 files changed, 56 insertions, 88 deletions

diff --git a/scripts/guix-build-coordinator.in b/scripts/guix-build-coordinator.in
index daa0873..787542c 100644
--- a/scripts/guix-build-coordinator.in
+++ b/scripts/guix-build-coordinator.in
@@ -38,6 +38,7 @@
              (srfi srfi-37)
              (srfi srfi-43)
              (ice-9 match)
+             (ice-9 streams)
              (ice-9 suspendable-ports)
              (web uri)
              (fibers)
@@ -242,8 +243,7 @@
          %common-build-filtering-options))
 
 (define %builds-list-option-defaults
-  `(,@%common-build-filtering-option-defaults
-    (limit        . 1000)))
+  `(,@%common-build-filtering-option-defaults))
 
 (define %build-cancel-options
   (list (option '("tag") #t #f
@@ -529,24 +529,23 @@ canceled?:       ~A
                                       %client-option-defaults
                                       %builds-list-option-defaults)
                               rest)))
-     (let loop ((after-id #f))
-       (let ((response (request-builds-list
-                        (assq-ref opts 'coordinator)
-                        #:tags (assq-ref opts 'tags)
-                        #:not-tags (assq-ref opts 'not-tags)
-                        #:systems (assq-ref opts 'systems)
-                        #:not-systems (assq-ref opts 'not-systems)
-                        #:processed (assq-ref opts 'processed)
-                        #:canceled (assq-ref opts 'canceled)
-                        #:priority-> (assq-ref opts 'priority->)
-                        #:priority-< (assq-ref opts 'priority-<)
-                        #:relationship (assq-ref opts 'relationship)
-                        #:after-id (or after-id (assq-ref opts 'after-id))
-                        #:limit (assq-ref opts 'limit))))
-         (for-each
-          (lambda (build-details)
-            (simple-format (current-output-port)
-                           "id: ~A
+     (let ((response (request-builds-list
+                      (assq-ref opts 'coordinator)
+                      #:tags (assq-ref opts 'tags)
+                      #:not-tags (assq-ref opts 'not-tags)
+                      #:systems (assq-ref opts 'systems)
+                      #:not-systems (assq-ref opts 'not-systems)
+                      #:processed (assq-ref opts 'processed)
+                      #:canceled (assq-ref opts 'canceled)
+                      #:priority-> (assq-ref opts 'priority->)
+                      #:priority-< (assq-ref opts 'priority-<)
+                      #:relationship (assq-ref opts 'relationship)
+                      #:after-id (assq-ref opts 'after-id)
+                      #:limit (assq-ref opts 'limit))))
+       (stream-for-each
+        (lambda (build-details)
+          (simple-format (current-output-port)
+                         "id: ~A
 derivation: ~A
 processed: ~A
 canceled: ~A
@@ -554,31 +553,25 @@ priority: ~A
 tags:
 ~A
 \n"
-                           (assoc-ref build-details "uuid")
-                           (assoc-ref build-details "derivation-name")
-                           (if (assoc-ref build-details "processed")
-                               "true"
-                               "false")
-                           (if (assoc-ref build-details "canceled")
-                               "true"
-                               "false")
-                           (assoc-ref build-details "priority")
-                           (string-join
-                            (map (lambda (tag)
-                                   (let ((key (assoc-ref tag "key"))
-                                         (val (assoc-ref tag "value")))
-                                     (string-append "  " key ": " val)))
-                                 (vector->list
-                                  (assoc-ref build-details "tags")))
-                            "\n")))
-          (vector->list (assoc-ref response "builds")))
+                         (assoc-ref build-details "uuid")
+                         (assoc-ref build-details "derivation-name")
+                         (if (assoc-ref build-details "processed")
+                             "true"
+                             "false")
+                         (if (assoc-ref build-details "canceled")
+                             "true"
+                             "false")
+                         (assoc-ref build-details "priority")
+                         (string-join
+                          (map (lambda (tag)
+                                 (let ((key (assoc-ref tag "key"))
+                                       (val (assoc-ref tag "value")))
+                                   (string-append "  " key ": " val)))
+                               (vector->list
+                                (assoc-ref build-details "tags")))
+                          "\n")))
+        response))))
 
-         (unless (= (vector-length (assoc-ref response "builds")) 0)
-           (loop
-            (assoc-ref (vector-ref
-                        (assoc-ref response "builds")
-                        (- (vector-length (assoc-ref response "builds")) 1))
-                       "uuid")))))))
   (("build" "show-blocking" rest ...)
    (let ((opts (parse-options (append %base-options
                                       %client-options
@@ -608,8 +601,6 @@ tags:
                                       %build-cancel-option-defaults)
                               rest)))
      (define (get-batch)
-       (define limit 1000)
-
        (simple-format (current-error-port)
                       "requesting matching builds\n")
        (force-output (current-error-port))
@@ -621,17 +612,12 @@ tags:
                          #:not-systems (assq-ref opts 'not-systems)
                          #:processed #f
                          #:canceled #f
-                         #:relationship 'no-dependent-builds
-                         #:limit 1000))
-              (received-builds
-               (vector-length (assoc-ref response "builds"))))
+                         #:relationship 'no-dependent-builds)))
 
-         (fold
-          (lambda (build-details result)
-            (cons (assoc-ref build-details "uuid")
-                  result))
-          '()
-          (vector->list (assoc-ref response "builds")))))
+         (stream-map
+          (lambda (build-details)
+            (assoc-ref build-details "uuid"))
+          response)))
 
      (match (assq-ref opts 'arguments)
        (#f
@@ -689,39 +675,21 @@ tags:
                                       %build-update-priority-option-defaults)
                               rest)))
      (define (find-matching-builds)
-       (define limit 1000)
+       (let* ((response (request-builds-list
+                         (assq-ref opts 'coordinator)
+                         #:tags (assq-ref opts 'tags)
+                         #:not-tags (assq-ref opts 'not-tags)
+                         #:systems (assq-ref opts 'systems)
+                         #:not-systems (assq-ref opts 'not-systems)
+                         #:processed #f
+                         #:canceled #f
+                         #:priority-> (assq-ref opts 'priority->)
+                         #:priority-< (assq-ref opts 'priority-<))))
 
-       (let loop ((after-id #f)
-                  (result '()))
-         (let* ((response (request-builds-list
-                           (assq-ref opts 'coordinator)
-                           #:tags (assq-ref opts 'tags)
-                           #:not-tags (assq-ref opts 'not-tags)
-                           #:systems (assq-ref opts 'systems)
-                           #:not-systems (assq-ref opts 'not-systems)
-                           #:processed #f
-                           #:canceled #f
-                           #:priority-> (assq-ref opts 'priority->)
-                           #:priority-< (assq-ref opts 'priority-<)
-                           #:after-id after-id
-                           #:limit 1000))
-                (received-builds
-                 (vector-length (assoc-ref response "builds")))
-                (new-result
-                 (fold
-                  (lambda (build-details result)
-                    (cons (assoc-ref build-details "uuid")
-                          result))
-                  result
-                  (vector->list (assoc-ref response "builds")))))
-           (display "." (current-error-port))
-           (force-output (current-error-port))
-           (if (< received-builds limit)
-               new-result
-               (loop (assoc-ref (vector-ref (assoc-ref response "builds")
-                                            (- received-builds 1))
-                                "uuid")
-                     new-result)))))
+         (stream-map
+          (lambda (build-details)
+            (assoc-ref build-details "uuid"))
+          response)))
 
      (match (assq-ref opts 'arguments)
        (#f