diff options
author | Vivien Kraus <vivien@planete-kraus.eu> | 2020-11-30 21:39:32 +0100 |
---|---|---|
committer | Vivien Kraus <vivien@planete-kraus.eu> | 2021-05-11 00:30:44 +0200 |
commit | 2984035f4ffb2a5b0c34e2b177d2406a8876e356 (patch) | |
tree | ad7ccdaa39450c1326bfe904bf51259f4191fff9 | |
parent | d15b79983460f6eaaa44dd48af47f586bd0d8c36 (diff) |
Implement the DPoP proof
-rw-r--r-- | doc/manual.html | 198 | ||||
-rw-r--r-- | po/fr.po | 334 | ||||
-rw-r--r-- | po/webid-oidc.pot | 238 | ||||
-rw-r--r-- | src/scm/webid-oidc/Makefile.am | 8 | ||||
-rw-r--r-- | src/scm/webid-oidc/dpop-proof.scm | 217 | ||||
-rw-r--r-- | src/scm/webid-oidc/errors.scm | 287 | ||||
-rw-r--r-- | src/scm/webid-oidc/jti.scm | 34 | ||||
-rw-r--r-- | tests/Makefile.am | 9 | ||||
-rw-r--r-- | tests/dpop-proof-iat-in-future.scm | 37 | ||||
-rw-r--r-- | tests/dpop-proof-iat-too-late.scm | 37 | ||||
-rw-r--r-- | tests/dpop-proof-replay.scm | 40 | ||||
-rw-r--r-- | tests/dpop-proof-valid.scm | 30 | ||||
-rw-r--r-- | tests/dpop-proof-wrong-htm.scm | 37 | ||||
-rw-r--r-- | tests/dpop-proof-wrong-htu.scm | 37 | ||||
-rw-r--r-- | tests/dpop-proof-wrong-key.scm | 37 |
15 files changed, 1324 insertions, 256 deletions
diff --git a/doc/manual.html b/doc/manual.html index e3e9cbe..2b44467 100644 --- a/doc/manual.html +++ b/doc/manual.html @@ -178,6 +178,84 @@ which case the fingerprint will be computed for you. </p> </info:deffn> + <h2>The DPoP proof</h2> + <p> + This is a special JWT, that is signed by a key controlled by the + application. The access token certifies that the key used to + sign the proof is approved by the identity provider. + </p> + <info:deffn type="function" name="dpop-proof?" arguments="proof"> + <p> + Check that the <info:var>proof</info:var> is a decoded DPoP + proof. The validity of the proof is not checked by this + function. + </p> + </info:deffn> + <info:deffn type="function" name="dpop-proof-alg" arguments="proof"> + <info:deffnx type="function" name="dpop-proof-jwk" arguments="proof" /> + <info:deffnx type="function" name="dpop-proof-jti" arguments="proof" /> + <info:deffnx type="function" name="dpop-proof-htm" arguments="proof" /> + <info:deffnx type="function" name="dpop-proof-htu" arguments="proof" /> + <info:deffnx type="function" name="dpop-proof-iat" arguments="proof" /> + <p> + Get the corresponding field of the proof. + </p> + </info:deffn> + <info:deffn type="function" name="dpop-proof-decode" arguments="current-time jti-list method uri str cnf/check"> + <p> + Check and decode a DPoP proof encoded + as <info:var>str</info:var>. + </p> + <p> + The <info:var>current-time</info:var> is passed as a date, + time or number (of seconds). + </p> + <p> + In order to prevent replay attacks, each proof has a unique + random string that is remembered + in <info:var>jti-list</info:var> until its expiration date is + reached. See the <pre>make-jti-list</pre> function. + </p> + <p> + The proof is limited to the scope of + one <info:var>uri</info:var> and + one <info:var>method</info:var> + (<pre>'GET</pre>, <pre>'POST</pre> and so on). + </p> + <p> + Finally, the key that is used to sign the proof should be + confirmed by the identity provider. To this end, + the <info:var>cnf/check</info:var> function is called with the + fingerprint of the key. The function should check that the + fingerprint is OK (return a boolean). + </p> + </info:deffn> + <info:deffn type="function" + name="make-jti-list" + arguments=""> + <p> + This function in <emph>(webid-oidc jti-list)</emph> + creates an in-memory, async-safe, thread-safe cache for the + proof IDs. + </p> + </info:deffn> + <info:deffn type="function" name="dpop-proof-encode" arguments="proof key"> + <p> + Encode the proof and sign it with <info:var>key</info:var>. To + generate valid proofs, <info:var>key</info:var> should be the + private key corresponding to the <pre>jwk</pre> field of the + proof. + </p> + </info:deffn> + <info:deffn type="function" name="issue-dpop-proof" arguments="client-key #alg #htm #htu #iat"> + <p> + Create a proof, sign it and encode it with + <info:var>client-key</info:var>. <info:var>client-key</info:var> + should contain both the private and public key, because the + public part is written in the proof and the private part is + used to sign it. + </p> + </info:deffn> <h2>Generic JWTs</h2> <p> You can parse generic JWTs signed with JWS with the following @@ -396,38 +474,68 @@ </info:deftp> <info:deftp type="exception type" name="&incorrect-webid-field" arguments="value"> <p> - The <info:var>value</info:var> of the webid field in the JWT - is missing (if <pre>#f</pre>), or not an acceptable value. + The <info:var>value</info:var> of the webid field in the JWT + is missing (if <pre>#f</pre>), or not an acceptable value. </p> </info:deftp> <info:deftp type="exception type" name="&incorrect-iss-field" arguments="value"> <p> - The <info:var>value</info:var> of the iss field is incorrect. + The <info:var>value</info:var> of the iss field is incorrect. </p> </info:deftp> <info:deftp type="exception type" name="&incorrect-aud-field" arguments="value"> <p> - The <info:var>value</info:var> of the aud field is incorrect. + The <info:var>value</info:var> of the aud field is incorrect. </p> </info:deftp> <info:deftp type="exception type" name="&incorrect-iat-field" arguments="value"> <p> - The <info:var>value</info:var> of the iat field is incorrect. + The <info:var>value</info:var> of the iat field is incorrect. </p> </info:deftp> <info:deftp type="exception type" name="&incorrect-exp-field" arguments="value"> <p> - The <info:var>value</info:var> of the exp field is incorrect. + The <info:var>value</info:var> of the exp field is incorrect. </p> </info:deftp> <info:deftp type="exception type" name="&incorrect-cnf/jkt-field" arguments="value"> <p> - The <info:var>value</info:var> of the cnf/jkt field is incorrect. + The <info:var>value</info:var> of the cnf/jkt field is incorrect. </p> </info:deftp> <info:deftp type="exception type" name="&incorrect-client-id-field" arguments="value"> <p> - The <info:var>value</info:var> of the client-id field is incorrect. + The <info:var>value</info:var> of the client-id field is incorrect. + </p> + </info:deftp> + <info:deftp type="exception type" name="&incorrect-typ-field" arguments="value"> + <p> + The <info:var>value</info:var> of the typ field in the DPoP proof + header is incorrect. + </p> + </info:deftp> + <info:deftp type="exception type" name="&incorrect-jwk-field" arguments="value cause"> + <p> + The <info:var>value</info:var> of the jwk field in the DPoP + proof header is incorrect. + </p> + </info:deftp> + <info:deftp type="exception type" name="&incorrect-jti-field" arguments="value"> + <p> + The <info:var>value</info:var> of the jti field in the DPoP + proof is incorrect. + </p> + </info:deftp> + <info:deftp type="exception type" name="&incorrect-htm-field" arguments="value"> + <p> + The <info:var>value</info:var> of the htm field in the DPoP + proof is incorrect. + </p> + </info:deftp> + <info:deftp type="exception type" name="&incorrect-htu-field" arguments="value"> + <p> + The <info:var>value</info:var> of the htu field in the DPoP + proof is incorrect. </p> </info:deftp> <info:deftp type="exception type" name="&not-an-access-token" arguments="value cause"> @@ -447,14 +555,14 @@ </info:deftp> <info:deftp type="exception type" name="&cannot-fetch-issuer-configuration" arguments="issuer cause"> <p> - It is impossible to fetch the configuration of - <info:var>issuer</info:var>. + It is impossible to fetch the configuration of + <info:var>issuer</info:var>. </p> </info:deftp> <info:deftp type="exception type" name="&cannot-fetch-jwks" arguments="issuer uri cause"> <p> - It is impossible to fetch the keys of - <info:var>issuer</info:var> at <info:var>uri</info:var>. + It is impossible to fetch the keys of + <info:var>issuer</info:var> at <info:var>uri</info:var>. </p> </info:deftp> <info:deftp type="exception type" name="&cannot-decode-access-token" arguments="value cause"> @@ -468,6 +576,72 @@ The <info:var>access-token</info:var> cannot be signed. </p> </info:deftp> + <info:deftp type="exception type" name="&not-a-dpop-proof" arguments="value cause"> + <p> + The <info:var>value</info:var> is not a DPoP proof. + </p> + </info:deftp> + <info:deftp type="exception type" name="&not-a-dpop-proof-header" arguments="value cause"> + <p> + The <info:var>value</info:var> is not a DPoP proof header. + </p> + </info:deftp> + <info:deftp type="exception type" name="&not-a-dpop-proof-payload" arguments="value cause"> + <p> + The <info:var>value</info:var> is not a DPoP proof payload. + </p> + </info:deftp> + <info:deftp type="exception type" name="&dpop-method-mismatch" arguments="signed requested"> + <p> + The method value <info:var>signed</info:var> in the DPoP proof + does not match the method that is + <info:var>requested</info:var> on the server. + </p> + </info:deftp> + <info:deftp type="exception type" name="&dpop-uri-mismatch" arguments="signed requested"> + <p> + The URI value <info:var>signed</info:var> in the DPoP proof + does not match the URI that is <info:var>requested</info:var> + on the server. + </p> + </info:deftp> + <info:deftp type="exception type" name="&dpop-signed-in-future" arguments="signed current"> + <p> + The proof is <info:var>signed</info:var> for a date which is + too much ahead of the <info:var>current</info:var> time. + </p> + </info:deftp> + <info:deftp type="exception type" name="&dpop-too-old" arguments="signed current"> + <p> + The proof was <info:var>signed</info:var> at a past date of + <info:var>current</info:var>. + </p> + </info:deftp> + <info:deftp type="exception type" name="&dpop-unconfirmed-key" arguments="key expected cause"> + <p> + The confirmation of <info:var>key</info:var> is not what is + <info:var>expected</info:var>, or (if a function was passed as + <info:var>cnf/check</info:var>) the <info:var>cause</info:var> + exception occurred while confirming. + </p> + </info:deftp> + <info:deftp type="exception type" name="&jti-found" arguments="jti cause"> + <p> + The <info:var>jti</info:var> of the proof has already been + issued in a recent past. + </p> + </info:deftp> + <info:deftp type="exception type" name="&cannot-decode-dpop-proof" arguments="value cause"> + <p> + The <info:var>value</info:var> string is not an encoding of a + valid DPoP proof. + </p> + </info:deftp> + <info:deftp type="exception type" name="&cannot-encode-dpop-proof" arguments="dpop-proof key cause"> + <p> + The <info:var>dpop-proof</info:var> cannot be signed. + </p> + </info:deftp> <h1 type="appendix">GNU Free Documentation License</h1> <info:gfdl /> @@ -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-05-10 14:48+0200\n" +"POT-Creation-Date: 2021-05-10 14:49+0200\n" "PO-Revision-Date: 2021-05-10 14:31+0200\n" "Last-Translator: Vivien Kraus <vivien@planete-kraus.eu>\n" "Language-Team: French <vivien@planete-kraus.eu>\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:378 +#: src/scm/webid-oidc/errors.scm:540 msgid "that’s how it is" msgstr "c’est comme ça" -#: src/scm/webid-oidc/errors.scm:383 +#: src/scm/webid-oidc/errors.scm:545 #, 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:386 +#: src/scm/webid-oidc/errors.scm:548 #, 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:389 +#: src/scm/webid-oidc/errors.scm:551 #, 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:394 +#: src/scm/webid-oidc/errors.scm:556 #, 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:396 +#: src/scm/webid-oidc/errors.scm:558 #, 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:401 +#: src/scm/webid-oidc/errors.scm:563 #, 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:403 +#: src/scm/webid-oidc/errors.scm:565 #, 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:408 +#: src/scm/webid-oidc/errors.scm:570 #, 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:410 +#: src/scm/webid-oidc/errors.scm:572 #, 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:415 +#: src/scm/webid-oidc/errors.scm:577 #, 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:417 +#: src/scm/webid-oidc/errors.scm:579 #, 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:420 +#: src/scm/webid-oidc/errors.scm:582 #, 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:423 +#: src/scm/webid-oidc/errors.scm:585 #, 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:426 +#: src/scm/webid-oidc/errors.scm:588 #, 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:429 +#: src/scm/webid-oidc/errors.scm:591 #, 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:432 +#: src/scm/webid-oidc/errors.scm:594 #, 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:435 +#: src/scm/webid-oidc/errors.scm:597 #, 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:438 +#: src/scm/webid-oidc/errors.scm:600 #, 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:441 +#: src/scm/webid-oidc/errors.scm:603 #, 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:444 +#: src/scm/webid-oidc/errors.scm:606 #, 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:447 +#: src/scm/webid-oidc/errors.scm:609 #, scheme-format msgid "" "the server request unexpectedly failed with code ~a and reason phrase ~s" @@ -242,177 +242,296 @@ 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:452 +#: src/scm/webid-oidc/errors.scm:614 #, 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:454 +#: src/scm/webid-oidc/errors.scm:616 #, 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:457 +#: src/scm/webid-oidc/errors.scm:619 #, 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:463 +#: src/scm/webid-oidc/errors.scm:625 #, 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:468 +#: src/scm/webid-oidc/errors.scm:630 #, scheme-format msgid "the webid field is incorrect: ~s" msgstr "le champ webid est incorrect : ~s" -#: src/scm/webid-oidc/errors.scm:469 +#: src/scm/webid-oidc/errors.scm:631 msgid "the webid field is missing" msgstr "le champ webid est manquant" -#: src/scm/webid-oidc/errors.scm:473 +#: src/scm/webid-oidc/errors.scm:635 #, scheme-format msgid "the iss field is incorrect: ~s" msgstr "le champ iss est incorrect : ~s" -#: src/scm/webid-oidc/errors.scm:474 +#: src/scm/webid-oidc/errors.scm:636 msgid "the iss field is missing" msgstr "le champ iss est manquant" -#: src/scm/webid-oidc/errors.scm:478 +#: src/scm/webid-oidc/errors.scm:640 #, scheme-format msgid "the aud field is incorrect: ~s" msgstr "le champ aud est incorrect : ~s" -#: src/scm/webid-oidc/errors.scm:479 +#: src/scm/webid-oidc/errors.scm:641 msgid "the aud field is missing" msgstr "le champ aud est manquant" -#: src/scm/webid-oidc/errors.scm:483 +#: src/scm/webid-oidc/errors.scm:645 #, scheme-format msgid "the iat field is incorrect: ~s" msgstr "le champ iat est incorrect : ~s" -#: src/scm/webid-oidc/errors.scm:484 +#: src/scm/webid-oidc/errors.scm:646 msgid "the iat field is missing" msgstr "le champ iat est manquant" -#: src/scm/webid-oidc/errors.scm:488 +#: src/scm/webid-oidc/errors.scm:650 #, scheme-format msgid "the exp field is incorrect: ~s" msgstr "le champ exp est incorrect : ~s" -#: src/scm/webid-oidc/errors.scm:489 +#: src/scm/webid-oidc/errors.scm:651 msgid "the exp field is missing" msgstr "le champ exp est manquant" -#: src/scm/webid-oidc/errors.scm:493 +#: src/scm/webid-oidc/errors.scm:655 #, 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 +#: src/scm/webid-oidc/errors.scm:656 msgid "the cnf/jkt field is missing" msgstr "le champ cnf/jkt est manquant" -#: src/scm/webid-oidc/errors.scm:498 +#: src/scm/webid-oidc/errors.scm:660 #, 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 +#: src/scm/webid-oidc/errors.scm:661 msgid "the client-id field is missing" msgstr "le champ client-id est manquant" -#: src/scm/webid-oidc/errors.scm:501 +#: src/scm/webid-oidc/errors.scm:665 +#, scheme-format +msgid "the typ field is incorrect: ~s" +msgstr "le champ typ est incorrect : ~s" + +#: src/scm/webid-oidc/errors.scm:666 +msgid "the typ field is missing" +msgstr "le champ typ est manquant" + +#: src/scm/webid-oidc/errors.scm:670 +#, scheme-format +msgid "the jwk field is incorrect: ~s (because ~a)" +msgstr "le champ jwk est incorrect : ~s (parce que ~a)" + +#: src/scm/webid-oidc/errors.scm:672 +msgid "the jwk field is missing" +msgstr "le champ jwk est manquant" + +#: src/scm/webid-oidc/errors.scm:676 +#, scheme-format +msgid "the jti field is incorrect: ~s" +msgstr "le champ jti est incorrect : ~s" + +#: src/scm/webid-oidc/errors.scm:677 +msgid "the jti field is missing" +msgstr "le champ jti est manquant" + +#: src/scm/webid-oidc/errors.scm:681 +#, scheme-format +msgid "the htm field is incorrect: ~s" +msgstr "le champ htm est incorrect : ~s" + +#: src/scm/webid-oidc/errors.scm:682 +msgid "the htm field is missing" +msgstr "le champ htm est manquant" + +#: src/scm/webid-oidc/errors.scm:686 +#, scheme-format +msgid "the htu field is incorrect: ~s" +msgstr "le champ htu est incorrect : ~s" + +#: src/scm/webid-oidc/errors.scm:687 +msgid "the htu field is missing" +msgstr "le champ htu est manquant" + +#: src/scm/webid-oidc/errors.scm:689 #, 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 +#: src/scm/webid-oidc/errors.scm:692 #, 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 +#: src/scm/webid-oidc/errors.scm:695 #, 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 +#: src/scm/webid-oidc/errors.scm:698 +#, scheme-format +msgid "~s is not a DPoP proof (because ~a)" +msgstr "~s n’est pas une preuve DPoP (parce que ~a)" + +#: src/scm/webid-oidc/errors.scm:701 +#, scheme-format +msgid "~s is not a DPoP proof header (because ~a)" +msgstr "~s n’est pas un en-tête de preuve DPoP (parce que ~a)" + +#: src/scm/webid-oidc/errors.scm:704 +#, scheme-format +msgid "~s is not a DPoP proof payload (because ~a)" +msgstr "~s n’est pas un contenu de preuve DPoP (parce que ~a)" + +#: src/scm/webid-oidc/errors.scm:707 #, 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 +#: src/scm/webid-oidc/errors.scm:714 #, 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 +#: src/scm/webid-oidc/errors.scm:725 +#, 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é" + +#: src/scm/webid-oidc/errors.scm:728 +#, scheme-format +msgid "the HTTP uri is signed for ~a, but ~a was requested" +msgstr "l’uri HTTP a été signé pour ~a, mais ~a a été demandé" + +#: src/scm/webid-oidc/errors.scm:731 +#, scheme-format +msgid "the date is ~a, but the DPoP proof is signed in the future at ~a" +msgstr "la date est ~a, mais la preuve DPoP a été signée dans le futur à ~a" + +#: src/scm/webid-oidc/errors.scm:735 +#, scheme-format +msgid "the date is ~a, but the DPoP proof was signed too long ago at ~a" +msgstr "" +"la date est ~a, mais la preuve DPoP a été signée il y a trop longtemps à ~a" + +#: src/scm/webid-oidc/errors.scm:744 +#, scheme-format +msgid "the key ~s does not hash to ~a" +msgstr "la clé ~s ne donne pas un hash de ~a" + +#: src/scm/webid-oidc/errors.scm:746 +#, scheme-format +msgid "the key confirmation of ~s failed (because ~a)" +msgstr "la confirmation de clé de ~s a échoué (parce que ~a)" + +#: src/scm/webid-oidc/errors.scm:748 +#, scheme-format +msgid "the key confirmation of ~s failed" +msgstr "la confirmation de la clé ~s a échoué" + +#: src/scm/webid-oidc/errors.scm:750 +#, scheme-format +msgid "the jti ~s has already been found (because ~a)" +msgstr "le jti ~s a déjà été trouvé (parce que ~a)" + +#: src/scm/webid-oidc/errors.scm:753 #, 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 +#: src/scm/webid-oidc/errors.scm:756 #, scheme-format msgid "I cannot encode ~s as an access token (because ~a)" msgstr "je n’ai pas pu encoder ~s comme un jeton d’accès (parce que ~a)" -#: src/scm/webid-oidc/errors.scm:536 +#: src/scm/webid-oidc/errors.scm:759 +#, 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)" + +#: src/scm/webid-oidc/errors.scm:762 +#, scheme-format +msgid "I cannot encode ~s as a DPoP proof (because ~a)" +msgstr "je n’ai pas pu encoder ~s comme une preuve DPoP (parce que ~a)" + +#: src/scm/webid-oidc/errors.scm:767 msgid "that’s it" msgstr "c’est tout" -#: src/scm/webid-oidc/errors.scm:540 +#: src/scm/webid-oidc/errors.scm:771 #, scheme-format msgid "~a and ~a" msgstr "~a et ~a" -#: src/scm/webid-oidc/errors.scm:543 +#: src/scm/webid-oidc/errors.scm:774 #, scheme-format msgid "~a, ~a" msgstr "~a, ~a" -#: src/scm/webid-oidc/errors.scm:547 +#: src/scm/webid-oidc/errors.scm:778 #, 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:550 +#: src/scm/webid-oidc/errors.scm:781 msgid "there is an undefined variable" msgstr "il y a une variable non définie" -#: src/scm/webid-oidc/errors.scm:552 +#: src/scm/webid-oidc/errors.scm:783 #, scheme-format msgid "the origin is ~a" msgstr "l’origine est ~a" -#: src/scm/webid-oidc/errors.scm:555 +#: src/scm/webid-oidc/errors.scm:786 #, scheme-format msgid "a message is attached: ~a" msgstr "un message est attaché : ~a" -#: src/scm/webid-oidc/errors.scm:558 +#: src/scm/webid-oidc/errors.scm:789 #, scheme-format msgid "the values ~s are problematic" msgstr "les valeurs ~s sont problématiques" -#: src/scm/webid-oidc/errors.scm:561 +#: src/scm/webid-oidc/errors.scm:792 msgid "there is a kind and args" msgstr "il y a un type et des arguments" -#: src/scm/webid-oidc/errors.scm:563 +#: src/scm/webid-oidc/errors.scm:794 msgid "there is an assertion failure" msgstr "il y a un échec d’assertion" -#: src/scm/webid-oidc/errors.scm:565 +#: src/scm/webid-oidc/errors.scm:796 #, scheme-format msgid "the program quits with code ~a" msgstr "le programme quitte avec le code ~a" -#: src/scm/webid-oidc/errors.scm:568 +#: src/scm/webid-oidc/errors.scm:799 +msgid "the program cannot recover from this exception" +msgstr "le programme ne peut pas récupérer après cette exception" + +#: src/scm/webid-oidc/errors.scm:801 +msgid "there is an error" +msgstr "il y a une erreur" + +#: src/scm/webid-oidc/errors.scm:803 #, scheme-format msgid "Unhandled exception type ~a." msgstr "Type d’exception non pris en charge ~a." @@ -436,27 +555,6 @@ msgstr "Type d’exception non pris en charge ~a." #~ msgstr "le champ redirect_uris est manquant" #, scheme-format -#~ msgid "the typ field is incorrect: ~s" -#~ msgstr "le champ typ est incorrect : ~s" - -#~ msgid "the typ field is missing" -#~ msgstr "le champ typ est manquant" - -#, scheme-format -#~ msgid "the jwk field is incorrect: ~s (because ~a)" -#~ msgstr "le champ jwk est incorrect : ~s (parce que ~a)" - -#~ msgid "the jwk field is missing" -#~ msgstr "le champ jwk est manquant" - -#, scheme-format -#~ msgid "the jti field is incorrect: ~s" -#~ msgstr "le champ jti est incorrect : ~s" - -#~ msgid "the jti field is missing" -#~ msgstr "le champ jti est manquant" - -#, scheme-format #~ msgid "the nonce field is incorrect: ~s" #~ msgstr "le champ nonce est incorrect : ~s" @@ -464,74 +562,6 @@ msgstr "Type d’exception non pris en charge ~a." #~ msgstr "le champ nonce est manquant" #, scheme-format -#~ msgid "the htm field is incorrect: ~s" -#~ msgstr "le champ htm est incorrect : ~s" - -#~ msgid "the htm field is missing" -#~ msgstr "le champ htm est manquant" - -#, scheme-format -#~ msgid "the htu field is incorrect: ~s" -#~ msgstr "le champ htu est incorrect : ~s" - -#~ msgid "the htu field is missing" -#~ msgstr "le champ htu est manquant" - -#, scheme-format -#~ msgid "~s is not a DPoP proof (because ~a)" -#~ msgstr "~s n’est pas une preuve DPoP (parce que ~a)" - -#, scheme-format -#~ msgid "~s is not a DPoP proof header (because ~a)" -#~ msgstr "~s n’est pas un en-tête de preuve DPoP (parce que ~a)" - -#, scheme-format -#~ msgid "~s is not a DPoP proof payload (because ~a)" -#~ msgstr "~s n’est pas un contenu de preuve DPoP (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é" - -#, scheme-format -#~ msgid "the HTTP uri is signed for ~a, but ~a was requested" -#~ msgstr "l’uri HTTP a été signé pour ~a, mais ~a a été demandé" - -#, scheme-format -#~ msgid "the date is ~a, but the DPoP proof is signed in the future at ~a" -#~ msgstr "la date est ~a, mais la preuve DPoP a été signée dans le futur à ~a" - -#, scheme-format -#~ msgid "the date is ~a, but the DPoP proof was signed too long ago at ~a" -#~ msgstr "" -#~ "la date est ~a, mais la preuve DPoP a été signée il y a trop longtemps à " -#~ "~a" - -#, scheme-format -#~ msgid "the key ~s does not hash to ~a" -#~ msgstr "la clé ~s ne donne pas un hash de ~a" - -#, scheme-format -#~ msgid "the key confirmation of ~s failed (because ~a)" -#~ msgstr "la confirmation de clé de ~s a échoué (parce que ~a)" - -#, scheme-format -#~ msgid "the key confirmation of ~s failed" -#~ msgstr "la confirmation de la clé ~s a échoué" - -#, scheme-format -#~ msgid "the jti ~s has already been found (because ~a)" -#~ msgstr "le jti ~s a déjà été trouvé (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)" - -#, scheme-format -#~ msgid "I cannot encode ~s as a DPoP proof (because ~a)" -#~ msgstr "je n’ai pas pu encoder ~s comme une preuve DPoP (parce que ~a)" - -#, scheme-format #~ msgid "I could not fetch a RDF graph at ~a (because ~a)" #~ msgstr "je n’ai pas pu récupérer de graphe RDF à ~a (parce que ~a)" @@ -661,12 +691,6 @@ msgstr "Type d’exception non pris en charge ~a." #~ msgid ", " #~ msgstr ", " -#~ msgid "the program cannot recover from this exception" -#~ msgstr "le programme ne peut pas récupérer après cette exception" - -#~ msgid "there is an error" -#~ msgstr "il y a une erreur" - #~ msgid "Warning: generating a new key pair." #~ msgstr "Attention : génération d'une nouvelle paire de clé." diff --git a/po/webid-oidc.pot b/po/webid-oidc.pot index 7c52b89..3c95f53 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-05-10 14:48+0200\n" +"POT-Creation-Date: 2021-05-10 14:49+0200\n" "PO-Revision-Date: YEAR-MO-DA HO:MI+ZONE\n" "Last-Translator: FULL NAME <EMAIL@ADDRESS>\n" "Language-Team: LANGUAGE <LL@li.org>\n" @@ -122,288 +122,406 @@ msgstr "" msgid "Usage: generate-key [NUMBER OF BITS | CURVE]\n" msgstr "" -#: src/scm/webid-oidc/errors.scm:378 +#: src/scm/webid-oidc/errors.scm:540 msgid "that’s how it is" msgstr "" -#: src/scm/webid-oidc/errors.scm:383 +#: src/scm/webid-oidc/errors.scm:545 #, scheme-format msgid "the value ~s is not a base64 string (because ~a)" msgstr "" -#: src/scm/webid-oidc/errors.scm:386 +#: src/scm/webid-oidc/errors.scm:548 #, scheme-format msgid "the value ~s is not JSON (because ~a)" msgstr "" -#: src/scm/webid-oidc/errors.scm:389 +#: src/scm/webid-oidc/errors.scm:551 #, scheme-format msgid "the value ~s does not identify an elleptic curve" msgstr "" -#: src/scm/webid-oidc/errors.scm:394 +#: src/scm/webid-oidc/errors.scm:556 #, scheme-format msgid "the value ~s does not identify a JWK (because ~a)" msgstr "" -#: src/scm/webid-oidc/errors.scm:396 +#: src/scm/webid-oidc/errors.scm:558 #, scheme-format msgid "the value ~s does not identify a JWK" msgstr "" -#: src/scm/webid-oidc/errors.scm:401 +#: src/scm/webid-oidc/errors.scm:563 #, scheme-format msgid "the value ~s does not identify a public JWK (because ~a)" msgstr "" -#: src/scm/webid-oidc/errors.scm:403 +#: src/scm/webid-oidc/errors.scm:565 #, scheme-format msgid "the value ~s does not identify a public JWK" msgstr "" -#: src/scm/webid-oidc/errors.scm:408 +#: src/scm/webid-oidc/errors.scm:570 #, scheme-format msgid "the value ~s does not identify a private JWK (because ~a)" msgstr "" -#: src/scm/webid-oidc/errors.scm:410 +#: src/scm/webid-oidc/errors.scm:572 #, scheme-format msgid "the value ~s does not identify a private JWK" msgstr "" -#: src/scm/webid-oidc/errors.scm:415 +#: src/scm/webid-oidc/errors.scm:577 #, scheme-format msgid "the value ~s does not identify a JWKS (because ~a)" msgstr "" -#: src/scm/webid-oidc/errors.scm:417 +#: src/scm/webid-oidc/errors.scm:579 #, scheme-format msgid "the value ~s does not identify a JWKS" msgstr "" -#: src/scm/webid-oidc/errors.scm:420 +#: src/scm/webid-oidc/errors.scm:582 #, scheme-format msgid "the value ~s does not identify a hash algorithm" msgstr "" -#: src/scm/webid-oidc/errors.scm:423 +#: src/scm/webid-oidc/errors.scm:585 #, scheme-format msgid "the value ~s is not an alist or misses key ~s" msgstr "" -#: src/scm/webid-oidc/errors.scm:426 +#: src/scm/webid-oidc/errors.scm:588 #, scheme-format msgid "the value ~s is not a JWS header (because ~a)" msgstr "" -#: src/scm/webid-oidc/errors.scm:429 +#: src/scm/webid-oidc/errors.scm:591 #, scheme-format msgid "the value ~s is not a JWS payload (because ~a)" msgstr "" -#: src/scm/webid-oidc/errors.scm:432 +#: src/scm/webid-oidc/errors.scm:594 #, scheme-format msgid "the value ~s is not a JWS (because ~a)" msgstr "" -#: src/scm/webid-oidc/errors.scm:435 +#: src/scm/webid-oidc/errors.scm:597 #, scheme-format msgid "the string ~s cannot be split in 3 parts with ~s" msgstr "" -#: src/scm/webid-oidc/errors.scm:438 +#: src/scm/webid-oidc/errors.scm:600 #, 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:441 +#: src/scm/webid-oidc/errors.scm:603 #, scheme-format msgid "I cannot decode JWS ~a (because ~a)" msgstr "" -#: src/scm/webid-oidc/errors.scm:444 +#: src/scm/webid-oidc/errors.scm:606 #, scheme-format msgid "I cannot encode JWS ~a (because ~a)" msgstr "" -#: src/scm/webid-oidc/errors.scm:447 +#: src/scm/webid-oidc/errors.scm:609 #, scheme-format msgid "" "the server request unexpectedly failed with code ~a and reason phrase ~s" msgstr "" -#: src/scm/webid-oidc/errors.scm:452 +#: src/scm/webid-oidc/errors.scm:614 #, scheme-format msgid "the header ~a should not have the value ~s" msgstr "" -#: src/scm/webid-oidc/errors.scm:454 +#: src/scm/webid-oidc/errors.scm:616 #, scheme-format msgid "the header ~a should be present" msgstr "" -#: src/scm/webid-oidc/errors.scm:457 +#: src/scm/webid-oidc/errors.scm:619 #, scheme-format msgid "the server response wasn't expected: ~s (because ~a)" msgstr "" -#: src/scm/webid-oidc/errors.scm:463 +#: src/scm/webid-oidc/errors.scm:625 #, scheme-format msgid "the value ~s is not an OIDC configuration (because ~a)" msgstr "" -#: src/scm/webid-oidc/errors.scm:468 +#: src/scm/webid-oidc/errors.scm:630 #, scheme-format msgid "the webid field is incorrect: ~s" msgstr "" -#: src/scm/webid-oidc/errors.scm:469 +#: src/scm/webid-oidc/errors.scm:631 msgid "the webid field is missing" msgstr "" -#: src/scm/webid-oidc/errors.scm:473 +#: src/scm/webid-oidc/errors.scm:635 #, scheme-format msgid "the iss field is incorrect: ~s" msgstr "" -#: src/scm/webid-oidc/errors.scm:474 +#: src/scm/webid-oidc/errors.scm:636 msgid "the iss field is missing" msgstr "" -#: src/scm/webid-oidc/errors.scm:478 +#: src/scm/webid-oidc/errors.scm:640 #, scheme-format msgid "the aud field is incorrect: ~s" msgstr "" -#: src/scm/webid-oidc/errors.scm:479 +#: src/scm/webid-oidc/errors.scm:641 msgid "the aud field is missing" msgstr "" -#: src/scm/webid-oidc/errors.scm:483 +#: src/scm/webid-oidc/errors.scm:645 #, scheme-format msgid "the iat field is incorrect: ~s" msgstr "" -#: src/scm/webid-oidc/errors.scm:484 +#: src/scm/webid-oidc/errors.scm:646 msgid "the iat field is missing" msgstr "" -#: src/scm/webid-oidc/errors.scm:488 +#: src/scm/webid-oidc/errors.scm:650 #, scheme-format msgid "the exp field is incorrect: ~s" msgstr "" -#: src/scm/webid-oidc/errors.scm:489 +#: src/scm/webid-oidc/errors.scm:651 msgid "the exp field is missing" msgstr "" -#: src/scm/webid-oidc/errors.scm:493 +#: src/scm/webid-oidc/errors.scm:655 #, scheme-format msgid "the cnf/jkt field is incorrect: ~s" msgstr "" -#: src/scm/webid-oidc/errors.scm:494 +#: src/scm/webid-oidc/errors.scm:656 msgid "the cnf/jkt field is missing" msgstr "" -#: src/scm/webid-oidc/errors.scm:498 +#: src/scm/webid-oidc/errors.scm:660 #, scheme-format msgid "the client-id field is incorrect: ~s" msgstr "" -#: src/scm/webid-oidc/errors.scm:499 +#: src/scm/webid-oidc/errors.scm:661 msgid "the client-id field is missing" msgstr "" -#: src/scm/webid-oidc/errors.scm:501 +#: src/scm/webid-oidc/errors.scm:665 +#, scheme-format +msgid "the typ field is incorrect: ~s" +msgstr "" + +#: src/scm/webid-oidc/errors.scm:666 +msgid "the typ field is missing" +msgstr "" + +#: src/scm/webid-oidc/errors.scm:670 +#, scheme-format +msgid "the jwk field is incorrect: ~s (because ~a)" +msgstr "" + +#: src/scm/webid-oidc/errors.scm:672 +msgid "the jwk field is missing" +msgstr "" + +#: src/scm/webid-oidc/errors.scm:676 +#, scheme-format +msgid "the jti field is incorrect: ~s" +msgstr "" + +#: src/scm/webid-oidc/errors.scm:677 +msgid "the jti field is missing" +msgstr "" + +#: src/scm/webid-oidc/errors.scm:681 +#, scheme-format +msgid "the htm field is incorrect: ~s" +msgstr "" + +#: src/scm/webid-oidc/errors.scm:682 +msgid "the htm field is missing" +msgstr "" + +#: src/scm/webid-oidc/errors.scm:686 +#, scheme-format +msgid "the htu field is incorrect: ~s" +msgstr "" + +#: src/scm/webid-oidc/errors.scm:687 +msgid "the htu field is missing" +msgstr "" + +#: src/scm/webid-oidc/errors.scm:689 #, scheme-format msgid "~s is not an access token (because ~a)" msgstr "" -#: src/scm/webid-oidc/errors.scm:504 +#: src/scm/webid-oidc/errors.scm:692 #, scheme-format msgid "~s is not an access token header (because ~a)" msgstr "" -#: src/scm/webid-oidc/errors.scm:507 +#: src/scm/webid-oidc/errors.scm:695 #, scheme-format msgid "~s is not an access token payload (because ~a)" msgstr "" -#: src/scm/webid-oidc/errors.scm:510 +#: src/scm/webid-oidc/errors.scm:698 +#, scheme-format +msgid "~s is not a DPoP proof (because ~a)" +msgstr "" + +#: src/scm/webid-oidc/errors.scm:701 +#, scheme-format +msgid "~s is not a DPoP proof header (because ~a)" +msgstr "" + +#: src/scm/webid-oidc/errors.scm:704 +#, scheme-format +msgid "~s is not a DPoP proof payload (because ~a)" +msgstr "" + +#: src/scm/webid-oidc/errors.scm:707 #, scheme-format msgid "I cannot fetch the issuer configuration of ~a (because ~a)" msgstr "" -#: src/scm/webid-oidc/errors.scm:517 +#: src/scm/webid-oidc/errors.scm:714 #, scheme-format msgid "I cannot fetch the JWKS of ~a at ~a (because ~a)" msgstr "" -#: src/scm/webid-oidc/errors.scm:528 +#: src/scm/webid-oidc/errors.scm:725 +#, scheme-format +msgid "the HTTP method is signed for ~s, but ~s was requested" +msgstr "" + +#: src/scm/webid-oidc/errors.scm:728 +#, scheme-format +msgid "the HTTP uri is signed for ~a, but ~a was requested" +msgstr "" + +#: src/scm/webid-oidc/errors.scm:731 +#, scheme-format +msgid "the date is ~a, but the DPoP proof is signed in the future at ~a" +msgstr "" + +#: src/scm/webid-oidc/errors.scm:735 +#, scheme-format +msgid "the date is ~a, but the DPoP proof was signed too long ago at ~a" +msgstr "" + +#: src/scm/webid-oidc/errors.scm:744 +#, scheme-format +msgid "the key ~s does not hash to ~a" +msgstr "" + +#: src/scm/webid-oidc/errors.scm:746 +#, scheme-format +msgid "the key confirmation of ~s failed (because ~a)" +msgstr "" + +#: src/scm/webid-oidc/errors.scm:748 +#, scheme-format +msgid "the key confirmation of ~s failed" +msgstr "" + +#: src/scm/webid-oidc/errors.scm:750 +#, scheme-format +msgid "the jti ~s has already been found (because ~a)" +msgstr "" + +#: src/scm/webid-oidc/errors.scm:753 #, scheme-format msgid "I cannot decode ~s as an access token (because ~a)" msgstr "" -#: src/scm/webid-oidc/errors.scm:531 +#: src/scm/webid-oidc/errors.scm:756 #, scheme-format msgid "I cannot encode ~s as an access token (because ~a)" msgstr "" -#: src/scm/webid-oidc/errors.scm:536 +#: src/scm/webid-oidc/errors.scm:759 +#, scheme-format +msgid "I cannot decode ~s as a DPoP proof (because ~a)" +msgstr "" + +#: src/scm/webid-oidc/errors.scm:762 +#, scheme-format +msgid "I cannot encode ~s as a DPoP proof (because ~a)" +msgstr "" + +#: src/scm/webid-oidc/errors.scm:767 msgid "that’s it" msgstr "" -#: src/scm/webid-oidc/errors.scm:540 +#: src/scm/webid-oidc/errors.scm:771 #, scheme-format msgid "~a and ~a" msgstr "" -#: src/scm/webid-oidc/errors.scm:543 +#: src/scm/webid-oidc/errors.scm:774 #, scheme-format msgid "~a, ~a" msgstr "" -#: src/scm/webid-oidc/errors.scm:547 +#: src/scm/webid-oidc/errors.scm:778 #, scheme-format msgid "the signature ~a does not match key ~s with payload ~a" msgstr "" -#: src/scm/webid-oidc/errors.scm:550 +#: src/scm/webid-oidc/errors.scm:781 msgid "there is an undefined variable" msgstr "" -#: src/scm/webid-oidc/errors.scm:552 +#: src/scm/webid-oidc/errors.scm:783 #, scheme-format msgid "the origin is ~a" msgstr "" -#: src/scm/webid-oidc/errors.scm:555 +#: src/scm/webid-oidc/errors.scm:786 #, scheme-format msgid "a message is attached: ~a" msgstr "" -#: src/scm/webid-oidc/errors.scm:558 +#: src/scm/webid-oidc/errors.scm:789 #, scheme-format msgid "the values ~s are problematic" msgstr "" -#: src/scm/webid-oidc/errors.scm:561 +#: src/scm/webid-oidc/errors.scm:792 msgid "there is a kind and args" msgstr "" -#: src/scm/webid-oidc/errors.scm:563 +#: src/scm/webid-oidc/errors.scm:794 msgid "there is an assertion failure" msgstr "" -#: src/scm/webid-oidc/errors.scm:565 +#: src/scm/webid-oidc/errors.scm:796 #, scheme-format msgid "the program quits with code ~a" msgstr "" -#: src/scm/webid-oidc/errors.scm:568 +#: src/scm/webid-oidc/errors.scm:799 +msgid "the program cannot recover from this exception" +msgstr "" + +#: src/scm/webid-oidc/errors.scm:801 +msgid "there is an error" +msgstr "" + +#: src/scm/webid-oidc/errors.scm:803 #, 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 a63fa89..ecb3f0a 100644 --- a/src/scm/webid-oidc/Makefile.am +++ b/src/scm/webid-oidc/Makefile.am @@ -6,7 +6,9 @@ dist_webidoidcmod_DATA += \ %reldir%/jws.scm \ %reldir%/cache.scm \ %reldir%/oidc-configuration.scm \ - %reldir%/access-token.scm + %reldir%/access-token.scm \ + %reldir%/jti.scm \ + %reldir%/dpop-proof.scm webidoidcgo_DATA += \ %reldir%/errors.go \ %reldir%/stubs.go \ @@ -15,4 +17,6 @@ webidoidcgo_DATA += \ %reldir%/jws.go \ %reldir%/cache.go \ %reldir%/oidc-configuration.go \ - %reldir%/access-token.go + %reldir%/access-token.go \ + %reldir%/jti.go \ + %reldir%/dpop-proof.go diff --git a/src/scm/webid-oidc/dpop-proof.scm b/src/scm/webid-oidc/dpop-proof.scm new file mode 100644 index 0000000..89c78af --- /dev/null +++ b/src/scm/webid-oidc/dpop-proof.scm @@ -0,0 +1,217 @@ +(define-module (webid-oidc dpop-proof) + #:use-module (webid-oidc jws) + #:use-module (webid-oidc errors) + #:use-module (webid-oidc jwk) + #:use-module (webid-oidc jti) + #:use-module ((webid-oidc stubs) #:prefix stubs:) + #:use-module (web uri) + #:use-module (ice-9 optargs) + #:use-module (srfi srfi-19)) + +(define-public (the-dpop-proof-header x) + (with-exception-handler + (lambda (error) + (raise-not-a-dpop-proof-header x error)) + (lambda () + (let ((x (the-jws-header x))) + (let ((alg (assq-ref x 'alg)) + (typ (assq-ref x 'typ)) + (jwk (assq-ref x 'jwk))) + (unless (and alg (string? alg)) + (raise-unsupported-alg alg)) + (case (string->symbol alg) + ((RS256 RS384 RS512 ES256 ES384 ES512 PS256 PS384 PS512) + #t) + (else + (raise-unsupported-alg alg))) + (unless (equal? typ "dpop+jwt") + (raise-incorrect-typ-field typ)) + (with-exception-handler + (lambda (error) + (raise-incorrect-jwk-field jwk error)) + (lambda () + (the-public-jwk jwk))) + x))))) + +(define-public (dpop-proof-header? x) + (false-if-exception + (and (the-dpop-proof-header x) #t))) + +(define-public (the-dpop-proof-payload x) + (with-exception-handler + (lambda (error) + (raise-not-a-dpop-proof-payload x error)) + (lambda () + (let ((x (the-jws-payload x))) + (let ((jti (assq-ref x 'jti)) + (htm (assq-ref x 'htm)) + (htu (assq-ref x 'htu)) + (iat (assq-ref x 'iat))) + (unless (and jti (string? jti)) + (raise-incorrect-jti-field jti)) + (unless (and htm (string? htm)) + (raise-incorrect-htm-field htm)) + (unless (and htu (string? htu) (string->uri htu)) + (raise-incorrect-htu-field htu)) + (unless (and iat (integer? iat)) + (raise-incorrect-iat-field iat)) + x))))) + +(define-public (dpop-proof-payload? x) + (false-if-exception + (and (the-dpop-proof-payload x) #t))) + +(define-public (the-dpop-proof x) + (with-exception-handler + (lambda (error) + (raise-not-a-dpop-proof x error)) + (lambda () + (cons (the-dpop-proof-header (car x)) + (the-dpop-proof-payload (cdr x)))))) + +(define-public (dpop-proof? x) + (false-if-exception + (and (the-dpop-proof x) #t))) + +(define-public (make-dpop-proof header payload) + (the-dpop-proof (cons header payload))) + +(define-public (make-dpop-proof-header alg jwk) + (when (symbol? alg) + (set! alg (symbol->string alg))) + (the-dpop-proof-header + `((alg . ,alg) + (typ . "dpop+jwt") + (jwk . ,(stubs:strip-key jwk))))) + +(define-public (make-dpop-proof-payload jti htm htu iat) + (when (symbol? htm) + (set! htm (symbol->string htm))) + (when (uri? htu) + (set! htu (uri->string htu))) + (when (date? iat) + (set! iat (date->time-utc iat))) + (when (time? iat) + (set! iat (time-second iat))) + (the-dpop-proof-payload + `((jti . ,jti) + (htm . ,htm) + (htu . ,htu) + (iat . ,iat)))) + +(define-public (dpop-proof-header dpop) + (car (the-dpop-proof dpop))) + +(define-public (dpop-proof-payload dpop) + (cdr (the-dpop-proof dpop))) + +(define-public (dpop-proof-alg code) + (when (dpop-proof? code) + (set! code (dpop-proof-header code))) + (jws-alg (the-dpop-proof-header code))) + +(define-public (dpop-proof-jwk dpop) + (when (dpop-proof? dpop) + (set! dpop (dpop-proof-header dpop))) + (assq-ref (the-dpop-proof-header dpop) 'jwk)) + +(define-public (dpop-proof-jti dpop) + (when (dpop-proof? dpop) + (set! dpop (dpop-proof-payload dpop))) + (assq-ref (the-dpop-proof-payload dpop) 'jti)) + +(define-public (dpop-proof-htm dpop) + (when (dpop-proof? dpop) + (set! dpop (dpop-proof-payload dpop))) + (string->symbol + (assq-ref (the-dpop-proof-payload dpop) + 'htm))) + +(define-public (dpop-proof-htu dpop) + (when (dpop-proof? dpop) + (set! dpop (dpop-proof-payload dpop))) + (string->uri + (assq-ref (the-dpop-proof-payload dpop) + 'htu))) + +(define-public (dpop-proof-iat dpop) + (when (dpop-proof? dpop) + (set! dpop (dpop-proof-payload dpop))) + (time-utc->date + (make-time time-utc + 0 + (assq-ref (the-dpop-proof-payload dpop) + 'iat)))) + +(define (uris-compatible a b) + ;; a is what is signed, b is the request + (unless + (and (eq? (uri-scheme a) + (uri-scheme b)) + (equal? (uri-userinfo a) + (uri-userinfo b)) + (equal? (uri-port a) + (uri-port b)) + (equal? (split-and-decode-uri-path + (uri-path a)) + (split-and-decode-uri-path + (uri-path b)))) + (raise-dpop-uri-mismatch a b))) + +(define-public (dpop-proof-decode current-time jti-list method uri str cnf/check) + (when (date? current-time) + (set! current-time (date->time-utc current-time))) + (when (time? current-time) + (set! current-time (time-second current-time))) + (with-exception-handler + (lambda (error) + (raise-cannot-decode-dpop-proof str error)) + (lambda () + (let ((decoded (the-dpop-proof (jws-decode str dpop-proof-jwk)))) + (unless (eq? method (dpop-proof-htm decoded)) + (raise-dpop-method-mismatch (dpop-proof-htm decoded) method)) + (uris-compatible (dpop-proof-htu decoded) + (if (string? uri) + (string->uri uri) + uri)) + (let ((iat (time-second (date->time-utc (dpop-proof-iat decoded))))) + (unless (>= current-time (- iat 5)) + (raise-dpop-signed-in-future iat current-time)) + (unless (<= current-time (+ iat 120)) ;; Valid for 2 min + (raise-dpop-too-old iat current-time))) + (if (string? cnf/check) + (unless (equal? cnf/check (stubs:jkt (dpop-proof-jwk decoded))) + (raise-dpop-unconfirmed-key (dpop-proof-jwk decoded) cnf/check #f)) + (with-exception-handler + (lambda (error) + (raise-dpop-unconfirmed-key (dpop-proof-jwk decoded) #f error)) + (lambda () + (unless (cnf/check (stubs:jkt (dpop-proof-jwk decoded))) + ;; deprecated; throw an error instead! + (error "the cnf/check function returned #f"))))) + (unless (jti-check current-time (dpop-proof-jti decoded) jti-list 120) + (with-exception-handler + (lambda (error) + (raise-jti-found (dpop-proof-jti decoded) error)) + (lambda () + (error "the jti-check function returned #f")))) + decoded)))) + +(define-public (dpop-proof-encode dpop-proof key) + (with-exception-handler + (lambda (error) + (raise-cannot-encode-dpop-proof dpop-proof key error)) + (lambda () + (jws-encode dpop-proof key)))) + +(define*-public (issue-dpop-proof + client-key + #:key + (alg #f) + (htm #f) + (htu #f) + (iat #f)) + (dpop-proof-encode + (make-dpop-proof (make-dpop-proof-header alg client-key) + (make-dpop-proof-payload (stubs:random 12) htm htu iat)) + client-key)) diff --git a/src/scm/webid-oidc/errors.scm b/src/scm/webid-oidc/errors.scm index 37f8593..154f759 100644 --- a/src/scm/webid-oidc/errors.scm +++ b/src/scm/webid-oidc/errors.scm @@ -3,6 +3,8 @@ #:use-module (ice-9 exceptions) #:use-module (ice-9 optargs) #:use-module (ice-9 i18n) + #:use-module (srfi srfi-19) + #:use-module (web uri) #:use-module (web response)) (define (G_ text) @@ -297,6 +299,56 @@ (raise-exception ((record-constructor &incorrect-client-id-field) value))) +(define-public &incorrect-typ-field + (make-exception-type + '&incorrect-typ-field + &external-error + '(value))) + +(define-public (raise-incorrect-typ-field value) + (raise-exception + ((record-constructor &incorrect-typ-field) value))) + +(define-public &incorrect-jwk-field + (make-exception-type + '&incorrect-jwk-field + &external-error + '(value cause))) + +(define-public (raise-incorrect-jwk-field value cause) + (raise-exception + ((record-constructor &incorrect-jwk-field) value cause))) + +(define-public &incorrect-jti-field + (make-exception-type + '&incorrect-jti-field + &external-error + '(value))) + +(define-public (raise-incorrect-jti-field value) + (raise-exception + ((record-constructor &incorrect-jti-field) value))) + +(define-public &incorrect-htm-field + (make-exception-type + '&incorrect-htm-field + &external-error + '(value))) + +(define-public (raise-incorrect-htm-field value) + (raise-exception + ((record-constructor &incorrect-htm-field) value))) + +(define-public &incorrect-htu-field + (make-exception-type + '&incorrect-htu-field + &external-error + '(value))) + +(define-public (raise-incorrect-htu-field value) + (raise-exception + ((record-constructor &incorrect-htu-field) value))) + (define-public ¬-an-access-token (make-exception-type '¬-an-access-token @@ -327,6 +379,36 @@ (raise-exception ((record-constructor ¬-an-access-token-payload) value cause))) +(define-public ¬-a-dpop-proof + (make-exception-type + '¬-a-dpop-proof + &external-error + '(value cause))) + +(define-public (raise-not-a-dpop-proof value cause) + (raise-exception + ((record-constructor ¬-a-dpop-proof) value cause))) + +(define-public ¬-a-dpop-proof-header + (make-exception-type + '¬-a-dpop-proof-header + &external-error + '(value cause))) + +(define-public (raise-not-a-dpop-proof-header value cause) + (raise-exception + ((record-constructor ¬-a-dpop-proof-header) value cause))) + +(define-public ¬-a-dpop-proof-payload + (make-exception-type + '¬-a-dpop-proof-payload + &external-error + '(value cause))) + +(define-public (raise-not-a-dpop-proof-payload value cause) + (raise-exception + ((record-constructor ¬-a-dpop-proof-payload) value cause))) + (define-public &cannot-fetch-issuer-configuration (make-exception-type '&cannot-fetch-issuer-configuration @@ -347,6 +429,66 @@ (raise-exception ((record-constructor &cannot-fetch-jwks) issuer uri cause))) +(define-public &dpop-method-mismatch + (make-exception-type + '&dpop-method-mismatch + &external-error + '(signed requested))) + +(define-public (raise-dpop-method-mismatch signed requested) + (raise-exception + ((record-constructor &dpop-method-mismatch) signed requested))) + +(define-public &dpop-uri-mismatch + (make-exception-type + '&dpop-uri-mismatch + &external-error + '(signed requested))) + +(define-public (raise-dpop-uri-mismatch signed requested) + (raise-exception + ((record-constructor &dpop-uri-mismatch) signed requested))) + +(define-public &dpop-signed-in-future + (make-exception-type + '&dpop-signed-in-future + &external-error + '(signed requested))) + +(define-public (raise-dpop-signed-in-future signed requested) + (raise-exception + ((record-constructor &dpop-signed-in-future) signed requested))) + +(define-public &dpop-too-old + (make-exception-type + '&dpop-too-old + &external-error + '(signed requested))) + +(define-public (raise-dpop-too-old signed requested) + (raise-exception + ((record-constructor &dpop-too-old) signed requested))) + +(define-public &dpop-unconfirmed-key + (make-exception-type + '&dpop-unconfirmed-key + &external-error + '(key expected cause))) + +(define-public (raise-dpop-unconfirmed-key key expected cause) + (raise-exception + ((record-constructor &dpop-unconfirmed-key) key expected cause))) + +(define-public &jti-found + (make-exception-type + '&jti-found + &external-error + '(jti cause))) + +(define-public (raise-jti-found jti cause) + (raise-exception + ((record-constructor &jti-found) jti cause))) + (define-public &cannot-decode-access-token (make-exception-type '&cannot-decode-access-token @@ -367,6 +509,26 @@ (raise-exception ((record-constructor &cannot-encode-access-token) value cause))) +(define-public &cannot-decode-dpop-proof + (make-exception-type + '&cannot-decode-dpop-proof + &external-error + '(value cause))) + +(define-public (raise-cannot-decode-dpop-proof value cause) + (raise-exception + ((record-constructor &cannot-decode-dpop-proof) value cause))) + +(define-public &cannot-encode-dpop-proof + (make-exception-type + '&cannot-encode-dpop-proof + &external-error + '(value cause))) + +(define-public (raise-cannot-encode-dpop-proof value cause) + (raise-exception + ((record-constructor &cannot-encode-dpop-proof) value cause))) + (define*-public (error->str err #:key (max-depth #f)) (if (record? err) (let* ((type (record-type-descriptor err)) @@ -497,39 +659,108 @@ (if value (format #f (G_ "the client-id field is incorrect: ~s") value) (format #f (G_ "the client-id field is missing"))))) + ((&incorrect-typ-field) + (let ((value (get 'value))) + (if value + (format #f (G_ "the typ field is incorrect: ~s") value) + (format #f (G_ "the typ field is missing"))))) + ((&incorrect-jwk-field) + (let ((value (get 'value))) + (if value + (format #f (G_ "the jwk field is incorrect: ~s (because ~a)") + value (recurse (get 'cause))) + (format #f (G_ "the jwk field is missing"))))) + ((&incorrect-jti-field) + (let ((value (get 'value))) + (if value + (format #f (G_ "the jti field is incorrect: ~s") value) + (format #f (G_ "the jti field is missing"))))) + ((&incorrect-htm-field) + (let ((value (get 'value))) + (if value + (format #f (G_ "the htm field is incorrect: ~s") value) + (format #f (G_ "the htm field is missing"))))) + ((&incorrect-htu-field) + (let ((value (get 'value))) + (if value + (format #f (G_ "the htu field is incorrect: ~s") value) + (format #f (G_ "the htu field is missing"))))) ((¬-an-access-token) - (format #f (G_ "~s is not an access token (because ~a)" - (get 'value) (recurse (get 'cause))))) + (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))))) + (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))))) + (format #f (G_ "~s is not an access token payload (because ~a)") + (get 'value) (recurse (get 'cause)))) + ((¬-a-dpop-proof) + (format #f (G_ "~s is not a DPoP proof (because ~a)") + (get 'value) (recurse (get 'cause)))) + ((¬-a-dpop-proof-header) + (format #f (G_ "~s is not a DPoP proof header (because ~a)") + (get 'value) (recurse (get 'cause)))) + ((¬-a-dpop-proof-payload) + (format #f (G_ "~s is not a DPoP proof 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))))) + (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))))) + (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)))) + ((&dpop-method-mismatch) + (format #f (G_ "the HTTP method is signed for ~s, but ~s was requested") + (get 'signed) (get 'requested))) + ((&dpop-uri-mismatch) + (format #f (G_ "the HTTP uri is signed for ~a, but ~a was requested") + (uri->string (get 'signed)) (uri->string (get 'requested)))) + ((&dpop-signed-in-future) + (format #f (G_ "the date is ~a, but the DPoP proof is signed in the future at ~a") + (time-second (date->time-utc (get 'signed))) + (time-second (date->time-utc (get 'requested))))) + ((&dpop-too-old) + (format #f (G_ "the date is ~a, but the DPoP proof was signed too long ago at ~a") + (time-second (date->time-utc (get 'signed))) + (time-second (date->time-utc (get 'requested))))) + ((&dpop-unconfirmed-key) + (let ((key (get 'key)) + (expected (get 'expected)) + (cause (get 'cause))) + (cond + (expected + (format #f (G_ "the key ~s does not hash to ~a") key expected)) + (cause + (format #f (G_ "the key confirmation of ~s failed (because ~a)" key (recurse cause)))) + (else + (format #f (G_ "the key confirmation of ~s failed" key)))))) + ((&jti-found) + (format #f (G_ "the jti ~s has already been found (because ~a)") + (get 'jti) (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))))) + (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 (because ~a)" - (get 'value) (recurse (get 'cause))))) + (format #f (G_ "I cannot encode ~s as an access token (because ~a)") + (get 'value) (recurse (get 'cause)))) + ((&cannot-decode-dpop-proof) + (format #f (G_ "I cannot decode ~s as a DPoP proof (because ~a)") + (get 'value) (recurse (get 'cause)))) + ((&cannot-encode-dpop-proof) + (format #f (G_ "I cannot encode ~s as a DPoP proof (because ~a)") + (get 'value) (recurse (get 'cause)))) ((&compound-exception) (let ((components (get 'components))) (if (null? components) @@ -564,6 +795,10 @@ ((&quit-exception) (format #f (G_ "the program quits with code ~a") (get 'code))) + ((&non-continuable) + (format #f (G_ "the program cannot recover from this exception"))) + ((&error) + (format #f (G_ "there is an error"))) (else (error (format #f (G_ "Unhandled exception type ~a.") (record-type-name type)))))) diff --git a/src/scm/webid-oidc/jti.scm b/src/scm/webid-oidc/jti.scm new file mode 100644 index 0000000..423382a --- /dev/null +++ b/src/scm/webid-oidc/jti.scm @@ -0,0 +1,34 @@ +(define-module (webid-oidc jti) + #:use-module (ice-9 atomic) + #:use-module (ice-9 threads) + #:use-module (srfi srfi-19)) + +(define-public (make-jti-list) + (make-atomic-box '())) + +(define-public (lookup list jti) + (if (null? list) + #f + (or (string=? (assq-ref (car list) 'jti) jti) + (lookup (cdr list) jti)))) + +(define-public (jti-check current-time jti list valid-time) + (when (date? current-time) + (set! current-time (date->time-utc current-time))) + (when (time? current-time) + (set! current-time (time-second current-time))) + (let* ((old (atomic-box-ref list)) + (new-entry `((exp . ,(+ current-time valid-time)) + (jti . ,jti))) + (new (filter + (lambda (entry) + (let ((exp (assq-ref entry 'exp))) + (>= exp current-time))) + (cons new-entry old)))) + (let ((present? (lookup old jti))) + (if present? + #f + (let ((discarded (atomic-box-compare-and-swap! list old new))) + (if (eq? discarded old) + #t + (jti-check current-time jti list valid-time))))))) diff --git a/tests/Makefile.am b/tests/Makefile.am index 3468ccb..2eb0db6 100644 --- a/tests/Makefile.am +++ b/tests/Makefile.am @@ -16,7 +16,14 @@ TESTS = %reldir%/load-library.scm \ %reldir%/jws.scm \ %reldir%/cache-valid.scm \ %reldir%/cache-revalidate.scm \ - %reldir%/oidc-configuration.scm + %reldir%/oidc-configuration.scm \ + %reldir%/dpop-proof-valid.scm \ + %reldir%/dpop-proof-wrong-htm.scm \ + %reldir%/dpop-proof-wrong-htu.scm \ + %reldir%/dpop-proof-iat-in-future.scm \ + %reldir%/dpop-proof-iat-too-late.scm \ + %reldir%/dpop-proof-wrong-key.scm \ + %reldir%/dpop-proof-replay.scm EXTRA_DIST += $(TESTS) diff --git a/tests/dpop-proof-iat-in-future.scm b/tests/dpop-proof-iat-in-future.scm new file mode 100644 index 0000000..7444a02 --- /dev/null +++ b/tests/dpop-proof-iat-in-future.scm @@ -0,0 +1,37 @@ +(use-modules (webid-oidc dpop-proof) + (webid-oidc jti) + (webid-oidc jwk) + (webid-oidc testing) + (webid-oidc errors) + (web uri) + (srfi srfi-19) + (web response)) + +(with-test-environment + "dpop-proof-iat-in-future" + (lambda () + (define jwk (generate-key #:n-size 2048)) + (define cnf (jkt jwk)) + (define blacklist (make-jti-list)) + (define proof + (issue-dpop-proof + jwk + #:alg 'RS256 + #:htm 'GET + #:htu (string->uri "https://example.com/res#frag") + #:iat (time-utc->date (make-time time-utc 0 10)))) + (with-exception-handler + (lambda (error) + (unless ((record-predicate &dpop-signed-in-future) + ((record-accessor &cannot-decode-dpop-proof 'cause) error)) + (raise-exception error))) + (lambda () + (dpop-proof-decode (time-utc->date (make-time time-utc 0 0)) + blacklist + 'GET + (string->uri "https://example.com/res?query") + proof + cnf) + (exit 2)) + #:unwind? #t + #:unwind-for-type &cannot-decode-dpop-proof))) diff --git a/tests/dpop-proof-iat-too-late.scm b/tests/dpop-proof-iat-too-late.scm new file mode 100644 index 0000000..1a56f22 --- /dev/null +++ b/tests/dpop-proof-iat-too-late.scm @@ -0,0 +1,37 @@ +(use-modules (webid-oidc dpop-proof) + (webid-oidc jti) + (webid-oidc jwk) + (webid-oidc testing) + (webid-oidc errors) + (web uri) + (srfi srfi-19) + (web response)) + +(with-test-environment + "dpop-proof-iat-too-late" + (lambda () + (define jwk (generate-key #:n-size 2048)) + (define cnf (jkt jwk)) + (define blacklist (make-jti-list)) + (define proof + (issue-dpop-proof + jwk + #:alg 'RS256 + #:htm 'GET + #:htu (string->uri "https://example.com/res#frag") + #:iat (time-utc->date (make-time time-utc 0 0)))) + (with-exception-handler + (lambda (error) + (unless ((record-predicate &dpop-too-old) + ((record-accessor &cannot-decode-dpop-proof 'cause) error)) + (raise-exception error))) + (lambda () + (dpop-proof-decode (time-utc->date (make-time time-utc 0 600)) + blacklist + 'GET + (string->uri "https://example.com/res?query") + proof + cnf) + (exit 2)) + #:unwind? #t + #:unwind-for-type &cannot-decode-dpop-proof))) diff --git a/tests/dpop-proof-replay.scm b/tests/dpop-proof-replay.scm new file mode 100644 index 0000000..b527dce --- /dev/null +++ b/tests/dpop-proof-replay.scm @@ -0,0 +1,40 @@ +(use-modules (webid-oidc dpop-proof) + (webid-oidc jti) + (webid-oidc jwk) + (webid-oidc testing) + (webid-oidc errors) + (web uri) + (srfi srfi-19) + (web response)) + +(with-test-environment + "dpop-proof-replay" + (lambda () + (define jwk (generate-key #:n-size 2048)) + (define cnf (jkt jwk)) + (define blacklist (make-jti-list)) + (define proof + (issue-dpop-proof + jwk + #:alg 'RS256 + #:htm 'GET + #:htu (string->uri "https://example.com/res#frag") + #:iat (time-utc->date (make-time time-utc 0 0)))) + (define (decode) + (dpop-proof-decode (time-utc->date (make-time time-utc 0 10)) + blacklist + 'GET + (string->uri "https://example.com/res?query") + proof + cnf)) + (define decoded-once (decode)) + (with-exception-handler + (lambda (error) + (unless ((record-predicate &jti-found) + ((record-accessor &cannot-decode-dpop-proof 'cause) error)) + (raise-exception error))) + (lambda () + (decode) + (exit 2)) + #:unwind? #t + #:unwind-for-type &cannot-decode-dpop-proof))) diff --git a/tests/dpop-proof-valid.scm b/tests/dpop-proof-valid.scm new file mode 100644 index 0000000..a05a223 --- /dev/null +++ b/tests/dpop-proof-valid.scm @@ -0,0 +1,30 @@ +(use-modules (webid-oidc dpop-proof) + (webid-oidc jti) + (webid-oidc jwk) + (webid-oidc testing) + (web uri) + (srfi srfi-19) + (web response)) + +(with-test-environment + "dpop-proof-valid" + (lambda () + (define jwk (generate-key #:n-size 2048)) + (define cnf (jkt jwk)) + (define blacklist (make-jti-list)) + (define proof + (issue-dpop-proof + jwk + #:alg 'RS256 + #:htm 'GET + #:htu (string->uri "https://example.com/res#frag") + #:iat (time-utc->date (make-time time-utc 0 0)))) + (define decoded + (dpop-proof-decode (time-utc->date (make-time time-utc 0 10)) + blacklist + 'GET + (string->uri "https://example.com/res?query") + proof + cnf)) + (unless decoded + (exit 1)))) diff --git a/tests/dpop-proof-wrong-htm.scm b/tests/dpop-proof-wrong-htm.scm new file mode 100644 index 0000000..4531a44 --- /dev/null +++ b/tests/dpop-proof-wrong-htm.scm @@ -0,0 +1,37 @@ +(use-modules (webid-oidc dpop-proof) + (webid-oidc jti) + (webid-oidc jwk) + (webid-oidc testing) + (webid-oidc errors) + (web uri) + (srfi srfi-19) + (web response)) + +(with-test-environment + "dpop-proof-wrong-htm" + (lambda () + (define jwk (generate-key #:n-size 2048)) + (define cnf (jkt jwk)) + (define blacklist (make-jti-list)) + (define proof + (issue-dpop-proof + jwk + #:alg 'RS256 + #:htm 'POST + #:htu (string->uri "https://example.com/res#frag") + #:iat (time-utc->date (make-time time-utc 0 0)))) + (with-exception-handler + (lambda (error) + (unless ((record-predicate &dpop-method-mismatch) + ((record-accessor &cannot-decode-dpop-proof 'cause) error)) + (raise-exception error))) + (lambda () + (dpop-proof-decode (time-utc->date (make-time time-utc 0 10)) + blacklist + 'GET + (string->uri "https://example.com/res?query") + proof + cnf) + (exit 2)) + #:unwind? #t + #:unwind-for-type &cannot-decode-dpop-proof))) diff --git a/tests/dpop-proof-wrong-htu.scm b/tests/dpop-proof-wrong-htu.scm new file mode 100644 index 0000000..f8ecb29 --- /dev/null +++ b/tests/dpop-proof-wrong-htu.scm @@ -0,0 +1,37 @@ +(use-modules (webid-oidc dpop-proof) + (webid-oidc jti) + (webid-oidc jwk) + (webid-oidc testing) + (webid-oidc errors) + (web uri) + (srfi srfi-19) + (web response)) + +(with-test-environment + "dpop-proof-wrong-htu" + (lambda () + (define jwk (generate-key #:n-size 2048)) + (define cnf (jkt jwk)) + (define blacklist (make-jti-list)) + (define proof + (issue-dpop-proof + jwk + #:alg 'RS256 + #:htm 'GET + #:htu (string->uri "https://example.com/other-res#frag") + #:iat (time-utc->date (make-time time-utc 0 0)))) + (with-exception-handler + (lambda (error) + (unless ((record-predicate &dpop-uri-mismatch) + ((record-accessor &cannot-decode-dpop-proof 'cause) error)) + (raise-exception error))) + (lambda () + (dpop-proof-decode (time-utc->date (make-time time-utc 0 10)) + blacklist + 'GET + (string->uri "https://example.com/res?query") + proof + cnf) + (exit 2)) + #:unwind? #t + #:unwind-for-type &cannot-decode-dpop-proof))) diff --git a/tests/dpop-proof-wrong-key.scm b/tests/dpop-proof-wrong-key.scm new file mode 100644 index 0000000..9ea98ee --- /dev/null +++ b/tests/dpop-proof-wrong-key.scm @@ -0,0 +1,37 @@ +(use-modules (webid-oidc dpop-proof) + (webid-oidc jti) + (webid-oidc jwk) + (webid-oidc testing) + (webid-oidc errors) + (web uri) + (srfi srfi-19) + (web response)) + +(with-test-environment + "dpop-proof-wrong-key" + (lambda () + (define jwk (generate-key #:n-size 2048)) + (define cnf (jkt (generate-key #:n-size 2048))) + (define blacklist (make-jti-list)) + (define proof + (issue-dpop-proof + jwk + #:alg 'RS256 + #:htm 'GET + #:htu (string->uri "https://example.com/res#frag") + #:iat (time-utc->date (make-time time-utc 0 0)))) + (with-exception-handler + (lambda (error) + (unless ((record-predicate &dpop-unconfirmed-key) + ((record-accessor &cannot-decode-dpop-proof 'cause) error)) + (raise-exception error))) + (lambda () + (dpop-proof-decode (time-utc->date (make-time time-utc 0 10)) + blacklist + 'GET + (string->uri "https://example.com/res?query") + proof + cnf) + (exit 2)) + #:unwind? #t + #:unwind-for-type &cannot-decode-dpop-proof))) |