summaryrefslogtreecommitdiff
path: root/src/scm/webid-oidc/server/delete.scm
diff options
context:
space:
mode:
Diffstat (limited to 'src/scm/webid-oidc/server/delete.scm')
-rw-r--r--src/scm/webid-oidc/server/delete.scm53
1 files changed, 26 insertions, 27 deletions
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)))))))