From 62f82cd792753aa5b6cd9dce9a0e723e60bbd9fd Mon Sep 17 00:00:00 2001
From: Wojtek Kosior <koszko@koszko.org>
Date: Thu, 25 Jan 2024 18:19:51 +0100
Subject: Add tests for `find-resource-file` and exceptions it raises.

---
 tests/guile/cantius-test.scm | 57 ++++++++++++++++++++++++++++++++++++++++++--
 1 file changed, 55 insertions(+), 2 deletions(-)

diff --git a/tests/guile/cantius-test.scm b/tests/guile/cantius-test.scm
index 04176f9..0e4b2ca 100644
--- a/tests/guile/cantius-test.scm
+++ b/tests/guile/cantius-test.scm
@@ -1,8 +1,9 @@
 ;;; SPDX-License-Identifier: CC0-1.0
 ;;;
-;;; Copyright (C) 2023 Wojtek Kosior <koszko@koszko.org>
+;;; Copyright (C) 2023, 2024 Wojtek Kosior <koszko@koszko.org>
 
-(use-modules ((srfi srfi-8) #:select (receive))
+(use-modules ((scheme base) #:select (bytevector-copy string->utf8))
+             ((srfi srfi-8) #:select (receive))
              ((srfi srfi-26) #:select (cut))
              ((srfi srfi-34) #:select (guard raise))
              ((ice-9 safe-r5rs) #:select (null-environment))
@@ -38,6 +39,7 @@
                                 (make-thread thread-terminate! thread-yield!
                                  thread-start!))
                   #:use-module ((ice-9 format) #:select (format))
+                  #:use-module ((ice-9 textual-ports) #:select (get-string-all))
                   #:use-module (cantius))
 
                 (define sock-port
@@ -73,6 +75,17 @@
                   (values (build-response*)
                           "Google provides the best services in the world..."))
 
+                (define-endpoint %my-endset static-files
+                  ("static" . file-path)
+                  `((,%resource-root-path
+                     . ,(dirname (search-path %load-path "cantius" ".scm")))
+                    (,%default-headers
+                     . ((content-type
+                         . (text/formatted (charset . "Windows-1252"))))))
+                  (call-with-input-file
+                      (find-resource-file (string-join file-path "/"))
+                    get-string-all))
+
                 (define server-sock
                   (socket PF_INET SOCK_STREAM 0))
 
@@ -164,6 +177,46 @@
 
     (tu:test-assert (string-prefix? "Google provides" (cadr google-result))))
 
+  (tu:test-group "valid-static-resources"
+    (define valid-resource-result
+      (get "/static/cantius.scm"))
+
+    (tu:test-eqv 200 (rsp:response-code (car valid-resource-result)))
+
+    (tu:test-equal '(text/formatted (charset . "Windows-1252"))
+                   (rsp:response-content-type (car valid-resource-result)))
+
+    (tu:test-assert (string-prefix? ";;; " (cadr valid-resource-result))))
+
+  (tu:test-group "illegal-static-resources"
+    (for-each (lambda (resource-path)
+                (define illegal-resource-result
+                  (get resource-path))
+
+                (tu:test-eqv 403
+                             (rsp:response-code (car illegal-resource-result)))
+
+                ;; Default handler for illegal resource accesses is expected to
+                ;; ignore the value of the `%default-headers` parameter.
+                (tu:test-equal '(text/plain (charset . "utf-8"))
+                               (rsp:response-content-type
+                                (car illegal-resource-result))))
+
+              '("/static/../../../../../etc/passwd"
+                "/static/stylesheets/."
+                "/static/nonfree/../scripts/main.js")))
+
+  (tu:test-group "missing-static-resources"
+    (define missing-resource-result
+      (get "/static/i'm-not-here!!!"))
+
+    (tu:test-eqv 404 (rsp:response-code (car missing-resource-result)))
+
+    ;; Default handler for missing resource accesses is expected to ignore the
+    ;; value of the `%default-headers` parameter.
+    (tu:test-equal '(text/plain (charset . "utf-8"))
+                   (rsp:response-content-type (car missing-resource-result))))
+
   (tu:test-assert (eval '(begin (thread-terminate! server-thread)
                                 (close server-sock))
                         (test-env 'nonfree-site))))
-- 
cgit v1.2.3