Improve error handling in builds.scm

This commit is contained in:
Christopher Baines 2019-03-06 23:36:46 +00:00
parent b0eaf9cf7a
commit 891cf42fc6
Signed by: cbaines
GPG key ID: 5E28A33B0B84F577

View file

@ -70,17 +70,14 @@
(select-derivations-with-no-known-build conn)))
(define (fetch-build-for-derivation url derivation-file-name)
(match (array->list
(fetch-latest-builds-for-derivation url derivation-file-name))
(#f #f)
(()
(match (array->list
(fetch-queued-builds-for-derivation url derivation-file-name))
(#f #f)
(() #f)
((status)
(match (fetch-latest-builds-for-derivation url derivation-file-name)
((or #f #())
(match (fetch-queued-builds-for-derivation url derivation-file-name)
((or #f #())
#f)
(#(status)
status)))
((status)
(#(status)
status)))
(define (json-string->scm* string)
@ -94,33 +91,37 @@
(simple-format #t "error parsing: ~A\n" string)
#f)))
(define (fetch-latest-builds-for-derivation url derivation-file-name)
(let-values
(((response body)
(http-request (string-append
url
(define (fetch-latest-builds-for-derivation base-url derivation-file-name)
(define url
(string-append base-url
"api/latestbuilds?nr=10"
"&derivation=" derivation-file-name))))
"&derivation=" derivation-file-name))
(let-values (((response body) (http-request url)))
(let ((code (response-code response)))
(cond
((eq? (response-code response) 200)
((eq? code 200)
(json-string->scm
(bytevector->string body "utf-8")))
(else #f))))
(else
(simple-format #t "error: response code ~A: ~A\n" url code)
#f)))))
(define (fetch-queued-builds-for-derivation url derivation-file-name)
(let-values
(((response body)
(http-request (string-append
url
(define (fetch-queued-builds-for-derivation base-url derivation-file-name)
(define url
(string-append base-url
"api/queue?nr=10"
"&derivation=" derivation-file-name))))
"&derivation=" derivation-file-name))
(let-values (((response body) (http-request url)))
(let ((code (response-code response)))
(cond
((eq? (response-code response) 200)
((eq? code 200)
(json-string->scm
(bytevector->string body "utf-8")))
(else #f))))
(else
(simple-format #t "error: response code ~A: ~A\n" url code)
#f)))))
(define (fetch-build url id)
(let-values