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 = "
| Persistence: | ${persistence} | @@ -337,6 +338,25 @@Basic auth enabled: | ${basicAuthEnabled} |
| File expiration: | +${fileExpiration} | +||
| Stats enabled: | +${statsEnabled} | +||
| New uploads allowed: | +${newUploadsAllowed} | +||
| Basic auth enabled: | +${basicAuthEnabled} | +