;; disfluid, implementation of the Solid specification
;; Copyright (C) 2020, 2021  Vivien Kraus

;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU Affero General Public License as
;; published by the Free Software Foundation, either version 3 of the
;; License, or (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU Affero General Public License for more details.

;; 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/>.

(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)
    (set! uri (string->uri uri)))
  (unless (equal? uri
                  (string->uri "https://fbi.databox.me/group"))
    (format (current-error-port)
            "Expected:\n  ~s, got:\n  ~s\n" uri (string->uri "https://fbi.databox.me/group"))
    (exit 1))
  (values
   (build-response #:headers '((content-type text/turtle)))
   "@prefix vcard: <http://www.w3.org/2006/vcard/ns#>.

<#spies> a vcard:Group;
  vcard:hasMember <https://the-spy.databox.me/profile/card#me> .
"))

(with-test-environment
 "direct-acl"
 (lambda ()
   (for-each
    (lambda (f)
      (false-if-exception
       (delete-file
        (string-append
         "tests/direct-acl.home/disfluid/server/content/"
         f))))  
    '("6/8OMG_V5x-KmI6TI"
      "X/hqM_2Avn5_egTzs"
      "a/68pTwiImTWTpjQl"
      "5/n1KPgAd3ng4wSqn"
      "D/wxU0ogx5rzRrvu2"
      "F/BQKBGrtq6U_M0L7"
      "n/U46BXbknEaLWZpH"
      "N/gnO8RAS9FpPiO5j"
      "A/fkGTJRCHc-jHk-V"
      "H/y4S5p1BqTEJi-Jb"
      "b/k7RqZevpCHAumba"
      "y/29x0MEOMybxUqDU"
      "5/KVojpXDg0Aob3_v"))
   (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;
  acl:accessTo <https://alice.databox.me/>;
  acl:agent <https://alice.databox.me/profile/card#me>;
  acl:mode acl:Read, acl:Write, acl:Control;
  acl:default <https://alice.databox.me/>.

<#for-the-fbi>
  a acl:Authorization;
  acl:accessTo <https://alice.databox.me/>;
  acl:agentGroup <https://fbi.databox.me/group#spies>;
  acl:mode acl:Read, acl:Write;
  acl:default <https://alice.databox.me/private-docs/file1>.
"))
           (/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>
  a acl:Authorization;
  acl:accessTo <https://alice.databox.me/docs/>;
  acl:agent <https://alice.databox.me/profile/card#me>;
  acl:mode acl:Read, acl:Write, acl:Control.

<#anyone-can-list-files>
  a acl:Authorization;
  acl:accessTo <https://alice.databox.me/docs/>;
  acl:agentClass foaf:Agent;
  acl:mode acl:Read.
"))
           (/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>
  a acl:Authorization;
  acl:accessTo <https://alice.databox.me/docs/file1>;
  acl:agent <https://alice.databox.me/profile/card#me>;
  acl:mode acl:Read, acl:Write, acl:Control.

<#public>
  a acl:Authorization;
  acl:accessTo <https://alice.databox.me/docs/file1>;
  acl:agentClass foaf:Agent;
  acl:mode acl:Read.
"))
           (/docs/file2.acl
            (make <content>
              #:content-type 'text/turtle
              #:static-content "@prefix acl: <http://www.w3.org/ns/auth/acl#> .

<#default>
  a acl:Authorization;
  acl:accessTo <https://alice.databox.me/docs/file2>;
  acl:agent <https://alice.databox.me/profile/card#me>;
  acl:mode acl:Read, acl:Write, acl:Control.

<#public>
  a acl:Authorization;
  acl:accessTo <https://alice.databox.me/docs/file2>;
  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)))))
       (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))))))))