diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index 8ed7ab6641..161928875b 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -227,13 +227,21 @@ restoreCalls user = do calls <- asks currentCalls atomically $ writeTVar calls callsMap -stopChatController :: MonadUnliftIO m => ChatController -> m () -stopChatController ChatController {smpAgent, agentAsync = s, expireCIs} = do +stopChatController :: forall m. MonadUnliftIO m => ChatController -> m () +stopChatController ChatController {smpAgent, agentAsync = s, sndFiles, rcvFiles, expireCIs} = do disconnectAgentClient smpAgent readTVarIO s >>= mapM_ (\(a1, a2) -> uninterruptibleCancel a1 >> mapM_ uninterruptibleCancel a2) + closeFiles sndFiles + closeFiles rcvFiles atomically $ do writeTVar expireCIs False writeTVar s Nothing + where + closeFiles :: TVar (Map Int64 Handle) -> m () + closeFiles files = do + fs <- readTVarIO files + mapM_ hClose fs + atomically $ writeTVar files M.empty execChatCommand :: (MonadUnliftIO m, MonadReader ChatController m) => ByteString -> m ChatResponse execChatCommand s = case parseChatCommand s of @@ -3252,8 +3260,7 @@ getFileHandle fileId filePath files ioMode = do maybe (newHandle fs) pure h_ where newHandle fs = do - -- TODO handle errors - h <- liftIO (openFile filePath ioMode) + h <- liftIO (openFile filePath ioMode) `E.catch` (throwChatError . CEFileInternal . (show :: E.SomeException -> String)) atomically . modifyTVar fs $ M.insert fileId h pure h diff --git a/tests/ChatTests.hs b/tests/ChatTests.hs index 1987d97507..13ef6d7aa2 100644 --- a/tests/ChatTests.hs +++ b/tests/ChatTests.hs @@ -159,10 +159,12 @@ chatTests = do -- it "v1 to v2" testFullAsyncV1toV2 -- it "v2 to v1" testFullAsyncV2toV1 describe "async sending and receiving files" $ do + it "send and receive file, sender restarts" testAsyncFileTransferSenderRestarts + it "send and receive file, receiver restarts" testAsyncFileTransferReceiverRestarts xdescribe "send and receive file, fully asynchronous" $ do it "v2" testAsyncFileTransfer it "v1" testAsyncFileTransferV1 - xit "send and receive file to group, fully asynchronous" testAsyncGroupFileTransfer + it "send and receive file to group, fully asynchronous" testAsyncGroupFileTransfer describe "webrtc calls api" $ do it "negotiate call" testNegotiateCall describe "maintenance mode" $ do @@ -4010,6 +4012,34 @@ testFullAsyncV2toV1 = withTmpFiles $ do withNewBob = withNewTestChat "bob" bobProfile withBob = withTestChat "bob" +testAsyncFileTransferSenderRestarts :: IO () +testAsyncFileTransferSenderRestarts = withTmpFiles $ do + withNewTestChat "bob" bobProfile $ \bob -> do + withNewTestChat "alice" aliceProfile $ \alice -> do + connectUsers alice bob + startFileTransfer' alice bob "test_1MB.pdf" "1017.7 KiB / 1042157 bytes" + threadDelay 100000 + withTestChatContactConnected "alice" $ \alice -> do + alice <## "completed sending file 1 (test_1MB.pdf) to bob" + bob <## "completed receiving file 1 (test_1MB.pdf) from alice" + src <- B.readFile "./tests/fixtures/test_1MB.pdf" + dest <- B.readFile "./tests/tmp/test_1MB.pdf" + dest `shouldBe` src + +testAsyncFileTransferReceiverRestarts :: IO () +testAsyncFileTransferReceiverRestarts = withTmpFiles $ do + withNewTestChat "alice" aliceProfile $ \alice -> do + withNewTestChat "bob" bobProfile $ \bob -> do + connectUsers alice bob + startFileTransfer' alice bob "test_1MB.pdf" "1017.7 KiB / 1042157 bytes" + threadDelay 100000 + withTestChatContactConnected "bob" $ \bob -> do + alice <## "completed sending file 1 (test_1MB.pdf) to bob" + bob <## "completed receiving file 1 (test_1MB.pdf) from alice" + src <- B.readFile "./tests/fixtures/test_1MB.pdf" + dest <- B.readFile "./tests/tmp/test_1MB.pdf" + dest `shouldBe` src + testAsyncFileTransfer :: IO () testAsyncFileTransfer = withTmpFiles $ do withNewTestChat "alice" aliceProfile $ \alice ->