diff options
| author | Vivien Kraus <vivien@planete-kraus.eu> | 2021-09-20 11:25:29 +0200 |
|---|---|---|
| committer | Vivien Kraus <vivien@planete-kraus.eu> | 2021-09-21 22:28:51 +0200 |
| commit | e910b3ba2ded990a5193f7ea0cfad525332e4171 (patch) | |
| tree | b04e74e7c06e0a0fde5edd7ac0b8773db94cd515 | |
| parent | dcd329af1ec765ca0fac97ef2dc18a3177d34083 (diff) | |
JWS: use GOOPS
32 files changed, 2720 insertions, 2514 deletions
diff --git a/doc/disfluid.texi b/doc/disfluid.texi index 2cfe60c..0047379 100644 --- a/doc/disfluid.texi +++ b/doc/disfluid.texi @@ -60,6 +60,7 @@ is tracked in the Guix channel * Decentralized Authentication on the Web:: * Invoking disfluid:: * Running disfluid with GNU Guix:: +* Managing keys:: * The Json Web Token:: * Caching on server side:: * Content negociation:: @@ -280,264 +281,8 @@ This record configures a server to serve public application pages. The configuration for the full server. @end deftp -@node The Json Web Token -@chapter The Json Web Token - -The Json Web Token, or @dfn{JWT}, is a terse representation of a pair -of JSON objects: the @dfn{header}, and the @dfn{payload}. The JWT can -be @dfn{encoded} as a Json Web Signature (@dfn{JWS}), in which case -the header is encoded to base64 with the URL alphabet, and without -padding characters, the payload is also encoded to base64, and the -concatenation of the encoding of the header, a dot, and the encoding -of the payload is signed with some cryptography algorithm. In the -following, we will only be interested by public-key cryptography. The -concatenation of header, dot, payload, dot and signature in base64 is -the encoding of the JWT. - -Decoded JWT are represented as a pair. The car of the pair is the -header, and the cdr is the payload. Both the header and the payload -use the JSON representation from srfi-180: objects are alists of -@strong{symbols} to values, arrays are vectors. It is unfortunate that -guile-json has a slightly different representation, where alist keys -are @emph{strings}, but we hope that in the future SRFI-180 will be -more closely respected. - -@menu -* The ID token:: -* The access token:: -* The DPoP proof:: -* Generic JWTs:: -* Public-key cryptography:: -@end menu - -@node The ID token -@section The ID token - -The ID token is a special JWT that the application keeps for -itself. It is signed by the identity provider, and contains the -following claims: - -@table @emph -@item webid -the URI of the user’s webid; -@item iss -the URI of the identity provider (issuer); -@item sub -the username (the webid-oidc issuer puts the webid again here, but it -could be any string); -@item aud -the ID of the client application that is intended to receive the ID -token; -@item nonce -some random data to change the signature; -@item exp -an UTC time (in seconds) for when the token expires; -@item iat -the time when it was issued. -@end table - -There are functions to work with ID tokens in -@emph{(webid-oidc oidc-id-token)}. - -@deffn function id-token? @var{object} -Check that @var{object} is a decoded ID token. -@end deffn - -The following helper functions convert URIs to the URIs from -@emph{(web uri)} and times to @emph{(srfi srfi-19)} dates. - -@deffn function id-token-webid @var{token} -@deffnx function id-token-iss @var{token} -@deffnx function id-token-sub @var{token} -@deffnx function id-token-aud @var{token} -@deffnx function id-token-nonce @var{token} -@deffnx function id-token-exp @var{token} -@deffnx function id-token-iat @var{token} -Get the suitable field from the payload of @var{token}. -@end deffn - -ID tokens can be signed and encoded as a string, or decoded. - -@deffn function id-token-decode @var{token} @var{[#http-get]} -Decode @var{token}, as a string, into a decoded 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)}. Return -@code{#f} if it failed, or the decoded token otherwise. -@end deffn - -@deffn function id-token-encode @var{token} @var{key} -Encode @var{token} and sign it with the issuer’s @var{key}. -@end deffn - -@deffn function issue-id-token @var{issuer-key} @var{#:webid} @var{#:iss} @var{#:sub} @var{#:aud} @var{#:validity} -Create an ID token that is valid for @var{#:validity} seconds, and -sign and encode it with @var{issuer-key}. -@end deffn - -@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 the decoded access token, or raise -an exception. -@end deffn - -@deffn function issue-access-token @var{issuer-key} #:@var{webid} #:@var{iss} #:@var{client-id} #:@var{validity} [#:@var{[client-key} | #:@var{cnf/jkt}] -Create an access token for @var{#:validity} seconds, 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 The DPoP proof -@section The DPoP proof - -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. - -@deffn function dpop-proof? @var{proof} -Check that the @var{proof} is a decoded DPoP proof. The validity of -the proof is not checked by this function. -@end deffn - -@deffn function dpop-proof-alg @var{proof} -@deffnx function dpop-proof-jwk @var{proof} -@deffnx function dpop-proof-jti @var{proof} -@deffnx function dpop-proof-htm @var{proof} -@deffnx function dpop-proof-htu @var{proof} -@deffnx function dpop-proof-iat @var{proof} -@deffnx function dpop-proof-ath @var{proof} -Get the corresponding field of the proof. -@end deffn - -@deffn function dpop-proof-decode @var{method} @var{uri} @var{str} @var{cnf/check} @var{[#:access-token]} -Check and decode a DPoP proof encoded as @var{str}. - -In order to prevent replay attacks, each proof has a unique random -string that is remembered globally until its expiration date is -reached. - -The proof is limited to the scope of one @var{uri} and one -@var{method} (@code{'GET}, @code{'POST} and so on). - -The key that is used to sign the proof should be confirmed by the -identity provider. To this end, the @var{cnf/check} function is called -with the fingerprint of the key. The function should check that the -fingerprint is OK (return a boolean). - -Finally, when the DPoP proof is tied to an access token (so, for all -uses except requesting an access token or a refresh token), it must be -bound to an @var{access-token}. -@end deffn - -The DPoP proof algorithm is sensitive to the current time, because the -proofs have a limited time validity. By default, the time is the -system time when the proof is decoded. - -@deffn parameter current-date -This parameter overrides the current time. - -It is a thunk returning a date, so you need to put two parenthesis to -get the time. However, you can set it to a date, a time, a number of -seconds, or a thunk returning any of these. - -@example - (use-module ((webid-oidc parameters) #:prefix p:)) - ;; This is the current date: - ((p:current-date)) - ;; You can override it with a thunk, or a fixed date: - (parameterize ((p:current-date 0)) - ;; Jan 1st 1970 - ((p:current-date))) -@end example -@end deffn - -@deffn function dpop-proof-encode @var{proof} @var{key} -Encode the proof and sign it with @var{key}. To generate valid proofs, -@var{key} should be the private key corresponding to the @code{jwk} -field of the proof. -@end deffn - -@deffn function issue-dpop-proof @var{client-key} #:@var{htm} #:@var{htu} {[#:@var{access-token}=#f]} -Create a proof, sign it and encode it with -@var{client-key}. @var{client-key} 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. For most uses, the DPoP proof should -be encoded for a specific access token. Only token requests should -omit the @samp{access-token} field. - -The @samp{iat} field of the DPoP proof is read from the -@var{current-date} parameter. -@end deffn - -@node Generic JWTs -@section Generic JWTs - -You can parse generic JWTs signed with JWS with the following -functions from @emph{(webid-oidc jws)}. - -@deffn function jws? @var{jwt} -Check that @var{jwt} is a decoded JWT signed with JWS. -@end deffn - -@deffn function jws-alg @var{jwt} -Get the algorithm used to sign @var{jwt}. -@end deffn - -@deffn function jws-decode @var{str} @var{lookup-keys} -Check and decode a JWT signed with JWS and encoded as @var{str}. - -Since the decoding and signature verification happen at the same time -(for user friendliness), the @var{lookup-keys} function is used. It is -passed as arguments the decoded JWT (but the signature is not checked -yet), and it should return a public key, a public key set or a list of -public keys. If the key lookup failed, this function should raise an -exception. -@end deffn - -@deffn function jws-encode @var{jwt} @var{key} -Encode the JWT and sign it with @var{key}. -@end deffn - -@node Public-key cryptography -@section Public-key cryptography +@node Managing keys +@chapter Managing keys Some functions require a key, or a key pair, to operate. The @emph{(webid-oidc jwk)} module provides you with everything required @@ -713,6 +458,710 @@ If the JWKS cannot be downloaded, or is incorrect, this exception is raised. @end deftp +@node The Json Web Token +@chapter The Json Web Token + +The Json Web Token, or @dfn{JWT}, is a terse representation of a pair +of JSON objects: the @dfn{header}, and the @dfn{payload}. The JWT can +be @dfn{encoded} as a Json Web Signature (@dfn{JWS}), in which case +the header is encoded to base64 with the URL alphabet, and without +padding characters, the payload is also encoded to base64, and the +concatenation of the encoding of the header, a dot, and the encoding +of the payload is signed with some cryptography algorithm. In the +following, we will only be interested by public-key cryptography. The +concatenation of header, dot, payload, dot and signature in base64 is +the encoding of the JWT. + +@menu +* Tokens:: +* Tokens issued by an OIDC provider:: +* Date verification for tokens:: +* Single-use tokens:: +* ID tokens:: +* Access tokens:: +* DPoP proofs:: +* Authorization codes:: +@end menu + +@node Tokens +@section Tokens + +The @emph{(webid-oidc jws)} implements some functionality for tokens. + +@deftp {Class} <token> () @var{alg} +The base class for all tokens. It only knows the signature +@var{alg}orithm. You can construct one in different ways: +@itemize +@item +the @code{#:@var{alg}} construct keyword supports a string or a +keyword as a value, containing a valid JWA identifier, such as +@code{RS256}; +@item +the @code{#:@var{signing-key}} keyword defines the key that will serve +to sign the token. The signature algorithm is set to the default of +@var{signing-key}; +@item +the @code{#:@var{jwt-header}} and @code{#:@var{jwt-payload}} keywords +let you pass two alists, following the JSON representation from +srfi-180: objects are alists of @strong{symbols} to values, arrays are +vectors. +@end itemize +@end deftp + +@deftp {Exception type} &invalid-jws +This exception is raised when a JWT cannot be parsed or constructed as +a JWS. +@end deftp + +@deffn {function} make-invalid-jws +Construct an exception of type @code{&invalid-jws}. +@end deffn + +@deffn {function} invalid-jws? @var{exception} +Check whether @var{exception} was raised because of an invalid JWS. +@end deffn + +There are multiple things you can do with a token. + +@deffn {Generic} alg @var{token} +Return the signature algorithm used for @var{token}, as a symbol. +@end deffn + +@deffn {Generic} token->jwt @var{token} +Return two alists, following the JSON representation from srfi-180: +one for the header, and then one for the payload. +@end deffn + +@deffn {Generic} lookup-keys @var{token} @var{args} +Return the set of keys that could be used to sign @var{token}, as a +public key, a list of keys, or a JWKS. @var{args} is a list of keyword +arguments for specific implementations. +@end deffn + +@deffn {Generic} verify @var{token} @var{args} +Suppose that the @var{token} signature has been checked, perform some +additional verifications. This function should raise exceptions to +signal an invalid token. +@end deffn + +@deffn {function} decode @var{expected-token-class} @var{encoded} . @var{args} +Parse @var{encoded} as a token from the @var{expected-token-class}, +check its signature against the key obtained by @code{(lookup-keys +@var{token} @var{args})} where @var{token} is the parsed token, and +perform additional verifications with @code{(verify @var{token} +@var{args})}. +@end deffn + +@deffn {function} encode @var{token} @var{key} +Encode and sign @var{token} with @var{key}, returning a string. +@end deffn + +@deffn {function} issue @var{token-class} @var{issuer-key} . @var{args} +Construct a token of @var{token-class} and @var{args} and sign it with +@var{issuer-key}. Since we know the key to sign it, it is not +necessary to pass either @code{#:signing-key} nor @code{#:alg} to the +constructor. +@end deffn + +@node Tokens issued by an OIDC provider +@section Tokens issued by an OIDC provider +OIDC tokens are those signed by an OIDC identity provider. This kind +of token knows its issuer, and getting the keys to check the token +signature is done by OIDC discovery. + +@deftp {Class} <oidc-token> (<token>) @var{iss} +The base class for tokens which are issued by an identity provider. It +knows the issuer (@var{iss}, an uri from @emph{(web uri)}), and can +query it to check the token signature. + +Similarly to the base token type, you can construct one by specifying +its arguments, or create one from a pair of alists. +@itemize +@item +@code{#:@var{alg}} or @code{#:@var{signing-key}} is required to +construct the base token; +@item +@code{#:@var{iss}} specifies the issuer. +@end itemize + +The main point of this class is to provide a method for the +@code{lookup-keys} generic. This method accepts one keyword argument, +@code{#:@var{http-request}}, a function that behaves like the web +client in @emph{(web client)}. You can set this value as a keyword +argument in the @code{decode} function. +@end deftp + +@deffn {Generic} iss @var{token} +Return the issuer of @var{token}, as an URI. +@end deffn + +@deftp {Exception type} &cannot-query-identity-provider @var{identity-provider} +This exception is raised when the OIDC discovery +fails. @var{identity-provider} is an URI. +@end deftp + +@deffn {function} make-cannot-query-identity-provider @var{identity-provider} +Construct an exception of type @code{&cannot-query-identity-provider}. +@end deffn + +@deffn {function} cannot-query-identity-provider? @var{exception} +Check whether @var{exception} was raised because an identity provider +could not be queried. +@end deffn + +@deffn {function} cannot-query-identity-provider-value @var{exception} +Return the faulty identity provider for @var{exception}. +@end deffn + +@node Date verification for tokens +@section Date verification for tokens +Different kinds of tokens have a requirement for a limited time window +for which the signature should be valid. + +@deftp {Class} <time-bound-token> (<token>) @var{iat} @var{exp} +The base class for tokens which are issued for a limited time +window. It knows the issuance date (@var{iat}, a date from +@emph{(srfi srfi-19)}), and the expiration date (@var{iat}, a date +from @emph{(srfi srfi-19)}). + +Similarly to the base token type, you can construct one by specifying +its arguments, or create one from a pair of alists. +@itemize +@item +@code{#:@var{alg}} or @code{#:@var{signing-key}} is required to +construct the base token; +@item +@code{#:@var{iat}} specifies the issuance date. It defaults to the +current date; +@item +@code{#:@var{exp}} specifies the expiration date. If it is not set, +the value will be computed from @var{iat} and @var{validity}; +@item +@code{#:@var{validity}} is used when the expiration date is not known +in advance. It is a number of seconds. For a DPoP proof, the value +should be around 30 seconds. For an access token, a good value is in +the ballpark of 3600 seconds (an hour). Defaults to 3600 seconds, but +be aware that for single-use tokens, this value will be ignored and +replaced with a much shorter time. +@end itemize + +The main point of this class is to provide a stricter token validation +function. You can customize the current date by passing +@code{#:@var{current-date} ...} as keyword arguments to +@code{decode}. @code{...} would be replaced with a time or date. +@end deftp + +@deffn {Generic} default-validity @var{token} +Return the default validity as a number of seconds to construct +@var{token}, or @code{#f} if an explicit @code{#:validity} is +required. +@end deffn + +@deffn {Generic} has-explicit-exp? @var{token} +Check whether we should trust the JWT exp field when constructing +@var{token}. DPoP proofs should not be able to fill our cache with +infinitely-valid proofs, so it is disabled for DPoP proofs. +@end deffn + +@deffn {Generic} iat @var{token} +Return the signature date of @var{token}, as a srfi-19 date. +@end deffn + +@deffn {Generic} exp @var{token} +Return the expiration date of @var{token}, as a srfi-19 date. +@end deffn + +@deftp {Exception type} &signed-in-future @var{signature-date} @var{current-date} +@deftpx {Exception type} &expired @var{expiration-date} @var{current-date} +An exception of type @code{&signed-in-future} is raised when the +current date is before the alleged signature date. Since the signing +entity and the verifier entity may not be on the same system, the +clocks may be slightly out of synchronization, so a margin of 5 +seconds is usually accepted. + +An exception of type @code{&expired} indicates that the signature is +no longer valid. +@end deftp + +@deffn {function} make-signed-in-future @var{signature-date} @var{current-date} +@deffnx {function} make-expired @var{expiration-date} @var{current-date} +Constructors for the @code{&signed-in-future} and @code{&expired} +exception types. +@end deffn + +@deffn {function} signed-in-future? @var{exception} +@deffnx {function} expired? @var{exception} +Check whether @var{exception} was raised because of a date mismatch. +@end deffn + +@deffn {function} error-signature-date @var{exception} +@deffnx {function} error-expiration-date @var{exception} +@deffnx {function} error-current-date @var{exception} +If @var{exception} was raised because of a date mismatch, return the +signature, expiration or current date. +@end deffn + +@node Single-use tokens +@section Single-use tokens +To prevent replay attacks, you might want to assign an unique +identifier to each token of some kind. If you have an expiration date, +you could remember that this identifier has been seen, and forget +about it as soon as the token expires. For this to work, you would +need an expiration date for your single-use token: this is why we only +support it for time-bound tokens, and the validity is reduced down to +2 minutes. + +@deftp {Class} <single-use-token> (<time-bound-token>) @var{nonce} +The base class for tokens which are intended to be decoded only +once. The unique identifier string @var{nonce} will be remembered as +long as the program is running and the token is not expired. + +Similarly to the base token type, you can construct one by specifying +its arguments, or create one from a pair of alists. +@itemize +@item +@code{#:@var{alg}} or @code{#:@var{signing-key}} is required to +construct the base token; +@item +@code{#:@var{iat}} and @code{#:@var{exp}} or @code{#:@var{validity}} +is required to construct the time-bound token; +@item +@code{#:@var{nonce}} specifies the unique identifier. It defaults to a +random string of base64 data encoding 96 bits of entropy. +@item +@end itemize + +The main point of this class is to provide an even stricter token +validation function, that can only be run once for a given token (with +reasonable limits: if the program is killed, it won’t remember the +tokens from before). You can customize the current date by passing +@code{#:@var{current-date} ...} as keyword arguments to @code{decode}, +just as you do for regular time-bound tokens. @code{...} would be +replaced with a time or date. +@end deftp + +@deffn {Generic} nonce-field-name @var{token} +When constructing @var{token} from an existing JWT, this method gives +the field name in the JWT payload that represents the nonce. DPoP +proofs use @code{'jti}, so they override this value. +@end deffn + +@deffn {Generic} nonce @var{token} +Return the unique identifier of @var{token}, as a string. +@end deffn + +@deftp {Exception type} &nonce-found @var{nonce} +If a token with the same nonce has already been decoded during its +life time, this exception is raised with the duplicated @var{nonce}. +@end deftp + +@deffn {function} make-nonce-found @var{nonce} +Construct an exception of type @code{&nonce-found}. +@end deffn + +@deffn {function} nonce-found? @var{exception} +Check whether @var{exception} was raised because a single-use token +was already parsed. +@end deffn + +@deffn {function} nonce-found-nonce @var{exception} +Return the faulty nonce in @var{exception}. +@end deffn + +@node ID tokens +@section ID tokens + +The @emph{(webid-oidc oidc-id-token)} module contains a definition for +the OIDC ID token. + +@deftp {Class} <id-token> (<single-use-token> <oidc-token>) @var{webid} @var{sub} @var{aud} +The ID token is issued by an identity provider, and is intended to be +used by the client only. It gives information about the user +identified by a @var{webid}, an URI from @emph{(web uri)}, and the +client ID, @var{aud}, an URI too. Since the client should not +communicate this token, it is reasonable to think that the client will +deccode the token as soon as it gets it, and then forget the now +useless signature. This is why this token is considered +single-use. The @var{sub} field should store a username as a string, +but if it is missing, the webid (as a string) will be used. + +To construct an ID token, you would either need +@code{#:@var{jwt-header}} and @code{#:@var{jwt-payload}}, as for any +token, or a combination of parameters: + +@itemize +@item +@code{#:@var{alg}} or @code{#:@var{signing-key}}, to initialize a JWT; +@item +@code{#:@var{iat}} and @code{#:@var{exp}} or @code{#:@var{validity}}, +because it is issued for a limited time window (around an hour); +@item +@code{#:@var{nonce}} to define its identifier (defaults to a random +one); +@item +@code{#:@var{iss}}, the issuer URI, because it is an OIDC token; +@item +@code{#:@var{webid}}, an URI identifying the user; +@item +@code{#:@var{sub}}, a string that defaults to the webid; +@item +@code{#:@var{aud}}, an URI identifying the application. +@end itemize +@end deftp + +@deffn {Generic} webid @var{token} +Return the user identifier in @var{token}, as an URI. +@end deffn + +@deffn {Generic} sub @var{token} +Return the username in @var{token}, as a string. +@end deffn + +@deffn {Generic} aud @var{token} +Return the client identifier in @var{token}, as an URI. +@end deffn + +@deftp {Exception type} &invalid-id-token +This exception is raised when the ID token is invalid. +@end deftp + +@deffn {function} make-invalid-id-token +Construct an exception of type @code{&invalid-id-token}. +@end deffn + +@deffn {function} invalid-id-token? @var{exception} +Check whether @var{exception} was raised because of an invalid ID +token. +@end deffn + +@node Access tokens +@section Access tokens + +The @emph{(webid-oidc access-token)} module contains a definition for +the OIDC access token. + +@deftp {Class} <access-token> (<time-bound-token> <oidc-token>) @var{webid} @var{aud} @var{client-id} @var{cnf/jkt} +The access token is issued by an identity provider for a client, and +is intended to be used by the resource servers. It indicates that the +agent possessing a key hashed to @var{cnf/jkt} (a string) is +identified by @var{client-id} (an URI) and is authorized to act on +behalf of the user identified by @var{webid} (an URI). For +compatibility, @var{aud} should be set to the literal string +@code{"solid"}. The agent demonstrates that it owns this key by +issuing a DPoP proof alongside the access token. + +To construct an access token, you would either need +@code{#:@var{jwt-header}} and @code{#:@var{jwt-payload}}, as for any +token, or a combination of parameters: + +@itemize +@item +@code{#:@var{alg}} or @code{#:@var{signing-key}}, to initialize a JWT; +@item +@code{#:@var{iat}} and @code{#:@var{exp}} or @code{#:@var{validity}}, +because it is issued for a limited time window (around an hour); +@item +@code{#:@var{iss}}, the issuer URI, because it is an OIDC token; +@item +@code{#:@var{webid}}, an URI identifying the user; +@item +@code{#:@var{client-id}}, an URI identifying the client; +@item +@code{#:@var{cnf/jkt}}, the hash of a public key whose private key is +owned by the client, or @code{#:@var{client-key}}, the client key +itself; +@item +@code{#:@var{aud}}, literally @code{"solid"}, +optional, defaults to the correct value. +@end itemize + +Since the same access token is presented on each request, it is not +single-use. +@end deftp + +@deffn {Generic} webid @var{token} +Return the user identifier in @var{token}, as an URI. +@end deffn + +@deffn {Generic} client-id @var{token} +Return the client identifier in @var{token}, as an URI. +@end deffn + +@deffn {Generic} cnf/jkt @var{token} +Return the hash of the client key, as a string. +@end deffn + +@deffn {Generic} aud @var{token} +Return @code{"solid"}. +@end deffn + +@deftp {Exception type} &invalid-access-token +This exception is raised when the access token is invalid. +@end deftp + +@deffn {function} make-invalid-access-token +Construct an exception of type @code{&invalid-access-token}. +@end deffn + +@deffn {function} invalid-access-token? @var{exception} +Check whether @var{exception} was raised because of an invalid access +token. +@end deffn + +@node DPoP proofs +@section DPoP proofs + +The @emph{(webid-oidc dpop-proof)} module contains a definition for +the DPoP proof token. + +@deftp {Class} <dpop-proof> (<single-use-token>) @var{typ} @var{jwk} @var{htm} @var{htu} @var{ath} +The DPoP proof is a token that is issued by the client, and presented +to the resource server along with an access token. It is only valid +for one request, and for one use. So, it should have a very short +validity frame, for instance 30 seconds, and should only be valid for +a specific request method @var{htm} and a specific request URI +@var{htu}, down to the path, but ignoring the query and fragment. + +The DPoP proof is the proof of possession of @var{jwk}, a public +key. It should always have a @var{typ} field set to @code{"dpop+jwt"}. + +To construct a DPoP proof, you would either need +@code{#:@var{jwt-header}} and @code{#:@var{jwt-payload}}, as for any +token, or a combination of parameters: + +@itemize +@item +@code{#:@var{alg}} or @code{#:@var{signing-key}}, to initialize a JWT; +@item +@code{#:@var{iat}} and @code{#:@var{exp}} or @code{#:@var{validity}}, +because it is issued for a limited time window (around 30 seconds); +@item +@code{#:@var{nonce}}, because it is single-use; +@item +@code{#:@var{jwk}}, the public key whose possession we demonstrate by +signing the proof; +@item +@code{#:@var{htm}}, the HTTP method used (as a symbol); +@item +@code{#:@var{htu}}, the HTTP URI used (as an URI); +@item +@code{#:@var{ath}}, the hash of the access token that goes with this +proof, or @code{#:@var{access-token}}, the encoded access token +itself, if the proof goes with an access token. Otherwise, pass +@code{#f}. Defaults to @code{#f}; +@item +@code{#:@var{typ}}, literally @code{"dpop+jwt"}, +optional, defaults to the correct value. +@end itemize + +This token class makes a stricter verification function. It requires +you to set as a keyword argument in @code{decode} the following +parameters: + +@table @code +@item #:@var{access-token} +set the access token that should go with the proof, defaults to +@code{#f} (no access token); +@item #:@var{method} +set the method used for the proof; +@item #:@var{uri} +set the URI used for the proof; +@item #:@var{cnf/check} +set the expected hash of the key used by the DPoP proof, or a function +taking a public key hash. If this is a function, it should raise an +exception if the hash is invalid, because its return value is ignored. +@end table +@end deftp + +@deffn {Generic} jwk @var{proof} +Return the public key whose possession @var{proof} demonstrates. +@end deffn + +@deffn {Generic} htm @var{proof} +Return the HTTP method in @var{proof}, as a symbol. +@end deffn + +@deffn {Generic} htu @var{proof} +Return the HTTP URI in @var{proof}, as an URI. +@end deffn + +@deffn {Generic} ath @var{proof} +Return the hash of the access token that should go with @var{proof}, +or @code{#f} if @var{proof} is not used with an access token. +@end deffn + +@deffn {Generic} typ @var{proof} +Return @code{"dpop+jwt"}. +@end deffn + +@deftp {Exception type} &invalid-dpop-proof +This exception is raised when the DPoP proof is invalid. +@end deftp + +@deffn {function} make-invalid-dpop-proof +Construct an exception of type @code{&invalid-dpop-proof}. +@end deffn + +@deffn {function} invalid-dpop-proof? @var{exception} +Check whether @var{exception} was raised because of an invalid DPoP +proof. +@end deffn + +@deftp {Exception type} &dpop-method-mismatch @var{advertised} @var{actual} +This exception is raised when the @var{advertised} method is not what +is @var{actual}ly used in the request (both symbols). +@end deftp + +@deffn {function} make-dpop-method-mismatch @var{advertised} @var{actual} +Construct an exception of type @code{&dpop-method-mismatch}. +@end deffn + +@deffn {function} dpop-method-mismatch? @var{exception} +Check whether @var{exception} was raised because of a difference +between the advertised and actual HTTP methods used. +@end deffn + +@deffn {function} dpop-method-mismatch-advertised @var{exception} +In case of a DPoP method mismatch causing @var{exception}, return the +method used in the proof signature. +@end deffn + +@deffn {function} dpop-method-mismatch-actual @var{exception} +In case of a DPoP method mismatch causing @var{exception}, return the +method that the server received. +@end deffn + +@deftp {Exception type} &dpop-uri-mismatch @var{advertised} @var{actual} +This exception is raised when the @var{advertised} URI is not what is +@var{actual}ly used in the request (both URIs). +@end deftp + +@deffn {function} make-dpop-uri-mismatch @var{advertised} @var{actual} +Construct an exception of type @code{&dpop-uri-mismatch}. +@end deffn + +@deffn {function} dpop-uri-mismatch? @var{exception} +Check whether @var{exception} was raised because of a difference +between the advertised and actual HTTP URIs used. +@end deffn + +@deffn {function} dpop-uri-mismatch-advertised @var{exception} +In case of a DPoP URI mismatch causing @var{exception}, return the +URI used in the proof signature. +@end deffn + +@deffn {function} dpop-uri-mismatch-actual @var{exception} +In case of a DPoP URI mismatch causing @var{exception}, return the URI +that the server received. +@end deffn + +@deftp {Exception type} &dpop-invalid-ath @var{hash} @var{access-token} +This exception is raised when the DPoP proof is intended for use along +with an access token identified by @var{hash}, but is actually used +along with @var{access-token}. +@end deftp + +@deffn {function} make-dpop-invalid-ath @var{hash} @var{access-token} +Construct an exception of type @code{&dpop-invalid-ath}. +@end deffn + +@deffn {function} dpop-invalid-ath? @var{exception} +Check whether @var{exception} was raised because the DPoP proof was +not used with the correct access token. +@end deffn + +@deffn {function} dpop-invalid-ath-hash @var{exception} +In case of a DPoP presented with the wrong access token, causing +@var{exception}, return the hash of the intended access token. +@end deffn + +@deffn {function} dpop-invalid-ath-access-token @var{exception} +In case of a DPoP presented with the wrong access token, causing +@var{exception}, return the actual access token. +@end deffn + +@deftp {Exception type} &dpop-unconfirmed-key +This exception is raised when the DPoP proof does not demonstrate the +possession of the correct key. +@end deftp + +@deffn {function} make-dpop-unconfirmed-key +Construct an exception of type @code{&dpop-unconfirmed-key}. +@end deffn + +@deffn {function} dpop-unconfirmed-key? @var{exception} +Check whether @var{exception} was raised because the DPoP proof +demonstrated the possession of an incorrect key. +@end deffn + +@node Authorization codes +@section Authorization codes +@emph{(webid-oidc authorization-code)} defines an authorization code +type. + +@deftp {Class} <authorization-code> (<single-use-token>) @var{webid} @var{client-id} +While it is not necessary that an authorization code is a JWT, it is +easier to implement that way. It is an authorization for +@var{client-id}, an URI identifying a client, to access the data of +the user identified by @var{webid}, an URI too. It should only be +valid for a limited amount of time, and used once only. + + +The DPoP proof is a token that is issued by the client, and presented +to the resource server along with an access token. It is only valid +for one request, and for one use. So, it should have a very short +validity frame, for instance 30 seconds, and should only be valid for +a specific request method @var{htm} and a specific request URI +@var{htu}, down to the path, but ignoring the query and fragment. + +The DPoP proof is the proof of possession of @var{jwk}, a public +key. It should always have a @var{typ} field set to @code{"dpop+jwt"}. + +To construct an authorization code, you would either need +@code{#:@var{jwt-header}} and @code{#:@var{jwt-payload}}, as for any +token, or a combination of parameters: + +@itemize +@item +@code{#:@var{alg}} or @code{#:@var{signing-key}}, to initialize a JWT; +@item +@code{#:@var{iat}} and @code{#:@var{exp}} or @code{#:@var{validity}}, +because it is issued for a limited time window (around 30 seconds); +@item +@code{#:@var{nonce}}, because it is single-use; +@item +@code{#:@var{webid}}, the user identifier; +@item +@code{#:@var{client-id}}, the client identifier. +@end itemize + +The authorization code is signed and verified by the same entity. So, +the key lookup function is tuned to always return the issuer key. You +need to set it as the @code{#:@var{issuer-key}} keyword argument of +the @code{decode} function. +@end deftp + +@deffn {Generic} webid @var{token} +Return the user identifier in @var{token}, as an URI. +@end deffn + +@deffn {Generic} client-id @var{token} +Return the client identifier in @var{token}, as an URI. +@end deffn + +@deftp {Exception type} &invalid-authorization-code +This exception is raised when the authorization ccode is invalid. +@end deftp + +@deffn {function} make-invalid-authorization-code +Construct an exception of type @code{&invalid-authorization-code}. +@end deffn + +@deffn {function} invalid-authorization-code? @var{exception} +Check whether @var{exception} was raised because of an invalid +authorization code. +@end deffn + @node Caching on server side @chapter Caching on server side diff --git a/po/disfluid.pot b/po/disfluid.pot index 6f2cad2..67b4c36 100644 --- a/po/disfluid.pot +++ b/po/disfluid.pot @@ -8,7 +8,7 @@ msgid "" msgstr "" "Project-Id-Version: disfluid SNAPSHOT\n" "Report-Msgid-Bugs-To: vivien@planete-kraus.eu\n" -"POT-Creation-Date: 2021-09-17 23:19+0200\n" +"POT-Creation-Date: 2021-09-21 22:28+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,183 +122,66 @@ msgid "" "webid_oidc_random_init first.\n" msgstr "" -#: src/scm/webid-oidc/access-token.scm:72 +#: src/scm/webid-oidc/access-token.scm:73 #, scheme-format -msgid "this is not an access token, because it is not even a JWS: ~a" +msgid "invalid access token: ~a" msgstr "" -#: src/scm/webid-oidc/access-token.scm:74 -msgid "this is not an access token, because it is not even a JWS" +#: src/scm/webid-oidc/access-token.scm:75 +msgid "invalid access token" msgstr "" -#: src/scm/webid-oidc/access-token.scm:77 src/scm/webid-oidc/dpop-proof.scm:101 -#, scheme-format -msgid "this is not an access token: ~a" -msgstr "" - -#: src/scm/webid-oidc/access-token.scm:79 src/scm/webid-oidc/dpop-proof.scm:103 -msgid "this is not an access token" -msgstr "" - -#: src/scm/webid-oidc/access-token.scm:101 -#: src/scm/webid-oidc/authorization-code.scm:89 -#: src/scm/webid-oidc/oidc-id-token.scm:97 -#, scheme-format -msgid "the payload is missing ~s" +#: src/scm/webid-oidc/access-token.scm:117 +#: src/scm/webid-oidc/authorization-code.scm:93 +#: src/scm/webid-oidc/oidc-id-token.scm:100 +msgid "#:webid should be an URI" msgstr "" -#: src/scm/webid-oidc/access-token.scm:123 -#: src/scm/webid-oidc/authorization-code.scm:105 -#: src/scm/webid-oidc/oidc-id-token.scm:118 -#, scheme-format -msgid "the \"webid\" field should be an URI, ~s is given" -msgstr "" - -#: src/scm/webid-oidc/access-token.scm:130 -#: src/scm/webid-oidc/oidc-id-token.scm:125 -#, scheme-format -msgid "the \"iss\" field should be an URI, ~s is given" +#: src/scm/webid-oidc/access-token.scm:122 +msgid "#:client-id should be an URI" msgstr "" -#: src/scm/webid-oidc/access-token.scm:135 -#, scheme-format -msgid "the \"aud\" field should be set to \"solid\", ~s is given" +#: src/scm/webid-oidc/access-token.scm:127 +msgid "#:cnf/jkt should be a string" msgstr "" -#: src/scm/webid-oidc/access-token.scm:142 -#: src/scm/webid-oidc/oidc-id-token.scm:153 -#, scheme-format -msgid "the \"iat\" field should be a timestamp, ~s is given" -msgstr "" - -#: src/scm/webid-oidc/access-token.scm:149 -#: src/scm/webid-oidc/authorization-code.scm:126 -#: src/scm/webid-oidc/oidc-id-token.scm:160 -#, scheme-format -msgid "the \"exp\" field should be a timestamp, ~s is given" -msgstr "" - -#: src/scm/webid-oidc/access-token.scm:158 -msgid "the \"cnf\" / \"jkt\" field is missing" -msgstr "" - -#: src/scm/webid-oidc/access-token.scm:166 -#, scheme-format -msgid "the \"cnf\" / \"jkt\" field should be a string, ~s is given" -msgstr "" - -#: src/scm/webid-oidc/access-token.scm:171 -#, scheme-format -msgid "the \"cnf\" field should be an object, ~s is given" +#: src/scm/webid-oidc/access-token.scm:132 +msgid "#:aud should be exactly \"solid\"" msgstr "" -#: src/scm/webid-oidc/access-token.scm:178 -#: src/scm/webid-oidc/authorization-code.scm:112 -#, scheme-format -msgid "the \"client_id\" field should be an URI, ~s is given" -msgstr "" - -#: src/scm/webid-oidc/access-token.scm:239 -#, scheme-format -msgid "the access token is invalid: ~a" -msgstr "" - -#: src/scm/webid-oidc/access-token.scm:241 -msgid "the access token is invalid" -msgstr "" - -#: src/scm/webid-oidc/access-token.scm:257 -#: src/scm/webid-oidc/oidc-id-token.scm:237 -#, scheme-format -msgid "I cannot query the identity provider configuration: ~a" -msgstr "" - -#: src/scm/webid-oidc/access-token.scm:259 -#: src/scm/webid-oidc/oidc-id-token.scm:239 -msgid "I cannot query the identity provider configuratioon" -msgstr "" - -#: src/scm/webid-oidc/access-token.scm:276 -#, scheme-format -msgid "I cannot query the identity provider public keys: ~a" -msgstr "" - -#: src/scm/webid-oidc/access-token.scm:278 -msgid "I cannot query the identity provider public keys" -msgstr "" - -#: src/scm/webid-oidc/access-token.scm:294 -#, scheme-format -msgid "the access token is signed in the future, ~a, relative to current ~a" -msgstr "" - -#: src/scm/webid-oidc/access-token.scm:303 -#, scheme-format -msgid "the access token expired ~a, which is in the past (from ~a)" -msgstr "" - -#: src/scm/webid-oidc/access-token.scm:317 -#, scheme-format -msgid "cannot encode the access token: ~a" -msgstr "" - -#: src/scm/webid-oidc/access-token.scm:319 -msgid "cannot encode the access token" -msgstr "" - -#: src/scm/webid-oidc/authorization-code.scm:64 -#, scheme-format -msgid "this is not an authorization code, because it is not even a JWS: ~a" -msgstr "" - -#: src/scm/webid-oidc/authorization-code.scm:66 -msgid "this is not an authorization code, because it is not even a JWS" +#: src/scm/webid-oidc/access-token.scm:150 +msgid "" +"when making an access token either its required fields (#:alg, #:webid, #:" +"iss, #:aud, #:client-id, #:cnf/jkt, #:iat and #:exp) or (#:jwt-header and #:" +"jwt-payload) should be passed" msgstr "" #: src/scm/webid-oidc/authorization-code.scm:69 #, scheme-format -msgid "this is not an authorization code: ~a" +msgid "invalid authorization code: ~a" msgstr "" #: src/scm/webid-oidc/authorization-code.scm:71 -msgid "this is not an authorization code" -msgstr "" - -#: src/scm/webid-oidc/authorization-code.scm:119 -#, scheme-format -msgid "the \"jti\" field should be a string, ~s is given" -msgstr "" - -#: src/scm/webid-oidc/authorization-code.scm:171 -#, scheme-format -msgid "the authorization code is invalid: ~a" -msgstr "" - -#: src/scm/webid-oidc/authorization-code.scm:173 -msgid "the authorization code is invalid" -msgstr "" - -#: src/scm/webid-oidc/authorization-code.scm:187 -#, scheme-format -msgid "the authorization expired ~a, which is in the past (from ~a)" +msgid "invalid authorization code" msgstr "" -#: src/scm/webid-oidc/authorization-code.scm:203 -#, scheme-format -msgid "cannot encode the authorization code: ~a" +#: src/scm/webid-oidc/authorization-code.scm:98 +msgid "#:client-id should be a string" msgstr "" -#: src/scm/webid-oidc/authorization-code.scm:205 -msgid "cannot encode the authorization code" +#: src/scm/webid-oidc/authorization-code.scm:112 +msgid "" +"when making an authorization code either its required fields (#:webid and #:" +"client-id) or (#:jwt-header and #:jwt-payload) should be passed" msgstr "" #: src/scm/webid-oidc/authorization-page-unsafe.scm:52 #: src/scm/webid-oidc/hello-world.scm:40 src/scm/webid-oidc/hello-world.scm:167 #: src/scm/webid-oidc/hello-world.scm:187 #: src/scm/webid-oidc/identity-provider.scm:139 -#: src/scm/webid-oidc/token-endpoint.scm:111 -#: src/scm/webid-oidc/token-endpoint.scm:137 -#: src/scm/webid-oidc/token-endpoint.scm:164 +#: src/scm/webid-oidc/token-endpoint.scm:113 +#: src/scm/webid-oidc/token-endpoint.scm:139 +#: src/scm/webid-oidc/token-endpoint.scm:166 msgid "xml-lang|en" msgstr "" @@ -332,8 +215,8 @@ msgid "Allow" msgstr "" #: src/scm/webid-oidc/authorization-page-unsafe.scm:95 -#: src/scm/webid-oidc/token-endpoint.scm:129 -#: src/scm/webid-oidc/token-endpoint.scm:156 +#: src/scm/webid-oidc/token-endpoint.scm:131 +#: src/scm/webid-oidc/token-endpoint.scm:158 msgid "reason-phrase|Bad Request" msgstr "" @@ -358,7 +241,7 @@ msgid "The application you are trying to authorize behaved unexpectedly." msgstr "" #: src/scm/webid-oidc/authorization-page-unsafe.scm:126 -#: src/scm/webid-oidc/resource-server.scm:299 +#: src/scm/webid-oidc/resource-server.scm:311 msgid "reason-phrase|Found" msgstr "" @@ -477,78 +360,78 @@ msgstr "" msgid "the client manifest is dereferenced from ~s, but it pretends to be ~s" msgstr "" -#: src/scm/webid-oidc/client/accounts.scm:282 +#: src/scm/webid-oidc/client/accounts.scm:285 msgid "The refresh token has expired." msgstr "" -#: src/scm/webid-oidc/client/accounts.scm:289 +#: src/scm/webid-oidc/client/accounts.scm:292 #, scheme-format msgid "The token request failed with code ~s (~s)." msgstr "" -#: src/scm/webid-oidc/client/accounts.scm:298 +#: src/scm/webid-oidc/client/accounts.scm:301 msgid "The token response did not set the content type." msgstr "" -#: src/scm/webid-oidc/client/accounts.scm:306 +#: src/scm/webid-oidc/client/accounts.scm:309 msgid "The token endpoint did not respond in UTF-8." msgstr "" -#: src/scm/webid-oidc/client/accounts.scm:318 +#: src/scm/webid-oidc/client/accounts.scm:321 #, scheme-format msgid "The token response has content-type ~s, not application/json." msgstr "" -#: src/scm/webid-oidc/client/accounts.scm:328 +#: src/scm/webid-oidc/client/accounts.scm:331 msgid "The token response is not valid JSON." msgstr "" -#: src/scm/webid-oidc/client/accounts.scm:342 +#: src/scm/webid-oidc/client/accounts.scm:345 #, scheme-format msgid "The token response did not include an ID token: ~s" msgstr "" -#: src/scm/webid-oidc/client/accounts.scm:350 +#: src/scm/webid-oidc/client/accounts.scm:353 #, scheme-format msgid "The token response did not include an access token: ~s\n" msgstr "" -#: src/scm/webid-oidc/client/accounts.scm:361 +#: src/scm/webid-oidc/client/accounts.scm:364 #, scheme-format msgid "the ID token signature is invalid: ~a" msgstr "" -#: src/scm/webid-oidc/client/accounts.scm:363 +#: src/scm/webid-oidc/client/accounts.scm:366 msgid "the ID token signature is invalid" msgstr "" -#: src/scm/webid-oidc/client/accounts.scm:381 +#: src/scm/webid-oidc/client/accounts.scm:383 #, scheme-format msgid "the ID token delivered by the identity provider for ~s has ~s as webid" msgstr "" -#: src/scm/webid-oidc/client/accounts.scm:391 +#: src/scm/webid-oidc/client/accounts.scm:393 #, scheme-format msgid "The ID token delivered by the identity provider ~s is for issuer ~s." msgstr "" -#: src/scm/webid-oidc/client/accounts.scm:406 +#: src/scm/webid-oidc/client/accounts.scm:408 msgid "The issuer is required." msgstr "" -#: src/scm/webid-oidc/client/accounts.scm:411 +#: src/scm/webid-oidc/client/accounts.scm:413 msgid "The optional subject and required issuer should be strings or URI." msgstr "" -#: src/scm/webid-oidc/client/accounts.scm:447 +#: src/scm/webid-oidc/client/accounts.scm:449 msgid "Cannot check the username and/or password." msgstr "" -#: src/scm/webid-oidc/client/accounts.scm:457 +#: src/scm/webid-oidc/client/accounts.scm:459 msgid "The subject should be a string or URI." msgstr "" -#: src/scm/webid-oidc/client/accounts.scm:471 +#: src/scm/webid-oidc/client/accounts.scm:473 msgid "The issuer should be a string or URI." msgstr "" @@ -582,217 +465,161 @@ msgstr "" msgid "Hello, world!" msgstr "" -#: src/scm/webid-oidc/dpop-proof.scm:96 -#, scheme-format -msgid "this is not a DPoP proof, because it is not even a JWS: ~a" -msgstr "" - -#: src/scm/webid-oidc/dpop-proof.scm:98 -msgid "this is not a DPoP proof, because it is not even a JWS" -msgstr "" - -#: src/scm/webid-oidc/dpop-proof.scm:129 -#, scheme-format -msgid "the DPoP proof is missing ~s" -msgstr "" - -#: src/scm/webid-oidc/dpop-proof.scm:152 -#, scheme-format -msgid "the \"jti\" field should be a string, not ~s" -msgstr "" - -#: src/scm/webid-oidc/dpop-proof.scm:159 +#: src/scm/webid-oidc/dpop-proof.scm:110 #, scheme-format -msgid "the \"htm\" field should be a string, not ~s" -msgstr "" - -#: src/scm/webid-oidc/dpop-proof.scm:166 -#, scheme-format -msgid "the \"htu\" field should be an URI, not ~s" +msgid "the DPoP proof is signed for ~s, but it is issued to ~s" msgstr "" -#: src/scm/webid-oidc/dpop-proof.scm:173 +#: src/scm/webid-oidc/dpop-proof.scm:155 #, scheme-format -msgid "the \"iat\" field should be a timestamp, not ~s" +msgid "invalid DPoP proof: ~a" msgstr "" -#: src/scm/webid-oidc/dpop-proof.scm:180 -#, scheme-format -msgid "the \"ath\" field should be an encoded JWT, not ~s" +#: src/scm/webid-oidc/dpop-proof.scm:157 +msgid "invalid DPoP proof token" msgstr "" #: src/scm/webid-oidc/dpop-proof.scm:189 -#, scheme-format -msgid "the \"alg\" field should be a string, not ~s" +msgid "#:typ should be exactly \"dpop+jwt\"" msgstr "" #: src/scm/webid-oidc/dpop-proof.scm:194 -#, scheme-format -msgid "the \"typ\" field should be \"dpop+jwt\", not ~s" -msgstr "" - -#: src/scm/webid-oidc/dpop-proof.scm:200 -msgid "the \"jwk\" field should not contain the private key" -msgstr "" - -#: src/scm/webid-oidc/dpop-proof.scm:202 -#, scheme-format -msgid "the \"jwk\" field should be a valid public key, not ~s" +msgid "#:jwk should be a public key" msgstr "" -#: src/scm/webid-oidc/dpop-proof.scm:281 -#, scheme-format -msgid "the DPoP proof is signed for ~s, but it is issued to ~s" -msgstr "" - -#: src/scm/webid-oidc/dpop-proof.scm:312 -#, scheme-format -msgid "the DPoP proof cannot be decoded: ~a" +#: src/scm/webid-oidc/dpop-proof.scm:199 +msgid "#:htm should be a symbol" msgstr "" -#: src/scm/webid-oidc/dpop-proof.scm:314 -msgid "the DPoP proof cannot be decoded" +#: src/scm/webid-oidc/dpop-proof.scm:205 +msgid "when present, #:ath should be a string" msgstr "" -#: src/scm/webid-oidc/dpop-proof.scm:324 -#, scheme-format -msgid "the DPoP proof is signed for access through ~s, but it is used with ~s" -msgstr "" - -#: src/scm/webid-oidc/dpop-proof.scm:338 -#, scheme-format +#: src/scm/webid-oidc/dpop-proof.scm:226 msgid "" -"the DPoP proof is signed in the future, ~a, relative to the current date, ~a" +"when making a DPoP proof, either its required fields (#:typ, #:jwk, #:htm " +"and #:htu) or (#:jwt-header and #:jwt-payload) should be passed" msgstr "" -#: src/scm/webid-oidc/dpop-proof.scm:347 +#: src/scm/webid-oidc/dpop-proof.scm:259 #, scheme-format -msgid "the DPoP proof is too old, it was signed ~a and now it is ~a" +msgid "the DPoP proof is signed for access through ~s, but it is used with ~s" msgstr "" -#: src/scm/webid-oidc/dpop-proof.scm:359 +#: src/scm/webid-oidc/dpop-proof.scm:269 #, scheme-format msgid "" "the DPoP proof should go along with an access token hashed to ~s, not ~s" msgstr "" -#: src/scm/webid-oidc/dpop-proof.scm:368 src/scm/webid-oidc/dpop-proof.scm:379 +#: src/scm/webid-oidc/dpop-proof.scm:277 src/scm/webid-oidc/dpop-proof.scm:284 msgid "the DPoP proof is signed with the wrong key" msgstr "" -#: src/scm/webid-oidc/dpop-proof.scm:377 +#: src/scm/webid-oidc/dpop-proof.scm:282 #, scheme-format msgid "the DPoP proof is signed with the wrong key: ~a" msgstr "" -#: src/scm/webid-oidc/dpop-proof.scm:388 +#: src/scm/webid-oidc/dpop-proof.scm:293 msgid "the cnf/check function returned #f" msgstr "" -#: src/scm/webid-oidc/dpop-proof.scm:399 -#, scheme-format -msgid "cannot encode a DPoP proof: ~a" -msgstr "" - -#: src/scm/webid-oidc/dpop-proof.scm:401 -msgid "cannot encode a DPoP proof" -msgstr "" - -#: src/scm/webid-oidc/example-app.scm:97 +#: src/scm/webid-oidc/example-app.scm:96 #, scheme-format msgid "~a (issued by ~a): no interaction required" msgstr "" -#: src/scm/webid-oidc/example-app.scm:100 +#: src/scm/webid-oidc/example-app.scm:99 #, scheme-format msgid "~a (issued by ~a): offline but accessible" msgstr "" -#: src/scm/webid-oidc/example-app.scm:103 +#: src/scm/webid-oidc/example-app.scm:102 #, scheme-format msgid "~a (issued by ~a): online" msgstr "" -#: src/scm/webid-oidc/example-app.scm:106 +#: src/scm/webid-oidc/example-app.scm:105 #, scheme-format msgid "~a (issued by ~a): inaccessible" msgstr "" -#: src/scm/webid-oidc/example-app.scm:119 +#: src/scm/webid-oidc/example-app.scm:118 #, scheme-format msgid "Your choice ~a does not exist.\n" msgstr "" -#: src/scm/webid-oidc/example-app.scm:137 +#: src/scm/webid-oidc/example-app.scm:136 msgid "Your choice is not a valid URI.\n" msgstr "" -#: src/scm/webid-oidc/example-app.scm:146 +#: src/scm/webid-oidc/example-app.scm:145 msgid "This is not a valid HTTP method.\n" msgstr "" -#: src/scm/webid-oidc/example-app.scm:162 +#: src/scm/webid-oidc/example-app.scm:161 msgid "This is not a valid value for this header.\n" msgstr "" -#: src/scm/webid-oidc/example-app.scm:200 +#: src/scm/webid-oidc/example-app.scm:199 msgid "Nothing to undo.\n" msgstr "" -#: src/scm/webid-oidc/example-app.scm:212 +#: src/scm/webid-oidc/example-app.scm:211 msgid "Nothing to redo.\n" msgstr "" -#: src/scm/webid-oidc/example-app.scm:272 +#: src/scm/webid-oidc/example-app.scm:271 msgid "Example app command|add-account" msgstr "" -#: src/scm/webid-oidc/example-app.scm:274 +#: src/scm/webid-oidc/example-app.scm:273 msgid "Example app command|choose-account" msgstr "" -#: src/scm/webid-oidc/example-app.scm:276 +#: src/scm/webid-oidc/example-app.scm:275 msgid "Example app command|set-uri" msgstr "" -#: src/scm/webid-oidc/example-app.scm:278 +#: src/scm/webid-oidc/example-app.scm:277 msgid "Example app command|set-method" msgstr "" -#: src/scm/webid-oidc/example-app.scm:280 +#: src/scm/webid-oidc/example-app.scm:279 msgid "Example app command|view-headers" msgstr "" -#: src/scm/webid-oidc/example-app.scm:282 +#: src/scm/webid-oidc/example-app.scm:281 msgid "Example app command|clear-headers" msgstr "" -#: src/scm/webid-oidc/example-app.scm:284 +#: src/scm/webid-oidc/example-app.scm:283 msgid "Example app command|add-header" msgstr "" -#: src/scm/webid-oidc/example-app.scm:286 +#: src/scm/webid-oidc/example-app.scm:285 msgid "Example app command|ok" msgstr "" -#: src/scm/webid-oidc/example-app.scm:288 +#: src/scm/webid-oidc/example-app.scm:287 msgid "Example app command|undo" msgstr "" -#: src/scm/webid-oidc/example-app.scm:290 +#: src/scm/webid-oidc/example-app.scm:289 msgid "Example app command|redo" msgstr "" -#: src/scm/webid-oidc/example-app.scm:300 +#: src/scm/webid-oidc/example-app.scm:299 #, scheme-format msgid "To log in on ~a, please visit: ~a\n" msgstr "" -#: src/scm/webid-oidc/example-app.scm:303 +#: src/scm/webid-oidc/example-app.scm:302 msgid "Then, paste the authorization code you get:\n" msgstr "" -#: src/scm/webid-oidc/example-app.scm:321 +#: src/scm/webid-oidc/example-app.scm:320 #, scheme-format msgid "" "Account: ~a\n" @@ -812,87 +639,87 @@ msgid "" "\n" msgstr "" -#: src/scm/webid-oidc/example-app.scm:340 +#: src/scm/webid-oidc/example-app.scm:339 msgid "Account:|unset" msgstr "" -#: src/scm/webid-oidc/example-app.scm:344 +#: src/scm/webid-oidc/example-app.scm:343 msgid "URI:|unset" msgstr "" -#: src/scm/webid-oidc/example-app.scm:348 +#: src/scm/webid-oidc/example-app.scm:347 msgid "Method:|unset" msgstr "" -#: src/scm/webid-oidc/example-app.scm:351 +#: src/scm/webid-oidc/example-app.scm:350 msgid "Headers:|none" msgstr "" -#: src/scm/webid-oidc/example-app.scm:355 +#: src/scm/webid-oidc/example-app.scm:354 msgid "list separator|, " msgstr "" -#: src/scm/webid-oidc/example-app.scm:365 +#: src/scm/webid-oidc/example-app.scm:364 #, scheme-format msgid "You can undo your last command with \"~a\".\n" msgstr "" -#: src/scm/webid-oidc/example-app.scm:367 +#: src/scm/webid-oidc/example-app.scm:366 #, scheme-format msgid "You can re-apply your last undone command with \"~a\".\n" msgstr "" -#: src/scm/webid-oidc/example-app.scm:368 +#: src/scm/webid-oidc/example-app.scm:367 msgid "Readline prompt|Command: " msgstr "" -#: src/scm/webid-oidc/example-app.scm:375 +#: src/scm/webid-oidc/example-app.scm:374 #, scheme-format msgid "An error happened: ~a.\n" msgstr "" -#: src/scm/webid-oidc/example-app.scm:387 +#: src/scm/webid-oidc/example-app.scm:386 msgid "Please enter your identity provider: " msgstr "" -#: src/scm/webid-oidc/example-app.scm:393 +#: src/scm/webid-oidc/example-app.scm:392 msgid "" "You don’t have other accounts available. Please add one with \"add-account" "\".\n" msgstr "" -#: src/scm/webid-oidc/example-app.scm:399 +#: src/scm/webid-oidc/example-app.scm:398 #, scheme-format msgid "- ~a: ~a\n" msgstr "" -#: src/scm/webid-oidc/example-app.scm:407 +#: src/scm/webid-oidc/example-app.scm:406 #, scheme-format msgid "[1-~a] " msgstr "" -#: src/scm/webid-oidc/example-app.scm:415 +#: src/scm/webid-oidc/example-app.scm:414 msgid "Visit this URI: " msgstr "" -#: src/scm/webid-oidc/example-app.scm:421 +#: src/scm/webid-oidc/example-app.scm:420 msgid "Use this HTTP method [GET]: " msgstr "" -#: src/scm/webid-oidc/example-app.scm:437 +#: src/scm/webid-oidc/example-app.scm:436 msgid "Which header? " msgstr "" -#: src/scm/webid-oidc/example-app.scm:440 +#: src/scm/webid-oidc/example-app.scm:439 #, scheme-format msgid "Which header value for ~a? " msgstr "" -#: src/scm/webid-oidc/example-app.scm:463 +#: src/scm/webid-oidc/example-app.scm:462 msgid "Please define an account and the URI.\n" msgstr "" -#: src/scm/webid-oidc/example-app.scm:470 +#: src/scm/webid-oidc/example-app.scm:469 msgid "I don’t know that command.\n" msgstr "" @@ -1002,7 +829,7 @@ msgid "The port should be a number between 0 and 65535.\n" msgstr "" #: src/scm/webid-oidc/hello-world.scm:159 -#: src/scm/webid-oidc/resource-server.scm:320 +#: src/scm/webid-oidc/resource-server.scm:332 msgid "reason-phrase|Unauthorized" msgstr "" @@ -1015,7 +842,7 @@ msgid "<p>This page requires authentication with Solid.</p>" msgstr "" #: src/scm/webid-oidc/hello-world.scm:179 -#: src/scm/webid-oidc/resource-server.scm:328 +#: src/scm/webid-oidc/resource-server.scm:340 msgid "reason-phrase|Method Not Allowed" msgstr "" @@ -1097,84 +924,123 @@ msgstr "" msgid "invalid content-type: ~s" msgstr "" -#: src/scm/webid-oidc/jws.scm:73 +#: src/scm/webid-oidc/jws.scm:127 #, scheme-format -msgid "the JWS is invalid: ~a" +msgid "unsupported JWS algorithm: ~s" msgstr "" -#: src/scm/webid-oidc/jws.scm:75 -msgid "the JWS is invalid" +#: src/scm/webid-oidc/jws.scm:137 +msgid "" +"when making a token either #:alg or (#:jwt-header and #:jwt-payload) should " +"be passed" msgstr "" -#: src/scm/webid-oidc/jws.scm:94 -msgid "the JWS header does not have an \"alg\" field" +#: src/scm/webid-oidc/jws.scm:202 +msgid "#:iat should be a date" msgstr "" -#: src/scm/webid-oidc/jws.scm:102 -msgid "invalid JSON object as payload" +#: src/scm/webid-oidc/jws.scm:207 +msgid "#:exp should be a date" msgstr "" -#: src/scm/webid-oidc/jws.scm:111 -#, scheme-format -msgid "invalid signature algorithm: ~s" +#: src/scm/webid-oidc/jws.scm:217 +msgid "" +"when making a time-bound token, either its required fields (#:iat, and " +"either #:exp or #:validity) or (#:jwt-header and #:jwt-payload) should be " +"passed" msgstr "" -#: src/scm/webid-oidc/jws.scm:115 -#, scheme-format -msgid "invalid \"alg\" value: ~s" +#: src/scm/webid-oidc/jws.scm:245 +msgid "#:iss should be an URI" msgstr "" -#: src/scm/webid-oidc/jws.scm:120 -msgid "invalid JSON object as header" +#: src/scm/webid-oidc/jws.scm:256 +msgid "" +"when making an OIDC token, either its required #:iss field or (#:jwt-header " +"and #:jwt-payload) should be passed" msgstr "" -#: src/scm/webid-oidc/jws.scm:122 -msgid "this is not a pair" +#: src/scm/webid-oidc/jws.scm:300 +msgid "#:nonce should be a string" msgstr "" -#: src/scm/webid-oidc/jws.scm:139 +#: src/scm/webid-oidc/jws.scm:309 +msgid "" +"when making a single-use token, either its required #:nonce field or (#:jwt-" +"header and #:jwt-payload) should be passed" +msgstr "" + +#: src/scm/webid-oidc/jws.scm:354 msgid "the encoded JWS is not in 3 parts" msgstr "" -#: src/scm/webid-oidc/jws.scm:150 +#: src/scm/webid-oidc/jws.scm:365 #, scheme-format msgid "" "the encoded JWS header or payload is not a JSON object encoded in base64: ~a" msgstr "" -#: src/scm/webid-oidc/jws.scm:152 +#: src/scm/webid-oidc/jws.scm:367 msgid "" "the encoded JWS header or payload is not a JSON object encoded in base64" msgstr "" -#: src/scm/webid-oidc/jws.scm:211 +#: src/scm/webid-oidc/jws.scm:426 msgid "the JWS is not signed by any of the expected set of public keys" msgstr "" -#: src/scm/webid-oidc/jws.scm:222 +#: src/scm/webid-oidc/jws.scm:437 #, scheme-format msgid "while verifying the JWS signature: ~a" msgstr "" -#: src/scm/webid-oidc/jws.scm:224 +#: src/scm/webid-oidc/jws.scm:439 msgid "an unexpected error happened while verifying a JWS" msgstr "" -#: src/scm/webid-oidc/jws.scm:253 +#: src/scm/webid-oidc/jws.scm:478 +#, scheme-format +msgid "I cannot query the identity provider configuration: ~a" +msgstr "" + +#: src/scm/webid-oidc/jws.scm:480 +msgid "I cannot query the identity provider configuration" +msgstr "" + +#: src/scm/webid-oidc/jws.scm:501 +#, scheme-format +msgid "I cannot query the JWKS URI of the identity provider: ~a" +msgstr "" + +#: src/scm/webid-oidc/jws.scm:503 +msgid "I cannot query the JWKS URI of the identity provider" +msgstr "" + +#: src/scm/webid-oidc/jws.scm:531 +#, scheme-format +msgid "the token is signed in the future, ~a, relative to current ~a" +msgstr "" + +#: src/scm/webid-oidc/jws.scm:540 +#, scheme-format +msgid "the token expired ~a, which is in the past (from ~a)" +msgstr "" + +#: src/scm/webid-oidc/jws.scm:563 #, scheme-format msgid "cannot decode a JWS: ~a" msgstr "" -#: src/scm/webid-oidc/jws.scm:255 +#: src/scm/webid-oidc/jws.scm:565 msgid "cannot decode a JWS" msgstr "" -#: src/scm/webid-oidc/jws.scm:272 +#: src/scm/webid-oidc/jws.scm:583 #, scheme-format msgid "cannot encode a JWS: ~a" msgstr "" -#: src/scm/webid-oidc/jws.scm:274 +#: src/scm/webid-oidc/jws.scm:585 msgid "cannot encode a JWS" msgstr "" @@ -1239,78 +1105,28 @@ msgstr "" msgid "unexpected content-type: ~s" msgstr "" -#: src/scm/webid-oidc/oidc-id-token.scm:68 -#, scheme-format -msgid "this is not an ID token, because it is not even a JWS: ~a" -msgstr "" - -#: src/scm/webid-oidc/oidc-id-token.scm:71 -msgid "this is not an ID token, because it is not even a JWS" -msgstr "" - -#: src/scm/webid-oidc/oidc-id-token.scm:73 -#, scheme-format -msgid "this is not an ID token: ~a" -msgstr "" - -#: src/scm/webid-oidc/oidc-id-token.scm:76 -msgid "this is not an ID token" -msgstr "" - -#: src/scm/webid-oidc/oidc-id-token.scm:132 -#, scheme-format -msgid "the \"sub\" field should be a string, ~s is given" -msgstr "" - -#: src/scm/webid-oidc/oidc-id-token.scm:139 -#, scheme-format -msgid "the \"aud\" field should be an URI, ~s is given" -msgstr "" - -#: src/scm/webid-oidc/oidc-id-token.scm:146 -#, scheme-format -msgid "the \"nonce\" field should be a string, ~s is given" -msgstr "" - -#: src/scm/webid-oidc/oidc-id-token.scm:166 -msgid "the payload should be a JSON object" -msgstr "" - -#: src/scm/webid-oidc/oidc-id-token.scm:219 -#, scheme-format -msgid "the ID token is invalid: ~a" -msgstr "" - -#: src/scm/webid-oidc/oidc-id-token.scm:221 -msgid "the ID token is invalid" -msgstr "" - -#: src/scm/webid-oidc/oidc-id-token.scm:259 +#: src/scm/webid-oidc/oidc-id-token.scm:72 #, scheme-format -msgid "I cannot query the JWKS URI of the identity provider: ~a" +msgid "invalid OIDC ID token: ~a" msgstr "" -#: src/scm/webid-oidc/oidc-id-token.scm:261 -msgid "I cannot query the JWKS URI of the identity provider" +#: src/scm/webid-oidc/oidc-id-token.scm:74 +msgid "invalid OIDC id token" msgstr "" -#: src/scm/webid-oidc/oidc-id-token.scm:272 -#, scheme-format -msgid "the ID token is signed in the future, ~a, relative to current ~a" +#: src/scm/webid-oidc/oidc-id-token.scm:105 +msgid "#:sub should be a string" msgstr "" -#: src/scm/webid-oidc/oidc-id-token.scm:281 -#, scheme-format -msgid "the ID token expired ~a, which is in the past (from ~a)" +#: src/scm/webid-oidc/oidc-id-token.scm:110 +msgid "#:aud should be a string" msgstr "" -#: src/scm/webid-oidc/oidc-id-token.scm:295 -#, scheme-format -msgid "cannot encode the ID token: ~a" -msgstr "" - -#: src/scm/webid-oidc/oidc-id-token.scm:297 -msgid "cannot encode the ID token" +#: src/scm/webid-oidc/oidc-id-token.scm:126 +msgid "" +"when making an ID token either its required fields (#:alg, #:webid, #:iss, #:" +"sub, #:aud, #:iat and #:exp) or (#:jwt-header and #:jwt-payload) should be " +"passed" msgstr "" #: src/scm/webid-oidc/program.scm:57 @@ -2050,47 +1866,47 @@ msgstr "" msgid "~a: authentication failure\n" msgstr "" -#: src/scm/webid-oidc/resource-server.scm:160 -#: src/scm/webid-oidc/resource-server.scm:351 +#: src/scm/webid-oidc/resource-server.scm:172 +#: src/scm/webid-oidc/resource-server.scm:363 msgid "reason-phrase|Precondition Failed" msgstr "" -#: src/scm/webid-oidc/resource-server.scm:175 +#: src/scm/webid-oidc/resource-server.scm:187 msgid "reason-phrase|Not Modified" msgstr "" -#: src/scm/webid-oidc/resource-server.scm:191 +#: src/scm/webid-oidc/resource-server.scm:203 msgid "The owner is not defined." msgstr "" -#: src/scm/webid-oidc/resource-server.scm:263 +#: src/scm/webid-oidc/resource-server.scm:275 msgid "reason-phrase|Created" msgstr "" -#: src/scm/webid-oidc/resource-server.scm:288 +#: src/scm/webid-oidc/resource-server.scm:300 #, scheme-format msgid "~a: ignoring a group that cannot be fetched: ~a\n" msgstr "" -#: src/scm/webid-oidc/resource-server.scm:292 +#: src/scm/webid-oidc/resource-server.scm:304 #, scheme-format msgid "~a: ignoring a group that cannot be fetched\n" msgstr "" -#: src/scm/webid-oidc/resource-server.scm:316 -#: src/scm/webid-oidc/token-endpoint.scm:103 +#: src/scm/webid-oidc/resource-server.scm:328 +#: src/scm/webid-oidc/token-endpoint.scm:105 msgid "reason-phrase|Forbidden" msgstr "" -#: src/scm/webid-oidc/resource-server.scm:337 +#: src/scm/webid-oidc/resource-server.scm:349 msgid "reason-phrase|Conflict" msgstr "" -#: src/scm/webid-oidc/resource-server.scm:344 +#: src/scm/webid-oidc/resource-server.scm:356 msgid "reason-phrase|Unsupported Media Type" msgstr "" -#: src/scm/webid-oidc/resource-server.scm:358 +#: src/scm/webid-oidc/resource-server.scm:370 msgid "reason-phrase|Not Acceptable" msgstr "" @@ -2169,46 +1985,46 @@ msgstr "" msgid "an error happened while updating file ~s" msgstr "" -#: src/scm/webid-oidc/token-endpoint.scm:91 +#: src/scm/webid-oidc/token-endpoint.scm:93 #, scheme-format msgid "while handling web failure for the token endpoint: ~a" msgstr "" -#: src/scm/webid-oidc/token-endpoint.scm:93 +#: src/scm/webid-oidc/token-endpoint.scm:95 msgid "an error happened during the token endpoint failure handling" msgstr "" -#: src/scm/webid-oidc/token-endpoint.scm:222 +#: src/scm/webid-oidc/token-endpoint.scm:225 msgid "missing grant type" msgstr "" -#: src/scm/webid-oidc/token-endpoint.scm:226 +#: src/scm/webid-oidc/token-endpoint.scm:229 msgid "<p>You did not specify a grant_type for this request.</p>" msgstr "" -#: src/scm/webid-oidc/token-endpoint.scm:240 +#: src/scm/webid-oidc/token-endpoint.scm:243 msgid "missing authorization code" msgstr "" -#: src/scm/webid-oidc/token-endpoint.scm:244 +#: src/scm/webid-oidc/token-endpoint.scm:247 msgid "" "<p>You want to grant an authorization code, but you did not set one.</p>" msgstr "" -#: src/scm/webid-oidc/token-endpoint.scm:258 +#: src/scm/webid-oidc/token-endpoint.scm:268 msgid "missing refresh token" msgstr "" -#: src/scm/webid-oidc/token-endpoint.scm:262 +#: src/scm/webid-oidc/token-endpoint.scm:272 msgid "<p>You want to grant a refresh token, but you did not set one.</p>" msgstr "" -#: src/scm/webid-oidc/token-endpoint.scm:275 +#: src/scm/webid-oidc/token-endpoint.scm:285 #, scheme-format msgid "unsupported grant type: ~s" msgstr "" -#: src/scm/webid-oidc/token-endpoint.scm:280 +#: src/scm/webid-oidc/token-endpoint.scm:290 #, scheme-format msgid "" "<p>You want to use <pre>~s</pre> as a grant type, but this is not supported." @@ -2,8 +2,8 @@ msgid "" msgstr "" "Project-Id-Version: webid-oidc 0.0.0\n" "Report-Msgid-Bugs-To: vivien@planete-kraus.eu\n" -"POT-Creation-Date: 2021-09-17 23:19+0200\n" -"PO-Revision-Date: 2021-09-17 18:38+0200\n" +"POT-Creation-Date: 2021-09-21 22:28+0200\n" +"PO-Revision-Date: 2021-09-21 22:28+0200\n" "Last-Translator: Vivien Kraus <vivien@planete-kraus.eu>\n" "Language-Team: French <vivien@planete-kraus.eu>\n" "Language: fr\n" @@ -126,190 +126,71 @@ msgstr "" "Le module aléatoire n'a pas été initialisé. Veuillez appeler " "webid_oidc_random_init d'abort.\n" -#: src/scm/webid-oidc/access-token.scm:72 +#: src/scm/webid-oidc/access-token.scm:73 #, scheme-format -msgid "this is not an access token, because it is not even a JWS: ~a" -msgstr "ce n’est pas un jeton d’accès, parce que ce n’est même pas un JWS : ~a" +msgid "invalid access token: ~a" +msgstr "jeton d’accès invalide : ~a" -#: src/scm/webid-oidc/access-token.scm:74 -msgid "this is not an access token, because it is not even a JWS" -msgstr "ce n’est pas un jeton d’accès, parce que ce n’est même pas un JWS" +#: src/scm/webid-oidc/access-token.scm:75 +msgid "invalid access token" +msgstr "jeton d’accès invalide" -#: src/scm/webid-oidc/access-token.scm:77 src/scm/webid-oidc/dpop-proof.scm:101 -#, scheme-format -msgid "this is not an access token: ~a" -msgstr "ce n’est pas un jeton d’accès : ~a" +#: src/scm/webid-oidc/access-token.scm:117 +#: src/scm/webid-oidc/authorization-code.scm:93 +#: src/scm/webid-oidc/oidc-id-token.scm:100 +msgid "#:webid should be an URI" +msgstr "#:webid doit être une URI" -#: src/scm/webid-oidc/access-token.scm:79 src/scm/webid-oidc/dpop-proof.scm:103 -msgid "this is not an access token" -msgstr "ce n’est pas un jeton d’accès" +#: src/scm/webid-oidc/access-token.scm:122 +msgid "#:client-id should be an URI" +msgstr "#:client-id doit être une URI" -#: src/scm/webid-oidc/access-token.scm:101 -#: src/scm/webid-oidc/authorization-code.scm:89 -#: src/scm/webid-oidc/oidc-id-token.scm:97 -#, scheme-format -msgid "the payload is missing ~s" -msgstr "il manque ~s à la charge utile" +#: src/scm/webid-oidc/access-token.scm:127 +msgid "#:cnf/jkt should be a string" +msgstr "#:cnf/jkt doit être une chaîne de caractères" -#: src/scm/webid-oidc/access-token.scm:123 -#: src/scm/webid-oidc/authorization-code.scm:105 -#: src/scm/webid-oidc/oidc-id-token.scm:118 -#, scheme-format -msgid "the \"webid\" field should be an URI, ~s is given" -msgstr "le champ « webid » doit être une URI, pas ~s" - -#: src/scm/webid-oidc/access-token.scm:130 -#: src/scm/webid-oidc/oidc-id-token.scm:125 -#, scheme-format -msgid "the \"iss\" field should be an URI, ~s is given" -msgstr "le champ « iss » doit être une URI, pas ~s" - -#: src/scm/webid-oidc/access-token.scm:135 -#, scheme-format -msgid "the \"aud\" field should be set to \"solid\", ~s is given" -msgstr "le champ « aud » doit être « solid », pas ~s" - -#: src/scm/webid-oidc/access-token.scm:142 -#: src/scm/webid-oidc/oidc-id-token.scm:153 -#, scheme-format -msgid "the \"iat\" field should be a timestamp, ~s is given" -msgstr "le champ « iat » doit être un horodatage, pas ~s" +#: src/scm/webid-oidc/access-token.scm:132 +msgid "#:aud should be exactly \"solid\"" +msgstr "#:aud doit être exactement « solid »" -#: src/scm/webid-oidc/access-token.scm:149 -#: src/scm/webid-oidc/authorization-code.scm:126 -#: src/scm/webid-oidc/oidc-id-token.scm:160 -#, scheme-format -msgid "the \"exp\" field should be a timestamp, ~s is given" -msgstr "le champ « exp » doit être un horodatage, pas ~s" - -#: src/scm/webid-oidc/access-token.scm:158 -msgid "the \"cnf\" / \"jkt\" field is missing" -msgstr "le champ « cnf » / « jkt » est manquant" - -#: src/scm/webid-oidc/access-token.scm:166 -#, scheme-format -msgid "the \"cnf\" / \"jkt\" field should be a string, ~s is given" -msgstr "le champ « cnf » / « jkt » doit être une chaîne de caractères, pas ~s" - -#: src/scm/webid-oidc/access-token.scm:171 -#, scheme-format -msgid "the \"cnf\" field should be an object, ~s is given" -msgstr "le champ « cnf » doit être un objet JSON, pas ~s" - -#: src/scm/webid-oidc/access-token.scm:178 -#: src/scm/webid-oidc/authorization-code.scm:112 -#, scheme-format -msgid "the \"client_id\" field should be an URI, ~s is given" -msgstr "le champ « client_id » doit être une URI, pas ~s" - -#: src/scm/webid-oidc/access-token.scm:239 -#, scheme-format -msgid "the access token is invalid: ~a" -msgstr "le jeton d’accès est invalide : ~a" - -#: src/scm/webid-oidc/access-token.scm:241 -msgid "the access token is invalid" -msgstr "le jeton d’accès est invalide" - -#: src/scm/webid-oidc/access-token.scm:257 -#: src/scm/webid-oidc/oidc-id-token.scm:237 -#, scheme-format -msgid "I cannot query the identity provider configuration: ~a" -msgstr "" -"je ne peux pas requêter la configuration du fournisseur d’identité : ~a" - -#: src/scm/webid-oidc/access-token.scm:259 -#: src/scm/webid-oidc/oidc-id-token.scm:239 -msgid "I cannot query the identity provider configuratioon" -msgstr "je ne peux pas requêter la configurration du fournisseur d’identité" - -#: src/scm/webid-oidc/access-token.scm:276 -#, scheme-format -msgid "I cannot query the identity provider public keys: ~a" -msgstr "" -"je ne peux pas requêter les clés publiques du fournisseur d’identité : ~a" - -#: src/scm/webid-oidc/access-token.scm:278 -msgid "I cannot query the identity provider public keys" -msgstr "je ne peux pas requêter les clés publiques du fournisseur d’identité" - -#: src/scm/webid-oidc/access-token.scm:294 -#, scheme-format -msgid "the access token is signed in the future, ~a, relative to current ~a" -msgstr "" -"le jeton d’accès est signé dans le futur, le ~a, par rapport à la date " -"courante, le ~a" - -#: src/scm/webid-oidc/access-token.scm:303 -#, scheme-format -msgid "the access token expired ~a, which is in the past (from ~a)" -msgstr "le jeton d’accès a expiré le ~a, qui est dans le passé (de ~a)" - -#: src/scm/webid-oidc/access-token.scm:317 -#, scheme-format -msgid "cannot encode the access token: ~a" -msgstr "impossible d’encoder le jeton d’accès : ~a" - -#: src/scm/webid-oidc/access-token.scm:319 -msgid "cannot encode the access token" -msgstr "impossible d’encoder le jeton d’accès" - -#: src/scm/webid-oidc/authorization-code.scm:64 -#, scheme-format -msgid "this is not an authorization code, because it is not even a JWS: ~a" -msgstr "" -"ce n’est pas un code d’autorisation, parce que ce n’est même pas un JWS : ~a" - -#: src/scm/webid-oidc/authorization-code.scm:66 -msgid "this is not an authorization code, because it is not even a JWS" +#: src/scm/webid-oidc/access-token.scm:150 +msgid "" +"when making an access token either its required fields (#:alg, #:webid, #:" +"iss, #:aud, #:client-id, #:cnf/jkt, #:iat and #:exp) or (#:jwt-header and #:" +"jwt-payload) should be passed" msgstr "" -"ce n’est pas un code d’autorisation, parce que ce n’est même pas un JWS" +"lors de la création d’un jeton d’accès, il faut passer soit les champs " +"nécessaires (#:alg, #:webid, #:iss, #:aud, #:client-id, #:cnf/jkt, #:iat et " +"#:exp) soit (#:jwt-header et #:jwt-payload)" #: src/scm/webid-oidc/authorization-code.scm:69 #, scheme-format -msgid "this is not an authorization code: ~a" -msgstr "ce n’est pas un code d’autorisation : ~a" +msgid "invalid authorization code: ~a" +msgstr "jeton d’autorisation invalide : ~a" #: src/scm/webid-oidc/authorization-code.scm:71 -msgid "this is not an authorization code" -msgstr "ce n’est pas un code d’autorisation" - -#: src/scm/webid-oidc/authorization-code.scm:119 -#, scheme-format -msgid "the \"jti\" field should be a string, ~s is given" -msgstr "le champ « jti » doit être une chaîne de caractères, pas ~s" - -#: src/scm/webid-oidc/authorization-code.scm:171 -#, scheme-format -msgid "the authorization code is invalid: ~a" -msgstr "le code d’autorisation est invalide : ~a" +msgid "invalid authorization code" +msgstr "jeton d’autorisation invalide" -#: src/scm/webid-oidc/authorization-code.scm:173 -msgid "the authorization code is invalid" -msgstr "le code d’autorisation est invalide" +#: src/scm/webid-oidc/authorization-code.scm:98 +msgid "#:client-id should be a string" +msgstr "#:client-id doit être une chaîne de caractères" -#: src/scm/webid-oidc/authorization-code.scm:187 -#, scheme-format -msgid "the authorization expired ~a, which is in the past (from ~a)" +#: src/scm/webid-oidc/authorization-code.scm:112 +msgid "" +"when making an authorization code either its required fields (#:webid and #:" +"client-id) or (#:jwt-header and #:jwt-payload) should be passed" msgstr "" -"le code d’autorisation a expiré le ~a, qui est dans le passé (depuis ~a)" - -#: src/scm/webid-oidc/authorization-code.scm:203 -#, scheme-format -msgid "cannot encode the authorization code: ~a" -msgstr "impossible d’encoder le code d’autorisation : ~a" - -#: src/scm/webid-oidc/authorization-code.scm:205 -msgid "cannot encode the authorization code" -msgstr "impossible d’encoder le code d’autorisation" +"lors de la création d’un code d’autorisation, il faut soit passer les champs " +"requis (#:webid et #:client-id), soit (#:jwt-header et #:jwt-payload)" #: src/scm/webid-oidc/authorization-page-unsafe.scm:52 #: src/scm/webid-oidc/hello-world.scm:40 src/scm/webid-oidc/hello-world.scm:167 #: src/scm/webid-oidc/hello-world.scm:187 #: src/scm/webid-oidc/identity-provider.scm:139 -#: src/scm/webid-oidc/token-endpoint.scm:111 -#: src/scm/webid-oidc/token-endpoint.scm:137 -#: src/scm/webid-oidc/token-endpoint.scm:164 +#: src/scm/webid-oidc/token-endpoint.scm:113 +#: src/scm/webid-oidc/token-endpoint.scm:139 +#: src/scm/webid-oidc/token-endpoint.scm:166 msgid "xml-lang|en" msgstr "fr" @@ -343,8 +224,8 @@ msgid "Allow" msgstr "Autoriser" #: src/scm/webid-oidc/authorization-page-unsafe.scm:95 -#: src/scm/webid-oidc/token-endpoint.scm:129 -#: src/scm/webid-oidc/token-endpoint.scm:156 +#: src/scm/webid-oidc/token-endpoint.scm:131 +#: src/scm/webid-oidc/token-endpoint.scm:158 msgid "reason-phrase|Bad Request" msgstr "Requête Invalide" @@ -370,7 +251,7 @@ msgstr "" "L’application que vous essayez d’autoriser se comporte de façon inattendue." #: src/scm/webid-oidc/authorization-page-unsafe.scm:126 -#: src/scm/webid-oidc/resource-server.scm:299 +#: src/scm/webid-oidc/resource-server.scm:311 msgid "reason-phrase|Found" msgstr "Trouvé" @@ -497,83 +378,83 @@ msgstr "impossible de télécharger le manifeste client ~s" msgid "the client manifest is dereferenced from ~s, but it pretends to be ~s" msgstr "le manifeste client est déréférencé depuis ~s, mais il prétend être ~s" -#: src/scm/webid-oidc/client/accounts.scm:282 +#: src/scm/webid-oidc/client/accounts.scm:285 msgid "The refresh token has expired." msgstr "le jeton de rafraîchissement a expiré." -#: src/scm/webid-oidc/client/accounts.scm:289 +#: src/scm/webid-oidc/client/accounts.scm:292 #, scheme-format msgid "The token request failed with code ~s (~s)." msgstr "La requête de jeton a échoué avec un code ~s (~s)." -#: src/scm/webid-oidc/client/accounts.scm:298 +#: src/scm/webid-oidc/client/accounts.scm:301 msgid "The token response did not set the content type." msgstr "Le jeton de réponse n’a pas défini de type de contenu." -#: src/scm/webid-oidc/client/accounts.scm:306 +#: src/scm/webid-oidc/client/accounts.scm:309 msgid "The token endpoint did not respond in UTF-8." msgstr "Le terminal de jetonn n’a pas répondu en UTF-8." -#: src/scm/webid-oidc/client/accounts.scm:318 +#: src/scm/webid-oidc/client/accounts.scm:321 #, scheme-format msgid "The token response has content-type ~s, not application/json." msgstr "La réponse de jeton a un type de contenu ~s, pas application/json." -#: src/scm/webid-oidc/client/accounts.scm:328 +#: src/scm/webid-oidc/client/accounts.scm:331 msgid "The token response is not valid JSON." msgstr "La réponse de jeton n’est pas un JSON valide." -#: src/scm/webid-oidc/client/accounts.scm:342 +#: src/scm/webid-oidc/client/accounts.scm:345 #, scheme-format msgid "The token response did not include an ID token: ~s" msgstr "La réponse de jeton n’a pas inclus de jeton d’ID : ~s" -#: src/scm/webid-oidc/client/accounts.scm:350 +#: src/scm/webid-oidc/client/accounts.scm:353 #, scheme-format msgid "The token response did not include an access token: ~s\n" msgstr "La réponse de jeton n’a pas inclus de jeton d’accès : ~s\n" -#: src/scm/webid-oidc/client/accounts.scm:361 +#: src/scm/webid-oidc/client/accounts.scm:364 #, scheme-format msgid "the ID token signature is invalid: ~a" msgstr "la signature du jeton d’ID est invalide : ~a" -#: src/scm/webid-oidc/client/accounts.scm:363 +#: src/scm/webid-oidc/client/accounts.scm:366 msgid "the ID token signature is invalid" msgstr "la signature du jeton d’ID est invalide" -#: src/scm/webid-oidc/client/accounts.scm:381 +#: src/scm/webid-oidc/client/accounts.scm:383 #, scheme-format msgid "the ID token delivered by the identity provider for ~s has ~s as webid" msgstr "" "le jeton d’ID délivré par le fournisseur d’identité pour ~s a ~s pour webid" -#: src/scm/webid-oidc/client/accounts.scm:391 +#: src/scm/webid-oidc/client/accounts.scm:393 #, scheme-format msgid "The ID token delivered by the identity provider ~s is for issuer ~s." msgstr "" "Le jeton d’ID délivré par le fournisseur d’identité ~s est pour l’émetteur " "~s." -#: src/scm/webid-oidc/client/accounts.scm:406 +#: src/scm/webid-oidc/client/accounts.scm:408 msgid "The issuer is required." msgstr "L’émetteur est requis." -#: src/scm/webid-oidc/client/accounts.scm:411 +#: src/scm/webid-oidc/client/accounts.scm:413 msgid "The optional subject and required issuer should be strings or URI." msgstr "" "Le sujet optionnel et émetteur doivent être des chaînes de caractère ou des " "URIs." -#: src/scm/webid-oidc/client/accounts.scm:447 +#: src/scm/webid-oidc/client/accounts.scm:449 msgid "Cannot check the username and/or password." msgstr "Impossible de vérifier le nom d’utilisateur et/ou le mot de passe." -#: src/scm/webid-oidc/client/accounts.scm:457 +#: src/scm/webid-oidc/client/accounts.scm:459 msgid "The subject should be a string or URI." msgstr "Le sujet doit être une chaîne de caractères ou une URI." -#: src/scm/webid-oidc/client/accounts.scm:471 +#: src/scm/webid-oidc/client/accounts.scm:473 msgid "The issuer should be a string or URI." msgstr "L’émetteur doit être une chaîne de caractères ou une URI." @@ -611,101 +492,52 @@ msgstr "Bonjour, le monde !\n" msgid "Hello, world!" msgstr "Bonjour, le monde !" -#: src/scm/webid-oidc/dpop-proof.scm:96 -#, scheme-format -msgid "this is not a DPoP proof, because it is not even a JWS: ~a" -msgstr "ce n’est pas une preuve DPoP, parce que ce n’est même pas un JWS : ~a" - -#: src/scm/webid-oidc/dpop-proof.scm:98 -msgid "this is not a DPoP proof, because it is not even a JWS" -msgstr "ce n’est pas une preuve DPoP, parce que ce n’est même pas un JWS" - -#: src/scm/webid-oidc/dpop-proof.scm:129 +#: src/scm/webid-oidc/dpop-proof.scm:110 #, scheme-format -msgid "the DPoP proof is missing ~s" -msgstr "il manque ~s à la preuve DPoP" - -#: src/scm/webid-oidc/dpop-proof.scm:152 -#, scheme-format -msgid "the \"jti\" field should be a string, not ~s" -msgstr "le champ « jti » doit être une chaîne de caractères, pas ~s" - -#: src/scm/webid-oidc/dpop-proof.scm:159 -#, scheme-format -msgid "the \"htm\" field should be a string, not ~s" -msgstr "le champ « htm » doit être une chaîne de caractères, pas ~s" - -#: src/scm/webid-oidc/dpop-proof.scm:166 -#, scheme-format -msgid "the \"htu\" field should be an URI, not ~s" -msgstr "le champ « htu » doit être une URI, pas ~s" +msgid "the DPoP proof is signed for ~s, but it is issued to ~s" +msgstr "la preuve DPoP est signée pour ~s, mais elle est émise pour ~s" -#: src/scm/webid-oidc/dpop-proof.scm:173 +#: src/scm/webid-oidc/dpop-proof.scm:155 #, scheme-format -msgid "the \"iat\" field should be a timestamp, not ~s" -msgstr "le champ « iat » doit être un horodatage, pas ~s" +msgid "invalid DPoP proof: ~a" +msgstr "preuve DPoP invalide : ~a" -#: src/scm/webid-oidc/dpop-proof.scm:180 -#, scheme-format -msgid "the \"ath\" field should be an encoded JWT, not ~s" -msgstr "le champ « ath » doit être un JWT encodé, pas ~s" +#: src/scm/webid-oidc/dpop-proof.scm:157 +msgid "invalid DPoP proof token" +msgstr "jeton de preuve DPoP invalide" #: src/scm/webid-oidc/dpop-proof.scm:189 -#, scheme-format -msgid "the \"alg\" field should be a string, not ~s" -msgstr "le champ « alg » doit être une chaîne de caractères, pas ~s" +msgid "#:typ should be exactly \"dpop+jwt\"" +msgstr "#:typ doit être exactement « dpop+jwt »" #: src/scm/webid-oidc/dpop-proof.scm:194 -#, scheme-format -msgid "the \"typ\" field should be \"dpop+jwt\", not ~s" -msgstr "le champ « typ » doit être « dpop+jwt », pas ~s" +msgid "#:jwk should be a public key" +msgstr "#:jwk doit être une clé publique" -#: src/scm/webid-oidc/dpop-proof.scm:200 -msgid "the \"jwk\" field should not contain the private key" -msgstr "le champ « jwk » ne doit pas contenir la clé privée" +#: src/scm/webid-oidc/dpop-proof.scm:199 +msgid "#:htm should be a symbol" +msgstr "#:htm doit être un symbole" -#: src/scm/webid-oidc/dpop-proof.scm:202 -#, scheme-format -msgid "the \"jwk\" field should be a valid public key, not ~s" -msgstr "le champ « jwk » doit être unen clé publique valide, pas ~s" +#: src/scm/webid-oidc/dpop-proof.scm:205 +msgid "when present, #:ath should be a string" +msgstr "si présent, #:ath doit être une chaîne de caractères" -#: src/scm/webid-oidc/dpop-proof.scm:281 -#, scheme-format -msgid "the DPoP proof is signed for ~s, but it is issued to ~s" -msgstr "la preuve DPoP est signée pour ~s, mais elle est émise pour ~s" - -#: src/scm/webid-oidc/dpop-proof.scm:312 -#, scheme-format -msgid "the DPoP proof cannot be decoded: ~a" -msgstr "impossible de décoder la preuve DPoP : ~a" - -#: src/scm/webid-oidc/dpop-proof.scm:314 -msgid "the DPoP proof cannot be decoded" -msgstr "impossible de décoder la preuve DPoP" +#: src/scm/webid-oidc/dpop-proof.scm:226 +msgid "" +"when making a DPoP proof, either its required fields (#:typ, #:jwk, #:htm " +"and #:htu) or (#:jwt-header and #:jwt-payload) should be passed" +msgstr "" +"lors de la création d’une preuve DPoP, il faut passer soit les champs requis " +"(#:typ, #:jwk, #:htm et #:htu) soit (#:jwt-header et #:jwt-payload)" -#: src/scm/webid-oidc/dpop-proof.scm:324 +#: src/scm/webid-oidc/dpop-proof.scm:259 #, scheme-format msgid "the DPoP proof is signed for access through ~s, but it is used with ~s" msgstr "" "la preuve DPoP est signée pour un accès avec ~s, mais elle est utilisée avec " "~s" -#: src/scm/webid-oidc/dpop-proof.scm:338 -#, scheme-format -msgid "" -"the DPoP proof is signed in the future, ~a, relative to the current date, ~a" -msgstr "" -"la preuve DPoP est signée dans le futur, le ~a, par rapport à la date " -"courante, ~a" - -#: src/scm/webid-oidc/dpop-proof.scm:347 -#, scheme-format -msgid "the DPoP proof is too old, it was signed ~a and now it is ~a" -msgstr "" -"la preuve DPoP est trop vieille, elle a été signée le ~a et nous sommes " -"maintenant le ~a" - -#: src/scm/webid-oidc/dpop-proof.scm:359 +#: src/scm/webid-oidc/dpop-proof.scm:269 #, scheme-format msgid "" "the DPoP proof should go along with an access token hashed to ~s, not ~s" @@ -713,123 +545,114 @@ msgstr "" "la preuve DPoP devrait être accompagnée d’un jeton d’accès de condensat ~s, " "pas ~s" -#: src/scm/webid-oidc/dpop-proof.scm:368 src/scm/webid-oidc/dpop-proof.scm:379 +#: src/scm/webid-oidc/dpop-proof.scm:277 src/scm/webid-oidc/dpop-proof.scm:284 msgid "the DPoP proof is signed with the wrong key" msgstr "la preuve DPoP est signée avec la mauvaise clé" -#: src/scm/webid-oidc/dpop-proof.scm:377 +#: src/scm/webid-oidc/dpop-proof.scm:282 #, scheme-format msgid "the DPoP proof is signed with the wrong key: ~a" msgstr "la preuve DPoP est signée avec la mauvaise clé : ~a" -#: src/scm/webid-oidc/dpop-proof.scm:388 +#: src/scm/webid-oidc/dpop-proof.scm:293 msgid "the cnf/check function returned #f" msgstr "la fonction cnf/check a retourné #f" -#: src/scm/webid-oidc/dpop-proof.scm:399 -#, scheme-format -msgid "cannot encode a DPoP proof: ~a" -msgstr "impossible d’encoder la preuve DPoP : ~a" - -#: src/scm/webid-oidc/dpop-proof.scm:401 -msgid "cannot encode a DPoP proof" -msgstr "impossible d’encoder la preuve DPoP" - -#: src/scm/webid-oidc/example-app.scm:97 +#: src/scm/webid-oidc/example-app.scm:96 #, scheme-format msgid "~a (issued by ~a): no interaction required" msgstr "~a (émis par ~a) : aucune interaction nécessaire" -#: src/scm/webid-oidc/example-app.scm:100 +#: src/scm/webid-oidc/example-app.scm:99 #, scheme-format msgid "~a (issued by ~a): offline but accessible" msgstr "~a (émis par ~a) : hors ligne mais accessible" -#: src/scm/webid-oidc/example-app.scm:103 +#: src/scm/webid-oidc/example-app.scm:102 #, scheme-format msgid "~a (issued by ~a): online" msgstr "~a (émis par ~a) : en ligne" -#: src/scm/webid-oidc/example-app.scm:106 +#: src/scm/webid-oidc/example-app.scm:105 #, scheme-format msgid "~a (issued by ~a): inaccessible" msgstr "~a (émis par ~a) : inaccessible" -#: src/scm/webid-oidc/example-app.scm:119 +#: src/scm/webid-oidc/example-app.scm:118 #, scheme-format msgid "Your choice ~a does not exist.\n" msgstr "Votre choix, ~a, n’existe pas.\n" -#: src/scm/webid-oidc/example-app.scm:137 +#: src/scm/webid-oidc/example-app.scm:136 msgid "Your choice is not a valid URI.\n" msgstr "Votre choix doit être une URI valide.\n" -#: src/scm/webid-oidc/example-app.scm:146 +#: src/scm/webid-oidc/example-app.scm:145 msgid "This is not a valid HTTP method.\n" msgstr "ce n’est pas une méthode HTTP valide.\n" -#: src/scm/webid-oidc/example-app.scm:162 +#: src/scm/webid-oidc/example-app.scm:161 msgid "This is not a valid value for this header.\n" msgstr "Ce n’est pas une valeur valide pour cet en-tête.\n" -#: src/scm/webid-oidc/example-app.scm:200 +#: src/scm/webid-oidc/example-app.scm:199 msgid "Nothing to undo.\n" msgstr "Rien à annuler.\n" -#: src/scm/webid-oidc/example-app.scm:212 +#: src/scm/webid-oidc/example-app.scm:211 msgid "Nothing to redo.\n" msgstr "Rien à refaire.\n" -#: src/scm/webid-oidc/example-app.scm:272 +#: src/scm/webid-oidc/example-app.scm:271 msgid "Example app command|add-account" msgstr "ajouter-compte" -#: src/scm/webid-oidc/example-app.scm:274 +#: src/scm/webid-oidc/example-app.scm:273 msgid "Example app command|choose-account" msgstr "choisir-compte" -#: src/scm/webid-oidc/example-app.scm:276 +#: src/scm/webid-oidc/example-app.scm:275 msgid "Example app command|set-uri" msgstr "définir-uri" -#: src/scm/webid-oidc/example-app.scm:278 +#: src/scm/webid-oidc/example-app.scm:277 msgid "Example app command|set-method" msgstr "définir-méthode" -#: src/scm/webid-oidc/example-app.scm:280 +#: src/scm/webid-oidc/example-app.scm:279 msgid "Example app command|view-headers" msgstr "voir-en-têtes" -#: src/scm/webid-oidc/example-app.scm:282 +#: src/scm/webid-oidc/example-app.scm:281 msgid "Example app command|clear-headers" msgstr "effacer-en-têtes" -#: src/scm/webid-oidc/example-app.scm:284 +#: src/scm/webid-oidc/example-app.scm:283 msgid "Example app command|add-header" msgstr "ajouter-en-tête" -#: src/scm/webid-oidc/example-app.scm:286 +#: src/scm/webid-oidc/example-app.scm:285 msgid "Example app command|ok" msgstr "ok" -#: src/scm/webid-oidc/example-app.scm:288 +#: src/scm/webid-oidc/example-app.scm:287 msgid "Example app command|undo" msgstr "annuler" -#: src/scm/webid-oidc/example-app.scm:290 +#: src/scm/webid-oidc/example-app.scm:289 msgid "Example app command|redo" msgstr "refaire" -#: src/scm/webid-oidc/example-app.scm:300 +#: src/scm/webid-oidc/example-app.scm:299 #, scheme-format msgid "To log in on ~a, please visit: ~a\n" msgstr "Pour vous connecte avec ~a, veuillez visiter : ~a\n" -#: src/scm/webid-oidc/example-app.scm:303 +#: src/scm/webid-oidc/example-app.scm:302 msgid "Then, paste the authorization code you get:\n" msgstr "Ensuite, veuillez coller votre code d’autorisation :\n" -#: src/scm/webid-oidc/example-app.scm:321 +#: src/scm/webid-oidc/example-app.scm:320 #, scheme-format msgid "" "Account: ~a\n" @@ -864,50 +687,50 @@ msgstr "" " - ~a : effectuer la requête.\n" "\n" -#: src/scm/webid-oidc/example-app.scm:340 +#: src/scm/webid-oidc/example-app.scm:339 msgid "Account:|unset" msgstr "non défini" -#: src/scm/webid-oidc/example-app.scm:344 +#: src/scm/webid-oidc/example-app.scm:343 msgid "URI:|unset" msgstr "non défini" -#: src/scm/webid-oidc/example-app.scm:348 +#: src/scm/webid-oidc/example-app.scm:347 msgid "Method:|unset" msgstr "non définie" -#: src/scm/webid-oidc/example-app.scm:351 +#: src/scm/webid-oidc/example-app.scm:350 msgid "Headers:|none" msgstr "aucun" -#: src/scm/webid-oidc/example-app.scm:355 +#: src/scm/webid-oidc/example-app.scm:354 msgid "list separator|, " msgstr ", " -#: src/scm/webid-oidc/example-app.scm:365 +#: src/scm/webid-oidc/example-app.scm:364 #, scheme-format msgid "You can undo your last command with \"~a\".\n" msgstr "Vous pouvez annuler votre dernière commande avec « ~a ».\n" -#: src/scm/webid-oidc/example-app.scm:367 +#: src/scm/webid-oidc/example-app.scm:366 #, scheme-format msgid "You can re-apply your last undone command with \"~a\".\n" msgstr "Vous pouvez refaire votre dernière commande annulée avec « ~a ».\n" -#: src/scm/webid-oidc/example-app.scm:368 +#: src/scm/webid-oidc/example-app.scm:367 msgid "Readline prompt|Command: " msgstr "Commande : " -#: src/scm/webid-oidc/example-app.scm:375 +#: src/scm/webid-oidc/example-app.scm:374 #, scheme-format msgid "An error happened: ~a.\n" msgstr "Une erreur est survenue : ~a.\n" -#: src/scm/webid-oidc/example-app.scm:387 +#: src/scm/webid-oidc/example-app.scm:386 msgid "Please enter your identity provider: " msgstr "Veuillez entrer votre fournisseur d’identité : " -#: src/scm/webid-oidc/example-app.scm:393 +#: src/scm/webid-oidc/example-app.scm:392 msgid "" "You don’t have other accounts available. Please add one with \"add-account" "\".\n" @@ -915,38 +738,38 @@ msgstr "" "Vous n’avez pas d’autre compte disponible. Veuillez en ajouter un avec " "« ajouter-compte ».\n" -#: src/scm/webid-oidc/example-app.scm:399 +#: src/scm/webid-oidc/example-app.scm:398 #, scheme-format msgid "- ~a: ~a\n" msgstr "- ~a : ~a\n" -#: src/scm/webid-oidc/example-app.scm:407 +#: src/scm/webid-oidc/example-app.scm:406 #, scheme-format msgid "[1-~a] " msgstr "[1-~a] " -#: src/scm/webid-oidc/example-app.scm:415 +#: src/scm/webid-oidc/example-app.scm:414 msgid "Visit this URI: " msgstr "Naviguer cette URI : " -#: src/scm/webid-oidc/example-app.scm:421 +#: src/scm/webid-oidc/example-app.scm:420 msgid "Use this HTTP method [GET]: " msgstr "Utiliser cette méthode HTTP [GET] : " -#: src/scm/webid-oidc/example-app.scm:437 +#: src/scm/webid-oidc/example-app.scm:436 msgid "Which header? " msgstr "Quel en-tête ? " -#: src/scm/webid-oidc/example-app.scm:440 +#: src/scm/webid-oidc/example-app.scm:439 #, scheme-format msgid "Which header value for ~a? " msgstr "Quelle valeur pour l’en-tête ~a ? " -#: src/scm/webid-oidc/example-app.scm:463 +#: src/scm/webid-oidc/example-app.scm:462 msgid "Please define an account and the URI.\n" msgstr "Veuillez définir un compte et une URI.\n" -#: src/scm/webid-oidc/example-app.scm:470 +#: src/scm/webid-oidc/example-app.scm:469 msgid "I don’t know that command.\n" msgstr "Je ne connais pas cette commande.\n" @@ -1083,7 +906,7 @@ msgid "The port should be a number between 0 and 65535.\n" msgstr "Le port doit être un nombre entre 0 et 65535.\n" #: src/scm/webid-oidc/hello-world.scm:159 -#: src/scm/webid-oidc/resource-server.scm:320 +#: src/scm/webid-oidc/resource-server.scm:332 msgid "reason-phrase|Unauthorized" msgstr "Non Autorisé" @@ -1096,7 +919,7 @@ msgid "<p>This page requires authentication with Solid.</p>" msgstr "<p>Cette page requiert une authentification avec Solid.</p>" #: src/scm/webid-oidc/hello-world.scm:179 -#: src/scm/webid-oidc/resource-server.scm:328 +#: src/scm/webid-oidc/resource-server.scm:340 msgid "reason-phrase|Method Not Allowed" msgstr "Méthode Non Autorisée" @@ -1184,46 +1007,66 @@ msgstr "type de contenu manquant" msgid "invalid content-type: ~s" msgstr "type de contenu invalide : ~s" -#: src/scm/webid-oidc/jws.scm:73 +#: src/scm/webid-oidc/jws.scm:127 #, scheme-format -msgid "the JWS is invalid: ~a" -msgstr "le JWS est invalide : ~a" +msgid "unsupported JWS algorithm: ~s" +msgstr "algorithme JWS non supporté : ~s" -#: src/scm/webid-oidc/jws.scm:75 -msgid "the JWS is invalid" -msgstr "le JWS est invalide" +#: src/scm/webid-oidc/jws.scm:137 +msgid "" +"when making a token either #:alg or (#:jwt-header and #:jwt-payload) should " +"be passed" +msgstr "" +"lors de la création d’un jeton il faut passer soit #:alg soit (#:jwt-header " +"et #:jwt-payload)" -#: src/scm/webid-oidc/jws.scm:94 -msgid "the JWS header does not have an \"alg\" field" -msgstr "l’en-tête JWS n’a pas de champ « alg »" +#: src/scm/webid-oidc/jws.scm:202 +msgid "#:iat should be a date" +msgstr "#:iat doit être une date" -#: src/scm/webid-oidc/jws.scm:102 -msgid "invalid JSON object as payload" -msgstr "objet JSON invalide comme charge utile" +#: src/scm/webid-oidc/jws.scm:207 +msgid "#:exp should be a date" +msgstr "#:exp doit être une date" -#: src/scm/webid-oidc/jws.scm:111 -#, scheme-format -msgid "invalid signature algorithm: ~s" -msgstr "algorithme de signature invalide : ~s" +#: src/scm/webid-oidc/jws.scm:217 +msgid "" +"when making a time-bound token, either its required fields (#:iat, and " +"either #:exp or #:validity) or (#:jwt-header and #:jwt-payload) should be " +"passed" +msgstr "" +"lors de la création d’un jeton limité dans le temps, il faut passer soit ses " +"champs requis (#:iat et soit #:exp soit #:validity) soit (#:jwt-header et #:" +"jwt-payload)" -#: src/scm/webid-oidc/jws.scm:115 -#, scheme-format -msgid "invalid \"alg\" value: ~s" -msgstr "valeur « alg » invalide : ~s" +#: src/scm/webid-oidc/jws.scm:245 +msgid "#:iss should be an URI" +msgstr "#:iss doit être une URI" -#: src/scm/webid-oidc/jws.scm:120 -msgid "invalid JSON object as header" -msgstr "objet JSON d’en-tête invalide" +#: src/scm/webid-oidc/jws.scm:256 +msgid "" +"when making an OIDC token, either its required #:iss field or (#:jwt-header " +"and #:jwt-payload) should be passed" +msgstr "" +"lors de la création d’un jeton OIDC, il faut passer soit le champs requis #:" +"iss soit (#:jwt-header et #:jwt-payload)" -#: src/scm/webid-oidc/jws.scm:122 -msgid "this is not a pair" -msgstr "ce n’est pas une paire" +#: src/scm/webid-oidc/jws.scm:300 +msgid "#:nonce should be a string" +msgstr "#:nonce doit être une chaîne de caractères" -#: src/scm/webid-oidc/jws.scm:139 +#: src/scm/webid-oidc/jws.scm:309 +msgid "" +"when making a single-use token, either its required #:nonce field or (#:jwt-" +"header and #:jwt-payload) should be passed" +msgstr "" +"lors de la création d’un jeton à usage unique, il faut soit passer le champs " +"requis #:nonce soit (#:jwt-header et #:jwt-payload)" + +#: src/scm/webid-oidc/jws.scm:354 msgid "the encoded JWS is not in 3 parts" msgstr "le JWS encodé n’est pas en 3 parties" -#: src/scm/webid-oidc/jws.scm:150 +#: src/scm/webid-oidc/jws.scm:365 #, scheme-format msgid "" "the encoded JWS header or payload is not a JSON object encoded in base64: ~a" @@ -1231,41 +1074,71 @@ msgstr "" "l’en-tête ou la charge utile du JWS encodé n’est pas un objet JSON encodé en " "base64 : ~a" -#: src/scm/webid-oidc/jws.scm:152 +#: src/scm/webid-oidc/jws.scm:367 msgid "" "the encoded JWS header or payload is not a JSON object encoded in base64" msgstr "" "l’en-tête ou la charge utile du JWS encodé n’est pas un objet JSON encodé en " "base64" -#: src/scm/webid-oidc/jws.scm:211 +#: src/scm/webid-oidc/jws.scm:426 msgid "the JWS is not signed by any of the expected set of public keys" msgstr "le JWS n’est signé par aucune des clés attendues" -#: src/scm/webid-oidc/jws.scm:222 +#: src/scm/webid-oidc/jws.scm:437 #, scheme-format msgid "while verifying the JWS signature: ~a" msgstr "en vérifiant la signature du JWS : ~a" -#: src/scm/webid-oidc/jws.scm:224 +#: src/scm/webid-oidc/jws.scm:439 msgid "an unexpected error happened while verifying a JWS" msgstr "une erreur inattendue est survenue pendant la vérification d’un JWS" -#: src/scm/webid-oidc/jws.scm:253 +#: src/scm/webid-oidc/jws.scm:478 +#, scheme-format +msgid "I cannot query the identity provider configuration: ~a" +msgstr "" +"je ne peux pas requêter la configuration du fournisseur d’identité : ~a" + +#: src/scm/webid-oidc/jws.scm:480 +msgid "I cannot query the identity provider configuration" +msgstr "je ne peux pas requêter la configuration du fournisseur d’identité" + +#: src/scm/webid-oidc/jws.scm:501 +#, scheme-format +msgid "I cannot query the JWKS URI of the identity provider: ~a" +msgstr "je ne peux pas requêter l’URI de JWKS du fournisseur d’identité : ~a" + +#: src/scm/webid-oidc/jws.scm:503 +msgid "I cannot query the JWKS URI of the identity provider" +msgstr "impossible de requêter l’URI de JWKS du fournisseur d’identité" + +#: src/scm/webid-oidc/jws.scm:531 +#, scheme-format +msgid "the token is signed in the future, ~a, relative to current ~a" +msgstr "" +"le jeton est signé dans le futur, ~a, par rapport à la date courante, ~a" + +#: src/scm/webid-oidc/jws.scm:540 +#, scheme-format +msgid "the token expired ~a, which is in the past (from ~a)" +msgstr "le jeton a expiré le ~a, qui est dans le passé (depuis ~a)" + +#: src/scm/webid-oidc/jws.scm:563 #, scheme-format msgid "cannot decode a JWS: ~a" msgstr "impossible de décoder un JWS : ~a" -#: src/scm/webid-oidc/jws.scm:255 +#: src/scm/webid-oidc/jws.scm:565 msgid "cannot decode a JWS" msgstr "impossible de décoder un JWS" -#: src/scm/webid-oidc/jws.scm:272 +#: src/scm/webid-oidc/jws.scm:583 #, scheme-format msgid "cannot encode a JWS: ~a" msgstr "impossible d’encoder un JWS : ~a" -#: src/scm/webid-oidc/jws.scm:274 +#: src/scm/webid-oidc/jws.scm:585 msgid "cannot encode a JWS" msgstr "impossible d’encoder un JWS" @@ -1330,80 +1203,32 @@ msgstr "il n’y a pas de type de contenu" msgid "unexpected content-type: ~s" msgstr "type de contenu inattendu : ~s" -#: src/scm/webid-oidc/oidc-id-token.scm:68 -#, scheme-format -msgid "this is not an ID token, because it is not even a JWS: ~a" -msgstr "ce n’est pas un jeton d’ID, parce que ce n’est même pas un JWS : ~a" - -#: src/scm/webid-oidc/oidc-id-token.scm:71 -msgid "this is not an ID token, because it is not even a JWS" -msgstr "ce n’est pas un jeton d’ID, parce que ce n’est même pas un JWS" - -#: src/scm/webid-oidc/oidc-id-token.scm:73 -#, scheme-format -msgid "this is not an ID token: ~a" -msgstr "ce n’est pas un jeton d’ID : ~a" - -#: src/scm/webid-oidc/oidc-id-token.scm:76 -msgid "this is not an ID token" -msgstr "ce n’est pas un jeton d’ID" - -#: src/scm/webid-oidc/oidc-id-token.scm:132 -#, scheme-format -msgid "the \"sub\" field should be a string, ~s is given" -msgstr "le champ « sub » doit être une chaîne de caractères, pas ~s" - -#: src/scm/webid-oidc/oidc-id-token.scm:139 -#, scheme-format -msgid "the \"aud\" field should be an URI, ~s is given" -msgstr "le champ « aud » doit être une URI, pas ~s" - -#: src/scm/webid-oidc/oidc-id-token.scm:146 -#, scheme-format -msgid "the \"nonce\" field should be a string, ~s is given" -msgstr "le champ « nonce » doit être une chaîne de caractères, pas ~s" - -#: src/scm/webid-oidc/oidc-id-token.scm:166 -msgid "the payload should be a JSON object" -msgstr "la charge utile doit être un objet JSON" - -#: src/scm/webid-oidc/oidc-id-token.scm:219 +#: src/scm/webid-oidc/oidc-id-token.scm:72 #, scheme-format -msgid "the ID token is invalid: ~a" -msgstr "le jeton d’ID est invalide : ~a" +msgid "invalid OIDC ID token: ~a" +msgstr "jeton d’identité OIDC invalide : ~a" -#: src/scm/webid-oidc/oidc-id-token.scm:221 -msgid "the ID token is invalid" -msgstr "le jeton d’ID est invalide" +#: src/scm/webid-oidc/oidc-id-token.scm:74 +msgid "invalid OIDC id token" +msgstr "jeton d’identité OIDC invalide" -#: src/scm/webid-oidc/oidc-id-token.scm:259 -#, scheme-format -msgid "I cannot query the JWKS URI of the identity provider: ~a" -msgstr "je ne peux pas requêter l’URI de JWKS du fournisseur d’identité : ~a" +#: src/scm/webid-oidc/oidc-id-token.scm:105 +msgid "#:sub should be a string" +msgstr "#:sub doit être une chaîne de caractères" -#: src/scm/webid-oidc/oidc-id-token.scm:261 -msgid "I cannot query the JWKS URI of the identity provider" -msgstr "impossible de requêter l’URI de JWKS du fournisseur d’identité" +#: src/scm/webid-oidc/oidc-id-token.scm:110 +msgid "#:aud should be a string" +msgstr "#:aud doit être une chaîne de caractères" -#: src/scm/webid-oidc/oidc-id-token.scm:272 -#, scheme-format -msgid "the ID token is signed in the future, ~a, relative to current ~a" +#: src/scm/webid-oidc/oidc-id-token.scm:126 +msgid "" +"when making an ID token either its required fields (#:alg, #:webid, #:iss, #:" +"sub, #:aud, #:iat and #:exp) or (#:jwt-header and #:jwt-payload) should be " +"passed" msgstr "" -"le jeton d’ID est signé dans le futur, ~a, par rapport à la date courante, ~a" - -#: src/scm/webid-oidc/oidc-id-token.scm:281 -#, scheme-format -msgid "the ID token expired ~a, which is in the past (from ~a)" -msgstr "le jeton d’ID a expiré le ~a, qui est dans le passé (depuis ~a)" - -#: src/scm/webid-oidc/oidc-id-token.scm:295 -#, scheme-format -msgid "cannot encode the ID token: ~a" -msgstr "impossible d’encoder le jeton d’ID : ~a" - -#: src/scm/webid-oidc/oidc-id-token.scm:297 -msgid "cannot encode the ID token" -msgstr "impossible d’encoder le jeton d’ID" +"lors de la création d’un jeton d’identité il faut soit passer ses champs " +"requis (#:alg, #:webid, #:iss, #:sub, #:aud, #:iat et #:exp) soit (#:jwt-" +"header et #:jwt-payload)" #: src/scm/webid-oidc/program.scm:57 #, scheme-format @@ -2387,47 +2212,47 @@ msgstr "~a : échec d’authentificationn : ~a\n" msgid "~a: authentication failure\n" msgstr "~a : échec d’authentification\n" -#: src/scm/webid-oidc/resource-server.scm:160 -#: src/scm/webid-oidc/resource-server.scm:351 +#: src/scm/webid-oidc/resource-server.scm:172 +#: src/scm/webid-oidc/resource-server.scm:363 msgid "reason-phrase|Precondition Failed" msgstr "Échec de Précondition" -#: src/scm/webid-oidc/resource-server.scm:175 +#: src/scm/webid-oidc/resource-server.scm:187 msgid "reason-phrase|Not Modified" msgstr "Non Modifié" -#: src/scm/webid-oidc/resource-server.scm:191 +#: src/scm/webid-oidc/resource-server.scm:203 msgid "The owner is not defined." msgstr "Le propriétaire n’est pas défini." -#: src/scm/webid-oidc/resource-server.scm:263 +#: src/scm/webid-oidc/resource-server.scm:275 msgid "reason-phrase|Created" msgstr "Créé" -#: src/scm/webid-oidc/resource-server.scm:288 +#: src/scm/webid-oidc/resource-server.scm:300 #, scheme-format msgid "~a: ignoring a group that cannot be fetched: ~a\n" msgstr "~a : j’ignore un groupe qui n’a pas pu être téléchargé : ~a\n" -#: src/scm/webid-oidc/resource-server.scm:292 +#: src/scm/webid-oidc/resource-server.scm:304 #, scheme-format msgid "~a: ignoring a group that cannot be fetched\n" msgstr "~a : j’ignore un groupe qui ne peut pas être téléchargé\n" -#: src/scm/webid-oidc/resource-server.scm:316 -#: src/scm/webid-oidc/token-endpoint.scm:103 +#: src/scm/webid-oidc/resource-server.scm:328 +#: src/scm/webid-oidc/token-endpoint.scm:105 msgid "reason-phrase|Forbidden" msgstr "Interdit" -#: src/scm/webid-oidc/resource-server.scm:337 +#: src/scm/webid-oidc/resource-server.scm:349 msgid "reason-phrase|Conflict" msgstr "Conflit" -#: src/scm/webid-oidc/resource-server.scm:344 +#: src/scm/webid-oidc/resource-server.scm:356 msgid "reason-phrase|Unsupported Media Type" msgstr "Type de Média Non Supporté" -#: src/scm/webid-oidc/resource-server.scm:358 +#: src/scm/webid-oidc/resource-server.scm:370 msgid "reason-phrase|Not Acceptable" msgstr "Inacceptable" @@ -2506,51 +2331,51 @@ msgstr "pendant la mise à jour du fichier ~s : ~a" msgid "an error happened while updating file ~s" msgstr "une erreur est survenue pendant la mise à jour du fichier ~s" -#: src/scm/webid-oidc/token-endpoint.scm:91 +#: src/scm/webid-oidc/token-endpoint.scm:93 #, scheme-format msgid "while handling web failure for the token endpoint: ~a" msgstr "lors de la gestion d’un échec web pour le terminal de jeton : ~a" -#: src/scm/webid-oidc/token-endpoint.scm:93 +#: src/scm/webid-oidc/token-endpoint.scm:95 msgid "an error happened during the token endpoint failure handling" msgstr "" "une erreur est survenue pendant la gestion d’un échec du terminal de jeton" -#: src/scm/webid-oidc/token-endpoint.scm:222 +#: src/scm/webid-oidc/token-endpoint.scm:225 msgid "missing grant type" msgstr "type d’offre manquant" -#: src/scm/webid-oidc/token-endpoint.scm:226 +#: src/scm/webid-oidc/token-endpoint.scm:229 msgid "<p>You did not specify a grant_type for this request.</p>" msgstr "<p>Vous n’avez pas spécifié de grant_type pour cette requête.</p>" -#: src/scm/webid-oidc/token-endpoint.scm:240 +#: src/scm/webid-oidc/token-endpoint.scm:243 msgid "missing authorization code" msgstr "code d’autorisation manquant" -#: src/scm/webid-oidc/token-endpoint.scm:244 +#: src/scm/webid-oidc/token-endpoint.scm:247 msgid "" "<p>You want to grant an authorization code, but you did not set one.</p>" msgstr "" "<p>Vous voulez offrir un code d’autorisation, mais vous n’en avez pas défini." "</p>" -#: src/scm/webid-oidc/token-endpoint.scm:258 +#: src/scm/webid-oidc/token-endpoint.scm:268 msgid "missing refresh token" msgstr "jeton de rafraîchissement manquant" -#: src/scm/webid-oidc/token-endpoint.scm:262 +#: src/scm/webid-oidc/token-endpoint.scm:272 msgid "<p>You want to grant a refresh token, but you did not set one.</p>" msgstr "" "<p>Vous voulez offrir un jeton de rafraîchissement, mais vous n’en avez pas " "défini.</p>" -#: src/scm/webid-oidc/token-endpoint.scm:275 +#: src/scm/webid-oidc/token-endpoint.scm:285 #, scheme-format msgid "unsupported grant type: ~s" msgstr "type d’offre non supporté : ~s" -#: src/scm/webid-oidc/token-endpoint.scm:280 +#: src/scm/webid-oidc/token-endpoint.scm:290 #, scheme-format msgid "" "<p>You want to use <pre>~s</pre> as a grant type, but this is not supported." @@ -2560,6 +2385,244 @@ msgstr "" "supporté.</p>" #, scheme-format +#~ msgid "this is not an access token, because it is not even a JWS: ~a" +#~ msgstr "" +#~ "ce n’est pas un jeton d’accès, parce que ce n’est même pas un JWS : ~a" + +#~ msgid "this is not an access token, because it is not even a JWS" +#~ msgstr "ce n’est pas un jeton d’accès, parce que ce n’est même pas un JWS" + +#, scheme-format +#~ msgid "the payload is missing ~s" +#~ msgstr "il manque ~s à la charge utile" + +#, scheme-format +#~ msgid "the \"webid\" field should be an URI, ~s is given" +#~ msgstr "le champ « webid » doit être une URI, pas ~s" + +#, scheme-format +#~ msgid "the \"iss\" field should be an URI, ~s is given" +#~ msgstr "le champ « iss » doit être une URI, pas ~s" + +#, scheme-format +#~ msgid "the \"aud\" field should be set to \"solid\", ~s is given" +#~ msgstr "le champ « aud » doit être « solid », pas ~s" + +#, scheme-format +#~ msgid "the \"iat\" field should be a timestamp, ~s is given" +#~ msgstr "le champ « iat » doit être un horodatage, pas ~s" + +#, scheme-format +#~ msgid "the \"exp\" field should be a timestamp, ~s is given" +#~ msgstr "le champ « exp » doit être un horodatage, pas ~s" + +#~ msgid "the \"cnf\" / \"jkt\" field is missing" +#~ msgstr "le champ « cnf » / « jkt » est manquant" + +#, scheme-format +#~ msgid "the \"cnf\" / \"jkt\" field should be a string, ~s is given" +#~ msgstr "" +#~ "le champ « cnf » / « jkt » doit être une chaîne de caractères, pas ~s" + +#, scheme-format +#~ msgid "the \"cnf\" field should be an object, ~s is given" +#~ msgstr "le champ « cnf » doit être un objet JSON, pas ~s" + +#, scheme-format +#~ msgid "the access token is invalid: ~a" +#~ msgstr "le jeton d’accès est invalide : ~a" + +#~ msgid "the access token is invalid" +#~ msgstr "le jeton d’accès est invalide" + +#, scheme-format +#~ msgid "I cannot query the identity provider public keys: ~a" +#~ msgstr "" +#~ "je ne peux pas requêter les clés publiques du fournisseur d’identité : ~a" + +#~ msgid "I cannot query the identity provider public keys" +#~ msgstr "" +#~ "je ne peux pas requêter les clés publiques du fournisseur d’identité" + +#, scheme-format +#~ msgid "the access token is signed in the future, ~a, relative to current ~a" +#~ msgstr "" +#~ "le jeton d’accès est signé dans le futur, le ~a, par rapport à la date " +#~ "courante, le ~a" + +#, scheme-format +#~ msgid "the access token expired ~a, which is in the past (from ~a)" +#~ msgstr "le jeton d’accès a expiré le ~a, qui est dans le passé (de ~a)" + +#, scheme-format +#~ msgid "cannot encode the access token: ~a" +#~ msgstr "impossible d’encoder le jeton d’accès : ~a" + +#~ msgid "cannot encode the access token" +#~ msgstr "impossible d’encoder le jeton d’accès" + +#, scheme-format +#~ msgid "this is not an authorization code, because it is not even a JWS: ~a" +#~ msgstr "" +#~ "ce n’est pas un code d’autorisation, parce que ce n’est même pas un JWS : " +#~ "~a" + +#~ msgid "this is not an authorization code, because it is not even a JWS" +#~ msgstr "" +#~ "ce n’est pas un code d’autorisation, parce que ce n’est même pas un JWS" + +#, scheme-format +#~ msgid "this is not an authorization code: ~a" +#~ msgstr "ce n’est pas un code d’autorisation : ~a" + +#~ msgid "this is not an authorization code" +#~ msgstr "ce n’est pas un code d’autorisation" + +#, scheme-format +#~ msgid "the \"jti\" field should be a string, ~s is given" +#~ msgstr "le champ « jti » doit être une chaîne de caractères, pas ~s" + +#, scheme-format +#~ msgid "the authorization code is invalid: ~a" +#~ msgstr "le code d’autorisation est invalide : ~a" + +#~ msgid "the authorization code is invalid" +#~ msgstr "le code d’autorisation est invalide" + +#, scheme-format +#~ msgid "the authorization expired ~a, which is in the past (from ~a)" +#~ msgstr "" +#~ "le code d’autorisation a expiré le ~a, qui est dans le passé (depuis ~a)" + +#, scheme-format +#~ msgid "cannot encode the authorization code: ~a" +#~ msgstr "impossible d’encoder le code d’autorisation : ~a" + +#~ msgid "cannot encode the authorization code" +#~ msgstr "impossible d’encoder le code d’autorisation" + +#, scheme-format +#~ msgid "this is not a DPoP proof, because it is not even a JWS: ~a" +#~ msgstr "" +#~ "ce n’est pas une preuve DPoP, parce que ce n’est même pas un JWS : ~a" + +#~ msgid "this is not a DPoP proof, because it is not even a JWS" +#~ msgstr "ce n’est pas une preuve DPoP, parce que ce n’est même pas un JWS" + +#, scheme-format +#~ msgid "the DPoP proof is missing ~s" +#~ msgstr "il manque ~s à la preuve DPoP" + +#, scheme-format +#~ msgid "the \"htm\" field should be a string, not ~s" +#~ msgstr "le champ « htm » doit être une chaîne de caractères, pas ~s" + +#, scheme-format +#~ msgid "the \"iat\" field should be a timestamp, not ~s" +#~ msgstr "le champ « iat » doit être un horodatage, pas ~s" + +#, scheme-format +#~ msgid "the \"ath\" field should be an encoded JWT, not ~s" +#~ msgstr "le champ « ath » doit être un JWT encodé, pas ~s" + +#, scheme-format +#~ msgid "the \"alg\" field should be a string, not ~s" +#~ msgstr "le champ « alg » doit être une chaîne de caractères, pas ~s" + +#~ msgid "the \"jwk\" field should not contain the private key" +#~ msgstr "le champ « jwk » ne doit pas contenir la clé privée" + +#, scheme-format +#~ msgid "the DPoP proof cannot be decoded: ~a" +#~ msgstr "impossible de décoder la preuve DPoP : ~a" + +#~ msgid "the DPoP proof cannot be decoded" +#~ msgstr "impossible de décoder la preuve DPoP" + +#, scheme-format +#~ msgid "" +#~ "the DPoP proof is signed in the future, ~a, relative to the current date, " +#~ "~a" +#~ msgstr "" +#~ "la preuve DPoP est signée dans le futur, le ~a, par rapport à la date " +#~ "courante, ~a" + +#, scheme-format +#~ msgid "the DPoP proof is too old, it was signed ~a and now it is ~a" +#~ msgstr "" +#~ "la preuve DPoP est trop vieille, elle a été signée le ~a et nous sommes " +#~ "maintenant le ~a" + +#~ msgid "cannot encode a DPoP proof" +#~ msgstr "impossible d’encoder la preuve DPoP" + +#, scheme-format +#~ msgid "the JWS is invalid: ~a" +#~ msgstr "le JWS est invalide : ~a" + +#~ msgid "the JWS is invalid" +#~ msgstr "le JWS est invalide" + +#~ msgid "the JWS header does not have an \"alg\" field" +#~ msgstr "l’en-tête JWS n’a pas de champ « alg »" + +#~ msgid "invalid JSON object as payload" +#~ msgstr "objet JSON invalide comme charge utile" + +#, scheme-format +#~ msgid "invalid signature algorithm: ~s" +#~ msgstr "algorithme de signature invalide : ~s" + +#, scheme-format +#~ msgid "invalid \"alg\" value: ~s" +#~ msgstr "valeur « alg » invalide : ~s" + +#~ msgid "invalid JSON object as header" +#~ msgstr "objet JSON d’en-tête invalide" + +#~ msgid "this is not a pair" +#~ msgstr "ce n’est pas une paire" + +#, scheme-format +#~ msgid "this is not an ID token, because it is not even a JWS: ~a" +#~ msgstr "ce n’est pas un jeton d’ID, parce que ce n’est même pas un JWS : ~a" + +#~ msgid "this is not an ID token, because it is not even a JWS" +#~ msgstr "ce n’est pas un jeton d’ID, parce que ce n’est même pas un JWS" + +#, scheme-format +#~ msgid "this is not an ID token: ~a" +#~ msgstr "ce n’est pas un jeton d’ID : ~a" + +#~ msgid "this is not an ID token" +#~ msgstr "ce n’est pas un jeton d’ID" + +#, scheme-format +#~ msgid "the \"sub\" field should be a string, ~s is given" +#~ msgstr "le champ « sub » doit être une chaîne de caractères, pas ~s" + +#, scheme-format +#~ msgid "the \"aud\" field should be an URI, ~s is given" +#~ msgstr "le champ « aud » doit être une URI, pas ~s" + +#~ msgid "the payload should be a JSON object" +#~ msgstr "la charge utile doit être un objet JSON" + +#, scheme-format +#~ msgid "the ID token is invalid: ~a" +#~ msgstr "le jeton d’ID est invalide : ~a" + +#~ msgid "the ID token is invalid" +#~ msgstr "le jeton d’ID est invalide" + +#, scheme-format +#~ msgid "cannot encode the ID token: ~a" +#~ msgstr "impossible d’encoder le jeton d’ID : ~a" + +#~ msgid "cannot encode the ID token" +#~ msgstr "impossible d’encoder le jeton d’ID" + +#, scheme-format #~ msgid "unknown key type ~s" #~ msgstr "type de clé inconnu ~s" diff --git a/src/scm/webid-oidc/access-token.scm b/src/scm/webid-oidc/access-token.scm index 7e67270..7c23126 100644 --- a/src/scm/webid-oidc/access-token.scm +++ b/src/scm/webid-oidc/access-token.scm @@ -29,7 +29,17 @@ #:use-module (srfi srfi-19) #:use-module (srfi srfi-26) #:use-module (ice-9 exceptions) + #:use-module (ice-9 receive) + #:use-module (oop goops) #:declarative? #t + #:re-export + ( + alg iat exp iss + token->jwt + decode + encode + issue + ) #:export ( @@ -37,21 +47,7 @@ make-invalid-access-token invalid-access-token? - the-access-token - access-token? - - access-token-alg - - access-token-webid - access-token-iss - access-token-aud - access-token-iat - access-token-exp - access-token-client-id - access-token-cnf/jkt - - access-token-decode - issue-access-token + <access-token> webid aud client-id cnf/jkt )) (define-exception-type @@ -60,289 +56,109 @@ make-invalid-access-token invalid-access-token?) -;; The order is meaningful in this module, the-access-token reorders -;; them. -(define (the-access-token x) - (with-exception-handler - (lambda (error) - (let ((final-message - (cond - ((invalid-jws? error) - (if (exception-with-message? error) - (format #f (G_ "this is not an access token, because it is not even a JWS: ~a") - (exception-message error)) - (format #f (G_ "this is not an access token, because it is not even a JWS")))) - (else - (if (exception-with-message? error) - (format #f (G_ "this is not an access token: ~a") - (exception-message error)) - (format #f (G_ "this is not an access token"))))))) - (raise-exception - (make-exception - (make-invalid-access-token) - (make-exception-with-message final-message) - error)))) - (lambda () - (match (the-jws x) - ((header . payload) - (let examine-payload ((payload payload) - (webid #f) - (iss #f) - (aud #f) - (iat #f) - (exp #f) - (cnf #f) - (client-id #f) - (other-fields '())) - (match payload - (() - (unless (and webid iss aud iat exp cnf client-id) - ;; Missing some things - (fail (format #f (G_ "the payload is missing ~s") - `(,@(if webid '() '("webid")) - ,@(if iss '() '("iss")) - ,@(if aud '() '("aud")) - ,@(if iat '() '("iat")) - ,@(if exp '() '("exp")) - ,@(if cnf '() '("cnf")) - ,@(if client-id '() '("client_id")))))) - `(,header - . ((webid . ,(uri->string webid)) - (iss . ,(uri->string iss)) - (aud . "solid") - (iat . ,(time-second (date->time-utc iat))) - (exp . ,(time-second (date->time-utc exp))) - (client_id . ,(uri->string client-id)) - (cnf . ,cnf) - ,@(reverse other-fields)))) - ((('webid . (? string? (= string->uri (? uri? webid-given)))) payload ...) - (examine-payload payload - (or webid webid-given) - iss aud iat exp cnf client-id other-fields)) - ((('webid . infringing) payload ...) - (fail (format #f (G_ "the \"webid\" field should be an URI, ~s is given") - infringing))) - ((('iss . (? string? (= string->uri (? uri? iss-given)))) payload ...) - (examine-payload payload webid - (or iss iss-given) - aud iat exp cnf client-id other-fields)) - ((('iss . infringing) payload ...) - (fail (format #f (G_ "the \"iss\" field should be an URI, ~s is given") - infringing))) - ((('aud . "solid") payload ...) - (examine-payload payload webid iss #t iat exp cnf client-id other-fields)) - ((('aud . infringing) payload ...) - (fail (format #f (G_ "the \"aud\" field should be set to \"solid\", ~s is given") - infringing))) - ((('iat . (? (cute >= <> 0) (? integer? iat-given))) payload ...) - (examine-payload payload webid iss aud - (or iat (time-utc->date (make-time time-utc 0 iat-given))) - exp cnf client-id other-fields)) - ((('iat . infringing) payload ...) - (fail (format #f (G_ "the \"iat\" field should be a timestamp, ~s is given") - infringing))) - ((('exp . (? (cute >= <> 0) (? integer? exp-given))) payload ...) - (examine-payload payload webid iss aud iat - (or exp (time-utc->date (make-time time-utc 0 exp-given))) - cnf client-id other-fields)) - ((('exp . infringing) payload ...) - (fail (format #f (G_ "the \"exp\" field should be a timestamp, ~s is given") - infringing))) - ((('cnf . cnf) payload ...) - (let examine-cnf ((data cnf) - (jkt #f) - (other-cnf-fields '())) - (match data - (() - (unless jkt - (fail (format #f (G_ "the \"cnf\" / \"jkt\" field is missing")))) - (examine-payload payload webid iss aud iat exp - `((jkt . ,jkt) - ,@(reverse other-cnf-fields)) - client-id other-fields)) - ((('jkt . (? string? jkt-given)) data ...) - (examine-cnf data (or jkt jkt-given other-cnf-fields) other-cnf-fields)) - ((('jkt . infringing) _ ...) - (fail (format #f (G_ "the \"cnf\" / \"jkt\" field should be a string, ~s is given") - infringing))) - ((field data ...) - (examine-cnf data jkt `(,field ,@other-cnf-fields))) - (data - (fail (format #f (G_ "the \"cnf\" field should be an object, ~s is given") - data)))))) - ((('client_id . (? string? (= string->uri (? uri? client-id-given)))) payload ...) - (examine-payload payload webid iss aud iat exp cnf - (or client-id client-id-given) - other-fields)) - ((('client_id . infringing) payload ...) - (fail (format #f (G_ "the \"client_id\" field should be an URI, ~s is given") - infringing))) - ((field payload ...) - (examine-payload payload webid iss aud iat exp cnf client-id - `(,field ,@other-fields)))))) - (else - (scm-error 'wrong-type-arg "the-access-token" - "expected a pair of lists" - '() - (list x))))))) - -(define (access-token? x) - (false-if-exception (the-access-token x))) - -(define (access-token-alg code) - (match (the-access-token code) - ((header . _) - (string->symbol (assq-ref header 'alg))))) - -(define (access-token-webid code) - (match (the-access-token code) - ((_ . payload) - (string->uri (assq-ref payload 'webid))))) - -(define (access-token-iss code) - (match (the-access-token code) - ((_ . payload) - (string->uri (assq-ref payload 'iss))))) +(define-class <access-token> (<time-bound-token> <oidc-token>) + (webid #:init-keyword #:webid #:accessor webid) + (aud #:init-keyword #:aud #:accessor aud) + (client-id #:init-keyword #:client-id #:accessor client-id) + (cnf/jkt #:init-keyword #:cnf/jkt #:accessor cnf/jkt)) -(define (access-token-aud code) - (match (the-access-token code) - ((_ . payload) - (assq-ref payload 'aud)))) - -(define (access-token-iat code) - (match (the-access-token code) - ((_ . payload) - (time-utc->date - (make-time time-utc 0 (assq-ref payload 'iat)))))) - -(define (access-token-exp code) - (match (the-access-token code) - ((_ . payload) - (time-utc->date - (make-time time-utc 0 (assq-ref payload 'exp)))))) - -(define (access-token-client-id code) - (match (the-access-token code) - ((_ . payload) - (string->uri (assq-ref payload 'client-id))))) - -(define (access-token-cnf/jkt code) - (match (the-access-token code) - ((_ . payload) - (assq-ref (assq-ref payload 'cnf) 'jkt)))) - -(define* (access-token-decode str #:key (http-get http-get)) +(define-method (initialize (token <access-token>) initargs) (with-exception-handler (lambda (error) - (let ((final-message - (if (exception-with-message? error) - (format #f (G_ "the access token is invalid: ~a") - (exception-message error)) - (format #f (G_ "the access token is invalid"))))) - (raise-exception - (make-exception - (make-invalid-access-token) - (make-exception-with-message final-message) - error)))) + (raise-exception + (make-exception + (make-invalid-access-token) + (make-exception-with-message + (if (exception-with-message? error) + (format #f (G_ "invalid access token: ~a") + (exception-message error)) + (G_ "invalid access token"))) + error))) (lambda () - (jws-decode - str - (lambda (token) - (let* ((iss (access-token-iss token)) - (cfg - (with-exception-handler - (lambda (error) - (let ((final-message - (if (exception-with-message? error) - (format #f (G_ "I cannot query the identity provider configuration: ~a") - (exception-message error)) - (format #f (G_ "I cannot query the identity provider configuratioon"))))) - (raise-exception - (make-exception - (make-cannot-query-identity-provider iss) - (make-exception-with-message final-message) - error)))) - (lambda () - (get-oidc-configuration - (uri-host iss) - #:userinfo (uri-userinfo iss) - #:port (uri-port iss) - #:http-get http-get)))) - (jwks - (with-exception-handler - (lambda (error) - (let ((final-message - (if (exception-with-message? error) - (format #f (G_ "I cannot query the identity provider public keys: ~a") - (exception-message error)) - (format #f (G_ "I cannot query the identity provider public keys"))))) - (raise-exception - (make-exception - (make-cannot-query-identity-provider iss) - (make-exception-with-message final-message) - error)))) - (lambda () - (oidc-configuration-jwks cfg #:http-get http-get))))) - (let ((iat (access-token-iat token)) - (exp (access-token-exp token)) - (current-date ((p:current-date)))) - (let ((iat-s (time-second (date->time-utc iat))) - (exp-s (time-second (date->time-utc exp))) - (current-s (time-second (date->time-utc current-date)))) - (when (>= iat-s (+ current-s 5)) - (let ((final-message - (format #f (G_ "the access token is signed in the future, ~a, relative to current ~a") - (date->string iat) - (date->string current-date)))) - (raise-exception - (make-exception - (make-signed-in-future iat current-date) - (make-exception-with-message final-message))))) - (when (>= current-s exp-s) - (let ((final-message - (format #f (G_ "the access token expired ~a, which is in the past (from ~a)") - (date->string exp) - (date->string current-date)))) - (raise-exception - (make-exception - (make-expired exp current-date) - (make-exception-with-message final-message))))))) - jwks)))))) - -(define (access-token-encode access-token key) - (with-exception-handler - (lambda (error) - (let ((final-message - (if (exception-with-message? error) - (format #f (G_ "cannot encode the access token: ~a") - (exception-message error)) - (format #f (G_ "cannot encode the access token"))))) - (raise-exception - (make-exception-with-message final-message)))) - (lambda () - (jws-encode access-token key)))) - -(define* (issue-access-token - issuer-key - #:key - (webid #f) - (iss #f) - (validity 3600) - (client-key #f) - (cnf/jkt #f) - (client-id #f)) - (when client-key - (set! cnf/jkt (jkt client-key))) - (let* ((iat (time-second (date->time-utc ((p:current-date))))) - (exp (+ iat validity))) - (jws-encode - (the-access-token - `(((alg . ,(symbol->string (alg issuer-key)))) - . ((webid . ,(uri->string webid)) - (iss . ,(uri->string iss)) - (aud . "solid") - (iat . ,iat) - (exp . ,exp) - (cnf . ((jkt . ,cnf/jkt))) - (client_id . ,(uri->string client-id))))) - issuer-key))) + (next-method) + (let-keywords + initargs #t + ((webid #f) + (aud "solid") + (client-id #f) + (cnf/jkt #f) + (client-key #f) + (jwt-header #f) + (jwt-payload #f)) + (let do-initialize ((webid webid) + (aud aud) + (client-id client-id) + (cnf/jkt cnf/jkt) + (client-key client-key) + (jwt-header jwt-header) + (jwt-payload jwt-payload)) + (cond + ((string? webid) + (do-initialize (string->uri webid) + aud + client-id + cnf/jkt + client-key + jwt-header + jwt-payload)) + ((string? client-id) + (do-initialize webid + aud + (string->uri client-id) + cnf/jkt + client-key + jwt-header + jwt-payload)) + ((and (not cnf/jkt) client-key) + (do-initialize webid aud client-id (jkt client-key) #f jwt-header jwt-payload)) + ((and webid client-id cnf/jkt) + (unless (uri? webid) + (scm-error 'wrong-type-arg "make" + (G_ "#:webid should be an URI") + '() + (list webid))) + (unless (uri? client-id) + (scm-error 'wrong-type-arg "make" + (G_ "#:client-id should be an URI") + '() + (list client-id))) + (unless (string? cnf/jkt) + (scm-error 'wrong-type-arg "make" + (G_ "#:cnf/jkt should be a string") + '() + (list cnf/jkt))) + (unless (equal? aud "solid") + (scm-error 'wrong-type-arg "make" + (G_ "#:aud should be exactly \"solid\"") + '() + (list aud))) + (slot-set! token 'webid webid) + (slot-set! token 'aud aud) + (slot-set! token 'client-id client-id) + (slot-set! token 'cnf/jkt cnf/jkt)) + ((and jwt-header jwt-payload) + (do-initialize (assq-ref jwt-payload 'webid) + (assq-ref jwt-payload 'aud) + (assq-ref jwt-payload 'client_id) + (assq-ref (assq-ref jwt-payload 'cnf) 'jkt) + #f #f #f)) + (else + (raise-exception + (make-exception + (make-invalid-jws) + (make-exception-with-message + (G_ "when making an access token either its required fields (#:alg, #:webid, #:iss, #:aud, #:client-id, #:cnf/jkt, #:iat and #:exp) or (#:jwt-header and #:jwt-payload) should be passed"))))))))))) + +(define-method (token->jwt (token <access-token>)) + (receive (base-header base-payload) + (next-method) + (values + base-header + `((webid . ,(uri->string (webid token))) + (iss . ,(uri->string (iss token))) + (aud . ,(aud token)) + (client_id . ,(uri->string (client-id token))) + (cnf . ((jkt . ,(cnf/jkt token)))) + (iat . ,(time-second (date->time-utc (iat token)))) + (exp . ,(time-second (date->time-utc (exp token)))) + ,@base-payload)))) diff --git a/src/scm/webid-oidc/authorization-code.scm b/src/scm/webid-oidc/authorization-code.scm index 1481b2c..13b7ac4 100644 --- a/src/scm/webid-oidc/authorization-code.scm +++ b/src/scm/webid-oidc/authorization-code.scm @@ -26,7 +26,18 @@ #:use-module (webid-oidc web-i18n) #:use-module (ice-9 match) #:use-module (ice-9 exceptions) + #:use-module (ice-9 receive) + #:use-module (ice-9 optargs) + #:use-module (oop goops) #:declarative? #t + #:re-export + ( + alg iat exp nonce + token->jwt + decode + encode + issue + ) #:export ( @@ -34,18 +45,7 @@ make-invalid-authorization-code invalid-authorization-code? - the-authorization-code - authorization-code? - - authorization-code-alg - - authorization-code-webid - authorization-code-client-id - authorization-code-jti - authorization-code-exp - - authorization-code-decode - issue-authorization-code + <authorization-code> webid client-id )) (define-exception-type @@ -54,171 +54,74 @@ make-invalid-authorization-code invalid-authorization-code?) -(define (the-authorization-code x) - (with-exception-handler - (lambda (error) - (let ((final-message - (cond - ((invalid-jws? error) - (if (exception-with-message? error) - (format #f (G_ "this is not an authorization code, because it is not even a JWS: ~a") - (exception-message error)) - (format #f (G_ "this is not an authorization code, because it is not even a JWS")))) - (else - (if (exception-with-message? error) - (format #f (G_ "this is not an authorization code: ~a") - (exception-message error)) - (format #f (G_ "this is not an authorization code"))))))) - (raise-exception - (make-exception - (make-invalid-authorization-code) - (make-exception-with-message final-message) - error)))) - (lambda () - (match (the-jws x) - ((header . payload) - (let examine-payload ((payload payload) - (webid #f) - (client-id #f) - (jti #f) - (exp #f) - (other-fields '())) - (match payload - (() - (unless (and webid client-id jti exp) - (fail (format #f (G_ "the payload is missing ~s") - `(,@(if webid '() '("webid")) - ,@(if client-id '() '("client_id")) - ,@(if jti '() '("jti")) - ,@(if exp '() '("exp")))))) - `(,header - . ((webid . ,(uri->string webid)) - (client_id . ,(uri->string client-id)) - (jti . ,jti) - (exp . ,(time-second (date->time-utc exp))) - ,@(reverse other-fields)))) - ((('webid . (? string? (= string->uri (? uri? webid-given)))) payload ...) - (examine-payload payload - (or webid webid-given) - client-id jti exp other-fields)) - ((('webid . infringing) payload ...) - (fail (format #f (G_ "the \"webid\" field should be an URI, ~s is given") - infringing))) - ((('client_id . (? string? (= string->uri (? uri? client-id-given)))) payload ...) - (examine-payload payload webid - (or client-id client-id-given) - jti exp other-fields)) - ((('client_id . infringing) payload ...) - (fail (format #f (G_ "the \"client_id\" field should be an URI, ~s is given") - infringing))) - ((('jti . (? string? jti-given)) payload ...) - (examine-payload payload webid client-id - (or jti jti-given) - exp other-fields)) - ((('jti . invalid) payload ...) - (fail (format #f (G_ "the \"jti\" field should be a string, ~s is given") - invalid))) - ((('exp . (? (lambda (x) (and (integer? x) (>= x 0))) exp-given)) payload ...) - (examine-payload payload webid client-id jti - (or exp (time-utc->date (make-time time-utc 0 exp-given))) - other-fields)) - ((('exp . infringing) payload ...) - (fail (format #f (G_ "the \"exp\" field should be a timestamp, ~s is given") - infringing))) - ((field payload ...) - (examine-payload payload webid client-id jti exp `(,field ,@other-fields)))))) - (else - (scm-error 'wrong-type-arg "the-authorization-code" - "expected a pair of lists" - '() - (list x))))))) - -(define (authorization-code? x) - (false-if-exception (the-authorization-code x))) +(define-class <authorization-code> (<single-use-token>) + (webid #:init-keyword #:webid #:accessor webid) + (client-id #:init-keyword #:client-id #:accessor client-id)) -(define (authorization-code-alg x) - (match (the-authorization-code x) - ((header . _) - (string->symbol (assq-ref header 'alg))))) - -(define (authorization-code-webid x) - (match (the-authorization-code x) - ((_ . payload) - (string->uri (assq-ref payload 'webid))))) - -(define (authorization-code-client-id x) - (match (the-authorization-code x) - ((_ . payload) - (string->uri (assq-ref payload 'client_id))))) - -(define (authorization-code-jti x) - (match (the-authorization-code x) - ((_ . payload) - (assq-ref payload 'jti)))) - -(define (authorization-code-exp x) - (match (the-authorization-code x) - ((_ . payload) - (time-utc->date (make-time time-utc 0 (assq-ref payload 'exp)))))) - -(define (authorization-code-decode str jwk) - (parameterize ((p:current-date - (time-second (date->time-utc ((p:current-date)))))) - (with-exception-handler - (lambda (error) - (let ((final-message - (if (exception-with-message? error) - (format #f (G_ "the authorization code is invalid: ~a") - (exception-message error)) - (format #f (G_ "the authorization code is invalid"))))) - (raise-exception - (make-exception - (make-invalid-authorization-code) - (make-exception-with-message final-message) - error)))) - (lambda () - (let ((code (the-authorization-code (jws-decode str (lambda (x) jwk))))) - (let ((exp (authorization-code-exp code)) - (current-date ((p:current-date)))) - (let ((exp-s (time-second (date->time-utc exp))) - (current-s (time-second (date->time-utc current-date)))) - (when (>= current-s exp-s) - (let ((final-message - (format #f (G_ "the authorization expired ~a, which is in the past (from ~a)") - (date->string exp) - (date->string current-date)))) - (raise-exception - (make-exception - (make-expired exp current-date) - (make-exception-with-message final-message))))) - (jti-check (authorization-code-jti code) - (- exp-s current-s)) - code))))))) - -(define (authorization-code-encode authorization-code key) +(define-method (initialize (token <authorization-code>) initargs) (with-exception-handler (lambda (error) - (let ((final-message - (if (exception-with-message? error) - (format #f (G_ "cannot encode the authorization code: ~a") - (exception-message error)) - (format #f (G_ "cannot encode the authorization code"))))) - (raise-exception - (make-exception-with-message final-message)))) + (raise-exception + (make-exception + (make-invalid-authorization-code) + (make-exception-with-message + (if (exception-with-message? error) + (format #f (G_ "invalid authorization code: ~a") + (exception-message error)) + (G_ "invalid authorization code"))) + error))) (lambda () - (jws-encode authorization-code key)))) - -(define* (issue-authorization-code issuer-key - #:key - (validity 120) - webid - client-id) - (let* ((iat (time-second (date->time-utc ((p:current-date))))) - (exp (+ iat validity))) - (authorization-code-encode - `(((alg . ,(symbol->string (alg issuer-key)))) - . ((webid . ,(uri->string webid)) - (client_id . ,(uri->string client-id)) - (exp . ,exp) - (jti . ,(stubs:random 12)))) - issuer-key))) + (next-method) + (let-keywords + initargs #t + ((webid #f) + (client-id #f) + (jwt-header #f) + (jwt-payload #f)) + (let do-initialize ((webid webid) + (client-id client-id) + (jwt-header jwt-header) + (jwt-payload jwt-payload)) + (cond + ((string? webid) + (do-initialize (string->uri webid) client-id jwt-header jwt-payload)) + ((string? client-id) + (do-initialize webid (string->uri client-id) jwt-header jwt-payload)) + ((and webid client-id) + (unless (uri? webid) + (scm-error 'wrong-type-arg "make" + (G_ "#:webid should be an URI") + '() + (list webid))) + (unless (uri? client-id) + (scm-error 'wrong-type-arg "make" + (G_ "#:client-id should be a string") + '() + (list client-id))) + (slot-set! token 'webid webid) + (slot-set! token 'client-id client-id)) + ((and jwt-header jwt-payload) + (do-initialize (assq-ref jwt-payload 'webid) + (assq-ref jwt-payload 'client_id) + #f #f)) + (else + (raise-exception + (make-exception + (make-invalid-jws) + (make-exception-with-message + (G_ "when making an authorization code either its required fields (#:webid and #:client-id) or (#:jwt-header and #:jwt-payload) should be passed"))))))))))) + +(define-method (token->jwt (token <authorization-code>)) + (receive (base-header base-payload) + (next-method) + (values + base-header + `((webid . ,(uri->string (webid token))) + (client_id . ,(uri->string (client-id token))) + ,@base-payload)))) + +(define-method (lookup-keys (token <authorization-code>) args) + (let-keywords + args #f + ((issuer-key #f)) + issuer-key)) diff --git a/src/scm/webid-oidc/authorization-endpoint.scm b/src/scm/webid-oidc/authorization-endpoint.scm index cf45a9c..4f171a2 100644 --- a/src/scm/webid-oidc/authorization-endpoint.scm +++ b/src/scm/webid-oidc/authorization-endpoint.scm @@ -106,7 +106,7 @@ (lambda (error) (error-application locale error)) (lambda () - (let ((code (issue-authorization-code + (let ((code (issue <authorization-code> jwk #:webid subject #:client-id client-id)) diff --git a/src/scm/webid-oidc/client.scm b/src/scm/webid-oidc/client.scm index 5b6b0ef..006c86a 100644 --- a/src/scm/webid-oidc/client.scm +++ b/src/scm/webid-oidc/client.scm @@ -137,11 +137,12 @@ (let* ((access-token (account:access-token account)) (dpop-proof (let ((key-pair (account:key-pair account))) - (issue-dpop-proof - key-pair - #:htm method - #:htu uri - #:access-token access-token)))) + (issue <dpop-proof> + key-pair + #:jwk (public-key key-pair) + #:htm method + #:htu uri + #:access-token access-token)))) (let ((all-headers `((dpop . ,dpop-proof) (authorization . (dpop . ,access-token)) diff --git a/src/scm/webid-oidc/client/accounts.scm b/src/scm/webid-oidc/client/accounts.scm index ddb592a..3591b52 100644 --- a/src/scm/webid-oidc/client/accounts.scm +++ b/src/scm/webid-oidc/client/accounts.scm @@ -27,12 +27,13 @@ #:use-module (srfi srfi-19) #:use-module (webid-oidc errors) #:use-module (webid-oidc web-i18n) + #:use-module (webid-oidc jws) #:use-module ((webid-oidc parameters) #:prefix p:) #:use-module ((webid-oidc stubs) #:prefix stubs:) #:use-module ((webid-oidc oidc-id-token) #:prefix id:) #:use-module ((webid-oidc oidc-configuration) #:prefix cfg:) #:use-module ((webid-oidc jwk) #:prefix jwk:) - #:use-module ((webid-oidc dpop-proof) #:prefix dpop:) + #:use-module (webid-oidc dpop-proof) #:use-module ((webid-oidc client client) #:prefix client:) #:use-module (web uri) #:use-module (web response) @@ -87,6 +88,7 @@ #:declarative? #t) (define <jwk:key-pair> jwk:<key-pair>) +(define <id:id-token> id:<id-token>) ;; This exception is continuable! Continue with the authorization ;; code. @@ -253,10 +255,11 @@ (unless key-pair (set! key-pair (client:client-key-pair client))) (let ((dpop-proof - (dpop:issue-dpop-proof - key-pair - #:htm 'POST - #:htu token-endpoint))) + (issue <dpop-proof> + key-pair + #:jwk (jwk:public-key key-pair) + #:htm 'POST + #:htu token-endpoint))) (receive (response response-body) ((anonymous-http-request) token-endpoint #:method 'POST @@ -368,25 +371,24 @@ decoding-error)))) (lambda () (set! id-token - (id:id-token-decode id-token - #:http-get - (http-request->http-get (anonymous-http-request)))))) + (decode <id:id-token> id-token + #:http-request (anonymous-http-request))))) ;; We are not interested in the ID token ;; signature anymore, because it won’t be ;; transmitted to other parties and we know that ;; it is valid. (when (and subject - (not (equal? subject (id:id-token-webid id-token)))) + (not (equal? subject (id:webid id-token)))) (let ((final-message (format #f (G_ "the ID token delivered by the identity provider for ~s has ~s as webid") (uri->string subject) - (id:id-token-webid id-token)))) + (id:webid id-token)))) (raise-exception (make-exception (make-token-request-failed response response-body) (make-exception-with-message final-message))))) - (set! subject (id:id-token-webid id-token)) - (when (not (equal? issuer (id:id-token-iss id-token))) + (set! subject (id:webid id-token)) + (when (not (equal? issuer (iss id-token))) (let ((final-message (format #f (G_ "The ID token delivered by the identity provider ~s is for issuer ~s.") (uri->string issuer) diff --git a/src/scm/webid-oidc/dpop-proof.scm b/src/scm/webid-oidc/dpop-proof.scm index 8c66f68..318ebb8 100644 --- a/src/scm/webid-oidc/dpop-proof.scm +++ b/src/scm/webid-oidc/dpop-proof.scm @@ -26,10 +26,19 @@ #:use-module (ice-9 optargs) #:use-module (ice-9 exceptions) #:use-module (ice-9 match) + #:use-module (ice-9 receive) #:use-module (srfi srfi-19) #:use-module (srfi srfi-26) #:use-module (oop goops) #:declarative? #t + #:re-export + ( + alg iat exp nonce (nonce . jti) + token->jwt + decode + encode + issue + ) #:export ( @@ -37,19 +46,6 @@ make-invalid-dpop-proof invalid-dpop-proof? - the-dpop-proof - dpop-proof? - - dpop-proof-alg - dpop-proof-typ - dpop-proof-jwk - - dpop-proof-jti - dpop-proof-htm - dpop-proof-htu - dpop-proof-iat - dpop-proof-ath - &dpop-method-mismatch make-dpop-method-mismatch dpop-method-mismatch? @@ -72,8 +68,7 @@ make-dpop-unconfirmed-key dpop-unconfirmed-key? - dpop-proof-decode - issue-dpop-proof + <dpop-proof> typ jwk htm htu ath )) (define-exception-type @@ -82,172 +77,6 @@ make-invalid-dpop-proof invalid-dpop-proof?) -(define (parse-jwk data) - (false-if-exception - (jwk->key data))) - -(define (the-dpop-proof x) - (with-exception-handler - (lambda (error) - (let ((final-message - (cond - ((invalid-jws? error) - (if (exception-with-message? error) - (format #f (G_ "this is not a DPoP proof, because it is not even a JWS: ~a") - (exception-message error)) - (format #f (G_ "this is not a DPoP proof, because it is not even a JWS")))) - (else - (if (exception-with-message? error) - (format #f (G_ "this is not an access token: ~a") - (exception-message error)) - (format #f (G_ "this is not an access token"))))))) - (raise-exception - (make-exception - (make-invalid-dpop-proof) - (make-exception-with-message final-message) - error)))) - (lambda () - (match (the-jws x) - ((header . payload) - (let examine-header ((header header) - (alg #f) - (typ #f) - (jwk #f) - (other-header-fields '())) - (match header - (() - (let examine-payload ((payload payload) - (jti #f) - (htm #f) - (htu #f) - (iat #f) - (ath #f) - (other-payload-fields '())) - (match payload - (() - (unless (and alg typ jwk jti htm htu iat) - (fail (format #f (G_ "the DPoP proof is missing ~s") - `(,@(if alg '() '("alg")) - ,@(if typ '() '("typ")) - ,@(if jwk '() '("jwk")) - ,@(if jti '() '("jti")) - ,@(if htm '() '("htm")) - ,@(if htu '() '("htu")) - ,@(if iat '() '("iat")))))) - `(((alg . ,(symbol->string alg)) - (typ . "dpop+jwt") - (jwk . ,(key->jwk (public-key jwk))) - ,@other-header-fields) - . ((jti . ,jti) - (htm . ,(symbol->string htm)) - (htu . ,(uri->string htu)) - (iat . ,(time-second (date->time-utc iat))) - ,@(if ath `((ath . ,ath)) '()) - ,@other-payload-fields))) - ((('jti . (? string? given-jti)) payload ...) - (examine-payload payload - (or jti given-jti) htm htu iat ath - other-payload-fields)) - ((('jti . incorrect) payload ...) - (fail (format #f (G_ "the \"jti\" field should be a string, not ~s") - incorrect))) - ((('htm . (? string? given-htm)) payload ...) - (examine-payload payload jti - (or htm (string->symbol given-htm)) - htu iat ath other-payload-fields)) - ((('htm . incorrect) payload ...) - (fail (format #f (G_ "the \"htm\" field should be a string, not ~s") - incorrect))) - ((('htu . (? string? (= string->uri (? uri? given-htu)))) payload ...) - (examine-payload payload jti htm - (or htu given-htu) - iat ath other-payload-fields)) - ((('htu . incorrect) payload ...) - (fail (format #f (G_ "the \"htu\" field should be an URI, not ~s") - incorrect))) - ((('iat . (? (cute >= <> 0) (? integer? given-iat))) payload ...) - (examine-payload payload jti htm htu - (or iat (time-utc->date (make-time time-utc 0 given-iat))) - ath other-payload-fields)) - ((('iat . incorrect) payload ...) - (fail (format #f (G_ "the \"iat\" field should be a timestamp, not ~s") - incorrect))) - ((('ath . (? string? given-ath)) payload ...) - (examine-payload payload jti htm htu iat - (or ath given-ath) - other-payload-fields)) - ((('ath . incorrect) payload ...) - (fail (format #f (G_ "the \"ath\" field should be an encoded JWT, not ~s") - incorrect))) - ((field payload ...) - (examine-payload payload jti htm htu iat ath - `(,field ,@other-payload-fields)))))) - ((('alg . (? string? given-alg)) header ...) - (examine-header header (or alg (string->symbol given-alg)) - typ jwk other-header-fields)) - ((('alg . incorrect) header ...) - (fail (format #f (G_ "the \"alg\" field should be a string, not ~s") - incorrect))) - ((('typ . "dpop+jwt") header ...) - (examine-header header alg #t jwk other-header-fields)) - ((('typ . incorrect) header ...) - (fail (format #f (G_ "the \"typ\" field should be \"dpop+jwt\", not ~s") - incorrect))) - ((('jwk . (= parse-jwk (? (cute is-a? <> <public-key>) given-jwk))) header ...) - (examine-header header alg typ (or jwk given-jwk) - other-header-fields)) - ((('jwk . (= parse-jwk (? (cute is-a? <> <key-pair>) given-jwk))) header ...) - (fail (format #f (G_ "the \"jwk\" field should not contain the private key")))) - ((('jwk . incorrect) header ...) - (fail (format #f (G_ "the \"jwk\" field should be a valid public key, not ~s") - incorrect))) - ((field header ...) - (examine-header header alg typ jwk `(,field ,@other-header-fields)))))))))) - -(define (dpop-proof? x) - (false-if-exception (the-dpop-proof x))) - -(define (dpop-proof-alg proof) - (match (the-dpop-proof proof) - ((header . _) - (symbol->string (assq-ref header 'alg))))) - -(define (dpop-proof-typ proof) - (match (the-dpop-proof proof) - ((header . _) - (assq-ref header 'typ)))) - -(define (dpop-proof-jwk proof) - (match (the-dpop-proof proof) - ((header . _) - (jwk->key (assq-ref header 'jwk))))) - -(define (dpop-proof-jti proof) - (match (the-dpop-proof proof) - ((_ . payload) - (assq-ref payload 'jti)))) - -(define (dpop-proof-htm proof) - (match (the-dpop-proof proof) - ((_ . payload) - (string->symbol (assq-ref payload 'htm))))) - -(define (dpop-proof-htu proof) - (match (the-dpop-proof proof) - ((_ . payload) - (string->uri (assq-ref payload 'htu))))) - -(define (dpop-proof-iat proof) - (match (the-dpop-proof proof) - ((_ . payload) - (time-utc->date - (make-time time-utc 0 (assq-ref payload 'iat)))))) - -(define (dpop-proof-ath proof) - (match (the-dpop-proof proof) - ((_ . payload) - (assq-ref payload 'ath)))) - (define-exception-type &dpop-method-mismatch &external-error @@ -299,129 +128,169 @@ make-dpop-unconfirmed-key dpop-unconfirmed-key?) -(define* (dpop-proof-decode method uri str cnf/check - #:key - (access-token #f)) - (let* ((current-date ((p:current-date))) - (current-time - (time-second (date->time-utc current-date)))) - (with-exception-handler - (lambda (error) - (let ((final-message - (if (exception-with-message? error) - (format #f (G_ "the DPoP proof cannot be decoded: ~a") - (exception-message error)) - (format #f (G_ "the DPoP proof cannot be decoded"))))) - (raise-exception - (make-exception - (make-invalid-dpop-proof) - (make-exception-with-message final-message) - error)))) - (lambda () - (let ((decoded (the-dpop-proof (jws-decode str dpop-proof-jwk)))) - (unless (eq? method (dpop-proof-htm decoded)) - (let ((final-message - (format #f (G_ "the DPoP proof is signed for access through ~s, but it is used with ~s") - (dpop-proof-htm decoded) method))) - (raise-exception - (make-exception - (make-dpop-method-mismatch (dpop-proof-htm decoded) method) - (make-exception-with-message final-message))))) - (uris-compatible (dpop-proof-htu decoded) - (if (string? uri) - (string->uri uri) - uri)) - (let ((iat (dpop-proof-iat decoded))) - (let ((iat-s (time-second (date->time-utc iat)))) - (unless (>= current-time (- iat-s 5)) - (let ((final-message - (format #f (G_ "the DPoP proof is signed in the future, ~a, relative to the current date, ~a") - (date->string iat) - (date->string current-date)))) - (raise-exception - (make-exception - (make-signed-in-future iat current-date) - (make-exception-with-message final-message))))) - (unless (<= current-time (+ iat-s 120)) ;; valid for 2 minutes - (let ((final-message - (format #f (G_ "the DPoP proof is too old, it was signed ~a and now it is ~a") - (date->string iat) - (date->string current-date)))) - (raise-exception - (make-exception - (make-expired (time-utc->date (make-time time-utc 0 (+ iat-s 120))) - current-date) - (make-exception-with-message final-message))))))) - (when access-token - (let ((h (stubs:hash 'SHA-256 access-token))) - (unless (equal? (dpop-proof-ath decoded) h) - (let ((final-message - (format #f (G_ "the DPoP proof should go along with an access token hashed to ~s, not ~s") - (dpop-proof-ath decoded) access-token))) - (raise-exception - (make-exception - (make-dpop-invalid-ath (dpop-proof-ath decoded) access-token) - (make-exception-with-message final-message))))))) - (if (string? cnf/check) - (unless (equal? cnf/check (jkt (dpop-proof-jwk decoded))) - (let ((final-message - (format #f (G_ "the DPoP proof is signed with the wrong key")))) - (raise-exception - (make-exception - (make-dpop-unconfirmed-key) - (make-exception-with-message final-message))))) - (with-exception-handler - (lambda (error) - (let ((final-message - (if (exception-with-message? error) - (format #f (G_ "the DPoP proof is signed with the wrong key: ~a") - (exception-message error)) - (format #f (G_ "the DPoP proof is signed with the wrong key"))))) - (raise-exception - (make-exception - (make-dpop-unconfirmed-key) - (make-exception-with-message final-message) - error)))) - (lambda () - (unless (cnf/check (jkt (dpop-proof-jwk decoded))) - ;; You should throw an error instead! - (fail (G_ "the cnf/check function returned #f")))))) - (parameterize ((p:current-date current-date)) - ;; jti-check should use the same date. - (jti-check (dpop-proof-jti decoded) 120)) - decoded))))) +(define-class <dpop-proof> (<single-use-token>) + (typ #:init-keyword #:typ #:accessor typ) + (jwk #:init-keyword #:jwk #:accessor jwk) + (htm #:init-keyword #:htm #:accessor htm) + (htu #:init-keyword #:htu #:accessor htu) + (ath #:init-keyword #:ath #:accessor ath)) + +(define-method (default-validity (proof <dpop-proof>)) + 30) + +(define-method (has-explicit-exp? (proof <dpop-proof>)) + #f) -(define (dpop-proof-encode dpop-proof key) +(define-method (nonce-field-name (proof <dpop-proof>)) + 'jti) + +(define-method (initialize (token <dpop-proof>) initargs) (with-exception-handler (lambda (error) - (let ((final-message - (if (exception-with-message? error) - (format #f (G_ "cannot encode a DPoP proof: ~a") - (exception-message error)) - (format #f (G_ "cannot encode a DPoP proof"))))) - (raise-exception - (make-exception - (make-exception-with-message final-message) - error)))) + (raise-exception + (make-exception + (make-invalid-dpop-proof) + (make-exception-with-message + (if (exception-with-message? error) + (format #f (G_ "invalid DPoP proof: ~a") + (exception-message error)) + (G_ "invalid DPoP proof token"))) + error))) (lambda () - (jws-encode dpop-proof key)))) - -(define* (issue-dpop-proof - client-key - #:key - (htm #f) - (htu #f) - (access-token #f)) - (dpop-proof-encode - (the-dpop-proof - `(((alg . ,(symbol->string (alg client-key))) - (typ . "dpop+jwt") - (jwk . ,(key->jwk (public-key client-key)))) - . ((jti . ,(stubs:random 12)) - (htm . ,(symbol->string htm)) - (htu . ,(uri->string htu)) - (iat . ,(time-second (date->time-utc ((p:current-date))))) - ,@(if access-token - `((ath . ,(stubs:hash 'SHA-256 access-token))) - '())))) - client-key)) + (next-method) + (let-keywords + initargs #t + ((typ "dpop+jwt") + (jwk #f) + (htm #f) + (htu #f) + (ath #f) + (access-token #f) + (jwt-header #f) + (jwt-payload #f)) + (let do-initialize ((typ typ) + (jwk jwk) + (htm htm) + (htu htu) + (ath ath) + (access-token access-token) + (jwt-header jwt-header) + (jwt-payload jwt-payload)) + (cond + ((string? htu) + (do-initialize typ jwk htm (string->uri htu) ath access-token jwt-header jwt-payload)) + ((string? htm) + (do-initialize typ jwk (string->symbol htm) htu ath access-token jwt-header jwt-payload)) + ((and (not ath) access-token) + (do-initialize typ jwk htm htu (stubs:hash 'SHA-256 access-token) #f jwt-header jwt-payload)) + ((and typ jwk htm htu) + (unless (equal? typ "dpop+jwt") + (scm-error 'wrong-type-arg "make" + (G_ "#:typ should be exactly \"dpop+jwt\"") + '() + (list typ))) + (unless (is-a? jwk <public-key>) + (scm-error 'wrong-type-arg "make" + (G_ "#:jwk should be a public key") + '() + (list jwk))) + (unless (symbol? htm) + (scm-error 'wrong-type-arg "make" + (G_ "#:htm should be a symbol") + '() + (list htm))) + (when ath + (unless (string? ath) + (scm-error 'wrong-type-arg "make" + (G_ "when present, #:ath should be a string") + '() + (list ath)))) + (slot-set! token 'typ typ) + (slot-set! token 'jwk jwk) + (slot-set! token 'htm htm) + (slot-set! token 'htu htu) + (slot-set! token 'ath ath)) + ((and jwt-header jwt-payload) + (do-initialize + (assq-ref jwt-header 'typ) + (jwk->key (assq-ref jwt-header 'jwk)) + (assq-ref jwt-payload 'htm) + (assq-ref jwt-payload 'htu) + (assq-ref jwt-payload 'ath) + #f #f #f)) + (else + (raise-exception + (make-exception + (make-invalid-jws) + (make-exception-with-message + (G_ "when making a DPoP proof, either its required fields (#:typ, #:jwk, #:htm and #:htu) or (#:jwt-header and #:jwt-payload) should be passed"))))))))))) + +(define-method (token->jwt (token <dpop-proof>)) + ;; exp should be implicit, and nonce should be replaced by jti + (receive (base-header base-payload) (next-method) + (values + `((typ . ,(typ token)) + (jwk . ,(key->jwk (jwk token))) + ,@base-header) + `((htm . ,(symbol->string (htm token))) + (htu . ,(uri->string (htu token))) + ,@(let ((ath (ath token))) + (if ath + `((ath . ,ath)) + '())) + ,@base-payload)))) + +(define-method (verify (token <dpop-proof>) args) + (next-method) + (let-keywords + args #t + ((access-token #f) + (method #f) + (uri #f) + (cnf/check #f)) + (begin + (when (string? uri) + (set! uri (string->uri uri))) + (unless (eq? (htm token) method) + (raise-exception + (make-exception + (make-dpop-method-mismatch (htm token) method) + (make-exception-with-message + (format #f (G_ "the DPoP proof is signed for access through ~s, but it is used with ~s") + (htm token) method))))) + (uris-compatible (htu token) uri) + (when access-token + (let ((h (stubs:hash 'SHA-256 access-token))) + (unless (equal? (ath token) h) + (raise-exception + (make-exception + (make-dpop-invalid-ath (ath token) access-token) + (make-exception-with-message + (format #f (G_ "the DPoP proof should go along with an access token hashed to ~s, not ~s") + (ath token) access-token))))))) + (if (string? cnf/check) + (unless (equal? cnf/check (jkt (jwk token))) + (raise-exception + (make-exception + (make-dpop-unconfirmed-key) + (make-exception-with-message + (format #f (G_ "the DPoP proof is signed with the wrong key")))))) + (with-exception-handler + (lambda (error) + (let ((final-message + (if (exception-with-message? error) + (format #f (G_ "the DPoP proof is signed with the wrong key: ~a") + (exception-message error)) + (format #f (G_ "the DPoP proof is signed with the wrong key"))))) + (raise-exception + (make-exception + (make-dpop-unconfirmed-key) + (make-exception-with-message final-message) + error)))) + (lambda () + (unless (cnf/check (jkt (jwk token))) + ;; You should throw an error instead! + (fail (G_ "the cnf/check function returned #f"))))))))) + +(define-method (lookup-keys (token <dpop-proof>) args) + (jwk token)) diff --git a/src/scm/webid-oidc/example-app.scm b/src/scm/webid-oidc/example-app.scm index c293d69..67d959f 100644 --- a/src/scm/webid-oidc/example-app.scm +++ b/src/scm/webid-oidc/example-app.scm @@ -18,7 +18,6 @@ #:use-module ((webid-oidc client) #:prefix client:) #:use-module ((webid-oidc client accounts) #:prefix account:) #:use-module ((webid-oidc cache) #:prefix cache:) - #:use-module (webid-oidc dpop-proof) #:use-module (webid-oidc web-i18n) #:use-module ((webid-oidc stubs) #:prefix stubs:) #:use-module ((webid-oidc refresh-token) #:prefix refresh:) diff --git a/src/scm/webid-oidc/jws.scm b/src/scm/webid-oidc/jws.scm index 3e5e50b..af83c90 100644 --- a/src/scm/webid-oidc/jws.scm +++ b/src/scm/webid-oidc/jws.scm @@ -18,13 +18,30 @@ #:use-module (webid-oidc jwk) #:use-module (webid-oidc errors) #:use-module (webid-oidc web-i18n) + #:use-module (webid-oidc jti) + #:use-module (webid-oidc oidc-configuration) #:use-module ((webid-oidc stubs) #:prefix stubs:) + #:use-module ((webid-oidc parameters) #:prefix p:) #:use-module (rnrs bytevectors) + #:use-module (srfi srfi-19) #:use-module (ice-9 receive) #:use-module (ice-9 exceptions) #:use-module (ice-9 match) + #:use-module (ice-9 optargs) + #:use-module (web uri) #:use-module (oop goops) #:declarative? #t + #:re-export + ( + (&jti-found . &nonce-found) + (make-jti-found . make-nonce-found) + (jti-found? . nonce-found?) + (jti-found-jti . nonce-found-nonce) + ) + #:replace + ( + exp ;; This is a function in guile + ) #:export ( @@ -32,10 +49,16 @@ make-invalid-jws invalid-jws? - the-jws - jws? + <token> + + <time-bound-token> iat default-validity has-explicit-exp? + nonce-field-name ;; DPoP proofs use 'jti instead of 'nonce + + <oidc-token> iss - jws-alg + <single-use-token> nonce + + token->jwt &cannot-query-identity-provider make-cannot-query-identity-provider @@ -54,8 +77,11 @@ error-expiration-date ;; error-current-date works for that one too - jws-decode - jws-encode + lookup-keys + verify + decode + encode + issue )) @@ -65,70 +91,259 @@ make-invalid-jws invalid-jws?) -(define (the-jws x) - (with-exception-handler - (lambda (error) - (let ((final-message - (if (exception-with-message? error) - (format #f (G_ "the JWS is invalid: ~a") - (exception-message error)) - (format #f (G_ "the JWS is invalid"))))) +(define-class <token> () + (alg #:init-keyword #:alg #:accessor alg)) + +(define (key-alg key) + (alg key)) + +(define-method (initialize (token <token>) initargs) + (next-method) + (let-keywords + initargs #t + ((alg #f) + (signing-key #f) + (jwt-header #f) + (jwt-payload #f)) + (let do-initialize ((alg alg) + (signing-key signing-key) + (jwt-header jwt-header) + (jwt-payload jwt-payload)) + (cond + ((string? alg) + (do-initialize (string->symbol alg) signing-key jwt-header jwt-payload)) + (alg + (case alg + ((HS256 HS384 HS512 + RS256 RS384 RS512 + ES256 ES384 ES512 + PS256 PS384 PS512) + (slot-set! token 'alg alg)) + (else (raise-exception (make-exception (make-invalid-jws) - (make-exception-with-message final-message) - error)))) - (lambda () - (match x - ((header . payload) - (let examine-header ((header header) - (alg #f) - (other-header-fields '())) - (match header - (() - (let examine-payload ((payload payload) - (other-payload-fields '())) - (match payload - (() - (unless alg - (fail (format #f (G_ "the JWS header does not have an \"alg\" field")))) - `(((alg . ,(symbol->string alg)) - ,@(reverse other-header-fields)) - . ,(reverse other-payload-fields))) - ((((? symbol? key) . value) payload ...) - (examine-payload payload - `((,key . ,value) ,@other-payload-fields))) - (else - (fail (format #f (G_ "invalid JSON object as payload"))))))) - ((('alg . (? string? given-alg)) header ...) - (case (string->symbol given-alg) - ((HS256 HS384 HS512 - RS256 RS384 RS512 - ES256 ES384 ES512 - PS256 PS384 PS512) - #t) - (else - (fail (format #f (G_ "invalid signature algorithm: ~s") given-alg)))) - (examine-header header (or alg (string->symbol given-alg)) - other-header-fields)) - ((('alg . invalid) header ...) - (fail (format #f (G_ "invalid \"alg\" value: ~s") invalid))) - ((((? symbol? key) . value) header ...) - (examine-header header alg - `((,key . ,value) ,@other-header-fields))) - (else - (fail (format #f (G_ "invalid JSON object as header"))))))) - (else - (fail (format #f (G_ "this is not a pair")))))))) - -(define (jws? x) - (false-if-exception - (the-jws x))) - -(define (jws-alg jws) - (match (the-jws jws) - ((header . _) - (string->symbol (assq-ref header 'alg))))) + (make-exception-with-message + (format #f (G_ "unsupported JWS algorithm: ~s") alg))))))) + (signing-key + (do-initialize (key-alg signing-key) #f jwt-payload jwt-header)) + ((and jwt-header jwt-payload) + (do-initialize (assq-ref jwt-header 'alg) #f #f #f)) + (else + (raise-exception + (make-exception + (make-invalid-jws) + (make-exception-with-message + (G_ "when making a token either #:alg or (#:jwt-header and #:jwt-payload) should be passed"))))))))) + +(define-class <generic-with-default> (<generic>) + ;; neutral is the list of values that are returned when there are no + ;; next methods. + (neutral #:init-keyword #:neutral)) + +(define-method (no-next-method (generic <generic-with-default>) args) + (apply values (slot-ref generic 'neutral))) + +(define-method (no-applicable-method (generic <generic-with-default>) args) + (apply values (slot-ref generic 'neutral))) + +(define-class <time-bound-token> (<token>) + (iat #:init-keyword #:iat #:accessor iat) + (exp #:init-keyword #:exp #:accessor exp)) + +(define default-validity + (make <generic-with-default> + #:name 'default-validity + #:neutral (list #f))) + +(define-method (has-explicit-exp? (token <time-bound-token>)) + ;; Change it to #f when the token should not have an explicit + ;; expiration date, such as DPoP proofs + #t) + +(define-method (initialize (token <time-bound-token>) initargs) + (next-method) + (let-keywords + initargs #t + ((iat ((p:current-date))) + (exp #f) + (validity (default-validity token)) + (jwt-header #f) + (jwt-payload #f)) + (let do-initialize ((iat iat) + (exp exp) + (validity validity) + (jwt-header jwt-header) + (jwt-payload jwt-payload)) + (cond + ((integer? iat) + (do-initialize (make-time time-utc 0 iat) exp validity jwt-header jwt-payload)) + ((time? iat) + (do-initialize (time-utc->date iat) exp validity jwt-header jwt-payload)) + ((and (not exp) (date? iat) (integer? validity)) + (do-initialize iat + (+ (time-second (date->time-utc iat)) + validity) + validity + jwt-header + jwt-payload)) + ((integer? exp) + (do-initialize iat (make-time time-utc 0 exp) validity jwt-header jwt-payload)) + ((time? exp) + (do-initialize iat (time-utc->date exp) validity jwt-header jwt-payload)) + ((and jwt-header jwt-payload) + (do-initialize (assq-ref jwt-payload 'iat) + (and (has-explicit-exp? token) + (assq-ref jwt-payload 'exp)) + validity #f #f)) + ((and iat exp) + (unless (date? iat) + (scm-error 'wrong-type-arg "make" + (G_ "#:iat should be a date") + '() + (list iat))) + (unless (date? exp) + (scm-error 'wrong-type-arg "make" + (G_ "#:exp should be a date") + '() + (list exp))) + (slot-set! token 'iat iat) + (slot-set! token 'exp exp)) + (else + (raise-exception + (make-exception + (make-invalid-jws) + (make-exception-with-message + (G_ "when making a time-bound token, either its required fields (#:iat, and either #:exp or #:validity) or (#:jwt-header and #:jwt-payload) should be passed"))))))))) + +(define-class <oidc-token> (<token>) + (iss #:init-keyword #:iss #:accessor iss)) + +(define-method (default-validity (token <oidc-token>)) + (let ((next (next-method)) + (mine 3600)) + (if (and next (< next mine)) + next + mine))) + +(define-method (initialize (token <oidc-token>) initargs) + (next-method) + (let-keywords + initargs #t + ((iss #f) + (jwt-header #f) + (jwt-payload #f)) + (let do-initialize ((iss iss) + (jwt-header jwt-header) + (jwt-payload jwt-payload)) + (cond + ((string? iss) + (do-initialize (string->uri iss) jwt-header jwt-payload)) + (iss + (unless (uri? iss) + (scm-error 'wrong-type-arg "make" + (G_ "#:iss should be an URI") + '() + (list iss))) + (slot-set! token 'iss iss)) + ((and jwt-header jwt-payload) + (do-initialize (assq-ref jwt-payload 'iss) #f #f)) + (else + (raise-exception + (make-exception + (make-invalid-jws) + (make-exception-with-message + (G_ "when making an OIDC token, either its required #:iss field or (#:jwt-header and #:jwt-payload) should be passed"))))))))) + +(define-class <single-use-token> (<time-bound-token>) + (nonce #:init-keyword #:nonce #:accessor nonce)) + +(define-method (default-validity (token <single-use-token>)) + (let ((next (next-method)) + (mine 120)) + (if (and next (< next mine)) + next + mine))) + +(define nonce-field-name + (make <generic-with-default> + #:name 'nonce-field-name + #:neutral (list 'nonce))) + +(define-method (nonce-field-name (token <top>)) + ;; Without this method, this is an infinite loop. + (next-method)) + +(define-method (initialize (token <single-use-token>) initargs) + (next-method) + (let-keywords + initargs #t + ((nonce (stubs:random 12)) + (jwt-header #f) + (jwt-payload #f)) + ;; The maximum validity is 2 minutes + (let ((iat (time-second (date->time-utc (iat token)))) + (exp (time-second (date->time-utc (exp token))))) + (let ((validity (- exp iat))) + (when (> validity 120) + (let ((true-exp (+ iat 120))) + (slot-set! token 'exp (time-utc->date (make-time time-utc 0 true-exp))))))) + (let do-initialize ((nonce nonce) + (jwt-header jwt-header) + (jwt-payload jwt-payload)) + (cond + ((and jwt-header jwt-payload) + (do-initialize (assq-ref jwt-payload (nonce-field-name token)) #f #f)) + (nonce + (unless (string? nonce) + (scm-error 'wrong-type-arg "make" + (G_ "#:nonce should be a string") + '() + (list nonce))) + (slot-set! token 'nonce nonce)) + (else + (raise-exception + (make-exception + (make-invalid-jws) + (make-exception-with-message + (G_ "when making a single-use token, either its required #:nonce field or (#:jwt-header and #:jwt-payload) should be passed"))))))))) + +(define token->jwt + (make <generic-with-default> + #:name 'token->jwt + #:neutral (list '() '()))) + +(define-method (token->jwt (token <token>)) + (receive (base-header base-payload) + (next-method) + (values + `((alg . ,(symbol->string (alg token))) + ,@base-header) + base-payload))) + +(define-method (token->jwt (token <time-bound-token>)) + (receive (base-header base-payload) + (next-method) + (values base-header + `((iat . ,(time-second (date->time-utc (iat token)))) + ,@(if (has-explicit-exp? token) + `((exp . ,(time-second (date->time-utc (exp token))))) + '()) + ,@base-payload)))) + +(define-method (token->jwt (token <single-use-token>)) + (receive (base-header base-payload) + (next-method) + (values base-header + `((,(nonce-field-name token) . ,(nonce token)) + ,@base-payload)))) + +(define-method (token->jwt (token <oidc-token>)) + (receive (base-header base-payload) + (next-method) + (values base-header + `((iss . ,(uri->string (iss token))) + ,@base-payload)))) (define (split-in-3-parts string separator) (match (string-split string separator) @@ -193,14 +408,14 @@ (error-current-date (apply make-exception sub-exceptions))) (else #f))) -(define (parse str verify) +(define (parse token-class str verify-signature) (receive (header payload signature) (split-in-3-parts str #\.) (let ((base (string-append header "." payload)) (header (base64-decode-json header)) (payload (base64-decode-json payload))) - (let ((ret `(,header . ,payload))) - (verify ret base signature) + (let ((ret (make token-class #:jwt-header header #:jwt-payload payload))) + (verify-signature ret base signature) ret)))) (define (verify-any alg keys payload signature) @@ -245,7 +460,102 @@ (define-method (keys (keys <list>)) (map public-key keys)) -(define (jws-decode str lookup-keys) +(define lookup-keys + (make <generic-with-default> + #:name 'lookup-keys + #:neutral (list '()))) + +(define-method (lookup-keys (token <oidc-token>) args) + (let-keywords + args #f + ((http-request http-request)) + (let ((iss (iss token))) + (let ((cfg + (with-exception-handler + (lambda (error) + (let ((final-message + (if (exception-with-message? error) + (format #f (G_ "I cannot query the identity provider configuration: ~a") + (exception-message error)) + (format #f (G_ "I cannot query the identity provider configuration"))))) + (raise-exception + (make-exception + (make-cannot-query-identity-provider iss) + (make-exception-with-message final-message) + error)))) + (lambda () + (get-oidc-configuration + (uri-host iss) + #:userinfo (uri-userinfo iss) + #:port (uri-port iss) + #:http-get + (lambda* (uri . args) + (apply http-request uri #:method 'GET args))))))) + (with-exception-handler + (lambda (error) + (raise-exception + (make-exception + (make-cannot-query-identity-provider iss) + (make-exception-with-message + (if (exception-with-message? error) + (format #f (G_ "I cannot query the JWKS URI of the identity provider: ~a") + (exception-message error)) + (format #f (G_ "I cannot query the JWKS URI of the identity provider"))))))) + (lambda () + (append + (keys (next-method)) + (keys + (oidc-configuration-jwks + cfg + #:http-get + (lambda* (uri . args) + (apply http-request uri #:method 'GET args))))))))))) + +(define verify + (make <generic-with-default> + #:name 'verify + #:neutral (list #t))) + +(define-method (verify (token <time-bound-token>) args) + (next-method) + (let-keywords + args #t + ((current-date ((p:current-date)))) + (let ((iat (iat token)) + (exp (exp token))) + (let ((iat-s (time-second (date->time-utc iat))) + (exp-s (time-second (date->time-utc exp))) + (current-s (time-second (date->time-utc current-date)))) + (when (>= iat-s (+ current-s 5)) + (let ((final-message + (format #f (G_ "the token is signed in the future, ~a, relative to current ~a") + (date->string iat) + (date->string current-date)))) + (raise-exception + (make-exception + (make-signed-in-future iat current-date) + (make-exception-with-message final-message))))) + (when (>= current-s exp-s) + (let ((final-message + (format #f (G_ "the token expired ~a, which is in the past (from ~a)") + (date->string exp) + (date->string current-date)))) + (raise-exception + (make-exception + (make-expired exp current-date) + (make-exception-with-message final-message))))))))) + +(define-method (verify (token <single-use-token>) args) + (next-method) + (let-keywords + args #t + ((current-date ((p:current-date)))) + (let ((exp (exp token))) + (let ((exp-s (time-second (date->time-utc exp))) + (current-s (time-second (date->time-utc current-date)))) + (jti-check (nonce token) (- exp-s current-s)))))) + +(define* (decode token-class str . args) (with-exception-handler (lambda (error) (let ((final-message @@ -259,12 +569,13 @@ (make-exception-with-message final-message) error)))) (lambda () - (parse str - (lambda (jws payload signature) - (let ((k (keys (lookup-keys jws)))) - (verify-any (jws-alg jws) k payload signature))))))) + (parse token-class str + (lambda (token payload signature) + (let ((k (keys (lookup-keys token args)))) + (verify-any (alg token) k payload signature)) + (verify token args)))))) -(define (jws-encode jws key) +(define (encode token key) (with-exception-handler (lambda (error) (let ((final-message @@ -278,12 +589,14 @@ (make-exception-with-message final-message) error)))) (lambda () - (match jws - ((header . payload) - (let ((header (stubs:scm->json-string header)) - (payload (stubs:scm->json-string payload))) - (let ((header (stubs:base64-encode header)) - (payload (stubs:base64-encode payload))) - (let ((payload (string-append header "." payload))) - (let ((signature (stubs:sign (jws-alg jws) (key->jwk key) payload))) - (string-append payload "." signature)))))))))) + (receive (header payload) (token->jwt token) + (let ((header (stubs:scm->json-string header)) + (payload (stubs:scm->json-string payload))) + (let ((header (stubs:base64-encode header)) + (payload (stubs:base64-encode payload))) + (let ((payload (string-append header "." payload))) + (let ((signature (stubs:sign (alg token) (key->jwk key) payload))) + (string-append payload "." signature))))))))) + +(define* (issue token-class issuer-key . args) + (encode (apply make token-class #:signing-key issuer-key args) issuer-key)) diff --git a/src/scm/webid-oidc/oidc-id-token.scm b/src/scm/webid-oidc/oidc-id-token.scm index abef88d..1d96a47 100644 --- a/src/scm/webid-oidc/oidc-id-token.scm +++ b/src/scm/webid-oidc/oidc-id-token.scm @@ -28,28 +28,26 @@ #:use-module (ice-9 optargs) #:use-module (ice-9 exceptions) #:use-module (ice-9 match) + #:use-module (ice-9 receive) #:use-module (srfi srfi-19) + #:use-module (oop goops) + #:duplicates (merge-generics) #:declarative? #t + #:re-export + ( + alg iat iss nonce + token->jwt + decode + encode + issue + ) #:export ( &invalid-id-token make-invalid-id-token invalid-id-token? - the-id-token - id-token? - - id-token-alg - id-token-webid - id-token-iss - id-token-sub - id-token-aud - id-token-nonce - id-token-iat - id-token-exp - - id-token-decode - issue-id-token + <id-token> webid sub aud )) (define-exception-type @@ -58,268 +56,81 @@ make-invalid-id-token invalid-id-token?) -(define (the-id-token x) - (with-exception-handler - (lambda (error) - (let ((final-message - (cond - ((and (invalid-jws? error) - (exception-with-message? error)) - (format #f (G_ "this is not an ID token, because it is not even a JWS: ~a") - (exception-message error))) - ((invalid-jws? error) - (format #f (G_ "this is not an ID token, because it is not even a JWS"))) - ((exception-with-message? error) - (format #f (G_ "this is not an ID token: ~a") - (exception-message error))) - (else - (format #f (G_ "this is not an ID token")))))) - (raise-exception - (make-exception - (make-invalid-id-token) - (make-exception-with-message final-message) - error)))) - (lambda () - (match (the-jws x) - ((header . payload) - (let examine-payload ((payload payload) - (webid #f) - (iss #f) - (sub #f) - (aud #f) - (nonce #f) - (iat #f) - (exp #f) - (other-fields '())) - (match payload - (() - (unless (and webid iss sub aud nonce iat exp) - (fail (format #f (G_ "the payload is missing ~s") - `(,@(if webid '() '("webid")) - ,@(if iss '() '("iss")) - ,@(if sub '() '("sub")) - ,@(if aud '() '("aud")) - ,@(if nonce '() '("nonce")) - ,@(if iat '() '("iat")) - ,@(if exp '() '("exp")))))) - `(,header - . ((webid . ,(uri->string webid)) - (iss . ,(uri->string iss)) - (sub . ,sub) - (aud . ,(uri->string aud)) - (nonce . ,nonce) - (iat . ,(time-second (date->time-utc iat))) - (exp . ,(time-second (date->time-utc exp)))))) - ((('webid . (? string? (= string->uri (? uri? webid-given)))) payload ...) - (examine-payload payload - (or webid webid-given) - iss sub aud nonce iat exp other-fields)) - ((('webid . invalid) payload ...) - (fail (format #f (G_ "the \"webid\" field should be an URI, ~s is given") - invalid))) - ((('iss . (? string? (= string->uri (? uri? iss-given)))) payload ...) - (examine-payload payload webid - (or iss iss-given) - sub aud nonce iat exp other-fields)) - ((('iss . invalid) payload ...) - (fail (format #f (G_ "the \"iss\" field should be an URI, ~s is given") - invalid))) - ((('sub . (? string? sub-given)) payload ...) - (examine-payload payload webid iss - (or sub sub-given) - aud nonce iat exp other-fields)) - ((('sub . invalid) payload ...) - (fail (format #f (G_ "the \"sub\" field should be a string, ~s is given") - invalid))) - ((('aud . (? string? (= string->uri (? uri? aud-given)))) payload ...) - (examine-payload payload webid iss sub - (or aud aud-given) - nonce iat exp other-fields)) - ((('aud . invalid) payload ...) - (fail (format #f (G_ "the \"aud\" field should be an URI, ~s is given") - invalid))) - ((('nonce . (? string? nonce-given)) payload ...) - (examine-payload payload webid iss sub aud - (or nonce nonce-given) - iat exp other-fields)) - ((('nonce . invalid) payload ...) - (fail (format #f (G_ "the \"nonce\" field should be a string, ~s is given") - invalid))) - ((('iat . (? (lambda (x) (>= x 0)) (? integer? iat-given))) payload ...) - (examine-payload payload webid iss sub aud nonce - (or iat (time-utc->date (make-time time-utc 0 iat-given))) - exp other-fields)) - ((('iat . invalid) payload ...) - (fail (format #f (G_ "the \"iat\" field should be a timestamp, ~s is given") - invalid))) - ((('exp . (? (lambda (x) (>= x 0)) (? integer? exp-given))) payload ...) - (examine-payload payload webid iss sub aud nonce iat - (or exp (time-utc->date (make-time time-utc 0 exp-given))) - other-fields)) - ((('exp . invalid) payload ...) - (fail (format #f (G_ "the \"exp\" field should be a timestamp, ~s is given") - invalid))) - ((field payload ...) - (examine-payload payload webid iss sub aud nonce iat exp - `(,field ,@other-fields))) - (else - (fail (format #f (G_ "the payload should be a JSON object"))))))))))) - -(define (id-token? x) - (false-if-exception - (the-id-token x))) - -(define (id-token-alg code) - (match (the-id-token code) - ((header . _) - (string->symbol (assq-ref header 'alg))))) - -(define (id-token-webid code) - (match (the-id-token code) - ((_ . payload) - (string->uri (assq-ref payload 'webid))))) - -(define (id-token-iss code) - (match (the-id-token code) - ((_ . payload) - (string->uri (assq-ref payload 'iss))))) +(define-class <id-token> (<single-use-token> <oidc-token>) + (webid #:init-keyword #:webid #:accessor webid) + (sub #:init-keyword #:sub #:accessor sub) + (aud #:init-keyword #:aud #:accessor aud)) -(define (id-token-sub code) - (match (the-id-token code) - ((_ . payload) - (assq-ref payload 'sub)))) - -(define (id-token-aud code) - (match (the-id-token code) - ((_ . payload) - (string->uri (assq-ref payload 'aud))))) - -(define (id-token-nonce code) - (match (the-id-token code) - ((_ . payload) - (assq-ref payload 'nonce)))) - -(define (id-token-iat code) - (match (the-id-token code) - ((_ . payload) - (time-utc->date - (make-time time-utc 0 (assq-ref payload 'iat)))))) - -(define (id-token-exp code) - (match (the-id-token code) - ((_ . payload) - (time-utc->date - (make-time time-utc 0 (assq-ref payload 'exp)))))) - -(define* (id-token-decode str #:key (http-get http-get)) +(define-method (initialize (token <id-token>) initargs) (with-exception-handler (lambda (error) - (let ((final-message - (if (exception-with-message? error) - (format #f (G_ "the ID token is invalid: ~a") - (exception-message error)) - (format #f (G_ "the ID token is invalid"))))) - (raise-exception - (make-exception - (make-invalid-id-token) - (make-exception-with-message final-message) - error)))) + (raise-exception + (make-exception + (make-invalid-id-token) + (make-exception-with-message + (if (exception-with-message? error) + (format #f (G_ "invalid OIDC ID token: ~a") + (exception-message error)) + (G_ "invalid OIDC id token"))) + error))) (lambda () - (jws-decode - str - (lambda (token) - (let ((iss (id-token-iss token))) - (let* ((cfg - (with-exception-handler - (lambda (error) - (let ((final-message - (if (exception-with-message? error) - (format #f (G_ "I cannot query the identity provider configuration: ~a") - (exception-message error)) - (format #f (G_ "I cannot query the identity provider configuratioon"))))) - (raise-exception - (make-exception - (make-cannot-query-identity-provider iss) - (make-exception-with-message final-message) - error)))) - (lambda () - (get-oidc-configuration - (uri-host iss) - #:userinfo (uri-userinfo iss) - #:port (uri-port iss) - #:http-get http-get)))) - (jwks - (with-exception-handler - (lambda (error) - (raise-exception - (make-exception - (make-cannot-query-identity-provider iss) - (make-exception-with-message - (if (exception-with-message? error) - (format #f (G_ "I cannot query the JWKS URI of the identity provider: ~a") - (exception-message error)) - (format #f (G_ "I cannot query the JWKS URI of the identity provider"))))))) - (lambda () - (oidc-configuration-jwks cfg #:http-get http-get))))) - (let ((iat (id-token-iat token)) - (exp (id-token-exp token)) - (current-date ((p:current-date)))) - (let ((iat-s (time-second (date->time-utc iat))) - (exp-s (time-second (date->time-utc exp))) - (current-s (time-second (date->time-utc current-date)))) - (when (>= iat-s (+ current-s 5)) - (let ((final-message - (format #f (G_ "the ID token is signed in the future, ~a, relative to current ~a") - (date->string iat) - (date->string current-date)))) - (raise-exception - (make-exception - (make-signed-in-future iat current-date) - (make-exception-with-message final-message))))) - (when (>= current-s exp-s) - (let ((final-message - (format #f (G_ "the ID token expired ~a, which is in the past (from ~a)") - (date->string exp) - (date->string current-date)))) - (raise-exception - (make-exception - (make-expired exp current-date) - (make-exception-with-message final-message))))))) - jwks))))))) - -(define (id-token-encode id-token key) - (with-exception-handler - (lambda (error) - (let ((final-message - (if (exception-with-message? error) - (format #f (G_ "cannot encode the ID token: ~a") - (exception-message error)) - (format #f (G_ "cannot encode the ID token"))))) - (raise-exception - (make-exception-with-message final-message)))) - (lambda () - (jws-encode id-token key)))) - -(define* (issue-id-token - issuer-key - #:key - (webid #f) - (iss #f) - (sub #f) - (aud #f) - (validity 3600)) - (unless sub - (set! sub (uri->string webid))) - (let* ((iat (time-second (date->time-utc ((p:current-date))))) - (exp (+ iat validity))) - (jws-encode - (the-id-token - `(((alg . ,(symbol->string (alg issuer-key)))) - . ((webid . ,(uri->string webid)) - (iss . ,(uri->string iss)) - (sub . ,sub) - (aud . ,(uri->string aud)) - (nonce . ,(stubs:random 12)) - (iat . ,iat) - (exp . ,exp)))) - issuer-key))) + (next-method) + (let-keywords + initargs #t + ((webid #f) + (sub #f) + (aud #f) + (jwt-header #f) + (jwt-payload #f)) + (let do-initialize ((webid webid) + (sub sub) + (aud aud) + (jwt-header jwt-header) + (jwt-payload jwt-payload)) + (cond + ((string? webid) + (do-initialize (string->uri webid) sub aud jwt-header jwt-payload)) + ((and (not sub) (uri? webid)) + (do-initialize webid (uri->string webid) aud jwt-header jwt-payload)) + ((string? aud) + (do-initialize webid sub (string->uri aud) jwt-header jwt-payload)) + ((and webid sub) + (unless (uri? webid) + (scm-error 'wrong-type-arg "make" + (G_ "#:webid should be an URI") + '() + (list webid))) + (unless (string? sub) + (scm-error 'wrong-type-arg "make" + (G_ "#:sub should be a string") + '() + (list sub))) + (unless (uri? aud) + (scm-error 'wrong-type-arg "make" + (G_ "#:aud should be a string") + '() + (list aud))) + (slot-set! token 'webid webid) + (slot-set! token 'sub sub) + (slot-set! token 'aud aud)) + ((and jwt-header jwt-payload) + (do-initialize (assq-ref jwt-payload 'webid) + (assq-ref jwt-payload 'sub) + (assq-ref jwt-payload 'aud) + #f #f)) + (else + (raise-exception + (make-exception + (make-invalid-jws) + (make-exception-with-message + (G_ "when making an ID token either its required fields (#:alg, #:webid, #:iss, #:sub, #:aud, #:iat and #:exp) or (#:jwt-header and #:jwt-payload) should be passed"))))))))))) + +(define-method (token->jwt (token <id-token>)) + (receive (base-header base-payload) + (next-method) + (values + base-header + `((webid . ,(uri->string (webid token))) + (sub . ,(sub token)) + (aud . ,(uri->string (aud token))) + ,@base-payload)))) diff --git a/src/scm/webid-oidc/resource-server.scm b/src/scm/webid-oidc/resource-server.scm index 551b72d..99291b0 100644 --- a/src/scm/webid-oidc/resource-server.scm +++ b/src/scm/webid-oidc/resource-server.scm @@ -107,15 +107,27 @@ (('dpop . (? string? string-value)) string-value))) (access-token - (access-token-decode lit-access-token - #:http-get http-get)) - (cnf/jkt (access-token-cnf/jkt access-token)) + (decode <access-token> lit-access-token + #:http-request + (lambda* (uri . args) + (let without-method ((remaining-args args) + (kept-args '())) + (match remaining-args + (() (apply http-get uri (reverse kept-args))) + ((#:method 'GET remaining-args ...) + (without-method remaining-args kept-args)) + (((? keyword? key) value remaining-args ...) + (without-method remaining-args + `(,value ,key ,@kept-args)))))))) + (cnf/jkt (cnf/jkt access-token)) (dpop-proof - (dpop-proof-decode - method full-uri - dpop cnf/jkt #:access-token lit-access-token))) - (let ((subject (access-token-webid access-token)) - (issuer (access-token-iss access-token))) + (decode <dpop-proof> dpop + #:method method + #:uri full-uri + #:cnf/check cnf/jkt + #:access-token lit-access-token))) + (let ((subject (webid access-token)) + (issuer (iss access-token))) (confirm-provider subject issuer #:http-get http-get) subject))) #:unwind? #t))))))) diff --git a/src/scm/webid-oidc/token-endpoint.scm b/src/scm/webid-oidc/token-endpoint.scm index 81f8e48..292df4d 100644 --- a/src/scm/webid-oidc/token-endpoint.scm +++ b/src/scm/webid-oidc/token-endpoint.scm @@ -38,6 +38,8 @@ #:use-module (rnrs bytevectors) #:use-module (sxml simple) #:use-module (sxml match) + #:use-module (oop goops) + #:duplicates (merge-generics) #:declarative? #t #:export ( @@ -177,7 +179,7 @@ port))))))) thunk)))) -(define (make-token-endpoint token-endpoint-uri iss jwk validity) +(define (make-token-endpoint token-endpoint-uri iss issuer-key validity) (lambda (request request-body) (when (bytevector? request-body) (set! request-body (utf8->string request-body))) @@ -213,10 +215,11 @@ #:path (uri-path (request-uri request)) #:query (uri-query (request-uri request))))) (let ((grant-type (assoc-ref form-args "grant_type")) - (dpop (dpop-proof-decode - method uri - (assq-ref (request-headers request) 'dpop) - (lambda (jkt) #t)))) + (dpop (decode <dpop-proof> (assq-ref (request-headers request) 'dpop) + #:method method + #:uri uri + #:cnf/check + (lambda (jkt) #t)))) (unless (and grant-type (string? grant-type)) (let ((final-message (format #f (G_ "missing grant type"))) @@ -248,9 +251,16 @@ (make-no-authorization-code) (make-exception-with-message final-message) (make-message-for-the-user final-user-message))))) - (authorization-code-decode str jwk)))) - (values (authorization-code-webid code) - (authorization-code-client-id code)))) + (with-exception-handler + (lambda (error) + (raise-exception + (make-exception + (make-invalid-authorization-code) + error))) + (lambda () + (decode <authorization-code> str + #:issuer-key issuer-key)))))) + (values (webid code) (client-id code)))) ((refresh_token) (let ((refresh-token (assoc-ref form-args "refresh_token"))) (unless refresh-token @@ -268,7 +278,7 @@ (make-message-for-the-user final-user-message))))) (refresh:with-refresh-token refresh-token - (dpop-proof-jwk dpop) + (jwk dpop) values))) (else (let ((final-message @@ -288,26 +298,23 @@ (let* ((iat (time-second (date->time-utc current-time))) (exp (+ iat validity))) (let ((id-token - (issue-id-token - jwk + (issue <id-token> + issuer-key #:webid webid - #:sub (uri->string webid) #:iss iss - #:aud client-id - #:validity 3600)) + #:aud client-id)) (access-token - (issue-access-token - jwk + (issue <access-token> + issuer-key #:webid webid #:iss iss - #:validity 3600 - #:client-key (dpop-proof-jwk dpop) + #:client-key (jwk dpop) #:client-id client-id)) (refresh-token (if (equal? grant-type "refresh_token") (assoc-ref form-args "refresh_token") (refresh:issue-refresh-token webid client-id - (jkt (dpop-proof-jwk dpop)))))) + (jkt (jwk dpop)))))) (values (build-response #:headers '((content-type application/json) (cache-control (no-cache no-store))) diff --git a/tests/Makefile.am b/tests/Makefile.am index 251b6b0..99c834d 100644 --- a/tests/Makefile.am +++ b/tests/Makefile.am @@ -29,7 +29,6 @@ TESTS = %reldir%/load-library.scm \ %reldir%/jkt.scm \ %reldir%/verify.scm \ %reldir%/verification-failed.scm \ - %reldir%/jws.scm \ %reldir%/cache-valid.scm \ %reldir%/cache-revalidate.scm \ %reldir%/oidc-configuration.scm \ @@ -43,6 +42,8 @@ TESTS = %reldir%/load-library.scm \ %reldir%/dpop-proof-replay.scm \ %reldir%/dpop-proof-no-ath.scm \ %reldir%/dpop-proof-invalid-ath.scm \ + %reldir%/dpop-proof-no-explicit-exp.scm \ + %reldir%/dpop-proof-no-explicit-iat.scm \ %reldir%/client-manifest-public.scm \ %reldir%/client-manifest.scm \ %reldir%/client-manifest-fraudulent.scm \ diff --git a/tests/authorization-endpoint-submit-form.scm b/tests/authorization-endpoint-submit-form.scm index 37059fe..2fc7197 100644 --- a/tests/authorization-endpoint-submit-form.scm +++ b/tests/authorization-endpoint-submit-form.scm @@ -107,8 +107,8 @@ (exit 9)) (let ((parsed (parameterize ((p:current-date 60)) - (authorization-code-decode - (car (assoc-ref args "code")) - key)))) + (decode <authorization-code> + (car (assoc-ref args "code")) + #:issuer-key key)))) (unless parsed (exit 10))))))))) diff --git a/tests/dpop-proof-iat-in-future.scm b/tests/dpop-proof-iat-in-future.scm index f212643..7e6a3b1 100644 --- a/tests/dpop-proof-iat-in-future.scm +++ b/tests/dpop-proof-iat-in-future.scm @@ -32,10 +32,11 @@ (define cnf (jkt jwk)) (define proof (parameterize ((p:current-date 10)) - (issue-dpop-proof - jwk - #:htm 'GET - #:htu (string->uri "https://example.com/res#frag")))) + (issue <dpop-proof> + jwk + #:jwk (public-key jwk) + #:htm 'GET + #:htu (string->uri "https://example.com/res#frag")))) (with-exception-handler (lambda (error) (unless (and (signed-in-future? error) @@ -46,10 +47,10 @@ (raise-exception error))) (lambda () (parameterize ((p:current-date 0)) - (dpop-proof-decode 'GET - (string->uri "https://example.com/res?query") - proof - cnf)) + (decode <dpop-proof> proof + #:method 'GET + #:uri (string->uri "https://example.com/res?query") + #:cnf/check cnf)) (exit 2)) #:unwind? #t #:unwind-for-type &signed-in-future))) diff --git a/tests/dpop-proof-iat-too-late.scm b/tests/dpop-proof-iat-too-late.scm index 149e814..8019d1d 100644 --- a/tests/dpop-proof-iat-too-late.scm +++ b/tests/dpop-proof-iat-too-late.scm @@ -32,24 +32,25 @@ (define cnf (jkt jwk)) (define proof (parameterize ((p:current-date 0)) - (issue-dpop-proof - jwk - #:htm 'GET - #:htu (string->uri "https://example.com/res#frag")))) + (issue <dpop-proof> + jwk + #:jwk (public-key jwk) + #:htm 'GET + #:htu (string->uri "https://example.com/res#frag")))) (with-exception-handler (lambda (error) (unless (and (expired? error) (eqv? (time-second (date->time-utc (error-expiration-date error))) - 120) + 30) (eqv? (time-second (date->time-utc (error-current-date error))) - 600)) + 60)) (raise-exception error))) (lambda () - (parameterize ((p:current-date 600)) - (dpop-proof-decode 'GET - (string->uri "https://example.com/res?query") - proof - cnf)) + (parameterize ((p:current-date 60)) + (decode <dpop-proof> proof + #:method 'GET + #:uri (string->uri "https://example.com/res?query") + #:cnf/check cnf)) (exit 2)) #:unwind? #t #:unwind-for-type &expired))) diff --git a/tests/dpop-proof-invalid-ath.scm b/tests/dpop-proof-invalid-ath.scm index a82cf47..8c33e77 100644 --- a/tests/dpop-proof-invalid-ath.scm +++ b/tests/dpop-proof-invalid-ath.scm @@ -33,20 +33,20 @@ (define cnf (jkt jwk)) (define access-token (parameterize ((p:current-date 10)) - (issue-access-token - idp-key - #:webid (string->uri "https://data.provider/subject") - #:iss (string->uri "https://identity.provider") - #:validity 3600 - #:client-key jwk - #:client-id (string->uri "https://client")))) + (issue <access-token> + idp-key + #:webid (string->uri "https://data.provider/subject") + #:iss (string->uri "https://identity.provider") + #:client-key jwk + #:client-id (string->uri "https://client")))) (define proof (parameterize ((p:current-date 0)) - (issue-dpop-proof - jwk - #:htm 'GET - #:htu (string->uri "https://example.com/res?query") - #:access-token "aaaaaaaaaaaaaaa"))) + (issue <dpop-proof> + jwk + #:jwk (public-key jwk) + #:htm 'GET + #:htu (string->uri "https://example.com/res?query") + #:access-token "aaaaaaaaaaaaaaa"))) (with-exception-handler (lambda (error) (unless (and (dpop-invalid-ath? error) @@ -57,11 +57,11 @@ (raise-exception error))) (lambda () (parameterize ((p:current-date 10)) - (dpop-proof-decode 'GET - (string->uri "https://example.com/res?query") - proof - cnf - #:access-token access-token)) + (decode <dpop-proof> proof + #:method 'GET + #:uri (string->uri "https://example.com/res?query") + #:cnf/check cnf + #:access-token access-token)) (exit 2)) #:unwind? #t #:unwind-for-type &dpop-invalid-ath))) diff --git a/tests/dpop-proof-no-ath.scm b/tests/dpop-proof-no-ath.scm index ec37836..60c9cee 100644 --- a/tests/dpop-proof-no-ath.scm +++ b/tests/dpop-proof-no-ath.scm @@ -31,10 +31,11 @@ (define cnf (jkt jwk)) (define proof (parameterize ((p:current-date 0)) - (issue-dpop-proof - jwk - #:htm 'GET - #:htu (string->uri "https://example.com/res?query")))) + (issue <dpop-proof> + jwk + #:jwk (public-key jwk) + #:htm 'GET + #:htu (string->uri "https://example.com/res?query")))) (with-exception-handler (lambda (error) (unless (and (dpop-invalid-ath? error) @@ -45,11 +46,11 @@ (raise-exception error))) (lambda () (parameterize ((p:current-date 10)) - (dpop-proof-decode 'GET - (string->uri "https://example.com/res?query") - proof - cnf - #:access-token "aaa")) + (decode <dpop-proof> proof + #:method 'GET + #:uri (string->uri "https://example.com/res?query") + #:cnf/check cnf + #:access-token "aaa")) (exit 2)) #:unwind? #t #:unwind-for-type &dpop-invalid-ath))) diff --git a/tests/dpop-proof-no-explicit-exp.scm b/tests/dpop-proof-no-explicit-exp.scm new file mode 100644 index 0000000..c485cac --- /dev/null +++ b/tests/dpop-proof-no-explicit-exp.scm @@ -0,0 +1,86 @@ +;; disfluid, implementation of the Solid specification +;; Copyright (C) 2021 Vivien Kraus + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU Affero General Public License as +;; published by the Free Software Foundation, either version 3 of the +;; License, or (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU Affero General Public License for more details. + +;; You should have received a copy of the GNU Affero General Public License +;; along with this program. If not, see <https://www.gnu.org/licenses/>. + +(use-modules (webid-oidc dpop-proof) + (webid-oidc access-token) + (webid-oidc jwk) + (webid-oidc jws) + (webid-oidc testing) + (webid-oidc errors) + ((webid-oidc stubs) #:prefix stubs:) + ((webid-oidc parameters) #:prefix p:) + (web uri) + (srfi srfi-19) + (web response) + (ice-9 receive) + (oop goops)) + +(define-class <dpop-proof-with-exp> (<dpop-proof>)) + +(define malicious-jwt-created? #f) + +(define-method (token->jwt (token <dpop-proof-with-exp>)) + (set! malicious-jwt-created? #t) + (receive (header payload) (next-method) + (values header + `((exp . ,(time-second (date->time-utc (exp token)))) + ,@payload)))) + +(with-test-environment + "dpop-proof-no-explicit-exp" + (lambda () + (define jwk (generate-key #:n-size 2048)) + (define idp-key (generate-key #:n-size 2048)) + (define cnf (jkt jwk)) + (define access-token + (parameterize ((p:current-date 0)) + (issue <access-token> + idp-key + #:webid (string->uri "https://data.provider/subject") + #:iss (string->uri "https://identity.provider") + #:client-key jwk + #:client-id (string->uri "https://client")))) + (define proof + (parameterize ((p:current-date 0)) + (issue <dpop-proof-with-exp> + jwk + #:jwk (public-key jwk) + #:htm 'GET + #:htu (string->uri "https://example.com/res?query") + #:validity 3600 ;; Obviously too long: the decoder + ;; should ignore this value and make it + ;; obsolete after 120 seconds. + #:access-token access-token))) + (unless malicious-jwt-created? + (exit 1)) + (with-exception-handler + (lambda (error) + (unless (and (expired? error) + (eqv? (time-second (date->time-utc (error-expiration-date error))) + 30) + (eqv? (time-second (date->time-utc (error-current-date error))) + 60)) + (raise-exception error))) + (lambda () + (parameterize ((p:current-date 60)) + (decode <dpop-proof> proof + #:method 'GET + #:uri (string->uri "https://example.com/res?query") + #:cnf/check cnf + #:access-token access-token)) + (exit 2)) + #:unwind? #t + #:unwind-for-type &expired))) diff --git a/tests/dpop-proof-no-explicit-iat.scm b/tests/dpop-proof-no-explicit-iat.scm new file mode 100644 index 0000000..671dfa0 --- /dev/null +++ b/tests/dpop-proof-no-explicit-iat.scm @@ -0,0 +1,83 @@ +;; disfluid, implementation of the Solid specification +;; Copyright (C) 2021 Vivien Kraus + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU Affero General Public License as +;; published by the Free Software Foundation, either version 3 of the +;; License, or (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU Affero General Public License for more details. + +;; You should have received a copy of the GNU Affero General Public License +;; along with this program. If not, see <https://www.gnu.org/licenses/>. + +(use-modules (webid-oidc dpop-proof) + (webid-oidc access-token) + (webid-oidc jwk) + (webid-oidc jws) + (webid-oidc testing) + (webid-oidc errors) + ((webid-oidc stubs) #:prefix stubs:) + ((webid-oidc parameters) #:prefix p:) + (web uri) + (srfi srfi-19) + (web response) + (ice-9 receive) + (ice-9 match) + (oop goops)) + +(define-class <dpop-proof-without-iat> (<dpop-proof>)) + +(define malicious-jwt-created? #f) + +(define-method (token->jwt (token <dpop-proof-without-iat>)) + (set! malicious-jwt-created? #t) + ;; Omit the iat field; check that we don’t provide a default + (receive (header payload) (next-method) + (values header + (filter (match-lambda + (('iat . _) #f) + (else #t)) + payload)))) + +(with-test-environment + "dpop-proof-no-explicit-iat" + (lambda () + (define jwk (generate-key #:n-size 2048)) + (define idp-key (generate-key #:n-size 2048)) + (define cnf (jkt jwk)) + (define access-token + (parameterize ((p:current-date 10)) + (issue <access-token> + idp-key + #:webid (string->uri "https://data.provider/subject") + #:iss (string->uri "https://identity.provider") + #:client-key jwk + #:client-id (string->uri "https://client")))) + (define proof + (parameterize ((p:current-date 0)) + (issue <dpop-proof-without-iat> + jwk + #:jwk (public-key jwk) + #:htm 'GET + #:htu (string->uri "https://example.com/res?query") + #:access-token access-token))) + (unless malicious-jwt-created? + (exit 1)) + (with-exception-handler + (lambda (error) + (unless (invalid-jws? error) ;; iat should not be missing + (exit 2))) + (lambda () + (parameterize ((p:current-date 180)) + (decode <dpop-proof> proof + #:method 'GET + #:uri (string->uri "https://example.com/res?query") + #:cnf/check cnf + #:access-token access-token)) + (exit 3)) + #:unwind? #t + #:unwind-for-type &invalid-jws))) diff --git a/tests/dpop-proof-replay.scm b/tests/dpop-proof-replay.scm index 19e6a30..5720d93 100644 --- a/tests/dpop-proof-replay.scm +++ b/tests/dpop-proof-replay.scm @@ -31,23 +31,24 @@ (define cnf (jkt jwk)) (define proof (parameterize ((p:current-date 0)) - (issue-dpop-proof - jwk - #:htm 'GET - #:htu (string->uri "https://example.com/res#frag")))) - (define (decode) + (issue <dpop-proof> + jwk + #:jwk (public-key jwk) + #:htm 'GET + #:htu (string->uri "https://example.com/res#frag")))) + (define (do-decode) (parameterize ((p:current-date 10)) - (dpop-proof-decode 'GET - (string->uri "https://example.com/res?query") - proof - cnf))) - (define decoded-once (decode)) + (decode <dpop-proof> proof + #:method 'GET + #:uri (string->uri "https://example.com/res?query") + #:cnf/check cnf))) + (define decoded-once (do-decode)) (with-exception-handler (lambda (error) (unless (jti-found? error) (raise-exception error))) (lambda () - (decode) + (do-decode) (exit 2)) #:unwind? #t #:unwind-for-type &jti-found))) diff --git a/tests/dpop-proof-valid-ath.scm b/tests/dpop-proof-valid-ath.scm index 2a27e88..afcc9cd 100644 --- a/tests/dpop-proof-valid-ath.scm +++ b/tests/dpop-proof-valid-ath.scm @@ -31,26 +31,27 @@ (define cnf (jkt jwk)) (define access-token (parameterize ((p:current-date 10)) - (issue-access-token - idp-key - #:webid (string->uri "https://data.provider/subject") - #:iss (string->uri "https://identity.provider") - #:validity 3600 - #:client-key jwk - #:client-id (string->uri "https://client")))) + (issue <access-token> + idp-key + #:webid "https://data.provider/subject" + #:iss "https://identity.provider" + #:client-key jwk + #:client-id "https://client"))) (define proof (parameterize ((p:current-date 0)) - (issue-dpop-proof - jwk - #:htm 'GET - #:htu (string->uri "https://example.com/res#frag") - #:access-token access-token))) + (issue <dpop-proof> + jwk + #:jwk (public-key jwk) + #:htm 'GET + #:htu "https://example.com/res#frag" + #:access-token access-token))) (define decoded (parameterize ((p:current-date 10)) - (dpop-proof-decode 'GET - (string->uri "https://example.com/res?query") - proof - cnf - #:access-token access-token))) + (decode <dpop-proof> + proof + #:method 'GET + #:uri (string->uri "https://example.com/res?query") + #:cnf/check cnf + #:access-token access-token))) (unless decoded (exit 1)))) diff --git a/tests/dpop-proof-valid.scm b/tests/dpop-proof-valid.scm index 71ef602..1ef50d4 100644 --- a/tests/dpop-proof-valid.scm +++ b/tests/dpop-proof-valid.scm @@ -30,15 +30,16 @@ (define cnf (jkt jwk)) (define proof (parameterize ((p:current-date 0)) - (issue-dpop-proof + (issue <dpop-proof> jwk + #:jwk (public-key jwk) #:htm 'GET #:htu (string->uri "https://example.com/res#frag")))) (define decoded (parameterize ((p:current-date 10)) - (dpop-proof-decode 'GET - (string->uri "https://example.com/res?query") - proof - cnf))) + (decode <dpop-proof> proof + #:method 'GET + #:uri (string->uri "https://example.com/res?query") + #:cnf/check cnf))) (unless decoded (exit 1)))) diff --git a/tests/dpop-proof-wrong-htm.scm b/tests/dpop-proof-wrong-htm.scm index 1e94f72..b59dc9a 100644 --- a/tests/dpop-proof-wrong-htm.scm +++ b/tests/dpop-proof-wrong-htm.scm @@ -31,10 +31,11 @@ (define cnf (jkt jwk)) (define proof (parameterize ((p:current-date 0)) - (issue-dpop-proof - jwk - #:htm 'POST - #:htu (string->uri "https://example.com/res#frag")))) + (issue <dpop-proof> + jwk + #:jwk (public-key jwk) + #:htm 'POST + #:htu (string->uri "https://example.com/res#frag")))) (with-exception-handler (lambda (error) (unless (and (dpop-method-mismatch? error) @@ -45,10 +46,10 @@ (raise-exception error))) (lambda () (parameterize ((p:current-date 10)) - (dpop-proof-decode 'GET - (string->uri "https://example.com/res?query") - proof - cnf)) + (decode <dpop-proof> proof + #:method 'GET + #:uri (string->uri "https://example.com/res?query") + #:cnf/jkt cnf)) (exit 2)) #:unwind? #t #:unwind-for-type &dpop-method-mismatch))) diff --git a/tests/dpop-proof-wrong-htu.scm b/tests/dpop-proof-wrong-htu.scm index 299060e..68303d9 100644 --- a/tests/dpop-proof-wrong-htu.scm +++ b/tests/dpop-proof-wrong-htu.scm @@ -31,10 +31,11 @@ (define cnf (jkt jwk)) (define proof (parameterize ((p:current-date 0)) - (issue-dpop-proof - jwk - #:htm 'GET - #:htu (string->uri "https://example.com/other-res#frag")))) + (issue <dpop-proof> + jwk + #:jwk (public-key jwk) + #:htm 'GET + #:htu (string->uri "https://example.com/other-res#frag")))) (with-exception-handler (lambda (error) (unless (and (dpop-uri-mismatch? error) @@ -45,10 +46,10 @@ (raise-exception error))) (lambda () (parameterize ((p:current-date 10)) - (dpop-proof-decode 'GET - (string->uri "https://example.com/res?query") - proof - cnf)) + (decode <dpop-proof> proof + #:method 'GET + #:uri (string->uri "https://example.com/res?query") + #:cnf/jkt cnf)) (exit 2)) #:unwind? #t #:unwind-for-type &dpop-uri-mismatch))) diff --git a/tests/dpop-proof-wrong-key.scm b/tests/dpop-proof-wrong-key.scm index 1f3d033..cb5d4e5 100644 --- a/tests/dpop-proof-wrong-key.scm +++ b/tests/dpop-proof-wrong-key.scm @@ -31,20 +31,21 @@ (define cnf (jkt (generate-key #:n-size 2048))) (define proof (parameterize ((p:current-date 0)) - (issue-dpop-proof - jwk - #:htm 'GET - #:htu (string->uri "https://example.com/res#frag")))) + (issue <dpop-proof> + jwk + #:jwk (public-key jwk) + #:htm 'GET + #:htu (string->uri "https://example.com/res#frag")))) (with-exception-handler (lambda (error) (unless (dpop-unconfirmed-key? error) (raise-exception error))) (lambda () (parameterize ((p:current-date 10)) - (dpop-proof-decode 'GET - (string->uri "https://example.com/res?query") - proof - cnf)) + (decode <dpop-proof> proof + #:method 'GET + #:uri (string->uri "https://example.com/res?query") + #:cnf/check cnf)) (exit 2)) #:unwind? #t #:unwind-for-type &dpop-unconfirmed-key))) diff --git a/tests/jws.scm b/tests/jws.scm deleted file mode 100644 index a5c9330..0000000 --- a/tests/jws.scm +++ /dev/null @@ -1,70 +0,0 @@ -;; disfluid, implementation of the Solid specification -;; Copyright (C) 2020, 2021 Vivien Kraus - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU Affero General Public License as -;; published by the Free Software Foundation, either version 3 of the -;; License, or (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU Affero General Public License for more details. - -;; You should have received a copy of the GNU Affero General Public License -;; along with this program. If not, see <https://www.gnu.org/licenses/>. - -(use-modules (webid-oidc stubs) - (webid-oidc jwk) - (webid-oidc jws) - (webid-oidc testing)) - -(with-test-environment - "jws" - (lambda () - (let* ((key - (jwk->key - (json-string->scm "{\"kty\":\"RSA\",\"e\":\"AQAB\",\"kid\":\"db7cdbbf-0ca3-48da-abf6-8f34002a4651\",\"n\":\"nzyis1ZjfNB0bBgKFMSvvkTtwlvBsaJq7S5wA-kzeVOVpVWwkWdVha4s38XM_pa_yr47av7-z3VTmvDRyAHcaT92whREFpLv9cj5lTeJSibyr_Mrm_YtjCZVWgaOYIhwrXwKLqPr_11inWsAkfIytvHWTxZYEcXLgAXFuUuaS3uF9gEiNQwzGTU1v0FqkqTBr4B8nW3HCN47XUu0t8Y0e-lf4s4OxQawWD79J9_5d3Ry0vbV3Am1FtGJiJvOwRsIfVChDpYStTcHTCMqtvWbV6L11BWkpzGXSW4Hv43qa-GSYOD2QU68Mb59oSk2OB-BtOLpJofmbGEGgvmwyCI9Mw\"}"))) - (other-key (generate-key #:n-size 2048)) - (encoded "eyJhbGciOiJQUzI1NiIsInR5cCI6IkpXVCJ9.eyJzdWIiOiIxMjM0NTY3ODkwIiwibmFtZSI6IkpvaG4gRG9lIiwiYWRtaW4iOnRydWUsImlhdCI6MTUxNjIzOTAyMn0.hZnl5amPk_I3tb4O-Otci_5XZdVWhPlFyVRvcqSwnDo_srcysDvhhKOD01DigPK1lJvTSTolyUgKGtpLqMfRDXQlekRsF4XhAjYZTmcynf-C-6wO5EI4wYewLNKFGGJzHAknMgotJFjDi_NCVSjHsW3a10nTao1lB82FRS305T226Q0VqNVJVWhE4G0JQvi2TssRtCxYTqzXVt22iDKkXeZJARZ1paXHGV5Kd1CljcZtkNZYIGcwnj65gvuCwohbkIxAnhZMJXCLaVvHqv9l-AAUV7esZvkQR1IpwBAiDQJh4qxPjFGylyXrHMqh5NlT_pWL2ZoULWTg_TJjMO9TuQ") - (expected-alg "PS256") - (expected-typ "JWT") - (expected-sub "1234567890") - (expected-name "John Doe") - (expected-admin #t) - (expected-iat 1516239022) - (parsed (jws-decode encoded (lambda (jws) - (and (jws? jws) - key)))) - (parsed-header (car parsed)) - (parsed-payload (cdr parsed)) - (alg (jws-alg parsed)) - (typ (assq-ref parsed-header 'typ)) - (sub (assq-ref parsed-payload 'sub)) - (name (assq-ref parsed-payload 'name)) - (admin (assq-ref parsed-payload 'admin)) - (iat (assq-ref parsed-payload 'iat)) - (re-encoded (jws-encode parsed other-key)) - (re-parsed (jws-decode re-encoded (lambda (jws) other-key))) - (re-parsed-header (car re-parsed)) - (re-parsed-payload (cdr re-parsed)) - (re-alg (jws-alg re-parsed)) - (re-typ (assq-ref re-parsed-header 'typ)) - (re-sub (assq-ref re-parsed-payload 'sub)) - (re-name (assq-ref re-parsed-payload 'name)) - (re-admin (assq-ref re-parsed-payload 'admin)) - (re-iat (assq-ref re-parsed-payload 'iat))) - (unless (and (equal? alg expected-alg) - (equal? re-alg expected-alg) - (equal? typ expected-typ) - (equal? re-typ expected-typ) - (equal? sub expected-sub) - (equal? re-sub expected-sub) - (equal? name expected-name) - (equal? re-name expected-name) - (equal? admin expected-admin) - (equal? re-admin expected-admin) - (equal? iat expected-iat) - (equal? re-iat expected-iat)) - (format (current-error-port) - "The JWS test failed."))))) diff --git a/tests/resource-server.scm b/tests/resource-server.scm index 02b7e46..a8032b1 100644 --- a/tests/resource-server.scm +++ b/tests/resource-server.scm @@ -57,23 +57,23 @@ (else (exit 1)))) (define access-token (parameterize ((p:current-date 10)) - (issue-access-token - idp-key - #:webid subject - #:iss (string->uri "https://identity.provider") - #:validity 3600 - #:client-key client-key - #:client-id (string->uri "https://client")))) + (issue <access-token> + idp-key + #:webid subject + #:iss (string->uri "https://identity.provider") + #:client-key client-key + #:client-id (string->uri "https://client")))) (define uri (string->uri "https://resource.server/resource")) (define server-uri (string->uri "https://resource.server/")) (define method 'GET) (define dpop-proof (parameterize ((p:current-date 15)) - (issue-dpop-proof - client-key - #:htm method - #:htu uri - #:access-token access-token))) + (issue <dpop-proof> + client-key + #:jwk (public-key client-key) + #:htm method + #:htu uri + #:access-token access-token))) (define rq (call-with-input-string (format #f "GET /resource HTTP/1.1\r\n\ diff --git a/tests/token-endpoint-issue.scm b/tests/token-endpoint-issue.scm index c80658c..0815c30 100644 --- a/tests/token-endpoint-issue.scm +++ b/tests/token-endpoint-issue.scm @@ -43,11 +43,10 @@ (define validity 3600) (define authz (parameterize ((p:current-date 0)) - (issue-authorization-code - key - #:validity 120 - #:webid subject - #:client-id client))) + (issue <authorization-code> + key + #:webid subject + #:client-id client))) (define endpoint (make-token-endpoint (string->uri "https://token-endpoint-issue.scm/token") @@ -56,11 +55,12 @@ ;; The code is fake! (let ((dpop (parameterize ((p:current-date 0)) - (issue-dpop-proof - client-key - #:htm 'POST - #:htu (string->uri - "https://token-endpoint-issue.scm/token"))))) + (issue <dpop-proof> + client-key + #:jwk (public-key client-key) + #:htm 'POST + #:htu (string->uri + "https://token-endpoint-issue.scm/token"))))) (parameterize ((p:current-date 0)) (endpoint (build-request (string->uri @@ -75,11 +75,12 @@ (receive (response response-body . _) (let ((dpop (parameterize ((p:current-date 10)) - (issue-dpop-proof - client-key - #:htm 'POST - #:htu (string->uri - "https://token-endpoint-issue.scm/token"))))) + (issue <dpop-proof> + client-key + #:jwk (public-key client-key) + #:htm 'POST + #:htu (string->uri + "https://token-endpoint-issue.scm/token"))))) (parameterize ((p:current-date 10)) (endpoint (build-request (string->uri @@ -101,11 +102,29 @@ (exit 6)) (unless refresh-token-enc (exit 7)) - (let ((access-token (jws-decode access-token-enc - (lambda (h) key)))) + (let ((access-token + (parameterize ((p:current-date 20)) + (decode <access-token> access-token-enc + #:http-request + (lambda* (uri . args) + (cond + ((equal? uri (string->uri "https://issuer.token-endpoint-issue.scm/.well-known/openid-configuration")) + (values (build-response #:headers '((content-type application/json))) + "{ + \"jwks_uri\": \"https://token-endpoint-issue.scm/keys\", + \"token_endpoint\": \"https://token-endpoint-issue.scm/token\", + \"authorization_endpoint\": \"https://token-endpoint-issue.scm/authorize\", + \"solid_oidc_supported\": \"https://solidproject.org/TR/solid-oidc\" +}")) + ((equal? uri (string->uri "https://token-endpoint-issue.scm/keys")) + (values (build-response #:headers '((content-type application/json))) + (stubs:scm->json-string `((keys . ,(list->vector (list (key->jwk key)))))))) + (else + (format (current-error-port) "Unknown URI: ~s\n" (uri->string uri)) + (exit 11)))))))) (unless access-token (exit 8)) - (let ((access-token-cnf/jkt (access-token-cnf/jkt access-token))) + (let ((access-token-cnf/jkt (cnf/jkt access-token))) (unless access-token-cnf/jkt (exit 9)) (unless (string=? access-token-cnf/jkt (jkt client-key)) diff --git a/tests/token-endpoint-refresh.scm b/tests/token-endpoint-refresh.scm index f14d648..f0174b8 100644 --- a/tests/token-endpoint-refresh.scm +++ b/tests/token-endpoint-refresh.scm @@ -19,6 +19,7 @@ (webid-oidc refresh-token) (webid-oidc dpop-proof) (webid-oidc jwk) + (webid-oidc access-token) (webid-oidc jws) (webid-oidc jti) (webid-oidc testing) @@ -50,11 +51,12 @@ ;; The refresh token is fake! (let ((dpop (parameterize ((p:current-date 0)) - (issue-dpop-proof - client-key - #:htm 'POST - #:htu (string->uri - "https://token-endpoint-issue.scm/token"))))) + (issue <dpop-proof> + client-key + #:jwk (public-key client-key) + #:htm 'POST + #:htu (string->uri + "https://token-endpoint-issue.scm/token"))))) (parameterize ((p:current-date 0)) (endpoint (build-request (string->uri @@ -69,11 +71,12 @@ (receive (response response-body user error) (let ((dpop (parameterize ((p:current-date 10)) - (issue-dpop-proof - client-key - #:htm 'POST - #:htu (string->uri - "https://token-endpoint-issue.scm/token"))))) + (issue <dpop-proof> + client-key + #:jwk (public-key client-key) + #:htm 'POST + #:htu (string->uri + "https://token-endpoint-issue.scm/token"))))) (parameterize ((p:current-date 10)) (endpoint (build-request (string->uri @@ -94,17 +97,31 @@ (exit 6)) (unless refresh-token-enc (exit 7)) - (let ((access-token (jws-decode access-token-enc - (lambda (h) key)))) + (let ((access-token + (parameterize ((p:current-date 20)) + (decode <access-token> access-token-enc + #:http-request + (lambda* (uri . args) + (cond + ((equal? uri (string->uri "https://issuer.token-endpoint-issue.scm/.well-known/openid-configuration")) + (values (build-response #:headers '((content-type application/json))) + "{ + \"jwks_uri\": \"https://token-endpoint-issue.scm/keys\", + \"token_endpoint\": \"https://token-endpoint-issue.scm/token\", + \"authorization_endpoint\": \"https://token-endpoint-issue.scm/authorize\", + \"solid_oidc_supported\": \"https://solidproject.org/TR/solid-oidc\" +}")) + ((equal? uri (string->uri "https://token-endpoint-issue.scm/keys")) + (values (build-response #:headers '((content-type application/json))) + (stubs:scm->json-string `((keys . ,(list->vector (list (key->jwk key)))))))) + (else + (exit 8)))))))) (unless access-token - (exit 8)) - (let ((access-token-cnf (assq-ref access-token 'cnf))) - (unless access-token-cnf - (exit 9)) - (let ((access-token-cnf/jkt (assq-ref access-token-cnf 'jkt))) - (unless access-token-cnf/jkt - (exit 10)) - (unless (string=? access-token-cnf/jkt (jkt client-key)) - (exit 11)))) - (unless (string=? refresh-token-enc refresh-code) - (exit 12))))))))) + (exit 9)) + (let ((access-token-cnf/jkt (cnf/jkt access-token))) + (unless access-token-cnf/jkt + (exit 10)) + (unless (string=? access-token-cnf/jkt (jkt client-key)) + (exit 11)))) + (unless (string=? refresh-token-enc refresh-code) + (exit 12)))))))) |