diff options
| author | Vivien Kraus <vivien@planete-kraus.eu> | 2021-09-20 11:25:29 +0200 |
|---|---|---|
| committer | Vivien Kraus <vivien@planete-kraus.eu> | 2021-09-21 22:28:51 +0200 |
| commit | e910b3ba2ded990a5193f7ea0cfad525332e4171 (patch) | |
| tree | b04e74e7c06e0a0fde5edd7ac0b8773db94cd515 /src/scm/webid-oidc/token-endpoint.scm | |
| parent | dcd329af1ec765ca0fac97ef2dc18a3177d34083 (diff) | |
JWS: use GOOPS
Diffstat (limited to 'src/scm/webid-oidc/token-endpoint.scm')
| -rw-r--r-- | src/scm/webid-oidc/token-endpoint.scm | 45 |
1 files changed, 26 insertions, 19 deletions
diff --git a/src/scm/webid-oidc/token-endpoint.scm b/src/scm/webid-oidc/token-endpoint.scm index 81f8e48..292df4d 100644 --- a/src/scm/webid-oidc/token-endpoint.scm +++ b/src/scm/webid-oidc/token-endpoint.scm @@ -38,6 +38,8 @@ #:use-module (rnrs bytevectors) #:use-module (sxml simple) #:use-module (sxml match) + #:use-module (oop goops) + #:duplicates (merge-generics) #:declarative? #t #:export ( @@ -177,7 +179,7 @@ port))))))) thunk)))) -(define (make-token-endpoint token-endpoint-uri iss jwk validity) +(define (make-token-endpoint token-endpoint-uri iss issuer-key validity) (lambda (request request-body) (when (bytevector? request-body) (set! request-body (utf8->string request-body))) @@ -213,10 +215,11 @@ #:path (uri-path (request-uri request)) #:query (uri-query (request-uri request))))) (let ((grant-type (assoc-ref form-args "grant_type")) - (dpop (dpop-proof-decode - method uri - (assq-ref (request-headers request) 'dpop) - (lambda (jkt) #t)))) + (dpop (decode <dpop-proof> (assq-ref (request-headers request) 'dpop) + #:method method + #:uri uri + #:cnf/check + (lambda (jkt) #t)))) (unless (and grant-type (string? grant-type)) (let ((final-message (format #f (G_ "missing grant type"))) @@ -248,9 +251,16 @@ (make-no-authorization-code) (make-exception-with-message final-message) (make-message-for-the-user final-user-message))))) - (authorization-code-decode str jwk)))) - (values (authorization-code-webid code) - (authorization-code-client-id code)))) + (with-exception-handler + (lambda (error) + (raise-exception + (make-exception + (make-invalid-authorization-code) + error))) + (lambda () + (decode <authorization-code> str + #:issuer-key issuer-key)))))) + (values (webid code) (client-id code)))) ((refresh_token) (let ((refresh-token (assoc-ref form-args "refresh_token"))) (unless refresh-token @@ -268,7 +278,7 @@ (make-message-for-the-user final-user-message))))) (refresh:with-refresh-token refresh-token - (dpop-proof-jwk dpop) + (jwk dpop) values))) (else (let ((final-message @@ -288,26 +298,23 @@ (let* ((iat (time-second (date->time-utc current-time))) (exp (+ iat validity))) (let ((id-token - (issue-id-token - jwk + (issue <id-token> + issuer-key #:webid webid - #:sub (uri->string webid) #:iss iss - #:aud client-id - #:validity 3600)) + #:aud client-id)) (access-token - (issue-access-token - jwk + (issue <access-token> + issuer-key #:webid webid #:iss iss - #:validity 3600 - #:client-key (dpop-proof-jwk dpop) + #:client-key (jwk dpop) #:client-id client-id)) (refresh-token (if (equal? grant-type "refresh_token") (assoc-ref form-args "refresh_token") (refresh:issue-refresh-token webid client-id - (jkt (dpop-proof-jwk dpop)))))) + (jkt (jwk dpop)))))) (values (build-response #:headers '((content-type application/json) (cache-control (no-cache no-store))) |