server: add the endpoint API

4 files changed, 171 insertions, 6 deletions

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 +=