diff options
Diffstat (limited to 'ldp/response.scm')
-rw-r--r-- | ldp/response.scm | 110 |
1 files changed, 110 insertions, 0 deletions
diff --git a/ldp/response.scm b/ldp/response.scm new file mode 100644 index 0000000..339e44b --- /dev/null +++ b/ldp/response.scm @@ -0,0 +1,110 @@ +(define-module (ldp response) + #:use-module (ldp path) + #:use-module (ldp resource) + #:use-module (web response)) + +(define-public (respond-not-found) + (values (build-response + #:code 404 + #:reason-phrase "Not Found") + #f)) + +(define-public (respond-bad-request) + (values (build-response + #:code 400 + #:reason-phrase "Bad Request") + #f)) + +(define-public (respond-not-modified) + (values (build-response + #:code 304 + #:reason-phrase "Not Modified") + #f)) + +(define-public (respond-precondition-failed) + (values (build-response + #:code 412 + #:reason-phrase "Precondition Failed") + #f)) + +(define-public (respond-conflict) + (values (build-response + #:code 409 + #:reason-phrase "Conflict") + #f)) + +(define-public (respond-method-not-allowed) + (values (build-response + #:code 405 + #:reason-phrase "Method Not Allowed") + #f)) + +(define-public (respond-to-error key . args) + (case key + ((not-found) + (respond-not-found)) + ((bad-request) + (respond-bad-request)) + ((not-modified) + (respond-not-modified)) + ((precondition-failed) + (respond-precondition-failed)) + ((conflict cannot-delete-the-root) + (respond-conflict)) + ((method-not-allowed cannot-add-resources-in-non-container) + (respond-method-not-allowed)) + (else + (apply throw key args)))) + +(define (resource->http-link resource) + (if (container? resource) + "<http://www.w3.org/ns/ldp#BasicContainer>; rel=\"type\", <http://www.w3.org/ns/ldp#Resource>; rel=\"type\"" + "<http://www.w3.org/ns/ldp#Resource>; rel=\"type\">")) + +(define-public (respond-to-post resource) + (values (build-response + #:code 201 + #:reason-phrase "Created" + #:headers `((location . ,(path->uri (resource-path resource))))) + #f)) + +(define-public (respond-to-put) + (values (build-response) + #f)) + +(define-public (respond-to-delete) + (values (build-response) + #f)) + +(define-public (respond-to-get resource data) + (values (build-response + #:headers `((content-type . (,(resource-content-type resource))) + (etag . (,(resource-etag resource) . #t)) + (link . ,(resource->http-link resource)) + (allow HEAD GET POST PUT DELETE OPTIONS))) + data)) + +(define-public (respond-to-head resource) + (values (build-response + #:headers `((content-type . (,(resource-content-type resource))) + (etag . (,(resource-etag resource) . #t)) + (link . ,(resource->http-link resource)) + (allow HEAD GET POST PUT DELETE OPTIONS))) + #f)) + +(define-public (respond-to-options resource) + (let ((allow + (cond ((is-root? (resource-path resource)) + '(HEAD GET POST PUT OPTIONS)) + ((container? resource) + '(HEAD GET POST PUT DELETE OPTIONS)) + (else + '(HEAD GET PUT DELETE OPTIONS))))) + (values (build-response + #:code 204 + #:reason-phrase "No Content" + #:headers `((content-type . (,(resource-content-type resource))) + (etag . (,(resource-etag resource) . #t)) + (link . ,(resource->http-link resource)) + (allow . ,allow))) + #f))) |