diff --git a/apps/smp-server/Main.hs b/apps/smp-server/Main.hs index 36abd1091..3a334d0d5 100644 --- a/apps/smp-server/Main.hs +++ b/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 diff --git a/apps/smp-server/SMPWeb.hs b/apps/smp-server/SMPWeb.hs new file mode 100644 index 000000000..efa7edee3 --- /dev/null +++ b/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" diff --git a/apps/smp-server/static/a/index.html b/apps/smp-server/static/a/index.html deleted file mode 120000 index 1140bcf31..000000000 --- a/apps/smp-server/static/a/index.html +++ /dev/null @@ -1 +0,0 @@ -../link.html \ No newline at end of file diff --git a/apps/smp-server/static/c/index.html b/apps/smp-server/static/c/index.html deleted file mode 120000 index 1140bcf31..000000000 --- a/apps/smp-server/static/c/index.html +++ /dev/null @@ -1 +0,0 @@ -../link.html \ No newline at end of file diff --git a/apps/smp-server/static/contact/index.html b/apps/smp-server/static/contact/index.html deleted file mode 120000 index 1140bcf31..000000000 --- a/apps/smp-server/static/contact/index.html +++ /dev/null @@ -1 +0,0 @@ -../link.html \ No newline at end of file diff --git a/apps/smp-server/static/i/index.html b/apps/smp-server/static/i/index.html deleted file mode 120000 index 1140bcf31..000000000 --- a/apps/smp-server/static/i/index.html +++ /dev/null @@ -1 +0,0 @@ -../link.html \ No newline at end of file diff --git a/apps/smp-server/static/invitation/index.html b/apps/smp-server/static/invitation/index.html deleted file mode 120000 index 1140bcf31..000000000 --- a/apps/smp-server/static/invitation/index.html +++ /dev/null @@ -1 +0,0 @@ -../link.html \ No newline at end of file diff --git a/apps/smp-server/web/Static/Embedded.hs b/apps/smp-server/web/Static/Embedded.hs deleted file mode 100644 index c1c4fde2f..000000000 --- a/apps/smp-server/web/Static/Embedded.hs +++ /dev/null @@ -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/") diff --git a/apps/xftp-server/Main.hs b/apps/xftp-server/Main.hs index 269156c93..b77a38b47 100644 --- a/apps/xftp-server/Main.hs +++ b/apps/xftp-server/Main.hs @@ -1,8 +1,10 @@ module Main where import Control.Logger.Simple +import Simplex.FileTransfer.Server.Main (xftpServerCLI_) import Simplex.Messaging.Server.CLI (getEnvPath) -import Simplex.FileTransfer.Server.Main +import Simplex.Messaging.Server.Web (serveStaticFiles) +import XFTPWeb (xftpGenerateSite) defaultCfgPath :: FilePath defaultCfgPath = "/etc/opt/simplex-xftp" @@ -18,4 +20,4 @@ main = do setLogLevel LogDebug -- change to LogError in production cfgPath <- getEnvPath "XFTP_SERVER_CFG_PATH" defaultCfgPath logPath <- getEnvPath "XFTP_SERVER_LOG_PATH" defaultLogPath - withGlobalLogging logCfg $ xftpServerCLI cfgPath logPath + withGlobalLogging logCfg $ xftpServerCLI_ xftpGenerateSite serveStaticFiles cfgPath logPath diff --git a/apps/xftp-server/XFTPWeb.hs b/apps/xftp-server/XFTPWeb.hs new file mode 100644 index 000000000..e8ee7040a --- /dev/null +++ b/apps/xftp-server/XFTPWeb.hs @@ -0,0 +1,37 @@ +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} + +module XFTPWeb + ( xftpGenerateSite, + xftpServerInformation, + ) where + +import Data.ByteString (ByteString) +import Data.Maybe (isJust) +import Data.String (fromString) +import Simplex.FileTransfer.Server.Env (XFTPServerConfig (..)) +import Simplex.Messaging.Encoding.String (strEncode) +import Simplex.Messaging.Server.Expiration (ExpirationConfig (..)) +import Simplex.Messaging.Server.Information (ServerPublicInfo) +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 (..)) + +xftpGenerateSite :: XFTPServerConfig -> Maybe ServerPublicInfo -> Maybe TransportHost -> FilePath -> IO () +xftpGenerateSite cfg info onionHost path = + Web.generateSite (xftpServerInformation cfg info onionHost) [] path + +xftpServerInformation :: XFTPServerConfig -> Maybe ServerPublicInfo -> Maybe TransportHost -> ByteString +xftpServerInformation XFTPServerConfig {fileExpiration, logStatsInterval, allowNewFiles, newFileBasicAuth} information onionHost = render E.indexHtml substs + where + substs = [("smpConfig", Nothing), ("xftpConfig", Just "y")] <> substConfig <> serverInfoSubsts simplexmqSource information <> [("onionHost", strEncode <$> onionHost), ("iniFileName", Just "file-server.ini")] + substConfig = + [ ("fileExpiration", Just $ maybe "Never" (fromString . timedTTLText . ttl) fileExpiration), + ("statsEnabled", Just . yesNo $ isJust logStatsInterval), + ("newUploadsAllowed", Just . yesNo $ allowNewFiles), + ("basicAuthEnabled", Just . yesNo $ isJust newFileBasicAuth) + ] + yesNo True = "Yes" + yesNo False = "No" diff --git a/rfcs/README.md b/rfcs/README.md index b7a87d7d0..a98f8aa10 100644 --- a/rfcs/README.md +++ b/rfcs/README.md @@ -131,7 +131,7 @@ A subset of standard specifications will be designated as Core IP under the Cons This is a legally binding commitment. Once Licensed IP is included in Core IP, the company that owns the code cannot unilaterally change it — even though they own the code, the Consortium Agreement requires a Governing Decision for any change to Core IP. This protects the fundamental properties of the network (privacy, security, decentralization) from unilateral modification by any single party. -The designation of specific specifications as Core IP is itself a Governing Decision requiring unanimous approval. The transition will happen incrementally as protocols stabilize — the governance ratchet ensures that each designation is irreversible. +The designation of specific specifications as Core IP is itself a Governing Decision that requires Consortium vote. The transition will happen incrementally as protocols stabilize — the governance ratchet ensures that each designation is irreversible. The exact mechanism for distinguishing core from standard within the RFC and protocol folder structure is TBD — it will be decided as the first protocols are designated as Core IP. diff --git a/simplexmq.cabal b/simplexmq.cabal index fd3026968..34ca63faa 100644 --- a/simplexmq.cabal +++ b/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 @@ -248,6 +248,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 @@ -343,11 +345,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) @@ -404,30 +411,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 @@ -451,6 +447,7 @@ executable xftp-server buildable: False main-is: Main.hs other-modules: + XFTPWeb Paths_simplexmq hs-source-dirs: apps/xftp-server @@ -459,6 +456,7 @@ executable xftp-server 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 , simple-logger , simplexmq default-language: Haskell2010 @@ -500,9 +498,10 @@ test-suite simplexmq-test XFTPCLI XFTPClient XFTPServerTests + WebTests XFTPWebTests - Static - Static.Embedded + SMPWeb + XFTPWeb Paths_simplexmq if flag(client_postgres) other-modules: @@ -521,7 +520,8 @@ test-suite simplexmq-test PostgresSchemaDump hs-source-dirs: tests - apps/smp-server/web + apps/smp-server + apps/xftp-server default-extensions: StrictData -- add -fhpc to ghc-options to run tests with coverage @@ -539,7 +539,6 @@ test-suite simplexmq-test , crypton-x509-store , crypton-x509-validation , directory - , file-embed , filepath , generic-random ==1.5.* , hashable @@ -569,10 +568,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) diff --git a/src/Simplex/FileTransfer/Server.hs b/src/Simplex/FileTransfer/Server.hs index b5c0dbd6b..6e0a9735a 100644 --- a/src/Simplex/FileTransfer/Server.hs +++ b/src/Simplex/FileTransfer/Server.hs @@ -73,6 +73,7 @@ import Simplex.Messaging.Transport.HTTP2 import Simplex.Messaging.Transport.HTTP2.File (fileBlockSize) import Simplex.Messaging.Transport.HTTP2.Server (runHTTP2Server) import Simplex.Messaging.Transport.Server (SNICredentialUsed, TransportServerConfig (..), runLocalTCPServer) +import Simplex.Messaging.Server.Web (serveStaticPageH2) import Simplex.Messaging.Util import Simplex.Messaging.Version import System.Environment (lookupEnv) @@ -84,7 +85,7 @@ import System.Random (getStdRandom, randomR) #endif import UnliftIO import UnliftIO.Concurrent (threadDelay) -import UnliftIO.Directory (doesFileExist, removeFile, renameFile) +import UnliftIO.Directory (canonicalizePath, doesFileExist, removeFile, renameFile) import qualified UnliftIO.Exception as E type M a = ReaderT XFTPEnv IO a @@ -147,11 +148,13 @@ xftpServer cfg@XFTPServerConfig {xftpPort, transportConfig, inactiveClientExpira sessions <- liftIO TM.emptyIO let cleanup sessionId = atomically $ TM.delete sessionId sessions srvParams = if isJust httpCreds_ then defaultSupportedParamsHTTPS else defaultSupportedParams + webCanonicalRoot_ <- liftIO $ mapM canonicalizePath (webStaticPath cfg) liftIO . runHTTP2Server started xftpPort defaultHTTP2BufferSize srvParams srvCreds httpCreds_ transportConfig inactiveClientExpiration cleanup $ \sniUsed sessionId sessionALPN r sendResponse -> do let addCORS' = sniUsed && addCORSHeaders transportConfig - if addCORS' && H.requestMethod r == Just "OPTIONS" - then sendResponse $ H.responseNoBody N.ok200 corsPreflightHeaders - else do + case H.requestMethod r of + Just "OPTIONS" | addCORS' -> sendResponse $ H.responseNoBody N.ok200 corsPreflightHeaders + Just "GET" | sniUsed -> forM_ webCanonicalRoot_ $ \root -> serveStaticPageH2 root r sendResponse + _ -> do reqBody <- getHTTP2Body r xftpBlockSize let v = VersionXFTP 1 thServerVRange = versionToRange v @@ -377,7 +380,6 @@ xftpServer cfg@XFTPServerConfig {xftpPort, transportConfig, inactiveClientExpira CPHelp -> hPutStrLn h "commands: stats-rts, delete, help, quit" CPQuit -> pure () CPSkip -> pure () - _ -> hPutStrLn h "unsupported command" where withUserRole action = readTVarIO role >>= \case diff --git a/src/Simplex/FileTransfer/Server/Env.hs b/src/Simplex/FileTransfer/Server/Env.hs index 8b391f86f..d4c58df66 100644 --- a/src/Simplex/FileTransfer/Server/Env.hs +++ b/src/Simplex/FileTransfer/Server/Env.hs @@ -77,7 +77,8 @@ data XFTPServerConfig = XFTPServerConfig prometheusInterval :: Maybe Int, prometheusMetricsFile :: FilePath, transportConfig :: TransportServerConfig, - responseDelay :: Int + responseDelay :: Int, + webStaticPath :: Maybe FilePath } defaultInactiveClientExpiration :: ExpirationConfig diff --git a/src/Simplex/FileTransfer/Server/Main.hs b/src/Simplex/FileTransfer/Server/Main.hs index ed35e5b14..101fe945b 100644 --- a/src/Simplex/FileTransfer/Server/Main.hs +++ b/src/Simplex/FileTransfer/Server/Main.hs @@ -5,16 +5,22 @@ {-# LANGUAGE OverloadedLists #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE TypeApplications #-} module Simplex.FileTransfer.Server.Main ( xftpServerCLI, + xftpServerCLI_, ) where +import Control.Monad (when) import Data.Either (fromRight) import Data.Functor (($>)) import Data.Ini (lookupValue, readIniFile) import Data.Int (Int64) +import Data.List (find) +import qualified Data.List.NonEmpty as L import Data.Maybe (fromMaybe, isJust) +import Data.Text.Encoding (encodeUtf8) import qualified Data.Text as T import qualified Data.Text.IO as T import Network.Socket (HostName) @@ -29,6 +35,9 @@ import Simplex.Messaging.Encoding.String import Simplex.Messaging.Protocol (ProtoServerWithAuth (..), pattern XFTPServer) import Simplex.Messaging.Server.CLI import Simplex.Messaging.Server.Expiration +import Simplex.Messaging.Server.Information (ServerPublicInfo (..)) +import Simplex.Messaging.Server.Main (serverPublicInfo, printSourceCode) +import Simplex.Messaging.Server.Web (EmbeddedWebParams (..), WebHttpsParams (..)) import Simplex.Messaging.Transport.Client (TransportHost (..)) import Simplex.Messaging.Transport.HTTP2 (httpALPN) import Simplex.Messaging.Transport.Server (ServerCredentials (..), TransportServerConfig (..), mkTransportServerConfig) @@ -39,7 +48,15 @@ import System.IO (BufferMode (..), hSetBuffering, stderr, stdout) import Text.Read (readMaybe) xftpServerCLI :: FilePath -> FilePath -> IO () -xftpServerCLI cfgPath logPath = do +xftpServerCLI = xftpServerCLI_ (\_ _ _ _ -> pure ()) (\_ -> pure ()) + +xftpServerCLI_ :: + (XFTPServerConfig -> Maybe ServerPublicInfo -> Maybe TransportHost -> FilePath -> IO ()) -> + (EmbeddedWebParams -> IO ()) -> + FilePath -> + FilePath -> + IO () +xftpServerCLI_ generateSite serveStaticFiles cfgPath logPath = do getCliCommand' (cliCommandP cfgPath logPath iniFile) serverVersion >>= \case Init opts -> doesFileExist iniFile >>= \case @@ -66,7 +83,8 @@ xftpServerCLI cfgPath logPath = do defaultServerPort = "443" executableName = "file-server" storeLogFilePath = combine logPath "file-server-store.log" - initializeServer InitOptions {enableStoreLog, signAlgorithm, ip, fqdn, filesPath, fileSizeQuota} = do + defaultStaticPath = combine logPath "www" + initializeServer InitOptions {enableStoreLog, signAlgorithm, ip, fqdn, filesPath, fileSizeQuota, webStaticPath = webStaticPath_} = do clearDirIfExists cfgPath clearDirIfExists logPath createDirectoryIfMissing True cfgPath @@ -81,7 +99,27 @@ xftpServerCLI cfgPath logPath = do printServiceInfo serverVersion srv where iniFileContent host = - "[STORE_LOG]\n\ + "[INFORMATION]\n\ + \# AGPLv3 license requires that you make any source code modifications\n\ + \# available to the end users of the server.\n\ + \# LICENSE: https://github.com/simplex-chat/simplexmq/blob/stable/LICENSE\n\ + \# Include correct source code URI in case the server source code is modified in any way.\n\ + \# source_code: https://github.com/simplex-chat/simplexmq\n\ + \\n\ + \# Declaring all below information is optional, any of these fields can be omitted.\n\ + \# server_country: ISO-3166 2-letter code\n\ + \# operator: entity (organization or person name)\n\ + \# operator_country: ISO-3166 2-letter code\n\ + \# website:\n\ + \# admin_simplex: SimpleX address\n\ + \# admin_email:\n\ + \# complaints_simplex: SimpleX address\n\ + \# complaints_email:\n\ + \# hosting: entity (organization or person name)\n\ + \# hosting_country: ISO-3166 2-letter code\n\ + \# hosting_type: virtual\n\ + \\n\ + \[STORE_LOG]\n\ \# The server uses STM memory for persistence,\n\ \# that will be lost on restart (e.g., as with redis).\n\ \# This option enables saving memory to append only log,\n\ @@ -128,8 +166,13 @@ xftpServerCLI cfgPath logPath = do <> ("# check_interval: " <> tshow (checkInterval defaultInactiveClientExpiration) <> "\n") <> "\n\ \[WEB]\n\ - \# cert: /etc/opt/simplex-xftp/web.crt\n\ - \# key: /etc/opt/simplex-xftp/web.key\n" + \# Set path to generate static mini-site for server information\n" + <> ("static_path: " <> T.pack (fromMaybe defaultStaticPath webStaticPath_) <> "\n\n") + <> "# Run an embedded HTTP server on this port.\n\ + \# http: 8000\n\n\ + \# TLS credentials for HTTPS web server on the same port as XFTP.\n\ + \# cert: " <> T.pack (cfgPath `combine` "web.crt") <> "\n\ + \# key: " <> T.pack (cfgPath `combine` "web.key") <> "\n" runServer ini = do hSetBuffering stdout LineBuffering hSetBuffering stderr LineBuffering @@ -138,9 +181,22 @@ xftpServerCLI cfgPath logPath = do port = T.unpack $ strictIni "TRANSPORT" "port" ini srv = ProtoServerWithAuth (XFTPServer [THDomainName host] (if port == "443" then "" else port) (C.KeyHash fp)) Nothing printServiceInfo serverVersion srv + let information = serverPublicInfo ini + printSourceCode (sourceCode <$> information) printXFTPConfig serverConfig + case webStaticPath' of + Just path -> do + let onionHost = + either (const Nothing) (find isOnion) $ + strDecode @(L.NonEmpty TransportHost) . encodeUtf8 =<< lookupValue "TRANSPORT" "host" ini + webHttpPort = eitherToMaybe (lookupValue "WEB" "http" ini) >>= readMaybe . T.unpack + generateSite serverConfig information onionHost path + when (isJust webHttpPort || isJust webHttpsParams') $ + serveStaticFiles EmbeddedWebParams {webStaticPath = path, webHttpPort, webHttpsParams = webHttpsParams'} + Nothing -> pure () runXFTPServer serverConfig where + isOnion = \case THOnionHost _ -> True; _ -> False enableStoreLog = settingIsOn "STORE_LOG" "enable" ini logStats = settingIsOn "STORE_LOG" "log_stats" ini c = combine cfgPath . ($ defaultX509Config) @@ -172,6 +228,14 @@ xftpServerCLI cfgPath logPath = do privateKeyFile = key } + webHttpsParams' = do + httpsPort <- 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 = httpsPort, cert, key} + + webStaticPath' = eitherToMaybe $ T.unpack <$> lookupValue "WEB" "static_path" ini + serverConfig = XFTPServerConfig { xftpPort = T.unpack $ strictIni "TRANSPORT" "port" ini, @@ -209,7 +273,7 @@ xftpServerCLI cfgPath logPath = do logStatsStartTime = 0, -- seconds from 00:00 UTC serverStatsLogFile = combine logPath "file-server-stats.daily.log", serverStatsBackupFile = logStats $> combine logPath "file-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 "xftp-server-metrics.txt", transportConfig = let cfg = @@ -218,7 +282,8 @@ xftpServerCLI cfgPath logPath = do (Just $ alpnSupportedXFTPhandshakes <> httpALPN) False in cfg {addCORSHeaders = isJust httpCredentials_}, - responseDelay = 0 + responseDelay = 0, + webStaticPath = webStaticPath' } data CliCommand @@ -233,7 +298,8 @@ data InitOptions = InitOptions ip :: HostName, fqdn :: Maybe HostName, filesPath :: FilePath, - fileSizeQuota :: FileSize Int64 + fileSizeQuota :: FileSize Int64, + webStaticPath :: Maybe FilePath } deriving (Show) @@ -302,4 +368,10 @@ cliCommandP cfgPath logPath iniFile = <> help "File storage quota (e.g. 100gb)" <> metavar "QUOTA" ) - pure InitOptions {enableStoreLog, signAlgorithm, ip, fqdn, filesPath, fileSizeQuota} + webStaticPath <- + (optional . strOption) + ( long "web-path" + <> help "Directory to store generated static site with server information" + <> metavar "PATH" + ) + pure InitOptions {enableStoreLog, signAlgorithm, ip, fqdn, filesPath, fileSizeQuota, webStaticPath} diff --git a/src/Simplex/Messaging/Server/Main.hs b/src/Simplex/Messaging/Server/Main.hs index 25dbaec90..f7461f392 100644 --- a/src/Simplex/Messaging/Server/Main.hs +++ b/src/Simplex/Messaging/Server/Main.hs @@ -73,6 +73,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 @@ -572,7 +573,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 @@ -613,18 +614,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 () @@ -748,18 +748,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 diff --git a/apps/smp-server/web/Static.hs b/src/Simplex/Messaging/Server/Web.hs similarity index 52% rename from apps/smp-server/web/Static.hs rename to src/Simplex/Messaging/Server/Web.hs index cf6d5834b..23a534429 100644 --- a/apps/smp-server/web/Static.hs +++ b/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 = " label <> ">" endMarker = " 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 diff --git a/apps/smp-server/static/.well-known/apple-app-site-association b/src/Simplex/Messaging/Server/Web/.well-known/apple-app-site-association similarity index 100% rename from apps/smp-server/static/.well-known/apple-app-site-association rename to src/Simplex/Messaging/Server/Web/.well-known/apple-app-site-association diff --git a/apps/smp-server/static/.well-known/assetlinks.json b/src/Simplex/Messaging/Server/Web/.well-known/assetlinks.json similarity index 100% rename from apps/smp-server/static/.well-known/assetlinks.json rename to src/Simplex/Messaging/Server/Web/.well-known/assetlinks.json diff --git a/src/Simplex/Messaging/Server/Web/Embedded.hs b/src/Simplex/Messaging/Server/Web/Embedded.hs new file mode 100644 index 000000000..7345829cc --- /dev/null +++ b/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/") diff --git a/apps/smp-server/static/index.html b/src/Simplex/Messaging/Server/Web/index.html similarity index 98% rename from apps/smp-server/static/index.html rename to src/Simplex/Messaging/Server/Web/index.html index a66cd7988..fdc6fb054 100644 --- a/apps/smp-server/static/index.html +++ b/src/Simplex/Messaging/Server/Web/index.html @@ -229,7 +229,7 @@ Source code: ${sourceCode} - add to smp-server.ini (required by AGPLv3) + add to ${iniFileName} (required by AGPLv3) @@ -317,6 +317,7 @@

Configuration

+ @@ -337,6 +338,25 @@ + + + + + + + + + + + + + + + + + + +
Persistence: ${persistence}Basic auth enabled: ${basicAuthEnabled}
File expiration:${fileExpiration}
Stats enabled:${statsEnabled}
New uploads allowed:${newUploadsAllowed}
Basic auth enabled:${basicAuthEnabled}
diff --git a/apps/smp-server/static/link.html b/src/Simplex/Messaging/Server/Web/link.html similarity index 100% rename from apps/smp-server/static/link.html rename to src/Simplex/Messaging/Server/Web/link.html diff --git a/apps/smp-server/static/media/GilroyBold.woff2 b/src/Simplex/Messaging/Server/Web/media/GilroyBold.woff2 similarity index 100% rename from apps/smp-server/static/media/GilroyBold.woff2 rename to src/Simplex/Messaging/Server/Web/media/GilroyBold.woff2 diff --git a/apps/smp-server/static/media/GilroyLight.woff2 b/src/Simplex/Messaging/Server/Web/media/GilroyLight.woff2 similarity index 100% rename from apps/smp-server/static/media/GilroyLight.woff2 rename to src/Simplex/Messaging/Server/Web/media/GilroyLight.woff2 diff --git a/apps/smp-server/static/media/GilroyMedium.woff2 b/src/Simplex/Messaging/Server/Web/media/GilroyMedium.woff2 similarity index 100% rename from apps/smp-server/static/media/GilroyMedium.woff2 rename to src/Simplex/Messaging/Server/Web/media/GilroyMedium.woff2 diff --git a/apps/smp-server/static/media/GilroyRegular.woff2 b/src/Simplex/Messaging/Server/Web/media/GilroyRegular.woff2 similarity index 100% rename from apps/smp-server/static/media/GilroyRegular.woff2 rename to src/Simplex/Messaging/Server/Web/media/GilroyRegular.woff2 diff --git a/apps/smp-server/static/media/GilroyRegularItalic.woff2 b/src/Simplex/Messaging/Server/Web/media/GilroyRegularItalic.woff2 similarity index 100% rename from apps/smp-server/static/media/GilroyRegularItalic.woff2 rename to src/Simplex/Messaging/Server/Web/media/GilroyRegularItalic.woff2 diff --git a/apps/smp-server/static/media/apk_icon.png b/src/Simplex/Messaging/Server/Web/media/apk_icon.png similarity index 100% rename from apps/smp-server/static/media/apk_icon.png rename to src/Simplex/Messaging/Server/Web/media/apk_icon.png diff --git a/apps/smp-server/static/media/apple_store.svg b/src/Simplex/Messaging/Server/Web/media/apple_store.svg similarity index 100% rename from apps/smp-server/static/media/apple_store.svg rename to src/Simplex/Messaging/Server/Web/media/apple_store.svg diff --git a/apps/smp-server/static/media/contact.js b/src/Simplex/Messaging/Server/Web/media/contact.js similarity index 100% rename from apps/smp-server/static/media/contact.js rename to src/Simplex/Messaging/Server/Web/media/contact.js diff --git a/apps/smp-server/static/media/contact_page_mobile.png b/src/Simplex/Messaging/Server/Web/media/contact_page_mobile.png similarity index 100% rename from apps/smp-server/static/media/contact_page_mobile.png rename to src/Simplex/Messaging/Server/Web/media/contact_page_mobile.png diff --git a/apps/smp-server/static/media/f_droid.svg b/src/Simplex/Messaging/Server/Web/media/f_droid.svg similarity index 100% rename from apps/smp-server/static/media/f_droid.svg rename to src/Simplex/Messaging/Server/Web/media/f_droid.svg diff --git a/apps/smp-server/static/media/favicon.ico b/src/Simplex/Messaging/Server/Web/media/favicon.ico similarity index 100% rename from apps/smp-server/static/media/favicon.ico rename to src/Simplex/Messaging/Server/Web/media/favicon.ico diff --git a/apps/smp-server/static/media/google_play.svg b/src/Simplex/Messaging/Server/Web/media/google_play.svg similarity index 100% rename from apps/smp-server/static/media/google_play.svg rename to src/Simplex/Messaging/Server/Web/media/google_play.svg diff --git a/apps/smp-server/static/media/logo-dark.png b/src/Simplex/Messaging/Server/Web/media/logo-dark.png similarity index 100% rename from apps/smp-server/static/media/logo-dark.png rename to src/Simplex/Messaging/Server/Web/media/logo-dark.png diff --git a/apps/smp-server/static/media/logo-light.png b/src/Simplex/Messaging/Server/Web/media/logo-light.png similarity index 100% rename from apps/smp-server/static/media/logo-light.png rename to src/Simplex/Messaging/Server/Web/media/logo-light.png diff --git a/apps/smp-server/static/media/logo-symbol-dark.svg b/src/Simplex/Messaging/Server/Web/media/logo-symbol-dark.svg similarity index 100% rename from apps/smp-server/static/media/logo-symbol-dark.svg rename to src/Simplex/Messaging/Server/Web/media/logo-symbol-dark.svg diff --git a/apps/smp-server/static/media/logo-symbol-light.svg b/src/Simplex/Messaging/Server/Web/media/logo-symbol-light.svg similarity index 100% rename from apps/smp-server/static/media/logo-symbol-light.svg rename to src/Simplex/Messaging/Server/Web/media/logo-symbol-light.svg diff --git a/apps/smp-server/static/media/moon.svg b/src/Simplex/Messaging/Server/Web/media/moon.svg similarity index 100% rename from apps/smp-server/static/media/moon.svg rename to src/Simplex/Messaging/Server/Web/media/moon.svg diff --git a/apps/smp-server/static/media/qrcode.js b/src/Simplex/Messaging/Server/Web/media/qrcode.js similarity index 100% rename from apps/smp-server/static/media/qrcode.js rename to src/Simplex/Messaging/Server/Web/media/qrcode.js diff --git a/apps/smp-server/static/media/script.js b/src/Simplex/Messaging/Server/Web/media/script.js similarity index 100% rename from apps/smp-server/static/media/script.js rename to src/Simplex/Messaging/Server/Web/media/script.js diff --git a/apps/smp-server/static/media/style.css b/src/Simplex/Messaging/Server/Web/media/style.css similarity index 100% rename from apps/smp-server/static/media/style.css rename to src/Simplex/Messaging/Server/Web/media/style.css diff --git a/apps/smp-server/static/media/sun.svg b/src/Simplex/Messaging/Server/Web/media/sun.svg similarity index 100% rename from apps/smp-server/static/media/sun.svg rename to src/Simplex/Messaging/Server/Web/media/sun.svg diff --git a/apps/smp-server/static/media/swiper-bundle.min.css b/src/Simplex/Messaging/Server/Web/media/swiper-bundle.min.css similarity index 100% rename from apps/smp-server/static/media/swiper-bundle.min.css rename to src/Simplex/Messaging/Server/Web/media/swiper-bundle.min.css diff --git a/apps/smp-server/static/media/swiper-bundle.min.js b/src/Simplex/Messaging/Server/Web/media/swiper-bundle.min.js similarity index 100% rename from apps/smp-server/static/media/swiper-bundle.min.js rename to src/Simplex/Messaging/Server/Web/media/swiper-bundle.min.js diff --git a/apps/smp-server/static/media/tailwind.css b/src/Simplex/Messaging/Server/Web/media/tailwind.css similarity index 100% rename from apps/smp-server/static/media/tailwind.css rename to src/Simplex/Messaging/Server/Web/media/tailwind.css diff --git a/apps/smp-server/static/media/testflight.png b/src/Simplex/Messaging/Server/Web/media/testflight.png similarity index 100% rename from apps/smp-server/static/media/testflight.png rename to src/Simplex/Messaging/Server/Web/media/testflight.png diff --git a/tests/CLITests.hs b/tests/CLITests.hs index 30d798ca7..798b3e939 100644 --- a/tests/CLITests.hs +++ b/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 diff --git a/tests/Test.hs b/tests/Test.hs index be799a6e6..d397c57db 100644 --- a/tests/Test.hs +++ b/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) @@ -150,6 +151,7 @@ main = do describe "XFTP agent" xftpAgentTests describe "XFTP Web Client" xftpWebTests describe "XRCP" remoteControlTests + describe "Web" webTests describe "Server CLIs" cliTests #if defined(dbPostgres) around_ (postgressBracket testDBConnectInfo) $ diff --git a/tests/WebTests.hs b/tests/WebTests.hs new file mode 100644 index 000000000..9eb123d34 --- /dev/null +++ b/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") "${s}" `shouldBe` "val" + it "removes section when content is Nothing" $ + section_ "s" Nothing "beforeinsideafter" `shouldBe` "beforeafter" + it "keeps section when content is Just empty" $ + section_ "s" (Just "") "beforeinsideafter" `shouldBe` "beforeinsideafter" + it "handles multiple sections with same label" $ + section_ "s" (Just "X") "${s}mid${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${s}bbb" `shouldBe` "aaaYbbb" + it "removes Nothing section preserving surroundings" $ + section_ "s" Nothing "aaagonebbb" `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 "optional: ${opt}kept" [("opt", Nothing)] + `shouldBe` "kept" + it "handles mixed present and absent substitutions" $ + render "${a}${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" diff --git a/tests/XFTPClient.hs b/tests/XFTPClient.hs index f0d1e3a61..85a1d21b8 100644 --- a/tests/XFTPClient.hs +++ b/tests/XFTPClient.hs @@ -135,7 +135,8 @@ testXFTPServerConfig = prometheusInterval = Nothing, prometheusMetricsFile = xftpTestPrometheusMetricsFile, transportConfig = mkTransportServerConfig True (Just alpnSupportedXFTPhandshakes) False, - responseDelay = 0 + responseDelay = 0, + webStaticPath = Nothing } testXFTPClientConfig :: XFTPClientConfig