diff options
| author | Vivien Kraus <vivien@planete-kraus.eu> | 2021-07-27 10:59:45 +0200 |
|---|---|---|
| committer | Vivien Kraus <vivien@planete-kraus.eu> | 2021-07-27 13:40:09 +0200 |
| commit | e150c1b232294d9352b61df22e82e2d4513b615e (patch) | |
| tree | 22ab5b13caed5c5ec942fde2e13c475e19b97e9b /src/scm/webid-oidc/resource-server.scm | |
| parent | 4d9a10165a6c7bf8df6f86f032bf7b3412e83ae6 (diff) | |
Support for json-ld
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)) |