;; Safsaf, a Guile web framework ;; Copyright (C) 2026 Christopher Baines ;; 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 ;; . (use-modules (tests support) (safsaf params) (safsaf handler-wrappers csrf)) (define-suite params-tests (suite "processors" (test "as-string passes through" (is (equal? "hello" (as-string "hello")))) (test "as-integer parses integers" (is (equal? 42 (as-integer "42"))) (is (equal? -3 (as-integer "-3"))) (is (equal? 0 (as-integer "0")))) (test "as-integer rejects non-integers" (is (invalid-param? (as-integer "3.14"))) (is (invalid-param? (as-integer "abc"))) (is (invalid-param? (as-integer "")))) (test "as-number parses numbers" (is (equal? 42 (as-number "42"))) (is (equal? 3.14 (as-number "3.14"))) (is (equal? -1 (as-number "-1")))) (test "as-number rejects non-numbers" (is (invalid-param? (as-number "abc"))) (is (invalid-param? (as-number "")))) (test "as-checkbox" (is (eq? #t (as-checkbox "on"))) (is (eq? #f (as-checkbox "off"))) (is (eq? #f (as-checkbox "")))) (test "as-one-of accepts valid choices" (define proc (as-one-of '("red" "green" "blue"))) (is (equal? "red" (proc "red"))) (is (equal? "blue" (proc "blue")))) (test "as-one-of rejects invalid choices" (define proc (as-one-of '("red" "green" "blue"))) (is (invalid-param? (proc "yellow")))) (test "as-one-of custom message" (define proc (as-one-of '("a") #:message "nope")) (is (equal? "nope" (invalid-param-message (proc "z"))))) (test "as-matching accepts matching values" (define proc (as-matching "^[0-9]+$")) (is (equal? "123" (proc "123")))) (test "as-matching rejects non-matching values" (define proc (as-matching "^[0-9]+$")) (is (invalid-param? (proc "abc")))) (test "as-predicate" (define proc (as-predicate (lambda (s) (> (string-length s) 3)))) (is (equal? "hello" (proc "hello"))) (is (invalid-param? (proc "hi"))))) (suite "parse-params" (test "basic optional param" (define result (parse-params `((name ,as-string)) '(("name" . "Alice")))) (is (equal? "Alice" (assq-ref result 'name)))) (test "missing optional param omitted" (define result (parse-params `((name ,as-string)) '())) (is (not (assq-ref result 'name)))) (test "empty string treated as absent for optional" (define result (parse-params `((name ,as-string)) '(("name" . "")))) (is (not (assq-ref result 'name)))) (test "required param present" (define result (parse-params `((name ,as-string #:required)) '(("name" . "Bob")))) (is (equal? "Bob" (assq-ref result 'name)))) (test "required param missing" (define result (parse-params `((name ,as-string #:required)) '())) (is (invalid-param? (assq-ref result 'name)))) (test "required param empty" (define result (parse-params `((name ,as-string #:required)) '(("name" . "")))) (is (invalid-param? (assq-ref result 'name)))) (test "default used when absent" (define result (parse-params `((limit ,as-integer #:default 50)) '())) (is (equal? 50 (assq-ref result 'limit)))) (test "default not used when present" (define result (parse-params `((limit ,as-integer #:default 50)) '(("limit" . "10")))) (is (equal? 10 (assq-ref result 'limit)))) (test "default used when empty string" (define result (parse-params `((limit ,as-integer #:default 50)) '(("limit" . "")))) (is (equal? 50 (assq-ref result 'limit)))) (test "multi-value collects all" (define result (parse-params `((color ,as-string #:multi-value)) '(("color" . "red") ("color" . "blue")))) (is (equal? '("red" "blue") (assq-ref result 'color)))) (test "multi-value empty omitted" (define result (parse-params `((color ,as-string #:multi-value)) '())) (is (not (assq-ref result 'color)))) (test "multi-value skips empty strings" (define result (parse-params `((color ,as-string #:multi-value)) '(("color" . "red") ("color" . "") ("color" . "blue")))) (is (equal? '("red" "blue") (assq-ref result 'color)))) (test "multi-value with default" (define result (parse-params `((color ,as-string #:multi-value #:default ("red"))) '())) (is (equal? '("red") (assq-ref result 'color)))) (test "no-default-when suppresses default" (define result (parse-params `((limit ,as-integer #:no-default-when (all_results) #:default 50) (all_results ,as-checkbox)) '(("all_results" . "on")))) (is (not (assq-ref result 'limit))) (is (eq? #t (assq-ref result 'all_results)))) (test "no-default-when uses default when condition absent" (define result (parse-params `((limit ,as-integer #:no-default-when (all_results) #:default 50)) '())) (is (equal? 50 (assq-ref result 'limit)))) (test "processor transforms value" (define result (parse-params `((count ,as-integer)) '(("count" . "42")))) (is (equal? 42 (assq-ref result 'count)))) (test "processor error appears inline" (define result (parse-params `((count ,as-integer)) '(("count" . "abc")))) (is (invalid-param? (assq-ref result 'count)))) (test "multiple params parsed together" (define result (parse-params `((name ,as-string #:required) (age ,as-integer #:default 0) (active ,as-checkbox)) '(("name" . "Alice") ("active" . "on")))) (is (equal? "Alice" (assq-ref result 'name))) (is (equal? 0 (assq-ref result 'age))) (is (eq? #t (assq-ref result 'active))))) (suite "any-invalid-params?" (test "no errors" (is (not (any-invalid-params? '((name . "Alice") (age . 30)))))) (test "with error" (is (any-invalid-params? `((name . ,(make-invalid-param #f "required")))))) (test "error in multi-value list" (is (any-invalid-params? `((colors . ("red" ,(make-invalid-param "x" "bad")))))))) (suite "invalid-param-ref" (test "returns record when invalid" (define params `((name . ,(make-invalid-param "" "required")))) (is (invalid-param? (invalid-param-ref params 'name)))) (test "returns #f when valid" (is (not (invalid-param-ref '((name . "Alice")) 'name)))) (test "returns #f when absent" (is (not (invalid-param-ref '() 'name))))) (suite "field-errors" (test "returns error messages" (define params `((name . ,(make-invalid-param "" "required")))) (is (equal? '("required") (field-errors params 'name)))) (test "returns empty for valid field" (is (equal? '() (field-errors '((name . "Alice")) 'name)))) (test "returns empty for absent field" (is (equal? '() (field-errors '() 'name))))) (suite "guard-against-mutually-exclusive-params" (test "no conflict" (define result (guard-against-mutually-exclusive-params '((limit . 50)) '((limit all_results)))) (is (equal? 50 (assq-ref result 'limit)))) (test "conflict marks both invalid" (define result (guard-against-mutually-exclusive-params '((limit . 50) (all_results . #t)) '((limit all_results)))) (is (invalid-param? (assq-ref result 'limit))) (is (invalid-param? (assq-ref result 'all_results)))) (test "preserves existing errors" (define result (guard-against-mutually-exclusive-params `((name . ,(make-invalid-param #f "bad"))) '((name other)))) (is (invalid-param? (assq-ref result 'name))))) (suite "params->query-string" (test "simple params" (is (equal? "name=Alice&age=30" (params->query-string '((name . "Alice") (age . 30)))))) (test "boolean params" (is (equal? "active=on" (params->query-string '((active . #t)))))) (test "multi-value params" (is (equal? "color=red&color=blue" (params->query-string '((color . ("red" "blue"))))))) (test "skips invalid params" (is (equal? "name=Alice" (params->query-string `((name . "Alice") (bad . ,(make-invalid-param "x" "err"))))))) (test "empty result" (is (equal? "" (params->query-string '()))))) (suite "parse-form-params" (test "csrf pass" (parameterize ((current-csrf-token "tok123")) (define result (parse-form-params `((name ,as-string #:required)) '(("csrf-token" . "tok123") ("name" . "Alice")))) (is (not (any-invalid-params? result))) (is (equal? "Alice" (assq-ref result 'name))))) (test "csrf fail" (parameterize ((current-csrf-token "tok123")) (define result (parse-form-params `((name ,as-string)) '(("csrf-token" . "wrong")))) (is (any-invalid-params? result)))) (test "csrf missing" (parameterize ((current-csrf-token "tok123")) (define result (parse-form-params `() '())) (is (any-invalid-params? result)))))) (run-tests params-tests)