1 files changed, 53 insertions, 55 deletions
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)