diff options
Diffstat (limited to 'tests/server-path.scm')
| -rw-r--r-- | tests/server-path.scm | 151 |
1 files changed, 151 insertions, 0 deletions
diff --git a/tests/server-path.scm b/tests/server-path.scm new file mode 100644 index 0000000..f45fb38 --- /dev/null +++ b/tests/server-path.scm @@ -0,0 +1,151 @@ +(use-modules (webid-oidc server resource content) + (webid-oidc server resource path) + (webid-oidc fetch) + (webid-oidc testing) + (webid-oidc errors) + (web uri) + (web response) + (rnrs bytevectors) + (ice-9 optargs) + (ice-9 receive) + (oop goops)) + +(with-test-environment + "server-path" + (lambda () + (for-each + (lambda (file) + (false-if-exception (delete-file file))) + '( + "tests/server-path.home/webid-oidc/server/content/6/8OMG_V5x-KmI6TI" + "tests/server-path.home/webid-oidc/server/content/X/hqM_2Avn5_egTzs" + "tests/server-path.home/webid-oidc/server/content/a/68pTwiImTWTpjQl" + "tests/server-path.home/webid-oidc/server/content/5/n1KPgAd3ng4wSqn" + "tests/server-path.home/webid-oidc/server/content/D/wxU0ogx5rzRrvu2" + "tests/server-path.home/webid-oidc/server/content/F/BQKBGrtq6U_M0L7" + "tests/server-path.home/webid-oidc/server/content/N/gnO8RAS9FpPiO5j" + "tests/server-path.home/webid-oidc/server/content/n/U46BXbknEaLWZpH" + "tests/server-path.home/webid-oidc/server/content/y/29x0MEOMybxUqDU" + "tests/server-path.home/webid-oidc/server/content/b/k7RqZevpCHAumba" + "tests/server-path.home/webid-oidc/server/content/H/y4S5p1BqTEJi-Jb" + "tests/server-path.home/webid-oidc/server/content/A/fkGTJRCHc-jHk-V" + "tests/server-path.home/webid-oidc/server/path/b/FkceBVDI7O39t4bFK02Vu0E7OWtjnjDfAXDLKuREbE" + "tests/server-path.home/webid-oidc/server/path/b/FkceBVDI7O39t4bFK02Vu0E7OWtjnjDfAXDLKuREbE.lock" + "tests/server-path.home/webid-oidc/server/path/g/pBBL3msK7bpJ_LUp4xDyrB-EZD1EaJgD6xo9ysqy6Q" + "tests/server-path.home/webid-oidc/server/path/g/pBBL3msK7bpJ_LUp4xDyrB-EZD1EaJgD6xo9ysqy6Q.lock" + "tests/server-path.home/webid-oidc/server/path/i/l7asoJjJEMhngUeSt4tHVu8Zxx4EFG_FDeJfL3-oPE" + "tests/server-path.home/webid-oidc/server/path/i/l7asoJjJEMhngUeSt4tHVu8Zxx4EFG_FDeJfL3-oPE.lock" + "tests/server-path.home/webid-oidc/server/path/Q/hRrKeOf3iJxfvabWz2CBYAlF_ovDFXqHWcwhhuQhXg" + "tests/server-path.home/webid-oidc/server/path/Q/hRrKeOf3iJxfvabWz2CBYAlF_ovDFXqHWcwhhuQhXg.lock" + )) + (with-session + (lambda (content-type contained static-content create delete) + (let ((new-etag + (lambda () + (create 'text/plain '() "Hello :)"))) + (new-acl + (lambda () + (create 'text/turtle '() + "@prefix acl: <http://www.w3.org/ns/auth/acl#>. + +<#authorized> a acl:Authorization; + acl:accessTo <https://example.com/a/b/c>; + acl:mode acl:Read; + acl:agent <https://friend.example.com/profile/card#me>. +")))) + ;; Create with parents: + (update-path + "/a/b/c" + (lambda (etag auxiliary) + (when (or etag auxiliary) + (exit 1)) + (values (new-etag) `((,(string->uri "http://www.w3.org/ns/auth/acl#accessControl") . ,(new-acl))))) + content-type contained static-content create delete + #:create-intermediate-containers? #t) + ;; So now, there should be a chain of directories: + (receive (root-etag root-aux) + (read-path "/") + (let ((root-children (contained root-etag))) + (unless (equal? root-children '("/a/")) + (exit 2))) + (unless (null? root-aux) + (exit 3))) + (receive (/a/ /a/-aux) + (read-path "/a/") + (unless (equal? (contained /a/) '("/a/b/")) + (exit 4)) + (unless (null? /a/-aux) + (exit 5))) + (receive (/a/b/ /a/b/-aux) + (read-path "/a/b/") + (unless (equal? (contained /a/b/) '("/a/b/c")) + (exit 6)) + (unless (null? /a/b/-aux) + (exit 7))) + (receive (/a/b/c /a/b/c-aux) + (read-path "/a/b/c") + (unless (equal? (content-type /a/b/c) 'text/plain) + (exit 8)) + (unless (equal? (static-content /a/b/c) + (string->utf8 "Hello :)")) + (exit 9))) + ;; We can delete /a/b/c + (update-path "/a/b/c" (lambda (etag aux) #f) + content-type contained static-content create delete) + ;; Now /a/b/c does not exist + (with-exception-handler + (lambda (error) + (unless (path-not-found? error) + (exit 10))) + (lambda () + (read-path "/a/b/c") + (exit 11)) + #:unwind? #t + #:unwind-for-type &path-not-found) + ;; We can’t delete /a/ because there's /a/b/ in it + (with-exception-handler + (lambda (error) + (unless (container-not-empty? error) + (exit 12)) + (unless (equal? (container-not-empty-path error) "/a/") + (exit 13))) + (lambda () + (update-path "/a/" (lambda (etag aux) #f) + content-type contained static-content create delete) + (exit 14)) + #:unwind? #t + #:unwind-for-type &container-not-empty) + ;; However, we can recreate /a/b/c without creating intermediate containers + (update-path "/a/b/c" + (lambda (etag aux) + (values (new-etag) + `((,(string->uri + "http://www.w3.org/ns/auth/acl#accessControl") + . ,(new-acl))))) + content-type contained static-content create delete + #:create-intermediate-containers? #f) + ;; Delete /a/b/c again + (update-path "/a/b/c" (lambda (etag aux) #f) + content-type contained static-content create delete) + ;; Delete /a/b/ + (update-path "/a/b/" (lambda (etag aux) #f) + content-type contained static-content create delete) + ;; Delete /a/ + (update-path "/a/" (lambda (etag aux) #f) + content-type contained static-content create delete) + ;; Cannot delete the root + (with-exception-handler + (lambda (error) + (unless (cannot-delete-root? error) + (exit 15))) + (lambda () + (update-path "/" (lambda (etag aux) #f) + content-type contained static-content create delete) + (exit 16)) + #:unwind? #t + #:unwind-for-type &cannot-delete-root) + ;; However, the root should be empty + (receive (root-etag root-aux) + (read-path "/") + (unless (null? (contained root-etag)) + (exit 17)))))))) |