summaryrefslogtreecommitdiff
path: root/src/scm/webid-oidc/fetch.scm
blob: 6642ed1e9a489ed5b63a01dacc8420098b9326e5 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
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))))))))))