From 4a144d76950ac002996c3941c1eb4a5a6de6a661 Mon Sep 17 00:00:00 2001
From: Vivien Kraus <vivien@planete-kraus.eu>
Date: Thu, 30 Sep 2021 10:30:40 +0200
Subject: Content API: use GOOPS for the cache

---
 src/scm/webid-oidc/server/delete.scm | 53 ++++++++++++++++++------------------
 1 file changed, 26 insertions(+), 27 deletions(-)

(limited to 'src/scm/webid-oidc/server/delete.scm')

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)))))))
-- 
cgit v1.2.3