diff options
author | Vivien Kraus <vivien@planete-kraus.eu> | 2021-10-13 17:44:51 +0200 |
---|---|---|
committer | Vivien Kraus <vivien@planete-kraus.eu> | 2021-10-19 11:35:22 +0200 |
commit | 5f6437959c641647447fe8801bee917a0d56c3dc (patch) | |
tree | 13bcf0ba4958691cc030352190b85aa9501b8de5 | |
parent | b7476072a7550c29c04a9718af26ca947003418c (diff) |
server: add a hello world backend
-rw-r--r-- | doc/disfluid.texi | 11 | ||||
-rw-r--r-- | po/POTFILES.in | 1 | ||||
-rw-r--r-- | po/disfluid.pot | 80 | ||||
-rw-r--r-- | po/fr.po | 98 | ||||
-rw-r--r-- | src/scm/webid-oidc/hello-world.scm | 122 | ||||
-rw-r--r-- | src/scm/webid-oidc/server/endpoint/Makefile.am | 6 | ||||
-rw-r--r-- | src/scm/webid-oidc/server/endpoint/hello.scm | 80 | ||||
-rw-r--r-- | tests/Makefile.am | 3 | ||||
-rw-r--r-- | tests/hello.scm | 68 |
9 files changed, 305 insertions, 164 deletions
diff --git a/doc/disfluid.texi b/doc/disfluid.texi index de04b9b..8f22927 100644 --- a/doc/disfluid.texi +++ b/doc/disfluid.texi @@ -1547,6 +1547,7 @@ the user. * Error signalling:: * Router endpoint:: * Request authentication:: +* Hello world:: * Reverse proxy:: @end menu @@ -1662,6 +1663,16 @@ Return the backend endpoint of @var{authenticator}. Return the public server URI of @var{authenticator}. @end deffn +@node Hello world +@section Hello world +The @emph{(webid-oidc server endpoint hello)} module defines an +endpoint that will greet the user, to check that Solid authentication +worked. It is intended to be a backend for an authenticator. + +@deftp {Class} <greeter> (<endpoint>) +An endpoint that will greet anonymous users and authenticated users. +@end deftp + @node Reverse proxy @section Reverse proxy The @emph{(webid-oidc server endpoint reverse-proxy)} module defines a diff --git a/po/POTFILES.in b/po/POTFILES.in index 8154eb0..f11d0d2 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/hello.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 0163544..fd646d9 100644 --- a/po/disfluid.pot +++ b/po/disfluid.pot @@ -278,10 +278,9 @@ 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:40 -#: src/scm/webid-oidc/hello-world.scm:167 -#: src/scm/webid-oidc/hello-world.scm:187 +#: src/scm/webid-oidc/client.scm:346 src/scm/webid-oidc/hello-world.scm:147 #: src/scm/webid-oidc/identity-provider.scm:136 +#: 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 #: src/scm/webid-oidc/token-endpoint.scm:139 @@ -995,40 +994,31 @@ msgstr "" msgid "cannot negociate a recognized RFD content type, got ~s" msgstr "" -#: src/scm/webid-oidc/hello-world.scm:44 -#, scheme-format -msgid "<h1>Hello, ~a!</h1>" -msgstr "" - -#: src/scm/webid-oidc/hello-world.scm:54 -msgid "<p>The client is compatible with Solid.</p>" -msgstr "" - -#: src/scm/webid-oidc/hello-world.scm:64 src/scm/webid-oidc/program.scm:240 +#: src/scm/webid-oidc/hello-world.scm:49 src/scm/webid-oidc/program.scm:240 msgid "command-line|version" msgstr "" -#: src/scm/webid-oidc/hello-world.scm:66 src/scm/webid-oidc/program.scm:244 +#: src/scm/webid-oidc/hello-world.scm:51 src/scm/webid-oidc/program.scm:244 msgid "command-line|complete-corresponding-source" msgstr "" -#: src/scm/webid-oidc/hello-world.scm:68 src/scm/webid-oidc/program.scm:246 +#: src/scm/webid-oidc/hello-world.scm:53 src/scm/webid-oidc/program.scm:246 msgid "command-line|help" msgstr "" -#: src/scm/webid-oidc/hello-world.scm:70 +#: src/scm/webid-oidc/hello-world.scm:55 msgid "command-line|port" msgstr "" -#: src/scm/webid-oidc/hello-world.scm:72 src/scm/webid-oidc/program.scm:278 +#: src/scm/webid-oidc/hello-world.scm:57 src/scm/webid-oidc/program.scm:278 msgid "command-line|log-file" msgstr "" -#: src/scm/webid-oidc/hello-world.scm:74 src/scm/webid-oidc/program.scm:280 +#: src/scm/webid-oidc/hello-world.scm:59 src/scm/webid-oidc/program.scm:280 msgid "command-line|error-file" msgstr "" -#: src/scm/webid-oidc/hello-world.scm:86 +#: src/scm/webid-oidc/hello-world.scm:71 #, scheme-format msgid "" "~a [OPTIONS]...\n" @@ -1057,44 +1047,26 @@ msgid "" " redirect the program errors to FILE.err.\n" msgstr "" -#: src/scm/webid-oidc/hello-world.scm:119 +#: src/scm/webid-oidc/hello-world.scm:104 #, scheme-format msgid "~a version ~a\n" msgstr "" -#: src/scm/webid-oidc/hello-world.scm:128 src/scm/webid-oidc/program.scm:642 +#: src/scm/webid-oidc/hello-world.scm:113 src/scm/webid-oidc/program.scm:642 msgid "" "You are legally required to link to the complete corresponding source code.\n" msgstr "" -#: src/scm/webid-oidc/hello-world.scm:138 +#: src/scm/webid-oidc/hello-world.scm:123 msgid "The port should be a number between 0 and 65535.\n" msgstr "" -#: src/scm/webid-oidc/hello-world.scm:159 -#: src/scm/webid-oidc/resource-server.scm:304 -msgid "reason-phrase|Unauthorized" -msgstr "" - -#: src/scm/webid-oidc/hello-world.scm:171 +#: src/scm/webid-oidc/hello-world.scm:150 msgid "<h1>Please authenticate</h1>" msgstr "" -#: src/scm/webid-oidc/hello-world.scm:175 -msgid "<p>This page requires authentication with Solid.</p>" -msgstr "" - -#: src/scm/webid-oidc/hello-world.scm:179 -#: src/scm/webid-oidc/resource-server.scm:312 -msgid "reason-phrase|Method Not Allowed" -msgstr "" - -#: src/scm/webid-oidc/hello-world.scm:191 -msgid "<h1>Method not allowed</h1>" -msgstr "" - -#: src/scm/webid-oidc/hello-world.scm:195 -msgid "<p>You can only use the <emph>GET</emph> method on this resource.</p>" +#: src/scm/webid-oidc/hello-world.scm:155 +msgid "<p>No more information.</p>" msgstr "" #: src/scm/webid-oidc/http-link.scm:148 @@ -2163,6 +2135,15 @@ msgstr "" msgid "reason-phrase|Forbidden" msgstr "" +#: src/scm/webid-oidc/resource-server.scm:304 +#: src/scm/webid-oidc/server/endpoint/hello.scm:54 +msgid "reason-phrase|Unauthorized" +msgstr "" + +#: src/scm/webid-oidc/resource-server.scm:312 +msgid "reason-phrase|Method Not Allowed" +msgstr "" + #: src/scm/webid-oidc/resource-server.scm:321 msgid "reason-phrase|Conflict" msgstr "" @@ -2265,6 +2246,19 @@ 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/hello.scm:57 +msgid "<p>You are not authentified.</p>" +msgstr "" + +#: src/scm/webid-oidc/server/endpoint/hello.scm:66 +#, scheme-format +msgid "<h1>Hello, ~a!</h1>" +msgstr "" + +#: src/scm/webid-oidc/server/endpoint/hello.scm:74 +msgid "<p>You are authenticated with Solid.</p>" +msgstr "" + #: src/scm/webid-oidc/server/endpoint/reverse-proxy.scm:77 msgid "#:backend-uri should be an URI" msgstr "" @@ -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:33+0200\n" +"PO-Revision-Date: 2021-10-19 11:34+0200\n" "Last-Translator: Vivien Kraus <vivien@planete-kraus.eu>\n" "Language-Team: French <vivien@planete-kraus.eu>\n" "Language: fr\n" @@ -309,10 +309,9 @@ 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:40 -#: src/scm/webid-oidc/hello-world.scm:167 -#: src/scm/webid-oidc/hello-world.scm:187 +#: src/scm/webid-oidc/client.scm:346 src/scm/webid-oidc/hello-world.scm:147 #: src/scm/webid-oidc/identity-provider.scm:136 +#: 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 #: src/scm/webid-oidc/token-endpoint.scm:139 @@ -1085,40 +1084,31 @@ msgstr "la requête a échoué de façon inattendue avec ~s ~s" msgid "cannot negociate a recognized RFD content type, got ~s" msgstr "impossible de négocier un type de contenu RDF reconnu, ayant obtenu ~s" -#: src/scm/webid-oidc/hello-world.scm:44 -#, scheme-format -msgid "<h1>Hello, ~a!</h1>" -msgstr "<h1>Bonjour, ~a !</h1>" - -#: src/scm/webid-oidc/hello-world.scm:54 -msgid "<p>The client is compatible with Solid.</p>" -msgstr "<p>Le client est compatible avec Solid.</p>" - -#: src/scm/webid-oidc/hello-world.scm:64 src/scm/webid-oidc/program.scm:240 +#: src/scm/webid-oidc/hello-world.scm:49 src/scm/webid-oidc/program.scm:240 msgid "command-line|version" msgstr "version" -#: src/scm/webid-oidc/hello-world.scm:66 src/scm/webid-oidc/program.scm:244 +#: src/scm/webid-oidc/hello-world.scm:51 src/scm/webid-oidc/program.scm:244 msgid "command-line|complete-corresponding-source" msgstr "code-source-correspondant-complet" -#: src/scm/webid-oidc/hello-world.scm:68 src/scm/webid-oidc/program.scm:246 +#: src/scm/webid-oidc/hello-world.scm:53 src/scm/webid-oidc/program.scm:246 msgid "command-line|help" msgstr "aide" -#: src/scm/webid-oidc/hello-world.scm:70 +#: src/scm/webid-oidc/hello-world.scm:55 msgid "command-line|port" msgstr "port" -#: src/scm/webid-oidc/hello-world.scm:72 src/scm/webid-oidc/program.scm:278 +#: src/scm/webid-oidc/hello-world.scm:57 src/scm/webid-oidc/program.scm:278 msgid "command-line|log-file" msgstr "fichier-journal" -#: src/scm/webid-oidc/hello-world.scm:74 src/scm/webid-oidc/program.scm:280 +#: src/scm/webid-oidc/hello-world.scm:59 src/scm/webid-oidc/program.scm:280 msgid "command-line|error-file" msgstr "fichier-erreur" -#: src/scm/webid-oidc/hello-world.scm:86 +#: src/scm/webid-oidc/hello-world.scm:71 #, scheme-format msgid "" "~a [OPTIONS]...\n" @@ -1172,49 +1162,29 @@ msgstr "" " -e FICHIER.err, --~a=FICHIER.err :\n" " redirige la sortie d’erreur du programme vers ce fichier.\n" -#: src/scm/webid-oidc/hello-world.scm:119 +#: src/scm/webid-oidc/hello-world.scm:104 #, scheme-format msgid "~a version ~a\n" msgstr "~a version ~a\n" -#: src/scm/webid-oidc/hello-world.scm:128 src/scm/webid-oidc/program.scm:642 +#: src/scm/webid-oidc/hello-world.scm:113 src/scm/webid-oidc/program.scm:642 msgid "" "You are legally required to link to the complete corresponding source code.\n" msgstr "" "Vous êtes légalement tenu de fournir un lien vers le code source " "correspondant.\n" -#: src/scm/webid-oidc/hello-world.scm:138 +#: src/scm/webid-oidc/hello-world.scm:123 msgid "The port should be a number between 0 and 65535.\n" msgstr "Le port doit être un nombre entre 0 et 65535.\n" -#: src/scm/webid-oidc/hello-world.scm:159 -#: src/scm/webid-oidc/resource-server.scm:304 -msgid "reason-phrase|Unauthorized" -msgstr "Non Autorisé" - -#: src/scm/webid-oidc/hello-world.scm:171 +#: src/scm/webid-oidc/hello-world.scm:150 msgid "<h1>Please authenticate</h1>" msgstr "<h1>Veuillez vous authentifier</h1>" -#: src/scm/webid-oidc/hello-world.scm:175 -msgid "<p>This page requires authentication with Solid.</p>" -msgstr "<p>Cette page requiert une authentification avec Solid.</p>" - -#: src/scm/webid-oidc/hello-world.scm:179 -#: src/scm/webid-oidc/resource-server.scm:312 -msgid "reason-phrase|Method Not Allowed" -msgstr "Méthode Non Autorisée" - -#: src/scm/webid-oidc/hello-world.scm:191 -msgid "<h1>Method not allowed</h1>" -msgstr "<h1>Méthode non autorisée</h1>" - -#: src/scm/webid-oidc/hello-world.scm:195 -msgid "<p>You can only use the <emph>GET</emph> method on this resource.</p>" -msgstr "" -"<p>Vous pouvez uniquement utiliser la méthode <emph>GET</emph> pour cette " -"ressource.</p>" +#: 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" @@ -2558,6 +2528,15 @@ msgstr "~a : j’ignore un groupe qui ne peut pas être téléchargé\n" msgid "reason-phrase|Forbidden" msgstr "Interdit" +#: src/scm/webid-oidc/resource-server.scm:304 +#: src/scm/webid-oidc/server/endpoint/hello.scm:54 +msgid "reason-phrase|Unauthorized" +msgstr "Non Autorisé" + +#: src/scm/webid-oidc/resource-server.scm:312 +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" @@ -2664,6 +2643,19 @@ 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/hello.scm:57 +msgid "<p>You are not authentified.</p>" +msgstr "<p>Vous n’êtes pas authentifié.</p>" + +#: src/scm/webid-oidc/server/endpoint/hello.scm:66 +#, scheme-format +msgid "<h1>Hello, ~a!</h1>" +msgstr "<h1>Bonjour, ~a !</h1>" + +#: src/scm/webid-oidc/server/endpoint/hello.scm:74 +msgid "<p>You are authenticated with Solid.</p>" +msgstr "<p>Vous êtes authentifié par Solid.</p>" + #: src/scm/webid-oidc/server/endpoint/reverse-proxy.scm:77 msgid "#:backend-uri should be an URI" msgstr "#:backend-uri doit être une URI" @@ -2932,6 +2924,18 @@ msgstr "Contenu :" msgid "Discard edits" msgstr "Rejeter les modifications" +#~ msgid "<p>The client is compatible with Solid.</p>" +#~ msgstr "<p>Le client est compatible avec Solid.</p>" + +#~ msgid "<h1>Method not allowed</h1>" +#~ msgstr "<h1>Méthode non autorisée</h1>" + +#~ msgid "" +#~ "<p>You can only use the <emph>GET</emph> method on this resource.</p>" +#~ msgstr "" +#~ "<p>Vous pouvez uniquement utiliser la méthode <emph>GET</emph> pour cette " +#~ "ressource.</p>" + #~ msgid "Disfluid" #~ msgstr "Disfluid" diff --git a/src/scm/webid-oidc/hello-world.scm b/src/scm/webid-oidc/hello-world.scm index 98b4703..4d97657 100644 --- a/src/scm/webid-oidc/hello-world.scm +++ b/src/scm/webid-oidc/hello-world.scm @@ -15,6 +15,8 @@ ;; along with this program. If not, see <https://www.gnu.org/licenses/>. (define-module (webid-oidc hello-world) + #:use-module (webid-oidc server endpoint) + #:use-module (webid-oidc server endpoint hello) #:use-module (webid-oidc resource-server) #:use-module (webid-oidc server log) #:use-module (webid-oidc web-i18n) @@ -28,32 +30,15 @@ #:use-module (ice-9 i18n) #:use-module (ice-9 getopt-long) #:use-module (ice-9 suspendable-ports) + #:use-module (ice-9 match) #:use-module (sxml simple) #:use-module (sxml match) #:use-module (srfi srfi-19) + #:use-module (srfi srfi-26) + #:use-module (oop goops) + #:duplicates (merge-generics) #:declarative? #t) -(define (hello-page id) - `(*TOP* - (*PI* xml "version=\"1.0\" encoding=\"utf-8\"") - (html (@ (xmlns "http://www.w3.org/1999/xhtml") - (xml:lang ,(W_ "xml-lang|en"))) - (body - ,(sxml-match - (xml->sxml - (format #f (W_ "<h1>Hello, ~a!</h1>") - (uri->string id) - (with-output-to-string - (lambda () - (sxml->xml - `(a (@ (href ,(uri->string id))) - ,(uri->string id))))))) - ((*TOP* ,title) title)) - ,(sxml-match - (xml->sxml - (format #f (W_ "<p>The client is compatible with Solid.</p>"))) - ((*TOP* ,p) p)))))) - (define-public (main) (setvbuf (current-output-port) 'none) (setvbuf (current-error-port) 'none) @@ -137,6 +122,7 @@ Options: (format (current-error-port) (G_ "The port should be a number between 0 and 65535.\n")) (exit 1)) + (define greeter (make <greeter>)) (let ((handler (lambda (request request-body) (when log-file @@ -144,55 +130,49 @@ Options: (when error-file (prepare-error-file error-file)) (parameterize ((web-locale request)) - (if (eq? (request-method request) 'GET) - (let ((agent (assoc-ref (request-headers request) 'xxx-agent))) - (if (and agent (string->uri agent)) - (values - (build-response - #:headers `((content-type application/xhtml+xml) - (source . ,means-string))) - (with-output-to-string - (lambda () - (sxml->xml (hello-page (string->uri agent)))))) - (values - (build-response #:code 401 - #:reason-phrase (W_ "reason-phrase|Unauthorized") - #:headers `((content-type application/xhtml+xml) - (source . ,means-string))) - (with-output-to-string - (lambda () - (sxml->xml - `(*TOP* (*PI* xml "version=\"1.0\" encoding=\"utf-8\"") - (html (@ (xmlns "http://www.w3.org/1999/xhtml") - (xml:lang ,(W_ "xml-lang|en"))) - (body - ,(sxml-match - (xml->sxml - (format #f (W_ "<h1>Please authenticate</h1>"))) - ((*TOP* ,title) title)) - ,(sxml-match - (xml->sxml - (format #f (W_ "<p>This page requires authentication with Solid.</p>"))) - ((*TOP* ,p) p))))))))))) - (values - (build-response #:code 405 - #:reason-phrase (W_ "reason-phrase|Method Not Allowed") - #:headers `((content-type application/xhtml+xml) - (source . ,means-string))) - (with-output-to-string - (lambda () - (sxml->xml - `(*TOP* (*PI* xml "version=\"1.0\" encoding=\"utf-8\"") - (html (@ (xmlns "http://www.w3.org/1999/xhtml") - (xml:lang ,(W_ "xml-lang|en"))) - (body - ,(sxml-match - (xml->sxml - (format #f (W_ "<h1>Method not allowed</h1>"))) - ((*TOP* ,title) title)) - ,(sxml-match - (xml->sxml - (format #f (W_ "<p>You can only use the <emph>GET</emph> method on this resource.</p>"))) - ((*TOP* ,p) p)))))))))))))) + (with-exception-handler + (lambda (exn) + (unless (web-exception? exn) + (raise-exception exn)) + (values + (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>Please authenticate</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 () + (set! request + (let ((user + (match (assq-ref (request-headers request) 'xxx-agent) + ((? string? (= string->uri (? uri? uri))) + uri) + (else #f)))) + (build-request (request-uri request) + #:meta (if user `((user . ,user)) '()) + #:headers (request-headers request) + #:version (request-version request) + #:method (request-method request)))) + (receive (response response-body response-meta) + (handle greeter request request-body) + (when (port? response-body) + (set! response-body + (read-response-body response))) + (values response response-body))) + #:unwind? #t))))) (install-suspendable-ports!) (run-server handler 'http (list #:port (string->number port-string)))))))))) diff --git a/src/scm/webid-oidc/server/endpoint/Makefile.am b/src/scm/webid-oidc/server/endpoint/Makefile.am index 51dee79..1e4ee16 100644 --- a/src/scm/webid-oidc/server/endpoint/Makefile.am +++ b/src/scm/webid-oidc/server/endpoint/Makefile.am @@ -16,8 +16,10 @@ dist_endpointserverwebidoidcmod_DATA += \ %reldir%/reverse-proxy.scm \ - %reldir%/authentication.scm + %reldir%/authentication.scm \ + %reldir%/hello.scm endpointserverwebidoidcgo_DATA += \ %reldir%/reverse-proxy.go \ - %reldir%/authentication.go + %reldir%/authentication.go \ + %reldir%/hello.go diff --git a/src/scm/webid-oidc/server/endpoint/hello.scm b/src/scm/webid-oidc/server/endpoint/hello.scm new file mode 100644 index 0000000..b03c8f4 --- /dev/null +++ b/src/scm/webid-oidc/server/endpoint/hello.scm @@ -0,0 +1,80 @@ +;; 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 hello) + #:use-module (webid-oidc errors) + #:use-module (webid-oidc server endpoint) + #:use-module (webid-oidc provider-confirmation) + #: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 + #:export + ( + <greeter> + )) + +(define-class <greeter> (<endpoint>)) + +(define-method (handle (endpoint <greeter>) request request-body) + (let ((user (assq-ref (request-meta request) 'user))) + (unless user + (raise-exception + (make-exception + (make-web-exception 401 (W_ "reason-phrase|Unauthorized")) + (make-user-message + (call-with-input-string + (format #f (W_ "<p>You are not authentified.</p>")) + xml->sxml))))) + (let ((page + `(*TOP* + (*PI* xml "version=\"1.0\" encoding=\"utf-8\"") + (html (@ (xmlns "http://www.w3.org/1999/xhtml") + (xml:lang ,(W_ "xml-lang|en"))) + (body + ,(xml->sxml + (format #f (W_ "<h1>Hello, ~a!</h1>") + (call-with-output-string + (lambda (port) + (sxml->xml + `(a (@ (href ,(uri->string user))) + ,(uri->string user)) + port))))) + ,(xml->sxml + (format #f (W_ "<p>You are authenticated with Solid.</p>")))))))) + (values + (build-response + #:headers `((content-type application/xhtml+xml))) + (call-with-output-string + (cute sxml->xml page <>)) + '())))) diff --git a/tests/Makefile.am b/tests/Makefile.am index 8cc262b..a35c853 100644 --- a/tests/Makefile.am +++ b/tests/Makefile.am @@ -69,7 +69,8 @@ TESTS = %reldir%/load-library.scm \ %reldir%/xml-accounts.scm \ %reldir%/reverse-proxy.scm \ %reldir%/reverse-proxy-502.scm \ - %reldir%/reverse-proxy-anonymous.scm + %reldir%/reverse-proxy-anonymous.scm \ + %reldir%/hello.scm EXTRA_DIST += $(TESTS) %reldir%/ChangeLog diff --git a/tests/hello.scm b/tests/hello.scm new file mode 100644 index 0000000..0c65b30 --- /dev/null +++ b/tests/hello.scm @@ -0,0 +1,68 @@ +;; 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 (tests hello) + #:use-module (webid-oidc server endpoint) + #:use-module (webid-oidc server endpoint hello) + #:use-module (webid-oidc testing) + #:use-module (webid-oidc offloading) + #:use-module ((webid-oidc parameters) #:prefix p:) + #:use-module (oop goops) + #:use-module (web server) + #:use-module (web request) + #:use-module (web response) + #:use-module (web uri) + #:use-module (ice-9 match) + #:use-module (ice-9 receive) + #:use-module (srfi srfi-26) + #:use-module (rnrs bytevectors) + #:declarative? #t + #:duplicates (merge-generics)) + +(define (drop-sxml-top element) + (match element + (('*TOP* thing) + thing) + ((root subtrees ...) + `(,root ,@(map drop-sxml-top subtrees))) + (x x))) + +(with-test-environment + "hello" + (lambda () + (define greeter (make <greeter>)) + (with-exception-handler + (lambda (exn) + (unless (and (web-exception? exn) + (equal? (drop-sxml-top (user-message-sxml exn)) + `(div (p "You are not authentified."))) + (eqv? (web-exception-code exn) 401) + (equal? (web-exception-reason-phrase exn) "Unauthorized")) + (exit 1) + #t)) + (lambda () + (handle greeter + (build-request (string->uri "https://example.com")) + #f) + (exit 2)) + #:unwind? #t) + (receive (response response-body response-meta) + (handle greeter + (build-request (string->uri "https://example.com") + #:meta `((user . ,(string->uri "https://example.com/profile/card#me")))) + #f) + (unless (eqv? (response-code response) 200) + (exit 3))))) |