From 97d45fb2a645236bffc4dfc5b9c7e06e8358393a Mon Sep 17 00:00:00 2001 From: Evgeny Date: Sun, 6 Oct 2024 12:34:44 +0100 Subject: [PATCH] smp server: pass server information via CLI during server initialization (#1356) * smp server: pass server information via CLI during server initialization * more info * enable client expiration by default, disable port 8000 * update --- apps/smp-server/static/index.html | 6 + apps/smp-server/web/Static.hs | 4 +- src/Simplex/FileTransfer/Server/Env.hs | 2 +- src/Simplex/Messaging/Server/Information.hs | 50 +++++ src/Simplex/Messaging/Server/Main.hs | 220 +++++++++++++++----- tests/CLITests.hs | 4 +- 6 files changed, 232 insertions(+), 54 deletions(-) diff --git a/apps/smp-server/static/index.html b/apps/smp-server/static/index.html index de7ac9e46..68ac6d906 100644 --- a/apps/smp-server/static/index.html +++ b/apps/smp-server/static/index.html @@ -295,6 +295,12 @@ ${hostingEntity} (${hostingCountry}) + + + Hosting type: + ${hostingType} + + Server country: diff --git a/apps/smp-server/web/Static.hs b/apps/smp-server/web/Static.hs index 510034a4a..342b4ae33 100644 --- a/apps/smp-server/web/Static.hs +++ b/apps/smp-server/web/Static.hs @@ -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 diff --git a/src/Simplex/FileTransfer/Server/Env.hs b/src/Simplex/FileTransfer/Server/Env.hs index c967d834c..a9b6c9a79 100644 --- a/src/Simplex/FileTransfer/Server/Env.hs +++ b/src/Simplex/FileTransfer/Server/Env.hs @@ -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 } diff --git a/src/Simplex/Messaging/Server/Information.hs b/src/Simplex/Messaging/Server/Information.hs index 01052541d..422dab224 100644 --- a/src/Simplex/Messaging/Server/Information.hs +++ b/src/Simplex/Messaging/Server/Information.hs @@ -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) diff --git a/src/Simplex/Messaging/Server/Main.hs b/src/Simplex/Messaging/Server/Main.hs index ca4a5ed60..33e275862 100644 --- a/src/Simplex/Messaging/Server/Main.hs +++ b/src/Simplex/Messaging/Server/Main.hs @@ -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 "" 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 diff --git a/tests/CLITests.hs b/tests/CLITests.hs index e8417fc8b..01b68653d 100644 --- a/tests/CLITests.hs +++ b/tests/CLITests.hs @@ -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"