diff options
Diffstat (limited to 'src/scm/webid-oidc')
-rw-r--r-- | src/scm/webid-oidc/ChangeLog | 7 | ||||
-rw-r--r-- | src/scm/webid-oidc/Makefile.am | 6 | ||||
-rw-r--r-- | src/scm/webid-oidc/errors.scm | 37 | ||||
-rw-r--r-- | src/scm/webid-oidc/token-endpoint.scm | 168 |
4 files changed, 216 insertions, 2 deletions
diff --git a/src/scm/webid-oidc/ChangeLog b/src/scm/webid-oidc/ChangeLog index 1223e69..8ce40eb 100644 --- a/src/scm/webid-oidc/ChangeLog +++ b/src/scm/webid-oidc/ChangeLog @@ -1,3 +1,10 @@ +2021-05-07 Vivien Kraus <vivien@planete-kraus.eu> + + * token-endpoint.scm (make-token-endpoint): The token endpoint + needs to know its public URI, because if it is behind a reverse + proxy we can’t rely on (request-uri request); and it will fail + DPoP validation. + 2021-04-30 Vivien Kraus <vivien@planete-kraus.eu> * reverse-proxy.scm (make-reverse-proxy): Make the auth header diff --git a/src/scm/webid-oidc/Makefile.am b/src/scm/webid-oidc/Makefile.am index 0aea0d9..8436089 100644 --- a/src/scm/webid-oidc/Makefile.am +++ b/src/scm/webid-oidc/Makefile.am @@ -16,7 +16,8 @@ dist_webidoidcmod_DATA += \ %reldir%/oidc-id-token.scm \ %reldir%/authorization-page.scm \ %reldir%/authorization-page-unsafe.scm \ - %reldir%/authorization-endpoint.scm + %reldir%/authorization-endpoint.scm \ + %reldir%/token-endpoint.scm webidoidcgo_DATA += \ %reldir%/errors.go \ @@ -36,6 +37,7 @@ webidoidcgo_DATA += \ %reldir%/oidc-id-token.go \ %reldir%/authorization-page.go \ %reldir%/authorization-page-unsafe.go \ - %reldir%/authorization-endpoint.go + %reldir%/authorization-endpoint.go \ + %reldir%/token-endpoint.go EXTRA_DIST += %reldir%/ChangeLog diff --git a/src/scm/webid-oidc/errors.scm b/src/scm/webid-oidc/errors.scm index 714e0be..4b4ba2d 100644 --- a/src/scm/webid-oidc/errors.scm +++ b/src/scm/webid-oidc/errors.scm @@ -788,6 +788,36 @@ ((record-constructor &unknown-client-locale) web-locale c-locale) #:continuable? #t)) +(define-public &unsupported-grant-type + (make-exception-type + '&unsupported-grant-type + &external-error + '(value))) + +(define-public (raise-unsupported-grant-type value) + (raise-exception + ((record-constructor &unsupported-grant-type) value))) + +(define-public &no-authorization-code + (make-exception-type + '&no-authorization-code + &external-error + '(value))) + +(define-public (raise-no-authorization-code) + (raise-exception + ((record-constructor &no-authorization-code)))) + +(define-public &no-refresh-token + (make-exception-type + '&no-refresh-token + &external-error + '(value))) + +(define-public (raise-no-refresh-token) + (raise-exception + ((record-constructor &no-refresh-token)))) + (define*-public (error->str err #:key (max-depth #f)) (if (record? err) (let* ((type (record-type-descriptor err)) @@ -1089,6 +1119,13 @@ ((&cannot-encode-id-token) (format #f (G_ "I cannot encode ~s as an ID token (because ~a)") (get 'value) (recurse (get 'cause)))) + ((&unsupported-grant-type) + (format #f (G_ "the grant type ~s is not supported") + (get 'value))) + ((&no-authorization-code) + (format #f (G_ "there is no authorization code in the request"))) + ((&no-refresh-token) + (format #f (G_ "there is no refresh token in the request"))) ((¬-an-id-token) (format #f (G_ "~s is not an ID token (because ~a)") (get 'value) (recurse (get 'cause)))) diff --git a/src/scm/webid-oidc/token-endpoint.scm b/src/scm/webid-oidc/token-endpoint.scm new file mode 100644 index 0000000..422bac6 --- /dev/null +++ b/src/scm/webid-oidc/token-endpoint.scm @@ -0,0 +1,168 @@ +(define-module (webid-oidc token-endpoint) + #:use-module (webid-oidc errors) + #:use-module (webid-oidc authorization-code) + #:use-module (webid-oidc dpop-proof) + #:use-module (webid-oidc jws) + #:use-module (webid-oidc jwk) + #:use-module (webid-oidc oidc-id-token) + #:use-module (webid-oidc access-token) + #:use-module ((webid-oidc stubs) #:prefix stubs:) + #:use-module ((webid-oidc refresh-token) #:prefix refresh:) + #:use-module (web client) + #:use-module (web request) + #:use-module (web response) + #:use-module (web uri) + #:use-module (ice-9 optargs) + #:use-module (ice-9 receive) + #:use-module (srfi srfi-19) + #:use-module (rnrs bytevectors)) + +(define (try-handle-web-failure thunk) + (define (error->str err) + (if (record? err) + (let* ((type (record-type-descriptor err)) + (get + (lambda (slot) + ((record-accessor type slot) err))) + (recurse + (lambda (err) + (error->str err)))) + (case (record-type-name type) + ((&cannot-decode-dpop-proof) + (format #f "the DPoP proof is invalid")) + ((&no-authorization-code) + (format #f "there is no authorization code in the request")) + ((&no-refresh-token) + (format #f "there is no refresh token in the request")) + ((&cannot-decode-authorization-code) + (format #f "the authorization code is invalid")) + ((&invalid-refresh-token) + (format #f "the refresh token is invalid")) + ((&invalid-key-for-refresh-token) + (format #f "the refresh token is bound to another key")) + ((&unsupported-grant-type) + (format #f "the grant type ~s is not supported" (get 'value))) + (else + (raise-exception err)))) + (throw err))) + (with-exception-handler + (lambda (error) + (values + (build-response + #:code 400 + #:reason-phrase (string-append "Bad Request: " (error->str error))) + (error->str error))) + thunk + #:unwind? #t)) + +(define*-public (make-token-endpoint token-endpoint-uri iss alg jwk validity jti-list + #:key + (refresh-token-dir refresh:default-dir) + (current-time current-time)) + (lambda* (request request-body) + (try-handle-web-failure + (lambda () + (when (bytevector? request-body) + (set! request-body (utf8->string request-body))) + (let ((current-time + (let ((t current-time)) + (when (thunk? t) + (set! t (t))) + (when (integer? t) + (set! t (make-time time-utc 0 t))) + (when (time? t) + (set! t (time-utc->date t))) + t)) + (form-args + (if (and (request-content-type request) + (eq? (car (request-content-type request)) + 'application/x-www-form-urlencoded)) + (filter + (lambda (x) x) + (map (lambda (kv) + (let ((parsed + (list->vector + (map (lambda (x) + (uri-decode x #:decode-plus-to-space? #t)) + (string-split kv #\=))))) + (if (eq? (vector-length parsed) 2) + `(,(vector-ref parsed 0) . ,(vector-ref parsed 1)) + #f))) + (string-split request-body #\&))) + '())) + (method (request-method request)) + ;; Maybe we’re behind a reverse proxy, so the authority of + ;; (request-uri request) is meaningless. + (uri (build-uri (uri-scheme token-endpoint-uri) + #:userinfo (uri-userinfo token-endpoint-uri) + #:host (uri-host token-endpoint-uri) + #:port (uri-port token-endpoint-uri) + #: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 + current-time jti-list method uri + (assq-ref (request-headers request) 'dpop) + (lambda (jkt) #t)))) + (unless (and grant-type (string? grant-type)) + (raise-unsupported-grant-type #f)) + (receive (webid client-id) + (case (string->symbol grant-type) + ((authorization_code) + (let ((code + (let ((str (assoc-ref form-args "code"))) + (unless str + (raise-no-authorization-code)) + (authorization-code-decode + current-time jti-list str jwk)))) + (values (authorization-code-webid code) + (authorization-code-client-id code)))) + ((refresh_token) + (let ((refresh-token (assoc-ref form-args "refresh_token"))) + (unless refresh-token + (raise-no-refresh-token)) + (refresh:with-refresh-token + refresh-token + (dpop-proof-jwk dpop) + values + #:dir refresh-token-dir))) + (else + (raise-unsupported-grant-type grant-type))) + (let* ((iat (time-second (date->time-utc current-time))) + (exp (+ iat validity))) + (let ((id-token + (issue-id-token + jwk + #:alg alg + #:webid (uri->string webid) + #:sub (uri->string webid) + #:iss (uri->string iss) + #:aud (uri->string client-id) + #:exp exp + #:iat iat)) + (access-token + (issue-access-token + jwk + #:alg alg + #:webid (uri->string webid) + #:iss (uri->string iss) + #:exp exp + #:iat iat + #:client-key (dpop-proof-jwk dpop) + #:client-id (uri->string 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)) + #:dir refresh-token-dir)))) + (values + (build-response #:headers '((content-type application/json) + (cache-control (no-cache no-store))) + #:port #f) + (stubs:scm->json-string + `((id_token . ,id-token) + (access_token . ,access-token) + (token_type . "DPoP") + (expires_in . ,validity) + (refresh_token . ,refresh-token))))))))))))) |