;; 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 .
(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 "")
(example-two "; ok")
(example-three "; a=b")
(example-four "; a=\"\\\\b\\n\"")
(example-five "; ok; a=b; a=\"\\\\b\\n\"")
(expected-zero "Link: <>\r\n")
(expected-one "Link: \r\n")
(expected-two "Link: ; ok\r\n")
(expected-three "Link: ; a=\"b\"\r\n")
(expected-four "Link: ; a=\"\\\\b\n\"\r\n")
(expected-five "Link: ; 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: <>, , ; ok, ; a=\"b\", ; a=\"\\\\b\n\", ; 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)))))))))