diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index 8f9d985efe..c140025648 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -980,70 +980,47 @@ processChatCommand' vr = \case throwChatError (CECommandError $ "reaction already " <> if add then "added" else "removed") when (add && length rs >= maxMsgReactions) $ throwChatError (CECommandError "too many reactions") - APIForwardChatItems (ChatRef toCType toChatId) (ChatRef fromCType fromChatId) itemIds itemTTL ignoreMissingFiles -> withUser $ \user -> case toCType of + APIForwardChatItems (ChatRef toCType toChatId) (ChatRef fromCType fromChatId) itemIds itemTTL -> withUser $ \user -> case toCType of CTDirect -> do - cmrs <- prepareForwardOrFail user - withContactLock "forwardChatItem, to contact" toChatId $ - sendContactContentMessages user toChatId False itemTTL cmrs + cmrs <- prepareForward user + case L.nonEmpty cmrs of + Just cmrs' -> + withContactLock "forwardChatItem, to contact" toChatId $ + sendContactContentMessages user toChatId False itemTTL cmrs' + Nothing -> throwChatError $ CEInternalError "no chat items to forward" CTGroup -> do - cmrs <- prepareForwardOrFail user - withGroupLock "forwardChatItem, to group" toChatId $ - sendGroupContentMessages user toChatId False itemTTL cmrs + cmrs <- prepareForward user + case L.nonEmpty cmrs of + Just cmrs' -> + withGroupLock "forwardChatItem, to group" toChatId $ + sendGroupContentMessages user toChatId False itemTTL cmrs' + Nothing -> throwChatError $ CEInternalError "no chat items to forward" CTLocal -> do - cmrs <- prepareForwardOrFail user - createNoteFolderContentItems user toChatId cmrs + cmrs <- prepareForward user + case L.nonEmpty cmrs of + Just cmrs' -> + createNoteFolderContentItems user toChatId cmrs' + Nothing -> throwChatError $ CEInternalError "no chat items to forward" CTContactRequest -> pure $ chatCmdError (Just user) "not supported" CTContactConnection -> pure $ chatCmdError (Just user) "not supported" where - prepareForwardOrFail :: User -> CM (NonEmpty ComposeMessageReq) - prepareForwardOrFail user = do - (errs, cmrs) <- partitionEithers . L.toList <$> prepareForward user - case sortOn fst errs of - [] -> case L.nonEmpty (catMaybes cmrs) of - Nothing -> throwChatError $ CEInternalError "no chat items to forward" - Just cmrs' -> do - -- copy forwarded files, in case originals are deleted - withFilesFolder $ \filesFolder -> do - let toFolder cf@CryptoFile {filePath} = cf {filePath = filesFolder filePath} :: CryptoFile - forM_ cmrs' $ \case - (_, Just (fromCF, toCF)) -> - liftIOEither $ runExceptT $ withExceptT (ChatError . CEInternalError . show) $ - copyCryptoFile (toFolder fromCF) (toFolder toCF) - _ -> pure () - pure $ L.map fst cmrs' - errs'@((err, _) : _) -> do - -- cleanup files - withFilesFolder $ \filesFolder -> - forM_ cmrs $ \case - Just (_, Just (_, CryptoFile {filePath = toFPath})) -> do - let fsToPath = filesFolder toFPath - removeFile fsToPath `catchChatError` \e -> - logError ("prepareForwardOrFail: failed to clean up " <> tshow fsToPath <> ": " <> tshow e) - _ -> pure () - throwChatError $ case err of - FFENotAccepted _ -> CEForwardFilesNotAccepted files msgCount - FFEInProgress -> CEForwardFilesInProgress filesCount msgCount - FFEMissing -> CEForwardFilesMissing filesCount msgCount - FFEFailed -> CEForwardFilesFailed filesCount msgCount - where - msgCount = foldl' (\cnt (_, hasContent) -> if hasContent then cnt + 1 else cnt) 0 errs' - filesCount = foldl' (\cnt (e, _) -> if err == e then cnt + 1 else cnt) 0 errs' - files = foldl' (\ftIds -> \case (FFENotAccepted ftId, _) -> ftId : ftIds; _ -> ftIds) [] errs' - prepareForward :: User -> CM (NonEmpty (Either (ForwardFileError, Bool) (Maybe (ComposeMessageReq, Maybe (CryptoFile, CryptoFile))))) + prepareForward :: User -> CM [ComposeMessageReq] prepareForward user = case fromCType of CTDirect -> withContactLock "forwardChatItem, from contact" fromChatId $ do ct <- withFastStore $ \db -> getContact db vr user fromChatId - items <- withFastStore $ \db -> mapM (getDirectChatItem db user fromChatId) itemIds + (errs, items) <- lift $ partitionEithers <$> withStoreBatch (\db -> map (getDirectCI db) (L.toList itemIds)) + unless (null errs) $ toView $ CRChatErrors (Just user) errs mapM (ciComposeMsgReq ct) items where - ciComposeMsgReq :: Contact -> CChatItem 'CTDirect -> CM (Either (ForwardFileError, Bool) (Maybe (ComposeMessageReq, Maybe (CryptoFile, CryptoFile)))) + getDirectCI :: DB.Connection -> ChatItemId -> IO (Either ChatError (CChatItem 'CTDirect)) + getDirectCI db itemId = runExceptT . withExceptT ChatErrorStore $ getDirectChatItem db user fromChatId itemId + ciComposeMsgReq :: Contact -> CChatItem 'CTDirect -> CM ComposeMessageReq ciComposeMsgReq ct (CChatItem _ ci) = do (mc, mDir) <- forwardMC ci - fc <- forwardContent ci mc - forM fc $ \mcFile -> forM mcFile $ \(mc'', file_) -> do - let itemId = chatItemId' ci - ciff = forwardCIFF ci $ Just (CIFFContact (forwardName ct) mDir (Just fromChatId) (Just itemId)) - pure ((ComposedMessage (snd <$> file_) Nothing mc'', ciff), file_) + file <- forwardCryptoFile ci + let itemId = chatItemId' ci + ciff = forwardCIFF ci $ Just (CIFFContact (forwardName ct) mDir (Just fromChatId) (Just itemId)) + pure (ComposedMessage file Nothing mc, ciff) where forwardName :: Contact -> ContactName forwardName Contact {profile = LocalProfile {displayName, localAlias}} @@ -1051,31 +1028,35 @@ processChatCommand' vr = \case | otherwise = displayName CTGroup -> withGroupLock "forwardChatItem, from group" fromChatId $ do gInfo <- withFastStore $ \db -> getGroupInfo db vr user fromChatId - items <- withFastStore $ \db -> mapM (getGroupChatItem db user fromChatId) itemIds + (errs, items) <- lift $ partitionEithers <$> withStoreBatch (\db -> map (getGroupCI db) (L.toList itemIds)) + unless (null errs) $ toView $ CRChatErrors (Just user) errs mapM (ciComposeMsgReq gInfo) items where - ciComposeMsgReq :: GroupInfo -> CChatItem 'CTGroup -> CM (Either (ForwardFileError, Bool) (Maybe (ComposeMessageReq, Maybe (CryptoFile, CryptoFile)))) + getGroupCI :: DB.Connection -> ChatItemId -> IO (Either ChatError (CChatItem 'CTGroup)) + getGroupCI db itemId = runExceptT . withExceptT ChatErrorStore $ getGroupChatItem db user fromChatId itemId + ciComposeMsgReq :: GroupInfo -> CChatItem 'CTGroup -> CM ComposeMessageReq ciComposeMsgReq gInfo (CChatItem _ ci) = do (mc, mDir) <- forwardMC ci - fc <- forwardContent ci mc - forM fc $ \mcFile -> forM mcFile $ \(mc'', file_) -> do - let itemId = chatItemId' ci - ciff = forwardCIFF ci $ Just (CIFFGroup (forwardName gInfo) mDir (Just fromChatId) (Just itemId)) - pure ((ComposedMessage (snd <$> file_) Nothing mc'', ciff), file_) + file <- forwardCryptoFile ci + let itemId = chatItemId' ci + ciff = forwardCIFF ci $ Just (CIFFGroup (forwardName gInfo) mDir (Just fromChatId) (Just itemId)) + pure (ComposedMessage file Nothing mc, ciff) where forwardName :: GroupInfo -> ContactName forwardName GroupInfo {groupProfile = GroupProfile {displayName}} = displayName CTLocal -> do - items <- withFastStore $ \db -> mapM (getLocalChatItem db user fromChatId) itemIds + (errs, items) <- lift $ partitionEithers <$> withStoreBatch (\db -> map (getLocalCI db) (L.toList itemIds)) + unless (null errs) $ toView $ CRChatErrors (Just user) errs mapM ciComposeMsgReq items where - ciComposeMsgReq :: CChatItem 'CTLocal -> CM (Either (ForwardFileError, Bool) (Maybe (ComposeMessageReq, Maybe (CryptoFile, CryptoFile)))) + getLocalCI :: DB.Connection -> ChatItemId -> IO (Either ChatError (CChatItem 'CTLocal)) + getLocalCI db itemId = runExceptT . withExceptT ChatErrorStore $ getLocalChatItem db user fromChatId itemId + ciComposeMsgReq :: CChatItem 'CTLocal -> CM ComposeMessageReq ciComposeMsgReq (CChatItem _ ci) = do (mc, _) <- forwardMC ci - fc <- forwardContent ci mc - forM fc $ \mcFile -> forM mcFile $ \(mc'', file_) -> do - let ciff = forwardCIFF ci Nothing - pure ((ComposedMessage (snd <$> file_) Nothing mc'', ciff), file_) + file <- forwardCryptoFile ci + let ciff = forwardCIFF ci Nothing + pure (ComposedMessage file Nothing mc, ciff) CTContactRequest -> throwChatError $ CECommandError "not supported" CTContactConnection -> throwChatError $ CECommandError "not supported" where @@ -1089,53 +1070,48 @@ processChatCommand' vr = \case Nothing -> ciff Just CIFFUnknown -> ciff Just prevCIFF -> Just prevCIFF - forwardContent :: ChatItem c d -> MsgContent -> CM (Either (ForwardFileError, Bool) (Maybe (MsgContent, Maybe (CryptoFile, CryptoFile)))) - forwardContent ChatItem {file = Nothing} mc = pure $ Right $ Just (mc, Nothing) - forwardContent ChatItem {file = Just ciFile} mc = case ciFile of - CIFile {fileId, fileName, fileStatus, fileSource = Just fromCF@CryptoFile {filePath}} -> case ciFileForwardError fileId fileStatus of - Just e -> pure $ ignoreOrError e - Nothing -> - chatReadVar filesFolder >>= \case - Nothing -> - ifM (doesFileExist filePath) (pure $ Right $ Just (mc, Just (fromCF, fromCF))) (pure $ ignoreOrError FFEMissing) - Just filesFolder -> - ifM (doesFileExist $ filesFolder filePath) forwardedFile (pure $ ignoreOrError FFEMissing) - where - forwardedFile = do - 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 fsNewPath cfArgs - pure $ Right $ Just (mc, Just (fromCF, toCF {filePath = takeFileName fsNewPath} :: CryptoFile)) - _ -> pure $ ignoreOrError FFEMissing + forwardCryptoFile :: ChatItem c d -> CM (Maybe CryptoFile) + forwardCryptoFile ChatItem {file = Nothing} = pure Nothing + forwardCryptoFile ChatItem {file = Just ciFile} = case ciFile of + CIFile {fileName, fileSource = Just fromCF@CryptoFile {filePath}} -> + chatReadVar filesFolder >>= \case + Nothing -> + ifM (doesFileExist filePath) (pure $ Just fromCF) (pure Nothing) + Just filesFolder -> do + let fsFromPath = filesFolder filePath + ifM + (doesFileExist fsFromPath) + ( do + 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 fsNewPath cfArgs + -- to keep forwarded file in case original is deleted + liftIOEither $ runExceptT $ withExceptT (ChatError . CEInternalError . show) $ copyCryptoFile (fromCF {filePath = fsFromPath} :: CryptoFile) toCF + pure $ Just (toCF {filePath = takeFileName fsNewPath} :: CryptoFile) + ) + (pure Nothing) + _ -> pure Nothing + copyCryptoFile :: CryptoFile -> CryptoFile -> ExceptT CF.FTCryptoError IO () + copyCryptoFile fromCF@CryptoFile {filePath = fsFromPath, cryptoArgs = fromArgs} toCF@CryptoFile {cryptoArgs = toArgs} = do + fromSizeFull <- getFileSize fsFromPath + let fromSize = fromSizeFull - maybe 0 (const $ toInteger C.authTagSize) fromArgs + CF.withFile fromCF ReadMode $ \fromH -> + CF.withFile toCF WriteMode $ \toH -> do + copyChunks fromH toH fromSize + forM_ fromArgs $ \_ -> CF.hGetTag fromH + forM_ toArgs $ \_ -> liftIO $ CF.hPutTag toH where - ignoreOrError err = if ignoreMissingFiles then Right (newContent mc) else Left (err, hasContent mc) - where - newContent mc' = case mc' of - MCImage {} -> Just (mc', Nothing) - _ | msgContentText mc' /= "" -> Just (MCText $ msgContentText mc', Nothing) - _ -> Nothing - hasContent mc' = isJust $ newContent mc' - copyCryptoFile :: CryptoFile -> CryptoFile -> ExceptT CF.FTCryptoError IO () - copyCryptoFile fromCF@CryptoFile {filePath = fsFromPath, cryptoArgs = fromArgs} toCF@CryptoFile {cryptoArgs = toArgs} = do - fromSizeFull <- getFileSize fsFromPath - let fromSize = fromSizeFull - maybe 0 (const $ toInteger C.authTagSize) fromArgs - CF.withFile fromCF ReadMode $ \fromH -> - CF.withFile toCF WriteMode $ \toH -> do - copyChunks fromH toH fromSize - forM_ fromArgs $ \_ -> CF.hGetTag fromH - forM_ toArgs $ \_ -> liftIO $ CF.hPutTag toH - where - copyChunks :: CF.CryptoFileHandle -> CF.CryptoFileHandle -> Integer -> ExceptT CF.FTCryptoError IO () - copyChunks r w size = do - let chSize = min size U.chunkSize - chSize' = fromIntegral chSize - size' = size - chSize - ch <- liftIO $ CF.hGet r chSize' - when (B.length ch /= chSize') $ throwError $ CF.FTCEFileIOError "encrypting file: unexpected EOF" - liftIO . CF.hPut w $ LB.fromStrict ch - when (size' > 0) $ copyChunks r w size' + copyChunks :: CF.CryptoFileHandle -> CF.CryptoFileHandle -> Integer -> ExceptT CF.FTCryptoError IO () + copyChunks r w size = do + let chSize = min size U.chunkSize + chSize' = fromIntegral chSize + size' = size - chSize + ch <- liftIO $ CF.hGet r chSize' + when (B.length ch /= chSize') $ throwError $ CF.FTCEFileIOError "encrypting file: unexpected EOF" + liftIO . CF.hPut w $ LB.fromStrict ch + when (size' > 0) $ copyChunks r w size' APIUserRead userId -> withUserId userId $ \user -> withFastStore' (`setUserChatsRead` user) >> ok user UserRead -> withUser $ \User {userId} -> processChatCommand $ APIUserRead userId APIChatRead chatRef@(ChatRef cType chatId) fromToIds -> withUser $ \_ -> case cType of @@ -1855,17 +1831,17 @@ processChatCommand' vr = \case contactId <- withFastStore $ \db -> getContactIdByName db user fromContactName forwardedItemId <- withFastStore $ \db -> getDirectChatItemIdByText' db user contactId forwardedMsg toChatRef <- getChatRef user toChatName - processChatCommand $ APIForwardChatItems toChatRef (ChatRef CTDirect contactId) (forwardedItemId :| []) Nothing True + processChatCommand $ APIForwardChatItems toChatRef (ChatRef CTDirect contactId) (forwardedItemId :| []) Nothing ForwardGroupMessage toChatName fromGroupName fromMemberName_ forwardedMsg -> withUser $ \user -> do groupId <- withFastStore $ \db -> getGroupIdByName db user fromGroupName forwardedItemId <- withFastStore $ \db -> getGroupChatItemIdByText db user groupId fromMemberName_ forwardedMsg toChatRef <- getChatRef user toChatName - processChatCommand $ APIForwardChatItems toChatRef (ChatRef CTGroup groupId) (forwardedItemId :| []) Nothing True + processChatCommand $ APIForwardChatItems toChatRef (ChatRef CTGroup groupId) (forwardedItemId :| []) Nothing ForwardLocalMessage toChatName forwardedMsg -> withUser $ \user -> do folderId <- withFastStore (`getUserNoteFolderId` user) forwardedItemId <- withFastStore $ \db -> getLocalChatItemIdByText' db user folderId forwardedMsg toChatRef <- getChatRef user toChatName - processChatCommand $ APIForwardChatItems toChatRef (ChatRef CTLocal folderId) (forwardedItemId :| []) Nothing True + processChatCommand $ APIForwardChatItems toChatRef (ChatRef CTLocal folderId) (forwardedItemId :| []) Nothing SendMessage (ChatName cType name) msg -> withUser $ \user -> do let mc = MCText msg case cType of @@ -3356,10 +3332,9 @@ deleteFilesLocally files = delete fPath = removeFile fPath `catchAll` \_ -> removePathForcibly fPath `catchAll_` pure () - --- perform an action only if filesFolder is set (i.e. on mobile devices) -withFilesFolder :: (FilePath -> CM ()) -> CM () -withFilesFolder action = asks filesFolder >>= readTVarIO >>= mapM_ action + -- perform an action only if filesFolder is set (i.e. on mobile devices) + withFilesFolder :: (FilePath -> CM ()) -> CM () + withFilesFolder action = asks filesFolder >>= readTVarIO >>= mapM_ action updateCallItemStatus :: User -> Contact -> Call -> WebRTCCallStatus -> Maybe MessageId -> CM () updateCallItemStatus user ct@Contact {contactId} Call {chatItemId} receivedStatus msgId_ = do @@ -7913,7 +7888,7 @@ chatCommandP = "/_delete item " *> (APIDeleteChatItem <$> chatRefP <*> _strP <* A.space <*> ciDeleteMode), "/_delete member item #" *> (APIDeleteMemberChatItem <$> A.decimal <*> _strP), "/_reaction " *> (APIChatItemReaction <$> chatRefP <* A.space <*> A.decimal <* A.space <*> onOffP <* A.space <*> jsonP), - "/_forward " *> (APIForwardChatItems <$> chatRefP <* A.space <*> chatRefP <*> _strP <*> sendMessageTTLP <*> (" ignore_files=" *> onOffP <|> pure False)), + "/_forward " *> (APIForwardChatItems <$> chatRefP <* A.space <*> chatRefP <*> _strP <*> sendMessageTTLP), "/_read user " *> (APIUserRead <$> A.decimal), "/read user" $> UserRead, "/_read chat " *> (APIChatRead <$> chatRefP <*> optional (A.space *> ((,) <$> ("from=" *> A.decimal) <* A.space <*> ("to=" *> A.decimal)))), diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index 7c49e9e7e4..7268d0734a 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -298,7 +298,7 @@ data ChatCommand | APIDeleteChatItem ChatRef (NonEmpty ChatItemId) CIDeleteMode | APIDeleteMemberChatItem GroupId (NonEmpty ChatItemId) | APIChatItemReaction {chatRef :: ChatRef, chatItemId :: ChatItemId, add :: Bool, reaction :: MsgReaction} - | APIForwardChatItems {toChatRef :: ChatRef, fromChatRef :: ChatRef, chatItemIds :: NonEmpty ChatItemId, ttl :: Maybe Int, ignoreMissingFiles :: Bool} + | APIForwardChatItems {toChatRef :: ChatRef, fromChatRef :: ChatRef, chatItemIds :: NonEmpty ChatItemId, ttl :: Maybe Int} | APIUserRead UserId | UserRead | APIChatRead ChatRef (Maybe (ChatItemId, ChatItemId)) @@ -1178,10 +1178,6 @@ data ChatErrorType | CEFallbackToSMPProhibited {fileId :: FileTransferId} | CEInlineFileProhibited {fileId :: FileTransferId} | CEInvalidQuote - | CEForwardFilesNotAccepted {files :: [FileTransferId], msgCount :: Int} -- contentCount is the count of messages if files are ignored - | CEForwardFilesInProgress {filesCount :: Int, msgCount :: Int} - | CEForwardFilesMissing {filesCount :: Int, msgCount :: Int} - | CEForwardFilesFailed {filesCount :: Int, msgCount :: Int} | CEInvalidForward | CEInvalidChatItemUpdate | CEInvalidChatItemDelete diff --git a/src/Simplex/Chat/Messages.hs b/src/Simplex/Chat/Messages.hs index 0e4edbd685..f6c59cbcb5 100644 --- a/src/Simplex/Chat/Messages.hs +++ b/src/Simplex/Chat/Messages.hs @@ -35,7 +35,7 @@ import Data.Maybe (fromMaybe, isJust, isNothing) import Data.Text (Text) import qualified Data.Text as T import Data.Text.Encoding (decodeLatin1, encodeUtf8) -import Data.Time.Clock (NominalDiffTime, UTCTime, diffUTCTime, nominalDay) +import Data.Time.Clock (UTCTime, diffUTCTime, nominalDay, NominalDiffTime) import Data.Type.Equality import Data.Typeable (Typeable) import Database.SQLite.Simple.FromField (FromField (..)) @@ -577,26 +577,23 @@ ciFileEnded = \case CIFSRcvWarning {} -> False CIFSInvalid {} -> True -data ForwardFileError = FFENotAccepted FileTransferId | FFEInProgress | FFEFailed | FFEMissing - deriving (Eq, Ord) - -ciFileForwardError :: FileTransferId -> CIFileStatus d -> Maybe ForwardFileError -ciFileForwardError fId = \case - CIFSSndStored -> Nothing - CIFSSndTransfer {} -> Nothing - CIFSSndComplete -> Nothing - CIFSSndCancelled -> Nothing - CIFSSndError {} -> Nothing - CIFSSndWarning {} -> Nothing - CIFSRcvInvitation -> Just $ FFENotAccepted fId - CIFSRcvAccepted -> Just FFEInProgress - CIFSRcvTransfer {} -> Just FFEInProgress - CIFSRcvAborted -> Just $ FFENotAccepted fId - CIFSRcvCancelled -> Just FFEFailed -- ? - CIFSRcvComplete -> Nothing - CIFSRcvError {} -> Just FFEFailed - CIFSRcvWarning {} -> Just FFEFailed - CIFSInvalid {} -> Just FFEFailed -- ? +ciFileLoaded :: CIFileStatus d -> Bool +ciFileLoaded = \case + CIFSSndStored -> True + CIFSSndTransfer {} -> True + CIFSSndComplete -> True + CIFSSndCancelled -> True + CIFSSndError {} -> True + CIFSSndWarning {} -> True + CIFSRcvInvitation -> False + CIFSRcvAccepted -> False + CIFSRcvTransfer {} -> False + CIFSRcvAborted -> False + CIFSRcvCancelled -> False + CIFSRcvComplete -> True + CIFSRcvError {} -> False + CIFSRcvWarning {} -> False + CIFSInvalid {} -> False data ACIFileStatus = forall d. MsgDirectionI d => AFS (SMsgDirection d) (CIFileStatus d) diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index e8814fb32d..2158599c4b 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -2034,11 +2034,7 @@ viewChatError isCmd logLevel testView = \case CEFallbackToSMPProhibited fileId -> ["recipient tried to accept file " <> sShow fileId <> " via old protocol, prohibited"] CEInlineFileProhibited _ -> ["A small file sent without acceptance - you can enable receiving such files with -f option."] CEInvalidQuote -> ["cannot reply to this message"] - CEInvalidForward -> ["cannot forward message(s)"] - CEForwardFilesNotAccepted files msgCount -> [plain $ "Some files are not accepted: " <> intercalate ", " (map show files), showForwardMsgCount msgCount] - CEForwardFilesInProgress cnt msgCount -> [plain $ "Still receiving " <> show cnt <> " file(s)", showForwardMsgCount msgCount] - CEForwardFilesMissing cnt msgCount -> [plain $ show cnt <> " file(s) are missing", showForwardMsgCount msgCount] - CEForwardFilesFailed cnt msgCount -> [plain $ show cnt <> " file(s) failed", showForwardMsgCount msgCount] + CEInvalidForward -> ["cannot forward this message"] CEInvalidChatItemUpdate -> ["cannot update this item"] CEInvalidChatItemDelete -> ["cannot delete this item"] CEHasCurrentCall -> ["call already in progress"] @@ -2057,9 +2053,6 @@ viewChatError isCmd logLevel testView = \case CEPeerChatVRangeIncompatible -> ["peer chat protocol version range incompatible"] CEInternalError e -> ["internal chat error: " <> plain e] CEException e -> ["exception: " <> plain e] - where - showForwardMsgCount 0 = "No other messages to forward" - showForwardMsgCount msgCount = plain $ "Use ignore_files to forward " <> show msgCount <> " message(s)" -- e -> ["chat error: " <> sShow e] ChatErrorStore err -> case err of SEDuplicateName -> ["this display name is already used by user, contact or group"] diff --git a/tests/ChatTests/Forward.hs b/tests/ChatTests/Forward.hs index 1897cddef5..b339053abf 100644 --- a/tests/ChatTests/Forward.hs +++ b/tests/ChatTests/Forward.hs @@ -671,8 +671,6 @@ testMultiForwardFiles = \alice bob cath -> withXFTPServer $ do setRelativePaths alice "./tests/tmp/alice_app_files" "./tests/tmp/alice_xftp" copyFile "./tests/fixtures/test.jpg" "./tests/tmp/alice_app_files/test.jpg" - copyFile "./tests/fixtures/test.jpg" "./tests/tmp/alice_app_files/test_3.jpg" - copyFile "./tests/fixtures/test.jpg" "./tests/tmp/alice_app_files/test_4.jpg" copyFile "./tests/fixtures/test.pdf" "./tests/tmp/alice_app_files/test.pdf" setRelativePaths bob "./tests/tmp/bob_app_files" "./tests/tmp/bob_xftp" setRelativePaths cath "./tests/tmp/cath_app_files" "./tests/tmp/cath_xftp" @@ -690,10 +688,7 @@ testMultiForwardFiles = let cm1 = "{\"msgContent\": {\"type\": \"text\", \"text\": \"message without file\"}}" cm2 = "{\"filePath\": \"test.jpg\", \"msgContent\": {\"type\": \"text\", \"text\": \"sending file 1\"}}" cm3 = "{\"filePath\": \"test.pdf\", \"msgContent\": {\"type\": \"text\", \"text\": \"sending file 2\"}}" - cm4 = "{\"filePath\": \"test_4.jpg\", \"msgContent\": {\"type\": \"text\", \"text\": \"sending file 3\"}}" - cm5 = "{\"filePath\": \"test_3.jpg\", \"msgContent\": {\"text\":\"\",\"type\":\"file\"}}" - - alice ##> ("/_send @2 json [" <> cm1 <> "," <> cm2 <> "," <> cm3 <> "," <> cm4 <> "," <> cm5 <> "]") + alice ##> ("/_send @2 json [" <> cm1 <> "," <> cm2 <> "," <> cm3 <> "]") alice <# "@bob message without file" @@ -705,13 +700,6 @@ testMultiForwardFiles = alice <# "/f @bob test.pdf" alice <## "use /fc 2 to cancel sending" - alice <# "@bob sending file 3" - alice <# "/f @bob test_4.jpg" - alice <## "use /fc 3 to cancel sending" - - alice <# "/f @bob test_3.jpg" - alice <## "use /fc 4 to cancel sending" - bob <# "alice> message without file" bob <# "alice> sending file 1" @@ -722,17 +710,8 @@ testMultiForwardFiles = bob <# "alice> sends file test.pdf (266.0 KiB / 272376 bytes)" bob <## "use /fr 2 [/ | ] to receive it" - bob <# "alice> sending file 3" - bob <# "alice> sends file test_4.jpg (136.5 KiB / 139737 bytes)" - bob <## "use /fr 3 [/ | ] to receive it" - - bob <# "alice> sends file test_3.jpg (136.5 KiB / 139737 bytes)" - bob <## "use /fr 4 [/ | ] to receive it" - alice <## "completed uploading file 1 (test.jpg) for bob" alice <## "completed uploading file 2 (test.pdf) for bob" - alice <## "completed uploading file 3 (test_4.jpg) for bob" - alice <## "completed uploading file 4 (test_3.jpg) for bob" bob ##> "/fr 1" bob @@ -741,11 +720,6 @@ testMultiForwardFiles = ] bob <## "completed receiving file 1 (test.jpg) from alice" - -- try to forward file without receiving 2nd file - let msgId1 = (read msgIdZero :: Int) + 1 - bob ##> ("/_forward @3 @2 " <> show msgId1 <> "," <> show (msgId1 + 1) <> "," <> show (msgId1 + 2) <> "," <> show (msgId1 + 3) <> "," <> show (msgId1 + 4) <> "," <> show (msgId1 + 5)) - bob <### ["3 file(s) are missing", "Use ignore_files to forward 2 message(s)"] - bob ##> "/fr 2" bob <### [ "saving file 2 from alice to test.pdf", @@ -762,7 +736,8 @@ testMultiForwardFiles = dest2 `shouldBe` src2 -- forward file - bob ##> ("/_forward @3 @2 " <> show msgId1 <> "," <> show (msgId1 + 1) <> "," <> show (msgId1 + 2) <> "," <> show (msgId1 + 3) <> "," <> show (msgId1 + 4) <> "," <> show (msgId1 + 5) <> " ignore_files=on") + let msgId1 = (read msgIdZero :: Int) + 1 + bob ##> ("/_forward @3 @2 " <> show msgId1 <> "," <> show (msgId1 + 1) <> "," <> show (msgId1 + 2) <> "," <> show (msgId1 + 3)) -- messages printed for bob bob <# "@cath <- you @alice" @@ -774,15 +749,12 @@ testMultiForwardFiles = bob <# "@cath <- @alice" bob <## " sending file 1" bob <# "/f @cath test_1.jpg" - bob <## "use /fc 5 to cancel sending" + bob <## "use /fc 3 to cancel sending" bob <# "@cath <- @alice" bob <## " sending file 2" bob <# "/f @cath test_1.pdf" - bob <## "use /fc 6 to cancel sending" - - bob <# "@cath <- @alice" - bob <## " sending file 3" + bob <## "use /fc 4 to cancel sending" -- messages printed for cath cath <# "bob> -> forwarded" @@ -801,12 +773,9 @@ testMultiForwardFiles = cath <# "bob> sends file test_1.pdf (266.0 KiB / 272376 bytes)" cath <## "use /fr 2 [/ | ] to receive it" - cath <# "bob> -> forwarded" - cath <## " sending file 3" -- No file sent here - -- file transfer - bob <## "completed uploading file 5 (test_1.jpg) for cath" - bob <## "completed uploading file 6 (test_1.pdf) for cath" + bob <## "completed uploading file 3 (test_1.jpg) for cath" + bob <## "completed uploading file 4 (test_1.pdf) for cath" cath ##> "/fr 1" cath