dandri/simplexmq
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplexmq.git synced 2026-03-30 14:16:00 +00:00
Code Issues Packages Projects Releases Wiki Activity

Merge branch 'master' into short-links

Browse Source
This commit is contained in:
Evgeny Poberezkin
2025-03-31 16:54:07 +01:00
parent 56bec06856 285fd93c32
commit dd67de4d71
6 changed files with 67 additions and 36 deletions
Download Patch File Download Diff File Expand all files Collapse all files

33
src/Simplex/FileTransfer/Server/Main.hs
View File

@@ -1,3 +1,4 @@
{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
@@ -220,14 +221,19 @@ cliCommandP cfgPath logPath iniFile =
)
where
initP :: Parser InitOptions
initP =
InitOptions
<$> switch
( long "store-log"
<> short 'l'
<> help "Enable store log for persistence"
initP = do
enableStoreLog <-
flag' False
( long "disable-store-log"
<> help "Disable store log for persistence (enabled by default)"
)
<*> option
<|> flag True True
( long "store-log"
<> short 'l'
<> help "Enable store log for persistence (DEPRECATED, enabled by default)"
)
signAlgorithm <-
option
(maybeReader readMaybe)
( long "sign-algorithm"
<> short 'a'
@@ -236,7 +242,8 @@ cliCommandP cfgPath logPath iniFile =
<> showDefault
<> metavar "ALG"
)
<*> strOption
ip <-
strOption
( long "ip"
<> help
"Server IP address, used as Common Name for TLS online certificate if FQDN is not supplied"
@@ -244,22 +251,26 @@ cliCommandP cfgPath logPath iniFile =
<> showDefault
<> metavar "IP"
)
<*> (optional . strOption)
fqdn <-
(optional . strOption)
( long "fqdn"
<> short 'n'
<> help "Server FQDN used as Common Name for TLS online certificate"
<> showDefault
<> metavar "FQDN"
)
<*> strOption
filesPath <-
strOption
( long "path"
<> short 'p'
<> help "Path to the directory to store files"
<> metavar "PATH"
)
<*> strOption
fileSizeQuota <-
strOption
( long "quota"
<> short 'q'
<> help "File storage quota (e.g. 100gb)"
<> metavar "QUOTA"
)
pure InitOptions {enableStoreLog, signAlgorithm, ip, fqdn, filesPath, fileSizeQuota}

27
src/Simplex/Messaging/Notifications/Server/Main.hs
View File

@@ -1,3 +1,4 @@
{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
@@ -222,14 +223,19 @@ cliCommandP cfgPath logPath iniFile =
)
where
initP :: Parser InitOptions
initP =
InitOptions
<$> switch
( long "store-log"
<> short 'l'
<> help "Enable store log for persistence"
initP = do
enableStoreLog <-
flag' False
( long "disable-store-log"
<> help "Disable store log for persistence (enabled by default)"
)
<*> option
<|> flag True True
( long "store-log"
<> short 'l'
<> help "Enable store log for persistence (DEPRECATED, enabled by default)"
)
signAlgorithm <-
option
(maybeReader readMaybe)
( long "sign-algorithm"
<> short 'a'
@@ -238,7 +244,8 @@ cliCommandP cfgPath logPath iniFile =
<> showDefault
<> metavar "ALG"
)
<*> strOption
ip <-
strOption
( long "ip"
<> help
"Server IP address, used as Common Name for TLS online certificate if FQDN is not supplied"
@@ -246,10 +253,12 @@ cliCommandP cfgPath logPath iniFile =
<> showDefault
<> metavar "IP"
)
<*> (optional . strOption)
fqdn <-
(optional . strOption)
( long "fqdn"
<> short 'n'
<> help "Server FQDN used as Common Name for TLS online certificate"
<> showDefault
<> metavar "FQDN"
)
pure InitOptions {enableStoreLog, signAlgorithm, ip, fqdn}

13
src/Simplex/Messaging/Server/CLI.hs
View File

@@ -302,10 +302,15 @@ printServerConfig transports logFile = do
printServerTransports transports
printServerTransports :: [(ServiceName, ATransport, AddHTTP)] -> IO ()
printServerTransports = mapM_ $ \(p, ATransport t, addHTTP) -> do
let descr = p <> " (" <> transportName t <> ")..."
putStrLn $ "Serving SMP protocol on port " <> descr
when addHTTP $ putStrLn $ "Serving static site on port " <> descr
printServerTransports ts = do
forM_ ts $ \(p, ATransport t, addHTTP) -> do
let descr = p <> " (" <> transportName t <> ")..."
putStrLn $ "Serving SMP protocol on port " <> descr
when addHTTP $ putStrLn $ "Serving static site on port " <> descr
unless (any (\(p, _, _) -> p == "443") ts) $
putStrLn
"\nWARNING: the clients will use port 443 by default soon.\n\
\Set `port` in smp-server.ini section [TRANSPORT] to `5223,443`\n"
printSMPServerConfig :: [(ServiceName, ATransport, AddHTTP)] -> AServerStoreCfg -> IO ()
printSMPServerConfig transports (ASSCfg _ _ cfg) = case cfg of

8
src/Simplex/Messaging/Server/Env/STM.hs
View File

@@ -384,8 +384,10 @@ newEnv config@ServerConfig {smpCredentials, httpCredentials, serverStoreCfg, smp
getCredentials protocol creds = do
files <- missingCreds
unless (null files) $ do
putStrLn $ "Error: no " <> protocol <> " credentials: " <> intercalate ", " files
when (protocol == "HTTPS") $ putStrLn letsEncrypt
putStrLn $ "----------\nError: no " <> protocol <> " credentials: " <> intercalate ", " files
when (protocol == "HTTPS") $ do
putStrLn "Server should serve static pages to show connection links in the browser."
putStrLn letsEncrypt
exitFailure
loadServerCredential creds
where
@@ -400,7 +402,7 @@ newEnv config@ServerConfig {smpCredentials, httpCredentials, serverStoreCfg, smp
_ -> do
putStrLn $ "Error: unsupported HTTPS credentials, required 4096-bit RSA\n" <> letsEncrypt
exitFailure
letsEncrypt = "Use Let's Encrypt to generate: certbot certonly --standalone -d yourdomainname --key-type rsa --rsa-key-size 4096"
letsEncrypt = "Use Let's Encrypt to generate: certbot certonly --standalone -d yourdomainname --key-type rsa --rsa-key-size 4096\n----------"
serverInfo =
ServerInformation
{ information,

16
src/Simplex/Messaging/Server/Main.hs
View File

@@ -281,11 +281,11 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
enableStoreLog <- onOffPrompt "Enable store log to restore queues and messages on server restart" True
logStats <- onOffPrompt "Enable logging daily statistics" False
putStrLn "Require a password to create new messaging queues?"
password <- withPrompt "'r' for random (default), 'n' - no password, or enter password: " serverPassword
password <- withPrompt "'r' for random (default), 'n' - no password (recommended for public servers), or enter password: " serverPassword
let host = fromMaybe ip fqdn
host' <- withPrompt ("Enter server FQDN or IP address for certificate (" <> host <> "): ") getLine
sourceCode' <- withPrompt ("Enter server source code URI (" <> maybe simplexmqSource T.unpack src' <> "): ") getServerSourceCode
staticPath' <- withPrompt ("Enter path to store generated static site with server information (" <> fromMaybe defaultStaticPath sp' <> "): ") getLine
staticPath' <- withPrompt ("Enter path to store generated server pages to show connection links (" <> fromMaybe defaultStaticPath sp' <> "): ") getLine
initialize
opts
{ enableStoreLog,
@@ -659,11 +659,15 @@ cliCommandP cfgPath logPath iniFile =
initP :: Parser InitOptions
initP = do
enableStoreLog <-
switch
( long "store-log"
<> short 'l'
<> help "Enable store log for persistence"
flag' False
( long "disable-store-log"
<> help "Disable store log for persistence (enabled by default)"
)
<|> flag True True
( long "store-log"
<> short 'l'
<> help "Enable store log for persistence (DEPRECATED, enabled by default)"
)
dbOptions <- dbOptsP
logStats <-
switch

6
tests/CLITests.hs
View File

@@ -80,7 +80,7 @@ cliTests = do
smpServerTest :: Bool -> Bool -> IO ()
smpServerTest storeLog basicAuth = do
-- init
capture_ (withArgs (["init", "-y"] <> ["-l" | storeLog] <> ["--no-password" | not basicAuth]) $ smpServerCLI cfgPath logPath)
capture_ (withArgs (["init", "-y"] <> ["--disable-store-log" | not storeLog] <> ["--no-password" | not basicAuth]) $ smpServerCLI cfgPath logPath)
>>= (`shouldSatisfy` (("Server initialized, please provide additional server information in " <> cfgPath <> "/smp-server.ini") `isPrefixOf`))
Right ini <- readIniFile $ cfgPath <> "/smp-server.ini"
lookupValue "STORE_LOG" "enable" ini `shouldBe` Right (if storeLog then "on" else "off")
@@ -184,7 +184,7 @@ smpServerTestStatic = do
ntfServerTest :: Bool -> IO ()
ntfServerTest storeLog = do
capture_ (withArgs (["init"] <> ["-l" | storeLog]) $ ntfServerCLI ntfCfgPath ntfLogPath)
capture_ (withArgs (["init"] <> ["--disable-store-log" | not storeLog]) $ ntfServerCLI ntfCfgPath ntfLogPath)
>>= (`shouldSatisfy` (("Server initialized, you can modify configuration in " <> ntfCfgPath <> "/ntf-server.ini") `isPrefixOf`))
Right ini <- readIniFile $ ntfCfgPath <> "/ntf-server.ini"
lookupValue "STORE_LOG" "enable" ini `shouldBe` Right (if storeLog then "on" else "off")
@@ -202,7 +202,7 @@ ntfServerTest storeLog = do
xftpServerTest :: Bool -> IO ()
xftpServerTest storeLog = do
capture_ (withArgs (["init", "-p", "tests/tmp", "-q", "10gb"] <> ["-l" | storeLog]) $ xftpServerCLI fileCfgPath fileLogPath)
capture_ (withArgs (["init", "-p", "tests/tmp", "-q", "10gb"] <> ["--disable-store-log" | not storeLog]) $ xftpServerCLI fileCfgPath fileLogPath)
>>= (`shouldSatisfy` (("Server initialized, you can modify configuration in " <> fileCfgPath <> "/file-server.ini") `isPrefixOf`))
Right ini <- readIniFile $ fileCfgPath <> "/file-server.ini"
lookupValue "STORE_LOG" "enable" ini `shouldBe` Right (if storeLog then "on" else "off")