xftp: set xftp config (#2059)
This commit is contained in:
parent
47c6daf0cc
commit
2a9c138a23
@ -59,7 +59,7 @@ import Simplex.Chat.Store
|
||||
import Simplex.Chat.Types
|
||||
import Simplex.Chat.Util (diffInMicros, diffInSeconds)
|
||||
import Simplex.FileTransfer.Client.Presets (defaultXFTPServers)
|
||||
import Simplex.FileTransfer.Description (ValidFileDescription)
|
||||
import Simplex.FileTransfer.Description (ValidFileDescription, gb, kb, mb)
|
||||
import Simplex.FileTransfer.Protocol (FileParty (..))
|
||||
import Simplex.Messaging.Agent as Agent
|
||||
import Simplex.Messaging.Agent.Client (AgentStatsKey (..))
|
||||
@ -370,6 +370,9 @@ processChatCommand = \case
|
||||
createDirectoryIfMissing True ff
|
||||
asks filesFolder >>= atomically . (`writeTVar` Just ff)
|
||||
ok_
|
||||
APISetXFTPConfig cfg -> do
|
||||
asks userXFTPFileConfig >>= atomically . (`writeTVar` cfg)
|
||||
ok_
|
||||
SetIncognito onOff -> do
|
||||
asks incognitoMode >>= atomically . (`writeTVar` onOff)
|
||||
ok_
|
||||
@ -4215,6 +4218,8 @@ chatCommandP =
|
||||
"/_resubscribe all" $> ResubscribeAllConnections,
|
||||
"/_temp_folder " *> (SetTempFolder <$> filePath),
|
||||
"/_files_folder " *> (SetFilesFolder <$> filePath),
|
||||
"/_xftp " *> (APISetXFTPConfig <$> ("on " *> (Just <$> jsonP) <|> ("off" $> Nothing))),
|
||||
"/xftp " *> (APISetXFTPConfig <$> ("on " *> (Just <$> xftpCfgP) <|> ("off" $> Nothing))),
|
||||
"/_db export " *> (APIExportArchive <$> jsonP),
|
||||
"/_db import " *> (APIImportArchive <$> jsonP),
|
||||
"/_db delete" $> APIDeleteStorage,
|
||||
@ -4474,6 +4479,17 @@ chatCommandP =
|
||||
logErrors <- " log=" *> onOffP <|> pure False
|
||||
let tcpTimeout = 1000000 * fromMaybe (maybe 5 (const 10) socksProxy) t_
|
||||
pure $ fullNetworkConfig socksProxy tcpTimeout logErrors
|
||||
xftpCfgP = do
|
||||
minFileSize <- "minFileSize=" *> fileSizeP
|
||||
pure $ XFTPFileConfig {minFileSize}
|
||||
-- TODO move to Utils in simplexmq
|
||||
fileSizeP =
|
||||
A.choice
|
||||
[ gb <$> A.decimal <* "gb",
|
||||
mb <$> A.decimal <* "mb",
|
||||
kb <$> A.decimal <* "kb",
|
||||
A.decimal
|
||||
]
|
||||
dbKeyP = nonEmptyKey <$?> strP
|
||||
nonEmptyKey k@(DBEncryptionKey s) = if null s then Left "empty key" else Right k
|
||||
autoAcceptP =
|
||||
|
@ -198,6 +198,7 @@ data ChatCommand
|
||||
| ResubscribeAllConnections
|
||||
| SetTempFolder FilePath
|
||||
| SetFilesFolder FilePath
|
||||
| APISetXFTPConfig (Maybe XFTPFileConfig)
|
||||
| SetIncognito Bool
|
||||
| APIExportArchive ArchiveConfig
|
||||
| APIImportArchive ArchiveConfig
|
||||
|
@ -50,6 +50,7 @@ chatFileTests = do
|
||||
xit "send and receive file to group, fully asynchronous" testAsyncGroupFileTransfer
|
||||
describe "file transfer over XFTP" $ do
|
||||
it "send and receive file" testXFTPFileTransfer
|
||||
it "with changed XFTP config: send and receive file" testXFTPWithChangedConfig
|
||||
it "with relative paths: send and receive file" testXFTPWithRelativePaths
|
||||
it "continue receiving file after restart" testXFTPContinueRcv
|
||||
|
||||
@ -942,6 +943,35 @@ testXFTPFileTransfer =
|
||||
where
|
||||
cfg = testCfg {xftpFileConfig = Just $ XFTPFileConfig {minFileSize = 0}, tempDir = Just "./tests/tmp"}
|
||||
|
||||
testXFTPWithChangedConfig :: HasCallStack => FilePath -> IO ()
|
||||
testXFTPWithChangedConfig =
|
||||
testChatCfg2 cfg aliceProfile bobProfile $ \alice bob -> do
|
||||
withXFTPServer $ do
|
||||
alice #$> ("/_xftp off", id, "ok")
|
||||
alice #$> ("/_xftp on {\"minFileSize\":1024}", id, "ok")
|
||||
|
||||
bob #$> ("/xftp off", id, "ok")
|
||||
bob #$> ("/xftp on minFileSize=1kb", id, "ok")
|
||||
|
||||
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 [<dir>/ | <path>] 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
|
||||
where
|
||||
cfg = testCfg {tempDir = Just "./tests/tmp"}
|
||||
|
||||
testXFTPWithRelativePaths :: HasCallStack => FilePath -> IO ()
|
||||
testXFTPWithRelativePaths =
|
||||
testChatCfg2 cfg aliceProfile bobProfile $ \alice bob -> do
|
||||
|
Loading…
Reference in New Issue
Block a user