Content API: use GOOPS for the cache

7 files changed, 656 insertions, 576 deletions

diff --git a/src/scm/webid-oidc/server/create.scm b/src/scm/webid-oidc/server/create.scm
index 0558ff3..6c2a619 100644
--- a/src/scm/webid-oidc/server/create.scm
+++ b/src/scm/webid-oidc/server/create.scm
@@ -119,58 +119,58 @@
              (types-indicate-container? (cdr types))))))
 
 (define* (create server-name owner user container types slug content-type content)
-  (check-acl-can-append server-name container owner user)
-  (unless (and slug (not (equal? slug "")))
-    (set! slug (stubs:random 12)))
-  (when (string-contains slug "/")
-    (let ((i (string-contains slug "/")))
-      (set! slug (substring slug 0 i))))
-  (let ((container? (types-indicate-container? types)))
-    (let ((doc-uri
-           (build-uri
-            (uri-scheme server-name)
-            #:userinfo (uri-userinfo server-name)
-            #:host (uri-host server-name)
-            #:port (uri-port server-name)
-            #:path
-            (string-append
-             "/"
-             (encode-and-join-uri-path
-              (append (split-and-decode-uri-path container)
-                      (list slug)))
-             ;; There’s no risk to have // here, because slug is
-             ;; non-empty.
-             (if container? "/" "")))))
-      (when (auxiliary-path? (uri-path doc-uri))
-        (let ((final-message
-               (format #f (G_ "cannot POST to an auxiliary resource path, ~s")
-                       (uri-path doc-uri))))
-          (raise-exception
-           (make-exception
-            (make-path-is-auxiliary (uri-path doc-uri))
-            (make-exception-with-message final-message)))))
-      (when container?
-        (without-containment-triples doc-uri content-type content))
-      (with-session
-       (lambda (load-content-type load-contained load-static-content
-                                  do-create do-delete)
-         (catch 'slug-already-exists
-           (lambda ()
-             (update-path
-              (uri-path doc-uri)
-              (lambda (etag auxiliary)
-                (when etag
-                  (throw 'slug-already-exists))
-                (values
-                 (do-create content-type (and container? '()) content)
-                 '()))
-              load-content-type load-contained load-static-content
-              do-create do-delete)
-             doc-uri)
-           (lambda error
-             (create server-name owner user container types
-                     (string-append slug "-" (stubs:random 12))
-                     content-type content))))))))
+  (parameterize ((current-content-cache (make <content-cache>)))
+    (check-acl-can-append server-name container owner user)
+    (unless (and slug (not (equal? slug "")))
+      (set! slug (stubs:random 12)))
+    (when (string-contains slug "/")
+      (let ((i (string-contains slug "/")))
+        (set! slug (substring slug 0 i))))
+    (let ((container? (types-indicate-container? types)))
+      (let ((doc-uri
+             (build-uri
+              (uri-scheme server-name)
+              #:userinfo (uri-userinfo server-name)
+              #:host (uri-host server-name)
+              #:port (uri-port server-name)
+              #:path
+              (string-append
+               "/"
+               (encode-and-join-uri-path
+                (append (split-and-decode-uri-path container)
+                        (list slug)))
+               ;; There’s no risk to have // here, because slug is
+               ;; non-empty.
+               (if container? "/" "")))))
+        (when (auxiliary-path? (uri-path doc-uri))
+          (let ((final-message
+                 (format #f (G_ "cannot POST to an auxiliary resource path, ~s")
+                         (uri-path doc-uri))))
+            (raise-exception
+             (make-exception
+              (make-path-is-auxiliary (uri-path doc-uri))
+              (make-exception-with-message final-message)))))
+        (when container?
+          (without-containment-triples doc-uri content-type content))
+        (parameterize ((current-content-cache (make <content-cache>)))
+          (catch 'slug-already-exists
+            (lambda ()
+              (update-path
+               (uri-path doc-uri)
+               (lambda (main auxiliary)
+                 (when main
+                   (throw 'slug-already-exists))
+                 (values
+                  (make <content>
+                    #:content-type content-type
+                    #:contained (and container? '())
+                    #:static-content content)
+                  '())))
+              doc-uri)
+            (lambda error
+              (create server-name owner user container types
+                      (string-append slug "-" (stubs:random 12))
+                      content-type content))))))))
 
 (define (create-root server-name owner)
   (define (fix-angle-aux accu chars)
@@ -185,29 +185,32 @@
             (fix-angle-aux (append next-accu accu) rest)))))
   (define (fix-angle str)
     (fix-angle-aux '() (string->list str)))
-  (with-session
-   (lambda (load-content-type load-contained load-static-content
-                              do-create do-delete)
-     (catch 'already-exists
-       (lambda ()
-         (update-path
-          "/"
-          (lambda (etag auxiliary)
-            (when etag
-              (throw 'already-exists))
-            (let ((root-uri
-                   (build-uri
-                    (uri-scheme server-name)
-                    #:userinfo (uri-userinfo server-name)
-                    #:host (uri-host server-name)
-                    #:port (uri-port server-name)
-                    #:path "/")))
-              (values
-               (do-create 'text/turtle '() "")
-               (list
-                (cons (string->uri "http://www.w3.org/ns/auth/acl#accessControl")
-                      (do-create 'text/turtle #f
-                                 (format #f "@prefix acl: <http://www.w3.org/ns/auth/acl#> .
+  (parameterize ((current-content-cache (make <content-cache>)))
+    (catch 'already-exists
+      (lambda ()
+        (update-path
+         "/"
+         (lambda (main auxiliary)
+           (when main
+             (throw 'already-exists))
+           (let ((root-uri
+                  (build-uri
+                   (uri-scheme server-name)
+                   #:userinfo (uri-userinfo server-name)
+                   #:host (uri-host server-name)
+                   #:port (uri-port server-name)
+                   #:path "/")))
+             (values
+              (make <content>
+                #:content-type 'text/turtle
+                #:contained '()
+                #:static-content "")
+              (list
+               `(,(string->uri "http://www.w3.org/ns/auth/acl#accessControl")
+                 . ,(make <content>
+                      #:content-type 'text/turtle
+                      #:static-content
+                      (format #f "@prefix acl: <http://www.w3.org/ns/auth/acl#> .
 
 <#default>
   a acl:Authorization;
@@ -216,66 +219,68 @@
   acl:mode acl:Read, acl:Write, acl:Control;
   acl:default <~a>.
 "
-                                         (fix-angle (uri->string root-uri))
-                                         (fix-angle (uri->string owner))
-                                         (fix-angle
-                                          (uri->string
-                                           (build-uri (uri-scheme root-uri)
-                                                      #:userinfo (uri-userinfo root-uri)
-                                                      #:host (uri-host root-uri)
-                                                      #:port (uri-port root-uri)
-                                                      #:path "/"))))))))))
-          load-content-type load-contained load-static-content
-          do-create do-delete)
-         #t)
-       (lambda error
-         #f))
-     (when (and (equal? (uri-scheme server-name)
-                        (uri-scheme owner))
-                (equal? (uri-userinfo server-name)
-                        (uri-userinfo owner))
-                (equal? (uri-host server-name)
-                        (uri-host owner))
-                (equal? (uri-port server-name)
-                        (uri-port owner)))
-       ;; We need to make sure that the profile exists
-       (catch 'already-exists
-         (lambda ()
-           (update-path
-            (uri-path owner)
-            (lambda (etag auxiliary)
-              (when etag
-                (throw 'already-exists))
-              (values
-               (do-create 'text/turtle #f
-                          (format #f "@prefix foaf: <http://xmlns.com/foaf/0.1/> .
+                              (fix-angle (uri->string root-uri))
+                              (fix-angle (uri->string owner))
+                              (fix-angle
+                               (uri->string
+                                (build-uri (uri-scheme root-uri)
+                                           #:userinfo (uri-userinfo root-uri)
+                                           #:host (uri-host root-uri)
+                                           #:port (uri-port root-uri)
+                                           #:path "/")))))))))))
+        #t)
+      (lambda error
+        #f))
+    (when (and (equal? (uri-scheme server-name)
+                       (uri-scheme owner))
+               (equal? (uri-userinfo server-name)
+                       (uri-userinfo owner))
+               (equal? (uri-host server-name)
+                       (uri-host owner))
+               (equal? (uri-port server-name)
+                       (uri-port owner)))
+      ;; We need to make sure that the profile exists
+      (catch 'already-exists
+        (lambda ()
+          (update-path
+           (uri-path owner)
+           (lambda (main auxiliary)
+             (when main
+               (throw 'already-exists))
+             (values
+              (make <content>
+                #:content-type 'text/turtle
+                #:static-content
+                (format #f "@prefix foaf: <http://xmlns.com/foaf/0.1/> .
 @prefix ldp: <http://www.w3.org/ns/ldp#> .
 
 <~a~a> a foaf:Person .
 "
-                                  (if (uri-query owner)
-                                      (string-append
-                                       "?"
-                                       (fix-angle
-                                        (uri-encode (uri-query owner))))
-                                      "")
-                                  (if (uri-fragment owner)
-                                      (string-append
-                                       "#"
-                                       (fix-angle
-                                        (uri-encode (uri-fragment owner))))
-                                      "")))
-               (list
-                (cons (string->uri "http://www.w3.org/ns/auth/acl#accessControl")
-                      (let ((doc-uri
-                             (build-uri
-                              (uri-scheme owner)
-                              #:userinfo (uri-userinfo owner)
-                              #:host (uri-host owner)
-                              #:port (uri-port owner)
-                              #:path (uri-path owner))))
-                        (do-create 'text/turtle #f
-                                   (format #f "@prefix acl: <http://www.w3.org/ns/auth/acl#> .
+                        (if (uri-query owner)
+                            (string-append
+                             "?"
+                             (fix-angle
+                              (uri-encode (uri-query owner))))
+                            "")
+                        (if (uri-fragment owner)
+                            (string-append
+                             "#"
+                             (fix-angle
+                              (uri-encode (uri-fragment owner))))
+                            "")))
+              (list
+               `(,(string->uri "http://www.w3.org/ns/auth/acl#accessControl")
+                 . ,(let ((doc-uri
+                           (build-uri
+                            (uri-scheme owner)
+                            #:userinfo (uri-userinfo owner)
+                            #:host (uri-host owner)
+                            #:port (uri-port owner)
+                            #:path (uri-path owner))))
+                      (make <content>
+                        #:content-type 'text/turtle
+                        #:static-content
+                        (format #f "@prefix acl: <http://www.w3.org/ns/auth/acl#> .
 @prefix foaf: <http://xmlns.com/foaf/0.1/> .
 
 <#public>
@@ -290,10 +295,8 @@
   acl:agent <~a>;
   acl:mode acl:Read, acl:Write, acl:Control.
 "
-                                           (fix-angle (uri->string doc-uri))
-                                           (fix-angle (uri->string doc-uri))
-                                           (fix-angle (uri->string owner)))))))))
-            load-content-type load-contained load-static-content
-            do-create do-delete
-            #:create-intermediate-containers? #t))
-         (lambda error #f))))))
+                                (fix-angle (uri->string doc-uri))
+                                (fix-angle (uri->string doc-uri))
+                                (fix-angle (uri->string owner)))))))))
+           #:create-intermediate-containers? #t))
+        (lambda error #f)))))
diff --git a/src/scm/webid-oidc/server/delete.scm b/src/scm/webid-oidc/server/delete.scm
index 02344ad..445622c 100644
--- a/src/scm/webid-oidc/server/delete.scm
+++ b/src/scm/webid-oidc/server/delete.scm
@@ -41,6 +41,7 @@
   #:use-module (ice-9 binary-ports)
   #:use-module (ice-9 threads)
   #:use-module (ice-9 hash-table)
+  #:use-module (ice-9 match)
   #:use-module (rnrs bytevectors)
   #:use-module (oop goops)
   #:declarative? #t
@@ -52,30 +53,28 @@
    ))
 
 (define* (delete server-name owner user path if-match if-none-match)
-  (check-acl-can-write server-name path owner user)
-  (with-session
-   (lambda (load-content-type load-contained load-static-content
-                              do-create do-delete)
-     (receive (base-path path-type)
-         (base-path path)
-       (update-path
-        base-path
-        (lambda (main-etag auxiliary)
-          (let ((relevant-etag
-                 (if path-type
-                     (assoc-ref auxiliary path-type)
-                     main-etag)))
-            (check-precondition path if-match if-none-match relevant-etag)
-            (if path-type
-                ;; Delete an auxiliary resource
-                (values
-                 main-etag
-                 (filter
-                  (lambda (auxiliary)
-                    (not (equal? (car auxiliary) path-type)))
-                  auxiliary))
-                ;; Delete the main resource, if it’s not the root and
-                ;; it’s not a non-empty container (those things are
-                ;; checked by update-path).
-                #f)))
-        load-content-type load-contained load-static-content do-create do-delete)))))
+  (parameterize ((current-content-cache (make <content-cache>)))
+    (check-acl-can-write server-name path owner user)
+    (receive (base-path path-type)
+        (base-path path)
+      (update-path
+       base-path
+       (lambda (main auxiliary)
+         (let ((relevant
+                (if path-type
+                    (assoc-ref auxiliary path-type)
+                    main)))
+           (check-precondition path if-match if-none-match (and relevant (etag relevant)))
+           (if path-type
+               ;; Delete an auxiliary resource
+               (values
+                main
+                (filter
+                 (match-lambda
+                   ((type . content)
+                    (not (equal? type path-type))))
+                 auxiliary))
+               ;; Delete the main resource, if it’s not the root and
+               ;; it’s not a non-empty container (those things are
+               ;; checked by update-path).
+               #f)))))))
diff --git a/src/scm/webid-oidc/server/read.scm b/src/scm/webid-oidc/server/read.scm
index 0cd49fd..73d32e3 100644
--- a/src/scm/webid-oidc/server/read.scm
+++ b/src/scm/webid-oidc/server/read.scm
@@ -65,157 +65,150 @@
 
 (define* (read server-name owner user path)
   (declare-link-header!)
-  (with-session
-   (lambda (load-content-type load-contained load-static-content
-                              do-create do-delete)
-     (check-acl-can-read server-name path owner user)
-     (receive (base-path path-type)
-         (base-path path)
-       (let ((container? (container-path? path))
-             (root? (root-path? path))
-             (acl?
-              (equal? path-type
-                      (string->uri
-                       "http://www.w3.org/ns/auth/acl#accessControl")))
-             (description?
-              (equal?
-               path-type
-               (string->uri
-                "https://www.w3.org/ns/iana/link-relations/relation#describedby"))))
-         (receive (main-etag auxiliary)
-             (read-path base-path)
-           (let ((relevant-etag
-                  (if path-type
-                      (assoc-ref auxiliary path-type)
-                      main-etag))
-                 (needs-meta?
-                  (case (load-content-type main-etag)
-                    ((text/turtle)
-                     #f)
-                    (else #t)))
-                 (needs-acl?
-                  (not acl?))
-                 (allow (cond (root? '(GET HEAD OPTIONS POST PUT))
-                              (container? '(GET HEAD OPTIONS POST PUT DELETE))
-                              (else '(GET HEAD OPTIONS PUT DELETE)))))
-             (unless relevant-etag
-               (let ((final-message
-                      (format #f (G_ "the auxiliary resource of type ~s at ~s is absent")
-                              (uri->string path-type)
-                              (uri->string base-path))))
-                 (raise-exception
-                  (make-exception
-                   (make-auxiliary-resource-absent base-path path-type)
-                   (make-exception-with-message final-message)))))
-             (let ((accept-put (if (or container? path-type)
-                                   "text/turtle; application/n-quads; application/ld+json"
-                                   "*/*")))
-               (values
-                ;; Headers
-                (let ((links
-                       (let ((type
-                              (cons
-                               (if container?
-                                   (string->uri "http://www.w3.org/ns/ldp#BasicContainer")
-                                   (string->uri "http://www.w3.org/ns/ldp#Resource"))
-                               '((rel . "type"))))
-                             (acl
-                              (and needs-acl?
-                                   (cons
-                                    (build-uri
-                                     'https
-                                     #:userinfo (uri-userinfo server-name)
-                                     #:host (uri-host server-name)
-                                     #:port (uri-port server-name)
-                                     #:path (derive-path
-                                             base-path
-                                             (string->uri
-                                              "http://www.w3.org/ns/auth/acl#accessControl")))
-                                    '((rel . "acl")))))
-                             (describedby
-                              (and needs-meta?
-                                   (cons
-                                    (build-uri
-                                     'https
-                                     #:userinfo (uri-userinfo server-name)
-                                     #:host (uri-host server-name)
-                                     #:port (uri-port server-name)
-                                     #:path (derive-path
-                                             base-path
-                                             (string->uri
-                                              "https://www.w3.org/ns/iana/link-relations/relation#describedby")))
-                                    '((rel . "describedby")))))
-                             (describes
-                              (and description?
-                                   (cons
-                                    (build-uri
-                                     'https
-                                     #:userinfo (uri-userinfo server-name)
-                                     #:host (uri-host server-name)
-                                     #:port (uri-port server-name)
-                                     #:path base-path)
-                                    '((rel . "https://www.w3.org/ns/iana/link-relations/relation#describes")))))
-                             (storage
-                              (and root?
-                                   (list
-                                    (list
-                                     (string->uri "http://www.w3.org/ns/pim/space#Storage")
-                                     '(rel . "type"))
-                                    (list
-                                     owner
-                                     '(rel . "http://www.w3.org/ns/solid/terms#owner"))))))
-                         (append
-                          (list type)
-                          (if acl (list acl) '())
-                          (if describedby (list describedby) '())
-                          (if describes (list describes) '())
-                          (or storage '())))))
-                  `((link . ,links)
-                    (allow . ,allow)
-                    (accept-put . ,accept-put)
-                    (content-type
-                     . (,(if container?
-                             'text/turtle
-                             (load-content-type relevant-etag))))
-                    (etag . (,relevant-etag . #f))))
-                ;; Content
-                (if container?
-                    (let ((static-graph
-                           (parameterize
-                               ((p:anonymous-http-request
-                                 (lambda (uri . args)
-                                   (values
-                                    (build-response
-                                     #:headers `((content-type ,(load-content-type relevant-etag))))
-                                    (load-static-content relevant-etag)))))
-                             (fetch
-                              (build-uri
-                               'https
-                               #:userinfo (uri-userinfo server-name)
-                               #:host (uri-host server-name)
-                               #:port (uri-port server-name)
-                               #:path path)))))
-                      (let ((final-graph
-                             (reverse
-                              (append
-                               (map (lambda (contained-path)
-                                      (make-rdf-triple
-                                       (uri->string
-                                        (build-uri
-                                         'https
-                                         #:userinfo (uri-userinfo server-name)
-                                         #:host (uri-host server-name)
-                                         #:port (uri-port server-name)
-                                         #:path path))
-                                       "http://www.w3.org/ns/ldp#contains"
-                                       (uri->string
-                                        (build-uri
-                                         'https
-                                         #:userinfo (uri-userinfo server-name)
-                                         #:host (uri-host server-name)
-                                         #:port (uri-port server-name)
-                                         #:path contained-path))))
-                                    (load-contained relevant-etag))
-                               static-graph))))
-                        (rdf->turtle final-graph)))
-                    (load-static-content relevant-etag)))))))))))
+  (parameterize ((current-content-cache (make <content-cache>)))
+    (check-acl-can-read server-name path owner user)
+    (receive (base-path path-type)
+        (base-path path)
+      (let ((container? (container-path? path))
+            (root? (root-path? path))
+            (acl?
+             (equal? path-type
+                     (string->uri
+                      "http://www.w3.org/ns/auth/acl#accessControl")))
+            (description?
+             (equal?
+              path-type
+              (string->uri
+               "https://www.w3.org/ns/iana/link-relations/relation#describedby"))))
+        (receive (main auxiliary)
+            (read-path base-path)
+          (let ((relevant
+                 (if path-type
+                     (assoc-ref auxiliary path-type)
+                     main))
+                (needs-meta?
+                 (case (content-type main)
+                   ((text/turtle)
+                    #f)
+                   (else #t)))
+                (needs-acl?
+                 (not acl?))
+                (allow (cond (root? '(GET HEAD OPTIONS POST PUT))
+                             (container? '(GET HEAD OPTIONS POST PUT DELETE))
+                             (else '(GET HEAD OPTIONS PUT DELETE)))))
+            (unless relevant
+              (let ((final-message
+                     (format #f (G_ "the auxiliary resource of type ~s at ~s is absent")
+                             (uri->string path-type)
+                             (uri->string base-path))))
+                (raise-exception
+                 (make-exception
+                  (make-auxiliary-resource-absent base-path path-type)
+                  (make-exception-with-message final-message)))))
+            (let ((accept-put (if (or container? path-type)
+                                  "text/turtle; application/n-quads; application/ld+json"
+                                  "*/*")))
+              (values
+               ;; Headers
+               (let ((links
+                      (let ((type
+                             `(,(string->uri
+                                 (string-append "http://www.w3.org/ns/ldp#"
+                                                (if container?
+                                                    "BasicContainer"
+                                                    "Resource")))
+                               (rel . "type")))
+                            (acl
+                             (and needs-acl?
+                                  `(,(build-uri
+                                      'https
+                                      #:userinfo (uri-userinfo server-name)
+                                      #:host (uri-host server-name)
+                                      #:port (uri-port server-name)
+                                      #:path (derive-path
+                                              base-path
+                                              (string->uri
+                                               "http://www.w3.org/ns/auth/acl#accessControl")))
+                                    (rel . "acl"))))
+                            (describedby
+                             (and needs-meta?
+                                  `(,(build-uri
+                                      'https
+                                      #:userinfo (uri-userinfo server-name)
+                                      #:host (uri-host server-name)
+                                      #:port (uri-port server-name)
+                                      #:path (derive-path
+                                              base-path
+                                              (string->uri
+                                               "https://www.w3.org/ns/iana/link-relations/relation#describedby")))
+                                    (rel . "describedby"))))
+                            (describes
+                             (and needs-meta?
+                                  `(,(build-uri
+                                      'https
+                                      #:userinfo (uri-userinfo server-name)
+                                      #:host (uri-host server-name)
+                                      #:port (uri-port server-name)
+                                      #:path base-path)
+                                    (rel . "https://www.w3.org/ns/iana/link-relations/relation#describes"))))
+                            (storage
+                             (and root?
+                                  `((,(string->uri "http://www.w3.org/ns/pim/space#Storage")
+                                     (rel . "type"))
+                                    (,owner
+                                     (rel . "http://www.w3.org/ns/solid/terms#owner"))))))
+                        (append
+                         (list type)
+                         (if acl (list acl) '())
+                         (if describedby (list describedby) '())
+                         (if describes (list describes) '())
+                         (or storage '())))))
+                 `((link . ,links)
+                   (allow . ,allow)
+                   (accept-put . ,accept-put)
+                   (content-type
+                    . (,(if container?
+                            'text/turtle
+                            (content-type relevant))))
+                   (etag . (,(etag relevant) . #f))))
+               ;; Content
+               (if container?
+                   (let ((static-graph
+                          (parameterize
+                              ((p:anonymous-http-request
+                                (lambda (uri . args)
+                                  (values
+                                   (build-response
+                                    #:headers `((content-type ,(content-type relevant))))
+                                   (static-content relevant)))))
+                            (fetch
+                             (build-uri
+                              'https
+                              #:userinfo (uri-userinfo server-name)
+                              #:host (uri-host server-name)
+                              #:port (uri-port server-name)
+                              #:path path)))))
+                     (let ((final-graph
+                            (reverse
+                             (append
+                              (map (lambda (contained-path)
+                                     (make-rdf-triple
+                                      (uri->string
+                                       (build-uri
+                                        'https
+                                        #:userinfo (uri-userinfo server-name)
+                                        #:host (uri-host server-name)
+                                        #:port (uri-port server-name)
+                                        #:path path))
+                                      "http://www.w3.org/ns/ldp#contains"
+                                      (uri->string
+                                       (build-uri
+                                        'https
+                                        #:userinfo (uri-userinfo server-name)
+                                        #:host (uri-host server-name)
+                                        #:port (uri-port server-name)
+                                        #:path contained-path))))
+                                   (contained relevant))
+                              static-graph))))
+                       (rdf->turtle final-graph)))
+                   (static-content relevant))))))))))
diff --git a/src/scm/webid-oidc/server/resource/content.scm b/src/scm/webid-oidc/server/resource/content.scm
index 57c51dd..f0d12a5 100644
--- a/src/scm/webid-oidc/server/resource/content.scm
+++ b/src/scm/webid-oidc/server/resource/content.scm
@@ -1,4 +1,4 @@
-;; webid-oidc, implementation of the Solid specification
+;; disfluid, implementation of the Solid specification
 ;; Copyright (C) 2020, 2021  Vivien Kraus
 
 ;; This program is free software: you can redistribute it and/or modify
@@ -16,6 +16,7 @@
 
 (define-module (webid-oidc server resource content)
   #:use-module (webid-oidc errors)
+  #:use-module (webid-oidc web-i18n)
   #:use-module ((webid-oidc stubs) #:prefix stubs:)
   #:use-module (webid-oidc rdf-index)
   #:use-module ((webid-oidc refresh-token) #:prefix refresh:)
@@ -28,79 +29,165 @@
   #:use-module (ice-9 iconv)
   #:use-module (ice-9 textual-ports)
   #:use-module (ice-9 binary-ports)
-  #:use-module (rnrs bytevectors)
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-26)
   #:use-module (oop goops)
+  #:declarative? #t
   #:export
   (
 
-   with-session
+   <content>
+   etag
+   content-type
+   contained
+   static-content
+
+   <content-cache>
+   cache
+   delete-content
+
+   current-content-cache
 
    ))
 
 (define-class <content> ()
+  (etag #:init-keyword #:etag #:getter etag)
   (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 etag)
-  (let ((first-char (substring etag 0 1))
-        (rest (substring etag 1)))
-    (call-with-input-file (format #f "~a/server/content/~a/~a"
-                                  (p:data-home)
-                                  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 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/server/content/~a" (p:data-home) first-char))
-      (let ((port (open (format #f "~a/server/content/~a/~a" (p:data-home) 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 etag)
+(define-class <content-cache> ()
+  (cache #:init-thunk make-hash-table #:getter cache))
+
+(define current-content-cache
+  (make-parameter #f))
+
+(define (filter-keyword check arguments)
+  (let scan ((arguments arguments)
+             (kept '()))
+    (match arguments
+      (()
+       (let reverse ((reversed kept)
+                     (final '()))
+         (match reversed
+           (() final)
+           ((key value reversed ...)
+            (reverse reversed `(,key ,value ,@final))))))
+      (((? check key) value arguments ...)
+       (scan arguments `(,key ,value ,@kept)))
+      ((_ _ arguments ...)
+       (scan arguments kept)))))
+
+(define-method (initialize (content <content>) initargs)
+  (let-keywords
+   initargs #t
+   ((etag #f)
+    (content-type #f)
+    (contained #f)
+    (static-content #f)
+    (cache (current-content-cache))
+    (save-to-cache (current-content-cache)))
+   (cond
+    ((and (not (eq? content-type 'text/turtle))
+          (list? contained))
+     ;; Error: containers must be RDF
+     (fail (G_ "content with contained resources must be RDF")))
+    ((and etag content-type static-content)
+     ;; Construct it the normal way
+     (unless (string? etag)
+       (scm-error 'wrong-type-arg "make"
+                  (G_ "#:etag should be a string")
+                  '()
+                  (list etag)))
+     (unless (symbol? content-type)
+       (scm-error 'wrong-type-arg "make"
+                  (G_ "#:content-type should be a symbol")
+                  '()
+                  (list content-type)))
+     (unless (or (not contained)
+                 (list? contained))
+       (scm-error 'wrong-type-arg "make"
+                  (G_ "#:contained should be a list if not #f")
+                  '()
+                  (list contained)))
+     (when (string? static-content)
+       (set! static-content (string->utf8 static-content)))
+     (unless (bytevector? static-content)
+       (scm-error 'wrong-type-arg "make"
+                  (G_ "#:static-content should be a bytevector")
+                  '()
+                  (list static-content)))
+     (slot-set! content 'etag etag)
+     (slot-set! content 'content-type content-type)
+     (slot-set! content 'contained contained)
+     (slot-set! content 'static-content static-content)
+     (when save-to-cache
+       (hash-set! (slot-ref save-to-cache 'cache) etag content)))
+    ((and cache etag)
+     ;; Load the content from disk or from the session
+     (let ((cached (hash-ref (slot-ref save-to-cache 'cache) etag)))
+       (if cached
+           (initialize content `(#:etag ,etag
+                                 #:content-type ,(slot-ref cached 'content-type)
+                                 #:contained ,(slot-ref cached 'contained)
+                                 #:static-content ,(slot-ref cached 'static-content)
+                                 ,@initargs))
+           ;; The cache is useless, try again without it
+           (parameterize ((current-content-cache #f))
+             (initialize
+              content
+              `(#:save-to-cache ,cache
+                ,@(filter-keyword (lambda (key) (not (equal? key #:cache)))
+                                  initargs)))))))
+    (etag
+     (let ((first-char (substring etag 0 1))
+           (rest (substring etag 1)))
+       (call-with-input-file (format #f "~a/server/content/~a/~a"
+                                     (p:data-home)
+                                     first-char
+                                     rest)
+         (lambda (port)
+           (let ((properties (read port)))
+             (set-port-encoding! port "ISO-8859-1")
+             (initialize
+              content
+              `(#:etag ,etag
+                #:content-type ,(assq-ref properties 'content-type)
+                #:contained ,(assq-ref properties 'contained)
+                #:static-content
+                ,(string->bytevector (get-string-all port) "ISO-8859-1")
+                ,@initargs)))))))
+    ((and content-type static-content)
+     ;; Save it to disk and generate an ETag
+     (let ((etag (stubs:random 12)))
+       ;; Recursive call before touching the file system, so if
+       ;; there’s an error we won’t create garbage
+       (initialize content `(#:etag ,etag ,@initargs))
+       ;; static-content may be a string converted to bytevector by
+       ;; the recursive call
+       (set! static-content (slot-ref content 'static-content))
+       (let ((first-char (substring etag 0 1))
+             (rest (substring etag 1)))
+         (stubs:mkdir-p (format #f "~a/server/content/~a" (p:data-home) first-char))
+         (let ((port (open (format #f "~a/server/content/~a/~a" (p:data-home) 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)
+           (when save-to-cache
+             (hash-set! (slot-ref save-to-cache 'cache) etag content))))))
+    (else
+     (fail (G_ "not enough arguments to create or load a <content>"))))))
+
+(define (delete-etag etag)
   (let ((first-char (substring etag 0 1))
         (rest (substring etag 1)))
     (delete-file (format #f "~a/server/content/~a/~a" (p:data-home) first-char rest))))
 
-(define (with-session f)
-  (let ((session (make-hash-table)))
-    (define (do-load etag)
-      (or (hash-ref session etag)
-          (load-content session 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 content-type contained static-content))
-    (define (do-delete etag)
-      (delete-content etag))
-    (f get-content-type get-contained get-static-content do-create do-delete)))
+(define-method (delete-content (content <content>))
+  (delete-etag (etag content)))
+
+(define-method (delete-content (etag <string>))
+  (delete-etag etag))
diff --git a/src/scm/webid-oidc/server/resource/path.scm b/src/scm/webid-oidc/server/resource/path.scm
index b8a9472..667dd2f 100644
--- a/src/scm/webid-oidc/server/resource/path.scm
+++ b/src/scm/webid-oidc/server/resource/path.scm
@@ -19,6 +19,7 @@
   #:use-module ((webid-oidc stubs) #:prefix stubs:)
   #:use-module (webid-oidc rdf-index)
   #:use-module (webid-oidc web-i18n)
+  #:use-module (webid-oidc server resource content)
   #:use-module ((webid-oidc refresh-token) #:prefix refresh:)
   #:use-module ((webid-oidc parameters) #:prefix p:)
   #:use-module (web uri)
@@ -30,7 +31,9 @@
   #:use-module (ice-9 textual-ports)
   #:use-module (ice-9 binary-ports)
   #:use-module (ice-9 threads)
+  #:use-module (ice-9 match)
   #:use-module (rnrs bytevectors)
+  #:use-module (srfi srfi-26)
   #:use-module (oop goops)
   #:declarative? #t
   #:export
@@ -167,16 +170,16 @@
       (lambda ()
         (call-with-input-file h
           (lambda (port)
-            (let ((main-etag (read port)))
-              (let ((auxiliary (read port)))
-                (values main-etag
-                        (map (lambda (cell)
-                               (let ((key (string->uri (car cell)))
-                                     (value (cdr cell)))
-                                 (cons key value)))
-                             auxiliary))))))))))
+            (let* ((main-etag (read port))
+                   (auxiliary (read port)))
+              (values (make <content> #:etag main-etag)
+                      (map
+                       (match-lambda
+                         (((= string->uri key) . etag)
+                          `(,key . ,(make <content> #:etag etag))))
+                       auxiliary)))))))))
 
-(define* (update-path path f content-type contained static-content create delete
+(define* (update-path path f
                       #:key (create-intermediate-containers? #f))
   (let ((h (hash-path path))
         (lock (lock-file-name path))
@@ -202,7 +205,7 @@
      h
      lock
      (lambda (port)
-       (receive (etag auxiliary)
+       (receive (main auxiliary)
            (with-exception-handler
                (lambda (error)
                  (unless (path-not-found? error)
@@ -213,25 +216,21 @@
                (read-path path))
              #:unwind? #t
              #:unwind-for-type &path-not-found)
-         (when etag
-           (hash-set! garbage etag #t))
-         (when auxiliary
-           (for-each
-            (lambda (cell)
-              (when (cdr cell)
-                (hash-set! garbage (cdr cell) #t)))
-            auxiliary))
+         (when main
+           (hash-set! garbage (etag main) #t))
+         (for-each
+          (match-lambda
+            ((_ . content)
+             (hash-set! garbage (etag content) #t)))
+          (or auxiliary '()))
          (call-with-values
              (lambda ()
-               (f etag auxiliary))
-           (case-lambda
-             ((false)
-              (when false
-                (fail (G_ "You’re using the API wrong.")))
-              ;; Delete the resource
-              (unless (or (not etag)
-                          (not (contained etag))
-                          (null? (contained etag)))
+               (f main auxiliary))
+           (match-lambda*
+             ((#f)
+              (unless (or (not main)
+                          (not (contained main))
+                          (null? (contained main)))
                 (raise-exception
                  (make-exception
                   (make-container-not-empty path)
@@ -246,62 +245,64 @@
                    (format #f (G_ "you cannot delete the root"))))))
               (set! has-been-deleted? #t)
               #f)
-             ((new-etag new-auxiliary)
-              (unless (and (string? new-etag) (list? new-auxiliary))
-                (fail (G_ "You’re using the API wrong.")))
-              (hash-remove! garbage new-etag)
-              (when new-auxiliary
-                (for-each
-                 (lambda (cell)
-                   (hash-remove! garbage (cdr cell)))
-                 new-auxiliary))
-              (write new-etag port)
-              (write (map (lambda (cell)
-                            (cons (uri->string (car cell))
-                                  (cdr cell)))
-                          new-auxiliary)
+             (((? (cute is-a? <> <content>) new-main)
+               new-auxiliary)
+              (hash-remove! garbage (etag new-main))
+              (for-each
+               (match-lambda
+                 ((_ . content)
+                  (hash-remove! garbage (etag content))))
+               (or new-auxiliary '()))
+              (write (etag new-main) port)
+              (write (map (match-lambda
+                            (((= uri->string key) . (= etag etag))
+                             `(,key . ,etag)))
+                          (or new-auxiliary '()))
                      port)
-              #t))))))
+              #t)
+             (else
+              (fail (G_ "you must return either #f to delete the path, or a new main content and alist from URI types to auxiliary content"))))))))
     (when (and parent-path has-been-created? (not has-been-deleted?))
       (update-path
        parent-path
-       (lambda (etag auxiliary)
+       (lambda (main auxiliary)
          ;; Add path as a child of the resource at etag
          (unless create-intermediate-containers?
-           (unless etag
+           (unless main
              ;; Typically, POST to a non-existing path
              (raise-exception (make-path-not-found parent-path))))
          (unless auxiliary
            (set! auxiliary '()))
-         (let ((content-type (if etag (content-type etag) 'text/turtle))
-               (other-children (if etag (contained etag) '()))
-               (static-content (if etag (static-content etag) (string->utf8 ""))))
-           (let ((new-etag
-                  (create content-type (cons path other-children) static-content)))
-             (values new-etag auxiliary))))
-       content-type contained static-content create delete
+         (let ((content-type (if main (content-type main) 'text/turtle))
+               (other-children (if main (contained main) '()))
+               (static-content (if main (static-content main) (string->utf8 ""))))
+           (let ((new-content
+                  (make <content>
+                    #:content-type content-type
+                    #:contained (cons path other-children)
+                    #:static-content static-content)))
+             (values new-content auxiliary))))
        #:create-intermediate-containers? create-intermediate-containers?))
     (when (and parent-path has-been-deleted? (not has-been-created?))
       (update-path
        parent-path
-       (lambda (etag auxiliary)
-         (unless etag
+       (lambda (main auxiliary)
+         (unless main
            (raise-exception (make-path-not-found parent-path)))
-         (let ((content-type (content-type etag))
-               (all-children (contained etag))
-               (static-content (static-content etag)))
+         (let ((content-type (content-type main))
+               (all-children (contained main))
+               (static-content (static-content main)))
            (values
-            (create content-type
-                    (filter (lambda (x)
-                              (not (equal? x path)))
-                            all-children)
-                    static-content)
+            (make <content>
+              #:content-type content-type
+              #:contained
+              (filter (lambda (x) (not (equal? x path))) all-children)
+              #:static-content static-content)
             auxiliary)))
-       content-type contained static-content create delete
        #:create-intermediate-containers? create-intermediate-containers?))
     (for-each
-     delete
-     (hash-map->list (lambda (garbage false) garbage) garbage))))
+     delete-content
+     (hash-map->list (lambda (garbage _) garbage) garbage))))
 
 (define (base-path path)
   (define (check-suffix suffix type)
diff --git a/src/scm/webid-oidc/server/resource/wac.scm b/src/scm/webid-oidc/server/resource/wac.scm
index d3f4adf..fd0d81e 100644
--- a/src/scm/webid-oidc/server/resource/wac.scm
+++ b/src/scm/webid-oidc/server/resource/wac.scm
@@ -242,61 +242,59 @@
 (define acl-aux (string->uri "http://www.w3.org/ns/auth/acl#accessControl"))
 
 (define (wac-get-modes server-name final-path user)
-  (with-session
-   (lambda (content-type contained static-content create delete)
-     (define (wac-check-recursive path check-default?)
-       (receive (main-etag auxiliary)
-           (with-exception-handler
-               (lambda (error)
-                 (unless (path-not-found? error)
-                   (raise-exception error))
-                 (values #f '()))
-             (lambda ()
-               (read-path path))
-             #:unwind? #t
-             #:unwind-for-type &path-not-found)
-         (let ((acl-etag (assoc-ref auxiliary acl-aux)))
-           (if acl-etag
-               (with-rdf-source
-                server-name path (content-type acl-etag) (static-content acl-etag)
-                (lambda (rdf-match)
-                  (check-authorizations
-                   path check-default? server-name final-path user rdf-match
-                   '()
-                   (map rdf-triple-subject
-                        (rdf-match #f
-                                   "http://www.w3.org/1999/02/22-rdf-syntax-ns#type"
-                                   "http://www.w3.org/ns/auth/acl#Authorization")))))
-               ;; No existing ACL.
-               (let ((parent-path
-                      (string-append
-                       "/"
-                       (encode-and-join-uri-path
-                        (reverse
-                         (cdr
-                          (reverse
-                           (split-and-decode-uri-path path)))))
-                       "/")))
-                 (when (equal? parent-path "//")
-                   ;; The parent is the root
-                   (set! parent-path "/"))
-                 (wac-check-recursive parent-path #t))))))
-     (let ((all-modes (wac-check-recursive final-path #f)))
-       (define (accumulate-unique accumulated list)
-         (cond
-          ((null? list)
-           (reverse accumulated))
-          ((or (null? accumulated) (not (equal? (car accumulated) (car list))))
-           (accumulate-unique (cons (car list) accumulated) (cdr list)))
-          (else
-           (accumulate-unique accumulated (cdr list)))))
-       (accumulate-unique
-        '()
-        (sort all-modes
-              (match-lambda*
-                (((? uri? (= uri->string a))
-                  (? uri? (= uri->string b)))
-                 (string< a b)))))))))
+  (define (wac-check-recursive path check-default?)
+    (receive (main auxiliary)
+        (with-exception-handler
+            (lambda (error)
+              (unless (path-not-found? error)
+                (raise-exception error))
+              (values #f '()))
+          (lambda ()
+            (read-path path))
+          #:unwind? #t
+          #:unwind-for-type &path-not-found)
+      (let ((acl (assoc-ref auxiliary acl-aux)))
+        (if acl
+            (with-rdf-source
+             server-name path (content-type acl) (static-content acl)
+             (lambda (rdf-match)
+               (check-authorizations
+                path check-default? server-name final-path user rdf-match
+                '()
+                (map rdf-triple-subject
+                     (rdf-match #f
+                                "http://www.w3.org/1999/02/22-rdf-syntax-ns#type"
+                                "http://www.w3.org/ns/auth/acl#Authorization")))))
+            ;; No existing ACL.
+            (let ((parent-path
+                   (string-append
+                    "/"
+                    (encode-and-join-uri-path
+                     (reverse
+                      (cdr
+                       (reverse
+                        (split-and-decode-uri-path path)))))
+                    "/")))
+              (when (equal? parent-path "//")
+                ;; The parent is the root
+                (set! parent-path "/"))
+              (wac-check-recursive parent-path #t))))))
+  (let ((all-modes (wac-check-recursive final-path #f)))
+    (let accumulate-unique ((accumulated '())
+                            (list (sort all-modes
+                                        (match-lambda*
+                                          (((? uri? (= uri->string a))
+                                            (? uri? (= uri->string b)))
+                                           (string< a b))))))
+      (match list
+        (() (reverse accumulated))
+        ((hd list ...)
+         (match accumulated
+           ((or () ;; Nothing accumulated, can’t be unique
+                ((? (lambda (head) (not (equal? head hd)))) _ ...))
+            (accumulate-unique `(,hd ,@accumulated) list))
+           (else
+            (accumulate-unique accumulated list))))))))
 
 (define (check-mode server-name path owner user expected-mode)
   (unless (equal? owner user)
diff --git a/src/scm/webid-oidc/server/update.scm b/src/scm/webid-oidc/server/update.scm
index d568d06..9bca2e6 100644
--- a/src/scm/webid-oidc/server/update.scm
+++ b/src/scm/webid-oidc/server/update.scm
@@ -42,6 +42,7 @@
   #:use-module (ice-9 binary-ports)
   #:use-module (ice-9 threads)
   #:use-module (ice-9 hash-table)
+  #:use-module (ice-9 match)
   #:use-module (rnrs bytevectors)
   #:use-module (oop goops)
   #:declarative? #t
@@ -92,80 +93,78 @@
 
 (define* (update server-name owner user path if-match if-none-match
                  content-type content)
-  (define updated-etag #f)
-  (with-session
-   (lambda (load-content-type load-contained load-static-content
-                              do-create do-delete)
-     (receive (base-path path-type)
-         (base-path path)
-       (update-path
-        base-path
-        (lambda (main-etag auxiliary)
-          (let ((relevant-etag
-                 (if path-type
-                     (assoc-ref auxiliary path-type)
-                     main-etag)))
-            (if relevant-etag
-                ;; The resource exists, so we need write permission
-                (check-acl-can-write server-name path owner user)
-                ;; The resource does not exist yet, so we only need
-                ;; append permission
-                (check-acl-can-append server-name path owner user))
-            (check-precondition path if-match if-none-match relevant-etag)
-            (set! updated-etag
-                  (do-create content-type
-                             (if relevant-etag
-                                 (load-contained relevant-etag)
-                                 (if (container-path? path)
-                                     '()
-                                     #f))
-                             (if (container-path? path)
-                                 (remove-containment-triples
-                                  (build-uri (uri-scheme server-name)
-                                             #:userinfo (uri-userinfo server-name)
-                                             #:host (uri-host server-name)
-                                             #:port (uri-port server-name)
-                                             #:path path)
-                                  content-type content)
-                                 content)))
-            (let ((new-main-etag
-                   (if path-type
-                       main-etag
-                       updated-etag))
-                  (new-auxiliary
-                   (if path-type
-                       (cons
-                        `(,path-type . ,updated-etag)
-                        (filter
-                         (lambda (auxiliary)
-                           (let ((needs-description? (not (eq? content-type 'text/turtle)))
-                                 (is-describedby?
-                                  (equal?
-                                   (car auxiliary)
-                                   (string->uri
-                                    "https://www.w3.org/ns/iana/link-relations/relation#describedby")))
-                                 (is-path-type?
-                                  (equal? (car auxiliary) path-type)))
-                             (and (not is-path-type?)
-                                  (or (not is-describedby?) needs-description?))))
-                         (or auxiliary '())))
-                       (if (eq? content-type 'text/turtle)
-                           (or auxiliary '())
-                           (cons
-                            `(,(string->uri
-                                "https://www.w3.org/ns/iana/link-relations/relation#describedby")
-                              . ,(do-create 'text/turtle #f ""))
-                            (or auxiliary '()))))))
-              (unless new-main-etag
-                ;; Trying to update an auxiliary resource for a
-                ;; resource that does not exist
-                (set! new-main-etag
-                      (do-create 'text/turtle
-                                 (if (container-path? path)
-                                     '()
-                                     #f)
-                                 "")))
-              (values new-main-etag new-auxiliary))))
-        load-content-type load-contained load-static-content do-create do-delete
-        #:create-intermediate-containers? #t))))
-  updated-etag)
+  (define updated #f)
+  (parameterize ((current-content-cache (make <content-cache>)))
+    (receive (base-path path-type)
+        (base-path path)
+      (update-path
+       base-path
+       (lambda (main auxiliary)
+         (let ((relevant
+                (if path-type
+                    (assoc-ref auxiliary path-type)
+                    main)))
+           (if relevant
+               ;; The resource exists, so we need write permission
+               (check-acl-can-write server-name path owner user)
+               ;; The resource does not exist yet, so we only need
+               ;; append permission
+               (check-acl-can-append server-name path owner user))
+           (check-precondition path if-match if-none-match (and relevant (etag relevant)))
+           (set! updated
+                 (make <content>
+                   #:content-type content-type
+                   #:contained
+                   (if relevant
+                       (contained relevant)
+                       (if (container-path? path)
+                           '()
+                           #f))
+                   #:static-content
+                   (if (container-path? path)
+                       (remove-containment-triples
+                        (build-uri (uri-scheme server-name)
+                                   #:userinfo (uri-userinfo server-name)
+                                   #:host (uri-host server-name)
+                                   #:port (uri-port server-name)
+                                   #:path path)
+                        content-type content)
+                       content)))
+           (let ((new-main
+                  (if path-type main updated))
+                 (new-auxiliary
+                  (if path-type
+                      `((,path-type . ,updated)
+                        ,@(filter
+                           (match-lambda
+                             ((type . content)
+                              (let ((needs-description? (not (eq? content-type 'text/turtle)))
+                                    (is-describedby?
+                                     (equal?
+                                      type
+                                      (string->uri
+                                       "https://www.w3.org/ns/iana/link-relations/relation#describedby")))
+                                    (is-path-type?
+                                     (equal? type path-type)))
+                                (and (not is-path-type?)
+                                     (or (not is-describedby?) needs-description?)))))
+                           (or auxiliary '())))
+                      (if (eq? content-type 'text/turtle)
+                          (or auxiliary '())
+                          `((,(string->uri
+                               "https://www.w3.org/ns/iana/link-relations/relation#describedby")
+                             . ,(make <content>
+                                  #:content-type 'text/turtle
+                                  #:static-content ""))
+                            ,@(or auxiliary '()))))))
+             (unless new-main
+               ;; Trying to update an auxiliary resource for a
+               ;; resource that does not exist
+               (set! new-main
+                     (make <content>
+                       #:content-type 'text/turtle
+                       #:contained (and (container-path? path) '())
+                       #:statitc-content "")))
+             (values new-main new-auxiliary))))
+       #:create-intermediate-containers? #t)))
+  updated)