diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index c4646dcb2a..2f518b707f 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -822,7 +822,7 @@ processChatCommand' vr = \case throwChatError (CECommandError $ "reaction already " <> if add then "added" else "removed") when (add && length rs >= maxMsgReactions) $ throwChatError (CECommandError "too many reactions") - APIForwardChatItem (ChatRef fromCType fromChatId) (ChatRef toCType toChatId) itemId -> withUser $ \user -> withChatLock "forwardChatItem" $ case toCType of + APIForwardChatItem fromChatRef (ChatRef toCType toChatId) itemId -> withUser $ \user -> withChatLock "forwardChatItem" $ case toCType of CTDirect -> do cm <- prepareForward user sendContactContentMessage user toChatId False Nothing cm True @@ -836,24 +836,11 @@ processChatCommand' vr = \case CTContactConnection -> pure $ chatCmdError (Just user) "not supported" where prepareForward :: User -> CM ComposedMessage - prepareForward user = case fromCType of - CTDirect -> do - (CChatItem _ ci) <- withStore $ \db -> getDirectChatItem db user fromChatId itemId - mc <- forwardMC ci - file <- forwardCryptoFile ci `catchChatError` \_ -> pure Nothing - pure $ ComposedMessage file Nothing mc - CTGroup -> do - (CChatItem _ ci) <- withStore $ \db -> getGroupChatItem db user fromChatId itemId - mc <- forwardMC ci - file <- forwardCryptoFile ci `catchChatError` \_ -> pure Nothing - pure $ ComposedMessage file Nothing mc - CTLocal -> do - (CChatItem _ ci) <- withStore $ \db -> getLocalChatItem db user fromChatId itemId - mc <- forwardMC ci - file <- forwardCryptoFile ci `catchChatError` \_ -> pure Nothing - pure $ ComposedMessage file Nothing mc - CTContactRequest -> throwChatError $ CECommandError "not supported" - CTContactConnection -> throwChatError $ CECommandError "not supported" + prepareForward user = do + (AChatItem _ _ _ ci) <- withStore $ \db -> getAChatItem db vr user fromChatRef itemId + mc <- forwardMC ci + file <- forwardCryptoFile ci `catchChatError` (\e -> toView (CRChatError (Just user) e) $> Nothing) + pure $ ComposedMessage file Nothing mc where forwardMC :: ChatItem c d -> CM MsgContent forwardMC ChatItem {meta = CIMeta {itemDeleted = Just _}} = throwChatError CEInvalidForward @@ -866,20 +853,21 @@ processChatCommand' vr = \case chatReadVar filesFolder >>= \case Nothing -> ifM (doesFileExist filePath) (pure $ Just fromCF) (pure Nothing) - Just filesFolder -> + Just filesFolder -> do + let fsFromPath = filesFolder filePath ifM - (doesFileExist filePath) + (doesFileExist fsFromPath) ( do - newPath <- liftIO $ filesFolder `uniqueCombine` fileName - liftIO $ B.writeFile newPath "" -- create empty file + fsNewPath <- liftIO $ filesFolder `uniqueCombine` fileName + liftIO $ B.writeFile fsNewPath "" -- create empty file encrypt <- chatReadVar encryptLocalFiles cfArgs <- if encrypt then Just <$> (atomically . CF.randomArgs =<< asks random) else pure Nothing - let toCF = CryptoFile newPath cfArgs + let toCF = CryptoFile fsNewPath cfArgs -- to keep forwarded file in case original is deleted liftIOEither $ runExceptT $ withExceptT (ChatError . CEInternalError . show) $ do - lb <- CF.readFile fromCF + lb <- CF.readFile (fromCF {filePath = fsFromPath} :: CryptoFile) CF.writeFile toCF lb - pure $ Just toCF + pure $ Just (toCF {filePath = takeFileName fsNewPath} :: CryptoFile) ) (pure Nothing) | otherwise = pure Nothing diff --git a/tests/ChatClient.hs b/tests/ChatClient.hs index fd47c54a3e..a827236a15 100644 --- a/tests/ChatClient.hs +++ b/tests/ChatClient.hs @@ -346,8 +346,8 @@ getTermLine cc = 5000000 `timeout` atomically (readTQueue $ termQ cc) >>= \case Just s -> do -- remove condition to always echo virtual terminal - when True $ do - -- when (printOutput cc) $ do + -- when True $ do + when (printOutput cc) $ do name <- userName cc putStrLn $ name <> ": " <> s pure s diff --git a/tests/ChatTests/Forward.hs b/tests/ChatTests/Forward.hs index 31bc85d44c..b7f8428806 100644 --- a/tests/ChatTests/Forward.hs +++ b/tests/ChatTests/Forward.hs @@ -22,7 +22,7 @@ chatForwardTests = do it "from notes to notes" testForwardNotesToNotes -- TODO forward between different folders when supported describe "forward files" $ do it "from contact to contact" testForwardFileNoFilesFolder - fit "with relative paths: from contact to contact" testForwardFileRelativePaths + it "with relative paths: from contact to contact" testForwardFileRelativePaths testForwardContactToContact :: HasCallStack => FilePath -> IO () testForwardContactToContact = @@ -329,22 +329,22 @@ testForwardFileRelativePaths = bob `send` "> @alice -> @cath hi" bob <# "@cath -> forwarded" bob <## " hi" - bob <# "/f @cath test.pdf" + bob <# "/f @cath test_1.pdf" bob <## "use /fc 2 to cancel sending" cath <# "bob> -> forwarded" cath <## " hi" - cath <# "bob> sends file test.pdf (266.0 KiB / 272376 bytes)" + cath <# "bob> sends file test_1.pdf (266.0 KiB / 272376 bytes)" cath <## "use /fr 1 [/ | ] to receive it" - cath ##> "/fr 1 ./tests/tmp" + cath ##> "/fr 1" concurrentlyN_ - [ bob <## "completed uploading file 2 (test.pdf) for cath", + [ bob <## "completed uploading file 2 (test_1.pdf) for cath", cath - <### [ "saving file 1 from bob to test.pdf", - "started receiving file 1 (test.pdf) from bob" + <### [ "saving file 1 from bob to test_1.pdf", + "started receiving file 1 (test_1.pdf) from bob" ] ] - cath <## "completed receiving file 1 (test.pdf) from bob" + cath <## "completed receiving file 1 (test_1.pdf) from bob" - dest2 <- B.readFile "./tests/tmp/cath_files/test.pdf" + dest2 <- B.readFile "./tests/tmp/cath_files/test_1.pdf" dest2 `shouldBe` src