diff --git a/package.yaml b/package.yaml index 3761a3cd8b..4663c0c9f1 100644 --- a/package.yaml +++ b/package.yaml @@ -107,6 +107,7 @@ tests: - deepseq == 1.4.* - hspec == 2.7.* - network == 3.1.* + - silently == 1.2.* - stm == 2.5.* ghc-options: - -threaded diff --git a/simplex-chat.cabal b/simplex-chat.cabal index 32b5219f04..75740cfb51 100644 --- a/simplex-chat.cabal +++ b/simplex-chat.cabal @@ -1,6 +1,6 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.35.0. +-- This file has been generated from package.yaml by hpack version 0.35.1. -- -- see: https://github.com/sol/hpack @@ -389,6 +389,7 @@ test-suite simplex-chat-test , process ==1.6.* , random >=1.1 && <1.3 , record-hasfield ==1.0.* + , silently ==1.2.* , simple-logger ==0.1.* , simplex-chat , simplexmq >=5.0 diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index d23dffe669..2e41f31ea0 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -1401,13 +1401,27 @@ processChatCommand = \case _ -> throwChatError $ CEFileInternal "invalid chat ref for file transfer" ci <- withStore $ \db -> getChatItemByFileId db user fileId pure $ CRSndFileCancelled user ci ftm fts - FTRcv ftr@RcvFileTransfer {cancelled, fileStatus} + FTRcv ftr@RcvFileTransfer {cancelled, fileStatus, xftpRcvFile} | cancelled -> throwChatError $ CEFileCancel fileId "file already cancelled" | rcvFileComplete fileStatus -> throwChatError $ CEFileCancel fileId "file transfer is complete" - | otherwise -> do - cancelRcvFileTransfer user ftr >>= mapM_ (deleteAgentConnectionAsync user) - ci <- withStore $ \db -> getChatItemByFileId db user fileId - pure $ CRRcvFileCancelled user ci ftr + | otherwise -> case xftpRcvFile of + Nothing -> do + cancelRcvFileTransfer user ftr >>= mapM_ (deleteAgentConnectionAsync user) + ci <- withStore $ \db -> getChatItemByFileId db user fileId + pure $ CRRcvFileCancelled user ci ftr + Just XFTPRcvFile {agentRcvFileId} -> do + forM_ (liveRcvFileTransferPath ftr) $ \filePath -> do + fsFilePath <- toFSFilePath filePath + removeFile fsFilePath `E.catch` \(_ :: E.SomeException) -> pure () + forM_ agentRcvFileId $ \(AgentRcvFileId aFileId) -> + withAgent $ \a -> xftpDeleteRcvFile a (aUserId user) aFileId + ci <- withStore $ \db -> do + liftIO $ do + updateCIFileStatus db user fileId CIFSRcvInvitation + updateRcvFileStatus db fileId FSNew + updateRcvFileAgentId db fileId Nothing + getChatItemByFileId db user fileId + pure $ CRRcvFileCancelled user ci ftr FileStatus fileId -> withUser $ \user -> do fileStatus <- withStore $ \db -> getFileTransferProgress db user fileId pure $ CRFileTransferStatus user fileStatus @@ -1808,7 +1822,7 @@ deleteFile' user CIFileInfo {filePath, fileId, fileStatus} sendCancel = do delete :: m () delete = withFilesFolder $ \filesFolder -> forM_ filePath $ \fPath -> do - let fsFilePath = filesFolder <> "/" <> fPath + let fsFilePath = filesFolder fPath removeFile fsFilePath `E.catch` \(_ :: E.SomeException) -> removePathForcibly fsFilePath `E.catch` \(_ :: E.SomeException) -> pure () -- perform an action only if filesFolder is set (i.e. on mobile devices) @@ -1925,7 +1939,7 @@ receiveViaCompleteFD user fileId RcvFileDescr {fileDescrText, fileDescrComplete} rd <- parseRcvFileDescription fileDescrText aFileId <- withAgent $ \a -> xftpReceiveFile a (aUserId user) rd startReceivingFile user fileId - withStore' $ \db -> updateRcvFileAgentId db fileId (AgentRcvFileId aFileId) + withStore' $ \db -> updateRcvFileAgentId db fileId (Just $ AgentRcvFileId aFileId) startReceivingFile :: ChatMonad m => User -> FileTransferId -> m () startReceivingFile user fileId = do diff --git a/src/Simplex/Chat/Store.hs b/src/Simplex/Chat/Store.hs index b7ef583be1..e5efbfc885 100644 --- a/src/Simplex/Chat/Store.hs +++ b/src/Simplex/Chat/Store.hs @@ -3074,7 +3074,7 @@ getRcvFileDescrByFileId_ db fileId = toRcvFileDescr (fileDescrId, fileDescrText, fileDescrPartNo, fileDescrComplete) = RcvFileDescr {fileDescrId, fileDescrText, fileDescrPartNo, fileDescrComplete} -updateRcvFileAgentId :: DB.Connection -> FileTransferId -> AgentRcvFileId -> IO () +updateRcvFileAgentId :: DB.Connection -> FileTransferId -> Maybe AgentRcvFileId -> IO () updateRcvFileAgentId db fileId aFileId = do currentTs <- getCurrentTime DB.execute db "UPDATE rcv_files SET agent_rcv_file_id = ?, updated_at = ? WHERE file_id = ?" (aFileId, currentTs, fileId) diff --git a/tests/ChatTests/Files.hs b/tests/ChatTests/Files.hs index 5887330e69..200daeb292 100644 --- a/tests/ChatTests/Files.hs +++ b/tests/ChatTests/Files.hs @@ -10,8 +10,11 @@ import Control.Concurrent.Async (concurrently_) import qualified Data.ByteString.Char8 as B import Simplex.Chat.Controller (ChatConfig (..), InlineFilesConfig (..), XFTPFileConfig (..), defaultInlineFilesConfig) import Simplex.Chat.Options (ChatOpts (..)) +import Simplex.FileTransfer.Client.Main (xftpClientCLI) import Simplex.Messaging.Util (unlessM) import System.Directory (copyFile, doesFileExist) +import System.Environment (withArgs) +import System.IO.Silently (capture_) import Test.Hspec chatFileTests :: SpecWith FilePath @@ -54,6 +57,7 @@ chatFileTests = do 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 + it "cancel receiving file, repeat receive" testXFTPCancelRcvRepeat runTestFileTransfer :: HasCallStack => TestCC -> TestCC -> IO () runTestFileTransfer alice bob = do @@ -1088,6 +1092,41 @@ testXFTPContinueRcv tmp = do where cfg = testCfg {xftpFileConfig = Just $ XFTPFileConfig {minFileSize = 0}, tempDir = Just "./tests/tmp"} +testXFTPCancelRcvRepeat :: HasCallStack => FilePath -> IO () +testXFTPCancelRcvRepeat = + testChatCfg2 cfg aliceProfile bobProfile $ \alice bob -> do + withXFTPServer $ do + xftpCLI ["rand", "./tests/tmp/testfile", "17mb"] `shouldReturn` ["File created: " <> "./tests/tmp/testfile"] + + connectUsers alice bob + + alice #> "/f @bob ./tests/tmp/testfile" + alice <## "use /fc 1 to cancel sending" + bob <# "alice> sends file testfile (17.0 MiB / 17825792 bytes)" + bob <## "use /fr 1 [/ | ] to receive it" + bob ##> "/fr 1 ./tests/tmp" + bob <## "saving file 1 from alice to ./tests/tmp/testfile_1" + -- alice <## "started sending file 1 (testfile) to bob" -- TODO "started uploading" ? + alice <## "uploaded file 1 (testfile) for bob" + bob <## "started receiving file 1 (testfile) from alice" + + bob ##> "/fc 1" + bob <## "cancelled receiving file 1 (testfile) from alice" + + bob ##> "/fr 1 ./tests/tmp" + bob <## "started receiving file 1 (testfile) from alice" + bob <## "saving file 1 from alice to ./tests/tmp/testfile_1" + bob <## "completed receiving file 1 (testfile) from alice" + + src <- B.readFile "./tests/tmp/testfile" + dest <- B.readFile "./tests/tmp/testfile_1" + dest `shouldBe` src + where + cfg = testCfg {xftpFileConfig = Just $ XFTPFileConfig {minFileSize = 0}, tempDir = Just "./tests/tmp"} + +xftpCLI :: [String] -> IO [String] +xftpCLI params = lines <$> capture_ (withArgs params xftpClientCLI) + startFileTransfer :: HasCallStack => TestCC -> TestCC -> IO () startFileTransfer alice bob = startFileTransfer' alice bob "test.jpg" "136.5 KiB / 139737 bytes"