From 34a3387830e5c7569013e47fc315e89cd9ed30f4 Mon Sep 17 00:00:00 2001 From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com> Date: Thu, 16 Mar 2023 14:12:19 +0400 Subject: [PATCH] core: xftp servers option; use local xftp server in tests (#2015) --- src/Simplex/Chat.hs | 5 +++-- src/Simplex/Chat/Mobile.hs | 1 + src/Simplex/Chat/Options.hs | 18 ++++++++++++++++- tests/ChatClient.hs | 40 +++++++++++++++++++++++++++++++++++++ tests/ChatTests/Files.hs | 29 ++++++++++++++------------- 5 files changed, 76 insertions(+), 17 deletions(-) diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index ff05f4fed..51b0c5278 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -146,7 +146,7 @@ createChatDatabase filePrefix key yesToMigrations = do pure ChatDatabase {chatStore, agentStore} newChatController :: ChatDatabase -> Maybe User -> ChatConfig -> ChatOpts -> Maybe (Notification -> IO ()) -> IO ChatController -newChatController ChatDatabase {chatStore, agentStore} user cfg@ChatConfig {agentConfig = aCfg, defaultServers, inlineFiles, tempDir} ChatOpts {coreOptions = CoreChatOpts {smpServers, networkConfig, logLevel, logConnections, logServerHosts, logFile, tbqSize}, optFilesFolder, allowInstantFiles} sendToast = do +newChatController ChatDatabase {chatStore, agentStore} user cfg@ChatConfig {agentConfig = aCfg, defaultServers, inlineFiles, tempDir} ChatOpts {coreOptions = CoreChatOpts {smpServers, xftpServers, networkConfig, logLevel, logConnections, logServerHosts, logFile, tbqSize}, optFilesFolder, allowInstantFiles} sendToast = do let inlineFiles' = if allowInstantFiles then inlineFiles else inlineFiles {sendChunks = 0, receiveInstant = False} config = cfg {logLevel, tbqSize, subscriptionEvents = logConnections, hostEvents = logServerHosts, defaultServers = configServers, inlineFiles = inlineFiles'} sendNotification = fromMaybe (const $ pure ()) sendToast @@ -178,7 +178,8 @@ newChatController ChatDatabase {chatStore, agentStore} user cfg@ChatConfig {agen configServers :: DefaultAgentServers configServers = let smp' = fromMaybe (smp (defaultServers :: DefaultAgentServers)) (nonEmpty smpServers) - in defaultServers {smp = smp', netCfg = networkConfig} + xftp' = fromMaybe (xftp (defaultServers :: DefaultAgentServers)) (nonEmpty xftpServers) + in defaultServers {smp = smp', xftp = xftp', netCfg = networkConfig} agentServers :: ChatConfig -> IO InitialAgentServers agentServers config@ChatConfig {defaultServers = defServers@DefaultAgentServers {ntf, netCfg}} = do users <- withTransaction chatStore getUsers diff --git a/src/Simplex/Chat/Mobile.hs b/src/Simplex/Chat/Mobile.hs index 172a0c179..d40df7cfe 100644 --- a/src/Simplex/Chat/Mobile.hs +++ b/src/Simplex/Chat/Mobile.hs @@ -130,6 +130,7 @@ mobileChatOpts dbFilePrefix dbKey = { dbFilePrefix, dbKey, smpServers = [], + xftpServers = [], networkConfig = defaultNetworkConfig, logLevel = CLLImportant, logConnections = False, diff --git a/src/Simplex/Chat/Options.hs b/src/Simplex/Chat/Options.hs index 8631e7a27..20053a806 100644 --- a/src/Simplex/Chat/Options.hs +++ b/src/Simplex/Chat/Options.hs @@ -25,7 +25,7 @@ import Simplex.Chat.Controller (ChatLogLevel (..), updateStr, versionNumber, ver import Simplex.Messaging.Client (NetworkConfig (..), defaultNetworkConfig) import Simplex.Messaging.Encoding.String import Simplex.Messaging.Parsers (parseAll) -import Simplex.Messaging.Protocol (SMPServerWithAuth) +import Simplex.Messaging.Protocol (SMPServerWithAuth, XFTPServerWithAuth) import Simplex.Messaging.Transport.Client (SocksProxy, defaultSocksProxy) import System.FilePath (combine) @@ -43,6 +43,7 @@ data CoreChatOpts = CoreChatOpts { dbFilePrefix :: String, dbKey :: String, smpServers :: [SMPServerWithAuth], + xftpServers :: [XFTPServerWithAuth], networkConfig :: NetworkConfig, logLevel :: ChatLogLevel, logConnections :: Bool, @@ -88,6 +89,14 @@ coreChatOptsP appDir defaultDbFileName = do <> help "Semicolon-separated list of SMP server(s) to use (each server can have more than one hostname)" <> value [] ) + xftpServers <- + option + parseXFTPServers + ( long "xftp-server" + <> metavar "SERVER" + <> help "Semicolon-separated list of XFTP server(s) to use (each server can have more than one hostname)" + <> value [] + ) socksProxy <- flag' (Just defaultSocksProxy) (short 'x' <> help "Use local SOCKS5 proxy at :9050") <|> option @@ -156,6 +165,7 @@ coreChatOptsP appDir defaultDbFileName = do { dbFilePrefix, dbKey, smpServers, + xftpServers, networkConfig = fullNetworkConfig socksProxy (useTcpTimeout socksProxy t) (logTLSErrors || logLevel == CLLDebug), logLevel, logConnections = logConnections || logLevel <= CLLInfo, @@ -236,6 +246,9 @@ fullNetworkConfig socksProxy tcpTimeout logTLSErrors = parseSMPServers :: ReadM [SMPServerWithAuth] parseSMPServers = eitherReader $ parseAll smpServersP . B.pack +parseXFTPServers :: ReadM [XFTPServerWithAuth] +parseXFTPServers = eitherReader $ parseAll xftpServersP . B.pack + parseSocksProxy :: ReadM (Maybe SocksProxy) parseSocksProxy = eitherReader $ parseAll strP . B.pack @@ -248,6 +261,9 @@ serverPortP = Just . B.unpack <$> A.takeWhile A.isDigit smpServersP :: A.Parser [SMPServerWithAuth] smpServersP = strP `A.sepBy1` A.char ';' +xftpServersP :: A.Parser [XFTPServerWithAuth] +xftpServersP = strP `A.sepBy1` A.char ';' + parseLogLevel :: ReadM ChatLogLevel parseLogLevel = eitherReader $ \case "debug" -> Right CLLDebug diff --git a/tests/ChatClient.hs b/tests/ChatClient.hs index b914dd2e3..3d782603a 100644 --- a/tests/ChatClient.hs +++ b/tests/ChatClient.hs @@ -26,6 +26,9 @@ import Simplex.Chat.Store import Simplex.Chat.Terminal import Simplex.Chat.Terminal.Output (newChatTerminal) import Simplex.Chat.Types (AgentUserId (..), Profile, User (..)) +import Simplex.FileTransfer.Description (kb, mb) +import Simplex.FileTransfer.Server (runXFTPServerBlocking) +import Simplex.FileTransfer.Server.Env (XFTPServerConfig (..), defaultFileExpiration) import Simplex.Messaging.Agent.Env.SQLite import Simplex.Messaging.Agent.RetryInterval import Simplex.Messaging.Client (ProtocolClientConfig (..), defaultNetworkConfig) @@ -55,6 +58,7 @@ testOpts = dbKey = "", -- dbKey = "this is a pass-phrase to encrypt the database", smpServers = ["smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=:server_password@localhost:7001"], + xftpServers = ["xftp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:7002"], networkConfig = defaultNetworkConfig, logLevel = CLLImportant, logConnections = False, @@ -305,6 +309,42 @@ serverCfg = withSmpServer :: IO () -> IO () withSmpServer = serverBracket (`runSMPServerBlocking` serverCfg) +xftpTestPort :: ServiceName +xftpTestPort = "7002" + +xftpServerFiles :: FilePath +xftpServerFiles = "tests/tmp/xftp-server-files" + +xftpServerConfig :: XFTPServerConfig +xftpServerConfig = + XFTPServerConfig + { xftpPort = xftpTestPort, + fileIdSize = 16, + storeLogFile = Nothing, + filesPath = xftpServerFiles, + fileSizeQuota = Nothing, + allowedChunkSizes = [kb 128, kb 256, mb 1, mb 4], + allowNewFiles = True, + newFileBasicAuth = Nothing, + fileExpiration = Just defaultFileExpiration, + caCertificateFile = "tests/fixtures/tls/ca.crt", + privateKeyFile = "tests/fixtures/tls/server.key", + certificateFile = "tests/fixtures/tls/server.crt", + logStatsInterval = Nothing, + logStatsStartTime = 0, + serverStatsLogFile = "tests/tmp/xftp-server-stats.daily.log", + serverStatsBackupFile = Nothing, + logTLSErrors = True + } + +withXFTPServer :: IO () -> IO () +withXFTPServer = + serverBracket + ( \started -> do + createDirectoryIfMissing False xftpServerFiles + runXFTPServerBlocking started xftpServerConfig + ) + serverBracket :: (TMVar Bool -> IO ()) -> IO () -> IO () serverBracket server f = do started <- newEmptyTMVarIO diff --git a/tests/ChatTests/Files.hs b/tests/ChatTests/Files.hs index 16335d628..396cd4839 100644 --- a/tests/ChatTests/Files.hs +++ b/tests/ChatTests/Files.hs @@ -920,22 +920,23 @@ testAsyncGroupFileTransfer tmp = do testXFTPFileTransfer :: HasCallStack => FilePath -> IO () testXFTPFileTransfer = testChatCfg2 cfg aliceProfile bobProfile $ \alice bob -> do - connectUsers alice bob + withXFTPServer $ do + connectUsers alice bob - alice #> "/f @bob ./tests/fixtures/test.pdf" - alice <## "use /fc 1 to cancel sending" - bob <# "alice> sends file test.pdf (266.0 KiB / 272376 bytes)" - bob <## "use /fr 1 [/ | ] to receive it" - bob ##> "/fr 1 ./tests/tmp" - bob <## "saving file 1 from alice to ./tests/tmp/test.pdf" - -- alice <## "started sending file 1 (test.pdf) to bob" -- TODO "started uploading" ? - alice <## "completed sending file 1 (test.pdf) to bob" - bob <## "started receiving file 1 (test.pdf) from alice" - bob <## "completed receiving file 1 (test.pdf) from alice" + alice #> "/f @bob ./tests/fixtures/test.pdf" + alice <## "use /fc 1 to cancel sending" + bob <# "alice> sends file test.pdf (266.0 KiB / 272376 bytes)" + bob <## "use /fr 1 [/ | ] to receive it" + bob ##> "/fr 1 ./tests/tmp" + bob <## "saving file 1 from alice to ./tests/tmp/test.pdf" + -- alice <## "started sending file 1 (test.pdf) to bob" -- TODO "started uploading" ? + alice <## "completed sending file 1 (test.pdf) to bob" + bob <## "started receiving file 1 (test.pdf) from alice" + bob <## "completed receiving file 1 (test.pdf) from alice" - src <- B.readFile "./tests/fixtures/test.pdf" - dest <- B.readFile "./tests/tmp/test.pdf" - dest `shouldBe` src + src <- B.readFile "./tests/fixtures/test.pdf" + dest <- B.readFile "./tests/tmp/test.pdf" + dest `shouldBe` src where cfg = testCfg {xftpFileConfig = Just $ XFTPFileConfig {minFileSize = 0}, tempDir = Just "./tests/tmp"}