diff options
| author | Christopher Baines <mail@cbaines.net> | 2020-05-08 11:14:46 +0100 |
|---|---|---|
| committer | Christopher Baines <mail@cbaines.net> | 2020-05-08 11:14:46 +0100 |
| commit | c134165dc4a459423c599bd6a6f1a0a8a459b7c4 (patch) | |
| tree | f081338f54e1076b6a636e0924283e952cbc4bc2 | |
| parent | 2efa624b1fbe8f1dbadff23dfe1a9fa288f7a54c (diff) | |
| download | build-coordinator-c134165dc4a459423c599bd6a6f1a0a8a459b7c4.tar build-coordinator-c134165dc4a459423c599bd6a6f1a0a8a459b7c4.tar.gz | |
Support handling access denied responses as successes
This will be useful for submitting setup failures. Once the message is
processed successfully, the agent should no longer have access to update that
build. If the request is processed successfully, but the response isn't
received, when the agent retries, it'll get an access denied response. In this
scenario, that means success, so this will allow it to be treated as such.
| -rw-r--r-- | guix-build-coordinator/agent-messaging/http.scm | 26 |
1 files changed, 22 insertions, 4 deletions
diff --git a/guix-build-coordinator/agent-messaging/http.scm b/guix-build-coordinator/agent-messaging/http.scm index 1f1b5de..3f4f5ba 100644 --- a/guix-build-coordinator/agent-messaging/http.scm +++ b/guix-build-coordinator/agent-messaging/http.scm @@ -409,7 +409,8 @@ port. Also, the port used can be changed by passing the --port option.\n" (define* (coordinator-http-request coordinator-uri agent-uuid password path - #:key method body (headers '())) + #:key method body (headers '()) + succeed-on-access-denied-retry?) (define auth-value (string-append "Basic " @@ -421,6 +422,8 @@ port. Also, the port used can be changed by passing the --port option.\n" (coordinator-uri-for-path coordinator-uri path)) + (define first-request-failed? #f) + (define (make-request) (let-values (((response body) (http-request uri @@ -436,10 +439,11 @@ port. Also, the port used can be changed by passing the --port option.\n" (current-error-port) "error: coordinator-http-request: ~A ~A: ~A\n" method path (response-code response)) - (error (catch #t + (let ((body + (catch #t (lambda () - (if (eq? '(application/json (charset . "utf-8")) - (response-content-type response)) + (if (equal? '(application/json (charset . "utf-8")) + (response-content-type response)) (json-string->scm (utf8->string body)) (utf8->string body))) (lambda (key . args) @@ -448,6 +452,20 @@ port. Also, the port used can be changed by passing the --port option.\n" "error decoding body ~A ~A\n" key args) #f)))) + (if (and first-request-failed? + succeed-on-access-denied-retry? + (equal? body + '(("error" . "access denied")))) + (begin + (simple-format + (current-error-port) + "warning: treating access denied response as success\n") + (values body response)) + (begin + (set! first-request-failed? #t) + (raise-exception + (make-exception-with-message + body)))))) (values (json-string->scm (utf8->string body)) response)))) |