dandri/simplexmq
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplexmq.git synced 2026-08-27 11:31:02 +00:00
Code Issues Packages Projects Releases Wiki Activity

smp server: pass server information via CLI during server initialization (#1356)

Browse Source 
* smp server: pass server information via CLI during server initialization

* more info

* enable client expiration by default, disable port 8000

* update
This commit is contained in:
Evgeny
2024-10-06 12:34:44 +01:00
committed by GitHub
parent 50e4abf836
commit 97d45fb2a6
6 changed files with 232 additions and 54 deletions
Download Patch File Download Diff File Expand all files Collapse all files
apps/smp-server/static/index.html
+6
View File
@@ -295,6 +295,12 @@
<td>${hostingEntity} (${hostingCountry})</td>
</tr>
</x-hosting>
<x-hostingType>
<tr class="text-grey-black dark:text-white text-base">
<td>Hosting type:</td>
<td>${hostingType}</td>
</tr>
</x-hostingType>
<x-serverCountry>
<tr class="text-grey-black dark:text-white text-base">
<td>Server country:</td>
apps/smp-server/web/Static.hs
+3 -1
View File
@@ -8,6 +8,7 @@ import Control.Logger.Simple
import Control.Monad
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as B
import Data.Char (toUpper)
import Data.IORef (readIORef)
import Data.Maybe (fromMaybe)
import Data.String (fromString)
@@ -150,7 +151,8 @@ serverInformation ServerInformation {config, information} onionHost = render E.i
("hostingCountry", encodeUtf8 <$> country)
]
server =
[ ("serverCountry", fmap encodeUtf8 $ serverCountry =<< information)
[ ("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
src/Simplex/FileTransfer/Server/Env.hs
+1 -1
View File
@@ -72,7 +72,7 @@ data XFTPServerConfig = XFTPServerConfig
defaultInactiveClientExpiration :: ExpirationConfig
defaultInactiveClientExpiration =
ExpirationConfig
{ ttl = 43200, -- seconds, 12 hours
{ ttl = 21600, -- seconds, 6 hours
checkInterval = 3600 -- seconds, 1 hours
}
src/Simplex/Messaging/Server/Information.hs
+50
View File
@@ -1,14 +1,21 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}
module Simplex.Messaging.Server.Information where
import Data.Aeson (FromJSON (..), ToJSON (..))
import qualified Data.Aeson.TH as J
import qualified Data.Attoparsec.ByteString.Char8 as A
import Data.Int (Int64)
import Data.Maybe (isJust)
import Data.Text (Text)
import Simplex.Messaging.Agent.Protocol (ConnectionMode (..), ConnectionRequestUri)
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON)
data ServerInformation = ServerInformation
@@ -36,16 +43,59 @@ data ServerPublicInfo = ServerPublicInfo
adminContacts :: Maybe ServerContactAddress,
complaintsContacts :: Maybe ServerContactAddress,
hosting :: Maybe Entity,
hostingType :: Maybe HostingType,
serverCountry :: Maybe Text
}
deriving (Show)
emptyServerInfo :: Text -> ServerPublicInfo
emptyServerInfo sourceCode =
ServerPublicInfo
{ sourceCode,
usageConditions = Nothing,
operator = Nothing,
website = Nothing,
adminContacts = Nothing,
complaintsContacts = Nothing,
hosting = Nothing,
hostingType = Nothing,
serverCountry = Nothing
}
hasServerInfo :: ServerPublicInfo -> Bool
hasServerInfo ServerPublicInfo {usageConditions, operator, website, adminContacts, complaintsContacts, hosting, hostingType, serverCountry} =
isJust usageConditions || isJust operator || isJust website || isJust adminContacts || isJust complaintsContacts || isJust hosting || isJust hostingType || isJust serverCountry
data ServerPersistenceMode = SPMMemoryOnly | SPMQueues | SPMMessages
deriving (Show)
data ServerConditions = ServerConditions {conditions :: Text, amendments :: Maybe Text}
deriving (Show)
data HostingType = HTVirtual | HTDedicated | HTColocation | HTOwned
deriving (Show)
instance StrEncoding HostingType where
strEncode = \case
HTVirtual -> "virtual"
HTDedicated -> "dedicated"
HTColocation -> "colocation"
HTOwned -> "owned"
strP =
A.takeTill (== ' ') >>= \case
"virtual" -> pure HTVirtual
"dedicated" -> pure HTDedicated
"colocation" -> pure HTColocation
"owned" -> pure HTOwned
_ -> fail "bad HostingType"
instance FromJSON HostingType where
parseJSON = strParseJSON "HostingType"
instance ToJSON HostingType where
toJSON = strToJSON
toEncoding = strToJEncoding
data Entity = Entity {name :: Text, country :: Maybe Text}
deriving (Show)
src/Simplex/Messaging/Server/Main.hs
+170 -50
View File
@@ -1,4 +1,5 @@
{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
@@ -14,7 +15,7 @@ module Simplex.Messaging.Server.Main where
import Control.Concurrent.STM
import Control.Logger.Simple
import Control.Monad (void, when, (<$!>))
import Control.Monad
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as B
import Data.Char (isAlpha, isAscii, toUpper)
@@ -25,7 +26,7 @@ import qualified Data.List.NonEmpty as L
import Data.Maybe (fromMaybe, isJust, isNothing)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Text.Encoding (encodeUtf8)
import Data.Text.Encoding (encodeUtf8, decodeLatin1)
import qualified Data.Text.IO as T
import Network.Socket (HostName)
import Options.Applicative
@@ -42,11 +43,12 @@ import Simplex.Messaging.Server.Env.STM
import Simplex.Messaging.Server.Expiration
import Simplex.Messaging.Server.Information
import Simplex.Messaging.Transport (batchCmdsSMPVersion, sendingProxySMPVersion, simplexMQVersion, supportedServerSMPRelayVRange)
import Simplex.Messaging.Transport.Client (TransportHost (..))
import Simplex.Messaging.Transport.Client (SocksProxy, TransportHost (..), defaultSocksProxy)
import Simplex.Messaging.Transport.Server (ServerCredentials (..), TransportServerConfig (..), defaultTransportServerConfig)
import Simplex.Messaging.Util (eitherToMaybe, safeDecodeUtf8, tshow)
import Simplex.Messaging.Version (mkVersionRange)
import System.Directory (createDirectoryIfMissing, doesFileExist)
import System.Exit (exitFailure)
import System.FilePath (combine)
import System.IO (BufferMode (..), hSetBuffering, stderr, stdout)
import Text.Read (readMaybe)
@@ -93,6 +95,7 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
| scripted = initialize opts
| otherwise = do
putStrLn "Use `smp-server init -h` for available options."
checkInitOptions opts
void $ withPrompt "SMP server will be initialized (press Enter)" getLine
enableStoreLog <- onOffPrompt "Enable store log to restore queues and messages on server restart" True
logStats <- onOffPrompt "Enable logging daily statistics" False
@@ -108,7 +111,7 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
logStats,
fqdn = if null host' then fqdn else Just host',
password,
sourceCode = (T.pack <$> sourceCode') <|> src',
sourceCode = (T.pack <$> sourceCode') <|> src' <|> Just (T.pack simplexmqSource),
webStaticPath = if null staticPath' then sp' else Just staticPath',
disableWeb = noWeb'
}
@@ -122,7 +125,18 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
case strDecode $ encodeUtf8 $ T.pack s of
Right auth -> pure . Just $ ServerPassword auth
_ -> putStrLn "Invalid password. Only latin letters, digits and symbols other than '@' and ':' are allowed" >> serverPassword
initialize InitOptions {enableStoreLog, logStats, signAlgorithm, password, sourceCode, webStaticPath, disableWeb} = do
checkInitOptions InitOptions {sourceCode, serverInfo, operatorCountry, hostingCountry} = do
let err_
| isNothing sourceCode && hasServerInfo serverInfo =
Just "Error: passing any server information requires passing --source-code"
| isNothing (operator serverInfo) && isJust operatorCountry =
Just "Error: passing --operator-country requires passing --operator"
| isNothing (hosting serverInfo) && isJust hostingCountry =
Just "Error: passing --hosting-country requires passing --hosting"
| otherwise = Nothing
forM_ err_ $ \err -> putStrLn err >> exitFailure
initialize opts'@InitOptions {enableStoreLog, logStats, signAlgorithm, password, controlPort, socksProxy, ownDomains, sourceCode, webStaticPath, disableWeb} = do
checkInitOptions opts'
clearDirIfExists cfgPath
clearDirIfExists logPath
createDirectoryIfMissing True cfgPath
@@ -130,9 +144,10 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
let x509cfg = defaultX509Config {commonName = fromMaybe ip fqdn, signAlgorithm}
fp <- createServerX509 cfgPath x509cfg
basicAuth <- mapM createServerPassword password
controlPortPwds <- forM controlPort $ \_ -> let pwd = decodeLatin1 <$> randomBase64 18 in (,) <$> pwd <*> pwd
let host = fromMaybe (if ip == "127.0.0.1" then "<hostnames>" else ip) fqdn
srv = ProtoServerWithAuth (SMPServer [THDomainName host] "" (C.KeyHash fp)) basicAuth
T.writeFile iniFile $ iniFileContent host basicAuth $ Just "https://github.com/simplex-chat/simplexmq"
T.writeFile iniFile $ iniFileContent host basicAuth controlPortPwds
putStrLn $ "Server initialized, please provide additional server information in " <> iniFile <> "."
putStrLn $ "Run `" <> executableName <> " start` to start server."
warnCAPrivateKeyFile cfgPath x509cfg
@@ -141,9 +156,10 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
where
createServerPassword = \case
ServerPassword s -> pure s
SPRandom -> BasicAuth . strEncode <$> (atomically . C.randomBytes 32 =<< C.newRandom)
iniFileContent host basicAuth sourceCode' =
informationIniContent sourceCode'
SPRandom -> BasicAuth <$> randomBase64 32
randomBase64 n = strEncode <$> (atomically . C.randomBytes n =<< C.newRandom)
iniFileContent host basicAuth controlPortPwds =
informationIniContent opts'
<> "[STORE_LOG]\n\
\# The server uses STM memory for persistence,\n\
\# that will be lost on restart (e.g., as with redis).\n\
@@ -167,13 +183,13 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
\# smp://fingerprint:password@host1,host2\n\
\# The password will not be shared with the connecting contacts, you must share it only\n\
\# with the users who you want to allow creating messaging queues on your server.\n"
<> ( case basicAuth of
Just auth -> "create_password: " <> safeDecodeUtf8 (strEncode auth)
_ -> "# create_password: password to create new queues (any printable ASCII characters without whitespace, '@', ':' and '/')"
<> ( let noPassword = "password to create new queues and forward messages (any printable ASCII characters without whitespace, '@', ':' and '/')"
in optDisabled basicAuth <> "create_password: " <> maybe noPassword (safeDecodeUtf8 . strEncode) basicAuth
)
<> "\n\n\
\# control_port_admin_password:\n\
\# control_port_user_password:\n\n\
<> "\n\n"
<> (optDisabled controlPortPwds <> "control_port_admin_password: " <> maybe "" fst controlPortPwds <> "\n")
<> (optDisabled controlPortPwds <> "control_port_user_password: " <> maybe "" snd controlPortPwds <> "\n")
<> "\n\
\[TRANSPORT]\n\
\# Host is only used to print server address on start.\n\
\# You can specify multiple server ports.\n"
@@ -181,38 +197,44 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
<> ("port: " <> T.pack defaultServerPorts <> "\n")
<> "log_tls_errors: off\n\n\
\# Use `websockets: 443` to run websockets server in addition to plain TLS.\n\
\websockets: off\n\
\# control_port: 5224\n\n\
\# This option is deprecated and should be used for testing only.\n\
\# , port 443 should be specified in port above\n\
\websockets: off\n"
<> (optDisabled controlPort <> "control_port: " <> tshow (fromMaybe defaultControlPort controlPort))
<> "\n\n\
\[PROXY]\n\
\# Network configuration for SMP proxy client.\n\
\# `host_mode` can be 'public' (default) or 'onion'.\n\
\# It defines prefferred hostname for destination servers with multiple hostnames.\n\
\# host_mode: public\n\
\# required_host_mode: off\n\n\
\# The domain suffixes of the relays you operate (space-separated) to count as separate proxy statistics.\n\
\# own_server_domains: \n\n\
\# The domain suffixes of the relays you operate (space-separated) to count as separate proxy statistics.\n"
<> (optDisabled ownDomains <> "own_server_domains: " <> maybe "" (safeDecodeUtf8 . strEncode) ownDomains)
<> "\n\n\
\# SOCKS proxy port for forwarding messages to destination servers.\n\
\# You may need a separate instance of SOCKS proxy for incoming single-hop requests.\n\
\# socks_proxy: localhost:9050\n\n\
\# You may need a separate instance of SOCKS proxy for incoming single-hop requests.\n"
<> (optDisabled socksProxy <> "socks_proxy: " <> maybe "localhost:9050" (safeDecodeUtf8 . strEncode) socksProxy)
<> "\n\n\
\# `socks_mode` can be 'onion' for SOCKS proxy to be used for .onion destination hosts only (default)\n\
\# or 'always' to be used for all destination hosts (can be used if it is an .onion server).\n\
\# socks_mode: onion\n\n\
\# Limit number of threads a client can spawn to process proxy commands in parrallel.\n"
<> ("# client_concurrency: " <> tshow defaultProxyClientConcurrency <> "\n\n")
<> "[INACTIVE_CLIENTS]\n\
<> ("# client_concurrency: " <> tshow defaultProxyClientConcurrency)
<> "\n\n\
\[INACTIVE_CLIENTS]\n\
\# TTL and interval to check inactive clients\n\
\disconnect: off\n"
<> ("# ttl: " <> tshow (ttl defaultInactiveClientExpiration) <> "\n")
<> ("# check_interval: " <> tshow (checkInterval defaultInactiveClientExpiration) <> "\n")
\disconnect: on\n"
<> ("ttl: " <> tshow (ttl defaultInactiveClientExpiration) <> "\n")
<> ("check_interval: " <> tshow (checkInterval defaultInactiveClientExpiration))
<> "\n\n\
\[WEB]\n\
\# Set path to generate static mini-site for server information and qr codes/links\n"
<> ("static_path: " <> T.pack (fromMaybe defaultStaticPath webStaticPath) <> "\n\n")
<> "# Run an embedded server on this port\n\
\# Onion sites can use any port and register it in the hidden service config.\n\
\# Running on a port 80 may require setting process capabilities.\n"
<> (webDisabled <> "http: 8000\n\n")
<> "# You can run an embedded TLS web server too if you provide port and cert and key files.\n\
\# Running on a port 80 may require setting process capabilities.\n\
\# http: 8000\n\n\
\# You can run an embedded TLS web server too if you provide port and cert and key files.\n\
\# Not required for running relay on onion address.\n"
<> (webDisabled <> "https: 443\n")
<> (webDisabled <> "cert: " <> T.pack httpsCertFile <> "\n")
@@ -389,28 +411,31 @@ getServerSourceCode =
simplexmqSource :: String
simplexmqSource = "https://github.com/simplex-chat/simplexmq"
informationIniContent :: Maybe Text -> Text
informationIniContent sourceCode_ =
defaultControlPort :: Int
defaultControlPort = 5224
informationIniContent :: InitOptions -> Text
informationIniContent InitOptions {sourceCode, serverInfo} =
"[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\
\# If any other information fields are present, source code property also MUST be present.\n\n"
<> (maybe "# source_code: URI" ("source_code: " <>) sourceCode_ <> "\n\n")
<> "# Declaring all below information is optional, any of these fields can be omitted.\n\
<> (optDisabled sourceCode <> "source_code: " <> fromMaybe "URI" sourceCode)
<> "\n\n\
\# Declaring all below information is optional, any of these fields can be omitted.\n\
\\n\
\# Server usage conditions and amendments.\n\
\# It is recommended to use standard conditions with any amendments in a separate document.\n\
\# usage_conditions: https://github.com/simplex-chat/simplex-chat/blob/stable/PRIVACY.md\n\
\# condition_amendments: link\n\
\\n\
\# Server location and operator.\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\
\\n\
\# Server location and operator.\n"
<> countryStr "server" serverCountry
<> enitiyStrs "operator" operator
<> (optDisabled website <> "website: " <> fromMaybe "" website)
<> "\n\n\
\# Administrative contacts.\n\
\# admin_simplex: SimpleX address\n\
\# admin_email:\n\
@@ -423,9 +448,20 @@ informationIniContent sourceCode_ =
\# complaints_pgp:\n\
\# complaints_pgp_fingerprint:\n\
\\n\
\# Hosting provider.\n\
\# hosting: entity (organization or person name)\n\
\# hosting_country: ISO-3166 2-letter code\n\n"
\# Hosting provider.\n"
<> enitiyStrs "hosting" hosting
<> "\n\
\# Hosting type can be `virtual`, `dedicated`, `colocation`, `owned`\n"
<> ("hosting_type: " <> maybe "virtual" (decodeLatin1 . strEncode) hostingType <> "\n\n")
where
ServerPublicInfo {operator, website, hosting, hostingType, serverCountry}= serverInfo
countryStr optName country = optDisabled country <> optName <> "_country: " <> fromMaybe "ISO-3166 2-letter code" country <> "\n"
enitiyStrs optName entity =
optDisabled entity
<> optName <> ": "
<> maybe ("entity (organization or person name)") name entity
<> "\n"
<> countryStr optName (country =<< entity)
serverPublicInfo :: Ini -> Maybe ServerPublicInfo
serverPublicInfo ini = serverInfo <$!> infoValue "source_code"
@@ -441,15 +477,14 @@ serverPublicInfo ini = serverInfo <$!> infoValue "source_code"
website = infoValue "website",
adminContacts = iniContacts "admin_simplex" "admin_email" "admin_pgp" "admin_pgp_fingerprint",
complaintsContacts = iniContacts "complaints_simplex" "complaints_email" "complaints_pgp" "complaints_pgp_fingerprint",
hosting = iniEntity "hosting" "hosting_country"
hosting = iniEntity "hosting" "hosting_country",
hostingType = either error id <$!> strDecodeIni "INFORMATION" "hosting_type" ini
}
infoValue name = eitherToMaybe $ lookupValue "INFORMATION" name ini
iniEntity nameField countryField =
(\name -> Entity {name, country = countryValue countryField})
<$!> infoValue nameField
countryValue field =
(\cs -> if T.length cs == 2 && T.all (\c -> isAscii c && isAlpha c) cs then T.map toUpper cs else error $ "Use ISO3166 2-letter code for " <> T.unpack field)
<$!> infoValue field
countryValue field = (either error id . validCountryValue (T.unpack field) . T.unpack) <$!> infoValue field
iniContacts simplexField emailField pgpKeyUriField pgpKeyFingerprintField =
let simplex = either error id . parseAll (connReqUriP' Nothing) . encodeUtf8 <$!> eitherToMaybe (lookupValue "INFORMATION" simplexField ini)
email = infoValue emailField
@@ -460,6 +495,14 @@ serverPublicInfo ini = serverInfo <$!> infoValue "source_code"
(Nothing, Nothing, _, Nothing) -> Nothing
(_, _, pkURI, pkFingerprint) -> Just ServerContactAddress {simplex, email, pgp = PGPKey <$> pkURI <*> pkFingerprint}
optDisabled :: Maybe a -> Text
optDisabled p = if isNothing p then "# " else ""
validCountryValue :: String -> String -> Either String Text
validCountryValue field s
| length s == 2 && all (\c -> isAscii c && isAlpha c) s = Right $ T.pack $ map toUpper s
| otherwise = Left $ "Use ISO3166 2-letter code for " <> field
printSourceCode :: Maybe Text -> IO ()
printSourceCode = \case
Just sourceCode -> T.putStrLn $ "Server source code: " <> sourceCode
@@ -480,7 +523,13 @@ data InitOptions = InitOptions
ip :: HostName,
fqdn :: Maybe HostName,
password :: Maybe ServerPassword,
controlPort :: Maybe Int,
socksProxy :: Maybe SocksProxy,
ownDomains :: Maybe (L.NonEmpty TransportHost),
sourceCode :: Maybe Text,
serverInfo :: ServerPublicInfo,
operatorCountry :: Maybe Text,
hostingCountry :: Maybe Text,
webStaticPath :: Maybe FilePath,
disableWeb :: Bool,
scripted :: Bool
@@ -549,11 +598,46 @@ cliCommandP cfgPath logPath iniFile =
<> help "Set password to create new messaging queues"
<> value SPRandom
)
controlPort <-
flag' (Just defaultControlPort) (long "control-port" <> help ("Enable control port on " <> show defaultControlPort))
<|> option strParse (long "control-port" <> help "Enable control port" <> metavar "PORT" <> value Nothing)
socksProxy <-
flag' (Just defaultSocksProxy) (long "socks-proxy" <> help "Outgoing SOCKS proxy on port 9050")
<|>
option
strParse
( long "socks-proxy"
<> metavar "PROXY"
<> help "Outgoing SOCKS proxy to forward messages to onion-only servers"
<> value Nothing
)
ownDomains :: Maybe (L.NonEmpty TransportHost) <-
option
strParse
( long "own-domains"
<> metavar "DOMAINS"
<> help "Own server domain names (comma-separated)"
<> value Nothing
)
sourceCode <-
flag' (Just simplexmqSource) (long "source-code" <> help ("Server source code (default: " <> simplexmqSource <> ")"))
<|> (optional . strOption) (long "source-code" <> metavar "URI" <> help "Server source code")
operator_ <- entityP "operator" "OPERATOR" "Server operator"
hosting_ <- entityP "hosting" "HOSTING" "Hosting provider"
hostingType <-
option
strParse
( long "hosting-type"
<> metavar "HOSTING_TYPE"
<> help "Hosting type: virtual, dedicated, colocation, owned"
<> value Nothing
)
serverCountry <- countryP "server" "SERVER" "Server datacenter"
website <-
(optional . strOption)
( long "source-code"
<> help "Server source code will be communicated to the users"
<> metavar "URI"
( long "operator-website"
<> help "Operator public website"
<> metavar "WEBSITE"
)
webStaticPath <-
(optional . strOption)
@@ -580,10 +664,46 @@ cliCommandP cfgPath logPath iniFile =
ip,
fqdn,
password,
sourceCode,
controlPort,
socksProxy,
ownDomains,
sourceCode = T.pack <$> sourceCode,
serverInfo =
ServerPublicInfo
{ sourceCode = T.pack simplexmqSource,
usageConditions = Nothing,
operator = fst operator_,
website,
adminContacts = Nothing,
complaintsContacts = Nothing,
hosting = fst hosting_,
hostingType,
serverCountry
},
operatorCountry = snd operator_,
hostingCountry = snd hosting_,
webStaticPath,
disableWeb,
scripted
}
parseBasicAuth :: ReadM ServerPassword
parseBasicAuth = eitherReader $ fmap ServerPassword . strDecode . B.pack
entityP :: String -> String -> String -> Parser (Maybe Entity, Maybe Text)
entityP opt' metavar' help' = do
name_ <-
(optional . strOption)
( long opt'
<> metavar (metavar' <> "_NAME")
<> help (help' <> " name")
)
country <- countryP opt' metavar' help'
pure ((\name -> Entity {name, country}) <$> name_, country)
countryP :: String -> String -> String -> Parser (Maybe Text)
countryP opt' metavar' help' =
(optional . option (eitherReader $ validCountryValue opt'))
( long (opt' <> "-country")
<> metavar (metavar' <> "_COUNTRY")
<> help (help' <> " country")
)
strParse :: StrEncoding a => ReadM a
strParse = eitherReader $ parseAll strP . encodeUtf8 . T.pack
tests/CLITests.hs
+2 -2
View File
@@ -88,14 +88,14 @@ smpServerTest storeLog basicAuth = do
lookupValue "TRANSPORT" "port" ini `shouldBe` Right "5223,443"
lookupValue "TRANSPORT" "websockets" ini `shouldBe` Right "off"
lookupValue "AUTH" "new_queues" ini `shouldBe` Right "on"
lookupValue "INACTIVE_CLIENTS" "disconnect" ini `shouldBe` Right "off"
lookupValue "INACTIVE_CLIENTS" "disconnect" ini `shouldBe` Right "on"
doesFileExist (cfgPath <> "/ca.key") `shouldReturn` True
-- start
r <- lines <$> capture_ (withArgs ["start"] $ (100000 `timeout` smpServerCLI cfgPath logPath) `catchAll_` pure (Just ()))
r `shouldContain` ["SMP server v" <> simplexMQVersion]
r `shouldContain` (if storeLog then ["Store log: " <> logPath <> "/smp-server-store.log"] else ["Store log disabled."])
r `shouldContain` ["Serving SMP protocol on port 5223 (TLS)...", "Serving SMP protocol on port 443 (TLS)...", "Serving static site on port 443 (TLS)..."]
r `shouldContain` ["not expiring inactive clients"]
r `shouldContain` ["expiring clients inactive for 21600 seconds every 3600 seconds"]
r `shouldContain` (if basicAuth then ["creating new queues requires password"] else ["creating new queues allowed"])
-- cert
let certPath = cfgPath </> "server.crt"