From e74c0727183e310c479a1d45a472bdef68db9a04 Mon Sep 17 00:00:00 2001 From: Vivien Kraus Date: Sun, 29 Nov 2020 18:53:17 +0100 Subject: Get a JWKS on the web --- doc/webid-oidc.texi | 20 ++++++++ po/fr.po | 108 ++++++++++++++++++++++-------------------- po/webid-oidc.pot | 87 +++++++++++++++++++++------------- src/scm/webid-oidc/errors.scm | 57 ++++++++++++++++++++-- src/scm/webid-oidc/jwk.scm | 41 ++++++++++++++-- tests/Makefile.am | 2 + tests/jwk-public.scm | 10 ++++ tests/jwks-get.scm | 57 ++++++++++++++++++++++ 8 files changed, 288 insertions(+), 94 deletions(-) create mode 100644 tests/jwk-public.scm create mode 100644 tests/jwks-get.scm diff --git a/doc/webid-oidc.texi b/doc/webid-oidc.texi index 5269330..a63c283 100644 --- a/doc/webid-oidc.texi +++ b/doc/webid-oidc.texi @@ -204,6 +204,7 @@ Return a string explaining the @var{error}. You can limit the @menu * Invalid data format:: * Invalid JWT:: +* Cannot fetch data on the web:: @end menu @node Invalid data format @@ -290,6 +291,25 @@ The @var{value} string is not an encoding of a valid JWS. The @var{jws} cannot be signed. @end deftp +@node Cannot fetch data on the web +@section Cannot fetch data on the web +In the client (local and public parts), resource server and identity +provider, the protocol requires to fetch data on the web. + +@deftp {exception type} &request-failed-unexpectedly @var{response-code} @var{response-reason-phrase} +We expected the request to succeed, but the server sent a non-OK +@var{response-code}. +@end deftp + +@deftp {exception type} &unexpected-header-value @var{header} @var{value} +We did not expect the server to respond with @var{header} set to +@var{value}. +@end deftp + +@deftp {exception type} &unexpected-response @var{response} @var{cause} +The @var{response} (from @emph{(web response)}) is not appropriate. +@end deftp + @node GNU Free Documentation License @appendix GNU Free Documentation License diff --git a/po/fr.po b/po/fr.po index d8023b3..9bdf3cb 100644 --- a/po/fr.po +++ b/po/fr.po @@ -126,96 +126,96 @@ msgstr "Utilisation : generate-random [NOMBRE D'OCTETS]\n" msgid "Usage: generate-key [NUMBER OF BITS | CURVE]\n" msgstr "Utilisation : generate-key [NOMBRE DE BITS | COURBE]\n" -#: src/scm/webid-oidc/errors.scm:195 +#: src/scm/webid-oidc/errors.scm:228 msgid "that’s how it is" msgstr "c’est comme ça" -#: src/scm/webid-oidc/errors.scm:200 +#: src/scm/webid-oidc/errors.scm:233 #, scheme-format msgid "the value ~s is not a base64 string (because ~a)" msgstr "la valeur ~s n’est pas une chaîne base64 (parce que ~a)" -#: src/scm/webid-oidc/errors.scm:203 +#: src/scm/webid-oidc/errors.scm:236 #, scheme-format msgid "the value ~s is not JSON (because ~a)" msgstr "la valeur ~s n’est pas du JSON (parce que ~a)" -#: src/scm/webid-oidc/errors.scm:206 +#: src/scm/webid-oidc/errors.scm:239 #, scheme-format msgid "the value ~s does not identify an elleptic curve" msgstr "la valeur ~s n’identifie pas une courbe elliptique" -#: src/scm/webid-oidc/errors.scm:211 +#: src/scm/webid-oidc/errors.scm:244 #, scheme-format msgid "the value ~s does not identify a JWK (because ~a)" msgstr "la valeur ~s n’identifie pas une JWK (parce que ~a)" -#: src/scm/webid-oidc/errors.scm:213 +#: src/scm/webid-oidc/errors.scm:246 #, scheme-format msgid "the value ~s does not identify a JWK" msgstr "la valeur ~s n’identifie pas une JWK" -#: src/scm/webid-oidc/errors.scm:218 +#: src/scm/webid-oidc/errors.scm:251 #, scheme-format msgid "the value ~s does not identify a public JWK (because ~a)" msgstr "la valeur ~s n’identifie pas une JWK publique (parce que ~a)" -#: src/scm/webid-oidc/errors.scm:220 +#: src/scm/webid-oidc/errors.scm:253 #, scheme-format msgid "the value ~s does not identify a public JWK" msgstr "la valeur ~s n’identifie pas une JWK publique" -#: src/scm/webid-oidc/errors.scm:225 +#: src/scm/webid-oidc/errors.scm:258 #, scheme-format msgid "the value ~s does not identify a private JWK (because ~a)" msgstr "la valeur ~s n’identifie pas une JWK privée (parce que ~a)" -#: src/scm/webid-oidc/errors.scm:227 +#: src/scm/webid-oidc/errors.scm:260 #, scheme-format msgid "the value ~s does not identify a private JWK" msgstr "la valeur ~s n’identifie pas une JWK privée" -#: src/scm/webid-oidc/errors.scm:232 +#: src/scm/webid-oidc/errors.scm:265 #, scheme-format msgid "the value ~s does not identify a JWKS (because ~a)" msgstr "la valeur ~s n’identifie pas un JWKS (parce que ~a)" -#: src/scm/webid-oidc/errors.scm:234 +#: src/scm/webid-oidc/errors.scm:267 #, scheme-format msgid "the value ~s does not identify a JWKS" msgstr "la valeur ~s n’identifie pas un JWKS" -#: src/scm/webid-oidc/errors.scm:237 +#: src/scm/webid-oidc/errors.scm:270 #, scheme-format msgid "the value ~s does not identify a hash algorithm" msgstr "la valeur ~s n’identifie pas un algorithme de hachage" -#: src/scm/webid-oidc/errors.scm:240 +#: src/scm/webid-oidc/errors.scm:273 #, scheme-format msgid "the value ~s is not an alist or misses key ~s" msgstr "la valeur ~s n’est pas une alist ou il manque la clé ~s" -#: src/scm/webid-oidc/errors.scm:243 +#: src/scm/webid-oidc/errors.scm:276 #, scheme-format msgid "the value ~s is not a JWS header (because ~a)" msgstr "la valeur ~s n’est pas un header JWS (parce que ~a)" -#: src/scm/webid-oidc/errors.scm:246 +#: src/scm/webid-oidc/errors.scm:279 #, scheme-format msgid "the value ~s is not a JWS payload (because ~a)" msgstr "la valeur ~s n’est pas un contenu JWS (parce que ~a)" -#: src/scm/webid-oidc/errors.scm:249 +#: src/scm/webid-oidc/errors.scm:282 #, scheme-format msgid "the value ~s is not a JWS (because ~a)" msgstr "la valeur ~s n’est pas un JWS (parce que ~a)" -#: src/scm/webid-oidc/errors.scm:252 +#: src/scm/webid-oidc/errors.scm:285 #, scheme-format msgid "the string ~s cannot be split in 3 parts with ~s" msgstr "la chaîne ~s ne peut pas être découpée en 3 parties avec ~s" -#: src/scm/webid-oidc/errors.scm:255 +#: src/scm/webid-oidc/errors.scm:288 #, scheme-format msgid "" "all key candidates failed to verify signature ~s with algorithm ~s and " @@ -224,68 +224,91 @@ msgstr "" "aucune clé candidate n’a pu vérifier la signature ~s avec l’algorithme ~s et " "le contenu ~a (il y en avait ~a : ~s)" -#: src/scm/webid-oidc/errors.scm:258 +#: src/scm/webid-oidc/errors.scm:291 #, scheme-format msgid "I cannot decode JWS ~a (because ~a)" msgstr "je n’ai pas pu décoder le JWS encodé par ~a (parce que ~a)" -#: src/scm/webid-oidc/errors.scm:261 +#: src/scm/webid-oidc/errors.scm:294 #, scheme-format msgid "I cannot encode JWS ~a (because ~a)" msgstr "je n’ai pas pu encoder le JWS ~a (parce que ~a)" -#: src/scm/webid-oidc/errors.scm:266 +#: src/scm/webid-oidc/errors.scm:297 +#, scheme-format +msgid "" +"the server request unexpectedly failed with code ~a and reason phrase ~s" +msgstr "" +"la requête au serveur a échoué de façon inattendue avec un code ~a et une " +"raison ~s" + +#: src/scm/webid-oidc/errors.scm:302 +#, scheme-format +msgid "the header ~a should not have the value ~s" +msgstr "l’en-tête ~a ne devrait pas avoir la valeur ~s" + +#: src/scm/webid-oidc/errors.scm:304 +#, scheme-format +msgid "the header ~a should be present" +msgstr "l’en-tête ~a devrait être présent" + +#: src/scm/webid-oidc/errors.scm:307 +#, scheme-format +msgid "the server response wasn't expected: ~s (because ~a)" +msgstr "la réponse du serveur est inattendue : ~s (parce que ~a)" + +#: src/scm/webid-oidc/errors.scm:315 msgid "that’s it" msgstr "c’est tout" -#: src/scm/webid-oidc/errors.scm:270 +#: src/scm/webid-oidc/errors.scm:319 #, scheme-format msgid "~a and ~a" msgstr "~a et ~a" -#: src/scm/webid-oidc/errors.scm:273 +#: src/scm/webid-oidc/errors.scm:322 #, scheme-format msgid "~a, ~a" msgstr "~a, ~a" -#: src/scm/webid-oidc/errors.scm:277 +#: src/scm/webid-oidc/errors.scm:326 #, scheme-format msgid "the signature ~a does not match key ~s with payload ~a" msgstr "la signature ~a ne correspond pas à la clé ~s avec le contenu ~a" -#: src/scm/webid-oidc/errors.scm:280 +#: src/scm/webid-oidc/errors.scm:329 msgid "there is an undefined variable" msgstr "il y a une variable non définie" -#: src/scm/webid-oidc/errors.scm:282 +#: src/scm/webid-oidc/errors.scm:331 #, scheme-format msgid "the origin is ~a" msgstr "l’origine est ~a" -#: src/scm/webid-oidc/errors.scm:285 +#: src/scm/webid-oidc/errors.scm:334 #, scheme-format msgid "a message is attached: ~a" msgstr "un message est attaché : ~a" -#: src/scm/webid-oidc/errors.scm:288 +#: src/scm/webid-oidc/errors.scm:337 #, scheme-format msgid "the values ~s are problematic" msgstr "les valeurs ~s sont problématiques" -#: src/scm/webid-oidc/errors.scm:291 +#: src/scm/webid-oidc/errors.scm:340 msgid "there is a kind and args" msgstr "il y a un type et des arguments" -#: src/scm/webid-oidc/errors.scm:293 +#: src/scm/webid-oidc/errors.scm:342 msgid "there is an assertion failure" msgstr "il y a un échec d’assertion" -#: src/scm/webid-oidc/errors.scm:295 +#: src/scm/webid-oidc/errors.scm:344 #, scheme-format msgid "the program quits with code ~a" msgstr "le programme quitte avec le code ~a" -#: src/scm/webid-oidc/errors.scm:298 +#: src/scm/webid-oidc/errors.scm:347 #, scheme-format msgid "Unhandled exception type ~a." msgstr "Type d’exception non pris en charge ~a." @@ -294,25 +317,6 @@ msgstr "Type d’exception non pris en charge ~a." #~ msgid "the value ~s is not Turtle (because ~a)" #~ msgstr "la valeur ~s n’est pas du Turtle (parce que ~a)" -#, scheme-format -#~ msgid "" -#~ "the server request unexpectedly failed with code ~a and reason phrase ~s" -#~ msgstr "" -#~ "la requête au serveur a échoué de façon inattendue avec un code ~a et une " -#~ "raison ~s" - -#, scheme-format -#~ msgid "the header ~a should not have the value ~s" -#~ msgstr "l’en-tête ~a ne devrait pas avoir la valeur ~s" - -#, scheme-format -#~ msgid "the header ~a should be present" -#~ msgstr "l’en-tête ~a devrait être présent" - -#, scheme-format -#~ msgid "the server response wasn't expected: ~s (because ~a)" -#~ msgstr "la réponse du serveur est inattendue : ~s (parce que ~a)" - #, scheme-format #~ msgid "the value ~s is not an OIDC configuration (because ~a)" #~ msgstr "la valeur ~s n’est pas une configuration OIDC (parce que ~a)" diff --git a/po/webid-oidc.pot b/po/webid-oidc.pot index 147fe5e..dccae4a 100644 --- a/po/webid-oidc.pot +++ b/po/webid-oidc.pot @@ -122,164 +122,185 @@ msgstr "" msgid "Usage: generate-key [NUMBER OF BITS | CURVE]\n" msgstr "" -#: src/scm/webid-oidc/errors.scm:195 +#: src/scm/webid-oidc/errors.scm:228 msgid "that’s how it is" msgstr "" -#: src/scm/webid-oidc/errors.scm:200 +#: src/scm/webid-oidc/errors.scm:233 #, scheme-format msgid "the value ~s is not a base64 string (because ~a)" msgstr "" -#: src/scm/webid-oidc/errors.scm:203 +#: src/scm/webid-oidc/errors.scm:236 #, scheme-format msgid "the value ~s is not JSON (because ~a)" msgstr "" -#: src/scm/webid-oidc/errors.scm:206 +#: src/scm/webid-oidc/errors.scm:239 #, scheme-format msgid "the value ~s does not identify an elleptic curve" msgstr "" -#: src/scm/webid-oidc/errors.scm:211 +#: src/scm/webid-oidc/errors.scm:244 #, scheme-format msgid "the value ~s does not identify a JWK (because ~a)" msgstr "" -#: src/scm/webid-oidc/errors.scm:213 +#: src/scm/webid-oidc/errors.scm:246 #, scheme-format msgid "the value ~s does not identify a JWK" msgstr "" -#: src/scm/webid-oidc/errors.scm:218 +#: src/scm/webid-oidc/errors.scm:251 #, scheme-format msgid "the value ~s does not identify a public JWK (because ~a)" msgstr "" -#: src/scm/webid-oidc/errors.scm:220 +#: src/scm/webid-oidc/errors.scm:253 #, scheme-format msgid "the value ~s does not identify a public JWK" msgstr "" -#: src/scm/webid-oidc/errors.scm:225 +#: src/scm/webid-oidc/errors.scm:258 #, scheme-format msgid "the value ~s does not identify a private JWK (because ~a)" msgstr "" -#: src/scm/webid-oidc/errors.scm:227 +#: src/scm/webid-oidc/errors.scm:260 #, scheme-format msgid "the value ~s does not identify a private JWK" msgstr "" -#: src/scm/webid-oidc/errors.scm:232 +#: src/scm/webid-oidc/errors.scm:265 #, scheme-format msgid "the value ~s does not identify a JWKS (because ~a)" msgstr "" -#: src/scm/webid-oidc/errors.scm:234 +#: src/scm/webid-oidc/errors.scm:267 #, scheme-format msgid "the value ~s does not identify a JWKS" msgstr "" -#: src/scm/webid-oidc/errors.scm:237 +#: src/scm/webid-oidc/errors.scm:270 #, scheme-format msgid "the value ~s does not identify a hash algorithm" msgstr "" -#: src/scm/webid-oidc/errors.scm:240 +#: src/scm/webid-oidc/errors.scm:273 #, scheme-format msgid "the value ~s is not an alist or misses key ~s" msgstr "" -#: src/scm/webid-oidc/errors.scm:243 +#: src/scm/webid-oidc/errors.scm:276 #, scheme-format msgid "the value ~s is not a JWS header (because ~a)" msgstr "" -#: src/scm/webid-oidc/errors.scm:246 +#: src/scm/webid-oidc/errors.scm:279 #, scheme-format msgid "the value ~s is not a JWS payload (because ~a)" msgstr "" -#: src/scm/webid-oidc/errors.scm:249 +#: src/scm/webid-oidc/errors.scm:282 #, scheme-format msgid "the value ~s is not a JWS (because ~a)" msgstr "" -#: src/scm/webid-oidc/errors.scm:252 +#: src/scm/webid-oidc/errors.scm:285 #, scheme-format msgid "the string ~s cannot be split in 3 parts with ~s" msgstr "" -#: src/scm/webid-oidc/errors.scm:255 +#: src/scm/webid-oidc/errors.scm:288 #, scheme-format msgid "" "all key candidates failed to verify signature ~s with algorithm ~s and " "payload ~a (there were ~a: ~s)" msgstr "" -#: src/scm/webid-oidc/errors.scm:258 +#: src/scm/webid-oidc/errors.scm:291 #, scheme-format msgid "I cannot decode JWS ~a (because ~a)" msgstr "" -#: src/scm/webid-oidc/errors.scm:261 +#: src/scm/webid-oidc/errors.scm:294 #, scheme-format msgid "I cannot encode JWS ~a (because ~a)" msgstr "" -#: src/scm/webid-oidc/errors.scm:266 +#: src/scm/webid-oidc/errors.scm:297 +#, scheme-format +msgid "" +"the server request unexpectedly failed with code ~a and reason phrase ~s" +msgstr "" + +#: src/scm/webid-oidc/errors.scm:302 +#, scheme-format +msgid "the header ~a should not have the value ~s" +msgstr "" + +#: src/scm/webid-oidc/errors.scm:304 +#, scheme-format +msgid "the header ~a should be present" +msgstr "" + +#: src/scm/webid-oidc/errors.scm:307 +#, scheme-format +msgid "the server response wasn't expected: ~s (because ~a)" +msgstr "" + +#: src/scm/webid-oidc/errors.scm:315 msgid "that’s it" msgstr "" -#: src/scm/webid-oidc/errors.scm:270 +#: src/scm/webid-oidc/errors.scm:319 #, scheme-format msgid "~a and ~a" msgstr "" -#: src/scm/webid-oidc/errors.scm:273 +#: src/scm/webid-oidc/errors.scm:322 #, scheme-format msgid "~a, ~a" msgstr "" -#: src/scm/webid-oidc/errors.scm:277 +#: src/scm/webid-oidc/errors.scm:326 #, scheme-format msgid "the signature ~a does not match key ~s with payload ~a" msgstr "" -#: src/scm/webid-oidc/errors.scm:280 +#: src/scm/webid-oidc/errors.scm:329 msgid "there is an undefined variable" msgstr "" -#: src/scm/webid-oidc/errors.scm:282 +#: src/scm/webid-oidc/errors.scm:331 #, scheme-format msgid "the origin is ~a" msgstr "" -#: src/scm/webid-oidc/errors.scm:285 +#: src/scm/webid-oidc/errors.scm:334 #, scheme-format msgid "a message is attached: ~a" msgstr "" -#: src/scm/webid-oidc/errors.scm:288 +#: src/scm/webid-oidc/errors.scm:337 #, scheme-format msgid "the values ~s are problematic" msgstr "" -#: src/scm/webid-oidc/errors.scm:291 +#: src/scm/webid-oidc/errors.scm:340 msgid "there is a kind and args" msgstr "" -#: src/scm/webid-oidc/errors.scm:293 +#: src/scm/webid-oidc/errors.scm:342 msgid "there is an assertion failure" msgstr "" -#: src/scm/webid-oidc/errors.scm:295 +#: src/scm/webid-oidc/errors.scm:344 #, scheme-format msgid "the program quits with code ~a" msgstr "" -#: src/scm/webid-oidc/errors.scm:298 +#: src/scm/webid-oidc/errors.scm:347 #, scheme-format msgid "Unhandled exception type ~a." msgstr "" diff --git a/src/scm/webid-oidc/errors.scm b/src/scm/webid-oidc/errors.scm index e6c7a3e..1476e86 100644 --- a/src/scm/webid-oidc/errors.scm +++ b/src/scm/webid-oidc/errors.scm @@ -2,7 +2,8 @@ #:use-module ((webid-oidc stubs) #:prefix stubs:) #:use-module (ice-9 exceptions) #:use-module (ice-9 optargs) - #:use-module (ice-9 i18n)) + #:use-module (ice-9 i18n) + #:use-module (web response)) (define (G_ text) (let ((out (gettext text))) @@ -184,6 +185,38 @@ (raise-exception ((record-constructor &cannot-encode-jws) jws key cause))) +(define-public &request-failed-unexpectedly + (make-exception-type + '&request-failed-unexpectedly + &external-error + '(response-code response-reason-phrase))) + +(define-public (raise-request-failed-unexpectedly + response-code response-reason-phrase) + (raise-exception + ((record-constructor &request-failed-unexpectedly) + response-code response-reason-phrase))) + +(define-public &unexpected-header-value + (make-exception-type + '&unexpected-header-value + &external-error + '(header value))) + +(define-public (raise-unexpected-header-value header value) + (raise-exception + ((record-constructor &unexpected-header-value) header value))) + +(define-public &unexpected-response + (make-exception-type + '&unexpected-response + &external-error + '(response cause))) + +(define-public (raise-unexpected-response response cause) + (raise-exception + ((record-constructor &unexpected-response) response cause))) + (define*-public (error->str err #:key (max-depth #f)) (if (record? err) (let* ((type (record-type-descriptor err)) @@ -209,14 +242,14 @@ (let ((cause (get 'cause))) (if cause (format #f (G_ "the value ~s does not identify a JWK (because ~a)") - (get 'value) cause) + (get 'value) (recurse cause)) (format #f (G_ "the value ~s does not identify a JWK") (get 'value))))) ((¬-a-public-jwk) (let ((cause (get 'cause))) (if cause (format #f (G_ "the value ~s does not identify a public JWK (because ~a)") - (get 'value) cause) + (get 'value) (recurse cause)) (format #f (G_ "the value ~s does not identify a public JWK") (get 'value))))) ((¬-a-private-jwk) @@ -230,7 +263,7 @@ (let ((cause (get 'cause))) (if cause (format #f (G_ "the value ~s does not identify a JWKS (because ~a)") - (get 'value) cause) + (get 'value) (recurse cause)) (format #f (G_ "the value ~s does not identify a JWKS") (get 'value))))) ((&unsupported-alg) @@ -260,6 +293,22 @@ ((&cannot-encode-jws) (format #f (G_ "I cannot encode JWS ~a (because ~a)") (get 'value) (recurse (get 'cause)))) + ((&response-failed-unexpectedly) + (format #f (G_ "the server request unexpectedly failed with code ~a and reason phrase ~s") + (get 'response-code) (get 'response-reason-phrase))) + ((&unexpected-header-value) + (let ((value (get 'value))) + (if value + (format #f (G_ "the header ~a should not have the value ~s") + (get 'header) value) + (format #f (G_ "the header ~a should be present") + (get 'header))))) + ((&unexpected-response) + (format #f (G_ "the server response wasn't expected: ~s (because ~a)") + (call-with-output-string + (lambda (port) + (write-response (get 'response) port))) + (recurse (get 'cause)))) ((&compound-exception) (let ((components (get 'components))) (if (null? components) diff --git a/src/scm/webid-oidc/jwk.scm b/src/scm/webid-oidc/jwk.scm index 1ad54ad..db7a41f 100644 --- a/src/scm/webid-oidc/jwk.scm +++ b/src/scm/webid-oidc/jwk.scm @@ -1,7 +1,12 @@ (define-module (webid-oidc jwk) #:use-module ((webid-oidc stubs) #:prefix stubs:) #:use-module (webid-oidc errors) - #:use-module (json)) + #:use-module (ice-9 receive) + #:use-module (ice-9 optargs) + #:use-module (srfi srfi-19) + #:use-module (web response) + #:use-module (web client) + #:use-module (rnrs bytevectors)) (define-public (the-jwk x) (with-exception-handler @@ -36,13 +41,13 @@ (y . ,y))) (rsa-part `((n . ,n) (e . ,e)))) - (case (stubs:kty ec-part) + (case (stubs:kty key) ((EC) ec-part) ((RSA) rsa-part)))))))) (define-public (jwk-public? key) (false-if-exception - (and (the-public-jwk x) #t))) + (and (the-public-jwk key) #t))) (define-public (strip key) (with-exception-handler @@ -86,7 +91,7 @@ (define-public generate-key stubs:generate-key) (define (the-public-keys keys) - (map the-public-key keys)) + (map the-public-jwk keys)) (define-public (the-jwks jwks) (let ((keys (vector->list (assoc-ref jwks 'keys)))) @@ -109,4 +114,30 @@ (the-jwks `((keys . ,pubs)))))) (define-public (jwks-keys jwks) - (vector->list (assq-ref (the-jwks jwks) keys))) + (vector->list (assq-ref (the-jwks jwks) 'keys))) + +(define-public (serve-jwks expiration-date jwks) + (values (build-response + #:headers `((content-type . (application/json)) + (expires . ,expiration-date))) + (stubs:scm->json-string (the-jwks jwks)))) + +(define*-public (get-jwks uri #:key (http-get http-get)) + (receive (response response-body) (http-get uri) + (with-exception-handler + (lambda (cause) + (raise-unexpected-response response cause)) + (lambda () + (unless (eqv? (response-code response) 200) + (raise-request-failed-unexpectedly + (response-code response) + (response-reason-phrase response))) + (let ((content-type (response-content-type response))) + (unless (and (eq? (car content-type) 'application/json) + (or (equal? (assoc-ref (cdr content-type) 'charset) + "utf-8") + (not (assoc-ref (cdr content-type) 'charset)))) + (raise-unexpected-header-value 'content-type content-type)) + (unless (string? response-body) + (set! response-body (utf8->string response-body))) + (the-jwks (stubs:json-string->scm response-body))))))) diff --git a/tests/Makefile.am b/tests/Makefile.am index 172abf3..c8b4e9a 100644 --- a/tests/Makefile.am +++ b/tests/Makefile.am @@ -6,8 +6,10 @@ TESTS = %reldir%/load-library.scm \ %reldir%/jwk-kty-ec-incorrect.scm \ %reldir%/jwk-kty-rsa-correct.scm \ %reldir%/jwk-kty-rsa-incorrect.scm \ + %reldir%/jwk-public.scm \ %reldir%/hash-ok.scm \ %reldir%/hash-unsupported.scm \ + %reldir%/jwks-get.scm \ %reldir%/jkt.scm \ %reldir%/verify.scm \ %reldir%/verification-failed.scm \ diff --git a/tests/jwk-public.scm b/tests/jwk-public.scm new file mode 100644 index 0000000..d82c80b --- /dev/null +++ b/tests/jwk-public.scm @@ -0,0 +1,10 @@ +(use-modules (webid-oidc jwk) + (webid-oidc testing)) + +(with-test-environment + "jwk-public" + (lambda () + (let ((key + '((kty . "RSA") (alg . "RS256") (n . "sV158-MQ-5-sP2iTJibiMap1ug8tNY97laOud3Se_3jd4INq36NwhLpgU3FC5SCfJOs9wehTLzv_hBuo-sW0JNjAEtMEE-SDtx5486gjymDR-5Iwv7bgt25tD0cDgiboZLt1RLn-nP-V3zgYHZa_s9zLjpNyArsWWcSh6tWe2R8yW6BqS8l4_9z8jkKeyAwWmdpkY8BtKS0zZ9yljiCxKvs8CKjfHmrayg45sZ8V1-aRcjtR2ECxATHjE8L96_oNddZ-rj2axf2vTmnkx3OvIMgx0tZ0ycMG6Wy8wxxaR5ir2LV3Gkyfh72U7tI8Q1sokPmH6G62JcduNY66jEQlvQ") (kid . "dedc012d07f52aedfd5f97784e1bcbe23c19724d") (use . "sig") (e . "AQAB")))) + (unless (jwk-public? key) + (exit 1))))) diff --git a/tests/jwks-get.scm b/tests/jwks-get.scm new file mode 100644 index 0000000..4584c8d --- /dev/null +++ b/tests/jwks-get.scm @@ -0,0 +1,57 @@ +(use-modules (webid-oidc jwk) + (webid-oidc testing) + (webid-oidc cache) + (web uri) + (srfi srfi-19) + (web response)) + +(with-test-environment + "jwks-get" + (lambda () + (define* (respond uri #:key (headers '())) + (unless (null? headers) + (exit 1)) + (when (string? uri) + (set! uri (string->uri uri))) + (if (string=? (uri->string uri) "https://example.com/keys") + (values + (build-response #:headers `((expires . ,(time-utc->date (make-time time-utc 0 10))) + (content-type application/json (charset . "utf-8")))) + "{ + \"keys\": [ + { + \"e\": \"AQAB\", + \"use\": \"sig\", + \"kid\": \"dedc012d07f52aedfd5f97784e1bcbe23c19724d\", + \"n\": \"sV158-MQ-5-sP2iTJibiMap1ug8tNY97laOud3Se_3jd4INq36NwhLpgU3FC5SCfJOs9wehTLzv_hBuo-sW0JNjAEtMEE-SDtx5486gjymDR-5Iwv7bgt25tD0cDgiboZLt1RLn-nP-V3zgYHZa_s9zLjpNyArsWWcSh6tWe2R8yW6BqS8l4_9z8jkKeyAwWmdpkY8BtKS0zZ9yljiCxKvs8CKjfHmrayg45sZ8V1-aRcjtR2ECxATHjE8L96_oNddZ-rj2axf2vTmnkx3OvIMgx0tZ0ycMG6Wy8wxxaR5ir2LV3Gkyfh72U7tI8Q1sokPmH6G62JcduNY66jEQlvQ\", + \"alg\": \"RS256\", + \"kty\": \"RSA\" + }, + { + \"alg\": \"RS256\", + \"kid\": \"2e3025f26b595f96eac907cc2b9471422bcaeb93\", + \"e\": \"AQAB\", + \"use\": \"sig\", + \"kty\": \"RSA\", + \"n\": \"syWuIlYmoWSl5rBQGOtYGwO5OCCZnhoWBCyl-x5gby5ofc4HNhBoVVMUggk-f_MH-pyMI5yRYsS_aPQ2bmSox2s4i9cPhxqtSAYMhTPwSwQ2BROC7xxi_N0ovp5Ivut5q8TwAn5kQZa_jR9d7JO20BUB7UqbMkBsqg2J8QTtMJ9YtA5BmUn4Y6vhIjTFtvrA6iM4i1cKoUD5Rirt5CYpcKwsLxBZbVk4E4rqgv7G0UlWt6NAs-z7XDkchlNBVpMUuiUBzxHl4LChc7dsWXRaO5vhu3j_2WnxuWCQZPlGoB51jD_ynZ027hhIcoa_tXg28_qb5Al78ZttiRCQDKueAQ\" + } + ] +} +") + (exit 2))) + (define current-time 0) + (define cache-http-get + (with-cache + #:current-time + (lambda () + (make-time time-utc 0 current-time)) + #:http-get respond)) + (define jwks (get-jwks "https://example.com/keys" + #:http-get cache-http-get)) + (define keys (jwks-keys jwks)) + (unless (eq? (length keys) 2) + (exit 3)) + (map (lambda (k) + (unless (jwk-public? k) + (exit 4))) + keys))) -- cgit v1.2.3