core: plan forwarding chat items, api types (#4865)

* core: plan forwarding chat items, api types

* remove empty content, refactor get items

* another refactor

* plan

* test

* more tests

* text

src/Simplex/Chat.hs

@@ -843,9 +843,7 @@ processChatCommand' vr = \case
     CTContactConnection -> pure $ chatCmdError (Just user) "not supported"
   APIDeleteChatItem (ChatRef cType chatId) itemIds mode -> withUser $ \user -> case cType of
     CTDirect -> withContactLock "deleteChatItem" chatId $ do
-      ct <- withStore $ \db -> getContact db vr user chatId
-      (errs, items) <- lift $ partitionEithers <$> withStoreBatch (\db -> map (getDirectCI db) (L.toList itemIds))
-      unless (null errs) $ toView $ CRChatErrors (Just user) errs
+      (ct, items) <- getCommandDirectChatItems user chatId itemIds
       case mode of
         CIDMInternal -> deleteDirectCIs user ct items True False
         CIDMBroadcast -> do
@@ -858,13 +856,9 @@ processChatCommand' vr = \case
           if featureAllowed SCFFullDelete forUser ct
             then deleteDirectCIs user ct items True False
             else markDirectCIsDeleted user ct items True =<< liftIO getCurrentTime
-      where
-        getDirectCI :: DB.Connection -> ChatItemId -> IO (Either ChatError (CChatItem 'CTDirect))
-        getDirectCI db itemId = runExceptT . withExceptT ChatErrorStore $ getDirectChatItem db user chatId itemId
     CTGroup -> withGroupLock "deleteChatItem" chatId $ do
-      Group gInfo ms <- withStore $ \db -> getGroup db vr user chatId
-      (errs, items) <- lift $ partitionEithers <$> withStoreBatch (\db -> map (getGroupCI db) (L.toList itemIds))
-      unless (null errs) $ toView $ CRChatErrors (Just user) errs
+      (gInfo, items) <- getCommandGroupChatItems user chatId itemIds
+      ms <- withFastStore' $ \db -> getGroupMembers db vr user gInfo
       case mode of
         CIDMInternal -> deleteGroupCIs user gInfo items True False Nothing =<< liftIO getCurrentTime
         CIDMBroadcast -> do
@@ -874,17 +868,9 @@ processChatCommand' vr = \case
               events = L.nonEmpty $ map (`XMsgDel` Nothing) msgIds
           mapM_ (sendGroupMessages user gInfo ms) events
           delGroupChatItems user gInfo items Nothing
-      where
-        getGroupCI :: DB.Connection -> ChatItemId -> IO (Either ChatError (CChatItem 'CTGroup))
-        getGroupCI db itemId = runExceptT . withExceptT ChatErrorStore $ getGroupChatItem db user chatId itemId
     CTLocal -> do
-      nf <- withStore $ \db -> getNoteFolder db user chatId
-      (errs, items) <- lift $ partitionEithers <$> withStoreBatch (\db -> map (getLocalCI db) (L.toList itemIds))
-      unless (null errs) $ toView $ CRChatErrors (Just user) errs
+      (nf, items) <- getCommandLocalChatItems user chatId itemIds
       deleteLocalCIs user nf items True False
-      where
-        getLocalCI :: DB.Connection -> ChatItemId -> IO (Either ChatError (CChatItem 'CTLocal))
-        getLocalCI db itemId = runExceptT . withExceptT ChatErrorStore $ getLocalChatItem db user chatId itemId
     CTContactRequest -> pure $ chatCmdError (Just user) "not supported"
     CTContactConnection -> pure $ chatCmdError (Just user) "not supported"
     where
@@ -902,9 +888,8 @@ processChatCommand' vr = \case
       itemsMsgIds :: [CChatItem c] -> [SharedMsgId]
       itemsMsgIds = mapMaybe (\(CChatItem _ ChatItem {meta = CIMeta {itemSharedMsgId}}) -> itemSharedMsgId)
   APIDeleteMemberChatItem gId itemIds -> withUser $ \user -> withGroupLock "deleteChatItem" gId $ do
-    Group gInfo@GroupInfo {membership} ms <- withStore $ \db -> getGroup db vr user gId
-    (errs, items) <- lift $ partitionEithers <$> withStoreBatch (\db -> map (getGroupCI db user) (L.toList itemIds))
-    unless (null errs) $ toView $ CRChatErrors (Just user) errs
+    (gInfo@GroupInfo {membership}, items) <- getCommandGroupChatItems user gId itemIds
+    ms <- withFastStore' $ \db -> getGroupMembers db vr user gInfo
     assertDeletable gInfo items
     assertUserGroupRole gInfo GRAdmin
     let msgMemIds = itemsMsgMemIds gInfo items
@@ -912,8 +897,6 @@ processChatCommand' vr = \case
     mapM_ (sendGroupMessages user gInfo ms) events
     delGroupChatItems user gInfo items (Just membership)
     where
-      getGroupCI :: DB.Connection -> User -> ChatItemId -> IO (Either ChatError (CChatItem 'CTGroup))
-      getGroupCI db user itemId = runExceptT . withExceptT ChatErrorStore $ getGroupChatItem db user gId itemId
       assertDeletable :: GroupInfo -> [CChatItem 'CTGroup] -> CM ()
       assertDeletable GroupInfo {membership = GroupMember {memberRole = membershipMemRole}} items =
         unless (all itemDeletable items) $ throwChatError CEInvalidChatItemDelete
@@ -980,6 +963,51 @@ processChatCommand' vr = \case
           throwChatError (CECommandError $ "reaction already " <> if add then "added" else "removed")
         when (add && length rs >= maxMsgReactions) $
           throwChatError (CECommandError "too many reactions")
+  APIPlanForwardChatItems (ChatRef fromCType fromChatId) itemIds -> withUser $ \user -> case fromCType of
+    CTDirect -> planForward user . snd =<< getCommandDirectChatItems user fromChatId itemIds
+    CTGroup -> planForward user . snd =<< getCommandGroupChatItems user fromChatId itemIds
+    CTLocal -> planForward user . snd =<< getCommandLocalChatItems user fromChatId itemIds
+    CTContactRequest -> pure $ chatCmdError (Just user) "not supported"
+    CTContactConnection -> pure $ chatCmdError (Just user) "not supported"
+    where
+      planForward :: User -> [CChatItem c] -> CM ChatResponse
+      planForward user items = do
+        (itemIds', forwardErrors) <- unzip <$> mapM planItemForward items
+        let forwardConfirmation = case catMaybes forwardErrors of
+              [] -> Nothing
+              errs -> Just $ case mainErr of
+                FFENotAccepted _ -> FCFilesNotAccepted fileIds
+                FFEInProgress -> FCFilesInProgress filesCount
+                FFEMissing -> FCFilesMissing filesCount
+                FFEFailed -> FCFilesFailed filesCount
+                where
+                  mainErr = minimum errs
+                  fileIds = catMaybes $ map (\case FFENotAccepted ftId -> Just ftId; _ -> Nothing) errs
+                  filesCount = length $ filter (mainErr ==) errs
+        pure CRForwardPlan {user, itemsCount = length itemIds, chatItemIds = catMaybes itemIds', forwardConfirmation}
+        where
+          planItemForward :: CChatItem c -> CM (Maybe ChatItemId, Maybe ForwardFileError)
+          planItemForward (CChatItem _ ci) = forwardMsgContent ci >>= maybe (pure (Nothing, Nothing)) (forwardContentPlan ci)
+          forwardContentPlan :: ChatItem c d -> MsgContent -> CM (Maybe ChatItemId, Maybe ForwardFileError)
+          forwardContentPlan ChatItem {file, meta = CIMeta {itemId}} mc = case file of
+            Nothing -> pure (Just itemId, Nothing)
+            Just CIFile {fileId, fileStatus, fileSource} -> case ciFileForwardError fileId fileStatus of
+              Just err -> pure $ itemIdWithoutFile err
+              Nothing -> case fileSource of
+                Just CryptoFile {filePath} -> do
+                  exists <- doesFileExist . maybe filePath (</> filePath) =<< chatReadVar filesFolder
+                  pure $ if exists then (Just itemId, Nothing) else itemIdWithoutFile FFEMissing
+                Nothing -> pure $ itemIdWithoutFile FFEMissing
+            where
+              itemIdWithoutFile err = (if hasContent then Just itemId else Nothing, Just err)
+              hasContent = case mc of
+                MCText _ -> True
+                MCLink {} -> True
+                MCImage {} -> True
+                MCVideo {text} -> text /= ""
+                MCVoice {text} -> text /= ""
+                MCFile t -> t /= ""
+                MCUnknown {} -> True
   APIForwardChatItems (ChatRef toCType toChatId) (ChatRef fromCType fromChatId) itemIds itemTTL -> withUser $ \user -> case toCType of
     CTDirect -> do
       cmrs <- prepareForward user
@@ -987,96 +1015,76 @@ processChatCommand' vr = \case
         Just cmrs' ->
           withContactLock "forwardChatItem, to contact" toChatId $
             sendContactContentMessages user toChatId False itemTTL cmrs'
-        Nothing -> throwChatError $ CEInternalError "no chat items to forward"
+        Nothing -> pure $ CRNewChatItems user []
     CTGroup -> do
       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"
+        Nothing -> pure $ CRNewChatItems user []
     CTLocal -> do
       cmrs <- prepareForward user
       case L.nonEmpty cmrs of
         Just cmrs' ->
           createNoteFolderContentItems user toChatId cmrs'
-        Nothing -> throwChatError $ CEInternalError "no chat items to forward"
+        Nothing -> pure $ CRNewChatItems user []
     CTContactRequest -> pure $ chatCmdError (Just user) "not supported"
     CTContactConnection -> pure $ chatCmdError (Just user) "not supported"
     where
       prepareForward :: User -> CM [ComposeMessageReq]
       prepareForward user = case fromCType of
         CTDirect -> withContactLock "forwardChatItem, from contact" fromChatId $ do
-          ct <- withFastStore $ \db -> getContact db vr user fromChatId
-          (errs, items) <- lift $ partitionEithers <$> withStoreBatch (\db -> map (getDirectCI db) (L.toList itemIds))
-          unless (null errs) $ toView $ CRChatErrors (Just user) errs
-          mapM (ciComposeMsgReq ct) items
+          (ct, items) <- getCommandDirectChatItems user fromChatId itemIds
+          catMaybes <$> mapM (\ci -> ciComposeMsgReq ct ci <$$> prepareMsgReq ci) items
           where
-            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
-              file <- forwardCryptoFile ci
+            ciComposeMsgReq :: Contact -> CChatItem 'CTDirect -> (MsgContent, Maybe CryptoFile) -> ComposeMessageReq
+            ciComposeMsgReq ct (CChatItem md ci) (mc', file) =
               let itemId = chatItemId' ci
-                  ciff = forwardCIFF ci $ Just (CIFFContact (forwardName ct) mDir (Just fromChatId) (Just itemId))
-              pure (ComposedMessage file Nothing mc, ciff)
+                  ciff = forwardCIFF ci $ Just (CIFFContact (forwardName ct) (toMsgDirection md) (Just fromChatId) (Just itemId))
+               in (ComposedMessage file Nothing mc', ciff)
               where
                 forwardName :: Contact -> ContactName
                 forwardName Contact {profile = LocalProfile {displayName, localAlias}}
                   | localAlias /= "" = localAlias
                   | otherwise = displayName
         CTGroup -> withGroupLock "forwardChatItem, from group" fromChatId $ do
-          gInfo <- withFastStore $ \db -> getGroupInfo db vr user fromChatId
-          (errs, items) <- lift $ partitionEithers <$> withStoreBatch (\db -> map (getGroupCI db) (L.toList itemIds))
-          unless (null errs) $ toView $ CRChatErrors (Just user) errs
-          mapM (ciComposeMsgReq gInfo) items
+          (gInfo, items) <- getCommandGroupChatItems user fromChatId itemIds
+          catMaybes <$> mapM (\ci -> ciComposeMsgReq gInfo ci <$$> prepareMsgReq ci) items
           where
-            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
-              file <- forwardCryptoFile ci
+            ciComposeMsgReq :: GroupInfo -> CChatItem 'CTGroup -> (MsgContent, Maybe CryptoFile) -> ComposeMessageReq
+            ciComposeMsgReq gInfo (CChatItem md ci) (mc', file) = do
               let itemId = chatItemId' ci
-                  ciff = forwardCIFF ci $ Just (CIFFGroup (forwardName gInfo) mDir (Just fromChatId) (Just itemId))
-              pure (ComposedMessage file Nothing mc, ciff)
+                  ciff = forwardCIFF ci $ Just (CIFFGroup (forwardName gInfo) (toMsgDirection md) (Just fromChatId) (Just itemId))
+               in (ComposedMessage file Nothing mc', ciff)
               where
                 forwardName :: GroupInfo -> ContactName
                 forwardName GroupInfo {groupProfile = GroupProfile {displayName}} = displayName
         CTLocal -> do
-          (errs, items) <- lift $ partitionEithers <$> withStoreBatch (\db -> map (getLocalCI db) (L.toList itemIds))
-          unless (null errs) $ toView $ CRChatErrors (Just user) errs
-          mapM ciComposeMsgReq items
+          (_, items) <- getCommandLocalChatItems user fromChatId itemIds
+          catMaybes <$> mapM (\ci -> ciComposeMsgReq ci <$$> prepareMsgReq ci) items
           where
-            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
-              file <- forwardCryptoFile ci
+            ciComposeMsgReq :: CChatItem 'CTLocal -> (MsgContent, Maybe CryptoFile) -> ComposeMessageReq
+            ciComposeMsgReq (CChatItem _ ci) (mc', file) =
               let ciff = forwardCIFF ci Nothing
-              pure (ComposedMessage file Nothing mc, ciff)
+               in (ComposedMessage file Nothing mc', ciff)
         CTContactRequest -> throwChatError $ CECommandError "not supported"
         CTContactConnection -> throwChatError $ CECommandError "not supported"
         where
-          forwardMC :: ChatItem c d -> CM (MsgContent, MsgDirection)
-          forwardMC ChatItem {meta = CIMeta {itemDeleted = Just _}} = throwChatError CEInvalidForward
-          forwardMC ChatItem {content = CISndMsgContent fmc} = pure (fmc, MDSnd)
-          forwardMC ChatItem {content = CIRcvMsgContent fmc} = pure (fmc, MDRcv)
-          forwardMC _ = throwChatError CEInvalidForward
+          prepareMsgReq :: CChatItem c -> CM (Maybe (MsgContent, Maybe CryptoFile))
+          prepareMsgReq (CChatItem _ ci) = forwardMsgContent ci $>>= forwardContent ci
           forwardCIFF :: ChatItem c d -> Maybe CIForwardedFrom -> Maybe CIForwardedFrom
           forwardCIFF ChatItem {meta = CIMeta {itemForwarded}} ciff = case itemForwarded of
             Nothing -> ciff
             Just CIFFUnknown -> ciff
             Just prevCIFF -> Just prevCIFF
-          forwardCryptoFile :: ChatItem c d -> CM (Maybe CryptoFile)
-          forwardCryptoFile ChatItem {file = Nothing} = pure Nothing
-          forwardCryptoFile ChatItem {file = Just ciFile} = case ciFile of
+          forwardContent :: ChatItem c d -> MsgContent -> CM (Maybe (MsgContent, Maybe CryptoFile))
+          forwardContent ChatItem {file = Nothing} mc = pure $ Just (mc, Nothing)
+          forwardContent ChatItem {file = Just ciFile} mc = case ciFile of
             CIFile {fileName, fileSource = Just fromCF@CryptoFile {filePath}} ->
               chatReadVar filesFolder >>= \case
                 Nothing ->
-                  ifM (doesFileExist filePath) (pure $ Just fromCF) (pure Nothing)
+                  ifM (doesFileExist filePath) (pure $ Just (mc, Just fromCF)) (pure contentWithoutFile)
                 Just filesFolder -> do
                   let fsFromPath = filesFolder </> filePath
                   ifM
@@ -1089,10 +1097,17 @@ processChatCommand' vr = \case
                         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 $ Just (mc, Just (toCF {filePath = takeFileName fsNewPath} :: CryptoFile))
                     )
-                    (pure Nothing)
-            _ -> pure Nothing
+                    (pure contentWithoutFile)
+            _ -> pure contentWithoutFile
+            where
+              contentWithoutFile = case mc of
+                MCImage {} -> Just (mc, Nothing)
+                MCLink {} -> Just (mc, Nothing)
+                _ | contentText /= "" -> Just (MCText contentText, Nothing)
+                _ -> Nothing
+              contentText = msgContentText mc
           copyCryptoFile :: CryptoFile -> CryptoFile -> ExceptT CF.FTCryptoError IO ()
           copyCryptoFile fromCF@CryptoFile {filePath = fsFromPath, cryptoArgs = fromArgs} toCF@CryptoFile {cryptoArgs = toArgs} = do
             fromSizeFull <- getFileSize fsFromPath
@@ -3087,6 +3102,38 @@ processChatCommand' vr = \case
         | (msg_, (ComposedMessage {msgContent}, itemForwarded), f, q) <-
             zipWith4 (,,,) msgs_ (L.toList cmrs') (L.toList ciFiles_) (L.toList quotedItems_)
       ]
+    getCommandDirectChatItems :: User -> Int64 -> NonEmpty ChatItemId -> CM (Contact, [CChatItem 'CTDirect])
+    getCommandDirectChatItems user ctId itemIds = do
+      ct <- withFastStore $ \db -> getContact db vr user ctId
+      (errs, items) <- lift $ partitionEithers <$> withStoreBatch (\db -> map (getDirectCI db) (L.toList itemIds))
+      unless (null errs) $ toView $ CRChatErrors (Just user) errs
+      pure (ct, items)
+      where
+        getDirectCI :: DB.Connection -> ChatItemId -> IO (Either ChatError (CChatItem 'CTDirect))
+        getDirectCI db itemId = runExceptT . withExceptT ChatErrorStore $ getDirectChatItem db user ctId itemId
+    getCommandGroupChatItems :: User -> Int64 -> NonEmpty ChatItemId -> CM (GroupInfo, [CChatItem 'CTGroup])
+    getCommandGroupChatItems user gId itemIds = do
+      gInfo <- withFastStore $ \db -> getGroupInfo db vr user gId
+      (errs, items) <- lift $ partitionEithers <$> withStoreBatch (\db -> map (getGroupCI db) (L.toList itemIds))
+      unless (null errs) $ toView $ CRChatErrors (Just user) errs
+      pure (gInfo, items)
+      where
+        getGroupCI :: DB.Connection -> ChatItemId -> IO (Either ChatError (CChatItem 'CTGroup))
+        getGroupCI db itemId = runExceptT . withExceptT ChatErrorStore $ getGroupChatItem db user gId itemId
+    getCommandLocalChatItems :: User -> Int64 -> NonEmpty ChatItemId -> CM (NoteFolder, [CChatItem 'CTLocal])
+    getCommandLocalChatItems user nfId itemIds = do
+      nf <- withStore $ \db -> getNoteFolder db user nfId
+      (errs, items) <- lift $ partitionEithers <$> withStoreBatch (\db -> map (getLocalCI db) (L.toList itemIds))
+      unless (null errs) $ toView $ CRChatErrors (Just user) errs
+      pure (nf, items)
+      where
+        getLocalCI :: DB.Connection -> ChatItemId -> IO (Either ChatError (CChatItem 'CTLocal))
+        getLocalCI db itemId = runExceptT . withExceptT ChatErrorStore $ getLocalChatItem db user nfId itemId
+    forwardMsgContent :: ChatItem c d -> CM (Maybe MsgContent)
+    forwardMsgContent ChatItem {meta = CIMeta {itemDeleted = Just _}} = pure Nothing -- this can be deleted after selection
+    forwardMsgContent ChatItem {content = CISndMsgContent fmc} = pure $ Just fmc
+    forwardMsgContent ChatItem {content = CIRcvMsgContent fmc} = pure $ Just fmc
+    forwardMsgContent _ = throwChatError CEInvalidForward
     createNoteFolderContentItems :: User -> NoteFolderId -> NonEmpty ComposeMessageReq -> CM ChatResponse
     createNoteFolderContentItems user folderId cmrs = do
       assertNoQuotes
@@ -7888,6 +7935,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 plan " *> (APIPlanForwardChatItems <$> chatRefP <*> _strP),
       "/_forward " *> (APIForwardChatItems <$> chatRefP <* A.space <*> chatRefP <*> _strP <*> sendMessageTTLP),
       "/_read user " *> (APIUserRead <$> A.decimal),
       "/read user" $> UserRead,

src/Simplex/Chat/Controller.hs

@@ -298,6 +298,7 @@ data ChatCommand
   | APIDeleteChatItem ChatRef (NonEmpty ChatItemId) CIDeleteMode
   | APIDeleteMemberChatItem GroupId (NonEmpty ChatItemId)
   | APIChatItemReaction {chatRef :: ChatRef, chatItemId :: ChatItemId, add :: Bool, reaction :: MsgReaction}
+  | APIPlanForwardChatItems {fromChatRef :: ChatRef, chatItemIds :: NonEmpty ChatItemId}
   | APIForwardChatItems {toChatRef :: ChatRef, fromChatRef :: ChatRef, chatItemIds :: NonEmpty ChatItemId, ttl :: Maybe Int}
   | APIUserRead UserId
   | UserRead
@@ -649,6 +650,7 @@ data ChatResponse
   | CRContactRequestAlreadyAccepted {user :: User, contact :: Contact}
   | CRLeftMemberUser {user :: User, groupInfo :: GroupInfo}
   | CRGroupDeletedUser {user :: User, groupInfo :: GroupInfo}
+  | CRForwardPlan {user :: User, itemsCount :: Int, chatItemIds :: [ChatItemId], forwardConfirmation :: Maybe ForwardConfirmation}
   | CRRcvFileDescrReady {user :: User, chatItem :: AChatItem, rcvFileTransfer :: RcvFileTransfer, rcvFileDescr :: RcvFileDescr}
   | CRRcvFileAccepted {user :: User, chatItem :: AChatItem}
   | CRRcvFileAcceptedSndCancelled {user :: User, rcvFileTransfer :: RcvFileTransfer}
@@ -905,6 +907,13 @@ connectionPlanProceed = \case
     GLPConnectingConfirmReconnect -> True
     _ -> False
 
+data ForwardConfirmation
+  = FCFilesNotAccepted {fileIds :: [FileTransferId]}
+  | FCFilesInProgress {filesCount :: Int}
+  | FCFilesMissing {filesCount :: Int}
+  | FCFilesFailed {filesCount :: Int}
+  deriving (Show)
+
 newtype UserPwd = UserPwd {unUserPwd :: Text}
   deriving (Eq, Show)
 
@@ -1463,6 +1472,8 @@ $(JQ.deriveJSON (sumTypeJSON $ dropPrefix "GLP") ''GroupLinkPlan)
 
 $(JQ.deriveJSON (sumTypeJSON $ dropPrefix "CP") ''ConnectionPlan)
 
+$(JQ.deriveJSON defaultJSON ''ForwardConfirmation)
+
 $(JQ.deriveJSON (sumTypeJSON $ dropPrefix "CE") ''ChatErrorType)
 
 $(JQ.deriveJSON (sumTypeJSON $ dropPrefix "RHE") ''RemoteHostError)

src/Simplex/Chat/Messages.hs

@@ -595,6 +595,27 @@ ciFileLoaded = \case
   CIFSRcvWarning {} -> False
   CIFSInvalid {} -> False
 
+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
+
 data ACIFileStatus = forall d. MsgDirectionI d => AFS (SMsgDirection d) (CIFileStatus d)
 
 deriving instance Show ACIFileStatus

src/Simplex/Chat/View.hs

@@ -203,6 +203,7 @@ responseToView hu@(currentRH, user_) ChatConfig {logLevel, showReactions, showRe
   CRUnknownMemberBlocked u g byM um -> ttyUser u [ttyGroup' g <> ": " <> ttyMember byM <> " blocked an unknown member, creating unknown member record " <> ttyMember um]
   CRUnknownMemberAnnounced u g _ um m -> ttyUser u [ttyGroup' g <> ": unknown member " <> ttyMember um <> " updated to " <> ttyMember m]
   CRGroupDeletedUser u g -> ttyUser u [ttyGroup' g <> ": you deleted the group"]
+  CRForwardPlan u count itemIds fc -> ttyUser u $ viewForwardPlan count itemIds fc
   CRRcvFileDescrReady _ _ _ _ -> []
   CRRcvFileProgressXFTP {} -> []
   CRRcvFileAccepted u ci -> ttyUser u $ savingFile' ci
@@ -930,6 +931,20 @@ viewUserContactLinkDeleted =
     "To create a new chat address use " <> highlight' "/ad"
   ]
 
+viewForwardPlan :: Int -> [ChatItemId] -> Maybe ForwardConfirmation -> [StyledString]
+viewForwardPlan count itemIds = maybe [forwardCount] $ \fc -> [confirmation fc, forwardCount]
+  where
+    confirmation = \case
+      FCFilesNotAccepted fileIds -> plain $ "Files can be received: " <> intercalate ", " (map show fileIds)
+      FCFilesInProgress cnt -> plain $ "Still receiving " <> show cnt <> " file(s)"
+      FCFilesMissing cnt -> plain $ show cnt <> " file(s) are missing"
+      FCFilesFailed cnt -> plain $ "Receiving " <> show cnt <> " file(s) failed"
+    forwardCount
+      | count == len = "all messages can be forwarded"
+      | len == 0 = "nothing to forward"
+      | otherwise = plain $ show len <> " message(s) out of " <> show count <> " can be forwarded"
+    len = length itemIds
+
 connReqContact_ :: StyledString -> ConnReqContact -> [StyledString]
 connReqContact_ intro cReq =
   [ intro,
@@ -2034,7 +2049,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 this message"]
+    CEInvalidForward -> ["cannot forward message(s)"]
     CEInvalidChatItemUpdate -> ["cannot update this item"]
     CEInvalidChatItemDelete -> ["cannot delete this item"]
     CEHasCurrentCall -> ["call already in progress"]

tests/ChatTests/Forward.hs

@@ -7,7 +7,11 @@ import ChatClient
 import ChatTests.Utils
 import Control.Concurrent (threadDelay)
 import qualified Data.ByteString.Char8 as B
-import System.Directory (copyFile, doesFileExist)
+import Data.List (intercalate)
+import qualified Data.Text as T
+import System.Directory (copyFile, doesFileExist, removeFile)
+import Simplex.Chat (fixedImagePreview)
+import Simplex.Chat.Types (ImageData (..))
 import Test.Hspec hiding (it)
 
 chatForwardTests :: SpecWith FilePath
@@ -613,6 +617,8 @@ testForwardContactToContactMulti =
       alice <# "bob> hey"
       msgId2 <- lastItemId alice
 
+      alice ##> ("/_forward plan @2 " <> msgId1 <> "," <> msgId2)
+      alice <## "all messages can be forwarded"
       alice ##> ("/_forward @3 @2 " <> msgId1 <> "," <> msgId2)
       alice <# "@cath <- you @bob"
       alice <## "      hi"
@@ -642,6 +648,8 @@ testForwardGroupToGroupMulti =
       alice <# "#team bob> hey"
       msgId2 <- lastItemId alice
 
+      alice ##> ("/_forward plan #1 " <> msgId1 <> "," <> msgId2)
+      alice <## "all messages can be forwarded"
       alice ##> ("/_forward #2 #1 " <> msgId1 <> "," <> msgId2)
       alice <# "#club <- you #team"
       alice <## "      hi"
@@ -672,6 +680,7 @@ testMultiForwardFiles =
       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.pdf" "./tests/tmp/alice_app_files/test.pdf"
+      copyFile "./tests/fixtures/test_1MB.pdf" "./tests/tmp/alice_app_files/test_1MB.pdf"
       setRelativePaths bob "./tests/tmp/bob_app_files" "./tests/tmp/bob_xftp"
       setRelativePaths cath "./tests/tmp/cath_app_files" "./tests/tmp/cath_xftp"
       connectUsers alice bob
@@ -686,32 +695,46 @@ testMultiForwardFiles =
 
       -- send original files
       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\"}}"
-      alice ##> ("/_send @2 json [" <> cm1 <> "," <> cm2 <> "," <> cm3 <> "]")
+          ImageData img = fixedImagePreview
+          cm2 = "{\"filePath\": \"test.jpg\", \"msgContent\": {\"type\": \"image\", \"image\":\"" <> T.unpack img <> "\", \"text\": \"\"}}"
+          cm3 = "{\"filePath\": \"test.pdf\", \"msgContent\": {\"type\": \"file\", \"text\": \"\"}}"
+          cm4 = "{\"filePath\": \"test_1MB.pdf\", \"msgContent\": {\"type\": \"file\", \"text\": \"message with large file\"}}"
+      alice ##> ("/_send @2 json [" <> cm1 <> "," <> cm2 <> "," <> cm3 <> "," <> cm4 <> "]")
 
       alice <# "@bob message without file"
 
-      alice <# "@bob sending file 1"
       alice <# "/f @bob test.jpg"
       alice <## "use /fc 1 to cancel sending"
 
-      alice <# "@bob sending file 2"
       alice <# "/f @bob test.pdf"
       alice <## "use /fc 2 to cancel sending"
 
+      alice <# "@bob message with large file"
+      alice <# "/f @bob test_1MB.pdf"
+      alice <## "use /fc 3 to cancel sending"
+
       bob <# "alice> message without file"
 
-      bob <# "alice> sending file 1"
       bob <# "alice> sends file test.jpg (136.5 KiB / 139737 bytes)"
       bob <## "use /fr 1 [<dir>/ | <path>] to receive it"
 
-      bob <# "alice> sending file 2"
       bob <# "alice> sends file test.pdf (266.0 KiB / 272376 bytes)"
       bob <## "use /fr 2 [<dir>/ | <path>] to receive it"
 
+      bob <# "alice> message with large file"
+      bob <# "alice> sends file test_1MB.pdf (1017.7 KiB / 1042157 bytes)"
+      bob <## "use /fr 3 [<dir>/ | <path>] 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_1MB.pdf) for bob"
+
+      -- IDs to forward
+      let msgId1 = (read msgIdZero :: Int) + 1
+          msgIds = intercalate "," $ map show [msgId1, msgId1 + 1, msgId1 + 2, msgId1 + 3, msgId1 + 4]
+      bob ##> ("/_forward plan @2 " <> msgIds)
+      bob <## "Files can be received: 1, 2, 3"
+      bob <## "4 message(s) out of 5 can be forwarded"
 
       bob ##> "/fr 1"
       bob
@@ -720,6 +743,10 @@ testMultiForwardFiles =
              ]
       bob <## "completed receiving file 1 (test.jpg) from alice"
 
+      bob ##> ("/_forward plan @2 " <> msgIds)
+      bob <## "Files can be received: 2, 3"
+      bob <## "4 message(s) out of 5 can be forwarded"
+
       bob ##> "/fr 2"
       bob
         <### [ "saving file 2 from alice to test.pdf",
@@ -736,8 +763,10 @@ testMultiForwardFiles =
       dest2 `shouldBe` src2
 
       -- forward file
-      let msgId1 = (read msgIdZero :: Int) + 1
-      bob ##> ("/_forward @3 @2 " <> show msgId1 <> "," <> show (msgId1 + 1) <> "," <> show (msgId1 + 2) <> "," <> show (msgId1 + 3))
+      bob ##> ("/_forward plan @2 " <> msgIds)
+      bob <## "Files can be received: 3"
+      bob <## "all messages can be forwarded"
+      bob ##> ("/_forward @3 @2 " <> msgIds)
 
       -- messages printed for bob
       bob <# "@cath <- you @alice"
@@ -747,14 +776,17 @@ testMultiForwardFiles =
       bob <## "      message without file"
 
       bob <# "@cath <- @alice"
-      bob <## "      sending file 1"
+      bob <## "      test_1.jpg"
       bob <# "/f @cath test_1.jpg"
-      bob <## "use /fc 3 to cancel sending"
+      bob <## "use /fc 4 to cancel sending"
 
       bob <# "@cath <- @alice"
-      bob <## "      sending file 2"
+      bob <## "      test_1.pdf"
       bob <# "/f @cath test_1.pdf"
-      bob <## "use /fc 4 to cancel sending"
+      bob <## "use /fc 5 to cancel sending"
+
+      bob <# "@cath <- @alice"
+      bob <## "      message with large file"
 
       -- messages printed for cath
       cath <# "bob> -> forwarded"
@@ -764,18 +796,21 @@ testMultiForwardFiles =
       cath <## "      message without file"
 
       cath <# "bob> -> forwarded"
-      cath <## "      sending file 1"
+      cath <## "      test_1.jpg"
       cath <# "bob> sends file test_1.jpg (136.5 KiB / 139737 bytes)"
       cath <## "use /fr 1 [<dir>/ | <path>] to receive it"
 
       cath <# "bob> -> forwarded"
-      cath <## "      sending file 2"
+      cath <## "      test_1.pdf"
       cath <# "bob> sends file test_1.pdf (266.0 KiB / 272376 bytes)"
       cath <## "use /fr 2 [<dir>/ | <path>] to receive it"
 
+      cath <# "bob> -> forwarded"
+      cath <## "      message with large file"
+
       -- file transfer
-      bob <## "completed uploading file 3 (test_1.jpg) for cath"
-      bob <## "completed uploading file 4 (test_1.pdf) for cath"
+      bob <## "completed uploading file 4 (test_1.jpg) for cath"
+      bob <## "completed uploading file 5 (test_1.pdf) for cath"
 
       cath ##> "/fr 1"
       cath
@@ -801,6 +836,26 @@ testMultiForwardFiles =
       dest2C <- B.readFile "./tests/tmp/cath_app_files/test_1.pdf"
       dest2C `shouldBe` src2B
 
+      bob ##> "/fr 3"
+      bob
+        <### [ "saving file 3 from alice to test_1MB.pdf",
+               "started receiving file 3 (test_1MB.pdf) from alice"
+             ]
+      bob <## "completed receiving file 3 (test_1MB.pdf) from alice"
+
+      bob ##> ("/_forward plan @2 " <> msgIds)
+      bob <## "all messages can be forwarded"
+
+      removeFile "./tests/tmp/bob_app_files/test_1MB.pdf"
+      bob ##> ("/_forward plan @2 " <> msgIds)
+      bob <## "1 file(s) are missing"
+      bob <## "all messages can be forwarded"
+
+      removeFile "./tests/tmp/bob_app_files/test.pdf"
+      bob ##> ("/_forward plan @2 " <> msgIds)
+      bob <## "2 file(s) are missing"
+      bob <## "4 message(s) out of 5 can be forwarded"
+
       -- deleting original file doesn't delete forwarded file
       checkActionDeletesFile "./tests/tmp/bob_app_files/test.jpg" $ do
         bob ##> "/clear alice"