diff options
Diffstat (limited to 'tests/crud.scm')
| -rw-r--r-- | tests/crud.scm | 46 |
1 files changed, 34 insertions, 12 deletions
diff --git a/tests/crud.scm b/tests/crud.scm index da3637a..38af286 100644 --- a/tests/crud.scm +++ b/tests/crud.scm @@ -23,6 +23,7 @@ #:use-module (webid-oidc server resource path) #:use-module (webid-oidc errors) #:use-module (webid-oidc testing) + #:use-module (webid-oidc http-link) #:use-module ((webid-oidc parameters) #:prefix p:) #:use-module (webid-oidc fetch) #:use-module (webid-oidc rdf-index) @@ -31,6 +32,7 @@ #:use-module (web response) #:use-module (web uri) #:use-module (ice-9 receive) + #:use-module (ice-9 match) #:use-module (rnrs bytevectors) #:duplicates (merge-generics) #:declarative? #t) @@ -133,18 +135,38 @@ (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)) + (let search-links ((links links) + (container-type-found? #f) + (acl-found? #f) + (storage-type-found? #f) + (owner-found? #f)) + (match links + ((link links ...) + (cond + ((and (equal? (target-iri link) (string->uri "http://www.w3.org/ns/ldp#BasicContainer")) + (equal? (relation-type link) "type")) + (search-links links #t acl-found? storage-type-found? owner-found?)) + ((and (equal? (target-iri link) (string->uri "https://example.com/.acl")) + (equal? (relation-type link) "acl")) + (search-links links container-type-found? #t storage-type-found? owner-found?)) + ((and (equal? (target-iri link) (string->uri "http://www.w3.org/ns/pim/space#Storage")) + (equal? (relation-type link) "type")) + (search-links links container-type-found? acl-found? #t owner-found?)) + ((and (equal? (target-iri link) owner) + (equal? (relation-type link) "http://www.w3.org/ns/solid/terms#owner")) + (search-links links container-type-found? acl-found? storage-type-found? #t)) + (else + (format (current-error-port) "Ignoring link: ~s\n" link) + (search-links links container-type-found? acl-found? storage-type-found? owner-found?)))) + (() + (unless container-type-found? + (exit 6)) + (unless acl-found? + (exit 7)) + (unless storage-type-found? + (exit 8)) + (unless owner-found? + (exit 9))))) (unless (and (memq 'GET allow) (memq 'HEAD allow) (memq 'OPTIONS allow) |