An API to manipulate contents on the server

9 files changed, 223 insertions, 6 deletions

diff --git a/doc/webid-oidc.texi b/doc/webid-oidc.texi
index fb8bf63..66b9c6d 100644
--- a/doc/webid-oidc.texi
+++ b/doc/webid-oidc.texi
@@ -441,6 +441,7 @@ the seed.
 @menu
 * Running webid-oidc-reverse-proxy::
 * The authenticator::
+* Resources stored on the server::
 @end menu
 
 A Solid server is the server that manages your data. It needs to check
@@ -516,6 +517,55 @@ the subject of the access token. If an error happens, it is thrown;
 the function always returns a valid URI.
 @end deffn
 
+@node Resources stored on the server
+@section Resources stored on the server
+
+To store and serve resources, the server has two distinct
+mechanisms. A @dfn{content} is a read-only possible value for a
+resource, indexed by etags, and a @dfn{path} is a mutable value that
+indicates the etag of the resource, and of the auxiliary resources
+(description and ACL). With this separation, it is possible to
+atomically delete a resource and all associated auxiliary resources,
+by unlinking the corresponding @emph{path}. It is also possible to
+mutate separately the ACL and the resource itself without writing a
+copy for both.
+
+The @emph{content} API is contained in the
+@code{(webid-oidc server resource content)} module.
+
+@deffn function with-session @var{f} [@var{#:dir}]
+Call @var{f} with 5 arguments:
+@itemize
+@item
+a function to get the content-type of a given etag;
+@item
+a function to list the paths contained within the resource;
+@item
+a function to load the content of a given etag;
+@item
+a function to create a new content;
+@item
+a function to remove a content from the file system. It is still
+possible to query it with the first 3 functions, but new sessions will
+not see it.
+@end itemize
+
+Since the contents are read-only, it is possible to cache the value of
+the content in memory. This is why @var{f} should run within a session
+with memoization.
+
+Resources only store @emph{static} content, because the membership
+triples for containers is considered dynamic and not included in the
+representation.
+
+The first 3 functions as well as the last one are called with an etag,
+and the function to create a content is called with the content-type,
+list of contained paths, and (static) content.
+
+By default, the contents are stored within @var{XDG_DATA_HOME}, but it
+can be overriden by @var{#:dir}.
+@end deffn
+
 @node Running a client
 @chapter Running a client
 
diff --git a/src/Makefile.am b/src/Makefile.am
index 3dd6822..b61df70 100644
--- a/src/Makefile.am
+++ b/src/Makefile.am
@@ -14,6 +14,12 @@ godir = $(libdir)/guile/$(GUILE_EFFECTIVE_VERSION)/site-ccache
 webidoidcmoddir = $(moddir)/webid-oidc
 webidoidcgodir = $(godir)/webid-oidc
 
+serverwebidoidcmoddir = $(webidoidcmoddir)/server
+serverwebidoidcgodir = $(webidoidcgodir)/server
+
+resourceserverwebidoidcmoddir = $(serverwebidoidcmoddir)/resource
+resourceserverwebidoidcgodir = $(serverwebidoidcgodir)/resource
+
 dist_mod_DATA =
 mod_DATA =
 go_DATA =
@@ -22,8 +28,14 @@ dist_webidoidcmod_DATA =
 webidoidcmod_DATA =
 webidoidcgo_DATA =
 
-install_go_targets = install-webidoidcgoDATA
-install_mod_targets = install-webidoidcmodDATA install-dist_webidoidcmodDATA
+dist_serverwebidoidcmod_DATA =
+serverwebidoidcgo_DATA =
+
+dist_resourceserverwebidoidcmod_DATA =
+resourceserverwebidoidcgo_DATA =
+
+install_go_targets = install-webidoidcgoDATA install-serverwebidoidcgoDATA install-resourceserverwebidoidcgoDATA
+install_mod_targets = install-webidoidcmodDATA install-dist_webidoidcmodDATA install-dist_serverwebidoidcmodDATA install-dist_resourceserverwebidoidcmodDATA
 
 include %reldir%/base64/Makefile.am
 include %reldir%/random/Makefile.am
@@ -34,14 +46,15 @@ include %reldir%/pre-inst/Makefile.am
 include %reldir%/inst/Makefile.am
 include %reldir%/scm/Makefile.am
 
-CLEANFILES += $(go_DATA) $(webidoidcgo_DATA) $(mod_DATA) $(webidoidcmod_DATA)
+CLEANFILES += $(go_DATA) $(webidoidcgo_DATA) $(mod_DATA) $(webidoidcmod_DATA) \
+  $(serverwebidoidcgo_DATA) $(resourceserverwebidoidcgo_DATA)
 
 %canon_reldir%_libwebidoidc_la_SOURCES = %reldir%/gettext.h %reldir%/libwebidoidc.c %reldir%/utilities.h
 %canon_reldir%_libwebidoidc_la_LIBADD = $(noinst_LTLIBRARIES) $(GUILE_LIBS) $(NETTLE_LIBS)
 
 INDENTED += $(%canon_reldir%_libwebidoidc_la_SOURCES)
 
-$(go_DATA) $(webidoidcgo_DATA): %reldir%/libwebidoidc.la
+$(go_DATA) $(webidoidcgo_DATA) $(serverwebidoidcgo_DATA) $(resourceserverwebidoidcgo_DATA): %reldir%/libwebidoidc.la
 
 SUFFIXES += .c .x .scm .go
 .c.x:
diff --git a/src/scm/webid-oidc/Makefile.am b/src/scm/webid-oidc/Makefile.am
index af8746f..11f1b8b 100644
--- a/src/scm/webid-oidc/Makefile.am
+++ b/src/scm/webid-oidc/Makefile.am
@@ -57,3 +57,5 @@ webidoidcgo_DATA += \
   %reldir%/rdf-index.go
 
 EXTRA_DIST += %reldir%/ChangeLog
+
+include %reldir%/server/Makefile.am
diff --git a/src/scm/webid-oidc/server/Makefile.am b/src/scm/webid-oidc/server/Makefile.am
new file mode 100644
index 0000000..e0ca8d6
--- /dev/null
+++ b/src/scm/webid-oidc/server/Makefile.am
@@ -0,0 +1 @@
+include %reldir%/resource/Makefile.am
diff --git a/src/scm/webid-oidc/server/resource/Makefile.am b/src/scm/webid-oidc/server/resource/Makefile.am
new file mode 100644
index 0000000..88103cc
--- /dev/null
+++ b/src/scm/webid-oidc/server/resource/Makefile.am
@@ -0,0 +1,5 @@
+dist_resourceserverwebidoidcmod_DATA += \
+  %reldir%/content.scm
+
+resourceserverwebidoidcgo_DATA += \
+  %reldir%/content.go
diff --git a/src/scm/webid-oidc/server/resource/content.scm b/src/scm/webid-oidc/server/resource/content.scm
new file mode 100644
index 0000000..2bbf4f0
--- /dev/null
+++ b/src/scm/webid-oidc/server/resource/content.scm
@@ -0,0 +1,91 @@
+(define-module (webid-oidc server resource content)
+  #:use-module (webid-oidc errors)
+  #:use-module ((webid-oidc stubs) #:prefix stubs:)
+  #:use-module (webid-oidc rdf-index)
+  #:use-module ((webid-oidc refresh-token) #:prefix refresh:)
+  #:use-module (web uri)
+  #:use-module (rnrs bytevectors)
+  #:use-module (ice-9 exceptions)
+  #:use-module (ice-9 receive)
+  #:use-module (ice-9 optargs)
+  #:use-module (ice-9 iconv)
+  #:use-module (ice-9 textual-ports)
+  #:use-module (ice-9 binary-ports)
+  #:use-module (rnrs bytevectors)
+  #:use-module (oop goops)
+  #:export
+  (
+
+   with-session
+
+   ))
+
+(define (default-dir)
+  (string-append (refresh:default-dir) "/server"))
+
+(define-class <content> ()
+  (content-type #:init-keyword #:content-type #:getter content-type)
+  (contained #:init-keyword #:contained #:getter contained)
+  (static-content #:init-keyword #:static-content #:getter static-content))
+
+(define (load-content session dir etag)
+  (let ((first-char (substring etag 0 1))
+        (rest (substring etag 1)))
+    (call-with-input-file (format #f "~a/content/~a/~a" dir first-char rest)
+      (lambda (port)
+        (let ((properties (read port)))
+          (set-port-encoding! port "ISO-8859-1")
+          (let ((ret
+                 (make <content>
+                   #:content-type (assq-ref properties 'content-type)
+                   #:contained (assq-ref properties 'contained)
+                   #:static-content
+                   (string->bytevector (get-string-all port) "ISO-8859-1"))))
+            (hash-set! session etag ret)
+            ret))))))
+
+(define (new-content session dir content-type contained static-content)
+  (when (string? static-content)
+    (set! static-content (string->utf8 static-content)))
+  (let ((etag (stubs:random 12)))
+    (let ((first-char (substring etag 0 1))
+          (rest (substring etag 1)))
+      (stubs:mkdir-p (format #f "~a/content/~a" dir first-char))
+      (let ((port (open (format #f "~a/content/~a/~a" dir first-char rest)
+                        (logior O_WRONLY O_CREAT O_EXCL))))
+        (write `((content-type . ,content-type)
+                 (contained . ,contained)) port)
+        (set-port-encoding! port "ISO-8859-1")
+        (display (bytevector->string static-content "ISO-8859-1") port)
+        (close-port port)
+        (hash-set! session
+                   etag
+                   (make <content>
+                     #:content-type content-type
+                     #:contained contained
+                     #:static-content static-content))
+        etag))))
+
+(define (delete-content dir etag)
+  (let ((first-char (substring etag 0 1))
+        (rest (substring etag 1)))
+    (delete-file (format #f "~a/content/~a/~a" dir first-char rest))))
+
+(define* (with-session f #:key (dir default-dir))
+  (when (thunk? dir)
+    (set! dir (dir)))
+  (let ((session (make-hash-table)))
+    (define (do-load etag)
+      (or (hash-ref session etag)
+          (load-content session dir etag)))
+    (define (get-content-type etag)
+      (content-type (do-load etag)))
+    (define (get-contained etag)
+      (contained (do-load etag)))
+    (define (get-static-content etag)
+      (static-content (do-load etag)))
+    (define (do-create content-type contained static-content)
+      (new-content session dir content-type contained static-content))
+    (define (do-delete etag)
+      (delete-content dir etag))
+    (f get-content-type get-contained get-static-content do-create do-delete)))
diff --git a/src/scm/webid-oidc/stubs.scm b/src/scm/webid-oidc/stubs.scm
index 6ac5c3c..54ba25e 100644
--- a/src/scm/webid-oidc/stubs.scm
+++ b/src/scm/webid-oidc/stubs.scm
@@ -121,7 +121,7 @@
 
 (export (fixed:scm->json . scm->json))
 
-(define (mkdir-p name)
+(define-public (mkdir-p name)
   (catch 'system-error
     (lambda ()
       (mkdir name))
diff --git a/tests/Makefile.am b/tests/Makefile.am
index 8173b9b..14101ea 100644
--- a/tests/Makefile.am
+++ b/tests/Makefile.am
@@ -40,7 +40,8 @@ TESTS = %reldir%/load-library.scm \
   %reldir%/resource-server.scm \
   %reldir%/client-authorization.scm \
   %reldir%/client-token.scm \
-  %reldir%/client-manifest-not-modified.scm
+  %reldir%/client-manifest-not-modified.scm \
+  %reldir%/server-content.scm
 
 EXTRA_DIST += $(TESTS) %reldir%/ChangeLog
 
diff --git a/tests/server-content.scm b/tests/server-content.scm
new file mode 100644
index 0000000..c546dea
--- /dev/null
+++ b/tests/server-content.scm
@@ -0,0 +1,54 @@
+(use-modules (webid-oidc server resource content)
+             (webid-oidc fetch)
+             (webid-oidc testing)
+             (webid-oidc errors)
+             (web uri)
+             (web response)
+             (rnrs bytevectors)
+             (ice-9 optargs)
+             (ice-9 receive)
+             (oop goops))
+
+(with-test-environment
+ "server-content"
+ (lambda ()
+   (false-if-exception
+    ;; This is the etag of the root with the seed of the test
+    (delete-file "tests/server-content.home/webid-oidc/server/content/6/8OMG_V5x-KmI6TI"))
+   (false-if-exception
+    ;; This is the etag of /wtf
+    (delete-file "tests/server-content.home/webid-oidc/server/content/X/hqM_2Avn5_egTzs"))
+   (receive (/ /wtf)
+       (with-session
+        (lambda (content-type contained static-content create delete)
+          (let ((/ (create 'text/turtle '("/whatever" "/you" "/want")
+                           "# This is the content of the root"))
+                (/wtf (create 'text/plain '() "This is the content of the wtf")))
+            (unless (equal? (static-content /wtf)
+                            (string->utf8 "This is the content of the wtf"))
+              (exit 1))
+            (delete /wtf)
+            (unless (eq? (content-type /wtf) 'text/plain)
+              ;; It has survived in the cache
+              (exit 2))
+            (values / /wtf))))
+     (with-session
+      (lambda (content-type contained static-content create delete)
+        (unless
+            (with-exception-handler
+                (lambda (error)
+                  ;; Good, we can’t load /wtf
+                  #t)
+              (lambda ()
+                (content-type /wtf)
+                #f)
+              #:unwind? #t)
+          ;;We could read /wtf, it has not been deleted
+          (exit 3))
+        (unless (eq? (content-type /) 'text/turtle)
+          (exit 4))
+        (unless (equal? (contained /) '("/whatever" "/you" "/want"))
+          (exit 5))
+        (unless (equal? (static-content /)
+                        (string->utf8 "# This is the content of the root"))
+          (exit 6)))))))