(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))))))))