rose-ash/lib/dream/tests/html.sx

;; lib/dream/tests/html.sx — HTML escaping (+ demo XSS regression).

(define dream-ht-pass 0)
(define dream-ht-fail 0)
(define dream-ht-fails (list))

(define
  dream-ht-test
  (fn
    (name actual expected)
    (if
      (= actual expected)
      (set! dream-ht-pass (+ dream-ht-pass 1))
      (begin
        (set! dream-ht-fail (+ dream-ht-fail 1))
        (append! dream-ht-fails {:name name :actual actual :expected expected})))))

(dream-ht-test "escape ampersand" (dream-escape "a & b") "a & b")
(dream-ht-test "escape lt gt" (dream-escape "<b>") "&lt;b&gt;")
(dream-ht-test "escape quote" (dream-escape "say \"hi\"") "say &quot;hi&quot;")
(dream-ht-test "escape apostrophe" (dream-escape "it's") "it&#39;s")
(dream-ht-test
  "escape script tag"
  (dream-escape "<script>alert(1)</script>")
  "&lt;script&gt;alert(1)&lt;/script&gt;")
(dream-ht-test
  "ampersand first (no double-escape)"
  (dream-escape "&lt;")
  "&amp;lt;")
(dream-ht-test
  "safe string unchanged"
  (dream-escape "hello world")
  "hello world")
(dream-ht-test
  "attr escapes value"
  (dream-attr "title" "a\"b")
  "title=\"a&quot;b\"")
(dream-ht-test
  "escape-join"
  (dream-escape-join " " (list "<a>" "<b>"))
  "&lt;a&gt; &lt;b&gt;")

;; ── todo demo escapes user input (XSS regression) ──────────────────
(define dream-ht-store (dream-todo-store))
((get dream-ht-store :add) "<script>alert(1)</script>")
(define
  dream-ht-ctx
  (assoc (dream-request "GET" "/" {} "") :dream-csrf {:sign dream-csrf-sign-default :sid "s1" :secret "k"}))
(define dream-ht-rendered (dr/todo-render dream-ht-store dream-ht-ctx))
(dream-ht-test
  "todo escapes script"
  (contains? dream-ht-rendered "&lt;script&gt;")
  true)
(dream-ht-test
  "todo has no raw script"
  (contains? dream-ht-rendered "<script>")
  false)

(define dream-ht-tests-run! (fn () {:total (+ dream-ht-pass dream-ht-fail) :passed dream-ht-pass :failed dream-ht-fail :fails dream-ht-fails}))