From 089ff9eea238de05159ed2eaee0bff93793c9a4c Mon Sep 17 00:00:00 2001
From: Vivien Kraus <vivien@planete-kraus.eu>
Date: Thu, 10 Jun 2021 17:43:28 +0200
Subject: Add support for the HTTP Link header

---
 tests/Makefile.am   |  3 ++-
 tests/http-link.scm | 78 +++++++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 80 insertions(+), 1 deletion(-)
 create mode 100644 tests/http-link.scm

(limited to 'tests')

diff --git a/tests/Makefile.am b/tests/Makefile.am
index 17aa6f4..4d7fda4 100644
--- a/tests/Makefile.am
+++ b/tests/Makefile.am
@@ -42,7 +42,8 @@ TESTS = %reldir%/load-library.scm \
   %reldir%/client-token.scm \
   %reldir%/client-manifest-not-modified.scm \
   %reldir%/server-content.scm \
-  %reldir%/server-path.scm
+  %reldir%/server-path.scm \
+  %reldir%/http-link.scm
 
 EXTRA_DIST += $(TESTS) %reldir%/ChangeLog
 
diff --git a/tests/http-link.scm b/tests/http-link.scm
new file mode 100644
index 0000000..b2e4aa3
--- /dev/null
+++ b/tests/http-link.scm
@@ -0,0 +1,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)))))))))
-- 
cgit v1.2.3