diff options
Diffstat (limited to 'src/scm/webid-oidc/client/accounts.scm')
| -rw-r--r-- | src/scm/webid-oidc/client/accounts.scm | 34 |
1 files changed, 17 insertions, 17 deletions
diff --git a/src/scm/webid-oidc/client/accounts.scm b/src/scm/webid-oidc/client/accounts.scm index 3591b52..7e14000 100644 --- a/src/scm/webid-oidc/client/accounts.scm +++ b/src/scm/webid-oidc/client/accounts.scm @@ -31,7 +31,7 @@ #:use-module ((webid-oidc parameters) #:prefix p:) #:use-module ((webid-oidc stubs) #:prefix stubs:) #:use-module ((webid-oidc oidc-id-token) #:prefix id:) - #:use-module ((webid-oidc oidc-configuration) #:prefix cfg:) + #:use-module (webid-oidc oidc-configuration) #:use-module ((webid-oidc jwk) #:prefix jwk:) #:use-module (webid-oidc dpop-proof) #:use-module ((webid-oidc client client) #:prefix client:) @@ -41,6 +41,10 @@ #:use-module (rnrs bytevectors) #:use-module (oop goops) #:declarative? #t + #:re-export + ( + (p:anonymous-http-request . anonymous-http-request) + ) #:export ( <account> @@ -58,7 +62,6 @@ authorization-process authorization-state - anonymous-http-request &authorization-code-required make-authorization-code-required @@ -129,15 +132,12 @@ (define authorization-state (make-parameter #f)) -(define anonymous-http-request - (make-parameter http-request)) - (define (http-request->http-get http-request) (lambda* (uri . all-args) (apply http-request uri #:method 'GET all-args))) (define (http-get-implementation) - (http-request->http-get (anonymous-http-request))) + (http-request->http-get (p:anonymous-http-request))) (define-class <account> () (subject #:init-keyword #:subject #:getter subject) @@ -157,13 +157,16 @@ (define-method (->sexp (account <account>)) `(begin - (use-modules (oop goops) (webid-oidc client accounts) (webid-oidc jwk)) + (use-modules (oop goops) (webid-oidc client accounts) (webid-oidc jwk) (webid-oidc jws) (webid-oidc oidc-id-token)) (make <account> #:subject ,(uri->string (subject account)) #:issuer ,(uri->string (issuer account)) ,@(let ((id-token (id-token account))) (if id-token - `(#:id-token (quote ,id-token)) + (receive (header payload) (token->jwk id-token) + `(#:id-token (make <id-token> + #:jws-header (quote ,header) + #:jws-payload (quote ,payload)))) '())) ,@(let ((access-token (access-token account))) (if access-token @@ -217,14 +220,11 @@ (let ((client (client:client))) (receive (authorization-endpoint token-endpoint) (let ((configuration - (cfg:get-oidc-configuration - (uri-host issuer) - #:userinfo (uri-userinfo issuer) - #:port (uri-port issuer) - #:http-get (http-get-implementation)))) + (make <oidc-configuration> + #:server issuer))) (values - (cfg:oidc-configuration-authorization-endpoint configuration) - (cfg:oidc-configuration-token-endpoint configuration))) + (authorization-endpoint configuration) + (token-endpoint configuration))) (receive (grant-type grant) (if refresh-token (values "refresh_token" refresh-token) @@ -261,7 +261,7 @@ #:htm 'POST #:htu token-endpoint))) (receive (response response-body) - ((anonymous-http-request) token-endpoint + ((p:anonymous-http-request) token-endpoint #:method 'POST #:body (string-join @@ -372,7 +372,7 @@ (lambda () (set! id-token (decode <id:id-token> id-token - #:http-request (anonymous-http-request))))) + #:http-request (p:anonymous-http-request))))) ;; We are not interested in the ID token ;; signature anymore, because it won’t be ;; transmitted to other parties and we know that |