cbaines/guix-data-service
1
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Improve error handling in builds.scm

Browse source
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
1 changed files with 35 additions and 34 deletions
Download patch file Download diff file Expand all files Collapse all files

69
guix-data-service/builds.scm
View file

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