From 12200a74ffb2d5494efc8ee8dbd9251e7b90038d Mon Sep 17 00:00:00 2001 From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com> Date: Thu, 16 Mar 2023 10:49:57 +0400 Subject: [PATCH] core: XFTP file transfer test (#2009) --- cabal.project | 2 +- scripts/nix/sha256map.nix | 2 +- src/Simplex/Chat.hs | 57 ++++++++++++++++++++-------------- src/Simplex/Chat/Controller.hs | 1 + src/Simplex/Chat/Store.hs | 34 +++++++++----------- src/Simplex/Chat/Types.hs | 2 +- stack.yaml | 2 +- tests/ChatTests/Files.hs | 26 +++++++++++++++- 8 files changed, 78 insertions(+), 48 deletions(-) diff --git a/cabal.project b/cabal.project index 67dce5538..e66052985 100644 --- a/cabal.project +++ b/cabal.project @@ -7,7 +7,7 @@ constraints: zip +disable-bzip2 +disable-zstd source-repository-package type: git location: https://github.com/simplex-chat/simplexmq.git - tag: db120b6d2eee04836a132f0bfbca9491cacf3dc8 + tag: a0eb53b891b1f4f765f440020654fbae45bf8b00 source-repository-package type: git diff --git a/scripts/nix/sha256map.nix b/scripts/nix/sha256map.nix index 1f4922a61..a057c9a51 100644 --- a/scripts/nix/sha256map.nix +++ b/scripts/nix/sha256map.nix @@ -1,5 +1,5 @@ { - "https://github.com/simplex-chat/simplexmq.git"."db120b6d2eee04836a132f0bfbca9491cacf3dc8" = "0md0i4vl84mdmkgwjrmlkipqm9k1rqbld0ld1xxss3z1xdb7fdrj"; + "https://github.com/simplex-chat/simplexmq.git"."a0eb53b891b1f4f765f440020654fbae45bf8b00" = "0nbqj26yzdw3h5p4zdw4l65ybi60f571gpl3244fmmv7ll8v8ys8"; "https://github.com/simplex-chat/hs-socks.git"."a30cc7a79a08d8108316094f8f2f82a0c5e1ac51" = "0yasvnr7g91k76mjkamvzab2kvlb1g5pspjyjn2fr6v83swjhj38"; "https://github.com/kazu-yamamoto/http2.git"."78e18f52295a7f89e828539a03fbcb24931461a3" = "05q165anvv0qrcxqbvq1dlvw0l8gmsa9kl6sazk1mfhz2g0yimdk"; "https://github.com/simplex-chat/direct-sqlcipher.git"."34309410eb2069b029b8fc1872deb1e0db123294" = "0kwkmhyfsn2lixdlgl15smgr1h5gjk7fky6abzh8rng2h5ymnffd"; diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index 44fff46ab..ff05f4fed 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -15,7 +15,7 @@ module Simplex.Chat where import Control.Applicative (optional, (<|>)) -import Control.Concurrent.STM (retry, stateTVar) +import Control.Concurrent.STM (retry) import Control.Logger.Simple import Control.Monad.Except import Control.Monad.IO.Unlift @@ -111,6 +111,7 @@ defaultChatConfig = xftpDescrPartSize = 14000, inlineFiles = defaultInlineFilesConfig, xftpFileConfig = Nothing, + tempDir = Nothing, logLevel = CLLImportant, subscriptionEvents = False, hostEvents = False, @@ -145,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} 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, 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 @@ -171,7 +172,7 @@ newChatController ChatDatabase {chatStore, agentStore} user cfg@ChatConfig {agen timedItemThreads <- atomically TM.empty showLiveItems <- newTVarIO False userXFTPFileConfig <- newTVarIO $ xftpFileConfig cfg - tempDirectory <- newTVarIO Nothing + tempDirectory <- newTVarIO tempDir pure ChatController {activeTo, firstTime, currentUser, smpAgent, agentAsync, chatStore, chatStoreChanged, idsDrg, inputQ, outputQ, notifyQ, chatLock, sndFiles, rcvFiles, currentCalls, config, sendNotification, incognitoMode, filesFolder, expireCIThreads, expireCIFlags, cleanupManagerAsync, timedItemThreads, showLiveItems, userXFTPFileConfig, tempDirectory, logFilePath = logFile} where configServers :: DefaultAgentServers @@ -535,6 +536,7 @@ processChatCommand = \case fInv = xftpFileInvitation fileName fileSize fileDescr tmp <- readTVarIO =<< asks tempDirectory aFileId <- withAgent $ \a -> xftpSendFile a (aUserId user) file n tmp + -- TODO CRSndFileStart event for XFTP ft@FileTransferMeta {fileId} <- withStore' $ \db -> createSndFileTransferXFTP db user contactOrGroup file fInv $ AgentSndFileId aFileId let ciFile = CIFile {fileId, fileName, fileSize, filePath = Just file, fileStatus = CIFSSndStored} case contactOrGroup of @@ -1766,11 +1768,11 @@ acceptFileReceive user@User {userId} RcvFileTransfer {fileId, rcvFileDescription -- direct file protocol (Nothing, Just connReq) -> do connIds <- joinAgentConnectionAsync user True connReq . directMessage $ XFileAcpt fName - filePath <- getRcvFilePath fileId filePath_ fName + filePath <- getRcvFilePath fileId filePath_ fName True withStore $ \db -> acceptRcvFileTransfer db user fileId connIds ConnJoined filePath -- XFTP (Just rfd, _) -> do - filePath <- getRcvFilePath fileId filePath_ fName + filePath <- getRcvFilePath fileId filePath_ fName False ci <- withStore $ \db -> xftpAcceptRcvFT db user fileId filePath receiveViaCompleteFD user fileId filePath rfd pure ci @@ -1791,7 +1793,7 @@ acceptFileReceive user@User {userId} RcvFileTransfer {fileId, rcvFileDescription where acceptFile :: CommandFunction -> (ChatMsgEvent 'Json -> m ()) -> m AChatItem acceptFile cmdFunction send = do - filePath <- getRcvFilePath fileId filePath_ fName + filePath <- getRcvFilePath fileId filePath_ fName True inline <- receiveInline if | inline -> do @@ -1821,10 +1823,19 @@ receiveViaCompleteFD user fileId filePath RcvFileDescr {fileDescrText, fileDescr rd <- parseRcvFileDescription fileDescrText tmp <- readTVarIO =<< asks tempDirectory aFileId <- withAgent $ \a -> xftpReceiveFile a (aUserId user) rd tmp filePath + startReceivingFile user fileId withStore' $ \db -> updateRcvFileAgentId db fileId (AgentRcvFileId aFileId) -getRcvFilePath :: forall m. ChatMonad m => FileTransferId -> Maybe FilePath -> String -> m FilePath -getRcvFilePath fileId fPath_ fn = case fPath_ of +startReceivingFile :: ChatMonad m => User -> FileTransferId -> m () +startReceivingFile user fileId = do + ci <- withStore $ \db -> do + liftIO $ updateRcvFileStatus db fileId FSConnected + liftIO $ updateCIFileStatus db user fileId $ CIFSRcvTransfer 0 1 + getChatItemByFileId db user fileId + toView $ CRRcvFileStart user ci + +getRcvFilePath :: forall m. ChatMonad m => FileTransferId -> Maybe FilePath -> String -> Bool -> m FilePath +getRcvFilePath fileId fPath_ fn keepHandle = case fPath_ of Nothing -> asks filesFolder >>= readTVarIO >>= \case Nothing -> do @@ -1849,9 +1860,15 @@ getRcvFilePath fileId fPath_ fn = case fPath_ of createEmptyFile fPath = emptyFile fPath `E.catch` (throwChatError . CEFileWrite fPath . (show :: E.SomeException -> String)) emptyFile :: FilePath -> m FilePath emptyFile fPath = do - h <- getFileHandle fileId fPath rcvFiles AppendMode + h <- + if keepHandle + then getFileHandle fileId fPath rcvFiles AppendMode + else getTmpHandle fPath liftIO $ B.hPut h "" >> hFlush h pure fPath + getTmpHandle :: FilePath -> m Handle + getTmpHandle fPath = + liftIO (openFile fPath AppendMode) `E.catch` (throwChatError . CEFileInternal . (show :: E.SomeException -> String)) uniqueCombine :: FilePath -> String -> m FilePath uniqueCombine filePath fileName = tryCombine (0 :: Int) where @@ -2238,7 +2255,7 @@ processAgentMsgRcvFile _corrId aFileId msg = RFDONE -> do ci <- withStore $ \db -> do liftIO $ do - updateRcvFileStatus' db fileId FSComplete + updateRcvFileStatus db fileId FSComplete updateCIFileStatus db user fileId CIFSRcvComplete getChatItemByFileId db user fileId -- ack to agent @@ -2673,7 +2690,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do case chatMsgEvent of XOk -> allowAgentConnectionAsync user conn confId XOk -- [async agent commands] no continuation needed, but command should be asynchronous for stability _ -> pure () - CON -> startReceivingFile ft + CON -> startReceivingFile user fileId MSG meta _ msgBody -> do parseFileChunk msgBody >>= receiveFileChunk ft (Just conn) meta OK -> @@ -2688,14 +2705,6 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do -- TODO add debugging output _ -> pure () - startReceivingFile :: RcvFileTransfer -> m () - startReceivingFile ft@RcvFileTransfer {fileId} = do - ci <- withStore $ \db -> do - liftIO $ updateRcvFileStatus db ft FSConnected - liftIO $ updateCIFileStatus db user fileId $ CIFSRcvTransfer 0 1 - getChatItemByFileId db user fileId - toView $ CRRcvFileStart user ci - receiveFileChunk :: RcvFileTransfer -> Maybe Connection -> MsgMeta -> FileChunk -> m () receiveFileChunk ft@RcvFileTransfer {fileId, chunkSize, cancelled} conn_ meta@MsgMeta {recipient = (msgId, _), integrity} = \case FileChunkCancel -> @@ -2720,7 +2729,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do appendFileChunk ft chunkNo chunk ci <- withStore $ \db -> do liftIO $ do - updateRcvFileStatus db ft FSComplete + updateRcvFileStatus db fileId FSComplete updateCIFileStatus db user fileId CIFSRcvComplete deleteRcvFileChunks db ft getChatItemByFileId db user fileId @@ -2945,7 +2954,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do ft@RcvFileTransfer {fileId} <- withStore $ \db -> createRcvFT db fInv inline fileChunkSize (filePath, fileStatus) <- case inline of Just IFMSent -> do - fPath <- getRcvFilePath fileId Nothing fileName + fPath <- getRcvFilePath fileId Nothing fileName True withStore' $ \db -> startRcvInlineFT db user ft fPath inline pure (Just fPath, CIFSRcvAccepted) _ -> pure (Nothing, CIFSRcvInvitation) @@ -3171,9 +3180,9 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do receiveInlineChunk RcvFileTransfer {fileId, fileStatus = RFSNew} FileChunk {chunkNo} _ | chunkNo == 1 = throwChatError $ CEInlineFileProhibited fileId | otherwise = pure () - receiveInlineChunk ft chunk meta = do + receiveInlineChunk ft@RcvFileTransfer {fileId} chunk meta = do case chunk of - FileChunk {chunkNo} -> when (chunkNo == 1) $ startReceivingFile ft + FileChunk {chunkNo} -> when (chunkNo == 1) $ startReceivingFile user fileId _ -> pure () receiveFileChunk ft Nothing meta chunk @@ -3714,7 +3723,7 @@ cancelRcvFileTransfer user ft@RcvFileTransfer {fileId, rcvFileInline} = closeFileHandle fileId rcvFiles withStore' $ \db -> do updateFileCancelled db user fileId CIFSRcvCancelled - updateRcvFileStatus db ft FSCancelled + updateRcvFileStatus db fileId FSCancelled deleteRcvFileChunks db ft pure fileConnId fileConnId = if isNothing rcvFileInline then liveRcvFileTransferConnId ft else Nothing diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index bf381218f..0cb8f8441 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -108,6 +108,7 @@ data ChatConfig = ChatConfig xftpDescrPartSize :: Int, inlineFiles :: InlineFilesConfig, xftpFileConfig :: Maybe XFTPFileConfig, -- Nothing - XFTP is disabled + tempDir :: Maybe FilePath, subscriptionEvents :: Bool, hostEvents :: Bool, logLevel :: ChatLogLevel, diff --git a/src/Simplex/Chat/Store.hs b/src/Simplex/Chat/Store.hs index ea53ef562..7669816dc 100644 --- a/src/Simplex/Chat/Store.hs +++ b/src/Simplex/Chat/Store.hs @@ -185,7 +185,6 @@ module Simplex.Chat.Store startRcvInlineFT, xftpAcceptRcvFT, updateRcvFileStatus, - updateRcvFileStatus', createRcvFileChunk, updatedRcvFileChunkStored, deleteRcvFileChunks, @@ -274,7 +273,6 @@ module Simplex.Chat.Store where import Control.Applicative ((<|>)) -import Control.Concurrent.STM (stateTVar) import Control.Exception (Exception) import qualified Control.Exception as E import Control.Monad.Except @@ -562,7 +560,7 @@ getUserByASndFileId db aSndFileId = getUserByARcvFileId :: DB.Connection -> AgentRcvFileId -> IO (Maybe User) getUserByARcvFileId db aRcvFileId = maybeFirstRow toUser $ - DB.query db (userQuery <> " JOIN rcv_files r USING (file_id) JOIN files f ON f.user_id = u.user_id WHERE r.agent_rcv_file_id = ?") (Only aRcvFileId) + DB.query db (userQuery <> " JOIN files f ON f.user_id = u.user_id JOIN rcv_files r ON r.file_id = f.file_id WHERE r.agent_rcv_file_id = ?") (Only aRcvFileId) getUserByContactId :: DB.Connection -> ContactId -> ExceptT StoreError IO User getUserByContactId db contactId = @@ -2751,16 +2749,17 @@ createSndFileTransferXFTP db User {userId} contactOrGroup filePath FileInvitatio createSndFTDescrXFTP :: DB.Connection -> User -> Maybe GroupMember -> Connection -> FileTransferMeta -> FileDescr -> IO () createSndFTDescrXFTP db User {userId} m Connection {connId} FileTransferMeta {fileId} FileDescr {fileDescrText, fileDescrPartNo, fileDescrComplete} = do + currentTs <- getCurrentTime let fileStatus = FSNew DB.execute db - "INSERT INTO xftp_file_descriptions (user_id, file_descr_text, file_descr_part_no, file_descr_complete) VALUES (?,?,?,?)" - (userId, fileDescrText, fileDescrPartNo, fileDescrComplete) + "INSERT INTO xftp_file_descriptions (user_id, file_descr_text, file_descr_part_no, file_descr_complete, created_at, updated_at) VALUES (?,?,?,?,?,?)" + (userId, fileDescrText, fileDescrPartNo, fileDescrComplete, currentTs, currentTs) fileDescrId <- insertedRowId db DB.execute db - "INSERT INTO snd_files (file_id, file_status, file_descr_id, group_member_id, connection_id) VALUES (?,?,?,?,?)" - (fileId, fileStatus, fileDescrId, groupMemberId' <$> m, connId) + "INSERT INTO snd_files (file_id, file_status, file_descr_id, group_member_id, connection_id, created_at, updated_at) VALUES (?,?,?,?,?,?,?)" + (fileId, fileStatus, fileDescrId, groupMemberId' <$> m, connId, currentTs, currentTs) updateSndFTDescrXFTP :: DB.Connection -> User -> SndFileTransfer -> Text -> IO () updateSndFTDescrXFTP db user@User {userId} sft@SndFileTransfer {fileId, fileDescrId} rfdText = do @@ -2937,7 +2936,7 @@ createRcvFileTransfer db userId Contact {contactId, localDisplayName = c} f@File "INSERT INTO files (user_id, contact_id, file_name, file_size, chunk_size, file_inline, ci_file_status, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?)" (userId, contactId, fileName, fileSize, chunkSize, fileInline, CIFSRcvInvitation, currentTs, currentTs) insertedRowId db - rfd <- mapM (createRcvFD_ db userId) fileDescr + rfd <- mapM (createRcvFD_ db userId currentTs) fileDescr let rfdId = (fileDescrId :: RcvFileDescr -> Int64) <$> rfd liftIO $ DB.execute @@ -2955,7 +2954,7 @@ createRcvGroupFileTransfer db userId GroupMember {groupId, groupMemberId, localD "INSERT INTO files (user_id, group_id, file_name, file_size, chunk_size, file_inline, ci_file_status, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?)" (userId, groupId, fileName, fileSize, chunkSize, fileInline, CIFSRcvInvitation, currentTs, currentTs) insertedRowId db - rfd <- mapM (createRcvFD_ db userId) fileDescr + rfd <- mapM (createRcvFD_ db userId currentTs) fileDescr let rfdId = (fileDescrId :: RcvFileDescr -> Int64) <$> rfd liftIO $ DB.execute @@ -2964,14 +2963,14 @@ createRcvGroupFileTransfer db userId GroupMember {groupId, groupMemberId, localD (fileId, FSNew, fileConnReq, fileInline, rcvFileInline, groupMemberId, rfdId, currentTs, currentTs) pure RcvFileTransfer {fileId, fileInvitation = f, fileStatus = RFSNew, rcvFileInline, rcvFileDescription = rfd, senderDisplayName = c, chunkSize, cancelled = False, grpMemberId = Just groupMemberId} -createRcvFD_ :: DB.Connection -> UserId -> FileDescr -> ExceptT StoreError IO RcvFileDescr -createRcvFD_ db userId FileDescr {fileDescrText, fileDescrPartNo, fileDescrComplete} = do +createRcvFD_ :: DB.Connection -> UserId -> UTCTime -> FileDescr -> ExceptT StoreError IO RcvFileDescr +createRcvFD_ db userId currentTs FileDescr {fileDescrText, fileDescrPartNo, fileDescrComplete} = do when (fileDescrPartNo /= 0) $ throwError SERcvFileInvalidDescrPart fileDescrId <- liftIO $ do DB.execute db - "INSERT INTO xftp_file_descriptions (user_id, file_descr_text, file_descr_part_no, file_descr_complete) VALUES (?,?,?,?)" - (userId, fileDescrText, fileDescrPartNo, fileDescrComplete) + "INSERT INTO xftp_file_descriptions (user_id, file_descr_text, file_descr_part_no, file_descr_complete, created_at, updated_at) VALUES (?,?,?,?,?,?)" + (userId, fileDescrText, fileDescrPartNo, fileDescrComplete, currentTs, currentTs) insertedRowId db pure RcvFileDescr {fileDescrId, fileDescrPartNo, fileDescrText, fileDescrComplete} @@ -2980,7 +2979,7 @@ appendRcvFD db userId fileId fd@FileDescr {fileDescrText, fileDescrPartNo, fileD currentTs <- liftIO getCurrentTime liftIO (getRcvFileDescrByFileId_ db fileId) >>= \case Nothing -> do - rfd@RcvFileDescr {fileDescrId} <- createRcvFD_ db userId fd + rfd@RcvFileDescr {fileDescrId} <- createRcvFD_ db userId currentTs fd liftIO $ DB.execute db @@ -3127,11 +3126,8 @@ acceptRcvFT_ db User {userId} fileId filePath rcvFileInline currentTs = do "UPDATE rcv_files SET rcv_file_inline = ?, file_status = ?, updated_at = ? WHERE file_id = ?" (rcvFileInline, FSAccepted, currentTs, fileId) -updateRcvFileStatus :: DB.Connection -> RcvFileTransfer -> FileStatus -> IO () -updateRcvFileStatus db RcvFileTransfer {fileId} = updateRcvFileStatus' db fileId - -updateRcvFileStatus' :: DB.Connection -> FileTransferId -> FileStatus -> IO () -updateRcvFileStatus' db fileId status = do +updateRcvFileStatus :: DB.Connection -> FileTransferId -> FileStatus -> IO () +updateRcvFileStatus db fileId status = do currentTs <- getCurrentTime DB.execute db "UPDATE rcv_files SET file_status = ?, updated_at = ? WHERE file_id = ?" (status, currentTs, fileId) diff --git a/src/Simplex/Chat/Types.hs b/src/Simplex/Chat/Types.hs index 10f3851c3..6c475b24f 100644 --- a/src/Simplex/Chat/Types.hs +++ b/src/Simplex/Chat/Types.hs @@ -1500,7 +1500,7 @@ instance ToJSON FileDescr where toJSON = J.genericToJSON J.defaultOptions instance FromJSON FileDescr where - parseJSON = J.genericParseJSON . taggedObjectJSON $ dropPrefix "FD" + parseJSON = J.genericParseJSON J.defaultOptions xftpFileInvitation :: FilePath -> Integer -> FileDescr -> FileInvitation xftpFileInvitation fileName fileSize fileDescr = diff --git a/stack.yaml b/stack.yaml index 610e54e77..aa8d3d969 100644 --- a/stack.yaml +++ b/stack.yaml @@ -49,7 +49,7 @@ extra-deps: # - simplexmq-1.0.0@sha256:34b2004728ae396e3ae449cd090ba7410781e2b3cefc59259915f4ca5daa9ea8,8561 # - ../simplexmq - github: simplex-chat/simplexmq - commit: db120b6d2eee04836a132f0bfbca9491cacf3dc8 + commit: a0eb53b891b1f4f765f440020654fbae45bf8b00 - github: kazu-yamamoto/http2 commit: 78e18f52295a7f89e828539a03fbcb24931461a3 # - ../direct-sqlcipher diff --git a/tests/ChatTests/Files.hs b/tests/ChatTests/Files.hs index b28f6c0d0..16335d628 100644 --- a/tests/ChatTests/Files.hs +++ b/tests/ChatTests/Files.hs @@ -8,7 +8,7 @@ import ChatTests.Utils import Control.Concurrent (threadDelay) import Control.Concurrent.Async (concurrently_) import qualified Data.ByteString.Char8 as B -import Simplex.Chat.Controller (ChatConfig (..), InlineFilesConfig (..), defaultInlineFilesConfig) +import Simplex.Chat.Controller (ChatConfig (..), InlineFilesConfig (..), XFTPFileConfig (..), defaultInlineFilesConfig) import Simplex.Chat.Options (ChatOpts (..)) import Simplex.Messaging.Util (unlessM) import System.Directory (copyFile, doesFileExist) @@ -48,6 +48,8 @@ chatFileTests = do it "v2" testAsyncFileTransfer it "v1" testAsyncFileTransferV1 xit "send and receive file to group, fully asynchronous" testAsyncGroupFileTransfer + describe "file transfer over XFTP" $ do + it "send and receive file" testXFTPFileTransfer runTestFileTransfer :: HasCallStack => TestCC -> TestCC -> IO () runTestFileTransfer alice bob = do @@ -915,6 +917,28 @@ testAsyncGroupFileTransfer tmp = do dest2 <- B.readFile "./tests/tmp/test_1.jpg" dest2 `shouldBe` src +testXFTPFileTransfer :: HasCallStack => FilePath -> IO () +testXFTPFileTransfer = + testChatCfg2 cfg aliceProfile bobProfile $ \alice bob -> 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" + + 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"} + startFileTransfer :: HasCallStack => TestCC -> TestCC -> IO () startFileTransfer alice bob = startFileTransfer' alice bob "test.jpg" "136.5 KiB / 139737 bytes"