diff options
| author | Christopher Baines <mail@cbaines.net> | 2023-08-29 15:09:26 +0100 |
|---|---|---|
| committer | Christopher Baines <mail@cbaines.net> | 2023-08-29 15:09:26 +0100 |
| commit | 1f2c60c85b2b24d2dcb66133fd50bbdedcaacdbd (patch) | |
| tree | 6b57b6d2ae0c26db7820f16c5204283d8975d01f /guix-build-coordinator | |
| parent | cbded42c284cca4ecaaebbf0a666cf89efc465a7 (diff) | |
| download | build-coordinator-1f2c60c85b2b24d2dcb66133fd50bbdedcaacdbd.tar build-coordinator-1f2c60c85b2b24d2dcb66133fd50bbdedcaacdbd.tar.gz | |
Replace request-builds-list by fold-builds
As this can wait until the stream is finished and properly close the port.
Diffstat (limited to 'guix-build-coordinator')
| -rw-r--r-- | guix-build-coordinator/client-communication.scm | 60 |
1 files changed, 37 insertions, 23 deletions
diff --git a/guix-build-coordinator/client-communication.scm b/guix-build-coordinator/client-communication.scm index 61b8731..21d9e67 100644 --- a/guix-build-coordinator/client-communication.scm +++ b/guix-build-coordinator/client-communication.scm @@ -48,8 +48,8 @@ send-submit-build-request send-cancel-build-request send-update-build-priority-request + fold-builds request-build-details - request-builds-list request-output-details request-agent-details request-agent-build-allocation-plan @@ -786,19 +786,21 @@ 'GET (string-append "/build/" uuid))) -(define* (request-builds-list coordinator-uri - #:key - (tags '()) - (not-tags '()) - (systems '()) - (not-systems '()) - (processed 'unset) - (canceled 'unset) - (priority-> 'unset) - (priority-< 'unset) - (relationship 'unset) - (after-id #f) - (limit #f)) +(define* (fold-builds coordinator-uri + proc + init + #:key + (tags '()) + (not-tags '()) + (systems '()) + (not-systems '()) + (processed 'unset) + (canceled 'unset) + (priority-> 'unset) + (priority-< 'unset) + (relationship 'unset) + (after-id #f) + (limit #f)) (let ((query-parameters `(,@(if (null? tags) '() @@ -853,15 +855,27 @@ ,@(if limit (list (simple-format #f "limit=~A" limit)) '())))) - (send-request coordinator-uri - 'GET - (string-append - "/builds" - (if (null? query-parameters) - "" - (string-append - "?" - (string-join query-parameters "&"))))))) + (let ((builds-stream + response + (send-request coordinator-uri + 'GET + (string-append + "/builds" + (if (null? query-parameters) + "" + (string-append + "?" + (string-join query-parameters "&"))))))) + (with-exception-handler + (lambda (exn) + (close-port + (response-port response)) + (raise-exception exn)) + (lambda () + (stream-fold proc init builds-stream) + (close-port + (response-port response)))) + #:unwind? #t))) (define (request-output-details coordinator-uri output) |