server: add client endpoints

7 files changed, 373 insertions, 295 deletions

diff --git a/doc/disfluid.texi b/doc/disfluid.texi
index 8f22927..16cb1e3 100644
--- a/doc/disfluid.texi
+++ b/doc/disfluid.texi
@@ -1549,6 +1549,7 @@ the user.
 * Request authentication::
 * Hello world::
 * Reverse proxy::
+* Client pages::
 @end menu
 
 @node Error signalling
@@ -1698,6 +1699,48 @@ Return the header set by the reverse proxy to hold the authenticated
 webid.
 @end deffn
 
+@node Client pages
+@section Client pages
+The @emph{(webid-oidc server endpoint client)} module defines an
+endpoint to serve the public pages for a client application.
+
+@deftp {Class} <client-id> (<endpoint>) @var{client-id} @var{redirect-uris} @var{client-name} @var{client-uri} @var{grant-types} @var{response-types}
+During the OIDC authorization process, the identity provider must
+check some things against the public URI of a client application. This
+endpoint will respond to this query.
+
+You can construct it with @code{#:@var{redirect-uris}} (a list of
+URIs), @code{#:@var{client-id}} (an URI, or string encoding an URI),
+@code{#:@var{client-name}} (a string), @code{#:@var{grant-types}} (a
+list of symbols or strings), @code{#:@var{response-types}} (a list of
+symbols or strings).
+@end deftp
+
+@deffn {Generic} redirect-uris @var{client-id}
+Return the list of approved redirection URIs.
+@end deffn
+
+@deffn {Generic} client-id @var{client-id}
+Return the URI where the application can be queried by the identity
+provider.
+@end deffn
+
+@deffn {Generic} client-name @var{client-id}
+Return the associated name. Please note that the companion
+implementation of the identity provider in this package will not
+display the name to the user, because it can be misleading.
+@end deffn
+
+@deffn {Generic} client-uri @var{client-id}
+Return the URI where people can find information about the
+application. Also not hidden by the identity provider.
+@end deffn
+
+@deftp {Class} <redirect-uri> (<endpoint>)
+This endpoint receives an authorization code, and display it to the
+user, asking to paste it in the application.
+@end deftp
+
 @node Running an Identity Provider
 @chapter Running an Identity Provider
 
diff --git a/po/POTFILES.in b/po/POTFILES.in
index f11d0d2..3666403 100644
--- a/po/POTFILES.in
+++ b/po/POTFILES.in
@@ -80,6 +80,7 @@ src/scm/webid-oidc/server/create.scm
 src/scm/webid-oidc/server/delete.scm
 src/scm/webid-oidc/server/endpoint.scm
 src/scm/webid-oidc/server/endpoint/authentication.scm
+src/scm/webid-oidc/server/endpoint/client.scm
 src/scm/webid-oidc/server/endpoint/hello.scm
 src/scm/webid-oidc/server/endpoint/reverse-proxy.scm
 src/scm/webid-oidc/server/log.scm
diff --git a/po/disfluid.pot b/po/disfluid.pot
index fd646d9..030c1b2 100644
--- a/po/disfluid.pot
+++ b/po/disfluid.pot
@@ -277,9 +277,9 @@ msgid ""
 msgstr ""
 
 #: src/scm/webid-oidc/authorization-page-unsafe.scm:52
-#: src/scm/webid-oidc/client.scm:312 src/scm/webid-oidc/client.scm:329
-#: src/scm/webid-oidc/client.scm:346 src/scm/webid-oidc/hello-world.scm:147
+#: src/scm/webid-oidc/client.scm:193 src/scm/webid-oidc/hello-world.scm:147
 #: src/scm/webid-oidc/identity-provider.scm:136
+#: src/scm/webid-oidc/server/endpoint/client.scm:153
 #: src/scm/webid-oidc/server/endpoint/hello.scm:63
 #: src/scm/webid-oidc/server/endpoint/reverse-proxy.scm:125
 #: src/scm/webid-oidc/token-endpoint.scm:113
@@ -289,7 +289,7 @@ msgid "xml-lang|en"
 msgstr ""
 
 #: src/scm/webid-oidc/authorization-page-unsafe.scm:67
-#: src/scm/webid-oidc/client.scm:314
+#: src/scm/webid-oidc/server/endpoint/client.scm:155
 msgid "page-title|Authorization"
 msgstr ""
 
@@ -467,62 +467,16 @@ msgstr ""
 msgid "cannot serve the public manifest"
 msgstr ""
 
-#: src/scm/webid-oidc/client.scm:135
+#: src/scm/webid-oidc/client.scm:137
 msgid "accept-language-header|en-us"
 msgstr ""
 
-#: src/scm/webid-oidc/client.scm:182
-msgid "Example application"
+#: src/scm/webid-oidc/client.scm:196
+msgid "<h1>The request failed</h1>"
 msgstr ""
 
-#: src/scm/webid-oidc/client.scm:209
-msgid "#:client-name should be a string"
-msgstr ""
-
-#: src/scm/webid-oidc/client.scm:216
-msgid "#:client-uri should be an URI"
-msgstr ""
-
-#: src/scm/webid-oidc/client.scm:225
-msgid "#:response-types should be a list of symbols"
-msgstr ""
-
-#: src/scm/webid-oidc/client.scm:234
-msgid "#:grant-types should be a list of symbols"
-msgstr ""
-
-#: src/scm/webid-oidc/client.scm:286 src/scm/webid-oidc/resource-server.scm:143
-msgid "reason-phrase|Not Modified"
-msgstr ""
-
-#: src/scm/webid-oidc/client.scm:316
-msgid ""
-"You have been authorized. Please paste the following code in the application:"
-msgstr ""
-
-#: src/scm/webid-oidc/client.scm:321
-msgid "reason-phrase|Invalid Request"
-msgstr ""
-
-#: src/scm/webid-oidc/client.scm:331
-msgid "page-title|Error"
-msgstr ""
-
-#: src/scm/webid-oidc/client.scm:333
-msgid "Your identity provider did not authorize you. :("
-msgstr ""
-
-#: src/scm/webid-oidc/client.scm:338
-#: src/scm/webid-oidc/identity-provider.scm:129
-msgid "reason-phrase|Not Found"
-msgstr ""
-
-#: src/scm/webid-oidc/client.scm:348
-msgid "page-title|Not Found"
-msgstr ""
-
-#: src/scm/webid-oidc/client.scm:350
-msgid "This page does not exist on the server."
+#: src/scm/webid-oidc/client.scm:201 src/scm/webid-oidc/hello-world.scm:155
+msgid "<p>No more information.</p>"
 msgstr ""
 
 #: src/scm/webid-oidc/client/accounts.scm:118
@@ -1065,10 +1019,6 @@ msgstr ""
 msgid "<h1>Please authenticate</h1>"
 msgstr ""
 
-#: src/scm/webid-oidc/hello-world.scm:155
-msgid "<p>No more information.</p>"
-msgstr ""
-
 #: src/scm/webid-oidc/http-link.scm:148
 msgid "the #:anchor parameter should be a string or an URI reference"
 msgstr ""
@@ -1117,6 +1067,10 @@ msgstr ""
 msgid "Warning: generating a new key pair."
 msgstr ""
 
+#: src/scm/webid-oidc/identity-provider.scm:129
+msgid "reason-phrase|Not Found"
+msgstr ""
+
 #: src/scm/webid-oidc/jti.scm:59
 #, scheme-format
 msgid "a replay has been detected with JTI ~s"
@@ -2107,6 +2061,11 @@ msgstr ""
 msgid "reason-phrase|Precondition Failed"
 msgstr ""
 
+#: src/scm/webid-oidc/resource-server.scm:143
+#: src/scm/webid-oidc/server/endpoint/client.scm:123
+msgid "reason-phrase|Not Modified"
+msgstr ""
+
 #: src/scm/webid-oidc/resource-server.scm:165
 msgid "The owner is not defined."
 msgstr ""
@@ -2246,6 +2205,39 @@ msgid ""
 "<p>There is an access token and a DPoP proof, but one or both is invalid.</p>"
 msgstr ""
 
+#: src/scm/webid-oidc/server/endpoint/client.scm:70
+msgid "Example Solid Application"
+msgstr ""
+
+#: src/scm/webid-oidc/server/endpoint/client.scm:81
+msgid "#:client-uri should be an URI"
+msgstr ""
+
+#: src/scm/webid-oidc/server/endpoint/client.scm:100
+#, scheme-format
+msgid "#:~a element ~a should be a string or a symbol"
+msgstr ""
+
+#: src/scm/webid-oidc/server/endpoint/client.scm:106
+#, scheme-format
+msgid "#:~a should be a list"
+msgstr ""
+
+#: src/scm/webid-oidc/server/endpoint/client.scm:157
+msgid ""
+"You have been authorized. Please paste the following code in the application:"
+msgstr ""
+
+#: src/scm/webid-oidc/server/endpoint/client.scm:164
+msgid "reason-phrase|Invalid Request"
+msgstr ""
+
+#: src/scm/webid-oidc/server/endpoint/client.scm:166
+msgid ""
+"This page should obtain a code from your identity provider, but none has "
+"been provided."
+msgstr ""
+
 #: src/scm/webid-oidc/server/endpoint/hello.scm:57
 msgid "<p>You are not authentified.</p>"
 msgstr ""
diff --git a/po/fr.po b/po/fr.po
index dfbc8f5..bbb4d5e 100644
--- a/po/fr.po
+++ b/po/fr.po
@@ -3,7 +3,7 @@ msgstr ""
 "Project-Id-Version: webid-oidc 0.0.0\n"
 "Report-Msgid-Bugs-To: vivien@planete-kraus.eu\n"
 "POT-Creation-Date: 2021-10-19 11:31+0200\n"
-"PO-Revision-Date: 2021-10-19 11:34+0200\n"
+"PO-Revision-Date: 2021-10-19 11:35+0200\n"
 "Last-Translator: Vivien Kraus <vivien@planete-kraus.eu>\n"
 "Language-Team: French <vivien@planete-kraus.eu>\n"
 "Language: fr\n"
@@ -308,9 +308,9 @@ msgstr ""
 "requis (#:webid et #:client-id), soit (#:jwt-header et #:jwt-payload)"
 
 #: src/scm/webid-oidc/authorization-page-unsafe.scm:52
-#: src/scm/webid-oidc/client.scm:312 src/scm/webid-oidc/client.scm:329
-#: src/scm/webid-oidc/client.scm:346 src/scm/webid-oidc/hello-world.scm:147
+#: src/scm/webid-oidc/client.scm:193 src/scm/webid-oidc/hello-world.scm:147
 #: src/scm/webid-oidc/identity-provider.scm:136
+#: src/scm/webid-oidc/server/endpoint/client.scm:153
 #: src/scm/webid-oidc/server/endpoint/hello.scm:63
 #: src/scm/webid-oidc/server/endpoint/reverse-proxy.scm:125
 #: src/scm/webid-oidc/token-endpoint.scm:113
@@ -320,7 +320,7 @@ msgid "xml-lang|en"
 msgstr "fr"
 
 #: src/scm/webid-oidc/authorization-page-unsafe.scm:67
-#: src/scm/webid-oidc/client.scm:314
+#: src/scm/webid-oidc/server/endpoint/client.scm:155
 msgid "page-title|Authorization"
 msgstr "Autorisation"
 
@@ -510,65 +510,17 @@ msgstr ""
 msgid "cannot serve the public manifest"
 msgstr "impossible de servir le manifeste public"
 
-#: src/scm/webid-oidc/client.scm:135
+#: src/scm/webid-oidc/client.scm:137
 msgid "accept-language-header|en-us"
 msgstr "fr-fr"
 
-#: src/scm/webid-oidc/client.scm:182
-msgid "Example application"
-msgstr "Application exemple"
+#: src/scm/webid-oidc/client.scm:196
+msgid "<h1>The request failed</h1>"
+msgstr "<h1>La requête a échoué</h1>"
 
-#: src/scm/webid-oidc/client.scm:209
-msgid "#:client-name should be a string"
-msgstr "#:client-name doit être une chaîne de caractères"
-
-#: src/scm/webid-oidc/client.scm:216
-msgid "#:client-uri should be an URI"
-msgstr "#:client-uri doit être une URI"
-
-#: src/scm/webid-oidc/client.scm:225
-msgid "#:response-types should be a list of symbols"
-msgstr "#:response-types doit être une liste de symboles"
-
-#: src/scm/webid-oidc/client.scm:234
-msgid "#:grant-types should be a list of symbols"
-msgstr "#:grant-types doit être une liste de symboles"
-
-#: src/scm/webid-oidc/client.scm:286 src/scm/webid-oidc/resource-server.scm:143
-msgid "reason-phrase|Not Modified"
-msgstr "Non Modifié"
-
-#: src/scm/webid-oidc/client.scm:316
-msgid ""
-"You have been authorized. Please paste the following code in the application:"
-msgstr ""
-"Vous avez été autorisé. Veuillez coller le code suivant dans votre "
-"application :"
-
-#: src/scm/webid-oidc/client.scm:321
-msgid "reason-phrase|Invalid Request"
-msgstr "Requête Invalide"
-
-#: src/scm/webid-oidc/client.scm:331
-msgid "page-title|Error"
-msgstr "Erreur"
-
-#: src/scm/webid-oidc/client.scm:333
-msgid "Your identity provider did not authorize you. :("
-msgstr "Votre fournisseur d’identité ne vous a pas autorisé. :("
-
-#: src/scm/webid-oidc/client.scm:338
-#: src/scm/webid-oidc/identity-provider.scm:129
-msgid "reason-phrase|Not Found"
-msgstr "Non Trouvé"
-
-#: src/scm/webid-oidc/client.scm:348
-msgid "page-title|Not Found"
-msgstr "Non Trouvé"
-
-#: src/scm/webid-oidc/client.scm:350
-msgid "This page does not exist on the server."
-msgstr "Cette page n’existe pas sur le serveur."
+#: src/scm/webid-oidc/client.scm:201 src/scm/webid-oidc/hello-world.scm:155
+msgid "<p>No more information.</p>"
+msgstr "<p>Pas plus d’information.</p>"
 
 #: src/scm/webid-oidc/client/accounts.scm:118
 #, scheme-format
@@ -1182,10 +1134,6 @@ msgstr "Le port doit être un nombre entre 0 et 65535.\n"
 msgid "<h1>Please authenticate</h1>"
 msgstr "<h1>Veuillez vous authentifier</h1>"
 
-#: src/scm/webid-oidc/hello-world.scm:155
-msgid "<p>No more information.</p>"
-msgstr "<p>Pas plus d’information.</p>"
-
 #: src/scm/webid-oidc/http-link.scm:148
 msgid "the #:anchor parameter should be a string or an URI reference"
 msgstr ""
@@ -1238,6 +1186,10 @@ msgstr ""
 msgid "Warning: generating a new key pair."
 msgstr "Attention : génération d'une nouvelle paire de clé."
 
+#: src/scm/webid-oidc/identity-provider.scm:129
+msgid "reason-phrase|Not Found"
+msgstr "Non Trouvé"
+
 #: src/scm/webid-oidc/jti.scm:59
 #, scheme-format
 msgid "a replay has been detected with JTI ~s"
@@ -2500,6 +2452,11 @@ msgstr ""
 msgid "reason-phrase|Precondition Failed"
 msgstr "Échec de Précondition"
 
+#: src/scm/webid-oidc/resource-server.scm:143
+#: src/scm/webid-oidc/server/endpoint/client.scm:123
+msgid "reason-phrase|Not Modified"
+msgstr "Non Modifié"
+
 #: src/scm/webid-oidc/resource-server.scm:165
 msgid "The owner is not defined."
 msgstr "Le propriétaire n’est pas défini."
@@ -2643,6 +2600,44 @@ msgstr ""
 "<p>Il y a un jeton d’accès et une preuve DPoP, mais l’un ou les deux sont "
 "invalides.</p>"
 
+#: src/scm/webid-oidc/server/endpoint/client.scm:70
+msgid "Example Solid Application"
+msgstr "Application exemple Solid"
+
+#: src/scm/webid-oidc/server/endpoint/client.scm:81
+msgid "#:client-uri should be an URI"
+msgstr "#:client-uri doit être une URI"
+
+#: src/scm/webid-oidc/server/endpoint/client.scm:100
+#, scheme-format
+msgid "#:~a element ~a should be a string or a symbol"
+msgstr ""
+"l’élément #:~a numéro ~a doit être une chaîne de caractères ou un symbole"
+
+#: src/scm/webid-oidc/server/endpoint/client.scm:106
+#, scheme-format
+msgid "#:~a should be a list"
+msgstr "#:~a doit être une liste"
+
+#: src/scm/webid-oidc/server/endpoint/client.scm:157
+msgid ""
+"You have been authorized. Please paste the following code in the application:"
+msgstr ""
+"Vous avez été autorisé. Veuillez coller le code suivant dans votre "
+"application :"
+
+#: src/scm/webid-oidc/server/endpoint/client.scm:164
+msgid "reason-phrase|Invalid Request"
+msgstr "Requête Invalide"
+
+#: src/scm/webid-oidc/server/endpoint/client.scm:166
+msgid ""
+"This page should obtain a code from your identity provider, but none has "
+"been provided."
+msgstr ""
+"Cette page devait obtenir un code de votre fournisseur d’identité, mais "
+"aucun n’a été fourni."
+
 #: src/scm/webid-oidc/server/endpoint/hello.scm:57
 msgid "<p>You are not authentified.</p>"
 msgstr "<p>Vous n’êtes pas authentifié.</p>"
@@ -2924,6 +2919,27 @@ msgstr "Contenu :"
 msgid "Discard edits"
 msgstr "Rejeter les modifications"
 
+#~ msgid "#:client-name should be a string"
+#~ msgstr "#:client-name doit être une chaîne de caractères"
+
+#~ msgid "#:response-types should be a list of symbols"
+#~ msgstr "#:response-types doit être une liste de symboles"
+
+#~ msgid "#:grant-types should be a list of symbols"
+#~ msgstr "#:grant-types doit être une liste de symboles"
+
+#~ msgid "page-title|Error"
+#~ msgstr "Erreur"
+
+#~ msgid "Your identity provider did not authorize you. :("
+#~ msgstr "Votre fournisseur d’identité ne vous a pas autorisé. :("
+
+#~ msgid "page-title|Not Found"
+#~ msgstr "Non Trouvé"
+
+#~ msgid "This page does not exist on the server."
+#~ msgstr "Cette page n’existe pas sur le serveur."
+
 #~ msgid "<p>The client is compatible with Solid.</p>"
 #~ msgstr "<p>Le client est compatible avec Solid.</p>"
 
diff --git a/src/scm/webid-oidc/client.scm b/src/scm/webid-oidc/client.scm
index 5322af1..ee0b72c 100644
--- a/src/scm/webid-oidc/client.scm
+++ b/src/scm/webid-oidc/client.scm
@@ -22,6 +22,8 @@
   #:use-module (webid-oidc jwk)
   #:use-module (webid-oidc client-manifest)
   #:use-module (webid-oidc web-i18n)
+  #:use-module (webid-oidc server endpoint)
+  #:use-module (webid-oidc server endpoint client)
   #:use-module ((webid-oidc parameters) #:prefix p:)
   #:use-module ((webid-oidc stubs) #:prefix stubs:)
   #:use-module ((webid-oidc config) #:prefix cfg:)
@@ -168,183 +170,39 @@
       ((kw value args ...)
        (scan-arguments args headers `(,value ,kw ,@non-header-args) method)))))
 
-(define-class <extended-client-manifest> (<client-manifest>)
-  (client-name #:init-keyword #:client-name #:accessor client-name)
-  (client-uri #:init-keyword #:client-uri #:accessor client-uri)
-  (grant-types #:init-keyword #:grant-types #:accessor grant-types)
-  (response-types #:init-keyword #:response-types #:accessor response-types)
-  #:module-name '(webid-oidc client))
-
-(define-method (initialize (client <extended-client-manifest>) initargs)
-  (next-method)
-  (let-keywords
-   initargs #t
-   ((client-name (G_ "Example application"))
-    (client-uri "https://webid-oidc-demo.planete-kraus.eu")
-    (grant-types '(refresh_token authorization_code))
-    (response-types '(code)))
-   (let fix-grant-types ((grant-types grant-types)
-                         (ok '()))
-     (match grant-types
-       (()
-        (let ((grant-types (reverse ok)))
-          (let fix-response-types ((response-types response-types)
-                                   (ok '()))
-            (match response-types
-              (()
-               (let ((response-types (reverse ok)))
-                 (let fix-client-uri ((client-uri client-uri))
-                   (match client-uri
-                     ((? uri? client-uri)
-                      (let fix-client-name ((client-name client-name))
-                        (match client-name
-                          ((? string? client-name)
-                           (begin
-                             (slot-set! client 'client-name client-name)
-                             (slot-set! client 'client-uri client-uri)
-                             (slot-set! client 'grant-types grant-types)
-                             (slot-set! client 'response-types response-types)))
-                          (else
-                           (scm-error 'wrong-type-arg "make"
-                                      (G_ "#:client-name should be a string")
-                                      '()
-                                      (list client-name))))))
-                     ((? string? (= string->uri (? uri? client-uri)))
-                      (fix-client-uri client-uri))
-                     (else
-                      (scm-error 'wrong-type-arg "make"
-                                 (G_ "#:client-uri should be an URI")
-                                 '()
-                                 (list client-uri)))))))
-              (((or (? string? (= string->symbol hd))
-                    (? symbol? hd))
-                response-types ...)
-               (fix-response-types response-types `(,hd ,@ok)))
-              (else
-               (scm-error 'wrong-type-arg "make"
-                          (G_ "#:response-types should be a list of symbols")
-                          '()
-                          (list response-types)))))))
-       (((or (? string? (= string->symbol hd))
-             (? symbol? hd))
-         grant-types ...)
-        (fix-grant-types grant-types `(,hd ,@ok)))
-       (else
-        (scm-error 'wrong-type-arg "make"
-                   (G_ "#:grant-types should be a list of symbols")
-                   '()
-                   (list grant-types)))))))
-
-(define-method (->json-data (client <extended-client-manifest>))
-  (let ((other
-         (catch 'goops-error
-           (lambda ()
-             (next-method))
-           (lambda _
-             '()))))
-    (let ((all
-           `((client_name . ,(client-name client))
-             (client_uri . ,(uri->string (client-uri client)))
-             (grant_types . ,(list->vector (map symbol->string (grant-types client))))
-             (response_types . ,(list->vector (map symbol->string (response-types client))))
-             ,@other)))
-      ;; Put @context first
-      (receive (context non-context)
-          (let search-context ((fields all)
-                               (context-ones '())
-                               (non-context-ones '()))
-            (match fields
-              ((('@context . ,context) fields ...)
-               (search-context fields `(,context ,@context-ones) non-context-ones))
-              ((non-context fields ...)
-               (search-context fields context-ones `(,non-context ,@non-context-ones)))
-              (()
-               (values (reverse context-ones) (reverse non-context-ones)))))
-        (append
-         (map (lambda (ctx) `(@context . ,ctx)) context)
-         non-context)))))
-
 (define* (serve-application id redirect-uri . args)
-  (let ((manifest (apply make <extended-client-manifest>
+  (let ((endpoint (apply make <client-id>
                          #:client-id id
                          #:redirect-uris (list redirect-uri)
                          args)))
     (lambda (request request-body)
-      (parameterize ((web-locale request))
-        (let ((uri (request-uri request)))
-          (cond
-           ((equal? (uri-path uri) (uri-path id))
-            (receive (response response-body) (serve manifest #f)
-              (let ((if-none-match (request-if-none-match request))
-                    (etag (response-etag response)))
-                (if (and (list? if-none-match)
-                         etag
-                         (member (car etag) (map car if-none-match)))
-                    (values
-                     (build-response
-                      #:code 304
-                      #:reason-phrase (W_ "reason-phrase|Not Modified")
-                      #:headers `((content-type application/ld+json)
-                                  (etag . ,etag)))
-                     #f)
-                    (values response response-body)))))
-           ((equal? (uri-path uri) (uri-path redirect-uri))
-            (let ((query-args
-                   (map
-                    (lambda (key=value)
-                      (let ((splits
-                             (map uri-decode (string-split key=value #\=))))
-                        (if (or (null? splits) (null? (cdr splits)))
-                            splits
-                            (cons (string->symbol (car splits)) (cdr splits)))))
-                    (string-split (uri-query uri) #\&))))
-              (let ((code (assq-ref query-args 'code)))
-                (if code
-                    (values
-                     (build-response
-                      #:headers `((content-type application/xhtml+xml)))
-                     (with-output-to-string
-                       (lambda ()
-                         (sxml->xml
-                          `(*TOP*
-                            (*PI* xml "version=\"1.0\" encoding=\"utf-8\"")
-                            (html (@ (xmlns "http://www.w3.org/1999/xhtml")
-                                     (xml:lang ,(W_ "xml-lang|en")))
-                                  (head
-                                   (title ,(W_ "page-title|Authorization")))
-                                  (body
-                                   (p ,(W_ "You have been authorized. Please paste the following code in the application:"))
-                                   (p (strong ,code)))))))))
-                    (values
-                     (build-response
-                      #:code 400
-                      #:reason-phrase (W_ "reason-phrase|Invalid Request")
-                      #:headers `((content-type application/xhtml+xml)))
-                     (with-output-to-string
-                       (lambda ()
-                         (sxml->xml
-                          `(*TOP*
-                            (*PI* xml "version=\"1.0\" encoding=\"utf-8\"")
-                            (html (@ (xmlns "http://www.w3.org/1999/xhtml")
-                                     (xml:lang ,(W_ "xml-lang|en")))
-                                  (head
-                                   (title ,(W_ "page-title|Error")))
-                                  (body
-                                   (p ,(W_ "Your identity provider did not authorize you. :(")))))))))))))
-           (else
+      (with-exception-handler
+          (lambda (exn)
+            (unless (web-exception? exn)
+              (raise-exception exn))
             (values
              (build-response
-              #:code 404
-              #:reason-phrase (W_ "reason-phrase|Not Found")
+              #:code (web-exception-code exn)
+              #:reason-phrase (web-exception-reason-phrase exn)
               #:headers `((content-type application/xhtml+xml)))
-             (with-output-to-string
-               (lambda ()
-                 (sxml->xml
-                  `(*TOP*
-                    (*PI* xml "version=\"1.0\" encoding=\"utf-8\"")
-                    (html (@ (xmlns "http://www.w3.org/1999/xhtml")
-                             (xml:lang ,(W_ "xml-lang|en")))
-                          (head
-                           (title ,(W_ "page-title|Not Found")))
-                          (body
-                           (p ,(W_ "This page does not exist on the server."))))))))))))))))
+             (call-with-output-string
+               (cute sxml->xml
+                     `(*TOP*
+                       (*PI* xml "version=\"1.0\" encoding=\"utf-8\"")
+                       (html (@ (xmlns "http://www.w3.org/1999/xhtml")
+                                (xml:lang ,(W_ "xml-lang|en")))
+                             (body
+                              ,(call-with-input-string
+                                   (format #f (W_ "<h1>The request failed</h1>"))
+                                 xml->sxml)
+                              ,(if (user-message? exn)
+                                   (user-message-sxml exn)
+                                   (call-with-input-string
+                                       (format #f (W_ "<p>No more information.</p>"))
+                                     xml->sxml)))))
+                     <>))))
+        (lambda ()
+          (receive (response response-body response-meta)
+              (handle endpoint request request-body)
+            (values response response-body)))
+        #:unwind? #t))))
diff --git a/src/scm/webid-oidc/server/endpoint/Makefile.am b/src/scm/webid-oidc/server/endpoint/Makefile.am
index 1e4ee16..e6c6158 100644
--- a/src/scm/webid-oidc/server/endpoint/Makefile.am
+++ b/src/scm/webid-oidc/server/endpoint/Makefile.am
@@ -17,9 +17,11 @@
 dist_endpointserverwebidoidcmod_DATA += \
   %reldir%/reverse-proxy.scm \
   %reldir%/authentication.scm \
-  %reldir%/hello.scm
+  %reldir%/hello.scm \
+  %reldir%/client.scm
 
 endpointserverwebidoidcgo_DATA += \
   %reldir%/reverse-proxy.go \
   %reldir%/authentication.go \
-  %reldir%/hello.go
+  %reldir%/hello.go \
+  %reldir%/client.go
diff --git a/src/scm/webid-oidc/server/endpoint/client.scm b/src/scm/webid-oidc/server/endpoint/client.scm
new file mode 100644
index 0000000..ffa93c3
--- /dev/null
+++ b/src/scm/webid-oidc/server/endpoint/client.scm
@@ -0,0 +1,166 @@
+;; disfluid, implementation of the Solid specification
+;; Copyright (C) 2021  Vivien Kraus
+
+;; This program is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU Affero General Public License as
+;; published by the Free Software Foundation, either version 3 of the
+;; License, or (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU Affero General Public License for more details.
+
+;; You should have received a copy of the GNU Affero General Public License
+;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+(define-module (webid-oidc server endpoint client)
+  #:use-module (webid-oidc server endpoint)
+  #:use-module (webid-oidc errors)
+  #:use-module (webid-oidc provider-confirmation)
+  #:use-module (webid-oidc client-manifest)
+  #:use-module ((webid-oidc parameters) #:prefix p:)
+  #:use-module ((webid-oidc config) #:prefix cfg:)
+  #:use-module (web request)
+  #:use-module (web response)
+  #:use-module (web uri)
+  #:use-module (web server)
+  #:use-module (web client)
+  #:use-module (ice-9 optargs)
+  #:use-module (ice-9 receive)
+  #:use-module (webid-oidc web-i18n)
+  #:use-module (ice-9 getopt-long)
+  #:use-module (ice-9 suspendable-ports)
+  #:use-module (ice-9 control)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 exceptions)
+  #:use-module (sxml simple)
+  #:use-module (srfi srfi-19)
+  #:use-module (srfi srfi-26)
+  #:use-module (oop goops)
+  #:duplicates (merge-generics)
+  #:declarative? #t
+  #:re-export
+  (
+   client-id
+   redirect-uris
+   )
+  #:export
+  (
+   <client-id>
+   client-name
+   client-uri
+   grant-types
+   response-types
+
+   <redirect-uri>
+   ))
+
+(define-class <client-id> (<endpoint> <client-manifest>)
+  (client-name #:init-keyword #:client-name #:getter client-name)
+  (client-uri #:init-keyword #:client-uri #:getter client-uri)
+  (grant-types #:init-keyword #:grant-types #:getter grant-types)
+  (response-types #:init-keyword #:response-types #:getter response-types)
+  #:module-name '(webid-oidc server endpoint client))
+
+(define-method (initialize (c <client-id>) initargs)
+  (next-method)
+  (let-keywords
+   initargs #t
+   ((client-name (G_ "Example Solid Application"))
+    (client-uri (string->uri "https://disfluid.planete-kraus.eu"))
+    (grant-types '(refresh_token authorization_code))
+    (response-types '(code)))
+   (match client-uri
+     ((? string? (= string->uri (? uri? client-uri)))
+      (slot-set! c 'client-uri client-uri))
+     ((? uri?)
+      #t)
+     (else
+      (scm-error 'wrong-type-arg "make <client-id>"
+                 (G_ "#:client-uri should be an URI")
+                 '()
+                 (list client-uri))))
+   (let ((fix-symbol-list
+          (lambda (items what)
+            (let fix ((values items)
+                      (fixed '())
+                      (index 0))
+              (match values
+                ((? vector? x)
+                 (fix (vector->list x) fixed index))
+                (()
+                 (slot-set! c what (reverse fixed)))
+                (((or (? string? (= string->symbol value))
+                      (? symbol? value))
+                  values ...)
+                 (fix values `(,value @fixed) (+ index 1)))
+                ((wrong _ ...)
+                 (scm-error 'wrong-type-arg "make <client-id>"
+                            (format #f (G_ "#:~a element ~a should be a string or a symbol")
+                                    what index)
+                            '()
+                            (list wrong)))
+                (else
+                 (scm-error 'wrong-type-arg "make <client-id>"
+                            (format #f (G_ "#:~a should be a list")
+                                    what
+                                    '()
+                                    (list wrong)))))))))
+     (fix-symbol-list grant-types 'grant-types)
+     (fix-symbol-list response-types 'response-types))))
+
+(define-method (handle (endpoint <client-id>) request request-body)
+  (receive (response response-body) (serve endpoint #f)
+    (let ((if-none-match (request-if-none-match request))
+          (etag (response-etag response)))
+      (if (and (list? if-none-match)
+               etag
+               (member (car etag) (map car if-none-match)))
+          (values
+           (build-response
+            #:code 304
+            #:reason-phrase (W_ "reason-phrase|Not Modified")
+            #:headers `((content-type application/ld+json)
+                        (etag . ,etag)))
+           #f
+           '())
+          (values response response-body '())))))
+
+(define-class <redirect-uri> (<endpoint>))
+
+(define-method (handle (endpoint <redirect-uri>) request request-body)
+  (let ((query-args
+         (apply
+          append
+          (map
+           (lambda (key=value)
+             (match (map uri-decode (string-split key=value #\=))
+               ((key value)
+                `((,key . ,value)))
+               (else '())))
+           (string-split (uri-query (request-uri request)) #\&)))))
+    (let ((code (assq-ref query-args 'code)))
+      (if code
+          (values
+           (build-response
+            #:headers `((content-type applicationn/xhtml+xml)))
+           (call-with-output-string
+             (cute sxml->xml
+                   `(*TOP*
+                     (*PI* xml "version=\"1.0\" encoding=\"utf-8\"")
+                     (html (@ (xmlns "http://www.w3.org/1999/xhtml")
+                              (xml:lang ,(W_ "xml-lang|en")))
+                           (head
+                            (title ,(W_ "page-title|Authorization")))
+                           (body
+                            (p ,(W_ "You have been authorized. Please paste the following code in the application:"))
+                            (p (strong ,code)))))
+                   <>))
+           '())
+          ;; No code:
+          (raise-exception
+           (make-exception
+            (make-web-exception 400 (W_ "reason-phrase|Invalid Request"))
+            (make-user-message
+             `(p ,(W_ "This page should obtain a code from your identity provider, but none has been provided.")))))))))