diff options
Diffstat (limited to 'src/scm/webid-oidc/resource-server.scm')
-rw-r--r-- | src/scm/webid-oidc/resource-server.scm | 70 |
1 files changed, 42 insertions, 28 deletions
diff --git a/src/scm/webid-oidc/resource-server.scm b/src/scm/webid-oidc/resource-server.scm index 2d1c798..a6c111e 100644 --- a/src/scm/webid-oidc/resource-server.scm +++ b/src/scm/webid-oidc/resource-server.scm @@ -120,6 +120,16 @@ (lambda () (f return)))))) +(define (nonrdf-or-turtle server-uri request request-body) + ;; If the request is an exotic RDF serialization + ;; format, we want to convert it to Turtle, + ;; otherwise we will consider it non-rdf. + (convert '(text/turtle */*) + server-uri + (uri-path (request-uri request)) + (request-content-type request) + request-body)) + (define (serve-get return path if-match if-none-match content-type content etag headers user) (define (respond-normal) (return @@ -213,39 +223,43 @@ other-headers) user))))) ((PUT) - (return - (build-response - #:headers - `((etag . (,(update server-uri owner user - (uri-path (request-uri request)) - (request-if-match request) - (request-if-none-match request) - (request-content-type request) - request-body - #:http-get http-get) - . #f)))) - "" - user)) - ((POST) - (let ((types - (map car - (filter - (lambda (link) - (equal? (assq-ref link 'rel) "type")) - (request-links request))))) + (receive (content-type content) + (nonrdf-or-turtle server-uri request request-body) (return (build-response - #:code 201 #:reason-phrase "Created" #:headers - `((location . ,(create server-uri owner user - (uri-path (request-uri request)) - types - (assq-ref (request-headers request) 'slug) - (request-content-type request) - request-body - #:http-get http-get)))) + `((etag . (,(update server-uri owner user + (uri-path (request-uri request)) + (request-if-match request) + (request-if-none-match request) + content-type + content + #:http-get http-get) + . #f)))) "" user))) + ((POST) + (receive (content-type content) + (nonrdf-or-turtle server-uri request request-body) + (let ((types + (map car + (filter + (lambda (link) + (equal? (assq-ref link 'rel) "type")) + (request-links request))))) + (return + (build-response + #:code 201 #:reason-phrase "Created" + #:headers + `((location . ,(create server-uri owner user + (uri-path (request-uri request)) + types + (assq-ref (request-headers request) 'slug) + content-type + content + #:http-get http-get)))) + "" + user)))) ((DELETE) (delete server-uri owner user (uri-path (request-uri request)) |