Files
simplexmq/tests/WebTests.hs
sh eed1bf14c6 web: extract shared web module from smp-server (#1723)
* web: extract shared web module from smp-server

Move web serving infrastructure (warp, static files, HTML templating)
from apps/smp-server/web/Static.hs into library modules:
- Simplex.Messaging.Server.Web (generic web infra + templating)
- Simplex.Messaging.Server.Web.Embedded (TH-embedded assets)

Move static assets from apps/smp-server/static/ to
src/Simplex/Messaging/Server/Web/.

Move EmbeddedWebParams/WebHttpsParams from Server.Main to Server.Web.

Keep SMP-specific rendering (serverInformation) in apps/smp-server/SMP/Web.hs.

generateSite is now generic: takes pre-rendered HTML + link page paths,
enabling reuse by XFTP and NTF servers.

* web: add tests for templating engine

Tests for render, section_, item_, and timedTTLText functions
in Simplex.Messaging.Server.Web module.

* web: add serverInfoSubsts, serveStaticPageH2, safe port parsing

* web: rename SMP.Web to SMPWeb, remove SMP subdirectory

* fix(web): section_ collapsing sections with Just "" content

Commit e48bedea ("servers: fix server pages when source code is not
specified") changed section_ to treat Just "" the same as Nothing -
collapsing the section. The intent was to handle the sourceCode case
(empty string when not specified), but the guard
`not (B.null content)` also broke operator, admin, complaints, and
hosting - all of which legitimately use Just "" as a
section-present marker.

Before (correct):
  Nothing -> before <> next
  Just content -> before <> item_ label content inside <> ...

After (broken):
  Just content | not (B.null content) -> ...
  _ -> before <> next

Restore the original behavior: only Nothing collapses a section.

* refactor

---------

Co-authored-by: Evgeny Poberezkin <evgeny@poberezkin.com>
2026-03-09 08:42:38 +00:00

71 lines
3.0 KiB
Haskell

{-# LANGUAGE OverloadedStrings #-}
module WebTests where
import Simplex.Messaging.Server.Web (render, section_, item_, timedTTLText)
import Test.Hspec
webTests :: Spec
webTests = describe "Web module" $ do
describe "item_" $ do
it "replaces single placeholder" $
item_ "name" "Alice" "Hello, ${name}!" `shouldBe` "Hello, Alice!"
it "replaces multiple occurrences" $
item_ "x" "1" "${x}+${x}" `shouldBe` "1+1"
it "returns source unchanged when no placeholder found" $
item_ "missing" "val" "no placeholder here" `shouldBe` "no placeholder here"
it "handles empty content" $
item_ "x" "" "a${x}b" `shouldBe` "ab"
it "handles empty source" $
item_ "x" "val" "" `shouldBe` ""
describe "section_" $ do
it "keeps section and replaces items when content is Just" $
section_ "s" (Just "val") "<x-s>${s}</x-s>" `shouldBe` "val"
it "removes section when content is Nothing" $
section_ "s" Nothing "before<x-s>inside</x-s>after" `shouldBe` "beforeafter"
it "keeps section when content is Just empty" $
section_ "s" (Just "") "before<x-s>inside</x-s>after" `shouldBe` "beforeinsideafter"
it "handles multiple sections with same label" $
section_ "s" (Just "X") "<x-s>${s}</x-s>mid<x-s>${s}</x-s>"
`shouldBe` "XmidX"
it "falls back to item replacement when no section markers" $
section_ "s" (Just "val") "just ${s} here" `shouldBe` "just val here"
it "preserves surrounding content" $
section_ "s" (Just "Y") "aaa<x-s>${s}</x-s>bbb" `shouldBe` "aaaYbbb"
it "removes Nothing section preserving surroundings" $
section_ "s" Nothing "aaa<x-s>gone</x-s>bbb" `shouldBe` "aaabbb"
describe "render" $ do
it "applies multiple substitutions" $
render "Hello ${name}, you are ${age}." [("name", Just "Bob"), ("age", Just "30")]
`shouldBe` "Hello Bob, you are 30."
it "removes sections with Nothing" $
render "<x-opt>optional: ${opt}</x-opt>kept" [("opt", Nothing)]
`shouldBe` "kept"
it "handles mixed present and absent substitutions" $
render "<x-a>${a}</x-a><x-b>${b}</x-b>" [("a", Just "yes"), ("b", Nothing)]
`shouldBe` "yes"
it "returns source unchanged with empty substitutions" $
render "unchanged" [] `shouldBe` "unchanged"
describe "timedTTLText" $ do
it "formats zero" $
timedTTLText (0 :: Int) `shouldBe` "0 sec"
it "formats seconds" $
timedTTLText (45 :: Int) `shouldBe` "45 sec"
it "formats minutes and seconds" $
timedTTLText (90 :: Int) `shouldBe` "1 min 30 sec"
it "formats hours" $
timedTTLText (3600 :: Int) `shouldBe` "1 hour"
it "formats multiple hours" $
timedTTLText (7200 :: Int) `shouldBe` "2 hours"
it "formats days" $
timedTTLText (86400 :: Int) `shouldBe` "1 day"
it "formats weeks" $
timedTTLText (604800 :: Int) `shouldBe` "1 week"
it "formats months" $
timedTTLText (2592000 :: Int) `shouldBe` "1 month"
it "formats compound duration" $
timedTTLText (90061 :: Int) `shouldBe` "1 day 1 hour 1 min 1 sec"