summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorVivien Kraus <vivien@planete-kraus.eu>2021-08-07 22:45:06 +0200
committerVivien Kraus <vivien@planete-kraus.eu>2021-08-13 01:06:38 +0200
commitdb55d55e5c36c940986f437d26da1ff3c601c3b4 (patch)
tree0ecec5b2bd0b0bc6a02981a7c3b9ccafbb891c3b
parent0b5d0622e11c1f919ce660893067d3121e2583a0 (diff)
Make a better client API
-rwxr-xr-xbootstrap2
-rw-r--r--doc/disfluid.texi212
-rw-r--r--man/Makefile.am6
-rw-r--r--po/POTFILES.in1
-rw-r--r--po/disfluid.pot410
-rw-r--r--po/fr.po617
-rw-r--r--src/Makefile.am10
-rw-r--r--src/scm/webid-oidc/Makefile.am1
-rw-r--r--src/scm/webid-oidc/client.scm551
-rw-r--r--src/scm/webid-oidc/client/Makefile.am21
-rw-r--r--src/scm/webid-oidc/client/accounts.scm534
-rw-r--r--src/scm/webid-oidc/errors.scm22
-rw-r--r--src/scm/webid-oidc/example-app.scm288
-rw-r--r--src/scm/webid-oidc/resource-server.scm16
-rw-r--r--src/scm/webid-oidc/testing.scm7
-rw-r--r--tests/Makefile.am3
-rw-r--r--tests/client-authorization.scm134
-rw-r--r--tests/client-token.scm137
-rw-r--r--tests/client-workflow.scm140
19 files changed, 1615 insertions, 1497 deletions
diff --git a/bootstrap b/bootstrap
index ce85a33..2c0e28e 100755
--- a/bootstrap
+++ b/bootstrap
@@ -20,7 +20,7 @@ autoreconf -vif || exit 1
sed -i 's|SHELL = /bin/sh|SHELL = @SHELL@|g' po/Makefile.in.in || exit 1
## Prepare the man pages
-SCRIPTS_THAT_GET_EXECUTED="../src/disfluid ../src/disfluid-example-app"
+SCRIPTS_THAT_GET_EXECUTED="../src/disfluid"
mkdir -p .native || exit 1
cd .native || exit 1
diff --git a/doc/disfluid.texi b/doc/disfluid.texi
index 93128c1..2841052 100644
--- a/doc/disfluid.texi
+++ b/doc/disfluid.texi
@@ -443,8 +443,8 @@ Get the corresponding field of the proof.
Check and decode a DPoP proof encoded as @var{str}.
In order to prevent replay attacks, each proof has a unique random
-string that is remembered in @var{jti-list} until its expiration date
-is reached. See the @code{make-jti-list} function.
+string that is remembered globally until its expiration date is
+reached.
The proof is limited to the scope of one @var{uri} and one
@var{method} (@code{'GET}, @code{'POST} and so on).
@@ -873,103 +873,165 @@ OIDC ID token and an access token from the identity provider, and then
present the access token and a proof of possession of the linked key
in each request, in a DPoP HTTP header.
-The first operation is performed by the @emph{(webid-oidc client)}
-module.
+The list of accounts is stored on the file system. You can manipulate
+the accounts with the @emph{(webid-oidc client accounts)} module.
-@deffn function authorize @var{host/webid} @var{#client-id} @var{#redirect-uri} @var{[#state]} @var{[#http-get]}
-The user enters a valid webid or a host name, and then this function
-will query it (with the @var{http-get} parameter, by default the web
-client from @emph{(web client)}) to determine the authorization
-endpoint. The function will return an alist of authorization URIs,
-indexed by approved identity provider URIs, that the user should
-browse with a traditional web browser.
+@deftp {Record type} <account> @var{subject} @var{issuer} @var{id-token} @var{access-token} @var{refresh-token} @var{keypair}
+Store information about an account. @var{subject} and @var{issuer} are
+required, they must bue URIs. If the access token was not invalidated,
+then @var{id-token} contains a (decrypted) identity token, and
+@var{access-token} an encrypted access token. If you got a
+@var{refresh-token} for this account, it is also stored, along with
+the @var{keypair} that is server-side bound to it.
-Each application should have its own webid, or in that case
-@var{client-id}, that can be dereferenced by the identity provider.
+The optional parameters are @code{#f} when we don’t have them.
+@end deftp
-Once the user has given authorization, the user’s agent will be
-redirected to @var{redirect-uri}, with the authorization code as a GET
-parameter. It is possible to pass a @var{state}, but this is optional.
+@deffn function make-account @var{subject} @var{issuer} @var{id-token} @var{access-token} @var{refresh-token} @var{keypair}
+Create an account.
@end deffn
-Once the client gets the authorization code, it is necessary to create
-an access token and ID token.
+@deffn function account? @var{object}
+Check whether @var{object} is an account.
+@end deffn
-@deffn function token @var{host} @var{client-key} @var{[#authorization-code]} @var{[#refresh-token]} @var{[#http-get]} @var{[#http-post]} @var{[#current-time]}
-Trade an @var{authorization-code}, or a @var{refresh-token}, for an ID
-token and an access token bound to the @var{client-key} issued by
-@var{host}, the identity provider.
+@deffn function account-subject @var{account}
+@deffnx function account-issuer @var{account}
+@deffnx function account-id-token @var{account}
+@deffnx function account-access-token @var{account}
+@deffnx function account-refresh-token @var{account}
+@deffnx function account-keypair @var{account}
+Access the account.
+@end deffn
-You can override the HTTP client used (@var{http-get} and
-@var{http-post}), and how to compute the time (@var{current-time}).
+You should always manage the accounts with the users database.
+
+@deffn function read-accounts
+Read the list of all accounts. This function is safe to call at any
+time during concurrent updates of the database. If the update was
+finished, the new list is returned, otherwise the old list is returned
+without blocking.
@end deffn
-In an application, you would have a list of profiles in XDG_DATA_HOME,
-consisting of triples (webid, issuer, refresh token).
+@deffn function save-account @var{account}
+Find an account in the database with the same subject and issuer, and
+replace its contents with @var{account}. Return @var{account}.
+@end deffn
-@deffn function list-profiles @var{[#dir]}
-Read the list of available profiles. Returns a list of triples, webid,
-issuer, reresh token.
+@deffn function delete-account @var{account}
+Remove all accounts from the database that have the same subject and
+issuer as @var{account}.
+@end deffn
+
+To log a user in, you must know at least per issuer. More precisely,
+if the user is already known (because, for instance, the user presents
+a cookie for your web application), then you should know the user’s
+webid and the webid issuer. If you don’t know the user, and the user
+is eligible to your service, then you will only know the identity
+provider (issuer), because that’s what the user typed in.
-By default, this function will look for the profiles file in
-@var{XDG_DATA_HOME}. You can bypass it by providing the @var{#dir}
-optional keyword argument.
+@deffn function login @var{subject} @var{issuer} [#:@var{http-get}=@code{http-get}] [#:@var{http-post}=@code{http-post}] [#:@var{state}=@code{#f}] #:@var{client-id} #:@var{client-key} #:@var{redirect-uri}
+Return a new account with an ID token and an access
+token. @var{subject} is optional.
+
+When you receive an account record from this function, make sure to
+save it to the accounts database with @code{save-account}.
@end deffn
-@deffn function setup @var{get-host/webid} @var{choose-provider} @var{browse-authorization-uri} @var{#client-id} @var{#redirect-uri} @var{[#dir]} @var{[#http-get]} @var{[#http-post]} @var{[#current-time]}
-Negociate a refresh token, and save it. The function returns 3 values:
-the decoded ID token pyload, the encoded access token and the key
-pair.
-
-The @var{get-host/webid} thunk should ask the user’s webid or identity
-provider, and return it. @var{choose-provider} is called with a list
-of possible identity providers as host names (strings), and the user
-should choose one. The chosen one is returned. Finally,
-@var{browse-authorization-uri} should ask or let the user browse an
-URI as its argument, and return the authorization code taken from the
-redirect URI.
-
-The refresh token is saved to disk, as a profile, in
-XDG_DATA_HOME. Pass the optional @var{#dir} keyword argument to
-override the location.
-
-You need to set @var{client-id} to the public webid of the app, and
-@var{redirect-uri} to one of the approved redirection URIs for the
-application ID.
+@deftp {Exception type} &authorization-code-required @var{uri}
+If the login process requires the user to send an authorization code,
+an exception of this type will be raised, with an implicit invitation
+for the user to browse @var{uri} and follow the instructions.
+
+The instructions will be handled by the @var{redirect-uri} in the
+@code{login} function. If your client is a traditional web
+application, the user will be redirected to this URI with an
+authorization code. If your client is a native application, then maybe
+that redirection URI should display the authorization code and invite
+the user to paste it in the appropriate place in the application.
+
+When an exception of this type is raised during the @code{login}
+function, it is continuable, meaning that the login function will
+resume. You need to create an exception handler for an exception of
+this type, look up the @var{uri}, direct the user to browse it, get
+the authorization code back, and @emph{return} the authorization code
+@emph{from the exception handler}.
+@end deftp
+
+@deffn function make-authorization-code-required @var{uri}
+@deffnx function authorization-code-required? @var{error}
+@deffnx function authorization-code-required-uri @var{error}
+Constructor, predicate, and accessor for the
+@code{&authorization-code-required} exception type.
@end deffn
-@deffn function login @var{webid} @var{issuer} @var{refresh-token} @var{key} @var{[#dir]} @var{[#http-get]} @var{[#http-post]} @var{[#current-time]}
-If you have already a known profile, you can use it to automatically
-log in. This function might update the refresh token if it changed, so
-you can again set @var{#dir}. Please note that the @var{refresh-token}
-is bound to the client @var{key} on server side, so you must always
-use the same @var{key}.
+@deftp {Exception type} &refresh-token-expired
+The refresh token can be used to still perform requests on behalf of
+the user when perse is offline. However, if the refresh token expires
+while the user is offline, it is not possible to log in again, because
+it requires a new authorization code. So, it is not possible to
+recover from this error, and the refresh token is immediately
+discarded.
+@end deftp
+
+@deffn function make-refresh-token-expired
+@deffnx function refresh-token-expired? @var{error}
+Constructor and predicate for the @code{&refresh-token-expired}
+exception type.
@end deffn
-@deffn function refresh @var{id-token} @var{key} @var{[#dir]} @var{[#http-get]} @var{[#http-post]} @var{[#current-time]}
-If you have an ID token bound to a known profile, this helper function
-will look up the associated refresh token and log in.
+@deffn function invalidate-access-token @var{account}
+Discard the access token for @var{account}. It is not saved in the
+user database yet. This is roughly equivalent to log out.
@end deffn
-@deffn function make-client @var{id-token} @var{access-token} @var{key} @var{[#dir]} @var{[#http-get]} @var{[#http-post]} @var{[#http-request]} @var{[#current-time]}
-Return a replacement of @code{http-request} from @emph{(web client)},
-that automatically signs requests and refresh the tokens when needed.
+@deffn function invalidate-refresh-token @var{account}
+Discard the refresh token for @var{account}. You still need to save
+the @var{account}.
+@end deffn
-@var{#http-get} and @var{#http-post} are only used to refresh the
-tokens, while @var{#http-request} is used as a back-end for the
-requests.
+@deftp {Exception type} &token-request-failed @var{response} @var{response-body}
+If the token endpoint is unable to deliver an identity token and an
+access token, this exception is raised with the identity provider
+@var{response} and @var{response body}. This exception cannot be
+continued.
+@end deftp
-@var{#current-time} is set to a thunk that returns the time. It is
-used to issue DPoP proofs.
+@deffn function make-token-request-failed @var{response response-body}
+@deffnx function token-request-failed? @var{error}
+@deffnx function token-request-response @var{error}
+@deffnx function token-request-response-body @var{error}
+Constructor, predicate, and accessors for the
+@code{&token-request-failed} exception type.
@end deffn
-An example application is provided as the
-@code{disfluid-example-app} program. It demonstrates how
-authentication is done. It should help you understand how Solid-OIDC
-works.
+The @emph{(webid-oidc client)} module provides support for complete
+clients.
-The identity provider needs to call the application on the web. So,
-your client should have a public endpoint on the web.
+@deftp {Record type} <client> @var{id} @var{key} @var{redirect-uri}
+The @var{id} of a client is an URI without fragment that can be
+dereferenced in the world-wide web to metadata about the client. It
+should allow @var{redirect-uri} to access the authorization code.
+
+It is useful if an application rotates its @var{key}. So, while a key
+will still be used as long as the associated refresh token for a given
+user is valid, you can equip new users with a new key pair.
+@end deftp
+
+@deffn function make-client @var{id} @var{key} @var{redirect-uri}
+@deffnx function client? @var{object}
+@deffnx client-id @var{object}
+@deffnx client-key @var{object}
+@deffnx client-redirect-uri @var{object}
+Constructor, predicate and accessors for the @code{<client>} record
+type.
+@end deffn
+
+@deffn function request @var{client} @var{subject} @var{issuer} [#:@var{http-request}=@code{http-request}]
+Log in with @var{subject} (optional, may be @code{#f}) and
+@var{issuer}, and return a function that takes a request and request
+body and transfers it, signed, to the @var{http-request} back-end.
+@end deffn
@deffn function serve-application @var{id} @var{redirect-uri} @var{[#client-name]} @var{[#client-uri]}
Return a handler for web requests to serve the application manifest
diff --git a/man/Makefile.am b/man/Makefile.am
index 7390d64..cb6e589 100644
--- a/man/Makefile.am
+++ b/man/Makefile.am
@@ -14,7 +14,7 @@
# 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/>.
-dist_man8_MANS = disfluid.man disfluid-example-app.man
+dist_man8_MANS = disfluid.man
EXTRA_DIST = ./reset-env project
@@ -22,10 +22,6 @@ disfluid.man: ../src/scm/webid-oidc/program.scm ../configure.ac
$(AM_V_GEN) ../pre-inst-env ./reset-env $(HELP2MAN) $(srcdir)/../src/disfluid > $@-t
mv $@-t $(srcdir)/$@
-disfluid-example-app.man: ../src/scm/webid-oidc/example-app.scm ../configure.ac
- $(AM_V_GEN) ../pre-inst-env ./reset-env $(HELP2MAN) $(srcdir)/../src/disfluid-example-app > $@-t
- mv $@-t $(srcdir)/$@
-
install-html-local: project
$(INSTALL_DATA) $(srcdir)/$< $(DESTDIR)$(htmldir)/disfluid.html
diff --git a/po/POTFILES.in b/po/POTFILES.in
index 9ad200b..69026ba 100644
--- a/po/POTFILES.in
+++ b/po/POTFILES.in
@@ -29,3 +29,4 @@ src/scm/webid-oidc/resource-server.scm
src/scm/webid-oidc/hello-world.scm
src/scm/webid-oidc/example-app.scm
src/scm/webid-oidc/program.scm
+src/scm/webid-oidc/client/accounts.scm \ No newline at end of file
diff --git a/po/disfluid.pot b/po/disfluid.pot
index 75e0165..df099d6 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-08 23:16+0200\n"
+"POT-Creation-Date: 2021-08-12 18:50+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,704 +122,699 @@ msgstr ""
msgid "Usage: generate-key [NUMBER OF BITS | CURVE]\n"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1090
+#: src/scm/webid-oidc/errors.scm:1081
msgid "that’s how it is"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1095
+#: src/scm/webid-oidc/errors.scm:1086
#, scheme-format
msgid "the value ~s is not a base64 string (because ~a)"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1098
+#: src/scm/webid-oidc/errors.scm:1089
#, scheme-format
msgid "the value ~s is not JSON (because ~a)"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1101
+#: src/scm/webid-oidc/errors.scm:1092
#, scheme-format
msgid "the value ~s is not Turtle (because ~a)"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1104
+#: src/scm/webid-oidc/errors.scm:1095
#, scheme-format
msgid "the value ~s does not identify an elleptic curve"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1109
+#: src/scm/webid-oidc/errors.scm:1100
#, scheme-format
msgid "the value ~s does not identify a JWK (because ~a)"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1111
+#: src/scm/webid-oidc/errors.scm:1102
#, scheme-format
msgid "the value ~s does not identify a JWK"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1116
+#: src/scm/webid-oidc/errors.scm:1107
#, scheme-format
msgid "the value ~s does not identify a public JWK (because ~a)"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1118
+#: src/scm/webid-oidc/errors.scm:1109
#, scheme-format
msgid "the value ~s does not identify a public JWK"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1123
+#: src/scm/webid-oidc/errors.scm:1114
#, scheme-format
msgid "the value ~s does not identify a private JWK (because ~a)"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1125
+#: src/scm/webid-oidc/errors.scm:1116
#, scheme-format
msgid "the value ~s does not identify a private JWK"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1130
+#: src/scm/webid-oidc/errors.scm:1121
#, scheme-format
msgid "the value ~s does not identify a JWKS (because ~a)"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1132
+#: src/scm/webid-oidc/errors.scm:1123
#, scheme-format
msgid "the value ~s does not identify a JWKS"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1135
+#: src/scm/webid-oidc/errors.scm:1126
#, scheme-format
msgid "the value ~s does not identify a hash algorithm"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1138
+#: src/scm/webid-oidc/errors.scm:1129
#, scheme-format
msgid "the value ~s is not an alist or misses key ~s"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1141
+#: src/scm/webid-oidc/errors.scm:1132
#, scheme-format
msgid "the value ~s is not a JWS header (because ~a)"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1144
+#: src/scm/webid-oidc/errors.scm:1135
#, scheme-format
msgid "the value ~s is not a JWS payload (because ~a)"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1147
+#: src/scm/webid-oidc/errors.scm:1138
#, scheme-format
msgid "the value ~s is not a JWS (because ~a)"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1150
+#: src/scm/webid-oidc/errors.scm:1141
#, scheme-format
msgid "the string ~s cannot be split in 3 parts with ~s"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1153
+#: 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)"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1156
+#: src/scm/webid-oidc/errors.scm:1147
#, scheme-format
msgid "I cannot decode JWS ~a (because ~a)"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1159
+#: src/scm/webid-oidc/errors.scm:1150
#, scheme-format
msgid "I cannot encode JWS ~a (because ~a)"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1162
+#: src/scm/webid-oidc/errors.scm:1153
#, scheme-format
msgid ""
"the server request unexpectedly failed with code ~a and reason phrase ~s"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1167
+#: src/scm/webid-oidc/errors.scm:1158
#, scheme-format
msgid "the header ~a should not have the value ~s"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1169
+#: src/scm/webid-oidc/errors.scm:1160
#, scheme-format
msgid "the header ~a should be present"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1172
+#: src/scm/webid-oidc/errors.scm:1163
#, scheme-format
msgid "the server response wasn't expected: ~s (because ~a)"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1178
+#: src/scm/webid-oidc/errors.scm:1169
#, scheme-format
msgid "the value ~s is not an OIDC configuration (because ~a)"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1183
+#: src/scm/webid-oidc/errors.scm:1174
#, scheme-format
msgid "the webid field is incorrect: ~s"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1184
+#: src/scm/webid-oidc/errors.scm:1175
msgid "the webid field is missing"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1188
+#: src/scm/webid-oidc/errors.scm:1179
#, scheme-format
msgid "the sub field is incorrect: ~s"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1189
+#: src/scm/webid-oidc/errors.scm:1180
msgid "the sub field is missing"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1193
+#: src/scm/webid-oidc/errors.scm:1184
#, scheme-format
msgid "the iss field is incorrect: ~s"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1194
+#: src/scm/webid-oidc/errors.scm:1185
msgid "the iss field is missing"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1198
+#: src/scm/webid-oidc/errors.scm:1189
#, scheme-format
msgid "the aud field is incorrect: ~s"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1199
+#: src/scm/webid-oidc/errors.scm:1190
msgid "the aud field is missing"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1203
+#: src/scm/webid-oidc/errors.scm:1194
#, scheme-format
msgid "the iat field is incorrect: ~s"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1204
+#: src/scm/webid-oidc/errors.scm:1195
msgid "the iat field is missing"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1208
+#: src/scm/webid-oidc/errors.scm:1199
#, scheme-format
msgid "the exp field is incorrect: ~s"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1209
+#: src/scm/webid-oidc/errors.scm:1200
msgid "the exp field is missing"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1213
+#: src/scm/webid-oidc/errors.scm:1204
#, scheme-format
msgid "the cnf/jkt field is incorrect: ~s"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1214
+#: src/scm/webid-oidc/errors.scm:1205
msgid "the cnf/jkt field is missing"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1218
+#: src/scm/webid-oidc/errors.scm:1209
#, scheme-format
msgid "the client-id field is incorrect: ~s"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1219
+#: src/scm/webid-oidc/errors.scm:1210
msgid "the client-id field is missing"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1223
+#: 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 ""
-#: src/scm/webid-oidc/errors.scm:1224
+#: src/scm/webid-oidc/errors.scm:1215
#: src/scm/webid-oidc/authorization-page-unsafe.scm:150
msgid "the redirect_uris field is missing"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1228
+#: src/scm/webid-oidc/errors.scm:1219
#, scheme-format
msgid "the typ field is incorrect: ~s"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1229
+#: src/scm/webid-oidc/errors.scm:1220
msgid "the typ field is missing"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1233
+#: src/scm/webid-oidc/errors.scm:1224
#, scheme-format
msgid "the jwk field is incorrect: ~s (because ~a)"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1235
+#: src/scm/webid-oidc/errors.scm:1226
msgid "the jwk field is missing"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1239
+#: src/scm/webid-oidc/errors.scm:1230
#, scheme-format
msgid "the jti field is incorrect: ~s"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1240
+#: src/scm/webid-oidc/errors.scm:1231
msgid "the jti field is missing"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1244
+#: src/scm/webid-oidc/errors.scm:1235
#, scheme-format
msgid "the nonce field is incorrect: ~s"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1245
+#: src/scm/webid-oidc/errors.scm:1236
msgid "the nonce field is missing"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1249
+#: src/scm/webid-oidc/errors.scm:1240
#, scheme-format
msgid "the htm field is incorrect: ~s"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1250
+#: src/scm/webid-oidc/errors.scm:1241
msgid "the htm field is missing"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1254
+#: src/scm/webid-oidc/errors.scm:1245
#, scheme-format
msgid "the htu field is incorrect: ~s"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1255
+#: src/scm/webid-oidc/errors.scm:1246
msgid "the htu field is missing"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1259
+#: src/scm/webid-oidc/errors.scm:1250
#, scheme-format
msgid "the ath field is incorrect: ~s"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1260
+#: src/scm/webid-oidc/errors.scm:1251
msgid "the ath field is missing"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1262
+#: src/scm/webid-oidc/errors.scm:1253
#, scheme-format
msgid "~s is not an access token (because ~a)"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1265
+#: src/scm/webid-oidc/errors.scm:1256
#, scheme-format
msgid "~s is not an access token header (because ~a)"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1268
+#: src/scm/webid-oidc/errors.scm:1259
#, scheme-format
msgid "~s is not an access token payload (because ~a)"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1271
+#: src/scm/webid-oidc/errors.scm:1262
#, scheme-format
msgid "~s is not a DPoP proof (because ~a)"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1274
+#: src/scm/webid-oidc/errors.scm:1265
#, scheme-format
msgid "~s is not a DPoP proof header (because ~a)"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1277
+#: src/scm/webid-oidc/errors.scm:1268
#, scheme-format
msgid "~s is not a DPoP proof payload (because ~a)"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1280
+#: src/scm/webid-oidc/errors.scm:1271
#, scheme-format
msgid "I cannot fetch the issuer configuration of ~a (because ~a)"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1287
+#: src/scm/webid-oidc/errors.scm:1278
#, scheme-format
msgid "I cannot fetch the JWKS of ~a at ~a (because ~a)"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1298
+#: src/scm/webid-oidc/errors.scm:1289
#, scheme-format
msgid "the HTTP method is signed for ~s, but ~s was requested"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1301
+#: src/scm/webid-oidc/errors.scm:1292
#, scheme-format
msgid "the HTTP uri is signed for ~a, but ~a was requested"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1304
+#: 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 ""
-#: src/scm/webid-oidc/errors.scm:1308
+#: 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"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1317
+#: src/scm/webid-oidc/errors.scm:1308
#, scheme-format
msgid "the key ~s does not hash to ~a"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1319
+#: src/scm/webid-oidc/errors.scm:1310
#, scheme-format
msgid "the key confirmation of ~s failed (because ~a)"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1321
+#: src/scm/webid-oidc/errors.scm:1312
#, scheme-format
msgid "the key confirmation of ~s failed"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1326
+#: 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 ""
-#: src/scm/webid-oidc/errors.scm:1328
+#: src/scm/webid-oidc/errors.scm:1319
#, scheme-format
msgid "the DPoP proof should be bound to the access token ~s"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1331
+#: src/scm/webid-oidc/errors.scm:1322
#, scheme-format
msgid "the jti ~s has already been found (because ~a)"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1334
+#: src/scm/webid-oidc/errors.scm:1325
#, scheme-format
msgid "I cannot decode ~s as an access token (because ~a)"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1337
+#: src/scm/webid-oidc/errors.scm:1328
#, scheme-format
msgid "I cannot encode ~s as an access token with key ~s (because ~a)"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1340
+#: src/scm/webid-oidc/errors.scm:1331
#, scheme-format
msgid "I cannot decode ~s as a DPoP proof (because ~a)"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1343
+#: src/scm/webid-oidc/errors.scm:1334
#, scheme-format
msgid "I cannot encode ~s as a DPoP proof (because ~a)"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1346
+#: src/scm/webid-oidc/errors.scm:1337
#, scheme-format
msgid "I could not fetch a RDF graph at ~a (because ~a)"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1349
+#: src/scm/webid-oidc/errors.scm:1340
#, scheme-format
msgid "~s is not a client manifest (because ~a)"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1352
+#: src/scm/webid-oidc/errors.scm:1343
#, scheme-format
msgid "~s does not authorize redirection URI ~a"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1355
+#: src/scm/webid-oidc/errors.scm:1346
msgid "I cannot serve a public manifest"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1357
+#: src/scm/webid-oidc/errors.scm:1348
#, scheme-format
msgid "~a does not have a client manifest registration triple"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1360
+#: src/scm/webid-oidc/errors.scm:1351
#, scheme-format
msgid "the client manifest at ~a is advertised for ~a"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1363
+#: src/scm/webid-oidc/errors.scm:1354
#, scheme-format
msgid "I could not fetch the client manifest of ~a (because ~a)"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1366
+#: src/scm/webid-oidc/errors.scm:1357
#, scheme-format
msgid "~s is not an authorization code (because ~a)"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1369
+#: src/scm/webid-oidc/errors.scm:1360
#, scheme-format
msgid "~s is not an authorization code header (because ~a)"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1372
+#: src/scm/webid-oidc/errors.scm:1363
#, scheme-format
msgid "~s is not an authorization code payload (because ~a)"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1375
+#: src/scm/webid-oidc/errors.scm:1366
#, scheme-format
msgid "the current time is ~a, and the authorization code expired at ~a"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1379
+#: src/scm/webid-oidc/errors.scm:1370
#, scheme-format
msgid "I cannot decode ~s as an authorization code (because ~a)"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1382
+#: src/scm/webid-oidc/errors.scm:1373
#, scheme-format
msgid "I cannot encode ~s as an authorization code (because ~a)"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1385
+#: src/scm/webid-oidc/errors.scm:1376
#, scheme-format
msgid "there is no such refresh token as ~s"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1388
+#: src/scm/webid-oidc/errors.scm:1379
#, scheme-format
msgid ""
"the refresh token is bound to a key confirmed as ~s, but it is used with key "
"~s"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1391
+#: src/scm/webid-oidc/errors.scm:1382
#, scheme-format
msgid "I cannot decode ~s as an ID token (because ~a)"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1394
+#: src/scm/webid-oidc/errors.scm:1385
#, scheme-format
msgid "I cannot encode ~s as an ID token (because ~a)"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1397
+#: src/scm/webid-oidc/errors.scm:1388
#, scheme-format
msgid "the grant type ~s is not supported"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1400
+#: src/scm/webid-oidc/errors.scm:1391
msgid "there is no authorization code in the request"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1402
+#: src/scm/webid-oidc/errors.scm:1393
msgid "there is no refresh token in the request"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1404
+#: src/scm/webid-oidc/errors.scm:1395
#, scheme-format
msgid "~s is not an ID token (because ~a)"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1407
+#: src/scm/webid-oidc/errors.scm:1398
#, scheme-format
msgid "~s is not an ID token header (because ~a)"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1410
+#: src/scm/webid-oidc/errors.scm:1401
#, scheme-format
msgid "~s is not an ID token payload (because ~a)"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1413
+#: 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"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1416
+#: src/scm/webid-oidc/errors.scm:1407
#, scheme-format
msgid "~s does not admit ~s as an identity provider"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1419
+#: src/scm/webid-oidc/errors.scm:1410
#, scheme-format
msgid ""
"~a is neither an identity provider (because ~a) nor a webid (because ~a)"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1424
-#, scheme-format
-msgid "the token request failed (because ~a)"
-msgstr ""
-
-#: src/scm/webid-oidc/errors.scm:1427
+#: 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 ""
-#: src/scm/webid-oidc/errors.scm:1432
+#: src/scm/webid-oidc/errors.scm:1420
#, scheme-format
msgid "all identity provider candidates for ~a failed: ~a"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1436
+#: src/scm/webid-oidc/errors.scm:1424
#, scheme-format
msgid "~s failed (because ~a)"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1439
+#: src/scm/webid-oidc/errors.scm:1427
msgid ", "
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1441
+#: src/scm/webid-oidc/errors.scm:1429
#, scheme-format
msgid "no resource has been found to serve URI path ~s"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1444
+#: src/scm/webid-oidc/errors.scm:1432
#, scheme-format
msgid "the resource kind ~s is absent for the resource at ~s"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1447
+#: src/scm/webid-oidc/errors.scm:1435
#, scheme-format
msgid "no resource has been found to serve URI path ~s, but ~s exists"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1450
+#: src/scm/webid-oidc/errors.scm:1438
msgid "the root storage cannot be deleted"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1452
+#: src/scm/webid-oidc/errors.scm:1440
#, scheme-format
msgid "the container ~s should be emptied before being deleted"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1455
+#: src/scm/webid-oidc/errors.scm:1443
#, scheme-format
msgid "the group ~s cannot be fetched (because ~a)"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1459
+#: src/scm/webid-oidc/errors.scm:1447
#, scheme-format
msgid "the containment triples in the request to update ~s are not up to date"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1462
+#: src/scm/webid-oidc/errors.scm:1450
#, scheme-format
msgid "the server cannot process resources with the ~s content-type"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1465
+#: 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"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1468
+#: 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 ""
-#: src/scm/webid-oidc/errors.scm:1472
+#: src/scm/webid-oidc/errors.scm:1460
msgid "an anonymous user"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1477
+#: 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 ""
-#: src/scm/webid-oidc/errors.scm:1479
+#: 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 ""
-#: src/scm/webid-oidc/errors.scm:1482
+#: src/scm/webid-oidc/errors.scm:1470
#, 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 ""
-#: src/scm/webid-oidc/errors.scm:1489
+#: src/scm/webid-oidc/errors.scm:1477
msgid "that’s it"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1493
+#: src/scm/webid-oidc/errors.scm:1481
#, scheme-format
msgid "~a and ~a"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1496
+#: src/scm/webid-oidc/errors.scm:1484
#, scheme-format
msgid "~a, ~a"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1500
+#: src/scm/webid-oidc/errors.scm:1488
#, scheme-format
msgid "the signature ~a does not match key ~s with payload ~a"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1503
+#: src/scm/webid-oidc/errors.scm:1491
#, scheme-format
msgid "the request failed unexpectedly with code ~a: ~s"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1507
+#: src/scm/webid-oidc/errors.scm:1495
msgid "there is an undefined variable"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1509
+#: src/scm/webid-oidc/errors.scm:1497
#, scheme-format
msgid "the origin is ~a"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1512
+#: src/scm/webid-oidc/errors.scm:1500
#, scheme-format
msgid "a message is attached: ~a"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1515
+#: src/scm/webid-oidc/errors.scm:1503
#, scheme-format
msgid "the values ~s are problematic"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1518
+#: src/scm/webid-oidc/errors.scm:1506
#, scheme-format
msgid "there is a kind (~s) and args ~s"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1521
+#: src/scm/webid-oidc/errors.scm:1509
msgid "there is an assertion failure"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1523
+#: src/scm/webid-oidc/errors.scm:1511
#, scheme-format
msgid "the program quits with code ~a"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1526
+#: src/scm/webid-oidc/errors.scm:1514
msgid "the program cannot recover from this exception"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1528
+#: src/scm/webid-oidc/errors.scm:1516
msgid "there is an external error"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1530
+#: src/scm/webid-oidc/errors.scm:1518
msgid "there is an error"
msgstr ""
-#: src/scm/webid-oidc/errors.scm:1532
+#: src/scm/webid-oidc/errors.scm:1520
#, scheme-format
-msgid "Unhandled exception type ~a."
+msgid "there is an unknown exception of kind ~s"
msgstr ""
#: src/scm/webid-oidc/identity-provider.scm:68
@@ -958,18 +953,17 @@ msgid ""
"permissions."
msgstr ""
-#: src/scm/webid-oidc/resource-server.scm:85
+#: src/scm/webid-oidc/resource-server.scm:86
#, scheme-format
msgid "~a: authentication failure: ~a\n"
msgstr ""
-#: src/scm/webid-oidc/resource-server.scm:267
+#: src/scm/webid-oidc/resource-server.scm:279
#, scheme-format
msgid "Warning: ~a\n"
msgstr ""
-#: src/scm/webid-oidc/hello-world.scm:47 src/scm/webid-oidc/example-app.scm:116
-#: src/scm/webid-oidc/program.scm:233
+#: src/scm/webid-oidc/hello-world.scm:47 src/scm/webid-oidc/program.scm:233
msgid "command-line|version"
msgstr ""
@@ -1023,7 +1017,6 @@ msgid ""
msgstr ""
#: src/scm/webid-oidc/hello-world.scm:102
-#: src/scm/webid-oidc/example-app.scm:159
#, scheme-format
msgid "~a version ~a\n"
msgstr ""
@@ -1037,114 +1030,63 @@ msgstr ""
msgid "The port should be a number between 0 and 65535.\n"
msgstr ""
-#: src/scm/webid-oidc/example-app.scm:51
-#, scheme-format
-msgid "~a.\t~a, certified by ~a;\n"
+#: src/scm/webid-oidc/example-app.scm:63
+msgid "Main menu:\n"
msgstr ""
-#: src/scm/webid-oidc/example-app.scm:62
+#: src/scm/webid-oidc/example-app.scm:66
#, scheme-format
-msgid "~a – ~a\n"
+msgid "~a. Log in with ~a (issued by ~a): ~a\n"
msgstr ""
-#: src/scm/webid-oidc/example-app.scm:81
-#, scheme-format
-msgid "I’m expecting a number between ~a and ~a.\n"
+#: src/scm/webid-oidc/example-app.scm:71
+msgid "a new user"
msgstr ""
-#: src/scm/webid-oidc/example-app.scm:88
-msgid "Please enter an URI to GET: "
+#: src/scm/webid-oidc/example-app.scm:75
+msgid "status|currently logged in"
msgstr ""
-#: src/scm/webid-oidc/example-app.scm:107
-#, scheme-format
-msgid "Sending a request: ~s\n"
+#: src/scm/webid-oidc/example-app.scm:77
+msgid "status|offline (but accessible)"
msgstr ""
-#: src/scm/webid-oidc/example-app.scm:118
-msgid "comand-line|help"
+#: src/scm/webid-oidc/example-app.scm:78
+msgid "status|offline (inaccessible)"
msgstr ""
-#: src/scm/webid-oidc/example-app.scm:126
-#, scheme-format
-msgid ""
-"Usage: ~a [OPTIONS]...\n"
-"\n"
-"Demonstrate a webid-oidc application.\n"
-"\n"
-"Options:\n"
-" -h, --~a:\n"
-" display this help message and exit.\n"
-" -v, --~a:\n"
-" display the version information (~a) and exit.\n"
-"\n"
-"Environment variables:\n"
-"\n"
-" LANG: set the locale. Currently ~a.\n"
-"\n"
-" XDG_CACHE_HOME: where the seed for the key generator is\n"
-"stored. Currently ~a.\n"
-"\n"
-" XDG_DATA_HOME: where the login credentials are stored. Currently ~a.\n"
-"\n"
-" HOME: to compute a default value for XDG_CACHE_HOME and\n"
-"XDG_DATA_HOME, if missing. Currently ~a.\n"
-"\n"
-"If you find a bug, send a report to ~a.\n"
-msgstr ""
-
-#: src/scm/webid-oidc/example-app.scm:163
-msgid "First, let’s log in. Here are your options:\n"
+#: src/scm/webid-oidc/example-app.scm:79
+msgid "status|not initialized yet"
msgstr ""
-#: src/scm/webid-oidc/example-app.scm:165
-msgid "0.\tLog in with a different identity.\n"
-msgstr ""
-
-#: src/scm/webid-oidc/example-app.scm:170
-#: src/scm/webid-oidc/example-app.scm:189
-msgid "Please indicate your choice number: "
+#: 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"
msgstr ""
-#: src/scm/webid-oidc/example-app.scm:175
-msgid "Please enter your webid, or identity server: "
+#: src/scm/webid-oidc/example-app.scm:98
+#, scheme-format
+msgid "Please visit: ~a\n"
msgstr ""
-#: src/scm/webid-oidc/example-app.scm:185
-msgid "There are different possible identity providers for your webid:\n"
+#: src/scm/webid-oidc/example-app.scm:99
+msgid "Then, paste the authorization code you get:\n"
msgstr ""
-#: src/scm/webid-oidc/example-app.scm:192
+#: src/scm/webid-oidc/example-app.scm:105
#, scheme-format
-msgid ""
-"Please visit the following URI with a web browser:\n"
-"~a\n"
-msgstr ""
-
-#: src/scm/webid-oidc/example-app.scm:194
-msgid "Please paste your authorization code: "
+msgid "I could not negociate an access token. ~a"
msgstr ""
-#: src/scm/webid-oidc/example-app.scm:205
-#, scheme-format
+#: src/scm/webid-oidc/example-app.scm:109
msgid ""
-"Log in success. Keep this identity token for yourself:\n"
-"\n"
-"~a\n"
-"\n"
-"Now, you can do authenticated request by presenting the following access "
-"token:\n"
-"\n"
-"~a\n"
-"\n"
-"and signing DPoP proofs with the following key:\n"
-"\n"
-"~a\n"
+"The refresh token has expired, it is not possible to use that account "
+"offline.\n"
msgstr ""
-#: src/scm/webid-oidc/example-app.scm:226
-#, scheme-format
-msgid "There was an error: ~a\n"
+#: src/scm/webid-oidc/example-app.scm:114
+msgid "Please enter an URI to GET:\n"
msgstr ""
#: src/scm/webid-oidc/program.scm:125
diff --git a/po/fr.po b/po/fr.po
index 1f8d428..310c9a8 100644
--- a/po/fr.po
+++ b/po/fr.po
@@ -2,8 +2,8 @@ msgid ""
msgstr ""
"Project-Id-Version: webid-oidc 0.0.0\n"
"Report-Msgid-Bugs-To: vivien@planete-kraus.eu\n"
-"POT-Creation-Date: 2021-08-08 23:16+0200\n"
-"PO-Revision-Date: 2021-07-30 21:16+0200\n"
+"POT-Creation-Date: 2021-08-12 18:50+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"
"Language: fr\n"
@@ -126,101 +126,101 @@ 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:1090
+#: src/scm/webid-oidc/errors.scm:1081
msgid "that’s how it is"
msgstr "c’est comme ça"
-#: src/scm/webid-oidc/errors.scm:1095
+#: 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:1098
+#: 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:1101
+#: 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:1104
+#: 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:1109
+#: 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:1111
+#: 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:1116
+#: 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:1118
+#: 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:1123
+#: 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:1125
+#: 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:1130
+#: 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:1132
+#: 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:1135
+#: 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/errors.scm:1138
+#: 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/errors.scm:1141
+#: 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/errors.scm:1144
+#: 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/errors.scm:1147
+#: 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/errors.scm:1150
+#: 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/errors.scm:1153
+#: src/scm/webid-oidc/errors.scm:1144
#, scheme-format
msgid ""
"all key candidates failed to verify signature ~s with algorithm ~s and "
@@ -229,17 +229,17 @@ msgstr ""
"aucune clé candidate n’a pu vérifier la signature ~s avec l’algorithme ~s et "
"le contenu ~a (il y en avait ~a : ~s)"
-#: src/scm/webid-oidc/errors.scm:1156
+#: 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:1159
+#: src/scm/webid-oidc/errors.scm:1150
#, 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:1162
+#: src/scm/webid-oidc/errors.scm:1153
#, scheme-format
msgid ""
"the server request unexpectedly failed with code ~a and reason phrase ~s"
@@ -247,357 +247,357 @@ 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:1167
+#: src/scm/webid-oidc/errors.scm:1158
#, 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:1169
+#: 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:1172
+#: 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)"
-#: src/scm/webid-oidc/errors.scm:1178
+#: src/scm/webid-oidc/errors.scm:1169
#, scheme-format
msgid "the value ~s is not an OIDC configuration (because ~a)"
msgstr "la valeur ~s n’est pas une configuration OIDC (parce que ~a)"
-#: src/scm/webid-oidc/errors.scm:1183
+#: 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/errors.scm:1184
+#: src/scm/webid-oidc/errors.scm:1175
msgid "the webid field is missing"
msgstr "le champ webid est manquant"
-#: src/scm/webid-oidc/errors.scm:1188
+#: src/scm/webid-oidc/errors.scm:1179
#, scheme-format
msgid "the sub field is incorrect: ~s"
msgstr "le champ sub est incorrect : ~s"
-#: src/scm/webid-oidc/errors.scm:1189
+#: src/scm/webid-oidc/errors.scm:1180
msgid "the sub field is missing"
msgstr "le champ sub est manquant"
-#: src/scm/webid-oidc/errors.scm:1193
+#: src/scm/webid-oidc/errors.scm:1184
#, scheme-format
msgid "the iss field is incorrect: ~s"
msgstr "le champ iss est incorrect : ~s"
-#: src/scm/webid-oidc/errors.scm:1194
+#: src/scm/webid-oidc/errors.scm:1185
msgid "the iss field is missing"
msgstr "le champ iss est manquant"
-#: src/scm/webid-oidc/errors.scm:1198
+#: 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/errors.scm:1199
+#: src/scm/webid-oidc/errors.scm:1190
msgid "the aud field is missing"
msgstr "le champ aud est manquant"
-#: src/scm/webid-oidc/errors.scm:1203
+#: src/scm/webid-oidc/errors.scm:1194
#, scheme-format
msgid "the iat field is incorrect: ~s"
msgstr "le champ iat est incorrect : ~s"
-#: src/scm/webid-oidc/errors.scm:1204
+#: src/scm/webid-oidc/errors.scm:1195
msgid "the iat field is missing"
msgstr "le champ iat est manquant"
-#: src/scm/webid-oidc/errors.scm:1208
+#: 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/errors.scm:1209
+#: src/scm/webid-oidc/errors.scm:1200
msgid "the exp field is missing"
msgstr "le champ exp est manquant"
-#: src/scm/webid-oidc/errors.scm:1213
+#: src/scm/webid-oidc/errors.scm:1204
#, scheme-format
msgid "the cnf/jkt field is incorrect: ~s"
msgstr "le champ cnf/jkt est incorrect : ~s"
-#: src/scm/webid-oidc/errors.scm:1214
+#: src/scm/webid-oidc/errors.scm:1205
msgid "the cnf/jkt field is missing"
msgstr "le champ cnf/jkt est manquant"
-#: src/scm/webid-oidc/errors.scm:1218
+#: 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/errors.scm:1219
+#: 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/errors.scm:1223
+#: 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/errors.scm:1224
+#: 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/errors.scm:1228
+#: 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/errors.scm:1229
+#: src/scm/webid-oidc/errors.scm:1220
msgid "the typ field is missing"
msgstr "le champ typ est manquant"
-#: src/scm/webid-oidc/errors.scm:1233
+#: src/scm/webid-oidc/errors.scm:1224
#, 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:1235
+#: src/scm/webid-oidc/errors.scm:1226
msgid "the jwk field is missing"
msgstr "le champ jwk est manquant"
-#: src/scm/webid-oidc/errors.scm:1239
+#: 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/errors.scm:1240
+#: src/scm/webid-oidc/errors.scm:1231
msgid "the jti field is missing"
msgstr "le champ jti est manquant"
-#: src/scm/webid-oidc/errors.scm:1244
+#: src/scm/webid-oidc/errors.scm:1235
#, scheme-format
msgid "the nonce field is incorrect: ~s"
msgstr "le champ nonce est incorrect : ~s"
-#: src/scm/webid-oidc/errors.scm:1245
+#: src/scm/webid-oidc/errors.scm:1236
msgid "the nonce field is missing"
msgstr "le champ nonce est manquant"
-#: src/scm/webid-oidc/errors.scm:1249
+#: 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/errors.scm:1250
+#: src/scm/webid-oidc/errors.scm:1241
msgid "the htm field is missing"
msgstr "le champ htm est manquant"
-#: src/scm/webid-oidc/errors.scm:1254
+#: 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/errors.scm:1255
+#: src/scm/webid-oidc/errors.scm:1246
msgid "the htu field is missing"
msgstr "le champ htu est manquant"
-#: src/scm/webid-oidc/errors.scm:1259
+#: src/scm/webid-oidc/errors.scm:1250
#, scheme-format
msgid "the ath field is incorrect: ~s"
msgstr "le champ ath est incorrect : ~s"
-#: src/scm/webid-oidc/errors.scm:1260
+#: src/scm/webid-oidc/errors.scm:1251
msgid "the ath field is missing"
msgstr "le champ ath est manquant"
-#: src/scm/webid-oidc/errors.scm:1262
+#: 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/errors.scm:1265
+#: 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/errors.scm:1268
+#: 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/errors.scm:1271
+#: 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/errors.scm:1274
+#: 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/errors.scm:1277
+#: 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/errors.scm:1280
+#: src/scm/webid-oidc/errors.scm:1271
#, scheme-format
msgid "I cannot fetch the issuer configuration of ~a (because ~a)"
msgstr ""
"je n’ai pas pu récupérer la configuration de l’émetteur ~a (parce que ~a)"
-#: src/scm/webid-oidc/errors.scm:1287
+#: 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:1298
+#: 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:1301
+#: 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:1304
+#: 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:1308
+#: 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"
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:1317
+#: 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:1319
+#: 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)"
-#: src/scm/webid-oidc/errors.scm:1321
+#: 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/errors.scm:1326
+#: 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/errors.scm:1328
+#: src/scm/webid-oidc/errors.scm:1319
#, 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"
-#: src/scm/webid-oidc/errors.scm:1331
+#: 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/errors.scm:1334
+#: src/scm/webid-oidc/errors.scm:1325
#, scheme-format
msgid "I cannot decode ~s as an access token (because ~a)"
msgstr "je n’ai pas pu décoder ~s comme jeton d’accès (parce que ~a)"
-#: src/scm/webid-oidc/errors.scm:1337
+#: src/scm/webid-oidc/errors.scm:1328
#, scheme-format
msgid "I cannot encode ~s as an access token with key ~s (because ~a)"
msgstr ""
"je n’ai pas pu encoder ~s comme un jeton d’accès avec la clé ~s (parce que "
"~a)"
-#: src/scm/webid-oidc/errors.scm:1340
+#: src/scm/webid-oidc/errors.scm:1331
#, scheme-format
msgid "I cannot decode ~s as a DPoP proof (because ~a)"
msgstr "je n’ai pas pu décoder ~s comme preuve DPoP (parce que ~a)"
-#: src/scm/webid-oidc/errors.scm:1343
+#: 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/errors.scm:1346
+#: src/scm/webid-oidc/errors.scm:1337
#, 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)"
-#: src/scm/webid-oidc/errors.scm:1349
+#: 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/errors.scm:1352
+#: 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/errors.scm:1355
+#: 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/errors.scm:1357
+#: src/scm/webid-oidc/errors.scm:1348
#, scheme-format
msgid "~a does not have a client manifest registration triple"
msgstr "~a n’a pas de triplet d’enregistrement de manifeste client"
-#: src/scm/webid-oidc/errors.scm:1360
+#: 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/errors.scm:1363
+#: src/scm/webid-oidc/errors.scm:1354
#, 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)"
-#: src/scm/webid-oidc/errors.scm:1366
+#: src/scm/webid-oidc/errors.scm:1357
#, scheme-format
msgid "~s is not an authorization code (because ~a)"
msgstr "~s n’est pas un code d’autorisation (parce que ~a)"
-#: src/scm/webid-oidc/errors.scm:1369
+#: src/scm/webid-oidc/errors.scm:1360
#, 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)"
-#: src/scm/webid-oidc/errors.scm:1372
+#: 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/errors.scm:1375
+#: src/scm/webid-oidc/errors.scm:1366
#, 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"
-#: src/scm/webid-oidc/errors.scm:1379
+#: 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/errors.scm:1382
+#: 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/errors.scm:1385
+#: 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/errors.scm:1388
+#: src/scm/webid-oidc/errors.scm:1379
#, scheme-format
msgid ""
"the refresh token is bound to a key confirmed as ~s, but it is used with key "
@@ -606,45 +606,45 @@ 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:1391
+#: 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:1394
+#: 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/errors.scm:1397
+#: src/scm/webid-oidc/errors.scm:1388
#, 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:1400
+#: 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"
-#: src/scm/webid-oidc/errors.scm:1402
+#: 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/errors.scm:1404
+#: 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/errors.scm:1407
+#: 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/errors.scm:1410
+#: 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/errors.scm:1413
+#: 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"
@@ -652,12 +652,12 @@ 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:1416
+#: 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/errors.scm:1419
+#: src/scm/webid-oidc/errors.scm:1410
#, scheme-format
msgid ""
"~a is neither an identity provider (because ~a) nor a webid (because ~a)"
@@ -665,76 +665,71 @@ msgstr ""
"~a n’est ni un fournisseur d’identité (parce que ~a) ni un webid (parce que "
"~a)"
-#: src/scm/webid-oidc/errors.scm:1424
-#, scheme-format
-msgid "the token request failed (because ~a)"
-msgstr "la requête de jeton a échoué (parce que ~a)"
-
-#: src/scm/webid-oidc/errors.scm:1427
+#: 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/errors.scm:1432
+#: src/scm/webid-oidc/errors.scm:1420
#, scheme-format
msgid "all identity provider candidates for ~a failed: ~a"
msgstr "tous les candidats de fournisseurs d’identité pour ~a ont échoué : ~a"
-#: src/scm/webid-oidc/errors.scm:1436
+#: 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/errors.scm:1439
+#: src/scm/webid-oidc/errors.scm:1427
msgid ", "
msgstr ", "
-#: src/scm/webid-oidc/errors.scm:1441
+#: 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/errors.scm:1444
+#: 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/errors.scm:1447
+#: 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/errors.scm:1450
+#: 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/errors.scm:1452
+#: 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/errors.scm:1455
+#: 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/errors.scm:1459
+#: src/scm/webid-oidc/errors.scm:1447
#, 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"
-#: src/scm/webid-oidc/errors.scm:1462
+#: src/scm/webid-oidc/errors.scm:1450
#, scheme-format
msgid "the server cannot process resources with the ~s content-type"
msgstr ""
"le serveur ne peut pas traiter des ressources avec le type de contenu ~s"
-#: src/scm/webid-oidc/errors.scm:1465
+#: src/scm/webid-oidc/errors.scm:1453
#, scheme-format
msgid ""
"the client wants to create a resource at ~s, which is reserved for an "
@@ -743,7 +738,7 @@ 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:1468
+#: 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 "
@@ -752,11 +747,11 @@ 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/errors.scm:1472
+#: src/scm/webid-oidc/errors.scm:1460
msgid "an anonymous user"
msgstr "un utilisateur anonyme"
-#: src/scm/webid-oidc/errors.scm:1477
+#: src/scm/webid-oidc/errors.scm:1465
#, scheme-format
msgid ""
"the client precondition failed for ~s: it allows for ~s, forbids ~s, but the "
@@ -765,7 +760,7 @@ 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/errors.scm:1479
+#: src/scm/webid-oidc/errors.scm:1467
#, scheme-format
msgid ""
"the client precondition failed for ~s: it allows for ~s, forbids ~s, but the "
@@ -774,7 +769,7 @@ 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/errors.scm:1482
+#: src/scm/webid-oidc/errors.scm:1470
#, scheme-format
msgid ""
"the client wanted a response with a content type among ~s, but the resource "
@@ -784,80 +779,80 @@ msgstr ""
"ressource ~s a un type de contenu ~s qui ne peut pas être converti vers l’un "
"d’eux"
-#: src/scm/webid-oidc/errors.scm:1489
+#: src/scm/webid-oidc/errors.scm:1477
msgid "that’s it"
msgstr "c’est tout"
-#: src/scm/webid-oidc/errors.scm:1493
+#: src/scm/webid-oidc/errors.scm:1481
#, scheme-format
msgid "~a and ~a"
msgstr "~a et ~a"
-#: src/scm/webid-oidc/errors.scm:1496
+#: src/scm/webid-oidc/errors.scm:1484
#, scheme-format
msgid "~a, ~a"
msgstr "~a, ~a"
-#: src/scm/webid-oidc/errors.scm:1500
+#: 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/errors.scm:1503
+#: src/scm/webid-oidc/errors.scm:1491
#, scheme-format
msgid "the request failed unexpectedly with code ~a: ~s"
msgstr ""
"la requête au serveur a échoué de façon inattendue avec un code ~a : ~s"
-#: src/scm/webid-oidc/errors.scm:1507
+#: 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:1509
+#: 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:1512
+#: 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:1515
+#: 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:1518
+#: 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:1521
+#: 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:1523
+#: 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:1526
+#: 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/errors.scm:1528
+#: src/scm/webid-oidc/errors.scm:1516
msgid "there is an external error"
msgstr "il y a une erreur externe"
-#: src/scm/webid-oidc/errors.scm:1530
+#: src/scm/webid-oidc/errors.scm:1518
msgid "there is an error"
msgstr "il y a une erreur"
-#: src/scm/webid-oidc/errors.scm:1532
+#: src/scm/webid-oidc/errors.scm:1520
#, scheme-format
-msgid "Unhandled exception type ~a."
-msgstr "Type d’exception non pris en charge ~a."
+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."
@@ -1001,18 +996,17 @@ 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:85
+#: 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/resource-server.scm:267
+#: src/scm/webid-oidc/resource-server.scm:279
#, scheme-format
msgid "Warning: ~a\n"
msgstr "Avertissement : ~a\n"
-#: src/scm/webid-oidc/hello-world.scm:47 src/scm/webid-oidc/example-app.scm:116
-#: src/scm/webid-oidc/program.scm:233
+#: src/scm/webid-oidc/hello-world.scm:47 src/scm/webid-oidc/program.scm:233
msgid "command-line|version"
msgstr "version"
@@ -1091,7 +1085,6 @@ msgstr ""
" redirige la sortie d’erreur du programme vers ce fichier.\n"
#: src/scm/webid-oidc/hello-world.scm:102
-#: src/scm/webid-oidc/example-app.scm:159
#, scheme-format
msgid "~a version ~a\n"
msgstr "~a version ~a\n"
@@ -1107,156 +1100,68 @@ msgstr ""
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:51
-#, scheme-format
-msgid "~a.\t~a, certified by ~a;\n"
-msgstr "~a.\t~a, certifié par ~a ;\n"
+#: src/scm/webid-oidc/example-app.scm:63
+msgid "Main menu:\n"
+msgstr "Menu principal :\n"
-#: src/scm/webid-oidc/example-app.scm:62
+#: src/scm/webid-oidc/example-app.scm:66
#, scheme-format
-msgid "~a – ~a\n"
-msgstr "~a – ~a\n"
+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/example-app.scm:81
-#, scheme-format
-msgid "I’m expecting a number between ~a and ~a.\n"
-msgstr "J’attends un nombre entre ~a et ~a.\n"
+#: src/scm/webid-oidc/example-app.scm:71
+msgid "a new user"
+msgstr "un nouvel utilisateur"
-#: src/scm/webid-oidc/example-app.scm:88
-msgid "Please enter an URI to GET: "
-msgstr "Veuillez entrer un URI à requêter avec GET :"
+#: src/scm/webid-oidc/example-app.scm:75
+msgid "status|currently logged in"
+msgstr "actuellement connecté"
-#: src/scm/webid-oidc/example-app.scm:107
-#, scheme-format
-msgid "Sending a request: ~s\n"
-msgstr "Envoi d’une requête : ~s\n"
+#: src/scm/webid-oidc/example-app.scm:77
+msgid "status|offline (but accessible)"
+msgstr "hors ligne (mais accessible)"
-#: src/scm/webid-oidc/example-app.scm:118
-msgid "comand-line|help"
-msgstr "aide"
+#: src/scm/webid-oidc/example-app.scm:78
+msgid "status|offline (inaccessible)"
+msgstr "hors ligne (inaccessible)"
-#: src/scm/webid-oidc/example-app.scm:126
-#, scheme-format
-msgid ""
-"Usage: ~a [OPTIONS]...\n"
-"\n"
-"Demonstrate a webid-oidc application.\n"
-"\n"
-"Options:\n"
-" -h, --~a:\n"
-" display this help message and exit.\n"
-" -v, --~a:\n"
-" display the version information (~a) and exit.\n"
-"\n"
-"Environment variables:\n"
-"\n"
-" LANG: set the locale. Currently ~a.\n"
-"\n"
-" XDG_CACHE_HOME: where the seed for the key generator is\n"
-"stored. Currently ~a.\n"
-"\n"
-" XDG_DATA_HOME: where the login credentials are stored. Currently ~a.\n"
-"\n"
-" HOME: to compute a default value for XDG_CACHE_HOME and\n"
-"XDG_DATA_HOME, if missing. Currently ~a.\n"
-"\n"
-"If you find a bug, send a report to ~a.\n"
-msgstr ""
-"Utilisation : ~a [OPTIONS]...\n"
-"\n"
-"Fait démonstration d’une application webid-oidc.\n"
-"\n"
-"Options :\n"
-" -h, --~a :\n"
-" affiche ce message d’aide et quitte.\n"
-" -v, --~a :\n"
-" affiche le numéro de version (~a) et quitte.\n"
-"\n"
-"Variables d’environnement :\n"
-"\n"
-" LANG : définit la locale. Actuellement ~a.\n"
-"\n"
-" XDG_CACHE_HOME : où stocker la graine aléatoire du générateur de\n"
-"clé. Actuellement ~a.\n"
-"\n"
-" XDG_DATA_HOME : où les données d’authentification sont\n"
-"stockées. Actuellement ~a.\n"
-"\n"
-" HOME : pour calculer une valeur par défaut de XDG_CACHE_HOME et\n"
-"XDG_DATA_HOME, si manquant. Actuellement ~a.\n"
-"\n"
-"Si vous trouvez une erreur dans le programme, envoyez-en un rapport à\n"
-"~a.\n"
+#: src/scm/webid-oidc/example-app.scm:79
+msgid "status|not initialized yet"
+msgstr "pas encore initialisé"
-#: src/scm/webid-oidc/example-app.scm:163
-msgid "First, let’s log in. Here are your options:\n"
-msgstr "En premier lieu, authentifions-nous. Voici vos options :\n"
-
-#: src/scm/webid-oidc/example-app.scm:165
-msgid "0.\tLog in with a different identity.\n"
-msgstr "0.\tS’authentifier avec une identité différente.\n"
-
-#: src/scm/webid-oidc/example-app.scm:170
-#: src/scm/webid-oidc/example-app.scm:189
-msgid "Please indicate your choice number: "
-msgstr "Veuillez indiquer votre choix de numéro : "
-
-#: src/scm/webid-oidc/example-app.scm:175
-msgid "Please enter your webid, or identity server: "
-msgstr "Veuillez entrer votre webid, ou serveur d’identité : "
-
-#: src/scm/webid-oidc/example-app.scm:185
-msgid "There are different possible identity providers for your webid:\n"
+#: 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"
msgstr ""
-"Il y a différents fournisseurs d’identité possibles pour votre\n"
-"webid :\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/example-app.scm:192
+#: src/scm/webid-oidc/example-app.scm:98
#, scheme-format
-msgid ""
-"Please visit the following URI with a web browser:\n"
-"~a\n"
-msgstr ""
-"Veuillez accéder à cet URI avec un navigateur web :\n"
-"~a\n"
+msgid "Please visit: ~a\n"
+msgstr "Veuillez visiter : ~a\n"
-#: src/scm/webid-oidc/example-app.scm:194
-msgid "Please paste your authorization code: "
-msgstr "Veuillez coller votre code d’autorisation : "
+#: 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/example-app.scm:205
+#: src/scm/webid-oidc/example-app.scm:105
#, 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"
+
+#: src/scm/webid-oidc/example-app.scm:109
msgid ""
-"Log in success. Keep this identity token for yourself:\n"
-"\n"
-"~a\n"
-"\n"
-"Now, you can do authenticated request by presenting the following access "
-"token:\n"
-"\n"
-"~a\n"
-"\n"
-"and signing DPoP proofs with the following key:\n"
-"\n"
-"~a\n"
+"The refresh token has expired, it is not possible to use that account "
+"offline.\n"
msgstr ""
-"Authentification réussie. Gardez ce jeton d’identité pour vous :\n"
-"\n"
-"~a\n"
-"\n"
-"À partir de maintenant, vous pouvez effectuer des requêtes\n"
-"authentifiées en présentant le jeton d’accès suivant :\n"
-"\n"
-"~a\n"
-"\n"
-"et en signant les preuves DPoP avec la clé suivante :\n"
-"\n"
-"~a\n"
+"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:226
-#, scheme-format
-msgid "There was an error: ~a\n"
-msgstr "Il y a eu une erreur : ~a\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/program.scm:125
#, scheme-format
@@ -2191,6 +2096,142 @@ msgid "Unknown command ~s\n"
msgstr "Commande inconnue ~s\n"
#, scheme-format
+#~ msgid "the token request failed (because ~a)"
+#~ msgstr "la requête de jeton a échoué (parce que ~a)"
+
+#, scheme-format
+#~ msgid "Unhandled exception type ~a."
+#~ msgstr "Type d’exception non pris en charge ~a."
+
+#, scheme-format
+#~ msgid "~a.\t~a, certified by ~a;\n"
+#~ msgstr "~a.\t~a, certifié par ~a ;\n"
+
+#, scheme-format
+#~ msgid "~a – ~a\n"
+#~ msgstr "~a – ~a\n"
+
+#, scheme-format
+#~ msgid "I’m expecting a number between ~a and ~a.\n"
+#~ msgstr "J’attends un nombre entre ~a et ~a.\n"
+
+#, scheme-format
+#~ msgid "Sending a request: ~s\n"
+#~ msgstr "Envoi d’une requête : ~s\n"
+
+#~ msgid "comand-line|help"
+#~ msgstr "aide"
+
+#, scheme-format
+#~ msgid ""
+#~ "Usage: ~a [OPTIONS]...\n"
+#~ "\n"
+#~ "Demonstrate a webid-oidc application.\n"
+#~ "\n"
+#~ "Options:\n"
+#~ " -h, --~a:\n"
+#~ " display this help message and exit.\n"
+#~ " -v, --~a:\n"
+#~ " display the version information (~a) and exit.\n"
+#~ "\n"
+#~ "Environment variables:\n"
+#~ "\n"
+#~ " LANG: set the locale. Currently ~a.\n"
+#~ "\n"
+#~ " XDG_CACHE_HOME: where the seed for the key generator is\n"
+#~ "stored. Currently ~a.\n"
+#~ "\n"
+#~ " XDG_DATA_HOME: where the login credentials are stored. Currently ~a.\n"
+#~ "\n"
+#~ " HOME: to compute a default value for XDG_CACHE_HOME and\n"
+#~ "XDG_DATA_HOME, if missing. Currently ~a.\n"
+#~ "\n"
+#~ "If you find a bug, send a report to ~a.\n"
+#~ msgstr ""
+#~ "Utilisation : ~a [OPTIONS]...\n"
+#~ "\n"
+#~ "Fait démonstration d’une application webid-oidc.\n"
+#~ "\n"
+#~ "Options :\n"
+#~ " -h, --~a :\n"
+#~ " affiche ce message d’aide et quitte.\n"
+#~ " -v, --~a :\n"
+#~ " affiche le numéro de version (~a) et quitte.\n"
+#~ "\n"
+#~ "Variables d’environnement :\n"
+#~ "\n"
+#~ " LANG : définit la locale. Actuellement ~a.\n"
+#~ "\n"
+#~ " XDG_CACHE_HOME : où stocker la graine aléatoire du générateur de\n"
+#~ "clé. Actuellement ~a.\n"
+#~ "\n"
+#~ " XDG_DATA_HOME : où les données d’authentification sont\n"
+#~ "stockées. Actuellement ~a.\n"
+#~ "\n"
+#~ " HOME : pour calculer une valeur par défaut de XDG_CACHE_HOME et\n"
+#~ "XDG_DATA_HOME, si manquant. Actuellement ~a.\n"
+#~ "\n"
+#~ "Si vous trouvez une erreur dans le programme, envoyez-en un rapport à\n"
+#~ "~a.\n"
+
+#~ msgid "First, let’s log in. Here are your options:\n"
+#~ msgstr "En premier lieu, authentifions-nous. Voici vos options :\n"
+
+#~ msgid "0.\tLog in with a different identity.\n"
+#~ msgstr "0.\tS’authentifier avec une identité différente.\n"
+
+#~ msgid "Please indicate your choice number: "
+#~ msgstr "Veuillez indiquer votre choix de numéro : "
+
+#~ 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"
+#~ "~a\n"
+#~ msgstr ""
+#~ "Veuillez accéder à cet URI avec un navigateur web :\n"
+#~ "~a\n"
+
+#, scheme-format
+#~ msgid ""
+#~ "Log in success. Keep this identity token for yourself:\n"
+#~ "\n"
+#~ "~a\n"
+#~ "\n"
+#~ "Now, you can do authenticated request by presenting the following access "
+#~ "token:\n"
+#~ "\n"
+#~ "~a\n"
+#~ "\n"
+#~ "and signing DPoP proofs with the following key:\n"
+#~ "\n"
+#~ "~a\n"
+#~ msgstr ""
+#~ "Authentification réussie. Gardez ce jeton d’identité pour vous :\n"
+#~ "\n"
+#~ "~a\n"
+#~ "\n"
+#~ "À partir de maintenant, vous pouvez effectuer des requêtes\n"
+#~ "authentifiées en présentant le jeton d’accès suivant :\n"
+#~ "\n"
+#~ "~a\n"
+#~ "\n"
+#~ "et en signant les preuves DPoP avec la clé suivante :\n"
+#~ "\n"
+#~ "~a\n"
+
+#, scheme-format
+#~ msgid "There was an error: ~a\n"
+#~ msgstr "Il y a eu une erreur : ~a\n"
+
+#, scheme-format
#~ msgid ""
#~ "\n"
#~ " It is currently set to ~s.\n"
diff --git a/src/Makefile.am b/src/Makefile.am
index f30840e..38e458d 100644
--- a/src/Makefile.am
+++ b/src/Makefile.am
@@ -36,6 +36,9 @@ serverwebidoidcgodir = $(webidoidcgodir)/server
resourceserverwebidoidcmoddir = $(serverwebidoidcmoddir)/resource
resourceserverwebidoidcgodir = $(serverwebidoidcgodir)/resource
+clientwebidoidcmoddir = $(webidoidcmoddir)/client
+clientwebidoidcgodir = $(webidoidcgodir)/client
+
dist_mod_DATA =
mod_DATA =
go_DATA =
@@ -47,6 +50,9 @@ webidoidcgo_DATA =
dist_serverwebidoidcmod_DATA =
serverwebidoidcgo_DATA =
+dist_clientwebidoidcmod_DATA =
+clientwebidoidcgo_DATA =
+
dist_resourceserverwebidoidcmod_DATA =
resourceserverwebidoidcgo_DATA =
@@ -63,14 +69,14 @@ include %reldir%/inst/Makefile.am
include %reldir%/scm/Makefile.am
CLEANFILES += $(go_DATA) $(webidoidcgo_DATA) $(mod_DATA) $(webidoidcmod_DATA) \
- $(serverwebidoidcgo_DATA) $(resourceserverwebidoidcgo_DATA)
+ $(serverwebidoidcgo_DATA) $(clientwebidoidcgo_DATA) $(resourceserverwebidoidcgo_DATA)
%canon_reldir%_libwebidoidc_la_SOURCES = %reldir%/gettext.h %reldir%/libwebidoidc.c %reldir%/utilities.h
%canon_reldir%_libwebidoidc_la_LIBADD = $(noinst_LTLIBRARIES) $(GUILE_LIBS) $(NETTLE_LIBS)
INDENTED += $(%canon_reldir%_libwebidoidc_la_SOURCES)
-$(go_DATA) $(webidoidcgo_DATA) $(serverwebidoidcgo_DATA) $(resourceserverwebidoidcgo_DATA): %reldir%/libwebidoidc.la
+$(go_DATA) $(webidoidcgo_DATA) $(serverwebidoidcgo_DATA) $(clientwebidoidcgo_DATA) $(resourceserverwebidoidcgo_DATA): %reldir%/libwebidoidc.la
SUFFIXES += .c .x .scm .go
.c.x:
diff --git a/src/scm/webid-oidc/Makefile.am b/src/scm/webid-oidc/Makefile.am
index 4db767f..57c3930 100644
--- a/src/scm/webid-oidc/Makefile.am
+++ b/src/scm/webid-oidc/Makefile.am
@@ -89,3 +89,4 @@ webidoidcgo_DATA += \
EXTRA_DIST += %reldir%/ChangeLog
include %reldir%/server/Makefile.am
+include %reldir%/client/Makefile.am
diff --git a/src/scm/webid-oidc/client.scm b/src/scm/webid-oidc/client.scm
index 67928db..4fdb824 100644
--- a/src/scm/webid-oidc/client.scm
+++ b/src/scm/webid-oidc/client.scm
@@ -24,6 +24,7 @@
#:use-module ((webid-oidc parameters) #:prefix p:)
#:use-module ((webid-oidc stubs) #:prefix stubs:)
#:use-module ((webid-oidc config) #:prefix cfg:)
+ #:use-module ((webid-oidc client accounts) #:prefix client:)
#:use-module (web uri)
#:use-module (web client)
#:use-module (web request)
@@ -32,434 +33,154 @@
#:use-module (web http)
#:use-module (ice-9 optargs)
#:use-module (ice-9 receive)
+ #:use-module (srfi srfi-9)
#:use-module (srfi srfi-19)
+ #:use-module (srfi srfi-26)
#:use-module (rnrs bytevectors)
#:use-module (ice-9 i18n)
#:use-module (ice-9 getopt-long)
#:use-module (ice-9 suspendable-ports)
- #:use-module (sxml simple))
+ #:use-module (ice-9 match)
+ #:use-module (sxml simple)
+ #:export
+ (
+ <client>
+ make-client
+ client?
+ client-id
+ client-key
+ client-redirect-uri
-(define*-public (authorize host-or-webid
- #:key
- (client-id #f)
- (redirect-uri #f)
- (state #f)
- (http-get http-get))
- (define cannot-be-webid #f)
- (define candidate-errors '())
- ;; host-or-webid can be: the host (as a string), an URI (as a string
- ;; or an URI). 3 differents things.
- (when (string? host-or-webid)
- ;; If it’s a string, it can be either a host name or a URI.
- (set! host-or-webid
- (catch #t
- (lambda ()
- (let ((urified (string->uri host-or-webid)))
- (if urified
- urified
- (error "It’s not a string representing an URI."))))
- (lambda error
- (build-uri 'https #:host host-or-webid)))))
- ;; client-id and redirect-uri are required, state must be a string.
- (when (string? client-id)
- (set! client-id (string->uri client-id)))
- (when (string? redirect-uri)
- (set! redirect-uri (string->uri redirect-uri)))
- (let ((host-candidates
- (with-exception-handler
- (lambda (why-not-webid)
- ;; try as an identity provider
- (set! cannot-be-webid why-not-webid)
- (build-uri 'https
- #:userinfo (uri-userinfo host-or-webid)
- #:host (uri-host host-or-webid)
- #:port (uri-port host-or-webid)))
- (lambda ()
- (get-provider-confirmations host-or-webid #:http-get http-get))
- #:unwind? #t)))
- (let ((configurations
- (if cannot-be-webid
- (with-exception-handler
- (lambda (why-not-identity-provider)
- (raise-neither-identity-provider-nor-webid
- host-or-webid
- why-not-identity-provider
- cannot-be-webid))
- (lambda ()
- (cons (uri->string host-candidates)
- (get-oidc-configuration (uri-host host-candidates)
- #:userinfo (uri-userinfo host-candidates)
- #:port (uri-port host-candidates)
- #:http-get http-get))))
- (filter
- (lambda (cfg) cfg)
- (map
- (lambda (host)
- (with-exception-handler
- (lambda (cause)
- (set! candidate-errors (acons host cause candidate-errors))
- #f)
- (lambda ()
- (cons (uri->string host)
- (get-oidc-configuration (uri-host host)
- #:userinfo (uri-userinfo host)
- #:port (uri-port host)
- #:http-get http-get)))
- #:unwind? #t))
- host-candidates)))))
- (let ((authorization-endpoints
- (if cannot-be-webid
- (with-exception-handler
- (lambda (why-not-identity-provider)
- (raise-neither-identity-provider-nor-webid
- host-or-webid
- why-not-identity-provider
- cannot-be-webid))
- (lambda ()
- (let ((host (car configurations))
- (cfg (cdr configurations)))
- (cons host (oidc-configuration-authorization-endpoint cfg)))))
- (map
- (lambda (host/cfg)
- (let ((host (car host/cfg))
- (cfg (cdr host/cfg)))
- (with-exception-handler
- (lambda (cause)
- (set! candidate-errors (acons (string->uri host) cause
- candidate-errors)))
- (lambda ()
- (cons host
- (oidc-configuration-authorization-endpoint cfg)))
- #:unwind? #t)))
- configurations))))
- (if cannot-be-webid
- (let ((host (car authorization-endpoints))
- (authz (cdr authorization-endpoints)))
- (list
- (cons
- host
- (build-uri (uri-scheme authz)
- #:userinfo (uri-userinfo authz)
- #:host (uri-host authz)
- #:port (uri-port authz)
- #:path (uri-path authz)
- #:query (format #f "client_id=~a&redirect_uri=~a~a"
- (uri-encode (uri->string client-id))
- (uri-encode (uri->string redirect-uri))
- (if state
- (format #f "&state=~a"
- (uri-encode state))
- ""))))))
- (let ((final-candidates
- (map
- (lambda (host/authorization-endpoint)
- (let ((host (car host/authorization-endpoint))
- (authorization-endpoint (cdr host/authorization-endpoint)))
- (cons
- host
- (build-uri (uri-scheme authorization-endpoint)
- #:userinfo (uri-userinfo authorization-endpoint)
- #:host (uri-host authorization-endpoint)
- #:port (uri-port authorization-endpoint)
- #:path (uri-path authorization-endpoint)
- #:query (format #f "client_id=~a&redirect_uri=~a~a"
- (uri-encode (uri->string client-id))
- (uri-encode (uri->string redirect-uri))
- (if state
- (format #f "&state=~a"
- (uri-encode state))
- ""))))))
- authorization-endpoints)))
- (when (null? final-candidates)
- (raise-no-provider-candidates host-or-webid candidate-errors))
- final-candidates))))))
-
-(define*-public (token host client-key
- #:key
- (authorization-code #f)
- (refresh-token #f)
- (http-get http-get)
- (http-post http-post))
- (unless (or authorization-code refresh-token)
- (scm-error 'wrong-type-arg "token"
- "You need to either set #:authorization-code or #:refresh-token."
- '()
- (list authorization-code)))
- (let ((token-endpoint
- (oidc-configuration-token-endpoint
- (get-oidc-configuration host #:http-get http-get)))
- (grant-type
- (if authorization-code
- "authorization_code"
- "refresh_token")))
- (let ((dpop-proof
- (issue-dpop-proof
- client-key
- #:alg (case (kty client-key)
- ((EC) 'ES256)
- ((RSA) 'RS256)
- (else
- (error "Unknown key type of ~S." client-key)))
- #:htm 'POST
- #:htu token-endpoint)))
- (receive (response response-body)
- (http-post token-endpoint
- #:body
- (string-join
- (map
- (lambda (arg)
- (string-append (uri-encode (car arg))
- "="
- (uri-encode (cdr arg))))
- `(("grant_type" . ,grant-type)
- ,@(if authorization-code
- `(("code" . ,authorization-code))
- '())
- ,@(if refresh-token
- `(("refresh_token" . ,refresh-token))
- '())))
- "&")
- #:headers
- `((content-type application/x-www-form-urlencoded)
- (dpop . ,dpop-proof)))
- (with-exception-handler
- (lambda (error)
- (raise-token-request-failed error))
- (lambda ()
- (when (bytevector? response-body)
- (set! response-body (utf8->string response-body)))
- (with-exception-handler
- (lambda (error)
- (raise-unexpected-response response error))
- (lambda ()
- (unless (eqv? (response-code response) 200)
- (raise-request-failed-unexpectedly
- (response-code response)
- (response-reason-phrase response)))
- (unless (and (response-content-type response)
- (eq? (car (response-content-type response 'application/json))))
- (raise-unexpected-header-value 'content-type (response-content-type response)))
- (stubs:json-string->scm response-body)))))))))
-
-(define-public (list-profiles)
- (map (lambda (profile)
- (list
- (string->uri (car profile)) ;; webid
- (string->uri (cadr profile)) ;; issuer
- (caddr profile) ;; refresh token
- (cadddr profile))) ;; key
- (catch #t
- (lambda ()
- (call-with-input-file (string-append (p:data-home) "/profiles")
- read))
- (lambda error
- (format (current-error-port) "Could not read profiles: ~s\n" error)
- '()))))
-
-(define (add-profile webid issuer refresh-token key)
- (let ((other-profiles (list-profiles)))
- (stubs:atomically-update-file
- (string-append (p:data-home) "/profiles")
- (string-append (p:data-home) "/profiles.lock")
- (lambda (port)
- (write
- (map (lambda (profile)
- (list
- (uri->string (car profile)) ;; webid
- (uri->string (cadr profile)) ;; issuer
- (caddr profile) ;; refresh token
- key)) ;; key
- (cons `(,webid
- ,issuer
- ,refresh-token)
- other-profiles))
- port)))))
-
-(define*-public (setup get-host/webid choose-provider browse-authorization-uri
- #:key
- (client-id #f)
- (redirect-uri #f)
- (http-get http-get)
- (http-post http-post))
- (let ((host/webid (get-host/webid)))
- (let ((authorization-uris
- (authorize host/webid
- #:client-id client-id
- #:redirect-uri redirect-uri
- #:http-get http-get))
- (key (generate-key #:n-size 2048)))
- (let ((provider (choose-provider (map car authorization-uris))))
- (let ((authz-uri (assq-ref authorization-uris provider)))
- (let ((authz-code (browse-authorization-uri authz-uri)))
- (let ((params
- (token host/webid key
- #:authorization-code authz-code
- #:http-get http-get
- #:http-post http-post)))
- (let ((id-token (id-token-decode (assq-ref params 'id_token)
- #:http-get http-get))
- (access-token (assq-ref params 'access_token))
- (refresh-token (assq-ref params 'refresh_token)))
- (when refresh-token
- ;; Save it to disk
- (add-profile (id-token-webid id-token)
- (id-token-iss id-token)
- refresh-token
- key))
- (values (cdr id-token) access-token key)))))))))
-
-(define*-public (login webid issuer refresh-token key
- #:key
- (http-get http-get)
- (http-post http-post))
- (when (string? webid)
- (set! webid (string->uri webid)))
- (when (string? issuer)
- (set! issuer (string->uri issuer)))
- (let ((iss-host (uri-host issuer)))
- (let ((params
- (token iss-host key
- #:refresh-token refresh-token
- #:http-get http-get
- #:http-post http-post)))
- (let ((id-token (id-token-decode (assq-ref params 'id_token)
- #:http-get http-get))
- (access-token (assq-ref params 'access_token))
- (new-refresh-token (assq-ref params 'refresh-token)))
- (when (and new-refresh-token
- (not (equal? refresh-token new-refresh-token)))
- ;; The refresh token has been updated
- (add-profile (id-token-webid id-token)
- (id-token-iss id-token)
- refresh-token
- key))
- (values (cdr id-token) access-token key)))))
+ request
-(define*-public (refresh id-token
- key
- #:key
- (http-get http-get)
- (http-post http-post))
- (when (id-token-payload? id-token)
- ;; For convenience, we’d like a full ID token to use the ID token
- ;; API.
- (set! id-token (cons `((alg . "HS256")) id-token)))
- (let ((profiles (list-profiles)))
- (letrec ((find-refresh-token
- (lambda (profiles)
- (when (null? profiles)
- (raise-profile-not-found (id-token-webid id-token)
- (id-token-iss id-token)
- (p:data-home)))
- (let ((prof (car profiles))
- (others (cdr profiles)))
- (let ((webid (car prof))
- (issuer (cadr prof))
- (refresh (caddr prof)))
- (if (and (equal? webid (id-token-webid id-token))
- (equal? issuer (id-token-iss id-token)))
- refresh
- (find-refresh-token others)))))))
- (login (id-token-webid id-token)
- (id-token-iss id-token)
- (find-refresh-token (profiles))
- key
- #:http-get http-get
- #:http-post http-post))))
+ serve-application
+ )
+ #:declarative? #t)
-(define* (renew-if-expired id-token access-token key
- date
- #:key
- (http-get http-get)
- (http-post http-post))
- ;; Since we’re not supposed to decode the access token, we’re
- ;; judging from the ID token to know if it has expired.
- (when (date? date)
- (set! date (date->time-utc date)))
- (when (time? date)
- (set! date (time-second date)))
- (when (id-token-payload? id-token)
- ;; See the refresh function
- (set! id-token (cons `((alg . "HS256")) id-token)))
- (let ((exp (id-token-exp id-token)))
- (set! exp (date->time-utc exp))
- (set! exp (time-second exp))
- (if (>= date exp)
- (parameterize ((p:current-date (lambda () date)))
- (refresh id-token key
- #:http-get http-get
- #:http-post http-post))
- (values id-token access-token key))))
+(define-record-type <client>
+ (make-client id key redirect-uri)
+ client?
+ (id client-id)
+ (key client-key)
+ (redirect-uri client-redirect-uri))
-(define*-public (make-client id-token access-token key
- #:key
- (http-get http-get)
- (http-post http-post)
- (http-request http-request))
+;; subject is optional, if you don’t know who the user is.
+(define* (request client subject issuer
+ #:key
+ (http-request http-request))
;; HACK: guile does not support other authentication schemes in
;; WWW-Authenticate than Basic, so it will crash when a response
;; containing that header will be issued.
- (declare-header! "WWW-Authenticate" string->symbol symbol? write)
- (define (handler uri method headers other-args retry?)
- (let ((proof (issue-dpop-proof
- key
- #:alg (case (kty key)
- ((EC) 'ES256)
- ((RSA) 'RS256)
- (else
- (error "Unknown key type of ~S." key)))
- #:htm method
- #:htu uri
- #:access-token access-token)))
- (receive (response response-body)
- (apply http-request uri
- #:method method
- #:headers (append `((dpop . ,proof)
- (Authorization . ,(string-append "DPoP " access-token)))
- headers)
- other-args)
- (let ((server-date (response-date response))
- (code (response-code response)))
- (if (and retry? (eqv? code 401))
- ;; Maybe the access token has expired?
- (receive (new-id-token new-access-token new-key)
- (renew-if-expired id-token access-token key server-date
- #:http-get http-get
- #:http-post http-post)
- (if (equal? access-token new-access-token)
- ;; No, it’s just that way.
- (values response response-body)
- ;; Ah, we have a new access token
- (begin
- (set! id-token new-id-token)
- (set! access-token new-access-token)
- (set! key new-key)
- (handler uri method headers other-args #f))))
- (values response response-body))))))
- (define (parse-args uri method headers other-args-rev rest)
- (if (null? rest)
- (handler uri method headers (reverse other-args-rev) #t)
- (let ((kw (car rest)))
- (case kw
- ((#:method)
- (if (null? (cdr rest))
- (parse-args uri method headers (cons kw other-args-rev) '())
- (parse-args uri (cadr rest) headers other-args-rev (cddr rest))))
- ((#:headers)
- (if (null? (cdr rest))
- (parse-args uri method headers (cons kw other-args-rev) '())
- (parse-args uri method (append headers (cadr rest)) other-args-rev (cddr rest))))
- (else
- (parse-args uri method headers (cons kw other-args-rev) '()))))))
- (define (parse-http-request-args uri args)
- (parse-args uri 'GET '() '() args))
- (lambda (uri . args)
- (parse-http-request-args uri args)))
+ (declare-header!
+ "WWW-Authenticate"
+ (cute parse-header 'pragma <>)
+ (lambda (value)
+ (and (list? value)
+ (let check-value ((schemes value))
+ (match schemes
+ (() #t)
+ (((hd . args) tl ...)
+ (and (symbol? hd)
+ (let check-args ((args args))
+ (match args
+ (() #t)
+ (((key . value) tl ...)
+ (and (symbol? key)
+ (string? value)
+ (check-args tl)))))
+ (check-value tl)))))))
+ (cute write-header 'pragma <> <>))
+ ;; The same applies for the authorization header.
+ (let ((original-parser (header-parser 'authorization))
+ (original-writer (header-writer 'authorization)))
+ (declare-header!
+ "Authorization"
+ original-parser
+ (lambda (value) #t)
+ (match-lambda*
+ ((('dpop . dpop) port)
+ (format port "DPoP ~a" dpop))
+ ((value port)
+ (original-writer value port)))))
+ (match client
+ (($ <client> client-id client-key redirect-uri)
+ (let ((do-login
+ (let ((my-http-get
+ (lambda* (uri . args)
+ (apply http-request uri
+ #:method 'GET
+ args)))
+ (my-http-post
+ (lambda* (uri . args)
+ (apply http-request uri
+ #:method 'POST
+ args))))
+ (match-lambda*
+ ((subject issuer)
+ (client:save-account
+ (client:login subject issuer
+ #:http-get my-http-get
+ #:http-post my-http-post
+ #:client-id client-id
+ #:client-key client-key
+ #:redirect-uri redirect-uri)))
+ (($ <account> subject issuer _ _ _ _)
+ (client:save-account
+ (client:login subject issuer
+ #:http-get my-http-get
+ #:http-post my-http-post
+ #:client-id client-id
+ #:client-key client-key
+ #:redirect-uri redirect-uri)))))))
+ (let ((current-account (do-login subject issuer)))
+ (define (handle request request-body)
+ (receive (response response-body)
+ (let* ((access-token (client:account-access-token current-account))
+ (dpop-proof
+ (issue-dpop-proof
+ (client:account-keypair current-account)
+ #:alg (case (kty client-key)
+ ((EC) 'ES256)
+ ((RSA) 'RS256))
+ #:htm (request-method request)
+ #:htu (request-uri request)
+ #:access-token access-token)))
+ (let ((headers
+ `((dpop . ,dpop-proof)
+ (authorization . (dpop . ,access-token))
+ ,@(request-headers request))))
+ (http-request
+ (request-uri request)
+ #:method (request-method request)
+ #:headers headers)))
+ (if (eqv? (response-code response) 401)
+ ;; Maybe the accesss token expired
+ (let ((server-date (time-second (date->time-utc (response-date response))))
+ (exp (assq-ref (client:account-id-token current-account) 'exp)))
+ (if (>= server-date exp)
+ ;; The ID token expired, renew it.
+ (begin
+ (set! current-account
+ (client:save-account
+ (do-login
+ (client:save-account
+ (client:invalidate-access-token current-account)))))
+ ;; Read it that way: invalidate the current
+ ;; account access token, then save it so that
+ ;; noone uses the invalid access token, then
+ ;; try to log in again, and finally save the
+ ;; new access token.
+ (handle request request-body))
+ ;; The ID token has not expired, we don’t care.
+ (values response response-body)))
+ ;; OK or other error, we don’t care.
+ (values response response-body))))
+ handle)))))
-(define*-public (serve-application id redirect-uri
- #:key
- (client-name "Example application")
- (client-uri "https://webid-oidc-demo.planete-kraus.eu"))
+(define* (serve-application id redirect-uri
+ #:key
+ (client-name "Example application")
+ (client-uri "https://webid-oidc-demo.planete-kraus.eu"))
(when (string? id)
(set! id (string->uri id)))
(when (string? redirect-uri)
diff --git a/src/scm/webid-oidc/client/Makefile.am b/src/scm/webid-oidc/client/Makefile.am
new file mode 100644
index 0000000..ccb7e35
--- /dev/null
+++ b/src/scm/webid-oidc/client/Makefile.am
@@ -0,0 +1,21 @@
+# 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/>.
+
+dist_clientwebidoidcmod_DATA += \
+ %reldir%/accounts.scm
+
+clientwebidoidcgo_DATA += \
+ %reldir%/accounts.go
diff --git a/src/scm/webid-oidc/client/accounts.scm b/src/scm/webid-oidc/client/accounts.scm
new file mode 100644
index 0000000..98fef85
--- /dev/null
+++ b/src/scm/webid-oidc/client/accounts.scm
@@ -0,0 +1,534 @@
+(define-module (webid-oidc client accounts)
+ #:use-module (sxml simple)
+ #:use-module (sxml match)
+ #:use-module (ice-9 match)
+ #:use-module (ice-9 exceptions)
+ #:use-module (ice-9 i18n)
+ #:use-module (ice-9 receive)
+ #:use-module (srfi srfi-9)
+ #:use-module (srfi srfi-19)
+ #:use-module (webid-oidc errors)
+ #:use-module ((webid-oidc parameters) #:prefix p:)
+ #:use-module ((webid-oidc stubs) #:prefix stubs:)
+ #:use-module ((webid-oidc oidc-id-token) #:prefix id:)
+ #:use-module ((webid-oidc oidc-configuration) #:prefix cfg:)
+ #:use-module ((webid-oidc jwk) #:prefix jwk:)
+ #:use-module ((webid-oidc dpop-proof) #:prefix dpop:)
+ #:use-module (web uri)
+ #:use-module (web response)
+ #:use-module (rnrs bytevectors)
+ #:export
+ (
+ <account>
+ make-account
+ account?
+ account-subject
+ account-issuer
+ account-id-token
+ account-access-token
+ account-refresh-token
+ account-keypair
+
+ authorization-process
+
+ &authorization-code-required
+ make-authorization-code-required
+ authorization-code-required?
+ authorization-code-required-uri
+
+ &refresh-token-expired
+ make-refresh-token-expired
+ refresh-token-expired?
+
+ &token-request-failed
+ make-token-request-failed
+ token-request-failed?
+ token-request-response
+ token-request-response-body
+
+ read-accounts
+ save-account
+ delete-account
+ invalidate-access-token
+ invalidate-refresh-token
+ login
+ )
+ #:declarative? #t)
+
+(define (G_ text)
+ (let ((out (gettext text)))
+ (if (string=? out text)
+ ;; No translation, disambiguate
+ (car (reverse (string-split text #\|)))
+ out)))
+
+;; This exception is continuable! Continue with the authorization
+;; code.
+(define-exception-type
+ &authorization-code-required
+ &external-error
+ make-authorization-code-required
+ authorization-code-required?
+ (uri authorization-code-required-uri))
+
+(define-exception-type
+ &token-request-failed
+ &external-error
+ make-token-request-failed
+ token-request-failed?
+ (response token-request-response)
+ (response-body token-request-response-body))
+
+(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))))
+
+(define-record-type <account>
+ (make-account subject issuer id-token access-token refresh-token keypair)
+ account?
+ (subject account-subject)
+ (issuer account-issuer)
+ (id-token account-id-token)
+ (access-token account-access-token)
+ (refresh-token account-refresh-token)
+ (keypair account-keypair))
+
+(define (load-account-arguments subject issuer arguments)
+ (let collect-arguments ((id-token #f)
+ (access-token #f)
+ (refresh-token #f)
+ (keypair #f)
+ (arguments arguments))
+ (match arguments
+ (()
+ (make-account subject
+ issuer
+ id-token
+ access-token
+ refresh-token
+ keypair))
+ ((hd tl ...)
+ (sxml-match
+ hd
+ ((disfluid:id-token (@ (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))))
+ access-token
+ refresh-token
+ keypair
+ tl))
+ ((disfluid:access-token (@ (access-token ,access-token)))
+ (collect-arguments
+ id-token
+ access-token
+ refresh-token
+ keypair
+ tl))
+ ((disfluid:refresh-token (@ (refresh-token ,refresh-token)))
+ (collect-arguments
+ id-token
+ access-token
+ refresh-token
+ keypair
+ tl))
+ ((disfluid:rsa-keypair (@ (n ,n) (e (,e "AQAB"))
+ (d ,d) (p ,p) (q ,q) (dp ,dp) (dq ,dq) (qi ,qi)))
+ (collect-arguments
+ id-token
+ access-token
+ refresh-token
+ `(,@(jwk:make-rsa-public-key n e)
+ ,@(jwk:make-rsa-private-key d p q dp dq qi))
+ tl))
+ ((disfluid:ec-keypair (@ (crv ,crv) (x ,x) (y ,y) (d ,d)))
+ (collect-arguments
+ id-token
+ access-token
+ refresh-token
+ `(,@(jwk:make-ec-point crv x y)
+ ,@(jwk:make-ec-scalar crv d)))))))))
+
+(define (read-accounts)
+ (let generate-list
+ ((content
+ (catch #t
+ (lambda ()
+ (call-with-input-file (string-append (p:data-home) "/profiles.xml")
+ (lambda (port)
+ (xml->sxml port
+ #:namespaces '((disfluid . "https://disfluid.planete-kraus.eu/client-account/v1"))
+ #:trim-whitespace? #t))))
+ (lambda error
+ '(*TOP*
+ (disfluid:accounts)))))
+ (parsed-accounts '()))
+ (sxml-match
+ content
+ ((*TOP*
+ (disfluid:accounts))
+ (reverse parsed-accounts))
+ ((*TOP*
+ (disfluid:accounts
+ (disfluid:account
+ (@ (subject ,subject)
+ (issuer ,issuer))
+ ,arguments ...)
+ ,other-accounts ...))
+ (let ((account (load-account-arguments
+ (string->uri subject)
+ (string->uri issuer) arguments)))
+ (generate-list
+ `(*TOP* (disfluid:accounts ,@other-accounts))
+ `(,account ,@parsed-accounts))))
+ ((*TOP*
+ (disfluid:accounts
+ (disfluid:account
+ ;; the subject is not set yet
+ (@ (issuer ,issuer))
+ ,arguments ...)
+ ,other-accounts ...))
+ (let ((account (load-account-arguments
+ #f (string->uri issuer) arguments)))
+ (generate-list
+ `(*TOP* (disfluid:accounts ,@other-accounts))
+ `(,account ,@parsed-accounts))))
+ ((*TOP*
+ (disfluid:accounts
+ ,whatever
+ ,other-accounts ...))
+ (generate-list `(*TOP* (disfluid:accounts ,@other-accounts)) parsed-accounts))
+ ((*TOP*
+ ,whatever)
+ (generate-list `(*TOP* (disfluid:accounts)) parsed-accounts)))))
+
+(define (update-accounts transformer)
+ (stubs:atomically-update-file
+ (string-append (p:data-home) "/profiles.xml")
+ (string-append (p:data-home) "/profiles.xml.lock")
+ (lambda (port)
+ (let ((old-accounts (read-accounts)))
+ (let ((new-accounts (transformer old-accounts)))
+ (chmod port #o600)
+ (sxml->xml
+ `(*TOP*
+ (accounts
+ (@ (xmlns "https://disfluid.planete-kraus.eu/client-account/v1"))
+ ,@(map (match-lambda
+ (($ <account> subject issuer id-token access-token refresh-token keypair)
+ (when (string? subject)
+ (set! subject (string->uri subject)))
+ (when (string? issuer)
+ (set! issuer (string->uri issuer)))
+ `(account
+ (@ ,@(if subject
+ `((subject ,(uri->string subject)))
+ '())
+ (issuer ,(uri->string issuer)))
+ ,@(if id-token
+ `((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
+ ,(number->string
+ (time-second
+ (date->time-utc
+ (id:id-token-iat id-token)))))
+ (exp
+ ,(number->string
+ (time-second
+ (date->time-utc
+ (id:id-token-exp id-token))))))))
+ '())
+ ,@(if access-token
+ `((access-token (@ (access-token ,access-token))))
+ '())
+ ,@(if refresh-token
+ `((refresh-token (@ (refresh-token ,refresh-token))))
+ '())
+ ,@(if keypair
+ (case (jwk:kty keypair)
+ ((RSA)
+ `((rsa-keypair (@ (n ,(assq-ref keypair 'n))
+ (e ,(assq-ref keypair 'e))
+ (d ,(assq-ref keypair 'd))
+ (p ,(assq-ref keypair 'p))
+ (q ,(assq-ref keypair 'q))
+ (dp ,(assq-ref keypair 'dp))
+ (dq ,(assq-ref keypair 'dq))
+ (qi ,(assq-ref keypair 'qi))))))
+ ((EC)
+ `((ec-keypair (@ (crv ,(symbol->string (assq-ref keypair 'crv)))
+ (x ,(assq-ref keypair 'x))
+ (y ,(assq-ref keypair 'y))
+ (d ,(assq-ref keypair 'd)))))))))))
+ new-accounts)))
+ port))))))
+
+(define (filter-out account old-accounts)
+ (match account
+ (($ <account> subject issuer _ _ _ _)
+ (filter
+ (match-lambda
+ (($ <account> other-subject other-issuer _ _ _ _)
+ ;; Keep it only if this is not the same user
+ (or (not (equal? other-subject subject))
+ (not (equal? other-issuer issuer)))))
+ old-accounts))))
+
+(define (save-account account)
+ (update-accounts
+ (lambda (old-accounts)
+ `(,account
+ ,@(filter-out account old-accounts))))
+ account)
+
+(define (delete-account account)
+ (update-accounts
+ (lambda (old-accounts)
+ (filter-out account old-accounts))))
+
+(define invalidate-access-token
+ (match-lambda
+ (($ <account> subject issuer _ _ refresh-token keypair)
+ (make-account subject issuer #f #f refresh-token keypair))))
+
+(define invalidate-refresh-token
+ (match-lambda
+ (($ <account> subject issuer id-token access-token _ keypair)
+ (make-account subject issuer id-token access-token #f keypair))))
+
+;; subject is optional. If the user is unknown, ask for an issuer and
+;; pass #f as subject.
+(define* (login subject issuer
+ #:key
+ (http-get http-get)
+ (http-post http-post)
+ (state #f)
+ client-id
+ client-key
+ redirect-uri)
+ (let ((all-accounts (if subject
+ ;; we’re expected to know the subject
+ (read-accounts)
+ ;; we’re not expected to know the subject
+ ;; anyway.
+ '())))
+ (let find-access-token ((accounts (read-accounts))
+ (available-refresh-token #f))
+ (match accounts
+ (() ;; No access token available (or no ID token, or no key):
+ ;; requires authorization.
+ (receive (authorization-endpoint token-endpoint)
+ (let ((configuration
+ (cfg:get-oidc-configuration
+ (uri-host issuer)
+ #:userinfo (uri-userinfo issuer)
+ #:port (uri-port issuer)
+ #:http-get http-get)))
+ (values
+ (cfg:oidc-configuration-authorization-endpoint configuration)
+ (cfg:oidc-configuration-token-endpoint configuration)))
+ (let ((grant-type
+ (if available-refresh-token
+ "refresh_token"
+ "authorization_code"))
+ (grant
+ (or available-refresh-token
+ ;; Negociate an authorization code
+ (let ((authorization-uri
+ (build-uri
+ (uri-scheme authorization-endpoint)
+ #:userinfo (uri-userinfo authorization-endpoint)
+ #:host (uri-host authorization-endpoint)
+ #:port (uri-port authorization-endpoint)
+ #:path (uri-path authorization-endpoint)
+ #:query
+ (string-join
+ (map (match-lambda
+ ((key . value)
+ (string-join `(,(symbol->string key)
+ ,(uri-encode value))
+ "=")))
+ `((client_id . ,(uri->string client-id))
+ (redirect_uri . ,(uri->string redirect-uri))
+ ,@(if state
+ `((state . ,state))
+ '())))
+ "&"))))
+ ((authorization-process) authorization-uri #:issuer issuer))))
+ (dpop-proof
+ (dpop:issue-dpop-proof
+ client-key
+ #:alg (case (jwk:kty client-key)
+ ((EC) 'ES256)
+ ((RSA) 'RS256))
+ #:htm 'POST
+ #:htu token-endpoint)))
+ ;; Post the token request with the correct grant:
+ (receive (response response-body)
+ (http-post token-endpoint
+ #:body
+ (string-join
+ (map
+ (match-lambda
+ ((key . value)
+ (string-append (uri-encode key)
+ "="
+ (uri-encode value))))
+ `(("grant_type" . ,grant-type)
+ (,(if available-refresh-token
+ "refresh_token"
+ "code") . ,grant)))
+ "&")
+ #:headers
+ `((content-type application/x-www-form-urlencoded)
+ (dpop . ,dpop-proof)))
+ ;; Check that the token endpoint responded correctly.
+ (when (eqv? (response-code response) 403)
+ (when subject
+ (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.")))))
+ (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))))))
+ (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."))))))
+ (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)))
+ (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 ((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)))
+ (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)))))
+ (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
+")
+ data)))))
+ (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)))
+ (lambda ()
+ (match (id:id-token-decode id-token #:http-get http-get)
+ ((header . payload)
+ (set! id-token payload)))))
+ ;; 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))))))
+ (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))))))
+ (make-account
+ (id:id-token-webid id-token)
+ issuer
+ id-token
+ access-token
+ refresh-token
+ client-key)))))))
+ ;; There is an account with an access token that was still
+ ;; valid last time we used it.
+ ((($ <account> hd-subject hd-issuer hd-id-token hd-access-token hd-refresh-token hd-keypair) tl ...)
+ (cond
+ ((and (equal? hd-subject subject)
+ (equal? hd-issuer issuer)
+ hd-id-token
+ hd-access-token
+ hd-keypair)
+ ;; We can use it as is.
+ (make-account hd-subject hd-issuer
+ hd-id-token hd-access-token hd-refresh-token hd-keypair))
+ ((and (equal? hd-subject subject)
+ (equal? hd-issuer issuer))
+ ;; We know that user, but the access token has been
+ ;; invalidated. If it still has a refresh token, maybe try
+ ;; it.
+ (find-access-token '() hd-refresh-token))
+ (else
+ ;; We can’t even use this refresh token, so we will try
+ ;; with the previous one.
+ (find-access-token tl available-refresh-token))))))))
diff --git a/src/scm/webid-oidc/errors.scm b/src/scm/webid-oidc/errors.scm
index beccc35..1c7d539 100644
--- a/src/scm/webid-oidc/errors.scm
+++ b/src/scm/webid-oidc/errors.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,7 +21,8 @@
#:use-module (ice-9 i18n)
#:use-module (srfi srfi-19)
#:use-module (web uri)
- #:use-module (web response))
+ #:use-module (web response)
+ #:use-module (web client))
(define (G_ text)
(let ((out (gettext text)))
@@ -883,16 +884,6 @@
((record-constructor &neither-identity-provider-nor-webid)
uri why-not-identity-provider why-not-webid)))
-(define-public &token-request-failed
- (make-exception-type
- '&token-request-failed
- &external-error
- '(cause)))
-
-(define-public (raise-token-request-failed cause)
- (raise-exception
- ((record-constructor &token-request-failed) cause)))
-
(define-public &profile-not-found
(make-exception-type
'&profile-not-found
@@ -1420,9 +1411,6 @@
(uri->string (get 'uri))
(recurse (get 'why-not-identity-provider))
(recurse (get 'why-not-webid))))
- ((&token-request-failed)
- (format #f (G_ "the token request failed (because ~a)")
- (recurse (get 'cause))))
((&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))
@@ -1529,6 +1517,6 @@
((&error)
(format #f (G_ "there is an error")))
(else
- (error (format #f (G_ "Unhandled exception type ~a.")
- (record-type-name type))))))
+ (format #f (G_ "there is an unknown exception of kind ~s")
+ (record-type-name type)))))
(format #f "~a" err)))
diff --git a/src/scm/webid-oidc/example-app.scm b/src/scm/webid-oidc/example-app.scm
index f0fcdd3..d6ef2a0 100644
--- a/src/scm/webid-oidc/example-app.scm
+++ b/src/scm/webid-oidc/example-app.scm
@@ -15,25 +15,30 @@
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
(define-module (webid-oidc example-app)
- #:use-module (webid-oidc client)
+ #: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 stubs) #:prefix stubs:)
#:use-module ((webid-oidc refresh-token) #:prefix refresh:)
#:use-module ((webid-oidc config) #:prefix cfg:)
+ #:use-module ((webid-oidc jwk) #:prefix jwk:)
#:use-module (web uri)
#:use-module (web client)
+ #:use-module (web request)
#:use-module (web response)
#:use-module (web server)
#: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)
#:use-module (ice-9 textual-ports)
#:use-module (ice-9 rdelim)
+ #:use-module (ice-9 match)
#:use-module (sxml simple)
#:use-module (rnrs bytevectors))
@@ -44,187 +49,102 @@
(car (reverse (string-split text #\|)))
out)))
-(define (enumerate-profiles profiles)
- (define (aux i)
- (when (< i (vector-length profiles))
- (let ((prof (vector-ref profiles i)))
- (format #t (G_ "~a.\t~a, certified by ~a;\n")
- (+ i 1)
- (uri->string (car prof))
- (uri->string (cadr prof))))
- (aux (+ i 1))))
- (aux 0))
-
-(define (enumerate-providers providers)
- (define (aux i)
- (when (< i (vector-length providers))
- (let ((prov (vector-ref providers i)))
- (format #t (G_ "~a – ~a\n")
- (+ i 1)
- (prov)))
- (aux (+ i 1))))
- (aux 0))
-
-(define (select-choice mini maxi question)
- (format #t "~a" question)
- (let* ((line
- (read-line (current-input-port) 'trim))
- (number (false-if-exception (string->number line))))
- (cond
- ((eof-object? line)
- (exit 0))
- ((and (integer? number)
- (>= number mini)
- (<= number maxi))
- number)
- (else
- (format #t (G_ "I’m expecting a number between ~a and ~a.\n")
- mini maxi)
- (select-choice mini maxi question)))))
-
-(define cache-http-get (cache:with-cache))
-
-(define (inner-main-loop http-request)
- (format #t (G_ "Please enter an URI to GET: "))
- (let ((line (read-line (current-input-port) 'trim)))
- (unless (eof-object? line)
- (let ((uri (string->uri line)))
- (receive (response response-body)
- (http-request uri)
- (let ((write-body
- (write-response response (current-output-port))))
- (when (string? response-body)
- (set! response-body (string->utf8 response-body)))
- (when response-body
- (write-response-body write-body response-body)))))
- (inner-main-loop http-request))))
-
-(define (main-loop id-token access-token key)
- (let ((my-http-request
- (make-client id-token access-token key
- #:http-request
- (lambda args
- (format (current-error-port) (G_ "Sending a request: ~s\n") args)
- (apply http-request args)))))
- (inner-main-loop my-http-request)))
-
-(define-public (inner-main)
- (setlocale LC_ALL "")
- (bindtextdomain cfg:package cfg:localedir)
- (textdomain cfg:package)
- (let ((version-sym
- (string->symbol (G_ "command-line|version")))
- (help-sym
- (string->symbol (G_ "comand-line|help"))))
- (let ((options
- (let ((option-spec
- `((,version-sym (single-char #\v) (value #f))
- (,help-sym (single-char #\h) (value #f)))))
- (getopt-long (command-line) option-spec))))
- (cond
- ((option-ref options help-sym #f)
- (format #t (G_ "Usage: ~a [OPTIONS]...
-
-Demonstrate a webid-oidc application.
-
-Options:
- -h, --~a:
- display this help message and exit.
- -v, --~a:
- display the version information (~a) and exit.
-
-Environment variables:
-
- LANG: set the locale. Currently ~a.
-
- XDG_CACHE_HOME: where the seed for the key generator is
-stored. Currently ~a.
-
- XDG_DATA_HOME: where the login credentials are stored. Currently ~a.
-
- HOME: to compute a default value for XDG_CACHE_HOME and
-XDG_DATA_HOME, if missing. Currently ~a.
-
-If you find a bug, send a report to ~a.
-")
- (car (command-line))
- help-sym version-sym
- cfg:version
- (or (getenv "LANG") "")
- (or (getenv "XDG_CACHE_HOME") "")
- (or (getenv "XDG_DATA_HOME") "")
- (or (getenv "HOME") "")
- cfg:package-bugreport))
- ((option-ref options version-sym #f)
- (format #t (G_ "~a version ~a\n")
- cfg:package cfg:version))
- (else
- (let ((profiles (list->vector (list-profiles))))
- (format #t (G_ "First, let’s log in. Here are your options:\n"))
- (enumerate-profiles profiles)
- (format #t (G_ "0.\tLog in with a different identity.\n"))
- (let ((i-profile
- (select-choice
- 0
- (vector-length profiles)
- (G_ "Please indicate your choice number: "))))
- (receive (id-token access-token key)
- (if (eqv? i-profile 0)
- (setup
- (lambda ()
- (format #t (G_ "Please enter your webid, or identity server: "))
- (read-line (current-input-port) 'trim))
- (lambda (providers)
- (cond
- ((null? providers)
- (error "No, this cannot happen."))
- ((null? (cdr providers))
- (car providers))
- (else
- (set! providers (list->vector providers))
- (format #t (G_ "There are different possible identity providers for your webid:\n"))
- (enumerate-providers providers)
- (let ((i-provider
- (select-choice 1 (- (vector-length providers) 1)
- (G_ "Please indicate your choice number: "))))
- (vector-ref providers i-provider)))))
- (lambda (uri)
- (format #t (G_ "Please visit the following URI with a web browser:\n~a\n")
- (uri->string uri))
- (format #t (G_ "Please paste your authorization code: "))
- (read-line (current-input-port) 'trim))
- #:client-id "https://webid-oidc-demo.planete-kraus.eu/example-application#id"
- #:redirect-uri "https://webid-oidc-demo.planete-kraus.eu/authorized"
- #:http-get cache-http-get)
- (let ((profile (vector-ref profiles (- i-profile 1))))
- (let ((webid (car profile))
- (issuer (cadr profile))
- (refresh-token (caddr profile))
- (key (cadddr profile)))
- (login webid issuer refresh-token key #:http-get cache-http-get))))
- (format #t (G_ "Log in success. Keep this identity token for yourself:
-
-~a
-
-Now, you can do authenticated request by presenting the following access token:
-
-~a
-
-and signing DPoP proofs with the following key:
-
-~a
+(define (main)
+ (define (do-the-trick subject issuer)
+ (client:request
+ (client:make-client
+ (string->uri
+ "https://webid-oidc-demo.planete-kraus.eu/example-application#id")
+ (jwk:generate-key #:n-size 2048)
+ (string->uri
+ "https://webid-oidc-demo.planete-kraus.eu/authorized"))
+ subject issuer))
+ (let ((accounts (list->vector (client:read-accounts))))
+ (format #t (G_ "Main menu:\n"))
+ (let enumerate-accounts ((i 0))
+ (when (< i (vector-length accounts))
+ (format #t (G_ "~a. Log in with ~a (issued by ~a): ~a
")
- (stubs:scm->json-string id-token #:pretty #t)
- access-token
- (stubs:scm->json-string key #:pretty #t))
- (main-loop id-token access-token key)))))))))
-
-(define-public (main)
- (with-exception-handler
- (lambda (error)
- (format (current-error-port)
- (G_ "There was an error: ~a\n")
- (error->str error)))
- (lambda ()
- (inner-main))
- #:unwind? #t))
+ (1+ i)
+ (or (let ((subject (client:account-subject (vector-ref accounts i))))
+ (and subject (uri->string subject)))
+ (format #f (G_ "a new user")))
+ (uri->string (client:account-issuer (vector-ref accounts i)))
+ (if (client:account-subject (vector-ref accounts i))
+ (if (client:account-id-token (vector-ref accounts i))
+ (format #f (G_ "status|currently logged in"))
+ (if (client:account-refresh-token (vector-ref accounts i))
+ (format #f (G_ "status|offline (but accessible)"))
+ (format #f (G_ "status|offline (inaccessible)"))))
+ (format #f (G_ "status|not initialized yet"))))
+ (enumerate-accounts (1+ i))))
+ (format #t (G_ "Type a number to log in, prefix it with '-' to delete the account, or type + to create a new account.
+"))
+ (match (read-line (current-input-port) 'trim)
+ ((? string?
+ (= string->number
+ (and (? integer? _)
+ (? (cute >= <> 1) _)
+ (? (cute <= <> (vector-length accounts)))
+ (= (cute - <> 1) choice))))
+ (let ((account (vector-ref accounts choice)))
+ (parameterize
+ ((client:authorization-process
+ ;; There’s a problem with guile continuable
+ ;; exceptions: we can’t handle errors in a handler for
+ ;; continuable exceptions. Until this is clarified, we
+ ;; avoid continuable exceptions.
+ (lambda* (uri #:key issuer)
+ (format (current-error-port) (G_ "Please visit: ~a\n") (uri->string uri))
+ (format (current-error-port) (G_ "Then, paste the authorization code you get:\n"))
+ (read-line (current-input-port) 'trim))))
+ (with-exception-handler
+ (lambda (error)
+ (cond
+ ((client:token-request-failed? error)
+ (format (current-error-port) (G_ "I could not negociate an access token. ~a")
+ (exception-message error))
+ (main))
+ ((client:refresh-token-expired? error)
+ (format (current-error-port) (G_ "The refresh token has expired, it is not possible to use that account offline.\n"))
+ (main))
+ (else
+ (raise-exception error))))
+ (lambda ()
+ (format #t (G_ "Please enter an URI to GET:\n"))
+ (let ((uri (string->uri (read-line (current-input-port) 'trim)))
+ (handler (do-the-trick (client:account-subject account)
+ (client:account-issuer account))))
+ (receive (response response-body)
+ (handler (build-request uri) "")
+ (let ((ad-hoc-port (write-response response (current-output-port))))
+ (unless (response-must-not-include-body? response)
+ (when (string? response-body)
+ (set! response-body (string->utf8 response-body)))
+ (write-response-body ad-hoc-port response-body)))))
+ (format #t "\n")
+ (main))))))
+ ((? string?
+ (= string->number
+ (and (? integer? _)
+ (= (cute - <>)
+ (and (? (cute >= <> 1) _)
+ (? (cute <= <> (vector-length accounts)) _)
+ (= (cute - <> 1) choice))))))
+ ;; Delete
+ (client:delete-account (vector-ref accounts choice))
+ (main))
+ ("+"
+ ;; Create an account
+ (format #t (G_ "Please type your identity provider:\n"))
+ (let ((issuer (read-line (current-input-port) 'trim)))
+ (when (and (string? issuer) (string->uri issuer))
+ (client:save-account
+ (client:make-account #f (string->uri issuer) #f #f #f #f))))
+ (main))
+ ((? eof-object? _)
+ (exit 0))
+ (else
+ (main)))))
+
+(main)
diff --git a/src/scm/webid-oidc/resource-server.scm b/src/scm/webid-oidc/resource-server.scm
index 14d8b81..5ee84db 100644
--- a/src/scm/webid-oidc/resource-server.scm
+++ b/src/scm/webid-oidc/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
@@ -42,6 +42,7 @@
#:use-module (ice-9 getopt-long)
#:use-module (ice-9 suspendable-ports)
#:use-module (ice-9 control)
+ #:use-module (ice-9 match)
#:use-module (sxml simple)
#:use-module (srfi srfi-19))
@@ -87,7 +88,18 @@
(error->str error))
#f)
(lambda ()
- (let* ((lit-access-token (symbol->string (cadr authz)))
+ ;; Sometimes the access is the cadr as a symbol,
+ ;; sometimes it is the cdr as a string. It depends
+ ;; whether the response has been written and read,
+ ;; or preserved as a guile object.
+ (let* ((lit-access-token
+ (match authz
+ ;; That’s when the request is parsed:
+ (('dpop (? symbol? symbol-value))
+ (symbol->string symbol-value))
+ ;; That’s when it’s not:
+ (('dpop . (? string? string-value))
+ string-value)))
(access-token
(access-token-decode lit-access-token
#:http-get http-get))
diff --git a/src/scm/webid-oidc/testing.scm b/src/scm/webid-oidc/testing.scm
index aec9504..f4de433 100644
--- a/src/scm/webid-oidc/testing.scm
+++ b/src/scm/webid-oidc/testing.scm
@@ -17,7 +17,12 @@
(define-module (webid-oidc testing)
#:use-module (webid-oidc stubs)
#:use-module (webid-oidc errors)
- #:use-module (webid-oidc parameters))
+ #:use-module (srfi srfi-9)
+ #:use-module (ice-9 optargs)
+ #:use-module (webid-oidc parameters)
+ #:use-module (webid-oidc resource-server)
+ #:use-module (webid-oidc refresh-token)
+ #:use-module (webid-oidc client))
;; This module is used only when running tests.
diff --git a/tests/Makefile.am b/tests/Makefile.am
index 086ccbd..e09ad57 100644
--- a/tests/Makefile.am
+++ b/tests/Makefile.am
@@ -57,8 +57,7 @@ TESTS = %reldir%/load-library.scm \
%reldir%/token-endpoint-refresh.scm \
%reldir%/provider-confirmation.scm \
%reldir%/resource-server.scm \
- %reldir%/client-authorization.scm \
- %reldir%/client-token.scm \
+ %reldir%/client-workflow.scm \
%reldir%/client-manifest-not-modified.scm \
%reldir%/server-content.scm \
%reldir%/server-path.scm \
diff --git a/tests/client-authorization.scm b/tests/client-authorization.scm
deleted file mode 100644
index af95893..0000000
--- a/tests/client-authorization.scm
+++ /dev/null
@@ -1,134 +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 client)
- (webid-oidc testing)
- ((webid-oidc stubs) #:prefix stubs:)
- (web uri)
- (web response)
- (srfi srfi-19)
- (ice-9 optargs)
- (ice-9 receive)
- (ice-9 hash-table))
-
-;; We need to test different things.
-
-;; 1. It works when passed a host
-;; 2. It works when passed a webid with foreign identity providers
-;; 3. It works when passed a webid without foreign identity providers
-
-(with-test-environment
- "client-authorization"
- (lambda ()
- (define* (http-get uri #:key (headers '()))
- (cond
- ;; 1. We pass a host name
- ((equal? uri (string->uri "https://case-1.client-authorization.scm/.well-known/openid-configuration"))
- (values
- (build-response #:headers `((content-type application/json)))
- (stubs:scm->json-string
- `((jwks_uri . "https://case-1.client-authorization.scm/keys")
- (authorization_endpoint . "https://case-1.client-authorization.scm/authorize")
- (token_endpoint . "https://case-1.client-authorization.scm/token")))))
- ;; It’s not a webid
- ((equal? uri (string->uri "https://case-1.client-authorization.scm"))
- (values
- (build-response #:code 404 #:reason-phrase "Not Found")
- #f))
- ;; 2. We first dereference the webid
- ((equal? uri (string->uri "https://case-2.client-authorization.scm/profile/card#me"))
- (values
- (build-response #:headers `((content-type text/turtle)))
- "<#me> <http://www.w3.org/ns/solid/terms#oidcIssuer> <https://one.identity.provider>, <https://another.identity.provider> ."))
- ;; and we get the config of all IPs
- ((equal? uri (string->uri "https://case-2.client-authorization.scm/.well-known/openid-configuration"))
- (values
- (build-response #:headers `((content-type application/json)))
- (stubs:scm->json-string
- `((jwks_uri . "https://case-2.client-authorization.scm/keys")
- (authorization_endpoint . "https://case-2.client-authorization.scm/authorize")
- (token_endpoint . "https://case-2.client-authorization.scm/token")))))
- ((equal? uri (string->uri "https://one.identity.provider/.well-known/openid-configuration"))
- (values
- (build-response #:headers `((content-type application/json)))
- (stubs:scm->json-string
- `((jwks_uri . "https://one.identity.provider/keys")
- (authorization_endpoint . "https://one.identity.provider/authorize")
- (token_endpoint . "https://one.identity.provider/token")))))
- ((equal? uri (string->uri "https://another.identity.provider/.well-known/openid-configuration"))
- (values
- (build-response #:headers `((content-type application/json)))
- (stubs:scm->json-string
- `((jwks_uri . "https://another.identity.provider/keys")
- (authorization_endpoint . "https://another.identity.provider/authorize")
- (token_endpoint . "https://another.identity.provider/token")))))
- ;; 3. The webid has no IPs.
- ((equal? uri (string->uri "https://case-3.client-authorization.scm/profile/card#me"))
- (values
- (build-response #:headers `((content-type text/turtle)))
- ""))
- ;; so we query the host of the webid.
- ((equal? uri (string->uri "https://case-3.client-authorization.scm/.well-known/openid-configuration"))
- (values
- (build-response #:headers `((content-type application/json)))
- (stubs:scm->json-string
- `((jwks_uri . "https://case-3.client-authorization.scm/keys")
- (authorization_endpoint . "https://case-3.client-authorization.scm/authorize")
- (token_endpoint . "https://case-3.client-authorization.scm/token")))))
- (else
- (format (current-error-port) "Unexpected GET query of URI ~a.\n" (uri->string uri))
- (exit 1))))
- (let ((case-1 (authorize "case-1.client-authorization.scm"
- #:client-id "https://app.client-authorization.scm"
- #:redirect-uri "https://app.client-authorization.scm/redirected"
- #:state "integrity&check"
- #:http-get http-get))
- (case-2 (authorize "https://case-2.client-authorization.scm/profile/card#me"
- #:client-id "https://app.client-authorization.scm"
- #:redirect-uri "https://app.client-authorization.scm/redirected"
- #:state "integrity&check"
- #:http-get http-get))
- (case-3 (authorize "https://case-3.client-authorization.scm/profile/card#me"
- #:client-id "https://app.client-authorization.scm"
- #:redirect-uri "https://app.client-authorization.scm/redirected"
- #:state "integrity&check"
- #:http-get http-get))
- (expected-1
- `(("https://case-1.client-authorization.scm"
- . ,(string->uri "https://case-1.client-authorization.scm/authorize?client_id=https%3A%2F%2Fapp.client-authorization.scm&redirect_uri=https%3A%2F%2Fapp.client-authorization.scm%2Fredirected&state=integrity%26check"))))
- (expected-2
- `(("https://case-2.client-authorization.scm"
- . ,(string->uri "https://case-2.client-authorization.scm/authorize?client_id=https%3A%2F%2Fapp.client-authorization.scm&redirect_uri=https%3A%2F%2Fapp.client-authorization.scm%2Fredirected&state=integrity%26check"))
- ("https://one.identity.provider"
- . ,(string->uri "https://one.identity.provider/authorize?client_id=https%3A%2F%2Fapp.client-authorization.scm&redirect_uri=https%3A%2F%2Fapp.client-authorization.scm%2Fredirected&state=integrity%26check"))
- ("https://another.identity.provider"
- . ,(string->uri "https://another.identity.provider/authorize?client_id=https%3A%2F%2Fapp.client-authorization.scm&redirect_uri=https%3A%2F%2Fapp.client-authorization.scm%2Fredirected&state=integrity%26check"))))
- (expected-3
- `(("https://case-3.client-authorization.scm"
- . ,(string->uri "https://case-3.client-authorization.scm/authorize?client_id=https%3A%2F%2Fapp.client-authorization.scm&redirect_uri=https%3A%2F%2Fapp.client-authorization.scm%2Fredirected&state=integrity%26check")))))
- (unless (equal? case-1 expected-1)
- (format (current-error-port) "Case 1 failed:\n~s\n~s\n\n"
- case-1 expected-1)
- (exit 2))
- (unless (equal? (hash-map->list cons (alist->hash-table case-2))
- (hash-map->list cons (alist->hash-table expected-2)))
- (format (current-error-port) "Case 2 failed:\n~s\n~s\n\n"
- case-2 expected-2)
- (exit 3))
- (unless (equal? case-3 expected-3)
- (format (current-error-port) "Case 3 failed:\n~s\n~s\n\n"
- case-3 expected-3)
- (exit 4)))))
diff --git a/tests/client-token.scm b/tests/client-token.scm
deleted file mode 100644
index 576019a..0000000
--- a/tests/client-token.scm
+++ /dev/null
@@ -1,137 +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 client)
- (webid-oidc testing)
- (webid-oidc token-endpoint)
- (webid-oidc jwk)
- (webid-oidc authorization-code)
- (webid-oidc oidc-configuration)
- (webid-oidc jws)
- (webid-oidc oidc-id-token)
- ((webid-oidc parameters) #:prefix p:)
- (web uri)
- (web request)
- (web response)
- (srfi srfi-19)
- (ice-9 optargs)
- (ice-9 receive)
- (ice-9 hash-table))
-
-(with-test-environment
- "client-token"
- (lambda ()
- (define the-current-time 0)
- (parameterize ((p:current-date (lambda () the-current-time)))
- (define issuer-key (generate-key #:n-size 2048))
- (define issuer-configuration
- (make-oidc-configuration
- "https://issuer.client-token.scm/keys"
- "https://issuer.client-token.scm/authorize"
- "https://issuer.client-token.scm/token"))
- (define token-endpoint (make-token-endpoint
- (string->uri "https://issuer.client-token.scm/token")
- (string->uri "https://issuer.client-token.scm")
- 'RS256
- issuer-key
- 3600))
- (define client-key (generate-key #:n-size 2048))
- (define authorization-code
- (issue-authorization-code 'RS256 issuer-key 120
- (string->uri "https://client-token.scm/profile/card#me")
- (string->uri "https://app.client-token.scm/app#id")))
- (define* (http-get uri #:key (headers '()))
- (cond
- ((equal? uri (string->uri "https://issuer.client-token.scm/.well-known/openid-configuration"))
- (serve-oidc-configuration
- (time-utc->date (make-time time-utc 0 (+ the-current-time 3600)))
- issuer-configuration))
- ((equal? uri (string->uri "https://issuer.client-token.scm/keys"))
- (serve-jwks
- (time-utc->date (make-time time-utc 0 (+ the-current-time 3600)))
- (make-jwks (list issuer-key))))
- (else
- (format (current-error-port) "GET request to ~a: error.\n" (uri->string uri))
- (exit 1))))
- (define* (http-post uri #:key (body #f) (headers '()))
- (unless (equal? uri (oidc-configuration-token-endpoint issuer-configuration))
- (format (current-error-port)
- "Wrong URI for token negociation: ~a (expected ~a).\n"
- (uri->string uri)
- (uri->string
- (oidc-configuration-token-endpoint
- issuer-configuration)))
- (exit 2))
- (unless (equal? body (format #f "grant_type=authorization_code&code=~a"
- authorization-code))
- (format (current-error-port)
- "Wrong body: ~s\n" body)
- (exit 3))
- (unless (equal?
- (assoc-ref headers 'content-type)
- '(application/x-www-form-urlencoded))
- (format (current-error-port)
- "Wrong content type: ~s\n" (assoc-ref headers 'content-type))
- (exit 4))
- (let ((request
- (build-request uri
- #:method 'POST
- #:headers headers
- #:port (open-input-string body)))
- (request-body body))
- (receive (response response-body user error)
- (token-endpoint request request-body)
- (values response response-body))))
- (let ((response
- (token "https://issuer.client-token.scm"
- client-key
- #:authorization-code authorization-code
- #:http-get http-get
- #:http-post http-post)))
- (let ((id-token (assq-ref response 'id_token))
- (access-token (assq-ref response 'access_token))
- (token-type (assq-ref response 'token_type))
- (token-expiration (assq-ref response 'expires_in))
- (refresh-token (assq-ref response 'refresh_token)))
- (let ((id-token-dec (id-token-decode id-token #:http-get http-get))
- (access-token-dec (jws-decode access-token (lambda (jws) issuer-key))))
- (unless id-token-dec
- (format (current-error-port) "Could not decode the ID token from ~s (~s)"
- id-token response)
- (exit 5))
- (unless access-token-dec
- (format (current-error-port) "Could not decode the access token from ~s (~s)"
- access-token response)
- (exit 6))
- (unless refresh-token
- (format (current-error-port) "There does not seem to be a refresh token in ~s"
- response)
- (exit 6))
- (unless (equal? (id-token-webid id-token-dec)
- (string->uri "https://client-token.scm/profile/card#me"))
- (exit 7))
- (unless (equal? (id-token-iss id-token-dec)
- (string->uri "https://issuer.client-token.scm"))
- (exit 8))
- (unless (equal? (id-token-aud id-token-dec)
- (string->uri "https://app.client-token.scm/app#id"))
- (exit 9))
- ;; It’s not the job of the client to check that the access
- ;; token is correct; TODO: add a check with a resource
- ;; server.
-
- ;; TODO: try to negociate a refresh token.
- ))))))
diff --git a/tests/client-workflow.scm b/tests/client-workflow.scm
new file mode 100644
index 0000000..04a4455
--- /dev/null
+++ b/tests/client-workflow.scm
@@ -0,0 +1,140 @@
+;; webid-oidc, implementation of the Solid specification
+;; Copyright (C) 2021 Vivien Kraus
+
+;; This program is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU Affero General Public License as
+;; published by the Free Software Foundation, either version 3 of the
+;; License, or (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU Affero General Public License for more details.
+
+;; You should have received a copy of the GNU Affero General Public License
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
+
+(use-modules ((webid-oidc client) #:prefix client:)
+ ((webid-oidc client accounts) #:prefix client:)
+ ((webid-oidc jwk) #:prefix jwk:)
+ (webid-oidc testing)
+ ((webid-oidc stubs) #:prefix stubs:)
+ ((webid-oidc refresh-token) #:prefix refresh:)
+ ((webid-oidc simulation) #:prefix sim:)
+ ((webid-oidc parameters) #:prefix p:)
+ (web uri)
+ (web request)
+ (web response)
+ (srfi srfi-19)
+ (srfi srfi-26)
+ (ice-9 optargs)
+ (ice-9 receive)
+ (ice-9 hash-table)
+ (ice-9 match))
+
+;; In this example, a user firsts requests an account, then logs in
+;; with a refresh token, then logs out, but we can still revive per
+;; account, then the refresh token gets banned.
+
+(define (display-log simulation)
+ (format (current-error-port) "Log:\n")
+ (for-each
+ (match-lambda
+ ((request request-body response response-body)
+ (format (current-error-port) "~s ~s (~s): ~s ~s\n"
+ (request-method request)
+ (uri->string (request-uri request))
+ request-body
+ (response-code response)
+ (response-reason-phrase response))))
+ (sim:simulation-scroll-log! simulation))
+ (exit 42))
+
+(with-test-environment
+ "client-workflow"
+ (lambda ()
+ (let ((simulation (sim:make-simulation)))
+ (sim:add-server! simulation
+ (string->uri "https://server@client-workflow.scm")
+ (string->uri "https://server@client-workflow.scm/alice#me"))
+ (sim:add-client! simulation
+ (string->uri "https://client@client-workflow.scm")
+ (string->uri "https://client@client-workflow.scm/id")
+ (string->uri "https://client@client-workflow.scm/authorized")
+ "Client workflow test"
+ (string->uri "https://client@client-workflow.scm/about"))
+ (let ((client (client:make-client
+ (string->uri "https://client@client-workflow.scm/id")
+ (jwk:generate-key #:n-size 2048)
+ (string->uri "https://client@client-workflow.scm/authorized"))))
+ (parameterize ((p:current-date 0)
+ (client:authorization-process
+ (lambda* (uri #:key issuer)
+ (sim:grant-authorization simulation uri))))
+ (receive (response response-body)
+ (let ((handler
+ (client:request client #f
+ (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 3)))
+ (match (sim:simulation-scroll-log! simulation)
+ ;; 1. The client gets the oidc configuration of the
+ ;; server.
+
+ ;; 2. The browser gets redirected to the authorization
+ ;; URI and POSTs the authorization form. The server makes
+ ;; a request to the client ID, which replies first.
+
+ ;; 3. The authorization request completes.
+
+ ;; 4. The client exchanges the authorization code for a
+ ;; refresh token.
+
+ ;; 5. and 6. The client decodes the ID token and requests
+ ;; the server keys.
+
+ ;; 7. and 8. While the client is waiting for the final response to
+ ;; complete, the server checks the access token validity by
+ ;; querying the identity provider for its key.
+
+ ;; 9. The client sends the signed request to the / URI of
+ ;; the server.
+ (((get-oidc-config-request _ get-oidc-config-response _)
+ (get-client-id-request _ get-client-id-response _)
+ (authorization-request _ authorization-response _)
+ (token-request _ token-response _)
+ _ _ ;; the client gets the key
+ _ _ ;; the resource server gets the key
+ (final-request _ final-response _))
+ (unless
+ (and
+ ;; 1. Get the authorization endpoint.
+ (equal? (request-uri get-oidc-config-request)
+ (string->uri "https://server@client-workflow.scm/.well-known/openid-configuration"))
+ (eqv? (response-code get-oidc-config-response) 200)
+ ;; 2. The server checks the client ID.
+ (equal? (request-uri get-client-id-request)
+ (string->uri "https://client@client-workflow.scm/id"))
+ (eqv? (response-code get-client-id-response) 200)
+ ;; 3. The authorization request completes.
+ (string-prefix?
+ "https://server@client-workflow.scm/authorize?"
+ (uri->string (request-uri authorization-request)))
+ (eq? (request-method authorization-request) 'POST)
+ (eqv? (response-code authorization-response) 302)
+ (string-prefix?
+ "https://client@client-workflow.scm/authorized?"
+ (uri->string (response-location authorization-response)))
+ ;; 4. Token negociation.
+ (equal? (request-uri token-request)
+ (string->uri "https://server@client-workflow.scm/token"))
+ (eqv? (response-code token-response) 200)
+ ;; 5. The final request.
+ (equal? (request-uri final-request)
+ (string->uri "https://server@client-workflow.scm/"))
+ (eqv? (response-code final-response) 200))
+ (exit 4)))))))))