server: add the endpoint API

8 files changed, 286 insertions, 21 deletions

diff --git a/doc/disfluid.texi b/doc/disfluid.texi
index be32b85..fa5347a 100644
--- a/doc/disfluid.texi
+++ b/doc/disfluid.texi
@@ -73,6 +73,7 @@ A PDF version of this manual is available at
 * Caching on server side::
 * The HTTP Link header::
 * Content negociation::
+* Server endpoints::
 * Running an Identity Provider::
 * Running a Resource Server::
 * Running a client::
@@ -1493,6 +1494,74 @@ Currently, the only conversions are from and to @emph{Turtle} and
 @emph{N-Quads}.
 @end deffn
 
+@node Server endpoints
+@chapter Server endpoints
+
+The disfluid server consists of a set of endpoints that handle
+requests. The @emph{(webid-oidc server endpoint)} module defines the
+base building blocks.
+
+@deftp {Class} <endpoint> () @var{host} @var{path}
+All endpoints define a @var{host} for which they are relevant, and an
+absolute @var{path}. If a request comes with a matching host and a
+matching path prefix, then it will be handled by this endpoint.
+
+If @var{host} is @code{#f}, then this endpoint will be used for all
+hosts.
+
+You can construct an endpoint with the @code{#:@var{host}} and
+@code{#:@var{path}} keyword arguments: the former is a string
+(defaults to @code{#f}), and the latter is a string starting with
+@code{"/"} (defaults to @code{"/"}).
+@end deftp
+
+@deffn {Generic} handle @var{endpoint} @var{request} @var{request-body}
+Handle @var{request} with @var{endpoint}.
+
+@var{request} is the request, in the form of an object from
+@emph{(web request)}. @var{request-body} is @code{#f}, a string or a
+bytevector.
+
+Return 3 values: a response, a response body (a string, bytevector,
+input port, or @code{#f} if no body is expected), and some response
+meta-data.
+@end deffn
+
+@deffn {Generic} host @var{endpoint}
+Return the host name @var{endpoint} is configured to respond to.
+@end deffn
+
+@deffn {Generic} path @var{endpoint}
+Return the path prefix @var{endpoint} is configured to respond to.
+@end deffn
+
+@deffn {Generic} relevant? @var{endpoint} @var{request}
+Check if @var{endpoint} is configured to respond to @var{request}.
+@end deffn
+
+@menu
+* Router endpoint::
+@end menu
+
+@node Router endpoint
+@section Router endpoint
+The first non-trivial handler is for the router endpoint, defined in
+@emph{(webid-oidc server endpoint)}.
+
+@deftp {Class} <router> (<endpoint>) @var{routed}
+The router has a list of endpoints, and chooses which one will handle
+an incoming request based on the request fields. The @var{routed}
+endpoints is a list of endpoints. You can set it at construction time
+with @code{#:@var{routed}}.
+
+The router will check if the @var{routed} endpoints are relevant, in
+turn, or return a 404 Not Found response if no endpoint is relevant.
+@end deftp
+
+@deffn {Generic} routed @var{router}
+Return the list of endpoints for @var{router}.
+@end deffn
+
 @node Running an Identity Provider
 @chapter Running an Identity Provider
 
diff --git a/po/POTFILES.in b/po/POTFILES.in
index dd6cd27..99578f5 100644
--- a/po/POTFILES.in
+++ b/po/POTFILES.in
@@ -78,6 +78,7 @@ src/scm/webid-oidc/serializable.scm
 src/scm/webid-oidc/serve.scm
 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/log.scm
 src/scm/webid-oidc/server/precondition.scm
 src/scm/webid-oidc/server/read.scm
diff --git a/po/disfluid.pot b/po/disfluid.pot
index 26edb09..6468cb0 100644
--- a/po/disfluid.pot
+++ b/po/disfluid.pot
@@ -8,7 +8,7 @@ msgid ""
 msgstr ""
 "Project-Id-Version: disfluid SNAPSHOT\n"
 "Report-Msgid-Bugs-To: vivien@planete-kraus.eu\n"
-"POT-Creation-Date: 2021-10-12 22:48+0200\n"
+"POT-Creation-Date: 2021-10-19 11:29+0200\n"
 "PO-Revision-Date: YEAR-MO-DA HO:MI+ZONE\n"
 "Last-Translator: FULL NAME <EMAIL@ADDRESS>\n"
 "Language-Team: LANGUAGE <LL@li.org>\n"
@@ -2222,6 +2222,27 @@ msgstr ""
 msgid "cannot POST to an auxiliary resource path, ~s"
 msgstr ""
 
+#: src/scm/webid-oidc/server/endpoint.scm:65
+msgid "#:host should be a string or #f"
+msgstr ""
+
+#: src/scm/webid-oidc/server/endpoint.scm:70
+msgid "#:path should be an absolute path"
+msgstr ""
+
+#: src/scm/webid-oidc/server/endpoint.scm:90
+#, scheme-format
+msgid "#:routed element ~a should be an endpoint"
+msgstr ""
+
+#: src/scm/webid-oidc/server/endpoint.scm:95
+msgid "#:routed should be a list of endpoints"
+msgstr ""
+
+#: src/scm/webid-oidc/server/endpoint.scm:128 src/ui/error-page.glade:73
+msgid "Not Found"
+msgstr ""
+
 #: src/scm/webid-oidc/server/read.scm:101
 #, scheme-format
 msgid "the auxiliary resource of type ~s at ~s is absent"
@@ -2389,10 +2410,6 @@ msgstr ""
 msgid "404"
 msgstr ""
 
-#: src/ui/error-page.glade:73
-msgid "Not Found"
-msgstr ""
-
 #: src/ui/link-widget.glade:20
 msgid "https://example.com"
 msgstr ""
diff --git a/po/fr.po b/po/fr.po
index 5ae942b..59df1e2 100644
--- a/po/fr.po
+++ b/po/fr.po
@@ -2,8 +2,8 @@ msgid ""
 msgstr ""
 "Project-Id-Version: webid-oidc 0.0.0\n"
 "Report-Msgid-Bugs-To: vivien@planete-kraus.eu\n"
-"POT-Creation-Date: 2021-10-12 22:48+0200\n"
-"PO-Revision-Date: 2021-10-12 22:49+0200\n"
+"POT-Creation-Date: 2021-10-19 11:29+0200\n"
+"PO-Revision-Date: 2021-10-18 13:25+0200\n"
 "Last-Translator: Vivien Kraus <vivien@planete-kraus.eu>\n"
 "Language-Team: French <vivien@planete-kraus.eu>\n"
 "Language: fr\n"
@@ -2618,6 +2618,27 @@ msgstr "la ressource créée ne peut pas avoir de triplets de contention"
 msgid "cannot POST to an auxiliary resource path, ~s"
 msgstr "impossible de POSTer vers un chemin de ressource auxiliaire, ~s"
 
+#: src/scm/webid-oidc/server/endpoint.scm:65
+msgid "#:host should be a string or #f"
+msgstr "#:host doit être une chaîne de caractères ou #f"
+
+#: src/scm/webid-oidc/server/endpoint.scm:70
+msgid "#:path should be an absolute path"
+msgstr "#:path doit être un chemin URI absolu"
+
+#: src/scm/webid-oidc/server/endpoint.scm:90
+#, scheme-format
+msgid "#:routed element ~a should be an endpoint"
+msgstr "élément #:routed ~a doit être un terminal"
+
+#: src/scm/webid-oidc/server/endpoint.scm:95
+msgid "#:routed should be a list of endpoints"
+msgstr "#:routed doit être une liste de terminaux"
+
+#: src/scm/webid-oidc/server/endpoint.scm:128 src/ui/error-page.glade:73
+msgid "Not Found"
+msgstr "Non Trouvé"
+
 #: src/scm/webid-oidc/server/read.scm:101
 #, scheme-format
 msgid "the auxiliary resource of type ~s at ~s is absent"
@@ -2792,10 +2813,6 @@ msgstr "La requête a échoué :"
 msgid "404"
 msgstr "404"
 
-#: src/ui/error-page.glade:73
-msgid "Not Found"
-msgstr "Non Trouvé"
-
 #: src/ui/link-widget.glade:20
 msgid "https://example.com"
 msgstr "https://exemple.com"
@@ -3370,10 +3387,6 @@ msgstr "Rejeter les modifications"
 #~ "raison ~s"
 
 #, scheme-format
-#~ msgid "the header ~a should be present"
-#~ msgstr "l’en-tête ~a devrait être présent"
-
-#, scheme-format
 #~ msgid "the server response wasn't expected: ~s (because ~a)"
 #~ msgstr "la réponse du serveur est inattendue : ~s (parce que ~a)"
 
diff --git a/src/Makefile.am b/src/Makefile.am
index e25a2e6..4d19c38 100644
--- a/src/Makefile.am
+++ b/src/Makefile.am
@@ -36,6 +36,9 @@ serverwebidoidcgodir = $(webidoidcgodir)/server
 resourceserverwebidoidcmoddir = $(serverwebidoidcmoddir)/resource
 resourceserverwebidoidcgodir = $(serverwebidoidcgodir)/resource
 
+endpointserverwebidoidcmoddir = $(serverwebidoidcmoddir)/endpoint
+endpointserverwebidoidcgodir = $(serverwebidoidcgodir)/endpoint
+
 clientwebidoidcmoddir = $(webidoidcmoddir)/client
 clientwebidoidcgodir = $(webidoidcgodir)/client
 
@@ -59,11 +62,14 @@ clientwebidoidcgo_DATA =
 dist_resourceserverwebidoidcmod_DATA =
 resourceserverwebidoidcgo_DATA =
 
+dist_endpointserverwebidoidcmod_DATA =
+endpointserverwebidoidcgo_DATA =
+
 dist_guiclientwebidoidcmod_DATA =
 guiclientwebidoidcgo_DATA =
 
-install_go_targets = install-webidoidcgoDATA install-serverwebidoidcgoDATA install-resourceserverwebidoidcgoDATA install-clientwebidoidcgoDATA install-guiclientwebidoidcgoDATA
-install_mod_targets = install-webidoidcmodDATA install-dist_webidoidcmodDATA install-dist_serverwebidoidcmodDATA install-dist_resourceserverwebidoidcmodDATA install-dist_clientwebidoidcmodDATA install-dist_guiclientwebidoidcmodDATA
+install_go_targets = install-webidoidcgoDATA install-serverwebidoidcgoDATA install-resourceserverwebidoidcgoDATA install-endpointserverwebidoidcgoDATA install-clientwebidoidcgoDATA install-guiclientwebidoidcgoDATA
+install_mod_targets = install-webidoidcmodDATA install-dist_webidoidcmodDATA install-dist_serverwebidoidcmodDATA install-dist_resourceserverwebidoidcmodDATA install-dist_endpointserverwebidoidcmodDATA install-dist_clientwebidoidcmodDATA install-dist_guiclientwebidoidcmodDATA
 
 include %reldir%/base64/Makefile.am
 include %reldir%/random/Makefile.am
@@ -76,7 +82,8 @@ include %reldir%/scm/Makefile.am
 include %reldir%/ui/Makefile.am
 
 CLEANFILES += $(go_DATA) $(webidoidcgo_DATA) $(mod_DATA) $(webidoidcmod_DATA) \
-  $(serverwebidoidcgo_DATA) $(clientwebidoidcgo_DATA) $(resourceserverwebidoidcgo_DATA) \
+  $(serverwebidoidcgo_DATA) $(clientwebidoidcgo_DATA) \
+  $(resourceserverwebidoidcgo_DATA) $(endpointserverwebidoidcgo_DATA) \
   $(guiclientwebidoidcgo_DATA)
 
 .PHONY: clean-xdg-extra-data-dir
@@ -91,7 +98,7 @@ clean-xdg-extra-data-dir:
 
 INDENTED += $(%canon_reldir%_libwebidoidc_la_SOURCES)
 
-$(go_DATA) $(webidoidcgo_DATA) $(serverwebidoidcgo_DATA) $(clientwebidoidcgo_DATA) $(resourceserverwebidoidcgo_DATA) $(guiclientwebidoidcgo_DATA): %reldir%/libwebidoidc.la xdg-extra-data-dir/glib-2.0/schemas/gschemas.compiled xdg-extra-data-dir/glib-2.0/schemas/eu.planete_kraus.Disfluid.gschema.xml
+$(go_DATA) $(webidoidcgo_DATA) $(serverwebidoidcgo_DATA) $(clientwebidoidcgo_DATA) $(resourceserverwebidoidcgo_DATA) $(endpointserverwebidoidcgo_DATA) $(guiclientwebidoidcgo_DATA): %reldir%/libwebidoidc.la xdg-extra-data-dir/glib-2.0/schemas/gschemas.compiled xdg-extra-data-dir/glib-2.0/schemas/eu.planete_kraus.Disfluid.gschema.xml
 
 SUFFIXES += .c .x .scm .go
 .c.x:
diff --git a/src/scm/webid-oidc/server/Makefile.am b/src/scm/webid-oidc/server/Makefile.am
index 365b878..fd33462 100644
--- a/src/scm/webid-oidc/server/Makefile.am
+++ b/src/scm/webid-oidc/server/Makefile.am
@@ -20,7 +20,8 @@ dist_serverwebidoidcmod_DATA += \
   %reldir%/precondition.scm \
   %reldir%/update.scm \
   %reldir%/delete.scm \
-  %reldir%/log.scm
+  %reldir%/log.scm \
+  %reldir%/endpoint.scm
 
 serverwebidoidcgo_DATA += \
   %reldir%/create.go \
@@ -28,6 +29,8 @@ serverwebidoidcgo_DATA += \
   %reldir%/precondition.go \
   %reldir%/update.go \
   %reldir%/delete.go \
-  %reldir%/log.go
+  %reldir%/log.go \
+  %reldir%/endpoint.go
 
 include %reldir%/resource/Makefile.am
+include %reldir%/endpoint/Makefile.am
diff --git a/src/scm/webid-oidc/server/endpoint.scm b/src/scm/webid-oidc/server/endpoint.scm
new file mode 100644
index 0000000..d327139
--- /dev/null
+++ b/src/scm/webid-oidc/server/endpoint.scm
@@ -0,0 +1,136 @@
+;; 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)
+  #:use-module (webid-oidc errors)
+  #: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 (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
+  (
+   <endpoint>
+   host
+   path
+   relevant?
+
+   <router>
+   routed
+
+   handle
+   ))
+
+(define-class <endpoint> ()
+  (host #:init-keyword #:host #:getter host #:init-value #f)
+  (path #:init-keyword #:path #:getter path  #:init-value "/"))
+
+(define-method (initialize (endpoint <endpoint>) initargs)
+  (next-method)
+  (let-keywords
+   initargs #t
+   ((host #f)
+    (path "/"))
+   (unless (or (not host) (string? host))
+     (scm-error 'wrong-type-arg "make <endpoint>"
+                (G_ "#:host should be a string or #f")
+                '()
+                (list host)))
+   (unless (and (string? path) (string-prefix? "/" path))
+     (scm-error 'wrong-type-arg "make <endpoint>"
+                (G_ "#:path should be an absolute path")
+                '()
+                (list path)))))
+
+(define-class <router> (<endpoint>)
+  (routed #:init-keyword #:routed #:getter routed #:init-value '()))
+
+(define-method (initialize (endpoint <router>) initargs)
+  (next-method)
+  (let-keywords
+   initargs #t
+   ((routed '()))
+   (let check-routed ((routed routed)
+                      (i 0))
+     (match routed
+       (() #t)
+       (((? (cute is-a? <> <endpoint>)) routed ...)
+        (check-routed routed (+ i 1)))
+       ((not-an-endpoint _ ...)
+        (scm-error 'wrong-type-arg "make <router>"
+                   (format #f (G_ "#:routed element ~a should be an endpoint") i)
+                   '()
+                   (list not-an-endpoint)))
+       (else
+        (scm-error 'wrong-type-arg "make <router>"
+                   (G_ "#:routed should be a list of endpoints")
+                   '()
+                   (list routed)))))))
+
+(define-method (relevant? (endpoint <endpoint>) request)
+  (let ((requested-host
+         (match (request-host request)
+           ((or ((? string? host) . _)
+                (? string? host))
+            host)
+           (else #f)))
+        (requested-path
+         (split-and-decode-uri-path
+          (uri-path (request-uri request)))))
+    (and (or (not (host endpoint))
+             (equal? (host endpoint) requested-host))
+         (let check-path ((path (split-and-decode-uri-path (path endpoint)))
+                          (requested-path requested-path))
+           (match `(,path ,requested-path)
+             ((() _) #t)
+             ((_ ()) #f)
+             (((element path ...)
+               (requested-element requested-path ...))
+              (and (equal? element requested-element)
+                   (check-path path requested-path))))))))
+
+(define-method (handle (endpoint <router>) request request-body)
+  (let find-router ((routed (routed endpoint)))
+    (match routed
+      (()
+       (values
+        (build-response
+         #:code 404
+         #:reason-phrase (W_ "Not Found"))
+        #f
+        '()))
+      (((and router
+             (? (cute relevant? <> request)))
+        _ ...)
+       (handle router request request-body))
+      ((_ routed ...)
+       (find-router routed)))))
diff --git a/src/scm/webid-oidc/server/endpoint/Makefile.am b/src/scm/webid-oidc/server/endpoint/Makefile.am
new file mode 100644
index 0000000..e32794d
--- /dev/null
+++ b/src/scm/webid-oidc/server/endpoint/Makefile.am
@@ -0,0 +1,19 @@
+# disfluid, implementation of the Solid specification
+# Copyright (C) 2021  Vivien Kraus
+
+# This program is free software: you can redistribute it and/or modify
+# it under the terms of the GNU Affero General Public License as
+# published by the Free Software Foundation, either version 3 of the
+# License, or (at your option) any later version.
+
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU Affero General Public License for more details.
+
+# You should have received a copy of the GNU Affero General Public License
+# along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+dist_endpointserverwebidoidcmod_DATA +=
+
+endpointserverwebidoidcgo_DATA +=