summaryrefslogtreecommitdiff
path: root/src/scm
diff options
context:
space:
mode:
authorVivien Kraus <vivien@planete-kraus.eu>2021-05-18 00:15:54 +0200
committerVivien Kraus <vivien@planete-kraus.eu>2021-05-18 00:49:21 +0200
commit58d4bdf80cb284f08b705a1bd553e84b02044964 (patch)
tree84e7d5a752c4eca26deb04e75365e7ab8e91c8dc /src/scm
parent7b3b7dcff9615255ed6f8bfa70f1f593609be2a5 (diff)
fixup! Negociate a token (client)
Diffstat (limited to 'src/scm')
-rw-r--r--src/scm/webid-oidc/client.scm34
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)