;; 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 (tests http-link)
  #:use-module (webid-oidc http-link)
  #:use-module (webid-oidc testing)
  #:use-module (web http)
  #:use-module (web request)
  #:use-module (web response)
  #:use-module (web uri)
  #:use-module (oop goops))

(define-class <test-case> ()
  (encoded-form #:init-keyword #:encoded-form #:getter encoded-form)
  (decoded-form #:init-keyword #:decoded-form #:getter decoded-form)
  (one-way? #:init-keyword #:one-way? #:getter one-way? #:init-value #f))

(define-method (check (test <test-case>))
  (let ((decoded (parse-header 'link (encoded-form test)))
        (encoded (and (not (one-way? test))
                      (call-with-output-string
                        (lambda (port)
                          (write-header 'link (decoded-form test) port))))))
    (unless (and (equal? decoded (decoded-form test))
                 (or (one-way? test)
                     (equal? encoded (format #f "Link: ~a\r\n" (encoded-form test)))))
      (format (current-error-port) "Test case failed:
~s:
           -> ~s
    (expected ~s)
~s:
           -> ~s
    (expected ~s)
"
              (encoded-form test) decoded (decoded-form test)
              (decoded-form test) encoded (format #f "Link: ~a\r\n" (encoded-form test)))
      (exit 1))))

(with-test-environment
 "http-link"
 (lambda ()
   (declare-link-header!)
   ;; Declare it twice to check that there’s no problem
   (declare-link-header!)
   (let ((cases
          ;; These test cases are copied from rfc8288
          (list
           (make <test-case>
             #:encoded-form
             "<http://example.com/TheBook/chapter2>; rel=\"previous\"; title=\"previous chapter\""
             #:decoded-form
             (list
              (make <link>
                #:target-iri "http://example.com/TheBook/chapter2"
                #:relation-type "previous"
                #:title "previous chapter")))
           (make <test-case>
             #:encoded-form
             "</>; rel=\"http://example.net/foo\""
             #:decoded-form
             (list
              (make <link>
                #:target-iri "/"
                #:relation-type "http://example.net/foo")))
           (make <test-case>
             #:encoded-form
             "</terms>; rel=\"copyright\"; anchor=\"#foo\""
             #:decoded-form
             (list
              (make <link>
                #:target-iri "/terms"
                #:relation-type "copyright"
                #:anchor "#foo")))
           (make <test-case>
             #:encoded-form
             "</TheBook/chapter2>; rel=\"previous\"; title*=UTF-8'de'letztes%20Kapitel, </TheBook/chapter4>; rel=\"next\"; title*=UTF-8'de'n%c3%a4chstes%20Kapitel"
             #:decoded-form
             (list
              (make <link>
                #:target-iri "/TheBook/chapter2"
                #:relation-type "previous"
                #:title* "UTF-8'de'letztes%20Kapitel")
              (make <link>
                #:target-iri "/TheBook/chapter4"
                #:relation-type "next"
                #:title* "UTF-8'de'n%c3%a4chstes%20Kapitel")))
           ;; These tests are mine, they check for more edge cases
           (make <test-case>
             #:encoded-form
             "<https://example.com>; rel=\"b\""
             #:decoded-form
             (list
              (make <link>
                #:target-iri "https://example.com"
                #:relation-type "b")))
           (make <test-case>
             #:encoded-form
             "<https://example.com>; rel=\"\\\\b\\n\""
             #:decoded-form
             (list
              (make <link>
                #:target-iri "https://example.com"
                #:relation-type "\\b\n")))
           (make <test-case>
             #:encoded-form
             "<https://example.com>; rel=\"\\\\b\\n\""
             #:decoded-form
             (list
              (make <link>
                #:target-iri "https://example.com"
                #:relation-type "\\b\n"))))))
     (for-each check cases))
   ;; Now, we check that the request / response API works
   (let ((first-link-uri (string->uri "https://example.com/vocab#link"))
         (second-link-uri (string->uri "https://example.com/vocab#type")))
     (let ((first-link
            (make <link>
              #:target-iri first-link-uri
              #:relation-type "type"))
           (second-link
            (make <link>
              #:target-iri second-link-uri
              #:relation-type "type")))
       (let ((request (build-request
                       (string->uri "https://example.com")
                       #:headers
                       `((link . (,first-link))
                         (link . (,second-link))))))
         (let ((response (build-response #:headers `((link . ,(request-links request))))))
           (let ((links (response-links response)))
             (unless (equal? links
                             (list
                              (make <link>
                                #:target-iri "https://example.com/vocab#link"
                                #:relation-type "type")
                              (make <link>
                                #:target-iri "https://example.com/vocab#type"
                                #:relation-type "type")))
               (exit 8)))))))))