;; webid-oidc, implementation of the Solid specification
;; Copyright (C) 2020, 2021  Vivien Kraus

;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU Affero General Public License as
;; published by the Free Software Foundation, either version 3 of the
;; License, or (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU Affero General Public License for more details.

;; You should have received a copy of the GNU Affero General Public License
;; along with this program.  If not, see <https://www.gnu.org/licenses/>.

(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 (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)
    (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 application/n-quads application/ld+json))))
        (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
                           (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 ()
                  (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)))))))))))))