diff options
author | Vivien Kraus <vivien@planete-kraus.eu> | 2021-05-18 00:15:54 +0200 |
---|---|---|
committer | Vivien Kraus <vivien@planete-kraus.eu> | 2021-05-18 00:49:21 +0200 |
commit | 58d4bdf80cb284f08b705a1bd553e84b02044964 (patch) | |
tree | 84e7d5a752c4eca26deb04e75365e7ab8e91c8dc | |
parent | 7b3b7dcff9615255ed6f8bfa70f1f593609be2a5 (diff) |
fixup! Negociate a token (client)
-rw-r--r-- | src/scm/webid-oidc/client.scm | 34 |
1 files changed, 17 insertions, 17 deletions
diff --git a/src/scm/webid-oidc/client.scm b/src/scm/webid-oidc/client.scm index fd970f7..573205b 100644 --- a/src/scm/webid-oidc/client.scm +++ b/src/scm/webid-oidc/client.scm @@ -98,7 +98,7 @@ (raise-neither-identity-provider-nor-webid host-or-webid why-not-identity-provider - why-not-webid)) + cannot-be-webid)) (lambda () (let ((host (car configurations)) (cfg (cdr configurations))) @@ -367,21 +367,21 @@ ;; API. (set! id-token (cons `((alg . "HS256")) id-token))) (let ((profiles (list-profiles #:dir dir))) - (let ((find-refresh-token - (lambda (profiles) - (when (null? profiles) - (raise-profile-not-found (id-token-webid id-token) - (id-token-iss id-token) - dir)) - (let ((prof (car profiles)) - (others (cdr profiles))) - (let ((webid (car prof)) - (issuer (cadr prof)) - (refresh (caddr prof))) - (if (and (equal? webid (id-token-webid id-token)) - (equal? issuer (id-token-iss id-token))) - refresh - (find-refresh-token others))))))) + (letrec ((find-refresh-token + (lambda (profiles) + (when (null? profiles) + (raise-profile-not-found (id-token-webid id-token) + (id-token-iss id-token) + dir)) + (let ((prof (car profiles)) + (others (cdr profiles))) + (let ((webid (car prof)) + (issuer (cadr prof)) + (refresh (caddr prof))) + (if (and (equal? webid (id-token-webid id-token)) + (equal? issuer (id-token-iss id-token))) + refresh + (find-refresh-token others))))))) (login (id-token-webid id-token) (id-token-iss id-token) (find-refresh-token (profiles)) @@ -484,7 +484,7 @@ ((#:headers) (if (null? (cdr rest)) (parse-args uri method headers (cons kw other-args-rev) '()) - (parse-args uri method (append headers (cadr rest)) (cddr rest)))) + (parse-args uri method (append headers (cadr rest)) other-args-rev (cddr rest)))) (else (parse-args uri method headers (cons kw other-args-rev) '())))))) (define (parse-http-request-args uri args) |