Support for json-ld

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