core: test async file transfer (sender & receiver restarts); close files in stopChatController; handle openFile error in getFileHandle (#1716)

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
 

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 ->