diff options
79 files changed, 6419 insertions, 5539 deletions
diff --git a/doc/disfluid.texi b/doc/disfluid.texi index 2841052..0a2c489 100644 --- a/doc/disfluid.texi +++ b/doc/disfluid.texi @@ -401,12 +401,8 @@ configuration of the claimed issuer, and check the signature against the published keys. The @code{http-get} optional keyword argument can set a different implementation of @code{http-get} from @emph{(web client)}, for instance to re-use the what has been obtained -by the ID token validation. Return @code{#f} if it failed, or the -decoded token otherwise. -@end deffn - -@deffn function access-token-encode @var{token} @var{key} -Encode @var{token} and sign it with the issuer’s @var{key}. +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{#alg} @var{#webid} @var{#iss} @var{#:validity} @var{[#client-key} @var{|} @var{#cnf/jkt]} @var{#client-id} @@ -1045,504 +1041,39 @@ point to where to a presentation of your application. The library will raise an exception whenever something fishy occurs. For instance, if a signature is invalid, or the expiration -date has passed. All exception types are defined in -@code{(webid-oidc errors)}. - -@deffn function error->str @var{error} @var{[#depth]} -Return a string explaining the @var{error}. You can limit the -@var{depth} of the explanation as an integer. +date has passed. + +When the client is responsible for an error, such as presenting an +invalid access token, a compound exception is raised. It is sometimes +useful for the user to understand what happened, because it could +indicate a problem in a part of the web they need to change. For +instance, if the access token cannot be decoded because the identity +provider is down, then maybe informing the user of that fact is +useful. + +However, presenting too much information is a security risk. For +instance, if the system administrator also runs a private server on +the same machine, and a malicious client tries to pretend that this +private server is an identity provider, then the public server will +try to query the private server. If an error happens and the public +server displays some information to the client, then a part of the +information comes from the private server. Thus, a balance needs to be +found so that not too much is revealed. + +The module @emph{(webid-oidc errors)} defines an exception type that +indicates a message that is safe to display to the user. + +@deftp {Exception type} &message-for-the-user @var{message} +Indicate that @var{message} can be safely displayed to the user. It is +an XHTML paragraph (or equivalent), presented as SXML. +@end deftp + +@deffn function make-message-for-the-user @var{message} +@deffnx user-message @var{exception} +Constructor and accessor for the @code{&message-for-the-user} +exception type. @end deffn -@menu -* Invalid data format:: -* Invalid JWT:: -* Cannot fetch data on the web:: -* Other errors in the protocol or from a reasonable implementation:: -* Server-side errors:: -@end menu - -@node Invalid data format -@section Invalid data format -There are a few JSON objects with required fields. This exceptions -usually occur as the cause of a higher-level exception. - -@deftp {exception type} ¬-base64 @var{value} @var{cause} -This exception is raised when the base64 decoding function -failed. @var{value} is the incorrect input, and @var{cause} is a -low-level error. -@end deftp - -@deftp {exception type} ¬-json @var{value} @var{cause} -Cannot decode @var{value} to a JSON object. -@end deftp - -@deftp {exception type} ¬-turtle @var{value} @var{cause} -Cannot decode @var{value} to a RDF graph. -@end deftp - -@deftp {exception type} &incorrect-webid-field @var{value} -The @var{value} of the webid field in the JWT is missing (if -@code{#f}), or not an acceptable value. -@end deftp - -@deftp {exception type} &incorrect-iss-field @var{value} -The @var{value} of the iss field is incorrect. -@end deftp - -@deftp {exception type} &incorrect-aud-field @var{value} -The @var{value} of the aud field is incorrect. -@end deftp - -@deftp {exception type} &incorrect-iat-field @var{value} -The @var{value} of the iat field is incorrect. -@end deftp - -@deftp {exception type} &incorrect-exp-field @var{value} -The @var{value} of the exp field is incorrect. -@end deftp - -@deftp {exception type} &incorrect-cnf/jkt-field @var{value} -The @var{value} of the cnf/jkt field is incorrect. -@end deftp - -@deftp {exception type} &incorrect-client-id-field @var{value} -The @var{value} of the client-id field is incorrect. -@end deftp - -@deftp {exception type} &incorrect-typ-field @var{value} -The @var{value} of the typ field in the DPoP proof header is -incorrect. -@end deftp - -@deftp {exception type} &incorrect-jwk-field @var{value} @var{cause} -The @var{value} of the jwk field in the DPoP proof header is -incorrect. -@end deftp - -@deftp {exception type} &incorrect-jti-field @var{value} -The @var{value} of the jti field in the DPoP proof is incorrect. -@end deftp - -@deftp {exception type} &incorrect-htm-field @var{value} -The @var{value} of the htm field in the DPoP proof is incorrect. -@end deftp - -@deftp {exception type} &incorrect-htu-field @var{value} -The @var{value} of the htu field in the DPoP proof is incorrect. -@end deftp - -@deftp {exception type} &incorrect-ath-field @var{value} -The @var{value} of the ath field is not the hash of the access token. -@end deftp - -@deftp {exception type} &incorrect-redirect-uris-field @var{value} -The @var{value} of the redirect-uris field of a client manifest is -incorrect. -@end deftp - -@deftp {exception type} &incorrect-typ-field @var{value} -The @var{value} of the typ field in the DPoP proof header is -incorrect. -@end deftp - -@deftp {exception type} &incorrect-sub-field @var{value} -The @var{value} of the sub field is incorrect. -@end deftp - -@deftp {exception type} &incorrect-iss-field @var{value} -The @var{value} of the iss field is incorrect. -@end deftp - -@deftp {exception type} &incorrect-nonce-field @var{value} -The @var{value} of the nonce field in the DPoP proof is incorrect. -@end deftp - -@deftp {exception type} &incorrect-htm-field @var{value} -The @var{value} of the htm field in the DPoP proof is incorrect. -@end deftp - -@deftp {exception type} ¬-a-client-manifest @var{value} @var{cause} -The @var{client-manifest} is incorrect. -@end deftp - -@node Invalid JWT -@section Invalid JWT -Each JWT type – access token, DPoP proof, ID token, authorization code -(this is internal to the identity provider) has different validation -rules, and can fail in different ways. - -@deftp {exception type} &unsupported-crv @var{crv} -The identifier @var{crv} does not identify an elliptic curve. -@end deftp - -@deftp {exception type} ¬-a-jwk @var{value} @var{cause} -@var{value} does not identify a JWK. -@end deftp - -@deftp {exception type} ¬-a-public-jwk @var{value} @var{cause} -@var{value} does not identify a public JWK. -@end deftp - -@deftp {exception type} ¬-a-private-jwk @var{value} @var{cause} -@var{value} does not identify a private JWK. -@end deftp - -@deftp {exception type} ¬-a-jwks @var{value} @var{cause} -@var{value} does not identify a set of public keys. -@end deftp - -@deftp {exception type} &unsupported-alg @var{value} -@var{value} does not identify a valid hash algorithm. -@end deftp - -@deftp {exception type} &invalid-signature @var{key} @var{payload} @var{signature} -@var{key} has not signed @var{payload} with @var{signature}. -@end deftp - -@deftp {exception type} &missing-alist-key @var{value} @var{key} -@var{value} isn’t an alist, or is missing a value with @var{key}. -@end deftp - -@deftp {exception type} ¬-a-jws-header @var{value} @var{cause} -@var{value} does not identify a decoded JWS header. -@end deftp - -@deftp {exception type} ¬-a-jws-payload @var{value} @var{cause} -@var{value} does not identify a decoded JWS payload. -@end deftp - -@deftp {exception type} ¬-a-jws @var{value} @var{cause} -@var{value} does not identify a decoded JWS. -@end deftp - -@deftp {exception type} ¬-in-3-parts @var{string} @var{separator} -@var{string} cannot be split into 3 parts with @var{separator}. -@end deftp - -@deftp {exception type} &no-matching-key @var{candidates} @var{alg} @var{payload} @var{signature} -No key among @var{candidates} could verify @var{signature} signed with -@var{alg} for @var{payload}, because the signature mismatched for all -keys. -@end deftp - -@deftp {exception type} &cannot-decode-jws @var{value} @var{cause} -The @var{value} string is not an encoding of a valid JWS. -@end deftp - -@deftp {exception type} &cannot-encode-jws @var{jws} @var{key} @var{cause} -The @var{jws} cannot be signed. -@end deftp - -@deftp {exception type} ¬-an-access-token @var{value} @var{cause} -The @var{value} is not an access token. -@end deftp - -@deftp {exception type} ¬-an-access-token-header @var{value} @var{cause} -The @var{value} is not an access token header. -@end deftp - -@deftp {exception type} ¬-an-access-token-payload @var{value} @var{cause} -The @var{value} is not an access token payload. -@end deftp - -@deftp {exception type} &cannot-decode-access-token @var{value} @var{cause} -The @var{value} string is not an encoding of a valid access token. -@end deftp - -@deftp {exception type} &cannot-encode-access-token @var{access-token} @var{key} @var{cause} -The @var{access-token} cannot be signed. -@end deftp - -@deftp {exception type} ¬-a-dpop-proof @var{value} @var{cause} -The @var{value} is not a DPoP proof. -@end deftp - -@deftp {exception type} ¬-a-dpop-proof-header @var{value} @var{cause} -The @var{value} is not a DPoP proof header. -@end deftp - -@deftp {exception type} ¬-a-dpop-proof-payload @var{value} @var{cause} -The @var{value} is not a DPoP proof payload. -@end deftp - -@deftp {exception type} &cannot-decode-dpop-proof @var{value} @var{cause} -The @var{value} string is not an encoding of a valid DPoP proof. -@end deftp - -@deftp {exception type} &cannot-encode-dpop-proof @var{dpop-proof} @var{key} @var{cause} -The @var{dpop-proof} cannot be signed. -@end deftp - -@deftp {exception type} ¬-an-authorization-code @var{value} @var{cause} -The @var{value} is not an authorization code. -@end deftp - -@deftp {exception type} ¬-an-authorization-code-header @var{value} @var{cause} -The @var{value} is not an authorization code header. -@end deftp - -@deftp {exception type} ¬-an-authorization-code-payload @var{value} @var{cause} -The @var{value} is not an authorization code payload. -@end deftp - -@deftp {exception type} &cannot-decode-authorization-code @var{value} @var{cause} -The @var{value} string is not an encoding of a valid authorization -code. -@end deftp - -@deftp {exception type} &cannot-encode-authorization-code @var{authorization-code} @var{key} @var{cause} -The @var{authorization-code} cannot be signed. -@end deftp - -@deftp {exception type} ¬-an-id-token @var{value} @var{cause} -The @var{value} is not an ID token. -@end deftp - -@deftp {exception type} ¬-an-id-token-header @var{value} @var{cause} -The @var{value} is not an ID token header. -@end deftp - -@deftp {exception type} ¬-an-id-token-payload @var{value} @var{cause} -The @var{value} is not an ID token payload. -@end deftp - -@deftp {exception type} &cannot-decode-id-token @var{value} @var{cause} -The @var{value} string is not an encoding of a valid ID token. -@end deftp - -@deftp {exception type} &cannot-encode-id-token @var{id-token} @var{key} @var{cause} -The @var{id-token} cannot be signed. -@end deftp - -@node Cannot fetch data on the web -@section Cannot fetch data on the web -In the client (local and public parts), resource server and identity -provider, the protocol requires to fetch data on the web. - -@deftp {exception type} &request-failed-unexpectedly @var{response-code} @var{response-reason-phrase} -We expected the request to succeed, but the server sent a non-OK -@var{response-code}. -@end deftp - -@deftp {exception type} &unexpected-header-value @var{header} @var{value} -We did not expect the server to respond with @var{header} set to -@var{value}. -@end deftp - -@deftp {exception type} &unexpected-response @var{response} @var{cause} -The @var{response} (from @emph{(web response)}) is not appropriate. -@end deftp - -@deftp {exception type} ¬-an-oidc-configuration @var{value} @var{cause} -The @var{value} is not appropriate an OIDC configuration. -@end deftp - -@deftp {exception type} &cannot-fetch-issuer-configuration @var{issuer} @var{cause} -It is impossible to fetch the configuration of @var{issuer}. -@end deftp - -@deftp {exception type} &cannot-fetch-jwks @var{issuer} @var{uri} @var{cause} -It is impossible to fetch the keys of @var{issuer} at @var{uri}. -@end deftp - -@deftp {exception type} &cannot-fetch-linked-data @var{uri} @var{cause} -Could not fetch the graph referenced by @var{uri}. -@end deftp - -@deftp {exception type} &cannot-fetch-client-manifest @var{id} @var{cause} -Could not fetch a client manifest at @var{id}. -@end deftp - -@node Other errors in the protocol or from a reasonable implementation -@section Other errors in the protocol or from a reasonable implementation -The protocol does not rely solely on JWT validation, so these errors -may happen too. - -@deftp {exception type} &dpop-method-mismatch @var{signed} @var{requested} -The method value @var{signed} in the DPoP proof does not match the -method that is @var{requested} on the server. -@end deftp - -@deftp {exception type} &dpop-uri-mismatch @var{signed} @var{requested} -The URI value @var{signed} in the DPoP proof does not match the URI -that is @var{requested} on the server. -@end deftp - -@deftp {exception type} &dpop-signed-in-future @var{signed} @var{current} -The proof is @var{signed} for a date which is too much ahead of the -@var{current} time. -@end deftp - -@deftp {exception type} &dpop-too-old @var{signed} @var{current} -The proof was @var{signed} at a past date of @var{current}. -@end deftp - -@deftp {exception type} &dpop-unconfirmed-key @var{key} @var{expected} @var{cause} -The confirmation of @var{key} is not what is @var{expected}, or (if a -function was passed as @var{cnf/check}) the @var{cause} exception -occurred while confirming. -@end deftp - -@deftp {exception type} &dpop-invalid-access-token-hash @var{hash} @var{access-token} -The @var{access-token} passed to the resource server does not match -the @var{hash} provided in the DPoP proof. -@end deftp - -@deftp {exception type} &jti-found @var{jti} @var{cause} -The @var{jti} of the proof has already been issued in a recent past. -@end deftp - -@deftp {exception type} &unauthorized-redirection-uri @var{manifest} @var{uri} -The authorization @var{uri} is not advertised in @var{manifest}. -@end deftp - -@deftp {exception type} &cannot-serve-public-manifest -You cannot serve the public client manifest. -@end deftp - -@deftp {exception type} &no-client-manifest-registration @var{id} -The @var{id} client manifest does not have a registration triple in -its document. -@end deftp - -@deftp {exception type} &inconsistent-client-manifest-id @var{id} @var{advertised-id} -The client @var{manifest} is being fetched at @var{id}, but it is -valid for another client @var{advertised-id}. -@end deftp - -@deftp {exception type} &authorization-code-expired @var{exp} @var{current-time} -The authorization code has expired at @var{exp}, it is now -@var{current-time}. -@end deftp - -@deftp {exception type} &invalid-refresh-token @var{refresh-token} -The @var{refresh-token} is unknown to the identity provider. -@end deftp - -@deftp {exception type} &invalid-key-for-refresh-token @var{key} @var{jkt} -The refresh token was issued for @var{jkt}, but it is used with -@var{key}. -@end deftp - -@deftp {exception type} &unknown-client-locale @var{web-locale} @var{c-locale} -The @var{web-locale} of the client, translated to C as @var{c-locale}, -cannot be set. This exception is always continuable; if the handler -returns, then the page will be served in the english locale. -@end deftp - -@deftp {exception type} &unsupported-grant-type @var{value} -The token request failed to indicate a @var{value} for the grant type, -or indicated an unsupported grant type. -@end deftp - -@deftp {exception type} &no-authorization-code -The token request forgot to put an authorization code. -@end deftp - -@deftp {exception type} &no-refresh-token -The token request forgot to put a refresh token with the request. -@end deftp - -@deftp {exception type} &unconfirmed-provider @var{subject} @var{provider} -@var{provider} is not confirmed by @var{subject} as an identity -provider. -@end deftp - -@deftp {exception type} &no-provider-candidates @var{webid} @var{causes} -The @var{webid} cannot be certified by any identity providers. The -@var{causes} alist indicates an error for each candidates. -@end deftp - -@deftp {exception type} &neither-identity-provider-nor-webid @var{uri} @var{why-not-identity-provider} @var{why-not-webid} -The @var{uri} you passed to get an authorization code is neither an -identity provider (because @var{why-not-identity-provider}) nor a -webid (because @var{why-not-webid}). -@end deftp - -@deftp {exception type} &token-request-failed @var{cause} -The token request failed on the server. -@end deftp - -@deftp {exception type} &profile-not-found @var{webid} @var{iss} @var{dir} -The @var{webid}, as certified by @var{iss}, cannot be refreshed -because we don’t have a refresh token stored in @var{dir}. -@end deftp - -@node Server-side errors -@section Server-side errors -The resource server implementation may encounter some more exceptional -conditions. - -@deftp {exception type} &path-not-found @var{path} -There is no registered resource at @var{path}. -@end deftp - -@deftp {exception type} &auxiliary-resource-absent @var{path} @var{kind} -The auxiliary resource of given @var{kind} is not instanciated on the -server for the base resource @var{path}. -@end deftp - -@deftp {exception type} &uri-slash-semantics-error @var{path} @var{expected-path} -While the resource at @var{path} does not exist, the resource at -@var{expected-path} does, and @var{path} and @var{expected-path} -differ only by a trailing slash. This exception may be raised along -with @code{&path-not-found}. - -Beware that even if it is true at the time when the exception is -created, maybe the resource has been created by the time it is -handled. -@end deftp - -@deftp {exception type} &cannot-delete-root -There was a request to delete the root storage, which is an error. -@end deftp - -@deftp {exception type} &container-not-empty @var{path} -There was a request to delete a non-empty container. -@end deftp - -@deftp {exception type} &cannot-fetch-group @var{group-uri} @var{cause} -The access control could not fetch the group @var{group-uri} (with a -known @var{cause}). This warning is continuable every time it is -raised. If the handler returns, then the group will be considered -empty. -@end deftp - -@deftp {exception type} &incorrect-containment-triples @var{path} -The client wanted to create or update a resource, and by that it tried -to change the containment triples at @var{path}. -@end deftp - -@deftp {exception type} &unsupported-media-type @var{content-type} -The client wanted to create a resource with the given -@var{content-type}, but it is not accepted, because @var{content-type} -is not recognized as an RDF content type. -@end deftp - -@deftp {exception type} &path-is-auxiliary @var{path} -The client wanted to create a resource that targets an auxiliary -resource, at @var{path}. -@end deftp - -@deftp {exception type} &forbidden @var{path} @var{user} @var{owner} @var{mode} -The @var{user} wanted to do something under @var{path} requiring -@var{mode}, but it is not the @var{owner} and it is forbidden by WAC. -@end deftp - -@deftp {exception type} &precondition-failed @var{path} @var{if-match} @var{if-none-match} @var{real-etag} -The resource under @var{path} has a @var{real-etag} that does not -match the request headers @var{if-match} and @var{if-none-match}. - -If the resource does not exist, @var{real-etag} is set to -@code{#f}. In this case, an exception of type @code{&path-not-found} -is also thrown. -@end deftp - -@deftp {exception type} ¬-acceptable @var{client-accepts} @var{path} @var{content-type} -The client wanted a response with a specific set of -@var{client-accept}ed content-types, but the real @var{content-type} -of the resource under @var{path} cannot be converted to one of them. -@end deftp @node GNU Free Documentation License @appendix GNU Free Documentation License diff --git a/po/Makevars b/po/Makevars index d325102..e156439 100644 --- a/po/Makevars +++ b/po/Makevars @@ -12,7 +12,7 @@ subdir = po top_builddir = .. # These options get passed to xgettext. -XGETTEXT_OPTIONS = --keyword=_ --keyword=N_ --keyword=G_ --from-code=utf-8 +XGETTEXT_OPTIONS = --keyword=_ --keyword=N_ --keyword=G_ --keyword=W_ --from-code=utf-8 # This is the copyright holder that gets inserted into the header of the # $(DOMAIN).pot file. Set this to the copyright holder of the surrounding diff --git a/po/POTFILES.in b/po/POTFILES.in index 69026ba..d19a46f 100644 --- a/po/POTFILES.in +++ b/po/POTFILES.in @@ -22,11 +22,47 @@ src/random/generate-random.c src/jwk/libwebidoidc-jwk.c src/jwk/generate-key.c src/hash/libwebidoidc-hash.c -src/scm/webid-oidc/errors.scm -src/scm/webid-oidc/identity-provider.scm +src/scm/webid-oidc/access-token.scm +src/scm/webid-oidc/authorization-code.scm +src/scm/webid-oidc/authorization-endpoint.scm +src/scm/webid-oidc/authorization-page.scm src/scm/webid-oidc/authorization-page-unsafe.scm -src/scm/webid-oidc/resource-server.scm -src/scm/webid-oidc/hello-world.scm +src/scm/webid-oidc/cache.scm +src/scm/webid-oidc/catalog.scm +src/scm/webid-oidc/ChangeLog +src/scm/webid-oidc/client/accounts.scm +src/scm/webid-oidc/client-manifest.scm +src/scm/webid-oidc/client.scm +src/scm/webid-oidc/dpop-proof.scm +src/scm/webid-oidc/errors.scm src/scm/webid-oidc/example-app.scm +src/scm/webid-oidc/fetch.scm +src/scm/webid-oidc/hello-world.scm +src/scm/webid-oidc/http-link.scm +src/scm/webid-oidc/identity-provider.scm +src/scm/webid-oidc/jti.scm +src/scm/webid-oidc/jwk.scm +src/scm/webid-oidc/jws.scm +src/scm/webid-oidc/Makefile.am +src/scm/webid-oidc/offloading.scm +src/scm/webid-oidc/oidc-configuration.scm +src/scm/webid-oidc/oidc-id-token.scm +src/scm/webid-oidc/parameters.scm src/scm/webid-oidc/program.scm -src/scm/webid-oidc/client/accounts.scm
\ No newline at end of file +src/scm/webid-oidc/provider-confirmation.scm +src/scm/webid-oidc/rdf-index.scm +src/scm/webid-oidc/refresh-token.scm +src/scm/webid-oidc/resource-server.scm +src/scm/webid-oidc/reverse-proxy.scm +src/scm/webid-oidc/server/create.scm +src/scm/webid-oidc/server/delete.scm +src/scm/webid-oidc/server/log.scm +src/scm/webid-oidc/server/precondition.scm +src/scm/webid-oidc/server/read.scm +src/scm/webid-oidc/server/update.scm +src/scm/webid-oidc/serve.scm +src/scm/webid-oidc/simulation.scm +src/scm/webid-oidc/stubs.scm +src/scm/webid-oidc/testing.scm +src/scm/webid-oidc/token-endpoint.scm +src/scm/webid-oidc/web-i18n.scm
\ No newline at end of file diff --git a/po/disfluid.pot b/po/disfluid.pot index df099d6..3c77ced 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-08-12 18:50+0200\n" +"POT-Creation-Date: 2021-08-12 18:55+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,1081 +122,1087 @@ msgstr "" msgid "Usage: generate-key [NUMBER OF BITS | CURVE]\n" msgstr "" -#: src/scm/webid-oidc/errors.scm:1081 -msgid "that’s how it is" +#: src/scm/webid-oidc/access-token.scm:72 +#, scheme-format +msgid "this is not an access token, because it is not even a JWS: ~a" msgstr "" -#: src/scm/webid-oidc/errors.scm:1086 -#, scheme-format -msgid "the value ~s is not a base64 string (because ~a)" +#: src/scm/webid-oidc/access-token.scm:74 +msgid "this is not an access token, because it is not even a JWS" msgstr "" -#: src/scm/webid-oidc/errors.scm:1089 +#: src/scm/webid-oidc/access-token.scm:77 src/scm/webid-oidc/dpop-proof.scm:96 #, scheme-format -msgid "the value ~s is not JSON (because ~a)" +msgid "this is not an access token: ~a" msgstr "" -#: src/scm/webid-oidc/errors.scm:1092 -#, scheme-format -msgid "the value ~s is not Turtle (because ~a)" +#: src/scm/webid-oidc/access-token.scm:79 src/scm/webid-oidc/dpop-proof.scm:98 +msgid "this is not an access token" msgstr "" -#: src/scm/webid-oidc/errors.scm:1095 +#: src/scm/webid-oidc/access-token.scm:101 +#: src/scm/webid-oidc/authorization-code.scm:88 +#: src/scm/webid-oidc/oidc-id-token.scm:96 #, scheme-format -msgid "the value ~s does not identify an elleptic curve" +msgid "the payload is missing ~s" msgstr "" -#: src/scm/webid-oidc/errors.scm:1100 +#: src/scm/webid-oidc/access-token.scm:123 +#: src/scm/webid-oidc/authorization-code.scm:104 +#: src/scm/webid-oidc/oidc-id-token.scm:117 #, scheme-format -msgid "the value ~s does not identify a JWK (because ~a)" +msgid "the \"webid\" field should be an URI, ~s is given" msgstr "" -#: src/scm/webid-oidc/errors.scm:1102 +#: src/scm/webid-oidc/access-token.scm:130 +#: src/scm/webid-oidc/oidc-id-token.scm:124 #, scheme-format -msgid "the value ~s does not identify a JWK" +msgid "the \"iss\" field should be an URI, ~s is given" msgstr "" -#: src/scm/webid-oidc/errors.scm:1107 +#: src/scm/webid-oidc/access-token.scm:135 #, scheme-format -msgid "the value ~s does not identify a public JWK (because ~a)" +msgid "the \"aud\" field should be set to \"solid\", ~s is given" msgstr "" -#: src/scm/webid-oidc/errors.scm:1109 +#: src/scm/webid-oidc/access-token.scm:142 +#: src/scm/webid-oidc/oidc-id-token.scm:152 #, scheme-format -msgid "the value ~s does not identify a public JWK" +msgid "the \"iat\" field should be a timestamp, ~s is given" msgstr "" -#: src/scm/webid-oidc/errors.scm:1114 +#: src/scm/webid-oidc/access-token.scm:149 +#: src/scm/webid-oidc/authorization-code.scm:125 +#: src/scm/webid-oidc/oidc-id-token.scm:159 #, scheme-format -msgid "the value ~s does not identify a private JWK (because ~a)" +msgid "the \"exp\" field should be a timestamp, ~s is given" msgstr "" -#: src/scm/webid-oidc/errors.scm:1116 -#, scheme-format -msgid "the value ~s does not identify a private JWK" +#: src/scm/webid-oidc/access-token.scm:158 +msgid "the \"cnf\" / \"jkt\" field is missing" msgstr "" -#: src/scm/webid-oidc/errors.scm:1121 +#: src/scm/webid-oidc/access-token.scm:166 #, scheme-format -msgid "the value ~s does not identify a JWKS (because ~a)" +msgid "the \"cnf\" / \"jkt\" field should be a string, ~s is given" msgstr "" -#: src/scm/webid-oidc/errors.scm:1123 +#: src/scm/webid-oidc/access-token.scm:171 #, scheme-format -msgid "the value ~s does not identify a JWKS" +msgid "the \"cnf\" field should be an object, ~s is given" msgstr "" -#: src/scm/webid-oidc/errors.scm:1126 +#: src/scm/webid-oidc/access-token.scm:178 +#: src/scm/webid-oidc/authorization-code.scm:111 #, scheme-format -msgid "the value ~s does not identify a hash algorithm" +msgid "the \"client_id\" field should be an URI, ~s is given" msgstr "" -#: src/scm/webid-oidc/errors.scm:1129 +#: src/scm/webid-oidc/access-token.scm:238 #, scheme-format -msgid "the value ~s is not an alist or misses key ~s" +msgid "the access token is invalid: ~a" msgstr "" -#: src/scm/webid-oidc/errors.scm:1132 -#, scheme-format -msgid "the value ~s is not a JWS header (because ~a)" +#: src/scm/webid-oidc/access-token.scm:240 +msgid "the access token is invalid" msgstr "" -#: src/scm/webid-oidc/errors.scm:1135 +#: src/scm/webid-oidc/access-token.scm:256 +#: src/scm/webid-oidc/oidc-id-token.scm:236 #, scheme-format -msgid "the value ~s is not a JWS payload (because ~a)" +msgid "I cannot query the identity provider configuration: ~a" msgstr "" -#: src/scm/webid-oidc/errors.scm:1138 -#, scheme-format -msgid "the value ~s is not a JWS (because ~a)" +#: src/scm/webid-oidc/access-token.scm:258 +#: src/scm/webid-oidc/oidc-id-token.scm:238 +msgid "I cannot query the identity provider configuratioon" msgstr "" -#: src/scm/webid-oidc/errors.scm:1141 +#: src/scm/webid-oidc/access-token.scm:275 #, scheme-format -msgid "the string ~s cannot be split in 3 parts with ~s" +msgid "I cannot query the identity provider public keys: ~a" msgstr "" -#: src/scm/webid-oidc/errors.scm:1144 -#, scheme-format -msgid "" -"all key candidates failed to verify signature ~s with algorithm ~s and " -"payload ~a (there were ~a: ~s)" +#: src/scm/webid-oidc/access-token.scm:277 +msgid "I cannot query the identity provider public keys" msgstr "" -#: src/scm/webid-oidc/errors.scm:1147 +#: src/scm/webid-oidc/access-token.scm:293 #, scheme-format -msgid "I cannot decode JWS ~a (because ~a)" +msgid "the access token is signed in the future, ~a, relative to current ~a" msgstr "" -#: src/scm/webid-oidc/errors.scm:1150 +#: src/scm/webid-oidc/access-token.scm:302 #, scheme-format -msgid "I cannot encode JWS ~a (because ~a)" +msgid "the access token expired ~a, which is in the past (from ~a)" msgstr "" -#: src/scm/webid-oidc/errors.scm:1153 +#: src/scm/webid-oidc/access-token.scm:316 #, scheme-format -msgid "" -"the server request unexpectedly failed with code ~a and reason phrase ~s" +msgid "cannot encode the access token: ~a" msgstr "" -#: src/scm/webid-oidc/errors.scm:1158 -#, scheme-format -msgid "the header ~a should not have the value ~s" +#: src/scm/webid-oidc/access-token.scm:318 +msgid "cannot encode the access token" msgstr "" -#: src/scm/webid-oidc/errors.scm:1160 +#: src/scm/webid-oidc/authorization-code.scm:63 #, scheme-format -msgid "the header ~a should be present" +msgid "this is not an authorization code, because it is not even a JWS: ~a" msgstr "" -#: src/scm/webid-oidc/errors.scm:1163 +#: src/scm/webid-oidc/authorization-code.scm:65 +msgid "this is not an authorization code, because it is not even a JWS" +msgstr "" + +#: src/scm/webid-oidc/authorization-code.scm:68 #, scheme-format -msgid "the server response wasn't expected: ~s (because ~a)" +msgid "this is not an authorization code: ~a" +msgstr "" + +#: src/scm/webid-oidc/authorization-code.scm:70 +msgid "this is not an authorization code" msgstr "" -#: src/scm/webid-oidc/errors.scm:1169 +#: src/scm/webid-oidc/authorization-code.scm:118 #, scheme-format -msgid "the value ~s is not an OIDC configuration (because ~a)" +msgid "the \"jti\" field should be a string, ~s is given" msgstr "" -#: src/scm/webid-oidc/errors.scm:1174 +#: src/scm/webid-oidc/authorization-code.scm:169 #, scheme-format -msgid "the webid field is incorrect: ~s" +msgid "the authorization code is invalid: ~a" msgstr "" -#: src/scm/webid-oidc/errors.scm:1175 -msgid "the webid field is missing" +#: src/scm/webid-oidc/authorization-code.scm:171 +msgid "the authorization code is invalid" msgstr "" -#: src/scm/webid-oidc/errors.scm:1179 +#: src/scm/webid-oidc/authorization-code.scm:185 #, scheme-format -msgid "the sub field is incorrect: ~s" +msgid "the authorization expired ~a, which is in the past (from ~a)" msgstr "" -#: src/scm/webid-oidc/errors.scm:1180 -msgid "the sub field is missing" +#: src/scm/webid-oidc/authorization-code.scm:201 +#, scheme-format +msgid "cannot encode the authorization code: ~a" msgstr "" -#: src/scm/webid-oidc/errors.scm:1184 -#, scheme-format -msgid "the iss field is incorrect: ~s" +#: src/scm/webid-oidc/authorization-code.scm:203 +msgid "cannot encode the authorization code" msgstr "" -#: src/scm/webid-oidc/errors.scm:1185 -msgid "the iss field is missing" +#: src/scm/webid-oidc/authorization-page-unsafe.scm:52 +#: src/scm/webid-oidc/hello-world.scm:40 src/scm/webid-oidc/hello-world.scm:164 +#: src/scm/webid-oidc/hello-world.scm:184 +msgid "xml-lang|en" msgstr "" -#: src/scm/webid-oidc/errors.scm:1189 -#, scheme-format -msgid "the aud field is incorrect: ~s" +#: src/scm/webid-oidc/authorization-page-unsafe.scm:67 +msgid "page-title|Authorization" msgstr "" -#: src/scm/webid-oidc/errors.scm:1190 -msgid "the aud field is missing" +#: src/scm/webid-oidc/authorization-page-unsafe.scm:72 +msgid "Authorize this anonymous application?" msgstr "" -#: src/scm/webid-oidc/errors.scm:1194 +#: src/scm/webid-oidc/authorization-page-unsafe.scm:73 #, scheme-format -msgid "the iat field is incorrect: ~s" +msgid "Authorize <a href=~s>~a</a>?" msgstr "" -#: src/scm/webid-oidc/errors.scm:1195 -msgid "the iat field is missing" +#: src/scm/webid-oidc/authorization-page-unsafe.scm:75 +msgid "Do you want to authorize this application to represent you?" msgstr "" -#: src/scm/webid-oidc/errors.scm:1199 -#, scheme-format -msgid "the exp field is incorrect: ~s" +#: src/scm/webid-oidc/authorization-page-unsafe.scm:85 +msgid "Please retry your password:" msgstr "" -#: src/scm/webid-oidc/errors.scm:1200 -msgid "the exp field is missing" +#: src/scm/webid-oidc/authorization-page-unsafe.scm:86 +msgid "Please enter your password:" msgstr "" -#: src/scm/webid-oidc/errors.scm:1204 -#, scheme-format -msgid "the cnf/jkt field is incorrect: ~s" +#: src/scm/webid-oidc/authorization-page-unsafe.scm:91 +msgid "Allow" msgstr "" -#: src/scm/webid-oidc/errors.scm:1205 -msgid "the cnf/jkt field is missing" +#: src/scm/webid-oidc/authorization-page-unsafe.scm:97 +msgid "Bad request" msgstr "" -#: src/scm/webid-oidc/errors.scm:1209 -#, scheme-format -msgid "the client-id field is incorrect: ~s" +#: src/scm/webid-oidc/authorization-page-unsafe.scm:102 +msgid "The application did not set the <emph>client_id</emph> parameter." msgstr "" -#: src/scm/webid-oidc/errors.scm:1210 -msgid "the client-id field is missing" +#: src/scm/webid-oidc/authorization-page-unsafe.scm:107 +msgid "The application did not set the <emph>redirect_uri</emph> parameter." msgstr "" -#: src/scm/webid-oidc/errors.scm:1214 -#: src/scm/webid-oidc/authorization-page-unsafe.scm:149 -#, scheme-format -msgid "the redirect_uris field is incorrect: ~s" +#: src/scm/webid-oidc/authorization-page-unsafe.scm:112 +msgid "Sorry, no more information is available." msgstr "" -#: src/scm/webid-oidc/errors.scm:1215 -#: src/scm/webid-oidc/authorization-page-unsafe.scm:150 -msgid "the redirect_uris field is missing" +#: src/scm/webid-oidc/authorization-page-unsafe.scm:117 +msgid "The application you are trying to authorize behaved unexpectedly." msgstr "" -#: src/scm/webid-oidc/errors.scm:1219 -#, scheme-format -msgid "the typ field is incorrect: ~s" +#: src/scm/webid-oidc/authorization-page-unsafe.scm:130 +msgid "Redirecting..." msgstr "" -#: src/scm/webid-oidc/errors.scm:1220 -msgid "the typ field is missing" +#: src/scm/webid-oidc/authorization-page-unsafe.scm:135 +#, scheme-format +msgid "" +"<p><a href=~s>~a</a> can now log in on your behalf. You still need to adjust " +"permissions.</p>" msgstr "" -#: src/scm/webid-oidc/errors.scm:1224 +#: src/scm/webid-oidc/cache.scm:94 #, scheme-format -msgid "the jwk field is incorrect: ~s (because ~a)" +msgid "Dropping cache item ~a.~%" msgstr "" -#: src/scm/webid-oidc/errors.scm:1226 -msgid "the jwk field is missing" +#: src/scm/webid-oidc/cache.scm:100 +#, scheme-format +msgid "Could not clean file ~a.~%" msgstr "" -#: src/scm/webid-oidc/errors.scm:1230 +#: src/scm/webid-oidc/cache.scm:106 #, scheme-format -msgid "the jti field is incorrect: ~s" +msgid "While cleaning the cache: ~a: ~a~%" msgstr "" -#: src/scm/webid-oidc/errors.scm:1231 -msgid "the jti field is missing" +#: src/scm/webid-oidc/cache.scm:166 +#, scheme-format +msgid "Cache miss for ~a: ~s~%" msgstr "" -#: src/scm/webid-oidc/errors.scm:1235 +#: src/scm/webid-oidc/cache.scm:261 #, scheme-format -msgid "the nonce field is incorrect: ~s" +msgid "Cache entry for ~a varies.\n" msgstr "" -#: src/scm/webid-oidc/errors.scm:1236 -msgid "the nonce field is missing" +#: src/scm/webid-oidc/catalog.scm:166 +msgid "invalid relative URI" msgstr "" -#: src/scm/webid-oidc/errors.scm:1240 +#: src/scm/webid-oidc/catalog.scm:245 #, scheme-format -msgid "the htm field is incorrect: ~s" +msgid "Unsupported delegate catalog URI scheme: ~s\n" msgstr "" -#: src/scm/webid-oidc/errors.scm:1241 -msgid "the htm field is missing" +#: src/scm/webid-oidc/client/accounts.scm:418 +msgid "The refresh token has expired." msgstr "" -#: src/scm/webid-oidc/errors.scm:1245 -#, scheme-format -msgid "the htu field is incorrect: ~s" +#: src/scm/webid-oidc/client/accounts.scm:434 +msgid "The token response did not set the content type." msgstr "" -#: src/scm/webid-oidc/errors.scm:1246 -msgid "the htu field is missing" +#: src/scm/webid-oidc/client/accounts.scm:442 +msgid "The token endpoint did not respond in UTF-8." msgstr "" -#: src/scm/webid-oidc/errors.scm:1250 +#: src/scm/webid-oidc/client/accounts.scm:454 #, scheme-format -msgid "the ath field is incorrect: ~s" +msgid "The token response has content-type ~s, not application/json." msgstr "" -#: src/scm/webid-oidc/errors.scm:1251 -msgid "the ath field is missing" +#: src/scm/webid-oidc/client/accounts.scm:464 +msgid "The token response is not valid JSON." msgstr "" -#: src/scm/webid-oidc/errors.scm:1253 +#: src/scm/webid-oidc/client/accounts.scm:477 #, scheme-format -msgid "~s is not an access token (because ~a)" +msgid "The token response did not include an ID token: ~s" msgstr "" -#: src/scm/webid-oidc/errors.scm:1256 +#: src/scm/webid-oidc/client/accounts.scm:485 #, scheme-format -msgid "~s is not an access token header (because ~a)" +msgid "The token response did not include an access token: ~s\n" msgstr "" -#: src/scm/webid-oidc/errors.scm:1259 +#: src/scm/webid-oidc/client/accounts.scm:496 #, scheme-format -msgid "~s is not an access token payload (because ~a)" +msgid "the ID token signature is invalid: ~a" msgstr "" -#: src/scm/webid-oidc/errors.scm:1262 -#, scheme-format -msgid "~s is not a DPoP proof (because ~a)" +#: src/scm/webid-oidc/client/accounts.scm:498 +msgid "the ID token signature is invalid" msgstr "" -#: src/scm/webid-oidc/errors.scm:1265 +#: src/scm/webid-oidc/client/accounts.scm:513 #, scheme-format -msgid "~s is not a DPoP proof header (because ~a)" +msgid "the ID token delivered by the identity provider for ~s has ~s as webid" msgstr "" -#: src/scm/webid-oidc/errors.scm:1268 +#: src/scm/webid-oidc/client/accounts.scm:522 #, scheme-format -msgid "~s is not a DPoP proof payload (because ~a)" +msgid "The ID token delivered by the identity provider ~s is for issuer ~s." msgstr "" -#: src/scm/webid-oidc/errors.scm:1271 +#: src/scm/webid-oidc/client-manifest.scm:111 #, scheme-format -msgid "I cannot fetch the issuer configuration of ~a (because ~a)" +msgid "this is not a client manifest: ~a" msgstr "" -#: src/scm/webid-oidc/errors.scm:1278 -#, scheme-format -msgid "I cannot fetch the JWKS of ~a at ~a (because ~a)" +#: src/scm/webid-oidc/client-manifest.scm:113 +msgid "this is not a client manifest" msgstr "" -#: src/scm/webid-oidc/errors.scm:1289 -#, scheme-format -msgid "the HTTP method is signed for ~s, but ~s was requested" +#: src/scm/webid-oidc/client-manifest.scm:117 +msgid "" +"<p>The client manifest could\n" +"not be queried. It can be because the client application is down, or\n" +"it is incomplete, or unusable for other reasons.</p>" msgstr "" -#: src/scm/webid-oidc/errors.scm:1292 +#: src/scm/webid-oidc/client-manifest.scm:144 #, scheme-format -msgid "the HTTP uri is signed for ~a, but ~a was requested" +msgid "the client manifest is missing ~s" msgstr "" -#: src/scm/webid-oidc/errors.scm:1295 +#: src/scm/webid-oidc/client-manifest.scm:155 #, scheme-format -msgid "the date is ~a, but the DPoP proof is signed in the future at ~a" +msgid "~s is an invalid \"client_id\" value, because it is not an URI" msgstr "" -#: src/scm/webid-oidc/errors.scm:1299 -#, scheme-format -msgid "the date is ~a, but the DPoP proof was signed too long ago at ~a" +#: src/scm/webid-oidc/client-manifest.scm:160 +msgid "at least one of the redirect URIs is not a proper URI" msgstr "" -#: src/scm/webid-oidc/errors.scm:1308 -#, scheme-format -msgid "the key ~s does not hash to ~a" +#: src/scm/webid-oidc/client-manifest.scm:162 +msgid "the \"redirect_uris\" field should be a vector of URIs" msgstr "" -#: src/scm/webid-oidc/errors.scm:1310 -#, scheme-format -msgid "the key confirmation of ~s failed (because ~a)" +#: src/scm/webid-oidc/client-manifest.scm:167 +msgid "the client manifest should be a JSON object" msgstr "" -#: src/scm/webid-oidc/errors.scm:1312 +#: src/scm/webid-oidc/client-manifest.scm:189 #, scheme-format -msgid "the key confirmation of ~s failed" +msgid "the client manifest does not allow ~s as a redirection uri" msgstr "" -#: src/scm/webid-oidc/errors.scm:1317 +#: src/scm/webid-oidc/client-manifest.scm:193 #, scheme-format -msgid "the DPoP proof is bound to an access token with hash ~s, not ~s" +msgid "" +"<p>The application wants to get your\n" +"authorization through <strong>~s</strong>, which is not\n" +"approved.</p>" msgstr "" -#: src/scm/webid-oidc/errors.scm:1319 -#, scheme-format -msgid "the DPoP proof should be bound to the access token ~s" +#: src/scm/webid-oidc/client-manifest.scm:221 +msgid "cannot serve the public manifest" msgstr "" -#: src/scm/webid-oidc/errors.scm:1322 +#: src/scm/webid-oidc/client-manifest.scm:242 #, scheme-format -msgid "the jti ~s has already been found (because ~a)" +msgid "cannot fetch the client manifest ~s: ~a" msgstr "" -#: src/scm/webid-oidc/errors.scm:1325 +#: src/scm/webid-oidc/client-manifest.scm:245 #, scheme-format -msgid "I cannot decode ~s as an access token (because ~a)" +msgid "cannot fetch the client manifest ~s" msgstr "" -#: src/scm/webid-oidc/errors.scm:1328 +#: src/scm/webid-oidc/client-manifest.scm:264 #, scheme-format -msgid "I cannot encode ~s as an access token with key ~s (because ~a)" +msgid "the client manifest is dereferenced from ~s, but it pretends to be ~s" msgstr "" -#: src/scm/webid-oidc/errors.scm:1331 +#: src/scm/webid-oidc/dpop-proof.scm:91 #, scheme-format -msgid "I cannot decode ~s as a DPoP proof (because ~a)" +msgid "this is not a DPoP proof, because it is not even a JWS: ~a" msgstr "" -#: src/scm/webid-oidc/errors.scm:1334 -#, scheme-format -msgid "I cannot encode ~s as a DPoP proof (because ~a)" +#: src/scm/webid-oidc/dpop-proof.scm:93 +msgid "this is not a DPoP proof, because it is not even a JWS" msgstr "" -#: src/scm/webid-oidc/errors.scm:1337 +#: src/scm/webid-oidc/dpop-proof.scm:124 #, scheme-format -msgid "I could not fetch a RDF graph at ~a (because ~a)" +msgid "the DPoP proof is missing ~s" msgstr "" -#: src/scm/webid-oidc/errors.scm:1340 +#: src/scm/webid-oidc/dpop-proof.scm:147 #, scheme-format -msgid "~s is not a client manifest (because ~a)" +msgid "the \"jti\" field should be a string, not ~s" msgstr "" -#: src/scm/webid-oidc/errors.scm:1343 +#: src/scm/webid-oidc/dpop-proof.scm:154 #, scheme-format -msgid "~s does not authorize redirection URI ~a" +msgid "the \"htm\" field should be a string, not ~s" msgstr "" -#: src/scm/webid-oidc/errors.scm:1346 -msgid "I cannot serve a public manifest" +#: src/scm/webid-oidc/dpop-proof.scm:161 +#, scheme-format +msgid "the \"htu\" field should be an URI, not ~s" msgstr "" -#: src/scm/webid-oidc/errors.scm:1348 +#: src/scm/webid-oidc/dpop-proof.scm:168 #, scheme-format -msgid "~a does not have a client manifest registration triple" +msgid "the \"iat\" field should be a timestamp, not ~s" msgstr "" -#: src/scm/webid-oidc/errors.scm:1351 +#: src/scm/webid-oidc/dpop-proof.scm:175 #, scheme-format -msgid "the client manifest at ~a is advertised for ~a" +msgid "the \"ath\" field should be an encoded JWT, not ~s" msgstr "" -#: src/scm/webid-oidc/errors.scm:1354 +#: src/scm/webid-oidc/dpop-proof.scm:184 #, scheme-format -msgid "I could not fetch the client manifest of ~a (because ~a)" +msgid "the \"alg\" field should be a string, not ~s" msgstr "" -#: src/scm/webid-oidc/errors.scm:1357 +#: src/scm/webid-oidc/dpop-proof.scm:189 #, scheme-format -msgid "~s is not an authorization code (because ~a)" +msgid "the \"typ\" field should be \"dpop+jwt\", not ~s" msgstr "" -#: src/scm/webid-oidc/errors.scm:1360 +#: src/scm/webid-oidc/dpop-proof.scm:195 #, scheme-format -msgid "~s is not an authorization code header (because ~a)" +msgid "the \"jwk\" field should be a valid public key, not ~s" msgstr "" -#: src/scm/webid-oidc/errors.scm:1363 +#: src/scm/webid-oidc/dpop-proof.scm:274 #, scheme-format -msgid "~s is not an authorization code payload (because ~a)" +msgid "the DPoP proof is signed for ~s, but it is issued to ~s" msgstr "" -#: src/scm/webid-oidc/errors.scm:1366 +#: src/scm/webid-oidc/dpop-proof.scm:305 #, scheme-format -msgid "the current time is ~a, and the authorization code expired at ~a" +msgid "the DPoP proof cannot be decoded: ~a" msgstr "" -#: src/scm/webid-oidc/errors.scm:1370 +#: src/scm/webid-oidc/dpop-proof.scm:307 +msgid "the DPoP proof cannot be decoded" +msgstr "" + +#: src/scm/webid-oidc/dpop-proof.scm:317 #, scheme-format -msgid "I cannot decode ~s as an authorization code (because ~a)" +msgid "the DPoP proof is signed for access through ~s, but it is used with ~s" msgstr "" -#: src/scm/webid-oidc/errors.scm:1373 +#: src/scm/webid-oidc/dpop-proof.scm:331 #, scheme-format -msgid "I cannot encode ~s as an authorization code (because ~a)" +msgid "" +"the DPoP proof is signed in the future, ~a, relative to the current date, ~a" msgstr "" -#: src/scm/webid-oidc/errors.scm:1376 +#: src/scm/webid-oidc/dpop-proof.scm:340 #, scheme-format -msgid "there is no such refresh token as ~s" +msgid "the DPoP proof is too old, it was signed ~a and now it is ~a" msgstr "" -#: src/scm/webid-oidc/errors.scm:1379 +#: src/scm/webid-oidc/dpop-proof.scm:352 #, scheme-format msgid "" -"the refresh token is bound to a key confirmed as ~s, but it is used with key " -"~s" +"the DPoP proof should go along with an access token hashed to ~s, not ~s" msgstr "" -#: src/scm/webid-oidc/errors.scm:1382 -#, scheme-format -msgid "I cannot decode ~s as an ID token (because ~a)" +#: src/scm/webid-oidc/dpop-proof.scm:361 src/scm/webid-oidc/dpop-proof.scm:372 +msgid "the DPoP proof is signed with the wrong key" msgstr "" -#: src/scm/webid-oidc/errors.scm:1385 +#: src/scm/webid-oidc/dpop-proof.scm:370 #, scheme-format -msgid "I cannot encode ~s as an ID token (because ~a)" +msgid "the DPoP proof is signed with the wrong key: ~a" msgstr "" -#: src/scm/webid-oidc/errors.scm:1388 +#: src/scm/webid-oidc/dpop-proof.scm:381 +msgid "the cnf/check function returned #f" +msgstr "" + +#: src/scm/webid-oidc/dpop-proof.scm:392 #, scheme-format -msgid "the grant type ~s is not supported" +msgid "cannot encode a DPoP proof: ~a" msgstr "" -#: src/scm/webid-oidc/errors.scm:1391 -msgid "there is no authorization code in the request" +#: src/scm/webid-oidc/dpop-proof.scm:394 +msgid "cannot encode a DPoP proof" msgstr "" -#: src/scm/webid-oidc/errors.scm:1393 -msgid "there is no refresh token in the request" +#: src/scm/webid-oidc/example-app.scm:56 +msgid "Main menu:\n" msgstr "" -#: src/scm/webid-oidc/errors.scm:1395 +#: src/scm/webid-oidc/example-app.scm:59 #, scheme-format -msgid "~s is not an ID token (because ~a)" +msgid "~a. Log in with ~a (issued by ~a): ~a\n" msgstr "" -#: src/scm/webid-oidc/errors.scm:1398 -#, scheme-format -msgid "~s is not an ID token header (because ~a)" +#: src/scm/webid-oidc/example-app.scm:64 +msgid "a new user" msgstr "" -#: src/scm/webid-oidc/errors.scm:1401 -#, scheme-format -msgid "~s is not an ID token payload (because ~a)" +#: src/scm/webid-oidc/example-app.scm:68 +msgid "status|currently logged in" msgstr "" -#: src/scm/webid-oidc/errors.scm:1404 -#, scheme-format -msgid "" -"I couldn’t set the locale to ~s as an approximation of the client locale ~s" +#: src/scm/webid-oidc/example-app.scm:70 +msgid "status|offline (but accessible)" msgstr "" -#: src/scm/webid-oidc/errors.scm:1407 -#, scheme-format -msgid "~s does not admit ~s as an identity provider" +#: src/scm/webid-oidc/example-app.scm:71 +msgid "status|offline (inaccessible)" msgstr "" -#: src/scm/webid-oidc/errors.scm:1410 -#, scheme-format +#: src/scm/webid-oidc/example-app.scm:72 +msgid "status|not initialized yet" +msgstr "" + +#: src/scm/webid-oidc/example-app.scm:74 msgid "" -"~a is neither an identity provider (because ~a) nor a webid (because ~a)" +"Type a number to log in, prefix it with '-' to delete the account, or type + " +"to create a new account.\n" msgstr "" -#: src/scm/webid-oidc/errors.scm:1415 +#: src/scm/webid-oidc/example-app.scm:91 #, scheme-format -msgid "you don’t have a refresh token for identity ~a certified by ~a in ~s" +msgid "Please visit: ~a\n" msgstr "" -#: src/scm/webid-oidc/errors.scm:1420 -#, scheme-format -msgid "all identity provider candidates for ~a failed: ~a" +#: src/scm/webid-oidc/example-app.scm:92 +msgid "Then, paste the authorization code you get:\n" msgstr "" -#: src/scm/webid-oidc/errors.scm:1424 +#: src/scm/webid-oidc/example-app.scm:98 #, scheme-format -msgid "~s failed (because ~a)" +msgid "I could not negociate an access token. ~a" msgstr "" -#: src/scm/webid-oidc/errors.scm:1427 -msgid ", " +#: src/scm/webid-oidc/example-app.scm:102 +msgid "" +"The refresh token has expired, it is not possible to use that account " +"offline.\n" +msgstr "" + +#: src/scm/webid-oidc/example-app.scm:107 +msgid "Please enter an URI to GET:\n" msgstr "" -#: src/scm/webid-oidc/errors.scm:1429 +#: src/scm/webid-oidc/fetch.scm:58 #, scheme-format -msgid "no resource has been found to serve URI path ~s" +msgid "cannot fetch ~s as linked data: ~a" msgstr "" -#: src/scm/webid-oidc/errors.scm:1432 +#: src/scm/webid-oidc/fetch.scm:60 #, scheme-format -msgid "the resource kind ~s is absent for the resource at ~s" +msgid "cannot fetch ~s as linked data" msgstr "" -#: src/scm/webid-oidc/errors.scm:1435 +#: src/scm/webid-oidc/fetch.scm:74 #, scheme-format -msgid "no resource has been found to serve URI path ~s, but ~s exists" +msgid "unexpected response from the server: ~a" msgstr "" -#: src/scm/webid-oidc/errors.scm:1438 -msgid "the root storage cannot be deleted" +#: src/scm/webid-oidc/fetch.scm:76 +msgid "unexpected response from the server" msgstr "" -#: src/scm/webid-oidc/errors.scm:1440 +#: src/scm/webid-oidc/fetch.scm:83 #, scheme-format -msgid "the container ~s should be emptied before being deleted" +msgid "the request failed unexpectedly with ~s ~s" msgstr "" -#: src/scm/webid-oidc/errors.scm:1443 +#: src/scm/webid-oidc/fetch.scm:111 #, scheme-format -msgid "the group ~s cannot be fetched (because ~a)" +msgid "cannot negociate a recognized RFD content type, got ~s" msgstr "" -#: src/scm/webid-oidc/errors.scm:1447 -#, scheme-format -msgid "the containment triples in the request to update ~s are not up to date" +#: src/scm/webid-oidc/hello-world.scm:61 src/scm/webid-oidc/program.scm:225 +msgid "command-line|version" msgstr "" -#: src/scm/webid-oidc/errors.scm:1450 -#, scheme-format -msgid "the server cannot process resources with the ~s content-type" +#: src/scm/webid-oidc/hello-world.scm:63 src/scm/webid-oidc/program.scm:229 +msgid "command-line|complete-corresponding-source" msgstr "" -#: src/scm/webid-oidc/errors.scm:1453 -#, scheme-format -msgid "" -"the client wants to create a resource at ~s, which is reserved for an " -"auxiliary resource" +#: src/scm/webid-oidc/hello-world.scm:65 src/scm/webid-oidc/program.scm:231 +msgid "command-line|help" msgstr "" -#: src/scm/webid-oidc/errors.scm:1456 -#, scheme-format -msgid "" -"the operation on ~s by ~a is refused, because it’s not by ~s and the access " -"control forbids the following mode of operation: ~s" +#: src/scm/webid-oidc/hello-world.scm:67 +msgid "command-line|port" msgstr "" -#: src/scm/webid-oidc/errors.scm:1460 -msgid "an anonymous user" +#: src/scm/webid-oidc/hello-world.scm:69 src/scm/webid-oidc/program.scm:263 +msgid "command-line|log-file" msgstr "" -#: src/scm/webid-oidc/errors.scm:1465 -#, scheme-format -msgid "" -"the client precondition failed for ~s: it allows for ~s, forbids ~s, but the " -"resource has a representation of ~s" +#: src/scm/webid-oidc/hello-world.scm:71 src/scm/webid-oidc/program.scm:265 +msgid "command-line|error-file" msgstr "" -#: src/scm/webid-oidc/errors.scm:1467 +#: src/scm/webid-oidc/hello-world.scm:83 #, scheme-format msgid "" -"the client precondition failed for ~s: it allows for ~s, forbids ~s, but the " -"resource has no representation" +"~a [OPTIONS]...\n" +"\n" +"Display your identity contained in the XXX-Agent header.\n" +"\n" +"This program is covered by the GNU Affero GPL, version 3 or\n" +"later. This license requires you to provide a way for any user over\n" +"the network to download the complete corresponding source code (with\n" +"your modifications) at no cost. The server adds a \"Source:\" header\n" +"to all responses.\n" +"\n" +"Options:\n" +" -S MEANS, --~a=MEANS:\n" +" specify a way to download the complete corresponding source\n" +" code. For instance, this would be an URI pointing to a tarball.\n" +" -h, --~a:\n" +" display this help message and exit.\n" +" -v, --~a:\n" +" display the version information (~a) and exit.\n" +" -p PORT, --~a=PORT:\n" +" set the port to bind.\n" +" -l FILE.log, --~a=FILE.log:\n" +" redirect the program standard output to FILE.log.\n" +" -e FILE.err, --~a=FILE.err:\n" +" redirect the program errors to FILE.err.\n" msgstr "" -#: src/scm/webid-oidc/errors.scm:1470 +#: src/scm/webid-oidc/hello-world.scm:116 #, scheme-format +msgid "~a version ~a\n" +msgstr "" + +#: src/scm/webid-oidc/hello-world.scm:125 src/scm/webid-oidc/program.scm:624 msgid "" -"the client wanted a response with a content type among ~s, but the resource " -"at ~s has content-type ~s which cannot be converted to one of them" +"You are legally required to link to the complete corresponding source code.\n" msgstr "" -#: src/scm/webid-oidc/errors.scm:1477 -msgid "that’s it" +#: src/scm/webid-oidc/hello-world.scm:135 +msgid "The port should be a number between 0 and 65535.\n" msgstr "" -#: src/scm/webid-oidc/errors.scm:1481 -#, scheme-format -msgid "~a and ~a" +#: src/scm/webid-oidc/hello-world.scm:156 +#: src/scm/webid-oidc/resource-server.scm:320 +msgid "reason-phrase|Unauthorized" msgstr "" -#: src/scm/webid-oidc/errors.scm:1484 -#, scheme-format -msgid "~a, ~a" +#: src/scm/webid-oidc/hello-world.scm:176 +#: src/scm/webid-oidc/resource-server.scm:328 +msgid "reason-phrase|Method Not Allowed" msgstr "" -#: src/scm/webid-oidc/errors.scm:1488 -#, scheme-format -msgid "the signature ~a does not match key ~s with payload ~a" +#: src/scm/webid-oidc/identity-provider.scm:72 +msgid "Warning: generating a new key pair." msgstr "" -#: src/scm/webid-oidc/errors.scm:1491 -#, scheme-format -msgid "the request failed unexpectedly with code ~a: ~s" +#: src/scm/webid-oidc/identity-provider.scm:132 +msgid "reason-phrase|Not Found" msgstr "" -#: src/scm/webid-oidc/errors.scm:1495 -msgid "there is an undefined variable" +#: 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 +msgid "xml-langlen" msgstr "" -#: src/scm/webid-oidc/errors.scm:1497 +#: src/scm/webid-oidc/jti.scm:59 #, scheme-format -msgid "the origin is ~a" +msgid "a replay has been detected with JTI ~s" msgstr "" -#: src/scm/webid-oidc/errors.scm:1500 +#: src/scm/webid-oidc/jwk.scm:76 #, scheme-format -msgid "a message is attached: ~a" +msgid "the JWK is invalid: ~a" +msgstr "" + +#: src/scm/webid-oidc/jwk.scm:78 +msgid "the JWK is invalid" msgstr "" -#: src/scm/webid-oidc/errors.scm:1503 +#: src/scm/webid-oidc/jwk.scm:87 #, scheme-format -msgid "the values ~s are problematic" +msgid "unknown key type ~s" msgstr "" -#: src/scm/webid-oidc/errors.scm:1506 +#: src/scm/webid-oidc/jwk.scm:103 #, scheme-format -msgid "there is a kind (~s) and args ~s" +msgid "the public JWK is invalid: ~a" msgstr "" -#: src/scm/webid-oidc/errors.scm:1509 -msgid "there is an assertion failure" +#: src/scm/webid-oidc/jwk.scm:105 +msgid "the public JWK is invalid" msgstr "" -#: src/scm/webid-oidc/errors.scm:1511 +#: src/scm/webid-oidc/jwk.scm:136 #, scheme-format -msgid "the program quits with code ~a" +msgid "cannot extract the public part of the key: ~a" msgstr "" -#: src/scm/webid-oidc/errors.scm:1514 -msgid "the program cannot recover from this exception" +#: src/scm/webid-oidc/jwk.scm:138 +msgid "cannot extract the public part of the key" msgstr "" -#: src/scm/webid-oidc/errors.scm:1516 -msgid "there is an external error" +#: src/scm/webid-oidc/jwk.scm:188 +msgid "the JWKS is invalid, because it does not have keys" msgstr "" -#: src/scm/webid-oidc/errors.scm:1518 -msgid "there is an error" +#: src/scm/webid-oidc/jwk.scm:197 +#, scheme-format +msgid "the JWKS is invalid: ~a" msgstr "" -#: src/scm/webid-oidc/errors.scm:1520 -#, scheme-format -msgid "there is an unknown exception of kind ~s" +#: src/scm/webid-oidc/jwk.scm:199 +msgid "the JWKS is invalid" msgstr "" -#: src/scm/webid-oidc/identity-provider.scm:68 -msgid "Warning: generating a new key pair." +#: src/scm/webid-oidc/jws.scm:72 +#, scheme-format +msgid "the JWS is invalid: ~a" msgstr "" -#: src/scm/webid-oidc/authorization-page-unsafe.scm:45 -msgid "xml-lang|en" +#: src/scm/webid-oidc/jws.scm:74 +msgid "the JWS is invalid" msgstr "" -#: src/scm/webid-oidc/authorization-page-unsafe.scm:61 -msgid "page-title|Authorization" +#: src/scm/webid-oidc/jws.scm:93 +msgid "the JWS header does not have an \"alg\" field" msgstr "" -#: src/scm/webid-oidc/authorization-page-unsafe.scm:66 -msgid "Authorize this anonymous application?" +#: src/scm/webid-oidc/jws.scm:101 +msgid "invalid JSON object as payload" msgstr "" -#: src/scm/webid-oidc/authorization-page-unsafe.scm:67 +#: src/scm/webid-oidc/jws.scm:110 #, scheme-format -msgid "Authorize <a href=~s>~a</a>?" +msgid "invalid signature algorithm: ~s" msgstr "" -#: src/scm/webid-oidc/authorization-page-unsafe.scm:69 -msgid "Do you want to authorize this application to represent you?" +#: src/scm/webid-oidc/jws.scm:114 +#, scheme-format +msgid "invalid \"alg\" value: ~s" msgstr "" -#: src/scm/webid-oidc/authorization-page-unsafe.scm:79 -msgid "Please retry your password:" +#: src/scm/webid-oidc/jws.scm:119 +msgid "invalid JSON object as header" msgstr "" -#: src/scm/webid-oidc/authorization-page-unsafe.scm:80 -msgid "Please enter your password:" +#: src/scm/webid-oidc/jws.scm:121 +msgid "this is not a pair" msgstr "" -#: src/scm/webid-oidc/authorization-page-unsafe.scm:85 -msgid "Allow" +#: src/scm/webid-oidc/jws.scm:138 +msgid "the encoded JWS is not in 3 parts" msgstr "" -#: src/scm/webid-oidc/authorization-page-unsafe.scm:91 -msgid "Bad request" +#: src/scm/webid-oidc/jws.scm:149 +#, scheme-format +msgid "" +"the encoded JWS header or payload is not a JSON object encoded in base64: ~a" msgstr "" -#: src/scm/webid-oidc/authorization-page-unsafe.scm:96 -msgid "The application did not set the <emph>client_id</emph> parameter." +#: src/scm/webid-oidc/jws.scm:151 +msgid "" +"the encoded JWS header or payload is not a JSON object encoded in base64" msgstr "" -#: src/scm/webid-oidc/authorization-page-unsafe.scm:101 -msgid "The application did not set the <emph>redirect_uri</emph> parameter." +#: src/scm/webid-oidc/jws.scm:210 +msgid "the JWS is not signed by any of the expected set of public keys" msgstr "" -#: src/scm/webid-oidc/authorization-page-unsafe.scm:114 +#: src/scm/webid-oidc/jws.scm:221 #, scheme-format -msgid "the value ~s is not a base64 string." +msgid "while verifying the JWS signature: ~a" msgstr "" -#: src/scm/webid-oidc/authorization-page-unsafe.scm:117 -msgid "the following value is not JSON:" +#: src/scm/webid-oidc/jws.scm:223 +msgid "an unexpected error happened while verifying a JWS" msgstr "" -#: src/scm/webid-oidc/authorization-page-unsafe.scm:120 -msgid "the following value is not Turtle:" -msgstr "" - -#: src/scm/webid-oidc/authorization-page-unsafe.scm:123 +#: src/scm/webid-oidc/jws.scm:240 #, scheme-format -msgid "" -"the server request unexpectedly failed with code ~a and reason phrase ~s." +msgid "cannot decode a JWS: ~a" msgstr "" -#: src/scm/webid-oidc/authorization-page-unsafe.scm:128 -#, scheme-format -msgid "the header ~a should not have the value ~s.\n" +#: src/scm/webid-oidc/jws.scm:242 +msgid "cannot decode a JWS" msgstr "" -#: src/scm/webid-oidc/authorization-page-unsafe.scm:130 +#: src/scm/webid-oidc/jws.scm:262 #, scheme-format -msgid "the header ~a should be present." +msgid "cannot encode a JWS: ~a" msgstr "" -#: src/scm/webid-oidc/authorization-page-unsafe.scm:134 -msgid "the server response wasn’t expected:" +#: src/scm/webid-oidc/jws.scm:264 +msgid "cannot encode a JWS" msgstr "" -#: src/scm/webid-oidc/authorization-page-unsafe.scm:143 +#: src/scm/webid-oidc/oidc-configuration.scm:59 #, scheme-format -msgid "the client_id field is incorrect: ~s" +msgid "the OIDC configuration is invalid: ~a" msgstr "" -#: src/scm/webid-oidc/authorization-page-unsafe.scm:144 -msgid "the client_id field is missing" +#: src/scm/webid-oidc/oidc-configuration.scm:61 +msgid "the OIDC configuration is invalid" msgstr "" -#: src/scm/webid-oidc/authorization-page-unsafe.scm:153 +#: src/scm/webid-oidc/oidc-configuration.scm:77 #, scheme-format -msgid "I could not fetch a RDF graph at ~a;" +msgid "the OIDC configuration does not have: ~s" msgstr "" -#: src/scm/webid-oidc/authorization-page-unsafe.scm:157 -msgid "this is not a client manifest:" +#: src/scm/webid-oidc/oidc-configuration.scm:92 +#, scheme-format +msgid "invalid JWKS URI: ~s" msgstr "" -#: src/scm/webid-oidc/authorization-page-unsafe.scm:162 +#: src/scm/webid-oidc/oidc-configuration.scm:99 #, scheme-format -msgid "the manifest does not authorize redirection URI ~a:" +msgid "invalid token endpoint: ~s" msgstr "" -#: src/scm/webid-oidc/authorization-page-unsafe.scm:167 +#: src/scm/webid-oidc/oidc-configuration.scm:108 #, scheme-format -msgid "the client manifest at ~a is advertised for ~a;" +msgid "invalid authorization endpoint: ~s" msgstr "" -#: src/scm/webid-oidc/authorization-page-unsafe.scm:172 +#: src/scm/webid-oidc/oidc-configuration.scm:116 #, scheme-format -msgid "I could not fetch the client manifest of ~a;" +msgid "\"solid_oidc_supported\" should be set to ~s, not ~s" msgstr "" -#: src/scm/webid-oidc/authorization-page-unsafe.scm:177 -msgid "I could not issue an authorization code for you;" +#: src/scm/webid-oidc/oidc-configuration.scm:124 +msgid "invalid JSON object" msgstr "" -#: src/scm/webid-oidc/authorization-page-unsafe.scm:185 -msgid "" -"The application you are trying to authorize behaved unexpectedly. Here is " -"the explanation of the error:" +#: src/scm/webid-oidc/oidc-configuration.scm:174 +#, scheme-format +msgid "cannot fetch the OIDC configuration: ~a" msgstr "" -#: src/scm/webid-oidc/authorization-page-unsafe.scm:194 -msgid "Redirecting..." +#: src/scm/webid-oidc/oidc-configuration.scm:176 +msgid "cannot fetch the OIDC configuration" msgstr "" -#: src/scm/webid-oidc/authorization-page-unsafe.scm:199 +#: src/scm/webid-oidc/oidc-configuration.scm:184 #, scheme-format -msgid "" -"<a href=~s>~a</a> can now log in on your behalf. You still need to adjust " -"permissions." +msgid "the server responded with ~s ~s" msgstr "" -#: src/scm/webid-oidc/resource-server.scm:86 -#, scheme-format -msgid "~a: authentication failure: ~a\n" +#: src/scm/webid-oidc/oidc-configuration.scm:189 +msgid "there is no content-type" msgstr "" -#: src/scm/webid-oidc/resource-server.scm:279 +#: src/scm/webid-oidc/oidc-configuration.scm:194 #, scheme-format -msgid "Warning: ~a\n" +msgid "unexpected content-type: ~s" msgstr "" -#: src/scm/webid-oidc/hello-world.scm:47 src/scm/webid-oidc/program.scm:233 -msgid "command-line|version" -msgstr "" - -#: src/scm/webid-oidc/hello-world.scm:49 src/scm/webid-oidc/program.scm:237 -msgid "command-line|complete-corresponding-source" +#: src/scm/webid-oidc/oidc-id-token.scm:67 +#, scheme-format +msgid "this is not an ID token, because it is not even a JWS: ~a" msgstr "" -#: src/scm/webid-oidc/hello-world.scm:51 src/scm/webid-oidc/program.scm:239 -msgid "command-line|help" +#: src/scm/webid-oidc/oidc-id-token.scm:70 +msgid "this is not an ID token, because it is not even a JWS" msgstr "" -#: src/scm/webid-oidc/hello-world.scm:53 -msgid "command-line|port" +#: src/scm/webid-oidc/oidc-id-token.scm:72 +#, scheme-format +msgid "this is not an ID token: ~a" msgstr "" -#: src/scm/webid-oidc/hello-world.scm:55 src/scm/webid-oidc/program.scm:271 -msgid "command-line|log-file" +#: src/scm/webid-oidc/oidc-id-token.scm:75 +msgid "this is not an ID token" msgstr "" -#: src/scm/webid-oidc/hello-world.scm:57 src/scm/webid-oidc/program.scm:273 -msgid "command-line|error-file" +#: src/scm/webid-oidc/oidc-id-token.scm:131 +#, scheme-format +msgid "the \"sub\" field should be a string, ~s is given" msgstr "" -#: src/scm/webid-oidc/hello-world.scm:69 +#: src/scm/webid-oidc/oidc-id-token.scm:138 #, scheme-format -msgid "" -"~a [OPTIONS]...\n" -"\n" -"Display your identity contained in the XXX-Agent header.\n" -"\n" -"This program is covered by the GNU Affero GPL, version 3 or\n" -"later. This license requires you to provide a way for any user over\n" -"the network to download the complete corresponding source code (with\n" -"your modifications) at no cost. The server adds a \"Source:\" header\n" -"to all responses.\n" -"\n" -"Options:\n" -" -S MEANS, --~a=MEANS:\n" -" specify a way to download the complete corresponding source\n" -" code. For instance, this would be an URI pointing to a tarball.\n" -" -h, --~a:\n" -" display this help message and exit.\n" -" -v, --~a:\n" -" display the version information (~a) and exit.\n" -" -p PORT, --~a=PORT:\n" -" set the port to bind.\n" -" -l FILE.log, --~a=FILE.log:\n" -" redirect the program standard output to FILE.log.\n" -" -e FILE.err, --~a=FILE.err:\n" -" redirect the program errors to FILE.err.\n" +msgid "the \"aud\" field should be an URI, ~s is given" msgstr "" -#: src/scm/webid-oidc/hello-world.scm:102 +#: src/scm/webid-oidc/oidc-id-token.scm:145 #, scheme-format -msgid "~a version ~a\n" +msgid "the \"nonce\" field should be a string, ~s is given" msgstr "" -#: src/scm/webid-oidc/hello-world.scm:111 src/scm/webid-oidc/program.scm:632 -msgid "" -"You are legally required to link to the complete corresponding source code.\n" +#: src/scm/webid-oidc/oidc-id-token.scm:165 +msgid "the payload should be a JSON object" msgstr "" -#: src/scm/webid-oidc/hello-world.scm:121 -msgid "The port should be a number between 0 and 65535.\n" +#: src/scm/webid-oidc/oidc-id-token.scm:218 +#, scheme-format +msgid "the ID token is invalid: ~a" msgstr "" -#: src/scm/webid-oidc/example-app.scm:63 -msgid "Main menu:\n" +#: src/scm/webid-oidc/oidc-id-token.scm:220 +msgid "the ID token is invalid" msgstr "" -#: src/scm/webid-oidc/example-app.scm:66 +#: src/scm/webid-oidc/oidc-id-token.scm:258 #, scheme-format -msgid "~a. Log in with ~a (issued by ~a): ~a\n" -msgstr "" - -#: src/scm/webid-oidc/example-app.scm:71 -msgid "a new user" +msgid "I cannot query the JWKS URI of the identity provider: ~a" msgstr "" -#: src/scm/webid-oidc/example-app.scm:75 -msgid "status|currently logged in" +#: src/scm/webid-oidc/oidc-id-token.scm:260 +msgid "I cannot query the JWKS URI of the identity provider" msgstr "" -#: src/scm/webid-oidc/example-app.scm:77 -msgid "status|offline (but accessible)" +#: src/scm/webid-oidc/oidc-id-token.scm:271 +#, scheme-format +msgid "the ID token is signed in the future, ~a, relative to current ~a" msgstr "" -#: src/scm/webid-oidc/example-app.scm:78 -msgid "status|offline (inaccessible)" +#: src/scm/webid-oidc/oidc-id-token.scm:280 +#, scheme-format +msgid "the ID token expired ~a, which is in the past (from ~a)" msgstr "" -#: src/scm/webid-oidc/example-app.scm:79 -msgid "status|not initialized yet" +#: src/scm/webid-oidc/oidc-id-token.scm:294 +#, scheme-format +msgid "cannot encode the ID token: ~a" msgstr "" -#: src/scm/webid-oidc/example-app.scm:81 -msgid "" -"Type a number to log in, prefix it with '-' to delete the account, or type + " -"to create a new account.\n" +#: src/scm/webid-oidc/oidc-id-token.scm:296 +msgid "cannot encode the ID token" msgstr "" -#: src/scm/webid-oidc/example-app.scm:98 +#: src/scm/webid-oidc/program.scm:56 #, scheme-format -msgid "Please visit: ~a\n" +msgid "~a: Warning: XML_CATALOG_FILES is set to ~s.\n" msgstr "" -#: src/scm/webid-oidc/example-app.scm:99 -msgid "Then, paste the authorization code you get:\n" +#: src/scm/webid-oidc/program.scm:59 +#, scheme-format +msgid "~a: GET ~a ~s...\n" msgstr "" -#: src/scm/webid-oidc/example-app.scm:105 +#: src/scm/webid-oidc/program.scm:66 #, scheme-format -msgid "I could not negociate an access token. ~a" +msgid "~a: Warning: loading XML catalog from the web, ~s.\n" msgstr "" -#: src/scm/webid-oidc/example-app.scm:109 -msgid "" -"The refresh token has expired, it is not possible to use that account " -"offline.\n" +#: src/scm/webid-oidc/program.scm:74 +#, scheme-format +msgid "~a: GET ~a ~s: ~s ~a bytes\n" msgstr "" -#: src/scm/webid-oidc/example-app.scm:114 -msgid "Please enter an URI to GET:\n" +#: src/scm/webid-oidc/program.scm:121 +msgid "really bad internal server error" msgstr "" -#: src/scm/webid-oidc/program.scm:125 +#: src/scm/webid-oidc/program.scm:128 #, scheme-format msgid "~a: ~a: Internal server error: ~a\n" msgstr "" -#: src/scm/webid-oidc/program.scm:140 -#, scheme-format -msgid "" -"The client locale ~s can’t be approximated by system locale ~s (because ~a), " -"using C.\n" +#: src/scm/webid-oidc/program.scm:134 +msgid "Internal Server Error" msgstr "" -#: src/scm/webid-oidc/program.scm:164 +#: src/scm/webid-oidc/program.scm:137 +msgid "Sorry, there was an error." +msgstr "" + +#: src/scm/webid-oidc/program.scm:158 #, scheme-format msgid "~a: ~s ~a ~s ~a\n" msgstr "" -#: src/scm/webid-oidc/program.scm:166 +#: src/scm/webid-oidc/program.scm:160 #, scheme-format msgid "~a: ~a (~a)" msgstr "" -#: src/scm/webid-oidc/program.scm:170 +#: src/scm/webid-oidc/program.scm:164 #, scheme-format msgid "~a: ~a" msgstr "" -#: src/scm/webid-oidc/program.scm:180 +#: src/scm/webid-oidc/program.scm:174 #, scheme-format msgid "(there was an error: ~a)" msgstr "" -#: src/scm/webid-oidc/program.scm:235 +#: src/scm/webid-oidc/program.scm:227 msgid "command-line|describe-project" msgstr "" -#: src/scm/webid-oidc/program.scm:241 +#: src/scm/webid-oidc/program.scm:233 msgid "command-line|server|port" msgstr "" -#: src/scm/webid-oidc/program.scm:243 +#: src/scm/webid-oidc/program.scm:235 msgid "command-line|server|server-name" msgstr "" -#: src/scm/webid-oidc/program.scm:245 +#: src/scm/webid-oidc/program.scm:237 msgid "command-line|server|reverse-proxy|backend-uri" msgstr "" -#: src/scm/webid-oidc/program.scm:247 +#: src/scm/webid-oidc/program.scm:239 msgid "command-line|server|reverse-proxy|header" msgstr "" -#: src/scm/webid-oidc/program.scm:249 +#: src/scm/webid-oidc/program.scm:241 msgid "command-line|server|issuer|key-file" msgstr "" -#: src/scm/webid-oidc/program.scm:251 +#: src/scm/webid-oidc/program.scm:243 msgid "command-line|server|issuer|subject" msgstr "" -#: src/scm/webid-oidc/program.scm:253 +#: src/scm/webid-oidc/program.scm:245 msgid "command-line|server|issuer|encrypted-password" msgstr "" -#: src/scm/webid-oidc/program.scm:255 +#: src/scm/webid-oidc/program.scm:247 msgid "command-line|server|issuer|encrypted-password-from-file" msgstr "" -#: src/scm/webid-oidc/program.scm:257 +#: src/scm/webid-oidc/program.scm:249 msgid "command-line|server|issuer|jwks-uri" msgstr "" -#: src/scm/webid-oidc/program.scm:259 +#: src/scm/webid-oidc/program.scm:251 msgid "command-line|server|issuer|authorization-endpoint-uri" msgstr "" -#: src/scm/webid-oidc/program.scm:261 +#: src/scm/webid-oidc/program.scm:253 msgid "command-line|server|issuer|token-endpoint-uri" msgstr "" -#: src/scm/webid-oidc/program.scm:263 +#: src/scm/webid-oidc/program.scm:255 msgid "command-line|server|client-id" msgstr "" -#: src/scm/webid-oidc/program.scm:265 +#: src/scm/webid-oidc/program.scm:257 msgid "command-line|server|redirect-uri" msgstr "" -#: src/scm/webid-oidc/program.scm:267 +#: src/scm/webid-oidc/program.scm:259 msgid "command-line|server|client-name" msgstr "" -#: src/scm/webid-oidc/program.scm:269 +#: src/scm/webid-oidc/program.scm:261 msgid "command-line|server|client-uri" msgstr "" -#: src/scm/webid-oidc/program.scm:303 +#: src/scm/webid-oidc/program.scm:295 #, scheme-format msgid "Usage: ~a COMMAND [OPTIONS]...\n" msgstr "" -#: src/scm/webid-oidc/program.scm:307 +#: src/scm/webid-oidc/program.scm:299 msgid "" "\n" "Run the disfluid COMMAND." msgstr "" -#: src/scm/webid-oidc/program.scm:310 +#: src/scm/webid-oidc/program.scm:302 msgid "" "\n" "This program is covered by the GNU Affero GPL, version 3 or\n" @@ -1206,13 +1212,13 @@ msgid "" "to all responses." msgstr "" -#: src/scm/webid-oidc/program.scm:317 +#: src/scm/webid-oidc/program.scm:309 msgid "" "\n" "Available commands:" msgstr "" -#: src/scm/webid-oidc/program.scm:319 +#: src/scm/webid-oidc/program.scm:311 #, scheme-format msgid "" "\n" @@ -1220,12 +1226,12 @@ msgid "" " run an authenticating reverse proxy." msgstr "" -#: src/scm/webid-oidc/program.scm:322 src/scm/webid-oidc/program.scm:514 -#: src/scm/webid-oidc/program.scm:715 +#: src/scm/webid-oidc/program.scm:314 src/scm/webid-oidc/program.scm:506 +#: src/scm/webid-oidc/program.scm:707 msgid "command-line|command|reverse-proxy" msgstr "" -#: src/scm/webid-oidc/program.scm:323 +#: src/scm/webid-oidc/program.scm:315 #, scheme-format msgid "" "\n" @@ -1233,12 +1239,12 @@ msgid "" " run an identity provider." msgstr "" -#: src/scm/webid-oidc/program.scm:326 src/scm/webid-oidc/program.scm:539 -#: src/scm/webid-oidc/program.scm:737 +#: src/scm/webid-oidc/program.scm:318 src/scm/webid-oidc/program.scm:531 +#: src/scm/webid-oidc/program.scm:729 msgid "command-line|command|identity-provider" msgstr "" -#: src/scm/webid-oidc/program.scm:327 +#: src/scm/webid-oidc/program.scm:319 #, scheme-format msgid "" "\n" @@ -1246,12 +1252,12 @@ msgid "" " serve the pages for a public application." msgstr "" -#: src/scm/webid-oidc/program.scm:330 src/scm/webid-oidc/program.scm:560 -#: src/scm/webid-oidc/program.scm:779 +#: src/scm/webid-oidc/program.scm:322 src/scm/webid-oidc/program.scm:552 +#: src/scm/webid-oidc/program.scm:771 msgid "command-line|command|client-service" msgstr "" -#: src/scm/webid-oidc/program.scm:331 +#: src/scm/webid-oidc/program.scm:323 #, scheme-format msgid "" "\n" @@ -1260,18 +1266,18 @@ msgid "" " facility." msgstr "" -#: src/scm/webid-oidc/program.scm:335 src/scm/webid-oidc/program.scm:586 -#: src/scm/webid-oidc/program.scm:808 +#: src/scm/webid-oidc/program.scm:327 src/scm/webid-oidc/program.scm:578 +#: src/scm/webid-oidc/program.scm:800 msgid "command-line|command|server" msgstr "" -#: src/scm/webid-oidc/program.scm:337 +#: src/scm/webid-oidc/program.scm:329 msgid "" "\n" "General options:" msgstr "" -#: src/scm/webid-oidc/program.scm:339 +#: src/scm/webid-oidc/program.scm:331 #, scheme-format msgid "" "\n" @@ -1280,7 +1286,7 @@ msgid "" " code. For instance, this would be an URI pointing to a tarball." msgstr "" -#: src/scm/webid-oidc/program.scm:344 +#: src/scm/webid-oidc/program.scm:336 #, scheme-format msgid "" "\n" @@ -1288,7 +1294,7 @@ msgid "" " display a short help message and exit." msgstr "" -#: src/scm/webid-oidc/program.scm:348 +#: src/scm/webid-oidc/program.scm:340 #, scheme-format msgid "" "\n" @@ -1296,7 +1302,7 @@ msgid "" " display the version information (~a, released ~a) and exit." msgstr "" -#: src/scm/webid-oidc/program.scm:354 +#: src/scm/webid-oidc/program.scm:346 #, scheme-format msgid "" "\n" @@ -1304,7 +1310,7 @@ msgid "" " describe the project in the DOAP vocabulary and exit." msgstr "" -#: src/scm/webid-oidc/program.scm:358 +#: src/scm/webid-oidc/program.scm:350 #, scheme-format msgid "" "\n" @@ -1312,7 +1318,7 @@ msgid "" " redirect the program standard output to FILE.log." msgstr "" -#: src/scm/webid-oidc/program.scm:362 +#: src/scm/webid-oidc/program.scm:354 #, scheme-format msgid "" "\n" @@ -1320,13 +1326,13 @@ msgid "" " redirect the program errors to FILE.err." msgstr "" -#: src/scm/webid-oidc/program.scm:367 +#: src/scm/webid-oidc/program.scm:359 msgid "" "\n" "General server-side options:" msgstr "" -#: src/scm/webid-oidc/program.scm:369 +#: src/scm/webid-oidc/program.scm:361 #, scheme-format msgid "" "\n" @@ -1334,7 +1340,7 @@ msgid "" " set the server port to bind, 8080 by default." msgstr "" -#: src/scm/webid-oidc/program.scm:373 +#: src/scm/webid-oidc/program.scm:365 #, scheme-format msgid "" "\n" @@ -1342,13 +1348,13 @@ msgid "" " set the public server URI (scheme, userinfo, host, and port)." msgstr "" -#: src/scm/webid-oidc/program.scm:378 +#: src/scm/webid-oidc/program.scm:370 msgid "" "\n" "Options for the resource server:" msgstr "" -#: src/scm/webid-oidc/program.scm:380 +#: src/scm/webid-oidc/program.scm:372 #, scheme-format msgid "" "\n" @@ -1358,7 +1364,7 @@ msgid "" " authentication." msgstr "" -#: src/scm/webid-oidc/program.scm:386 +#: src/scm/webid-oidc/program.scm:378 #, scheme-format msgid "" "\n" @@ -1367,13 +1373,13 @@ msgid "" " reverse-proxy command." msgstr "" -#: src/scm/webid-oidc/program.scm:392 +#: src/scm/webid-oidc/program.scm:384 msgid "" "\n" "Options for the identity provider:" msgstr "" -#: src/scm/webid-oidc/program.scm:394 +#: src/scm/webid-oidc/program.scm:386 #, scheme-format msgid "" "\n" @@ -1382,7 +1388,7 @@ msgid "" " key is generated. The server does not offer an HTTPS service." msgstr "" -#: src/scm/webid-oidc/program.scm:399 +#: src/scm/webid-oidc/program.scm:391 #, scheme-format msgid "" "\n" @@ -1390,7 +1396,7 @@ msgid "" " set the identity of the subject." msgstr "" -#: src/scm/webid-oidc/program.scm:403 +#: src/scm/webid-oidc/program.scm:395 #, scheme-format msgid "" "\n" @@ -1398,7 +1404,7 @@ msgid "" " set the encrypted password to recognize the user." msgstr "" -#: src/scm/webid-oidc/program.scm:407 +#: src/scm/webid-oidc/program.scm:399 #, scheme-format msgid "" "\n" @@ -1406,7 +1412,7 @@ msgid "" " load the user’s encrypted password from ENCRYPTED_PASSWORD_FILE." msgstr "" -#: src/scm/webid-oidc/program.scm:411 +#: src/scm/webid-oidc/program.scm:403 #, scheme-format msgid "" "\n" @@ -1414,7 +1420,7 @@ msgid "" " set the URI to query the key of the server." msgstr "" -#: src/scm/webid-oidc/program.scm:415 +#: src/scm/webid-oidc/program.scm:407 #, scheme-format msgid "" "\n" @@ -1422,7 +1428,7 @@ msgid "" " set the authorization endpoint of the issuer." msgstr "" -#: src/scm/webid-oidc/program.scm:419 +#: src/scm/webid-oidc/program.scm:411 #, scheme-format msgid "" "\n" @@ -1430,13 +1436,13 @@ msgid "" " set the token endpoint of the issuer." msgstr "" -#: src/scm/webid-oidc/program.scm:424 +#: src/scm/webid-oidc/program.scm:416 msgid "" "\n" "Options for the client service:" msgstr "" -#: src/scm/webid-oidc/program.scm:426 +#: src/scm/webid-oidc/program.scm:418 #, scheme-format msgid "" "\n" @@ -1445,7 +1451,7 @@ msgid "" " dereferenced to a semantic resource." msgstr "" -#: src/scm/webid-oidc/program.scm:431 +#: src/scm/webid-oidc/program.scm:423 #, scheme-format msgid "" "\n" @@ -1454,7 +1460,7 @@ msgid "" " page is presented with the code to paste in the application." msgstr "" -#: src/scm/webid-oidc/program.scm:436 +#: src/scm/webid-oidc/program.scm:428 #, scheme-format msgid "" "\n" @@ -1462,7 +1468,7 @@ msgid "" " set the user-visible application name (may be misleading...)." msgstr "" -#: src/scm/webid-oidc/program.scm:440 +#: src/scm/webid-oidc/program.scm:432 #, scheme-format msgid "" "\n" @@ -1471,13 +1477,13 @@ msgid "" " application (again, may be misleading)." msgstr "" -#: src/scm/webid-oidc/program.scm:446 +#: src/scm/webid-oidc/program.scm:438 msgid "" "\n" "Environment variables:" msgstr "" -#: src/scm/webid-oidc/program.scm:448 +#: src/scm/webid-oidc/program.scm:440 msgid "" "\n" " XML_CATALOG_FILES: the server will fetch resources on the web. By\n" @@ -1488,23 +1494,23 @@ msgid "" " content-type." msgstr "" -#: src/scm/webid-oidc/program.scm:456 src/scm/webid-oidc/program.scm:463 -#: src/scm/webid-oidc/program.scm:472 src/scm/webid-oidc/program.scm:480 -#: src/scm/webid-oidc/program.scm:488 +#: src/scm/webid-oidc/program.scm:448 src/scm/webid-oidc/program.scm:455 +#: src/scm/webid-oidc/program.scm:464 src/scm/webid-oidc/program.scm:472 +#: src/scm/webid-oidc/program.scm:480 #, scheme-format msgid "" "the-environment-variable|\n" " It is currently set to ~s." msgstr "" -#: src/scm/webid-oidc/program.scm:459 +#: src/scm/webid-oidc/program.scm:451 msgid "" "\n" " LANG: set the locale of the user interface (for the server commands,\n" " the user is the system administrator)." msgstr "" -#: src/scm/webid-oidc/program.scm:466 +#: src/scm/webid-oidc/program.scm:458 msgid "" "\n" " XDG_DATA_HOME: where the program stores persistent data. The\n" @@ -1513,7 +1519,7 @@ msgid "" " recommended to set it to /var/lib." msgstr "" -#: src/scm/webid-oidc/program.scm:475 +#: src/scm/webid-oidc/program.scm:467 msgid "" "\n" " XDG_CACHE_HOME: where the program stores and updates the seed file,\n" @@ -1521,7 +1527,7 @@ msgid "" " time. The seed file will be initialized from /dev/random." msgstr "" -#: src/scm/webid-oidc/program.scm:483 +#: src/scm/webid-oidc/program.scm:475 msgid "" "\n" " HOME: if XDG_DATA_HOME or XDG_CACHE_HOME is not set, they are\n" @@ -1529,13 +1535,13 @@ msgid "" " not used otherwise." msgstr "" -#: src/scm/webid-oidc/program.scm:492 +#: src/scm/webid-oidc/program.scm:484 msgid "" "\n" "Running a reverse proxy" msgstr "" -#: src/scm/webid-oidc/program.scm:494 +#: src/scm/webid-oidc/program.scm:486 msgid "" "\n" "Suppose that you operate data.provider.com. You want to run an\n" @@ -1548,7 +1554,7 @@ msgid "" "from this reverse proxy." msgstr "" -#: src/scm/webid-oidc/program.scm:504 +#: src/scm/webid-oidc/program.scm:496 #, scheme-format msgid "" "\n" @@ -1562,20 +1568,20 @@ msgid "" " --~a '/var/log/proxy.err'" msgstr "" -#: src/scm/webid-oidc/program.scm:519 +#: src/scm/webid-oidc/program.scm:511 msgid "" "\n" "Running an identity provider" msgstr "" -#: src/scm/webid-oidc/program.scm:521 +#: src/scm/webid-oidc/program.scm:513 msgid "" "\n" "The identity provider running at webid-oidc-demo.planete-kraus.eu is\n" "invoked with the following options:" msgstr "" -#: src/scm/webid-oidc/program.scm:525 +#: src/scm/webid-oidc/program.scm:517 #, scheme-format msgid "" "\n" @@ -1594,20 +1600,20 @@ msgid "" " --~a $PORT" msgstr "" -#: src/scm/webid-oidc/program.scm:545 +#: src/scm/webid-oidc/program.scm:537 msgid "" "\n" "Running the public pages for an application" msgstr "" -#: src/scm/webid-oidc/program.scm:547 +#: src/scm/webid-oidc/program.scm:539 msgid "" "\n" "The example client application pages for\n" "webid-oidc-demo.planete-kraus.eu are served this way:" msgstr "" -#: src/scm/webid-oidc/program.scm:551 +#: src/scm/webid-oidc/program.scm:543 #, scheme-format msgid "" "\n" @@ -1623,13 +1629,13 @@ msgid "" " --~a $PORT" msgstr "" -#: src/scm/webid-oidc/program.scm:565 +#: src/scm/webid-oidc/program.scm:557 msgid "" "\n" "Running a full server" msgstr "" -#: src/scm/webid-oidc/program.scm:568 +#: src/scm/webid-oidc/program.scm:560 msgid "" "\n" "To run the server with identity provider and\n" @@ -1637,7 +1643,7 @@ msgid "" "options for the parts." msgstr "" -#: src/scm/webid-oidc/program.scm:572 +#: src/scm/webid-oidc/program.scm:564 #, scheme-format msgid "" "\n" @@ -1656,14 +1662,14 @@ msgid "" " --~a '...port...'" msgstr "" -#: src/scm/webid-oidc/program.scm:597 +#: src/scm/webid-oidc/program.scm:589 #, scheme-format msgid "" "\n" "If you find a bug, then please send a report to ~a." msgstr "" -#: src/scm/webid-oidc/program.scm:602 +#: src/scm/webid-oidc/program.scm:594 #, scheme-format msgid "" "~a version ~a\n" @@ -1671,108 +1677,307 @@ msgid "" "Rreleased ~a\n" msgstr "" -#: src/scm/webid-oidc/program.scm:639 +#: src/scm/webid-oidc/program.scm:631 #, scheme-format msgid "The --~a argument must be a number, not ~s.\n" msgstr "" -#: src/scm/webid-oidc/program.scm:645 +#: src/scm/webid-oidc/program.scm:637 #, scheme-format msgid "The --~a argument must be an integer, not ~s.\n" msgstr "" -#: src/scm/webid-oidc/program.scm:651 +#: src/scm/webid-oidc/program.scm:643 #, scheme-format msgid "The --~a argument must be positive, ~s is invalid.\n" msgstr "" -#: src/scm/webid-oidc/program.scm:656 +#: src/scm/webid-oidc/program.scm:648 #, scheme-format msgid "The --~a argument must be less than 65536, ~s is invalid.\n" msgstr "" -#: src/scm/webid-oidc/program.scm:684 +#: src/scm/webid-oidc/program.scm:676 msgid "" "You specified two different passwords: one directly, and one from a file. " "Please set only one password.\n" msgstr "" -#: src/scm/webid-oidc/program.scm:708 +#: src/scm/webid-oidc/program.scm:700 #, scheme-format msgid "" "Usage: ~a COMMAND [OPTIONS]...\n" "See --~a (-h).\n" msgstr "" -#: src/scm/webid-oidc/program.scm:718 src/scm/webid-oidc/program.scm:740 -#: src/scm/webid-oidc/program.scm:810 +#: src/scm/webid-oidc/program.scm:710 src/scm/webid-oidc/program.scm:732 +#: src/scm/webid-oidc/program.scm:802 #, scheme-format msgid "You must pass --~a to set the server name.\n" msgstr "" -#: src/scm/webid-oidc/program.scm:722 +#: src/scm/webid-oidc/program.scm:714 #, scheme-format msgid "You must pass --~a to set the backend URI.\n" msgstr "" -#: src/scm/webid-oidc/program.scm:744 src/scm/webid-oidc/program.scm:814 +#: src/scm/webid-oidc/program.scm:736 src/scm/webid-oidc/program.scm:806 #, scheme-format msgid "" "You must pass --~a to set the file where to store the identity provider " "key.\n" msgstr "" -#: src/scm/webid-oidc/program.scm:748 src/scm/webid-oidc/program.scm:818 +#: src/scm/webid-oidc/program.scm:740 src/scm/webid-oidc/program.scm:810 #, scheme-format msgid "You must pass --~a to set the subject of the identity provider.\n" msgstr "" -#: src/scm/webid-oidc/program.scm:752 +#: src/scm/webid-oidc/program.scm:744 #, scheme-format msgid "You must pass --~a or --~a to set the subject’s encrypted password.\n" msgstr "" -#: src/scm/webid-oidc/program.scm:756 src/scm/webid-oidc/program.scm:826 +#: src/scm/webid-oidc/program.scm:748 src/scm/webid-oidc/program.scm:818 #, scheme-format msgid "You must pass --~a to set the JWKS URI.\n" msgstr "" -#: src/scm/webid-oidc/program.scm:760 src/scm/webid-oidc/program.scm:830 +#: src/scm/webid-oidc/program.scm:752 src/scm/webid-oidc/program.scm:822 #, scheme-format msgid "You must pass --~a to set the authorization endpoint URI.\n" msgstr "" -#: src/scm/webid-oidc/program.scm:764 src/scm/webid-oidc/program.scm:834 +#: src/scm/webid-oidc/program.scm:756 src/scm/webid-oidc/program.scm:826 #, scheme-format msgid "You must pass --~a to set the token endpoint URI.\n" msgstr "" -#: src/scm/webid-oidc/program.scm:782 +#: src/scm/webid-oidc/program.scm:774 #, scheme-format msgid "You must pass --~a to set the application web ID.\n" msgstr "" -#: src/scm/webid-oidc/program.scm:786 +#: src/scm/webid-oidc/program.scm:778 #, scheme-format msgid "You must pass --~a to set the redirection URI.\n" msgstr "" -#: src/scm/webid-oidc/program.scm:790 +#: src/scm/webid-oidc/program.scm:782 #, scheme-format msgid "You must pass --~a to set the informative client name.\n" msgstr "" -#: src/scm/webid-oidc/program.scm:794 +#: src/scm/webid-oidc/program.scm:786 #, scheme-format msgid "You must pass --~a to set the informative client URI.\n" msgstr "" -#: src/scm/webid-oidc/program.scm:822 +#: src/scm/webid-oidc/program.scm:814 #, scheme-format msgid "You must pass --~a to set the subject’s encrypted password.\n" msgstr "" -#: src/scm/webid-oidc/program.scm:877 +#: src/scm/webid-oidc/program.scm:869 #, scheme-format msgid "Unknown command ~s\n" msgstr "" + +#: src/scm/webid-oidc/refresh-token.scm:171 +msgid "the refresh token does not exist" +msgstr "" + +#: src/scm/webid-oidc/refresh-token.scm:182 +#, scheme-format +msgid "the refresh token is bound to key ~s, which is not that one" +msgstr "" + +#: src/scm/webid-oidc/resource-server.scm:62 +msgid "" +"You need to pass #:server-uri URI where URI is the public URI of the server, " +"as a (web uri)." +msgstr "" + +#: src/scm/webid-oidc/resource-server.scm:89 +#, scheme-format +msgid "~a: authentication failure: ~a\n" +msgstr "" + +#: src/scm/webid-oidc/resource-server.scm:93 +#, scheme-format +msgid "~a: authentication failure\n" +msgstr "" + +#: src/scm/webid-oidc/resource-server.scm:160 +#: src/scm/webid-oidc/resource-server.scm:351 +msgid "reason-phrase|Precondition Failed" +msgstr "" + +#: src/scm/webid-oidc/resource-server.scm:175 +msgid "reason-phrase|Not Modified" +msgstr "" + +#: src/scm/webid-oidc/resource-server.scm:191 +msgid "The owner is not defined." +msgstr "" + +#: src/scm/webid-oidc/resource-server.scm:263 +msgid "reason-phrase|Created" +msgstr "" + +#: src/scm/webid-oidc/resource-server.scm:288 +#, scheme-format +msgid "~a: ignoring a group that cannot be fetched: ~a\n" +msgstr "" + +#: src/scm/webid-oidc/resource-server.scm:292 +#, scheme-format +msgid "~a: ignoring a group that cannot be fetched\n" +msgstr "" + +#: src/scm/webid-oidc/resource-server.scm:299 +msgid "reason-phrase|Found" +msgstr "" + +#: src/scm/webid-oidc/resource-server.scm:316 +#: src/scm/webid-oidc/token-endpoint.scm:103 +msgid "reason-phrase|Forbidden" +msgstr "" + +#: src/scm/webid-oidc/resource-server.scm:337 +msgid "reason-phrase|Conflict" +msgstr "" + +#: src/scm/webid-oidc/resource-server.scm:344 +msgid "reason-phrase|Unsupported Media Type" +msgstr "" + +#: src/scm/webid-oidc/resource-server.scm:358 +msgid "reason-phrase|Not Acceptable" +msgstr "" + +#: src/scm/webid-oidc/reverse-proxy.scm:60 +msgid "#:endpoint argument is not present or not an URI." +msgstr "" + +#: src/scm/webid-oidc/server/create.scm:85 +#, scheme-format +msgid "only text/turtle is allowed for the target of a POST request, not ~s" +msgstr "" + +#: src/scm/webid-oidc/server/create.scm:105 +msgid "the created resource cannot have containment triples" +msgstr "" + +#: src/scm/webid-oidc/server/create.scm:147 +#, scheme-format +msgid "cannot POST to an auxiliary resource path, ~s" +msgstr "" + +#: src/scm/webid-oidc/server/read.scm:105 +#, scheme-format +msgid "the auxiliary resource of type ~s at ~s is absent" +msgstr "" + +#: src/scm/webid-oidc/serve.scm:76 +msgid "content negociation failed while serving a request" +msgstr "" + +#: src/scm/webid-oidc/simulation.scm:130 +#, scheme-format +msgid "invalid credentials: response ~s ~s" +msgstr "" + +#: src/scm/webid-oidc/stubs.scm:110 +#, scheme-format +msgid "invalid base64 data: ~a" +msgstr "" + +#: src/scm/webid-oidc/stubs.scm:127 +#, scheme-format +msgid "~s is not a recognized elliptic curve" +msgstr "" + +#: src/scm/webid-oidc/stubs.scm:155 +#, scheme-format +msgid "~s is not a supported signature algorithm" +msgstr "" + +#: src/scm/webid-oidc/stubs.scm:158 +#, scheme-format +msgid "~s is not a supported hash algorithm" +msgstr "" + +#: src/scm/webid-oidc/stubs.scm:196 +msgid "the signature is invalid" +msgstr "" + +#: src/scm/webid-oidc/stubs.scm:248 +#, scheme-format +msgid "invalid JSON data: ~a" +msgstr "" + +#: src/scm/webid-oidc/stubs.scm:263 +msgid "invalid JSON data in input port" +msgstr "" + +#: src/scm/webid-oidc/stubs.scm:323 +#, scheme-format +msgid "while updating file ~s: ~a" +msgstr "" + +#: src/scm/webid-oidc/stubs.scm:325 +#, scheme-format +msgid "an error happened while updating file ~s" +msgstr "" + +#: src/scm/webid-oidc/token-endpoint.scm:91 +#, scheme-format +msgid "while handling web failure for the token endpoint: ~a" +msgstr "" + +#: src/scm/webid-oidc/token-endpoint.scm:93 +msgid "an error happened during the token endpoint failure handling" +msgstr "" + +#: src/scm/webid-oidc/token-endpoint.scm:129 +#: src/scm/webid-oidc/token-endpoint.scm:156 +msgid "reason-phrase|Bad Request" +msgstr "" + +#: src/scm/webid-oidc/token-endpoint.scm:222 +msgid "missing grant type" +msgstr "" + +#: src/scm/webid-oidc/token-endpoint.scm:226 +msgid "<p>You did not specify a grant_type for this request.</p>" +msgstr "" + +#: src/scm/webid-oidc/token-endpoint.scm:240 +msgid "missing authorization code" +msgstr "" + +#: src/scm/webid-oidc/token-endpoint.scm:244 +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 +msgid "missing refresh token" +msgstr "" + +#: src/scm/webid-oidc/token-endpoint.scm:262 +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 +#, scheme-format +msgid "unsupported grant type: ~s" +msgstr "" + +#: src/scm/webid-oidc/token-endpoint.scm:280 +#, scheme-format +msgid "" +"<p>You want to use <pre>~s</pre> as a grant type, but this is not supported." +"</p>" +msgstr "" @@ -2,7 +2,7 @@ msgid "" msgstr "" "Project-Id-Version: webid-oidc 0.0.0\n" "Report-Msgid-Bugs-To: vivien@planete-kraus.eu\n" -"POT-Creation-Date: 2021-08-12 18:50+0200\n" +"POT-Creation-Date: 2021-08-12 18:55+0200\n" "PO-Revision-Date: 2021-08-12 18:53+0200\n" "Last-Translator: Vivien Kraus <vivien@planete-kraus.eu>\n" "Language-Team: French <vivien@planete-kraus.eu>\n" @@ -126,911 +126,720 @@ msgstr "Utilisation : generate-random [NOMBRE D'OCTETS]\n" msgid "Usage: generate-key [NUMBER OF BITS | CURVE]\n" msgstr "Utilisation : generate-key [NOMBRE DE BITS | COURBE]\n" -#: src/scm/webid-oidc/errors.scm:1081 -msgid "that’s how it is" -msgstr "c’est comme ça" - -#: src/scm/webid-oidc/errors.scm:1086 -#, scheme-format -msgid "the value ~s is not a base64 string (because ~a)" -msgstr "la valeur ~s n’est pas une chaîne base64 (parce que ~a)" - -#: src/scm/webid-oidc/errors.scm:1089 -#, scheme-format -msgid "the value ~s is not JSON (because ~a)" -msgstr "la valeur ~s n’est pas du JSON (parce que ~a)" - -#: src/scm/webid-oidc/errors.scm:1092 -#, scheme-format -msgid "the value ~s is not Turtle (because ~a)" -msgstr "la valeur ~s n’est pas du Turtle (parce que ~a)" - -#: src/scm/webid-oidc/errors.scm:1095 -#, scheme-format -msgid "the value ~s does not identify an elleptic curve" -msgstr "la valeur ~s n’identifie pas une courbe elliptique" - -#: src/scm/webid-oidc/errors.scm:1100 -#, scheme-format -msgid "the value ~s does not identify a JWK (because ~a)" -msgstr "la valeur ~s n’identifie pas une JWK (parce que ~a)" - -#: src/scm/webid-oidc/errors.scm:1102 -#, scheme-format -msgid "the value ~s does not identify a JWK" -msgstr "la valeur ~s n’identifie pas une JWK" - -#: src/scm/webid-oidc/errors.scm:1107 -#, scheme-format -msgid "the value ~s does not identify a public JWK (because ~a)" -msgstr "la valeur ~s n’identifie pas une JWK publique (parce que ~a)" - -#: src/scm/webid-oidc/errors.scm:1109 -#, scheme-format -msgid "the value ~s does not identify a public JWK" -msgstr "la valeur ~s n’identifie pas une JWK publique" - -#: src/scm/webid-oidc/errors.scm:1114 -#, scheme-format -msgid "the value ~s does not identify a private JWK (because ~a)" -msgstr "la valeur ~s n’identifie pas une JWK privée (parce que ~a)" - -#: src/scm/webid-oidc/errors.scm:1116 -#, scheme-format -msgid "the value ~s does not identify a private JWK" -msgstr "la valeur ~s n’identifie pas une JWK privée" - -#: src/scm/webid-oidc/errors.scm:1121 -#, scheme-format -msgid "the value ~s does not identify a JWKS (because ~a)" -msgstr "la valeur ~s n’identifie pas un JWKS (parce que ~a)" - -#: src/scm/webid-oidc/errors.scm:1123 -#, scheme-format -msgid "the value ~s does not identify a JWKS" -msgstr "la valeur ~s n’identifie pas un JWKS" - -#: src/scm/webid-oidc/errors.scm:1126 -#, scheme-format -msgid "the value ~s does not identify a hash algorithm" -msgstr "la valeur ~s n’identifie pas un algorithme de hachage" +#: src/scm/webid-oidc/access-token.scm:72 +#, fuzzy, scheme-format +#| msgid "~s is not an access token (because ~a)" +msgid "this is not an access token, because it is not even a JWS: ~a" +msgstr "~s n’est pas un jeton d’accès (parce que ~a)" -#: src/scm/webid-oidc/errors.scm:1129 -#, scheme-format -msgid "the value ~s is not an alist or misses key ~s" -msgstr "la valeur ~s n’est pas une alist ou il manque la clé ~s" +#: src/scm/webid-oidc/access-token.scm:74 +#, fuzzy +#| msgid "~s is not an access token (because ~a)" +msgid "this is not an access token, because it is not even a JWS" +msgstr "~s n’est pas un jeton d’accès (parce que ~a)" -#: src/scm/webid-oidc/errors.scm:1132 -#, scheme-format -msgid "the value ~s is not a JWS header (because ~a)" -msgstr "la valeur ~s n’est pas un header JWS (parce que ~a)" +#: src/scm/webid-oidc/access-token.scm:77 src/scm/webid-oidc/dpop-proof.scm:96 +#, fuzzy, scheme-format +#| msgid "~s is not an access token (because ~a)" +msgid "this is not an access token: ~a" +msgstr "~s n’est pas un jeton d’accès (parce que ~a)" -#: src/scm/webid-oidc/errors.scm:1135 -#, scheme-format -msgid "the value ~s is not a JWS payload (because ~a)" -msgstr "la valeur ~s n’est pas un contenu JWS (parce que ~a)" +#: src/scm/webid-oidc/access-token.scm:79 src/scm/webid-oidc/dpop-proof.scm:98 +#, fuzzy +#| msgid "~s is not an access token (because ~a)" +msgid "this is not an access token" +msgstr "~s n’est pas un jeton d’accès (parce que ~a)" -#: src/scm/webid-oidc/errors.scm:1138 -#, scheme-format -msgid "the value ~s is not a JWS (because ~a)" -msgstr "la valeur ~s n’est pas un JWS (parce que ~a)" +#: src/scm/webid-oidc/access-token.scm:101 +#: src/scm/webid-oidc/authorization-code.scm:88 +#: src/scm/webid-oidc/oidc-id-token.scm:96 +#, fuzzy, scheme-format +#| msgid "the aud field is missing" +msgid "the payload is missing ~s" +msgstr "le champ aud est manquant" -#: src/scm/webid-oidc/errors.scm:1141 -#, scheme-format -msgid "the string ~s cannot be split in 3 parts with ~s" -msgstr "la chaîne ~s ne peut pas être découpée en 3 parties avec ~s" +#: src/scm/webid-oidc/access-token.scm:123 +#: src/scm/webid-oidc/authorization-code.scm:104 +#: src/scm/webid-oidc/oidc-id-token.scm:117 +#, fuzzy, scheme-format +#| msgid "the webid field is missing" +msgid "the \"webid\" field should be an URI, ~s is given" +msgstr "le champ webid est manquant" -#: src/scm/webid-oidc/errors.scm:1144 +#: src/scm/webid-oidc/access-token.scm:130 +#: src/scm/webid-oidc/oidc-id-token.scm:124 #, scheme-format -msgid "" -"all key candidates failed to verify signature ~s with algorithm ~s and " -"payload ~a (there were ~a: ~s)" +msgid "the \"iss\" field should be an URI, ~s is given" msgstr "" -"aucune clé candidate n’a pu vérifier la signature ~s avec l’algorithme ~s et " -"le contenu ~a (il y en avait ~a : ~s)" - -#: src/scm/webid-oidc/errors.scm:1147 -#, scheme-format -msgid "I cannot decode JWS ~a (because ~a)" -msgstr "je n’ai pas pu décoder le JWS encodé par ~a (parce que ~a)" -#: src/scm/webid-oidc/errors.scm:1150 +#: src/scm/webid-oidc/access-token.scm:135 #, scheme-format -msgid "I cannot encode JWS ~a (because ~a)" -msgstr "je n’ai pas pu encoder le JWS ~a (parce que ~a)" - -#: src/scm/webid-oidc/errors.scm:1153 -#, scheme-format -msgid "" -"the server request unexpectedly failed with code ~a and reason phrase ~s" +msgid "the \"aud\" field should be set to \"solid\", ~s is given" msgstr "" -"la requête au serveur a échoué de façon inattendue avec un code ~a et une " -"raison ~s" -#: src/scm/webid-oidc/errors.scm:1158 +#: src/scm/webid-oidc/access-token.scm:142 +#: src/scm/webid-oidc/oidc-id-token.scm:152 #, scheme-format -msgid "the header ~a should not have the value ~s" -msgstr "l’en-tête ~a ne devrait pas avoir la valeur ~s" - -#: src/scm/webid-oidc/errors.scm:1160 -#, scheme-format -msgid "the header ~a should be present" -msgstr "l’en-tête ~a devrait être présent" - -#: src/scm/webid-oidc/errors.scm:1163 -#, scheme-format -msgid "the server response wasn't expected: ~s (because ~a)" -msgstr "la réponse du serveur est inattendue : ~s (parce que ~a)" +msgid "the \"iat\" field should be a timestamp, ~s is given" +msgstr "" -#: src/scm/webid-oidc/errors.scm:1169 +#: src/scm/webid-oidc/access-token.scm:149 +#: src/scm/webid-oidc/authorization-code.scm:125 +#: src/scm/webid-oidc/oidc-id-token.scm:159 #, scheme-format -msgid "the value ~s is not an OIDC configuration (because ~a)" -msgstr "la valeur ~s n’est pas une configuration OIDC (parce que ~a)" +msgid "the \"exp\" field should be a timestamp, ~s is given" +msgstr "" -#: src/scm/webid-oidc/errors.scm:1174 -#, scheme-format -msgid "the webid field is incorrect: ~s" -msgstr "le champ webid est incorrect : ~s" +#: src/scm/webid-oidc/access-token.scm:158 +#, fuzzy +#| msgid "the cnf/jkt field is missing" +msgid "the \"cnf\" / \"jkt\" field is missing" +msgstr "le champ cnf/jkt est manquant" -#: src/scm/webid-oidc/errors.scm:1175 -msgid "the webid field is missing" -msgstr "le champ webid est manquant" +#: src/scm/webid-oidc/access-token.scm:166 +#, fuzzy, scheme-format +#| msgid "the cnf/jkt field is missing" +msgid "the \"cnf\" / \"jkt\" field should be a string, ~s is given" +msgstr "le champ cnf/jkt est manquant" -#: src/scm/webid-oidc/errors.scm:1179 +#: src/scm/webid-oidc/access-token.scm:171 #, scheme-format -msgid "the sub field is incorrect: ~s" -msgstr "le champ sub est incorrect : ~s" +msgid "the \"cnf\" field should be an object, ~s is given" +msgstr "" -#: src/scm/webid-oidc/errors.scm:1180 -msgid "the sub field is missing" -msgstr "le champ sub est manquant" +#: src/scm/webid-oidc/access-token.scm:178 +#: src/scm/webid-oidc/authorization-code.scm:111 +#, fuzzy, scheme-format +#| msgid "The client URI should be an URI.\n" +msgid "the \"client_id\" field should be an URI, ~s is given" +msgstr "L’URI du client doit être un URI.\n" -#: src/scm/webid-oidc/errors.scm:1184 +#: src/scm/webid-oidc/access-token.scm:238 #, scheme-format -msgid "the iss field is incorrect: ~s" -msgstr "le champ iss est incorrect : ~s" +msgid "the access token is invalid: ~a" +msgstr "" -#: src/scm/webid-oidc/errors.scm:1185 -msgid "the iss field is missing" -msgstr "le champ iss est manquant" +#: src/scm/webid-oidc/access-token.scm:240 +msgid "the access token is invalid" +msgstr "" -#: src/scm/webid-oidc/errors.scm:1189 -#, scheme-format -msgid "the aud field is incorrect: ~s" -msgstr "le champ aud est incorrect : ~s" +#: src/scm/webid-oidc/access-token.scm:256 +#: src/scm/webid-oidc/oidc-id-token.scm:236 +#, fuzzy, scheme-format +#| msgid "I cannot fetch the issuer configuration of ~a (because ~a)" +msgid "I cannot query the identity provider configuration: ~a" +msgstr "" +"je n’ai pas pu récupérer la configuration de l’émetteur ~a (parce que ~a)" -#: src/scm/webid-oidc/errors.scm:1190 -msgid "the aud field is missing" -msgstr "le champ aud est manquant" +#: src/scm/webid-oidc/access-token.scm:258 +#: src/scm/webid-oidc/oidc-id-token.scm:238 +msgid "I cannot query the identity provider configuratioon" +msgstr "" -#: src/scm/webid-oidc/errors.scm:1194 +#: src/scm/webid-oidc/access-token.scm:275 #, scheme-format -msgid "the iat field is incorrect: ~s" -msgstr "le champ iat est incorrect : ~s" - -#: src/scm/webid-oidc/errors.scm:1195 -msgid "the iat field is missing" -msgstr "le champ iat est manquant" +msgid "I cannot query the identity provider public keys: ~a" +msgstr "" -#: src/scm/webid-oidc/errors.scm:1199 -#, scheme-format -msgid "the exp field is incorrect: ~s" -msgstr "le champ exp est incorrect : ~s" +#: src/scm/webid-oidc/access-token.scm:277 +#, fuzzy +#| msgid "" +#| "\n" +#| "Options for the identity provider:" +msgid "I cannot query the identity provider public keys" +msgstr "" +"\n" +"Options du fournisseur d’identité :" -#: src/scm/webid-oidc/errors.scm:1200 -msgid "the exp field is missing" -msgstr "le champ exp est manquant" +#: src/scm/webid-oidc/access-token.scm:293 +#, fuzzy, scheme-format +#| msgid "the date is ~a, but the DPoP proof is signed in the future at ~a" +msgid "the access token is signed in the future, ~a, relative to current ~a" +msgstr "la date est ~a, mais la preuve DPoP a été signée dans le futur à ~a" -#: src/scm/webid-oidc/errors.scm:1204 +#: src/scm/webid-oidc/access-token.scm:302 #, scheme-format -msgid "the cnf/jkt field is incorrect: ~s" -msgstr "le champ cnf/jkt est incorrect : ~s" - -#: src/scm/webid-oidc/errors.scm:1205 -msgid "the cnf/jkt field is missing" -msgstr "le champ cnf/jkt est manquant" +msgid "the access token expired ~a, which is in the past (from ~a)" +msgstr "" -#: src/scm/webid-oidc/errors.scm:1209 -#, scheme-format -msgid "the client-id field is incorrect: ~s" -msgstr "le champ client-id est incorrect : ~s" +#: src/scm/webid-oidc/access-token.scm:316 +#, fuzzy, scheme-format +#| msgid "I cannot decode ~s as an access token (because ~a)" +msgid "cannot encode the access token: ~a" +msgstr "je n’ai pas pu décoder ~s comme jeton d’accès (parce que ~a)" -#: src/scm/webid-oidc/errors.scm:1210 -msgid "the client-id field is missing" -msgstr "le champ client-id est manquant" +#: src/scm/webid-oidc/access-token.scm:318 +#, fuzzy +#| msgid "I cannot decode ~s as an access token (because ~a)" +msgid "cannot encode the access token" +msgstr "je n’ai pas pu décoder ~s comme jeton d’accès (parce que ~a)" -#: src/scm/webid-oidc/errors.scm:1214 -#: src/scm/webid-oidc/authorization-page-unsafe.scm:149 -#, scheme-format -msgid "the redirect_uris field is incorrect: ~s" -msgstr "le champ redirect_uris est incorrect : ~s" +#: src/scm/webid-oidc/authorization-code.scm:63 +#, fuzzy, scheme-format +#| msgid "~s is not an authorization code (because ~a)" +msgid "this is not an authorization code, because it is not even a JWS: ~a" +msgstr "~s n’est pas un code d’autorisation (parce que ~a)" -#: src/scm/webid-oidc/errors.scm:1215 -#: src/scm/webid-oidc/authorization-page-unsafe.scm:150 -msgid "the redirect_uris field is missing" -msgstr "le champ redirect_uris est manquant" +#: src/scm/webid-oidc/authorization-code.scm:65 +#, fuzzy +#| msgid "~s is not an authorization code (because ~a)" +msgid "this is not an authorization code, because it is not even a JWS" +msgstr "~s n’est pas un code d’autorisation (parce que ~a)" -#: src/scm/webid-oidc/errors.scm:1219 -#, scheme-format -msgid "the typ field is incorrect: ~s" -msgstr "le champ typ est incorrect : ~s" +#: src/scm/webid-oidc/authorization-code.scm:68 +#, fuzzy, scheme-format +#| msgid "~s is not an authorization code (because ~a)" +msgid "this is not an authorization code: ~a" +msgstr "~s n’est pas un code d’autorisation (parce que ~a)" -#: src/scm/webid-oidc/errors.scm:1220 -msgid "the typ field is missing" -msgstr "le champ typ est manquant" +#: src/scm/webid-oidc/authorization-code.scm:70 +#, fuzzy +#| msgid "~s is not an authorization code (because ~a)" +msgid "this is not an authorization code" +msgstr "~s n’est pas un code d’autorisation (parce que ~a)" -#: src/scm/webid-oidc/errors.scm:1224 +#: src/scm/webid-oidc/authorization-code.scm:118 #, scheme-format -msgid "the jwk field is incorrect: ~s (because ~a)" -msgstr "le champ jwk est incorrect : ~s (parce que ~a)" - -#: src/scm/webid-oidc/errors.scm:1226 -msgid "the jwk field is missing" -msgstr "le champ jwk est manquant" +msgid "the \"jti\" field should be a string, ~s is given" +msgstr "" -#: src/scm/webid-oidc/errors.scm:1230 -#, scheme-format -msgid "the jti field is incorrect: ~s" -msgstr "le champ jti est incorrect : ~s" +#: src/scm/webid-oidc/authorization-code.scm:169 +#, fuzzy, scheme-format +#| msgid "there is no authorization code in the request" +msgid "the authorization code is invalid: ~a" +msgstr "il n’y a pas de code d’autorisation dans la requête" -#: src/scm/webid-oidc/errors.scm:1231 -msgid "the jti field is missing" -msgstr "le champ jti est manquant" +#: src/scm/webid-oidc/authorization-code.scm:171 +#, fuzzy +#| msgid "there is no authorization code in the request" +msgid "the authorization code is invalid" +msgstr "il n’y a pas de code d’autorisation dans la requête" -#: src/scm/webid-oidc/errors.scm:1235 +#: src/scm/webid-oidc/authorization-code.scm:185 #, scheme-format -msgid "the nonce field is incorrect: ~s" -msgstr "le champ nonce est incorrect : ~s" +msgid "the authorization expired ~a, which is in the past (from ~a)" +msgstr "" -#: src/scm/webid-oidc/errors.scm:1236 -msgid "the nonce field is missing" -msgstr "le champ nonce est manquant" +#: src/scm/webid-oidc/authorization-code.scm:201 +#, fuzzy, scheme-format +#| msgid "I cannot encode ~s as an authorization code (because ~a)" +msgid "cannot encode the authorization code: ~a" +msgstr "je n’ai pas pu encoder ~s comme un code d’autorisation (parce que ~a)" -#: src/scm/webid-oidc/errors.scm:1240 -#, scheme-format -msgid "the htm field is incorrect: ~s" -msgstr "le champ htm est incorrect : ~s" +#: src/scm/webid-oidc/authorization-code.scm:203 +#, fuzzy +#| msgid "I cannot encode ~s as an authorization code (because ~a)" +msgid "cannot encode the authorization code" +msgstr "je n’ai pas pu encoder ~s comme un code d’autorisation (parce que ~a)" -#: src/scm/webid-oidc/errors.scm:1241 -msgid "the htm field is missing" -msgstr "le champ htm est manquant" +#: src/scm/webid-oidc/authorization-page-unsafe.scm:52 +#: src/scm/webid-oidc/hello-world.scm:40 src/scm/webid-oidc/hello-world.scm:164 +#: src/scm/webid-oidc/hello-world.scm:184 +msgid "xml-lang|en" +msgstr "fr" -#: src/scm/webid-oidc/errors.scm:1245 -#, scheme-format -msgid "the htu field is incorrect: ~s" -msgstr "le champ htu est incorrect : ~s" +#: src/scm/webid-oidc/authorization-page-unsafe.scm:67 +msgid "page-title|Authorization" +msgstr "Autorisation" -#: src/scm/webid-oidc/errors.scm:1246 -msgid "the htu field is missing" -msgstr "le champ htu est manquant" +#: src/scm/webid-oidc/authorization-page-unsafe.scm:72 +msgid "Authorize this anonymous application?" +msgstr "Autoriser cette application anonyme ?" -#: src/scm/webid-oidc/errors.scm:1250 +#: src/scm/webid-oidc/authorization-page-unsafe.scm:73 #, scheme-format -msgid "the ath field is incorrect: ~s" -msgstr "le champ ath est incorrect : ~s" +msgid "Authorize <a href=~s>~a</a>?" +msgstr "Autoriser <a href=~s>~a</a> ?" -#: src/scm/webid-oidc/errors.scm:1251 -msgid "the ath field is missing" -msgstr "le champ ath est manquant" +#: src/scm/webid-oidc/authorization-page-unsafe.scm:75 +msgid "Do you want to authorize this application to represent you?" +msgstr "Voulez-vous autoriser cette application à vous représenter ?" -#: src/scm/webid-oidc/errors.scm:1253 -#, scheme-format -msgid "~s is not an access token (because ~a)" -msgstr "~s n’est pas un jeton d’accès (parce que ~a)" +#: src/scm/webid-oidc/authorization-page-unsafe.scm:85 +msgid "Please retry your password:" +msgstr "Veuillez réessayer votre mot de passe :" -#: src/scm/webid-oidc/errors.scm:1256 -#, scheme-format -msgid "~s is not an access token header (because ~a)" -msgstr "~s n’est pas un en-tête de jeton d’accès (parce que ~a)" +#: src/scm/webid-oidc/authorization-page-unsafe.scm:86 +msgid "Please enter your password:" +msgstr "Veuillez entrer votre mot de passe :" -#: src/scm/webid-oidc/errors.scm:1259 -#, scheme-format -msgid "~s is not an access token payload (because ~a)" -msgstr "~s n’est pas un contenu de jeton d’accès (parce que ~a)" +#: src/scm/webid-oidc/authorization-page-unsafe.scm:91 +msgid "Allow" +msgstr "Autoriser" -#: src/scm/webid-oidc/errors.scm:1262 -#, scheme-format -msgid "~s is not a DPoP proof (because ~a)" -msgstr "~s n’est pas une preuve DPoP (parce que ~a)" +#: src/scm/webid-oidc/authorization-page-unsafe.scm:97 +msgid "Bad request" +msgstr "Requête invalide" -#: src/scm/webid-oidc/errors.scm:1265 -#, scheme-format -msgid "~s is not a DPoP proof header (because ~a)" -msgstr "~s n’est pas un en-tête de preuve DPoP (parce que ~a)" +#: src/scm/webid-oidc/authorization-page-unsafe.scm:102 +msgid "The application did not set the <emph>client_id</emph> parameter." +msgstr "L'application n'a pas spécifié le paramètre <emph>client_id</emph>." -#: src/scm/webid-oidc/errors.scm:1268 -#, scheme-format -msgid "~s is not a DPoP proof payload (because ~a)" -msgstr "~s n’est pas un contenu de preuve DPoP (parce que ~a)" +#: src/scm/webid-oidc/authorization-page-unsafe.scm:107 +msgid "The application did not set the <emph>redirect_uri</emph> parameter." +msgstr "L'application n'a pas spécifié le paramètre <emph>redirect_uri</emph>." -#: src/scm/webid-oidc/errors.scm:1271 -#, scheme-format -msgid "I cannot fetch the issuer configuration of ~a (because ~a)" +#: src/scm/webid-oidc/authorization-page-unsafe.scm:112 +msgid "Sorry, no more information is available." msgstr "" -"je n’ai pas pu récupérer la configuration de l’émetteur ~a (parce que ~a)" - -#: src/scm/webid-oidc/errors.scm:1278 -#, scheme-format -msgid "I cannot fetch the JWKS of ~a at ~a (because ~a)" -msgstr "je n’ai pas pu récupérer le JWKS de ~a à ~a (parce que ~a)" -#: src/scm/webid-oidc/errors.scm:1289 -#, scheme-format -msgid "the HTTP method is signed for ~s, but ~s was requested" -msgstr "la méthode HTTP a été signée pour ~s, mais ~s a été demandé" - -#: src/scm/webid-oidc/errors.scm:1292 -#, scheme-format -msgid "the HTTP uri is signed for ~a, but ~a was requested" -msgstr "l’uri HTTP a été signé pour ~a, mais ~a a été demandé" - -#: src/scm/webid-oidc/errors.scm:1295 -#, scheme-format -msgid "the date is ~a, but the DPoP proof is signed in the future at ~a" -msgstr "la date est ~a, mais la preuve DPoP a été signée dans le futur à ~a" - -#: src/scm/webid-oidc/errors.scm:1299 -#, scheme-format -msgid "the date is ~a, but the DPoP proof was signed too long ago at ~a" +#: src/scm/webid-oidc/authorization-page-unsafe.scm:117 +#, fuzzy +#| msgid "" +#| "The application you are trying to authorize behaved unexpectedly. Here is " +#| "the explanation of the error:" +msgid "The application you are trying to authorize behaved unexpectedly." msgstr "" -"la date est ~a, mais la preuve DPoP a été signée il y a trop longtemps à ~a" - -#: src/scm/webid-oidc/errors.scm:1308 -#, scheme-format -msgid "the key ~s does not hash to ~a" -msgstr "la clé ~s ne donne pas un hash de ~a" - -#: src/scm/webid-oidc/errors.scm:1310 -#, scheme-format -msgid "the key confirmation of ~s failed (because ~a)" -msgstr "la confirmation de clé de ~s a échoué (parce que ~a)" +"L’application que vous essayez d’autoriser se comporte de façon inattendue. " +"Ci-après une explication de l’erreur :" -#: src/scm/webid-oidc/errors.scm:1312 -#, scheme-format -msgid "the key confirmation of ~s failed" -msgstr "la confirmation de la clé ~s a échoué" +#: src/scm/webid-oidc/authorization-page-unsafe.scm:130 +msgid "Redirecting..." +msgstr "Redirection..." -#: src/scm/webid-oidc/errors.scm:1317 -#, scheme-format -msgid "the DPoP proof is bound to an access token with hash ~s, not ~s" -msgstr "la preuve DPoP est liée à un jeton d’accès haché en ~s, pas ~s" +#: src/scm/webid-oidc/authorization-page-unsafe.scm:135 +#, fuzzy, scheme-format +#| msgid "" +#| "<a href=~s>~a</a> can now log in on your behalf. You still need to adjust " +#| "permissions." +msgid "" +"<p><a href=~s>~a</a> can now log in on your behalf. You still need to adjust " +"permissions.</p>" +msgstr "" +"<a href=~s>~a</a> peut maintenant s'identifier en votre nom. Vous devez " +"toujours ajuster ses permissions." -#: src/scm/webid-oidc/errors.scm:1319 +#: src/scm/webid-oidc/cache.scm:94 #, scheme-format -msgid "the DPoP proof should be bound to the access token ~s" -msgstr "la preuve DPoP doit être liée au jeton d’accès ~s" +msgid "Dropping cache item ~a.~%" +msgstr "" -#: src/scm/webid-oidc/errors.scm:1322 -#, scheme-format -msgid "the jti ~s has already been found (because ~a)" -msgstr "le jti ~s a déjà été trouvé (parce que ~a)" +#: src/scm/webid-oidc/cache.scm:100 +#, fuzzy, scheme-format +#| msgid "Could not open the seed file '%s'.\n" +msgid "Could not clean file ~a.~%" +msgstr "Impossible d'ouvrir le fichier graine « %s ».\n" -#: src/scm/webid-oidc/errors.scm:1325 +#: src/scm/webid-oidc/cache.scm:106 #, scheme-format -msgid "I cannot decode ~s as an access token (because ~a)" -msgstr "je n’ai pas pu décoder ~s comme jeton d’accès (parce que ~a)" +msgid "While cleaning the cache: ~a: ~a~%" +msgstr "" -#: src/scm/webid-oidc/errors.scm:1328 +#: src/scm/webid-oidc/cache.scm:166 #, scheme-format -msgid "I cannot encode ~s as an access token with key ~s (because ~a)" +msgid "Cache miss for ~a: ~s~%" msgstr "" -"je n’ai pas pu encoder ~s comme un jeton d’accès avec la clé ~s (parce que " -"~a)" -#: src/scm/webid-oidc/errors.scm:1331 +#: src/scm/webid-oidc/cache.scm:261 #, scheme-format -msgid "I cannot decode ~s as a DPoP proof (because ~a)" -msgstr "je n’ai pas pu décoder ~s comme preuve DPoP (parce que ~a)" +msgid "Cache entry for ~a varies.\n" +msgstr "" -#: src/scm/webid-oidc/errors.scm:1334 -#, scheme-format -msgid "I cannot encode ~s as a DPoP proof (because ~a)" -msgstr "je n’ai pas pu encoder ~s comme une preuve DPoP (parce que ~a)" +#: src/scm/webid-oidc/catalog.scm:166 +msgid "invalid relative URI" +msgstr "" -#: src/scm/webid-oidc/errors.scm:1337 +#: src/scm/webid-oidc/catalog.scm:245 #, scheme-format -msgid "I could not fetch a RDF graph at ~a (because ~a)" -msgstr "je n’ai pas pu récupérer de graphe RDF à ~a (parce que ~a)" +msgid "Unsupported delegate catalog URI scheme: ~s\n" +msgstr "" -#: src/scm/webid-oidc/errors.scm:1340 -#, scheme-format -msgid "~s is not a client manifest (because ~a)" -msgstr "~s n’est pas un manifeste client (parce que ~a)" +#: src/scm/webid-oidc/client/accounts.scm:418 +#, fuzzy +#| msgid "there is no such refresh token as ~s" +msgid "The refresh token has expired." +msgstr "il n’y a pas de jeton de rafraîchissement ~s" -#: src/scm/webid-oidc/errors.scm:1343 -#, scheme-format -msgid "~s does not authorize redirection URI ~a" -msgstr "~s n’autorise pas l’URI de redirection ~a" +#: src/scm/webid-oidc/client/accounts.scm:434 +msgid "The token response did not set the content type." +msgstr "" -#: src/scm/webid-oidc/errors.scm:1346 -msgid "I cannot serve a public manifest" -msgstr "je ne peux pas servir un manifeste public" +#: src/scm/webid-oidc/client/accounts.scm:442 +msgid "The token endpoint did not respond in UTF-8." +msgstr "" -#: src/scm/webid-oidc/errors.scm:1348 +#: src/scm/webid-oidc/client/accounts.scm:454 #, scheme-format -msgid "~a does not have a client manifest registration triple" -msgstr "~a n’a pas de triplet d’enregistrement de manifeste client" +msgid "The token response has content-type ~s, not application/json." +msgstr "" -#: src/scm/webid-oidc/errors.scm:1351 -#, scheme-format -msgid "the client manifest at ~a is advertised for ~a" -msgstr "le manifeste client ~a est publié pour ~a" +#: src/scm/webid-oidc/client/accounts.scm:464 +msgid "The token response is not valid JSON." +msgstr "" -#: src/scm/webid-oidc/errors.scm:1354 +#: src/scm/webid-oidc/client/accounts.scm:477 #, scheme-format -msgid "I could not fetch the client manifest of ~a (because ~a)" -msgstr "je n’ai pas pu récupérer le manifeste client de ~a (parce que ~a)" +msgid "The token response did not include an ID token: ~s" +msgstr "" -#: src/scm/webid-oidc/errors.scm:1357 +#: src/scm/webid-oidc/client/accounts.scm:485 #, scheme-format -msgid "~s is not an authorization code (because ~a)" -msgstr "~s n’est pas un code d’autorisation (parce que ~a)" +msgid "The token response did not include an access token: ~s\n" +msgstr "" -#: src/scm/webid-oidc/errors.scm:1360 +#: src/scm/webid-oidc/client/accounts.scm:496 #, scheme-format -msgid "~s is not an authorization code header (because ~a)" -msgstr "~s n’est pas un en-tête de code d’autorisation (parce que ~a)" +msgid "the ID token signature is invalid: ~a" +msgstr "" -#: src/scm/webid-oidc/errors.scm:1363 -#, scheme-format -msgid "~s is not an authorization code payload (because ~a)" -msgstr "~s n’est pas un contenu de code d’autorisation (parce que ~a)" +#: src/scm/webid-oidc/client/accounts.scm:498 +msgid "the ID token signature is invalid" +msgstr "" -#: src/scm/webid-oidc/errors.scm:1366 -#, scheme-format -msgid "the current time is ~a, and the authorization code expired at ~a" +#: src/scm/webid-oidc/client/accounts.scm:513 +#, fuzzy, scheme-format +#| msgid "There are different possible identity providers for your webid:\n" +msgid "the ID token delivered by the identity provider for ~s has ~s as webid" msgstr "" -"la date est actuellement ~a, et le code d’autorisation a expiré à la date ~a" +"Il y a différents fournisseurs d’identité possibles pour votre\n" +"webid :\n" -#: src/scm/webid-oidc/errors.scm:1370 -#, scheme-format -msgid "I cannot decode ~s as an authorization code (because ~a)" -msgstr "je n’ai pas pu décoder ~s comme un code d’autorisation (parce que ~a)" +#: src/scm/webid-oidc/client/accounts.scm:522 +#, fuzzy, scheme-format +#| msgid "There are different possible identity providers for your webid:\n" +msgid "The ID token delivered by the identity provider ~s is for issuer ~s." +msgstr "" +"Il y a différents fournisseurs d’identité possibles pour votre\n" +"webid :\n" -#: src/scm/webid-oidc/errors.scm:1373 -#, scheme-format -msgid "I cannot encode ~s as an authorization code (because ~a)" -msgstr "je n’ai pas pu encoder ~s comme un code d’autorisation (parce que ~a)" +#: src/scm/webid-oidc/client-manifest.scm:111 +#, fuzzy, scheme-format +#| msgid "this is not a client manifest:" +msgid "this is not a client manifest: ~a" +msgstr "ceci n’est pas un manifeste client :" -#: src/scm/webid-oidc/errors.scm:1376 -#, scheme-format -msgid "there is no such refresh token as ~s" -msgstr "il n’y a pas de jeton de rafraîchissement ~s" +#: src/scm/webid-oidc/client-manifest.scm:113 +#, fuzzy +#| msgid "this is not a client manifest:" +msgid "this is not a client manifest" +msgstr "ceci n’est pas un manifeste client :" -#: src/scm/webid-oidc/errors.scm:1379 -#, scheme-format +#: src/scm/webid-oidc/client-manifest.scm:117 msgid "" -"the refresh token is bound to a key confirmed as ~s, but it is used with key " -"~s" +"<p>The client manifest could\n" +"not be queried. It can be because the client application is down, or\n" +"it is incomplete, or unusable for other reasons.</p>" msgstr "" -"Le jeton de rafraîchissement est lié à une clé confirmée par ~s, mais il est " -"utilisé avec la clé ~s" - -#: src/scm/webid-oidc/errors.scm:1382 -#, scheme-format -msgid "I cannot decode ~s as an ID token (because ~a)" -msgstr "je n’ai pas pu décoder ~s comme jeton d’identité (parce que ~a)" -#: src/scm/webid-oidc/errors.scm:1385 -#, scheme-format -msgid "I cannot encode ~s as an ID token (because ~a)" -msgstr "je n’ai pas pu encoder ~s comme un jeton d’identité (parce que ~a)" +#: src/scm/webid-oidc/client-manifest.scm:144 +#, fuzzy, scheme-format +#| msgid "the client-id field is missing" +msgid "the client manifest is missing ~s" +msgstr "le champ client-id est manquant" -#: src/scm/webid-oidc/errors.scm:1388 +#: src/scm/webid-oidc/client-manifest.scm:155 #, scheme-format -msgid "the grant type ~s is not supported" -msgstr "le type d’octroi ~s n’est pas supporté " - -#: src/scm/webid-oidc/errors.scm:1391 -msgid "there is no authorization code in the request" -msgstr "il n’y a pas de code d’autorisation dans la requête" +msgid "~s is an invalid \"client_id\" value, because it is not an URI" +msgstr "" -#: src/scm/webid-oidc/errors.scm:1393 -msgid "there is no refresh token in the request" -msgstr "il n’y a pas de jeton de rafraîchissement dans la requête" +#: src/scm/webid-oidc/client-manifest.scm:160 +msgid "at least one of the redirect URIs is not a proper URI" +msgstr "" -#: src/scm/webid-oidc/errors.scm:1395 -#, scheme-format -msgid "~s is not an ID token (because ~a)" -msgstr "~s n’est pas un jeton d’identité (parce que ~a)" +#: src/scm/webid-oidc/client-manifest.scm:162 +#, fuzzy +#| msgid "the redirect_uris field is incorrect: ~s" +msgid "the \"redirect_uris\" field should be a vector of URIs" +msgstr "le champ redirect_uris est incorrect : ~s" -#: src/scm/webid-oidc/errors.scm:1398 -#, scheme-format -msgid "~s is not an ID token header (because ~a)" -msgstr "~s n’est pas un en-tête de jeton d’identité (parce que ~a)" +#: src/scm/webid-oidc/client-manifest.scm:167 +#, fuzzy +#| msgid "The client URI should be an URI.\n" +msgid "the client manifest should be a JSON object" +msgstr "L’URI du client doit être un URI.\n" -#: src/scm/webid-oidc/errors.scm:1401 -#, scheme-format -msgid "~s is not an ID token payload (because ~a)" -msgstr "~s n’est pas un contenu de jeton d’identité (parce que ~a)" +#: src/scm/webid-oidc/client-manifest.scm:189 +#, fuzzy, scheme-format +#| msgid "the manifest does not authorize redirection URI ~a:" +msgid "the client manifest does not allow ~s as a redirection uri" +msgstr "le manifeste n’autorise pas l’URI de redirection ~a :" -#: src/scm/webid-oidc/errors.scm:1404 +#: src/scm/webid-oidc/client-manifest.scm:193 #, scheme-format msgid "" -"I couldn’t set the locale to ~s as an approximation of the client locale ~s" +"<p>The application wants to get your\n" +"authorization through <strong>~s</strong>, which is not\n" +"approved.</p>" msgstr "" -"je n’ai pas pu définir la locale à ~s comme approximation de la locale du " -"client ~s" -#: src/scm/webid-oidc/errors.scm:1407 -#, scheme-format -msgid "~s does not admit ~s as an identity provider" -msgstr "~s n’admet pas ~s comme fournisseur d’identité" +#: src/scm/webid-oidc/client-manifest.scm:221 +#, fuzzy +#| msgid "I cannot serve a public manifest" +msgid "cannot serve the public manifest" +msgstr "je ne peux pas servir un manifeste public" -#: src/scm/webid-oidc/errors.scm:1410 -#, scheme-format -msgid "" -"~a is neither an identity provider (because ~a) nor a webid (because ~a)" -msgstr "" -"~a n’est ni un fournisseur d’identité (parce que ~a) ni un webid (parce que " -"~a)" +#: src/scm/webid-oidc/client-manifest.scm:242 +#, fuzzy, scheme-format +#| msgid "I could not fetch the client manifest of ~a;" +msgid "cannot fetch the client manifest ~s: ~a" +msgstr "je n’ai pas pu récupérer le manifeste client de ~a ;" -#: src/scm/webid-oidc/errors.scm:1415 -#, scheme-format -msgid "you don’t have a refresh token for identity ~a certified by ~a in ~s" -msgstr "" -"vous n’avez pas de jeton de rafraîchissement pour l’identité ~a certifié par " -"~a dans ~s" +#: src/scm/webid-oidc/client-manifest.scm:245 +#, fuzzy, scheme-format +#| msgid "I could not fetch the client manifest of ~a;" +msgid "cannot fetch the client manifest ~s" +msgstr "je n’ai pas pu récupérer le manifeste client de ~a ;" -#: src/scm/webid-oidc/errors.scm:1420 +#: src/scm/webid-oidc/client-manifest.scm:264 #, scheme-format -msgid "all identity provider candidates for ~a failed: ~a" -msgstr "tous les candidats de fournisseurs d’identité pour ~a ont échoué : ~a" +msgid "the client manifest is dereferenced from ~s, but it pretends to be ~s" +msgstr "" -#: src/scm/webid-oidc/errors.scm:1424 -#, scheme-format -msgid "~s failed (because ~a)" -msgstr "~s a échoué (parce que ~a)" +#: src/scm/webid-oidc/dpop-proof.scm:91 +#, fuzzy, scheme-format +#| msgid "~s is not a DPoP proof (because ~a)" +msgid "this is not a DPoP proof, because it is not even a JWS: ~a" +msgstr "~s n’est pas une preuve DPoP (parce que ~a)" -#: src/scm/webid-oidc/errors.scm:1427 -msgid ", " -msgstr ", " +#: src/scm/webid-oidc/dpop-proof.scm:93 +#, fuzzy +#| msgid "~s is not a DPoP proof (because ~a)" +msgid "this is not a DPoP proof, because it is not even a JWS" +msgstr "~s n’est pas une preuve DPoP (parce que ~a)" -#: src/scm/webid-oidc/errors.scm:1429 -#, scheme-format -msgid "no resource has been found to serve URI path ~s" -msgstr "aucune ressource n’a été trouvée pour servir le chemin d’URI ~s" +#: src/scm/webid-oidc/dpop-proof.scm:124 +#, fuzzy, scheme-format +#| msgid "the nonce field is missing" +msgid "the DPoP proof is missing ~s" +msgstr "le champ nonce est manquant" -#: src/scm/webid-oidc/errors.scm:1432 -#, scheme-format -msgid "the resource kind ~s is absent for the resource at ~s" -msgstr "le type de ressource ~s est absent pour la ressource ~s" +#: src/scm/webid-oidc/dpop-proof.scm:147 +#, fuzzy, scheme-format +#| msgid "the jti field is incorrect: ~s" +msgid "the \"jti\" field should be a string, not ~s" +msgstr "le champ jti est incorrect : ~s" -#: src/scm/webid-oidc/errors.scm:1435 -#, scheme-format -msgid "no resource has been found to serve URI path ~s, but ~s exists" -msgstr "" -"aucune ressource n’a été trouvée pour servir le chemin d’URI ~s, mais ~s " -"existe" +#: src/scm/webid-oidc/dpop-proof.scm:154 +#, fuzzy, scheme-format +#| msgid "the htm field is incorrect: ~s" +msgid "the \"htm\" field should be a string, not ~s" +msgstr "le champ htm est incorrect : ~s" -#: src/scm/webid-oidc/errors.scm:1438 -msgid "the root storage cannot be deleted" -msgstr "le stockage racine ne peut pas être détruit" +#: src/scm/webid-oidc/dpop-proof.scm:161 +#, fuzzy, scheme-format +#| msgid "the htu field is incorrect: ~s" +msgid "the \"htu\" field should be an URI, not ~s" +msgstr "le champ htu est incorrect : ~s" -#: src/scm/webid-oidc/errors.scm:1440 -#, scheme-format -msgid "the container ~s should be emptied before being deleted" -msgstr "le conteneur ~s doit être vidé avant d’être détruit" +#: src/scm/webid-oidc/dpop-proof.scm:168 +#, fuzzy, scheme-format +#| msgid "the iat field is incorrect: ~s" +msgid "the \"iat\" field should be a timestamp, not ~s" +msgstr "le champ iat est incorrect : ~s" -#: src/scm/webid-oidc/errors.scm:1443 -#, scheme-format -msgid "the group ~s cannot be fetched (because ~a)" -msgstr "le groupe ~s n’a pas pu être récupéré (parce que ~a)" +#: src/scm/webid-oidc/dpop-proof.scm:175 +#, fuzzy, scheme-format +#| msgid "the ath field is incorrect: ~s" +msgid "the \"ath\" field should be an encoded JWT, not ~s" +msgstr "le champ ath est incorrect : ~s" -#: src/scm/webid-oidc/errors.scm:1447 +#: src/scm/webid-oidc/dpop-proof.scm:184 #, scheme-format -msgid "the containment triples in the request to update ~s are not up to date" +msgid "the \"alg\" field should be a string, not ~s" msgstr "" -"les triplets de contention dans la requête pour changer ~s ne sont pas à jour" -#: src/scm/webid-oidc/errors.scm:1450 +#: src/scm/webid-oidc/dpop-proof.scm:189 #, scheme-format -msgid "the server cannot process resources with the ~s content-type" +msgid "the \"typ\" field should be \"dpop+jwt\", not ~s" msgstr "" -"le serveur ne peut pas traiter des ressources avec le type de contenu ~s" -#: src/scm/webid-oidc/errors.scm:1453 +#: src/scm/webid-oidc/dpop-proof.scm:195 #, scheme-format -msgid "" -"the client wants to create a resource at ~s, which is reserved for an " -"auxiliary resource" +msgid "the \"jwk\" field should be a valid public key, not ~s" msgstr "" -"le client veut créer une ressource en tant que ~s, qui est réservé pour une " -"ressource auxiliare" -#: src/scm/webid-oidc/errors.scm:1456 -#, scheme-format -msgid "" -"the operation on ~s by ~a is refused, because it’s not by ~s and the access " -"control forbids the following mode of operation: ~s" -msgstr "" -"l’opération sur ~s par ~a est refusée, parce que ce n’est pas ~s et le " -"contrôle d’accès refuse le mode d’opération suivant : ~s" +#: src/scm/webid-oidc/dpop-proof.scm:274 +#, fuzzy, scheme-format +#| msgid "the HTTP method is signed for ~s, but ~s was requested" +msgid "the DPoP proof is signed for ~s, but it is issued to ~s" +msgstr "la méthode HTTP a été signée pour ~s, mais ~s a été demandé" -#: src/scm/webid-oidc/errors.scm:1460 -msgid "an anonymous user" -msgstr "un utilisateur anonyme" +#: src/scm/webid-oidc/dpop-proof.scm:305 +#, fuzzy, scheme-format +#| msgid "the root storage cannot be deleted" +msgid "the DPoP proof cannot be decoded: ~a" +msgstr "le stockage racine ne peut pas être détruit" -#: src/scm/webid-oidc/errors.scm:1465 -#, scheme-format -msgid "" -"the client precondition failed for ~s: it allows for ~s, forbids ~s, but the " -"resource has a representation of ~s" -msgstr "" -"la précondition du client a échoué pour ~s : elle autorise ~s, interdit ~s, " -"mais la ressource a une représentation ~s" +#: src/scm/webid-oidc/dpop-proof.scm:307 +#, fuzzy +#| msgid "the root storage cannot be deleted" +msgid "the DPoP proof cannot be decoded" +msgstr "le stockage racine ne peut pas être détruit" -#: src/scm/webid-oidc/errors.scm:1467 -#, scheme-format -msgid "" -"the client precondition failed for ~s: it allows for ~s, forbids ~s, but the " -"resource has no representation" -msgstr "" -"la précondition du client a échoué pour ~s : elle autorise ~s, interdit ~s, " -"mais la ressource n’a pas de représentation" +#: src/scm/webid-oidc/dpop-proof.scm:317 +#, fuzzy, scheme-format +#| msgid "the DPoP proof is bound to an access token with hash ~s, not ~s" +msgid "the DPoP proof is signed for access through ~s, but it is used with ~s" +msgstr "la preuve DPoP est liée à un jeton d’accès haché en ~s, pas ~s" -#: src/scm/webid-oidc/errors.scm:1470 -#, scheme-format +#: src/scm/webid-oidc/dpop-proof.scm:331 +#, fuzzy, scheme-format +#| msgid "the date is ~a, but the DPoP proof is signed in the future at ~a" msgid "" -"the client wanted a response with a content type among ~s, but the resource " -"at ~s has content-type ~s which cannot be converted to one of them" -msgstr "" -"le client voulait une réponse avec un type de contenu parmi ~s, mais la " -"ressource ~s a un type de contenu ~s qui ne peut pas être converti vers l’un " -"d’eux" +"the DPoP proof is signed in the future, ~a, relative to the current date, ~a" +msgstr "la date est ~a, mais la preuve DPoP a été signée dans le futur à ~a" -#: src/scm/webid-oidc/errors.scm:1477 -msgid "that’s it" -msgstr "c’est tout" +#: src/scm/webid-oidc/dpop-proof.scm:340 +#, fuzzy, scheme-format +#| msgid "the DPoP proof is bound to an access token with hash ~s, not ~s" +msgid "the DPoP proof is too old, it was signed ~a and now it is ~a" +msgstr "la preuve DPoP est liée à un jeton d’accès haché en ~s, pas ~s" -#: src/scm/webid-oidc/errors.scm:1481 -#, scheme-format -msgid "~a and ~a" -msgstr "~a et ~a" +#: src/scm/webid-oidc/dpop-proof.scm:352 +#, fuzzy, scheme-format +#| msgid "the DPoP proof is bound to an access token with hash ~s, not ~s" +msgid "" +"the DPoP proof should go along with an access token hashed to ~s, not ~s" +msgstr "la preuve DPoP est liée à un jeton d’accès haché en ~s, pas ~s" -#: src/scm/webid-oidc/errors.scm:1484 -#, scheme-format -msgid "~a, ~a" -msgstr "~a, ~a" +#: src/scm/webid-oidc/dpop-proof.scm:361 src/scm/webid-oidc/dpop-proof.scm:372 +#, fuzzy +#| msgid "the date is ~a, but the DPoP proof is signed in the future at ~a" +msgid "the DPoP proof is signed with the wrong key" +msgstr "la date est ~a, mais la preuve DPoP a été signée dans le futur à ~a" -#: src/scm/webid-oidc/errors.scm:1488 -#, scheme-format -msgid "the signature ~a does not match key ~s with payload ~a" -msgstr "la signature ~a ne correspond pas à la clé ~s avec le contenu ~a" +#: src/scm/webid-oidc/dpop-proof.scm:370 +#, fuzzy, scheme-format +#| msgid "the date is ~a, but the DPoP proof is signed in the future at ~a" +msgid "the DPoP proof is signed with the wrong key: ~a" +msgstr "la date est ~a, mais la preuve DPoP a été signée dans le futur à ~a" -#: src/scm/webid-oidc/errors.scm:1491 -#, scheme-format -msgid "the request failed unexpectedly with code ~a: ~s" +#: src/scm/webid-oidc/dpop-proof.scm:381 +msgid "the cnf/check function returned #f" msgstr "" -"la requête au serveur a échoué de façon inattendue avec un code ~a : ~s" - -#: src/scm/webid-oidc/errors.scm:1495 -msgid "there is an undefined variable" -msgstr "il y a une variable non définie" - -#: src/scm/webid-oidc/errors.scm:1497 -#, scheme-format -msgid "the origin is ~a" -msgstr "l’origine est ~a" - -#: src/scm/webid-oidc/errors.scm:1500 -#, scheme-format -msgid "a message is attached: ~a" -msgstr "un message est attaché : ~a" - -#: src/scm/webid-oidc/errors.scm:1503 -#, scheme-format -msgid "the values ~s are problematic" -msgstr "les valeurs ~s sont problématiques" - -#: src/scm/webid-oidc/errors.scm:1506 -#, scheme-format -msgid "there is a kind (~s) and args ~s" -msgstr "il y a un type (~s) et des arguments ~s" -#: src/scm/webid-oidc/errors.scm:1509 -msgid "there is an assertion failure" -msgstr "il y a un échec d’assertion" - -#: src/scm/webid-oidc/errors.scm:1511 -#, scheme-format -msgid "the program quits with code ~a" -msgstr "le programme quitte avec le code ~a" - -#: src/scm/webid-oidc/errors.scm:1514 -msgid "the program cannot recover from this exception" -msgstr "le programme ne peut pas récupérer après cette exception" +#: src/scm/webid-oidc/dpop-proof.scm:392 +#, fuzzy, scheme-format +#| msgid "I cannot encode ~s as a DPoP proof (because ~a)" +msgid "cannot encode a DPoP proof: ~a" +msgstr "je n’ai pas pu encoder ~s comme une preuve DPoP (parce que ~a)" -#: src/scm/webid-oidc/errors.scm:1516 -msgid "there is an external error" -msgstr "il y a une erreur externe" +#: src/scm/webid-oidc/dpop-proof.scm:394 +#, fuzzy +#| msgid "I cannot encode ~s as a DPoP proof (because ~a)" +msgid "cannot encode a DPoP proof" +msgstr "je n’ai pas pu encoder ~s comme une preuve DPoP (parce que ~a)" -#: src/scm/webid-oidc/errors.scm:1518 -msgid "there is an error" -msgstr "il y a une erreur" +#: src/scm/webid-oidc/example-app.scm:56 +msgid "Main menu:\n" +msgstr "Menu principal :\n" -#: src/scm/webid-oidc/errors.scm:1520 +#: src/scm/webid-oidc/example-app.scm:59 #, scheme-format -msgid "there is an unknown exception of kind ~s" -msgstr "il y a eu une exception de type inconnu ~s" - -#: src/scm/webid-oidc/identity-provider.scm:68 -msgid "Warning: generating a new key pair." -msgstr "Attention : génération d'une nouvelle paire de clé." - -#: src/scm/webid-oidc/authorization-page-unsafe.scm:45 -msgid "xml-lang|en" -msgstr "fr" - -#: src/scm/webid-oidc/authorization-page-unsafe.scm:61 -msgid "page-title|Authorization" -msgstr "Autorisation" - -#: src/scm/webid-oidc/authorization-page-unsafe.scm:66 -msgid "Authorize this anonymous application?" -msgstr "Autoriser cette application anonyme ?" - -#: src/scm/webid-oidc/authorization-page-unsafe.scm:67 -#, scheme-format -msgid "Authorize <a href=~s>~a</a>?" -msgstr "Autoriser <a href=~s>~a</a> ?" - -#: src/scm/webid-oidc/authorization-page-unsafe.scm:69 -msgid "Do you want to authorize this application to represent you?" -msgstr "Voulez-vous autoriser cette application à vous représenter ?" - -#: src/scm/webid-oidc/authorization-page-unsafe.scm:79 -msgid "Please retry your password:" -msgstr "Veuillez réessayer votre mot de passe :" - -#: src/scm/webid-oidc/authorization-page-unsafe.scm:80 -msgid "Please enter your password:" -msgstr "Veuillez entrer votre mot de passe :" - -#: src/scm/webid-oidc/authorization-page-unsafe.scm:85 -msgid "Allow" -msgstr "Autoriser" - -#: src/scm/webid-oidc/authorization-page-unsafe.scm:91 -msgid "Bad request" -msgstr "Requête invalide" +msgid "~a. Log in with ~a (issued by ~a): ~a\n" +msgstr "~a. Se connecter avec ~a (émis par ~a) : ~a\n" -#: src/scm/webid-oidc/authorization-page-unsafe.scm:96 -msgid "The application did not set the <emph>client_id</emph> parameter." -msgstr "L'application n'a pas spécifié le paramètre <emph>client_id</emph>." +#: src/scm/webid-oidc/example-app.scm:64 +msgid "a new user" +msgstr "un nouvel utilisateur" -#: src/scm/webid-oidc/authorization-page-unsafe.scm:101 -msgid "The application did not set the <emph>redirect_uri</emph> parameter." -msgstr "L'application n'a pas spécifié le paramètre <emph>redirect_uri</emph>." +#: src/scm/webid-oidc/example-app.scm:68 +msgid "status|currently logged in" +msgstr "actuellement connecté" -#: src/scm/webid-oidc/authorization-page-unsafe.scm:114 -#, scheme-format -msgid "the value ~s is not a base64 string." -msgstr "la valeur ~s n’est pas une chaîne base64." +#: src/scm/webid-oidc/example-app.scm:70 +msgid "status|offline (but accessible)" +msgstr "hors ligne (mais accessible)" -#: src/scm/webid-oidc/authorization-page-unsafe.scm:117 -msgid "the following value is not JSON:" -msgstr "la valeur suivante n’est pas du JSON :" +#: src/scm/webid-oidc/example-app.scm:71 +msgid "status|offline (inaccessible)" +msgstr "hors ligne (inaccessible)" -#: src/scm/webid-oidc/authorization-page-unsafe.scm:120 -msgid "the following value is not Turtle:" -msgstr "la valeur suivante n’est pas du Turtle :" +#: src/scm/webid-oidc/example-app.scm:72 +msgid "status|not initialized yet" +msgstr "pas encore initialisé" -#: src/scm/webid-oidc/authorization-page-unsafe.scm:123 -#, scheme-format +#: src/scm/webid-oidc/example-app.scm:74 msgid "" -"the server request unexpectedly failed with code ~a and reason phrase ~s." +"Type a number to log in, prefix it with '-' to delete the account, or type + " +"to create a new account.\n" msgstr "" -"la requête au serveur a échoué de façon inattendue avec un code ~a et une " -"raison ~s." - -#: src/scm/webid-oidc/authorization-page-unsafe.scm:128 -#, scheme-format -msgid "the header ~a should not have the value ~s.\n" -msgstr "l’en-tête ~a ne devrait pas avoir la valeur ~s.\n" +"Entrez un nombre pour vous connecter, préfixez-le avec « - » pour supprimer " +"le compte, ou tapez + pour créer un nouveau compte.\n" -#: src/scm/webid-oidc/authorization-page-unsafe.scm:130 +#: src/scm/webid-oidc/example-app.scm:91 #, scheme-format -msgid "the header ~a should be present." -msgstr "l’en-tête ~a devrait être présent." +msgid "Please visit: ~a\n" +msgstr "Veuillez visiter : ~a\n" -#: src/scm/webid-oidc/authorization-page-unsafe.scm:134 -msgid "the server response wasn’t expected:" -msgstr "la réponse du serveur est inattendue :" +#: src/scm/webid-oidc/example-app.scm:92 +msgid "Then, paste the authorization code you get:\n" +msgstr "Ensuite, veuillez coller votre code d’autorisation :\n" -#: src/scm/webid-oidc/authorization-page-unsafe.scm:143 +#: src/scm/webid-oidc/example-app.scm:98 #, scheme-format -msgid "the client_id field is incorrect: ~s" -msgstr "le champ client_id est incorrect : ~s" - -#: src/scm/webid-oidc/authorization-page-unsafe.scm:144 -msgid "the client_id field is missing" -msgstr "le champ client_id est manquant" +msgid "I could not negociate an access token. ~a" +msgstr "Je n’ai pas pu négocier de jeton d’accès. ~a" -#: src/scm/webid-oidc/authorization-page-unsafe.scm:153 -#, scheme-format -msgid "I could not fetch a RDF graph at ~a;" -msgstr "je n’ai pas pu récupérer de graphe RDF à ~a;" +#: src/scm/webid-oidc/example-app.scm:102 +msgid "" +"The refresh token has expired, it is not possible to use that account " +"offline.\n" +msgstr "" +"Le jeton de rafraîchissement a expiré, il n’est pas possible d’utiliser ce " +"compte hors ligne.\n" -#: src/scm/webid-oidc/authorization-page-unsafe.scm:157 -msgid "this is not a client manifest:" -msgstr "ceci n’est pas un manifeste client :" +#: src/scm/webid-oidc/example-app.scm:107 +msgid "Please enter an URI to GET:\n" +msgstr "Veuillez entrer un URI à requêter avec GET :\n" -#: src/scm/webid-oidc/authorization-page-unsafe.scm:162 -#, scheme-format -msgid "the manifest does not authorize redirection URI ~a:" -msgstr "le manifeste n’autorise pas l’URI de redirection ~a :" +#: src/scm/webid-oidc/fetch.scm:58 +#, fuzzy, scheme-format +#| msgid "I cannot decode ~s as an ID token (because ~a)" +msgid "cannot fetch ~s as linked data: ~a" +msgstr "je n’ai pas pu décoder ~s comme jeton d’identité (parce que ~a)" -#: src/scm/webid-oidc/authorization-page-unsafe.scm:167 +#: src/scm/webid-oidc/fetch.scm:60 #, scheme-format -msgid "the client manifest at ~a is advertised for ~a;" -msgstr "le manifeste client ~a est publié pour ~a ;" +msgid "cannot fetch ~s as linked data" +msgstr "" -#: src/scm/webid-oidc/authorization-page-unsafe.scm:172 +#: src/scm/webid-oidc/fetch.scm:74 #, scheme-format -msgid "I could not fetch the client manifest of ~a;" -msgstr "je n’ai pas pu récupérer le manifeste client de ~a ;" - -#: src/scm/webid-oidc/authorization-page-unsafe.scm:177 -msgid "I could not issue an authorization code for you;" -msgstr "je n’ai pas pu émettre un code d’autorisation pour vous ;" - -#: src/scm/webid-oidc/authorization-page-unsafe.scm:185 -msgid "" -"The application you are trying to authorize behaved unexpectedly. Here is " -"the explanation of the error:" +msgid "unexpected response from the server: ~a" msgstr "" -"L’application que vous essayez d’autoriser se comporte de façon inattendue. " -"Ci-après une explication de l’erreur :" -#: src/scm/webid-oidc/authorization-page-unsafe.scm:194 -msgid "Redirecting..." -msgstr "Redirection..." - -#: src/scm/webid-oidc/authorization-page-unsafe.scm:199 -#, scheme-format -msgid "" -"<a href=~s>~a</a> can now log in on your behalf. You still need to adjust " -"permissions." +#: src/scm/webid-oidc/fetch.scm:76 +msgid "unexpected response from the server" msgstr "" -"<a href=~s>~a</a> peut maintenant s'identifier en votre nom. Vous devez " -"toujours ajuster ses permissions." -#: src/scm/webid-oidc/resource-server.scm:86 -#, scheme-format -msgid "~a: authentication failure: ~a\n" -msgstr "~a : échec d’authentificationn : ~a\n" +#: src/scm/webid-oidc/fetch.scm:83 +#, fuzzy, scheme-format +#| msgid "the request failed unexpectedly with code ~a: ~s" +msgid "the request failed unexpectedly with ~s ~s" +msgstr "" +"la requête au serveur a échoué de façon inattendue avec un code ~a : ~s" -#: src/scm/webid-oidc/resource-server.scm:279 +#: src/scm/webid-oidc/fetch.scm:111 #, scheme-format -msgid "Warning: ~a\n" -msgstr "Avertissement : ~a\n" +msgid "cannot negociate a recognized RFD content type, got ~s" +msgstr "" -#: src/scm/webid-oidc/hello-world.scm:47 src/scm/webid-oidc/program.scm:233 +#: src/scm/webid-oidc/hello-world.scm:61 src/scm/webid-oidc/program.scm:225 msgid "command-line|version" msgstr "version" -#: src/scm/webid-oidc/hello-world.scm:49 src/scm/webid-oidc/program.scm:237 +#: src/scm/webid-oidc/hello-world.scm:63 src/scm/webid-oidc/program.scm:229 msgid "command-line|complete-corresponding-source" msgstr "code-source-correspondant-complet" -#: src/scm/webid-oidc/hello-world.scm:51 src/scm/webid-oidc/program.scm:239 +#: src/scm/webid-oidc/hello-world.scm:65 src/scm/webid-oidc/program.scm:231 msgid "command-line|help" msgstr "aide" -#: src/scm/webid-oidc/hello-world.scm:53 +#: src/scm/webid-oidc/hello-world.scm:67 msgid "command-line|port" msgstr "port" -#: src/scm/webid-oidc/hello-world.scm:55 src/scm/webid-oidc/program.scm:271 +#: src/scm/webid-oidc/hello-world.scm:69 src/scm/webid-oidc/program.scm:263 msgid "command-line|log-file" msgstr "fichier-journal" -#: src/scm/webid-oidc/hello-world.scm:57 src/scm/webid-oidc/program.scm:273 +#: src/scm/webid-oidc/hello-world.scm:71 src/scm/webid-oidc/program.scm:265 msgid "command-line|error-file" msgstr "fichier-erreur" -#: src/scm/webid-oidc/hello-world.scm:69 +#: src/scm/webid-oidc/hello-world.scm:83 #, scheme-format msgid "" "~a [OPTIONS]...\n" @@ -1084,189 +893,485 @@ msgstr "" " -e FICHIER.err, --~a=FICHIER.err :\n" " redirige la sortie d’erreur du programme vers ce fichier.\n" -#: src/scm/webid-oidc/hello-world.scm:102 +#: src/scm/webid-oidc/hello-world.scm:116 #, scheme-format msgid "~a version ~a\n" msgstr "~a version ~a\n" -#: src/scm/webid-oidc/hello-world.scm:111 src/scm/webid-oidc/program.scm:632 +#: src/scm/webid-oidc/hello-world.scm:125 src/scm/webid-oidc/program.scm:624 msgid "" "You are legally required to link to the complete corresponding source code.\n" msgstr "" "Vous êtes légalement tenu de fournir un lien vers le code source " "correspondant.\n" -#: src/scm/webid-oidc/hello-world.scm:121 +#: src/scm/webid-oidc/hello-world.scm:135 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/example-app.scm:63 -msgid "Main menu:\n" -msgstr "Menu principal :\n" +#: src/scm/webid-oidc/hello-world.scm:156 +#: src/scm/webid-oidc/resource-server.scm:320 +msgid "reason-phrase|Unauthorized" +msgstr "" -#: src/scm/webid-oidc/example-app.scm:66 +#: src/scm/webid-oidc/hello-world.scm:176 +#: src/scm/webid-oidc/resource-server.scm:328 +msgid "reason-phrase|Method Not Allowed" +msgstr "" + +#: src/scm/webid-oidc/identity-provider.scm:72 +msgid "Warning: generating a new key pair." +msgstr "Attention : génération d'une nouvelle paire de clé." + +#: src/scm/webid-oidc/identity-provider.scm:132 +msgid "reason-phrase|Not Found" +msgstr "" + +#: 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 +#, fuzzy +#| msgid "xml-lang|en" +msgid "xml-langlen" +msgstr "fr" + +#: src/scm/webid-oidc/jti.scm:59 #, scheme-format -msgid "~a. Log in with ~a (issued by ~a): ~a\n" -msgstr "~a. Se connecter avec ~a (émis par ~a) : ~a\n" +msgid "a replay has been detected with JTI ~s" +msgstr "" -#: src/scm/webid-oidc/example-app.scm:71 -msgid "a new user" -msgstr "un nouvel utilisateur" +#: src/scm/webid-oidc/jwk.scm:76 +#, scheme-format +msgid "the JWK is invalid: ~a" +msgstr "" -#: src/scm/webid-oidc/example-app.scm:75 -msgid "status|currently logged in" -msgstr "actuellement connecté" +#: src/scm/webid-oidc/jwk.scm:78 +msgid "the JWK is invalid" +msgstr "" -#: src/scm/webid-oidc/example-app.scm:77 -msgid "status|offline (but accessible)" -msgstr "hors ligne (mais accessible)" +#: src/scm/webid-oidc/jwk.scm:87 +#, scheme-format +msgid "unknown key type ~s" +msgstr "" -#: src/scm/webid-oidc/example-app.scm:78 -msgid "status|offline (inaccessible)" -msgstr "hors ligne (inaccessible)" +#: src/scm/webid-oidc/jwk.scm:103 +#, scheme-format +msgid "the public JWK is invalid: ~a" +msgstr "" -#: src/scm/webid-oidc/example-app.scm:79 -msgid "status|not initialized yet" -msgstr "pas encore initialisé" +#: src/scm/webid-oidc/jwk.scm:105 +msgid "the public JWK is invalid" +msgstr "" -#: src/scm/webid-oidc/example-app.scm:81 -msgid "" -"Type a number to log in, prefix it with '-' to delete the account, or type + " -"to create a new account.\n" +#: src/scm/webid-oidc/jwk.scm:136 +#, scheme-format +msgid "cannot extract the public part of the key: ~a" msgstr "" -"Entrez un nombre pour vous connecter, préfixez-le avec « - » pour supprimer " -"le compte, ou tapez + pour créer un nouveau compte.\n" -#: src/scm/webid-oidc/example-app.scm:98 +#: src/scm/webid-oidc/jwk.scm:138 +msgid "cannot extract the public part of the key" +msgstr "" + +#: src/scm/webid-oidc/jwk.scm:188 +msgid "the JWKS is invalid, because it does not have keys" +msgstr "" + +#: src/scm/webid-oidc/jwk.scm:197 #, scheme-format -msgid "Please visit: ~a\n" -msgstr "Veuillez visiter : ~a\n" +msgid "the JWKS is invalid: ~a" +msgstr "" -#: src/scm/webid-oidc/example-app.scm:99 -msgid "Then, paste the authorization code you get:\n" -msgstr "Ensuite, veuillez coller votre code d’autorisation :\n" +#: src/scm/webid-oidc/jwk.scm:199 +msgid "the JWKS is invalid" +msgstr "" -#: src/scm/webid-oidc/example-app.scm:105 +#: src/scm/webid-oidc/jws.scm:72 #, scheme-format -msgid "I could not negociate an access token. ~a" -msgstr "Je n’ai pas pu négocier de jeton d’accès. ~a" +msgid "the JWS is invalid: ~a" +msgstr "" -#: src/scm/webid-oidc/example-app.scm:109 -msgid "" -"The refresh token has expired, it is not possible to use that account " -"offline.\n" +#: src/scm/webid-oidc/jws.scm:74 +msgid "the JWS is invalid" msgstr "" -"Le jeton de rafraîchissement a expiré, il n’est pas possible d’utiliser ce " -"compte hors ligne.\n" -#: src/scm/webid-oidc/example-app.scm:114 -msgid "Please enter an URI to GET:\n" -msgstr "Veuillez entrer un URI à requêter avec GET :\n" +#: src/scm/webid-oidc/jws.scm:93 +#, fuzzy +#| msgid "the header ~a should not have the value ~s" +msgid "the JWS header does not have an \"alg\" field" +msgstr "l’en-tête ~a ne devrait pas avoir la valeur ~s" -#: src/scm/webid-oidc/program.scm:125 +#: src/scm/webid-oidc/jws.scm:101 +msgid "invalid JSON object as payload" +msgstr "" + +#: src/scm/webid-oidc/jws.scm:110 #, scheme-format -msgid "~a: ~a: Internal server error: ~a\n" -msgstr "~a : ~a : Erreur interne du serveur : ~a\n" +msgid "invalid signature algorithm: ~s" +msgstr "" -#: src/scm/webid-oidc/program.scm:140 +#: src/scm/webid-oidc/jws.scm:114 +#, scheme-format +msgid "invalid \"alg\" value: ~s" +msgstr "" + +#: src/scm/webid-oidc/jws.scm:119 +msgid "invalid JSON object as header" +msgstr "" + +#: src/scm/webid-oidc/jws.scm:121 +#, fuzzy +#| msgid "this is not a client manifest:" +msgid "this is not a pair" +msgstr "ceci n’est pas un manifeste client :" + +#: src/scm/webid-oidc/jws.scm:138 +msgid "the encoded JWS is not in 3 parts" +msgstr "" + +#: src/scm/webid-oidc/jws.scm:149 #, scheme-format msgid "" -"The client locale ~s can’t be approximated by system locale ~s (because ~a), " -"using C.\n" +"the encoded JWS header or payload is not a JSON object encoded in base64: ~a" msgstr "" -"La locale du client ~s ne peut pas être approchée par la locale système ~s " -"(parce que ~a), on utilise C.\n" -#: src/scm/webid-oidc/program.scm:164 +#: src/scm/webid-oidc/jws.scm:151 +msgid "" +"the encoded JWS header or payload is not a JSON object encoded in base64" +msgstr "" + +#: src/scm/webid-oidc/jws.scm:210 +msgid "the JWS is not signed by any of the expected set of public keys" +msgstr "" + +#: src/scm/webid-oidc/jws.scm:221 +#, scheme-format +msgid "while verifying the JWS signature: ~a" +msgstr "" + +#: src/scm/webid-oidc/jws.scm:223 +msgid "an unexpected error happened while verifying a JWS" +msgstr "" + +#: src/scm/webid-oidc/jws.scm:240 +#, fuzzy, scheme-format +#| msgid "I cannot decode JWS ~a (because ~a)" +msgid "cannot decode a JWS: ~a" +msgstr "je n’ai pas pu décoder le JWS encodé par ~a (parce que ~a)" + +#: src/scm/webid-oidc/jws.scm:242 +#, fuzzy +#| msgid "I cannot decode JWS ~a (because ~a)" +msgid "cannot decode a JWS" +msgstr "je n’ai pas pu décoder le JWS encodé par ~a (parce que ~a)" + +#: src/scm/webid-oidc/jws.scm:262 +#, fuzzy, scheme-format +#| msgid "I cannot encode JWS ~a (because ~a)" +msgid "cannot encode a JWS: ~a" +msgstr "je n’ai pas pu encoder le JWS ~a (parce que ~a)" + +#: src/scm/webid-oidc/jws.scm:264 +#, fuzzy +#| msgid "I cannot encode JWS ~a (because ~a)" +msgid "cannot encode a JWS" +msgstr "je n’ai pas pu encoder le JWS ~a (parce que ~a)" + +#: src/scm/webid-oidc/oidc-configuration.scm:59 +#, fuzzy, scheme-format +#| msgid "the key confirmation of ~s failed" +msgid "the OIDC configuration is invalid: ~a" +msgstr "la confirmation de la clé ~s a échoué" + +#: src/scm/webid-oidc/oidc-configuration.scm:61 +#, fuzzy +#| msgid "the key confirmation of ~s failed" +msgid "the OIDC configuration is invalid" +msgstr "la confirmation de la clé ~s a échoué" + +#: src/scm/webid-oidc/oidc-configuration.scm:77 +#, fuzzy, scheme-format +#| msgid "the key confirmation of ~s failed" +msgid "the OIDC configuration does not have: ~s" +msgstr "la confirmation de la clé ~s a échoué" + +#: src/scm/webid-oidc/oidc-configuration.scm:92 +#, scheme-format +msgid "invalid JWKS URI: ~s" +msgstr "" + +#: src/scm/webid-oidc/oidc-configuration.scm:99 +#, scheme-format +msgid "invalid token endpoint: ~s" +msgstr "" + +#: src/scm/webid-oidc/oidc-configuration.scm:108 +#, scheme-format +msgid "invalid authorization endpoint: ~s" +msgstr "" + +#: src/scm/webid-oidc/oidc-configuration.scm:116 +#, scheme-format +msgid "\"solid_oidc_supported\" should be set to ~s, not ~s" +msgstr "" + +#: src/scm/webid-oidc/oidc-configuration.scm:124 +msgid "invalid JSON object" +msgstr "" + +#: src/scm/webid-oidc/oidc-configuration.scm:174 +#, fuzzy, scheme-format +#| msgid "I cannot fetch the issuer configuration of ~a (because ~a)" +msgid "cannot fetch the OIDC configuration: ~a" +msgstr "" +"je n’ai pas pu récupérer la configuration de l’émetteur ~a (parce que ~a)" + +#: src/scm/webid-oidc/oidc-configuration.scm:176 +#, fuzzy +#| msgid "I cannot fetch the issuer configuration of ~a (because ~a)" +msgid "cannot fetch the OIDC configuration" +msgstr "" +"je n’ai pas pu récupérer la configuration de l’émetteur ~a (parce que ~a)" + +#: src/scm/webid-oidc/oidc-configuration.scm:184 +#, fuzzy, scheme-format +#| msgid "the server response wasn’t expected:" +msgid "the server responded with ~s ~s" +msgstr "la réponse du serveur est inattendue :" + +#: src/scm/webid-oidc/oidc-configuration.scm:189 +#, fuzzy +#| msgid "there is an external error" +msgid "there is no content-type" +msgstr "il y a une erreur externe" + +#: src/scm/webid-oidc/oidc-configuration.scm:194 +#, scheme-format +msgid "unexpected content-type: ~s" +msgstr "" + +#: src/scm/webid-oidc/oidc-id-token.scm:67 +#, fuzzy, scheme-format +#| msgid "~s is not an ID token (because ~a)" +msgid "this is not an ID token, because it is not even a JWS: ~a" +msgstr "~s n’est pas un jeton d’identité (parce que ~a)" + +#: src/scm/webid-oidc/oidc-id-token.scm:70 +#, fuzzy +#| msgid "~s is not an ID token (because ~a)" +msgid "this is not an ID token, because it is not even a JWS" +msgstr "~s n’est pas un jeton d’identité (parce que ~a)" + +#: src/scm/webid-oidc/oidc-id-token.scm:72 +#, fuzzy, scheme-format +#| msgid "~s is not an ID token (because ~a)" +msgid "this is not an ID token: ~a" +msgstr "~s n’est pas un jeton d’identité (parce que ~a)" + +#: src/scm/webid-oidc/oidc-id-token.scm:75 +#, fuzzy +#| msgid "~s is not an ID token (because ~a)" +msgid "this is not an ID token" +msgstr "~s n’est pas un jeton d’identité (parce que ~a)" + +#: src/scm/webid-oidc/oidc-id-token.scm:131 +#, scheme-format +msgid "the \"sub\" field should be a string, ~s is given" +msgstr "" + +#: src/scm/webid-oidc/oidc-id-token.scm:138 +#, scheme-format +msgid "the \"aud\" field should be an URI, ~s is given" +msgstr "" + +#: src/scm/webid-oidc/oidc-id-token.scm:145 +#, fuzzy, scheme-format +#| msgid "the nonce field is missing" +msgid "the \"nonce\" field should be a string, ~s is given" +msgstr "le champ nonce est manquant" + +#: src/scm/webid-oidc/oidc-id-token.scm:165 +msgid "the payload should be a JSON object" +msgstr "" + +#: src/scm/webid-oidc/oidc-id-token.scm:218 +#, scheme-format +msgid "the ID token is invalid: ~a" +msgstr "" + +#: src/scm/webid-oidc/oidc-id-token.scm:220 +msgid "the ID token is invalid" +msgstr "" + +#: src/scm/webid-oidc/oidc-id-token.scm:258 +#, scheme-format +msgid "I cannot query the JWKS URI of the identity provider: ~a" +msgstr "" + +#: src/scm/webid-oidc/oidc-id-token.scm:260 +#, fuzzy +#| msgid "You must pass --~a to set the subject of the identity provider.\n" +msgid "I cannot query the JWKS URI of the identity provider" +msgstr "" +"Vous devez passer --~a pour définir le sujet du fournisseur d’identité.\n" + +#: src/scm/webid-oidc/oidc-id-token.scm:271 +#, scheme-format +msgid "the ID token is signed in the future, ~a, relative to current ~a" +msgstr "" + +#: src/scm/webid-oidc/oidc-id-token.scm:280 +#, scheme-format +msgid "the ID token expired ~a, which is in the past (from ~a)" +msgstr "" + +#: src/scm/webid-oidc/oidc-id-token.scm:294 +#, fuzzy, scheme-format +#| msgid "I cannot encode ~s as an ID token (because ~a)" +msgid "cannot encode the ID token: ~a" +msgstr "je n’ai pas pu encoder ~s comme un jeton d’identité (parce que ~a)" + +#: src/scm/webid-oidc/oidc-id-token.scm:296 +#, fuzzy +#| msgid "I cannot encode ~s as an ID token (because ~a)" +msgid "cannot encode the ID token" +msgstr "je n’ai pas pu encoder ~s comme un jeton d’identité (parce que ~a)" + +#: src/scm/webid-oidc/program.scm:56 +#, scheme-format +msgid "~a: Warning: XML_CATALOG_FILES is set to ~s.\n" +msgstr "" + +#: src/scm/webid-oidc/program.scm:59 +#, fuzzy, scheme-format +#| msgid "~a: ~s ~a ~s ~a\n" +msgid "~a: GET ~a ~s...\n" +msgstr "~a : ~s ~a ~s ~a\n" + +#: src/scm/webid-oidc/program.scm:66 +#, scheme-format +msgid "~a: Warning: loading XML catalog from the web, ~s.\n" +msgstr "" + +#: src/scm/webid-oidc/program.scm:74 +#, fuzzy, scheme-format +#| msgid "~a: ~s ~a ~s ~a\n" +msgid "~a: GET ~a ~s: ~s ~a bytes\n" +msgstr "~a : ~s ~a ~s ~a\n" + +#: src/scm/webid-oidc/program.scm:121 +#, fuzzy +#| msgid "~a: ~a: Internal server error: ~a\n" +msgid "really bad internal server error" +msgstr "~a : ~a : Erreur interne du serveur : ~a\n" + +#: src/scm/webid-oidc/program.scm:128 +#, scheme-format +msgid "~a: ~a: Internal server error: ~a\n" +msgstr "~a : ~a : Erreur interne du serveur : ~a\n" + +#: src/scm/webid-oidc/program.scm:134 +#, fuzzy +#| msgid "~a: ~a: Internal server error: ~a\n" +msgid "Internal Server Error" +msgstr "~a : ~a : Erreur interne du serveur : ~a\n" + +#: src/scm/webid-oidc/program.scm:137 +#, fuzzy +#| msgid "there is an error" +msgid "Sorry, there was an error." +msgstr "il y a une erreur" + +#: src/scm/webid-oidc/program.scm:158 #, scheme-format msgid "~a: ~s ~a ~s ~a\n" msgstr "~a : ~s ~a ~s ~a\n" -#: src/scm/webid-oidc/program.scm:166 +#: src/scm/webid-oidc/program.scm:160 #, scheme-format msgid "~a: ~a (~a)" msgstr "~a : ~a (~a)" -#: src/scm/webid-oidc/program.scm:170 +#: src/scm/webid-oidc/program.scm:164 #, scheme-format msgid "~a: ~a" msgstr "~a : ~a" -#: src/scm/webid-oidc/program.scm:180 +#: src/scm/webid-oidc/program.scm:174 #, scheme-format msgid "(there was an error: ~a)" msgstr "(il y a eu une erreur : ~a)" -#: src/scm/webid-oidc/program.scm:235 +#: src/scm/webid-oidc/program.scm:227 msgid "command-line|describe-project" msgstr "décrire-projet" -#: src/scm/webid-oidc/program.scm:241 +#: src/scm/webid-oidc/program.scm:233 msgid "command-line|server|port" msgstr "port" -#: src/scm/webid-oidc/program.scm:243 +#: src/scm/webid-oidc/program.scm:235 msgid "command-line|server|server-name" msgstr "nom-du-serveur" -#: src/scm/webid-oidc/program.scm:245 +#: src/scm/webid-oidc/program.scm:237 msgid "command-line|server|reverse-proxy|backend-uri" msgstr "uri-arrière-plan" -#: src/scm/webid-oidc/program.scm:247 +#: src/scm/webid-oidc/program.scm:239 msgid "command-line|server|reverse-proxy|header" msgstr "en-tête" -#: src/scm/webid-oidc/program.scm:249 +#: src/scm/webid-oidc/program.scm:241 msgid "command-line|server|issuer|key-file" msgstr "fichier-clé" -#: src/scm/webid-oidc/program.scm:251 +#: src/scm/webid-oidc/program.scm:243 msgid "command-line|server|issuer|subject" msgstr "sujet" -#: src/scm/webid-oidc/program.scm:253 +#: src/scm/webid-oidc/program.scm:245 msgid "command-line|server|issuer|encrypted-password" msgstr "mot-de-passe-chiffré" -#: src/scm/webid-oidc/program.scm:255 +#: src/scm/webid-oidc/program.scm:247 msgid "command-line|server|issuer|encrypted-password-from-file" msgstr "fichier-de-mot-de-passe-chiffré" -#: src/scm/webid-oidc/program.scm:257 +#: src/scm/webid-oidc/program.scm:249 msgid "command-line|server|issuer|jwks-uri" msgstr "uri-jwks" -#: src/scm/webid-oidc/program.scm:259 +#: src/scm/webid-oidc/program.scm:251 msgid "command-line|server|issuer|authorization-endpoint-uri" msgstr "uri-terminal-autorisation" -#: src/scm/webid-oidc/program.scm:261 +#: src/scm/webid-oidc/program.scm:253 msgid "command-line|server|issuer|token-endpoint-uri" msgstr "uri-terminal-jeton" -#: src/scm/webid-oidc/program.scm:263 +#: src/scm/webid-oidc/program.scm:255 msgid "command-line|server|client-id" msgstr "id-client" -#: src/scm/webid-oidc/program.scm:265 +#: src/scm/webid-oidc/program.scm:257 msgid "command-line|server|redirect-uri" msgstr "uri-redirection" -#: src/scm/webid-oidc/program.scm:267 +#: src/scm/webid-oidc/program.scm:259 msgid "command-line|server|client-name" msgstr "nom-client" -#: src/scm/webid-oidc/program.scm:269 +#: src/scm/webid-oidc/program.scm:261 msgid "command-line|server|client-uri" msgstr "uri-client" -#: src/scm/webid-oidc/program.scm:303 +#: src/scm/webid-oidc/program.scm:295 #, scheme-format msgid "Usage: ~a COMMAND [OPTIONS]...\n" msgstr "Utilisation : ~a COMMANDE [OPTIONS]...\n" -#: src/scm/webid-oidc/program.scm:307 +#: src/scm/webid-oidc/program.scm:299 msgid "" "\n" "Run the disfluid COMMAND." @@ -1274,7 +1379,7 @@ msgstr "" "\n" "Exécute la COMMANDE disfluid." -#: src/scm/webid-oidc/program.scm:310 +#: src/scm/webid-oidc/program.scm:302 msgid "" "\n" "This program is covered by the GNU Affero GPL, version 3 or\n" @@ -1290,7 +1395,7 @@ msgstr "" "code source complet correspondant (avec vos modifications) sans\n" "frais. Le serveur ajoute un en-tête « Source: » à toutes les réponses." -#: src/scm/webid-oidc/program.scm:317 +#: src/scm/webid-oidc/program.scm:309 msgid "" "\n" "Available commands:" @@ -1298,7 +1403,7 @@ msgstr "" "\n" "Commandes disponibles :" -#: src/scm/webid-oidc/program.scm:319 +#: src/scm/webid-oidc/program.scm:311 #, scheme-format msgid "" "\n" @@ -1309,12 +1414,12 @@ msgstr "" " ~a :\n" " exécute le proxy inverse authentifiant." -#: src/scm/webid-oidc/program.scm:322 src/scm/webid-oidc/program.scm:514 -#: src/scm/webid-oidc/program.scm:715 +#: src/scm/webid-oidc/program.scm:314 src/scm/webid-oidc/program.scm:506 +#: src/scm/webid-oidc/program.scm:707 msgid "command-line|command|reverse-proxy" msgstr "proxy-inversé" -#: src/scm/webid-oidc/program.scm:323 +#: src/scm/webid-oidc/program.scm:315 #, scheme-format msgid "" "\n" @@ -1325,12 +1430,12 @@ msgstr "" " ~a :\n" " exécute un fournisseur d’identité." -#: src/scm/webid-oidc/program.scm:326 src/scm/webid-oidc/program.scm:539 -#: src/scm/webid-oidc/program.scm:737 +#: src/scm/webid-oidc/program.scm:318 src/scm/webid-oidc/program.scm:531 +#: src/scm/webid-oidc/program.scm:729 msgid "command-line|command|identity-provider" msgstr "fournisseur-identité" -#: src/scm/webid-oidc/program.scm:327 +#: src/scm/webid-oidc/program.scm:319 #, scheme-format msgid "" "\n" @@ -1341,12 +1446,12 @@ msgstr "" " ~a :\n" " sert les pages d’une application publique." -#: src/scm/webid-oidc/program.scm:330 src/scm/webid-oidc/program.scm:560 -#: src/scm/webid-oidc/program.scm:779 +#: src/scm/webid-oidc/program.scm:322 src/scm/webid-oidc/program.scm:552 +#: src/scm/webid-oidc/program.scm:771 msgid "command-line|command|client-service" msgstr "service-client" -#: src/scm/webid-oidc/program.scm:331 +#: src/scm/webid-oidc/program.scm:323 #, scheme-format msgid "" "\n" @@ -1359,12 +1464,12 @@ msgstr "" " exécute un serveur complet, avec un fournisseur d’identité et\n" " une fonction de stockage de ressources." -#: src/scm/webid-oidc/program.scm:335 src/scm/webid-oidc/program.scm:586 -#: src/scm/webid-oidc/program.scm:808 +#: src/scm/webid-oidc/program.scm:327 src/scm/webid-oidc/program.scm:578 +#: src/scm/webid-oidc/program.scm:800 msgid "command-line|command|server" msgstr "serveur" -#: src/scm/webid-oidc/program.scm:337 +#: src/scm/webid-oidc/program.scm:329 msgid "" "\n" "General options:" @@ -1372,7 +1477,7 @@ msgstr "" "\n" "Options générales :" -#: src/scm/webid-oidc/program.scm:339 +#: src/scm/webid-oidc/program.scm:331 #, scheme-format msgid "" "\n" @@ -1386,7 +1491,7 @@ msgstr "" " correspondant. Par exemple, MOYEN serait une URI pointant vers\n" " l’archive de code." -#: src/scm/webid-oidc/program.scm:344 +#: src/scm/webid-oidc/program.scm:336 #, scheme-format msgid "" "\n" @@ -1397,7 +1502,7 @@ msgstr "" " -h, --~a :\n" " affiche un court message d’aide et quitte." -#: src/scm/webid-oidc/program.scm:348 +#: src/scm/webid-oidc/program.scm:340 #, scheme-format msgid "" "\n" @@ -1408,7 +1513,7 @@ msgstr "" " -v, --~a :\n" " affiche le numéro de version (~a, publiée le ~a) et quitte." -#: src/scm/webid-oidc/program.scm:354 +#: src/scm/webid-oidc/program.scm:346 #, scheme-format msgid "" "\n" @@ -1419,7 +1524,7 @@ msgstr "" " --~a :\n" " décrit le projet dans le vocabulaire DOAP et quitte." -#: src/scm/webid-oidc/program.scm:358 +#: src/scm/webid-oidc/program.scm:350 #, scheme-format msgid "" "\n" @@ -1430,7 +1535,7 @@ msgstr "" " -l FICHIER.journal, --~a=FICHIER.journal :\n" " redirige la sortie standard du programme vers FICHIER.journal." -#: src/scm/webid-oidc/program.scm:362 +#: src/scm/webid-oidc/program.scm:354 #, scheme-format msgid "" "\n" @@ -1441,7 +1546,7 @@ msgstr "" " -e FICHIER.erreurs, --~a=FICHIER.erreurs :\n" " redirige les erreurs du programme vers FICHIER.erreurs." -#: src/scm/webid-oidc/program.scm:367 +#: src/scm/webid-oidc/program.scm:359 msgid "" "\n" "General server-side options:" @@ -1449,7 +1554,7 @@ msgstr "" "\n" "Options générales pour un serveur :" -#: src/scm/webid-oidc/program.scm:369 +#: src/scm/webid-oidc/program.scm:361 #, scheme-format msgid "" "\n" @@ -1460,7 +1565,7 @@ msgstr "" " -p PORT, --~a=PORT :\n" " définit le port à lier, 8080 par défaut." -#: src/scm/webid-oidc/program.scm:373 +#: src/scm/webid-oidc/program.scm:365 #, scheme-format msgid "" "\n" @@ -1472,7 +1577,7 @@ msgstr "" " définit l’URI publique du serveur (schéma, identifiant de\n" " l’utilisateur, hôte et port)." -#: src/scm/webid-oidc/program.scm:378 +#: src/scm/webid-oidc/program.scm:370 msgid "" "\n" "Options for the resource server:" @@ -1480,7 +1585,7 @@ msgstr "" "\n" "Options pour le serveur de ressources :" -#: src/scm/webid-oidc/program.scm:380 +#: src/scm/webid-oidc/program.scm:372 #, scheme-format msgid "" "\n" @@ -1495,7 +1600,7 @@ msgstr "" " authentifié, XXX-Agent par défaut. Pour un serveur complet, ceci\n" " désactive l’authentification par Solid-OIDC." -#: src/scm/webid-oidc/program.scm:386 +#: src/scm/webid-oidc/program.scm:378 #, scheme-format msgid "" "\n" @@ -1508,7 +1613,7 @@ msgstr "" " définit l’URI sortante du proxy inversé, seulement pour la\n" " commande proxy-inversé." -#: src/scm/webid-oidc/program.scm:392 +#: src/scm/webid-oidc/program.scm:384 msgid "" "\n" "Options for the identity provider:" @@ -1516,7 +1621,7 @@ msgstr "" "\n" "Options du fournisseur d’identité :" -#: src/scm/webid-oidc/program.scm:394 +#: src/scm/webid-oidc/program.scm:386 #, scheme-format msgid "" "\n" @@ -1530,7 +1635,7 @@ msgstr "" " nouvelle clé sera générée. Le serveur n’offre pas de service\n" " HTTPS." -#: src/scm/webid-oidc/program.scm:399 +#: src/scm/webid-oidc/program.scm:391 #, scheme-format msgid "" "\n" @@ -1541,7 +1646,7 @@ msgstr "" " -s WEBID, --~a=WEBID :\n" " définit l'identité du sujet." -#: src/scm/webid-oidc/program.scm:403 +#: src/scm/webid-oidc/program.scm:395 #, scheme-format msgid "" "\n" @@ -1552,7 +1657,7 @@ msgstr "" " -w MOT_DE_PASSE_CHIFFRÉ, --~a=MOT_DE_PASSE_CHIFFRÉ :\n" " définit le mot de passe chiffré pour reconnaître l’utilisateur." -#: src/scm/webid-oidc/program.scm:407 +#: src/scm/webid-oidc/program.scm:399 #, scheme-format msgid "" "\n" @@ -1565,7 +1670,7 @@ msgstr "" " lit le mot de passe chiffré de l’utilisateur dans " "FICHIER_DE_MOT_DE_PASSE_CHIFFRÉ." -#: src/scm/webid-oidc/program.scm:411 +#: src/scm/webid-oidc/program.scm:403 #, scheme-format msgid "" "\n" @@ -1576,7 +1681,7 @@ msgstr "" " -j URI, --~a=URI :\n" " définit l’URI pour requêter les clés du serveur." -#: src/scm/webid-oidc/program.scm:415 +#: src/scm/webid-oidc/program.scm:407 #, scheme-format msgid "" "\n" @@ -1588,7 +1693,7 @@ msgstr "" " définit l'URI du terminal d'autorisation de l’émetteur\n" " d’identité." -#: src/scm/webid-oidc/program.scm:419 +#: src/scm/webid-oidc/program.scm:411 #, scheme-format msgid "" "\n" @@ -1599,7 +1704,7 @@ msgstr "" " -t URI, --~a=URI :\n" " définit le terminal de jeton de l’émetteur d’identité." -#: src/scm/webid-oidc/program.scm:424 +#: src/scm/webid-oidc/program.scm:416 msgid "" "\n" "Options for the client service:" @@ -1607,7 +1712,7 @@ msgstr "" "\n" "Options pour le service associé à un client :" -#: src/scm/webid-oidc/program.scm:426 +#: src/scm/webid-oidc/program.scm:418 #, scheme-format msgid "" "\n" @@ -1620,7 +1725,7 @@ msgstr "" " définit l’identifiant web de l’application client, qui est\n" " déréférencé pour une ressource sémantique." -#: src/scm/webid-oidc/program.scm:431 +#: src/scm/webid-oidc/program.scm:423 #, scheme-format msgid "" "\n" @@ -1634,7 +1739,7 @@ msgstr "" " d’autorisation. La page de redirection affiche le code à coller\n" " dans l’application." -#: src/scm/webid-oidc/program.scm:436 +#: src/scm/webid-oidc/program.scm:428 #, scheme-format msgid "" "\n" @@ -1646,7 +1751,7 @@ msgstr "" " définit le nom de l’application visible par l’utilisateur (peut\n" " être trompeur…)." -#: src/scm/webid-oidc/program.scm:440 +#: src/scm/webid-oidc/program.scm:432 #, scheme-format msgid "" "\n" @@ -1659,7 +1764,7 @@ msgstr "" " définit l’URI présentant plus d’informations à propos de\n" " l’application (peut aussi être trompeur)." -#: src/scm/webid-oidc/program.scm:446 +#: src/scm/webid-oidc/program.scm:438 msgid "" "\n" "Environment variables:" @@ -1667,7 +1772,7 @@ msgstr "" "\n" "Variables d’environnement :" -#: src/scm/webid-oidc/program.scm:448 +#: src/scm/webid-oidc/program.scm:440 msgid "" "\n" " XML_CATALOG_FILES: the server will fetch resources on the web. By\n" @@ -1686,9 +1791,9 @@ msgstr "" " fichiers depuis le système de fichiers, parce qu’il n’y a pas de\n" " moyen de spécifier le type de contenu." -#: src/scm/webid-oidc/program.scm:456 src/scm/webid-oidc/program.scm:463 -#: src/scm/webid-oidc/program.scm:472 src/scm/webid-oidc/program.scm:480 -#: src/scm/webid-oidc/program.scm:488 +#: src/scm/webid-oidc/program.scm:448 src/scm/webid-oidc/program.scm:455 +#: src/scm/webid-oidc/program.scm:464 src/scm/webid-oidc/program.scm:472 +#: src/scm/webid-oidc/program.scm:480 #, scheme-format msgid "" "the-environment-variable|\n" @@ -1697,7 +1802,7 @@ msgstr "" " \n" " Elle vaut actuellement ~s." -#: src/scm/webid-oidc/program.scm:459 +#: src/scm/webid-oidc/program.scm:451 msgid "" "\n" " LANG: set the locale of the user interface (for the server commands,\n" @@ -1707,7 +1812,7 @@ msgstr "" " LANG : définit la locale de l’interface utilisateur (pour les\n" " commandes serveur, l’utilisateur est l’administrateur système)." -#: src/scm/webid-oidc/program.scm:466 +#: src/scm/webid-oidc/program.scm:458 msgid "" "\n" " XDG_DATA_HOME: where the program stores persistent data. The\n" @@ -1722,7 +1827,7 @@ msgstr "" " ici. Pour un service système, il est recommandé d’utiliser\n" " /var/lib." -#: src/scm/webid-oidc/program.scm:475 +#: src/scm/webid-oidc/program.scm:467 msgid "" "\n" " XDG_CACHE_HOME: where the program stores and updates the seed file,\n" @@ -1735,7 +1840,7 @@ msgstr "" " supprimer ce dossier n’importe quand. Le fichier de graine sera\n" " initialisé à partir de /dev/random." -#: src/scm/webid-oidc/program.scm:483 +#: src/scm/webid-oidc/program.scm:475 msgid "" "\n" " HOME: if XDG_DATA_HOME or XDG_CACHE_HOME is not set, they are\n" @@ -1747,7 +1852,7 @@ msgstr "" " valeur est calculée à partir de la variable d’environnement\n" " HOME. Elle n’est pas utilisée autrement." -#: src/scm/webid-oidc/program.scm:492 +#: src/scm/webid-oidc/program.scm:484 msgid "" "\n" "Running a reverse proxy" @@ -1755,7 +1860,7 @@ msgstr "" "\n" "Exécution d’un proxy inversé" -#: src/scm/webid-oidc/program.scm:494 +#: src/scm/webid-oidc/program.scm:486 msgid "" "\n" "Suppose that you operate data.provider.com. You want to run an\n" @@ -1777,7 +1882,7 @@ msgstr "" "authentifié. https://private.data.provider.com ne doit accepter que\n" "les requêtes depuis ce proxy inversé." -#: src/scm/webid-oidc/program.scm:504 +#: src/scm/webid-oidc/program.scm:496 #, scheme-format msgid "" "\n" @@ -1801,7 +1906,7 @@ msgstr "" " --~a '/var/log/proxy.log' \\\n" " --~a '/var/log/proxy.err'" -#: src/scm/webid-oidc/program.scm:519 +#: src/scm/webid-oidc/program.scm:511 msgid "" "\n" "Running an identity provider" @@ -1809,7 +1914,7 @@ msgstr "" "\n" "Exécution d’un fournisseur d’identité" -#: src/scm/webid-oidc/program.scm:521 +#: src/scm/webid-oidc/program.scm:513 msgid "" "\n" "The identity provider running at webid-oidc-demo.planete-kraus.eu is\n" @@ -1820,7 +1925,7 @@ msgstr "" "webid-oidc-demo.planete-kraus.eu est invoqué avec les options\n" "suivantes :" -#: src/scm/webid-oidc/program.scm:525 +#: src/scm/webid-oidc/program.scm:517 #, scheme-format msgid "" "\n" @@ -1854,7 +1959,7 @@ msgstr "" " --~a 'https://webid-oidc-demo.planete-kraus.eu/token' \\\n" " --~a $PORT" -#: src/scm/webid-oidc/program.scm:545 +#: src/scm/webid-oidc/program.scm:537 msgid "" "\n" "Running the public pages for an application" @@ -1862,7 +1967,7 @@ msgstr "" "\n" "Service des pages publiques pour une application" -#: src/scm/webid-oidc/program.scm:547 +#: src/scm/webid-oidc/program.scm:539 msgid "" "\n" "The example client application pages for\n" @@ -1872,7 +1977,7 @@ msgstr "" "Les pages de l’application client d’exemple pour\n" "webid-oidc-demo.planete-kraus.eu sont servies de cette façon :" -#: src/scm/webid-oidc/program.scm:551 +#: src/scm/webid-oidc/program.scm:543 #, scheme-format msgid "" "\n" @@ -1900,7 +2005,7 @@ msgstr "" "html#Running-a-client' \\\n" " --~a $PORT" -#: src/scm/webid-oidc/program.scm:565 +#: src/scm/webid-oidc/program.scm:557 msgid "" "\n" "Running a full server" @@ -1908,7 +2013,7 @@ msgstr "" "\n" "Exécution d’un serveur complet" -#: src/scm/webid-oidc/program.scm:568 +#: src/scm/webid-oidc/program.scm:560 msgid "" "\n" "To run the server with identity provider and\n" @@ -1920,7 +2025,7 @@ msgstr "" "un serveur de ressources pour un utilisateur particulier, vous devez\n" "combiner les options des parties." -#: src/scm/webid-oidc/program.scm:572 +#: src/scm/webid-oidc/program.scm:564 #, scheme-format msgid "" "\n" @@ -1954,7 +2059,7 @@ msgstr "" " --~a 'https://data.planete-kraus.eu/token' \\\n" " --~a '...port...'" -#: src/scm/webid-oidc/program.scm:597 +#: src/scm/webid-oidc/program.scm:589 #, scheme-format msgid "" "\n" @@ -1963,7 +2068,7 @@ msgstr "" "\n" "Si vous trouvez une erreur, veuillez en envoyer un rapport à ~a." -#: src/scm/webid-oidc/program.scm:602 +#: src/scm/webid-oidc/program.scm:594 #, scheme-format msgid "" "~a version ~a\n" @@ -1974,27 +2079,27 @@ msgstr "" "\n" "Publiée le ~a\n" -#: src/scm/webid-oidc/program.scm:639 +#: src/scm/webid-oidc/program.scm:631 #, scheme-format msgid "The --~a argument must be a number, not ~s.\n" msgstr "L’argument de --~a doit être un nombre, pas ~s.\n" -#: src/scm/webid-oidc/program.scm:645 +#: src/scm/webid-oidc/program.scm:637 #, scheme-format msgid "The --~a argument must be an integer, not ~s.\n" msgstr "L’argument de --~a doit être un entier, pas ~s.\n" -#: src/scm/webid-oidc/program.scm:651 +#: src/scm/webid-oidc/program.scm:643 #, scheme-format msgid "The --~a argument must be positive, ~s is invalid.\n" msgstr "L’argument de --~a doit être positif, ~s est invalide.\n" -#: src/scm/webid-oidc/program.scm:656 +#: src/scm/webid-oidc/program.scm:648 #, scheme-format msgid "The --~a argument must be less than 65536, ~s is invalid.\n" msgstr "L’argument de --~a doit être inférieur à 65536, ~s est invalide.\n" -#: src/scm/webid-oidc/program.scm:684 +#: src/scm/webid-oidc/program.scm:676 msgid "" "You specified two different passwords: one directly, and one from a file. " "Please set only one password.\n" @@ -2002,7 +2107,7 @@ msgstr "" "Vous avez spécifié deux mots de passe différents : l’un directement,\n" "et un autre depuis un fichier. Veuillez n’en spécifier qu’un.\n" -#: src/scm/webid-oidc/program.scm:708 +#: src/scm/webid-oidc/program.scm:700 #, scheme-format msgid "" "Usage: ~a COMMAND [OPTIONS]...\n" @@ -2011,18 +2116,18 @@ msgstr "" "Utilisation : ~a COMMANDE [OPTIONS]...\n" "Voir --~a (-h).\n" -#: src/scm/webid-oidc/program.scm:718 src/scm/webid-oidc/program.scm:740 -#: src/scm/webid-oidc/program.scm:810 +#: src/scm/webid-oidc/program.scm:710 src/scm/webid-oidc/program.scm:732 +#: src/scm/webid-oidc/program.scm:802 #, scheme-format msgid "You must pass --~a to set the server name.\n" msgstr "Vous devez passer --~a pour définir le nom du serveur.\n" -#: src/scm/webid-oidc/program.scm:722 +#: src/scm/webid-oidc/program.scm:714 #, scheme-format msgid "You must pass --~a to set the backend URI.\n" msgstr "Vous devez passer --~a pour définir l'URI du service d’arrière-plan.\n" -#: src/scm/webid-oidc/program.scm:744 src/scm/webid-oidc/program.scm:814 +#: src/scm/webid-oidc/program.scm:736 src/scm/webid-oidc/program.scm:806 #, scheme-format msgid "" "You must pass --~a to set the file where to store the identity provider " @@ -2031,70 +2136,771 @@ msgstr "" "Vous devez passer --~a pour définir le nom du fichier pour sauvegarder\n" "la clé du fournisseur d’identité.\n" -#: src/scm/webid-oidc/program.scm:748 src/scm/webid-oidc/program.scm:818 +#: src/scm/webid-oidc/program.scm:740 src/scm/webid-oidc/program.scm:810 #, scheme-format msgid "You must pass --~a to set the subject of the identity provider.\n" msgstr "" "Vous devez passer --~a pour définir le sujet du fournisseur d’identité.\n" -#: src/scm/webid-oidc/program.scm:752 +#: src/scm/webid-oidc/program.scm:744 #, scheme-format msgid "You must pass --~a or --~a to set the subject’s encrypted password.\n" msgstr "" "Vous devez passer --~a ou --~a pour définir le mot de passe chiffré du " "sujet.\n" -#: src/scm/webid-oidc/program.scm:756 src/scm/webid-oidc/program.scm:826 +#: src/scm/webid-oidc/program.scm:748 src/scm/webid-oidc/program.scm:818 #, scheme-format msgid "You must pass --~a to set the JWKS URI.\n" msgstr "Vous devez passer --~a pour définir l'URI du JWKS.\n" -#: src/scm/webid-oidc/program.scm:760 src/scm/webid-oidc/program.scm:830 +#: src/scm/webid-oidc/program.scm:752 src/scm/webid-oidc/program.scm:822 #, scheme-format msgid "You must pass --~a to set the authorization endpoint URI.\n" msgstr "" "Vous devez passer --~a pour définir l'URI du terminal d'autorisation.\n" -#: src/scm/webid-oidc/program.scm:764 src/scm/webid-oidc/program.scm:834 +#: src/scm/webid-oidc/program.scm:756 src/scm/webid-oidc/program.scm:826 #, scheme-format msgid "You must pass --~a to set the token endpoint URI.\n" msgstr "Vous devez passer --~a pour définir l'URI du terminal de jeton.\n" -#: src/scm/webid-oidc/program.scm:782 +#: src/scm/webid-oidc/program.scm:774 #, scheme-format msgid "You must pass --~a to set the application web ID.\n" msgstr "" "Vous devez passer --~a pour définir l'identifiant web de l’application.\n" -#: src/scm/webid-oidc/program.scm:786 +#: src/scm/webid-oidc/program.scm:778 #, scheme-format msgid "You must pass --~a to set the redirection URI.\n" msgstr "Vous devez passer --~a pour définir l'URI de redirection.\n" -#: src/scm/webid-oidc/program.scm:790 +#: src/scm/webid-oidc/program.scm:782 #, scheme-format msgid "You must pass --~a to set the informative client name.\n" msgstr "" "Vous devez passer --~a pour donner un nom pour l’application à titre " "informatif.\n" -#: src/scm/webid-oidc/program.scm:794 +#: src/scm/webid-oidc/program.scm:786 #, scheme-format msgid "You must pass --~a to set the informative client URI.\n" msgstr "" "Vous devez passer --~a pour définir l'URI du client, à titre informatif.\n" -#: src/scm/webid-oidc/program.scm:822 +#: src/scm/webid-oidc/program.scm:814 #, scheme-format msgid "You must pass --~a to set the subject’s encrypted password.\n" msgstr "" "Vous devez passer --~a pour définir le mot de passe chiffré du sujet.\n" -#: src/scm/webid-oidc/program.scm:877 +#: src/scm/webid-oidc/program.scm:869 #, scheme-format msgid "Unknown command ~s\n" msgstr "Commande inconnue ~s\n" +#: src/scm/webid-oidc/refresh-token.scm:171 +#, fuzzy +#| msgid "there is no refresh token in the request" +msgid "the refresh token does not exist" +msgstr "il n’y a pas de jeton de rafraîchissement dans la requête" + +#: src/scm/webid-oidc/refresh-token.scm:182 +#, fuzzy, scheme-format +#| msgid "" +#| "the refresh token is bound to a key confirmed as ~s, but it is used with " +#| "key ~s" +msgid "the refresh token is bound to key ~s, which is not that one" +msgstr "" +"Le jeton de rafraîchissement est lié à une clé confirmée par ~s, mais il est " +"utilisé avec la clé ~s" + +#: src/scm/webid-oidc/resource-server.scm:62 +msgid "" +"You need to pass #:server-uri URI where URI is the public URI of the server, " +"as a (web uri)." +msgstr "" + +#: src/scm/webid-oidc/resource-server.scm:89 +#, scheme-format +msgid "~a: authentication failure: ~a\n" +msgstr "~a : échec d’authentificationn : ~a\n" + +#: src/scm/webid-oidc/resource-server.scm:93 +#, fuzzy, scheme-format +#| msgid "~a: authentication failure: ~a\n" +msgid "~a: authentication failure\n" +msgstr "~a : échec d’authentificationn : ~a\n" + +#: src/scm/webid-oidc/resource-server.scm:160 +#: src/scm/webid-oidc/resource-server.scm:351 +msgid "reason-phrase|Precondition Failed" +msgstr "" + +#: src/scm/webid-oidc/resource-server.scm:175 +msgid "reason-phrase|Not Modified" +msgstr "" + +#: src/scm/webid-oidc/resource-server.scm:191 +msgid "The owner is not defined." +msgstr "" + +#: src/scm/webid-oidc/resource-server.scm:263 +msgid "reason-phrase|Created" +msgstr "" + +#: src/scm/webid-oidc/resource-server.scm:288 +#, fuzzy, scheme-format +#| msgid "the group ~s cannot be fetched (because ~a)" +msgid "~a: ignoring a group that cannot be fetched: ~a\n" +msgstr "le groupe ~s n’a pas pu être récupéré (parce que ~a)" + +#: src/scm/webid-oidc/resource-server.scm:292 +#, scheme-format +msgid "~a: ignoring a group that cannot be fetched\n" +msgstr "" + +#: src/scm/webid-oidc/resource-server.scm:299 +msgid "reason-phrase|Found" +msgstr "" + +#: src/scm/webid-oidc/resource-server.scm:316 +#: src/scm/webid-oidc/token-endpoint.scm:103 +msgid "reason-phrase|Forbidden" +msgstr "" + +#: src/scm/webid-oidc/resource-server.scm:337 +msgid "reason-phrase|Conflict" +msgstr "" + +#: src/scm/webid-oidc/resource-server.scm:344 +msgid "reason-phrase|Unsupported Media Type" +msgstr "" + +#: src/scm/webid-oidc/resource-server.scm:358 +msgid "reason-phrase|Not Acceptable" +msgstr "" + +#: src/scm/webid-oidc/reverse-proxy.scm:60 +msgid "#:endpoint argument is not present or not an URI." +msgstr "" + +#: src/scm/webid-oidc/server/create.scm:85 +#, scheme-format +msgid "only text/turtle is allowed for the target of a POST request, not ~s" +msgstr "" + +#: src/scm/webid-oidc/server/create.scm:105 +#, fuzzy +#| msgid "the server cannot process resources with the ~s content-type" +msgid "the created resource cannot have containment triples" +msgstr "" +"le serveur ne peut pas traiter des ressources avec le type de contenu ~s" + +#: src/scm/webid-oidc/server/create.scm:147 +#, scheme-format +msgid "cannot POST to an auxiliary resource path, ~s" +msgstr "" + +#: src/scm/webid-oidc/server/read.scm:105 +#, scheme-format +msgid "the auxiliary resource of type ~s at ~s is absent" +msgstr "" + +#: src/scm/webid-oidc/serve.scm:76 +msgid "content negociation failed while serving a request" +msgstr "" + +#: src/scm/webid-oidc/simulation.scm:130 +#, scheme-format +msgid "invalid credentials: response ~s ~s" +msgstr "" + +#: src/scm/webid-oidc/stubs.scm:110 +#, scheme-format +msgid "invalid base64 data: ~a" +msgstr "" + +#: src/scm/webid-oidc/stubs.scm:127 +#, fuzzy, scheme-format +#| msgid "the value ~s does not identify an elleptic curve" +msgid "~s is not a recognized elliptic curve" +msgstr "la valeur ~s n’identifie pas une courbe elliptique" + +#: src/scm/webid-oidc/stubs.scm:155 +#, scheme-format +msgid "~s is not a supported signature algorithm" +msgstr "" + +#: src/scm/webid-oidc/stubs.scm:158 +#, fuzzy, scheme-format +#| msgid "the value ~s does not identify a hash algorithm" +msgid "~s is not a supported hash algorithm" +msgstr "la valeur ~s n’identifie pas un algorithme de hachage" + +#: src/scm/webid-oidc/stubs.scm:196 +#, fuzzy +#| msgid "the origin is ~a" +msgid "the signature is invalid" +msgstr "l’origine est ~a" + +#: src/scm/webid-oidc/stubs.scm:248 +#, scheme-format +msgid "invalid JSON data: ~a" +msgstr "" + +#: src/scm/webid-oidc/stubs.scm:263 +msgid "invalid JSON data in input port" +msgstr "" + +#: src/scm/webid-oidc/stubs.scm:323 +#, scheme-format +msgid "while updating file ~s: ~a" +msgstr "" + +#: src/scm/webid-oidc/stubs.scm:325 +#, scheme-format +msgid "an error happened while updating file ~s" +msgstr "" + +#: src/scm/webid-oidc/token-endpoint.scm:91 +#, scheme-format +msgid "while handling web failure for the token endpoint: ~a" +msgstr "" + +#: src/scm/webid-oidc/token-endpoint.scm:93 +msgid "an error happened during the token endpoint failure handling" +msgstr "" + +#: src/scm/webid-oidc/token-endpoint.scm:129 +#: src/scm/webid-oidc/token-endpoint.scm:156 +msgid "reason-phrase|Bad Request" +msgstr "" + +#: src/scm/webid-oidc/token-endpoint.scm:222 +msgid "missing grant type" +msgstr "" + +#: src/scm/webid-oidc/token-endpoint.scm:226 +msgid "<p>You did not specify a grant_type for this request.</p>" +msgstr "" + +#: src/scm/webid-oidc/token-endpoint.scm:240 +#, fuzzy +#| msgid "~s is not an authorization code (because ~a)" +msgid "missing authorization code" +msgstr "~s n’est pas un code d’autorisation (parce que ~a)" + +#: src/scm/webid-oidc/token-endpoint.scm:244 +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 +msgid "missing refresh token" +msgstr "" + +#: src/scm/webid-oidc/token-endpoint.scm:262 +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 +#, scheme-format +msgid "unsupported grant type: ~s" +msgstr "" + +#: src/scm/webid-oidc/token-endpoint.scm:280 +#, scheme-format +msgid "" +"<p>You want to use <pre>~s</pre> as a grant type, but this is not supported." +"</p>" +msgstr "" + +#~ msgid "that’s how it is" +#~ msgstr "c’est comme ça" + +#, scheme-format +#~ msgid "the value ~s is not a base64 string (because ~a)" +#~ msgstr "la valeur ~s n’est pas une chaîne base64 (parce que ~a)" + +#, scheme-format +#~ msgid "the value ~s is not JSON (because ~a)" +#~ msgstr "la valeur ~s n’est pas du JSON (parce que ~a)" + +#, scheme-format +#~ msgid "the value ~s is not Turtle (because ~a)" +#~ msgstr "la valeur ~s n’est pas du Turtle (parce que ~a)" + +#, scheme-format +#~ msgid "the value ~s does not identify a JWK (because ~a)" +#~ msgstr "la valeur ~s n’identifie pas une JWK (parce que ~a)" + +#, scheme-format +#~ msgid "the value ~s does not identify a JWK" +#~ msgstr "la valeur ~s n’identifie pas une JWK" + +#, scheme-format +#~ msgid "the value ~s does not identify a public JWK (because ~a)" +#~ msgstr "la valeur ~s n’identifie pas une JWK publique (parce que ~a)" + +#, scheme-format +#~ msgid "the value ~s does not identify a public JWK" +#~ msgstr "la valeur ~s n’identifie pas une JWK publique" + +#, scheme-format +#~ msgid "the value ~s does not identify a private JWK (because ~a)" +#~ msgstr "la valeur ~s n’identifie pas une JWK privée (parce que ~a)" + +#, scheme-format +#~ msgid "the value ~s does not identify a private JWK" +#~ msgstr "la valeur ~s n’identifie pas une JWK privée" + +#, scheme-format +#~ msgid "the value ~s does not identify a JWKS (because ~a)" +#~ msgstr "la valeur ~s n’identifie pas un JWKS (parce que ~a)" + +#, scheme-format +#~ msgid "the value ~s does not identify a JWKS" +#~ msgstr "la valeur ~s n’identifie pas un JWKS" + +#, scheme-format +#~ msgid "the value ~s is not an alist or misses key ~s" +#~ msgstr "la valeur ~s n’est pas une alist ou il manque la clé ~s" + +#, scheme-format +#~ msgid "the value ~s is not a JWS header (because ~a)" +#~ msgstr "la valeur ~s n’est pas un header JWS (parce que ~a)" + +#, scheme-format +#~ msgid "the value ~s is not a JWS payload (because ~a)" +#~ msgstr "la valeur ~s n’est pas un contenu JWS (parce que ~a)" + +#, scheme-format +#~ msgid "the value ~s is not a JWS (because ~a)" +#~ msgstr "la valeur ~s n’est pas un JWS (parce que ~a)" + +#, scheme-format +#~ msgid "the string ~s cannot be split in 3 parts with ~s" +#~ msgstr "la chaîne ~s ne peut pas être découpée en 3 parties avec ~s" + +#, scheme-format +#~ msgid "" +#~ "all key candidates failed to verify signature ~s with algorithm ~s and " +#~ "payload ~a (there were ~a: ~s)" +#~ msgstr "" +#~ "aucune clé candidate n’a pu vérifier la signature ~s avec l’algorithme ~s " +#~ "et le contenu ~a (il y en avait ~a : ~s)" + +#, scheme-format +#~ msgid "" +#~ "the server request unexpectedly failed with code ~a and reason phrase ~s" +#~ msgstr "" +#~ "la requête au serveur a échoué de façon inattendue avec un code ~a et une " +#~ "raison ~s" + +#, scheme-format +#~ msgid "the header ~a should be present" +#~ msgstr "l’en-tête ~a devrait être présent" + +#, scheme-format +#~ msgid "the server response wasn't expected: ~s (because ~a)" +#~ msgstr "la réponse du serveur est inattendue : ~s (parce que ~a)" + +#, scheme-format +#~ msgid "the value ~s is not an OIDC configuration (because ~a)" +#~ msgstr "la valeur ~s n’est pas une configuration OIDC (parce que ~a)" + +#, scheme-format +#~ msgid "the webid field is incorrect: ~s" +#~ msgstr "le champ webid est incorrect : ~s" + +#, scheme-format +#~ msgid "the sub field is incorrect: ~s" +#~ msgstr "le champ sub est incorrect : ~s" + +#~ msgid "the sub field is missing" +#~ msgstr "le champ sub est manquant" + +#, scheme-format +#~ msgid "the iss field is incorrect: ~s" +#~ msgstr "le champ iss est incorrect : ~s" + +#~ msgid "the iss field is missing" +#~ msgstr "le champ iss est manquant" + +#, scheme-format +#~ msgid "the aud field is incorrect: ~s" +#~ msgstr "le champ aud est incorrect : ~s" + +#~ msgid "the iat field is missing" +#~ msgstr "le champ iat est manquant" + +#, scheme-format +#~ msgid "the exp field is incorrect: ~s" +#~ msgstr "le champ exp est incorrect : ~s" + +#~ msgid "the exp field is missing" +#~ msgstr "le champ exp est manquant" + +#, scheme-format +#~ msgid "the cnf/jkt field is incorrect: ~s" +#~ msgstr "le champ cnf/jkt est incorrect : ~s" + +#, scheme-format +#~ msgid "the client-id field is incorrect: ~s" +#~ msgstr "le champ client-id est incorrect : ~s" + +#~ msgid "the redirect_uris field is missing" +#~ msgstr "le champ redirect_uris est manquant" + +#, scheme-format +#~ msgid "the typ field is incorrect: ~s" +#~ msgstr "le champ typ est incorrect : ~s" + +#~ msgid "the typ field is missing" +#~ msgstr "le champ typ est manquant" + +#, scheme-format +#~ msgid "the jwk field is incorrect: ~s (because ~a)" +#~ msgstr "le champ jwk est incorrect : ~s (parce que ~a)" + +#~ msgid "the jwk field is missing" +#~ msgstr "le champ jwk est manquant" + +#~ msgid "the jti field is missing" +#~ msgstr "le champ jti est manquant" + +#, scheme-format +#~ msgid "the nonce field is incorrect: ~s" +#~ msgstr "le champ nonce est incorrect : ~s" + +#~ msgid "the htm field is missing" +#~ msgstr "le champ htm est manquant" + +#~ msgid "the htu field is missing" +#~ msgstr "le champ htu est manquant" + +#~ msgid "the ath field is missing" +#~ msgstr "le champ ath est manquant" + +#, scheme-format +#~ msgid "~s is not an access token header (because ~a)" +#~ msgstr "~s n’est pas un en-tête de jeton d’accès (parce que ~a)" + +#, scheme-format +#~ msgid "~s is not an access token payload (because ~a)" +#~ msgstr "~s n’est pas un contenu de jeton d’accès (parce que ~a)" + +#, scheme-format +#~ msgid "~s is not a DPoP proof header (because ~a)" +#~ msgstr "~s n’est pas un en-tête de preuve DPoP (parce que ~a)" + +#, scheme-format +#~ msgid "~s is not a DPoP proof payload (because ~a)" +#~ msgstr "~s n’est pas un contenu de preuve DPoP (parce que ~a)" + +#, scheme-format +#~ msgid "I cannot fetch the JWKS of ~a at ~a (because ~a)" +#~ msgstr "je n’ai pas pu récupérer le JWKS de ~a à ~a (parce que ~a)" + +#, scheme-format +#~ msgid "the HTTP uri is signed for ~a, but ~a was requested" +#~ msgstr "l’uri HTTP a été signé pour ~a, mais ~a a été demandé" + +#, scheme-format +#~ msgid "the date is ~a, but the DPoP proof was signed too long ago at ~a" +#~ msgstr "" +#~ "la date est ~a, mais la preuve DPoP a été signée il y a trop longtemps à " +#~ "~a" + +#, scheme-format +#~ msgid "the key ~s does not hash to ~a" +#~ msgstr "la clé ~s ne donne pas un hash de ~a" + +#, scheme-format +#~ msgid "the key confirmation of ~s failed (because ~a)" +#~ msgstr "la confirmation de clé de ~s a échoué (parce que ~a)" + +#, scheme-format +#~ msgid "the DPoP proof should be bound to the access token ~s" +#~ msgstr "la preuve DPoP doit être liée au jeton d’accès ~s" + +#, scheme-format +#~ msgid "the jti ~s has already been found (because ~a)" +#~ msgstr "le jti ~s a déjà été trouvé (parce que ~a)" + +#, scheme-format +#~ msgid "I cannot encode ~s as an access token with key ~s (because ~a)" +#~ msgstr "" +#~ "je n’ai pas pu encoder ~s comme un jeton d’accès avec la clé ~s (parce " +#~ "que ~a)" + +#, scheme-format +#~ msgid "I cannot decode ~s as a DPoP proof (because ~a)" +#~ msgstr "je n’ai pas pu décoder ~s comme preuve DPoP (parce que ~a)" + +#, scheme-format +#~ msgid "I could not fetch a RDF graph at ~a (because ~a)" +#~ msgstr "je n’ai pas pu récupérer de graphe RDF à ~a (parce que ~a)" + +#, scheme-format +#~ msgid "~s is not a client manifest (because ~a)" +#~ msgstr "~s n’est pas un manifeste client (parce que ~a)" + +#, scheme-format +#~ msgid "~s does not authorize redirection URI ~a" +#~ msgstr "~s n’autorise pas l’URI de redirection ~a" + +#, scheme-format +#~ msgid "~a does not have a client manifest registration triple" +#~ msgstr "~a n’a pas de triplet d’enregistrement de manifeste client" + +#, scheme-format +#~ msgid "the client manifest at ~a is advertised for ~a" +#~ msgstr "le manifeste client ~a est publié pour ~a" + +#, scheme-format +#~ msgid "I could not fetch the client manifest of ~a (because ~a)" +#~ msgstr "je n’ai pas pu récupérer le manifeste client de ~a (parce que ~a)" + +#, scheme-format +#~ msgid "~s is not an authorization code header (because ~a)" +#~ msgstr "~s n’est pas un en-tête de code d’autorisation (parce que ~a)" + +#, scheme-format +#~ msgid "~s is not an authorization code payload (because ~a)" +#~ msgstr "~s n’est pas un contenu de code d’autorisation (parce que ~a)" + +#, scheme-format +#~ msgid "the current time is ~a, and the authorization code expired at ~a" +#~ msgstr "" +#~ "la date est actuellement ~a, et le code d’autorisation a expiré à la date " +#~ "~a" + +#, scheme-format +#~ msgid "I cannot decode ~s as an authorization code (because ~a)" +#~ msgstr "" +#~ "je n’ai pas pu décoder ~s comme un code d’autorisation (parce que ~a)" + +#, scheme-format +#~ msgid "the grant type ~s is not supported" +#~ msgstr "le type d’octroi ~s n’est pas supporté " + +#, scheme-format +#~ msgid "~s is not an ID token header (because ~a)" +#~ msgstr "~s n’est pas un en-tête de jeton d’identité (parce que ~a)" + +#, scheme-format +#~ msgid "~s is not an ID token payload (because ~a)" +#~ msgstr "~s n’est pas un contenu de jeton d’identité (parce que ~a)" + +#, scheme-format +#~ msgid "" +#~ "I couldn’t set the locale to ~s as an approximation of the client locale " +#~ "~s" +#~ msgstr "" +#~ "je n’ai pas pu définir la locale à ~s comme approximation de la locale du " +#~ "client ~s" + +#, scheme-format +#~ msgid "~s does not admit ~s as an identity provider" +#~ msgstr "~s n’admet pas ~s comme fournisseur d’identité" + +#, scheme-format +#~ msgid "" +#~ "~a is neither an identity provider (because ~a) nor a webid (because ~a)" +#~ msgstr "" +#~ "~a n’est ni un fournisseur d’identité (parce que ~a) ni un webid (parce " +#~ "que ~a)" + +#, scheme-format +#~ msgid "you don’t have a refresh token for identity ~a certified by ~a in ~s" +#~ msgstr "" +#~ "vous n’avez pas de jeton de rafraîchissement pour l’identité ~a certifié " +#~ "par ~a dans ~s" + +#, scheme-format +#~ msgid "all identity provider candidates for ~a failed: ~a" +#~ msgstr "" +#~ "tous les candidats de fournisseurs d’identité pour ~a ont échoué : ~a" + +#, scheme-format +#~ msgid "~s failed (because ~a)" +#~ msgstr "~s a échoué (parce que ~a)" + +#~ msgid ", " +#~ msgstr ", " + +#, scheme-format +#~ msgid "no resource has been found to serve URI path ~s" +#~ msgstr "aucune ressource n’a été trouvée pour servir le chemin d’URI ~s" + +#, scheme-format +#~ msgid "the resource kind ~s is absent for the resource at ~s" +#~ msgstr "le type de ressource ~s est absent pour la ressource ~s" + +#, scheme-format +#~ msgid "no resource has been found to serve URI path ~s, but ~s exists" +#~ msgstr "" +#~ "aucune ressource n’a été trouvée pour servir le chemin d’URI ~s, mais ~s " +#~ "existe" + +#, scheme-format +#~ msgid "the container ~s should be emptied before being deleted" +#~ msgstr "le conteneur ~s doit être vidé avant d’être détruit" + +#, scheme-format +#~ msgid "" +#~ "the containment triples in the request to update ~s are not up to date" +#~ msgstr "" +#~ "les triplets de contention dans la requête pour changer ~s ne sont pas à " +#~ "jour" + +#, scheme-format +#~ msgid "" +#~ "the client wants to create a resource at ~s, which is reserved for an " +#~ "auxiliary resource" +#~ msgstr "" +#~ "le client veut créer une ressource en tant que ~s, qui est réservé pour " +#~ "une ressource auxiliare" + +#, scheme-format +#~ msgid "" +#~ "the operation on ~s by ~a is refused, because it’s not by ~s and the " +#~ "access control forbids the following mode of operation: ~s" +#~ msgstr "" +#~ "l’opération sur ~s par ~a est refusée, parce que ce n’est pas ~s et le " +#~ "contrôle d’accès refuse le mode d’opération suivant : ~s" + +#~ msgid "an anonymous user" +#~ msgstr "un utilisateur anonyme" + +#, scheme-format +#~ msgid "" +#~ "the client precondition failed for ~s: it allows for ~s, forbids ~s, but " +#~ "the resource has a representation of ~s" +#~ msgstr "" +#~ "la précondition du client a échoué pour ~s : elle autorise ~s, interdit " +#~ "~s, mais la ressource a une représentation ~s" + +#, scheme-format +#~ msgid "" +#~ "the client precondition failed for ~s: it allows for ~s, forbids ~s, but " +#~ "the resource has no representation" +#~ msgstr "" +#~ "la précondition du client a échoué pour ~s : elle autorise ~s, interdit " +#~ "~s, mais la ressource n’a pas de représentation" + +#, scheme-format +#~ msgid "" +#~ "the client wanted a response with a content type among ~s, but the " +#~ "resource at ~s has content-type ~s which cannot be converted to one of " +#~ "them" +#~ msgstr "" +#~ "le client voulait une réponse avec un type de contenu parmi ~s, mais la " +#~ "ressource ~s a un type de contenu ~s qui ne peut pas être converti vers " +#~ "l’un d’eux" + +#~ msgid "that’s it" +#~ msgstr "c’est tout" + +#, scheme-format +#~ msgid "~a and ~a" +#~ msgstr "~a et ~a" + +#, scheme-format +#~ msgid "~a, ~a" +#~ msgstr "~a, ~a" + +#, scheme-format +#~ msgid "the signature ~a does not match key ~s with payload ~a" +#~ msgstr "la signature ~a ne correspond pas à la clé ~s avec le contenu ~a" + +#~ msgid "there is an undefined variable" +#~ msgstr "il y a une variable non définie" + +#, scheme-format +#~ msgid "a message is attached: ~a" +#~ msgstr "un message est attaché : ~a" + +#, scheme-format +#~ msgid "the values ~s are problematic" +#~ msgstr "les valeurs ~s sont problématiques" + +#, scheme-format +#~ msgid "there is a kind (~s) and args ~s" +#~ msgstr "il y a un type (~s) et des arguments ~s" + +#~ msgid "there is an assertion failure" +#~ msgstr "il y a un échec d’assertion" + +#, scheme-format +#~ msgid "the program quits with code ~a" +#~ msgstr "le programme quitte avec le code ~a" + +#~ msgid "the program cannot recover from this exception" +#~ msgstr "le programme ne peut pas récupérer après cette exception" + +#, scheme-format +#~ msgid "there is an unknown exception of kind ~s" +#~ msgstr "il y a eu une exception de type inconnu ~s" + +#, scheme-format +#~ msgid "the value ~s is not a base64 string." +#~ msgstr "la valeur ~s n’est pas une chaîne base64." + +#~ msgid "the following value is not JSON:" +#~ msgstr "la valeur suivante n’est pas du JSON :" + +#~ msgid "the following value is not Turtle:" +#~ msgstr "la valeur suivante n’est pas du Turtle :" + +#, scheme-format +#~ msgid "" +#~ "the server request unexpectedly failed with code ~a and reason phrase ~s." +#~ msgstr "" +#~ "la requête au serveur a échoué de façon inattendue avec un code ~a et une " +#~ "raison ~s." + +#, scheme-format +#~ msgid "the header ~a should not have the value ~s.\n" +#~ msgstr "l’en-tête ~a ne devrait pas avoir la valeur ~s.\n" + +#, scheme-format +#~ msgid "the header ~a should be present." +#~ msgstr "l’en-tête ~a devrait être présent." + +#, scheme-format +#~ msgid "the client_id field is incorrect: ~s" +#~ msgstr "le champ client_id est incorrect : ~s" + +#~ msgid "the client_id field is missing" +#~ msgstr "le champ client_id est manquant" + +#, scheme-format +#~ msgid "I could not fetch a RDF graph at ~a;" +#~ msgstr "je n’ai pas pu récupérer de graphe RDF à ~a;" + +#, scheme-format +#~ msgid "the client manifest at ~a is advertised for ~a;" +#~ msgstr "le manifeste client ~a est publié pour ~a ;" + +#~ msgid "I could not issue an authorization code for you;" +#~ msgstr "je n’ai pas pu émettre un code d’autorisation pour vous ;" + +#, scheme-format +#~ msgid "Warning: ~a\n" +#~ msgstr "Avertissement : ~a\n" + +#, scheme-format +#~ msgid "" +#~ "The client locale ~s can’t be approximated by system locale ~s (because " +#~ "~a), using C.\n" +#~ msgstr "" +#~ "La locale du client ~s ne peut pas être approchée par la locale système " +#~ "~s (parce que ~a), on utilise C.\n" + #, scheme-format #~ msgid "the token request failed (because ~a)" #~ msgstr "la requête de jeton a échoué (parce que ~a)" @@ -2186,11 +2992,6 @@ msgstr "Commande inconnue ~s\n" #~ msgid "Please enter your webid, or identity server: " #~ msgstr "Veuillez entrer votre webid, ou serveur d’identité : " -#~ msgid "There are different possible identity providers for your webid:\n" -#~ msgstr "" -#~ "Il y a différents fournisseurs d’identité possibles pour votre\n" -#~ "webid :\n" - #, scheme-format #~ msgid "" #~ "Please visit the following URI with a web browser:\n" @@ -2689,9 +3490,6 @@ msgstr "Commande inconnue ~s\n" #~ msgid "You need to set the redirect URI.\n" #~ msgstr "Vous devez définir l'URI de redirection.\n" -#~ msgid "The client URI should be an URI.\n" -#~ msgstr "L’URI du client doit être un URI.\n" - #~ msgid "comand-line|issuer" #~ msgstr "émetteur" diff --git a/src/scm/webid-oidc/Makefile.am b/src/scm/webid-oidc/Makefile.am index 57c3930..5ffac04 100644 --- a/src/scm/webid-oidc/Makefile.am +++ b/src/scm/webid-oidc/Makefile.am @@ -48,7 +48,8 @@ dist_webidoidcmod_DATA += \ %reldir%/offloading.scm \ %reldir%/catalog.scm \ %reldir%/parameters.scm \ - %reldir%/simulation.scm + %reldir%/simulation.scm \ + %reldir%/web-i18n.scm webidoidcgo_DATA += \ %reldir%/errors.go \ @@ -84,7 +85,8 @@ webidoidcgo_DATA += \ %reldir%/offloading.go \ %reldir%/catalog.go \ %reldir%/parameters.go \ - %reldir%/simulation.go + %reldir%/simulation.go \ + %reldir%/web-i18n.go EXTRA_DIST += %reldir%/ChangeLog diff --git a/src/scm/webid-oidc/access-token.scm b/src/scm/webid-oidc/access-token.scm index acdc56f..6023108 100644 --- a/src/scm/webid-oidc/access-token.scm +++ b/src/scm/webid-oidc/access-token.scm @@ -1,5 +1,5 @@ -;; webid-oidc, implementation of the Solid specification -;; Copyright (C) 2020, 2021 Vivien Kraus +;; 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 @@ -19,204 +19,330 @@ #:use-module (webid-oidc errors) #:use-module (webid-oidc jwk) #:use-module (webid-oidc oidc-configuration) + #:use-module (webid-oidc web-i18n) #:use-module ((webid-oidc stubs) #:prefix stubs:) #:use-module ((webid-oidc parameters) #:prefix p:) #:use-module (web uri) #:use-module (web client) #:use-module (ice-9 optargs) - #:use-module (srfi srfi-19)) + #:use-module (ice-9 match) + #:use-module (srfi srfi-19) + #:use-module (srfi srfi-26) + #:use-module (ice-9 exceptions) + #:declarative? #t + #:export + ( -(define-public (the-access-token-header x) - (with-exception-handler - (lambda (error) - (raise-not-an-access-token-header x error)) - (lambda () - (the-jws-header x)))) + &invalid-access-token + make-invalid-access-token + invalid-access-token? + + the-access-token + access-token? + + access-token-alg -(define-public (access-token-header? x) - (false-if-exception - (and (the-access-token-header x) #t))) + access-token-webid + access-token-iss + access-token-aud + access-token-iat + access-token-exp + access-token-client-id + access-token-cnf/jkt -(define-public (the-access-token-payload x) + access-token-decode + issue-access-token + )) + +(define-exception-type + &invalid-access-token + &external-error + 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) - (raise-not-an-access-token-payload x 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 () - (let ((x (the-jws-payload x))) - (let ((webid (assq-ref x 'webid)) - (iss (assq-ref x 'iss)) - (aud (assq-ref x 'aud)) - (iat (assq-ref x 'iat)) - (exp (assq-ref x 'exp)) - (cnf (assq-ref x 'cnf)) - (client-id (assq-ref x 'client_id))) - (unless (and webid (string? webid) (string->uri webid)) - (raise-incorrect-webid-field webid)) - (unless (and iss (string? iss) (string->uri iss)) - (raise-incorrect-iss-field iss)) - (unless (equal? aud "solid") - (raise-incorrect-aud-field aud)) - (unless (integer? iat) - (raise-incorrect-iat-field iat)) - (unless (and (integer? exp) (>= exp iat)) - (raise-incorrect-exp-field exp)) - (unless (and client-id (string? client-id) (string->uri client-id)) - (raise-incorrect-client-id-field client-id)) - (unless (and cnf (assq-ref cnf 'jkt) (string? (assq-ref cnf 'jkt))) - (raise-incorrect-cnf/jkt-field (and cnf (assq-ref cnf 'jkt)))) - x))))) - -(define-public (access-token-payload? x) - (false-if-exception - (and (the-access-token-header x) #t))) - -(define-public (the-access-token x) - (with-exception-handler - (lambda (cause) - (raise-not-an-access-token x cause)) - (lambda () - (cons (the-access-token-header (car x)) - (the-access-token-payload (cdr x)))))) - -(define-public (access-token? x) - (false-if-exception - (and (the-access-token x) #t))) - -(define-public (make-access-token header payload) - (the-access-token - (cons header payload))) - -(define-public (make-access-token-payload webid iss iat exp cnf/jkt client-id) - (when (date? exp) - (set! exp (date->time-utc exp))) - (when (time? exp) - (set! exp (time-second exp))) - (when (date? iat) - (set! iat (date->time-utc iat))) - (when (time? iat) - (set! iat (time-second iat))) - (when (uri? webid) - (set! webid (uri->string webid))) - (when (uri? iss) - (set! iss (uri->string iss))) - (when (uri? client-id) - (set! client-id (uri->string client-id))) - (the-access-token-payload - `((webid . ,webid) - (iss . ,iss) - (aud . "solid") - (iat . ,iat) - (exp . ,exp) - (cnf . ((jkt . ,cnf/jkt))) - (client_id . ,client-id)))) - -(define-public (access-token-header code) - (car (the-access-token code))) - -(define-public (access-token-payload code) - (cdr (the-access-token code))) - -(define-public (access-token-alg code) - (when (access-token? code) - (set! code (access-token-header code))) - (jws-alg (the-access-token-header code))) - -(define-public (access-token-webid code) - (when (access-token? code) - (set! code (access-token-payload code))) - (string->uri - (assq-ref (the-access-token-payload code) 'webid))) - -(define-public (access-token-iss code) - (when (access-token? code) - (set! code (access-token-payload code))) - (string->uri - (assq-ref (the-access-token-payload code) 'iss))) - -(define-public (access-token-aud code) - (when (access-token? code) - (set! code (access-token-payload code))) - (assq-ref (the-access-token-payload code) 'aud)) - -(define-public (access-token-exp code) - (when (access-token? code) - (set! code (access-token-payload code))) - (time-utc->date - (make-time time-utc 0 (assq-ref - (the-access-token-payload code) - 'exp)))) - -(define-public (access-token-iat code) - (when (access-token? code) - (set! code (access-token-payload code))) - (time-utc->date - (make-time time-utc 0 (assq-ref - (the-access-token-payload code) - 'iat)))) - -(define-public (access-token-cnf/jkt code) - (when (access-token? code) - (set! code (access-token-payload code))) - (assq-ref - (assq-ref (the-access-token-payload code) 'cnf) - 'jkt)) - -(define-public (access-token-client-id code) - (when (access-token? code) - (set! code (access-token-payload code))) - (string->uri - (assq-ref (the-access-token-payload code) 'client_id))) - -(define*-public (access-token-decode str #:key (http-get http-get)) + (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 (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)) (with-exception-handler (lambda (error) - (raise-cannot-decode-access-token str 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)))) (lambda () (jws-decode str (lambda (token) - (let ((iss (access-token-iss token))) - (let ((cfg - (with-exception-handler - (lambda (error) - (raise-cannot-fetch-issuer-configuration iss error)) - (lambda () - (get-oidc-configuration - (uri-host iss) - #:userinfo (uri-userinfo iss) - #:port (uri-port iss) - #:http-get http-get))))) - (with-exception-handler - (lambda (error) - (raise-cannot-fetch-jwks iss - (oidc-configuration-jwks-uri cfg) - error)) - (lambda () - (oidc-configuration-jwks cfg #:http-get http-get)))))))))) - -(define-public (access-token-encode access-token key) + (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) - (raise-cannot-encode-access-token access-token key 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*-public (issue-access-token - issuer-key - #:key - (alg #f) - (webid #f) - (iss #f) - (validity 3600) - (client-key #f) - (cnf/jkt #f) - (client-id #f)) +(define* (issue-access-token + issuer-key + #:key + (alg #f) + (webid #f) + (iss #f) + (validity 3600) + (client-key #f) + (cnf/jkt #f) + (client-id #f)) (when client-key (set! cnf/jkt (jkt client-key))) - (access-token-encode - (make-access-token - `((alg . ,(if (symbol? alg) (symbol->string alg) alg))) - (let ((iat (time-second (date->time-utc ((p:current-date)))))) - (make-access-token-payload - webid iss iat (+ iat validity) cnf/jkt client-id))) - issuer-key)) + (let* ((iat (time-second (date->time-utc ((p:current-date))))) + (exp (+ iat validity))) + (jws-encode + (the-access-token + `(((alg . ,(symbol->string alg))) + . ((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))) diff --git a/src/scm/webid-oidc/authorization-code.scm b/src/scm/webid-oidc/authorization-code.scm index 267d67a..95dcc4a 100644 --- a/src/scm/webid-oidc/authorization-code.scm +++ b/src/scm/webid-oidc/authorization-code.scm @@ -1,4 +1,4 @@ -;; webid-oidc, implementation of the Solid specification +;; disfluid, implementation of the Solid specification ;; Copyright (C) 2020, 2021 Vivien Kraus ;; This program is free software: you can redistribute it and/or modify @@ -21,146 +21,203 @@ #:use-module (webid-oidc jti) #:use-module ((webid-oidc parameters) #:prefix p:) #:use-module (web uri) - #:use-module (srfi srfi-19)) - -(define-public (the-authorization-code-header x) - (with-exception-handler - (lambda (error) - (raise-not-an-authorization-code-header x error)) - (lambda () - (the-jws-header x)))) - -(define-public (authorization-code-header? x) - (false-if-exception - (and (the-authorization-code-header x) #t))) - -(define-public (the-authorization-code-payload x) - (with-exception-handler - (lambda (error) - (raise-not-an-authorization-code-payload x error)) - (lambda () - (let ((x (the-jws-payload x))) - (let ((exp (assq-ref x 'exp)) - (jti (assq-ref x 'jti)) - (webid (assq-ref x 'webid)) - (client-id (assq-ref x 'client_id))) - (unless (integer? exp) - (raise-incorrect-exp-field exp)) - (unless (string? jti) - (raise-incorrect-jti-field jti)) - (unless (and (string? webid) (string->uri webid)) - (raise-incorrect-webid-field webid)) - (unless (and (string? client-id) (string->uri client-id)) - (raise-incorrect-client-id-field client-id)) - x))))) - -(define-public (authorization-code-payload? x) - (false-if-exception - (and (the-authorization-code-payload x) #t))) - -(define-public (the-authorization-code x) + #:use-module (srfi srfi-19) + #:use-module (webid-oidc web-i18n) + #:use-module (ice-9 match) + #:use-module (ice-9 exceptions) + #:declarative? #t + #:export + ( + + &invalid-authorization-code + 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 + )) + +(define-exception-type + &invalid-authorization-code + &external-error + make-invalid-authorization-code + invalid-authorization-code?) + +(define (the-authorization-code x) (with-exception-handler (lambda (error) - (raise-not-an-authorization-code x 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 () - (cons (the-authorization-code-header (car x)) - (the-authorization-code-payload (cdr x)))))) - -(define-public (authorization-code? x) - (false-if-exception - (and (the-authorization-code x) #t))) - -(define-public (make-authorization-code header payload) - (the-authorization-code (cons header payload))) - -(define-public (make-authorization-code-header alg) - (when (symbol? alg) - (set! alg (symbol->string alg))) - (the-authorization-code-header - `((alg . ,alg)))) - -(define-public (make-authorization-code-payload exp jti sub aud) - (when (date? exp) - (set! exp (date->time-utc exp))) - (when (time? exp) - (set! exp (time-second exp))) - (when (uri? sub) - (set! sub (uri->string sub))) - (when (uri? aud) - (set! aud (uri->string aud))) - (the-authorization-code-payload - `((exp . ,exp) - (jti . ,jti) - (webid . ,sub) - (client_id . ,aud)))) - -(define-public (authorization-code-header code) - (car (the-authorization-code code))) - -(define-public (authorization-code-payload code) - (cdr (the-authorization-code code))) - -(define-public (authorization-code-alg code) - (when (authorization-code? code) - (set! code (authorization-code-header code))) - (jws-alg (the-authorization-code-header code))) - -(define-public (authorization-code-exp code) - (when (authorization-code? code) - (set! code (authorization-code-payload code))) - (time-utc->date - (make-time time-utc 0 (assq-ref - (the-authorization-code-payload code) - 'exp)))) - -(define-public (authorization-code-jti code) - (when (authorization-code? code) - (set! code (authorization-code-payload code))) - (assq-ref (the-authorization-code-payload code) 'jti)) - -(define-public (authorization-code-webid code) - (when (authorization-code? code) - (set! code (authorization-code-payload code))) - (string->uri - (assq-ref (the-authorization-code-payload code) 'webid))) - -(define-public (authorization-code-client-id code) - (when (authorization-code? code) - (set! code (authorization-code-payload code))) - (string->uri - (assq-ref (the-authorization-code-payload code) 'client_id))) - -(define-public (authorization-code-decode str jwk) + (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 (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) - (raise-cannot-decode-authorization-code str 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 (time-second (date->time-utc (authorization-code-exp code)))) - (current-time (time-second (date->time-utc ((p:current-date)))))) - (unless (<= current-time exp) - (raise-authorization-code-expired exp current-time)) - (unless (jti-check (authorization-code-jti code) - (- exp current-time)) - (with-exception-handler - (lambda (error) - (raise-jti-found (authorization-code-jti code) error)) - (lambda () - (error "the jti-check function returned #f")))) - code)))))) - -(define-public (authorization-code-encode authorization-code key) + (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) (with-exception-handler (lambda (error) - (raise-cannot-encode-authorization-code authorization-code key 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)))) (lambda () (jws-encode authorization-code key)))) -(define-public (issue-authorization-code alg jwk exp sub aud) - (authorization-code-encode - (make-authorization-code - (make-authorization-code-header alg) - (make-authorization-code-payload exp (stubs:random 12) sub aud)) - jwk)) +(define* (issue-authorization-code issuer-key + #:key + alg + (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))) + . ((webid . ,(uri->string webid)) + (client_id . ,(uri->string client-id)) + (exp . ,exp) + (jti . ,(stubs:random 12)))) + issuer-key))) diff --git a/src/scm/webid-oidc/authorization-endpoint.scm b/src/scm/webid-oidc/authorization-endpoint.scm index 4786a7a..86a8a4d 100644 --- a/src/scm/webid-oidc/authorization-endpoint.scm +++ b/src/scm/webid-oidc/authorization-endpoint.scm @@ -1,4 +1,4 @@ -;; webid-oidc, implementation of the Solid specification +;; disfluid, implementation of the Solid specification ;; Copyright (C) 2020, 2021 Vivien Kraus ;; This program is free software: you can redistribute it and/or modify @@ -27,16 +27,25 @@ #:use-module (web response) #:use-module (rnrs bytevectors) #:use-module (srfi srfi-19) + #:use-module (srfi srfi-26) #:use-module (ice-9 receive) - #:use-module (ice-9 optargs)) + #:use-module (ice-9 optargs) + #:use-module (ice-9 match) + #:declarative? #t + #:export + ( + + make-authorization-endpoint + + )) (define (verify-password encrypted-password password) (let ((c (crypt password encrypted-password))) (string=? c encrypted-password))) -(define*-public (make-authorization-endpoint subject encrypted-password alg jwk validity - #:key - (http-get http-get)) +(define* (make-authorization-endpoint subject encrypted-password alg jwk validity + #:key + (http-get http-get)) (define (parse-arg x decode-plus-to-space?) (map (lambda (x) (uri-decode x @@ -51,35 +60,40 @@ (query-parts (if query (string-split query #\&) '())) - (get-args (map (lambda (x) (parse-arg x #f)) query-parts)) + (get-args (map (cute parse-arg <> #f) query-parts)) (form-args - (if (and - (request-content-type request) - (eq? (car (request-content-type request)) - 'application/x-www-form-urlencoded)) - (let ((parts (string-split request-body #\&))) - (map (lambda (x) (parse-arg x #t)) parts)) - '())) + (match (request-content-type request) + ((application/x-www-form-urlencoded . _) + (map (cute parse-arg <> #t) + (string-split request-body #\&))) + (else '()))) (accept-language (sort (request-accept-language request) (lambda (x y) (>= (car x) (car y))))) - (locale (if (null? accept-language) - "C" - (cdar accept-language)))) - (let ((client-id (assoc-ref get-args "client_id")) - (redirect-uri (assoc-ref get-args "redirect_uri")) - (password (assoc-ref form-args "password")) - (state (assoc-ref get-args "state"))) - (when client-id - (set! client-id - (string->uri (car client-id)))) - (when redirect-uri - (set! redirect-uri - (string->uri (car redirect-uri)))) - (when password - (set! password (car password))) - (when state - (set! state (car state))) + (locale + (match accept-language + (((_ . lng) _ ...) lng) + (else "C")))) + (let ((client-id + (match (assoc-ref get-args "client_id") + (((? string->uri client-id) . _) + (string->uri client-id)) + (else #f))) + (redirect-uri + (match (assoc-ref get-args "redirect_uri") + (((? string->uri redirect-uri) . _) + (string->uri redirect-uri)) + (else #f))) + (password + (match (assoc-ref form-args "password") + ((password . _) + password) + (else #f))) + (state + (match (assoc-ref get-args "state") + ((state . _) + state) + (else #f)))) (cond ((not client-id) (error-no-client-id locale)) @@ -92,30 +106,29 @@ (lambda (error) (error-application locale error)) (lambda () - (let* ((current-time ((p:current-date))) ;; current-date is a thunk parameter - (current-sec - (time-second (date->time-utc current-time))) - (exp-sec (+ current-sec validity)) - (exp (time-utc->date (make-time time-utc 0 exp-sec))) - (code (issue-authorization-code alg jwk exp subject client-id))) - (let ((mf (get-client-manifest client-id - #:http-get http-get))) - (client-manifest-check-redirect-uri mf redirect-uri) - (let ((query - (if state - (format #f "code=~a&state=~a" - (uri-encode code) - (uri-encode state)) - (format #f "code=~a" - (uri-encode code))))) - (let ((uri - (build-uri 'https - #:userinfo (uri-userinfo redirect-uri) - #:host (uri-host redirect-uri) - #:port (uri-port redirect-uri) - #:path (uri-path redirect-uri) - #:query query))) - (redirection locale client-id uri)))))) + (let ((code (issue-authorization-code + jwk + #:alg alg + #:webid subject + #:client-id client-id)) + (mf (get-client-manifest client-id + #:http-get http-get))) + (client-manifest-check-redirect-uri mf redirect-uri) + (let ((query + (if state + (format #f "code=~a&state=~a" + (uri-encode code) + (uri-encode state)) + (format #f "code=~a" + (uri-encode code))))) + (let ((uri + (build-uri 'https + #:userinfo (uri-userinfo redirect-uri) + #:host (uri-host redirect-uri) + #:port (uri-port redirect-uri) + #:path (uri-path redirect-uri) + #:query query))) + (redirection locale client-id uri))))) #:unwind? #t)) (else (authorization-page locale diff --git a/src/scm/webid-oidc/authorization-page-unsafe.scm b/src/scm/webid-oidc/authorization-page-unsafe.scm index 1ab235e..a6f5c3b 100644 --- a/src/scm/webid-oidc/authorization-page-unsafe.scm +++ b/src/scm/webid-oidc/authorization-page-unsafe.scm @@ -1,4 +1,4 @@ -;; webid-oidc, implementation of the Solid specification +;; disfluid, implementation of the Solid specification ;; Copyright (C) 2020, 2021 Vivien Kraus ;; This program is free software: you can redistribute it and/or modify @@ -19,21 +19,28 @@ #:use-module (sxml simple) #:use-module (web uri) #:use-module (web response) - #:use-module (ice-9 i18n) + #:use-module (webid-oidc web-i18n) #:use-module (ice-9 exceptions) - #:use-module (ice-9 string-fun)) - -(define (G_ text) - (let ((out (gettext text))) - (if (string=? out text) - ;; No translation, disambiguate - (car (reverse (string-split text #\|))) - out))) + #:use-module (ice-9 string-fun) + #:use-module (ice-9 match) + #:use-module (sxml simple) + #:use-module (sxml match) + #:declarative? #t + #:export + ( + authorization-page + error-no-client-id + error-no-redirect-uri + error-application + redirection + )) (define (str->sxml str) - (cdadr + (sxml-match (xml->sxml - (string-append "<protect>" str "</protect>")))) + (string-append "<protect>" str "</protect>")) + ((*TOP* (protect ,element ...)) + (list element ...)))) (define (make-page title . body) (with-output-to-string @@ -42,31 +49,30 @@ `(*TOP* (*PI* xml "version=\"1.0\" encoding=\"utf-8\"") (html (@ (xmlns "http://www.w3.org/1999/xhtml") - (xml:lang ,(G_ "xml-lang|en"))) + (xml:lang ,(W_ "xml-lang|en"))) (head (title ,title)) (body ,@body))))))) -(define-public (authorization-page credential-invalid? - client-id post-uri) +(define (authorization-page credential-invalid? + client-id post-uri) (when (uri? client-id) (set! client-id (uri->string client-id))) (when (string? post-uri) (set! post-uri (string->uri post-uri))) (values (build-response #:headers `((content-type application/xhtml+xml))) - (make-page - (G_ "page-title|Authorization") + (W_ "page-title|Authorization") (if (equal? (string->uri client-id) (string->uri "http://www.w3.org/ns/solid/terms#PublicOidcClient")) - `(h1 ,@(str->sxml (G_ "Authorize this anonymous application?"))) - `(h1 ,@(str->sxml (format #f (G_ "Authorize <a href=~s>~a</a>?") + `(h1 ,@(str->sxml (W_ "Authorize this anonymous application?"))) + `(h1 ,@(str->sxml (format #f (W_ "Authorize <a href=~s>~a</a>?") client-id client-id)))) - `(p ,@(str->sxml (G_ "Do you want to authorize this application to represent you?"))) + `(p ,@(str->sxml (W_ "Do you want to authorize this application to represent you?"))) `(form (@ (action ,(uri->string post-uri)) (method "POST")) (div @@ -76,126 +82,56 @@ '())) ,@(str->sxml (if credential-invalid? - (G_ "Please retry your password:") - (G_ "Please enter your password:")))) + (W_ "Please retry your password:") + (W_ "Please enter your password:")))) (input (@ (type "password") (name "password") (id "password")))) (input (@ (type "submit") - (value ,(G_ "Allow")))))))) + (value ,(W_ "Allow")))))))) (define (bad-request . body) (values (build-response #:code 400 #:reason-phrase "Bad Request" #:headers '((content-type application/xhtml+xml))) - (apply make-page (G_ "Bad request") body))) + (apply make-page (W_ "Bad request") body))) -(define-public (error-no-client-id) +(define (error-no-client-id) (bad-request `(p ,@(str->sxml - (G_ "The application did not set the <emph>client_id</emph> parameter."))))) + (W_ "The application did not set the <emph>client_id</emph> parameter."))))) -(define-public (error-no-redirect-uri) +(define (error-no-redirect-uri) (bad-request `(p ,@(str->sxml - (G_ "The application did not set the <emph>redirect_uri</emph> parameter."))))) + (W_ "The application did not set the <emph>redirect_uri</emph> parameter."))))) (define (wrap-error err) - (if (record? err) - (let* ((type (record-type-descriptor err)) - (get - (lambda (slot) - ((record-accessor type slot) err))) - (recurse - (lambda (err) - (wrap-error err)))) - (case (record-type-name type) - ((¬-base64) - `((li ,(format #f (G_ "the value ~s is not a base64 string.") - (get 'value))))) - ((¬-json) - `((li ,(format #f (G_ "the following value is not JSON:")) - (pre ,(get 'value))))) - ((¬-turtle) - `((li ,(format #f (G_ "the following value is not Turtle:")) - (pre ,(get 'value))))) - ((&response-failed-unexpectedly) - `((li ,(format #f (G_ "the server request unexpectedly failed with code ~a and reason phrase ~s.") - (get 'response-code) (get 'response-reason-phrase))))) - ((&unexpected-header-value) - `((li ,(let ((value (get 'value))) - (if value - (format #f (G_ "the header ~a should not have the value ~s.\n") - (get 'header) value) - (format #f (G_ "the header ~a should be present.") - (get 'header))))))) - ((&unexpected-response) - (cons - `(li ,(format #f (G_ "the server response wasn’t expected:")) - (pre ,(call-with-output-string - (lambda (port) - (write-response (get 'response) port))))) - (recurse (get 'cause)))) - ((&incorrect-client-id-field) - (let ((value (get 'value))) - `((li - ,(if value - (format #f (G_ "the client_id field is incorrect: ~s") value) - (G_ "the client_id field is missing")))))) - ((&incorrect-redirect-uris-field) - (let ((value (get 'value))) - `((li - ,(if value - (format #f (G_ "the redirect_uris field is incorrect: ~s") value) - (G_ "the redirect_uris field is missing")))))) - ((&cannot-fetch-linked-data) - (cons - `(li ,(format #f (G_ "I could not fetch a RDF graph at ~a;") (uri->string (get 'uri)))) - (recurse (get 'cause)))) - ((¬-a-client-manifest) - (cons - `(li ,(format #f (G_ "this is not a client manifest:")) - (pre ,(format #f "~s" (get 'value)))) - (recurse (get 'cause)))) - ((&unauthorized-redirection-uri) - (cons - `(li ,(format #f (G_ "the manifest does not authorize redirection URI ~a:") - (uri->string (get 'uri))) - (pre ,(format #f "~s" (get 'manifest)))) - (recurse (get 'cause)))) - ((&inconsistent-client-manifest-id) - `((li ,(format #f (G_ "the client manifest at ~a is advertised for ~a;") - (uri->string (get 'id)) - (uri->string (get 'advertised-id)))))) - ((&cannot-fetch-client-manifest) - (cons - `(li ,(format #f (G_ "I could not fetch the client manifest of ~a;") - (uri->string (get 'id)))) - (recurse (get 'cause)))) - ((¬-an-authorization-code-payload) - (cons - `(li ,(format #f (G_ "I could not issue an authorization code for you;"))) - (recurse (get 'cause)))) - (else - (raise-exception err)))) - (throw err))) + (if (message-for-the-user? err) + (user-message err) + `(p (W_ "Sorry, no more information is available.")))) -(define-public (error-application error) +(define (error-application error) (bad-request - `(p ,(G_ "The application you are trying to authorize behaved unexpectedly. Here is the explanation of the error:") - (ol ,@(wrap-error error))))) + `(div + (p ,(W_ "The application you are trying to authorize behaved unexpectedly.")) + ,@(sxml-match + (wrap-error error) + ((div ,element ...) + `(,element ...)) + (,else `(,else)))))) -(define-public (redirection client-id uri) +(define (redirection client-id uri) (values (build-response #:code 302 #:headers `((location . ,uri) (content-type application/xhtml+xml))) (make-page - (G_ "Redirecting...") + (W_ "Redirecting...") `(h1 "Authorization granted, you are being redirected") `(p ,@(str->sxml (format #f - (G_ "<a href=~s>~a</a> can now log in on your behalf. You still need to adjust permissions.") + (W_ "<p><a href=~s>~a</a> can now log in on your behalf. You still need to adjust permissions.</p>") (uri->string client-id) (uri->string client-id))))))) diff --git a/src/scm/webid-oidc/authorization-page.scm b/src/scm/webid-oidc/authorization-page.scm index 453275b..536137e 100644 --- a/src/scm/webid-oidc/authorization-page.scm +++ b/src/scm/webid-oidc/authorization-page.scm @@ -1,4 +1,4 @@ -;; webid-oidc, implementation of the Solid specification +;; disfluid, implementation of the Solid specification ;; Copyright (C) 2020, 2021 Vivien Kraus ;; This program is free software: you can redistribute it and/or modify @@ -16,60 +16,41 @@ (define-module (webid-oidc authorization-page) #:use-module (webid-oidc errors) + #:use-module ((webid-oidc web-i18n) #:prefix i18n:) #:use-module ((webid-oidc authorization-page-unsafe) #:prefix unsafe:) - #:use-module (ice-9 i18n) #:use-module (ice-9 string-fun) #:use-module (ice-9 receive) - #:use-module (ice-9 threads)) - -(define locale-mutex - (make-mutex)) - -(define-syntax with-locale - (syntax-rules () - ((with-locale web-locale . job) - (let ((locale-with-underscore - (if (equal? web-locale "C") - ;; For the unit tests - "C" - (string-append - (string-replace-substring web-locale "-" "_") - ".UTF-8"))) - (previous-locale (setlocale LC_ALL))) - (dynamic-wind - (lambda () - (lock-mutex locale-mutex)) - (lambda () - (dynamic-wind - (lambda () - (with-exception-handler - (lambda (error) - (raise-unknown-client-locale web-locale locale-with-underscore) - (setlocale LC_ALL "C")) - (lambda () - (setlocale LC_ALL locale-with-underscore)) - #:unwind? #t)) - (lambda () . job) - (lambda () - (setlocale LC_ALL previous-locale)))) - (lambda () - (unlock-mutex locale-mutex))))))) - -(define-public (authorization-page - locale credential-invalid? client-id post-uri) - (with-locale - locale - (unsafe:authorization-page credential-invalid? - client-id post-uri))) - -(define-public (error-no-client-id locale) - (with-locale locale (unsafe:error-no-client-id))) - -(define-public (error-no-redirect-uri locale) - (with-locale locale (unsafe:error-no-redirect-uri))) - -(define-public (error-application locale error) - (with-locale locale (unsafe:error-application error))) - -(define-public (redirection locale client-id uri) - (with-locale locale (unsafe:redirection client-id uri))) + #:use-module (ice-9 threads) + #:declarative? #t + #:export + ( + + authorization-page + error-no-client-id + error-no-redirect-uri + error-application + redirection + + )) + +(define (authorization-page + locale credential-invalid? client-id post-uri) + (parameterize ((i18n:web-locale locale)) + (unsafe:authorization-page credential-invalid? + client-id post-uri))) + +(define (error-no-client-id locale) + (parameterize ((i18n:web-locale locale)) + (unsafe:error-no-client-id))) + +(define (error-no-redirect-uri locale) + (parameterize ((i18n:web-locale locale)) + (unsafe:error-no-redirect-uri))) + +(define (error-application locale error) + (parameterize ((i18n:web-locale locale)) + (unsafe:error-application error))) + +(define (redirection locale client-id uri) + (parameterize ((i18n:web-locale locale)) + (unsafe:redirection client-id uri))) diff --git a/src/scm/webid-oidc/cache.scm b/src/scm/webid-oidc/cache.scm index e98f87f..c9d7b26 100644 --- a/src/scm/webid-oidc/cache.scm +++ b/src/scm/webid-oidc/cache.scm @@ -17,6 +17,7 @@ (define-module (webid-oidc cache) #:use-module ((webid-oidc stubs) #:prefix stubs:) #:use-module ((webid-oidc parameters) #:prefix p:) + #:use-module (webid-oidc web-i18n) #:use-module (web client) #:use-module (web request) #:use-module (web response) @@ -26,6 +27,7 @@ #:use-module (ice-9 optargs) #:use-module (srfi srfi-19) #:use-module (rnrs bytevectors) + #:declarative? #t #:export ( clean-cache @@ -89,19 +91,19 @@ (unless (false-if-exception (begin - (format (current-error-port) "Dropping cache item ~a.~%" name) + (format (current-error-port) (G_ "Dropping cache item ~a.~%") name) (stubs:atomically-update-file name lock-file (lambda (whatever) #f)))) - (format (current-error-port) "Could not clean file ~a.~%" name))) + (format (current-error-port) (G_ "Could not clean file ~a.~%") name))) result) (define (down name stat result) result) (define (up name stat result) result) (define (skip name stat result) result) (define (error name stat errno result) - (format (current-error-port) "While cleaning the cache: ~a: ~a~%" + (format (current-error-port) (G_ "While cleaning the cache: ~a: ~a~%") name (strerror errno)) result) (file-system-fold enter? leaf down up skip error 0 @@ -161,7 +163,7 @@ (let ((response (read-response port))) (values request response (read-response-body response))))))) (lambda error - (format (current-error-port) "Cache miss for ~a: ~s~%" + (format (current-error-port) (G_ "Cache miss for ~a: ~s~%") (uri->string uri) error) (values #f #f #f))))) @@ -255,7 +257,9 @@ (let ((valid (valid? stored-response)) (invariant (not (varies? request stored-request stored-response)))) (unless invariant - (format (current-error-port) "Cache entry for ~a varies.\n" (uri->string uri))) + (format (current-error-port) + (G_ "Cache entry for ~a varies.\n") + (uri->string uri))) (if (and valid invariant) (values stored-response body) (receive (final-response final-body) diff --git a/src/scm/webid-oidc/catalog.scm b/src/scm/webid-oidc/catalog.scm index 11e0877..e12ebe6 100644 --- a/src/scm/webid-oidc/catalog.scm +++ b/src/scm/webid-oidc/catalog.scm @@ -1,4 +1,4 @@ -;; webid-oidc, implementation of the Solid specification +;; disfluid, implementation of the Solid specification ;; Copyright (C) 2020, 2021 Vivien Kraus ;; This program is free software: you can redistribute it and/or modify @@ -24,6 +24,8 @@ #:use-module (sxml match) #:use-module (ice-9 optargs) #:use-module (ice-9 receive) + #:use-module (webid-oidc web-i18n) + #:declarative? #t #:export (resolve-uri)) (define useful-namespaces @@ -161,7 +163,7 @@ (("." components ...) (with-absolute-relative-path defined components)) ((".." components ...) (match defined - (() (error "Invalid relative URI")) + (() (fail (G_ "invalid relative URI"))) ((dropped kept ...) (with-absolute-relative-path kept components)))) ((head components ...) @@ -240,7 +242,8 @@ (lambda (port) (xml->sxml port #:namespaces useful-namespaces)))) (else - (error (format #f "Unsupported delegate catalog URI scheme: ~s\n" (uri-scheme uri)))))) + (error (format #f (G_ "Unsupported delegate catalog URI scheme: ~s\n") + (uri-scheme uri)))))) (define* (resolve-uri uri #:key (http-get http-get)) (when (string? uri) diff --git a/src/scm/webid-oidc/client-manifest.scm b/src/scm/webid-oidc/client-manifest.scm index c4b49f0..847fc54 100644 --- a/src/scm/webid-oidc/client-manifest.scm +++ b/src/scm/webid-oidc/client-manifest.scm @@ -1,4 +1,4 @@ -;; webid-oidc, implementation of the Solid specification +;; disfluid, implementation of the Solid specification ;; Copyright (C) 2020, 2021 Vivien Kraus ;; This program is free software: you can redistribute it and/or modify @@ -17,61 +17,194 @@ (define-module (webid-oidc client-manifest) #:use-module (webid-oidc errors) #:use-module (webid-oidc fetch) + #:use-module (webid-oidc web-i18n) #:use-module ((webid-oidc stubs) #:prefix stubs:) #:use-module (web uri) #:use-module (web client) #:use-module (web response) #:use-module (rnrs bytevectors) #:use-module (srfi srfi-19) + #:use-module (srfi srfi-26) #:use-module (ice-9 receive) #:use-module (ice-9 optargs) #:use-module (rdf rdf) - #:use-module (turtle tordf)) + #:use-module (turtle tordf) + #:use-module (ice-9 exceptions) + #:use-module (ice-9 match) + #:use-module (sxml match) + #:use-module (sxml simple) + #:declarative? #t + #:export + ( -(define-public public-oidc-client + public-oidc-client + + &invalid-client-manifest + make-invalid-client-manifest + invalid-client-manifest? + + &unauthorized-redirect-uri + make-unauthorized-redirect-uri + unauthorized-redirect-uri? + + &inconsistent-client-manifest + make-inconsistent-client-manifest + inconsistent-client-manifest? + + &cannot-serve-public-manifest + make-cannot-serve-public-manifest + cannot-serve-public-manifest? + + &cannot-fetch-client-manifest + make-cannot-fetch-client-manifest + cannot-fetch-client-manifest? + + the-client-manifest + client-manifest? + make-client-manifest + client-manifest-client-id + client-manifest-check-redirect-uri + + serve-client-manifest + get-client-manifest + + )) + +(define public-oidc-client 'public-oidc-client) -(define-public (all-uris x) - (or (null? x) - (and (string->uri (car x)) - (all-uris (cdr x))))) - -(define-public (the-client-manifest x) - (if (eq? x public-oidc-client) - public-oidc-client - (let ((client-id (assq-ref x 'client_id)) - (redirect-uris (assq-ref x 'redirect_uris))) - (unless (and client-id (string? client-id) (string->uri client-id)) - (raise-incorrect-client-id-field client-id)) - (unless (and redirect-uris - (vector? redirect-uris) - (all-uris (vector->list redirect-uris))) - (raise-incorrect-redirect-uris-field redirect-uris)) - x))) - -(define-public (client-manifest? obj) +(define-exception-type + &invalid-client-manifest + &external-error + make-invalid-client-manifest + invalid-client-manifest?) + +(define-exception-type + &unauthorized-redirect-uri + &external-error + make-unauthorized-redirect-uri + unauthorized-redirect-uri?) + +(define-exception-type + &inconsistent-client-manifest + &external-error + make-inconsistent-client-manifest + inconsistent-client-manifest?) + +(define-exception-type + &cannot-serve-public-manifest + &external-error + make-cannot-serve-public-manifest + cannot-serve-public-manifest?) + +(define-exception-type + &cannot-fetch-client-manifest + &external-error + make-cannot-fetch-client-manifest + cannot-fetch-client-manifest?) + +(define (the-client-manifest x) + (with-exception-handler + (lambda (error) + (let ((sysadmin-message + (if (exception-with-message? error) + (format #f (G_ "this is not a client manifest: ~a") + (exception-message error)) + (format #f (G_ "this is not a client manifest")))) + (user-message + (let ((new-paragraph + (sxml-match + (xml->sxml (W_ "<p>The client manifest could +not be queried. It can be because the client application is down, or +it is incomplete, or unusable for other reasons.</p>")) + ((*TOP* ,element) + element)))) + (if (message-for-the-user? error) + (sxml-match + (user-message error) + ((div ,element ...) + `(div ,new-paragraph ,element ...)) + (,element + `(div ,new-paragraph ,element))) + new-paragraph)))) + (raise-exception + (make-exception + (make-invalid-client-manifest) + (make-exception-with-message sysadmin-message) + (make-message-for-the-user user-message) + error)))) + (lambda () + (let examine-fields ((fields x) + (client-id #f) + (redirect-uris #f) + (other-fields '())) + (match fields + (() + (unless (and client-id redirect-uris) + (fail (format #f (G_ "the client manifest is missing ~s") + (apply append + `(,@(if client-id '() '("client_id")) + ,@(if redirect-uris '() '("redirect_uris"))))))) + `((client_id . ,(uri->string client-id)) + (redirect_uris . ,(list->vector (map uri->string redirect-uris))) + ,@(reverse other-fields))) + ((('client_id . (? string? (= string->uri (? uri? client-id-given)))) fields ...) + (examine-fields fields (or client-id client-id-given) + redirect-uris other-fields)) + ((('client_id . invalid) _ ...) + (fail (format #f (G_ "~s is an invalid \"client_id\" value, because it is not an URI") + invalid))) + ((('redirect_uris . #((? string? (= string->uri (? uri? uri))) ...)) fields ...) + (examine-fields fields client-id (or redirect-uris uri) other-fields)) + ((('redirect_uris . #(_ ...)) _ ...) + (fail (format #f (G_ "at least one of the redirect URIs is not a proper URI")))) + ((('redirect_uris . _) _ ...) + (fail (format #f (G_ "the \"redirect_uris\" field should be a vector of URIs")))) + ((other-field fields ...) + (examine-fields fields client-id redirect-uris + `(,other-field ,@other-fields))) + (else + (fail (format #f (G_ "the client manifest should be a JSON object"))))))))) + +(define (client-manifest? x) (false-if-exception - (and (the-client-manifest obj) #t))) + (the-client-manifest x))) -(define-public (make-client-manifest client-id redirect-uris) +(define (make-client-manifest client-id redirect-uris) (the-client-manifest `((client_id . ,(uri->string client-id)) (redirect_uris . ,(list->vector (map uri->string redirect-uris)))))) -(define-public (client-manifest-client-id mf) +(define (client-manifest-client-id mf) (if (eq? mf public-oidc-client) (string->uri "http://www.w3.org/ns/solid/terms#PublicOidcClient") (string->uri (assq-ref (the-client-manifest mf) 'client_id)))) (define (check-redirect mf uris redir) - (if (null? uris) - (raise-unauthorized-redirection-uri mf (string->uri redir)) - (or (string=? (car uris) redir) - (check-redirect mf (cdr uris) redir)))) + (match uris + (() + (let ((final-message + (format #f (G_ "the client manifest does not allow ~s as a redirection uri") + (uri->string redir))) + (final-user-message + (sxml-match + (xml->sxml (W_ "<p>The application wants to get your +authorization through <strong>~s</strong>, which is not +approved.</p>")) + ((*TOP* ,element) element)))) + (raise-exception + (make-exception + (make-unauthorized-redirect-uri) + (make-exception-with-message final-message) + (make-message-for-the-user final-user-message))))) + (((? (cute equal? <> redir) redir) _ ...) + #t) + ((_ uris ...) + (check-redirect mf uris redir)))) -(define-public (client-manifest-check-redirect-uri mf redir) +(define (client-manifest-check-redirect-uri mf redir) (unless (uri? redir) (set! redir (string->uri redir))) (if (eq? mf public-oidc-client) @@ -79,12 +212,17 @@ (let ((redirect-uris (assq-ref (the-client-manifest mf) 'redirect_uris))) (check-redirect (the-client-manifest mf) - (vector->list redirect-uris) - (uri->string redir))))) + (map string->uri (vector->list redirect-uris)) + redir)))) -(define-public (serve-client-manifest expiration-date mf) +(define (serve-client-manifest expiration-date mf) (when (eq? mf public-oidc-client) - (raise-cannot-serve-public-manifest)) + (let ((final-message + (format #f (G_ "cannot serve the public manifest")))) + (raise-exception + (make-exception + (make-cannot-serve-public-manifest) + (make-exception-with-message final-message))))) (let ((json-object (stubs:scm->json-string `((@context . "https://www.w3.org/ns/solid/oidc-context.jsonld") ,@(the-client-manifest mf))))) @@ -92,14 +230,25 @@ (expires . ,expiration-date))) json-object))) -(define*-public (get-client-manifest id - #:key - (http-get http-get)) +(define* (get-client-manifest id + #:key + (http-get http-get)) (unless (uri? id) (set! id (string->uri id))) (with-exception-handler (lambda (error) - (raise-cannot-fetch-client-manifest id error)) + (let ((final-message + (if (exception-with-message? error) + (format #f (G_ "cannot fetch the client manifest ~s: ~a") + (uri->string id) + (exception-message error)) + (format #f (G_ "cannot fetch the client manifest ~s") + (uri->string id))))) + (raise-exception + (make-exception + (make-cannot-fetch-client-manifest) + (make-exception-with-message final-message) + error)))) (lambda () (if (equal? id (string->uri @@ -110,9 +259,13 @@ (when (bytevector? response-body) (set! response-body (utf8->string response-body))) (let ((mf (the-client-manifest (stubs:json-string->scm response-body)))) - (unless (equal? (uri->string (client-manifest-client-id mf)) - (uri->string id)) - (raise-inconsistent-client-manifest-id - id - (client-manifest-client-id mf))) + (unless (equal? (client-manifest-client-id mf) id) + (let ((final-message + (format #f (G_ "the client manifest is dereferenced from ~s, but it pretends to be ~s") + (uri->string id) + (uri->string (client-manifest-client-id mf))))) + (raise-exception + (make-exception + (make-inconsistent-client-manifest) + (make-exception-with-message final-message))))) mf)))))) diff --git a/src/scm/webid-oidc/client.scm b/src/scm/webid-oidc/client.scm index 4fdb824..f469d19 100644 --- a/src/scm/webid-oidc/client.scm +++ b/src/scm/webid-oidc/client.scm @@ -57,6 +57,9 @@ ) #:declarative? #t) +;; Better for syntax highlighting +(define <client:account> client:<account>) + (define-record-type <client> (make-client id key redirect-uri) client? @@ -124,7 +127,7 @@ #:client-id client-id #:client-key client-key #:redirect-uri redirect-uri))) - (($ <account> subject issuer _ _ _ _) + ((($ <client:account> subject issuer _ _ _ _)) (client:save-account (client:login subject issuer #:http-get my-http-get diff --git a/src/scm/webid-oidc/client/accounts.scm b/src/scm/webid-oidc/client/accounts.scm index 98fef85..447f760 100644 --- a/src/scm/webid-oidc/client/accounts.scm +++ b/src/scm/webid-oidc/client/accounts.scm @@ -17,6 +17,7 @@ #:use-module (web uri) #:use-module (web response) #:use-module (rnrs bytevectors) + #:declarative? #t #:export ( <account> @@ -79,17 +80,24 @@ (response token-request-response) (response-body token-request-response-body)) +(define-exception-type + &refresh-token-expired + &external-error + make-refresh-token-expired + refresh-token-expired?) + (define authorization-process (make-parameter (lambda* (uri #:key issuer) - (raise-exception - (make-exception - (make-authorization-code-required uri) - (make-exception-with-message - (G_ (format #f "An authorization code is required to log in with ~s, it can be obtained at ~s." - (uri->string issuer) - (uri->string uri))))) - #:continuable? #t)))) + (let ((final-message + (G_ (format #f "An authorization code is required to log in with ~s, it can be obtained at ~s." + (uri->string issuer) + (uri->string uri))))) + (raise-exception + (make-exception + (make-authorization-code-required uri) + (make-exception-with-message final-message)) + #:continuable? #t))))) (define-record-type <account> (make-account subject issuer id-token access-token refresh-token keypair) @@ -118,16 +126,17 @@ ((hd tl ...) (sxml-match hd - ((disfluid:id-token (@ (sub ,sub) (aud ,aud) (nonce ,nonce) (iat ,iat) (exp ,exp))) + ((disfluid:id-token (@ (alg ,alg) (sub ,sub) (aud ,aud) (nonce ,nonce) (iat ,iat) (exp ,exp))) (collect-arguments - (id:the-id-token-payload - `((webid . ,(uri->string subject)) - (iss . ,(uri->string issuer)) - (sub . ,sub) - (aud . ,aud) - (nonce . ,nonce) - (iat . ,(string->number iat)) - (exp . ,(string->number exp)))) + (id:the-id-token + `(((alg . ,alg)) + . ((webid . ,(uri->string subject)) + (iss . ,(uri->string issuer)) + (sub . ,sub) + (aud . ,aud) + (nonce . ,nonce) + (iat . ,(string->number iat)) + (exp . ,(string->number exp))))) access-token refresh-token keypair @@ -240,7 +249,8 @@ '()) (issuer ,(uri->string issuer))) ,@(if id-token - `((id-token (@ (sub ,(id:id-token-sub id-token)) + `((id-token (@ (alg ,(symbol->string (id:id-token-alg id-token))) + (sub ,(id:id-token-sub id-token)) (aud ,(uri->string (id:id-token-aud id-token))) (nonce ,(id:id-token-nonce id-token)) (iat @@ -404,105 +414,118 @@ (save-account (invalidate-refresh-token (make-account subject issuer #f #f #f #f)))) - (raise-exception - (make-refresh-token-expired) - (make-exception-with-message - (G_ (format #f "The refresh token has expired."))))) + (let ((final-message + (format #f (G_ "The refresh token has expired.")))) + (raise-exception + (make-exception + (make-refresh-token-expired) + (make-exception-with-message final-message))))) (unless (eqv? (response-code response) 200) - (raise-exception - (make-exception - (make-token-request-failed response response-body) - (make-exception-with-message - (G_ (format #f "The token request failed with code ~s (~s).") - (response-code response) - (response-reason-phrase response)))))) + (let ((final-message + (G_ (format #f "The token request failed with code ~s (~s).") + (response-code response) + (response-reason-phrase response)))) + (raise-exception + (make-exception + (make-token-request-failed response response-body) + (make-exception-with-message final-message))))) (unless (response-content-type response) - (raise-exception - (make-exception - (make-token-request-failed response response-body) - (make-exception-with-message - (G_ (format #f "The token response did not set the content type.")))))) + (let ((final-message + (format #f (G_ "The token response did not set the content type.")))) + (raise-exception + (make-exception + (make-token-request-failed response response-body) + (make-exception-with-message final-message))))) (with-exception-handler (lambda (encoding-error) - (raise-exception - (make-exception - (make-token-request-failed response response-body) - (make-exception-with-message - (G_ (format #f "The token endpoint did not respond in UTF-8."))) - encoding-error))) + (let ((final-message + (format #f (G_ "The token endpoint did not respond in UTF-8.")))) + (raise-exception + (make-exception + (make-token-request-failed response response-body) + (make-exception-with-message final-message) + encoding-error)))) (lambda () (when (bytevector? response-body) (set! response-body (utf8->string response-body))))) (unless (eq? (car (response-content-type response)) 'application/json) - (raise-exception - (make-exception - (make-token-request-failed response response-body) - (make-exception-with-message - (G_ (format #f "The token response has content-type ~s, not application/json.") - (response-content-type response)))))) + (let ((final-message + (format #f (G_ "The token response has content-type ~s, not application/json.") + (response-content-type response)))) + (raise-exception + (make-exception + (make-token-request-failed response response-body) + (make-exception-with-message final-message))))) (let ((data (with-exception-handler (lambda (json-error) - (raise-exception - (make-exception - (make-token-request-failed response response-body) - (make-exception-with-message - (G_ (format #f "The token response is not valid JSON."))) - json-error))) + (let ((final-message + (format #f (G_ "The token response is not valid JSON.")))) + (raise-exception + (make-exception + (make-token-request-failed response response-body) + (make-exception-with-message final-message) + json-error)))) (lambda () (stubs:json-string->scm response-body))))) (let ((id-token (assq-ref data 'id_token)) (access-token (assq-ref data 'access_token)) (refresh-token (assq-ref data 'refresh_token))) (unless id-token - (raise-exception - (make-exception - (make-token-request-failed response response-body) - (make-exception-with-message - (G_ (format #f "The token response did not include an ID token: ~s") - data))))) + (let ((final-message + (format #f (G_ "The token response did not include an ID token: ~s") + data))) + (raise-exception + (make-exception + (make-token-request-failed response response-body) + (make-exception-with-message final-message))))) (unless access-token - (raise-exception - (make-exception - (make-token-request-failed response response-body) - (make-exception-with-message - (G_ (format #f "The token response did not include an access token: ~s + (let ((final-message + (format #f (G_ "The token response did not include an access token: ~s ") - data))))) + data))) + (raise-exception + (make-exception + (make-token-request-failed response response-body) + (make-exception-with-message final-message))))) (with-exception-handler (lambda (decoding-error) - (raise-exception - (make-exception - (make-token-request-failed response response-body) - (make-exception-with-message - (G_ (format #f "The ID token signature is invalid."))) - decoding-error))) + (let ((final-message + (if (exception-with-message? decoding-error) + (format #f (G_ "the ID token signature is invalid: ~a") + (exception-message decoding-error)) + (format #f (G_ "the ID token signature is invalid"))))) + (raise-exception + (make-exception + (make-token-request-failed response response-body) + (make-exception-with-message final-message) + decoding-error)))) (lambda () - (match (id:id-token-decode id-token #:http-get http-get) - ((header . payload) - (set! id-token payload))))) + (set! id-token (id:id-token-decode id-token #:http-get http-get)))) ;; 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)))) - (raise-exception - (make-exception - (make-token-request-failed response response-body) - (make-exception-with-message - (G_ (format #f "The ID token delivered by the identity provider for ~s has ~s as webid.") - (uri->string subject) - (id:id-token-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)))) + (raise-exception + (make-exception + (make-token-request-failed response response-body) + (make-exception-with-message final-message))))) (when (not (equal? issuer (id:id-token-iss id-token))) - (raise-exception - (make-exception - (make-token-request-failed response response-body) - (make-exception-with-message - (G_ (format #f "The ID token delivered by the identity provider ~s is for issuer ~s.") - (uri->string issuer) - (id:id-token-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) + (id:id-token-iss id-token)))) + (raise-exception + (make-exception + (make-token-request-failed response response-body) + (make-exception-with-message final-message))))) (make-account (id:id-token-webid id-token) issuer diff --git a/src/scm/webid-oidc/dpop-proof.scm b/src/scm/webid-oidc/dpop-proof.scm index 2ccbddc..b1e07f9 100644 --- a/src/scm/webid-oidc/dpop-proof.scm +++ b/src/scm/webid-oidc/dpop-proof.scm @@ -1,4 +1,4 @@ -;; webid-oidc, implementation of the Solid specification +;; disfluid, implementation of the Solid specification ;; Copyright (C) 2020, 2021 Vivien Kraus ;; This program is free software: you can redistribute it and/or modify @@ -21,156 +21,241 @@ #:use-module (webid-oidc jti) #:use-module ((webid-oidc stubs) #:prefix stubs:) #:use-module ((webid-oidc parameters) #:prefix p:) + #:use-module (webid-oidc web-i18n) #:use-module (web uri) #:use-module (ice-9 optargs) - #:use-module (srfi srfi-19)) + #:use-module (ice-9 exceptions) + #:use-module (ice-9 match) + #:use-module (srfi srfi-19) + #:use-module (srfi srfi-26) + #:declarative? #t + #:export + ( -(define-public (the-dpop-proof-header x) - (with-exception-handler - (lambda (error) - (raise-not-a-dpop-proof-header x error)) - (lambda () - (let ((x (the-jws-header x))) - (let ((alg (assq-ref x 'alg)) - (typ (assq-ref x 'typ)) - (jwk (assq-ref x 'jwk))) - (unless (and alg (string? alg)) - (raise-unsupported-alg alg)) - (case (string->symbol alg) - ((RS256 RS384 RS512 ES256 ES384 ES512 PS256 PS384 PS512) - #t) - (else - (raise-unsupported-alg alg))) - (unless (equal? typ "dpop+jwt") - (raise-incorrect-typ-field typ)) - (with-exception-handler - (lambda (error) - (raise-incorrect-jwk-field jwk error)) - (lambda () - (the-public-jwk jwk))) - x))))) - -(define-public (dpop-proof-header? x) - (false-if-exception - (and (the-dpop-proof-header x) #t))) - -(define-public (the-dpop-proof-payload x) - (with-exception-handler - (lambda (error) - (raise-not-a-dpop-proof-payload x error)) - (lambda () - (let ((x (the-jws-payload x))) - (let ((jti (assq-ref x 'jti)) - (htm (assq-ref x 'htm)) - (htu (assq-ref x 'htu)) - (iat (assq-ref x 'iat)) - (ath (assq-ref x 'ath))) - (unless (and jti (string? jti)) - (raise-incorrect-jti-field jti)) - (unless (and htm (string? htm)) - (raise-incorrect-htm-field htm)) - (unless (and htu (string? htu) (string->uri htu)) - (raise-incorrect-htu-field htu)) - (unless (and iat (integer? iat)) - (raise-incorrect-iat-field iat)) - (unless (or (not ath) (string? ath)) - (raise-incorrect-ath-field ath)) - x))))) - -(define-public (dpop-proof-payload? x) - (false-if-exception - (and (the-dpop-proof-payload x) #t))) - -(define-public (the-dpop-proof x) + &invalid-dpop-proof + 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? + dpop-method-mismatch-advertised + dpop-method-mismatch-actual + + &dpop-uri-mismatch + make-dpop-uri-mismatch + dpop-uri-mismatch? + dpop-uri-mismatch-advertised + dpop-uri-mismatch-actual + + &dpop-invalid-ath + make-dpop-invalid-ath + dpop-invalid-ath? + dpop-invalid-ath-hash + dpop-invalid-ath-access-token + + &dpop-unconfirmed-key + make-dpop-unconfirmed-key + dpop-unconfirmed-key? + + dpop-proof-decode + issue-dpop-proof + )) + +(define-exception-type + &invalid-dpop-proof + &external-error + make-invalid-dpop-proof + invalid-dpop-proof?) + +(define (the-dpop-proof x) (with-exception-handler (lambda (error) - (raise-not-a-dpop-proof x 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 () - (cons (the-dpop-proof-header (car x)) - (the-dpop-proof-payload (cdr x)))))) - -(define-public (dpop-proof? x) - (false-if-exception - (and (the-dpop-proof x) #t))) - -(define-public (make-dpop-proof header payload) - (the-dpop-proof (cons header payload))) - -(define-public (make-dpop-proof-header alg jwk) - (when (symbol? alg) - (set! alg (symbol->string alg))) - (the-dpop-proof-header - `((alg . ,alg) - (typ . "dpop+jwt") - (jwk . ,(stubs:strip-key jwk))))) - -(define-public (make-dpop-proof-payload jti htm htu iat ath) - (when (symbol? htm) - (set! htm (symbol->string htm))) - (when (uri? htu) - (set! htu (uri->string htu))) - (when (date? iat) - (set! iat (date->time-utc iat))) - (when (time? iat) - (set! iat (time-second iat))) - (the-dpop-proof-payload - `((jti . ,jti) - (htm . ,htm) - (htu . ,htu) - (iat . ,iat) - ,@(if ath - `((ath . ,ath)) - '())))) - -(define-public (dpop-proof-header dpop) - (car (the-dpop-proof dpop))) - -(define-public (dpop-proof-payload dpop) - (cdr (the-dpop-proof dpop))) - -(define-public (dpop-proof-alg code) - (when (dpop-proof? code) - (set! code (dpop-proof-header code))) - (jws-alg (the-dpop-proof-header code))) - -(define-public (dpop-proof-jwk dpop) - (when (dpop-proof? dpop) - (set! dpop (dpop-proof-header dpop))) - (assq-ref (the-dpop-proof-header dpop) 'jwk)) - -(define-public (dpop-proof-jti dpop) - (when (dpop-proof? dpop) - (set! dpop (dpop-proof-payload dpop))) - (assq-ref (the-dpop-proof-payload dpop) 'jti)) - -(define-public (dpop-proof-htm dpop) - (when (dpop-proof? dpop) - (set! dpop (dpop-proof-payload dpop))) - (string->symbol - (assq-ref (the-dpop-proof-payload dpop) - 'htm))) - -(define-public (dpop-proof-htu dpop) - (when (dpop-proof? dpop) - (set! dpop (dpop-proof-payload dpop))) - (string->uri - (assq-ref (the-dpop-proof-payload dpop) - 'htu))) - -(define-public (dpop-proof-iat dpop) - (when (dpop-proof? dpop) - (set! dpop (dpop-proof-payload dpop))) - (time-utc->date - (make-time time-utc - 0 - (assq-ref (the-dpop-proof-payload dpop) - 'iat)))) - -(define-public (dpop-proof-ath dpop) - (when (dpop-proof? dpop) - (set! dpop (dpop-proof-payload dpop))) - (assq-ref (the-dpop-proof-payload dpop) - 'ath)) + (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 . ,(strip 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 . (? jwk-public? given-jwk)) header ...) + (examine-header header alg typ (or jwk (the-public-jwk given-jwk)) + other-header-fields)) + ((('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 . _) + (the-public-jwk (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 + make-dpop-method-mismatch + dpop-method-mismatch? + (advertised dpop-method-mismatch-advertised) + (actual dpop-method-mismatch-actual)) + +(define-exception-type + &dpop-uri-mismatch + &external-error + make-dpop-uri-mismatch + dpop-uri-mismatch? + (advertised dpop-uri-mismatch-advertised) + (actual dpop-uri-mismatch-actual)) (define (uris-compatible a b) ;; a is what is signed, b is the request @@ -185,71 +270,151 @@ (uri-path a)) (split-and-decode-uri-path (uri-path b)))) - (raise-dpop-uri-mismatch a b))) + (let ((final-message + (format #f (G_ "the DPoP proof is signed for ~s, but it is issued to ~s") + (uri->string a) (uri->string b)))) + (raise-exception + (make-exception + (make-dpop-uri-mismatch a b) + (make-exception-with-message final-message)))))) + +(define-exception-type + &dpop-invalid-ath + &external-error + make-dpop-invalid-ath + dpop-invalid-ath? + (hash dpop-invalid-ath-hash) + (access-token dpop-invalid-ath-access-token)) + +(define-exception-type + &dpop-unconfirmed-key + &external-error + make-dpop-unconfirmed-key + dpop-unconfirmed-key?) -(define*-public (dpop-proof-decode method uri str cnf/check - #:key - (access-token #f)) - (let ((current-time - (time-second (date->time-utc ((p:current-date)))))) +(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) - (raise-cannot-decode-dpop-proof str 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)) - (raise-dpop-method-mismatch (dpop-proof-htm decoded) method)) + (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 (time-second (date->time-utc (dpop-proof-iat decoded))))) - (unless (>= current-time (- iat 5)) - (raise-dpop-signed-in-future iat current-time)) - (unless (<= current-time (+ iat 120)) ;; Valid for 2 min - (raise-dpop-too-old iat current-time))) + (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) - (raise-exception - (make-dpop-invalid-access-token-hash (dpop-proof-ath decoded) access-token))))) + (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 (stubs:jkt (dpop-proof-jwk decoded))) - (raise-dpop-unconfirmed-key (dpop-proof-jwk decoded) cnf/check #f)) + (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) - (raise-dpop-unconfirmed-key (dpop-proof-jwk decoded) #f 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 (stubs:jkt (dpop-proof-jwk decoded))) - ;; deprecated; throw an error instead! - (error "the cnf/check function returned #f"))))) - (parameterize ((p:current-date current-time)) + ;; 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. - (unless (jti-check (dpop-proof-jti decoded) 120) - (with-exception-handler - (lambda (error) - (raise-jti-found (dpop-proof-jti decoded) error)) - (lambda () - (error "the jti-check function returned #f")))) - decoded)))))) + (jti-check (dpop-proof-jti decoded) 120)) + decoded))))) -(define-public (dpop-proof-encode dpop-proof key) +(define (dpop-proof-encode dpop-proof key) (with-exception-handler (lambda (error) - (raise-cannot-encode-dpop-proof dpop-proof key 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-with-message final-message) + error))) (lambda () (jws-encode dpop-proof key)))) -(define*-public (issue-dpop-proof - client-key - #:key - (alg #f) - (htm #f) - (htu #f) - (access-token #f)) +(define* (issue-dpop-proof + client-key + #:key + (alg #f) + (htm #f) + (htu #f) + (access-token #f)) (dpop-proof-encode - (make-dpop-proof (make-dpop-proof-header alg client-key) - (make-dpop-proof-payload (stubs:random 12) htm htu ((p:current-date)) - (and access-token - (stubs:hash 'SHA-256 access-token)))) + (the-dpop-proof + `(((alg . ,(symbol->string alg)) + (typ . "dpop+jwt") + (jwk . ,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)) diff --git a/src/scm/webid-oidc/errors.scm b/src/scm/webid-oidc/errors.scm index 1c7d539..4e24659 100644 --- a/src/scm/webid-oidc/errors.scm +++ b/src/scm/webid-oidc/errors.scm @@ -18,1505 +18,36 @@ #:use-module ((webid-oidc stubs) #:prefix stubs:) #:use-module (ice-9 exceptions) #:use-module (ice-9 optargs) - #:use-module (ice-9 i18n) + #:use-module (ice-9 match) #:use-module (srfi srfi-19) #:use-module (web uri) #:use-module (web response) - #:use-module (web client)) + #:use-module (web client) + #:declarative? #t + #:export + ( + &message-for-the-user + make-message-for-the-user + message-for-the-user? + user-message -(define (G_ text) - (let ((out (gettext text))) - (if (string=? out text) - ;; No translation, disambiguate - (car (reverse (string-split text #\|))) - out))) + fail + )) -;; This is a collection of all errors that can happen, and a function -;; to log them. - -(define-public ¬-base64 - (make-exception-type - '¬-base64 - &external-error - '(value cause))) - -(define-public (raise-not-base64 value cause) - (raise-exception - ((record-constructor ¬-base64) value cause))) - -(define-public ¬-json - (make-exception-type - '¬-json - &external-error - '(value cause))) - -(define-public (raise-not-json value cause) - (raise-exception - ((record-constructor ¬-json) value cause))) - -(define-public ¬-turtle - (make-exception-type - '¬-turtle - &external-error - '(value cause))) - -(define-public (raise-not-turtle value cause) - (raise-exception - ((record-constructor ¬-turtle) value cause))) - -(define-public &unsupported-crv - (make-exception-type - '&unsupported-crv - &external-error - '(crv))) - -(define-public (raise-unsupported-crv crv) - (raise-exception - ((record-constructor &unsupported-crv) crv))) - -(define-public ¬-a-jwk - (make-exception-type - '¬-a-jwk - &external-error - '(value cause))) - -(define-public (raise-not-a-jwk value cause) - (raise-exception - ((record-constructor ¬-a-jwk) value cause))) - -(define-public ¬-a-public-jwk - (make-exception-type - '¬-a-public-jwk - &external-error - '(value cause))) - -(define-public (raise-not-a-public-jwk value cause) - (raise-exception - ((record-constructor ¬-a-public-jwk) value cause))) - -(define-public ¬-a-private-jwk - (make-exception-type - '¬-a-private-jwk - &external-error - '(value cause))) - -(define-public (raise-not-a-private-jwk value cause) - (raise-exception - ((record-constructor ¬-a-private-jwk) value cause))) - -(define-public ¬-a-jwks - (make-exception-type - '¬-a-jwks - &external-error - '(value cause))) - -(define-public (raise-not-a-jwks value cause) - (raise-exception - ((record-constructor ¬-a-jwks) value cause))) - -(define-public &unsupported-alg - (make-exception-type - '&unsupported-alg - &external-error - '(value))) - -(define-public (raise-unsupported-alg value) - (raise-exception - ((record-constructor &unsupported-alg) value))) - -(define-public &invalid-signature - (make-exception-type - '&invalid-signature - &external-error - '(key payload signature))) - -(define-public (raise-invalid-signature key payload signature) - (raise-exception - ((record-constructor &invalid-signature) key payload signature))) - -(define-public ¬-a-jws-header - (make-exception-type - '¬-a-jws-header - &external-error - '(value cause))) - -(define-public (raise-not-a-jws-header value cause) - (raise-exception - ((record-constructor ¬-a-jws-header) value cause))) - -(define-public ¬-a-jws-payload - (make-exception-type - '¬-a-jws-payload - &external-error - '(value cause))) - -(define-public (raise-not-a-jws-payload value cause) - (raise-exception - ((record-constructor ¬-a-jws-payload) value cause))) - -(define-public ¬-a-jws - (make-exception-type - '¬-a-jws - &external-error - '(value cause))) - -(define-public (raise-not-a-jws value cause) - (raise-exception - ((record-constructor ¬-a-jws-payload) value cause))) - -(define-public ¬-in-3-parts - (make-exception-type - '¬-in-3-parts - &external-error - '(string separator))) - -(define-public (raise-not-in-3-parts string separator) - (raise-exception - ((record-constructor ¬-in-3-parts) string separator))) - -(define-public &missing-alist-key - (make-exception-type - '&missing-alist-key - &external-error - '(value key))) - -(define-public (raise-missing-alist-key value key) - (raise-exception - ((record-constructor &missing-alist-key) value key))) - -(define-public &no-matching-key - (make-exception-type - '&no-matching-key - &external-error - '(candidates alg payload signature other-problems))) - -(define-public (raise-no-matching-key candidates alg payload signature) - (raise-exception - ((record-constructor &no-matching-key) candidates alg payload signature))) - -(define-public &cannot-decode-jws - (make-exception-type - '&cannot-decode-jws - &external-error - '(value cause))) - -(define-public (raise-cannot-decode-jws value cause) - (raise-exception - ((record-constructor &cannot-decode-jws) value cause))) - -(define-public &cannot-encode-jws - (make-exception-type - '&cannot-encode-jws - &external-error - '(jws key cause))) - -(define-public (raise-cannot-encode-jws jws key cause) - (raise-exception - ((record-constructor &cannot-encode-jws) jws key cause))) - -(define-public &request-failed-unexpectedly - (make-exception-type - '&request-failed-unexpectedly - &external-error - '(response-code response-reason-phrase))) - -(define-public (raise-request-failed-unexpectedly - response-code response-reason-phrase) - (raise-exception - ((record-constructor &request-failed-unexpectedly) - response-code response-reason-phrase))) - -(define-public &unexpected-header-value - (make-exception-type - '&unexpected-header-value - &external-error - '(header value))) - -(define-public (raise-unexpected-header-value header value) - (raise-exception - ((record-constructor &unexpected-header-value) header value))) - -(define-public &unexpected-response - (make-exception-type - '&unexpected-response - &external-error - '(response cause))) - -(define-public (raise-unexpected-response response cause) - (raise-exception - ((record-constructor &unexpected-response) response cause))) - -(define-public ¬-an-oidc-configuration - (make-exception-type - '¬-an-oidc-configuration - &external-error - '(value cause))) - -(define-public (raise-not-an-oidc-configuration value cause) - (raise-exception - ((record-constructor ¬-an-oidc-configuration) value cause))) - -(define-public &incorrect-webid-field - (make-exception-type - '&incorrect-webid-field - &external-error - '(value))) - -(define-public (raise-incorrect-webid-field value) - (raise-exception - ((record-constructor &incorrect-webid-field) value))) - -(define-public &incorrect-sub-field - (make-exception-type - '&incorrect-sub-field - &external-error - '(value))) - -(define-public (raise-incorrect-sub-field value) - (raise-exception - ((record-constructor &incorrect-sub-field) value))) - -(define-public &incorrect-iss-field - (make-exception-type - '&incorrect-iss-field - &external-error - '(value))) - -(define-public (raise-incorrect-iss-field value) - (raise-exception - ((record-constructor &incorrect-iss-field) value))) - -(define-public &incorrect-aud-field - (make-exception-type - '&incorrect-aud-field - &external-error - '(value))) - -(define-public (raise-incorrect-aud-field value) - (raise-exception - ((record-constructor &incorrect-aud-field) value))) - -(define-public &incorrect-iat-field - (make-exception-type - '&incorrect-iat-field - &external-error - '(value))) - -(define-public (raise-incorrect-iat-field value) - (raise-exception - ((record-constructor &incorrect-iat-field) value))) - -(define-public &incorrect-exp-field - (make-exception-type - '&incorrect-exp-field - &external-error - '(value))) - -(define-public (raise-incorrect-exp-field value) - (raise-exception - ((record-constructor &incorrect-exp-field) value))) - -(define-public &incorrect-cnf/jkt-field - (make-exception-type - '&incorrect-cnf/jkt-field - &external-error - '(value))) - -(define-public (raise-incorrect-cnf/jkt-field value) - (raise-exception - ((record-constructor &incorrect-cnf/jkt-field) value))) - -(define-public &incorrect-client-id-field - (make-exception-type - '&incorrect-client-id-field - &external-error - '(value))) - -(define-public (raise-incorrect-client-id-field value) - (raise-exception - ((record-constructor &incorrect-client-id-field) value))) - -(define-public &incorrect-redirect-uris-field - (make-exception-type - '&incorrect-redirect-uris-field - &external-error - '(value))) - -(define-public (raise-incorrect-redirect-uris-field value) - (raise-exception - ((record-constructor &incorrect-redirect-uris-field) value))) - -(define-public &incorrect-typ-field - (make-exception-type - '&incorrect-typ-field - &external-error - '(value))) - -(define-public (raise-incorrect-typ-field value) - (raise-exception - ((record-constructor &incorrect-typ-field) value))) - -(define-public &incorrect-jwk-field - (make-exception-type - '&incorrect-jwk-field - &external-error - '(value cause))) - -(define-public (raise-incorrect-jwk-field value cause) - (raise-exception - ((record-constructor &incorrect-jwk-field) value cause))) - -(define-public &incorrect-jti-field - (make-exception-type - '&incorrect-jti-field - &external-error - '(value))) - -(define-public (raise-incorrect-jti-field value) - (raise-exception - ((record-constructor &incorrect-jti-field) value))) - -(define-public &incorrect-nonce-field - (make-exception-type - '&incorrect-nonce-field - &external-error - '(value))) - -(define-public (raise-incorrect-nonce-field value) - (raise-exception - ((record-constructor &incorrect-nonce-field) value))) - -(define-public &incorrect-htm-field - (make-exception-type - '&incorrect-htm-field - &external-error - '(value))) - -(define-public (raise-incorrect-htm-field value) - (raise-exception - ((record-constructor &incorrect-htm-field) value))) - -(define-public &incorrect-htu-field - (make-exception-type - '&incorrect-htu-field - &external-error - '(value))) - -(define-exception-type - &incorrect-ath-field - &external-error - make-incorrect-ath-field - incorrect-ath-field? - (value incorrect-ath-field-value)) - -(export &incorrect-ath-field - make-incorrect-ath-field - incorrect-ath-field? - incorrect-ath-field-value) - -(define-public (raise-incorrect-htu-field value) - (raise-exception - ((record-constructor &incorrect-htu-field) value))) - -(define-public ¬-an-access-token - (make-exception-type - '¬-an-access-token - &external-error - '(value cause))) - -(define-public (raise-not-an-access-token value cause) - (raise-exception - ((record-constructor ¬-an-access-token) value cause))) - -(define-public ¬-an-access-token-header - (make-exception-type - '¬-an-access-token-header - &external-error - '(value cause))) - -(define-public (raise-not-an-access-token-header value cause) - (raise-exception - ((record-constructor ¬-an-access-token-header) value cause))) - -(define-public ¬-an-access-token-payload - (make-exception-type - '¬-an-access-token-payload - &external-error - '(value cause))) - -(define-public (raise-not-an-access-token-payload value cause) - (raise-exception - ((record-constructor ¬-an-access-token-payload) value cause))) - -(define-public ¬-a-dpop-proof - (make-exception-type - '¬-a-dpop-proof - &external-error - '(value cause))) - -(define-public (raise-not-a-dpop-proof value cause) - (raise-exception - ((record-constructor ¬-a-dpop-proof) value cause))) - -(define-public ¬-a-dpop-proof-header - (make-exception-type - '¬-a-dpop-proof-header - &external-error - '(value cause))) - -(define-public (raise-not-a-dpop-proof-header value cause) - (raise-exception - ((record-constructor ¬-a-dpop-proof-header) value cause))) - -(define-public ¬-a-dpop-proof-payload - (make-exception-type - '¬-a-dpop-proof-payload - &external-error - '(value cause))) - -(define-public (raise-not-a-dpop-proof-payload value cause) - (raise-exception - ((record-constructor ¬-a-dpop-proof-payload) value cause))) - -(define-public &cannot-fetch-issuer-configuration - (make-exception-type - '&cannot-fetch-issuer-configuration - &external-error - '(issuer cause))) - -(define*-public (raise-cannot-fetch-issuer-configuration issuer cause #:key (recoverable? #f)) - (raise-exception - ((record-constructor &cannot-fetch-issuer-configuration) issuer cause) - #:continuable? recoverable?)) - -(define-public &cannot-fetch-jwks - (make-exception-type - '&cannot-fetch-jwks - &external-error - '(issuer uri cause))) - -(define-public (raise-cannot-fetch-jwks issuer uri cause) - (raise-exception - ((record-constructor &cannot-fetch-jwks) issuer uri cause))) - -(define-public &dpop-method-mismatch - (make-exception-type - '&dpop-method-mismatch - &external-error - '(signed requested))) - -(define-public (raise-dpop-method-mismatch signed requested) - (raise-exception - ((record-constructor &dpop-method-mismatch) signed requested))) - -(define-public &dpop-uri-mismatch - (make-exception-type - '&dpop-uri-mismatch - &external-error - '(signed requested))) - -(define-public (raise-dpop-uri-mismatch signed requested) - (raise-exception - ((record-constructor &dpop-uri-mismatch) signed requested))) - -(define-public &dpop-signed-in-future - (make-exception-type - '&dpop-signed-in-future - &external-error - '(signed current))) - -(define (the-date object) - (when (integer? object) - (set! object (make-time time-utc 0 object))) - (when (time? object) - (set! object (time-utc->date object))) - object) - -(define-public (raise-dpop-signed-in-future signed current) - (raise-exception - ((record-constructor &dpop-signed-in-future) (the-date signed) (the-date current)))) - -(define-public &dpop-too-old - (make-exception-type - '&dpop-too-old - &external-error - '(signed current))) - -(define-public (raise-dpop-too-old signed current) - (raise-exception - ((record-constructor &dpop-too-old) (the-date signed) (the-date current)))) - -(define-public &dpop-unconfirmed-key - (make-exception-type - '&dpop-unconfirmed-key - &external-error - '(key expected cause))) - -(define-public (raise-dpop-unconfirmed-key key expected cause) - (raise-exception - ((record-constructor &dpop-unconfirmed-key) key expected cause))) +;; A message to show the user is an XHTML paragraph or equivalent (as +;; sxml). A div is used to contain multiple messages. (define-exception-type - &dpop-invalid-access-token-hash + &message-for-the-user &external-error - make-dpop-invalid-access-token-hash - dpop-invalid-access-token-hash? - (hash dpop-invalid-access-token-hash-hash) - (access-token dpop-invalid-access-token-hash-access-token)) - -(export &dpop-invalid-access-token-hash - make-dpop-invalid-access-token-hash - dpop-invalid-access-token-hash? - dpop-invalid-access-token-hash-hash - dpop-invalid-access-token-hash-access-token) - -(define-public &jti-found - (make-exception-type - '&jti-found - &external-error - '(jti cause))) - -(define-public (raise-jti-found jti cause) - (raise-exception - ((record-constructor &jti-found) jti cause))) - -(define-public &cannot-decode-access-token - (make-exception-type - '&cannot-decode-access-token - &external-error - '(value cause))) - -(define-public (raise-cannot-decode-access-token value cause) - (raise-exception - ((record-constructor &cannot-decode-access-token) value cause))) - -(define-public &cannot-encode-access-token - (make-exception-type - '&cannot-encode-access-token - &external-error - '(access-token key cause))) - -(define-public (raise-cannot-encode-access-token access-token key cause) - (raise-exception - ((record-constructor &cannot-encode-access-token) access-token key cause))) - -(define-public &cannot-decode-dpop-proof - (make-exception-type - '&cannot-decode-dpop-proof - &external-error - '(value cause))) - -(define-public (raise-cannot-decode-dpop-proof value cause) - (raise-exception - ((record-constructor &cannot-decode-dpop-proof) value cause))) - -(define-public &cannot-encode-dpop-proof - (make-exception-type - '&cannot-encode-dpop-proof - &external-error - '(dpop-proof key cause))) - -(define-public (raise-cannot-encode-dpop-proof dpop-proof key cause) - (raise-exception - ((record-constructor &cannot-encode-dpop-proof) dpop-proof key cause))) - -(define-public &cannot-fetch-linked-data - (make-exception-type - '&cannot-fetch-linked-data - &external-error - '(uri cause))) - -(define-public (raise-cannot-fetch-linked-data uri cause) - (raise-exception - ((record-constructor &cannot-fetch-linked-data) uri cause))) - -(define-public ¬-a-client-manifest - (make-exception-type - '¬-a-client-manifest - &external-error - '(value cause))) - -(define-public (raise-not-a-client-manifest value cause) - (raise-exception - ((record-constructor ¬-a-client-manifest) value cause))) - -(define-public &unauthorized-redirection-uri - (make-exception-type - '&unauthorized-redirection-uri - &external-error - '(manifest uri))) - -(define-public (raise-unauthorized-redirection-uri manifest uri) - (raise-exception - ((record-constructor &unauthorized-redirection-uri) manifest uri))) - -(define-public &cannot-serve-public-manifest - (make-exception-type - '&cannot-serve-public-manifest - &external-error - '())) - -(define-public (raise-cannot-serve-public-manifest) - (raise-exception - ((record-constructor &cannot-serve-public-manifest)))) - -(define-public &no-client-manifest-registration - (make-exception-type - '&no-client-manifest-registration - &external-error - '(id))) - -(define-public (raise-no-client-manifest-registration id) - (raise-exception - ((record-constructor &no-client-manifest-registration) id))) - -(define-public &inconsistent-client-manifest-id - (make-exception-type - '&inconsistent-client-manifest-id - &external-error - '(id advertised-id))) - -(define-public (raise-inconsistent-client-manifest-id id advertised-id) - (raise-exception - ((record-constructor &inconsistent-client-manifest-id) id advertised-id))) + make-message-for-the-user + message-for-the-user? + (message user-message)) -(define-public &cannot-fetch-client-manifest - (make-exception-type - '&cannot-fetch-client-manifest - &external-error - '(id cause))) - -(define-public (raise-cannot-fetch-client-manifest id cause) - (raise-exception - ((record-constructor &cannot-fetch-client-manifest) id cause))) - -(define-public ¬-an-authorization-code - (make-exception-type - '¬-an-authorization-code - &external-error - '(value cause))) - -(define-public (raise-not-an-authorization-code value cause) - (raise-exception - ((record-constructor ¬-an-authorization-code) value cause))) - -(define-public ¬-an-authorization-code-header - (make-exception-type - '¬-an-authorization-code-header - &external-error - '(value cause))) - -(define-public (raise-not-an-authorization-code-header value cause) - (raise-exception - ((record-constructor ¬-an-authorization-code-header) value cause))) - -(define-public ¬-an-authorization-code-payload - (make-exception-type - '¬-an-authorization-code-payload - &external-error - '(value cause))) - -(define-public (raise-not-an-authorization-code-payload value cause) - (raise-exception - ((record-constructor ¬-an-authorization-code-payload) value cause))) - -(define-public &authorization-code-expired - (make-exception-type - '&authorization-code-expired - &external-error - '(exp current-time))) - -(define-public (raise-authorization-code-expired exp current-time) - (raise-exception - ((record-constructor &authorization-code-expired) - (the-date exp) - (the-date current-time)))) - -(define-public &cannot-decode-authorization-code - (make-exception-type - '&cannot-decode-authorization-code - &external-error - '(value cause))) - -(define-public (raise-cannot-decode-authorization-code value cause) - (raise-exception - ((record-constructor &cannot-decode-authorization-code) value cause))) - -(define-public &cannot-encode-authorization-code - (make-exception-type - '&cannot-encode-authorization-code - &external-error - '(authorization-code key cause))) - -(define-public (raise-cannot-encode-authorization-code authorization-code key cause) +(define (fail message) + ;; Like error, but don’t do funny things when message is not a + ;; string literal (raise-exception - ((record-constructor &cannot-encode-authorization-code) authorization-code key cause))) - -(define-public &invalid-refresh-token - (make-exception-type - '&invalid-refresh-token - &external-error - '(refresh-token))) - -(define-public (raise-invalid-refresh-token refresh-token) - (raise-exception - ((record-constructor &invalid-refresh-token) refresh-token))) - -(define-public &invalid-key-for-refresh-token - (make-exception-type - '&invalid-key-for-refresh-token - &external-error - '(key jkt))) - -(define-public (raise-invalid-key-for-refresh-token key jkt) - (raise-exception - ((record-constructor &invalid-key-for-refresh-token) key jkt))) - -(define-public ¬-an-id-token - (make-exception-type - '¬-an-id-token - &external-error - '(value cause))) - -(define-public (raise-not-an-id-token value cause) - (raise-exception - ((record-constructor ¬-an-id-token) value cause))) - -(define-public ¬-an-id-token-header - (make-exception-type - '¬-an-id-token-header - &external-error - '(value cause))) - -(define-public (raise-not-an-id-token-header value cause) - (raise-exception - ((record-constructor ¬-an-id-token-header) value cause))) - -(define-public ¬-an-id-token-payload - (make-exception-type - '¬-an-id-token-payload - &external-error - '(value cause))) - -(define-public (raise-not-an-id-token-payload value cause) - (raise-exception - ((record-constructor ¬-an-id-token-payload) value cause))) - -(define-public &cannot-decode-id-token - (make-exception-type - '&cannot-decode-id-token - &external-error - '(value cause))) - -(define-public (raise-cannot-decode-id-token value cause) - (raise-exception - ((record-constructor &cannot-decode-id-token) value cause))) - -(define-public &cannot-encode-id-token - (make-exception-type - '&cannot-encode-id-token - &external-error - '(id-token key cause))) - -(define-public (raise-cannot-encode-id-token id-token key cause) - (raise-exception - ((record-constructor &cannot-encode-id-token) id-token key cause))) - -(define-public &unknown-client-locale - (make-exception-type - '&unknown-client-locale - &external-error - '(web-locale c-locale))) - -(define-public (raise-unknown-client-locale web-locale c-locale) - (raise-exception - ((record-constructor &unknown-client-locale) web-locale c-locale) - #:continuable? #t)) - -(define-public &unsupported-grant-type - (make-exception-type - '&unsupported-grant-type - &external-error - '(value))) - -(define-public (raise-unsupported-grant-type value) - (raise-exception - ((record-constructor &unsupported-grant-type) value))) - -(define-public &no-authorization-code - (make-exception-type - '&no-authorization-code - &external-error - '(value))) - -(define-public (raise-no-authorization-code) - (raise-exception - ((record-constructor &no-authorization-code)))) - -(define-public &no-refresh-token - (make-exception-type - '&no-refresh-token - &external-error - '(value))) - -(define-public (raise-no-refresh-token) - (raise-exception - ((record-constructor &no-refresh-token)))) - -(define-public &unconfirmed-provider - (make-exception-type - '&unconfirmed-provider - &external-error - '(subject provider))) - -(define-public (raise-unconfirmed-provider subject provider) - (raise-exception - ((record-constructor &unconfirmed-provider) subject provider))) - -(define-public &neither-identity-provider-nor-webid - (make-exception-type - '&neither-identity-provider-nor-webid - &external-error - '(uri why-not-identity-provider why-not-webid))) - -(define-public (raise-neither-identity-provider-nor-webid uri why-not-identity-provider why-not-webid) - (raise-exception - ((record-constructor &neither-identity-provider-nor-webid) - uri why-not-identity-provider why-not-webid))) - -(define-public &profile-not-found - (make-exception-type - '&profile-not-found - &external-error - '(webid iss dir))) - -(define-public (raise-profile-not-found webid iss dir) - (raise-exception - ((record-constructor &profile-not-found) webid iss dir))) - -(define-public &no-provider-candidates - (make-exception-type - '&no-provider-candidates - &external-error - '(webid causes))) - -(define-public (raise-no-provider-candidates webid causes) - (raise-exception - ((record-constructor &no-provider-candidates) webid causes))) - -;; Server-side exceptions - -(define-exception-type - &path-not-found - &external-error - make-path-not-found - path-not-found? - (path path-not-found-path)) - -(export &path-not-found - make-path-not-found - path-not-found? - path-not-found-path) - -(define-exception-type - &auxiliary-resource-absent - &external-error - make-auxiliary-resource-absent - auxiliary-resource-absent? - (path auxiliary-resource-absent-path) - (kind auxiliary-resource-absent-kind)) - -(export &auxiliary-resource-absent - make-auxiliary-resource-absent - auxiliary-resource-absent? - auxiliary-resource-absent-path - auxiliary-resource-absent-kind) - -(define-exception-type - &uri-slash-semantics-error - &external-error - make-uri-slash-semantics-error - uri-slash-semantics-error? - (path uri-slash-semantics-error-path) - (expected-path uri-slash-semantics-error-expected-path)) - -(export &uri-slash-semantics-error - make-uri-slash-semantics-error - uri-slash-semantics-error? - uri-slash-semantics-error-path - uri-slash-semantics-error-expected-path) - -(define-exception-type - &cannot-delete-root - &external-error - make-cannot-delete-root - cannot-delete-root?) - -(export &cannot-delete-root - make-cannot-delete-root - cannot-delete-root?) - -(define-exception-type - &container-not-empty - &external-error - make-container-not-empty - container-not-empty? - (path container-not-empty-path)) - -(export &container-not-empty - make-container-not-empty - container-not-empty? - container-not-empty-path) - -(define-exception-type - &cannot-fetch-group - &warning - make-cannot-fetch-group - cannot-fetch-group? - (group-uri cannot-fetch-group-group-uri) - (cause cannot-fetch-group-cause)) - -(export &cannot-fetch-group - make-cannot-fetch-group - cannot-fetch-group? - cannot-fetch-group-group-uri - cannot-fetch-group-cause) - -(define-exception-type - &incorrect-containment-triples - &external-error - make-incorrect-containment-triples - incorrect-containment-triples? - (path incorrect-containment-triples-path)) - -(export &incorrect-containment-triples - make-incorrect-containment-triples - incorrect-containment-triples? - incorrect-containment-triples-path) - -(define-exception-type - &unsupported-media-type - &external-error - make-unsupported-media-type - unsupported-media-type? - (content-type unsupported-media-type-content-type)) - -(export &unsupported-media-type - make-unsupported-media-type - unsupported-media-type? - unsupported-media-type-content-type) - -(define-exception-type - &path-is-auxiliary - &external-error - make-path-is-auxiliary - path-is-auxiliary? - (path path-is-auxiliary-path)) - -(export &path-is-auxiliary - make-path-is-auxiliary - path-is-auxiliary? - path-is-auxiliary-path) - -(define-exception-type - &forbidden - &external-error - make-forbidden - forbidden? - (path forbidden-path) - (user forbidden-user) - (owner forbidden-owner) - (mode forbidden-mode)) - -(export &forbidden - make-forbidden - forbidden? - forbidden-path - forbidden-user - forbidden-owner - forbidden-mode) - -(define-exception-type - &precondition-failed - &external-error - make-precondition-failed - precondition-failed? - (path precondition-failed-path) - (if-match precondition-failed-if-match) - (if-none-match precondition-failed-if-none-match) - (real-etag precondition-failed-real-etag)) - -(export &precondition-failed - make-precondition-failed - precondition-failed? - precondition-failed-path - precondition-failed-if-match - precondition-failed-if-none-match - precondition-failed-real-etag) - -(define-exception-type - ¬-acceptable - &external-error - make-not-acceptable - not-acceptable? - (client-accepts not-acceptable-client-accepts) - (path not-acceptable-path) - (content-type not-acceptable-content-type)) - -(export ¬-acceptable - make-not-acceptable - not-acceptable? - not-acceptable-client-accepts - not-acceptable-path - not-acceptable-content-type) - -(define*-public (error->str err #:key (max-depth #f)) - (if (record? err) - (let* ((type (record-type-descriptor err)) - (get - (lambda (slot) - ((record-accessor type slot) err))) - (recurse - (if (eqv? max-depth 0) - (lambda (err) (G_ "that’s how it is")) - (lambda (err) - (error->str err #:max-depth (and max-depth (- max-depth 1))))))) - (case (record-type-name type) - ((¬-base64) - (format #f (G_ "the value ~s is not a base64 string (because ~a)") - (get 'value) (recurse (get 'cause)))) - ((¬-json) - (format #f (G_ "the value ~s is not JSON (because ~a)") - (get 'value) (recurse (get 'cause)))) - ((¬-turtle) - (format #f (G_ "the value ~s is not Turtle (because ~a)") - (get 'value) (recurse (get 'cause)))) - ((&unsupported-crv) - (format #f (G_ "the value ~s does not identify an elleptic curve") - (get 'crv))) - ((¬-a-jwk) - (let ((cause (get 'cause))) - (if cause - (format #f (G_ "the value ~s does not identify a JWK (because ~a)") - (get 'value) (recurse cause)) - (format #f (G_ "the value ~s does not identify a JWK") - (get 'value))))) - ((¬-a-public-jwk) - (let ((cause (get 'cause))) - (if cause - (format #f (G_ "the value ~s does not identify a public JWK (because ~a)") - (get 'value) (recurse cause)) - (format #f (G_ "the value ~s does not identify a public JWK") - (get 'value))))) - ((¬-a-private-jwk) - (let ((cause (get 'cause))) - (if cause - (format #f (G_ "the value ~s does not identify a private JWK (because ~a)") - (get 'value) cause) - (format #f (G_ "the value ~s does not identify a private JWK") - (get 'value))))) - ((¬-a-jwks) - (let ((cause (get 'cause))) - (if cause - (format #f (G_ "the value ~s does not identify a JWKS (because ~a)") - (get 'value) (recurse cause)) - (format #f (G_ "the value ~s does not identify a JWKS") - (get 'value))))) - ((&unsupported-alg) - (format #f (G_ "the value ~s does not identify a hash algorithm") - (get 'value))) - ((&missing-alist-key) - (format #f (G_ "the value ~s is not an alist or misses key ~s") - (get 'value) (get 'key))) - ((¬-a-jws-header) - (format #f (G_ "the value ~s is not a JWS header (because ~a)") - (get 'value) (recurse (get 'cause)))) - ((¬-a-jws-payload) - (format #f (G_ "the value ~s is not a JWS payload (because ~a)") - (get 'value) (recurse (get 'cause)))) - ((¬-a-jws) - (format #f (G_ "the value ~s is not a JWS (because ~a)") - (get 'value) (recurse (get 'cause)))) - ((¬-in-3-parts) - (format #f (G_ "the string ~s cannot be split in 3 parts with ~s") - (get 'string) (get 'separator))) - ((&no-matching-key) - (format #f (G_ "all key candidates failed to verify signature ~s with algorithm ~s and payload ~a (there were ~a: ~s)") - (get 'signature) (get 'alg) (get 'payload) (length (get 'candidates)) (get 'candidates))) - ((&cannot-decode-jws) - (format #f (G_ "I cannot decode JWS ~a (because ~a)") - (get 'value) (recurse (get 'cause)))) - ((&cannot-encode-jws) - (format #f (G_ "I cannot encode JWS ~a (because ~a)") - (get 'value) (recurse (get 'cause)))) - ((&response-failed-unexpectedly) - (format #f (G_ "the server request unexpectedly failed with code ~a and reason phrase ~s") - (get 'response-code) (get 'response-reason-phrase))) - ((&unexpected-header-value) - (let ((value (get 'value))) - (if value - (format #f (G_ "the header ~a should not have the value ~s") - (get 'header) value) - (format #f (G_ "the header ~a should be present") - (get 'header))))) - ((&unexpected-response) - (format #f (G_ "the server response wasn't expected: ~s (because ~a)") - (call-with-output-string - (lambda (port) - (write-response (get 'response) port))) - (recurse (get 'cause)))) - ((¬-an-oidc-configuration) - (format #f (G_ "the value ~s is not an OIDC configuration (because ~a)") - (get 'value) (recurse (get 'cause)))) - ((&incorrect-webid-field) - (let ((value (get 'value))) - (if value - (format #f (G_ "the webid field is incorrect: ~s") value) - (format #f (G_ "the webid field is missing"))))) - ((&incorrect-sub-field) - (let ((value (get 'value))) - (if value - (format #f (G_ "the sub field is incorrect: ~s") value) - (format #f (G_ "the sub field is missing"))))) - ((&incorrect-iss-field) - (let ((value (get 'value))) - (if value - (format #f (G_ "the iss field is incorrect: ~s") value) - (format #f (G_ "the iss field is missing"))))) - ((&incorrect-aud-field) - (let ((value (get 'value))) - (if value - (format #f (G_ "the aud field is incorrect: ~s") value) - (format #f (G_ "the aud field is missing"))))) - ((&incorrect-iat-field) - (let ((value (get 'value))) - (if value - (format #f (G_ "the iat field is incorrect: ~s") value) - (format #f (G_ "the iat field is missing"))))) - ((&incorrect-exp-field) - (let ((value (get 'value))) - (if value - (format #f (G_ "the exp field is incorrect: ~s") value) - (format #f (G_ "the exp field is missing"))))) - ((&incorrect-cnf/jkt-field) - (let ((value (get 'value))) - (if value - (format #f (G_ "the cnf/jkt field is incorrect: ~s") value) - (format #f (G_ "the cnf/jkt field is missing"))))) - ((&incorrect-client-id-field) - (let ((value (get 'value))) - (if value - (format #f (G_ "the client-id field is incorrect: ~s") value) - (format #f (G_ "the client-id field is missing"))))) - ((&incorrect-redirect-uris-field) - (let ((value (get 'value))) - (if value - (format #f (G_ "the redirect_uris field is incorrect: ~s") value) - (format #f (G_ "the redirect_uris field is missing"))))) - ((&incorrect-typ-field) - (let ((value (get 'value))) - (if value - (format #f (G_ "the typ field is incorrect: ~s") value) - (format #f (G_ "the typ field is missing"))))) - ((&incorrect-jwk-field) - (let ((value (get 'value))) - (if value - (format #f (G_ "the jwk field is incorrect: ~s (because ~a)") - value (recurse (get 'cause))) - (format #f (G_ "the jwk field is missing"))))) - ((&incorrect-jti-field) - (let ((value (get 'value))) - (if value - (format #f (G_ "the jti field is incorrect: ~s") value) - (format #f (G_ "the jti field is missing"))))) - ((&incorrect-nonce-field) - (let ((value (get 'value))) - (if value - (format #f (G_ "the nonce field is incorrect: ~s") value) - (format #f (G_ "the nonce field is missing"))))) - ((&incorrect-htm-field) - (let ((value (get 'value))) - (if value - (format #f (G_ "the htm field is incorrect: ~s") value) - (format #f (G_ "the htm field is missing"))))) - ((&incorrect-htu-field) - (let ((value (get 'value))) - (if value - (format #f (G_ "the htu field is incorrect: ~s") value) - (format #f (G_ "the htu field is missing"))))) - ((&incorrect-ath-field) - (let ((value (get 'value))) - (if value - (format #f (G_ "the ath field is incorrect: ~s") value) - (format #f (G_ "the ath field is missing"))))) - ((¬-an-access-token) - (format #f (G_ "~s is not an access token (because ~a)") - (get 'value) (recurse (get 'cause)))) - ((¬-an-access-token-header) - (format #f (G_ "~s is not an access token header (because ~a)") - (get 'value) (recurse (get 'cause)))) - ((¬-an-access-token-payload) - (format #f (G_ "~s is not an access token payload (because ~a)") - (get 'value) (recurse (get 'cause)))) - ((¬-a-dpop-proof) - (format #f (G_ "~s is not a DPoP proof (because ~a)") - (get 'value) (recurse (get 'cause)))) - ((¬-a-dpop-proof-header) - (format #f (G_ "~s is not a DPoP proof header (because ~a)") - (get 'value) (recurse (get 'cause)))) - ((¬-a-dpop-proof-payload) - (format #f (G_ "~s is not a DPoP proof payload (because ~a)") - (get 'value) (recurse (get 'cause)))) - ((&cannot-fetch-issuer-configuration) - (format #f (G_ "I cannot fetch the issuer configuration of ~a (because ~a)") - (let ((iss (get 'issuer))) - (when (uri? iss) - (set! iss (uri->string iss))) - iss) - (recurse (get 'cause)))) - ((&cannot-fetch-jwks) - (format #f (G_ "I cannot fetch the JWKS of ~a at ~a (because ~a)") - (let ((iss (get 'issuer))) - (when (uri? iss) - (set! iss (uri->string iss))) - iss) - (let ((uri (get 'uri))) - (when (uri? uri) - (set! uri (uri->string uri))) - uri) - (recurse (get 'cause)))) - ((&dpop-method-mismatch) - (format #f (G_ "the HTTP method is signed for ~s, but ~s was requested") - (get 'signed) (get 'requested))) - ((&dpop-uri-mismatch) - (format #f (G_ "the HTTP uri is signed for ~a, but ~a was requested") - (uri->string (get 'signed)) (uri->string (get 'requested)))) - ((&dpop-signed-in-future) - (format #f (G_ "the date is ~a, but the DPoP proof is signed in the future at ~a") - (time-second (date->time-utc (get 'current))) - (time-second (date->time-utc (get 'signed))))) - ((&dpop-too-old) - (format #f (G_ "the date is ~a, but the DPoP proof was signed too long ago at ~a") - (time-second (date->time-utc (get 'current))) - (time-second (date->time-utc (get 'signed))))) - ((&dpop-unconfirmed-key) - (let ((key (get 'key)) - (expected (get 'expected)) - (cause (get 'cause))) - (cond - (expected - (format #f (G_ "the key ~s does not hash to ~a") key expected)) - (cause - (format #f (G_ "the key confirmation of ~s failed (because ~a)") key (recurse cause))) - (else - (format #f (G_ "the key confirmation of ~s failed") key))))) - ((&dpop-invalid-access-token-hash) - (let ((h (get 'hash)) - (at (get 'access-token))) - (if h - (format #f (G_ "the DPoP proof is bound to an access token with hash ~s, not ~s") - h at) - (format #f (G_ "the DPoP proof should be bound to the access token ~s") - at)))) - ((&jti-found) - (format #f (G_ "the jti ~s has already been found (because ~a)") - (get 'jti) (recurse (get 'cause)))) - ((&cannot-decode-access-token) - (format #f (G_ "I cannot decode ~s as an access token (because ~a)") - (get 'value) (recurse (get 'cause)))) - ((&cannot-encode-access-token) - (format #f (G_ "I cannot encode ~s as an access token with key ~s (because ~a)") - (get 'access-token) (get 'key) (recurse (get 'cause)))) - ((&cannot-decode-dpop-proof) - (format #f (G_ "I cannot decode ~s as a DPoP proof (because ~a)") - (get 'value) (recurse (get 'cause)))) - ((&cannot-encode-dpop-proof) - (format #f (G_ "I cannot encode ~s as a DPoP proof (because ~a)") - (get 'value) (recurse (get 'cause)))) - ((&cannot-fetch-linked-data) - (format #f (G_ "I could not fetch a RDF graph at ~a (because ~a)") - (uri->string (get 'uri)) (recurse (get 'cause)))) - ((¬-a-client-manifest) - (format #f (G_ "~s is not a client manifest (because ~a)") - (get 'value) (recurse (get 'cause)))) - ((&unauthorized-redirection-uri) - (format #f (G_ "~s does not authorize redirection URI ~a") - (get 'manifest) (uri->string (get 'uri)))) - ((&cannot-serve-public-manifest) - (format #f (G_ "I cannot serve a public manifest"))) - ((&no-client-manifest-registration) - (format #f (G_ "~a does not have a client manifest registration triple") - (uri->string (get 'id)))) - ((&inconsistent-client-manifest-id) - (format #f (G_ "the client manifest at ~a is advertised for ~a") - (uri->string (get 'id)) (uri->string (get 'advertised-id)))) - ((&cannot-fetch-client-manifest) - (format #f (G_ "I could not fetch the client manifest of ~a (because ~a)") - (uri->string (get 'id)) (recurse (get 'cause)))) - ((¬-an-authorization-code) - (format #f (G_ "~s is not an authorization code (because ~a)") - (get 'value) (recurse (get 'cause)))) - ((¬-an-authorization-code-header) - (format #f (G_ "~s is not an authorization code header (because ~a)") - (get 'value) (recurse (get 'cause)))) - ((¬-an-authorization-code-payload) - (format #f (G_ "~s is not an authorization code payload (because ~a)") - (get 'value) (recurse (get 'cause)))) - ((&authorization-code-expired) - (format #f (G_ "the current time is ~a, and the authorization code expired at ~a") - (time-second (date->time-utc (get 'current-time))) - (time-second (date->time-utc (get 'exp))))) - ((&cannot-decode-authorization-code) - (format #f (G_ "I cannot decode ~s as an authorization code (because ~a)") - (get 'value) (recurse (get 'cause)))) - ((&cannot-encode-authorization-code) - (format #f (G_ "I cannot encode ~s as an authorization code (because ~a)") - (get 'value) (recurse (get 'cause)))) - ((&invalid-refresh-token) - (format #f (G_ "there is no such refresh token as ~s") - (get 'refresh-token))) - ((&invalid-key-for-refresh-token) - (format #f (G_ "the refresh token is bound to a key confirmed as ~s, but it is used with key ~s") - (get 'jkt) (get 'key))) - ((&cannot-decode-id-token) - (format #f (G_ "I cannot decode ~s as an ID token (because ~a)") - (get 'value) (recurse (get 'cause)))) - ((&cannot-encode-id-token) - (format #f (G_ "I cannot encode ~s as an ID token (because ~a)") - (get 'value) (recurse (get 'cause)))) - ((&unsupported-grant-type) - (format #f (G_ "the grant type ~s is not supported") - (get 'value))) - ((&no-authorization-code) - (format #f (G_ "there is no authorization code in the request"))) - ((&no-refresh-token) - (format #f (G_ "there is no refresh token in the request"))) - ((¬-an-id-token) - (format #f (G_ "~s is not an ID token (because ~a)") - (get 'value) (recurse (get 'cause)))) - ((¬-an-id-token-header) - (format #f (G_ "~s is not an ID token header (because ~a)") - (get 'value) (recurse (get 'cause)))) - ((¬-an-id-token-payload) - (format #f (G_ "~s is not an ID token payload (because ~a)") - (get 'value) (recurse (get 'cause)))) - ((&unknown-client-locale) - (format #f (G_ "I couldn’t set the locale to ~s as an approximation of the client locale ~s") - (get 'c-locale) (get 'web-locale))) - ((&unconfirmed-provider) - (format #f (G_ "~s does not admit ~s as an identity provider") - (get 'subject) (get 'provider))) - ((&neither-identity-provider-nor-webid) - (format #f (G_ "~a is neither an identity provider (because ~a) nor a webid (because ~a)") - (uri->string (get 'uri)) - (recurse (get 'why-not-identity-provider)) - (recurse (get 'why-not-webid)))) - ((&profile-not-found) - (format #f (G_ "you don’t have a refresh token for identity ~a certified by ~a in ~s") - (uri->string (get 'webid)) - (uri->string (get 'iss)) - (get 'dir))) - ((&no-provider-candidates) - (format #f (G_ "all identity provider candidates for ~a failed: ~a") - (uri->string (get 'webid)) - (string-join - (map (lambda (cause) - (format #f (G_ "~s failed (because ~a)") - (uri->string (car cause)) (recurse (cdr cause)))) - (get 'causes)) - (G_ ", ")))) - ((&path-not-found) - (format #f (G_ "no resource has been found to serve URI path ~s") - (get 'path))) - ((&auxiliary-resource-absent) - (format #f (G_ "the resource kind ~s is absent for the resource at ~s") - (get 'kind') (get 'path))) - ((&uri-slash-semantics-error) - (format #f (G_ "no resource has been found to serve URI path ~s, but ~s exists") - (get 'path) (get 'expected-path))) - ((&cannot-delete-root) - (format #f (G_ "the root storage cannot be deleted"))) - ((&container-not-empty) - (format #f (G_ "the container ~s should be emptied before being deleted") - (get 'path))) - ((&cannot-fetch-group) - (format #f (G_ "the group ~s cannot be fetched (because ~a)") - (uri->string (get 'group-uri)) - (recurse (get 'cause)))) - ((&incorrect-containment-triples) - (format #f (G_ "the containment triples in the request to update ~s are not up to date") - (get 'path))) - ((&unsupported-media-type) - (format #f (G_ "the server cannot process resources with the ~s content-type") - (get 'content-type))) - ((&path-is-auxiliary) - (format #f (G_ "the client wants to create a resource at ~s, which is reserved for an auxiliary resource") - (get 'path))) - ((&forbidden) - (format #f (G_ "the operation on ~s by ~a is refused, because it’s not by ~s and the access control forbids the following mode of operation: ~s") - (get 'path) - (if (get 'user) - (uri->string (get 'user)) - (G_ "an anonymous user")) - (uri->string (get 'owner)) - (uri->string (get 'mode)))) - ((&precondition-failed) - (if (get 'real-etag) - (format #f (G_ "the client precondition failed for ~s: it allows for ~s, forbids ~s, but the resource has a representation of ~s") - (get 'path) (get 'if-match) (get 'if-none-match) (get 'real-etag)) - (format #f (G_ "the client precondition failed for ~s: it allows for ~s, forbids ~s, but the resource has no representation") - (get 'path) (get 'if-match) (get 'if-none-match)))) - ((¬-acceptable) - (format #f (G_ "the client wanted a response with a content type among ~s, but the resource at ~s has content-type ~s which cannot be converted to one of them") - (get 'client-accepts) - (get 'path) - (get 'content-type))) - ((&compound-exception) - (let ((components (get 'components))) - (if (null? components) - (G_ "that’s it") - (if (null? (cdr components)) - (recurse (car components)) - (if (null? (cddr components)) - (format #f (G_ "~a and ~a") - (recurse (car components)) - (recurse (cadr components))) - (format #f (G_ "~a, ~a") - (recurse (car components)) - (recurse (apply make-exception (cdr components))))))))) - ((&invalid-signature) - (format #f (G_ "the signature ~a does not match key ~s with payload ~a") - (get 'signature) (get 'key) (get 'payload))) - ((&request-failed-unexpectedly) - (format #f (G_ "the request failed unexpectedly with code ~a: ~s") - (get 'response-code) - (get 'response-reason-phrase))) - ((&undefined-variable) - (G_ "there is an undefined variable")) - ((&origin) - (format #f (G_ "the origin is ~a") - (exception-origin err))) - ((&message) - (format #f (G_ "a message is attached: ~a") - (exception-message err))) - ((&irritants) - (format #f (G_ "the values ~s are problematic") - (exception-irritants err))) - ((&exception-with-kind-and-args) - (format #f (G_ "there is a kind (~s) and args ~s") - (get 'kind) (get 'args))) - ((&assertion-failure) - (format #f (G_ "there is an assertion failure"))) - ((&quit-exception) - (format #f (G_ "the program quits with code ~a") - (get 'code))) - ((&non-continuable) - (format #f (G_ "the program cannot recover from this exception"))) - ((&external-error) - (format #f (G_ "there is an external error"))) - ((&error) - (format #f (G_ "there is an error"))) - (else - (format #f (G_ "there is an unknown exception of kind ~s") - (record-type-name type))))) - (format #f "~a" err))) + (make-exception + (make-error) + (make-exception-with-message message)))) diff --git a/src/scm/webid-oidc/example-app.scm b/src/scm/webid-oidc/example-app.scm index d6ef2a0..24c4d8a 100644 --- a/src/scm/webid-oidc/example-app.scm +++ b/src/scm/webid-oidc/example-app.scm @@ -17,9 +17,9 @@ (define-module (webid-oidc example-app) #:use-module ((webid-oidc client) #:prefix client:) #:use-module ((webid-oidc client accounts) #:prefix client:) - #:use-module (webid-oidc errors) #: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:) #:use-module ((webid-oidc config) #:prefix cfg:) @@ -32,7 +32,6 @@ #:use-module (ice-9 optargs) #:use-module (ice-9 receive) #:use-module (srfi srfi-19) - #:use-module (ice-9 i18n) #:use-module (srfi srfi-26) #:use-module (ice-9 getopt-long) #:use-module (ice-9 suspendable-ports) @@ -40,14 +39,8 @@ #:use-module (ice-9 rdelim) #:use-module (ice-9 match) #:use-module (sxml simple) - #:use-module (rnrs bytevectors)) - -(define (G_ text) - (let ((out (gettext text))) - (if (string=? out text) - ;; No translation, disambiguate - (car (reverse (string-split text #\|))) - out))) + #:use-module (rnrs bytevectors) + #:declarative? #t) (define (main) (define (do-the-trick subject issuer) diff --git a/src/scm/webid-oidc/fetch.scm b/src/scm/webid-oidc/fetch.scm index c027787..dfc5406 100644 --- a/src/scm/webid-oidc/fetch.scm +++ b/src/scm/webid-oidc/fetch.scm @@ -1,4 +1,4 @@ -;; webid-oidc, implementation of the Solid specification +;; disfluid, implementation of the Solid specification ;; Copyright (C) 2020, 2021 Vivien Kraus ;; This program is free software: you can redistribute it and/or modify @@ -15,9 +15,10 @@ ;; along with this program. If not, see <https://www.gnu.org/licenses/>. (define-module (webid-oidc fetch) - #:use-module (webid-oidc errors) #:use-module (ice-9 optargs) #:use-module (ice-9 receive) + #:use-module (ice-9 match) + #:use-module (ice-9 exceptions) #:use-module (rnrs bytevectors) #:use-module (web client) #:use-module (web request) @@ -27,51 +28,88 @@ #:use-module (turtle tordf) #:use-module (nquads tordf) #:use-module (json) - #:use-module (jsonld)) + #:use-module (jsonld) + #:declarative? #t + #:export + ( -(define*-public (fetch uri #:key (http-get http-get)) + &cannot-fetch-linked-data + make-cannot-fetch-linked-data + cannot-fetch-linked-data? + cannot-fetch-linked-data-uri + + fetch + )) + +(define-exception-type + &cannot-fetch-linked-data + &external-error + make-cannot-fetch-linked-data + cannot-fetch-linked-data? + (uri cannot-fetch-linked-data-uri)) + +(define* (fetch uri #:key (http-get http-get)) (unless (uri? uri) (set! uri (string->uri uri))) (with-exception-handler (lambda (error) - (raise-cannot-fetch-linked-data uri error)) + (let ((final-message + (if (exception-with-message? error) + (format #f (G_ "cannot fetch ~s as linked data: ~a") + (exception-message error)) + (format #f (G_ "cannot fetch ~s as linked data"))))) + (raise-exception + (make-exception + (make-cannot-fetch-linked-data uri) + (make-exception-with-message final-message) + error)))) (lambda () (receive (response response-body) (http-get uri #:headers `((accept (text/turtle application/n-quads application/ld+json)))) (with-exception-handler (lambda (error) - (raise-unexpected-response response error)) + (let ((final-message + (if (exception-with-message? error) + (format #f (G_ "unexpected response from the server: ~a") + (exception-message error)) + (format #f (G_ "unexpected response from the server"))))) + (raise-exception + (make-exception + (make-exception-with-message final-message))))) (lambda () (unless (eqv? (response-code response) 200) - (raise-request-failed-unexpectedly (response-code response) - (response-reason-phrase response))) + (let ((final-message + (format #f (G_ "the request failed unexpectedly with ~s ~s") + (response-code response) + (response-reason-phrase response)))) + (raise-exception + (make-exception + (make-exception-with-message final-message))))) (let ((content-type (response-content-type response))) - (unless (and content-type - (or - (eq? (car content-type) 'text/turtle) - (eq? (car content-type) 'application/n-quads) - (eq? (car content-type) 'text/x-nquads) - (eq? (car content-type) 'application/ld+json)) - (or (not (assq-ref (cdr content-type) 'charset)) - (equal? (assq-ref (cdr content-type) 'charset) "utf-8"))) - (raise-unexpected-header-value 'content-type content-type)) - (when (bytevector? response-body) - (set! response-body (utf8->string response-body))) - (with-exception-handler - (lambda (rdf-error) - (raise-not-turtle response-body rdf-error)) - (lambda () - (case (car content-type) - ((text/turtle) - (turtle->rdf (string-append - "# This is not a file name\n" - response-body) - (uri->string uri))) - ((application/ld+json) - (rdf-dataset-default-graph - (jsonld->rdf (json-string->scm response-body)))) - ((application/n-quads text/x-nquads) - (nquads->rdf (string-append - "# This is not a file name\n" - response-body))))))))))))) + (define (as-text!) + (when (bytevector? response-body) + (set! response-body + (utf8->string response-body)))) + (match content-type + (('text/turtle . _) + (as-text!) + (turtle->rdf (string-append + "# This is not a file name\n" + response-body) + (uri->string uri))) + ((or ('application/n-quads . _) + ('text/x-nquads . _)) + (nquads->rdf (string-append + "# This is not a file name\n" + response-body))) + (('application/ld+json . _) + (rdf-dataset-default-graph + (jsonld->rdf (json-string->scm response-body)))) + (else + (let ((final-message + (format #f (G_ "cannot negociate a recognized RFD content type, got ~s") + content-type))) + (raise-exception + (make-exception + (make-exception-with-message final-message))))))))))))) diff --git a/src/scm/webid-oidc/hello-world.scm b/src/scm/webid-oidc/hello-world.scm index d752aae..45e0657 100644 --- a/src/scm/webid-oidc/hello-world.scm +++ b/src/scm/webid-oidc/hello-world.scm @@ -1,4 +1,4 @@ -;; webid-oidc, implementation of the Solid specification +;; disfluis, implementation of the Solid specification ;; Copyright (C) 2020, 2021 Vivien Kraus ;; This program is free software: you can redistribute it and/or modify @@ -17,6 +17,7 @@ (define-module (webid-oidc hello-world) #:use-module (webid-oidc resource-server) #:use-module (webid-oidc server log) + #:use-module (webid-oidc web-i18n) #:use-module ((webid-oidc config) #:prefix cfg:) #:use-module (web request) #:use-module (web response) @@ -28,14 +29,28 @@ #:use-module (ice-9 getopt-long) #:use-module (ice-9 suspendable-ports) #:use-module (sxml simple) - #:use-module (srfi srfi-19)) + #:use-module (sxml match) + #:use-module (srfi srfi-19) + #:declarative? #t) -(define (G_ text) - (let ((out (gettext text))) - (if (string=? out text) - ;; No translation, disambiguate - (car (reverse (string-split text #\|))) - out))) +(define (hello-page id) + `(*TOP* + (*PI* xml "version=\"1.0\" encoding=\"utf-8\"") + (html (@ (xmlns "http://www.w3.org/1999/xhtml") + (xml:lang ,(W_ "xml-lang|en"))) + (body + ,(sxml-match + (xml->sxml + (W_ (format #f (W_ "<h1>Hello, ~a!</h1>") + (uri->string id)) + (sxml->xml + `(a (@ (href ,(uri->string id))) + ,(uri->string id))))) + ((*TOP* ,title) title)) + ,(sxml-match + (xml->sxml + (W_ (format #f (W_ "<p>The client is compatible with Solid.</p>")))) + ((*TOP* ,p) p)))))) (define-public (main) (setvbuf (current-output-port) 'none) @@ -126,48 +141,56 @@ Options: (prepare-log-file log-file)) (when error-file (prepare-error-file error-file)) - (if (eq? (request-method request) 'GET) - (let ((agent (assoc-ref (request-headers request) 'xxx-agent))) - (if (and agent (string->uri agent)) - (values - (build-response - #:headers `((content-type application/xhtml+xml) - (source . ,means-string))) - (with-output-to-string - (lambda () - (sxml->xml - `(*TOP* (*PI* xml "version=\"1.0\" encoding=\"utf-8\"") - (html (@ (xmlns "http://www.w3.org/1999/xhtml") - (xml:lang "en")) - (body - (h1 "Hello, " - (a (@ (href ,(uri->string (string->uri agent)))) - ,(uri->string (string->uri agent))) "!")))))))) - (values - (build-response #:code 401 - #:reason-phrase "Unauthorized" - #:headers `((content-type application/xhtml+xml) - (source . ,means-string))) - (with-output-to-string - (lambda () - (sxml->xml - `(*TOP* (*PI* xml "version=\"1.0\" encoding=\"utf-8\"") - (html (@ (xmlns "http://www.w3.org/1999/xhtml") - (xml:lang "en")) - (body - (h1 "Please authenticate!")))))))))) - (values - (build-response #:code 405 - #:reason-phrase "Method Not Allowed" - #:headers `((content-type application/xhtml+xml) - (source . ,means-string))) - (with-output-to-string - (lambda () - (sxml->xml - `(*TOP* (*PI* xml "version=\"1.0\" encoding=\"utf-8\"") - (html (@ (xmlns "http://www.w3.org/1999/xhtml") - (xml:lang "en")) - (body - (h1 "Please issue a GET request.")))))))))))) + (parameterize ((web-locale request)) + (if (eq? (request-method request) 'GET) + (let ((agent (assoc-ref (request-headers request) 'xxx-agent))) + (if (and agent (string->uri agent)) + (values + (build-response + #:headers `((content-type application/xhtml+xml) + (source . ,means-string))) + (with-output-to-string + (lambda () + (sxml->xml (hello-page agent))))) + (values + (build-response #:code 401 + #:reason-phrase (W_ "reason-phrase|Unauthorized") + #:headers `((content-type application/xhtml+xml) + (source . ,means-string))) + (with-output-to-string + (lambda () + (sxml->xml + `(*TOP* (*PI* xml "version=\"1.0\" encoding=\"utf-8\"") + (html (@ (xmlns "http://www.w3.org/1999/xhtml") + (xml:lang ,(W_ "xml-lang|en"))) + (body + ,(sxml-match + (xml->sxml + (W_ (format #f "<h1>Please authenticate</h1>"))) + ((*TOP* ,title) title)) + ,(sxml-match + (xml->sxml + (W_ (format #f "<p>This page requires authentication with Solid.</p>"))) + ((*TOP* ,p) p))))))))))) + (values + (build-response #:code 405 + #:reason-phrase (W_ "reason-phrase|Method Not Allowed") + #:headers `((content-type application/xhtml+xml) + (source . ,means-string))) + (with-output-to-string + (lambda () + (sxml->xml + `(*TOP* (*PI* xml "version=\"1.0\" encoding=\"utf-8\"") + (html (@ (xmlns "http://www.w3.org/1999/xhtml") + (xml:lang ,(W_ "xml-lang|en"))) + (body + ,(sxml-match + (xml->sxml + (W_ (format #f "<h1>Method not allowed</h1>"))) + ((*TOP* ,title) title)) + ,(sxml-match + (xml->sxml + (W_ (format #f "<p>You can only use the <emph>GET</emph> method on this resource.</p>"))) + ((*TOP* ,p) p)))))))))))))) (install-suspendable-ports!) (run-server handler 'http (list #:port (string->number port-string)))))))))) diff --git a/src/scm/webid-oidc/http-link.scm b/src/scm/webid-oidc/http-link.scm index 64efc07..f8a239a 100644 --- a/src/scm/webid-oidc/http-link.scm +++ b/src/scm/webid-oidc/http-link.scm @@ -1,4 +1,4 @@ -;; webid-oidc, implementation of the Solid specification +;; disfluid, implementation of the Solid specification ;; Copyright (C) 2020, 2021 Vivien Kraus ;; This program is free software: you can redistribute it and/or modify @@ -23,6 +23,7 @@ #:use-module (web request) #:use-module (web response) #:use-module (web http) + #:declarative? #t #:export ( diff --git a/src/scm/webid-oidc/identity-provider.scm b/src/scm/webid-oidc/identity-provider.scm index e22f1ef..7f1fb48 100644 --- a/src/scm/webid-oidc/identity-provider.scm +++ b/src/scm/webid-oidc/identity-provider.scm @@ -1,4 +1,4 @@ -;; webid-oidc, implementation of the Solid specification +;; disfluid, implementation of the Solid specification ;; Copyright (C) 2020, 2021 Vivien Kraus ;; This program is free software: you can redistribute it and/or modify @@ -22,6 +22,7 @@ #:use-module (webid-oidc jwk) #:use-module ((webid-oidc config) #:prefix cfg:) #:use-module ((webid-oidc stubs) #:prefix stubs:) + #:use-module ((webid-oidc parameters) #:prefix p:) #:use-module (webid-oidc jti) #:use-module (web request) #:use-module (web response) @@ -31,34 +32,37 @@ #:use-module (webid-oidc cache) #:use-module (ice-9 optargs) #:use-module (ice-9 receive) - #:use-module (ice-9 i18n) + #:use-module (webid-oidc web-i18n) #:use-module (ice-9 getopt-long) #:use-module (ice-9 suspendable-ports) + #:use-module (ice-9 match) + #:use-module (ice-9 exceptions) #:use-module (sxml simple) + #:use-module (sxml match) #:use-module (srfi srfi-19) - #:use-module (rnrs bytevectors)) + #:use-module (rnrs bytevectors) + #:declarative? #t + #:export + ( -(define (G_ text) - (let ((out (gettext text))) - (if (string=? out text) - ;; No translation, disambiguate - (car (reverse (string-split text #\|))) - out))) + make-identity-provider + + )) (define* (same-uri? a b #:key (skip-query #f)) (and (equal? (uri-path a) (uri-path b)) (or skip-query (equal? (uri-query a) (uri-query b))))) -(define*-public (make-identity-provider - issuer - key-file - subject - encrypted-password - jwks-uri - authorization-endpoint-uri - token-endpoint-uri - #:key - (http-get http-get)) +(define* (make-identity-provider + issuer + key-file + subject + encrypted-password + jwks-uri + authorization-endpoint-uri + token-endpoint-uri + #:key + (http-get http-get)) (let ((key (catch #t (lambda () @@ -82,55 +86,63 @@ (token-endpoint (make-token-endpoint token-endpoint-uri issuer alg key 3600)) (openid-configuration - (make-oidc-configuration jwks-uri - authorization-endpoint-uri - token-endpoint-uri)) + `((jwks_uri . ,(uri->string jwks-uri)) + (authorization_endpoint . ,(uri->string authorization-endpoint-uri)) + (token_endpoint . ,(uri->string token-endpoint-uri)) + (solid_oidc_supported . "https://solidproject.org/TR/solid-oidc"))) (openid-configuration-uri (build-uri 'https #:host (uri-host issuer) #:path "/.well-known/openid-configuration"))) (lambda (request request-body) (let ((uri (request-uri request)) - (current-time (current-time))) - (cond ((same-uri? uri openid-configuration-uri) - (let* ((current-sec (time-second current-time)) - (exp-sec (+ current-sec 3600)) - (exp (time-utc->date - (make-time time-utc 0 exp-sec)))) - (serve-oidc-configuration exp openid-configuration))) - ((same-uri? uri jwks-uri) - (let* ((current-sec (time-second current-time)) - (exp-sec (+ current-sec 3600)) - (exp (time-utc->date - (make-time time-utc 0 exp-sec)))) - (serve-jwks exp (make-jwks (list key))))) - ((same-uri? uri authorization-endpoint-uri #:skip-query #t) - (authorization-endpoint request request-body)) - ((same-uri? uri token-endpoint-uri) - (token-endpoint request request-body)) - ((same-uri? uri subject) - (values - (build-response #:headers '((content-type text/turtle)) - #:port #f) - (format #f - "@prefix foaf: <http://xmlns.com/foaf/0.1/> . + (current-time ((p:current-date)))) + (parameterize ((web-locale request)) + (cond ((same-uri? uri openid-configuration-uri) + (let* ((current-sec (time-second (date->time-utc current-time))) + (exp-sec (+ current-sec 3600)) + (exp (time-utc->date + (make-time time-utc 0 exp-sec)))) + (serve-oidc-configuration exp openid-configuration))) + ((same-uri? uri jwks-uri) + (let* ((current-sec (time-second (date->time-utc current-time))) + (exp-sec (+ current-sec 3600)) + (exp (time-utc->date + (make-time time-utc 0 exp-sec)))) + (serve-jwks exp (make-jwks (list key))))) + ((same-uri? uri authorization-endpoint-uri #:skip-query #t) + (authorization-endpoint request request-body)) + ((same-uri? uri token-endpoint-uri) + (token-endpoint request request-body)) + ((same-uri? uri subject) + (values + (build-response #:headers '((content-type text/turtle)) + #:port #f) + (format #f + "@prefix foaf: <http://xmlns.com/foaf/0.1/> . @prefix rdfs: <http://www.w3.org/2000/01/rdf-schema#> . <#~a> a foaf:Person ; rdfs:comment \"It works. Now you should use another service to serve that resource.\" . " - (uri-fragment subject)))) - (else - (values - (build-response #:code 404 - #:reason-phrase "Not Found" - #:headers '((content-type application/xhtml+xml))) - (with-output-to-string - (lambda () - (sxml->xml - `(*TOP* (*PI* xml "version=\"1.0\" encoding=\"utf-8\"") - (html (@ (xmlns "http://www.w3.org/1999/xhtml") - (xml:lang "en")) - (body - (h1 "Resource not found") - (p "This OpenID Connect identity provider does not know the resource you are requesting.")))))))))))))))) + (uri-fragment subject)))) + (else + (values + (build-response #:code 404 + #:reason-phrase (W_ "reason-phrase|Not Found") + #:headers '((content-type application/xhtml+xml))) + (with-output-to-string + (lambda () + (sxml->xml + `(*TOP* (*PI* xml "version=\"1.0\" encoding=\"utf-8\"") + (html (@ (xmlns "http://www.w3.org/1999/xhtml") + (xml:lang ,(W_ "xml-lang|en"))) + (body + ,(sxml-match + (xml->sxml + (W_ (format #f "<h1>Resource not found</h1>"))) + ((*TOP* ,title) title)) + ,(sxml-match + (xml->sxml + (W_ (format #f "<p>This OpenID Connect identity provider does not know the resource you are requesting.</p>"))) + ((*TOP* ,p) p)))))))))))))))))) diff --git a/src/scm/webid-oidc/jti.scm b/src/scm/webid-oidc/jti.scm index cf05bbb..150de0b 100644 --- a/src/scm/webid-oidc/jti.scm +++ b/src/scm/webid-oidc/jti.scm @@ -1,4 +1,4 @@ -;; webid-oidc, implementation of the Solid specification +;; disfluid, implementation of the Solid specification ;; Copyright (C) 2020, 2021 Vivien Kraus ;; This program is free software: you can redistribute it and/or modify @@ -16,12 +16,30 @@ (define-module (webid-oidc jti) #:use-module ((webid-oidc parameters) #:prefix p:) + #:use-module (webid-oidc web-i18n) #:use-module (ice-9 atomic) #:use-module (ice-9 threads) #:use-module (ice-9 match) + #:use-module (ice-9 exceptions) #:use-module (srfi srfi-9) #:use-module (srfi srfi-19) - #:export (jti-check)) + #:declarative? #t + #:export + ( + jti-check + + &jti-found + make-jti-found + jti-found? + jti-found-jti + )) + +(define-exception-type + &jti-found + &external-error + make-jti-found + jti-found? + (jti jti-found-jti)) (define jti-list (make-atomic-box '())) @@ -36,8 +54,15 @@ (match-lambda* ((() item) #f) (((($ <jti-item> exp jti) other ...) item) - (or (string=? jti item) - (lookup other item))))) + (when (string=? jti item) + (let ((final-message + (format #f (G_ "a replay has been detected with JTI ~s") + jti))) + (raise-exception + (make-exception + (make-jti-found jti) + (make-exception-with-message final-message))))) + (lookup other item)))) (define (jti-check jti valid-time) (let* ((current-time diff --git a/src/scm/webid-oidc/jwk.scm b/src/scm/webid-oidc/jwk.scm index 57da31d..5b17f29 100644 --- a/src/scm/webid-oidc/jwk.scm +++ b/src/scm/webid-oidc/jwk.scm @@ -1,4 +1,4 @@ -;; webid-oidc, implementation of the Solid specification +;; disfluid, implementation of the Solid specification ;; Copyright (C) 2020, 2021 Vivien Kraus ;; This program is free software: you can redistribute it and/or modify @@ -17,34 +17,97 @@ (define-module (webid-oidc jwk) #:use-module ((webid-oidc stubs) #:prefix stubs:) #:use-module (webid-oidc errors) + #:use-module (webid-oidc web-i18n) #:use-module (ice-9 receive) #:use-module (ice-9 optargs) + #:use-module (ice-9 exceptions) #:use-module (srfi srfi-19) #:use-module (web response) #:use-module (web client) - #:use-module (rnrs bytevectors)) - -(define-public (the-jwk x) + #:use-module (rnrs bytevectors) + #:declarative? #t + #:export + ( + the-jwk + jwk? + kty + the-public-jwk + jwk-public? + strip + jkt + make-rsa-public-key + make-rsa-private-key + make-ec-point + make-ec-scalar + generate-key + the-jwks + jwks? + make-jwks + jwks-keys + serve-jwks + get-jwks + + ¬-a-jwk + make-not-a-jwk + not-a-jwk? + + ¬-a-jwks + make-not-a-jwks + not-a-jwks? + )) + +(define-exception-type + ¬-a-jwk + &external-error + make-not-a-jwk + not-a-jwk?) + +(define-exception-type + ¬-a-jwks + &external-error + make-not-a-jwks + not-a-jwks?) + +(define (the-jwk x) (with-exception-handler - (lambda (cause) - (raise-not-a-jwk x cause)) + (lambda (error) + (let ((final-message + (if (exception-with-message? error) + (format #f (G_ "the JWK is invalid: ~a") + (exception-message error)) + (format #f (G_ "the JWK is invalid"))))) + (raise-exception + (make-exception + (make-not-a-jwk) + (make-exception-with-message final-message) + error)))) (lambda () (let ((kty (stubs:kty x))) (unless (or (eq? kty 'EC) (eq? kty 'RSA)) - (throw 'really-not-a-jwk)) + (fail (format #f (G_ "unknown key type ~s") + kty))) x)))) -(define-public (jwk? x) +(define (jwk? x) (false-if-exception (and (the-jwk x) #t))) -(define-public (kty x) +(define (kty x) (stubs:kty (the-jwk x))) -(define-public (the-public-jwk x) +(define (the-public-jwk x) (with-exception-handler - (lambda (cause) - (raise-not-a-public-jwk x cause)) + (lambda (error) + (let ((final-message + (if (exception-with-message? error) + (format #f (G_ "the public JWK is invalid: ~a") + (exception-message error)) + (format #f (G_ "the public JWK is invalid"))))) + (raise-exception + (make-exception + (make-not-a-jwk) + (make-exception-with-message final-message) + error)))) (lambda () (let ((key (the-jwk x))) (let ((crv (assq-ref key 'crv)) @@ -61,26 +124,35 @@ ((EC) ec-part) ((RSA) rsa-part)))))))) -(define-public (jwk-public? key) +(define (jwk-public? key) (false-if-exception (and (the-public-jwk key) #t))) -(define-public (strip key) +(define (strip key) (with-exception-handler - (lambda (cause) - (raise-not-a-public-jwk key cause)) + (lambda (error) + (let ((final-message + (if (exception-with-message? error) + (format #f (G_ "cannot extract the public part of the key: ~a") + (exception-message error)) + (format #f (G_ "cannot extract the public part of the key"))))) + (raise-exception + (make-exception + (make-not-a-jwk) + (make-exception-with-message final-message) + error)))) (lambda () (stubs:strip-key key)))) -(define-public (jkt x) +(define (jkt x) (stubs:jkt (the-public-jwk x))) -(define-public (make-rsa-public-key n e) +(define (make-rsa-public-key n e) (the-public-jwk `((n . ,n) (e . ,e)))) -(define-public (make-rsa-private-key d p q dp dq qi) +(define (make-rsa-private-key d p q dp dq qi) (the-jwk `((d . ,d) (p . ,p) @@ -89,7 +161,7 @@ (dq . ,dq) (qi . ,qi)))) -(define-public (make-ec-point crv x y) +(define (make-ec-point crv x y) (if (symbol? crv) (make-ec-point (symbol->string crv) x y) (the-public-jwk @@ -97,48 +169,62 @@ (x . ,x) (y . ,y))))) -(define-public (make-ec-scalar crv d) +(define (make-ec-scalar crv d) (if (symbol? crv) (make-ec-scalar (symbol->string crv) d) (the-jwk `((crv . ,crv) (d . ,d))))) -(define-public generate-key stubs:generate-key) +(define generate-key stubs:generate-key) (define (the-public-keys keys) (map the-public-jwk keys)) -(define-public (the-jwks jwks) +(define (the-jwks jwks) (let ((keys (vector->list (assoc-ref jwks 'keys)))) (unless keys - (raise-not-a-jwks jwks #f)) + (let ((final-message + (format #f (G_ "the JWKS is invalid, because it does not have keys")))) + (raise-exception + (make-exception + (make-not-a-jwks) + (make-exception-with-message final-message))))) (with-exception-handler - (lambda (cause) - (raise-not-a-jwks jwks cause)) + (lambda (error) + (let ((final-message + (if (exception-with-message? error) + (format #f (G_ "the JWKS is invalid: ~a") + (exception-message error)) + (format #f (G_ "the JWKS is invalid"))))) + (raise-exception + (make-exception + (make-not-a-jwks) + (make-exception-with-message final-message) + error)))) (lambda () `((keys . ,(list->vector (the-public-keys keys)))))))) -(define-public (jwks? jwks) +(define (jwks? jwks) (false-if-exception (and (the-jwks jwks) #t))) -(define-public (make-jwks keys) +(define (make-jwks keys) (if (vector? keys) (make-jwks (vector->list keys)) (let ((pubs (list->vector (map strip keys)))) (the-jwks `((keys . ,pubs)))))) -(define-public (jwks-keys jwks) +(define (jwks-keys jwks) (vector->list (assq-ref (the-jwks jwks) 'keys))) -(define-public (serve-jwks expiration-date jwks) +(define (serve-jwks expiration-date jwks) (values (build-response #:headers `((content-type . (application/json)) (expires . ,expiration-date))) (stubs:scm->json-string (the-jwks jwks)))) -(define*-public (get-jwks uri #:key (http-get http-get)) +(define* (get-jwks uri #:key (http-get http-get)) (receive (response response-body) (http-get uri) (with-exception-handler (lambda (cause) diff --git a/src/scm/webid-oidc/jws.scm b/src/scm/webid-oidc/jws.scm index 43eb707..24a8bbc 100644 --- a/src/scm/webid-oidc/jws.scm +++ b/src/scm/webid-oidc/jws.scm @@ -1,4 +1,4 @@ -;; webid-oidc, implementation of the Solid specification +;; disfluid, implementation of the Solid specification ;; Copyright (C) 2020, 2021 Vivien Kraus ;; This program is free software: you can redistribute it and/or modify @@ -17,91 +17,180 @@ (define-module (webid-oidc jws) #:use-module (webid-oidc jwk) #:use-module (webid-oidc errors) + #:use-module (webid-oidc web-i18n) #:use-module ((webid-oidc stubs) #:prefix stubs:) #:use-module (rnrs bytevectors) - #:use-module (ice-9 receive)) + #:use-module (ice-9 receive) + #:use-module (ice-9 exceptions) + #:use-module (ice-9 match) + #:declarative? #t + #:export + ( -(define-public (the-jws-header x) - (with-exception-handler - (lambda (cause) - (raise-not-a-jws-header x cause)) - (lambda () - (let ((alg (assq-ref x 'alg))) - (unless alg - (raise-missing-alist-key x 'alg)) - (unless (string? alg) - (raise-unsupported-alg alg)) - (case (string->symbol alg) - ((HS256 HS384 HS512 RS256 RS384 RS512 ES256 ES384 ES512 PS256 PS384 PS512) - x) - (else - (raise-unsupported-alg (string->symbol alg)))))))) - -(define-public (the-jws-payload x) - (with-exception-handler - (lambda (cause) - (raise-not-a-jws-payload x cause)) - (lambda () - (unless (list? x) - (scm-error 'wrong-type-arg "the-jws-payload" "expected a list" '() (list x))) - x))) + &invalid-jws + make-invalid-jws + invalid-jws? -(define-public (the-jws x) - (with-exception-handler - (lambda (cause) - (raise-not-a-jws x cause)) - (lambda () - (unless (pair? x) - (scm-error 'wrong-type-arg "the-jws" "expected a pair" '() (list x))) - (cons (the-jws-header (car x)) - (the-jws-payload (cdr x)))))) + the-jws + jws? -(define-public (jws-header? x) - (false-if-exception - (and (the-jws-header x) #t))) + jws-alg -(define-public (jws-payload? x) - (false-if-exception - (and (the-jws-payload x) #t))) + &cannot-query-identity-provider + make-cannot-query-identity-provider + cannot-query-identity-provider? + cannot-query-identity-provider-value -(define-public (jws? x) - (false-if-exception - (and (the-jws x) #t))) + &signed-in-future + make-signed-in-future + signed-in-future? + error-signature-date + error-current-date -(define-public (make-jws header payload) - (the-jws (cons (the-jws-header header) - (the-jws-payload payload)))) + &expired + make-expired + expired? + error-expiration-date + ;; error-current-date works for that one too -(define-public (jws-header jws) - (car (the-jws jws))) + jws-decode + jws-encode -(define-public (jws-payload jws) - (cdr (the-jws jws))) + )) -(define-public (jws-alg jws) - (if (jws? jws) - (jws-alg (jws-header jws)) - (string->symbol (assq-ref (the-jws-header jws) 'alg)))) +(define-exception-type + &invalid-jws + &external-error + 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"))))) + (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))))) (define (split-in-3-parts string separator) - (let ((parts (list->vector (string-split string separator)))) - (unless (eqv? (vector-length parts) 3) - (raise-not-in-3-parts string separator)) - (values (vector-ref parts 0) (vector-ref parts 1) (vector-ref parts 2)))) + (match (string-split string separator) + ((header payload signature) + (values header payload signature)) + (else + (let ((final-message + (format #f (G_ "the encoded JWS is not in 3 parts")))) + (raise-exception + (make-exception + (make-invalid-jws) + (make-exception-with-message final-message))))))) (define (base64-decode-json str) (with-exception-handler (lambda (error) - (cond - (((record-predicate ¬-base64) error) - (raise-exception error)) - (((record-predicate ¬-json) error) - (raise-exception error)) - (else - ;; From utf8->string - (raise-not-base64 str error)))) + (let ((final-message + (if (exception-with-message? error) + (format #f (G_ "the encoded JWS header or payload is not a JSON object encoded in base64: ~a") + (exception-message error)) + (format #f (G_ "the encoded JWS header or payload is not a JSON object encoded in base64"))))) + (raise-exception + (make-exception + (make-invalid-jws) + (make-exception-with-message final-message) + error)))) (lambda () - (stubs:json-string->scm (utf8->string (stubs:base64-decode str)))))) + (stubs:json-string->scm + (utf8->string (stubs:base64-decode str)))))) + +(define-exception-type + &cannot-query-identity-provider + &external-error + make-cannot-query-identity-provider + cannot-query-identity-provider? + (identity-provider cannot-query-identity-provider-value)) + +(define-exception-type + &signed-in-future + &external-error + make-signed-in-future + signed-in-future? + (signature-date error-signature-date) + (current-date error-current-date*)) + +(define-exception-type + &expired + &external-error + make-expired + expired? + (expiration-date error-expiration-date) + (current-date error-current-date**)) + +(define error-current-date + (match-lambda + ((or ($ &signed-in-future _ date) + ($ &expired _ date) + ($ &compound-exception (($ &signed-in-future _ date) _ ...)) + ($ &compound-exception (($ &expired _ date) _ ...))) + date) + (($ &compound-exception (_ sub-exceptions ...)) + (error-current-date (apply make-exception sub-exceptions))) + (else #f))) (define (parse str verify) (receive (header payload signature) @@ -109,31 +198,53 @@ (let ((base (string-append header "." payload)) (header (base64-decode-json header)) (payload (base64-decode-json payload))) - (let ((ret (make-jws header payload))) + (let ((ret `(,header . ,payload))) (verify ret base signature) ret)))) (define (verify-any alg keys payload signature) - (define (aux candidates) - (if (null? keys) - (raise-no-matching-key keys alg payload signature) - (let ((next-ok - (with-exception-handler - (lambda (error) - #f) - (lambda () - (stubs:verify alg (car candidates) payload signature) - #t) - #:unwind? #t - #:unwind-for-type &invalid-signature))) - (or next-ok - (aux (cdr candidates)))))) - (aux keys)) - -(define-public (jws-decode str lookup-keys) + (let try-with-key ((keys keys)) + (match keys + (() + (let ((final-message + (format #f (G_ "the JWS is not signed by any of the expected set of public keys")))) + (raise-exception + (make-exception + (make-invalid-jws) + (make-exception-with-message final-message))))) + ((next-key keys ...) + (with-exception-handler + (lambda (error) + (unless (stubs:invalid-signature? error) + (let ((final-message + (if (exception-with-message? error) + (format #f (G_ "while verifying the JWS signature: ~a") + (exception-message error)) + (format #f (G_ "an unexpected error happened while verifying a JWS"))))) + (raise-exception + (make-exception + (make-invalid-jws) + (make-exception-with-message final-message) + error)))) + (try-with-key keys)) + (lambda () + (stubs:verify alg next-key payload signature)) + #:unwind? #t + #:unwind-for-type stubs:&invalid-signature))))) + +(define (jws-decode str lookup-keys) (with-exception-handler (lambda (error) - (raise-cannot-decode-jws str error)) + (let ((final-message + (if (exception-with-message? error) + (format #f (G_ "cannot decode a JWS: ~a") + (exception-message error)) + (format #f (G_ "cannot decode a JWS"))))) + (raise-exception + (make-exception + (make-invalid-jws) + (make-exception-with-message final-message) + error)))) (lambda () (parse str (lambda (jws payload signature) @@ -143,17 +254,26 @@ (else keys)))) (verify-any (jws-alg jws) keys payload signature)))))))) -(define-public (jws-encode jws key) +(define (jws-encode jws key) (with-exception-handler (lambda (error) - (raise-cannot-encode-jws jws key error)) + (let ((final-message + (if (exception-with-message? error) + (format #f (G_ "cannot encode a JWS: ~a") + (exception-message error)) + (format #f (G_ "cannot encode a JWS"))))) + (raise-exception + (make-exception + (make-invalid-jws) + (make-exception-with-message final-message) + error)))) (lambda () - (let ((header (jws-header jws)) - (payload (jws-payload jws))) - (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 payload))) - (string-append payload "." signature))))))))) + (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 payload))) + (string-append payload "." signature)))))))))) diff --git a/src/scm/webid-oidc/offloading.scm b/src/scm/webid-oidc/offloading.scm index 9620193..1332c70 100644 --- a/src/scm/webid-oidc/offloading.scm +++ b/src/scm/webid-oidc/offloading.scm @@ -1,4 +1,4 @@ -;; webid-oidc, implementation of the Solid specification +;; dislfuid, implementation of the Solid specification ;; Copyright (C) 2021 Vivien Kraus ;; This program is free software: you can redistribute it and/or modify @@ -16,6 +16,7 @@ (define-module (webid-oidc offloading) #:use-module (ice-9 threads) + #:declarative? #t #:export (with-threads in-another-thread)) (define tag (make-prompt-tag)) diff --git a/src/scm/webid-oidc/oidc-configuration.scm b/src/scm/webid-oidc/oidc-configuration.scm index 2169a99..d9aab84 100644 --- a/src/scm/webid-oidc/oidc-configuration.scm +++ b/src/scm/webid-oidc/oidc-configuration.scm @@ -1,4 +1,4 @@ -;; webid-oidc, implementation of the Solid specification +;; disfluid, implementation of the Solid specification ;; Copyright (C) 2020, 2021 Vivien Kraus ;; This program is free software: you can redistribute it and/or modify @@ -17,6 +17,7 @@ (define-module (webid-oidc oidc-configuration) #:use-module (webid-oidc jwk) #:use-module (webid-oidc errors) + #:use-module (webid-oidc web-i18n) #:use-module ((webid-oidc stubs) #:prefix stubs:) #:use-module (web uri) #:use-module (web client) @@ -24,81 +25,135 @@ #:use-module (rnrs bytevectors) #:use-module (srfi srfi-19) #:use-module (ice-9 receive) - #:use-module (ice-9 optargs)) + #:use-module (ice-9 optargs) + #:use-module (ice-9 exceptions) + #:use-module (ice-9 match) + #:declarative? #t + #:export + ( + &invalid-oidc-configuration + make-invalid-oidc-configuratioon + invalid-oidc-configuration? -(define-public (the-oidc-configuration x) + the-oidc-configuration + oidc-configuration? + oidc-configuration-jwks-uri + oidc-configuration-authorization-endpoint + oidc-configuration-token-endpoint + oidc-configuration-jwks + serve-oidc-configuration + get-oidc-configuration + )) + +(define-exception-type + &invalid-oidc-configuration + &external-error + make-invalid-oidc-configuration + invalid-oidc-configuration?) + +(define (the-oidc-configuration x) (with-exception-handler - (lambda (cause) - (raise-not-an-oidc-configuration x cause)) + (lambda (error) + (let ((final-message + (if (exception-with-message? error) + (format #f (G_ "the OIDC configuration is invalid: ~a") + (exception-message error)) + (format #f (G_ "the OIDC configuration is invalid"))))) + (raise-exception + (make-exception + (make-invalid-oidc-configuration) + (make-exception-with-message final-message) + error)))) (lambda () - (let ((jwks-uri (assq-ref x 'jwks_uri)) - (token-endpoint (assq-ref x 'token_endpoint)) - (authorization-endpoint (assq-ref x 'authorization_endpoint))) - (unless jwks-uri - (raise-missing-alist-key x 'jwks_uri)) - (unless token-endpoint - (raise-missing-alist-key x 'token_endpoint)) - (unless authorization-endpoint - (raise-missing-alist-key x 'authorization_endpoint)) - (for-each - (lambda (field) - (unless (string->uri field) - (scm-error 'wrong-type-arg - "the-oidc-configuration" - "expected an uri-like string" - '() - (list field)))) - (list jwks-uri token-endpoint authorization-endpoint)) - x)))) + (let examine ((data x) + (jwks-uri #f) + (token-endpoint #f) + (authorization-endpoint #f) + (solid-oidc-supported #f) + (other-fields '())) + (match data + (() + (unless (and jwks-uri token-endpoint authorization-endpoint solid-oidc-supported) + (fail (format #f (G_ "the OIDC configuration does not have: ~s") + `(,@(if jwks-uri '() '("jwks_uri")) + ,@(if token-endpoint '() '("token_endpoint")) + ,@(if authorization-endpoint '() '("authorization_endpoint")) + ,@(if solid-oidc-supported '() '("solid_oidc_supported")))))) + `((jwks_uri . ,(uri->string jwks-uri)) + (token_endpoint . ,(uri->string token-endpoint)) + (authorization_endpoint . ,(uri->string authorization-endpoint)) + (solid_oidc_supported . "https://solidproject.org/TR/solid-oidc") + ,@(reverse other-fields))) + ((('jwks_uri . (? string->uri (? string? given-jwks-uri))) data ...) + (examine data (or jwks-uri (string->uri given-jwks-uri)) + token-endpoint authorization-endpoint + solid-oidc-supported other-fields)) + ((('jwks_uri . invalid) data ...) + (fail (format #f (G_ "invalid JWKS URI: ~s") + invalid))) + ((('token_endpoint . (? string->uri (? string? given-token-endpoint))) data ...) + (examine data jwks-uri + (or token-endpoint (string->uri given-token-endpoint)) + authorization-endpoint solid-oidc-supported other-fields)) + ((('token_endpoint . invalid) data ...) + (fail (format #f (G_ "invalid token endpoint: ~s") + invalid))) + ((('authorization_endpoint + . (? string->uri (? string? given-authorization-endpoint))) + data ...) + (examine data jwks-uri token-endpoint + (or authorization-endpoint (string->uri given-authorization-endpoint)) + solid-oidc-supported other-fields)) + ((('authorization_endpoint . invalid) data ...) + (fail (format #f (G_ "invalid authorization endpoint: ~s") + invalid))) + ((('solid_oidc_supported . "https://solidproject.org/TR/solid-oidc") + data ...) + (examine data jwks-uri token-endpoint authorization-endpoint + (or solid-oidc-supported #t) + other-fields)) + ((('solid_oidc_supported . incorrect) data ...) + (fail (format #f (G_ "\"solid_oidc_supported\" should be set to ~s, not ~s") + "https://solidproject.org/TR/solid-oidc" + incorrect))) + ((((? symbol? key) . value) data ...) + (examine data jwks-uri token-endpoint authorization-endpoint + solid-oidc-supported + `((,key . ,value) ,@other-fields))) + (else + (fail (format #f (G_ "invalid JSON object"))))))))) -(define-public (oidc-configuration? obj) +(define (oidc-configuration? obj) (false-if-exception - (and (the-oidc-configuration obj) obj))) - -(define-public (make-oidc-configuration jwks-uri - authorization-endpoint - token-endpoint) - (when (string? jwks-uri) - (set! jwks-uri (string->uri jwks-uri))) - (when (string? authorization-endpoint) - (set! authorization-endpoint (string->uri authorization-endpoint))) - (when (string? token-endpoint) - (set! token-endpoint (string->uri token-endpoint))) - (the-oidc-configuration - `((jwks_uri . ,(uri->string jwks-uri)) - (token_endpoint . ,(uri->string token-endpoint)) - (authorization_endpoint . ,(uri->string authorization-endpoint))))) + (the-oidc-configuration obj))) (define (uri-field what) (lambda (x) (let ((str (assq-ref (the-oidc-configuration x) what))) (string->uri str)))) -(define-public oidc-configuration-jwks-uri +(define oidc-configuration-jwks-uri (uri-field 'jwks_uri)) -(define-public oidc-configuration-authorization-endpoint +(define oidc-configuration-authorization-endpoint (uri-field 'authorization_endpoint)) -(define-public oidc-configuration-token-endpoint +(define oidc-configuration-token-endpoint (uri-field 'token_endpoint)) -(define-public (oidc-configuration-jwks cfg . args) +(define (oidc-configuration-jwks cfg . args) (apply get-jwks (oidc-configuration-jwks-uri cfg) args)) -(define-public (serve-oidc-configuration expiration-date cfg) - (let ((with-solid-oidc-supported - (acons 'solid_oidc_supported "https://solidproject.org/TR/solid-oidc" - (the-oidc-configuration cfg)))) - (values (build-response #:headers `((content-type . (application/json)) - (expires . ,expiration-date))) - (stubs:scm->json-string with-solid-oidc-supported)))) +(define (serve-oidc-configuration expiration-date cfg) + (values (build-response #:headers `((content-type . (application/json)) + (expires . ,expiration-date))) + (stubs:scm->json-string cfg))) -(define*-public (get-oidc-configuration host - #:key - (userinfo #f) - (port #f) - (http-get http-get)) +(define* (get-oidc-configuration host + #:key + (userinfo #f) + (port #f) + (http-get http-get)) (when (and (string? host) (false-if-exception (string->uri host))) @@ -113,21 +168,31 @@ #:path "/.well-known/openid-configuration"))) (receive (response response-body) (http-get uri) (with-exception-handler - (lambda (cause) - (raise-unexpected-response response cause)) + (lambda (error) + (let ((final-message + (if (exception-with-message? error) + (format #f (G_ "cannot fetch the OIDC configuration: ~a") + (exception-message error)) + (format #f (G_ "cannot fetch the OIDC configuration"))))) + (raise-exception + (make-exception + (make-invalid-oidc-configuration) + (make-exception-with-message final-message) + error)))) (lambda () (unless (eqv? (response-code response) 200) - (raise-request-failed-unexpectedly - (response-code response) - (response-reason-phrase response))) + (fail (format #f (G_ "the server responded with ~s ~s") + (response-code response) + (response-reason-phrase response)))) (let ((content-type (response-content-type response))) (unless content-type - (raise-unexpected-header-value 'content-type content-type)) + (fail (format #f (G_ "there is no content-type")))) (unless (and (eq? (car content-type) 'application/json) (or (equal? (assoc-ref (cdr content-type) 'charset) "utf-8") (not (assoc-ref (cdr content-type) 'charset)))) - (raise-unexpected-header-value 'content-type content-type)) + (fail (format #f (G_ "unexpected content-type: ~s") + content-type))) (unless (string? response-body) (set! response-body (utf8->string response-body))) (the-oidc-configuration (stubs:json-string->scm response-body)))))))) diff --git a/src/scm/webid-oidc/oidc-id-token.scm b/src/scm/webid-oidc/oidc-id-token.scm index e95efaf..2f84f64 100644 --- a/src/scm/webid-oidc/oidc-id-token.scm +++ b/src/scm/webid-oidc/oidc-id-token.scm @@ -1,4 +1,4 @@ -;; webid-oidc, implementation of the Solid specification +;; disfluid, implementation of the Solid specification ;; Copyright (C) 2020, 2021 Vivien Kraus ;; This program is free software: you can redistribute it and/or modify @@ -19,201 +19,307 @@ #:use-module (webid-oidc errors) #:use-module (webid-oidc jws) #:use-module (webid-oidc jti) + #:use-module (webid-oidc web-i18n) #:use-module ((webid-oidc stubs) #:prefix stubs:) #:use-module ((webid-oidc parameters) #:prefix p:) #:use-module (web uri) #:use-module (web client) #:use-module (ice-9 optargs) - #:use-module (srfi srfi-19)) + #:use-module (ice-9 exceptions) + #:use-module (ice-9 match) + #:use-module (srfi srfi-19) + #:declarative? #t + #:export + ( + &invalid-id-token + make-invalid-id-token + invalid-id-token? -(define-public (the-id-token-header x) - (with-exception-handler - (lambda (error) - (raise-not-an-id-token-header x error)) - (lambda () - (the-jws-header x)))) + the-id-token + id-token? -(define-public (id-token-header? x) - (false-if-exception - (and (the-id-token-header x) #t))) + 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 + )) -(define-public (the-id-token-payload x) +(define-exception-type + &invalid-id-token + &external-error + make-invalid-id-token + invalid-id-token?) + +(define (the-id-token x) (with-exception-handler (lambda (error) - (raise-not-an-id-token-payload x 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 () - (let ((x (the-jws-payload x))) - (let ((webid (assq-ref x 'webid)) - (iss (assq-ref x 'iss)) - (sub (assq-ref x 'sub)) - (aud (assq-ref x 'aud)) - (nonce (assq-ref x 'nonce)) - (iat (assq-ref x 'iat)) - (exp (assq-ref x 'exp))) - (unless (and webid (string? webid) (string->uri webid)) - (raise-incorrect-webid-field webid)) - (unless (and iss (string? iss) (string->uri iss)) - (raise-incorrect-iss-field iss)) - (unless (string? sub) - (raise-incorrect-sub-field sub)) - (unless (and aud (string? aud) (string->uri aud)) - (raise-incorrect-aud-field aud)) - (unless (string? nonce) - (raise-incorrect-nonce-field nonce)) - (unless (integer? iat) - (raise-incorrect-iat-field iat)) - (unless (and (integer? exp) (>= exp iat)) - (raise-incorrect-exp-field exp)) - x))))) - -(define-public (id-token-payload? x) + (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 sud '() '("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 - (and (the-id-token-header x) #t))) + (the-id-token x))) -(define-public (the-id-token x) - (with-exception-handler - (lambda (cause) - (raise-not-an-id-token x cause)) - (lambda () - (cons (the-id-token-header (car x)) - (the-id-token-payload (cdr x)))))) +(define (id-token-alg code) + (match (the-id-token code) + ((header . _) + (string->symbol (assq-ref header 'alg))))) -(define-public (id-token? x) - (false-if-exception - (and (the-id-token x) #t))) - -(define-public (make-id-token header payload) - (the-id-token - (cons header payload))) - -(define-public (make-id-token-payload webid iss sub aud nonce exp iat) - (when (date? exp) - (set! exp (date->time-utc exp))) - (when (time? exp) - (set! exp (time-second exp))) - (when (date? iat) - (set! iat (date->time-utc iat))) - (when (time? iat) - (set! iat (time-second iat))) - (when (uri? webid) - (set! webid (uri->string webid))) - (when (uri? iss) - (set! iss (uri->string iss))) - (when (uri? aud) - (set! aud (uri->string aud))) - (the-id-token-payload - `((webid . ,webid) - (iss . ,iss) - (sub . ,sub) - (aud . ,aud) - (nonce . ,nonce) - (exp . ,exp) - (iat . ,iat)))) - -(define-public (id-token-header code) - (car (the-id-token code))) - -(define-public (id-token-payload code) - (cdr (the-id-token code))) - -(define-public (id-token-alg code) - (when (id-token? code) - (set! code (id-token-header code))) - (jws-alg (the-id-token-header code))) - -(define-public (id-token-webid code) - (when (id-token? code) - (set! code (id-token-payload code))) - (string->uri - (assq-ref (the-id-token-payload code) 'webid))) - -(define-public (id-token-iss code) - (when (id-token? code) - (set! code (id-token-payload code))) - (string->uri - (assq-ref (the-id-token-payload code) 'iss))) - -(define-public (id-token-sub code) - (when (id-token? code) - (set! code (id-token-payload code))) - (assq-ref (the-id-token-payload code) 'sub)) - -(define-public (id-token-aud code) - (when (id-token? code) - (set! code (id-token-payload code))) - (string->uri - (assq-ref (the-id-token-payload code) 'aud))) - -(define-public (id-token-nonce code) - (when (id-token? code) - (set! code (id-token-payload code))) - (assq-ref (the-id-token-payload code) 'nonce)) - -(define-public (id-token-exp code) - (when (id-token? code) - (set! code (id-token-payload code))) - (time-utc->date - (make-time time-utc 0 (assq-ref - (the-id-token-payload code) - 'exp)))) - -(define-public (id-token-iat code) - (when (id-token? code) - (set! code (id-token-payload code))) - (time-utc->date - (make-time time-utc 0 (assq-ref - (the-id-token-payload code) - 'iat)))) - -(define*-public (id-token-decode str #:key (http-get http-get)) +(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 (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)) (with-exception-handler (lambda (error) - (raise-cannot-decode-id-token str 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)))) (lambda () (jws-decode str (lambda (token) (let ((iss (id-token-iss token))) - (let ((cfg - (with-exception-handler - (lambda (error) - (raise-cannot-fetch-issuer-configuration iss error)) - (lambda () - (get-oidc-configuration - (uri-host iss) - #:userinfo (uri-userinfo iss) - #:port (uri-port iss) - #:http-get http-get))))) - (with-exception-handler - (lambda (error) - (raise-cannot-fetch-jwks iss - (oidc-configuration-jwks-uri cfg) - error)) - (lambda () - (oidc-configuration-jwks cfg #:http-get http-get)))))))))) - -(define-public (id-token-encode id-token key) + (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) - (raise-cannot-encode-id-token id-token key 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*-public (issue-id-token - issuer-key - #:key - (alg #f) - (webid #f) - (iss #f) - (sub #f) - (aud #f) - (validity 3600)) +(define* (issue-id-token + issuer-key + #:key + (alg #f) + (webid #f) + (iss #f) + (sub #f) + (aud #f) + (validity 3600)) (unless sub - (set! sub webid)) - (id-token-encode - (make-id-token - `((alg . ,(symbol->string alg))) - (let ((iat (time-second (date->time-utc ((p:current-date)))))) - (make-id-token-payload webid iss sub aud (stubs:random 12) - (+ iat validity) iat))) - issuer-key)) + (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))) + . ((webid . ,(uri->string webid)) + (iss . ,(uri->string iss)) + (sub . ,sub) + (aud . ,(uri->string aud)) + (nonce . ,(stubs:random 12)) + (iat . ,iat) + (exp . ,exp)))) + issuer-key))) diff --git a/src/scm/webid-oidc/parameters.scm b/src/scm/webid-oidc/parameters.scm index 3b24361..603a2cd 100644 --- a/src/scm/webid-oidc/parameters.scm +++ b/src/scm/webid-oidc/parameters.scm @@ -1,7 +1,24 @@ +;; 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/>. + (define-module (webid-oidc parameters) #:use-module (srfi srfi-19) #:use-module (webid-oidc jti) - #:export (data-home cache-home current-date)) + #:export (data-home cache-home current-date) + #:declarative? #t) (define data-home (make-parameter diff --git a/src/scm/webid-oidc/program.scm b/src/scm/webid-oidc/program.scm index 9d65b70..2b80bef 100644 --- a/src/scm/webid-oidc/program.scm +++ b/src/scm/webid-oidc/program.scm @@ -25,6 +25,7 @@ #:use-module (webid-oidc jti) #:use-module (webid-oidc offloading) #:use-module (webid-oidc catalog) + #:use-module (webid-oidc web-i18n) #:use-module ((webid-oidc parameters) #:prefix p:) #:use-module ((webid-oidc stubs) #:prefix stubs:) #:use-module ((webid-oidc config) #:prefix cfg:) @@ -45,13 +46,6 @@ #:use-module (webid-oidc cache) #:use-module (web server)) -(define (G_ text) - (let ((out (gettext text))) - (if (string=? out text) - ;; No translation, disambiguate - (car (reverse (string-split text #\|))) - out))) - (define logging-mutex (make-mutex)) (define* (http-get-with-log uri #:key (headers '())) @@ -59,16 +53,17 @@ (define uri-string (if (uri? uri) (uri->string uri) uri)) (with-mutex logging-mutex (when (getenv "XML_CATALOG_FILES") - (format (current-error-port) "~a: Warning: XML_CATALOG_FILES is set to ~s.\n" + (format (current-error-port) (G_ "~a: Warning: XML_CATALOG_FILES is set to ~s.\n") date (getenv "XML_CATALOG_FILES"))) - (format (current-error-port) "~a: GET ~a ~s...\n" + (format (current-error-port) (G_ "~a: GET ~a ~s...\n") date uri-string headers)) (set! uri (resolve-uri uri #:http-get (lambda* (uri . args) (with-mutex logging-mutex - (format (current-error-port) "~a: Warning: loading XML catalog from the web, ~s.\n" + (format (current-error-port) + (G_ "~a: Warning: loading XML catalog from the web, ~s.\n") date (uri->string uri))) (apply http-get uri args)))) @@ -76,7 +71,7 @@ (in-another-thread (http-get uri #:headers headers)) (with-mutex logging-mutex - (format (current-error-port) "~a: GET ~a ~s: ~s ~a bytes\n" + (format (current-error-port) (G_ "~a: GET ~a ~s: ~s ~a bytes\n") date uri-string headers response (cond ((bytevector? response-body) @@ -115,84 +110,81 @@ (string-append (getenv "HOME") "/.cache")) "/disfluid")) ;; Fix the date - (p:current-date ((p:current-date)))) + (p:current-date ((p:current-date))) + (web-locale request)) (call/ec (lambda (return) (with-exception-handler (lambda (error) + (unless (exception-with-message? error) + (let ((final-message + (format #f (G_ "really bad internal server error")))) + (raise-exception + (make-exception + (make-exception-with-message final-message) + error)))) (with-mutex logging-mutex (format (current-error-port) (G_ "~a: ~a: Internal server error: ~a\n") (date->string ((p:current-date))) (request-ip-address request) - (error->str error))) + (exception-message error))) (return (build-response #:code 500 - #:reason-phrase "Internal Server Error" + #:reason-phrase (W_ "Internal Server Error") #:headers `((source . ,complete-corresponding-source) (date . ,((p:current-date))))) - "Sorry, there was an error.")) + (W_ "Sorry, there was an error."))) (lambda () - (with-exception-handler - (lambda (error) - (with-mutex logging-mutex - (format (current-error-port) - (G_ "The client locale ~s can’t be approximated by system locale ~s (because ~a), using C.\n") - ((record-accessor &unknown-client-locale 'web-locale) error) - ((record-accessor &unknown-client-locale 'c-locale) error) - (error->str error)))) - (lambda () - (receive (response response-body user cause) - (call-with-values - (lambda () - (handler request request-body)) - (case-lambda - ((response response-body) - (values response response-body #f #f)) - ((response response-body user) - (values response response-body user #f)) - ((response response-body user cause) - (values response response-body user cause)))) - (let ((logging-port - (let ((response-code (response-code response))) - (if (>= response-code 400) - ;; That’s an error - (current-error-port) - (current-output-port))))) - (with-mutex logging-mutex - (format logging-port - (G_ "~a: ~s ~a ~s ~a\n") - (if user - (format #f (G_ "~a: ~a (~a)") - (date->string (time-utc->date (current-time))) - (uri->string user) - (request-ip-address request)) - (format #f (G_ "~a: ~a") - (date->string (time-utc->date (current-time))) - (request-ip-address request))) - (request-method request) - (uri-path (request-uri request)) - (response-code response) - (if cause - (string-append - (response-reason-phrase response) - " " - (format #f (G_ "(there was an error: ~a)") - (error->str cause))) - (response-reason-phrase response))))) - (return - (build-response - #:version (response-version response) - #:code (response-code response) - #:reason-phrase (response-reason-phrase response) - #:headers `((source . ,complete-corresponding-source) - (date . ,((p:current-date))) - ,@(response-headers response)) - #:port (response-port response) - #:validate-headers? #t) - response-body))) - #:unwind? #t - #:unwind-for-type &unknown-client-locale)))))))) + (receive (response response-body user cause) + (call-with-values + (lambda () + (handler request request-body)) + (case-lambda + ((response response-body) + (values response response-body #f #f)) + ((response response-body user) + (values response response-body user #f)) + ((response response-body user cause) + (values response response-body user cause)))) + (let ((logging-port + (let ((response-code (response-code response))) + (if (>= response-code 400) + ;; That’s an error + (current-error-port) + (current-output-port))))) + (with-mutex logging-mutex + (format logging-port + (G_ "~a: ~s ~a ~s ~a\n") + (if user + (format #f (G_ "~a: ~a (~a)") + (date->string (time-utc->date (current-time))) + (uri->string user) + (request-ip-address request)) + (format #f (G_ "~a: ~a") + (date->string (time-utc->date (current-time))) + (request-ip-address request))) + (request-method request) + (uri-path (request-uri request)) + (response-code response) + (if (and cause (exception-with-message? cause)) + (string-append + (response-reason-phrase response) + " " + (format #f (G_ "(there was an error: ~a)") + (exception-message cause))) + (response-reason-phrase response))))) + (return + (build-response + #:version (response-version response) + #:code (response-code response) + #:reason-phrase (response-reason-phrase response) + #:headers `((source . ,complete-corresponding-source) + (date . ,((p:current-date))) + ,@(response-headers response)) + #:port (response-port response) + #:validate-headers? #t) + response-body))))))))) (define (serve-one-client* handler implementation server state) ;; Same as serve-one-client, except it is served in a promise. diff --git a/src/scm/webid-oidc/provider-confirmation.scm b/src/scm/webid-oidc/provider-confirmation.scm index 1baf2f3..aa9e085 100644 --- a/src/scm/webid-oidc/provider-confirmation.scm +++ b/src/scm/webid-oidc/provider-confirmation.scm @@ -1,4 +1,4 @@ -;; webid-oidc, implementation of the Solid specification +;; disfluid, implementation of the Solid specification ;; Copyright (C) 2020, 2021 Vivien Kraus ;; This program is free software: you can redistribute it and/or modify @@ -22,24 +22,50 @@ #:use-module (web response) #:use-module (rnrs bytevectors) #:use-module (srfi srfi-19) + #:use-module (srfi srfi-26) #:use-module (ice-9 receive) #:use-module (ice-9 optargs) + #:use-module (ice-9 match) + #:use-module (ice-9 exceptions) + #:use-module (webid-oidc web-i18n) #:use-module (rdf rdf) - #:use-module (turtle tordf)) + #:use-module (turtle tordf) + #:declarative? #t + #:export + ( + + &unconfirmed-provider + make-unconfirmed-provider + unconfirmed-provider? + + get-provider-confirmations + confirm-provider + )) + +(define-exception-type + &unconfirmed-provider + &external-error + make-unconfirmed-provider + unconfirmed-provider?) (define (find-confirmations subject graph) - (cond ((null? graph) '()) - ((and (string=? (rdf-triple-predicate (car graph)) - "http://www.w3.org/ns/solid/terms#oidcIssuer") - (string? (rdf-triple-subject (car graph))) - (string=? (rdf-triple-subject (car graph)) subject) - (string? (rdf-triple-object (car graph))) - (string->uri (rdf-triple-object (car graph))) - (eq? (uri-scheme (string->uri (rdf-triple-object (car graph)))) - 'https)) - (cons (string->uri (rdf-triple-object (car graph))) - (find-confirmations subject (cdr graph)))) - (else (find-confirmations subject (cdr graph))))) + (let search-graph ((graph graph) + (confirmations '())) + (match graph + (() (reverse confirmations)) + ((hd graph ...) + (match `(,(rdf-triple-subject hd) + ,(rdf-triple-predicate hd) + ,(rdf-triple-object hd)) + (((? (cute equal? subject <>) _) + "http://www.w3.org/ns/solid/terms#oidcIssuer" + (? string? + (= string->uri + (and (? uri? provider) + (= uri-scheme 'https))))) + (search-graph graph `(,provider ,@confirmations))) + (else + (search-graph graph confirmations))))))) (define (serve-confirmations expiration-date subject cnf) (let ((resource (format #f "@prefix solid: <http://www.w3.org/ns/solid/terms#> . @@ -55,9 +81,9 @@ (expires . ,expiration-date))) resource))) -(define*-public (get-provider-confirmations subject - #:key - (http-get http-get)) +(define* (get-provider-confirmations subject + #:key + (http-get http-get)) (unless (equal? (uri-scheme subject) 'https) (set! subject (build-uri 'https #:userinfo (uri-userinfo subject) @@ -73,14 +99,28 @@ #:port (uri-port subject)) (find-confirmations (uri->string subject) graph)))) -(define*-public (confirm-provider subject issuer - #:key (http-get http-get)) +(define* (confirm-provider subject issuer + #:key (http-get http-get)) (define (search lst) (if (null? lst) (raise-unconfirmed-provider subject issuer) (or (string=? (car lst) (uri->string issuer)) (search (cdr lst))))) (unless (string=? (uri-host subject) (uri-host issuer)) - (search (get-provider-confirmations - subject - #:http-get http-get)))) + (let search ((providers (get-provider-confirmations + subject + #:http-get http-get))) + (match providers + (() + (let ((final-message + (format #f ("~s has not set ~s as an identity provider") + (uri->string subject) + (uri->string issuer)))) + (raise-exception + (make-exception + (make-unconfirmed-provider) + (make-exception-with-message final-message))))) + (((? (cute equal? <> issuer) _) . _) + #t) + ((_ providers ...) + (search providers)))))) diff --git a/src/scm/webid-oidc/rdf-index.scm b/src/scm/webid-oidc/rdf-index.scm index b70dc9a..71919ad 100644 --- a/src/scm/webid-oidc/rdf-index.scm +++ b/src/scm/webid-oidc/rdf-index.scm @@ -1,4 +1,4 @@ -;; webid-oidc, implementation of the Solid specification +;; disfluid, implementation of the Solid specification ;; Copyright (C) 2020, 2021 Vivien Kraus ;; This program is free software: you can redistribute it and/or modify @@ -18,56 +18,52 @@ #:use-module (oop goops) #:use-module (rdf rdf) #:use-module (web uri) + #:use-module (ice-9 match) + #:use-module (srfi srfi-26) + #:declarative? #t #:export ( with-index )) -(define (normalize uri) - ;; It is possible to hide triples by percent-escaping - ;; some characters, so that match will fail to see - ;; them. With normalization, it should be impossible. - (when (string? uri) - (set! uri (string->uri uri))) - (let ((scheme (uri-scheme uri)) - (userinfo (uri-userinfo uri)) - (host (uri-host uri)) - (port (uri-port uri)) - (path (uri-path uri)) - (query (uri-query uri)) - (fragment (uri-fragment uri))) - (let ((normalized-scheme scheme) - (normalized-userinfo userinfo) - (normalized-host host) - (normalized-port port) - (normalized-path - (let ((path-ends-in-slash? (string-suffix? "/" path))) - (string-append - "/" - (encode-and-join-uri-path - (split-and-decode-uri-path path)) - (if (and (not (equal? path "/")) - path-ends-in-slash?) - "/" - "")))) - (normalized-query - (and query - (uri-encode (uri-decode query)))) - (normalized-fragment - (and fragment - (uri-encode (uri-decode fragment))))) - (build-uri normalized-scheme - #:userinfo normalized-userinfo - #:host normalized-host - #:port normalized-port - #:path normalized-path - #:query normalized-query - #:fragment normalized-fragment)))) +(define normalize + (match-lambda + ((and (= uri-scheme scheme) + (= uri-userinfo userinfo) + (= uri-host host) + (= uri-port port) + (= uri-path path) + (= uri-query query) + (= uri-fragment fragment)) + (let ((normalized-path + (let ((path-ends-in-slash? (string-suffix? "/" path))) + (string-append + "/" + (encode-and-join-uri-path + (split-and-decode-uri-path path)) + (if (and (not (equal? path "/")) + path-ends-in-slash?) + "/" + "")))) + (normalized-query + (and query + (uri-encode (uri-decode query)))) + (normalized-fragment + (and fragment + (uri-encode (uri-decode fragment))))) + (build-uri scheme + #:userinfo userinfo + #:host host + #:port port + #:path normalized-path + #:query normalized-query + #:fragment normalized-fragment))))) -(define (normalize-object object) - (if (string? object) - (uri->string (normalize object)) - object)) +(define normalize-object + (match-lambda + ((? string? (= string->uri (? uri? x))) + (uri->string (normalize x))) + (object object))) (define-class <rdf-index> () (triples #:init-keyword #:triples #:getter triples) @@ -80,43 +76,41 @@ (define (build-index triples) (let ((ret (make <rdf-index> #:triples (list->vector triples)))) - (define (do-index n triples) - (unless (null? triples) - (let ((first (car triples)) - (rest (cdr triples))) - (let ((s (normalize-object (rdf-triple-subject first))) - (p (normalize-object (rdf-triple-predicate first))) - (o (normalize-object (rdf-triple-object first)))) - (let ((other-s (hash-ref (subject-index ret) s '())) - (other-p (hash-ref (predicate-index ret) p '())) - (other-o (hash-ref (object-index ret) o '())) - (i (- n 1))) - (hash-set! (subject-index ret) s (cons i other-s)) - (hash-set! (predicate-index ret) p (cons i other-p)) - (hash-set! (object-index ret) o (cons i other-o)))) - (do-index (- n 1) rest)))) - (do-index (length triples) (reverse triples)) - ret)) + (let do-index ((n (length triples)) + (triples (reverse triples))) + (match triples + (() ret) + ((($ rdf-triple + (= normalize-object s) + (= normalize-object p) + (= normalize-object o)) + triples ...) + (let ((other-s (hash-ref (subject-index ret) s '())) + (other-p (hash-ref (predicate-index ret) p '())) + (other-o (hash-ref (object-index ret) o '())) + (i (- n 1))) + (hash-set! (subject-index ret) s `(,i ,@other-s)) + (hash-set! (predicate-index ret) p `(,i ,@other-p)) + (hash-set! (object-index ret) o `(,i ,@other-o))) + (do-index (- n 1) triples)))))) -(define (intersection-2 a b) - (cond - ((not a) b) - ((not b) a) - ((or (null? a) (null? b)) - '()) - ((< (car a) (car b)) - (intersection-2 (cdr a) b)) - ((> (car a) (car b)) - (intersection-2 a (cdr b))) - (else - (cons (car a) (intersection-2 (cdr a) (cdr b)))))) +(define intersection-2 + ;; Intersection of two lists of integers, but if one is false, only + ;; consider the other. + (match-lambda* + ((or (#f x) (x #f)) x) + ((or (() _) (_ ())) '()) + ((and (a b) + ((hda tla ...) (hdb tlb ...))) + (cond ((< hda hdb) (intersection-2 tla b)) + ((> hda hdb) (intersection-2 a tlb)) + (else `(,hda ,@(intersection-2 tla tlb))))))) -(define (intersection a . rest) - (if (null? rest) - a - (let ((b (car rest)) - (true-rest (cdr rest))) - (apply intersection (intersection-2 a b) true-rest)))) +(define intersection + (match-lambda* + ((x) x) + ((a b c ...) + (apply intersection (intersection-2 a b) c)))) (define (rdf-match index subject predicate object) (let ((by-subject @@ -135,17 +129,15 @@ (normalize-object object) '())))) (let ((indices (intersection by-subject by-predicate by-object))) - (define (accumulate-triples acc i) - (if (null? i) - (reverse acc) - (let ((t (vector-ref (triples index) (car i)))) - (accumulate-triples (cons t acc) (cdr i))))) (if indices - (accumulate-triples '() indices) + (let accumulate-triples ((acc '()) + (i indices)) + (match i + (() (reverse acc)) + ((next i ...) + (let ((t (vector-ref (triples index) next))) + (accumulate-triples `(,t ,@acc) i))))) (vector->list (triples index)))))) - (define (with-index graph f) - (let ((index (build-index graph))) - (f (lambda (s p o) - (rdf-match index s p o))))) + (f (cute rdf-match (build-index graph) <> <> <>))) diff --git a/src/scm/webid-oidc/refresh-token.scm b/src/scm/webid-oidc/refresh-token.scm index e3fbf7c..14d7361 100644 --- a/src/scm/webid-oidc/refresh-token.scm +++ b/src/scm/webid-oidc/refresh-token.scm @@ -18,13 +18,33 @@ #:use-module (webid-oidc errors) #:use-module ((webid-oidc stubs) #:prefix stubs:) #:use-module (webid-oidc jwk) + #:use-module (webid-oidc web-i18n) #:use-module ((webid-oidc parameters) #:prefix p:) #:use-module (web uri) #:use-module (ice-9 optargs) #:use-module (ice-9 threads) + #:use-module (ice-9 match) + #:use-module (ice-9 exceptions) + #:use-module (srfi srfi-9) #:use-module (srfi srfi-19) + #:use-module (srfi srfi-26) + #:use-module (sxml simple) + #:use-module (sxml match) + #:declarative? #t #:export ( + <refresh-token> + make-refresh-token + refresh-token? + refresh-token-sub + refresh-token-aud + refresh-token-jkt + refresh-token-refresh-token + + &invalid-refresh-token + make-invalid-refresh-token + invalid-refresh-token? + list-refresh-tokens update-refresh-token-list issue-refresh-token @@ -32,83 +52,141 @@ remove-refresh-token )) +(define-exception-type + &invalid-refresh-token + &external-error + make-invalid-refresh-token + invalid-refresh-token?) + +(define-record-type <refresh-token> + (make-refresh-token sub aud jkt refresh-token) + refresh-token? + (sub refresh-token-sub) + (aud refresh-token-aud) + (jkt refresh-token-jkt) + (refresh-token refresh-token-refresh-token)) + (define (list-refresh-tokens) - (catch #t - (lambda () - (with-input-from-file (format #f "~a/refresh-tokens.scm" (p:data-home)) - read)) - (lambda errors - '()))) - -;; TODO: use stubs:atomically-update-file and remove that mutex. -(define mutex (make-mutex)) - -(define (set-refresh-token-list list) - (define dir (p:data-home)) - (define old-file (format #f "~a/refresh-tokens.scm" dir)) - (define new-file (format #f "~a/refresh-tokens.scm~" dir)) - (stubs:call-with-output-file* - new-file - (lambda (port) - (write list port) - (close-port port))) - (rename-file new-file old-file)) + (let generate-list + ((content + (catch #t + (lambda () + (call-with-input-file (format #f "~a/refresh-tokens.xml" (p:data-home)) + (cute xml->sxml <> + #:namespaces '((disfluid + . "https://disfluid.planete-kraus.eu/refresh-token/v1"))))) + (lambda error + '(*TOP* (disfluid:refresh-tokens))))) + (parsed-refresh-tokens '())) + (sxml-match + content + ((*TOP* (disfluid:refresh-tokens)) + (reverse parsed-refresh-tokens)) + ((*TOP* (disfluid:refresh-tokens + (disfluid:refresh-token + (@ (sub ,subject) + (aud ,audience) + (jkt ,jkt) + (refresh-token ,refresh-token))) + ,other-refresh-tokens ...)) + (let ((content + `(*TOP* + (disfluid:refresh-tokens + ,@other-refresh-tokens))) + (next-refresh-token + (make-refresh-token (string->uri subject) + (string->uri audience) + jkt + refresh-token))) + (generate-list content + `(,next-refresh-token + ,@parsed-refresh-tokens))))))) -(define (update-refresh-token-list f) - (with-mutex mutex - (let ((old (list-refresh-tokens))) - (let ((new (f old))) - (set-refresh-token-list new))))) +(define (update-refresh-token-list transformer) + (stubs:atomically-update-file + (format #f "~a/refresh-tokens.xml" (p:data-home)) + (format #f "~a/refresh-tokens.xml.lock" (p:data-home)) + (lambda (port) + (let* ((old-refresh-tokens (list-refresh-tokens)) + (new-refresh-tokens (transformer old-refresh-tokens))) + (chmod port #o600) + (sxml->xml + `(*TOP* + (refresh-tokens + (@ (xmlns "https://disfluid.planete-kraus.eu/refresh-token/v1")) + ,@(map + (match-lambda + (($ <refresh-token> + (= uri->string subject) + (= uri->string audience) + jkt + refresh-token) + `(refresh-token + (@ (sub ,subject) + (aud ,audience) + (jkt ,jkt) + (refresh-token ,refresh-token))))) + new-refresh-tokens))) + port))))) (define (remove sub aud) + (cute filter + (match-lambda + (($ <refresh-token> + (? (cute equal? <> sub) _) + (? (cute equal? <> aud) _) + _ _) + #f) + (else #t)) + <>)) + +(define (keep-n n) (lambda (old) - (filter (lambda (o) - (not (and (equal? (assq-ref o 'sub) - (uri->string sub)) - (equal? (assq-ref o 'aud) - (uri->string aud))))) - old))) - -(define (keep-n n list) - (cond - ((<= n 0) '()) - ((null? list) '()) - (else (cons (car list) (keep-n (- n 1) (cdr list)))))) + (let start-at ((i 0) (data old) (kept '())) + (match data + (() (reverse kept)) + ((saved data ...) + (if (>= i n) + (reverse kept) + (start-at (1+ i) data `(,saved ,@kept)))))))) (define (insert sub aud jkt jti) (define remover (remove sub aud)) + (define truncator (keep-n 20)) (lambda (old) - (keep-n - 20 - (cons `((sub . ,(uri->string sub)) - (aud . ,(uri->string aud)) - (jkt . ,jkt) - (refresh_token . ,jti)) - (remover old))))) + (truncator + `(,(make-refresh-token sub aud jkt jti) + ,@(remover old))))) (define (issue-refresh-token sub aud jkt) - (define jti (stubs:random 12)) - (update-refresh-token-list (insert sub aud jkt jti)) - jti) + (let ((jti (stubs:random 12))) + (update-refresh-token-list (insert sub aud jkt jti)) + jti)) (define (with-refresh-token refresh-token key f) - (let ((list (list-refresh-tokens))) - (define (check list) - (if (null? list) - (raise-invalid-refresh-token refresh-token) - (let ((hd (car list)) - (tl (cdr list))) - (let ((sub (string->uri (assq-ref hd 'sub))) - (aud (string->uri (assq-ref hd 'aud))) - (cnf/jkt (assq-ref hd 'jkt)) - (the-refresh-token (assq-ref hd 'refresh_token))) - (if (string=? refresh-token the-refresh-token) - (begin - (unless (equal? (jkt key) cnf/jkt) - (raise-invalid-key-for-refresh-token key cnf/jkt)) - (f sub aud)) - (check tl)))))) - (check list))) + (let search ((tokens (list-refresh-tokens))) + (match tokens + (() + (let ((final-message + (format #f (G_ "the refresh token does not exist")))) + (raise-exception + (make-exception + (make-invalid-refresh-token) + (make-exception-with-message final-message))))) + ((($ <refresh-token> (? uri? sub) (? uri? aud) (? string? the-jkt) (? string? the-rft)) + tokens ...) + (if (equal? refresh-token the-rft) + (begin + (unless (equal? (jkt key) the-jkt) + (let ((final-message + (format #f (G_ "the refresh token is bound to key ~s, which is not that one") + the-jkt))) + (raise-exception + (make-exception + (make-invalid-refresh-token) + (make-exception-with-message final-message))))) + (f sub aud)) + (search tokens)))))) (define (remove-refresh-token sub aud) (update-refresh-token-list (remove sub aud))) diff --git a/src/scm/webid-oidc/resource-server.scm b/src/scm/webid-oidc/resource-server.scm index 5ee84db..4b38248 100644 --- a/src/scm/webid-oidc/resource-server.scm +++ b/src/scm/webid-oidc/resource-server.scm @@ -25,6 +25,8 @@ #:use-module ((webid-oidc server read) #:prefix ldp:) #:use-module ((webid-oidc server update) #:prefix ldp:) #:use-module ((webid-oidc server delete) #:prefix ldp:) + #:use-module ((webid-oidc server resource wac) #:prefix wac:) + #:use-module ((webid-oidc server resource path) #:prefix ldp:) #:use-module (webid-oidc server precondition) #:use-module (webid-oidc http-link) #:use-module ((webid-oidc parameters) #:prefix p:) @@ -38,33 +40,33 @@ #:use-module (web client) #:use-module (ice-9 optargs) #:use-module (ice-9 receive) - #:use-module (ice-9 i18n) + #:use-module (webid-oidc web-i18n) #:use-module (ice-9 getopt-long) #:use-module (ice-9 suspendable-ports) #:use-module (ice-9 control) #:use-module (ice-9 match) + #:use-module (ice-9 exceptions) #:use-module (sxml simple) - #:use-module (srfi srfi-19)) + #:use-module (srfi srfi-19) + #:declarative? #t + #:export + ( + make-authenticator + make-resource-server + )) -(define (G_ text) - (let ((out (gettext text))) - (if (string=? out text) - ;; No translation, disambiguate - (car (reverse (string-split text #\|))) - out))) - -(define*-public (make-authenticator #:key - (server-uri #f) - (current-time current-time) - (http-get http-get)) +(define* (make-authenticator #:key + (server-uri #f) + (http-get http-get)) (unless (and server-uri (uri? server-uri)) - (error "You need to pass #:server-uri URI where URI is the public URI of the server, as a (web uri).")) + (fail (G_ "You need to pass #:server-uri URI where URI is the public URI of the server, as a (web uri)."))) (lambda (request request-body) (let ((headers (request-headers request)) (uri (request-uri request)) (method (request-method request)) (current-time ((p:current-date)))) - (parameterize ((p:current-date current-time)) ;; fix the date + (parameterize ((web-locale request) + (p:current-date current-time)) ;; fix the date (let ((authz (assoc-ref headers 'authorization)) (dpop (assoc-ref headers 'dpop)) (full-uri (build-uri (uri-scheme server-uri) @@ -82,10 +84,14 @@ (eq? (car authz) 'dpop) (with-exception-handler (lambda (error) - (format (current-error-port) - (G_ "~a: authentication failure: ~a\n") - (date->string current-time) - (error->str error)) + (if (exception-with-message? error) + (format (current-error-port) + (G_ "~a: authentication failure: ~a\n") + (date->string current-time) + (exception-message error)) + (format (current-error-port) + (G_ "~a: authentication failure\n") + (date->string current-time))) #f) (lambda () ;; Sometimes the access is the cadr as a symbol, @@ -151,7 +157,7 @@ (return (build-response #:code 412 - #:reason-phrase "Precondition Failed") + #:reason-phrase (W_ "reason-phrase|Precondition Failed")) #f user)) (lambda () @@ -166,7 +172,7 @@ (return (build-response #:code 304 - #:reason-phrase "Not Modified" + #:reason-phrase (W_ "reason-phrase|Not Modified") #:headers headers) #f user)) @@ -175,14 +181,14 @@ (check-precondition path if-match if-none-match etag)) (respond-normal))))) -(define*-public (make-resource-server - #:key - (server-uri #f) - (owner #f) - (authenticator #f) - (http-get http-get)) +(define* (make-resource-server + #:key + (server-uri #f) + (owner #f) + (authenticator #f) + (http-get http-get)) (unless owner - (error "The owner is not defined.")) + (fail (G_ "The owner is not defined."))) (declare-link-header!) (unless authenticator (set! authenticator @@ -190,7 +196,8 @@ #:server-uri server-uri #:http-get http-get))) (lambda (request request-body) - (parameterize ((p:current-date ((p:current-date)))) ;; Fix the date + (parameterize ((p:current-date ((p:current-date))) ;; Fix the date + (web-locale request)) (let ((user (authenticator request request-body))) (handle-errors (lambda (return) @@ -253,7 +260,7 @@ (request-links request))))) (return (build-response - #:code 201 #:reason-phrase "Created" + #:code 201 #:reason-phrase (W_ "reason-phrase|Created") #:headers `((location . ,(ldp:create server-uri owner user (uri-path (request-uri request)) @@ -275,15 +282,21 @@ "" user))))) (lambda (return error) - (if (cannot-fetch-group? error) - (format (current-error-port) (G_ "Warning: ~a\n") - (error->str error)) + (if (wac:cannot-fetch-group? error) + (if (exception-with-message? error) + (format (current-error-port) + (G_ "~a: ignoring a group that cannot be fetched: ~a\n") + (date->string ((p:current-date))) + (exception-message error)) + (format (current-error-port) + (G_ "~a: ignoring a group that cannot be fetched\n") + (date->string ((p:current-date))))) (cond - ((uri-slash-semantics-error? error) + ((ldp:uri-slash-semantics-error? error) (return (build-response #:code 301 - #:reason-phrase "Found" + #:reason-phrase (W_ "reason-phrase|Found") #:headers `((location . ,(build-uri @@ -294,55 +307,55 @@ #:path (uri-slash-semantics-error-expected-path error))))) #f user)) - ((or (path-not-found? error) - (auxiliary-resource-absent? error) - (forbidden? error)) + ((or (ldp:path-not-found? error) + (ldp:auxiliary-resource-absent? error) + (wac:forbidden? error)) (if user ;; That’s a forbidden (return - (build-response #:code 403 #:reason-phrase "Forbidden") + (build-response #:code 403 #:reason-phrase (W_ "reason-phrase|Forbidden")) #f user) (return - (build-response #:code 401 #:reason-phrase "Unauthorized" + (build-response #:code 401 #:reason-phrase (W_ "reason-phrase|Unauthorized") #:headers `((www-authenticate . ((DPoP))))) #f user))) - ((or (cannot-delete-root? error)) + ((ldp:cannot-delete-root? error) (return (build-response #:code 405 - #:reason-phrase "Method Not Allowed") + #:reason-phrase (W_ "reason-phrase|Method Not Allowed")) #f user)) - ((or (container-not-empty? error) - (incorrect-containment-triples? error) - (path-is-auxiliary? error)) + ((or (ldp:container-not-empty? error) + (ldp:incorrect-containment-triples? error) + (ldp:path-is-auxiliary? error)) (return (build-response #:code 409 - #:reason-phrase "Conflict") + #:reason-phrase (W_ "reason-phrase|Conflict")) #f user)) - ((unsupported-media-type? error) + ((ldp:unsupported-media-type? error) (return (build-response #:code 415 - #:reason-phrase "Unsupported Media Type") + #:reason-phrase (W_ "reason-phrase|Unsupported Media Type")) #f user)) ((precondition-failed? error) (return (build-response #:code 412 - #:reason-phrase "Precondition Failed") + #:reason-phrase (W_ "reason-phrase|Precondition Failed")) #f user)) ((not-acceptable? error) (return (build-response #:code 406 - #:reason-phrase "Not Acceptable") + #:reason-phrase (W_ "reason-phrase|Not Acceptable")) #f user)) (else diff --git a/src/scm/webid-oidc/reverse-proxy.scm b/src/scm/webid-oidc/reverse-proxy.scm index a1b05e3..30e6d48 100644 --- a/src/scm/webid-oidc/reverse-proxy.scm +++ b/src/scm/webid-oidc/reverse-proxy.scm @@ -1,4 +1,4 @@ -;; webid-oidc, implementation of the Solid specification +;; disfluid, implementation of the Solid specification ;; Copyright (C) 2020, 2021 Vivien Kraus ;; This program is free software: you can redistribute it and/or modify @@ -32,14 +32,20 @@ #:use-module (web response) #:use-module (web client) #:use-module (webid-oidc cache) - #:use-module (web server)) + #:use-module (webid-oidc web-i18n) + #:use-module (web server) + #:declarative? #t + #:export + ( + make-reverse-proxy + )) -(define*-public (make-reverse-proxy - #:key - (server-uri #f) - (http-get http-get) - (endpoint #f) - (auth-header 'XXX-Agent)) +(define* (make-reverse-proxy + #:key + (server-uri #f) + (http-get http-get) + (endpoint #f) + (auth-header 'XXX-Agent)) (set! auth-header ;; We need to remove the lowercase version of auth-header from ;; all incoming requests! @@ -51,7 +57,7 @@ #:server-uri server-uri #:http-get http-get)) (unless (and endpoint (uri? endpoint)) - (error "#:endpoint argument is not present or not an URI.")) + (fail (G_ "#:endpoint argument is not present or not an URI."))) (lambda (request request-body) (let ((agent (catch #t @@ -66,7 +72,8 @@ (else (apply throw key args)))))) (request-time ((p:current-date)))) - (parameterize ((p:current-date request-time)) + (parameterize ((p:current-date request-time) + (web-locale request)) ;; The time is now set for the duration of the request (let ((raw-headers (request-headers request))) (let ((modified-headers diff --git a/src/scm/webid-oidc/serve.scm b/src/scm/webid-oidc/serve.scm index c46ab8c..db95089 100644 --- a/src/scm/webid-oidc/serve.scm +++ b/src/scm/webid-oidc/serve.scm @@ -1,4 +1,4 @@ -;; webid-oidc, implementation of the Solid specification +;; disfluid, implementation of the Solid specification ;; Copyright (C) 2021 Vivien Kraus ;; This program is free software: you can redistribute it and/or modify @@ -17,6 +17,7 @@ (define-module (webid-oidc serve) #:use-module (webid-oidc errors) #:use-module (webid-oidc fetch) + #:use-module (webid-oidc web-i18n) #:use-module (ice-9 optargs) #:use-module (ice-9 receive) #:use-module (ice-9 exceptions) @@ -30,11 +31,29 @@ #:use-module (nquads fromrdf) #:use-module (json) #:use-module (jsonld) + #:declarative? #t #:export ( + + ¬-acceptable + make-not-acceptable + not-acceptable? + not-acceptable-client-accepts + not-acceptable-path + not-acceptable-content-type + convert )) +(define-exception-type + ¬-acceptable + &external-error + make-not-acceptable + not-acceptable? + (client-accepts not-acceptable-client-accepts) + (path not-acceptable-path) + (content-type not-acceptable-content-type)) + (define (convert client-accepts server-name path content-type content) (let ((data-as-rdf (false-if-exception @@ -53,7 +72,11 @@ ;; Content negociation is asked (let try-satisfy ((accepts client-accepts)) (if (null? accepts) - (raise-exception (make-not-acceptable client-accepts path content-type)) + (let ((final-message + (format #f (G_ "content negociation failed while serving a request")))) + (raise-exception + (make-not-acceptable client-accepts path content-type) + (make-exception-with-message final-message))) (let ((request (caar accepts))) (cond ((or (eq? request content-type) diff --git a/src/scm/webid-oidc/server/create.scm b/src/scm/webid-oidc/server/create.scm index b7b208d..dc9651e 100644 --- a/src/scm/webid-oidc/server/create.scm +++ b/src/scm/webid-oidc/server/create.scm @@ -1,4 +1,4 @@ -;; webid-oidc, implementation of the Solid specification +;; disfluid, implementation of the Solid specification ;; Copyright (C) 2020, 2021 Vivien Kraus ;; This program is free software: you can redistribute it and/or modify @@ -21,6 +21,7 @@ #:use-module (webid-oidc server read) #:use-module (webid-oidc cache) #:use-module (webid-oidc fetch) + #:use-module (webid-oidc web-i18n) #:use-module (webid-oidc rdf-index) #:use-module (webid-oidc server resource wac) #:use-module ((webid-oidc stubs) #:prefix stubs:) @@ -42,20 +43,51 @@ #:use-module (ice-9 threads) #:use-module (rnrs bytevectors) #:use-module (oop goops) + #:declarative? #t #:export ( + &incorrect-containment-triples + make-incorrect-containment-triples + incorrect-containment-triples? + incorrect-containment-triples-path + + &unsupported-media-type + make-unsupported-media-type + unsupported-media-type? + unsupported-media-type-content-type + create create-root )) +(define-exception-type + &incorrect-containment-triples + &external-error + make-incorrect-containment-triples + incorrect-containment-triples? + (path incorrect-containment-triples-path)) + +(define-exception-type + &unsupported-media-type + &external-error + make-unsupported-media-type + unsupported-media-type? + (content-type unsupported-media-type-content-type)) + (define (without-containment-triples doc-uri content-type content) (case content-type ((text/turtle) #t) (else - (raise-exception (make-unsupported-media-type content-type)))) + (let ((final-message + (format #f (G_ "only text/turtle is allowed for the target of a POST request, not ~s") + content-type))) + (raise-exception + (make-exception + (make-unsupported-media-type content-type) + (make-exception-with-message final-message)))))) (let ((graph (fetch doc-uri #:http-get @@ -69,8 +101,13 @@ (unless (null? (rdf-match (uri->string doc-uri) "http://www.w3.org/ns/auth/acl#contains" #f)) - (raise-exception (make-incorrect-containment-triples - (uri-path doc-uri)))))))) + (let ((final-message + (format #f (G_ "the created resource cannot have containment triples")))) + (raise-exception + (make-exception + (make-incorrect-containment-triples + (uri-path doc-uri)) + (make-exception-with-message final-message))))))))) (define (types-indicate-container? types) (and (not (null? types)) @@ -106,7 +143,13 @@ ;; non-empty. (if container? "/" ""))))) (when (auxiliary-path? (uri-path doc-uri)) - (raise-exception (make-path-is-auxiliary (uri-path doc-uri)))) + (let ((final-message + (format #f (G_ "cannot POST to an auxiliary resource path, ~s") + (uri-path doc-uri)))) + (raise-exception + (make-exception + (make-path-is-auxiliary (uri-path doc-uri)) + (make-exception-with-message final-message))))) (when container? (without-containment-triples doc-uri content-type content)) (with-session diff --git a/src/scm/webid-oidc/server/delete.scm b/src/scm/webid-oidc/server/delete.scm index b5fb3a9..4e4ce66 100644 --- a/src/scm/webid-oidc/server/delete.scm +++ b/src/scm/webid-oidc/server/delete.scm @@ -1,4 +1,4 @@ -;; webid-oidc, implementation of the Solid specification +;; disfluid, implementation of the Solid specification ;; Copyright (C) 2020, 2021 Vivien Kraus ;; This program is free software: you can redistribute it and/or modify @@ -43,6 +43,7 @@ #:use-module (ice-9 hash-table) #:use-module (rnrs bytevectors) #:use-module (oop goops) + #:declarative? #t #:export ( diff --git a/src/scm/webid-oidc/server/log.scm b/src/scm/webid-oidc/server/log.scm index f7dfa48..23c13c6 100644 --- a/src/scm/webid-oidc/server/log.scm +++ b/src/scm/webid-oidc/server/log.scm @@ -1,4 +1,4 @@ -;; webid-oidc, implementation of the Solid specification +;; disfluid, implementation of the Solid specification ;; Copyright (C) 2021 Vivien Kraus ;; This program is free software: you can redistribute it and/or modify @@ -16,6 +16,7 @@ (define-module (webid-oidc server log) #:use-module ((webid-oidc stubs) #:prefix stubs:) + #:declarative? #t #:export ( prepare-log-file diff --git a/src/scm/webid-oidc/server/precondition.scm b/src/scm/webid-oidc/server/precondition.scm index 6912a7a..03ee967 100644 --- a/src/scm/webid-oidc/server/precondition.scm +++ b/src/scm/webid-oidc/server/precondition.scm @@ -44,10 +44,28 @@ #:export ( + &precondition-failed + make-precondition-failed + precondition-failed? + precondition-failed-path + precondition-failed-if-match + precondition-failed-if-none-match + precondition-failed-etag + check-precondition )) +(define-exception-type + &precondition-failed + &external-error + make-precondition-failed + precondition-failed? + (path precondition-failed-path) + (if-match precondition-failed-if-match) + (if-none-match precondition-failed-if-none-match) + (etag precondition-failed-etag)) + (define (the-etag object) ;; Sometimes the user passes a pair as an etag (just like what ;; request-if-match may return). diff --git a/src/scm/webid-oidc/server/read.scm b/src/scm/webid-oidc/server/read.scm index aecde36..e672b15 100644 --- a/src/scm/webid-oidc/server/read.scm +++ b/src/scm/webid-oidc/server/read.scm @@ -1,4 +1,4 @@ -;; webid-oidc, implementation of the Solid specification +;; disfluid, implementation of the Solid specification ;; Copyright (C) 2020, 2021 Vivien Kraus ;; This program is free software: you can redistribute it and/or modify @@ -22,6 +22,7 @@ #:use-module (webid-oidc fetch) #:use-module (webid-oidc http-link) #:use-module (webid-oidc server resource wac) + #:use-module (webid-oidc web-i18n) #:use-module ((webid-oidc stubs) #:prefix stubs:) #:use-module (webid-oidc rdf-index) #:use-module ((webid-oidc refresh-token) #:prefix refresh:) @@ -44,10 +45,24 @@ #:export ( + &auxiliary-resource-absent + make-auxiliary-resource-absent + auxiliary-resource-absent? + auxiliary-resource-absent-base-path + auxiliary-resource-absent-path-type + read )) +(define-exception-type + &auxiliary-resource-absent + &external-error + make-auxiliary-resource-absent + auxiliary-resource-absent? + (base-path auxiliary-resource-absent-base-path) + (path-type auxiliary-resource-absent-path-type)) + (define* (read server-name owner user path #:key (http-get http-get)) @@ -86,8 +101,14 @@ (container? '(GET HEAD OPTIONS POST PUT DELETE)) (else '(GET HEAD OPTIONS PUT DELETE))))) (unless relevant-etag - (raise-exception - (make-auxiliary-resource-absent base-path path-type))) + (let ((final-message + (format #f (G_ "the auxiliary resource of type ~s at ~s is absent") + (uri->string path-type) + (uri->string base-path)))) + (raise-exception + (make-exception + (make-auxiliary-resource-absent base-path path-type) + (exception-with-message final-message))))) (let ((accept-put (if (or container? path-type) "text/turtle; application/n-quads; application/ld+json" "*/*"))) diff --git a/src/scm/webid-oidc/server/resource/path.scm b/src/scm/webid-oidc/server/resource/path.scm index 55c4274..b8a9472 100644 --- a/src/scm/webid-oidc/server/resource/path.scm +++ b/src/scm/webid-oidc/server/resource/path.scm @@ -1,4 +1,4 @@ -;; webid-oidc, implementation of the Solid specification +;; disfluid, implementation of the Solid specification ;; Copyright (C) 2020, 2021 Vivien Kraus ;; This program is free software: you can redistribute it and/or modify @@ -18,6 +18,7 @@ #:use-module (webid-oidc errors) #:use-module ((webid-oidc stubs) #:prefix stubs:) #:use-module (webid-oidc rdf-index) + #:use-module (webid-oidc web-i18n) #:use-module ((webid-oidc refresh-token) #:prefix refresh:) #:use-module ((webid-oidc parameters) #:prefix p:) #:use-module (web uri) @@ -31,9 +32,35 @@ #:use-module (ice-9 threads) #:use-module (rnrs bytevectors) #:use-module (oop goops) + #:declarative? #t #:export ( + &path-not-found + make-path-not-found + path-not-found? + path-not-found-path + + &uri-slash-semantics-error + make-uri-slash-semantics-error + uri-slash-semantics-error? + uri-slash-semantics-error-requested + uri-slash-semantics-error-existing + + &container-not-empty + make-container-not-empty + container-not-empty? + container-not-empty-path + + &cannot-delete-root + make-cannot-delete-root + cannot-delete-root? + + &path-is-auxiliary + make-path-is-auxiliary + path-is-auxiliary? + path-is-auxiliary-path + read-path update-path @@ -48,6 +75,41 @@ )) +(define-exception-type + &path-not-found + &external-error + make-path-not-found + path-not-found? + (path path-not-found-path)) + +(define-exception-type + &uri-slash-semantics-error + &external-error + make-uri-slash-semantics-error + uri-slash-semantics-error? + (requested uri-slash-semantics-error-requested) + (existing uri-slash-semantics-error-existing)) + +(define-exception-type + &container-not-empty + &external-error + make-container-not-empty + container-not-empty? + (path container-not-empty-path)) + +(define-exception-type + &cannot-delete-root + &external-error + make-cannot-delete-root + cannot-delete-root?) + +(define-exception-type + &path-is-auxiliary + &external-error + make-path-is-auxiliary + path-is-auxiliary? + (path path-is-auxiliary-path)) + (define (hash-path/lock path) (let ((h (stubs:hash 'SHA-256 path)) (dir (p:data-home))) @@ -78,17 +140,30 @@ (without-slash-exists (file-exists? (hash-path without-slash)))) (cond (with-slash-exists - (raise-exception - (make-exception - (make-path-not-found path) - (make-uri-slash-semantics-error path with-slash)))) + (let ((final-message + (format #f (G_ "incorrect slash semantics: path ~s should have a slash") + path))) + (raise-exception + (make-exception + (make-path-not-found path) + (make-uri-slash-semantics-error path with-slash) + (make-exception-with-message final-message))))) (without-slash-exists - (raise-exception - (make-exception - (make-path-not-found path) - (make-uri-slash-semantics-error path with-slash)))) + (let ((final-message + (format #f (G_ "incorrect slash semantics: path ~s should not have a slash") + path))) + (raise-exception + (make-exception + (make-path-not-found path) + (make-uri-slash-semantics-error path without-slash) + (make-exception-with-message final-message))))) (else - (raise-exception (make-path-not-found path))))))) + (let ((final-message + (format #f (G_ "path ~s does not exist") path))) + (raise-exception + (make-exception + (make-path-not-found path) + (make-exception-with-message final-message))))))))) (lambda () (call-with-input-file h (lambda (port) @@ -152,19 +227,28 @@ (case-lambda ((false) (when false - (error "You’re using the API wrong.")) + (fail (G_ "You’re using the API wrong."))) ;; Delete the resource (unless (or (not etag) (not (contained etag)) (null? (contained etag))) - (raise-exception (make-container-not-empty path))) + (raise-exception + (make-exception + (make-container-not-empty path) + (make-exception-with-message + (format #f (G_ "the path ~s exists, it has contained paths, and it is not empty") + path))))) (when (equal? path "/") - (raise-exception (make-cannot-delete-root))) + (raise-exception + (make-exception + (make-cannot-delete-root) + (make-exception-with-message + (format #f (G_ "you cannot delete the root")))))) (set! has-been-deleted? #t) #f) ((new-etag new-auxiliary) (unless (and (string? new-etag) (list? new-auxiliary)) - (error "You’re using the API wrong.")) + (fail (G_ "You’re using the API wrong."))) (hash-remove! garbage new-etag) (when new-auxiliary (for-each diff --git a/src/scm/webid-oidc/server/resource/wac.scm b/src/scm/webid-oidc/server/resource/wac.scm index 073d77b..e3ed089 100644 --- a/src/scm/webid-oidc/server/resource/wac.scm +++ b/src/scm/webid-oidc/server/resource/wac.scm @@ -1,4 +1,4 @@ -;; webid-oidc, implementation of the Solid specification +;; disfluid, implementation of the Solid specification ;; Copyright (C) 2020, 2021 Vivien Kraus ;; This program is free software: you can redistribute it and/or modify @@ -23,6 +23,7 @@ #:use-module ((webid-oidc stubs) #:prefix stubs:) #:use-module (webid-oidc rdf-index) #:use-module ((webid-oidc refresh-token) #:prefix refresh:) + #:use-module (webid-oidc web-i18n) #:use-module (web uri) #:use-module (web client) #:use-module (rdf rdf) @@ -35,11 +36,26 @@ #:use-module (ice-9 textual-ports) #:use-module (ice-9 binary-ports) #:use-module (ice-9 threads) + #:use-module (ice-9 match) #:use-module (rnrs bytevectors) #:use-module (oop goops) + #:declarative? #t #:export ( + &cannot-fetch-group + make-cannot-fetch-group + cannot-fetch-group? + cannot-fetch-group-uri + + &forbidden + make-forbidden + forbidden? + forbidden-path + forbidden-user + forbidden-owner + forbidden-expected-mode + wac-get-modes check-acl-can-read @@ -49,6 +65,23 @@ )) +(define-exception-type + &cannot-fetch-group + &external-error + make-cannot-fetch-group + cannot-fetch-group? + (group-uri cannot-fetch-group-uri)) + +(define-exception-type + &forbidden + &external-error + make-forbidden + forbidden? + (path forbidden-path) + (user forbidden-user) + (owner forbidden-owner) + (expected-mode forbidden-expected-mode)) + (define (group-member? http-get group-uri agent) (when (string? group-uri) (set! group-uri (string->uri group-uri))) @@ -63,9 +96,19 @@ #:query (uri-query group-uri)))) (with-exception-handler (lambda (error) - (raise-exception - (make-cannot-fetch-group group-uri error) - #:continuable? #t) + (let ((final-message + (if (exception-with-message? error) + (format #f (G_ "cannot fetch group ~s: ~a") + (uri->string group-uri) + (exception-message error)) + (format #f (G_ "cannot fetch group ~s") + (uri->string group-uri))))) + (raise-exception + (make-exception + (make-cannot-fetch-group group-uri) + (make-exception-with-message final-message) + error) + #:continuable? #t)) #f) (lambda () (let ((data (fetch group-doc-uri #:http-get http-get))) @@ -252,8 +295,10 @@ (accumulate-unique '() (sort all-modes - (lambda (a b) - (string< (uri->string a) (uri->string b))))))))) + (match-lambda* + (((? uri? (= uri->string a)) + (? uri? (= uri->string b))) + (string< a b))))))))) (define (check-mode server-name path owner user http-get expected-mode) (unless (equal? owner user) @@ -271,8 +316,18 @@ (let ((modes (wac-get-modes server-name path user #:http-get http-get))) (define (check-modes modes) (if (null? modes) - (raise-exception - (make-forbidden path user owner expected-mode)) + (let ((final-message + (format #f (G_ "the resource under ~s is owned by ~s, and ~s can’t access it with ~s") + path + (uri->string owner) + (if user + (uri->string user) + (G_ "is owned by ..., and <> can’t access it|an anonymous user")) + (uri->string expected-mode)))) + (raise-exception + (make-exception + (make-forbidden path user owner expected-mode) + (make-exception-with-message final-message)))) (or (equal? (car modes) expected-mode) ;; It is also OK if we’re asking for acl:Append but diff --git a/src/scm/webid-oidc/server/update.scm b/src/scm/webid-oidc/server/update.scm index 2e811ae..3eec8f8 100644 --- a/src/scm/webid-oidc/server/update.scm +++ b/src/scm/webid-oidc/server/update.scm @@ -1,4 +1,4 @@ -;; webid-oidc, implementation of the Solid specification +;; disfluid, implementation of the Solid specification ;; Copyright (C) 2020, 2021 Vivien Kraus ;; This program is free software: you can redistribute it and/or modify @@ -43,6 +43,7 @@ #:use-module (ice-9 hash-table) #:use-module (rnrs bytevectors) #:use-module (oop goops) + #:declarative? #t #:export ( @@ -55,7 +56,9 @@ ((text/turtle) #t) (else - (raise-exception (make-unsupported-media-type content-type)))) + (raise-exception + (make-exception + (make-unsupported-media-type content-type))))) (let ((graph (fetch doc-uri #:http-get diff --git a/src/scm/webid-oidc/simulation.scm b/src/scm/webid-oidc/simulation.scm index 45fb1f3..30f7b43 100644 --- a/src/scm/webid-oidc/simulation.scm +++ b/src/scm/webid-oidc/simulation.scm @@ -18,6 +18,8 @@ #:use-module ((webid-oidc client) #:prefix client:) #:use-module (webid-oidc identity-provider) #:use-module (webid-oidc resource-server) + #:use-module (webid-oidc web-i18n) + #:use-module (webid-oidc errors) #:use-module ((webid-oidc parameters) #:prefix p:) #:use-module ((webid-oidc server create) #:prefix server:) #:use-module (web uri) @@ -125,7 +127,9 @@ (response-location response) (uri-query (response-location response)) (string-prefix? "code=" (uri-query (response-location response)))) - (error "Invalid credentials.\n")) + (fail (format #f (G_ "invalid credentials: response ~s ~s") + (response-code response) + (response-reason-phrase response)))) (let* ((uri (response-location response)) (query (uri-query uri)) (code (substring query (string-length "code=")))) diff --git a/src/scm/webid-oidc/stubs.scm b/src/scm/webid-oidc/stubs.scm index 08d15aa..e029b7c 100644 --- a/src/scm/webid-oidc/stubs.scm +++ b/src/scm/webid-oidc/stubs.scm @@ -1,4 +1,4 @@ -;; webid-oidc, implementation of the Solid specification +;; disfluid, implementation of the Solid specification ;; Copyright (C) 2020, 2021 Vivien Kraus ;; This program is free software: you can redistribute it and/or modify @@ -16,84 +16,201 @@ (define-module (webid-oidc stubs) #:use-module (webid-oidc config) - #:use-module (webid-oidc errors) + #:use-module (ice-9 exceptions) + #:use-module (ice-9 i18n) #:use-module (webid-oidc parameters) - #:use-module (json)) + #:use-module (json) + #:export + ( + + &invalid-base64-data + make-invalid-base64-data + invalid-base64-data? + error-base64-data + + &unsupported-elliptic-curve + make-unsupported-elliptic-curve + unsupported-elliptic-curve? + unsupported-elliptic-curve-value + + &unsupported-algorithm + make-unsupported-algorithm + unsupported-algorithm? + unsupported-algorithm-alg + unsupported-algorithm-application + + &invalid-signature + make-invalid-signature + invalid-signature? + invalid-signature-alg + invalid-signature-key + invalid-signature-payload + invalid-signature-signature + + &invalid-json + make-invalid-json + invalid-json? + invalid-json-input + + base64-encode + (fix-base64-decode . base64-decode) + random + (fix-random-init! . random-init!) + (fix-generate-key . generate-key) + kty + strip-key + (fix-hash . hash) + jkt + (fix-sign . sign) + (fix-verify . verify) + (fixed:json-string->scm . json-string->scm) + (fixed:json->scm . json->scm) + (fixed:scm->json-string . scm->json-string) + (fixed:scm->json . scm->json) + + mkdir-p + open-output-file* + call-with-output-file* + atomically-update-file + + )) + +(define (G_ text) + (let ((out (gettext text))) + (if (string=? out text) + ;; No translation, disambiguate + (car (reverse (string-split text #\|))) + out))) (load-extension (format #f "~a/libwebidoidc" libdir) "init_webidoidc") +(define-exception-type + &invalid-base64-data + &external-error + make-invalid-base64-data + invalid-base64-data? + (data error-base64-data)) + +(define (summarize str) + (if (> (string-length str) 10) + (format #f "~s" + (string-append + (substring str 0 10) + "...")) + (format #f "~s" str))) + (define (fix-base64-decode data) (catch 'base64-decoding-error (lambda () (base64-decode data)) (lambda error - (raise-not-base64 data error)))) + (let ((final-message + (format #f (G_ "invalid base64 data: ~a") + (summarize data)))) + (raise-exception + (make-exception + (make-invalid-base64-data data) + (make-exception-with-message final-message) + (make-exception-with-irritants (list data)))))))) + +(define-exception-type + &unsupported-elliptic-curve + &external-error + make-unsupported-elliptic-curve + unsupported-elliptic-curve? + (curve unsupported-elliptic-curve-value)) + +(define (unsupported-crv crv) + (let ((final-message + (format #f (G_ "~s is not a recognized elliptic curve") + crv))) + (raise-exception + (make-exception + (make-unsupported-elliptic-curve crv) + (make-exception-with-message final-message) + (make-exception-with-irritants (list crv)))))) (define (fix-generate-key . args) (catch 'unsupported-crv (lambda () (apply generate-key args)) - (lambda (error) - (raise-unsupported-crv (cadr error))))) - -(define (fix-kty key) - (catch 'unsupported-crv - (lambda () - (let ((ret (kty key))) - (unless ret - (raise-not-a-jwk key #f)) - ret)) (lambda error - (raise-unsupported-crv (cadr error))))) + (unsupported-crv (cadr error))))) + +(define-exception-type + &unsupported-algorithm + &external-error + make-unsupported-algorithm + unsupported-algorithm? + (alg unsupported-algorithm-alg) + ;; 'sign or 'hash: + (application unsupported-algorithm-application)) + +(define (unsupported-alg alg application) + (let ((final-message + (case application + ((sign) + (format #f (G_ "~s is not a supported signature algorithm") + alg)) + ((hash) + (format #f (G_ "~s is not a supported hash algorithm") + alg))))) + (raise-exception + (make-exception + (make-unsupported-algorithm alg application) + (make-exception-with-message final-message) + (make-exception-with-irritants (list alg)))))) (define (fix-hash alg payload) (catch 'unsupported-alg (lambda () (hash alg payload)) (lambda error - (raise-unsupported-alg (cadr error))))) + (unsupported-alg alg 'hash)))) (define (fix-sign alg key payload) (catch 'unsupported-alg (lambda () (sign alg key payload)) (lambda error - (raise-unsupported-alg (cadr error))))) + (unsupported-alg alg 'sign)))) + +(define-exception-type + &invalid-signature + &external-error + make-invalid-signature + invalid-signature? + (alg invalid-signature-alg) + (key invalid-signature-key) + (payload invalid-signature-payload) + (signature invalid-signature-signature)) (define (fix-verify alg key payload signature) (catch 'unsupported-alg (lambda () - (let ((ok - (verify alg key payload signature))) + (let ((ok (verify alg key payload signature))) (unless ok - (raise-invalid-signature key payload signature)))) + (let ((final-message + (format #f (G_ "the signature is invalid")))) + (raise-exception + (make-exception + (make-invalid-signature alg key payload signature) + (make-exception-with-message final-message) + (make-exception-with-irritants (list alg key payload signature)))))))) (lambda error - (raise-unsupported-alg (cadr error))))) + (unsupported-alg alg 'sign)))) (define (fix-random-init!) (setenv "XDG_CACHE_HOME" (cache-home)) (setenv "DISFLUID_APPLICATION_NAME" ".") (random-init!)) -(export - base64-encode - (fix-base64-decode . base64-decode) - random - (fix-random-init! . random-init!) - (fix-generate-key . generate-key) - (fix-kty . kty) - strip-key - (fix-hash . hash) - jkt - (fix-sign . sign) - (fix-verify . verify)) - ;; json reader from guile-json will not behave consistently with ;; SRFI-180 with objects: keys will be mapped to strings, not ;; symbols. So we fix alist keys to be symbols. -(define-public (fix-alists data) +(define (fix-alists data) (define (fix-an-alist rest alist) (if (null? alist) (reverse rest) @@ -117,33 +234,47 @@ (fix-a-vector data)) (else data))) +(define-exception-type + &invalid-json + &external-error + make-invalid-json + invalid-json? + (input invalid-json-input)) + (define (fixed:json-string->scm str) (with-exception-handler - (lambda (err) - (raise-not-json str err)) + (lambda (exn) + (let ((final-message + (format #f (G_ "invalid JSON data: ~a") + (summarize str)))) + (raise-exception + (make-exception + (make-invalid-json str) + (make-exception-with-message final-message) + (make-exception-with-irritants (list str)) + exn)))) (lambda () (fix-alists (json-string->scm str))))) -(export (fixed:json-string->scm . json-string->scm)) - (define (fixed:json->scm port) (with-exception-handler (lambda (err) - (raise-not-json "(input)" err)) + (let ((final-message + (format #f (G_ "invalid JSON data in input port")))) + (raise-exception + (make-exception + (make-invalid-json "(input)") + (make-exception-with-message final-message) + (make-exception-with-irritants (list port)) + exn)))) (lambda () (fix-alists (json->scm port))))) -(export (fixed:json->scm . json->scm)) - (define fixed:scm->json-string scm->json-string) -(export (fixed:scm->json-string . scm->json-string)) - (define fixed:scm->json scm->json) -(export (fixed:scm->json . scm->json)) - -(define-public (mkdir-p name) +(define (mkdir-p name) (catch 'system-error (lambda () (mkdir name)) @@ -159,15 +290,15 @@ (else (throw key subr message args rest)))))) -(define-public (open-output-file* filename . args) +(define (open-output-file* filename . args) (mkdir-p (dirname filename)) (apply open-output-file filename args)) -(define-public (call-with-output-file* filename . args) +(define (call-with-output-file* filename . args) (mkdir-p (dirname filename)) (apply call-with-output-file filename args)) -(define-public (atomically-update-file file lock-file-name f) +(define (atomically-update-file file lock-file-name f) ;; Call f with an output port. If f returns #f, delete the original ;; file. Otherwise, replace it. (let ((updating-file-name (string-append file "~"))) @@ -187,7 +318,16 @@ (with-exception-handler (lambda (error) (false-if-exception (delete-file updating-file-name)) - (raise-exception error)) + (let ((final-message + (if (exception-with-message? error) + (format #f (G_ "while updating file ~s: ~a") + file (exception-message error)) + (format #f (G_ "an error happened while updating file ~s") + file)))) + (raise-exception + (make-exception + (make-exception-with-message final-message) + error)))) (lambda () (let ((ok (f port))) (fsync port) diff --git a/src/scm/webid-oidc/testing.scm b/src/scm/webid-oidc/testing.scm index f4de433..06d0127 100644 --- a/src/scm/webid-oidc/testing.scm +++ b/src/scm/webid-oidc/testing.scm @@ -27,17 +27,11 @@ ;; This module is used only when running tests. (define-public (with-test-environment test-name f) - (with-exception-handler - (lambda (error) - (format (current-error-port) "The test failed, because ~a.\n" - (error->str error)) - (raise-exception error)) - (lambda () - (parameterize ((data-home (format #f "tests/~a.home/disfluid" test-name)) - (cache-home (format #f "tests/~a.cache/disfluid" test-name))) - (call-with-output-file* - (format #f "~a/seed" (cache-home)) - (lambda (port) - (format port "This is the initial seed for the random number generator"))) - (random-init!) - (f))))) + (parameterize ((data-home (format #f "tests/~a.home/disfluid" test-name)) + (cache-home (format #f "tests/~a.cache/disfluid" test-name))) + (call-with-output-file* + (format #f "~a/seed" (cache-home)) + (lambda (port) + (format port "This is the initial seed for the random number generator"))) + (random-init!) + (f))) diff --git a/src/scm/webid-oidc/token-endpoint.scm b/src/scm/webid-oidc/token-endpoint.scm index 7c4d41c..30a78d4 100644 --- a/src/scm/webid-oidc/token-endpoint.scm +++ b/src/scm/webid-oidc/token-endpoint.scm @@ -1,4 +1,4 @@ -;; webid-oidc, implementation of the Solid specification +;; disfluid, implementation of the Solid specification ;; Copyright (C) 2020, 2021 Vivien Kraus ;; This program is free software: you can redistribute it and/or modify @@ -22,6 +22,7 @@ #:use-module (webid-oidc jwk) #:use-module (webid-oidc oidc-id-token) #:use-module (webid-oidc access-token) + #:use-module (webid-oidc web-i18n) #:use-module ((webid-oidc parameters) #:prefix p:) #:use-module ((webid-oidc stubs) #:prefix stubs:) #:use-module ((webid-oidc refresh-token) #:prefix refresh:) @@ -32,58 +33,158 @@ #:use-module (ice-9 optargs) #:use-module (ice-9 receive) #:use-module (ice-9 control) + #:use-module (ice-9 exceptions) #:use-module (srfi srfi-19) - #:use-module (rnrs bytevectors)) + #:use-module (rnrs bytevectors) + #:use-module (sxml simple) + #:use-module (sxml match) + #:declarative? #t + #:export + ( + &unsupported-grant-type + make-unsupported-grant-type + unsupported-grant-type? + unsupported-grant-type-grant-type + + &no-authorization-code + make-no-authorization-code + no-authorization-code? + + &no-refresh-token + make-no-refresh-token + no-refresh-token? + + make-token-endpoint + )) + +(define-exception-type + &unsupported-grant-type + &external-error + make-unsupported-grant-type + unsupported-grant-type? + (grant-type unsupported-grant-type-grant-type)) + +(define-exception-type + &no-authorization-code + &external-error + make-no-authorization-code + no-authorization-code?) + +(define-exception-type + &no-refresh-token + &external-error + make-no-refresh-token + no-refresh-token?) (define (try-handle-web-failure thunk) - (define (error->str err) - (if (record? err) - (let* ((type (record-type-descriptor err)) - (get - (lambda (slot) - ((record-accessor type slot) err))) - (recurse - (lambda (err) - (error->str err)))) - (case (record-type-name type) - ((&cannot-decode-dpop-proof) - (format #f "the DPoP proof is invalid")) - ((&no-authorization-code) - (format #f "there is no authorization code in the request")) - ((&no-refresh-token) - (format #f "there is no refresh token in the request")) - ((&cannot-decode-authorization-code) - (format #f "the authorization code is invalid")) - ((&invalid-refresh-token) - (format #f "the refresh token is invalid")) - ((&invalid-key-for-refresh-token) - (format #f "the refresh token is bound to another key")) - ((&unsupported-grant-type) - (format #f "the grant type ~s is not supported" (get 'value))) - (else - (raise-exception err)))) - (throw err))) (call/ec (lambda (return) (with-exception-handler (lambda (error) - (return - (build-response - #:code 400 - #:reason-phrase (string-append "Bad Request: " (error->str error))) - (error->str error) - #f - error)) - thunk - #:unwind? #t)))) + (unless (or (unsupported-grant-type? error) + (no-authorization-code? error) + (no-refresh-token? error) + (refresh:invalid-refresh-token? error) + (invalid-authorization-code? error)) + (let ((final-message + (if (exception-with-message? error) + (format #f (G_ "while handling web failure for the token endpoint: ~a") + (exception-message error)) + (format #f (G_ "an error happened during the token endpoint failure handling"))))) + (raise-exception + (make-exception + (make-exception-with-message final-message) + error)))) + (cond + ((refresh:invalid-refresh-token? error) + (return + (build-response + #:code 403 + #:reason-phrase (G_ "reason-phrase|Forbidden") + #:headers '((content-type application/xhtml-xml))) + (call-with-output-string + (lambda (port) + (sxml->xml + `(*TOP* + (*PI* xml "version=\"1.0\" encoding=\"utf-8\"") + (html (@ (xmlns "http://www.w3.org/1999/xhtml") + (xml:lang ,(W_ "xml-lang|en"))) + (body + ,(sxml-match + (xml->sxml + (W_ (format #f "<h1>Invalid refresh token</h1>"))) + ((*TOP* ,title) title)) + ,(sxml-match + (xml->sxml + (W_ (format #f "<p>The refresh token you sent is invalid, or it is already bound to another key.</p>"))) + ((*TOP* ,p) p)) + ,@(if (message-for-the-user? error) + (user-message error) + '())))) + port))))) + ((invalid-authorization-code? error) + (return + (build-response + #:code 400 + #:reason-phrase (G_ "reason-phrase|Bad Request") + #:headers '((content-type application/xhtml-xml))) + (call-with-output-string + (lambda (port) + (sxml->xml + `(*TOP* + (*PI* xml "version=\"1.0\" encoding=\"utf-8\"") + (html (@ (xmlns "http://www.w3.org/1999/xhtml") + (xml:lang ,(W_ "xml-lang|en"))) + (body + ,(sxml-match + (xml->sxml + (W_ (format #f "<h1>Invalid authorization code</h1>"))) + ((*TOP* ,title) title)) + ,(sxml-match + (xml->sxml + (W_ (format #f "<p>The authorization code is forged, or expired.</p>"))) + ((*TOP* ,p) p)) + ,@(if (message-for-the-user? error) + (user-message error) + '())))) + port))))) + ;; Other bad request + (else + (return + (build-response + #:code 400 + #:reason-phrase (G_ "reason-phrase|Bad Request") + #:headers '((content-type application/xhtml+xml))) + (call-with-output-string + (lambda (port) + (sxml->xml + `(*TOP* + (*PI* xml "version=\"1.0\" encoding=\"utf-8\"") + (html (@ (xmlns "http://www.w3.org/1999/xhtml") + (xml:lang ,(W_ "xml-lang|en"))) + (body + ,(sxml-match + (xml->sxml + (W_ (format #f "<h1>Bad token request</h1>"))) + ((*TOP* ,title) title)) + ,(sxml-match + (xml->sxml + (W_ (format #f "<p>The token request failed.</p>"))) + ((*TOP* ,p) p)) + ,@(if (message-for-the-user? error) + (user-message error) + '())))) + port))))))) + thunk)))) -(define*-public (make-token-endpoint token-endpoint-uri iss alg jwk validity) - (lambda* (request request-body) +(define (make-token-endpoint token-endpoint-uri iss alg jwk validity) + (lambda (request request-body) + (when (bytevector? request-body) + (set! request-body (utf8->string request-body))) (try-handle-web-failure (lambda () - (when (bytevector? request-body) - (set! request-body (utf8->string request-body))) - (parameterize ((p:current-date ((p:current-date)))) + (parameterize ((p:current-date ((p:current-date))) + (web-locale request)) (let ((current-time ((p:current-date))) ;; thunk parameter (form-args (if (and (request-content-type request) @@ -117,47 +218,93 @@ (assq-ref (request-headers request) 'dpop) (lambda (jkt) #t)))) (unless (and grant-type (string? grant-type)) - (raise-unsupported-grant-type #f)) + (let ((final-message + (format #f (G_ "missing grant type"))) + (final-user-message + (sxml-match + (xml->sxml + (format #f (W_ "<p>You did not specify a grant_type for this request.</p>"))) + ((*TOP* ,p) p)))) + (raise-exception + (make-exception + (make-unsupported-grant-type #f) + (make-exception-with-message final-message) + (make-message-for-the-user final-user-message))))) (receive (webid client-id) (case (string->symbol grant-type) ((authorization_code) (let ((code (let ((str (assoc-ref form-args "code"))) (unless str - (raise-no-authorization-code)) + (let ((final-message + (format #f (G_ "missing authorization code"))) + (final-user-message + (sxml-match + (xml->sxml + (format #f (W_ "<p>You want to grant an authorization code, but you did not set one.</p>"))) + ((*TOP* ,p) p)))) + (raise-exception + (make-exception + (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)))) ((refresh_token) (let ((refresh-token (assoc-ref form-args "refresh_token"))) (unless refresh-token - (raise-no-refresh-token)) + (let ((final-message + (format #f (G_ "missing refresh token"))) + (final-user-message + (sxml-match + (xml->sxml + (format #f (W_ "<p>You want to grant a refresh token, but you did not set one.</p>"))) + ((*TOP* ,p) p)))) + (raise-exception + (make-exception + (make-no-refresh-token) + (make-exception-with-message final-message) + (make-message-for-the-user final-user-message))))) (refresh:with-refresh-token refresh-token (dpop-proof-jwk dpop) values))) (else - (raise-unsupported-grant-type grant-type))) + (let ((final-message + (format #f (G_ "unsupported grant type: ~s") + grant-type)) + (final-user-message + (sxml-match + (xml->sxml + (format #f (W_ "<p>You want to use <pre>~s</pre> as a grant type, but this is not supported.</p>") + grant-type)) + ((*TOP* ,p) p)))) + (raise-exception + (make-exception + (make-unsupported-grant-type grant-type) + (make-exception-with-message final-message) + (make-message-for-the-user final-user-message)))))) (let* ((iat (time-second (date->time-utc current-time))) (exp (+ iat validity))) (let ((id-token (issue-id-token jwk #:alg alg - #:webid (uri->string webid) + #:webid webid #:sub (uri->string webid) - #:iss (uri->string iss) - #:aud (uri->string client-id) + #:iss iss + #:aud client-id #:validity 3600)) (access-token (issue-access-token jwk #:alg alg - #:webid (uri->string webid) - #:iss (uri->string iss) + #:webid webid + #:iss iss #:validity 3600 #:client-key (dpop-proof-jwk dpop) - #:client-id (uri->string client-id))) + #:client-id client-id)) (refresh-token (if (equal? grant-type "refresh_token") (assoc-ref form-args "refresh_token") diff --git a/src/scm/webid-oidc/web-i18n.scm b/src/scm/webid-oidc/web-i18n.scm new file mode 100644 index 0000000..d3a773f --- /dev/null +++ b/src/scm/webid-oidc/web-i18n.scm @@ -0,0 +1,92 @@ +;; 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/>. + +(define-module (webid-oidc web-i18n) + #:use-module (ice-9 i18n) + #:use-module (ice-9 match) + #:use-module (ice-9 receive) + #:use-module (ice-9 threads) + #:use-module (srfi srfi-26) + #:use-module (web request) + #:declarative? #t + #:export + ( + + web-locale + + (web-gettext . W_) + (sysadmin-gettext . G_) + + )) + +(define locale-mutex + (make-mutex)) + +(define sort-qlist + (cute sort <> + (match-lambda* + (((px . _) (py . _)) + (>= px py))))) + +(define get-preferred-language + (match-lambda + ((? request? + (= request-accept-language + (= sort-qlist + (((_ . language) _ ...))))) + (get-preferred-language language)) + ((? string? + (= (cute string-split <> #\-) + ((? string? lang) + (? string? region)))) + (format #f "~a_~a.UTF-8" lang region)) + (else ""))) + +(define web-locale + (make-parameter + "en-US" + get-preferred-language)) + +(define (disambiguate str out) + (if (string=? out str) + ;; No translation, disambiguate + (car (reverse (string-split str #\|))) + ;; Translation done, nothing to do + out)) + +(define (web-gettext str) + (let ((out + (with-mutex locale-mutex + (let ((previous-locale (setlocale LC_ALL))) + (dynamic-wind + (lambda () + (with-exception-handler + (lambda (exn) + (setlocale LC_ALL "C")) + (lambda () + (setlocale LC_ALL (web-locale))) + #:unwind? #t)) + (lambda () + (gettext str)) + (lambda () + (setlocale LC_ALL previous-locale))))))) + (disambiguate str out))) + +(define (sysadmin-gettext str) + (let ((out + (with-mutex locale-mutex + (gettext str)))) + (disambiguate str out))) diff --git a/tests/Makefile.am b/tests/Makefile.am index e09ad57..02512d8 100644 --- a/tests/Makefile.am +++ b/tests/Makefile.am @@ -49,7 +49,6 @@ TESTS = %reldir%/load-library.scm \ %reldir%/refresh-token.scm \ %reldir%/too-many-refresh-tokens.scm \ %reldir%/refresh-token-with-wrong-key.scm \ - %reldir%/unknown-client-locale.scm \ %reldir%/authorization-endpoint-no-args.scm \ %reldir%/authorization-endpoint-get-form.scm \ %reldir%/authorization-endpoint-submit-form.scm \ diff --git a/tests/base64-error.scm b/tests/base64-error.scm index 21ef7a6..0d065af 100644 --- a/tests/base64-error.scm +++ b/tests/base64-error.scm @@ -27,12 +27,12 @@ (unless (with-exception-handler (lambda (error) - (unless ((record-predicate ¬-base64) error) + (unless (stubs:invalid-base64-data? error) (exit 1)) #t) (lambda () (stubs:base64-decode test) #f) #:unwind? #t - #:unwind-for-type ¬-base64) + #:unwind-for-type stubs:&invalid-base64-data) (exit 2))))) diff --git a/tests/client-manifest-fraudulent.scm b/tests/client-manifest-fraudulent.scm index b786140..a1bfe20 100644 --- a/tests/client-manifest-fraudulent.scm +++ b/tests/client-manifest-fraudulent.scm @@ -1,4 +1,4 @@ -;; webid-oidc, implementation of the Solid specification +;; disfluid, implementation of the Solid specification ;; Copyright (C) 2020, 2021 Vivien Kraus ;; This program is free software: you can redistribute it and/or modify @@ -63,8 +63,7 @@ #:http-get respond)) (with-exception-handler (lambda (error) - (unless ((record-predicate &inconsistent-client-manifest-id) - ((record-accessor &cannot-fetch-client-manifest 'cause) error)) + (unless (inconsistent-client-manifest? error) (exit 3))) (lambda () (get-client-manifest @@ -72,4 +71,4 @@ #:http-get cache-http-get) (exit 4)) #:unwind? #t - #:unwind-for-type &cannot-fetch-client-manifest))) + #:unwind-for-type &inconsistent-client-manifest))) diff --git a/tests/client-manifest-public.scm b/tests/client-manifest-public.scm index 1e2c628..76eb8ba 100644 --- a/tests/client-manifest-public.scm +++ b/tests/client-manifest-public.scm @@ -1,4 +1,4 @@ -;; webid-oidc, implementation of the Solid specification +;; disfluid, implementation of the Solid specification ;; Copyright (C) 2020, 2021 Vivien Kraus ;; This program is free software: you can redistribute it and/or modify @@ -37,7 +37,7 @@ (exit 3)) (with-exception-handler (lambda (error) - (unless ((record-predicate &cannot-serve-public-manifest) error) + (unless (cannot-serve-public-manifest? error) (exit 4))) (lambda () (serve-client-manifest diff --git a/tests/client-manifest.scm b/tests/client-manifest.scm index 2812ede..8e98091 100644 --- a/tests/client-manifest.scm +++ b/tests/client-manifest.scm @@ -1,4 +1,4 @@ -;; webid-oidc, implementation of the Solid specification +;; disfluid, implementation of the Solid specification ;; Copyright (C) 2020, 2021 Vivien Kraus ;; This program is free software: you can redistribute it and/or modify @@ -66,13 +66,13 @@ (exit 4)) (with-exception-handler (lambda (error) - (unless ((record-predicate &unauthorized-redirection-uri) error) + (unless (unauthorized-redirect-uri? error) (exit 5))) (lambda () (client-manifest-check-redirect-uri mf "https://fraudulent-app.example.com/callback") (exit 55)) #:unwind? #t - #:unwind-for-type &unauthorized-redirection-uri) + #:unwind-for-type &unauthorized-redirect-uri) (receive (response response-body) (serve-client-manifest (time-utc->date (make-time time-utc 0 3600)) diff --git a/tests/client-workflow.scm b/tests/client-workflow.scm index 04a4455..15f480a 100644 --- a/tests/client-workflow.scm +++ b/tests/client-workflow.scm @@ -1,4 +1,4 @@ -;; webid-oidc, implementation of the Solid specification +;; disfluid, implementation of the Solid specification ;; Copyright (C) 2021 Vivien Kraus ;; This program is free software: you can redistribute it and/or modify @@ -137,4 +137,118 @@ (equal? (request-uri final-request) (string->uri "https://server@client-workflow.scm/")) (eqv? (response-code final-response) 200)) - (exit 4))))))))) + (exit 4))))) + ;; 1 hour later, the access token should have expired. + (parameterize ((p:current-date 3600)) + (receive (response response-body) + (let ((handler + (client:request client + (string->uri "https://server@client-workflow.scm/alice#me") + (string->uri "https://server@client-workflow.scm") + #:http-request (cute sim:request simulation <...>)))) + (handler (build-request (string->uri "https://server@client-workflow.scm/")) + #f)) + (unless (eqv? (response-code response) 200) + ;; Only Alice can read that resource. + (exit 5))) + (match (sim:simulation-scroll-log! simulation) + ;; 1. and 2. The client starts sending the request, the server + ;; querries the identity provider and keys. + + ;; 3. The client directly sends the request. It fails because + ;; the access token expired. + + ;; 4. The client queries the OIDC configuration to get the + ;; token endpoint. + + ;; 5. The client gets an access token from the refresh token. + + ;; 6. 7. The client decodes the ID token, by getting the keys + ;; again. + + ;; 8. and 9. The client starts sending the new request, the + ;; server checks the access token. + + ;; 10. The client sends the request again, and it succeeds. + ((_ + _ + (naively-try-request _ naively-try-response _) + (get-token-endpoint-request _ get-token-endpoint-response _) + (refresh-request _ refresh-response _) + _ _ _ _ + (with-new-refresh-token-request _ with-new-refresh-token-response _)) + (unless + (and + ;; 3. The client realizes that the access token is + ;; expired. + (equal? (request-uri naively-try-request) + (string->uri "https://server@client-workflow.scm/")) + (eqv? (response-code naively-try-response) 401) + (eqv? (time-second (date->time-utc (response-date naively-try-response))) + 3600) + ;; 4. The client discovers the token endpoint. + (equal? (request-uri get-token-endpoint-request) + (string->uri "https://server@client-workflow.scm/.well-known/openid-configuration")) + (eqv? (response-code get-token-endpoint-response) 200) + ;; 5. Refresh the access token. + (equal? (request-uri refresh-request) + (string->uri "https://server@client-workflow.scm/token")) + (eqv? (response-code refresh-response) 200) + ;; 10. Send again. + (equal? (request-uri with-new-refresh-token-request) + (string->uri "https://server@client-workflow.scm/")) + (eqv? (response-code with-new-refresh-token-response) 200)) + (exit 6))))) + ;; Wait another hour, and we’ll need to update the refresh + ;; token again, but this time it’s not there anymore. + (parameterize ((p:current-date 7200)) + (refresh:remove-refresh-token + (string->uri "https://server@client-workflow.scm/alice#me") + (string->uri "https://client@client-workflow.scm/id")) + (with-exception-handler + (lambda (error) + (unless (client:refresh-token-expired? error) + (exit 7))) + (lambda () + (let ((handler + (client:request client + (string->uri "https://server@client-workflow.scm/alice#me") + (string->uri "https://server@client-workflow.scm") + #:http-request (cute sim:request simulation <...>)))) + (handler (build-request (string->uri "https://server@client-workflow.scm/")) + #f)) + (exit 8)) + #:unwind? #t + #:unwind-for-type client:&refresh-token-expired) + (match (sim:simulation-scroll-log! simulation) + ;; 1. and 2. The client starts sending the request, the server + ;; querries the identity provider and keys. + + ;; 3. The client directly sends the request. It fails + ;; because the access token expired. + + ;; 4. The client queries the OIDC configuration to get the + ;; token endpoint. + + ;; 5. The client sends the token request, but it fails with + ;; 403. + ((_ + _ + (naively-try-request _ naively-try-response _) + (get-token-endpoint-request _ get-token-endpoint-response _) + (refresh-request _ refresh-response _)) + ;; 3. The client realizes that the access token is + ;; expired. + (equal? (request-uri naively-try-request) + (string->uri "https://server@client-workflow.scm/")) + (eqv? (response-code naively-try-response) 401) + (eqv? (time-second (date->time-utc (response-date naively-try-response))) + 7200) + ;; 4. The client discovers the token endpoint. + (equal? (request-uri get-token-endpoint-request) + (string->uri "https://server@client-workflow.scm/.well-known/openid-configuration")) + (eqv? (response-code get-token-endpoint-response) 200) + ;; 5. The client tries to refresh. + (equal? (request-uri refresh-request) + (string->uri "https://server@client-workflow.scm/token")) + (eqv? (response-code refresh-response) 403)))))))) diff --git a/tests/dpop-proof-iat-in-future.scm b/tests/dpop-proof-iat-in-future.scm index b5dd3f8..d7f345b 100644 --- a/tests/dpop-proof-iat-in-future.scm +++ b/tests/dpop-proof-iat-in-future.scm @@ -1,4 +1,4 @@ -;; webid-oidc, implementation of the Solid specification +;; disfluid, implementation of the Solid specification ;; Copyright (C) 2020, 2021 Vivien Kraus ;; This program is free software: you can redistribute it and/or modify @@ -17,6 +17,7 @@ (use-modules (webid-oidc dpop-proof) (webid-oidc jti) (webid-oidc jwk) + (webid-oidc jws) (webid-oidc testing) (webid-oidc errors) ((webid-oidc parameters) #:prefix p:) @@ -38,8 +39,11 @@ #:htu (string->uri "https://example.com/res#frag")))) (with-exception-handler (lambda (error) - (unless ((record-predicate &dpop-signed-in-future) - ((record-accessor &cannot-decode-dpop-proof 'cause) error)) + (unless (and (signed-in-future? error) + (eqv? (time-second (date->time-utc (error-signature-date error))) + 10) + (eqv? (time-second (date->time-utc (error-current-date error))) + 0)) (raise-exception error))) (lambda () (parameterize ((p:current-date 0)) @@ -49,4 +53,4 @@ cnf)) (exit 2)) #:unwind? #t - #:unwind-for-type &cannot-decode-dpop-proof))) + #: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 0e1f4ed..7cf2146 100644 --- a/tests/dpop-proof-iat-too-late.scm +++ b/tests/dpop-proof-iat-too-late.scm @@ -1,4 +1,4 @@ -;; webid-oidc, implementation of the Solid specification +;; disfluid, implementation of the Solid specification ;; Copyright (C) 2020, 2021 Vivien Kraus ;; This program is free software: you can redistribute it and/or modify @@ -17,6 +17,7 @@ (use-modules (webid-oidc dpop-proof) (webid-oidc jti) (webid-oidc jwk) + (webid-oidc jws) (webid-oidc testing) ((webid-oidc parameters) #:prefix p:) (webid-oidc errors) @@ -38,8 +39,11 @@ #:htu (string->uri "https://example.com/res#frag")))) (with-exception-handler (lambda (error) - (unless ((record-predicate &dpop-too-old) - ((record-accessor &cannot-decode-dpop-proof 'cause) error)) + (unless (and (expired? error) + (eqv? (time-second (date->time-utc (error-expiration-date error))) + 120) + (eqv? (time-second (date->time-utc (error-current-date error))) + 600)) (raise-exception error))) (lambda () (parameterize ((p:current-date 600)) @@ -49,4 +53,4 @@ cnf)) (exit 2)) #:unwind? #t - #:unwind-for-type &cannot-decode-dpop-proof))) + #:unwind-for-type &expired))) diff --git a/tests/dpop-proof-invalid-ath.scm b/tests/dpop-proof-invalid-ath.scm index 90cd168..cecd162 100644 --- a/tests/dpop-proof-invalid-ath.scm +++ b/tests/dpop-proof-invalid-ath.scm @@ -1,4 +1,4 @@ -;; webid-oidc, implementation of the Solid specification +;; disfluid, implementation of the Solid specification ;; Copyright (C) 2021 Vivien Kraus ;; This program is free software: you can redistribute it and/or modify @@ -36,11 +36,11 @@ (issue-access-token idp-key #:alg 'RS256 - #:webid "https://data.provider/subject" - #:iss "https://identity.provider" + #:webid (string->uri "https://data.provider/subject") + #:iss (string->uri "https://identity.provider") #:validity 3600 #:client-key jwk - #:client-id "https://client"))) + #:client-id (string->uri "https://client")))) (define proof (parameterize ((p:current-date 0)) (issue-dpop-proof @@ -51,14 +51,12 @@ #:access-token "aaaaaaaaaaaaaaa"))) (with-exception-handler (lambda (error) - (let ((cause - ((record-accessor &cannot-decode-dpop-proof 'cause) error))) - (unless (dpop-invalid-access-token-hash? cause) - (raise-exception error)) - (unless (and (equal? (dpop-invalid-access-token-hash-hash cause) - (stubs:hash 'SHA-256 "aaaaaaaaaaaaaaa")) - (equal? (dpop-invalid-access-token-hash-access-token cause) access-token)) - (exit 1)))) + (unless (and (dpop-invalid-ath? error) + (equal? (dpop-invalid-ath-hash error) + (stubs:hash 'SHA-256 "aaaaaaaaaaaaaaa")) + (equal? (dpop-invalid-ath-access-token error) + access-token)) + (raise-exception error))) (lambda () (parameterize ((p:current-date 10)) (dpop-proof-decode 'GET @@ -68,4 +66,4 @@ #:access-token access-token)) (exit 2)) #:unwind? #t - #:unwind-for-type &cannot-decode-dpop-proof))) + #:unwind-for-type &dpop-invalid-ath))) diff --git a/tests/dpop-proof-no-ath.scm b/tests/dpop-proof-no-ath.scm index 35bff75..3d87368 100644 --- a/tests/dpop-proof-no-ath.scm +++ b/tests/dpop-proof-no-ath.scm @@ -1,4 +1,4 @@ -;; webid-oidc, implementation of the Solid specification +;; disfluid, implementation of the Solid specification ;; Copyright (C) 2021 Vivien Kraus ;; This program is free software: you can redistribute it and/or modify @@ -38,14 +38,12 @@ #:htu (string->uri "https://example.com/res?query")))) (with-exception-handler (lambda (error) - (let ((cause - ((record-accessor &cannot-decode-dpop-proof 'cause) error))) - (unless (dpop-invalid-access-token-hash? cause) - (raise-exception error)) - (when (dpop-invalid-access-token-hash-hash cause) - ;; An #f value for hash indicates that there was no ath - ;; claim - (exit 1)))) + (unless (and (dpop-invalid-ath? error) + (equal? (dpop-invalid-ath-access-token error) "aaa") + ;; An #f value for hash indicates that there was + ;; no ath claim + (not (dpop-invalid-ath-hash error))) + (raise-exception error))) (lambda () (parameterize ((p:current-date 10)) (dpop-proof-decode 'GET @@ -55,4 +53,4 @@ #:access-token "aaa")) (exit 2)) #:unwind? #t - #:unwind-for-type &cannot-decode-dpop-proof))) + #:unwind-for-type &dpop-invalid-ath))) diff --git a/tests/dpop-proof-replay.scm b/tests/dpop-proof-replay.scm index b8f4668..71cabe5 100644 --- a/tests/dpop-proof-replay.scm +++ b/tests/dpop-proof-replay.scm @@ -1,4 +1,4 @@ -;; webid-oidc, implementation of the Solid specification +;; disfluid, implementation of the Solid specification ;; Copyright (C) 2020, 2021 Vivien Kraus ;; This program is free software: you can redistribute it and/or modify @@ -45,11 +45,10 @@ (define decoded-once (decode)) (with-exception-handler (lambda (error) - (unless ((record-predicate &jti-found) - ((record-accessor &cannot-decode-dpop-proof 'cause) error)) + (unless (jti-found? error) (raise-exception error))) (lambda () (decode) (exit 2)) #:unwind? #t - #:unwind-for-type &cannot-decode-dpop-proof))) + #:unwind-for-type &jti-found))) diff --git a/tests/dpop-proof-valid-ath.scm b/tests/dpop-proof-valid-ath.scm index 1e15e17..8753c3a 100644 --- a/tests/dpop-proof-valid-ath.scm +++ b/tests/dpop-proof-valid-ath.scm @@ -1,4 +1,4 @@ -;; webid-oidc, implementation of the Solid specification +;; disfluid, implementation of the Solid specification ;; Copyright (C) 2020, 2021 Vivien Kraus ;; This program is free software: you can redistribute it and/or modify @@ -34,11 +34,11 @@ (issue-access-token idp-key #:alg 'RS256 - #:webid "https://data.provider/subject" - #:iss "https://identity.provider" + #:webid (string->uri "https://data.provider/subject") + #:iss (string->uri "https://identity.provider") #:validity 3600 #:client-key jwk - #:client-id "https://client"))) + #:client-id (string->uri "https://client")))) (define proof (parameterize ((p:current-date 0)) (issue-dpop-proof diff --git a/tests/dpop-proof-wrong-htm.scm b/tests/dpop-proof-wrong-htm.scm index 1b30161..204e87a 100644 --- a/tests/dpop-proof-wrong-htm.scm +++ b/tests/dpop-proof-wrong-htm.scm @@ -1,4 +1,4 @@ -;; webid-oidc, implementation of the Solid specification +;; disfluid, implementation of the Solid specification ;; Copyright (C) 2020, 2021 Vivien Kraus ;; This program is free software: you can redistribute it and/or modify @@ -38,8 +38,11 @@ #:htu (string->uri "https://example.com/res#frag")))) (with-exception-handler (lambda (error) - (unless ((record-predicate &dpop-method-mismatch) - ((record-accessor &cannot-decode-dpop-proof 'cause) error)) + (unless (and (dpop-method-mismatch? error) + (eq? (dpop-method-mismatch-advertised error) + 'POST) + (eq? (dpop-method-mismatch-actual error) + 'GET)) (raise-exception error))) (lambda () (parameterize ((p:current-date 10)) @@ -49,4 +52,4 @@ cnf)) (exit 2)) #:unwind? #t - #:unwind-for-type &cannot-decode-dpop-proof))) + #:unwind-for-type &dpop-method-mismatch))) diff --git a/tests/dpop-proof-wrong-htu.scm b/tests/dpop-proof-wrong-htu.scm index 6f3ac0a..05bdea5 100644 --- a/tests/dpop-proof-wrong-htu.scm +++ b/tests/dpop-proof-wrong-htu.scm @@ -1,4 +1,4 @@ -;; webid-oidc, implementation of the Solid specification +;; disfluid, implementation of the Solid specification ;; Copyright (C) 2020, 2021 Vivien Kraus ;; This program is free software: you can redistribute it and/or modify @@ -38,8 +38,11 @@ #:htu (string->uri "https://example.com/other-res#frag")))) (with-exception-handler (lambda (error) - (unless ((record-predicate &dpop-uri-mismatch) - ((record-accessor &cannot-decode-dpop-proof 'cause) error)) + (unless (and (dpop-uri-mismatch? error) + (equal? (dpop-uri-mismatch-advertised error) + (string->uri "https://example.com/other-res#frag")) + (equal? (dpop-uri-mismatch-actual error) + (string->uri "https://example.com/res?query"))) (raise-exception error))) (lambda () (parameterize ((p:current-date 10)) @@ -49,4 +52,4 @@ cnf)) (exit 2)) #:unwind? #t - #:unwind-for-type &cannot-decode-dpop-proof))) + #:unwind-for-type &dpop-uri-mismatch))) diff --git a/tests/dpop-proof-wrong-key.scm b/tests/dpop-proof-wrong-key.scm index 497ae0e..ca1e01b 100644 --- a/tests/dpop-proof-wrong-key.scm +++ b/tests/dpop-proof-wrong-key.scm @@ -1,4 +1,4 @@ -;; webid-oidc, implementation of the Solid specification +;; disfluid, implementation of the Solid specification ;; Copyright (C) 2020, 2021 Vivien Kraus ;; This program is free software: you can redistribute it and/or modify @@ -38,8 +38,7 @@ #:htu (string->uri "https://example.com/res#frag")))) (with-exception-handler (lambda (error) - (unless ((record-predicate &dpop-unconfirmed-key) - ((record-accessor &cannot-decode-dpop-proof 'cause) error)) + (unless (dpop-unconfirmed-key? error) (raise-exception error))) (lambda () (parameterize ((p:current-date 10)) @@ -49,4 +48,4 @@ cnf)) (exit 2)) #:unwind? #t - #:unwind-for-type &cannot-decode-dpop-proof))) + #:unwind-for-type &dpop-unconfirmed-key))) diff --git a/tests/hash-unsupported.scm b/tests/hash-unsupported.scm index 3924202..bcea18c 100644 --- a/tests/hash-unsupported.scm +++ b/tests/hash-unsupported.scm @@ -1,4 +1,4 @@ -;; webid-oidc, implementation of the Solid specification +;; disfluid, implementation of the Solid specification ;; Copyright (C) 2020, 2021 Vivien Kraus ;; This program is free software: you can redistribute it and/or modify @@ -25,13 +25,14 @@ (lambda () (with-exception-handler (lambda (error) - (unless ((record-predicate &unsupported-alg) error) + (unless (stubs:unsupported-algorithm? error) (exit 1)) - (let ((value ((record-accessor &unsupported-alg 'value) error))) - (unless (eq? value 'SHA-1024) - (exit 2)))) + (unless (eq? (stubs:unsupported-algorithm-alg error) 'SHA-1024) + (exit 2)) + (unless (eq? (stubs:unsupported-algorithm-application error) 'hash) + (exit 3))) (lambda () (stubs:hash 'SHA-1024 "hello :)") - (exit 3)) + (exit 4)) #:unwind? #t - #:unwind-for-type &unsupported-alg))) + #:unwind-for-type stubs:&unsupported-algorithm))) diff --git a/tests/jwk-kty-ec-incorrect.scm b/tests/jwk-kty-ec-incorrect.scm index 3ca1283..bacdff0 100644 --- a/tests/jwk-kty-ec-incorrect.scm +++ b/tests/jwk-kty-ec-incorrect.scm @@ -1,4 +1,4 @@ -;; webid-oidc, implementation of the Solid specification +;; disfluid, implementation of the Solid specification ;; Copyright (C) 2020, 2021 Vivien Kraus ;; This program is free software: you can redistribute it and/or modify @@ -14,7 +14,8 @@ ;; 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) +(use-modules (webid-oidc jwk) + (webid-oidc stubs) (webid-oidc testing) (webid-oidc errors)) diff --git a/tests/jwk-kty-rsa-incorrect.scm b/tests/jwk-kty-rsa-incorrect.scm index fe81c1d..798933f 100644 --- a/tests/jwk-kty-rsa-incorrect.scm +++ b/tests/jwk-kty-rsa-incorrect.scm @@ -1,4 +1,4 @@ -;; webid-oidc, implementation of the Solid specification +;; disfluid, implementation of the Solid specification ;; Copyright (C) 2020, 2021 Vivien Kraus ;; This program is free software: you can redistribute it and/or modify @@ -15,6 +15,7 @@ ;; along with this program. If not, see <https://www.gnu.org/licenses/>. (use-modules (webid-oidc stubs) + (webid-oidc jwk) (webid-oidc testing) (webid-oidc errors)) diff --git a/tests/jws.scm b/tests/jws.scm index cfd57b1..981e751 100644 --- a/tests/jws.scm +++ b/tests/jws.scm @@ -1,4 +1,4 @@ -;; webid-oidc, implementation of the Solid specification +;; disfluid, implementation of the Solid specification ;; Copyright (C) 2020, 2021 Vivien Kraus ;; This program is free software: you can redistribute it and/or modify @@ -33,8 +33,8 @@ (parsed (jws-decode encoded (lambda (jws) (and (jws? jws) key)))) - (parsed-header (jws-header parsed)) - (parsed-payload (jws-payload parsed)) + (parsed-header (car parsed)) + (parsed-payload (cdr parsed)) (alg (jws-alg parsed)) (typ (assq-ref parsed-header 'typ)) (sub (assq-ref parsed-payload 'sub)) @@ -43,8 +43,8 @@ (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 (jws-header re-parsed)) - (re-parsed-payload (jws-payload re-parsed)) + (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)) diff --git a/tests/oidc-configuration.scm b/tests/oidc-configuration.scm index f7b3bbc..983c0f7 100644 --- a/tests/oidc-configuration.scm +++ b/tests/oidc-configuration.scm @@ -1,4 +1,4 @@ -;; webid-oidc, implementation of the Solid specification +;; disfluid, implementation of the Solid specification ;; Copyright (C) 2020, 2021 Vivien Kraus ;; This program is free software: you can redistribute it and/or modify @@ -112,7 +112,8 @@ \"code_challenge_methods_supported\": [ \"plain\", \"S256\" - ] + ], + \"solid_oidc_supported\": \"https://solidproject.org/TR/solid-oidc\" }")) (else (exit 2)))) (define cache-http-get @@ -128,18 +129,16 @@ (exit 3)) (unless (jwks? jwks) (exit 4)) - (let ((my-oidc (make-oidc-configuration - "https://example.com/keys" - "https://example.com/authorize" - "https://example.com/token"))) + (let ((my-oidc `((jwks_uri . "https://example.com/keys") + (authorization_endpoint . "https://example.com/authorize") + (token_endpoint . "https://example.com/token") + (solid_oidc_supported . "https://solidproject.org/TR/solid-oidc")))) (receive (response response-body) (serve-oidc-configuration (time-utc->date (make-time time-utc 0 3600)) my-oidc) (unless (eqv? (car (response-content-type response)) 'application/json) (exit 5)) - (let ((parsed (stubs:json-string->scm response-body))) - (unless (oidc-configuration? parsed) - (exit 6)) + (let ((parsed (the-oidc-configuration (stubs:json-string->scm response-body)))) (unless (equal? (assq-ref parsed 'jwks_uri) "https://example.com/keys") (exit 7)) diff --git a/tests/refresh-token-with-wrong-key.scm b/tests/refresh-token-with-wrong-key.scm index 38537ec..8a19905 100644 --- a/tests/refresh-token-with-wrong-key.scm +++ b/tests/refresh-token-with-wrong-key.scm @@ -1,4 +1,4 @@ -;; webid-oidc, implementation of the Solid specification +;; disfluid, implementation of the Solid specification ;; Copyright (C) 2020, 2021 Vivien Kraus ;; This program is free software: you can redistribute it and/or modify @@ -34,7 +34,7 @@ (define refresh-token (issue-refresh-token sub aud (jkt first-key))) (with-exception-handler (lambda (error) - (unless ((record-predicate &invalid-key-for-refresh-token) error) + (unless (invalid-refresh-token? error) (exit 1))) (lambda () (with-refresh-token refresh-token second-key @@ -42,4 +42,4 @@ (exit 2))) (exit 3)) #:unwind? #t - #:unwind-for-type &invalid-key-for-refresh-token))) + #:unwind-for-type &invalid-refresh-token))) diff --git a/tests/refresh-token.scm b/tests/refresh-token.scm index 3bcb27f..cf5640b 100644 --- a/tests/refresh-token.scm +++ b/tests/refresh-token.scm @@ -1,4 +1,4 @@ -;; webid-oidc, implementation of the Solid specification +;; disfluid, implementation of the Solid specification ;; Copyright (C) 2020, 2021 Vivien Kraus ;; This program is free software: you can redistribute it and/or modify @@ -58,7 +58,7 @@ (remove-refresh-token sub-b aud-b) (with-exception-handler (lambda (error) - (unless ((record-predicate &invalid-refresh-token) error) + (unless (invalid-refresh-token? error) (exit 10))) (lambda () (with-refresh-token refresh-b key-b diff --git a/tests/resource-server.scm b/tests/resource-server.scm index aba4bb0..b9f1036 100644 --- a/tests/resource-server.scm +++ b/tests/resource-server.scm @@ -1,4 +1,4 @@ -;; webid-oidc, implementation of the Solid specification +;; disfluid, implementation of the Solid specification ;; Copyright (C) 2020, 2021 Vivien Kraus ;; This program is free software: you can redistribute it and/or modify @@ -39,10 +39,10 @@ (define jwks (make-jwks (list idp-key))) (define jwks-uri (string->uri "https://identity.provider/keys")) (define oidc-config - (make-oidc-configuration - jwks-uri - (string->uri "https://identity.provider/authorize") - (string->uri "https://identity.provider/token"))) + `((jwks_uri . ,(uri->string jwks-uri)) + (authorization_endpoint . "https://identity.provider/authorize") + (token_endpoint . "https://identity.provider/token") + (solid_oidc_supported . "https://solidproject.org/TR/solid-oidc"))) (define oidc-config-uri (string->uri "https://identity.provider/.well-known/openid-configuration")) @@ -60,10 +60,10 @@ idp-key #:alg 'RS256 #:webid subject - #:iss "https://identity.provider" + #:iss (string->uri "https://identity.provider") #:validity 3600 #:client-key client-key - #:client-id "https://client"))) + #: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) diff --git a/tests/server-path.scm b/tests/server-path.scm index b2e1180..b497dae 100644 --- a/tests/server-path.scm +++ b/tests/server-path.scm @@ -33,26 +33,26 @@ (lambda (file) (false-if-exception (delete-file file))) '( - "tests/server-path.home/webid-oidc/server/content/6/8OMG_V5x-KmI6TI" - "tests/server-path.home/webid-oidc/server/content/X/hqM_2Avn5_egTzs" - "tests/server-path.home/webid-oidc/server/content/a/68pTwiImTWTpjQl" - "tests/server-path.home/webid-oidc/server/content/5/n1KPgAd3ng4wSqn" - "tests/server-path.home/webid-oidc/server/content/D/wxU0ogx5rzRrvu2" - "tests/server-path.home/webid-oidc/server/content/F/BQKBGrtq6U_M0L7" - "tests/server-path.home/webid-oidc/server/content/N/gnO8RAS9FpPiO5j" - "tests/server-path.home/webid-oidc/server/content/n/U46BXbknEaLWZpH" - "tests/server-path.home/webid-oidc/server/content/y/29x0MEOMybxUqDU" - "tests/server-path.home/webid-oidc/server/content/b/k7RqZevpCHAumba" - "tests/server-path.home/webid-oidc/server/content/H/y4S5p1BqTEJi-Jb" - "tests/server-path.home/webid-oidc/server/content/A/fkGTJRCHc-jHk-V" - "tests/server-path.home/webid-oidc/server/path/b/FkceBVDI7O39t4bFK02Vu0E7OWtjnjDfAXDLKuREbE" - "tests/server-path.home/webid-oidc/server/path/b/FkceBVDI7O39t4bFK02Vu0E7OWtjnjDfAXDLKuREbE.lock" - "tests/server-path.home/webid-oidc/server/path/g/pBBL3msK7bpJ_LUp4xDyrB-EZD1EaJgD6xo9ysqy6Q" - "tests/server-path.home/webid-oidc/server/path/g/pBBL3msK7bpJ_LUp4xDyrB-EZD1EaJgD6xo9ysqy6Q.lock" - "tests/server-path.home/webid-oidc/server/path/i/l7asoJjJEMhngUeSt4tHVu8Zxx4EFG_FDeJfL3-oPE" - "tests/server-path.home/webid-oidc/server/path/i/l7asoJjJEMhngUeSt4tHVu8Zxx4EFG_FDeJfL3-oPE.lock" - "tests/server-path.home/webid-oidc/server/path/Q/hRrKeOf3iJxfvabWz2CBYAlF_ovDFXqHWcwhhuQhXg" - "tests/server-path.home/webid-oidc/server/path/Q/hRrKeOf3iJxfvabWz2CBYAlF_ovDFXqHWcwhhuQhXg.lock" + "tests/server-path.home/disfluid/server/content/6/8OMG_V5x-KmI6TI" + "tests/server-path.home/disfluid/server/content/X/hqM_2Avn5_egTzs" + "tests/server-path.home/disfluid/server/content/a/68pTwiImTWTpjQl" + "tests/server-path.home/disfluid/server/content/5/n1KPgAd3ng4wSqn" + "tests/server-path.home/disfluid/server/content/D/wxU0ogx5rzRrvu2" + "tests/server-path.home/disfluid/server/content/F/BQKBGrtq6U_M0L7" + "tests/server-path.home/disfluid/server/content/N/gnO8RAS9FpPiO5j" + "tests/server-path.home/disfluid/server/content/n/U46BXbknEaLWZpH" + "tests/server-path.home/disfluid/server/content/y/29x0MEOMybxUqDU" + "tests/server-path.home/disfluid/server/content/b/k7RqZevpCHAumba" + "tests/server-path.home/disfluid/server/content/H/y4S5p1BqTEJi-Jb" + "tests/server-path.home/disfluid/server/content/A/fkGTJRCHc-jHk-V" + "tests/server-path.home/disfluid/server/path/b/FkceBVDI7O39t4bFK02Vu0E7OWtjnjDfAXDLKuREbE" + "tests/server-path.home/disfluid/server/path/b/FkceBVDI7O39t4bFK02Vu0E7OWtjnjDfAXDLKuREbE.lock" + "tests/server-path.home/disfluid/server/path/g/pBBL3msK7bpJ_LUp4xDyrB-EZD1EaJgD6xo9ysqy6Q" + "tests/server-path.home/disfluid/server/path/g/pBBL3msK7bpJ_LUp4xDyrB-EZD1EaJgD6xo9ysqy6Q.lock" + "tests/server-path.home/disfluid/server/path/i/l7asoJjJEMhngUeSt4tHVu8Zxx4EFG_FDeJfL3-oPE" + "tests/server-path.home/disfluid/server/path/i/l7asoJjJEMhngUeSt4tHVu8Zxx4EFG_FDeJfL3-oPE.lock" + "tests/server-path.home/disfluid/server/path/Q/hRrKeOf3iJxfvabWz2CBYAlF_ovDFXqHWcwhhuQhXg" + "tests/server-path.home/disfluid/server/path/Q/hRrKeOf3iJxfvabWz2CBYAlF_ovDFXqHWcwhhuQhXg.lock" )) (with-session (lambda (content-type contained static-content create delete) diff --git a/tests/token-endpoint-issue.scm b/tests/token-endpoint-issue.scm index 9438dfe..3b21f9b 100644 --- a/tests/token-endpoint-issue.scm +++ b/tests/token-endpoint-issue.scm @@ -1,4 +1,4 @@ -;; webid-oidc, implementation of the Solid specification +;; disfluid, implementation of the Solid specification ;; Copyright (C) 2020, 2021 Vivien Kraus ;; This program is free software: you can redistribute it and/or modify @@ -17,6 +17,7 @@ (use-modules (webid-oidc token-endpoint) (webid-oidc authorization-code) (webid-oidc dpop-proof) + (webid-oidc access-token) (webid-oidc jwk) (webid-oidc jws) (webid-oidc jti) @@ -42,16 +43,18 @@ (define issuer (string->uri "https://issuer.token-endpoint-issue.scm")) (define validity 3600) (define authz - (issue-authorization-code - alg key - (time-utc->date (make-time time-utc 0 120)) - subject - client)) + (parameterize ((p:current-date 0)) + (issue-authorization-code + key + #:alg alg + #:validity 120 + #:webid subject + #:client-id client))) (define endpoint (make-token-endpoint (string->uri "https://token-endpoint-issue.scm/token") issuer alg key validity)) - (receive (response response-body user error) + (receive (response response-body . _) ;; The code is fake! (let ((dpop (parameterize ((p:current-date 0)) @@ -72,7 +75,7 @@ "grant_type=authorization_code&code=fake"))) (unless (eq? (response-code response) 400) (exit 3)) - (receive (response response-body user error) + (receive (response response-body . _) (let ((dpop (parameterize ((p:current-date 10)) (issue-dpop-proof @@ -106,12 +109,8 @@ (lambda (h) key)))) (unless access-token (exit 8)) - (let ((access-token-cnf (assq-ref (jws-payload access-token) - 'cnf))) - (unless access-token-cnf + (let ((access-token-cnf/jkt (access-token-cnf/jkt access-token))) + (unless access-token-cnf/jkt (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=? access-token-cnf/jkt (jkt client-key)) + (exit 10)))))))))) diff --git a/tests/token-endpoint-refresh.scm b/tests/token-endpoint-refresh.scm index f3d9b52..2d5ece4 100644 --- a/tests/token-endpoint-refresh.scm +++ b/tests/token-endpoint-refresh.scm @@ -1,5 +1,5 @@ -;; webid-oidc, implementation of the Solid specification -;; Copyright (C) 2020, 2021 Vivien Kraus +;; 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 @@ -47,7 +47,7 @@ (define endpoint (make-token-endpoint (string->uri "https://token-endpoint-issue.scm/token") issuer alg key validity)) - (receive (response response-body user error) + (receive (response response-body . _) ;; The refresh token is fake! (let ((dpop (parameterize ((p:current-date 0)) diff --git a/tests/too-many-refresh-tokens.scm b/tests/too-many-refresh-tokens.scm index 3926da4..aacfbbd 100644 --- a/tests/too-many-refresh-tokens.scm +++ b/tests/too-many-refresh-tokens.scm @@ -1,4 +1,4 @@ -;; webid-oidc, implementation of the Solid specification +;; disfluid, implementation of the Solid specification ;; Copyright (C) 2020, 2021 Vivien Kraus ;; This program is free software: you can redistribute it and/or modify @@ -44,23 +44,25 @@ (second-refresh-token (vector-ref refresh-tokens 20))) (with-exception-handler (lambda (error) - (unless ((record-predicate &invalid-refresh-token) error) + (unless (invalid-refresh-token? error) (exit 1))) (lambda () - (with-refresh-token first-refresh-token key - (lambda (sub aud) - ;; It has been made invalid! - (exit 1)))) + (with-refresh-token + first-refresh-token key + (lambda (sub aud) + ;; It has been made invalid! + (exit 1)))) #:unwind? #t #:unwind-for-type &invalid-refresh-token) - (unless (with-refresh-token second-refresh-token key - (lambda (sub aud) - (format (current-error-port) - "~a / ~a\n" - (uri->string sub) - (uri->string aud)) - (unless (equal? sub (string->uri "https://subject-2.com")) - (exit 2)) - (unless (equal? aud (string->uri "https://client-2.com")) - (exit 3)))) + (unless (with-refresh-token + second-refresh-token key + (lambda (sub aud) + (format (current-error-port) + "~a / ~a\n" + (uri->string sub) + (uri->string aud)) + (unless (equal? sub (string->uri "https://subject-2.com")) + (exit 2)) + (unless (equal? aud (string->uri "https://client-2.com")) + (exit 3)))) (exit 4)))))) diff --git a/tests/unknown-client-locale.scm b/tests/unknown-client-locale.scm deleted file mode 100644 index c2fd4c2..0000000 --- a/tests/unknown-client-locale.scm +++ /dev/null @@ -1,45 +0,0 @@ -;; webid-oidc, 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 authorization-page) - (webid-oidc testing) - (webid-oidc errors) - (web uri) - (srfi srfi-19) - (web response) - (ice-9 optargs) - (ice-9 receive)) - -(with-test-environment - "unknown-client-locale" - (lambda () - (let ((problem-acknowledged #f)) - (receive (response response-body) - (with-exception-handler - (lambda (error) - (unless ((record-predicate &unknown-client-locale) error) - (format (current-error-port) "Huh... ~a\n" (error->str error)) - (exit 1)) - (set! problem-acknowledged #t)) - (lambda () - (authorization-page "qdfkljsmfklsjmf" #f - (string->uri "https://example.com") - (string->uri "https://example.com")))) - (unless (eqv? (response-code response) 200) - (exit 2)) - (unless problem-acknowledged - (exit 3)) - (format (current-error-port) "~a" response-body))))) diff --git a/tests/verification-failed.scm b/tests/verification-failed.scm index f4c22de..5bb5dd0 100644 --- a/tests/verification-failed.scm +++ b/tests/verification-failed.scm @@ -1,4 +1,4 @@ -;; webid-oidc, implementation of the Solid specification +;; disfluid, implementation of the Solid specification ;; Copyright (C) 2020, 2021 Vivien Kraus ;; This program is free software: you can redistribute it and/or modify @@ -31,7 +31,7 @@ (signature "lNhmpAX_WwmpBvwhok4E74kWCiGBNdavjLAeevGy32H3dbF0Jbri69Nm2ukkwb-uyUI4AUg_JSskfWIyo4UCbQ")) ;; Replaced 1 with _ (with-exception-handler (lambda (error) - (unless ((record-predicate &invalid-signature) error) + (unless (invalid-signature? error) (exit 1))) (lambda () (verify 'ES256 key payload signature) |