;; disfluid, 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 web-i18n)
  #:use-module ((webid-oidc parameters) #:prefix p:)
  #:use-module (ice-9 optargs)
  #:use-module (ice-9 receive)
  #:use-module (ice-9 match)
  #:use-module (ice-9 exceptions)
  #:use-module (rnrs bytevectors)
  #: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)
  #:declarative? #t
  #:export
  (

   &cannot-fetch-linked-data
   make-cannot-fetch-linked-data
   cannot-fetch-linked-data?
   cannot-fetch-linked-data-uri

   fetch
   ))

(define-exception-type
  &cannot-fetch-linked-data
  &external-error
  make-cannot-fetch-linked-data
  cannot-fetch-linked-data?
  (uri cannot-fetch-linked-data-uri))

(define (fetch uri)
  (unless (uri? uri)
    (set! uri (string->uri uri)))
  (with-exception-handler
      (lambda (error)
        (let ((final-message 
               (if (exception-with-message? error)
                   (format #f (G_ "cannot fetch ~s as linked data: ~a")
                           (uri->string uri)
                           (exception-message error))
                   (format #f (G_ "cannot fetch ~s as linked data")
                           (uri->string uri)))))
          (raise-exception
           (make-exception
            (make-cannot-fetch-linked-data uri)
            (make-exception-with-message final-message)
            error))))
    (lambda ()
      (receive (response response-body)
          ((p:anonymous-http-request) uri
           #:headers `((accept (text/turtle application/n-quads application/ld+json))))
        (with-exception-handler
            (lambda (error)
              (let ((final-message
                     (if (exception-with-message? error)
                         (format #f (G_ "unexpected response from the server: ~a")
                                 (exception-message error))
                         (format #f (G_ "unexpected response from the server")))))
                (raise-exception
                 (make-exception
                  (make-exception-with-message final-message)))))
          (lambda ()
            (unless (eqv? (response-code response) 200)
              (let ((final-message
                     (format #f (G_ "the request failed unexpectedly with ~s ~s")
                             (response-code response)
                             (response-reason-phrase response))))
                (raise-exception
                 (make-exception
                  (make-exception-with-message final-message)))))
            (let ((content-type (response-content-type response)))
              (define (as-text!)
                (when (bytevector? response-body)
                  (set! response-body
                        (utf8->string response-body))))
              (match content-type
                (('text/turtle . _)
                 (as-text!)
                 (turtle->rdf (string-append
                               "# This is not a file name\n"
                               response-body)
                              (uri->string uri)))
                ((or ('application/n-quads . _)
                     ('text/x-nquads . _))
                 (nquads->rdf  (string-append
                                "# This is not a file name\n"
                                response-body)))
                (('application/ld+json . _)
                 (rdf-dataset-default-graph
                  (jsonld->rdf (json-string->scm response-body))))
                (else
                 (let ((final-message
                        (format #f (G_ "cannot negociate a recognized RFD content type, got ~s")
                                content-type)))
                   (raise-exception
                    (make-exception
                     (make-exception-with-message final-message)))))))))))))