;; 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/>.

(use-modules (webid-oidc http-link)
             (webid-oidc testing)
             (web http)
             (web request)
             (web response)
             (web uri))

(with-test-environment
 "http-link"
 (lambda ()
   (declare-link-header!)
   ;; Declare it twice to check that there’s no problem
   (declare-link-header!)
   (let ((example-zero "<>")
         (example-one "<h>")
         (example-two "<https://two.example.com>; ok")
         (example-three "<https://three.example.com>; a=b")
         (example-four "<https://four.example.com>; a=\"\\\\b\\n\"")
         (example-five "<https://five.example.com>; ok; a=b; a=\"\\\\b\\n\"")
         (expected-zero "Link: <>\r\n")
         (expected-one "Link: <h>\r\n")
         (expected-two "Link: <https://two.example.com>; ok\r\n")
         (expected-three "Link: <https://three.example.com>; a=\"b\"\r\n")
         (expected-four "Link: <https://four.example.com>; a=\"\\\\b\n\"\r\n")
         (expected-five "Link: <https://five.example.com>; ok; a=\"b\"; a=\"\\\\b\n\"\r\n"))
     (let ((example-six
            (string-join (list
                          example-zero
                          example-one
                          example-two
                          example-three
                          example-four
                          example-five)
                         ", "))
           (expected-six
            "Link: <>, <h>, <https://two.example.com>; ok, <https://three.example.com>; a=\"b\", <https://four.example.com>; a=\"\\\\b\n\", <https://five.example.com>; ok; a=\"b\"; a=\"\\\\b\n\"\r\n"))
       (define (test str)
         (let ((parsed (parse-header 'link str)))
           (call-with-output-string
             (lambda (port)
               (write-header 'link parsed port)))))
       (let ((zero (test example-zero))
             (one (test example-one))
             (two (test example-two))
             (three (test example-three))
             (four (test example-four))
             (five (test example-five))
             (six (test example-six)))
         (unless (equal? zero expected-zero)
           (exit 1))
         (unless (equal? one expected-one)
           (exit 2))
         (unless (equal? two expected-two)
           (exit 3))
         (unless (equal? three expected-three)
           ;; This test is the first to fail if the Link header
           ;; handler is not installed.
           (exit 4))
         (unless (equal? four expected-four)
           (exit 5))
         (unless (equal? five expected-five)
           (exit 6))
         (unless (equal? six expected-six)
           (exit 7)))))
   (let ((first-link-uri (string->uri "https://example.com/vocab#link"))
         (second-link-uri (string->uri "https://example.com/vocab#type")))
     (let ((first-link
            `(,first-link-uri (rel . "type")))
           (second-link
            `(,second-link-uri (rel . "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
                              (list (string->uri "https://example.com/vocab#link") (cons 'rel "type"))
                              (list (string->uri "https://example.com/vocab#type") (cons 'rel "type"))))
               (exit 8)))))))))