diff options
Diffstat (limited to 'ldp.scm')
-rw-r--r-- | ldp.scm | 70 |
1 files changed, 70 insertions, 0 deletions
@@ -0,0 +1,70 @@ +(define-module (ldp) + #:use-module (ldp resource) + #:use-module (ldp path) + #:use-module (ldp resource load) + #:use-module (ldp resource update) + #:use-module (ldp response) + #:use-module (ldp content) + #:use-module (ldp precondition) + #:use-module (web request) + #:use-module (web response) + #:use-module (ldp precondition) + #:use-module (rnrs bytevectors)) + +(define-public (respond request request-body) + (when (string? request-body) + (set! request-body (string->utf8 request-body))) + (catch #t + (lambda () + (let ((method (request-method request)) + (path (uri->path (request-uri request))) + (has-precondition? (or (request-if-match request) + (request-if-none-match request))) + (precondition (request->precondition request))) + (cond ((or (eq? method 'POST) (eq? method 'PUT)) + (let ((slug (assoc-ref (request-headers request) 'slug)) + (link-header (assoc-ref (request-headers request) 'link)) + (content-type (request-content-type request))) + (unless slug + (set! slug "sub")) + (unless content-type + (throw 'bad-request)) + (set! content-type (car content-type)) + (cond ((eq? method 'POST) + (let ((resource (post path + slug + precondition + link-header + content-type + request-body))) + (respond-to-post resource))) + ((eq? method 'PUT) + (put path precondition link-header content-type request-body) + (respond-to-put))))) + ((or (eq? method 'GET) (eq? method 'HEAD) (eq? method 'OPTIONS)) + (call-with-values + (lambda () + (load (uri->path (request-uri request)))) + (lambda (resource port triples) + (let ((response-body + (and (eq? method 'GET) + (load-content + (make-content port triples) + (text-content-type? + (resource-content-type resource)))))) + (case method + ((GET) + (when (and has-precondition? + (precondition-valid? precondition + (resource-etag resource))) + (throw 'not-modified)) + (respond-to-get resource response-body)) + ((HEAD) (respond-to-head resource)) + ((OPTIONS) (respond-to-options resource))))))) + ((eq? method 'DELETE) + (delete path precondition) + (respond-to-delete)) + (else + (throw 'bad-request))))) + (lambda error + (apply respond-to-error error)))) |