diff options
author | Vivien Kraus <vivien@planete-kraus.eu> | 2021-04-27 14:07:10 +0200 |
---|---|---|
committer | Vivien Kraus <vivien@planete-kraus.eu> | 2021-06-19 13:06:24 +0200 |
commit | 6d2ea6504f000feac288b4f3fc33a8b0334a17b7 (patch) | |
tree | 6ae6b086fd031327aa9b555518afdfd172982f7c | |
parent | e3c5fbd6f7c58db41d1dd68ab2cd47f4c1cadbe8 (diff) |
Define the access token API
-rw-r--r-- | doc/webid-oidc.texi | 111 | ||||
-rw-r--r-- | po/fr.po | 257 | ||||
-rw-r--r-- | po/webid-oidc.pot | 174 | ||||
-rw-r--r-- | src/scm/webid-oidc/Makefile.am | 6 | ||||
-rw-r--r-- | src/scm/webid-oidc/access-token.scm | 205 | ||||
-rw-r--r-- | src/scm/webid-oidc/errors.scm | 208 |
6 files changed, 802 insertions, 159 deletions
diff --git a/doc/webid-oidc.texi b/doc/webid-oidc.texi index 8d2d638..27295e0 100644 --- a/doc/webid-oidc.texi +++ b/doc/webid-oidc.texi @@ -118,9 +118,62 @@ are @emph{strings}, but we hope that in the future SRFI-180 will be more closely respected. @menu +* The access token:: * Generic JWTs:: @end menu +@node The access token +@section The access token + +The access token is obtained by the client through a token request, +and is presented to the server on each authenticated request. It is +signed by the identity provider, and it contains enough information so +that the server knows who the user is and who the agent is, and most +importantly the fingerprint of the key that the client should use in a +DPoP proof. + +The API is defined in @emph{(webid-oidc access-token)}. + +@deffn function access-token? @var{object} +Check that @var{object} is a decoded access token. +@end deffn + +There are field getters for the access token: + +@deffn function access-token-webid @var{token} +@deffnx function access-token-iss @var{token} +@deffnx function access-token-aud @var{token} +@deffnx function access-token-exp @var{token} +@deffnx function access-token-iat @var{token} +@deffnx function access-token-cnf/jkt @var{token} +@deffnx function access-token-client-id @var{token} +Get the suitable field from the payload of @var{token}. +@end deffn + +Access tokens can be signed and encoded as a string, or decoded. + +@deffn function access-token-decode @var{token} @var{[#http-get]} +Decode @var{token}, as a string, into a decoded token. As with the ID +token, the signature verification will need to fetch the oidc +configuration of the claimed issuer, and check the signature against +the published keys. The @code{http-get} optional keyword argument can +set a different implementation of @code{http-get} from +@emph{(web client)}, for instance to re-use the what has been obtained +by the ID token validation. Return @code{#f} if it failed, or the +decoded token otherwise. +@end deffn + +@deffn function access-token-encode @var{token} @var{key} +Encode @var{token} and sign it with the issuer’s @var{key}. +@end deffn + +@deffn function issue-access-token @var{issuer-key} @var{#alg} @var{#webid} @var{#iss} @var{#exp} @var{#iat} @var{[#client-key} @var{|} @var{#cnf/jkt]} @var{#client-id} +Create an access token, and encode it with @var{issuer-key}. You can +either set the @code{#:cnf/jkt} keyword argument with the fingerprint +of the client key, or set @code{#:client-key} directly, in which case +the fingerprint will be computed for you. +@end deffn + @node Generic JWTs @section Generic JWTs @@ -218,13 +271,41 @@ failed. @var{value} is the incorrect input, and @var{cause} is a low-level error. @end deftp +@deftp {exception type} &incorrect-webid-field @var{value} +The @var{value} of the webid field in the JWT is missing (if +@code{#f}), or not an acceptable value. +@end deftp + +@deftp {exception type} &incorrect-iss-field @var{value} +The @var{value} of the iss field is incorrect. +@end deftp + +@deftp {exception type} &incorrect-aud-field @var{value} +The @var{value} of the aud field is incorrect. +@end deftp + +@deftp {exception type} &incorrect-iat-field @var{value} +The @var{value} of the iat field is incorrect. +@end deftp + +@deftp {exception type} &incorrect-exp-field @var{value} +The @var{value} of the exp field is incorrect. +@end deftp + +@deftp {exception type} &incorrect-cnf/jkt-field @var{value} +The @var{value} of the cnf/jkt field is incorrect. +@end deftp + +@deftp {exception type} &incorrect-client-id-field @var{value} +The @var{value} of the client-id field is incorrect. +@end deftp + @node Invalid JWT @section Invalid JWT Each JWT type – access token, DPoP proof, ID token, authorization code (this is internal to the identity provider) has different validation rules, and can fail in different ways. - @deftp {exception type} ¬-json @var{value} @var{cause} Cannot decode @var{value} to a JSON object. @end deftp @@ -291,6 +372,26 @@ The @var{value} string is not an encoding of a valid JWS. The @var{jws} cannot be signed. @end deftp +@deftp {exception type} ¬-an-access-token @var{value} @var{cause} +The @var{value} is not an access token. +@end deftp + +@deftp {exception type} ¬-an-access-token-header @var{value} @var{cause} +The @var{value} is not an access token header. +@end deftp + +@deftp {exception type} ¬-an-access-token-payload @var{value} @var{cause} +The @var{value} is not an access token payload. +@end deftp + +@deftp {exception type} &cannot-decode-access-token @var{value} @var{cause} +The @var{value} string is not an encoding of a valid access token. +@end deftp + +@deftp {exception type} &cannot-encode-access-token @var{access-token} @var{key} @var{cause} +The @var{access-token} 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 @@ -314,6 +415,14 @@ The @var{response} (from @emph{(web response)}) is not appropriate. The @var{value} is not appropriate an OIDC configuration. @end deftp +@deftp {exception type} &cannot-fetch-issuer-configuration @var{issuer} @var{cause} +It is impossible to fetch the configuration of @var{issuer}. +@end deftp + +@deftp {exception type} &cannot-fetch-jwks @var{issuer} @var{uri} @var{cause} +It is impossible to fetch the keys of @var{issuer} at @var{uri}. +@end deftp + @node GNU Free Documentation License @appendix GNU Free Documentation License @@ -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:238 +#: src/scm/webid-oidc/errors.scm:378 msgid "that’s how it is" msgstr "c’est comme ça" -#: src/scm/webid-oidc/errors.scm:243 +#: src/scm/webid-oidc/errors.scm:383 #, 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:246 +#: src/scm/webid-oidc/errors.scm:386 #, 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:249 +#: src/scm/webid-oidc/errors.scm:389 #, 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:254 +#: src/scm/webid-oidc/errors.scm:394 #, 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:256 +#: src/scm/webid-oidc/errors.scm:396 #, 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:261 +#: src/scm/webid-oidc/errors.scm:401 #, 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:263 +#: src/scm/webid-oidc/errors.scm:403 #, 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:268 +#: src/scm/webid-oidc/errors.scm:408 #, 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:270 +#: src/scm/webid-oidc/errors.scm:410 #, 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:275 +#: src/scm/webid-oidc/errors.scm:415 #, 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:277 +#: src/scm/webid-oidc/errors.scm:417 #, 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:280 +#: src/scm/webid-oidc/errors.scm:420 #, 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:283 +#: src/scm/webid-oidc/errors.scm:423 #, 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:286 +#: src/scm/webid-oidc/errors.scm:426 #, 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:289 +#: src/scm/webid-oidc/errors.scm:429 #, 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:292 +#: src/scm/webid-oidc/errors.scm:432 #, 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:295 +#: src/scm/webid-oidc/errors.scm:435 #, 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:298 +#: src/scm/webid-oidc/errors.scm:438 #, 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:301 +#: src/scm/webid-oidc/errors.scm:441 #, 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:304 +#: src/scm/webid-oidc/errors.scm:444 #, 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:307 +#: src/scm/webid-oidc/errors.scm:447 #, scheme-format msgid "" "the server request unexpectedly failed with code ~a and reason phrase ~s" @@ -242,78 +242,179 @@ 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:312 +#: src/scm/webid-oidc/errors.scm:452 #, 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:314 +#: src/scm/webid-oidc/errors.scm:454 #, 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:317 +#: src/scm/webid-oidc/errors.scm:457 #, 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:323 +#: src/scm/webid-oidc/errors.scm:463 #, 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 +#: src/scm/webid-oidc/errors.scm:468 +#, scheme-format +msgid "the webid field is incorrect: ~s" +msgstr "le champ webid est incorrect : ~s" + +#: src/scm/webid-oidc/errors.scm:469 +msgid "the webid field is missing" +msgstr "le champ webid est manquant" + +#: src/scm/webid-oidc/errors.scm:473 +#, scheme-format +msgid "the iss field is incorrect: ~s" +msgstr "le champ iss est incorrect : ~s" + +#: src/scm/webid-oidc/errors.scm:474 +msgid "the iss field is missing" +msgstr "le champ iss est manquant" + +#: src/scm/webid-oidc/errors.scm:478 +#, scheme-format +msgid "the aud field is incorrect: ~s" +msgstr "le champ aud est incorrect : ~s" + +#: src/scm/webid-oidc/errors.scm:479 +msgid "the aud field is missing" +msgstr "le champ aud est manquant" + +#: src/scm/webid-oidc/errors.scm:483 +#, scheme-format +msgid "the iat field is incorrect: ~s" +msgstr "le champ iat est incorrect : ~s" + +#: src/scm/webid-oidc/errors.scm:484 +msgid "the iat field is missing" +msgstr "le champ iat est manquant" + +#: src/scm/webid-oidc/errors.scm:488 +#, scheme-format +msgid "the exp field is incorrect: ~s" +msgstr "le champ exp est incorrect : ~s" + +#: src/scm/webid-oidc/errors.scm:489 +msgid "the exp field is missing" +msgstr "le champ exp est manquant" + +#: src/scm/webid-oidc/errors.scm:493 +#, scheme-format +msgid "the cnf/jkt field is incorrect: ~s" +msgstr "le champ cnf/jkt est incorrect : ~s" + +#: src/scm/webid-oidc/errors.scm:494 +msgid "the cnf/jkt field is missing" +msgstr "le champ cnf/jkt est manquant" + +#: src/scm/webid-oidc/errors.scm:498 +#, scheme-format +msgid "the client-id field is incorrect: ~s" +msgstr "le champ client-id est incorrect : ~s" + +#: src/scm/webid-oidc/errors.scm:499 +msgid "the client-id field is missing" +msgstr "le champ client-id est manquant" + +#: src/scm/webid-oidc/errors.scm:501 +#, scheme-format +msgid "~s is not an access token (because ~a)" +msgstr "~s n’est pas un jeton d’accès (parce que ~a)" + +#: src/scm/webid-oidc/errors.scm:504 +#, scheme-format +msgid "~s is not an access token header (because ~a)" +msgstr "~s n’est pas un en-tête de jeton d’accès (parce que ~a)" + +#: src/scm/webid-oidc/errors.scm:507 +#, scheme-format +msgid "~s is not an access token payload (because ~a)" +msgstr "~s n’est pas un contenu de jeton d’accès (parce que ~a)" + +#: src/scm/webid-oidc/errors.scm:510 +#, scheme-format +msgid "I cannot fetch the issuer configuration of ~a (because ~a)" +msgstr "" +"je n’ai pas pu récupérer la configuration de l’émetteur ~a (parce que ~a)" + +#: src/scm/webid-oidc/errors.scm:517 +#, scheme-format +msgid "I cannot fetch the JWKS of ~a at ~a (because ~a)" +msgstr "je n’ai pas pu récupérer le JWKS de ~a à ~a (parce que ~a)" + +#: src/scm/webid-oidc/errors.scm:528 +#, scheme-format +msgid "I cannot decode ~s as an access token (because ~a)" +msgstr "je n’ai pas pu décoder ~s comme jeton d’accès (parce que ~a)" + +#: src/scm/webid-oidc/errors.scm:531 +#, scheme-format +msgid "I cannot encode ~s as an access token with key ~s (because ~a)" +msgstr "" +"je n’ai pas pu encoder ~s comme un jeton d’accès avec la clé ~s (parce que " +"~a)" + +#: src/scm/webid-oidc/errors.scm:536 msgid "that’s it" msgstr "c’est tout" -#: src/scm/webid-oidc/errors.scm:332 +#: src/scm/webid-oidc/errors.scm:540 #, scheme-format msgid "~a and ~a" msgstr "~a et ~a" -#: src/scm/webid-oidc/errors.scm:335 +#: src/scm/webid-oidc/errors.scm:543 #, scheme-format msgid "~a, ~a" msgstr "~a, ~a" -#: src/scm/webid-oidc/errors.scm:339 +#: src/scm/webid-oidc/errors.scm:547 #, 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:342 +#: src/scm/webid-oidc/errors.scm:550 msgid "there is an undefined variable" msgstr "il y a une variable non définie" -#: src/scm/webid-oidc/errors.scm:344 +#: src/scm/webid-oidc/errors.scm:552 #, scheme-format msgid "the origin is ~a" msgstr "l’origine est ~a" -#: src/scm/webid-oidc/errors.scm:347 +#: src/scm/webid-oidc/errors.scm:555 #, scheme-format msgid "a message is attached: ~a" msgstr "un message est attaché : ~a" -#: src/scm/webid-oidc/errors.scm:350 +#: src/scm/webid-oidc/errors.scm:558 #, scheme-format msgid "the values ~s are problematic" msgstr "les valeurs ~s sont problématiques" -#: src/scm/webid-oidc/errors.scm:353 +#: src/scm/webid-oidc/errors.scm:561 msgid "there is a kind and args" msgstr "il y a un type et des arguments" -#: src/scm/webid-oidc/errors.scm:355 +#: src/scm/webid-oidc/errors.scm:563 msgid "there is an assertion failure" msgstr "il y a un échec d’assertion" -#: src/scm/webid-oidc/errors.scm:357 +#: src/scm/webid-oidc/errors.scm:565 #, scheme-format msgid "the program quits with code ~a" msgstr "le programme quitte avec le code ~a" -#: src/scm/webid-oidc/errors.scm:360 +#: src/scm/webid-oidc/errors.scm:568 #, scheme-format msgid "Unhandled exception type ~a." msgstr "Type d’exception non pris en charge ~a." @@ -323,13 +424,6 @@ msgstr "Type d’exception non pris en charge ~a." #~ msgstr "la valeur ~s n’est pas du Turtle (parce que ~a)" #, scheme-format -#~ msgid "the webid field is incorrect: ~s" -#~ msgstr "le champ webid est incorrect : ~s" - -#~ msgid "the webid field is missing" -#~ msgstr "le champ webid est manquant" - -#, scheme-format #~ msgid "the sub field is incorrect: ~s" #~ msgstr "le champ sub est incorrect : ~s" @@ -337,48 +431,6 @@ msgstr "Type d’exception non pris en charge ~a." #~ msgstr "le champ sub est manquant" #, scheme-format -#~ msgid "the iss field is incorrect: ~s" -#~ msgstr "le champ iss est incorrect : ~s" - -#~ msgid "the iss field is missing" -#~ msgstr "le champ iss est manquant" - -#, scheme-format -#~ msgid "the aud field is incorrect: ~s" -#~ msgstr "le champ aud est incorrect : ~s" - -#~ msgid "the aud field is missing" -#~ msgstr "le champ aud est manquant" - -#, scheme-format -#~ msgid "the iat field is incorrect: ~s" -#~ msgstr "le champ iat est incorrect : ~s" - -#~ msgid "the iat field is missing" -#~ msgstr "le champ iat est manquant" - -#, scheme-format -#~ msgid "the exp field is incorrect: ~s" -#~ msgstr "le champ exp est incorrect : ~s" - -#~ msgid "the exp field is missing" -#~ msgstr "le champ exp est manquant" - -#, scheme-format -#~ msgid "the cnf/jkt field is incorrect: ~s" -#~ msgstr "le champ cnf/jkt est incorrect : ~s" - -#~ msgid "the cnf/jkt field is missing" -#~ msgstr "le champ cnf/jkt est manquant" - -#, scheme-format -#~ msgid "the client-id field is incorrect: ~s" -#~ msgstr "le champ client-id est incorrect : ~s" - -#~ msgid "the client-id field is missing" -#~ msgstr "le champ client-id est manquant" - -#, scheme-format #~ msgid "the redirect_uris field is incorrect: ~s" #~ msgstr "le champ redirect_uris est incorrect : ~s" @@ -428,18 +480,6 @@ msgstr "Type d’exception non pris en charge ~a." #~ msgstr "le champ htu est manquant" #, scheme-format -#~ msgid "~s is not an access token (because ~a)" -#~ msgstr "~s n’est pas un jeton d’accès (parce que ~a)" - -#, scheme-format -#~ msgid "~s is not an access token header (because ~a)" -#~ msgstr "~s n’est pas un en-tête de jeton d’accès (parce que ~a)" - -#, scheme-format -#~ msgid "~s is not an access token payload (because ~a)" -#~ msgstr "~s n’est pas un contenu de jeton d’accès (parce que ~a)" - -#, scheme-format #~ msgid "~s is not a DPoP proof (because ~a)" #~ msgstr "~s n’est pas une preuve DPoP (parce que ~a)" @@ -452,15 +492,6 @@ msgstr "Type d’exception non pris en charge ~a." #~ msgstr "~s n’est pas un contenu de preuve DPoP (parce que ~a)" #, scheme-format -#~ msgid "I cannot fetch the issuer configuration of ~a (because ~a)" -#~ msgstr "" -#~ "je n’ai pas pu récupérer la configuration de l’émetteur ~a (parce que ~a)" - -#, scheme-format -#~ msgid "I cannot fetch the JWKS of ~a at ~a (because ~a)" -#~ msgstr "je n’ai pas pu récupérer le JWKS de ~a à ~a (parce que ~a)" - -#, scheme-format #~ msgid "the HTTP method is signed for ~s, but ~s was requested" #~ msgstr "la méthode HTTP a été signée pour ~s, mais ~s a été demandé" @@ -495,16 +526,6 @@ msgstr "Type d’exception non pris en charge ~a." #~ msgstr "le jti ~s a déjà été trouvé (parce que ~a)" #, scheme-format -#~ msgid "I cannot decode ~s as an access token (because ~a)" -#~ msgstr "je n’ai pas pu décoder ~s comme jeton d’accès (parce que ~a)" - -#, scheme-format -#~ msgid "I cannot encode ~s as an access token with key ~s (because ~a)" -#~ msgstr "" -#~ "je n’ai pas pu encoder ~s comme un jeton d’accès avec la clé ~s (parce " -#~ "que ~a)" - -#, scheme-format #~ msgid "I cannot decode ~s as a DPoP proof (because ~a)" #~ msgstr "je n’ai pas pu décoder ~s comme preuve DPoP (parce que ~a)" diff --git a/po/webid-oidc.pot b/po/webid-oidc.pot index f442518..e008e38 100644 --- a/po/webid-oidc.pot +++ b/po/webid-oidc.pot @@ -122,190 +122,288 @@ msgstr "" msgid "Usage: generate-key [NUMBER OF BITS | CURVE]\n" msgstr "" -#: src/scm/webid-oidc/errors.scm:238 +#: src/scm/webid-oidc/errors.scm:378 msgid "that’s how it is" msgstr "" -#: src/scm/webid-oidc/errors.scm:243 +#: src/scm/webid-oidc/errors.scm:383 #, scheme-format msgid "the value ~s is not a base64 string (because ~a)" msgstr "" -#: src/scm/webid-oidc/errors.scm:246 +#: src/scm/webid-oidc/errors.scm:386 #, scheme-format msgid "the value ~s is not JSON (because ~a)" msgstr "" -#: src/scm/webid-oidc/errors.scm:249 +#: src/scm/webid-oidc/errors.scm:389 #, scheme-format msgid "the value ~s does not identify an elleptic curve" msgstr "" -#: src/scm/webid-oidc/errors.scm:254 +#: src/scm/webid-oidc/errors.scm:394 #, scheme-format msgid "the value ~s does not identify a JWK (because ~a)" msgstr "" -#: src/scm/webid-oidc/errors.scm:256 +#: src/scm/webid-oidc/errors.scm:396 #, scheme-format msgid "the value ~s does not identify a JWK" msgstr "" -#: src/scm/webid-oidc/errors.scm:261 +#: src/scm/webid-oidc/errors.scm:401 #, scheme-format msgid "the value ~s does not identify a public JWK (because ~a)" msgstr "" -#: src/scm/webid-oidc/errors.scm:263 +#: src/scm/webid-oidc/errors.scm:403 #, scheme-format msgid "the value ~s does not identify a public JWK" msgstr "" -#: src/scm/webid-oidc/errors.scm:268 +#: src/scm/webid-oidc/errors.scm:408 #, scheme-format msgid "the value ~s does not identify a private JWK (because ~a)" msgstr "" -#: src/scm/webid-oidc/errors.scm:270 +#: src/scm/webid-oidc/errors.scm:410 #, scheme-format msgid "the value ~s does not identify a private JWK" msgstr "" -#: src/scm/webid-oidc/errors.scm:275 +#: src/scm/webid-oidc/errors.scm:415 #, scheme-format msgid "the value ~s does not identify a JWKS (because ~a)" msgstr "" -#: src/scm/webid-oidc/errors.scm:277 +#: src/scm/webid-oidc/errors.scm:417 #, scheme-format msgid "the value ~s does not identify a JWKS" msgstr "" -#: src/scm/webid-oidc/errors.scm:280 +#: src/scm/webid-oidc/errors.scm:420 #, scheme-format msgid "the value ~s does not identify a hash algorithm" msgstr "" -#: src/scm/webid-oidc/errors.scm:283 +#: src/scm/webid-oidc/errors.scm:423 #, scheme-format msgid "the value ~s is not an alist or misses key ~s" msgstr "" -#: src/scm/webid-oidc/errors.scm:286 +#: src/scm/webid-oidc/errors.scm:426 #, scheme-format msgid "the value ~s is not a JWS header (because ~a)" msgstr "" -#: src/scm/webid-oidc/errors.scm:289 +#: src/scm/webid-oidc/errors.scm:429 #, scheme-format msgid "the value ~s is not a JWS payload (because ~a)" msgstr "" -#: src/scm/webid-oidc/errors.scm:292 +#: src/scm/webid-oidc/errors.scm:432 #, scheme-format msgid "the value ~s is not a JWS (because ~a)" msgstr "" -#: src/scm/webid-oidc/errors.scm:295 +#: src/scm/webid-oidc/errors.scm:435 #, scheme-format msgid "the string ~s cannot be split in 3 parts with ~s" msgstr "" -#: src/scm/webid-oidc/errors.scm:298 +#: src/scm/webid-oidc/errors.scm:438 #, 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:301 +#: src/scm/webid-oidc/errors.scm:441 #, scheme-format msgid "I cannot decode JWS ~a (because ~a)" msgstr "" -#: src/scm/webid-oidc/errors.scm:304 +#: src/scm/webid-oidc/errors.scm:444 #, scheme-format msgid "I cannot encode JWS ~a (because ~a)" msgstr "" -#: src/scm/webid-oidc/errors.scm:307 +#: src/scm/webid-oidc/errors.scm:447 #, scheme-format msgid "" "the server request unexpectedly failed with code ~a and reason phrase ~s" msgstr "" -#: src/scm/webid-oidc/errors.scm:312 +#: src/scm/webid-oidc/errors.scm:452 #, scheme-format msgid "the header ~a should not have the value ~s" msgstr "" -#: src/scm/webid-oidc/errors.scm:314 +#: src/scm/webid-oidc/errors.scm:454 #, scheme-format msgid "the header ~a should be present" msgstr "" -#: src/scm/webid-oidc/errors.scm:317 +#: src/scm/webid-oidc/errors.scm:457 #, scheme-format msgid "the server response wasn't expected: ~s (because ~a)" msgstr "" -#: src/scm/webid-oidc/errors.scm:323 +#: src/scm/webid-oidc/errors.scm:463 #, scheme-format msgid "the value ~s is not an OIDC configuration (because ~a)" msgstr "" -#: src/scm/webid-oidc/errors.scm:328 +#: src/scm/webid-oidc/errors.scm:468 +#, scheme-format +msgid "the webid field is incorrect: ~s" +msgstr "" + +#: src/scm/webid-oidc/errors.scm:469 +msgid "the webid field is missing" +msgstr "" + +#: src/scm/webid-oidc/errors.scm:473 +#, scheme-format +msgid "the iss field is incorrect: ~s" +msgstr "" + +#: src/scm/webid-oidc/errors.scm:474 +msgid "the iss field is missing" +msgstr "" + +#: src/scm/webid-oidc/errors.scm:478 +#, scheme-format +msgid "the aud field is incorrect: ~s" +msgstr "" + +#: src/scm/webid-oidc/errors.scm:479 +msgid "the aud field is missing" +msgstr "" + +#: src/scm/webid-oidc/errors.scm:483 +#, scheme-format +msgid "the iat field is incorrect: ~s" +msgstr "" + +#: src/scm/webid-oidc/errors.scm:484 +msgid "the iat field is missing" +msgstr "" + +#: src/scm/webid-oidc/errors.scm:488 +#, scheme-format +msgid "the exp field is incorrect: ~s" +msgstr "" + +#: src/scm/webid-oidc/errors.scm:489 +msgid "the exp field is missing" +msgstr "" + +#: src/scm/webid-oidc/errors.scm:493 +#, scheme-format +msgid "the cnf/jkt field is incorrect: ~s" +msgstr "" + +#: src/scm/webid-oidc/errors.scm:494 +msgid "the cnf/jkt field is missing" +msgstr "" + +#: src/scm/webid-oidc/errors.scm:498 +#, scheme-format +msgid "the client-id field is incorrect: ~s" +msgstr "" + +#: src/scm/webid-oidc/errors.scm:499 +msgid "the client-id field is missing" +msgstr "" + +#: src/scm/webid-oidc/errors.scm:501 +#, scheme-format +msgid "~s is not an access token (because ~a)" +msgstr "" + +#: src/scm/webid-oidc/errors.scm:504 +#, scheme-format +msgid "~s is not an access token header (because ~a)" +msgstr "" + +#: src/scm/webid-oidc/errors.scm:507 +#, scheme-format +msgid "~s is not an access token payload (because ~a)" +msgstr "" + +#: src/scm/webid-oidc/errors.scm:510 +#, scheme-format +msgid "I cannot fetch the issuer configuration of ~a (because ~a)" +msgstr "" + +#: src/scm/webid-oidc/errors.scm:517 +#, scheme-format +msgid "I cannot fetch the JWKS of ~a at ~a (because ~a)" +msgstr "" + +#: src/scm/webid-oidc/errors.scm:528 +#, scheme-format +msgid "I cannot decode ~s as an access token (because ~a)" +msgstr "" + +#: src/scm/webid-oidc/errors.scm:531 +#, scheme-format +msgid "I cannot encode ~s as an access token with key ~s (because ~a)" +msgstr "" + +#: src/scm/webid-oidc/errors.scm:536 msgid "that’s it" msgstr "" -#: src/scm/webid-oidc/errors.scm:332 +#: src/scm/webid-oidc/errors.scm:540 #, scheme-format msgid "~a and ~a" msgstr "" -#: src/scm/webid-oidc/errors.scm:335 +#: src/scm/webid-oidc/errors.scm:543 #, scheme-format msgid "~a, ~a" msgstr "" -#: src/scm/webid-oidc/errors.scm:339 +#: src/scm/webid-oidc/errors.scm:547 #, scheme-format msgid "the signature ~a does not match key ~s with payload ~a" msgstr "" -#: src/scm/webid-oidc/errors.scm:342 +#: src/scm/webid-oidc/errors.scm:550 msgid "there is an undefined variable" msgstr "" -#: src/scm/webid-oidc/errors.scm:344 +#: src/scm/webid-oidc/errors.scm:552 #, scheme-format msgid "the origin is ~a" msgstr "" -#: src/scm/webid-oidc/errors.scm:347 +#: src/scm/webid-oidc/errors.scm:555 #, scheme-format msgid "a message is attached: ~a" msgstr "" -#: src/scm/webid-oidc/errors.scm:350 +#: src/scm/webid-oidc/errors.scm:558 #, scheme-format msgid "the values ~s are problematic" msgstr "" -#: src/scm/webid-oidc/errors.scm:353 +#: src/scm/webid-oidc/errors.scm:561 msgid "there is a kind and args" msgstr "" -#: src/scm/webid-oidc/errors.scm:355 +#: src/scm/webid-oidc/errors.scm:563 msgid "there is an assertion failure" msgstr "" -#: src/scm/webid-oidc/errors.scm:357 +#: src/scm/webid-oidc/errors.scm:565 #, scheme-format msgid "the program quits with code ~a" msgstr "" -#: src/scm/webid-oidc/errors.scm:360 +#: src/scm/webid-oidc/errors.scm:568 #, 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 ebf6811..a63fa89 100644 --- a/src/scm/webid-oidc/Makefile.am +++ b/src/scm/webid-oidc/Makefile.am @@ -5,7 +5,8 @@ dist_webidoidcmod_DATA += \ %reldir%/jwk.scm \ %reldir%/jws.scm \ %reldir%/cache.scm \ - %reldir%/oidc-configuration.scm + %reldir%/oidc-configuration.scm \ + %reldir%/access-token.scm webidoidcgo_DATA += \ %reldir%/errors.go \ %reldir%/stubs.go \ @@ -13,4 +14,5 @@ webidoidcgo_DATA += \ %reldir%/jwk.go \ %reldir%/jws.go \ %reldir%/cache.go \ - %reldir%/oidc-configuration.go + %reldir%/oidc-configuration.go \ + %reldir%/access-token.go diff --git a/src/scm/webid-oidc/access-token.scm b/src/scm/webid-oidc/access-token.scm new file mode 100644 index 0000000..34afcdc --- /dev/null +++ b/src/scm/webid-oidc/access-token.scm @@ -0,0 +1,205 @@ +(define-module (webid-oidc access-token) + #:use-module (webid-oidc jws) + #:use-module (webid-oidc errors) + #:use-module (webid-oidc jwk) + #:use-module (webid-oidc oidc-configuration) + #:use-module ((webid-oidc stubs) #:prefix stubs:) + #:use-module (web uri) + #:use-module (web client) + #:use-module (ice-9 optargs) + #:use-module (srfi srfi-19)) + +(define-public (the-access-token-header x) + (with-exception-handler + (lambda (error) + (raise-not-an-access-token-header x error)) + (lambda () + (the-jws-header x)))) + +(define-public (access-token-header? x) + (false-if-exception + (and (the-access-token-header x) #t))) + +(define-public (the-access-token-payload x) + (with-exception-handler + (lambda (error) + (raise-not-an-access-token-payload x error)) + (lambda () + (let ((x (the-jws-payload x))) + (let ((webid (assq-ref x 'webid)) + (iss (assq-ref x 'iss)) + (aud (assq-ref x 'aud)) + (iat (assq-ref x 'iat)) + (exp (assq-ref x 'exp)) + (cnf (assq-ref x 'cnf)) + (client-id (assq-ref x 'client_id))) + (unless (and webid (string? webid) (string->uri webid)) + (raise-incorrect-webid-field webid)) + (unless (and iss (string? iss) (string->uri iss)) + (raise-incorrect-iss-field iss)) + (unless (equal? aud "solid") + (raise-incorrect-aud-field aud)) + (unless (integer? iat) + (raise-incorrect-iat-field iat)) + (unless (and (integer? exp) (>= exp iat)) + (raise-incorrect-exp-field exp)) + (unless (and client-id (string? client-id) (string->uri client-id)) + (raise-incorrect-client-id-field client-id)) + (unless (and cnf (assq-ref cnf 'jkt) (string? (assq-ref cnf 'jkt))) + (raise-incorrect-cnf/jkt-field (and cnf (assq-ref cnf 'jkt)))) + x))))) + +(define-public (access-token-payload? x) + (false-if-exception + (and (the-access-token-header x) #t))) + +(define-public (the-access-token x) + (with-exception-handler + (lambda (cause) + (raise-not-an-access-token x cause)) + (lambda () + (cons (the-access-token-header (car x)) + (the-access-token-payload (cdr x)))))) + +(define-public (access-token? x) + (false-if-exception + (and (the-access-token x) #t))) + +(define-public (make-access-token header payload) + (the-access-token + (cons header payload))) + +(define-public (make-access-token-payload webid iss iat exp cnf/jkt client-id) + (when (date? exp) + (set! exp (date->time-utc exp))) + (when (time? exp) + (set! exp (time-second exp))) + (when (date? iat) + (set! iat (date->time-utc iat))) + (when (time? iat) + (set! iat (time-second iat))) + (when (uri? webid) + (set! webid (uri->string webid))) + (when (uri? iss) + (set! iss (uri->string iss))) + (when (uri? client-id) + (set! client-id (uri->string client-id))) + (the-access-token-payload + `((webid . ,webid) + (iss . ,iss) + (aud . "solid") + (iat . ,iat) + (exp . ,exp) + (cnf . ((jkt . ,cnf/jkt))) + (client_id . ,client-id)))) + +(define-public (access-token-header code) + (car (the-access-token code))) + +(define-public (access-token-payload code) + (cdr (the-access-token code))) + +(define-public (access-token-alg code) + (when (access-token? code) + (set! code (access-token-header code))) + (jws-alg (the-access-token-header code))) + +(define-public (access-token-webid code) + (when (access-token? code) + (set! code (access-token-payload code))) + (string->uri + (assq-ref (the-access-token-payload code) 'webid))) + +(define-public (access-token-iss code) + (when (access-token? code) + (set! code (access-token-payload code))) + (string->uri + (assq-ref (the-access-token-payload code) 'iss))) + +(define-public (access-token-aud code) + (when (access-token? code) + (set! code (access-token-payload code))) + (assq-ref (the-access-token-payload code) 'aud)) + +(define-public (access-token-exp code) + (when (access-token? code) + (set! code (access-token-payload code))) + (time-utc->date + (make-time time-utc 0 (assq-ref + (the-access-token-payload code) + 'exp)))) + +(define-public (access-token-iat code) + (when (access-token? code) + (set! code (access-token-payload code))) + (time-utc->date + (make-time time-utc 0 (assq-ref + (the-access-token-payload code) + 'iat)))) + +(define-public (access-token-cnf/jkt code) + (when (access-token? code) + (set! code (access-token-payload code))) + (assq-ref + (assq-ref (the-access-token-payload code) 'cnf) + 'jkt)) + +(define-public (access-token-client-id code) + (when (access-token? code) + (set! code (access-token-payload code))) + (string->uri + (assq-ref (the-access-token-payload code) 'client_id))) + +(define*-public (access-token-decode str #:key (http-get http-get)) + (with-exception-handler + (lambda (error) + (raise-cannot-decode-access-token str error)) + (lambda () + (jws-decode + str + (lambda (token) + (let ((iss (access-token-iss token))) + (let ((cfg + (with-exception-handler + (lambda (error) + (raise-cannot-fetch-issuer-configuration iss error)) + (lambda () + (get-oidc-configuration + (uri-host iss) + #:userinfo (uri-userinfo iss) + #:port (uri-port iss) + #:http-get http-get))))) + (with-exception-handler + (lambda (error) + (raise-cannot-fetch-jwks iss + (oidc-configuration-jwks-uri cfg) + error)) + (lambda () + (oidc-configuration-jwks cfg #:http-get http-get)))))))))) + +(define-public (access-token-encode access-token key) + (with-exception-handler + (lambda (error) + (raise-cannot-encode-access-token access-token key error)) + (lambda () + (jws-encode access-token key)))) + +(define*-public (issue-access-token + issuer-key + #:key + (alg #f) + (webid #f) + (iss #f) + (iat #f) + (exp #f) + (client-key #f) + (cnf/jkt #f) + (client-id #f)) + (when client-key + (set! cnf/jkt (jkt client-key))) + (access-token-encode + (make-access-token + `((alg . ,(if (symbol? alg) (symbol->string alg) alg))) + (make-access-token-payload + webid iss iat exp cnf/jkt client-id)) + issuer-key)) diff --git a/src/scm/webid-oidc/errors.scm b/src/scm/webid-oidc/errors.scm index beeaaea..50d526c 100644 --- a/src/scm/webid-oidc/errors.scm +++ b/src/scm/webid-oidc/errors.scm @@ -227,6 +227,146 @@ (raise-exception ((record-constructor ¬-an-oidc-configuration) value cause))) +(define-public &incorrect-webid-field + (make-exception-type + '&incorrect-webid-field + &external-error + '(value))) + +(define-public (raise-incorrect-webid-field value) + (raise-exception + ((record-constructor &incorrect-webid-field) value))) + +(define-public &incorrect-iss-field + (make-exception-type + '&incorrect-iss-field + &external-error + '(value))) + +(define-public (raise-incorrect-iss-field value) + (raise-exception + ((record-constructor &incorrect-iss-field) value))) + +(define-public &incorrect-aud-field + (make-exception-type + '&incorrect-aud-field + &external-error + '(value))) + +(define-public (raise-incorrect-aud-field value) + (raise-exception + ((record-constructor &incorrect-aud-field) value))) + +(define-public &incorrect-iat-field + (make-exception-type + '&incorrect-iat-field + &external-error + '(value))) + +(define-public (raise-incorrect-iat-field value) + (raise-exception + ((record-constructor &incorrect-iat-field) value))) + +(define-public &incorrect-exp-field + (make-exception-type + '&incorrect-exp-field + &external-error + '(value))) + +(define-public (raise-incorrect-exp-field value) + (raise-exception + ((record-constructor &incorrect-exp-field) value))) + +(define-public &incorrect-cnf/jkt-field + (make-exception-type + '&incorrect-cnf/jkt-field + &external-error + '(value))) + +(define-public (raise-incorrect-cnf/jkt-field value) + (raise-exception + ((record-constructor &incorrect-cnf/jkt-field) value))) + +(define-public &incorrect-client-id-field + (make-exception-type + '&incorrect-client-id-field + &external-error + '(value))) + +(define-public (raise-incorrect-client-id-field value) + (raise-exception + ((record-constructor &incorrect-client-id-field) value))) + +(define-public ¬-an-access-token + (make-exception-type + '¬-an-access-token + &external-error + '(value cause))) + +(define-public (raise-not-an-access-token value cause) + (raise-exception + ((record-constructor ¬-an-access-token) value cause))) + +(define-public ¬-an-access-token-header + (make-exception-type + '¬-an-access-token-header + &external-error + '(value cause))) + +(define-public (raise-not-an-access-token-header value cause) + (raise-exception + ((record-constructor ¬-an-access-token-header) value cause))) + +(define-public ¬-an-access-token-payload + (make-exception-type + '¬-an-access-token-payload + &external-error + '(value cause))) + +(define-public (raise-not-an-access-token-payload value cause) + (raise-exception + ((record-constructor ¬-an-access-token-payload) value cause))) + +(define-public &cannot-fetch-issuer-configuration + (make-exception-type + '&cannot-fetch-issuer-configuration + &external-error + '(issuer cause))) + +(define-public (raise-cannot-fetch-issuer-configuration issuer cause) + (raise-exception + ((record-constructor &cannot-fetch-issuer-configuration) issuer cause))) + +(define-public &cannot-fetch-jwks + (make-exception-type + '&cannot-fetch-jwks + &external-error + '(issuer uri cause))) + +(define-public (raise-cannot-fetch-jwks issuer uri cause) + (raise-exception + ((record-constructor &cannot-fetch-jwks) issuer uri cause))) + +(define-public &cannot-decode-access-token + (make-exception-type + '&cannot-decode-access-token + &external-error + '(value cause))) + +(define-public (raise-cannot-decode-access-token value cause) + (raise-exception + ((record-constructor &cannot-decode-access-token) value cause))) + +(define-public &cannot-encode-access-token + (make-exception-type + '&cannot-encode-access-token + &external-error + '(access-token key cause))) + +(define-public (raise-cannot-encode-access-token access-token key cause) + (raise-exception + ((record-constructor &cannot-encode-access-token) access-token key cause))) + (define*-public (error->str err #:key (max-depth #f)) (if (record? err) (let* ((type (record-type-descriptor err)) @@ -322,6 +462,74 @@ ((¬-an-oidc-configuration) (format #f (G_ "the value ~s is not an OIDC configuration (because ~a)") (get 'value) (recurse (get 'cause)))) + ((&incorrect-webid-field) + (let ((value (get 'value))) + (if value + (format #f (G_ "the webid field is incorrect: ~s") value) + (format #f (G_ "the webid field is missing"))))) + ((&incorrect-iss-field) + (let ((value (get 'value))) + (if value + (format #f (G_ "the iss field is incorrect: ~s") value) + (format #f (G_ "the iss field is missing"))))) + ((&incorrect-aud-field) + (let ((value (get 'value))) + (if value + (format #f (G_ "the aud field is incorrect: ~s") value) + (format #f (G_ "the aud field is missing"))))) + ((&incorrect-iat-field) + (let ((value (get 'value))) + (if value + (format #f (G_ "the iat field is incorrect: ~s") value) + (format #f (G_ "the iat field is missing"))))) + ((&incorrect-exp-field) + (let ((value (get 'value))) + (if value + (format #f (G_ "the exp field is incorrect: ~s") value) + (format #f (G_ "the exp field is missing"))))) + ((&incorrect-cnf/jkt-field) + (let ((value (get 'value))) + (if value + (format #f (G_ "the cnf/jkt field is incorrect: ~s") value) + (format #f (G_ "the cnf/jkt field is missing"))))) + ((&incorrect-client-id-field) + (let ((value (get 'value))) + (if value + (format #f (G_ "the client-id field is incorrect: ~s") value) + (format #f (G_ "the client-id field is missing"))))) + ((¬-an-access-token) + (format #f (G_ "~s is not an access token (because ~a)" + (get 'value) (recurse (get 'cause))))) + ((¬-an-access-token-header) + (format #f (G_ "~s is not an access token header (because ~a)" + (get 'value) (recurse (get 'cause))))) + ((¬-an-access-token-payload) + (format #f (G_ "~s is not an access token payload (because ~a)" + (get 'value) (recurse (get 'cause))))) + ((&cannot-fetch-issuer-configuration) + (format #f (G_ "I cannot fetch the issuer configuration of ~a (because ~a)" + (let ((iss (get 'issuer))) + (when (uri? iss) + (set! iss (uri->string iss))) + iss) + (recurse (get 'cause))))) + ((&cannot-fetch-jwks) + (format #f (G_ "I cannot fetch the JWKS of ~a at ~a (because ~a)" + (let ((iss (get 'issuer))) + (when (uri? iss) + (set! iss (uri->string iss))) + iss) + (let ((uri (get 'uri))) + (when (uri? uri) + (set! uri (uri->string uri))) + uri) + (recurse (get 'cause))))) + ((&cannot-decode-access-token) + (format #f (G_ "I cannot decode ~s as an access token (because ~a)" + (get 'value) (recurse (get 'cause))))) + ((&cannot-encode-access-token) + (format #f (G_ "I cannot encode ~s as an access token with key ~s (because ~a)") + (get 'access-token) (get 'key) (recurse (get 'cause)))) ((&compound-exception) (let ((components (get 'components))) (if (null? components) |