safsaf/tests/test-params.scm

;; 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/>.

(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)