(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!) (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) (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)))))))))