core: allow repeat receive after cancel for XFTP files (#2134)

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

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

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

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)

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 [<dir>/ | <path>] 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"