diff options
Diffstat (limited to 'tests/acl.scm')
| -rw-r--r-- | tests/acl.scm | 344 |
1 files changed, 188 insertions, 156 deletions
diff --git a/tests/acl.scm b/tests/acl.scm index 9a11eb6..b28bbde 100644 --- a/tests/acl.scm +++ b/tests/acl.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 @@ -14,15 +14,19 @@ ;; You should have received a copy of the GNU Affero General Public License ;; along with this program. If not, see <https://www.gnu.org/licenses/>. -(use-modules (webid-oidc server resource wac) - (webid-oidc server resource content) - (webid-oidc server resource path) - ((webid-oidc parameters) #:prefix p:) - (webid-oidc testing) - (web http) - (web request) - (web response) - (web uri)) +(define-module (tests acl) + #:use-module (webid-oidc server resource wac) + #:use-module (webid-oidc server resource content) + #:use-module (webid-oidc server resource path) + #:use-module ((webid-oidc parameters) #:prefix p:) + #:use-module (webid-oidc testing) + #:use-module (web http) + #:use-module (web request) + #:use-module (web response) + #:use-module (web uri) + #:use-module (oop goops) + #:duplicates (merge-generics) + #:declarative? #t) (define (http-get uri . other-args) (when (string? uri) @@ -63,25 +67,51 @@ "b/k7RqZevpCHAumba" "y/29x0MEOMybxUqDU" "5/KVojpXDg0Aob3_v")) - (with-session - (lambda (content-type contained static-content create delete) - ;; In this little scenario: - ;; / can only be listed by Alice and the FBI - ;; /docs/ can only be updated by Alice and the public can list - ;; /docs/file1 can only be updated by Alice, but public - ;; /docs/file2 same, but authenticated - ;; /fiction/file does not exist, so /#default applies - ;; /private-docs/ private to Alice, no ACL - ;; /private-docs/file1 no ACL (so, readable by the FBI as inherited in /) - ;; /private/docs/file2 no ACL (so, not readable by the FBI) - (let ((/ (create 'text/turtle '("docs" "private-docs") "")) - (/docs/ (create 'text/turtle '("file1" "file2") "")) - (/docs/file1 (create 'text/plain #f "Hello :)")) - (/docs/file2 (create 'text/plain #f "You’re authenticated :)")) - (/private-docs/ (create 'text/turtle '("file1") "")) - (/private-docs/file1 (create 'text/plain #f "Private, but FBI can read!")) - (/private-docs/file2 (create 'text/plain #f "Private!")) - (/.acl (create 'text/turtle #f "@prefix acl: <http://www.w3.org/ns/auth/acl#> . + (parameterize ((current-content-cache (make <content-cache>))) + ;; In this little scenario: + ;; / can only be listed by Alice and the FBI + ;; /docs/ can only be updated by Alice and the public can list + ;; /docs/file1 can only be updated by Alice, but public + ;; /docs/file2 same, but authenticated + ;; /fiction/file does not exist, so /#default applies + ;; /private-docs/ private to Alice, no ACL + ;; /private-docs/file1 no ACL (so, readable by the FBI as inherited in /) + ;; /private/docs/file2 no ACL (so, not readable by the FBI) + (let ((/ + (make <content> + #:content-type 'text/turtle + #:contained '("docs" "private-docs") + #:static-content "")) + (/docs/ + (make <content> + #:content-type 'text/turtle + #:contained '("file1" "file2") + #:static-content "")) + (/docs/file1 + (make <content> + #:content-type 'text/plain + #:static-content "Hello :)")) + (/docs/file2 + (make <content> + #:content-type 'text/plain + #:static-content "You’re authenticated :)")) + (/private-docs/ + (make <content> + #:content-type 'text/turtle + #:contained '("file1") + #:static-content "")) + (/private-docs/file1 + (make <content> + #:content-type 'text/plain + #:static-content "Private, but FBI can read!")) + (/private-docs/file2 + (make <content> + #:content-type 'text/plain + #:static-content "Private!")) + (/.acl + (make <content> + #:content-type 'text/turtle + #:static-content "@prefix acl: <http://www.w3.org/ns/auth/acl#> . <#default> a acl:Authorization; @@ -97,7 +127,10 @@ acl:mode acl:Read, acl:Write; acl:default <https://alice.databox.me/private-docs/file1>. ")) - (/docs/.acl (create 'text/turtle #f "@prefix acl: <http://www.w3.org/ns/auth/acl#> . + (/docs/.acl + (make <content> + #:content-type 'text/turtle + #:static-content "@prefix acl: <http://www.w3.org/ns/auth/acl#> . @prefix foaf: <http://xmlns.com/foaf/0.1/>. <#default> @@ -112,7 +145,10 @@ acl:agentClass foaf:Agent; acl:mode acl:Read. ")) - (/docs/file1.acl (create 'text/turtle #f "@prefix acl: <http://www.w3.org/ns/auth/acl#> . + (/docs/file1.acl + (make <content> + #:content-type 'text/turtle + #:static-content "@prefix acl: <http://www.w3.org/ns/auth/acl#> . @prefix foaf: <http://xmlns.com/foaf/0.1/>. <#default> @@ -127,7 +163,10 @@ acl:agentClass foaf:Agent; acl:mode acl:Read. ")) - (/docs/file2.acl (create 'text/turtle #f "@prefix acl: <http://www.w3.org/ns/auth/acl#> . + (/docs/file2.acl + (make <content> + #:content-type 'text/turtle + #:static-content "@prefix acl: <http://www.w3.org/ns/auth/acl#> . <#default> a acl:Authorization; @@ -141,127 +180,120 @@ acl:agentClass acl:AuthenticatedAgent; acl:mode acl:Read. "))) - (update-path - "/" - (lambda (main auxiliary) - (values / - `((,(string->uri "http://www.w3.org/ns/auth/acl#accessControl") - . ,/.acl)))) - content-type contained static-content create delete) - (update-path - "/docs/" - (lambda (main auxiliary) - (values /docs/ - `((,(string->uri "http://www.w3.org/ns/auth/acl#accessControl") - . ,/docs/.acl)))) - content-type contained static-content create delete) - (update-path - "/docs/file1" - (lambda (main auxiliary) - (values /docs/file1 - `((,(string->uri "http://www.w3.org/ns/auth/acl#accessControl") - . ,/docs/file1.acl)))) - content-type contained static-content create delete) - (update-path - "/docs/file2" - (lambda (main auxiliary) - (values /docs/file2 - `((,(string->uri "http://www.w3.org/ns/auth/acl#accessControl") - . ,/docs/file2.acl)))) - content-type contained static-content create delete) - (update-path - "/private-docs/" - (lambda (main auxiliary) - (values /private-docs/ '())) - content-type contained static-content create delete) - (update-path - "/private-docs/file1" - (lambda (main auxiliary) - (values /private-docs/file1 '())) - content-type contained static-content create delete) - (update-path - "/private-docs/file2" - (lambda (main auxiliary) - (values /private-docs/file2 '())) - content-type contained static-content create delete) - (let ((server-name - (string->uri "https://alice.databox.me"))) - ;; Who can access what? - ;; Alice: https://alice.databox.me/profile/card#me - ;; Bob: https://bob.databox.me/profile/card#me (authenticated) - ;; FBI: https://the-spy.databox.me/profile/card#me - ;; Anonymous - ;; - ;; Alice Bob FBI Anonymous - ;; / RWC X RW X - ;; /docs/ RWC R R R - ;; /docs/file1 RWC R R R - ;; /docs/file2 RWC R R X - ;; /fiction/file RWC X X X - ;; /private-docs/ RWC X X X - ;; /private-docs/file1 RWC X RW X - ;; /private-docs/file2 RWC X X X - (define (run-test path modes-alice modes-bob modes-fbi modes-anonymous) - (define (uri< a b) - (string< (uri->string a) (uri->string b))) - (parameterize - ((p:anonymous-http-request http-get)) - (let ((alice (wac-get-modes - server-name path - (string->uri "https://alice.databox.me/profile/card#me"))) - (bob (wac-get-modes - server-name path - (string->uri "https://bob.databox.me/profile/card#me"))) - (fbi (wac-get-modes - server-name path - (string->uri "https://the-spy.databox.me/profile/card#me"))) - (anonymous (wac-get-modes - server-name path - #f))) - (unless (equal? alice - modes-alice) - (format (current-error-port) - "Alice’s modes for path ~s:\n expected:\n ~s\n got:\n ~s\n" - path - (map uri->string modes-alice) - (map uri->string alice)) - (exit 2)) - (unless (equal? bob - modes-bob) - (format (current-error-port) - "Bob’s modes for path ~s:\n expected:\n ~s\n got:\n ~s\n" - path - (map uri->string modes-bob) - (map uri->string bob)) - (exit 3)) - (unless (equal? fbi - modes-fbi) - (format (current-error-port) - "Spy’s modes for path ~s:\n expected:\n ~s\n got:\n ~s\n" - path - (map uri->string modes-fbi) - (map uri->string fbi)) - (exit 4)) - (unless (equal? anonymous - modes-anonymous) - (format (current-error-port) - "Anonymous modes for path ~s:\n expected:\n ~s\n got:\n ~s\n" - path - (map uri->string modes-anonymous) - (map uri->string anonymous)) - (exit 5))))) - (let ((read (string->uri "http://www.w3.org/ns/auth/acl#Read")) - (write (string->uri "http://www.w3.org/ns/auth/acl#Write")) - (control (string->uri "http://www.w3.org/ns/auth/acl#Control"))) - (let ((RWC (list control read write)) - (R (list read)) - (RW (list read write)) - (X '())) - (run-test "/" RWC X RW X) - (run-test "/docs/" RWC R R R) - (run-test "/docs/file1" RWC R R R) - (run-test "/docs/file2" RWC R R X) - (run-test "/fiction/file" RWC X X X) - (run-test "/private-docs/" RWC X X X) - (run-test "/private-docs/file1" RWC X RW X) - (run-test "/private-docs/file2" RWC X X X))))))))) + (update-path + "/" + (lambda (main auxiliary) + (values / + `((,(string->uri "http://www.w3.org/ns/auth/acl#accessControl") + . ,/.acl))))) + (update-path + "/docs/" + (lambda (main auxiliary) + (values /docs/ + `((,(string->uri "http://www.w3.org/ns/auth/acl#accessControl") + . ,/docs/.acl))))) + (update-path + "/docs/file1" + (lambda (main auxiliary) + (values /docs/file1 + `((,(string->uri "http://www.w3.org/ns/auth/acl#accessControl") + . ,/docs/file1.acl))))) + (update-path + "/docs/file2" + (lambda (main auxiliary) + (values /docs/file2 + `((,(string->uri "http://www.w3.org/ns/auth/acl#accessControl") + . ,/docs/file2.acl))))) + (update-path + "/private-docs/" + (lambda (main auxiliary) + (values /private-docs/ '()))) + (update-path + "/private-docs/file1" + (lambda (main auxiliary) + (values /private-docs/file1 '()))) + (update-path + "/private-docs/file2" + (lambda (main auxiliary) + (values /private-docs/file2 '()))) + (let ((server-name + (string->uri "https://alice.databox.me"))) + ;; Who can access what? + ;; Alice: https://alice.databox.me/profile/card#me + ;; Bob: https://bob.databox.me/profile/card#me (authenticated) + ;; FBI: https://the-spy.databox.me/profile/card#me + ;; Anonymous + ;; + ;; Alice Bob FBI Anonymous + ;; / RWC X RW X + ;; /docs/ RWC R R R + ;; /docs/file1 RWC R R R + ;; /docs/file2 RWC R R X + ;; /fiction/file RWC X X X + ;; /private-docs/ RWC X X X + ;; /private-docs/file1 RWC X RW X + ;; /private-docs/file2 RWC X X X + (define (run-test path modes-alice modes-bob modes-fbi modes-anonymous) + (define (uri< a b) + (string< (uri->string a) (uri->string b))) + (parameterize + ((p:anonymous-http-request http-get)) + (let ((alice (wac-get-modes + server-name path + (string->uri "https://alice.databox.me/profile/card#me"))) + (bob (wac-get-modes + server-name path + (string->uri "https://bob.databox.me/profile/card#me"))) + (fbi (wac-get-modes + server-name path + (string->uri "https://the-spy.databox.me/profile/card#me"))) + (anonymous (wac-get-modes + server-name path + #f))) + (unless (equal? alice + modes-alice) + (format (current-error-port) + "Alice’s modes for path ~s:\n expected:\n ~s\n got:\n ~s\n" + path + (map uri->string modes-alice) + (map uri->string alice)) + (exit 2)) + (unless (equal? bob + modes-bob) + (format (current-error-port) + "Bob’s modes for path ~s:\n expected:\n ~s\n got:\n ~s\n" + path + (map uri->string modes-bob) + (map uri->string bob)) + (exit 3)) + (unless (equal? fbi + modes-fbi) + (format (current-error-port) + "Spy’s modes for path ~s:\n expected:\n ~s\n got:\n ~s\n" + path + (map uri->string modes-fbi) + (map uri->string fbi)) + (exit 4)) + (unless (equal? anonymous + modes-anonymous) + (format (current-error-port) + "Anonymous modes for path ~s:\n expected:\n ~s\n got:\n ~s\n" + path + (map uri->string modes-anonymous) + (map uri->string anonymous)) + (exit 5))))) + (let ((read (string->uri "http://www.w3.org/ns/auth/acl#Read")) + (write (string->uri "http://www.w3.org/ns/auth/acl#Write")) + (control (string->uri "http://www.w3.org/ns/auth/acl#Control"))) + (let ((RWC (list control read write)) + (R (list read)) + (RW (list read write)) + (X '())) + (run-test "/" RWC X RW X) + (run-test "/docs/" RWC R R R) + (run-test "/docs/file1" RWC R R R) + (run-test "/docs/file2" RWC R R X) + (run-test "/fiction/file" RWC X X X) + (run-test "/private-docs/" RWC X X X) + (run-test "/private-docs/file1" RWC X RW X) + (run-test "/private-docs/file2" RWC X X X)))))))) |