86 lines
3.2 KiB
Scheme
86 lines
3.2 KiB
Scheme
|
;; Safsaf, a Guile web framework
|
||
|
|
;; Copyright (C) 2026 Christopher Baines <mail@cbaines.net>
|
||
|
|
|
||
|
|
;; This program is free software: you can redistribute it and/or
|
||
|
|
;; modify it under the terms of the GNU Lesser General Public License
|
||
|
|
;; as published by the Free Software Foundation, either version 3 of
|
||
|
|
;; the License, or (at your option) any later version.
|
||
|
|
;;
|
||
|
|
;; This program is distributed in the hope that it will be useful, but
|
||
|
|
;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||
|
|
;; Lesser General Public License for more details.
|
||
|
|
;;
|
||
|
|
;; You should have received a copy of the GNU Lesser General Public
|
||
|
|
;; License along with this program. If not, see
|
||
|
|
;; <https://www.gnu.org/licenses/>.
|
||
|
|
|
||
|
|
;;; test-utils.scm — Tests for (safsaf utils)
|
||
|
|
|
||
|
|
(use-modules (tests support)
|
||
|
|
(safsaf utils)
|
||
|
|
(web request)
|
||
|
|
(web uri))
|
||
|
|
|
||
|
|
(define* (make-request method path #:key (headers '()))
|
||
|
|
(build-request (string->uri (string-append "http://localhost" path))
|
||
|
|
#:method method
|
||
|
|
#:headers headers))
|
||
|
|
|
||
|
|
(define-suite utils-tests
|
||
|
|
(suite "parse-query-string"
|
||
|
|
(test "parses key=value pairs"
|
||
|
|
(let* ((req (make-request 'GET "/?foo=bar&baz=qux"))
|
||
|
|
(qs (parse-query-string req)))
|
||
|
|
(is (equal? '(("foo" . "bar") ("baz" . "qux")) qs))))
|
||
|
|
|
||
|
|
(test "returns empty list when no query string"
|
||
|
|
(let* ((req (make-request 'GET "/"))
|
||
|
|
(qs (parse-query-string req)))
|
||
|
|
(is (null? qs))))
|
||
|
|
|
||
|
|
(test "decodes URL-encoded values"
|
||
|
|
(let* ((req (make-request 'GET "/?name=hello%20world"))
|
||
|
|
(qs (parse-query-string req)))
|
||
|
|
(is (equal? "hello world" (assoc-ref qs "name")))))
|
||
|
|
|
||
|
|
(test "handles key without value"
|
||
|
|
(let* ((req (make-request 'GET "/?flag"))
|
||
|
|
(qs (parse-query-string req)))
|
||
|
|
(is (equal? '(("flag" . "")) qs))))
|
||
|
|
|
||
|
|
(test "handles multiple values for same key"
|
||
|
|
(let* ((req (make-request 'GET "/?x=1&x=2"))
|
||
|
|
(qs (parse-query-string req)))
|
||
|
|
(is (= 2 (length qs)))
|
||
|
|
(is (equal? "1" (assoc-ref qs "x"))))))
|
||
|
|
|
||
|
|
(suite "request-cookies"
|
||
|
|
(test "parses cookie header"
|
||
|
|
(let* ((req (make-request 'GET "/"
|
||
|
|
#:headers '((cookie . (("a" . "1")
|
||
|
|
("b" . "2"))))))
|
||
|
|
(cookies (request-cookies req)))
|
||
|
|
(is (equal? '(("a" . "1") ("b" . "2")) cookies))))
|
||
|
|
|
||
|
|
(test "returns empty list when no cookie header"
|
||
|
|
(let* ((req (make-request 'GET "/"))
|
||
|
|
(cookies (request-cookies req)))
|
||
|
|
(is (null? cookies)))))
|
||
|
|
|
||
|
|
(suite "request-cookie-ref"
|
||
|
|
(test "returns cookie value by name"
|
||
|
|
(let ((req (make-request 'GET "/"
|
||
|
|
#:headers '((cookie . (("sid" . "abc123")))))))
|
||
|
|
(is (equal? "abc123" (request-cookie-ref req "sid")))))
|
||
|
|
|
||
|
|
(test "returns #f when cookie not found"
|
||
|
|
(let ((req (make-request 'GET "/")))
|
||
|
|
(is (not (request-cookie-ref req "missing")))))
|
||
|
|
|
||
|
|
(test "returns default when cookie not found"
|
||
|
|
(let ((req (make-request 'GET "/")))
|
||
|
|
(is (equal? "fallback" (request-cookie-ref req "missing" "fallback")))))))
|
||
|
|
|
||
|
|
(run-tests utils-tests)
|