core: xftp servers option; use local xftp server in tests (#2015)

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

src/Simplex/Chat/Mobile.hs

@@ -130,6 +130,7 @@ mobileChatOpts dbFilePrefix dbKey =
           { dbFilePrefix,
             dbKey,
             smpServers = [],
+            xftpServers = [],
             networkConfig = defaultNetworkConfig,
             logLevel = CLLImportant,
             logConnections = False,

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

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

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 #> "/f @bob ./tests/fixtures/test.pdf"
-    alice <## "use /fc 1 to cancel sending"
+      alice <## "use /fc 1 to cancel sending"
-    bob <# "alice> sends file test.pdf (266.0 KiB / 272376 bytes)"
+      bob <# "alice> sends file test.pdf (266.0 KiB / 272376 bytes)"
-    bob <## "use /fr 1 [<dir>/ | <path>] to receive it"
+      bob <## "use /fr 1 [<dir>/ | <path>] to receive it"
-    bob ##> "/fr 1 ./tests/tmp"
+      bob ##> "/fr 1 ./tests/tmp"
-    bob <## "saving file 1 from alice to ./tests/tmp/test.pdf"
+      bob <## "saving file 1 from alice to ./tests/tmp/test.pdf"
-    -- alice <## "started sending file 1 (test.pdf) to bob" -- TODO "started uploading" ?
+      -- alice <## "started sending file 1 (test.pdf) to bob" -- TODO "started uploading" ?
-    alice <## "completed sending file 1 (test.pdf) to bob"
+      alice <## "completed sending file 1 (test.pdf) to bob"
-    bob <## "started receiving file 1 (test.pdf) from alice"
+      bob <## "started receiving file 1 (test.pdf) from alice"
-    bob <## "completed receiving file 1 (test.pdf) from alice"
+      bob <## "completed receiving file 1 (test.pdf) from alice"
 
-    src <- B.readFile "./tests/fixtures/test.pdf"
+      src <- B.readFile "./tests/fixtures/test.pdf"
-    dest <- B.readFile "./tests/tmp/test.pdf"
+      dest <- B.readFile "./tests/tmp/test.pdf"
-    dest `shouldBe` src
+      dest `shouldBe` src
   where
     cfg = testCfg {xftpFileConfig = Just $ XFTPFileConfig {minFileSize = 0}, tempDir = Just "./tests/tmp"}