diff options
| author | Christopher Baines <mail@cbaines.net> | 2024-01-12 15:21:38 +0000 |
|---|---|---|
| committer | Christopher Baines <mail@cbaines.net> | 2024-01-12 15:49:21 +0000 |
| commit | de25e4b2886c1a4690344ff2f641ebc1a3c98675 (patch) | |
| tree | 5e973f537f791a7c098a427169d9de589a82c59b | |
| parent | d6edfc8f8f474ccb1c200f2135384646f11c8fb5 (diff) | |
| download | build-coordinator-de25e4b2886c1a4690344ff2f641ebc1a3c98675.tar build-coordinator-de25e4b2886c1a4690344ff2f641ebc1a3c98675.tar.gz | |
Change retry-on-error to take #:ignore and #:no-retry
And change #:ignore to better reflect ignoring the exception.
| -rw-r--r-- | guix-build-coordinator/agent-messaging/http.scm | 2 | ||||
| -rw-r--r-- | guix-build-coordinator/utils.scm | 34 |
2 files changed, 23 insertions, 13 deletions
diff --git a/guix-build-coordinator/agent-messaging/http.scm b/guix-build-coordinator/agent-messaging/http.scm index 04f4ea4..66045b4 100644 --- a/guix-build-coordinator/agent-messaging/http.scm +++ b/guix-build-coordinator/agent-messaging/http.scm @@ -199,7 +199,7 @@ (with-port-timeouts make-request)) #:times retry-times #:delay 10 - #:ignore agent-error-from-coordinator?)) + #:no-retry agent-error-from-coordinator?)) (define* (fetch-session-credentials coordinator name diff --git a/guix-build-coordinator/utils.scm b/guix-build-coordinator/utils.scm index 81d0899..6139835 100644 --- a/guix-build-coordinator/utils.scm +++ b/guix-build-coordinator/utils.scm @@ -634,21 +634,31 @@ References: ~a~%" compressed-size))) compressed-files)))) -(define* (retry-on-error f #:key times delay ignore error-hook) +(define* (retry-on-error f #:key times delay ignore no-retry error-hook) (let loop ((attempt 1)) (match (with-exception-handler (lambda (exn) - (when (cond - ((list? ignore) - (any (lambda (test) - (test exn)) - ignore)) - ((procedure? ignore) - (ignore exn)) - (else #f)) - (raise-exception exn)) - - (cons #f exn)) + (if (cond + ((list? ignore) + (any (lambda (test) + (test exn)) + ignore)) + ((procedure? ignore) + (ignore exn)) + (else #f)) + `(#t . (,exn)) + (begin + (when (cond + ((list? no-retry) + (any (lambda (test) + (test exn)) + no-retry)) + ((procedure? no-retry) + (no-retry exn)) + (else #f)) + (raise-exception exn)) + + (cons #f exn)))) (lambda () (call-with-values f (lambda vals |