summaryrefslogtreecommitdiff
path: root/tests/http-link.scm
blob: b2e4aa33d53f1eece2d94e07a2cc9f06ace396f3 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
(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 "<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)
           (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)))))))))