diff options
author | Vivien Kraus <vivien@planete-kraus.eu> | 2021-10-14 22:32:42 +0200 |
---|---|---|
committer | Vivien Kraus <vivien@planete-kraus.eu> | 2021-10-20 18:07:07 +0200 |
commit | 7debf052567f50d2c2510d80405069e53b0971bf (patch) | |
tree | 2a669dfd528dfcb9920f96e4b317fbafb7943ba7 | |
parent | 34624c72245b483e645efd281a27c9c9e210a19a (diff) |
server: add a resource server endpoint
-rw-r--r-- | doc/disfluid.texi | 36 | ||||
-rw-r--r-- | po/POTFILES.in | 1 | ||||
-rw-r--r-- | po/disfluid.pot | 190 | ||||
-rw-r--r-- | po/fr.po | 220 | ||||
-rw-r--r-- | src/scm/webid-oidc/resource-server.scm | 295 | ||||
-rw-r--r-- | src/scm/webid-oidc/server/endpoint/Makefile.am | 6 | ||||
-rw-r--r-- | src/scm/webid-oidc/server/endpoint/resource-server.scm | 373 |
7 files changed, 727 insertions, 394 deletions
diff --git a/doc/disfluid.texi b/doc/disfluid.texi index d85afd8..7e47022 100644 --- a/doc/disfluid.texi +++ b/doc/disfluid.texi @@ -1551,6 +1551,7 @@ the user. * Reverse proxy:: * Client pages:: * Identity provider:: +* Resource server:: @end menu @node Error signalling @@ -1845,6 +1846,41 @@ Return the endpoint where all requests that aren’t handled by any element of the @var{identity-provider} go. @end deffn +@node Resource server +@section Resource server +The resource server is a read-write server with fine-grained +authorizations. You can create one in the +@emph{(webid-oidc server endpoint resource-server)} module. + +@deftp {Class} <resource-server> (<endpoint>) @var{server-uri} @var{owner} @var{data-home} +Create a resource server endpoint. To manage RDF data, and in +particular to identify owned resources, it is necessary that the +server knows its public @var{server-uri}. @var{owner} is the webid of +someone that has total control. + +If you want to manage multiple resource servers, you must make sure +that each one of them has a separate @var{data-home} directory. + +You can construct one with @code{#:@var{server-uri}} (an URI), +@code{#:@var{owner}} (an URI) and @code{#:@var{data-home}} (a +directory file name or a thunk returning a file name; it may exist or +not, defaults to @code{$XDG_CACHE_HOME}). +@end deftp + +@deffn {Generic} server-uri @var{resource-server} +Return the public URI of the @var{resource-server}. +@end deffn + +@deffn {Generic} owner @var{resource-server} +Return the webid of a user that has full control over +@var{resource-server}. +@end deffn + +@deffn {Generic} data-home @var{resource-server} +Return the directory where @var{resource-server} stores persistent +data. +@end deffn + @node Running an Identity Provider @chapter Running an Identity Provider diff --git a/po/POTFILES.in b/po/POTFILES.in index 0308b21..23f2693 100644 --- a/po/POTFILES.in +++ b/po/POTFILES.in @@ -81,6 +81,7 @@ 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/identity-provider.scm +src/scm/webid-oidc/server/endpoint/resource-server.scm src/scm/webid-oidc/server/endpoint/reverse-proxy.scm src/scm/webid-oidc/server/log.scm src/scm/webid-oidc/server/precondition.scm diff --git a/po/disfluid.pot b/po/disfluid.pot index 7bdc5f6..872407d 100644 --- a/po/disfluid.pot +++ b/po/disfluid.pot @@ -279,6 +279,7 @@ msgstr "" #: src/scm/webid-oidc/authorization-endpoint.scm:70 #: src/scm/webid-oidc/client.scm:193 src/scm/webid-oidc/hello-world.scm:147 #: src/scm/webid-oidc/identity-provider.scm:120 +#: src/scm/webid-oidc/resource-server.scm:124 #: src/scm/webid-oidc/server/endpoint/client.scm:153 #: src/scm/webid-oidc/server/endpoint/hello.scm:63 #: src/scm/webid-oidc/server/endpoint/identity-provider.scm:389 @@ -295,6 +296,7 @@ msgstr "" #: src/scm/webid-oidc/authorization-endpoint.scm:78 #: src/scm/webid-oidc/client.scm:201 src/scm/webid-oidc/hello-world.scm:155 #: src/scm/webid-oidc/identity-provider.scm:128 +#: src/scm/webid-oidc/resource-server.scm:132 #: src/scm/webid-oidc/token-endpoint.scm:76 msgid "<p>No more information.</p>" msgstr "" @@ -1989,79 +1991,18 @@ msgstr "" msgid "the refresh token is bound to key ~s, which is not that one" msgstr "" -#: src/scm/webid-oidc/resource-server.scm:71 +#: src/scm/webid-oidc/resource-server.scm:75 msgid "" "You need to pass #:server-uri URI where URI is the public URI of the server, " "as a (web uri)." msgstr "" -#: src/scm/webid-oidc/resource-server.scm:128 -#: src/scm/webid-oidc/resource-server.scm:335 -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 +#: src/scm/webid-oidc/resource-server.scm:97 msgid "The owner is not defined." msgstr "" -#: src/scm/webid-oidc/resource-server.scm:215 -#: src/scm/webid-oidc/resource-server.scm:238 -msgid "Bad Request" -msgstr "" - -#: src/scm/webid-oidc/resource-server.scm:249 -msgid "reason-phrase|Created" -msgstr "" - -#: src/scm/webid-oidc/resource-server.scm:272 -#, scheme-format -msgid "~a: ignoring a group that cannot be fetched: ~a\n" -msgstr "" - -#: src/scm/webid-oidc/resource-server.scm:276 -#, scheme-format -msgid "~a: ignoring a group that cannot be fetched\n" -msgstr "" - -#: src/scm/webid-oidc/resource-server.scm:283 -#: src/scm/webid-oidc/server/endpoint/identity-provider.scm:369 -msgid "reason-phrase|Found" -msgstr "" - -#: src/scm/webid-oidc/resource-server.scm:300 -#: src/scm/webid-oidc/server/endpoint/identity-provider.scm:528 -msgid "reason-phrase|Forbidden" -msgstr "" - -#: src/scm/webid-oidc/resource-server.scm:304 -#: src/scm/webid-oidc/server/endpoint/hello.scm:54 -#: src/scm/webid-oidc/server/endpoint/identity-provider.scm:332 -#: src/scm/webid-oidc/server/endpoint/identity-provider.scm:459 -#: src/scm/webid-oidc/server/endpoint/identity-provider.scm:468 -msgid "reason-phrase|Unauthorized" -msgstr "" - -#: src/scm/webid-oidc/resource-server.scm:312 -#: src/scm/webid-oidc/server/endpoint/identity-provider.scm:439 -msgid "reason-phrase|Method Not Allowed" -msgstr "" - -#: src/scm/webid-oidc/resource-server.scm:321 -msgid "reason-phrase|Conflict" -msgstr "" - -#: src/scm/webid-oidc/resource-server.scm:328 -#: src/scm/webid-oidc/server/endpoint/identity-provider.scm:418 -msgid "reason-phrase|Unsupported Media Type" -msgstr "" - -#: src/scm/webid-oidc/resource-server.scm:342 -msgid "reason-phrase|Not Acceptable" +#: src/scm/webid-oidc/resource-server.scm:127 +msgid "<h1>The resource server request failed</h1>" msgstr "" #: src/scm/webid-oidc/reverse-proxy.scm:60 @@ -2172,6 +2113,11 @@ msgstr "" msgid "#:~a should be a list" msgstr "" +#: src/scm/webid-oidc/server/endpoint/client.scm:123 +#: src/scm/webid-oidc/server/endpoint/resource-server.scm:145 +msgid "reason-phrase|Not Modified" +msgstr "" + #: src/scm/webid-oidc/server/endpoint/client.scm:155 msgid "page-title|Authorization" msgstr "" @@ -2191,6 +2137,14 @@ msgid "" "been provided." msgstr "" +#: src/scm/webid-oidc/server/endpoint/hello.scm:54 +#: src/scm/webid-oidc/server/endpoint/identity-provider.scm:332 +#: src/scm/webid-oidc/server/endpoint/identity-provider.scm:459 +#: src/scm/webid-oidc/server/endpoint/identity-provider.scm:468 +#: src/scm/webid-oidc/server/endpoint/resource-server.scm:208 +msgid "reason-phrase|Unauthorized" +msgstr "" + #: src/scm/webid-oidc/server/endpoint/hello.scm:57 msgid "<p>You are not authentified.</p>" msgstr "" @@ -2256,6 +2210,8 @@ msgstr "" #: src/scm/webid-oidc/server/endpoint/identity-provider.scm:495 #: src/scm/webid-oidc/server/endpoint/identity-provider.scm:504 #: src/scm/webid-oidc/server/endpoint/identity-provider.scm:539 +#: src/scm/webid-oidc/server/endpoint/resource-server.scm:311 +#: src/scm/webid-oidc/server/endpoint/resource-server.scm:337 msgid "reason-phrase|Bad Request" msgstr "" @@ -2283,6 +2239,11 @@ msgid "" "redirection URI.</p>" msgstr "" +#: src/scm/webid-oidc/server/endpoint/identity-provider.scm:369 +#: src/scm/webid-oidc/server/endpoint/resource-server.scm:181 +msgid "reason-phrase|Found" +msgstr "" + #: src/scm/webid-oidc/server/endpoint/identity-provider.scm:391 msgid "Redirecting..." msgstr "" @@ -2295,6 +2256,11 @@ msgstr "" msgid "Authorization..." msgstr "" +#: src/scm/webid-oidc/server/endpoint/identity-provider.scm:418 +#: src/scm/webid-oidc/server/endpoint/resource-server.scm:241 +msgid "reason-phrase|Unsupported Media Type" +msgstr "" + #: src/scm/webid-oidc/server/endpoint/identity-provider.scm:421 msgid "<p>Please use <pre>application/x-www-form-urlencoded</pre>.</p>" msgstr "" @@ -2303,6 +2269,11 @@ msgstr "" msgid "<p>Expected an UTF-8 request body.</p>" msgstr "" +#: src/scm/webid-oidc/server/endpoint/identity-provider.scm:439 +#: src/scm/webid-oidc/server/endpoint/resource-server.scm:215 +msgid "reason-phrase|Method Not Allowed" +msgstr "" + #: src/scm/webid-oidc/server/endpoint/identity-provider.scm:442 msgid "<p>This is a token endpoint, please use <pre>POST</pre>.</p>" msgstr "" @@ -2335,6 +2306,11 @@ msgstr "" msgid "<p>Could not find a refresh token.</p>" msgstr "" +#: src/scm/webid-oidc/server/endpoint/identity-provider.scm:528 +#: src/scm/webid-oidc/server/endpoint/resource-server.scm:201 +msgid "reason-phrase|Forbidden" +msgstr "" + #: src/scm/webid-oidc/server/endpoint/identity-provider.scm:531 msgid "<p>The refresh token is invalid or has been revoked.</p>" msgstr "" @@ -2344,6 +2320,90 @@ msgstr "" msgid "<p>Cannot process your grant type, ~a.</p>" msgstr "" +#: src/scm/webid-oidc/server/endpoint/resource-server.scm:76 +msgid "#:server-name must be an URI or a string encoding an URI" +msgstr "" + +#: src/scm/webid-oidc/server/endpoint/resource-server.scm:86 +msgid "#:owner must be an URI or a string encoding an URI" +msgstr "" + +#: src/scm/webid-oidc/server/endpoint/resource-server.scm:94 +msgid "#:data-home must be a string, or a thunk (returning a string)" +msgstr "" + +#: src/scm/webid-oidc/server/endpoint/resource-server.scm:127 +#: src/scm/webid-oidc/server/endpoint/resource-server.scm:250 +msgid "reason-phrase|Precondition Failed" +msgstr "" + +#: src/scm/webid-oidc/server/endpoint/resource-server.scm:130 +msgid "<p>The resource has been updated.</p>" +msgstr "" + +#: src/scm/webid-oidc/server/endpoint/resource-server.scm:170 +#, scheme-format +msgid "~a: ignoring a group that cannot be fetched: ~a\n" +msgstr "" + +#: src/scm/webid-oidc/server/endpoint/resource-server.scm:174 +#, scheme-format +msgid "~a: ignoring a group that cannot be fetched\n" +msgstr "" + +#: src/scm/webid-oidc/server/endpoint/resource-server.scm:204 +msgid "" +"<p>You are authentified, but you are not authorized to access this resource." +"</p>" +msgstr "" + +#: src/scm/webid-oidc/server/endpoint/resource-server.scm:218 +msgid "<p>The storage root cannot be deleted.</p>" +msgstr "" + +#: src/scm/webid-oidc/server/endpoint/resource-server.scm:226 +msgid "reason-phrase|Conflict" +msgstr "" + +#: src/scm/webid-oidc/server/endpoint/resource-server.scm:231 +msgid "<p>You need to empty the container first before deleting it.</p>" +msgstr "" + +#: src/scm/webid-oidc/server/endpoint/resource-server.scm:233 +msgid "" +"<p>To change which resources are contained within this container, please use " +"HTTP POST, PUT or DELETE.</p>" +msgstr "" + +#: src/scm/webid-oidc/server/endpoint/resource-server.scm:235 +msgid "<p>The target resource is an auxiliary resource.</p>" +msgstr "" + +#: src/scm/webid-oidc/server/endpoint/resource-server.scm:244 +msgid "<p>You cannot use this content type.</p>" +msgstr "" + +#: src/scm/webid-oidc/server/endpoint/resource-server.scm:253 +msgid "<p>The resource is not in the state you expected.</p>" +msgstr "" + +#: src/scm/webid-oidc/server/endpoint/resource-server.scm:259 +msgid "reason-phrase|Not Acceptable" +msgstr "" + +#: src/scm/webid-oidc/server/endpoint/resource-server.scm:262 +msgid "<p>I cannot serve the resource with a content-type you want.</p>" +msgstr "" + +#: src/scm/webid-oidc/server/endpoint/resource-server.scm:314 +#: src/scm/webid-oidc/server/endpoint/resource-server.scm:340 +msgid "<p>Please include a request body.</p>" +msgstr "" + +#: src/scm/webid-oidc/server/endpoint/resource-server.scm:350 +msgid "reason-phrase|Created" +msgstr "" + #: src/scm/webid-oidc/server/endpoint/reverse-proxy.scm:77 msgid "#:backend-uri should be an URI" msgstr "" @@ -310,6 +310,7 @@ msgstr "" #: src/scm/webid-oidc/authorization-endpoint.scm:70 #: src/scm/webid-oidc/client.scm:193 src/scm/webid-oidc/hello-world.scm:147 #: src/scm/webid-oidc/identity-provider.scm:120 +#: src/scm/webid-oidc/resource-server.scm:124 #: src/scm/webid-oidc/server/endpoint/client.scm:153 #: src/scm/webid-oidc/server/endpoint/hello.scm:63 #: src/scm/webid-oidc/server/endpoint/identity-provider.scm:389 @@ -326,6 +327,7 @@ msgstr "<h1>La requête d’autorisation a échoué</h1>" #: src/scm/webid-oidc/authorization-endpoint.scm:78 #: src/scm/webid-oidc/client.scm:201 src/scm/webid-oidc/hello-world.scm:155 #: src/scm/webid-oidc/identity-provider.scm:128 +#: src/scm/webid-oidc/resource-server.scm:132 #: src/scm/webid-oidc/token-endpoint.scm:76 msgid "<p>No more information.</p>" msgstr "<p>Pas plus d’information.</p>" @@ -2376,7 +2378,7 @@ msgid "the refresh token is bound to key ~s, which is not that one" msgstr "" "le jeton de rafraîchissement est lié à la clé ~s, ce n’est pas celle utilisée" -#: src/scm/webid-oidc/resource-server.scm:71 +#: src/scm/webid-oidc/resource-server.scm:75 msgid "" "You need to pass #:server-uri URI where URI is the public URI of the server, " "as a (web uri)." @@ -2384,74 +2386,13 @@ msgstr "" "Vous devez passer #:server-uri URI où URI est l’URI publique du serveur, " "comme dans (web uri)." -#: src/scm/webid-oidc/resource-server.scm:128 -#: src/scm/webid-oidc/resource-server.scm:335 -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 +#: src/scm/webid-oidc/resource-server.scm:97 msgid "The owner is not defined." msgstr "Le propriétaire n’est pas défini." -#: src/scm/webid-oidc/resource-server.scm:215 -#: src/scm/webid-oidc/resource-server.scm:238 -msgid "Bad Request" -msgstr "Requête invalide" - -#: src/scm/webid-oidc/resource-server.scm:249 -msgid "reason-phrase|Created" -msgstr "Créé" - -#: src/scm/webid-oidc/resource-server.scm:272 -#, scheme-format -msgid "~a: ignoring a group that cannot be fetched: ~a\n" -msgstr "~a : j’ignore un groupe qui n’a pas pu être téléchargé : ~a\n" - -#: src/scm/webid-oidc/resource-server.scm:276 -#, scheme-format -msgid "~a: ignoring a group that cannot be fetched\n" -msgstr "~a : j’ignore un groupe qui ne peut pas être téléchargé\n" - -#: src/scm/webid-oidc/resource-server.scm:283 -#: src/scm/webid-oidc/server/endpoint/identity-provider.scm:369 -msgid "reason-phrase|Found" -msgstr "Trouvé" - -#: src/scm/webid-oidc/resource-server.scm:300 -#: src/scm/webid-oidc/server/endpoint/identity-provider.scm:528 -msgid "reason-phrase|Forbidden" -msgstr "Interdit" - -#: src/scm/webid-oidc/resource-server.scm:304 -#: src/scm/webid-oidc/server/endpoint/hello.scm:54 -#: src/scm/webid-oidc/server/endpoint/identity-provider.scm:332 -#: src/scm/webid-oidc/server/endpoint/identity-provider.scm:459 -#: src/scm/webid-oidc/server/endpoint/identity-provider.scm:468 -msgid "reason-phrase|Unauthorized" -msgstr "Non Autorisé" - -#: src/scm/webid-oidc/resource-server.scm:312 -#: src/scm/webid-oidc/server/endpoint/identity-provider.scm:439 -msgid "reason-phrase|Method Not Allowed" -msgstr "Méthode Non Autorisée" - -#: src/scm/webid-oidc/resource-server.scm:321 -msgid "reason-phrase|Conflict" -msgstr "Conflit" - -#: src/scm/webid-oidc/resource-server.scm:328 -#: src/scm/webid-oidc/server/endpoint/identity-provider.scm:418 -msgid "reason-phrase|Unsupported Media Type" -msgstr "Type de Média Non Supporté" - -#: src/scm/webid-oidc/resource-server.scm:342 -msgid "reason-phrase|Not Acceptable" -msgstr "Inacceptable" +#: src/scm/webid-oidc/resource-server.scm:127 +msgid "<h1>The resource server request failed</h1>" +msgstr "<h1>La requête du serveur de ressource a échoué</h1>" #: src/scm/webid-oidc/reverse-proxy.scm:60 msgid "#:endpoint argument is not present or not an URI." @@ -2566,6 +2507,11 @@ msgstr "" msgid "#:~a should be a list" msgstr "#:~a doit être une liste" +#: src/scm/webid-oidc/server/endpoint/client.scm:123 +#: src/scm/webid-oidc/server/endpoint/resource-server.scm:145 +msgid "reason-phrase|Not Modified" +msgstr "Non Modifié" + #: src/scm/webid-oidc/server/endpoint/client.scm:155 msgid "page-title|Authorization" msgstr "Autorisation" @@ -2589,6 +2535,14 @@ 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:54 +#: src/scm/webid-oidc/server/endpoint/identity-provider.scm:332 +#: src/scm/webid-oidc/server/endpoint/identity-provider.scm:459 +#: src/scm/webid-oidc/server/endpoint/identity-provider.scm:468 +#: src/scm/webid-oidc/server/endpoint/resource-server.scm:208 +msgid "reason-phrase|Unauthorized" +msgstr "Non Autorisé" + #: src/scm/webid-oidc/server/endpoint/hello.scm:57 msgid "<p>You are not authentified.</p>" msgstr "<p>Vous n’êtes pas authentifié.</p>" @@ -2654,6 +2608,8 @@ msgstr "Autoriser" #: src/scm/webid-oidc/server/endpoint/identity-provider.scm:495 #: src/scm/webid-oidc/server/endpoint/identity-provider.scm:504 #: src/scm/webid-oidc/server/endpoint/identity-provider.scm:539 +#: src/scm/webid-oidc/server/endpoint/resource-server.scm:311 +#: src/scm/webid-oidc/server/endpoint/resource-server.scm:337 msgid "reason-phrase|Bad Request" msgstr "Requête Invalide" @@ -2683,6 +2639,11 @@ msgstr "" "<p>Le véritable client <a href=~s>~a</a> ne contrôle pas l’URI de " "redirection publiée.</p>" +#: src/scm/webid-oidc/server/endpoint/identity-provider.scm:369 +#: src/scm/webid-oidc/server/endpoint/resource-server.scm:181 +msgid "reason-phrase|Found" +msgstr "Trouvé" + #: src/scm/webid-oidc/server/endpoint/identity-provider.scm:391 msgid "Redirecting..." msgstr "Redirection..." @@ -2695,6 +2656,11 @@ msgstr "Vous êtes redirigé." msgid "Authorization..." msgstr "Autorisations…" +#: src/scm/webid-oidc/server/endpoint/identity-provider.scm:418 +#: src/scm/webid-oidc/server/endpoint/resource-server.scm:241 +msgid "reason-phrase|Unsupported Media Type" +msgstr "Type de Média Non Supporté" + #: src/scm/webid-oidc/server/endpoint/identity-provider.scm:421 msgid "<p>Please use <pre>application/x-www-form-urlencoded</pre>.</p>" msgstr "<p>Veuillez utiliser <pre>application/x-www-form-urlencoded</pre>.</p>" @@ -2703,6 +2669,11 @@ msgstr "<p>Veuillez utiliser <pre>application/x-www-form-urlencoded</pre>.</p>" msgid "<p>Expected an UTF-8 request body.</p>" msgstr "<p>J’attends un corps de requête UTF-8.</p>" +#: src/scm/webid-oidc/server/endpoint/identity-provider.scm:439 +#: src/scm/webid-oidc/server/endpoint/resource-server.scm:215 +msgid "reason-phrase|Method Not Allowed" +msgstr "Méthode Non Autorisée" + #: src/scm/webid-oidc/server/endpoint/identity-provider.scm:442 msgid "<p>This is a token endpoint, please use <pre>POST</pre>.</p>" msgstr "" @@ -2736,6 +2707,11 @@ msgstr "Requête Invalide" msgid "<p>Could not find a refresh token.</p>" msgstr "<p>Impossible de trouver un jeton de rafraîchissement.</p>" +#: src/scm/webid-oidc/server/endpoint/identity-provider.scm:528 +#: src/scm/webid-oidc/server/endpoint/resource-server.scm:201 +msgid "reason-phrase|Forbidden" +msgstr "Interdit" + #: src/scm/webid-oidc/server/endpoint/identity-provider.scm:531 msgid "<p>The refresh token is invalid or has been revoked.</p>" msgstr "<p>Le jeton de rafraîchissement est invalide ou a expiré.</p>" @@ -2745,6 +2721,98 @@ msgstr "<p>Le jeton de rafraîchissement est invalide ou a expiré.</p>" msgid "<p>Cannot process your grant type, ~a.</p>" msgstr "<p>Impossible de traiter votre type d’offre, ~a.</p>" +#: src/scm/webid-oidc/server/endpoint/resource-server.scm:76 +msgid "#:server-name must be an URI or a string encoding an URI" +msgstr "" +"#:server-name doit être une URI ou une chaîne de caractères encodant une URI" + +#: src/scm/webid-oidc/server/endpoint/resource-server.scm:86 +msgid "#:owner must be an URI or a string encoding an URI" +msgstr "#:owner doit être une URI ou une chaîne encodant une URI" + +#: src/scm/webid-oidc/server/endpoint/resource-server.scm:94 +msgid "#:data-home must be a string, or a thunk (returning a string)" +msgstr "" +"#:data-home doit être une chaîne de caractères, ou un thunk (retournant une " +"chaîne)" + +#: src/scm/webid-oidc/server/endpoint/resource-server.scm:127 +#: src/scm/webid-oidc/server/endpoint/resource-server.scm:250 +msgid "reason-phrase|Precondition Failed" +msgstr "Échec de Précondition" + +#: src/scm/webid-oidc/server/endpoint/resource-server.scm:130 +msgid "<p>The resource has been updated.</p>" +msgstr "<p>La ressource a été mise à jour.</p>" + +#: src/scm/webid-oidc/server/endpoint/resource-server.scm:170 +#, scheme-format +msgid "~a: ignoring a group that cannot be fetched: ~a\n" +msgstr "~a : j’ignore un groupe qui n’a pas pu être téléchargé : ~a\n" + +#: src/scm/webid-oidc/server/endpoint/resource-server.scm:174 +#, scheme-format +msgid "~a: ignoring a group that cannot be fetched\n" +msgstr "~a : j’ignore un groupe qui ne peut pas être téléchargé\n" + +#: src/scm/webid-oidc/server/endpoint/resource-server.scm:204 +msgid "" +"<p>You are authentified, but you are not authorized to access this resource." +"</p>" +msgstr "" +"<p>Vous êtes authentifié, mais pas autorisé à accéder à cette ressource.</p>" + +#: src/scm/webid-oidc/server/endpoint/resource-server.scm:218 +msgid "<p>The storage root cannot be deleted.</p>" +msgstr "<p>La racine du stockage ne peut pas être détruite.</p>" + +#: src/scm/webid-oidc/server/endpoint/resource-server.scm:226 +msgid "reason-phrase|Conflict" +msgstr "Conflit" + +#: src/scm/webid-oidc/server/endpoint/resource-server.scm:231 +msgid "<p>You need to empty the container first before deleting it.</p>" +msgstr "<p>Vous devez vider le conteneur avant de le détruire.</p>" + +#: src/scm/webid-oidc/server/endpoint/resource-server.scm:233 +msgid "" +"<p>To change which resources are contained within this container, please use " +"HTTP POST, PUT or DELETE.</p>" +msgstr "" +"<p>Pour changer les ressources contenue dans ce conteneur, veuillez utiliser " +"les méthodes HTTP POST, PUT ou DELETE.</p>" + +#: src/scm/webid-oidc/server/endpoint/resource-server.scm:235 +msgid "<p>The target resource is an auxiliary resource.</p>" +msgstr "<p>La ressource cible est une ressource auxiliaire.</p>" + +#: src/scm/webid-oidc/server/endpoint/resource-server.scm:244 +msgid "<p>You cannot use this content type.</p>" +msgstr "<p>Vous ne pouvez pas utiliser ce type de contenu.</p>" + +#: src/scm/webid-oidc/server/endpoint/resource-server.scm:253 +msgid "<p>The resource is not in the state you expected.</p>" +msgstr "<p>La ressource n’est pas dans l’état auquel vous vous attendez.</p>" + +#: src/scm/webid-oidc/server/endpoint/resource-server.scm:259 +msgid "reason-phrase|Not Acceptable" +msgstr "Inacceptable" + +#: src/scm/webid-oidc/server/endpoint/resource-server.scm:262 +msgid "<p>I cannot serve the resource with a content-type you want.</p>" +msgstr "" +"<p>Je ne peux pas servir de ressource avec le type de contenu que vous " +"voulez.</p>" + +#: src/scm/webid-oidc/server/endpoint/resource-server.scm:314 +#: src/scm/webid-oidc/server/endpoint/resource-server.scm:340 +msgid "<p>Please include a request body.</p>" +msgstr "<p>Veuillez inclure un corps de requête.</p>" + +#: src/scm/webid-oidc/server/endpoint/resource-server.scm:350 +msgid "reason-phrase|Created" +msgstr "Créé" + #: src/scm/webid-oidc/server/endpoint/reverse-proxy.scm:77 msgid "#:backend-uri should be an URI" msgstr "#:backend-uri doit être une URI" @@ -2964,6 +3032,16 @@ msgstr "Contenu :" msgid "Discard edits" msgstr "Rejeter les modifications" +#~ msgid "Bad Request" +#~ msgstr "Requête invalide" + +#~ msgid "The client_id query argument cannot be parsed as an URI." +#~ msgstr "L’argument client_id n’a pas pu être interprété comme URI." + +#~ msgid "The redirect_uri query argument cannot be parsed as an URI." +#~ msgstr "" +#~ "Le paramètre de requête redirect_uri n’a pas pu être interprété comme URI." + #~ msgid "Authorize this anonymous application?" #~ msgstr "Autoriser cette application anonyme ?" @@ -3042,13 +3120,6 @@ msgstr "Rejeter les modifications" #~ "<p>Vous voulez utiliser <pre>~s</pre> comme type d’offre, mais ce n’est " #~ "pas supporté.</p>" -#~ msgid "The client_id query argument cannot be parsed as an URI." -#~ msgstr "L’argument client_id n’a pas pu être interprété comme URI." - -#~ msgid "The redirect_uri query argument cannot be parsed as an URI." -#~ msgstr "" -#~ "Le paramètre de requête redirect_uri n’a pas pu être interprété comme URI." - #~ msgid "#:client-name should be a string" #~ msgstr "#:client-name doit être une chaîne de caractères" @@ -3343,9 +3414,6 @@ msgstr "Rejeter les modifications" #~ msgid "the DPoP proof cannot be decoded: ~a" #~ msgstr "impossible de décoder la preuve DPoP : ~a" -#~ msgid "the DPoP proof cannot be decoded" -#~ msgstr "impossible de décoder la preuve DPoP" - #, scheme-format #~ msgid "" #~ "the DPoP proof is signed in the future, ~a, relative to the current date, " diff --git a/src/scm/webid-oidc/resource-server.scm b/src/scm/webid-oidc/resource-server.scm index 65d64f0..95fa78a 100644 --- a/src/scm/webid-oidc/resource-server.scm +++ b/src/scm/webid-oidc/resource-server.scm @@ -20,6 +20,9 @@ #:use-module (webid-oidc jwk) #:use-module (webid-oidc dpop-proof) #:use-module (webid-oidc serve) + #:use-module (webid-oidc server endpoint) + #:use-module (webid-oidc server endpoint authentication) + #:use-module (webid-oidc server endpoint resource-server) #:use-module ((webid-oidc server create) #:prefix ldp:) #:use-module ((webid-oidc server read) #:prefix ldp:) #:use-module ((webid-oidc server update) #:prefix ldp:) @@ -49,6 +52,7 @@ #: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 @@ -84,78 +88,6 @@ (handle endpoint request request-body)))) #:unwind? #t))))) -(define (handle-errors f g) - (call/ec - (lambda (do-return) - (define (return . args) - (apply do-return args)) - (with-exception-handler - (lambda (error) - (g return error)) - (lambda () - (f return)) - #:unwind? #t)))) - -(define (nonrdf-or-turtle server-uri request request-body) - ;; If the request is an exotic RDF serialization - ;; format, we want to convert it to Turtle, - ;; otherwise we will consider it non-rdf. - (convert '(text/turtle */*) - server-uri - (uri-path (request-uri request)) - (match (request-content-type request) - ((or (? symbol? content-type) - ((? symbol? content-type) _ ...)) - content-type)) - request-body)) - -(define (serve-get return path if-match if-none-match content-type content etag headers user) - (define (respond-normal) - (return - (build-response - #:headers headers) - content - user)) - (if if-match - ;; If the precondition failed, then we should respond with 412 - (with-exception-handler - (lambda (error) - (unless (precondition-failed? error) - (raise-exception error)) - (return - (build-response - #:code 412 - #:reason-phrase (W_ "reason-phrase|Precondition Failed")) - #f - user)) - (lambda () - (check-precondition path if-match if-none-match etag) - (respond-normal))) - ;; If the precondition succeeds (if-none-match is effectively - ;; invalid), we return 200 - (with-exception-handler - (lambda (error) - (unless (precondition-failed? error) - (raise-exception error)) - (return - (build-response - #:code 304 - #:reason-phrase (W_ "reason-phrase|Not Modified") - #:headers - (filter - (lambda (h) - (case (car h) - ((cache-control content-location date etag expires vary) - #t) - (else #f))) - headers)) - #f - user)) - (lambda () - (when if-none-match - (check-precondition path if-match if-none-match etag)) - (respond-normal))))) - (define* (make-resource-server #:key (server-uri #f) @@ -164,183 +96,44 @@ (unless owner (fail (G_ "The owner is not defined."))) (declare-link-header!) - (unless authenticator - (set! authenticator - (make-authenticator - #:server-uri server-uri))) + (define resource-server + (make <resource-server> + #:server-name server-uri + #:owner owner)) + (define authenticator + (make <authenticator> + #:backend resource-server + #:server-uri server-uri)) (lambda (request request-body) - (parameterize ((p:current-date ((p:current-date))) ;; Fix the date - (web-locale request)) - (let ((user (authenticator request request-body))) - (handle-errors - (lambda (return) - (let ((method (request-method request))) - (case method - ((GET HEAD OPTIONS) - (receive (headers content) - (ldp:read server-uri owner user - (uri-path (request-uri request))) - (let ((true-content-type - (car (assq-ref headers 'content-type))) - (other-headers - (filter - (lambda (h) - (not (eq? (car h) 'content-type))) - headers))) - (receive (negociated-content-type - negociated-content) - (convert (request-accept request #f) - server-uri - (uri-path (request-uri request)) - true-content-type - content) - (serve-get - return - (uri-path (request-uri request)) - (request-if-match request) - (request-if-none-match request) - negociated-content-type - negociated-content - (car (assq-ref headers 'etag)) - (cons `(content-type ,negociated-content-type) - other-headers) - user))))) - ((PUT) - (receive (content-type content) - (nonrdf-or-turtle server-uri request request-body) - (unless content - (return - (build-response - #:code 400 - #:reason-phrase (W_ "Bad Request")) - "" - user)) - (let ((updated - (ldp:update server-uri owner user - (uri-path (request-uri request)) - (request-if-match request) - (request-if-none-match request) - content-type - content))) - (return - (build-response - #:headers - `((etag . (,(ldp:etag updated) . #f)))) - "" - user)))) - ((POST) - (receive (content-type content) - (nonrdf-or-turtle server-uri request request-body) - (unless content - (return - (build-response - #:code 400 - #:reason-phrase (W_ "Bad Request")) - "" - user)) - (let ((types - (map target-iri - (filter - (lambda (link) - (equal? (relation-type link) "type")) - (request-links request))))) - (return - (build-response - #:code 201 #:reason-phrase (W_ "reason-phrase|Created") - #:headers - `((location . ,(ldp:create server-uri owner user - (uri-path (request-uri request)) - types - (assq-ref (request-headers request) 'slug) - content-type - content)))) - "" - user)))) - ((DELETE) - (ldp:delete server-uri owner user - (uri-path (request-uri request)) - (request-if-match request) - (request-if-none-match request)) - (return - (build-response) - "" - user))))) - (lambda (return error) - (if (wac:cannot-fetch-group? error) - (if (exception-with-message? error) - (format (current-error-port) - (G_ "~a: ignoring a group that cannot be fetched: ~a\n") - (date->string ((p:current-date))) - (exception-message error)) - (format (current-error-port) - (G_ "~a: ignoring a group that cannot be fetched\n") - (date->string ((p:current-date))))) - (cond - ((ldp:uri-slash-semantics-error? error) - (return - (build-response - #:code 301 - #:reason-phrase (W_ "reason-phrase|Found") - #:headers - `((location - . ,(build-uri - (uri-scheme server-uri) - #:userinfo (uri-userinfo server-uri) - #:host (uri-host server-uri) - #:port (uri-port server-uri) - #:path (ldp:uri-slash-semantics-error-existing error))))) - #f - user)) - ((or (ldp:path-not-found? error) - (ldp:auxiliary-resource-absent? error) - (wac:forbidden? error)) - (if user - ;; That’s a forbidden - (return - (build-response #:code 403 #:reason-phrase (W_ "reason-phrase|Forbidden")) - #f - user) - (return - (build-response #:code 401 #:reason-phrase (W_ "reason-phrase|Unauthorized") - #:headers `((www-authenticate . ((DPoP))))) - #f - user))) - ((ldp:cannot-delete-root? error) - (return - (build-response - #:code 405 - #:reason-phrase (W_ "reason-phrase|Method Not Allowed")) - #f - user)) - ((or (ldp:container-not-empty? error) - (ldp:incorrect-containment-triples? error) - (ldp:path-is-auxiliary? error)) - (return - (build-response - #:code 409 - #:reason-phrase (W_ "reason-phrase|Conflict")) - #f - user)) - ((ldp:unsupported-media-type? error) - (return - (build-response - #:code 415 - #:reason-phrase (W_ "reason-phrase|Unsupported Media Type")) - #f - user)) - ((precondition-failed? error) - (return - (build-response - #:code 412 - #:reason-phrase (W_ "reason-phrase|Precondition Failed")) - #f - user)) - ((not-acceptable? error) - (return - (build-response - #:code 406 - #:reason-phrase (W_ "reason-phrase|Not Acceptable")) - #f - user)) - (else - (raise-exception error)))))))))) + (let/ec return + (parameterize ((web-locale request)) + (with-exception-handler + (lambda (exn) + (unless (web-exception? exn) + (raise-exception exn)) + (return + (build-response + #:code (web-exception-code exn) + #:reason-phrase (web-exception-reason-phrase exn) + #:headers `((content-type application/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"))) + (body + ,(call-with-input-string + (format #f (W_ "<h1>The resource server 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 authenticator request request-body) + (return 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 7248538..a3b8cb5 100644 --- a/src/scm/webid-oidc/server/endpoint/Makefile.am +++ b/src/scm/webid-oidc/server/endpoint/Makefile.am @@ -19,12 +19,14 @@ dist_endpointserverwebidoidcmod_DATA += \ %reldir%/authentication.scm \ %reldir%/hello.scm \ %reldir%/client.scm \ - %reldir%/identity-provider.scm + %reldir%/identity-provider.scm \ + %reldir%/resource-server.scm endpointserverwebidoidcgo_DATA += \ %reldir%/reverse-proxy.go \ %reldir%/authentication.go \ %reldir%/hello.go \ %reldir%/client.go \ - %reldir%/identity-provider.go + %reldir%/identity-provider.go \ + %reldir%/resource-server.go diff --git a/src/scm/webid-oidc/server/endpoint/resource-server.scm b/src/scm/webid-oidc/server/endpoint/resource-server.scm new file mode 100644 index 0000000..9e7a0b7 --- /dev/null +++ b/src/scm/webid-oidc/server/endpoint/resource-server.scm @@ -0,0 +1,373 @@ +;; 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 resource-server) + #: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 http-link) + #:use-module (webid-oidc serve) + #:use-module ((webid-oidc parameters) #:prefix p:) + #:use-module ((webid-oidc config) #:prefix cfg:) + #:use-module ((webid-oidc server resource wac) #:prefix wac:) + #:use-module ((webid-oidc server resource path) #:prefix ldp:) + #:use-module ((webid-oidc server read) #:prefix ldp:) + #:use-module ((webid-oidc server create) #:prefix ldp:) + #:use-module (webid-oidc server precondition) + #: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 + #:export + ( + <resource-server> + server-name + owner + data-home + )) + +(define-class <resource-server> (<endpoint>) + (server-name #:init-keyword #:server-name #:getter server-name) + (owner #:init-keyword #:owner #:getter owner) + (data-home #:init-keyword #:data-home #:getter get-data-home #:init-value p:data-home)) + +(define-method (data-home (s <resource-server>)) + ;; Actually, it’s stored as a thunk + ((get-data-home s))) + +(define-method (initialize (s <resource-server>) initargs) + (next-method) + (match (server-name s) + ((? string? (= string->uri (? uri? uri))) + (slot-set! s 'server-name uri)) + ((? uri?) + #t) + (else + (scm-error 'wrong-type-arg "make <resource-server>" + (G_ "#:server-name must be an URI or a string encoding an URI") + '() + (list (server-name s))))) + (match (owner s) + ((? string? (= string->uri (? uri? uri))) + (slot-set! s 'owner uri)) + ((? uri?) + #t) + (else + (scm-error 'wrong-type-arg "make <resource-server>" + (G_ "#:owner must be an URI or a string encoding an URI") + '() + (list (owner s))))) + (let ((given-data-home (get-data-home s))) + (when (string? given-data-home) + (slot-set! s 'data-home (lambda () given-data-home)))) + (unless (thunk? (get-data-home s)) + (scm-error 'wrong-type-arg "make <resource-server>" + (G_ "#:data-home must be a string, or a thunk (returning a string)") + '() + (list (get-data-home s)))) + (parameterize ((p:data-home (data-home s))) + (ldp:create-root (server-name s) (owner s)))) + +(define (nonrdf-or-turtle server-uri request request-body) + ;; If the request is an exotic RDF serialization + ;; format, we want to convert it to Turtle, + ;; otherwise we will consider it non-rdf. + (convert '(text/turtle */*) + server-uri + (uri-path (request-uri request)) + (match (request-content-type request) + ((or (? symbol? content-type) + ((? symbol? content-type) _ ...)) + content-type)) + request-body)) + +(define (serve-get return path if-match if-none-match content-type content etag headers user) + (define (respond-normal) + (return + (build-response #:headers headers) + content + '())) + (if if-match + ;; If the precondition failed, then we should respond with 412 + (with-exception-handler + (lambda (error) + (unless (precondition-failed? error) + (raise-exception error)) + (raise-exception + (make-exception + (make-web-exception 412 (W_ "reason-phrase|Precondition Failed")) + (make-user-message + (call-with-input-string + (format #f (W_ "<p>The resource has been updated.</p>")) + xml->sxml)) + error))) + (lambda () + (check-precondition path if-match if-none-match etag) + (respond-normal))) + ;; If the precondition succeeds (if-none-match is effectively + ;; invalid), we return 200 + (with-exception-handler + (lambda (error) + (unless (precondition-failed? error) + (raise-exception error)) + (return + (build-response + #:code 304 + #:reason-phrase (W_ "reason-phrase|Not Modified") + #:headers + (filter + (lambda (h) + (case (car h) + ((cache-control content-location date etag expires vary) + #t) + (else #f))) + headers)) + #f + '())) + (lambda () + (when if-none-match + (check-precondition path if-match if-none-match etag)) + (respond-normal))))) + +(define-method (handle (endpoint <resource-server>) request request-body) + (parameterize ((p:data-home (data-home endpoint))) + (declare-link-header!) + (let/ec return + (with-exception-handler + (lambda (exn) + (if (wac:cannot-fetch-group? exn) + (if (exception-with-message? exn) + (format (current-error-port) + (G_ "~a: ignoring a group that cannot be fetched: ~a\n") + (date->string ((p:current-date))) + (exception-message exn)) + (format (current-error-port) + (G_ "~a: ignoring a group that cannot be fetched\n") + (date->string ((p:current-date))))) + (cond + ((ldp:uri-slash-semantics-error? exn) + (return + (build-response + #:code 301 + #:reason-phrase (W_ "reason-phrase|Found") + #:headers + (let ((server-uri (server-name endpoint))) + `((location + . ,(build-uri + (uri-scheme server-uri) + #:userinfo (uri-userinfo server-uri) + #:host (uri-host server-uri) + #:port (uri-port server-uri) + #:path (ldp:uri-slash-semantics-error-existing exn)))))) + #f + '())) + ((or (ldp:path-not-found? exn) + (ldp:auxiliary-resource-absent? exn) + (wac:forbidden? exn)) + (let ((user (assq-ref (request-meta request) 'user))) + (if user + ;; That’s a forbidden + (raise-exception + (make-exception + (make-web-exception 403 (W_ "reason-phrase|Forbidden")) + (make-user-message + (call-with-input-string + (format #f (W_ "<p>You are authentified, but you are not authorized to access this resource.</p>")) + xml->sxml)) + exn)) + (return + (build-response #:code 401 #:reason-phrase (W_ "reason-phrase|Unauthorized") + #:headers `((www-authenticate . ((DPoP))))) + #f + '())))) + ((ldp:cannot-delete-root? exn) + (raise-exception + (make-exception + (make-web-exception 405 (W_ "reason-phrase|Method Not Allowed")) + (make-user-message + (call-with-input-string + (format #f (W_ "<p>The storage root cannot be deleted.</p>")) + xml->sxml)) + exn))) + ((or (ldp:container-not-empty? exn) + (ldp:incorrect-containment-triples? exn) + (ldp:path-is-auxiliary? exn)) + (raise-exception + (make-exception + (make-web-exception 409 (W_ "reason-phrase|Conflict")) + (make-user-message + (call-with-input-string + (cond + ((ldp:container-not-empty? exn) + (format #f (W_ "<p>You need to empty the container first before deleting it.</p>"))) + ((ldp:incorrect-containment-triples? exn) + (format #f (W_ "<p>To change which resources are contained within this container, please use HTTP POST, PUT or DELETE.</p>"))) + ((ldp:path-is-auxiliary? exn) + (format #f (W_ "<p>The target resource is an auxiliary resource.</p>")))) + xml->sxml)) + exn))) + ((ldp:unsupported-media-type? exn) + (raise-exception + (make-exception + (make-web-exception 415 (W_ "reason-phrase|Unsupported Media Type")) + (make-user-message + (call-with-input-string + (format #f (W_ "<p>You cannot use this content type.</p>")) + xml->sxml)) + exn))) + ((precondition-failed? exn) + (raise-exception + (make-exception + (make-web-exception 412 (W_ "reason-phrase|Precondition Failed")) + (make-user-message + (call-with-input-string + (format #f (W_ "<p>The resource is not in the state you expected.</p>")) + xml->sxml)) + exn))) + ((not-acceptable? exn) + (raise-exception + (make-exception + (make-web-exception 406 (W_ "reason-phrase|Not Acceptable")) + (make-user-message + (call-with-input-string + (format #f (W_ "<p>I cannot serve the resource with a content-type you want.</p>")) + xml->sxml)) + exn))) + (else + (raise-exception exn))))) + (lambda () + (case (request-method request) + ((GET HEAD OPTIONS) + (receive (headers content) + (ldp:read (server-name endpoint) (owner endpoint) + (assq-ref (request-meta request) 'user) + (uri-path (request-uri request))) + (let ((true-content-type + (match (assq-ref headers 'content-type) + ((or (? symbol? ct) + ((? symbol? ct) _ ...)) + ct))) + (other-headers + (filter + (match-lambda + (('content-type . _) #f) + (else #t)) + headers))) + (receive (negociated-content-type + negociated-content) + (convert (request-accept request #f) + (server-name endpoint) + (uri-path (request-uri request)) + true-content-type + content) + (serve-get + return + (uri-path (request-uri request)) + (request-if-match request) + (request-if-none-match request) + negociated-content-type + negociated-content + (match (assq-ref headers 'etag) + (((? string? etag) . #f) + etag)) + `((content-type ,negociated-content-type) + ,@other-headers) + (assq-ref (request-meta request) 'user)))))) + ((PUT) + (receive (content-type content) + (nonrdf-or-turtle (server-name endpoint) request request-body) + (unless content + (raise-exception + (make-exception + (make-web-exception 400 (W_ "reason-phrase|Bad Request")) + (make-user-message + (call-with-input-string + (format #f (W_ "<p>Please include a request body.</p>")) + xml->sxml))))) + (let ((updated + (ldp:update (server-name endpoint) + (owner endpoint) + (assq-ref (request-meta request) 'user) + (uri-path (request-uri request)) + (request-if-match request) + (request-if-none-match request) + content-type + content))) + (return + (build-response + #:headers + `((etag . (,(ldp:etag updated) . #f)))) + "" + '())))) + ((POST) + (receive (content-type content) + (nonrdf-or-turtle (server-name endpoint) request request-body) + (unless content + (raise-exception + (make-exception + (make-web-exception 400 (W_ "reason-phrase|Bad Request")) + (make-user-message + (call-with-input-string + (format #f (W_ "<p>Please include a request body.</p>")) + xml->sxml))))) + (let ((types + (map target-iri + (filter + (lambda (link) + (equal? (relation-type link) "type")) + (request-links request))))) + (return + (build-response + #:code 201 #:reason-phrase (W_ "reason-phrase|Created") + #:headers + `((location . ,(ldp:create (server-name endpoint) + (owner endpoint) + (assq-ref (request-meta request) 'user) + (uri-path (request-uri request)) + types + (assq-ref (request-headers request) 'slug) + content-type + content)))) + "" + '())))) + ((DELETE) + (ldp:delete (server-name endpoint) + (owner endpoint) + (assq-ref (request-meta request) 'user) + (uri-path (request-uri request)) + (request-if-match request) + (request-if-none-match request)) + (return + (build-response) + "" + '())))) + #:unwind? #t)))) |