;;;; Copyright (C) 2020 Julien Lepiller <julien@lepiller.eu>
;;;; 
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
;;;; License as published by the Free Software Foundation; either
;;;; version 3 of the License, or (at your option) any later version.
;;;; 
;;;; This library 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
;;;; Lesser General Public License for more details.
;;;; 
;;;; You should have received a copy of the GNU Lesser General Public
;;;; License along with this library; if not, write to the Free Software
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
;;;; 

(define-module (test-modules download)
  #:use-module (jsonld download)
  #:use-module (jsonld iri)
  #:use-module (jsonld json)
  #:use-module (jsonld memoization)
  #:use-module (jsonld options)
  #:use-module (nquads tordf)
  #:use-module (rnrs bytevectors)
  #:use-module (test-modules testsuite)
  #:use-module (web client)
  #:use-module (web response)
  #:use-module (web uri)
  #:export (test-http-get get-test-document-loader download-nq))

(define* (update-response response
                          #:key
                          (version           (response-version response))
                          (code              (response-code response))
                          (reason-phrase     (response-reason-phrase response))
                          (headers           (response-headers response))
                          (port              (response-port response))
                          (validate-headers? #t))
  (build-response
    #:version version
    #:code code
    #:reason-phrase reason-phrase
    #:headers headers
    #:port port
    #:validate-headers? validate-headers?))

(define (test-http-get options)
  "Return a procedure that downloads a file, and modifies the response according
to @var{options}, an alist of parameters, as described in the test suite
specification."
  (lambda* (uri #:key (headers '()))
    (call-with-values
      (lambda ()
        (http-get uri #:headers headers))
      (lambda (hdr body)
        (when (json-has-key? options "contentType")
          (let ((type (assoc-ref options "contentType")))
            (set! type (list (string->symbol type)))
            (set! hdr
              (update-response hdr #:headers (alist-set (response-headers hdr)
                                                      'content-type type)))))
        (when (json-has-key? options "httpLink")
          ;; first remove http link headers
          (let loop ((headers (response-headers hdr)))
            (if (assoc-ref headers 'link)
                (loop (alist-remove headers 'link))
                (set! hdr (update-response hdr #:headers headers))))
          ;; then add our own
          (let* ((links (assoc-ref options "httpLink"))
                 (links (if (json-array? links)
                            (array->list links)
                            (list links))))
            (let loop ((headers (response-headers hdr))
                       (links links))
              (if (null? links)
                  (set! hdr (update-response hdr #:headers headers))
                  (loop (cons (cons 'link (car links)) headers)
                        (cdr links))))))
        (when (json-has-key? options "redirectTo")
          (let* ((location (assoc-ref options "redirectTo"))
                 (location (resolve-iri jsonld-test-url location)))
            (set! hdr
              (update-response hdr #:headers (alist-set (response-headers hdr)
                                               'location (string->uri location))))))
        (when (json-has-key? options "httpStatus")
          (set! hdr
            (update-response hdr #:code (assoc-ref options "httpStatus"))))
        (values hdr body)))))

(define (get-test-document-loader options)
  "Return a procedure that cane be used as the document loader in the
jsonld-options structure."
  (memoize
    (lambda args
      (apply download-json
             (append args `(#:http-get ,(test-http-get options)))))))

(define (download-nq url)
  (call-with-values
    (lambda ()
      (http-get url))
    (lambda (hdr body)
      (if (equal? (response-code hdr) 200)
          (nquads->rdf
            (if (string? body)
                body
                (utf8->string body)))
          (throw 'download-error (response-code hdr) url)))))