rework to build history via chat items

src/Simplex/Chat.hs

@@ -686,7 +686,7 @@ processChatCommand = \case
               withStore $ \db -> getDirectChatItem db user chatId quotedItemId
             (origQmc, qd, sent) <- quoteData qci
             let msgRef = MsgRef {msgId = itemSharedMsgId, sentAt = itemTs, sent, memberId = Nothing}
-                qmc = quoteContent origQmc file
+                qmc = quoteContent mc origQmc 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)
           where
@@ -700,13 +700,13 @@ processChatCommand = \case
       assertUserGroupRole gInfo GRAuthor
       send g
       where
-        send g@(Group gInfo@GroupInfo {groupId, membership} ms)
+        send g@(Group gInfo@GroupInfo {groupId} ms)
           | isVoice mc && not (groupFeatureAllowed SGFVoice gInfo) = notAllowedError GFVoice
           | not (isVoice mc) && isJust file_ && not (groupFeatureAllowed SGFFiles gInfo) = notAllowedError GFFiles
           | otherwise = do
               (fInv_, ciFile_, ft_) <- unzipMaybe3 <$> setupSndFileTransfer g (length $ filter memberCurrent ms)
               timed_ <- sndGroupCITimed live gInfo itemTTL
-              (msgContainer, quotedItem_) <- prepareMsg fInv_ timed_ membership
+              (msgContainer, quotedItem_) <- prepareGroupMsg user gInfo mc quotedItemId_ fInv_ timed_ live
               (msg@SndMessage {sharedMsgId}, sentToMembers) <- sendGroupMessage user gInfo ms (XMsgNew msgContainer)
               ci <- saveSndChatItem' user (CDGroupSnd gInfo) msg (CISndMsgContent mc) ciFile_ quotedItem_ timed_ live
               withStore' $ \db ->
@@ -746,51 +746,9 @@ processChatCommand = \case
                 void . withStore' $ \db -> createSndGroupInlineFT db m conn ft
                 sendMemberFileInline m conn ft sharedMsgId
             processMember _ = pure ()
-        prepareMsg :: Maybe FileInvitation -> Maybe CITimed -> GroupMember -> m (MsgContainer, Maybe (CIQuote 'CTGroup))
-        prepareMsg fInv_ timed_ membership = case quotedItemId_ of
-          Nothing -> pure (MCSimple (ExtMsgContent mc fInv_ (ttl' <$> timed_) (justTrue live)), Nothing)
-          Just quotedItemId -> do
-            CChatItem _ qci@ChatItem {meta = CIMeta {itemTs, itemSharedMsgId}, formattedText, file} <-
-              withStore $ \db -> getGroupChatItem db user chatId quotedItemId
-            (origQmc, qd, sent, GroupMember {memberId}) <- quoteData qci membership
-            let msgRef = MsgRef {msgId = itemSharedMsgId, sentAt = itemTs, sent, memberId = Just memberId}
-                qmc = quoteContent origQmc 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)
-          where
-            quoteData :: ChatItem c d -> GroupMember -> m (MsgContent, CIQDirection 'CTGroup, Bool, GroupMember)
-            quoteData ChatItem {meta = CIMeta {itemDeleted = Just _}} _ = throwChatError CEInvalidQuote
-            quoteData ChatItem {chatDir = CIGroupSnd, content = CISndMsgContent qmc} membership' = pure (qmc, CIQGroupSnd, True, membership')
-            quoteData ChatItem {chatDir = CIGroupRcv m, content = CIRcvMsgContent qmc} _ = pure (qmc, CIQGroupRcv $ Just m, False, m)
-            quoteData _ _ = throwChatError CEInvalidQuote
     CTContactRequest -> pure $ chatCmdError (Just user) "not supported"
     CTContactConnection -> pure $ chatCmdError (Just user) "not supported"
     where
-      quoteContent :: forall d. MsgContent -> Maybe (CIFile d) -> MsgContent
-      quoteContent qmc ciFile_
-        | replaceContent = MCText qTextOrFile
-        | otherwise = case qmc of
-            MCImage _ image -> MCImage qTextOrFile image
-            MCFile _ -> MCFile qTextOrFile
-            -- consider same for voice messages
-            -- MCVoice _ voice -> MCVoice qTextOrFile voice
-            _ -> qmc
-        where
-          -- if the message we're quoting with is one of the "large" MsgContents
-          -- we replace the quote's content with MCText
-          replaceContent = case mc of
-            MCText _ -> False
-            MCFile _ -> False
-            MCLink {} -> True
-            MCImage {} -> True
-            MCVideo {} -> True
-            MCVoice {} -> False
-            MCUnknown {} -> True
-          qText = msgContentText qmc
-          getFileName :: CIFile d -> String
-          getFileName CIFile {fileName} = fileName
-          qFileName = maybe qText (T.pack . getFileName) ciFile_
-          qTextOrFile = if T.null qText then qFileName else qText
       xftpSndFileTransfer :: User -> CryptoFile -> Integer -> Int -> ContactOrGroup -> m (FileInvitation, CIFile 'MDSnd, FileTransferMeta)
       xftpSndFileTransfer user file@(CryptoFile filePath cfArgs) fileSize n contactOrGroup = do
         let fileName = takeFileName filePath
@@ -2427,6 +2385,50 @@ processChatCommand = \case
         cReqHashes = bimap hash hash cReqSchemas
         hash = ConnReqUriHash . C.sha256Hash . strEncode
 
+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)
+  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
+        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)
+  where
+    quoteData :: ChatItem c d -> GroupMember -> m (MsgContent, CIQDirection 'CTGroup, Bool, GroupMember)
+    quoteData ChatItem {meta = CIMeta {itemDeleted = Just _}} _ = throwChatError CEInvalidQuote
+    quoteData ChatItem {chatDir = CIGroupSnd, content = CISndMsgContent qmc} membership' = pure (qmc, CIQGroupSnd, True, membership')
+    quoteData ChatItem {chatDir = CIGroupRcv m, content = CIRcvMsgContent qmc} _ = pure (qmc, CIQGroupRcv $ Just m, False, m)
+    quoteData _ _ = throwChatError CEInvalidQuote
+
+quoteContent :: forall d. MsgContent -> MsgContent -> Maybe (CIFile d) -> MsgContent
+quoteContent mc qmc ciFile_
+  | replaceContent = MCText qTextOrFile
+  | otherwise = case qmc of
+      MCImage _ image -> MCImage qTextOrFile image
+      MCFile _ -> MCFile qTextOrFile
+      -- consider same for voice messages
+      -- MCVoice _ voice -> MCVoice qTextOrFile voice
+      _ -> qmc
+  where
+    -- if the message we're quoting with is one of the "large" MsgContents
+    -- we replace the quote's content with MCText
+    replaceContent = case mc of
+      MCText _ -> False
+      MCFile _ -> False
+      MCLink {} -> True
+      MCImage {} -> True
+      MCVideo {} -> True
+      MCVoice {} -> False
+      MCUnknown {} -> True
+    qText = msgContentText qmc
+    getFileName :: CIFile d -> String
+    getFileName CIFile {fileName} = fileName
+    qFileName = maybe qText (T.pack . getFileName) ciFile_
+    qTextOrFile = if T.null qText then qFileName else qText
+
 assertDirectAllowed :: ChatMonad m => User -> MsgDirection -> Contact -> CMEventTag e -> m ()
 assertDirectAllowed user dir ct event =
   unless (allowedChatEvent || anyDirectOrUsed ct) . unlessM directMessagesAllowed $
@@ -2604,7 +2606,7 @@ acceptFileReceive user@User {userId} RcvFileTransfer {fileId, xftpRcvFile, fileI
         -- marking file as accepted and reading description in the same transaction
         -- to prevent race condition with appending description
         ci <- xftpAcceptRcvFT db user fileId filePath
-        rfd <- getRcvFileDescrByFileId db fileId
+        rfd <- getRcvFileDescrByRcvFileId db fileId
         pure (ci, rfd)
       receiveViaCompleteFD user fileId rfd cryptoArgs
       pure ci
@@ -3581,9 +3583,8 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
                     let events = map (XGrpMemIntro . memberInfo . reMember) shuffledIntros
                     forM_ (L.nonEmpty events) $ \events' ->
                       sendBatchedDirectMessages conn events' (GroupId groupId)
-                  else
-                    forM_ shuffledIntros $ \intro ->
-                      processIntro intro `catchChatError` (toView . CRChatError (Just user))
+                  else forM_ shuffledIntros $ \intro ->
+                    processIntro intro `catchChatError` (toView . CRChatError (Just user))
               shuffleIntros :: [GroupMemberIntro] -> IO [GroupMemberIntro]
               shuffleIntros intros = do
                 let (admins, others) = partition isAdmin intros
@@ -3602,10 +3603,92 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
                 withStore' $ \db -> updateIntroStatus db introId GMIntroSent
               sendHistory =
                 when (isCompatibleRange (memberChatVRange' m) batchSendVRange) $ do
-                  (errs, events) <- withStore' $ \db -> getGroupMsgsHistory db user gInfo 300
-                  toView $ CRChatErrors (Just user) (map ChatErrorStore errs)
+                  (errs, items) <- withStore' $ \db -> getGroupHistoryLastItems db user gInfo 100
+                  (errs', events) <- collectForwardEvents items [] []
+                  toView $ CRChatErrors (Just user) (map ChatErrorStore errs <> errs' )
                   forM_ (L.nonEmpty events) $ \events' ->
                     sendBatchedDirectMessages conn events' (GroupId groupId)
+              collectForwardEvents :: [CChatItem 'CTGroup] -> [ChatError] -> [ChatMsgEvent 'Json] -> m ([ChatError], [ChatMsgEvent 'Json])
+              collectForwardEvents [] errs evts = pure (errs, evts)
+              collectForwardEvents (ci : items) errs evts =
+                flip catchChatError (\e -> collectForwardEvents items (e : errs) evts) $ case ci of
+                  (CChatItem SMDRcv ChatItem {chatDir = CIGroupRcv sender, meta, content = CIRcvMsgContent mc, quotedItem, file}) -> do
+                    fInvDescr_ <- join <$> forM file getRcvFileInvDescr
+                    if isNothing fInvDescr_ && not (msgContentHasText mc)
+                      then collectForwardEvents items errs evts
+                      else do
+                        let CIMeta {itemTs, itemSharedMsgId, itemTimed} = meta
+                            quotedItemId_ = quoteItemId =<< quotedItem
+                            fInv_ = fst <$> fInvDescr_
+                        (msgContainer, _) <- prepareGroupMsg user gInfo mc quotedItemId_ fInv_ itemTimed False
+                        let senderVRange = memberChatVRange' sender
+                            xMsgNewChatMsg = ChatMessage {chatVRange = senderVRange, msgId = itemSharedMsgId, chatMsgEvent = XMsgNew msgContainer}
+                        fileDescrEvents <- case (snd <$> fInvDescr_, itemSharedMsgId) of
+                          (Just fileDescrText, Just msgId) -> prepareFileDescrEvents fileDescrText msgId
+                          _ -> pure []
+                        let fileDescrChatMsgs = map (ChatMessage senderVRange Nothing) fileDescrEvents
+                            GroupMember {memberId} = sender
+                            msgForwardEvents = map (\cm -> XGrpMsgForward memberId cm itemTs) (xMsgNewChatMsg : fileDescrChatMsgs)
+                        collectForwardEvents items errs (msgForwardEvents <> evts)
+                    where
+                      getRcvFileInvDescr :: CIFile 'MDRcv -> m (Maybe (FileInvitation, RcvFileDescrText))
+                      getRcvFileInvDescr CIFile {fileId, fileName, fileSize, fileProtocol, fileStatus}
+                        | fileProtocol /= FPXFTP || fileStatus == CIFSRcvCancelled = pure Nothing
+                        | otherwise = do
+                          RcvFileDescr {fileDescrText, fileDescrComplete} <- withStore $ \db -> getRcvFileDescrByRcvFileId db fileId
+                          if fileDescrComplete
+                            then do
+                              let fInvDescr = FileDescr {fileDescrText = "", fileDescrPartNo = 0, fileDescrComplete = False}
+                                  fInv = xftpFileInvitation fileName fileSize fInvDescr
+                              pure $ Just (fInv, fileDescrText)
+                            else pure Nothing
+                  (CChatItem SMDSnd ChatItem {chatDir = CIGroupSnd, meta, content = CISndMsgContent mc, quotedItem, file}) -> do
+                    fInvDescr_ <- join <$> forM file getSndFileInvDescr
+                    if isNothing fInvDescr_ && not (msgContentHasText mc)
+                      then collectForwardEvents items errs evts
+                      else do
+                        let CIMeta {itemTs, itemSharedMsgId, itemTimed} = meta
+                            quotedItemId_ = quoteItemId =<< quotedItem
+                            fInv_ = fst <$> fInvDescr_
+                        (msgContainer, _) <- prepareGroupMsg user gInfo mc quotedItemId_ fInv_ itemTimed False
+                        let senderVRange = memberChatVRange' membership
+                            xMsgNewChatMsg = ChatMessage {chatVRange = senderVRange, msgId = itemSharedMsgId, chatMsgEvent = XMsgNew msgContainer}
+                        fileDescrEvents <- case (snd <$> fInvDescr_, itemSharedMsgId) of
+                          (Just fileDescrText, Just msgId) -> prepareFileDescrEvents fileDescrText msgId
+                          _ -> pure []
+                        let fileDescrChatMsgs = map (ChatMessage senderVRange Nothing) fileDescrEvents
+                            GroupMember {memberId} = membership
+                            msgForwardEvents = map (\cm -> XGrpMsgForward memberId cm itemTs) (xMsgNewChatMsg : fileDescrChatMsgs)
+                        collectForwardEvents items errs (msgForwardEvents <> evts)
+                    where
+                      getSndFileInvDescr :: CIFile 'MDSnd -> m (Maybe (FileInvitation, RcvFileDescrText))
+                      getSndFileInvDescr CIFile {fileId, fileName, fileSize, fileProtocol, fileStatus}
+                        | fileProtocol /= FPXFTP || fileStatus == CIFSSndCancelled = pure Nothing
+                        | otherwise = do
+                          -- can also lookup in extra_xftp_file_descriptions, though it can be empty;
+                          -- would be best if snd file had a single rcv description for all members saved in files table
+                          RcvFileDescr {fileDescrText, fileDescrComplete} <- withStore $ \db -> getRcvFileDescrBySndFileId db fileId
+                          if fileDescrComplete
+                            then do
+                              let fInvDescr = FileDescr {fileDescrText = "", fileDescrPartNo = 0, fileDescrComplete = False}
+                                  fInv = xftpFileInvitation fileName fileSize fInvDescr
+                              pure $ Just (fInv, fileDescrText)
+                            else pure Nothing
+                  _ -> collectForwardEvents items errs evts
+                where
+                  prepareFileDescrEvents :: RcvFileDescrText -> SharedMsgId -> m [ChatMsgEvent 'Json]
+                  prepareFileDescrEvents fileDescrText msgId = do
+                    partSize <- asks $ xftpDescrPartSize . config
+                    pure $ prepareParts 1 partSize fileDescrText []
+                    where
+                      prepareParts partNo partSize rfdText events = do
+                        let (part, rest) = T.splitAt partSize rfdText
+                            complete = T.null rest
+                            fileDescr = FileDescr {fileDescrText = part, fileDescrPartNo = partNo, fileDescrComplete = complete}
+                            events' = XMsgFileDescr {msgId, fileDescr} : events
+                        if complete
+                          then reverse events'
+                          else prepareParts (partNo + 1) partSize rest events'
           _ -> do
             let memCategory = memberCategory m
             withStore' (\db -> getViaGroupContact db user m) >>= \case
@@ -5226,10 +5309,6 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
         processForwardedMsg :: GroupMember -> ChatMessage 'Json -> m ()
         processForwardedMsg author chatMsg = do
           let body = LB.toStrict $ J.encode msg
-          -- TODO [batch send] save broker ts (here - msgTs) on messages received via forward to include in history
-          -- consider adding chat_ts to messages table: as of now, messages received via forward
-          -- wouldn't have a record in msg_deliveries to retrieve it from;
-          -- practically it's not a problem if members join via a single same admin (e.g. directory bot)
           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
@@ -5556,21 +5635,21 @@ sendBatchedDirectMessages conn@Connection {connId} events connOrGroupId = do
       withStore' $ \db -> forM_ sndMsgs $ \SndMessage {msgId} ->
         createSndMsgDelivery db sndMsgDelivery msgId
   where
-  createSndMessages :: m [Either StoreError SndMessage]
-  createSndMessages = do
-    gVar <- asks idsDrg
-    ChatConfig {chatVRange} <- asks config
-    withStore' $ \db -> forM (toList events) $ \event ->
-      runExceptT $ createNewSndMessage db gVar connOrGroupId (newMsg chatVRange event)
-  newMsg chatVRange chatMsgEvent sharedMsgId =
-    let msgBody = encodeChatMessage ChatMessage {chatVRange, msgId = Just sharedMsgId, chatMsgEvent}
-      in NewMessage {chatMsgEvent, msgBody}
-  partitionBatches :: [ChatMessageBatch] -> ([SndMessage], [MessagesBatch])
-  partitionBatches = foldr partition' ([], [])
-    where
-      partition' :: ChatMessageBatch -> ([SndMessage], [MessagesBatch]) -> ([SndMessage], [MessagesBatch])
-      partition' (CMBMessages msgBatch) (largeMsgs, msgBatches) = (largeMsgs, msgBatch : msgBatches)
-      partition' (CMBLargeMessage largeMsg) (largeMsgs, msgBatches) = (largeMsg : largeMsgs, msgBatches)
+    createSndMessages :: m [Either StoreError SndMessage]
+    createSndMessages = do
+      gVar <- asks idsDrg
+      ChatConfig {chatVRange} <- asks config
+      withStore' $ \db -> forM (toList events) $ \event ->
+        runExceptT $ createNewSndMessage db gVar connOrGroupId (newMsg chatVRange event)
+    newMsg chatVRange chatMsgEvent sharedMsgId =
+      let msgBody = encodeChatMessage ChatMessage {chatVRange, msgId = Just sharedMsgId, chatMsgEvent}
+       in NewMessage {chatMsgEvent, msgBody}
+    partitionBatches :: [ChatMessageBatch] -> ([SndMessage], [MessagesBatch])
+    partitionBatches = foldr partition' ([], [])
+      where
+        partition' :: ChatMessageBatch -> ([SndMessage], [MessagesBatch]) -> ([SndMessage], [MessagesBatch])
+        partition' (CMBMessages msgBatch) (largeMsgs, msgBatches) = (largeMsgs, msgBatch : msgBatches)
+        partition' (CMBLargeMessage largeMsg) (largeMsgs, msgBatches) = (largeMsg : largeMsgs, msgBatches)
 
 data MessagesBatch = MessagesBatch ByteString [SndMessage]
 

src/Simplex/Chat/Messages.hs

@@ -370,6 +370,9 @@ data CIQuote (c :: ChatType) = CIQuote
   }
   deriving (Show)
 
+quoteItemId :: CIQuote c -> Maybe ChatItemId
+quoteItemId CIQuote {itemId} = itemId
+
 data CIReaction (c :: ChatType) (d :: MsgDirection) = CIReaction
   { chatDir :: CIDirection c d,
     chatItem :: CChatItem c,

src/Simplex/Chat/Messages/CIContent.hs

@@ -575,10 +575,16 @@ dbParseACIContent = fmap aciContentDBJSON . J.eitherDecodeStrict' . encodeUtf8
 instance FromJSON ACIContent where
   parseJSON = fmap aciContentJSON . J.parseJSON
 
+sndMsgContentTag :: Text
+sndMsgContentTag = "sndMsgContent"
+
+rcvMsgContentTag :: Text
+rcvMsgContentTag = "rcvMsgContent"
+
 toCIContentTag :: CIContent e -> Text
 toCIContentTag ciContent = case ciContent of
-  CISndMsgContent _ -> "sndMsgContent"
-  CIRcvMsgContent _ -> "rcvMsgContent"
+  CISndMsgContent _ -> sndMsgContentTag
+  CIRcvMsgContent _ -> rcvMsgContentTag
   CISndDeleted _ -> "sndDeleted"
   CIRcvDeleted _ -> "rcvDeleted"
   CISndCall {} -> "sndCall"

src/Simplex/Chat/Migrations/M20231215_recreate_msg_deliveries.hs

@@ -39,16 +39,11 @@ ALTER TABLE new_msg_deliveries RENAME TO msg_deliveries;
 CREATE INDEX idx_msg_deliveries_message_id ON "msg_deliveries"(message_id);
 CREATE INDEX idx_msg_deliveries_agent_ack_cmd_id ON "msg_deliveries"(connection_id, agent_ack_cmd_id);
 CREATE INDEX idx_msg_deliveries_agent_msg_id ON "msg_deliveries"(connection_id, agent_msg_id);
-
--- for message history retrieval
-CREATE INDEX idx_messages_group_id_created_at ON messages(group_id, created_at);
 |]
 
 down_m20231215_recreate_msg_deliveries :: Query
 down_m20231215_recreate_msg_deliveries =
   [sql|
-DROP INDEX idx_messages_group_id_created_at;
-
 DROP INDEX idx_msg_deliveries_message_id;
 DROP INDEX idx_msg_deliveries_agent_ack_cmd_id;
 DROP INDEX idx_msg_deliveries_agent_msg_id;

src/Simplex/Chat/Migrations/chat_schema.sql

@@ -812,7 +812,3 @@ CREATE INDEX idx_msg_deliveries_agent_msg_id ON "msg_deliveries"(
   connection_id,
   agent_msg_id
 );
-CREATE INDEX idx_messages_group_id_created_at ON messages(
-  group_id,
-  created_at
-);

src/Simplex/Chat/Protocol.hs

@@ -31,7 +31,6 @@ import qualified Data.ByteString.Char8 as B
 import Data.ByteString.Internal (c2w, w2c)
 import qualified Data.ByteString.Lazy.Char8 as LB
 import Data.Maybe (fromMaybe)
-import Data.Set (Set)
 import Data.String
 import Data.Text (Text)
 import qualified Data.Text as T
@@ -150,7 +149,7 @@ instance StrEncoding AppMessageBinary where
     pure AppMessageBinary {tag, msgId, body}
 
 newtype SharedMsgId = SharedMsgId ByteString
-  deriving (Eq, Ord, Show)
+  deriving (Eq, Show)
 
 instance FromField SharedMsgId where fromField f = SharedMsgId <$> fromField f
 
@@ -290,24 +289,6 @@ forwardedGroupMsg msg@ChatMessage {chatMsgEvent} = case encoding @e of
   SJson | isForwardedGroupMsg chatMsgEvent -> Just msg
   _ -> Nothing
 
-msgIncludedInHistory :: forall e. MsgEncodingI e => ChatMessage e -> Set SharedMsgId -> Maybe (ChatMessage 'Json)
-msgIncludedInHistory msg@ChatMessage {chatMsgEvent} refMsgIds = case encoding @e of
-  SJson -> case chatMsgEvent of
-    XMsgNew mc -> case mcExtMsgContent mc of
-      ExtMsgContent {file = Just FileInvitation {fileInline = Just _}} -> Nothing
-      _ -> Just msg
-    XMsgFileDescr msgId _ -> refIncluded msgId
-    XMsgUpdate {msgId} -> refIncluded msgId
-    XMsgDel msgId _ -> refIncluded msgId
-    XMsgReact {msgId} -> refIncluded msgId
-    XFileCancel msgId -> refIncluded msgId
-    _ -> Nothing
-    where
-      refIncluded msgId
-        | msgId `elem` refMsgIds = Just msg
-        | otherwise = Nothing
-  _ -> Nothing
-
 data MsgReaction = MREmoji {emoji :: MREmojiChar} | MRUnknown {tag :: Text, json :: J.Object}
   deriving (Eq, Show)
 
@@ -470,6 +451,18 @@ durationText duration =
       | n <= 9 = '0' : show n
       | otherwise = show n
 
+msgContentHasText :: MsgContent -> Bool
+msgContentHasText = \case
+  MCText t -> hasText t
+  MCLink {text} -> hasText text
+  MCImage {text} -> hasText text
+  MCVideo {text} -> hasText text
+  MCVoice {text} -> hasText text
+  MCFile t -> hasText t
+  MCUnknown {text} -> hasText text
+  where
+    hasText = not . T.null
+
 isVoice :: MsgContent -> Bool
 isVoice = \case
   MCVoice {} -> True

src/Simplex/Chat/Store/Files.hs

@@ -47,7 +47,8 @@ module Simplex.Chat.Store.Files
     createRcvFileTransfer,
     createRcvGroupFileTransfer,
     appendRcvFD,
-    getRcvFileDescrByFileId,
+    getRcvFileDescrByRcvFileId,
+    getRcvFileDescrBySndFileId,
     updateRcvFileAgentId,
     getRcvFileTransferById,
     getRcvFileTransfer,
@@ -543,7 +544,7 @@ createRcvFD_ db userId currentTs FileDescr {fileDescrText, fileDescrPartNo, file
 appendRcvFD :: DB.Connection -> UserId -> FileTransferId -> FileDescr -> ExceptT StoreError IO RcvFileDescr
 appendRcvFD db userId fileId fd@FileDescr {fileDescrText, fileDescrPartNo, fileDescrComplete} = do
   currentTs <- liftIO getCurrentTime
-  liftIO (getRcvFileDescrByFileId_ db fileId) >>= \case
+  liftIO (getRcvFileDescrByRcvFileId_ db fileId) >>= \case
     Nothing -> do
       rfd@RcvFileDescr {fileDescrId} <- createRcvFD_ db userId currentTs fd
       liftIO $
@@ -572,14 +573,14 @@ appendRcvFD db userId fileId fd@FileDescr {fileDescrText, fileDescrPartNo, fileD
             (fileDescrText', fileDescrPartNo, fileDescrComplete, fileDescrId)
         pure RcvFileDescr {fileDescrId, fileDescrText = fileDescrText', fileDescrPartNo, fileDescrComplete}
 
-getRcvFileDescrByFileId :: DB.Connection -> FileTransferId -> ExceptT StoreError IO RcvFileDescr
-getRcvFileDescrByFileId db fileId = do
-  liftIO (getRcvFileDescrByFileId_ db fileId) >>= \case
+getRcvFileDescrByRcvFileId :: DB.Connection -> FileTransferId -> ExceptT StoreError IO RcvFileDescr
+getRcvFileDescrByRcvFileId db fileId = do
+  liftIO (getRcvFileDescrByRcvFileId_ db fileId) >>= \case
     Nothing -> throwError $ SERcvFileDescrNotFound fileId
     Just rfd -> pure rfd
 
-getRcvFileDescrByFileId_ :: DB.Connection -> FileTransferId -> IO (Maybe RcvFileDescr)
-getRcvFileDescrByFileId_ db fileId =
+getRcvFileDescrByRcvFileId_ :: DB.Connection -> FileTransferId -> IO (Maybe RcvFileDescr)
+getRcvFileDescrByRcvFileId_ db fileId =
   maybeFirstRow toRcvFileDescr $
     DB.query
       db
@@ -591,10 +592,30 @@ getRcvFileDescrByFileId_ db fileId =
         LIMIT 1
       |]
       (Only fileId)
-  where
-    toRcvFileDescr :: (Int64, Text, Int, Bool) -> RcvFileDescr
-    toRcvFileDescr (fileDescrId, fileDescrText, fileDescrPartNo, fileDescrComplete) =
-      RcvFileDescr {fileDescrId, fileDescrText, fileDescrPartNo, fileDescrComplete}
+
+getRcvFileDescrBySndFileId :: DB.Connection -> FileTransferId -> ExceptT StoreError IO RcvFileDescr
+getRcvFileDescrBySndFileId db fileId = do
+  liftIO (getRcvFileDescrBySndFileId_ db fileId) >>= \case
+    Nothing -> throwError $ SERcvFileDescrNotFound fileId
+    Just rfd -> pure rfd
+
+getRcvFileDescrBySndFileId_ :: DB.Connection -> FileTransferId -> IO (Maybe RcvFileDescr)
+getRcvFileDescrBySndFileId_ db fileId =
+  maybeFirstRow toRcvFileDescr $
+    DB.query
+      db
+      [sql|
+        SELECT d.file_descr_id, d.file_descr_text, d.file_descr_part_no, d.file_descr_complete
+        FROM xftp_file_descriptions d
+        JOIN snd_files f ON f.file_descr_id = d.file_descr_id
+        WHERE f.file_id = ?
+        LIMIT 1
+      |]
+      (Only fileId)
+
+toRcvFileDescr :: (Int64, Text, Int, Bool) -> RcvFileDescr
+toRcvFileDescr (fileDescrId, fileDescrText, fileDescrPartNo, fileDescrComplete) =
+  RcvFileDescr {fileDescrId, fileDescrText, fileDescrPartNo, fileDescrComplete}
 
 updateRcvFileAgentId :: DB.Connection -> FileTransferId -> Maybe AgentRcvFileId -> IO ()
 updateRcvFileAgentId db fileId aFileId = do
@@ -627,7 +648,7 @@ getRcvFileTransfer_ db userId fileId = do
           WHERE f.user_id = ? AND f.file_id = ?
         |]
         (userId, fileId)
-  rfd_ <- liftIO $ getRcvFileDescrByFileId_ db fileId
+  rfd_ <- liftIO $ getRcvFileDescrByRcvFileId_ db fileId
   rcvFileTransfer rfd_ rftRow
   where
     rcvFileTransfer ::

src/Simplex/Chat/Store/Messages.hs

@@ -7,7 +7,6 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeApplications #-}
@@ -100,7 +99,7 @@ module Simplex.Chat.Store.Messages
     updateGroupSndStatus,
     getGroupSndStatuses,
     getGroupSndStatusCounts,
-    getGroupMsgsHistory,
+    getGroupHistoryLastItems,
   )
 where
 
@@ -115,8 +114,6 @@ import Data.Int (Int64)
 import Data.List (sortBy)
 import Data.Maybe (fromMaybe, isJust, mapMaybe)
 import Data.Ord (Down (..), comparing)
-import Data.Set (Set)
-import qualified Data.Set as S
 import Data.Text (Text)
 import Data.Time (addUTCTime)
 import Data.Time.Clock (UTCTime (..), getCurrentTime)
@@ -2081,87 +2078,22 @@ getGroupSndStatusCounts db itemId =
     |]
     (Only itemId)
 
-data JsonMessageRecord = JsonMessageRecord
-  { messageId :: Int64,
-    msgSent :: Bool,
-    chatMsgEvent :: CMEventTag 'Json,
-    chatMsg :: ChatMessage 'Json,
-    createdAt :: UTCTime,
-    updatedAt :: UTCTime,
-    connectionId :: Maybe Int64,
-    groupId :: Maybe Int64,
-    sharedMsgId :: Maybe SharedMsgId,
-    sharedMsgIdUser :: Maybe Bool,
-    authorGroupMemberId :: Maybe GroupMemberId,
-    forwardedByGroupMemberId :: Maybe GroupMemberId
-  }
-
-type JsonMessageRow = (Int64, Bool, CMEventTag 'Json, ByteString, UTCTime, UTCTime, Maybe Int64, Maybe Int64, Maybe SharedMsgId, Maybe Bool, Maybe GroupMemberId, Maybe GroupMemberId)
-
-toJsonMessageRecord :: JsonMessageRow -> Either StoreError JsonMessageRecord
-toJsonMessageRecord (messageId, msgSent, chatMsgEvent, msgBody, createdAt, updatedAt, connectionId, groupId, sharedMsgId, sharedMsgIdUser, authorGroupMemberId, forwardedByGroupMemberId) =
-  case parseChatMessages msgBody of
-    [Right (ACMsg SJson chatMsg)] -> Right JsonMessageRecord {..}
-    _ -> Left $ SEParseJsonMessageError messageId
-
-getGroupMsgsHistory :: DB.Connection -> User -> GroupInfo -> Int64 -> IO ([StoreError], [ChatMsgEvent 'Json])
-getGroupMsgsHistory db user GroupInfo {groupId, membership} numMsgsToSearch = do
-  (errs, msgRecs) <- partitionEithers <$> retrieveMessages
-  (errs', evts) <- collectForwardEvents msgRecs S.empty errs []
-  pure (errs <> errs', evts)
+getGroupHistoryLastItems :: DB.Connection -> User -> GroupInfo -> Int -> IO ([StoreError], [CChatItem 'CTGroup])
+getGroupHistoryLastItems db user@User {userId} GroupInfo {groupId} count = do
+  chatItemIds <- getLastItemIds_
+  -- use getGroupCIWithReactions to read reactions data
+  partitionEithers <$> mapM (runExceptT <$> getGroupChatItem db user groupId) chatItemIds
   where
-    retrieveMessages :: IO [Either StoreError JsonMessageRecord]
-    retrieveMessages =
-      map toJsonMessageRecord
+    getLastItemIds_ :: IO [ChatItemId]
+    getLastItemIds_ =
+      map fromOnly
         <$> DB.query
           db
           [sql|
-            SELECT
-              message_id, msg_sent, chat_msg_event, msg_body, created_at, updated_at, connection_id, group_id,
-              shared_msg_id, shared_msg_id_user, author_group_member_id, forwarded_by_group_member_id
-            FROM messages
-            WHERE group_id = ?
-              AND chat_msg_event IN (?,?,?,?,?,?)
-            ORDER BY created_at DESC
+            SELECT chat_item_id
+            FROM chat_items
+            WHERE user_id = ? AND group_id = ? AND item_content_tag IN (?,?)
+            ORDER BY item_ts DESC, chat_item_id DESC
             LIMIT ?
           |]
-          -- see msgIncludedInHistory in Protocol
-          (groupId, XMsgNew_, XMsgFileDescr_, XMsgUpdate_, XMsgDel_, XMsgReact_, XFileCancel_, numMsgsToSearch)
-    collectForwardEvents ::
-      [JsonMessageRecord] ->
-      Set SharedMsgId ->
-      [StoreError] ->
-      [ChatMsgEvent 'Json] ->
-      IO ([StoreError], [ChatMsgEvent 'Json])
-    collectForwardEvents [] _ errs evts = pure (errs, evts)
-    collectForwardEvents (mrec : mrecs) msgIds errs evts = do
-      let JsonMessageRecord {messageId, msgSent, chatMsg, createdAt, sharedMsgId, authorGroupMemberId} = mrec
-      case msgIncludedInHistory chatMsg msgIds of
-        Nothing -> collectForwardEvents mrecs msgIds errs evts
-        Just chatMsg'
-          | msgSent -> do
-              let GroupMember {memberId} = membership
-                  evt = XGrpMsgForward memberId chatMsg' createdAt -- TODO round to seconds
-                  msgIds' = maybe msgIds (`S.insert` msgIds) sharedMsgId
-              collectForwardEvents mrecs msgIds' errs (evt : evts)
-          | otherwise ->
-              case authorGroupMemberId of
-                Just amId -> do
-                  runExceptT (getGroupMember db user groupId amId) >>= \case
-                    Right _author@GroupMember {memberId} -> do
-                      brokerTs <- getDeliveryTs messageId
-                      -- message received via forward wouldn't have delivery record to retrieve chat_ts from,
-                      -- see comment in processForwardedMsg in Chat
-                      let msgTs = fromMaybe createdAt brokerTs
-                          evt = XGrpMsgForward memberId chatMsg' msgTs
-                          msgIds' = maybe msgIds (`S.insert` msgIds) sharedMsgId
-                      collectForwardEvents mrecs msgIds' errs (evt : evts)
-                    Left err ->
-                      collectForwardEvents mrecs msgIds (err : errs) evts
-                _ -> do
-                  let err = SEInternalError $ "message " <> show messageId <> " has no author group member id (can be due to older app version)"
-                  collectForwardEvents mrecs msgIds (err : errs) evts
-    getDeliveryTs :: Int64 -> IO (Maybe UTCTime)
-    getDeliveryTs messageId =
-      maybeFirstRow fromOnly $
-        DB.query db "SELECT chat_ts FROM msg_deliveries WHERE message_id = ? LIMIT 1" (Only messageId)
+          (userId, groupId, rcvMsgContentTag, sndMsgContentTag, count)

src/Simplex/Chat/Store/Shared.hs

@@ -99,7 +99,6 @@ data StoreError
   | SEContactNotFoundByFileId {fileId :: FileTransferId}
   | SENoGroupSndStatus {itemId :: ChatItemId, groupMemberId :: GroupMemberId}
   | SEDuplicateGroupMessage {groupId :: Int64, sharedMsgId :: SharedMsgId, authorGroupMemberId :: Maybe GroupMemberId, forwardedByGroupMemberId :: Maybe GroupMemberId}
-  | SEParseJsonMessageError {messageId :: Int64}
   | SERemoteHostNotFound {remoteHostId :: RemoteHostId}
   | SERemoteHostUnknown -- attempting to store KnownHost without a known fingerprint
   | SERemoteHostDuplicateCA

src/Simplex/Chat/Types.hs

@@ -1012,9 +1012,11 @@ data XFTPRcvFile = XFTPRcvFile
   }
   deriving (Eq, Show)
 
+type RcvFileDescrText = Text
+
 data RcvFileDescr = RcvFileDescr
   { fileDescrId :: Int64,
-    fileDescrText :: Text,
+    fileDescrText :: RcvFileDescrText,
     fileDescrPartNo :: Int,
     fileDescrComplete :: Bool
   }

tests/ChatTests/Groups.hs

@@ -116,7 +116,7 @@ chatGroupTests = do
     it "forward role change (x.grp.mem.role)" testGroupMsgForwardChangeRole
     it "forward new member announcement (x.grp.mem.new)" testGroupMsgForwardNewMember
   describe "group history" $ do
-    it "send recent history to invitee - text messages" testGroupHistory
+    fit "send recent history to invitee - text messages" testGroupHistory
   where
     _0 = supportedChatVRange -- don't create direct connections
     _1 = groupCreateDirectVRange