From 118d76f79b03f8a1a4a865e0d396d1c11f5efc83 Mon Sep 17 00:00:00 2001
From: Vivien Kraus <vivien@planete-kraus.eu>
Date: Sat, 28 Nov 2020 09:51:15 +0100
Subject: Use a web cache on the file system

---
 tests/Makefile.am          |  4 +++-
 tests/cache-revalidate.scm | 42 +++++++++++++++++++++++++++++++++
 tests/cache-valid.scm      | 58 ++++++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 103 insertions(+), 1 deletion(-)
 create mode 100644 tests/cache-revalidate.scm
 create mode 100644 tests/cache-valid.scm

(limited to 'tests')

diff --git a/tests/Makefile.am b/tests/Makefile.am
index e2330a4..172abf3 100644
--- a/tests/Makefile.am
+++ b/tests/Makefile.am
@@ -11,7 +11,9 @@ TESTS = %reldir%/load-library.scm \
   %reldir%/jkt.scm \
   %reldir%/verify.scm \
   %reldir%/verification-failed.scm \
-  %reldir%/jws.scm
+  %reldir%/jws.scm \
+  %reldir%/cache-valid.scm \
+  %reldir%/cache-revalidate.scm
 
 EXTRA_DIST += $(TESTS)
 
diff --git a/tests/cache-revalidate.scm b/tests/cache-revalidate.scm
new file mode 100644
index 0000000..29cc038
--- /dev/null
+++ b/tests/cache-revalidate.scm
@@ -0,0 +1,42 @@
+(use-modules (webid-oidc cache)
+             (webid-oidc testing)
+             (web uri)
+             (web request)
+             (web response)
+             (srfi srfi-19)
+             (ice-9 optargs)
+             (ice-9 receive))
+
+(with-test-environment
+ "cache-revalidate"
+ (lambda ()
+   (define original-response
+     (build-response #:headers `((etag . ("xxx" . #t))
+                                 (content-type text/plain)
+                                 (date . ,(time-utc->date (make-time time-utc 0 0))))))
+   (define* (backend uri #:key (headers '()))
+     (unless (equal? uri (string->uri "https://example.com"))
+       (exit 1))
+     (unless (equal? (assq-ref headers 'if-none-match)
+                     '(("xxx" . #t)))
+       (exit 2))
+     (unless (equal? (assq-ref headers 'user-agent) "Testbed")
+       (exit 3))
+     (unless (eqv? (length headers) 2)
+       (exit 4))
+     (values
+      (build-response #:code 304 #:reason-phrase "Not Modified"
+                      #:headers `((date . ,(time-utc->date (make-time time-utc 0 10)))))
+      #f))
+   (receive (response response-body)
+       (revalidate (string->uri "https://example.com") original-response "hello"
+                   #:headers `((if-none-match . ("yyy" . #t))
+                               (if-unmodified-since . ,(time-utc->date (make-time time-utc 0 42)))
+                               (user-agent . "Testbed"))
+                   #:http-get backend)
+     (unless (eqv? (response-code response) 200)
+       (exit 5))
+     (unless (equal? (response-headers response)
+                     `((date . ,(time-utc->date (make-time time-utc 0 10)))
+                       (content-type text/plain)))
+       (exit 6)))))
diff --git a/tests/cache-valid.scm b/tests/cache-valid.scm
new file mode 100644
index 0000000..eda831e
--- /dev/null
+++ b/tests/cache-valid.scm
@@ -0,0 +1,58 @@
+(use-modules (webid-oidc cache)
+             (webid-oidc testing)
+             (web uri)
+             (web request)
+             (web response)
+             (srfi srfi-19)
+             (ice-9 optargs)
+             (ice-9 receive))
+
+(with-test-environment
+ "cache-valid"
+ (lambda ()
+   (define response-not-stored
+     (build-response #:headers `((cache-control . (no-store)))))
+   (define response-not-cached
+     (build-response #:headers `((cache-control . (no-cache)))))
+   (define response-with-expires
+     (build-response #:headers `((expires . ,(time-utc->date (make-time time-utc 0 120))))))
+   (define response-with-overriden-expires
+     (build-response #:headers `((expires . ,(time-utc->date (make-time time-utc 0 120)))
+                                 (cache-control . (private (max-age . 100)))
+                                 (date . ,(time-utc->date (make-time time-utc 0 10))))))
+   (define response-without-max-age
+     (build-response #:headers `((cache-control . (private))
+                                 (date . ,(time-utc->date (make-time time-utc 0 10))))))
+   (define response-with-heuristic-max-age
+     (build-response #:headers `((cache-control . (private))
+                                 (last-modified . ,(time-utc->date (make-time time-utc 0 10)))
+                                 (date . ,(time-utc->date (make-time time-utc 0 30))))))
+   ;; response-not-stored: never valid.
+   (when (valid? response-not-stored #:current-time 0)
+     (exit 1))
+   (when (valid? response-not-stored #:current-time 100)
+     (exit 2))
+   ;; response-not-cached: never valid.
+   (when (valid? response-not-cached #:current-time 0)
+     (exit 3))
+   (when (valid? response-not-cached #:current-time 100)
+     (exit 4))
+   ;; response-with-expires: valid at 110, invalid at 130.
+   (unless (valid? response-with-expires #:current-time 110)
+     (exit 5))
+   (when (valid? response-with-expires #:current-time 130)
+     (exit 6))
+   ;; response-with-overriden-expires: valid at 105, invalid at 115
+   (unless (valid? response-with-overriden-expires #:current-time 105)
+     (exit 7))
+   (when (valid? response-with-overriden-expires #:current-time 115)
+     (exit 8))
+   ;; response-without-max-age: not valid, cannot get a heuristic
+   (when (valid? response-without-max-age #:current-time 10)
+     (exit 9))
+   ;; response-with-heuristic-max-age: the heuristic max age is 2, so
+   ;; it is valid at 31 but not at 33.
+   (unless (valid? response-with-heuristic-max-age #:current-time 31)
+     (exit 10))
+   (when (valid? response-with-heuristic-max-age #:current-time 33)
+     (exit 11))))
-- 
cgit v1.2.3