aboutsummaryrefslogtreecommitdiff
path: root/guix-data-service/builds.scm
diff options
context:
space:
mode:
authorChristopher Baines <mail@cbaines.net>2019-03-06 23:36:46 +0000
committerChristopher Baines <mail@cbaines.net>2019-03-06 23:47:26 +0000
commit891cf42fc64febc08736a2a619ef43025433a368 (patch)
treedf943a5b7ce9a27759ab825eba1873cc042e7507 /guix-data-service/builds.scm
parentb0eaf9cf7a8a60a7a2a4df2f44815e20ccc4720d (diff)
downloaddata-service-891cf42fc64febc08736a2a619ef43025433a368.tar
data-service-891cf42fc64febc08736a2a619ef43025433a368.tar.gz
Improve error handling in builds.scm
Diffstat (limited to 'guix-data-service/builds.scm')
-rw-r--r--guix-data-service/builds.scm75
1 files changed, 38 insertions, 37 deletions
diff --git a/guix-data-service/builds.scm b/guix-data-service/builds.scm
index a9a945c..a6802ac 100644
--- a/guix-data-service/builds.scm
+++ b/guix-data-service/builds.scm
@@ -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
- "api/latestbuilds?nr=10"
- "&derivation=" derivation-file-name))))
-
- (cond
- ((eq? (response-code response) 200)
- (json-string->scm
- (bytevector->string body "utf-8")))
- (else #f))))
-
-(define (fetch-queued-builds-for-derivation url derivation-file-name)
- (let-values
- (((response body)
- (http-request (string-append
- url
- "api/queue?nr=10"
- "&derivation=" derivation-file-name))))
-
- (cond
- ((eq? (response-code response) 200)
- (json-string->scm
- (bytevector->string body "utf-8")))
- (else #f))))
+(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))
+
+ (let-values (((response body) (http-request url)))
+ (let ((code (response-code response)))
+ (cond
+ ((eq? code 200)
+ (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 base-url derivation-file-name)
+ (define url
+ (string-append base-url
+ "api/queue?nr=10"
+ "&derivation=" derivation-file-name))
+
+ (let-values (((response body) (http-request url)))
+ (let ((code (response-code response)))
+ (cond
+ ((eq? code 200)
+ (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)
(let-values