diff options
Diffstat (limited to 'tests/crud.scm')
| -rw-r--r-- | tests/crud.scm | 107 |
1 files changed, 105 insertions, 2 deletions
diff --git a/tests/crud.scm b/tests/crud.scm index 422b1da..222bcc3 100644 --- a/tests/crud.scm +++ b/tests/crud.scm @@ -1,12 +1,17 @@ (use-modules (webid-oidc server create) + (webid-oidc server read) (webid-oidc server resource content) (webid-oidc server resource path) (webid-oidc errors) (webid-oidc testing) + (webid-oidc fetch) + (webid-oidc rdf-index) (web http) (web request) (web response) - (web uri)) + (web uri) + (ice-9 receive) + (rnrs bytevectors)) (with-test-environment "crud" @@ -40,6 +45,7 @@ "i/l7asoJjJEMhngUeSt4tHVu8Zxx4EFG_FDeJfL3-oPE")) (let ((server-name (string->uri "https://example.com")) (owner (string->uri "https://alice.databox.me"))) + ;; CREATE (unless (create-root server-name owner) (exit 1)) @@ -77,4 +83,101 @@ (exit 5)) #:unwind? #t #:unwind-for-type &path-is-auxiliary)) - '(".acl" ".meta"))))) + '(".acl" ".meta")) + ;; READ + (receive (headers-root root) (read server-name owner owner "/") + ;; For root, we’re looking for the following headers: + ;; - link: ldp:BasicContainer; rel = "type", </.acl>; rel = "acl", pim:Storage; rel = "type", owner; rel = "solid:owner" + ;; - allow: GET, HEAD, OPTIONS, PUT, POST, but not DELETE + ;; - accept-put: 'text/turtle + ;; - content-type: 'text/turtle + ;; - etag: weak + ;; The content is a RDF graph, it should contain 1 triple: </> ldp:contains </inbox>. + (when (bytevector? root) + (set! root (utf8->string root))) + (let ((links (assq-ref headers-root 'link)) + (allow (assq-ref headers-root 'allow)) + (accept-put (assq-ref headers-root 'accept-put)) + (content-type (assq-ref headers-root 'content-type)) + (etag (assq-ref headers-root 'etag))) + (unless (equal? (assoc-ref links (string->uri "http://www.w3.org/ns/ldp#BasicContainer")) + '((rel . "type"))) + (exit 6)) + (unless (equal? (assoc-ref links (string->uri "https://example.com/.acl")) + '((rel . "acl"))) + (exit 7)) + (unless (equal? (assoc-ref links (string->uri "http://www.w3.org/ns/pim/space#Storage")) + '((rel . "type"))) + (exit 8)) + (unless (equal? (assoc-ref links owner) + '((rel . "http://www.w3.org/ns/solid/terms#owner"))) + (exit 9)) + (unless (and (memq 'GET allow) + (memq 'HEAD allow) + (memq 'OPTIONS allow) + (memq 'PUT allow) + (memq 'POST allow)) + (exit 10)) + (when (memq 'DELETE allow) + (exit 11)) + (unless (equal? accept-put "text/turtle") + (exit 12)) + (unless (equal? content-type '(text/turtle)) + (exit 13)) + (unless (string? (car etag)) + (exit 14)) + (when (cdr etag) + (exit 15)) + (with-index + (fetch "https://example.com/" + #:http-get + (lambda (uri . rest) + (values + (build-response #:headers `((content-type . ,content-type))) + root))) + (lambda (rdf-match) + (when (null? (rdf-match "https://example.com/" + "http://www.w3.org/ns/ldp#contains" + "https://example.com/inbox/")) + (exit 16)))))) + (receive (headers-/.acl /.acl) (read server-name owner owner "/.acl") + ;; The ACL has the following headers: + ;; - allow: GET, HEAD, OPTIONS, PUT, DELETE, but not POST + ;; - accept-put: 'text/turtle + ;; - content-type: 'text/turtle + ;; - etag: weak + ;; The content is a RDF graph containing at least one authorization. + (when (bytevector? /.acl) + (set! /.acl (utf8->string /.acl))) + (let ((allow (assq-ref headers-/.acl 'allow)) + (accept-put (assq-ref headers-/.acl 'accept-put)) + (content-type (assq-ref headers-/.acl 'content-type)) + (etag (assq-ref headers-/.acl 'etag))) + (unless (and (memq 'GET allow) + (memq 'HEAD allow) + (memq 'OPTIONS allow) + (memq 'PUT allow) + (memq 'DELETE allow)) + (exit 17)) + (when (memq 'POST allow) + (exit 18)) + (unless (equal? accept-put "text/turtle") + (exit 19)) + (unless (equal? content-type '(text/turtle)) + (exit 20)) + (unless (string? (car etag)) + (exit 21)) + (when (cdr etag) + (exit 22)) + (with-index + (fetch "https://example.com/.acl" + #:http-get + (lambda (uri . rest) + (values + (build-response #:headers `((content-type . ,content-type))) + /.acl))) + (lambda (rdf-match) + (when (null? (rdf-match #f + "http://www.w3.org/1999/02/22-rdf-syntax-ns#type" + "http://www.w3.org/ns/auth/acl#Authorization")) + (exit 23))))))))) |