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>

apps/smp-server/Main.hs

@@ -2,8 +2,9 @@ module Main where
 
 import Control.Logger.Simple
 import Simplex.Messaging.Server.CLI (getEnvPath)
-import Simplex.Messaging.Server.Main
-import qualified Static
+import Simplex.Messaging.Server.Main (smpServerCLI_)
+import Simplex.Messaging.Server.Web (serveStaticFiles, attachStaticFiles)
+import SMPWeb (smpGenerateSite)
 
 defaultCfgPath :: FilePath
 defaultCfgPath = "/etc/opt/simplex"
@@ -18,4 +19,4 @@ main :: IO ()
 main = do
   cfgPath <- getEnvPath "SMP_SERVER_CFG_PATH" defaultCfgPath
   logPath <- getEnvPath "SMP_SERVER_LOG_PATH" defaultLogPath
-  withGlobalLogging logCfg $ smpServerCLI_ Static.generateSite Static.serveStaticFiles Static.attachStaticFiles cfgPath logPath
+  withGlobalLogging logCfg $ smpServerCLI_ smpGenerateSite serveStaticFiles attachStaticFiles cfgPath logPath

apps/smp-server/SMPWeb.hs

@@ -0,0 +1,43 @@
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module SMPWeb
+  ( smpGenerateSite,
+    serverInformation,
+  ) where
+
+import Data.ByteString (ByteString)
+import Data.String (fromString)
+import Simplex.Messaging.Encoding.String (strEncode)
+import Simplex.Messaging.Server.Information
+import Simplex.Messaging.Server.Main (simplexmqSource)
+import qualified Simplex.Messaging.Server.Web as Web
+import Simplex.Messaging.Server.Web (render, serverInfoSubsts, timedTTLText)
+import Simplex.Messaging.Server.Web.Embedded as E
+import Simplex.Messaging.Transport.Client (TransportHost (..))
+
+smpGenerateSite :: ServerInformation -> Maybe TransportHost -> FilePath -> IO ()
+smpGenerateSite si onionHost path =
+  Web.generateSite (serverInformation si onionHost) smpLinkPages path
+
+smpLinkPages :: [String]
+smpLinkPages = ["contact", "invitation", "a", "c", "g", "r", "i"]
+
+serverInformation :: ServerInformation -> Maybe TransportHost -> ByteString
+serverInformation ServerInformation {config, information} onionHost = render E.indexHtml substs
+  where
+    substs = [("smpConfig", Just "y"), ("xftpConfig", Nothing)] <> substConfig <> serverInfoSubsts simplexmqSource information <> [("onionHost", strEncode <$> onionHost), ("iniFileName", Just "smp-server.ini")]
+    substConfig =
+      [ ( "persistence",
+          Just $ case persistence config of
+            SPMMemoryOnly -> "In-memory only"
+            SPMQueues -> "Queues"
+            SPMMessages -> "Queues and messages"
+        ),
+        ("messageExpiration", Just $ maybe "Never" (fromString . timedTTLText) $ messageExpiration config),
+        ("statsEnabled", Just . yesNo $ statsEnabled config),
+        ("newQueuesAllowed", Just . yesNo $ newQueuesAllowed config),
+        ("basicAuthEnabled", Just . yesNo $ basicAuthEnabled config)
+      ]
+    yesNo True = "Yes"
+    yesNo False = "No"

apps/smp-server/static/a/index.html

@@ -1 +0,0 @@
-../link.html

apps/smp-server/static/c/index.html

@@ -1 +0,0 @@
-../link.html

apps/smp-server/static/contact/index.html

@@ -1 +0,0 @@
-../link.html

apps/smp-server/static/i/index.html

@@ -1 +0,0 @@
-../link.html

apps/smp-server/static/invitation/index.html

@@ -1 +0,0 @@
-../link.html

apps/smp-server/web/Static/Embedded.hs

@@ -1,18 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
-
-module Static.Embedded where
-
-import Data.FileEmbed (embedDir, embedFile)
-import Data.ByteString (ByteString)
-
-indexHtml :: ByteString
-indexHtml = $(embedFile "apps/smp-server/static/index.html")
-
-linkHtml :: ByteString
-linkHtml = $(embedFile "apps/smp-server/static/link.html")
-
-mediaContent :: [(FilePath, ByteString)]
-mediaContent = $(embedDir "apps/smp-server/static/media/")
-
-wellKnown :: [(FilePath, ByteString)]
-wellKnown = $(embedDir "apps/smp-server/static/.well-known/")

simplexmq.cabal

@@ -24,33 +24,33 @@ extra-source-files:
     CHANGELOG.md
     cbits/sha512.h
     cbits/sntrup761.h
-    apps/smp-server/static/index.html
-    apps/smp-server/static/link.html
-    apps/smp-server/static/media/apk_icon.png
-    apps/smp-server/static/media/apple_store.svg
-    apps/smp-server/static/media/contact.js
-    apps/smp-server/static/media/contact_page_mobile.png
-    apps/smp-server/static/media/f_droid.svg
-    apps/smp-server/static/media/favicon.ico
-    apps/smp-server/static/media/GilroyBold.woff2
-    apps/smp-server/static/media/GilroyLight.woff2
-    apps/smp-server/static/media/GilroyMedium.woff2
-    apps/smp-server/static/media/GilroyRegular.woff2
-    apps/smp-server/static/media/GilroyRegularItalic.woff2
-    apps/smp-server/static/media/google_play.svg
-    apps/smp-server/static/media/logo-dark.png
-    apps/smp-server/static/media/logo-light.png
-    apps/smp-server/static/media/logo-symbol-dark.svg
-    apps/smp-server/static/media/logo-symbol-light.svg
-    apps/smp-server/static/media/moon.svg
-    apps/smp-server/static/media/qrcode.js
-    apps/smp-server/static/media/script.js
-    apps/smp-server/static/media/style.css
-    apps/smp-server/static/media/sun.svg
-    apps/smp-server/static/media/swiper-bundle.min.css
-    apps/smp-server/static/media/swiper-bundle.min.js
-    apps/smp-server/static/media/tailwind.css
-    apps/smp-server/static/media/testflight.png
+    src/Simplex/Messaging/Server/Web/index.html
+    src/Simplex/Messaging/Server/Web/link.html
+    src/Simplex/Messaging/Server/Web/media/apk_icon.png
+    src/Simplex/Messaging/Server/Web/media/apple_store.svg
+    src/Simplex/Messaging/Server/Web/media/contact.js
+    src/Simplex/Messaging/Server/Web/media/contact_page_mobile.png
+    src/Simplex/Messaging/Server/Web/media/f_droid.svg
+    src/Simplex/Messaging/Server/Web/media/favicon.ico
+    src/Simplex/Messaging/Server/Web/media/GilroyBold.woff2
+    src/Simplex/Messaging/Server/Web/media/GilroyLight.woff2
+    src/Simplex/Messaging/Server/Web/media/GilroyMedium.woff2
+    src/Simplex/Messaging/Server/Web/media/GilroyRegular.woff2
+    src/Simplex/Messaging/Server/Web/media/GilroyRegularItalic.woff2
+    src/Simplex/Messaging/Server/Web/media/google_play.svg
+    src/Simplex/Messaging/Server/Web/media/logo-dark.png
+    src/Simplex/Messaging/Server/Web/media/logo-light.png
+    src/Simplex/Messaging/Server/Web/media/logo-symbol-dark.svg
+    src/Simplex/Messaging/Server/Web/media/logo-symbol-light.svg
+    src/Simplex/Messaging/Server/Web/media/moon.svg
+    src/Simplex/Messaging/Server/Web/media/qrcode.js
+    src/Simplex/Messaging/Server/Web/media/script.js
+    src/Simplex/Messaging/Server/Web/media/style.css
+    src/Simplex/Messaging/Server/Web/media/sun.svg
+    src/Simplex/Messaging/Server/Web/media/swiper-bundle.min.css
+    src/Simplex/Messaging/Server/Web/media/swiper-bundle.min.js
+    src/Simplex/Messaging/Server/Web/media/tailwind.css
+    src/Simplex/Messaging/Server/Web/media/testflight.png
 
 flag swift
   description: Enable swift JSON format
@@ -245,6 +245,8 @@ library
           Simplex.Messaging.Server.Main
           Simplex.Messaging.Server.Main.GitCommit
           Simplex.Messaging.Server.Main.Init
+          Simplex.Messaging.Server.Web
+          Simplex.Messaging.Server.Web.Embedded
           Simplex.Messaging.Server.MsgStore
           Simplex.Messaging.Server.MsgStore.Journal
           Simplex.Messaging.Server.MsgStore.Journal.SharedLock
@@ -341,11 +343,16 @@ library
   if !flag(client_library)
     build-depends:
         case-insensitive ==1.2.*
+      , file-embed >=0.0.10 && <0.1
       , hashable ==1.4.*
       , ini ==0.4.1
       , optparse-applicative >=0.15 && <0.17
       , process ==1.6.*
       , temporary ==1.3.*
+      , wai >=3.2 && <3.3
+      , wai-app-static >=3.1 && <3.2
+      , warp ==3.3.30
+      , warp-tls ==3.4.7
       , websockets ==0.12.*
       , zlib >=0.6 && <0.8
   if flag(client_postgres) || flag(server_postgres)
@@ -402,30 +409,19 @@ executable smp-server
     cpp-options: -DdbServerPostgres
   main-is: Main.hs
   other-modules:
-      Static
-      Static.Embedded
+      SMPWeb
       Paths_simplexmq
   hs-source-dirs:
       apps/smp-server
-      apps/smp-server/web
   default-extensions:
       StrictData
   ghc-options: -Weverything -Wno-missing-exported-signatures -Wno-missing-import-lists -Wno-missed-specialisations -Wno-all-missed-specialisations -Wno-unsafe -Wno-safe -Wno-missing-local-signatures -Wno-missing-kind-signatures -Wno-missing-deriving-strategies -Wno-monomorphism-restriction -Wno-prepositive-qualified-module -Wno-implicit-prelude -Wno-missing-safe-haskell-mode -Wno-missing-export-lists -Wno-partial-fields -Wcompat -Werror=incomplete-record-updates -Werror=incomplete-patterns -Werror=incomplete-uni-patterns -Werror=missing-methods -Werror=tabs -Wredundant-constraints -Wincomplete-record-updates -Wunused-type-patterns -O2 -threaded -rtsopts
   build-depends:
       base
     , bytestring
-    , directory
-    , file-embed
-    , filepath
-    , network
     , simple-logger
     , simplexmq
     , text
-    , unliftio
-    , wai
-    , wai-app-static
-    , warp ==3.3.30
-    , warp-tls ==3.4.7
   default-language: Haskell2010
 
 executable xftp
@@ -498,9 +494,9 @@ test-suite simplexmq-test
       XFTPCLI
       XFTPClient
       XFTPServerTests
+      WebTests
       XFTPWebTests
-      Static
-      Static.Embedded
+      SMPWeb
       Paths_simplexmq
   if flag(client_postgres)
       other-modules:
@@ -517,7 +513,7 @@ test-suite simplexmq-test
           PostgresSchemaDump
   hs-source-dirs:
       tests
-      apps/smp-server/web
+      apps/smp-server
   default-extensions:
       StrictData
   -- add -fhpc to ghc-options to run tests with coverage
@@ -535,7 +531,6 @@ test-suite simplexmq-test
     , crypton-x509-store
     , crypton-x509-validation
     , directory
-    , file-embed
     , filepath
     , generic-random ==1.5.*
     , hashable
@@ -564,10 +559,6 @@ test-suite simplexmq-test
     , unliftio
     , unliftio-core
     , unordered-containers
-    , wai
-    , wai-app-static
-    , warp
-    , warp-tls
     , yaml
   default-language: Haskell2010
   if flag(server_postgres)

src/Simplex/Messaging/Server/Main.hs

@@ -75,6 +75,7 @@ import Simplex.Messaging.Server.Env.STM
 import Simplex.Messaging.Server.Expiration
 import Simplex.Messaging.Server.Information
 import Simplex.Messaging.Server.Main.Init
+import Simplex.Messaging.Server.Web (EmbeddedWebParams (..), WebHttpsParams (..))
 import Simplex.Messaging.Server.MsgStore.Journal (JournalMsgStore (..), QStoreCfg (..), stmQueueStore)
 import Simplex.Messaging.Server.MsgStore.Types (MsgStoreClass (..), SQSType (..), SMSType (..), newMsgStore)
 import Simplex.Messaging.Server.QueueStore.Postgres.Config
@@ -569,7 +570,7 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
               logStatsStartTime = 0, -- seconds from 00:00 UTC
               serverStatsLogFile = combine logPath "smp-server-stats.daily.log",
               serverStatsBackupFile = logStats $> combine logPath "smp-server-stats.log",
-              prometheusInterval = eitherToMaybe $ read . T.unpack <$> lookupValue "STORE_LOG" "prometheus_interval" ini,
+              prometheusInterval = eitherToMaybe (lookupValue "STORE_LOG" "prometheus_interval" ini) >>= readMaybe . T.unpack,
               prometheusMetricsFile = combine logPath "smp-server-metrics.txt",
               pendingENDInterval = 15000000, -- 15 seconds
               ntfDeliveryInterval = 1500000, -- 1.5 second
@@ -610,18 +611,17 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
           let onionHost =
                 either (const Nothing) (find isOnion) $
                   strDecode @(L.NonEmpty TransportHost) . encodeUtf8 =<< lookupValue "TRANSPORT" "host" ini
-              webHttpPort = eitherToMaybe $ read . T.unpack <$> lookupValue "WEB" "http" ini
+              webHttpPort = eitherToMaybe (lookupValue "WEB" "http" ini) >>= readMaybe . T.unpack
           generateSite si onionHost webStaticPath
           when (isJust webHttpPort || isJust webHttpsParams) $
             serveStaticFiles EmbeddedWebParams {webStaticPath, webHttpPort, webHttpsParams}
           where
             isOnion = \case THOnionHost _ -> True; _ -> False
-        webHttpsParams' =
-          eitherToMaybe $ do
-            port <- read . T.unpack <$> lookupValue "WEB" "https" ini
-            cert <- T.unpack <$> lookupValue "WEB" "cert" ini
-            key <- T.unpack <$> lookupValue "WEB" "key" ini
-            pure WebHttpsParams {port, cert, key}
+        webHttpsParams' = do
+          port <- eitherToMaybe (lookupValue "WEB" "https" ini) >>= readMaybe . T.unpack
+          cert <- eitherToMaybe $ T.unpack <$> lookupValue "WEB" "cert" ini
+          key <- eitherToMaybe $ T.unpack <$> lookupValue "WEB" "key" ini
+          pure WebHttpsParams {port, cert, key}
         webStaticPath' = eitherToMaybe $ T.unpack <$> lookupValue "WEB" "static_path" ini
 
     checkMsgStoreMode :: Ini -> AStoreType -> IO ()
@@ -745,18 +745,6 @@ newJournalMsgStore logPath qsCfg =
 storeMsgsJournalDir' :: FilePath -> FilePath
 storeMsgsJournalDir' logPath = combine logPath "messages"
 
-data EmbeddedWebParams = EmbeddedWebParams
-  { webStaticPath :: FilePath,
-    webHttpPort :: Maybe Int,
-    webHttpsParams :: Maybe WebHttpsParams
-  }
-
-data WebHttpsParams = WebHttpsParams
-  { port :: Int,
-    cert :: FilePath,
-    key :: FilePath
-  }
-
 getServerSourceCode :: IO (Maybe String)
 getServerSourceCode =
   getLine >>= \case

src/Simplex/Messaging/Server/Web.hs

@@ -1,19 +1,35 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE StrictData #-}
 
-module Static where
+module Simplex.Messaging.Server.Web
+  ( EmbeddedWebParams (..),
+    WebHttpsParams (..),
+    serveStaticFiles,
+    attachStaticFiles,
+    serveStaticPageH2,
+    generateSite,
+    serverInfoSubsts,
+    render,
+    section_,
+    item_,
+    timedTTLText,
+  ) where
 
 import Control.Logger.Simple
 import Control.Monad
 import Data.ByteString (ByteString)
+import Data.ByteString.Builder (byteString)
 import qualified Data.ByteString.Char8 as B
 import Data.Char (toUpper)
 import Data.IORef (readIORef)
+import Data.List (isPrefixOf, isSuffixOf)
 import Data.Maybe (fromMaybe)
-import Data.String (fromString)
 import qualified Data.Text as T
 import Data.Text.Encoding (encodeUtf8)
+import qualified Network.HTTP.Types as N
+import qualified Network.HTTP2.Server as H
 import Network.Socket (getPeerName)
 import Network.Wai (Application, Request (..))
 import Network.Wai.Application.Static (StaticSettings (..))
@@ -25,17 +41,27 @@ import Simplex.Messaging.Encoding.String (strEncode)
 import Simplex.Messaging.Server (AttachHTTP)
 import Simplex.Messaging.Server.CLI (simplexmqCommit)
 import Simplex.Messaging.Server.Information
-import Simplex.Messaging.Server.Main (EmbeddedWebParams (..), WebHttpsParams (..), simplexmqSource)
+import Simplex.Messaging.Server.Web.Embedded as E
 import Simplex.Messaging.Transport (simplexMQVersion)
-import Simplex.Messaging.Transport.Client (TransportHost (..))
-import Simplex.Messaging.Util (tshow)
-import Static.Embedded as E
-import System.Directory (createDirectoryIfMissing)
+import Simplex.Messaging.Util (ifM, tshow)
+import System.Directory (canonicalizePath, createDirectoryIfMissing, doesFileExist)
 import System.FilePath
 import UnliftIO.Concurrent (forkFinally)
 import UnliftIO.Exception (bracket, finally)
 import qualified WaiAppStatic.Types as WAT
 
+data EmbeddedWebParams = EmbeddedWebParams
+  { webStaticPath :: FilePath,
+    webHttpPort :: Maybe Int,
+    webHttpsParams :: Maybe WebHttpsParams
+  }
+
+data WebHttpsParams = WebHttpsParams
+  { port :: Int,
+    cert :: FilePath,
+    key :: FilePath
+  }
+
 serveStaticFiles :: EmbeddedWebParams -> IO ()
 serveStaticFiles EmbeddedWebParams {webStaticPath, webHttpPort, webHttpsParams} = do
   forM_ webHttpPort $ \port -> flip forkFinally (\e -> logError $ "HTTP server crashed: " <> tshow e) $ do
@@ -92,21 +118,15 @@ staticFiles root = S.staticApp settings . changeWellKnownPath
       _ -> req
     pfxLen = B.length "/.well-known/"
 
-generateSite :: ServerInformation -> Maybe TransportHost -> FilePath -> IO ()
-generateSite si onionHost sitePath = do
+generateSite :: ByteString -> [String] -> FilePath -> IO ()
+generateSite indexContent linkPages sitePath = do
   createDirectoryIfMissing True sitePath
-  B.writeFile (sitePath </> "index.html") $ serverInformation si onionHost
+  B.writeFile (sitePath </> "index.html") indexContent
   copyDir "media" E.mediaContent
   -- `.well-known` path is re-written in changeWellKnownPath,
   -- staticApp does not allow hidden folders.
   copyDir "well-known" E.wellKnown
-  createLinkPage "contact"
-  createLinkPage "invitation"
-  createLinkPage "a"
-  createLinkPage "c"
-  createLinkPage "g"
-  createLinkPage "r"
-  createLinkPage "i"
+  forM_ linkPages createLinkPage
   logInfo $ "Generated static site contents at " <> tshow sitePath
   where
     copyDir dir content = do
@@ -116,78 +136,104 @@ generateSite si onionHost sitePath = do
       createDirectoryIfMissing True $ sitePath </> path
       B.writeFile (sitePath </> path </> "index.html") E.linkHtml
 
-serverInformation :: ServerInformation -> Maybe TransportHost -> ByteString
-serverInformation ServerInformation {config, information} onionHost = render E.indexHtml substs
+-- | Serve static files via HTTP/2 directly (without WAI).
+-- Path traversal protection: resolved path must stay under canonicalRoot.
+-- canonicalRoot must be pre-computed via 'canonicalizePath'.
+serveStaticPageH2 :: FilePath -> H.Request -> (H.Response -> IO ()) -> IO Bool
+serveStaticPageH2 canonicalRoot req sendResponse = do
+  let rawPath = fromMaybe "/" $ H.requestPath req
+      path = rewriteWellKnownH2 rawPath
+      relPath = B.unpack $ B.dropWhile (== '/') path
+      requestedPath
+        | null relPath || relPath == "/" = canonicalRoot </> "index.html"
+        | otherwise = canonicalRoot </> relPath
+      indexPath = requestedPath </> "index.html"
+  ifM
+    (doesFileExist requestedPath)
+    (serveSafe requestedPath)
+    (ifM (doesFileExist indexPath) (serveSafe indexPath) (pure False))
   where
-    substs = substConfig <> substInfo <> [("onionHost", strEncode <$> onionHost)]
-    substConfig =
-      [ ( "persistence",
-          Just $ case persistence config of
-            SPMMemoryOnly -> "In-memory only"
-            SPMQueues -> "Queues"
-            SPMMessages -> "Queues and messages"
-        ),
-        ("messageExpiration", Just $ maybe "Never" (fromString . timedTTLText) $ messageExpiration config),
-        ("statsEnabled", Just . yesNo $ statsEnabled config),
-        ("newQueuesAllowed", Just . yesNo $ newQueuesAllowed config),
-        ("basicAuthEnabled", Just . yesNo $ basicAuthEnabled config)
+    serveSafe filePath = do
+      canonicalFile <- canonicalizePath filePath
+      if (canonicalRoot <> "/") `isPrefixOf` canonicalFile || canonicalRoot == canonicalFile
+        then do
+          content <- B.readFile canonicalFile
+          sendResponse $ H.responseBuilder N.ok200 [("Content-Type", staticMimeType canonicalFile)] (byteString content)
+          pure True
+        else pure False -- path traversal attempt
+    rewriteWellKnownH2 p
+      | "/.well-known/" `B.isPrefixOf` p = "/well-known/" <> B.drop (B.length "/.well-known/") p
+      | otherwise = p
+    staticMimeType fp
+      | ".html" `isSuffixOf` fp = "text/html"
+      | ".css" `isSuffixOf` fp = "text/css"
+      | ".js" `isSuffixOf` fp = "application/javascript"
+      | ".svg" `isSuffixOf` fp = "image/svg+xml"
+      | ".png" `isSuffixOf` fp = "image/png"
+      | ".ico" `isSuffixOf` fp = "image/x-icon"
+      | ".json" `isSuffixOf` fp = "application/json"
+      | "apple-app-site-association" `isSuffixOf` fp = "application/json"
+      | ".woff" `isSuffixOf` fp = "font/woff"
+      | ".woff2" `isSuffixOf` fp = "font/woff2"
+      | ".ttf" `isSuffixOf` fp = "font/ttf"
+      | otherwise = "application/octet-stream"
+
+-- | Substitutions for server information fields shared between SMP and XFTP pages.
+serverInfoSubsts :: String -> Maybe ServerPublicInfo -> [(ByteString, Maybe ByteString)]
+serverInfoSubsts simplexmqSource information =
+  concat
+    [ basic,
+      maybe [("usageConditions", Nothing), ("usageAmendments", Nothing)] conds (usageConditions spi),
+      maybe [("operator", Nothing)] operatorE (operator spi),
+      maybe [("admin", Nothing)] admin (adminContacts spi),
+      maybe [("complaints", Nothing)] complaints (complaintsContacts spi),
+      maybe [("hosting", Nothing)] hostingE (hosting spi),
+      server
+    ]
+  where
+    basic =
+      [ ("sourceCode", if T.null sc then Nothing else Just (encodeUtf8 sc)),
+        ("noSourceCode", if T.null sc then Just "none" else Nothing),
+        ("version", Just $ B.pack simplexMQVersion),
+        ("commitSourceCode", Just $ encodeUtf8 $ maybe (T.pack simplexmqSource) sourceCode information),
+        ("shortCommit", Just $ B.pack $ take 7 simplexmqCommit),
+        ("commit", Just $ B.pack simplexmqCommit),
+        ("website", encodeUtf8 <$> website spi)
+      ]
+    spi = fromMaybe (emptyServerInfo "") information
+    sc = sourceCode spi
+    conds ServerConditions {conditions, amendments} =
+      [ ("usageConditions", Just $ encodeUtf8 conditions),
+        ("usageAmendments", encodeUtf8 <$> amendments)
+      ]
+    operatorE Entity {name, country} =
+      [ ("operator", Just ""),
+        ("operatorEntity", Just $ encodeUtf8 name),
+        ("operatorCountry", encodeUtf8 <$> country)
+      ]
+    admin ServerContactAddress {simplex, email, pgp} =
+      [ ("admin", Just ""),
+        ("adminSimplex", strEncode <$> simplex),
+        ("adminEmail", encodeUtf8 <$> email),
+        ("adminPGP", encodeUtf8 . pkURI <$> pgp),
+        ("adminPGPFingerprint", encodeUtf8 . pkFingerprint <$> pgp)
+      ]
+    complaints ServerContactAddress {simplex, email, pgp} =
+      [ ("complaints", Just ""),
+        ("complaintsSimplex", strEncode <$> simplex),
+        ("complaintsEmail", encodeUtf8 <$> email),
+        ("complaintsPGP", encodeUtf8 . pkURI <$> pgp),
+        ("complaintsPGPFingerprint", encodeUtf8 . pkFingerprint <$> pgp)
+      ]
+    hostingE Entity {name, country} =
+      [ ("hosting", Just ""),
+        ("hostingEntity", Just $ encodeUtf8 name),
+        ("hostingCountry", encodeUtf8 <$> country)
+      ]
+    server =
+      [ ("serverCountry", encodeUtf8 <$> serverCountry spi),
+        ("hostingType", (\s -> maybe s (\(c, rest) -> toUpper c `B.cons` rest) $ B.uncons s) . strEncode <$> hostingType spi)
       ]
-    yesNo True = "Yes"
-    yesNo False = "No"
-    substInfo =
-      concat
-        [ basic,
-          maybe [("usageConditions", Nothing), ("usageAmendments", Nothing)] conds (usageConditions spi),
-          maybe [("operator", Nothing)] operatorE (operator spi),
-          maybe [("admin", Nothing)] admin (adminContacts spi),
-          maybe [("complaints", Nothing)] complaints (complaintsContacts spi),
-          maybe [("hosting", Nothing)] hostingE (hosting spi),
-          server
-        ]
-      where
-        basic =
-          [ ("sourceCode", if T.null sc then Nothing else Just (encodeUtf8 sc)),
-            ("noSourceCode", if T.null sc then Just "none" else Nothing),
-            ("version", Just $ B.pack simplexMQVersion),
-            ("commitSourceCode", Just $ encodeUtf8 $ maybe (T.pack simplexmqSource) sourceCode information),
-            ("shortCommit", Just $ B.pack $ take 7 simplexmqCommit),
-            ("commit", Just $ B.pack simplexmqCommit),
-            ("website", encodeUtf8 <$> website spi)
-          ]
-        spi = fromMaybe (emptyServerInfo "") information
-        sc = sourceCode spi
-        conds ServerConditions {conditions, amendments} =
-          [ ("usageConditions", Just $ encodeUtf8 conditions),
-            ("usageAmendments", encodeUtf8 <$> amendments)
-          ]
-        operatorE Entity {name, country} =
-          [ ("operator", Just ""),
-            ("operatorEntity", Just $ encodeUtf8 name),
-            ("operatorCountry", encodeUtf8 <$> country)
-          ]
-        admin ServerContactAddress {simplex, email, pgp} =
-          [ ("admin", Just ""),
-            ("adminSimplex", strEncode <$> simplex),
-            ("adminEmail", encodeUtf8 <$> email),
-            ("adminPGP", encodeUtf8 . pkURI <$> pgp),
-            ("adminPGPFingerprint", encodeUtf8 . pkFingerprint <$> pgp)
-          ]
-        complaints ServerContactAddress {simplex, email, pgp} =
-          [ ("complaints", Just ""),
-            ("complaintsSimplex", strEncode <$> simplex),
-            ("complaintsEmail", encodeUtf8 <$> email),
-            ("complaintsPGP", encodeUtf8 . pkURI <$> pgp),
-            ("complaintsPGPFingerprint", encodeUtf8 . pkFingerprint <$> pgp)
-          ]
-        hostingE Entity {name, country} =
-          [ ("hosting", Just ""),
-            ("hostingEntity", Just $ encodeUtf8 name),
-            ("hostingCountry", encodeUtf8 <$> country)
-          ]
-        server =
-          [ ("serverCountry", encodeUtf8 <$> serverCountry spi),
-            ("hostingType",  (\s -> maybe s (\(c, rest) -> toUpper c `B.cons` rest) $ B.uncons s) . strEncode <$> hostingType spi)
-          ]
 
 -- Copy-pasted from simplex-chat Simplex.Chat.Types.Preferences
 {-# INLINE timedTTLText #-}
@@ -237,13 +283,13 @@ section_ label content' src =
         (inside, next') ->
           let next = B.drop (B.length endMarker) next'
            in case content' of
-                Just content | not (B.null content) -> before <> item_ label content inside <> section_ label content' next
-                _ -> before <> next -- collapse section
+                Just content -> before <> item_ label content inside <> section_ label content' next
+                Nothing -> before <> next -- collapse section
   where
     startMarker = "<x-" <> label <> ">"
     endMarker = "</x-" <> label <> ">"
 
--- | Replace all occurences of @${label}@ with provided content.
+-- | Replace all occurrences of @${label}@ with provided content.
 item_ :: ByteString -> ByteString -> ByteString -> ByteString
 item_ label content' src =
   case B.breakSubstring marker src of

src/Simplex/Messaging/Server/Web/Embedded.hs

@@ -0,0 +1,18 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+module Simplex.Messaging.Server.Web.Embedded where
+
+import Data.ByteString (ByteString)
+import Data.FileEmbed (embedDir, embedFile)
+
+indexHtml :: ByteString
+indexHtml = $(embedFile "src/Simplex/Messaging/Server/Web/index.html")
+
+linkHtml :: ByteString
+linkHtml = $(embedFile "src/Simplex/Messaging/Server/Web/link.html")
+
+mediaContent :: [(FilePath, ByteString)]
+mediaContent = $(embedDir "src/Simplex/Messaging/Server/Web/media/")
+
+wellKnown :: [(FilePath, ByteString)]
+wellKnown = $(embedDir "src/Simplex/Messaging/Server/Web/.well-known/")

src/Simplex/Messaging/Server/Web/index.html

@@ -229,7 +229,7 @@
                 <td>Source code:</td>
                 <td>
                   <x-sourceCode><a href="${sourceCode}" target="_blank">${sourceCode}</a></x-sourceCode>
-                  <x-noSourceCode>add to smp-server.ini (required by <a href="https://github.com/simplex-chat/simplexmq/blob/stable/LICENSE" target="_blank">AGPLv3</a>)</x-noSourceCode>
+                  <x-noSourceCode>add to ${iniFileName} (required by <a href="https://github.com/simplex-chat/simplexmq/blob/stable/LICENSE" target="_blank">AGPLv3</a>)</x-noSourceCode>
                 </td>
               </tr>
               <x-website>
@@ -317,6 +317,7 @@
             <h2 class="text-[30px] mb-[20px] leading-[28px] text-[#606C71] dark:text-white font-bold max-w-[475px]">
               Configuration</h2>
             <table id="config">
+              <x-smpConfig>
               <tr class="text-grey-black dark:text-white text-base">
                 <td>Persistence:</td>
                 <td>${persistence}</td>
@@ -337,6 +338,7 @@
                 <td>Basic auth enabled:</td>
                 <td>${basicAuthEnabled}</td>
               </tr>
+              </x-smpConfig>
             </table>
           </div>
         </div>

tests/CLITests.hs

@@ -30,7 +30,8 @@ import Simplex.Messaging.Transport.HTTP2 (HTTP2Body (..))
 import qualified Simplex.Messaging.Transport.HTTP2.Client as HC
 import Simplex.Messaging.Transport.Server (loadFileFingerprint)
 import Simplex.Messaging.Util (catchAll_)
-import qualified Static
+import qualified SMPWeb
+import Simplex.Messaging.Server.Web (serveStaticFiles, attachStaticFiles)
 import System.Directory (doesFileExist)
 import System.Environment (withArgs)
 import System.FilePath ((</>))
@@ -151,7 +152,7 @@ smpServerTestStatic = do
   Right ini_ <- readIniFile iniFile
   lookupValue "WEB" "https" ini_ `shouldBe` Right "5223"
 
-  let smpServerCLI' = smpServerCLI_ Static.generateSite Static.serveStaticFiles Static.attachStaticFiles
+  let smpServerCLI' = smpServerCLI_ SMPWeb.smpGenerateSite serveStaticFiles attachStaticFiles
   let server = capture_ (withArgs ["start"] $ smpServerCLI' cfgPath logPath `catchAny` print)
   bracket (async server) cancel $ \_t -> do
     threadDelay 1000000

tests/Test.hs

@@ -35,6 +35,7 @@ import Util
 import XFTPAgent
 import XFTPCLI
 import XFTPServerTests (xftpServerTests)
+import WebTests (webTests)
 import XFTPWebTests (xftpWebTests)
 
 #if defined(dbPostgres)
@@ -152,6 +153,7 @@ main = do
           describe "XFTP agent" xftpAgentTests
         describe "XFTP Web Client" xftpWebTests
         describe "XRCP" remoteControlTests
+        describe "Web" webTests
         describe "Server CLIs" cliTests
 
 eventuallyRemove :: FilePath -> Int -> IO ()

tests/WebTests.hs

@@ -0,0 +1,70 @@
+{-# 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"