rfc: handling multiple files/attachments in a message

docs/rfcs/2024-01-02-multiple-attachments.md

@@ -0,0 +1,39 @@
+# Sending multiple files with a message
+
+## Problem
+
+The immediate problem we need to solve is encrypting local videos, the absense of which creates a lot of confusion and perception that the videos are sent unencrypted.
+
+The reason videos are not encrypted is because they are usually large files that would be slow to decrypt in order to play, and they are also used to generate previews on the fly. The latter is slow anyway, and causes bad rendering experience.
+
+Videos on iOS are compressed from 5.4.2, and the solution to keep them encrypted is to keep video preview in a separate file. It can be done either on the receiving side, when the video is first rendered, or on the sending side, in which case we can send the preview as a separate file.
+
+In general, attaching multiple files to a message could be beneficial for other cases, such as sending hi- and low-res images at the same time, or sending long-form messages with attachments.
+
+## Solutions
+
+1. Extend chat protocol to allow multiple attachments in a single protocol message. This PR has types to support it, and database schema already supports multiple files with chat item. Different message types can allow a limited number of files and interpret them according to their indices in the array. This seems an ad hoc approach, as semantics of the additional attachments are not defined in the protocol and should be implied by file positions.
+
+2. Still allow multiple attachments but add file semantics in the protocol message, alongside FileInvitation object, e.g.:
+
+```
+data FileAttachment = FileAttachment
+  { file :: FileInvitation,
+    fileType :: FileAttachmentType
+  }
+```
+
+This format is marginally more complex, but it is more extensible.
+
+3. Instead of allowing multiple attachments in a message, we could allow up to two files for a single attachment (which is what we need now), that could later be useful for messages with multiple attachments as well. This way FileInvitation will be replaced with:
+
+```
+data FileAttachment = FileAttachment
+  { preview :: Maybe FileInvitation, -- received automatically if "receive images" is enabled
+    file :: FileInvitation, -- received automatically if "receive images" is enabled for images, in the absense of preview
+  }
+```
+
+4. Add additional protocol message to send additional attachments separately.
+
+5. To solve only original problem of videos, we could add an API to save previews on the first render - this seems the worst approach, as it both complicates the logic of the recipient, without allowing other use cases.

src/Simplex/Chat.hs

@@ -688,15 +688,15 @@ processChatCommand' vr = \case
                 pure (fileInvitation, ciFile, ft)
         prepareMsg :: Maybe FileInvitation -> Maybe CITimed -> m (MsgContainer, Maybe (CIQuote 'CTDirect))
         prepareMsg fInv_ timed_ = case quotedItemId_ of
-          Nothing -> pure (MCSimple (ExtMsgContent mc fInv_ (ttl' <$> timed_) (justTrue live)), Nothing)
+          Nothing -> pure (MCSimple (ExtMsgContent mc (maybeToList fInv_) (ttl' <$> timed_) (justTrue live)), Nothing)
           Just quotedItemId -> do
             CChatItem _ qci@ChatItem {meta = CIMeta {itemTs, itemSharedMsgId}, formattedText, file} <-
               withStore $ \db -> getDirectChatItem db user chatId quotedItemId
             (origQmc, qd, sent) <- quoteData qci
             let msgRef = MsgRef {msgId = itemSharedMsgId, sentAt = itemTs, sent, memberId = Nothing}
-                qmc = quoteContent mc origQmc file
+                qmc = quoteContent mc origQmc (listToMaybe file)
                 quotedItem = CIQuote {chatDir = qd, itemId = Just quotedItemId, sharedMsgId = itemSharedMsgId, sentAt = itemTs, content = qmc, formattedText}
-            pure (MCQuote QuotedMsg {msgRef, content = qmc} (ExtMsgContent mc fInv_ (ttl' <$> timed_) (justTrue live)), Just quotedItem)
+            pure (MCQuote QuotedMsg {msgRef, content = qmc} (ExtMsgContent mc (maybeToList fInv_) (ttl' <$> timed_) (justTrue live)), Just quotedItem)
           where
             quoteData :: ChatItem c d -> m (MsgContent, CIQDirection 'CTDirect, Bool)
             quoteData ChatItem {meta = CIMeta {itemDeleted = Just _}} = throwChatError CEInvalidQuote
@@ -1540,7 +1540,7 @@ processChatCommand' vr = \case
       sendAndCount user ll (s, f) ct =
         (sendToContact user ct $> (s + 1, f)) `catchChatError` \e -> when (ll <= CLLInfo) (toView $ CRChatError (Just user) e) $> (s, f + 1)
       sendToContact user ct = do
-        (sndMsg, _) <- sendDirectContactMessage ct (XMsgNew $ MCSimple (extMsgContent mc Nothing))
+        (sndMsg, _) <- sendDirectContactMessage ct (XMsgNew $ MCSimple (extMsgContent mc []))
         void $ saveSndChatItem user (CDDirectSnd ct) sndMsg (CISndMsgContent mc)
   SendMessageQuote cName (AMsgDirection msgDir) quotedMsg msg -> withUser $ \user@User {userId} -> do
     contactId <- withStore $ \db -> getContactIdByName db user cName
@@ -1906,7 +1906,7 @@ processChatCommand' vr = \case
   FileStatus fileId -> withUser $ \user -> do
     ci@(AChatItem _ _ _ ChatItem {file}) <- withStore $ \db -> getChatItemByFileId db vr user fileId
     case file of
-      Just CIFile {fileProtocol = FPXFTP} ->
+      CIFile {fileProtocol = FPXFTP} : _ ->
         pure $ CRFileTransferStatusXFTP user ci
       _ -> do
         fileStatus <- withStore $ \db -> getFileTransferProgress db user fileId
@@ -2401,15 +2401,15 @@ processChatCommand' vr = \case
 
 prepareGroupMsg :: forall m. ChatMonad m => User -> GroupInfo -> MsgContent -> Maybe ChatItemId -> Maybe FileInvitation -> Maybe CITimed -> Bool -> m (MsgContainer, Maybe (CIQuote 'CTGroup))
 prepareGroupMsg user GroupInfo {groupId, membership} mc quotedItemId_ fInv_ timed_ live = case quotedItemId_ of
-  Nothing -> pure (MCSimple (ExtMsgContent mc fInv_ (ttl' <$> timed_) (justTrue live)), Nothing)
+  Nothing -> pure (MCSimple (ExtMsgContent mc (maybeToList fInv_) (ttl' <$> timed_) (justTrue live)), Nothing)
   Just quotedItemId -> do
     CChatItem _ qci@ChatItem {meta = CIMeta {itemTs, itemSharedMsgId}, formattedText, file} <-
       withStore $ \db -> getGroupChatItem db user groupId quotedItemId
     (origQmc, qd, sent, GroupMember {memberId}) <- quoteData qci membership
     let msgRef = MsgRef {msgId = itemSharedMsgId, sentAt = itemTs, sent, memberId = Just memberId}
-        qmc = quoteContent mc origQmc file
+        qmc = quoteContent mc origQmc (listToMaybe file)
         quotedItem = CIQuote {chatDir = qd, itemId = Just quotedItemId, sharedMsgId = itemSharedMsgId, sentAt = itemTs, content = qmc, formattedText}
-    pure (MCQuote QuotedMsg {msgRef, content = qmc} (ExtMsgContent mc fInv_ (ttl' <$> timed_) (justTrue live)), Just quotedItem)
+    pure (MCQuote QuotedMsg {msgRef, content = qmc} (ExtMsgContent mc (maybeToList fInv_) (ttl' <$> timed_) (justTrue live)), Just quotedItem)
   where
     quoteData :: ChatItem c d -> GroupMember -> m (MsgContent, CIQDirection 'CTGroup, Bool, GroupMember)
     quoteData ChatItem {meta = CIMeta {itemDeleted = Just _}} _ = throwChatError CEInvalidQuote
@@ -3211,7 +3211,7 @@ processAgentMsgSndFile _corrId aFileId msg =
             -- returns msgDeliveryId of the last file description message
             loopSend :: NonEmpty FileDescr -> m Int64
             loopSend (fileDescr :| fds) = do
-              (_, msgDeliveryId) <- sendMsg $ XMsgFileDescr {msgId, fileDescr}
+              (_, msgDeliveryId) <- sendMsg $ XMsgFileDescr {msgId, fileId = Nothing, fileDescr}
               case L.nonEmpty fds of
                 Just fds' -> loopSend fds'
                 Nothing -> pure msgDeliveryId
@@ -3364,7 +3364,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
             updateChatLock "directMessage" event
             case event of
               XMsgNew mc -> newContentMessage ct' mc msg msgMeta
-              XMsgFileDescr sharedMsgId fileDescr -> messageFileDescription ct' sharedMsgId fileDescr msgMeta
+              XMsgFileDescr sharedMsgId _fileId fileDescr -> messageFileDescription ct' sharedMsgId fileDescr msgMeta
               XMsgUpdate sharedMsgId mContent ttl live -> messageUpdate ct' sharedMsgId mContent msg msgMeta ttl live
               XMsgDel sharedMsgId _ -> messageDelete ct' sharedMsgId msg msgMeta
               XMsgReact sharedMsgId _ reaction add -> directMsgReaction ct' sharedMsgId reaction add msg msgMeta
@@ -3438,7 +3438,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
                 let (UserContactLink {autoAccept}, groupId_, gLinkMemRole) = ucl
                 forM_ autoAccept $ \(AutoAccept {autoReply = mc_}) ->
                   forM_ mc_ $ \mc -> do
-                    (msg, _) <- sendDirectContactMessage ct (XMsgNew $ MCSimple (extMsgContent mc Nothing))
+                    (msg, _) <- sendDirectContactMessage ct (XMsgNew $ MCSimple (extMsgContent mc []))
                     ci <- saveSndChatItem user (CDDirectSnd ct) msg (CISndMsgContent mc)
                     toView $ CRNewChatItem user (AChatItem SCTDirect SMDSnd (DirectChat ct) ci)
                 forM_ groupId_ $ \groupId -> do
@@ -3649,15 +3649,15 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
               descrEvent_
                 | isCompatibleRange (memberChatVRange' m) groupHistoryIncludeWelcomeVRange = do
                     let GroupInfo {groupProfile = GroupProfile {description}} = gInfo
-                    fmap (\descr -> XMsgNew $ MCSimple $ extMsgContent (MCText descr) Nothing) description
+                    fmap (\descr -> XMsgNew $ MCSimple $ extMsgContent (MCText descr) []) description
                 | otherwise = Nothing
               itemForwardEvents :: CChatItem 'CTGroup -> m [ChatMsgEvent 'Json]
               itemForwardEvents cci = case cci of
                 (CChatItem SMDRcv ci@ChatItem {chatDir = CIGroupRcv sender, content = CIRcvMsgContent mc, file}) -> do
-                  fInvDescr_ <- join <$> forM file getRcvFileInvDescr
+                  fInvDescr_ <- join <$> forM (listToMaybe file) getRcvFileInvDescr
                   processContentItem sender ci mc fInvDescr_
                 (CChatItem SMDSnd ci@ChatItem {content = CISndMsgContent mc, file}) -> do
-                  fInvDescr_ <- join <$> forM file getSndFileInvDescr
+                  fInvDescr_ <- join <$> forM (listToMaybe file) getSndFileInvDescr
                   processContentItem membership ci mc fInvDescr_
                 _ -> pure []
                 where
@@ -3705,7 +3705,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
                         fileDescrEvents <- case (snd <$> fInvDescr_, itemSharedMsgId) of
                           (Just fileDescrText, Just msgId) -> do
                             parts <- splitFileDescr fileDescrText
-                            pure . toList $ L.map (XMsgFileDescr msgId) parts
+                            pure . toList $ L.map (XMsgFileDescr msgId Nothing) parts
                           _ -> pure []
                         let fileDescrChatMsgs = map (ChatMessage senderVRange Nothing) fileDescrEvents
                             GroupMember {memberId} = sender
@@ -3762,7 +3762,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
             updateChatLock "groupMessage" event
             case event of
               XMsgNew mc -> memberCanSend m' $ newGroupContentMessage gInfo m' mc msg brokerTs False
-              XMsgFileDescr sharedMsgId fileDescr -> memberCanSend m' $ groupMessageFileDescription gInfo m' sharedMsgId fileDescr
+              XMsgFileDescr sharedMsgId _fileId fileDescr -> memberCanSend m' $ groupMessageFileDescription gInfo m' sharedMsgId fileDescr
               XMsgUpdate sharedMsgId mContent ttl live -> memberCanSend m' $ groupMessageUpdate gInfo m' sharedMsgId mContent msg brokerTs ttl live
               XMsgDel sharedMsgId memberId -> groupMessageDelete gInfo m' sharedMsgId memberId msg brokerTs
               XMsgReact sharedMsgId (Just memberId) reaction add -> groupMsgReaction gInfo m' sharedMsgId memberId reaction add msg brokerTs
@@ -4246,7 +4246,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
           let ExtMsgContent _ _ itemTTL live_ = mcExtMsgContent mc
               timed_ = rcvContactCITimed ct itemTTL
               live = fromMaybe False live_
-          file_ <- processFileInvitation fInv_ content $ \db -> createRcvFileTransfer db userId ct
+          file_ <- processFileInvitation (listToMaybe fInv_) content $ \db -> createRcvFileTransfer db userId ct
           newChatItem (CIRcvMsgContent content) (snd <$> file_) timed_ live
           autoAcceptFile file_
       where
@@ -4406,7 +4406,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
     newGroupContentMessage :: GroupInfo -> GroupMember -> MsgContainer -> RcvMessage -> UTCTime -> Bool -> m ()
     newGroupContentMessage gInfo m@GroupMember {memberId, memberRole} mc msg@RcvMessage {sharedMsgId_} brokerTs forwarded
       | isVoice content && not (groupFeatureAllowed SGFVoice gInfo) = rejected GFVoice
-      | not (isVoice content) && isJust fInv_ && not (groupFeatureAllowed SGFFiles gInfo) = rejected GFFiles
+      | not (isVoice content) && isJust (listToMaybe fInv_) && not (groupFeatureAllowed SGFFiles gInfo) = rejected GFFiles
       | otherwise = do
           let timed_ =
                 if forwarded
@@ -4429,11 +4429,11 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
               ci' <- withStore' $ \db -> updateGroupChatItemModerated db user gInfo ci moderator moderatedAt
               toView $ CRNewChatItem user $ AChatItem SCTGroup SMDRcv (GroupChat gInfo) ci'
           | otherwise = do
-              file_ <- processFileInvitation fInv_ content $ \db -> createRcvGroupFileTransfer db userId m
+              file_ <- processFileInvitation (listToMaybe fInv_) content $ \db -> createRcvGroupFileTransfer db userId m
               ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg sharedMsgId_ brokerTs (CIRcvMsgContent content) (snd <$> file_) timed_ False
               toView =<< markGroupCIDeleted user gInfo ci createdByMsgId False (Just moderator) moderatedAt
         createItem timed_ live = do
-          file_ <- processFileInvitation fInv_ content $ \db -> createRcvGroupFileTransfer db userId m
+          file_ <- processFileInvitation (listToMaybe fInv_) content $ \db -> createRcvGroupFileTransfer db userId m
           newChatItem (CIRcvMsgContent content) (snd <$> file_) timed_ live
           when (showMessages $ memberSettings m) $ autoAcceptFile file_
         newChatItem ciContent ciFile_ timed_ live = do
@@ -4587,7 +4587,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
         else messageError "x.file.acpt.inv: fileName is different from expected"
 
     assertSMPAcceptNotProhibited :: ChatItem c d -> m ()
-    assertSMPAcceptNotProhibited ChatItem {file = Just CIFile {fileId, fileProtocol}, content}
+    assertSMPAcceptNotProhibited ChatItem {file = CIFile {fileId, fileProtocol} : _, content}
       | fileProtocol == FPXFTP && not (imageOrVoice content) = throwChatError $ CEFallbackToSMPProhibited fileId
       | otherwise = pure ()
       where
@@ -4606,7 +4606,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
           liftIO $ deleteSndFileChunks db sft
           updateDirectCIFileStatus db vr user fileId CIFSSndComplete
         case file of
-          Just CIFile {fileProtocol = FPXFTP} -> do
+          CIFile {fileProtocol = FPXFTP} : _ -> do
             ft <- withStore $ \db -> getFileTransferMeta db user fileId
             toView $ CRSndFileCompleteXFTP user ci ft
           _ -> toView $ CRSndFileComplete user ci sft
@@ -5343,7 +5343,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
           rcvMsg@RcvMessage {chatMsgEvent = ACME _ event} <- saveGroupFwdRcvMsg user groupId m author body chatMsg
           case event of
             XMsgNew mc -> memberCanSend author $ newGroupContentMessage gInfo author mc rcvMsg msgTs True
-            XMsgFileDescr sharedMsgId fileDescr -> memberCanSend author $ groupMessageFileDescription gInfo author sharedMsgId fileDescr
+            XMsgFileDescr sharedMsgId _fileId fileDescr -> memberCanSend author $ groupMessageFileDescription gInfo author sharedMsgId fileDescr
             XMsgUpdate sharedMsgId mContent ttl live -> memberCanSend author $ groupMessageUpdate gInfo author sharedMsgId mContent rcvMsg msgTs ttl live
             XMsgDel sharedMsgId memId -> groupMessageDelete gInfo author sharedMsgId memId rcvMsg msgTs
             XMsgReact sharedMsgId (Just memId) reaction add -> groupMsgReaction gInfo author sharedMsgId memId reaction add rcvMsg msgTs
@@ -5875,17 +5875,17 @@ mkChatItem cd ciId content file quotedItem sharedMsgId itemTimed live itemTs for
   let itemText = ciContentToText content
       itemStatus = ciCreateStatus content
       meta = mkCIMeta ciId content itemText itemStatus sharedMsgId Nothing False itemTimed (justTrue live) currentTs itemTs forwardedByMember currentTs currentTs
-  pure ChatItem {chatDir = toCIDirection cd, meta, content, formattedText = parseMaybeMarkdownList itemText, quotedItem, reactions = [], file}
+  pure ChatItem {chatDir = toCIDirection cd, meta, content, formattedText = parseMaybeMarkdownList itemText, quotedItem, reactions = [], file = maybeToList file}
 
 deleteDirectCI :: (ChatMonad m, MsgDirectionI d) => User -> Contact -> ChatItem 'CTDirect d -> Bool -> Bool -> m ChatResponse
 deleteDirectCI user ct ci@ChatItem {file} byUser timed = do
-  deleteCIFile user file
+  deleteCIFile user $ listToMaybe file
   withStoreCtx' (Just "deleteDirectCI, deleteDirectChatItem") $ \db -> deleteDirectChatItem db user ct ci
   pure $ CRChatItemDeleted user (AChatItem SCTDirect msgDirection (DirectChat ct) ci) Nothing byUser timed
 
 deleteGroupCI :: (ChatMonad m, MsgDirectionI d) => User -> GroupInfo -> ChatItem 'CTGroup d -> Bool -> Bool -> Maybe GroupMember -> UTCTime -> m ChatResponse
 deleteGroupCI user gInfo ci@ChatItem {file} byUser timed byGroupMember_ deletedTs = do
-  deleteCIFile user file
+  deleteCIFile user $ listToMaybe file
   toCi <- withStoreCtx' (Just "deleteGroupCI, deleteGroupChatItem ...") $ \db ->
     case byGroupMember_ of
       Nothing -> deleteGroupChatItem db user gInfo ci $> Nothing
@@ -5902,7 +5902,7 @@ deleteCIFile user file_ =
 
 markDirectCIDeleted :: (ChatMonad m, MsgDirectionI d) => User -> Contact -> ChatItem 'CTDirect d -> MessageId -> Bool -> UTCTime -> m ChatResponse
 markDirectCIDeleted user ct ci@ChatItem {file} msgId byUser deletedTs = do
-  cancelCIFile user file
+  cancelCIFile user $ listToMaybe file
   ci' <- withStore' $ \db -> markDirectChatItemDeleted db user ct ci msgId deletedTs
   pure $ CRChatItemDeleted user (ctItem ci) (Just $ ctItem ci') byUser False
   where
@@ -5910,7 +5910,7 @@ markDirectCIDeleted user ct ci@ChatItem {file} msgId byUser deletedTs = do
 
 markGroupCIDeleted :: (ChatMonad m, MsgDirectionI d) => User -> GroupInfo -> ChatItem 'CTGroup d -> MessageId -> Bool -> Maybe GroupMember -> UTCTime -> m ChatResponse
 markGroupCIDeleted user gInfo ci@ChatItem {file} msgId byUser byGroupMember_ deletedTs = do
-  cancelCIFile user file
+  cancelCIFile user $ listToMaybe file
   ci' <- withStore' $ \db -> markGroupChatItemDeleted db user gInfo ci msgId byGroupMember_ deletedTs
   pure $ CRChatItemDeleted user (gItem ci) (Just $ gItem ci') byUser False
   where

src/Simplex/Chat/Messages.hs

@@ -146,7 +146,7 @@ data ChatItem (c :: ChatType) (d :: MsgDirection) = ChatItem
     formattedText :: Maybe MarkdownList,
     quotedItem :: Maybe (CIQuote c),
     reactions :: [CIReactionCount],
-    file :: Maybe (CIFile d)
+    file :: [CIFile d]
   }
   deriving (Show)
 
@@ -300,10 +300,11 @@ aChatItemId (AChatItem _ _ _ ci) = chatItemId' ci
 aChatItemTs :: AChatItem -> UTCTime
 aChatItemTs (AChatItem _ _ _ ci) = chatItemTs' ci
 
+-- TODO multiple files
 updateFileStatus :: forall c d. ChatItem c d -> CIFileStatus d -> ChatItem c d
 updateFileStatus ci@ChatItem {file} status = case file of
-  Just f -> ci {file = Just (f :: CIFile d) {fileStatus = status}}
+  f : _ -> ci {file = [(f :: CIFile d) {fileStatus = status}]}
-  Nothing -> ci
+  [] -> ci
 
 -- This type is not saved to DB, so all JSON encodings are platform-specific
 data CIMeta (c :: ChatType) (d :: MsgDirection) = CIMeta

src/Simplex/Chat/Protocol.hs

@@ -225,7 +225,7 @@ data AChatMessage = forall e. MsgEncodingI e => ACMsg (SMsgEncoding e) (ChatMess
 
 data ChatMsgEvent (e :: MsgEncoding) where
   XMsgNew :: MsgContainer -> ChatMsgEvent 'Json
-  XMsgFileDescr :: {msgId :: SharedMsgId, fileDescr :: FileDescr} -> ChatMsgEvent 'Json
+  XMsgFileDescr :: {msgId :: SharedMsgId, fileId :: Maybe Int, fileDescr :: FileDescr} -> ChatMsgEvent 'Json
   XMsgUpdate :: {msgId :: SharedMsgId, content :: MsgContent, ttl :: Maybe Int, live :: Maybe Bool} -> ChatMsgEvent 'Json
   XMsgDel :: SharedMsgId -> Maybe MemberId -> ChatMsgEvent 'Json
   XMsgDeleted :: ChatMsgEvent 'Json
@@ -277,10 +277,10 @@ deriving instance Show AChatMsgEvent
 
 isForwardedGroupMsg :: ChatMsgEvent e -> Bool
 isForwardedGroupMsg ev = case ev of
-  XMsgNew mc -> case mcExtMsgContent mc of
+  XMsgNew mc ->
-    ExtMsgContent {file = Just FileInvitation {fileInline = Just _}} -> False
+    let ExtMsgContent {file} = mcExtMsgContent mc
-    _ -> True
+     in all (\case FileInvitation {fileInline = Just _} -> False; _ -> True) file
-  XMsgFileDescr _ _ -> True
+  XMsgFileDescr _ _ _ -> True
   XMsgUpdate {} -> True
   XMsgDel _ _ -> True
   XMsgReact {} -> True
@@ -488,7 +488,7 @@ msgContentTag = \case
   MCFile {} -> MCFile_
   MCUnknown {tag} -> MCUnknown_ tag
 
-data ExtMsgContent = ExtMsgContent {content :: MsgContent, file :: Maybe FileInvitation, ttl :: Maybe Int, live :: Maybe Bool}
+data ExtMsgContent = ExtMsgContent {content :: MsgContent, file :: [FileInvitation], ttl :: Maybe Int, live :: Maybe Bool}
   deriving (Eq, Show)
 
 $(JQ.deriveJSON defaultJSON ''QuotedMsg)
@@ -528,9 +528,9 @@ parseMsgContainer v =
     <|> (v .: "forward" >>= \f -> (if f then MCForward else MCSimple) <$> mc)
     <|> MCSimple <$> mc
   where
-    mc = ExtMsgContent <$> v .: "content" <*> v .:? "file" <*> v .:? "ttl" <*> v .:? "live"
+    mc = ExtMsgContent <$> v .: "content" <*> (maybe [] msgFiles <$> v .:? "file") <*> v .:? "ttl" <*> v .:? "live"
 
-extMsgContent :: MsgContent -> Maybe FileInvitation -> ExtMsgContent
+extMsgContent :: MsgContent -> [FileInvitation] -> ExtMsgContent
 extMsgContent mc file = ExtMsgContent mc file Nothing Nothing
 
 justTrue :: Bool -> Maybe Bool
@@ -575,7 +575,19 @@ msgContainerJSON = \case
   MCSimple mc -> o $ msgContent mc
   where
     o = JM.fromList
-    msgContent (ExtMsgContent c file ttl live) = ("file" .=? file) $ ("ttl" .=? ttl) $ ("live" .=? live) ["content" .= c]
+    msgContent (ExtMsgContent c file ttl live) = ("file" .=? filesToJSON file) $ ("ttl" .=? ttl) $ ("live" .=? live) ["content" .= c]
+
+newtype MsgFiles = MsgFiles {msgFiles :: [FileInvitation]}
+  deriving (Eq, Show)
+
+instance FromJSON MsgFiles where
+  parseJSON v = MsgFiles <$> (((: []) <$> parseJSON v) <|> parseJSON v)
+
+filesToJSON :: [FileInvitation] -> Maybe J.Value
+filesToJSON = \case
+  [] -> Nothing
+  [f] -> Just $ J.toJSON f
+  fs -> Just $ J.toJSON fs
 
 instance ToJSON MsgContent where
   toJSON = \case
@@ -750,7 +762,7 @@ instance StrEncoding ACMEventTag where
 toCMEventTag :: ChatMsgEvent e -> CMEventTag e
 toCMEventTag msg = case msg of
   XMsgNew _ -> XMsgNew_
-  XMsgFileDescr _ _ -> XMsgFileDescr_
+  XMsgFileDescr _ _ _ -> XMsgFileDescr_
   XMsgUpdate {} -> XMsgUpdate_
   XMsgDel {} -> XMsgDel_
   XMsgDeleted -> XMsgDeleted_
@@ -849,7 +861,7 @@ appJsonToCM AppMessageJson {v, msgId, event, params} = do
     msg :: CMEventTag 'Json -> Either String (ChatMsgEvent 'Json)
     msg = \case
       XMsgNew_ -> XMsgNew <$> JT.parseEither parseMsgContainer params
-      XMsgFileDescr_ -> XMsgFileDescr <$> p "msgId" <*> p "fileDescr"
+      XMsgFileDescr_ -> XMsgFileDescr <$> p "msgId" <*> opt "fileId" <*> p "fileDescr"
       XMsgUpdate_ -> XMsgUpdate <$> p "msgId" <*> p "content" <*> opt "ttl" <*> opt "live"
       XMsgDel_ -> XMsgDel <$> p "msgId" <*> opt "memberId"
       XMsgDeleted_ -> pure XMsgDeleted
@@ -909,7 +921,7 @@ chatToAppMessage ChatMessage {chatVRange, msgId, chatMsgEvent} = case encoding @
     params :: ChatMsgEvent 'Json -> J.Object
     params = \case
       XMsgNew container -> msgContainerJSON container
-      XMsgFileDescr msgId' fileDescr -> o ["msgId" .= msgId', "fileDescr" .= fileDescr]
+      XMsgFileDescr msgId' fileId fileDescr -> o $ ("fileId" .=? fileId) ["msgId" .= msgId', "fileDescr" .= fileDescr]
       XMsgUpdate msgId' content ttl live -> o $ ("ttl" .=? ttl) $ ("live" .=? live) ["msgId" .= msgId', "content" .= content]
       XMsgDel msgId' memberId -> o $ ("memberId" .=? memberId) ["msgId" .= msgId']
       XMsgDeleted -> JM.empty

src/Simplex/Chat/Store/Messages.hs

@@ -112,7 +112,7 @@ import Data.ByteString.Char8 (ByteString)
 import Data.Either (fromRight, rights)
 import Data.Int (Int64)
 import Data.List (sortBy)
-import Data.Maybe (fromMaybe, isJust, mapMaybe)
+import Data.Maybe (fromMaybe, isJust, mapMaybe, maybeToList)
 import Data.Ord (Down (..), comparing)
 import Data.Text (Text)
 import Data.Time (addUTCTime)
@@ -1122,7 +1122,7 @@ toDirectChatItem currentTs (((itemId, itemTs, AMsgDirection msgDir, itemContentT
         _ -> Nothing
     cItem :: MsgDirectionI d => SMsgDirection d -> CIDirection 'CTDirect d -> CIStatus d -> CIContent d -> Maybe (CIFile d) -> CChatItem 'CTDirect
     cItem d chatDir ciStatus content file =
-      CChatItem d ChatItem {chatDir, meta = ciMeta content ciStatus, content, formattedText = parseMaybeMarkdownList itemText, quotedItem = toDirectQuote quoteRow, reactions = [], file}
+      CChatItem d ChatItem {chatDir, meta = ciMeta content ciStatus, content, formattedText = parseMaybeMarkdownList itemText, quotedItem = toDirectQuote quoteRow, reactions = [], file = maybeToList file}
     badItem = Left $ SEBadChatItem itemId
     ciMeta :: CIContent d -> CIStatus d -> CIMeta 'CTDirect d
     ciMeta content status =
@@ -1173,7 +1173,7 @@ toGroupChatItem currentTs userContactId (((itemId, itemTs, AMsgDirection msgDir,
         _ -> Nothing
     cItem :: MsgDirectionI d => SMsgDirection d -> CIDirection 'CTGroup d -> CIStatus d -> CIContent d -> Maybe (CIFile d) -> CChatItem 'CTGroup
     cItem d chatDir ciStatus content file =
-      CChatItem d ChatItem {chatDir, meta = ciMeta content ciStatus, content, formattedText = parseMaybeMarkdownList itemText, quotedItem = toGroupQuote quoteRow quotedMember_, reactions = [], file}
+      CChatItem d ChatItem {chatDir, meta = ciMeta content ciStatus, content, formattedText = parseMaybeMarkdownList itemText, quotedItem = toGroupQuote quoteRow quotedMember_, reactions = [], file = maybeToList file}
     badItem = Left $ SEBadChatItem itemId
     ciMeta :: CIContent d -> CIStatus d -> CIMeta 'CTGroup d
     ciMeta content status =

src/Simplex/Chat/View.hs

@@ -24,7 +24,7 @@ import Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.List.NonEmpty as L
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
-import Data.Maybe (fromMaybe, isJust, isNothing, mapMaybe)
+import Data.Maybe (fromMaybe, isJust, isNothing, listToMaybe, mapMaybe)
 import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Text.Encoding (decodeLatin1)
@@ -411,7 +411,7 @@ responseToView hu@(currentRH, user_) ChatConfig {logLevel, showReactions, showRe
               Just CIQuote {chatDir = quoteDir, content} ->
                 Just (msgDirectionInt $ quoteMsgDirection quoteDir, msgContentText content)
             fPath = case file of
-              Just CIFile {fileSource = Just (CryptoFile fp _)} -> Just fp
+              CIFile {fileSource = Just (CryptoFile fp _)} : _ -> Just fp
               _ -> Nothing
     testViewItem :: CChatItem c -> Maybe GroupMember -> Text
     testViewItem (CChatItem _ ci@ChatItem {meta = CIMeta {itemText}}) membership_ =
@@ -561,12 +561,12 @@ viewChatItem chat ci@ChatItem {chatDir, meta = meta@CIMeta {forwardedByMember},
       Just _ -> item <> styled (colored Yellow) (" [>>]" :: String)
     withSndFile = withFile viewSentFileInvitation
     withRcvFile = withFile viewReceivedFileInvitation
-    withFile view dir l = maybe l (\f -> l <> view dir f ts tz meta) file
+    withFile view dir l = maybe l (\f -> l <> view dir f ts tz meta) $ listToMaybe file
     sndMsg = msg viewSentMessage
     rcvMsg = msg viewReceivedMessage
     msg view dir quote mc = case (msgContentText mc, file, quote) of
-      ("", Just _, []) -> []
+      ("", _ : _, []) -> []
-      ("", Just CIFile {fileName}, _) -> view dir quote (MCText $ T.pack fileName) ts tz meta
+      ("", CIFile {fileName} : _, _) -> view dir quote (MCText $ T.pack fileName) ts tz meta
       _ -> view dir quote mc ts tz meta
     showSndItem to = showItem $ sentWithTime_ ts tz [to <> plainContent content] meta
     showRcvItem from = showItem $ receivedWithTime_ ts tz from [] meta [plainContent content] False
@@ -1514,9 +1514,9 @@ sendingFile_ status ft@SndFileTransfer {recipientDisplayName = c} =
   [status <> " sending " <> sndFile ft <> " to " <> ttyContact c]
 
 uploadingFile :: StyledString -> AChatItem -> [StyledString]
-uploadingFile status (AChatItem _ _ (DirectChat Contact {localDisplayName = c}) ChatItem {file = Just CIFile {fileId, fileName}, chatDir = CIDirectSnd}) =
+uploadingFile status (AChatItem _ _ (DirectChat Contact {localDisplayName = c}) ChatItem {file = CIFile {fileId, fileName} : _, chatDir = CIDirectSnd}) =
   [status <> " uploading " <> fileTransferStr fileId fileName <> " for " <> ttyContact c]
-uploadingFile status (AChatItem _ _ (GroupChat g) ChatItem {file = Just CIFile {fileId, fileName}, chatDir = CIGroupSnd}) =
+uploadingFile status (AChatItem _ _ (GroupChat g) ChatItem {file = CIFile {fileId, fileName} : _, chatDir = CIGroupSnd}) =
   [status <> " uploading " <> fileTransferStr fileId fileName <> " for " <> ttyGroup' g]
 uploadingFile status _ = [status <> " uploading file"] -- shouldn't happen
 
@@ -1546,12 +1546,12 @@ humanReadableSize size
     gB = mB * 1024
 
 savingFile' :: AChatItem -> [StyledString]
-savingFile' (AChatItem _ _ chat ChatItem {file = Just CIFile {fileId, fileSource = Just (CryptoFile filePath _)}, chatDir}) =
+savingFile' (AChatItem _ _ chat ChatItem {file = CIFile {fileId, fileSource = Just (CryptoFile filePath _)} : _, chatDir}) =
   ["saving file " <> sShow fileId <> fileFrom chat chatDir <> " to " <> plain filePath]
 savingFile' _ = ["saving file"] -- shouldn't happen
 
 receivingFile_' :: (Maybe RemoteHostId, Maybe User) -> Bool -> String -> AChatItem -> [StyledString]
-receivingFile_' hu testView status (AChatItem _ _ chat ChatItem {file = Just CIFile {fileId, fileName, fileSource = Just f@(CryptoFile _ cfArgs_)}, chatDir}) =
+receivingFile_' hu testView status (AChatItem _ _ chat ChatItem {file = CIFile {fileId, fileName, fileSource = Just f@(CryptoFile _ cfArgs_)} : _, chatDir}) =
   [plain status <> " receiving " <> fileTransferStr fileId fileName <> fileFrom chat chatDir] <> cfArgsStr cfArgs_ <> getRemoteFileStr
   where
     cfArgsStr (Just cfArgs) = [plain (cryptoFileArgsStr testView cfArgs) | status == "completed"]
@@ -1620,7 +1620,7 @@ viewFileTransferStatus (FTRcv ft@RcvFileTransfer {fileId, fileInvitation = FileI
       RFSCancelled Nothing -> "cancelled"
 
 viewFileTransferStatusXFTP :: AChatItem -> [StyledString]
-viewFileTransferStatusXFTP (AChatItem _ _ _ ChatItem {file = Just CIFile {fileId, fileName, fileSize, fileStatus, fileSource}}) =
+viewFileTransferStatusXFTP (AChatItem _ _ _ ChatItem {file = CIFile {fileId, fileName, fileSize, fileStatus, fileSource} : _}) =
   case fileStatus of
     CIFSSndStored -> ["sending " <> fstr <> " just started"]
     CIFSSndTransfer progress total -> ["sending " <> fstr <> " in progress " <> fileProgressXFTP progress total fileSize]