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 | |
parent | 4d9a10165a6c7bf8df6f86f032bf7b3412e83ae6 (diff) |
Support for json-ld
Diffstat (limited to 'src/scm/webid-oidc')
-rw-r--r-- | src/scm/webid-oidc/fetch.scm | 45 | ||||
-rw-r--r-- | src/scm/webid-oidc/resource-server.scm | 70 | ||||
-rw-r--r-- | src/scm/webid-oidc/serve.scm | 7 | ||||
-rw-r--r-- | src/scm/webid-oidc/server/read.scm | 4 |
4 files changed, 83 insertions, 43 deletions
diff --git a/src/scm/webid-oidc/fetch.scm b/src/scm/webid-oidc/fetch.scm index f998ba2..c027787 100644 --- a/src/scm/webid-oidc/fetch.scm +++ b/src/scm/webid-oidc/fetch.scm @@ -23,7 +23,11 @@ #:use-module (web request) #:use-module (web response) #:use-module (web uri) - #:use-module (turtle tordf)) + #:use-module (rdf rdf) + #:use-module (turtle tordf) + #:use-module (nquads tordf) + #:use-module (json) + #:use-module (jsonld)) (define*-public (fetch uri #:key (http-get http-get)) (unless (uri? uri) @@ -34,7 +38,7 @@ (lambda () (receive (response response-body) (http-get uri - #:headers `((accept (text/turtle)))) + #:headers `((accept (text/turtle application/n-quads application/ld+json)))) (with-exception-handler (lambda (error) (raise-unexpected-response response error)) @@ -44,17 +48,30 @@ (response-reason-phrase response))) (let ((content-type (response-content-type response))) (unless (and content-type - (eq? (car content-type) 'text/turtle) + (or + (eq? (car content-type) 'text/turtle) + (eq? (car content-type) 'application/n-quads) + (eq? (car content-type) 'text/x-nquads) + (eq? (car content-type) 'application/ld+json)) (or (not (assq-ref (cdr content-type) 'charset)) (equal? (assq-ref (cdr content-type) 'charset) "utf-8"))) - (raise-unexpected-header-value 'content-type content-type))) - (when (bytevector? response-body) - (set! response-body (utf8->string response-body))) - (with-exception-handler - (lambda (rdf-error) - (raise-not-turtle response-body rdf-error)) - (lambda () - (turtle->rdf (string-append - "# This is not a file name\n" - response-body) - (uri->string uri)))))))))) + (raise-unexpected-header-value 'content-type content-type)) + (when (bytevector? response-body) + (set! response-body (utf8->string response-body))) + (with-exception-handler + (lambda (rdf-error) + (raise-not-turtle response-body rdf-error)) + (lambda () + (case (car content-type) + ((text/turtle) + (turtle->rdf (string-append + "# This is not a file name\n" + response-body) + (uri->string uri))) + ((application/ld+json) + (rdf-dataset-default-graph + (jsonld->rdf (json-string->scm response-body)))) + ((application/n-quads text/x-nquads) + (nquads->rdf (string-append + "# This is not a file name\n" + response-body))))))))))))) 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)) diff --git a/src/scm/webid-oidc/serve.scm b/src/scm/webid-oidc/serve.scm index 4f54495..c46ab8c 100644 --- a/src/scm/webid-oidc/serve.scm +++ b/src/scm/webid-oidc/serve.scm @@ -28,6 +28,8 @@ #:use-module (rdf rdf) #:use-module (turtle fromrdf) #:use-module (nquads fromrdf) + #:use-module (json) + #:use-module (jsonld) #:export ( convert @@ -66,6 +68,11 @@ (values request (rdf->nquads (make-rdf-dataset data-as-rdf '())))) + ((and (eq? request 'application/ld+json) data-as-rdf) + (values 'application/ld+json + (scm->json-string + (rdf->jsonld + (make-rdf-dataset data-as-rdf '()))))) ;; Add other conversion strategies here (else (try-satisfy (cdr accepts))))))) diff --git a/src/scm/webid-oidc/server/read.scm b/src/scm/webid-oidc/server/read.scm index 6cd1a01..aecde36 100644 --- a/src/scm/webid-oidc/server/read.scm +++ b/src/scm/webid-oidc/server/read.scm @@ -88,7 +88,9 @@ (unless relevant-etag (raise-exception (make-auxiliary-resource-absent base-path path-type))) - (let ((accept-put (if (or container? path-type) "text/turtle" "*/*"))) + (let ((accept-put (if (or container? path-type) + "text/turtle; application/n-quads; application/ld+json" + "*/*"))) (values ;; Headers (let ((links |