From e3c5fbd6f7c58db41d1dd68ab2cd47f4c1cadbe8 Mon Sep 17 00:00:00 2001 From: Vivien Kraus Date: Sun, 29 Nov 2020 19:21:28 +0100 Subject: Get an openid configuration on the web --- doc/webid-oidc.texi | 4 + po/fr.po | 85 +++++++++--------- po/webid-oidc.pot | 81 +++++++++-------- src/scm/webid-oidc/Makefile.am | 6 +- src/scm/webid-oidc/errors.scm | 13 +++ src/scm/webid-oidc/jwk.scm | 2 + src/scm/webid-oidc/oidc-configuration.scm | 117 ++++++++++++++++++++++++ tests/Makefile.am | 3 +- tests/oidc-configuration.scm | 142 ++++++++++++++++++++++++++++++ 9 files changed, 370 insertions(+), 83 deletions(-) create mode 100644 src/scm/webid-oidc/oidc-configuration.scm create mode 100644 tests/oidc-configuration.scm diff --git a/doc/webid-oidc.texi b/doc/webid-oidc.texi index a63c283..8d2d638 100644 --- a/doc/webid-oidc.texi +++ b/doc/webid-oidc.texi @@ -310,6 +310,10 @@ We did not expect the server to respond with @var{header} set to The @var{response} (from @emph{(web response)}) is not appropriate. @end deftp +@deftp {exception type} ¬-an-oidc-configuration @var{value} @var{cause} +The @var{value} is not appropriate an OIDC configuration. +@end deftp + @node GNU Free Documentation License @appendix GNU Free Documentation License diff --git a/po/fr.po b/po/fr.po index 9bdf3cb..a72ae43 100644 --- a/po/fr.po +++ b/po/fr.po @@ -2,7 +2,7 @@ msgid "" msgstr "" "Project-Id-Version: webid-oidc 0.0.0\n" "Report-Msgid-Bugs-To: vivien@planete-kraus.eu\n" -"POT-Creation-Date: 2021-06-05 16:12+0200\n" +"POT-Creation-Date: 2021-06-05 16:13+0200\n" "PO-Revision-Date: 2021-06-05 11:07+0200\n" "Last-Translator: Vivien Kraus \n" "Language-Team: French \n" @@ -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:228 +#: src/scm/webid-oidc/errors.scm:238 msgid "that’s how it is" msgstr "c’est comme ça" -#: src/scm/webid-oidc/errors.scm:233 +#: src/scm/webid-oidc/errors.scm:243 #, 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:236 +#: src/scm/webid-oidc/errors.scm:246 #, 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:239 +#: src/scm/webid-oidc/errors.scm:249 #, 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:244 +#: src/scm/webid-oidc/errors.scm:254 #, 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:246 +#: src/scm/webid-oidc/errors.scm:256 #, 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:251 +#: src/scm/webid-oidc/errors.scm:261 #, 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:253 +#: src/scm/webid-oidc/errors.scm:263 #, 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:258 +#: src/scm/webid-oidc/errors.scm:268 #, 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:260 +#: src/scm/webid-oidc/errors.scm:270 #, 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:265 +#: src/scm/webid-oidc/errors.scm:275 #, 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:267 +#: src/scm/webid-oidc/errors.scm:277 #, 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:270 +#: src/scm/webid-oidc/errors.scm:280 #, 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:273 +#: src/scm/webid-oidc/errors.scm:283 #, 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:276 +#: src/scm/webid-oidc/errors.scm:286 #, 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:279 +#: src/scm/webid-oidc/errors.scm:289 #, 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:282 +#: src/scm/webid-oidc/errors.scm:292 #, 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:285 +#: src/scm/webid-oidc/errors.scm:295 #, 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:288 +#: src/scm/webid-oidc/errors.scm:298 #, scheme-format msgid "" "all key candidates failed to verify signature ~s with algorithm ~s and " @@ -224,17 +224,17 @@ 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:291 +#: src/scm/webid-oidc/errors.scm:301 #, 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:294 +#: src/scm/webid-oidc/errors.scm:304 #, 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:297 +#: src/scm/webid-oidc/errors.scm:307 #, scheme-format msgid "" "the server request unexpectedly failed with code ~a and reason phrase ~s" @@ -242,73 +242,78 @@ 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 +#: src/scm/webid-oidc/errors.scm:312 #, 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 +#: src/scm/webid-oidc/errors.scm:314 #, 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 +#: src/scm/webid-oidc/errors.scm:317 #, 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 +#: src/scm/webid-oidc/errors.scm:323 +#, 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)" + +#: src/scm/webid-oidc/errors.scm:328 msgid "that’s it" msgstr "c’est tout" -#: src/scm/webid-oidc/errors.scm:319 +#: src/scm/webid-oidc/errors.scm:332 #, scheme-format msgid "~a and ~a" msgstr "~a et ~a" -#: src/scm/webid-oidc/errors.scm:322 +#: src/scm/webid-oidc/errors.scm:335 #, scheme-format msgid "~a, ~a" msgstr "~a, ~a" -#: src/scm/webid-oidc/errors.scm:326 +#: src/scm/webid-oidc/errors.scm:339 #, 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:329 +#: src/scm/webid-oidc/errors.scm:342 msgid "there is an undefined variable" msgstr "il y a une variable non définie" -#: src/scm/webid-oidc/errors.scm:331 +#: src/scm/webid-oidc/errors.scm:344 #, scheme-format msgid "the origin is ~a" msgstr "l’origine est ~a" -#: src/scm/webid-oidc/errors.scm:334 +#: src/scm/webid-oidc/errors.scm:347 #, scheme-format msgid "a message is attached: ~a" msgstr "un message est attaché : ~a" -#: src/scm/webid-oidc/errors.scm:337 +#: src/scm/webid-oidc/errors.scm:350 #, scheme-format msgid "the values ~s are problematic" msgstr "les valeurs ~s sont problématiques" -#: src/scm/webid-oidc/errors.scm:340 +#: src/scm/webid-oidc/errors.scm:353 msgid "there is a kind and args" msgstr "il y a un type et des arguments" -#: src/scm/webid-oidc/errors.scm:342 +#: src/scm/webid-oidc/errors.scm:355 msgid "there is an assertion failure" msgstr "il y a un échec d’assertion" -#: src/scm/webid-oidc/errors.scm:344 +#: src/scm/webid-oidc/errors.scm:357 #, scheme-format msgid "the program quits with code ~a" msgstr "le programme quitte avec le code ~a" -#: src/scm/webid-oidc/errors.scm:347 +#: src/scm/webid-oidc/errors.scm:360 #, scheme-format msgid "Unhandled exception type ~a." msgstr "Type d’exception non pris en charge ~a." @@ -317,10 +322,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 value ~s is not an OIDC configuration (because ~a)" -#~ msgstr "la valeur ~s n’est pas une configuration OIDC (parce que ~a)" - #, scheme-format #~ msgid "the webid field is incorrect: ~s" #~ msgstr "le champ webid est incorrect : ~s" diff --git a/po/webid-oidc.pot b/po/webid-oidc.pot index dccae4a..f442518 100644 --- a/po/webid-oidc.pot +++ b/po/webid-oidc.pot @@ -8,7 +8,7 @@ msgid "" msgstr "" "Project-Id-Version: webid-oidc SNAPSHOT\n" "Report-Msgid-Bugs-To: vivien@planete-kraus.eu\n" -"POT-Creation-Date: 2021-06-05 16:12+0200\n" +"POT-Creation-Date: 2021-06-05 16:13+0200\n" "PO-Revision-Date: YEAR-MO-DA HO:MI+ZONE\n" "Last-Translator: FULL NAME \n" "Language-Team: LANGUAGE \n" @@ -122,185 +122,190 @@ msgstr "" msgid "Usage: generate-key [NUMBER OF BITS | CURVE]\n" msgstr "" -#: src/scm/webid-oidc/errors.scm:228 +#: src/scm/webid-oidc/errors.scm:238 msgid "that’s how it is" msgstr "" -#: src/scm/webid-oidc/errors.scm:233 +#: src/scm/webid-oidc/errors.scm:243 #, scheme-format msgid "the value ~s is not a base64 string (because ~a)" msgstr "" -#: src/scm/webid-oidc/errors.scm:236 +#: src/scm/webid-oidc/errors.scm:246 #, scheme-format msgid "the value ~s is not JSON (because ~a)" msgstr "" -#: src/scm/webid-oidc/errors.scm:239 +#: src/scm/webid-oidc/errors.scm:249 #, scheme-format msgid "the value ~s does not identify an elleptic curve" msgstr "" -#: src/scm/webid-oidc/errors.scm:244 +#: src/scm/webid-oidc/errors.scm:254 #, scheme-format msgid "the value ~s does not identify a JWK (because ~a)" msgstr "" -#: src/scm/webid-oidc/errors.scm:246 +#: src/scm/webid-oidc/errors.scm:256 #, scheme-format msgid "the value ~s does not identify a JWK" msgstr "" -#: src/scm/webid-oidc/errors.scm:251 +#: src/scm/webid-oidc/errors.scm:261 #, scheme-format msgid "the value ~s does not identify a public JWK (because ~a)" msgstr "" -#: src/scm/webid-oidc/errors.scm:253 +#: src/scm/webid-oidc/errors.scm:263 #, scheme-format msgid "the value ~s does not identify a public JWK" msgstr "" -#: src/scm/webid-oidc/errors.scm:258 +#: src/scm/webid-oidc/errors.scm:268 #, scheme-format msgid "the value ~s does not identify a private JWK (because ~a)" msgstr "" -#: src/scm/webid-oidc/errors.scm:260 +#: src/scm/webid-oidc/errors.scm:270 #, scheme-format msgid "the value ~s does not identify a private JWK" msgstr "" -#: src/scm/webid-oidc/errors.scm:265 +#: src/scm/webid-oidc/errors.scm:275 #, scheme-format msgid "the value ~s does not identify a JWKS (because ~a)" msgstr "" -#: src/scm/webid-oidc/errors.scm:267 +#: src/scm/webid-oidc/errors.scm:277 #, scheme-format msgid "the value ~s does not identify a JWKS" msgstr "" -#: src/scm/webid-oidc/errors.scm:270 +#: src/scm/webid-oidc/errors.scm:280 #, scheme-format msgid "the value ~s does not identify a hash algorithm" msgstr "" -#: src/scm/webid-oidc/errors.scm:273 +#: src/scm/webid-oidc/errors.scm:283 #, scheme-format msgid "the value ~s is not an alist or misses key ~s" msgstr "" -#: src/scm/webid-oidc/errors.scm:276 +#: src/scm/webid-oidc/errors.scm:286 #, scheme-format msgid "the value ~s is not a JWS header (because ~a)" msgstr "" -#: src/scm/webid-oidc/errors.scm:279 +#: src/scm/webid-oidc/errors.scm:289 #, scheme-format msgid "the value ~s is not a JWS payload (because ~a)" msgstr "" -#: src/scm/webid-oidc/errors.scm:282 +#: src/scm/webid-oidc/errors.scm:292 #, scheme-format msgid "the value ~s is not a JWS (because ~a)" msgstr "" -#: src/scm/webid-oidc/errors.scm:285 +#: src/scm/webid-oidc/errors.scm:295 #, scheme-format msgid "the string ~s cannot be split in 3 parts with ~s" msgstr "" -#: src/scm/webid-oidc/errors.scm:288 +#: src/scm/webid-oidc/errors.scm:298 #, 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:291 +#: src/scm/webid-oidc/errors.scm:301 #, scheme-format msgid "I cannot decode JWS ~a (because ~a)" msgstr "" -#: src/scm/webid-oidc/errors.scm:294 +#: src/scm/webid-oidc/errors.scm:304 #, scheme-format msgid "I cannot encode JWS ~a (because ~a)" msgstr "" -#: src/scm/webid-oidc/errors.scm:297 +#: src/scm/webid-oidc/errors.scm:307 #, scheme-format msgid "" "the server request unexpectedly failed with code ~a and reason phrase ~s" msgstr "" -#: src/scm/webid-oidc/errors.scm:302 +#: src/scm/webid-oidc/errors.scm:312 #, scheme-format msgid "the header ~a should not have the value ~s" msgstr "" -#: src/scm/webid-oidc/errors.scm:304 +#: src/scm/webid-oidc/errors.scm:314 #, scheme-format msgid "the header ~a should be present" msgstr "" -#: src/scm/webid-oidc/errors.scm:307 +#: src/scm/webid-oidc/errors.scm:317 #, scheme-format msgid "the server response wasn't expected: ~s (because ~a)" msgstr "" -#: src/scm/webid-oidc/errors.scm:315 +#: src/scm/webid-oidc/errors.scm:323 +#, scheme-format +msgid "the value ~s is not an OIDC configuration (because ~a)" +msgstr "" + +#: src/scm/webid-oidc/errors.scm:328 msgid "that’s it" msgstr "" -#: src/scm/webid-oidc/errors.scm:319 +#: src/scm/webid-oidc/errors.scm:332 #, scheme-format msgid "~a and ~a" msgstr "" -#: src/scm/webid-oidc/errors.scm:322 +#: src/scm/webid-oidc/errors.scm:335 #, scheme-format msgid "~a, ~a" msgstr "" -#: src/scm/webid-oidc/errors.scm:326 +#: src/scm/webid-oidc/errors.scm:339 #, scheme-format msgid "the signature ~a does not match key ~s with payload ~a" msgstr "" -#: src/scm/webid-oidc/errors.scm:329 +#: src/scm/webid-oidc/errors.scm:342 msgid "there is an undefined variable" msgstr "" -#: src/scm/webid-oidc/errors.scm:331 +#: src/scm/webid-oidc/errors.scm:344 #, scheme-format msgid "the origin is ~a" msgstr "" -#: src/scm/webid-oidc/errors.scm:334 +#: src/scm/webid-oidc/errors.scm:347 #, scheme-format msgid "a message is attached: ~a" msgstr "" -#: src/scm/webid-oidc/errors.scm:337 +#: src/scm/webid-oidc/errors.scm:350 #, scheme-format msgid "the values ~s are problematic" msgstr "" -#: src/scm/webid-oidc/errors.scm:340 +#: src/scm/webid-oidc/errors.scm:353 msgid "there is a kind and args" msgstr "" -#: src/scm/webid-oidc/errors.scm:342 +#: src/scm/webid-oidc/errors.scm:355 msgid "there is an assertion failure" msgstr "" -#: src/scm/webid-oidc/errors.scm:344 +#: src/scm/webid-oidc/errors.scm:357 #, scheme-format msgid "the program quits with code ~a" msgstr "" -#: src/scm/webid-oidc/errors.scm:347 +#: src/scm/webid-oidc/errors.scm:360 #, scheme-format msgid "Unhandled exception type ~a." msgstr "" diff --git a/src/scm/webid-oidc/Makefile.am b/src/scm/webid-oidc/Makefile.am index 91dff23..ebf6811 100644 --- a/src/scm/webid-oidc/Makefile.am +++ b/src/scm/webid-oidc/Makefile.am @@ -4,11 +4,13 @@ dist_webidoidcmod_DATA += \ %reldir%/testing.scm \ %reldir%/jwk.scm \ %reldir%/jws.scm \ - %reldir%/cache.scm + %reldir%/cache.scm \ + %reldir%/oidc-configuration.scm webidoidcgo_DATA += \ %reldir%/errors.go \ %reldir%/stubs.go \ %reldir%/testing.go \ %reldir%/jwk.go \ %reldir%/jws.go \ - %reldir%/cache.go + %reldir%/cache.go \ + %reldir%/oidc-configuration.go diff --git a/src/scm/webid-oidc/errors.scm b/src/scm/webid-oidc/errors.scm index 1476e86..beeaaea 100644 --- a/src/scm/webid-oidc/errors.scm +++ b/src/scm/webid-oidc/errors.scm @@ -217,6 +217,16 @@ (raise-exception ((record-constructor &unexpected-response) response cause))) +(define-public ¬-an-oidc-configuration + (make-exception-type + '¬-an-oidc-configuration + &external-error + '(value cause))) + +(define-public (raise-not-an-oidc-configuration value cause) + (raise-exception + ((record-constructor ¬-an-oidc-configuration) value cause))) + (define*-public (error->str err #:key (max-depth #f)) (if (record? err) (let* ((type (record-type-descriptor err)) @@ -309,6 +319,9 @@ (lambda (port) (write-response (get 'response) port))) (recurse (get 'cause)))) + ((¬-an-oidc-configuration) + (format #f (G_ "the value ~s is not an OIDC configuration (because ~a)") + (get 'value) (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 db7a41f..fd94b9e 100644 --- a/src/scm/webid-oidc/jwk.scm +++ b/src/scm/webid-oidc/jwk.scm @@ -133,6 +133,8 @@ (response-code response) (response-reason-phrase response))) (let ((content-type (response-content-type response))) + (unless content-type + (raise-unexpected-header-value 'content-type content-type)) (unless (and (eq? (car content-type) 'application/json) (or (equal? (assoc-ref (cdr content-type) 'charset) "utf-8") diff --git a/src/scm/webid-oidc/oidc-configuration.scm b/src/scm/webid-oidc/oidc-configuration.scm new file mode 100644 index 0000000..99a4e17 --- /dev/null +++ b/src/scm/webid-oidc/oidc-configuration.scm @@ -0,0 +1,117 @@ +(define-module (webid-oidc oidc-configuration) + #:use-module (webid-oidc jwk) + #:use-module (webid-oidc errors) + #:use-module ((webid-oidc stubs) #:prefix stubs:) + #:use-module (web uri) + #:use-module (web client) + #:use-module (web response) + #:use-module (rnrs bytevectors) + #:use-module (srfi srfi-19) + #:use-module (ice-9 receive) + #:use-module (ice-9 optargs)) + +(define-public (the-oidc-configuration x) + (with-exception-handler + (lambda (cause) + (raise-not-an-oidc-configuration x cause)) + (lambda () + (let ((jwks-uri (assq-ref x 'jwks_uri)) + (token-endpoint (assq-ref x 'token_endpoint)) + (authorization-endpoint (assq-ref x 'authorization_endpoint))) + (unless jwks-uri + (raise-missing-alist-key x 'jwks_uri)) + (unless token-endpoint + (raise-missing-alist-key x 'token_endpoint)) + (unless authorization-endpoint + (raise-missing-alist-key x 'authorization_endpoint)) + (for-each + (lambda (field) + (unless (string->uri field) + (scm-error 'wrong-type-arg + "the-oidc-configuration" + "expected an uri-like string" + '() + (list field)))) + (list jwks-uri token-endpoint authorization-endpoint)) + x)))) + +(define-public (oidc-configuration? obj) + (false-if-exception + (and (the-oidc-configuration obj) obj))) + +(define-public (make-oidc-configuration jwks-uri + authorization-endpoint + token-endpoint) + (when (string? jwks-uri) + (set! jwks-uri (string->uri jwks-uri))) + (when (string? authorization-endpoint) + (set! authorization-endpoint (string->uri authorization-endpoint))) + (when (string? token-endpoint) + (set! token-endpoint (string->uri token-endpoint))) + (the-oidc-configuration + `((jwks_uri . ,(uri->string jwks-uri)) + (token_endpoint . ,(uri->string token-endpoint)) + (authorization_endpoint . ,(uri->string authorization-endpoint))))) + +(define (uri-field what) + (lambda (x) + (let ((str (assq-ref (the-oidc-configuration x) what))) + (string->uri str)))) + +(define-public oidc-configuration-jwks-uri + (uri-field 'jwks_uri)) + +(define-public oidc-configuration-authorization-endpoint + (uri-field 'authorization_endpoint)) + +(define-public oidc-configuration-token-endpoint + (uri-field 'token_endpoint)) + +(define-public (oidc-configuration-jwks cfg . args) + (apply get-jwks (oidc-configuration-jwks-uri cfg) args)) + +(define-public (serve-oidc-configuration expiration-date cfg) + (let ((with-solid-oidc-supported + (acons 'solid_oidc_supported "https://solidproject.org/TR/solid-oidc" + (the-oidc-configuration cfg)))) + (values (build-response #:headers `((content-type . (application/json)) + (expires . ,expiration-date))) + (stubs:scm->json-string with-solid-oidc-supported)))) + +(define*-public (get-oidc-configuration host + #:key + (userinfo #f) + (port #f) + (http-get http-get)) + (when (and (string? host) + (false-if-exception + (string->uri host))) + ;; host is something like "https://example.com" + (set! host (string->uri host))) + (when (uri? host) + (set! host (uri-host host))) + (let ((uri (build-uri 'https + #:userinfo userinfo + #:host host + #:port port + #:path "/.well-known/openid-configuration"))) + (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 content-type + (raise-unexpected-header-value 'content-type content-type)) + (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-oidc-configuration (stubs:json-string->scm response-body)))))))) diff --git a/tests/Makefile.am b/tests/Makefile.am index c8b4e9a..1959c84 100644 --- a/tests/Makefile.am +++ b/tests/Makefile.am @@ -15,7 +15,8 @@ TESTS = %reldir%/load-library.scm \ %reldir%/verification-failed.scm \ %reldir%/jws.scm \ %reldir%/cache-valid.scm \ - %reldir%/cache-revalidate.scm + %reldir%/cache-revalidate.scm \ + %reldir%/oidc-configuration.scm EXTRA_DIST += $(TESTS) diff --git a/tests/oidc-configuration.scm b/tests/oidc-configuration.scm new file mode 100644 index 0000000..6c613b3 --- /dev/null +++ b/tests/oidc-configuration.scm @@ -0,0 +1,142 @@ +(use-modules (webid-oidc oidc-configuration) + (webid-oidc jwk) + (webid-oidc cache) + (webid-oidc testing) + ((webid-oidc stubs) #:prefix stubs:) + (web uri) + (web response) + (srfi srfi-19) + (ice-9 receive)) + +(with-test-environment + "jwks-get" + (lambda () + (define* (respond uri #:key (headers '())) + (unless (null? headers) + (exit 1)) + (when (string? uri) + (set! uri (string->uri uri))) + (cond + ((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))) + "{ + \"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\" + } + ] +} +")) + ((string=? (uri->string uri) "https://example.com/.well-known/openid-configuration") + (values + (build-response #:headers `((expires . ,(time-utc->date (make-time time-utc 0 10))) + (content-type application/json))) + "{ + \"issuer\": \"https://accounts.google.com\", + \"authorization_endpoint\": \"https://accounts.google.com/o/oauth2/v2/auth\", + \"device_authorization_endpoint\": \"https://oauth2.googleapis.com/device/code\", + \"token_endpoint\": \"https://oauth2.googleapis.com/token\", + \"userinfo_endpoint\": \"https://openidconnect.googleapis.com/v1/userinfo\", + \"revocation_endpoint\": \"https://oauth2.googleapis.com/revoke\", + \"jwks_uri\": \"https://example.com/keys\", + \"response_types_supported\": [ + \"code\", + \"token\", + \"id_token\", + \"code token\", + \"code id_token\", + \"token id_token\", + \"code token id_token\", + \"none\" + ], + \"subject_types_supported\": [ + \"public\" + ], + \"id_token_signing_alg_values_supported\": [ + \"RS256\" + ], + \"scopes_supported\": [ + \"openid\", + \"email\", + \"profile\" + ], + \"token_endpoint_auth_methods_supported\": [ + \"client_secret_post\", + \"client_secret_basic\" + ], + \"claims_supported\": [ + \"aud\", + \"email\", + \"email_verified\", + \"exp\", + \"family_name\", + \"given_name\", + \"iat\", + \"iss\", + \"locale\", + \"name\", + \"picture\", + \"sub\" + ], + \"code_challenge_methods_supported\": [ + \"plain\", + \"S256\" + ] +}")) + (else (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 cfg (get-oidc-configuration + "example.com" + #:http-get cache-http-get)) + (define jwks (oidc-configuration-jwks + cfg + #:http-get cache-http-get)) + (unless (oidc-configuration? cfg) + (exit 3)) + (unless (jwks? jwks) + (exit 4)) + (let ((my-oidc (make-oidc-configuration + "https://example.com/keys" + "https://example.com/authorize" + "https://example.com/token"))) + (receive (response response-body) + (serve-oidc-configuration (time-utc->date (make-time time-utc 0 3600)) + my-oidc) + (unless (eqv? (car (response-content-type response)) 'application/json) + (exit 5)) + (let ((parsed (stubs:json-string->scm response-body))) + (unless (oidc-configuration? parsed) + (exit 6)) + (unless (equal? (assq-ref parsed 'jwks_uri) + "https://example.com/keys") + (exit 7)) + (unless (equal? (assq-ref parsed 'authorization_endpoint) + "https://example.com/authorize") + (exit 8)) + (unless (equal? (assq-ref parsed 'token_endpoint) + "https://example.com/token") + (exit 9)) + (unless (equal? (assq-ref parsed 'solid_oidc_supported) + "https://solidproject.org/TR/solid-oidc") + (exit 10))))))) -- cgit v1.2.3