1 files changed, 44 insertions, 0 deletions
diff --git a/src/scm/webid-oidc/fetch.scm b/src/scm/webid-oidc/fetch.scm
new file mode 100644
index 0000000..6642ed1
--- /dev/null
+++ b/src/scm/webid-oidc/fetch.scm
@@ -0,0 +1,44 @@
+(define-module (webid-oidc fetch)
+  #:use-module (webid-oidc errors)
+  #:use-module (ice-9 optargs)
+  #:use-module (ice-9 receive)
+  #:use-module (rnrs bytevectors)
+  #:use-module (web client)
+  #:use-module (web request)
+  #:use-module (web response)
+  #:use-module (web uri)
+  #:use-module (turtle tordf))
+
+(define*-public (fetch uri #:key (http-get http-get))
+  (unless (uri? uri)
+    (set! uri (string->uri uri)))
+  (with-exception-handler
+      (lambda (error)
+        (raise-cannot-fetch-linked-data uri error))
+    (lambda ()
+      (receive (response response-body)
+          (http-get uri
+                    #:headers `((accept (text/turtle))))
+        (with-exception-handler
+            (lambda (error)
+              (raise-unexpected-response response error))
+          (lambda ()
+            (unless (eqv? (response-code response) 200)
+              (raise-request-failed-unexpectedly (response-code response)
+                                                 (response-reason-phrase response)))
+            (let ((content-type (response-content-type response)))
+              (unless (and content-type
+                           (eq? (car content-type) 'text/turtle)
+                           (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))))))))))