core: support batch sending in groups, batch introductions; send recent message history to new members (#3519)

* core: batch send stubs, comments

* multiple events in ChatMessage and supporting types

* Revert "multiple events in ChatMessage and supporting types"

This reverts commit 9b239b26ba.

* schema, refactor group processing for batched messages

* encoding, refactor processing

* refactor code to work with updated schema

* encoding, remove instances

* wip

* implement batching

* batch introductions

* wip

* collect and send message history

* missing new line

* rename

* test

* rework to build history via chat items

* refactor, tests

* correctly set member version range, dont include deleted items

* tests

* fix disappearing messages

* check number of errors

* comment

* check size in encodeChatMessage

* fix - don't check msg size for binary

* use builder

* rename

* rename

* rework batching

* lazy msg body

* use withStoreBatch

* refactor

* reverse batches

* comment

* possibly fix builder for single msg

* refactor batcher

* refactor

* dont repopulate msg_deliveries on down migration

* EncodedChatMessage type

* remove type

* batcher tests

* add tests

* group history preference

* test group link

* fix tests

* fix for random update

* add test testImageFitsSingleBatch

* refactor

* rename function

* refactor

* mconcat

* rename feature

* catch error on each batch

* refactor file inv retrieval

* refactor gathering item forward events

* refactor message batching

* unite migrations

* move files

* refactor

* Revert "unite migrations"

This reverts commit 0be7a3117a.

* refactor splitFileDescr

* improve tests

* Revert "dont repopulate msg_deliveries on down migration"

This reverts commit 2944c1cc28.

* fix down migration

---------

Co-authored-by: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>

simplex-chat.cabal

@@ -36,6 +36,7 @@ library
       Simplex.Chat.Help
       Simplex.Chat.Markdown
       Simplex.Chat.Messages
+      Simplex.Chat.Messages.Batch
       Simplex.Chat.Messages.CIContent
       Simplex.Chat.Messages.CIContent.Events
       Simplex.Chat.Migrations.M20220101_initial
@@ -127,6 +128,7 @@ library
       Simplex.Chat.Migrations.M20231126_remote_ctrl_address
       Simplex.Chat.Migrations.M20231207_chat_list_pagination
       Simplex.Chat.Migrations.M20231214_item_content_tag
+      Simplex.Chat.Migrations.M20231215_recreate_msg_deliveries
       Simplex.Chat.Mobile
       Simplex.Chat.Mobile.File
       Simplex.Chat.Mobile.Shared
@@ -543,6 +545,7 @@ test-suite simplex-chat-test
       ChatTests.Utils
       JSONTests
       MarkdownTests
+      MessageBatching
       MobileTests
       ProtocolTests
       RemoteTests

src/Simplex/Chat.hs

@@ -29,6 +29,7 @@ import Data.Bifunctor (bimap, first)
 import Data.ByteArray (ScrubbedBytes)
 import qualified Data.ByteArray as BA
 import qualified Data.ByteString.Base64 as B64
+import Data.ByteString.Builder (toLazyByteString)
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString.Lazy.Char8 as LB
@@ -38,20 +39,19 @@ import Data.Either (fromRight, lefts, partitionEithers, rights)
 import Data.Fixed (div')
 import Data.Functor (($>))
 import Data.Int (Int64)
-import Data.List (find, foldl', isSuffixOf, partition, sortBy, sortOn)
+import Data.List (find, foldl', isSuffixOf, partition, sortOn)
-import Data.List.NonEmpty (NonEmpty, nonEmpty)
+import Data.List.NonEmpty (NonEmpty (..), nonEmpty, toList, (<|))
 import qualified Data.List.NonEmpty as L
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
 import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing, listToMaybe, mapMaybe, maybeToList)
-import Data.Ord (comparing)
 import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Text.Encoding (decodeLatin1, encodeUtf8)
 import Data.Time (NominalDiffTime, addUTCTime, defaultTimeLocale, formatTime)
 import Data.Time.Clock (UTCTime, diffUTCTime, getCurrentTime, nominalDay, nominalDiffTimeToSeconds)
 import Data.Time.Clock.System (systemToUTCTime)
-import Data.Word (Word16, Word32)
+import Data.Word (Word32)
 import qualified Database.SQLite.Simple as SQL
 import Simplex.Chat.Archive
 import Simplex.Chat.Call
@@ -59,6 +59,7 @@ import Simplex.Chat.Controller
 import Simplex.Chat.Files
 import Simplex.Chat.Markdown
 import Simplex.Chat.Messages
+import Simplex.Chat.Messages.Batch (MsgBatch (..), batchMessages)
 import Simplex.Chat.Messages.CIContent
 import Simplex.Chat.Messages.CIContent.Events
 import Simplex.Chat.Options
@@ -77,7 +78,7 @@ import Simplex.Chat.Store.Shared
 import Simplex.Chat.Types
 import Simplex.Chat.Types.Preferences
 import Simplex.Chat.Types.Util
-import Simplex.Chat.Util (encryptFile)
+import Simplex.Chat.Util (encryptFile, shuffle)
 import Simplex.FileTransfer.Client.Main (maxFileSize)
 import Simplex.FileTransfer.Client.Presets (defaultXFTPServers)
 import Simplex.FileTransfer.Description (ValidFileDescription, gb, kb, mb)
@@ -607,7 +608,7 @@ processChatCommand = \case
             <$> withConnection st (readTVarIO . DB.slow)
   APIGetChats {userId, pendingConnections, pagination, query} -> withUserId' userId $ \user -> do
     (errs, previews) <- partitionEithers <$> withStore' (\db -> getChatPreviews db user pendingConnections pagination query)
-    toView $ CRChatErrors (Just user) (map ChatErrorStore errs)
+    unless (null errs) $ toView $ CRChatErrors (Just user) (map ChatErrorStore errs)
     pure $ CRApiChats user previews
   APIGetChat (ChatRef cType cId) pagination search -> withUser $ \user -> case cType of
     -- TODO optimize queries calculating ChatStats, currently they're disabled
@@ -688,7 +689,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
@@ -702,13 +703,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 ->
@@ -748,51 +749,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
@@ -1836,7 +1795,7 @@ processChatCommand = \case
   LastChats count_ -> withUser' $ \user -> do
     let count = fromMaybe 5000 count_
     (errs, previews) <- partitionEithers <$> withStore' (\db -> getChatPreviews db user False (PTLast count) clqNoFilters)
-    toView $ CRChatErrors (Just user) (map ChatErrorStore errs)
+    unless (null errs) $ toView $ CRChatErrors (Just user) (map ChatErrorStore errs)
     pure $ CRChats previews
   LastMessages (Just chatName) count search -> withUser $ \user -> do
     chatRef <- getChatRef user chatName
@@ -2433,6 +2392,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 $
@@ -2610,7 +2613,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
@@ -3188,17 +3191,29 @@ processAgentMsgSndFile _corrId aFileId msg =
         sendFileDescription sft rfd msgId sendMsg = do
           let rfdText = fileDescrText rfd
           withStore' $ \db -> updateSndFTDescrXFTP db user sft rfdText
-          partSize <- asks $ xftpDescrPartSize . config
+          parts <- splitFileDescr rfdText
-          sendParts 1 partSize rfdText
+          loopSend parts
           where
-            sendParts partNo partSize rfdText = do
+            -- returns msgDeliveryId of the last file description message
-              let (part, rest) = T.splitAt partSize rfdText
+            loopSend :: NonEmpty FileDescr -> m Int64
-                  complete = T.null rest
+            loopSend (fileDescr :| fds) = do
-                  fileDescr = FileDescr {fileDescrText = part, fileDescrPartNo = partNo, fileDescrComplete = complete}
               (_, msgDeliveryId) <- sendMsg $ XMsgFileDescr {msgId, fileDescr}
-              if complete
+              case L.nonEmpty fds of
-                then pure msgDeliveryId
+                Just fds' -> loopSend fds'
-                else sendParts (partNo + 1) partSize rest
+                Nothing -> pure msgDeliveryId
+
+splitFileDescr :: ChatMonad m => RcvFileDescrText -> m (NonEmpty FileDescr)
+splitFileDescr rfdText = do
+  partSize <- asks $ xftpDescrPartSize . config
+  pure $ splitParts 1 partSize rfdText
+  where
+    splitParts partNo partSize remText =
+      let (part, rest) = T.splitAt partSize remText
+          complete = T.null rest
+          fileDescr = FileDescr {fileDescrText = part, fileDescrPartNo = partNo, fileDescrComplete = complete}
+       in if complete
+            then fileDescr :| []
+            else fileDescr <| splitParts (partNo + 1) partSize rest
 
 processAgentMsgRcvFile :: forall m. ChatMonad m => ACorrId -> RcvFileId -> ACommand 'Agent 'AERcvFile -> m ()
 processAgentMsgRcvFile _corrId aFileId msg =
@@ -3293,6 +3308,9 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
           pure ()
         MSG meta _msgFlags msgBody -> do
           cmdId <- createAckCmd conn
+          -- TODO only acknowledge without saving message?
+          -- probably this branch is never executed, so there should be no reason
+          -- to save message if contact hasn't been created yet - chat item isn't created anyway
           withAckMessage agentConnId cmdId meta $ do
             (_conn', _) <- saveDirectRcvMSG conn meta cmdId msgBody
             pure False
@@ -3568,21 +3586,105 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
             let Connection {viaUserContactLink} = conn
             when (isJust viaUserContactLink && isNothing (memberContactId m)) sendXGrpLinkMem
             members <- withStore' $ \db -> getGroupMembers db user gInfo
-            intros <- withStore' $ \db -> createIntroductions db members m
             void . sendGroupMessage user gInfo members . XGrpMemNew $ memberInfo m
-            shuffledIntros <- liftIO $ shuffleMembers intros $ \GroupMemberIntro {reMember = GroupMember {memberRole}} -> memberRole
+            sendIntroductions members
-            forM_ shuffledIntros $ \intro ->
+            when (groupFeatureAllowed SGFHistory gInfo) sendHistory
-              processIntro intro `catchChatError` (toView . CRChatError (Just user))
             where
               sendXGrpLinkMem = do
                 let profileMode = ExistingIncognito <$> incognitoMembershipProfile gInfo
                     profileToSend = profileToSendOnAccept user profileMode
                 void $ sendDirectMessage conn (XGrpLinkMem profileToSend) (GroupId groupId)
+              sendIntroductions members = do
+                intros <- withStore' $ \db -> createIntroductions db members m
+                shuffledIntros <- liftIO $ shuffleIntros intros
+                if isCompatibleRange (memberChatVRange' m) batchSendVRange
+                  then do
+                    let events = map (XGrpMemIntro . memberInfo . reMember) shuffledIntros
+                    forM_ (L.nonEmpty events) $ \events' ->
+                      sendGroupMemberMessages user conn events' groupId
+                  else forM_ shuffledIntros $ \intro ->
+                    processIntro intro `catchChatError` (toView . CRChatError (Just user))
+              shuffleIntros :: [GroupMemberIntro] -> IO [GroupMemberIntro]
+              shuffleIntros intros = do
+                let (admins, others) = partition isAdmin intros
+                    (admPics, admNoPics) = partition hasPicture admins
+                    (othPics, othNoPics) = partition hasPicture others
+                mconcat <$> mapM shuffle [admPics, admNoPics, othPics, othNoPics]
+                where
+                  isAdmin GroupMemberIntro {reMember = GroupMember {memberRole}} = memberRole >= GRAdmin
+                  hasPicture GroupMemberIntro {reMember = GroupMember {memberProfile = LocalProfile {image}}} = isJust image
               processIntro intro@GroupMemberIntro {introId} = do
                 void $ sendDirectMessage conn (XGrpMemIntro $ memberInfo (reMember intro)) (GroupId groupId)
                 withStore' $ \db -> updateIntroStatus db introId GMIntroSent
+              sendHistory =
+                when (isCompatibleRange (memberChatVRange' m) batchSendVRange) $ do
+                  (errs, items) <- partitionEithers <$> withStore' (\db -> getGroupHistoryItems db user gInfo 100)
+                  (errs', events) <- partitionEithers <$> mapM (tryChatError . itemForwardEvents) items
+                  let errors = map ChatErrorStore errs <> errs'
+                  unless (null errors) $ toView $ CRChatErrors (Just user) errors
+                  forM_ (L.nonEmpty $ concat events) $ \events' ->
+                    sendGroupMemberMessages user conn events' groupId
+              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
+                  processContentItem sender ci mc fInvDescr_
+                (CChatItem SMDSnd ci@ChatItem {content = CISndMsgContent mc, file}) -> do
+                  fInvDescr_ <- join <$> forM file getSndFileInvDescr
+                  processContentItem membership ci mc fInvDescr_
+                _ -> pure []
+                where
+                  getRcvFileInvDescr :: CIFile 'MDRcv -> m (Maybe (FileInvitation, RcvFileDescrText))
+                  getRcvFileInvDescr ciFile@CIFile {fileId, fileProtocol, fileStatus} = do
+                    expired <- fileExpired
+                    if fileProtocol /= FPXFTP || fileStatus == CIFSRcvCancelled || expired
+                      then pure Nothing
+                      else do
+                        rfd <- withStore $ \db -> getRcvFileDescrByRcvFileId db fileId
+                        pure $ invCompleteDescr ciFile rfd
+                  getSndFileInvDescr :: CIFile 'MDSnd -> m (Maybe (FileInvitation, RcvFileDescrText))
+                  getSndFileInvDescr ciFile@CIFile {fileId, fileProtocol, fileStatus} = do
+                    expired <- fileExpired
+                    if fileProtocol /= FPXFTP || fileStatus == CIFSSndCancelled || expired
+                      then pure Nothing
+                      else 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
+                        rfd <- withStore $ \db -> getRcvFileDescrBySndFileId db fileId
+                        pure $ invCompleteDescr ciFile rfd
+                  fileExpired :: m Bool
+                  fileExpired = do
+                    ttl <- asks $ rcvFilesTTL . agentConfig . config
+                    cutoffTs <- addUTCTime (-ttl) <$> liftIO getCurrentTime
+                    pure $ chatItemTs cci < cutoffTs
+                  invCompleteDescr :: CIFile d -> RcvFileDescr -> Maybe (FileInvitation, RcvFileDescrText)
+                  invCompleteDescr CIFile {fileName, fileSize} RcvFileDescr {fileDescrText, fileDescrComplete}
+                    | fileDescrComplete =
+                        let fInvDescr = FileDescr {fileDescrText = "", fileDescrPartNo = 0, fileDescrComplete = False}
+                            fInv = xftpFileInvitation fileName fileSize fInvDescr
+                         in Just (fInv, fileDescrText)
+                    | otherwise = Nothing
+                  processContentItem :: GroupMember -> ChatItem 'CTGroup d -> MsgContent -> Maybe (FileInvitation, RcvFileDescrText) -> m [ChatMsgEvent Json]
+                  processContentItem sender ChatItem {meta, quotedItem} mc fInvDescr_ =
+                    if isNothing fInvDescr_ && not (msgContentHasText mc)
+                      then pure []
+                      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) -> do
+                            parts <- splitFileDescr fileDescrText
+                            pure . toList $ L.map (XMsgFileDescr msgId) parts
+                          _ -> pure []
+                        let fileDescrChatMsgs = map (ChatMessage senderVRange Nothing) fileDescrEvents
+                            GroupMember {memberId} = sender
+                            msgForwardEvents = map (\cm -> XGrpMsgForward memberId cm itemTs) (xMsgNewChatMsg : fileDescrChatMsgs)
+                        pure msgForwardEvents
           _ -> do
-            -- TODO notify member who forwarded introduction - question - where it is stored? There is via_contact but probably there should be via_member in group_members table
             let memCategory = memberCategory m
             withStore' (\db -> getViaGroupContact db user m) >>= \case
               Nothing -> do
@@ -3610,41 +3712,27 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
                       void $ sendDirectMessage imConn (XGrpMemCon m.memberId) (GroupId groupId)
                 _ -> messageWarning "sendXGrpMemCon: member category GCPreMember or GCPostMember is expected"
       MSG msgMeta _msgFlags msgBody -> do
+        checkIntegrityCreateItem (CDGroupRcv gInfo m) msgMeta `catchChatError` \_ -> pure ()
         cmdId <- createAckCmd conn
-        tryChatError (processChatMessage cmdId) >>= \case
+        let aChatMsgs = parseChatMessages msgBody
-          Right (ACMsg _ chatMsg, withRcpt) -> do
+        withAckMessage agentConnId cmdId msgMeta $ do
-            ackMsg agentConnId cmdId msgMeta $ if withRcpt then Just "" else Nothing
+          forM_ aChatMsgs $ \case
-            when (membership.memberRole >= GRAdmin) $ forwardMsg_ chatMsg
+            Right (ACMsg _ chatMsg) ->
-          Left e -> ackMsg agentConnId cmdId msgMeta Nothing >> throwError e
+              processEvent cmdId chatMsg `catchChatError` \e -> toView $ CRChatError (Just user) e
+            Left e -> toView $ CRChatError (Just user) (ChatError . CEException $ "error parsing chat message: " <> e)
+          checkSendRcpt $ rights aChatMsgs
+        -- currently only a single message is forwarded
+        when (membership.memberRole >= GRAdmin) $ case aChatMsgs of
+          [Right (ACMsg _ chatMsg)] -> forwardMsg_ chatMsg
+          _ -> pure ()
         where
-          processChatMessage :: Int64 -> m (AChatMessage, Bool)
-          processChatMessage cmdId = do
-            msg@(ACMsg _ chatMsg) <- parseAChatMessage conn msgMeta msgBody
-            checkIntegrity chatMsg `catchChatError` \_ -> pure ()
-            (msg,) <$> processEvent cmdId chatMsg
           brokerTs = metaBrokerTs msgMeta
-          checkIntegrity :: ChatMessage e -> m ()
+          processEvent :: MsgEncodingI e => CommandId -> ChatMessage e -> m ()
-          checkIntegrity ChatMessage {chatMsgEvent} = do
-            when checkForEvent $ checkIntegrityCreateItem (CDGroupRcv gInfo m) msgMeta
-            where
-              checkForEvent = case chatMsgEvent of
-                XMsgNew _ -> True
-                XFileCancel _ -> True
-                XFileAcptInv {} -> True
-                XGrpMemNew _ -> True
-                XGrpMemRole {} -> True
-                XGrpMemDel _ -> True
-                XGrpLeave -> True
-                XGrpDel -> True
-                XGrpInfo _ -> True
-                XGrpDirectInv {} -> True
-                _ -> False
-          processEvent :: MsgEncodingI e => CommandId -> ChatMessage e -> m Bool
           processEvent cmdId chatMsg = do
             (m', conn', msg@RcvMessage {chatMsgEvent = ACME _ event}) <- saveGroupRcvMsg user groupId m conn msgMeta cmdId msgBody chatMsg
             updateChatLock "groupMessage" event
             case event of
-              XMsgNew mc -> memberCanSend m' $ newGroupContentMessage gInfo m' mc msg brokerTs
+              XMsgNew mc -> memberCanSend m' $ newGroupContentMessage gInfo m' mc msg brokerTs False
               XMsgFileDescr sharedMsgId 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
@@ -3672,15 +3760,17 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
               XInfoProbeOk probe -> xInfoProbeOk (COMGroupMember m') probe
               BFileChunk sharedMsgId chunk -> bFileChunkGroup gInfo sharedMsgId chunk msgMeta
               _ -> messageError $ "unsupported message: " <> T.pack (show event)
-            checkSendRcpt event
+          checkSendRcpt :: [AChatMessage] -> m Bool
-          checkSendRcpt :: ChatMsgEvent e -> m Bool
+          checkSendRcpt aChatMsgs = do
-          checkSendRcpt event = do
             currentMemCount <- withStore' $ \db -> getGroupCurrentMembersCount db user gInfo
             let GroupInfo {chatSettings = ChatSettings {sendRcpts}} = gInfo
             pure $
               fromMaybe (sendRcptsSmallGroups user) sendRcpts
-                && hasDeliveryReceipt (toCMEventTag event)
+                && any aChatMsgHasReceipt aChatMsgs
                 && currentMemCount <= smallGroupsRcptsMemLimit
+            where
+              aChatMsgHasReceipt (ACMsg _ ChatMessage {chatMsgEvent}) =
+                hasDeliveryReceipt (toCMEventTag chatMsgEvent)
           forwardMsg_ :: MsgEncodingI e => ChatMessage e -> m ()
           forwardMsg_ chatMsg =
             forM_ (forwardedGroupMsg chatMsg) $ \chatMsg' -> do
@@ -4017,15 +4107,11 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
 
     ackMsgDeliveryEvent :: Connection -> CommandId -> m ()
     ackMsgDeliveryEvent Connection {connId} ackCmdId =
-      withStoreCtx'
+      withStore' $ \db -> updateRcvMsgDeliveryStatus db connId ackCmdId MDSRcvAcknowledged
-        (Just $ "createRcvMsgDeliveryEvent, connId: " <> show connId <> ", ackCmdId: " <> show ackCmdId <> ", msgDeliveryStatus: MDSRcvAcknowledged")
-        $ \db -> createRcvMsgDeliveryEvent db connId ackCmdId MDSRcvAcknowledged
 
     sentMsgDeliveryEvent :: Connection -> AgentMsgId -> m ()
     sentMsgDeliveryEvent Connection {connId} msgId =
-      withStoreCtx
+      withStore' $ \db -> updateSndMsgDeliveryStatus db connId msgId MDSSndSent
-        (Just $ "createSndMsgDeliveryEvent, connId: " <> show connId <> ", msgId: " <> show msgId <> ", msgDeliveryStatus: MDSSndSent")
-        $ \db -> createSndMsgDeliveryEvent db connId msgId MDSSndSent
 
     agentErrToItemStatus :: AgentErrorType -> CIStatus 'MDSnd
     agentErrToItemStatus (SMP AUTH) = CISSndErrorAuth
@@ -4287,14 +4373,15 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
         ChatErrorStore (SEChatItemSharedMsgIdNotFound sharedMsgId) -> handle sharedMsgId
         e -> throwError e
 
-    newGroupContentMessage :: GroupInfo -> GroupMember -> MsgContainer -> RcvMessage -> UTCTime -> m ()
+    newGroupContentMessage :: GroupInfo -> GroupMember -> MsgContainer -> RcvMessage -> UTCTime -> Bool -> m ()
-    newGroupContentMessage gInfo m@GroupMember {memberId, memberRole} mc msg@RcvMessage {sharedMsgId_} brokerTs
+    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
       | otherwise = do
-          -- TODO integrity message check
+          let timed_ =
-          -- check if message moderation event was received ahead of message
+                if forwarded
-          let timed_ = rcvGroupCITimed gInfo itemTTL
+                  then rcvCITimed_ (Just Nothing) itemTTL
+                  else rcvGroupCITimed gInfo itemTTL
               live = fromMaybe False live_
           withStore' (\db -> getCIModeration db user gInfo memberId sharedMsgId_) >>= \case
             Just ciModeration -> do
@@ -5221,7 +5308,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
           let body = LB.toStrict $ J.encode msg
           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
+            XMsgNew mc -> memberCanSend author $ newGroupContentMessage gInfo author mc rcvMsg msgTs True
             XMsgFileDescr sharedMsgId 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
@@ -5240,14 +5327,19 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
     directMsgReceived ct conn@Connection {connId} msgMeta msgRcpts = do
       checkIntegrityCreateItem (CDDirectRcv ct) msgMeta
       forM_ msgRcpts $ \MsgReceipt {agentMsgId, msgRcptStatus} -> do
-        withStore $ \db -> createSndMsgDeliveryEvent db connId agentMsgId $ MDSSndRcvd msgRcptStatus
+        withStore' $ \db -> updateSndMsgDeliveryStatus db connId agentMsgId $ MDSSndRcvd msgRcptStatus
         updateDirectItemStatus ct conn agentMsgId $ CISSndRcvd msgRcptStatus SSPComplete
 
+    -- TODO [batch send] update status of all messages in batch
+    -- - this is for when we implement identifying inactive connections
+    -- - regular messages sent in batch would all be marked as delivered by a single receipt
+    -- - repeat for directMsgReceived if same logic is applied to direct messages
+    -- - getChatItemIdByAgentMsgId to return [ChatItemId]
     groupMsgReceived :: GroupInfo -> GroupMember -> Connection -> MsgMeta -> NonEmpty MsgReceipt -> m ()
     groupMsgReceived gInfo m conn@Connection {connId} msgMeta msgRcpts = do
       checkIntegrityCreateItem (CDGroupRcv gInfo m) msgMeta
       forM_ msgRcpts $ \MsgReceipt {agentMsgId, msgRcptStatus} -> do
-        withStore $ \db -> createSndMsgDeliveryEvent db connId agentMsgId $ MDSSndRcvd msgRcptStatus
+        withStore' $ \db -> updateSndMsgDeliveryStatus db connId agentMsgId $ MDSSndRcvd msgRcptStatus
         updateGroupItemStatus gInfo m conn agentMsgId $ CISSndRcvd msgRcptStatus SSPComplete
 
     updateDirectItemStatus :: Contact -> Connection -> AgentMsgId -> CIStatus 'MDSnd -> m ()
@@ -5338,17 +5430,13 @@ sendFileInline_ FileTransferMeta {filePath, chunkSize} sharedMsgId sendMsg =
     chSize = fromIntegral chunkSize
 
 parseChatMessage :: ChatMonad m => Connection -> ByteString -> m (ChatMessage 'Json)
-parseChatMessage conn = parseChatMessage_ conn Nothing
+parseChatMessage conn s = do
-{-# INLINE parseChatMessage #-}
+  case parseChatMessages s of
-
+    [msg] -> liftEither . first (ChatError . errType) $ (\(ACMsg _ m) -> checkEncoding m) =<< msg
-parseAChatMessage :: ChatMonad m => Connection -> MsgMeta -> ByteString -> m AChatMessage
+    _ -> throwChatError $ CEException "parseChatMessage: single message is expected"
-parseAChatMessage conn msgMeta = parseChatMessage_ conn (Just msgMeta)
-{-# INLINE parseAChatMessage #-}
-
-parseChatMessage_ :: (ChatMonad m, StrEncoding s) => Connection -> Maybe MsgMeta -> ByteString -> m s
-parseChatMessage_ conn msgMeta s = liftEither . first (ChatError . errType) $ strDecode s
   where
-    errType = CEInvalidChatMessage conn (msgMetaToJson <$> msgMeta) (safeDecodeUtf8 s)
+    errType = CEInvalidChatMessage conn Nothing (safeDecodeUtf8 s)
+{-# INLINE parseChatMessage #-}
 
 sendFileChunk :: ChatMonad m => User -> SndFileTransfer -> m ()
 sendFileChunk user ft@SndFileTransfer {fileId, fileStatus, agentConnId = AgentConnId acId} =
@@ -5525,40 +5613,77 @@ createSndMessage :: (MsgEncodingI e, ChatMonad m) => ChatMsgEvent e -> ConnOrGro
 createSndMessage chatMsgEvent connOrGroupId = do
   gVar <- asks random
   ChatConfig {chatVRange} <- asks config
-  withStore $ \db -> createNewSndMessage db gVar connOrGroupId $ \sharedMsgId ->
+  withStore $ \db -> createNewSndMessage db gVar connOrGroupId chatMsgEvent (encodeMessage chatVRange)
-    let msgBody = strEncode ChatMessage {chatVRange, msgId = Just sharedMsgId, chatMsgEvent}
+  where
-     in NewMessage {chatMsgEvent, msgBody}
+    encodeMessage chatVRange sharedMsgId =
+      encodeChatMessage ChatMessage {chatVRange, msgId = Just sharedMsgId, chatMsgEvent}
+
+sendGroupMemberMessages :: forall e m. (MsgEncodingI e, ChatMonad m) => User -> Connection -> NonEmpty (ChatMsgEvent e) -> GroupId -> m ()
+sendGroupMemberMessages user conn@Connection {connId} events groupId = do
+  when (connDisabled conn) $ throwChatError (CEConnectionDisabled conn)
+  (errs, msgs) <- partitionEithers <$> createSndMessages
+  unless (null errs) $ toView $ CRChatErrors (Just user) errs
+  unless (null msgs) $ do
+    let (errs', msgBatches) = partitionEithers $ batchMessages maxChatMsgSize msgs
+    -- shouldn't happen, as large messages would have caused createNewSndMessage to throw SELargeMsg
+    unless (null errs') $ toView $ CRChatErrors (Just user) errs'
+    forM_ msgBatches $ \batch ->
+      processBatch batch `catchChatError` (toView . CRChatError (Just user))
+  where
+    processBatch :: MsgBatch -> m ()
+    processBatch (MsgBatch builder sndMsgs) = do
+      let batchBody = LB.toStrict $ toLazyByteString builder
+      agentMsgId <- withAgent $ \a -> sendMessage a (aConnId conn) MsgFlags {notification = True} batchBody
+      let sndMsgDelivery = SndMsgDelivery {connId, agentMsgId}
+      void . withStoreBatch' $ \db -> map (\SndMessage {msgId} -> createSndMsgDelivery db sndMsgDelivery msgId) sndMsgs
+    createSndMessages :: m [Either ChatError SndMessage]
+    createSndMessages = do
+      gVar <- asks random
+      ChatConfig {chatVRange} <- asks config
+      withStoreBatch $ \db -> map (createMsg db gVar chatVRange) (toList events)
+    createMsg db gVar chatVRange evnt = do
+      r <- runExceptT $ createNewSndMessage db gVar (GroupId groupId) evnt (encodeMessage chatVRange evnt)
+      pure $ first ChatErrorStore r
+    encodeMessage chatVRange evnt sharedMsgId =
+      encodeChatMessage ChatMessage {chatVRange, msgId = Just sharedMsgId, chatMsgEvent = evnt}
 
 directMessage :: (MsgEncodingI e, ChatMonad m) => ChatMsgEvent e -> m ByteString
 directMessage chatMsgEvent = do
   ChatConfig {chatVRange} <- asks config
-  pure $ strEncode ChatMessage {chatVRange, msgId = Nothing, chatMsgEvent}
+  let r = encodeChatMessage ChatMessage {chatVRange, msgId = Nothing, chatMsgEvent}
+  case r of
+    ECMEncoded encodedBody -> pure . LB.toStrict $ encodedBody
+    ECMLarge -> throwChatError $ CEException "large message"
 
-deliverMessage :: ChatMonad m => Connection -> CMEventTag e -> MsgBody -> MessageId -> m Int64
+deliverMessage :: ChatMonad m => Connection -> CMEventTag e -> LazyMsgBody -> MessageId -> m Int64
-deliverMessage conn cmEventTag msgBody msgId =
+deliverMessage conn cmEventTag msgBody msgId = do
-  deliverMessages [(conn, cmEventTag, msgBody, msgId)] >>= \case
+  let msgFlags = MsgFlags {notification = hasNotification cmEventTag}
+  deliverMessage' conn msgFlags msgBody msgId
+
+deliverMessage' :: ChatMonad m => Connection -> MsgFlags -> LazyMsgBody -> MessageId -> m Int64
+deliverMessage' conn msgFlags msgBody msgId =
+  deliverMessages [(conn, msgFlags, msgBody, msgId)] >>= \case
     [r] -> liftEither r
     rs -> throwChatError $ CEInternalError $ "deliverMessage: expected 1 result, got " <> show (length rs)
 
-deliverMessages :: ChatMonad' m => [(Connection, CMEventTag e, MsgBody, MessageId)] -> m [Either ChatError Int64]
+deliverMessages :: ChatMonad' m => [(Connection, MsgFlags, LazyMsgBody, MessageId)] -> m [Either ChatError Int64]
 deliverMessages msgReqs = do
   sent <- zipWith prepareBatch msgReqs <$> withAgent' (`sendMessages` aReqs)
   withStoreBatch $ \db -> map (bindRight $ createDelivery db) sent
   where
-    aReqs = map (\(conn, cmEvTag, msgBody, _msgId) -> (aConnId conn, msgFlags cmEvTag, msgBody)) msgReqs
+    aReqs = map (\(conn, msgFlags, msgBody, _msgId) -> (aConnId conn, msgFlags, LB.toStrict msgBody)) msgReqs
-    msgFlags cmEvTag = MsgFlags {notification = hasNotification cmEvTag}
     prepareBatch req = bimap (`ChatErrorAgent` Nothing) (req,)
-    createDelivery :: DB.Connection -> ((Connection, CMEventTag e, MsgBody, MessageId), AgentMsgId) -> IO (Either ChatError Int64)
+    createDelivery :: DB.Connection -> ((Connection, MsgFlags, LazyMsgBody, MessageId), AgentMsgId) -> IO (Either ChatError Int64)
     createDelivery db ((Connection {connId}, _, _, msgId), agentMsgId) =
       Right <$> createSndMsgDelivery db (SndMsgDelivery {connId, agentMsgId}) msgId
 
 sendGroupMessage :: (MsgEncodingI e, ChatMonad m) => User -> GroupInfo -> [GroupMember] -> ChatMsgEvent e -> m (SndMessage, [GroupMember])
 sendGroupMessage user GroupInfo {groupId} members chatMsgEvent = do
   msg@SndMessage {msgId, msgBody} <- createSndMessage chatMsgEvent (GroupId groupId)
-  recipientMembers <- liftIO $ shuffleMembers (filter memberCurrent members) $ \GroupMember {memberRole} -> memberRole
+  recipientMembers <- liftIO $ shuffleMembers (filter memberCurrent members)
-  let tag = toCMEventTag chatMsgEvent
+  let msgFlags = MsgFlags {notification = hasNotification $ toCMEventTag chatMsgEvent}
       (toSend, pending) = foldr addMember ([], []) recipientMembers
-      msgReqs = map (\(_, conn) -> (conn, tag, msgBody, msgId)) toSend
+      msgReqs = map (\(_, conn) -> (conn, msgFlags, msgBody, msgId)) toSend
   delivered <- deliverMessages msgReqs
   let errors = lefts delivered
   unless (null errors) $ toView $ CRChatErrors (Just user) errors
@@ -5566,6 +5691,12 @@ sendGroupMessage user GroupInfo {groupId} members chatMsgEvent = do
   let sentToMembers = filterSent delivered toSend fst <> filterSent stored pending id
   pure (msg, sentToMembers)
   where
+    shuffleMembers :: [GroupMember] -> IO [GroupMember]
+    shuffleMembers ms = do
+      let (adminMs, otherMs) = partition isAdmin ms
+      liftM2 (<>) (shuffle adminMs) (shuffle otherMs)
+      where
+        isAdmin GroupMember {memberRole} = memberRole >= GRAdmin
     addMember m (toSend, pending) = case memberSendAction chatMsgEvent members m of
       Just (MSASend conn) -> ((m, conn) : toSend, pending)
       Just MSAPending -> (toSend, m : pending)
@@ -5614,15 +5745,6 @@ sendGroupMemberMessage user m@GroupMember {groupMemberId} chatMsgEvent groupId i
       MSASend conn -> deliverMessage conn (toCMEventTag chatMsgEvent) msgBody msgId >> postDeliver
       MSAPending -> withStore' $ \db -> createPendingGroupMessage db groupMemberId msgId introId_
 
-shuffleMembers :: [a] -> (a -> GroupMemberRole) -> IO [a]
-shuffleMembers ms role = do
-  let (adminMs, otherMs) = partition ((GRAdmin <=) . role) ms
-  liftM2 (<>) (shuffle adminMs) (shuffle otherMs)
-  where
-    random :: IO Word16
-    random = randomRIO (0, 65535)
-    shuffle xs = map snd . sortBy (comparing fst) <$> mapM (\x -> (,x) <$> random) xs
-
 sendPendingGroupMessages :: ChatMonad m => User -> GroupMember -> Connection -> m ()
 sendPendingGroupMessages user GroupMember {groupMemberId, localDisplayName} conn = do
   pendingMessages <- withStore' $ \db -> getPendingGroupMessages db groupMemberId
@@ -5639,21 +5761,25 @@ sendPendingGroupMessages user GroupMember {groupMemberId, localDisplayName} conn
           _ -> throwChatError $ CEGroupMemberIntroNotFound localDisplayName
         _ -> pure ()
 
+-- TODO [batch send] refactor direct message processing same as groups (e.g. checkIntegrity before processing)
 saveDirectRcvMSG :: ChatMonad m => Connection -> MsgMeta -> CommandId -> MsgBody -> m (Connection, RcvMessage)
-saveDirectRcvMSG conn@Connection {connId} agentMsgMeta agentAckCmdId msgBody = do
+saveDirectRcvMSG conn@Connection {connId} agentMsgMeta agentAckCmdId msgBody =
-  ACMsg _ ChatMessage {chatVRange, msgId = sharedMsgId_, chatMsgEvent} <- parseAChatMessage conn agentMsgMeta msgBody
+  case parseChatMessages msgBody of
-  conn' <- updatePeerChatVRange conn chatVRange
+    [Right (ACMsg _ ChatMessage {chatVRange, msgId = sharedMsgId_, chatMsgEvent})] -> do
-  let agentMsgId = fst $ recipient agentMsgMeta
+      conn' <- updatePeerChatVRange conn chatVRange
-      newMsg = NewMessage {chatMsgEvent, msgBody}
+      let agentMsgId = fst $ recipient agentMsgMeta
-      rcvMsgDelivery = RcvMsgDelivery {connId, agentMsgId, agentMsgMeta, agentAckCmdId}
+          newMsg = NewRcvMessage {chatMsgEvent, msgBody}
-  msg <- withStore $ \db -> createNewMessageAndRcvMsgDelivery db (ConnectionId connId) newMsg sharedMsgId_ rcvMsgDelivery Nothing
+          rcvMsgDelivery = RcvMsgDelivery {connId, agentMsgId, agentMsgMeta, agentAckCmdId}
-  pure (conn', msg)
+      msg <- withStore $ \db -> createNewMessageAndRcvMsgDelivery db (ConnectionId connId) newMsg sharedMsgId_ rcvMsgDelivery Nothing
+      pure (conn', msg)
+    [Left e] -> error $ "saveDirectRcvMSG: error parsing chat message: " <> e
+    _ -> error "saveDirectRcvMSG: batching not supported"
 
 saveGroupRcvMsg :: (MsgEncodingI e, ChatMonad m) => User -> GroupId -> GroupMember -> Connection -> MsgMeta -> CommandId -> MsgBody -> ChatMessage e -> m (GroupMember, Connection, RcvMessage)
 saveGroupRcvMsg user groupId authorMember conn@Connection {connId} agentMsgMeta agentAckCmdId msgBody ChatMessage {chatVRange, msgId = sharedMsgId_, chatMsgEvent} = do
   (am', conn') <- updateMemberChatVRange authorMember conn chatVRange
   let agentMsgId = fst $ recipient agentMsgMeta
-      newMsg = NewMessage {chatMsgEvent, msgBody}
+      newMsg = NewRcvMessage {chatMsgEvent, msgBody}
       rcvMsgDelivery = RcvMsgDelivery {connId, agentMsgId, agentMsgMeta, agentAckCmdId}
       amId = Just am'.groupMemberId
   msg <-
@@ -5669,7 +5795,7 @@ saveGroupRcvMsg user groupId authorMember conn@Connection {connId} agentMsgMeta
 
 saveGroupFwdRcvMsg :: (MsgEncodingI e, ChatMonad m) => User -> GroupId -> GroupMember -> GroupMember -> MsgBody -> ChatMessage e -> m RcvMessage
 saveGroupFwdRcvMsg user groupId forwardingMember refAuthorMember msgBody ChatMessage {msgId = sharedMsgId_, chatMsgEvent} = do
-  let newMsg = NewMessage {chatMsgEvent, msgBody}
+  let newMsg = NewRcvMessage {chatMsgEvent, msgBody}
       fwdMemberId = Just $ groupMemberId' forwardingMember
       refAuthorId = Just $ groupMemberId' refAuthorMember
   withStore (\db -> createNewRcvMessage db (GroupId groupId) newMsg sharedMsgId_ refAuthorId fwdMemberId)
@@ -6233,6 +6359,7 @@ chatCommandP =
       "/set voice @" *> (SetContactFeature (ACF SCFVoice) <$> displayName <*> optional (A.space *> strP)),
       "/set voice " *> (SetUserFeature (ACF SCFVoice) <$> strP),
       "/set files #" *> (SetGroupFeature (AGF SGFFiles) <$> displayName <*> (A.space *> strP)),
+      "/set history #" *> (SetGroupFeature (AGF SGFHistory) <$> displayName <*> (A.space *> strP)),
       "/set calls @" *> (SetContactFeature (ACF SCFCalls) <$> displayName <*> optional (A.space *> strP)),
       "/set calls " *> (SetUserFeature (ACF SCFCalls) <$> strP),
       "/set delete #" *> (SetGroupFeature (AGF SGFFullDelete) <$> displayName <*> (A.space *> strP)),
@@ -6320,7 +6447,12 @@ chatCommandP =
     jsonP = J.eitherDecodeStrict' <$?> A.takeByteString
     groupProfile = do
       (gName, fullName) <- profileNames
-      let groupPreferences = Just (emptyGroupPrefs :: GroupPreferences) {directMessages = Just DirectMessagesGroupPreference {enable = FEOn}}
+      let groupPreferences =
+            Just
+              (emptyGroupPrefs :: GroupPreferences)
+                { directMessages = Just DirectMessagesGroupPreference {enable = FEOn},
+                  history = Just HistoryGroupPreference {enable = FEOn}
+                }
       pure GroupProfile {displayName = gName, fullName, description = Nothing, image = Nothing, groupPreferences}
     fullNameP = A.space *> textP <|> pure ""
     textP = safeDecodeUtf8 <$> A.takeByteString
@@ -6358,6 +6490,7 @@ chatCommandP =
         <|> ("day" $> 86400)
         <|> ("week" $> (7 * 86400))
         <|> ("month" $> (30 * 86400))
+        <|> A.decimal
     timedTTLOnOffP =
       optional ("on" *> A.space) *> (Just <$> timedTTLP)
         <|> ("off" $> Nothing)

src/Simplex/Chat/Help.hs

@@ -155,7 +155,8 @@ groupsHelpInfo =
       "",
       green "Group chat preferences:",
       indent <> highlight "/set voice #<group> on/off         " <> " - enable/disable voice messages",
-      -- indent <> highlight "/set files #<group> on/off         " <> " - enable/disable files and media (other than voice)",
+      indent <> highlight "/set files #<group> on/off         " <> " - enable/disable files and media (other than voice)",
+      indent <> highlight "/set history #<group> on/off       " <> " - enable/disable sending recent history to new members",
       indent <> highlight "/set delete #<group> on/off        " <> " - enable/disable full message deletion",
       indent <> highlight "/set direct #<group> on/off        " <> " - enable/disable direct messages to other members",
       indent <> highlight "/set disappear #<group> on <time>  " <> " - enable disappearing messages with <time>:",

src/Simplex/Chat/Messages.hs

@@ -22,6 +22,7 @@ import qualified Data.Aeson.Encoding as JE
 import qualified Data.Aeson.TH as JQ
 import qualified Data.Attoparsec.ByteString.Char8 as A
 import qualified Data.ByteString.Base64 as B64
+import qualified Data.ByteString.Lazy as L
 import qualified Data.ByteString.Lazy.Char8 as LB
 import Data.Char (isSpace)
 import Data.Int (Int64)
@@ -370,6 +371,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,
@@ -760,17 +764,20 @@ checkChatType x = case testEquality (chatTypeI @c) (chatTypeI @c') of
   Just Refl -> Right x
   Nothing -> Left "bad chat type"
 
-data NewMessage e = NewMessage
+type LazyMsgBody = L.ByteString
-  { chatMsgEvent :: ChatMsgEvent e,
-    msgBody :: MsgBody
-  }
-  deriving (Show)
 
 data SndMessage = SndMessage
   { msgId :: MessageId,
     sharedMsgId :: SharedMsgId,
+    msgBody :: LazyMsgBody
+  }
+  deriving (Show)
+
+data NewRcvMessage e = NewRcvMessage
+  { chatMsgEvent :: ChatMsgEvent e,
     msgBody :: MsgBody
   }
+  deriving (Show)
 
 data RcvMessage = RcvMessage
   { msgId :: MessageId,
@@ -784,7 +791,7 @@ data RcvMessage = RcvMessage
 data PendingGroupMessage = PendingGroupMessage
   { msgId :: MessageId,
     cmEventTag :: ACMEventTag,
-    msgBody :: MsgBody,
+    msgBody :: LazyMsgBody,
     introId_ :: Maybe Int64
   }
 

src/Simplex/Chat/Messages/Batch.hs

@@ -0,0 +1,53 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Simplex.Chat.Messages.Batch
+  ( MsgBatch (..),
+    batchMessages,
+  )
+where
+
+import Data.ByteString.Builder (Builder, charUtf8, lazyByteString)
+import qualified Data.ByteString.Lazy as LB
+import Data.Int (Int64)
+import Simplex.Chat.Controller (ChatError (..), ChatErrorType (..))
+import Simplex.Chat.Messages
+
+data MsgBatch = MsgBatch Builder [SndMessage]
+  deriving (Show)
+
+-- | Batches [SndMessage] into batches of ByteString builders in form of JSON arrays.
+-- Does not check if the resulting batch is a valid JSON.
+-- If a single element is passed, it is returned as is (a JSON string).
+-- If an element exceeds maxLen, it is returned as ChatError.
+batchMessages :: Int64 -> [SndMessage] -> [Either ChatError MsgBatch]
+batchMessages maxLen msgs =
+  let (batches, batch, _, n) = foldr addToBatch ([], [], 0, 0) msgs
+   in if n == 0 then batches else msgBatch batch : batches
+  where
+    msgBatch batch = Right (MsgBatch (encodeMessages batch) batch)
+    addToBatch :: SndMessage -> ([Either ChatError MsgBatch], [SndMessage], Int64, Int) -> ([Either ChatError MsgBatch], [SndMessage], Int64, Int)
+    addToBatch msg@SndMessage {msgBody} (batches, batch, len, n)
+      | batchLen <= maxLen = (batches, msg : batch, len', n + 1)
+      | msgLen <= maxLen = (batches', [msg], msgLen, 1)
+      | otherwise = (errLarge msg : (if n == 0 then batches else batches'), [], 0, 0)
+      where
+        msgLen = LB.length msgBody
+        batches' = msgBatch batch : batches
+        len'
+          | n == 0 = msgLen
+          | otherwise = msgLen + len + 1 -- 1 accounts for comma
+        batchLen
+          | n == 0 = len'
+          | otherwise = len' + 2 -- 2 accounts for opening and closing brackets
+        errLarge SndMessage {msgId} = Left $ ChatError $ CEInternalError ("large message " <> show msgId)
+
+encodeMessages :: [SndMessage] -> Builder
+encodeMessages = \case
+  [] -> mempty
+  [msg] -> encodeMsg msg
+  (msg : msgs) -> charUtf8 '[' <> encodeMsg msg <> mconcat [charUtf8 ',' <> encodeMsg msg' | msg' <- msgs] <> charUtf8 ']'
+  where
+    encodeMsg SndMessage {msgBody} = lazyByteString msgBody

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"
+  CISndMsgContent _ -> sndMsgContentTag
-  CIRcvMsgContent _ -> "rcvMsgContent"
+  CIRcvMsgContent _ -> rcvMsgContentTag
   CISndDeleted _ -> "sndDeleted"
   CIRcvDeleted _ -> "rcvDeleted"
   CISndCall {} -> "sndCall"

src/Simplex/Chat/Migrations/M20231215_recreate_msg_deliveries.hs

@@ -0,0 +1,100 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module Simplex.Chat.Migrations.M20231215_recreate_msg_deliveries where
+
+import Database.SQLite.Simple (Query)
+import Database.SQLite.Simple.QQ (sql)
+
+m20231215_recreate_msg_deliveries :: Query
+m20231215_recreate_msg_deliveries =
+  [sql|
+DROP INDEX msg_delivery_events_msg_delivery_id;
+DROP TABLE msg_delivery_events;
+
+DROP INDEX idx_msg_deliveries_message_id;
+DROP INDEX idx_msg_deliveries_agent_ack_cmd_id;
+
+CREATE TABLE new_msg_deliveries(
+  msg_delivery_id INTEGER PRIMARY KEY,
+  message_id INTEGER NOT NULL REFERENCES messages ON DELETE CASCADE, -- non UNIQUE for group messages and for batched messages
+  connection_id INTEGER NOT NULL REFERENCES connections ON DELETE CASCADE,
+  agent_msg_id INTEGER, -- internal agent message ID (NULL while pending), non UNIQUE for batched messages
+  agent_msg_meta TEXT, -- JSON with timestamps etc. sent in MSG, NULL for sent
+  chat_ts TEXT NOT NULL DEFAULT(datetime('now')),
+  created_at TEXT CHECK(created_at NOT NULL),
+  updated_at TEXT CHECK(updated_at NOT NULL),
+  agent_ack_cmd_id INTEGER, -- broker_ts for received, created_at for sent
+  delivery_status TEXT -- MsgDeliveryStatus
+);
+
+INSERT INTO new_msg_deliveries (
+  msg_delivery_id, message_id, connection_id, agent_msg_id, agent_msg_meta,
+  chat_ts, created_at, updated_at, agent_ack_cmd_id
+)
+SELECT
+  msg_delivery_id, message_id, connection_id, agent_msg_id, agent_msg_meta,
+  chat_ts, created_at, updated_at, agent_ack_cmd_id
+FROM msg_deliveries;
+
+DROP TABLE msg_deliveries;
+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);
+|]
+
+down_m20231215_recreate_msg_deliveries :: Query
+down_m20231215_recreate_msg_deliveries =
+  [sql|
+DROP INDEX idx_msg_deliveries_message_id;
+DROP INDEX idx_msg_deliveries_agent_ack_cmd_id;
+DROP INDEX idx_msg_deliveries_agent_msg_id;
+
+CREATE TABLE old_msg_deliveries(
+  msg_delivery_id INTEGER PRIMARY KEY,
+  message_id INTEGER NOT NULL REFERENCES messages ON DELETE CASCADE, -- non UNIQUE for group messages
+  connection_id INTEGER NOT NULL REFERENCES connections ON DELETE CASCADE,
+  agent_msg_id INTEGER, -- internal agent message ID(NULL while pending)
+  agent_msg_meta TEXT, -- JSON with timestamps etc. sent in MSG, NULL for sent
+  chat_ts TEXT NOT NULL DEFAULT(datetime('now')),
+  created_at TEXT CHECK(created_at NOT NULL),
+  updated_at TEXT CHECK(updated_at NOT NULL),
+  agent_ack_cmd_id INTEGER, -- broker_ts for received, created_at for sent
+  UNIQUE(connection_id, agent_msg_id)
+);
+
+INSERT INTO old_msg_deliveries (
+  msg_delivery_id, message_id, connection_id, agent_msg_id, agent_msg_meta,
+  chat_ts, created_at, updated_at, agent_ack_cmd_id
+)
+WITH unique_msg_deliveries AS (
+  SELECT
+    msg_delivery_id, message_id, connection_id, agent_msg_id, agent_msg_meta,
+    chat_ts, created_at, updated_at, agent_ack_cmd_id,
+    row_number() OVER connection_id_agent_msg_id_win AS row_number
+  FROM msg_deliveries
+  WINDOW connection_id_agent_msg_id_win AS (PARTITION BY connection_id, agent_msg_id ORDER BY created_at ASC, msg_delivery_id ASC)
+)
+SELECT
+  msg_delivery_id, message_id, connection_id, agent_msg_id, agent_msg_meta,
+  chat_ts, created_at, updated_at, agent_ack_cmd_id
+FROM unique_msg_deliveries
+WHERE row_number = 1;
+
+DROP TABLE msg_deliveries;
+ALTER TABLE old_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 TABLE msg_delivery_events (
+  msg_delivery_event_id INTEGER PRIMARY KEY,
+  msg_delivery_id INTEGER NOT NULL REFERENCES msg_deliveries ON DELETE CASCADE, -- non UNIQUE for multiple events per msg delivery
+  delivery_status TEXT NOT NULL, -- see MsgDeliveryStatus for allowed values
+  created_at TEXT NOT NULL DEFAULT (datetime('now')),
+  updated_at TEXT NOT NULL DEFAULT (datetime('now')),
+  UNIQUE (msg_delivery_id, delivery_status)
+);
+CREATE INDEX msg_delivery_events_msg_delivery_id ON msg_delivery_events(msg_delivery_id);
+|]

src/Simplex/Chat/Migrations/chat_schema.sql

@@ -330,18 +330,6 @@ CREATE TABLE messages(
   author_group_member_id INTEGER REFERENCES group_members ON DELETE SET NULL,
   forwarded_by_group_member_id INTEGER REFERENCES group_members ON DELETE SET NULL
 );
-CREATE TABLE msg_deliveries(
-  msg_delivery_id INTEGER PRIMARY KEY,
-  message_id INTEGER NOT NULL REFERENCES messages ON DELETE CASCADE, -- non UNIQUE for group messages
-  connection_id INTEGER NOT NULL REFERENCES connections ON DELETE CASCADE,
-  agent_msg_id INTEGER, -- internal agent message ID(NULL while pending)
-  agent_msg_meta TEXT, -- JSON with timestamps etc. sent in MSG, NULL for sent
-  chat_ts TEXT NOT NULL DEFAULT(datetime('now')),
-  created_at TEXT CHECK(created_at NOT NULL),
-  updated_at TEXT CHECK(updated_at NOT NULL),
-  agent_ack_cmd_id INTEGER, -- broker_ts for received, created_at for sent
-  UNIQUE(connection_id, agent_msg_id)
-);
 CREATE TABLE pending_group_messages(
   pending_group_message_id INTEGER PRIMARY KEY,
   group_member_id INTEGER NOT NULL REFERENCES group_members ON DELETE CASCADE,
@@ -450,13 +438,6 @@ CREATE TABLE extra_xftp_file_descriptions(
   created_at TEXT NOT NULL DEFAULT(datetime('now')),
   updated_at TEXT NOT NULL DEFAULT(datetime('now'))
 );
-CREATE TABLE msg_delivery_events(
-  msg_delivery_event_id INTEGER PRIMARY KEY,
-  msg_delivery_id INTEGER NOT NULL REFERENCES msg_deliveries ON DELETE CASCADE,
-  delivery_status TEXT NOT NULL,
-  created_at TEXT NOT NULL DEFAULT(datetime('now')),
-  updated_at TEXT NOT NULL DEFAULT(datetime('now'))
-);
 CREATE TABLE chat_item_versions(
   -- contains versions only for edited chat items, including current version
   chat_item_version_id INTEGER PRIMARY KEY AUTOINCREMENT,
@@ -554,6 +535,18 @@ CREATE TABLE remote_controllers(
   dh_priv_key BLOB NOT NULL, -- last session DH key
   prev_dh_priv_key BLOB -- previous session DH key
 );
+CREATE TABLE IF NOT EXISTS "msg_deliveries"(
+  msg_delivery_id INTEGER PRIMARY KEY,
+  message_id INTEGER NOT NULL REFERENCES messages ON DELETE CASCADE, -- non UNIQUE for group messages and for batched messages
+  connection_id INTEGER NOT NULL REFERENCES connections ON DELETE CASCADE,
+  agent_msg_id INTEGER, -- internal agent message ID(NULL while pending), non UNIQUE for batched messages
+  agent_msg_meta TEXT, -- JSON with timestamps etc. sent in MSG, NULL for sent
+  chat_ts TEXT NOT NULL DEFAULT(datetime('now')),
+  created_at TEXT CHECK(created_at NOT NULL),
+  updated_at TEXT CHECK(updated_at NOT NULL),
+  agent_ack_cmd_id INTEGER, -- broker_ts for received, created_at for sent
+  delivery_status TEXT -- MsgDeliveryStatus
+);
 CREATE INDEX contact_profiles_index ON contact_profiles(
   display_name,
   full_name
@@ -585,7 +578,6 @@ CREATE UNIQUE INDEX idx_chat_items_group_shared_msg_id ON chat_items(
   group_member_id,
   shared_msg_id
 );
-CREATE INDEX idx_msg_deliveries_message_id ON msg_deliveries(message_id);
 CREATE UNIQUE INDEX idx_user_contact_links_group_id ON user_contact_links(
   group_id
 );
@@ -717,13 +709,6 @@ CREATE INDEX idx_chat_items_timed_delete_at ON chat_items(
   timed_delete_at
 );
 CREATE INDEX idx_group_members_group_id ON group_members(user_id, group_id);
-CREATE INDEX idx_msg_deliveries_agent_ack_cmd_id ON msg_deliveries(
-  connection_id,
-  agent_ack_cmd_id
-);
-CREATE INDEX msg_delivery_events_msg_delivery_id ON msg_delivery_events(
-  msg_delivery_id
-);
 CREATE INDEX idx_chat_item_moderations_group_id ON chat_item_moderations(
   group_id
 );
@@ -818,3 +803,12 @@ CREATE INDEX idx_contact_requests_updated_at ON contact_requests(
   updated_at
 );
 CREATE INDEX idx_connections_updated_at ON connections(user_id, updated_at);
+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
+);

src/Simplex/Chat/Protocol.hs

@@ -29,7 +29,9 @@ import qualified Data.Attoparsec.ByteString.Char8 as A
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Data.ByteString.Internal (c2w, w2c)
+import qualified Data.ByteString.Lazy as L
 import qualified Data.ByteString.Lazy.Char8 as LB
+import Data.Int (Int64)
 import Data.Maybe (fromMaybe)
 import Data.String
 import Data.Text (Text)
@@ -51,7 +53,7 @@ import Simplex.Messaging.Util (eitherToMaybe, safeDecodeUtf8, (<$?>))
 import Simplex.Messaging.Version hiding (version)
 
 currentChatVersion :: Version
-currentChatVersion = 4
+currentChatVersion = 5
 
 supportedChatVRange :: VersionRange
 supportedChatVRange = mkVersionRange 1 currentChatVersion
@@ -72,6 +74,10 @@ groupLinkNoContactVRange = mkVersionRange 3 currentChatVersion
 groupForwardVRange :: VersionRange
 groupForwardVRange = mkVersionRange 4 currentChatVersion
 
+-- version range that supports batch sending in groups
+batchSendVRange :: VersionRange
+batchSendVRange = mkVersionRange 5 currentChatVersion
+
 data ConnectionEntity
   = RcvDirectMsgConnection {entityConnection :: Connection, contact :: Maybe Contact}
   | RcvGroupMsgConnection {entityConnection :: Connection, groupInfo :: GroupInfo, groupMember :: GroupMember}
@@ -447,6 +453,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
@@ -467,18 +485,34 @@ data ExtMsgContent = ExtMsgContent {content :: MsgContent, file :: Maybe FileInv
 
 $(JQ.deriveJSON defaultJSON ''QuotedMsg)
 
-instance MsgEncodingI e => StrEncoding (ChatMessage e) where
+-- this limit reserves space for metadata in forwarded messages
-  strEncode msg = case chatToAppMessage msg of
+-- 15780 (limit used for fileChunkSize) - 161 (x.grp.msg.forward overhead) = 15619, round to 15610
-    AMJson m -> LB.toStrict $ J.encode m
+maxChatMsgSize :: Int64
-    AMBinary m -> strEncode m
+maxChatMsgSize = 15610
-  strP = (\(ACMsg _ m) -> checkEncoding m) <$?> strP
 
-instance StrEncoding AChatMessage where
+data EncodedChatMessage = ECMEncoded L.ByteString | ECMLarge
-  strEncode (ACMsg _ m) = strEncode m
+
-  strP =
+encodeChatMessage :: MsgEncodingI e => ChatMessage e -> EncodedChatMessage
-    A.peekChar' >>= \case
+encodeChatMessage msg = do
-      '{' -> ACMsg SJson <$> ((appJsonToCM <=< J.eitherDecodeStrict') <$?> A.takeByteString)
+  case chatToAppMessage msg of
-      _ -> ACMsg SBinary <$> (appBinaryToCM <$?> strP)
+    AMJson m -> do
+      let body = J.encode m
+      if LB.length body > maxChatMsgSize
+        then ECMLarge
+        else ECMEncoded body
+    AMBinary m -> ECMEncoded . LB.fromStrict $ strEncode m
+
+parseChatMessages :: ByteString -> [Either String AChatMessage]
+parseChatMessages "" = [Left "empty string"]
+parseChatMessages s = case B.head s of
+  '{' -> [ACMsg SJson <$> J.eitherDecodeStrict' s]
+  '[' -> case J.eitherDecodeStrict' s of
+    Right v -> map parseItem v
+    Left e -> [Left e]
+  _ -> [ACMsg SBinary <$> (appBinaryToCM =<< strDecode s)]
+  where
+    parseItem :: J.Value -> Either String AChatMessage
+    parseItem v = ACMsg SJson <$> JT.parseEither parseJSON v
 
 parseMsgContainer :: J.Object -> JT.Parser MsgContainer
 parseMsgContainer v =

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
+getRcvFileDescrByRcvFileId :: DB.Connection -> FileTransferId -> ExceptT StoreError IO RcvFileDescr
-getRcvFileDescrByFileId db fileId = do
+getRcvFileDescrByRcvFileId db fileId = do
-  liftIO (getRcvFileDescrByFileId_ db fileId) >>= \case
+  liftIO (getRcvFileDescrByRcvFileId_ db fileId) >>= \case
     Nothing -> throwError $ SERcvFileDescrNotFound fileId
     Just rfd -> pure rfd
 
-getRcvFileDescrByFileId_ :: DB.Connection -> FileTransferId -> IO (Maybe RcvFileDescr)
+getRcvFileDescrByRcvFileId_ :: DB.Connection -> FileTransferId -> IO (Maybe RcvFileDescr)
-getRcvFileDescrByFileId_ db fileId =
+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
+getRcvFileDescrBySndFileId :: DB.Connection -> FileTransferId -> ExceptT StoreError IO RcvFileDescr
-    toRcvFileDescr (fileDescrId, fileDescrText, fileDescrPartNo, fileDescrComplete) =
+getRcvFileDescrBySndFileId db fileId = do
-      RcvFileDescr {fileDescrId, fileDescrText, fileDescrPartNo, fileDescrComplete}
+  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/Groups.hs

@@ -150,7 +150,7 @@ type MaybeGroupMemberRow = ((Maybe Int64, Maybe Int64, Maybe MemberId, Maybe Ver
 
 toGroupInfo :: Int64 -> GroupInfoRow -> GroupInfo
 toGroupInfo userContactId ((groupId, localDisplayName, displayName, fullName, description, image, hostConnCustomUserProfileId, enableNtfs_, sendRcpts, favorite, groupPreferences) :. (createdAt, updatedAt, chatTs) :. userMemberRow) =
-  let membership = toGroupMember userContactId userMemberRow
+  let membership = (toGroupMember userContactId userMemberRow) {memberChatVRange = JVersionRange supportedChatVRange}
       chatSettings = ChatSettings {enableNtfs = fromMaybe MFAll enableNtfs_, sendRcpts, favorite}
       fullGroupPreferences = mergeGroupPreferences groupPreferences
       groupProfile = GroupProfile {displayName, fullName, description, image, groupPreferences}

src/Simplex/Chat/Store/Messages.hs

@@ -24,8 +24,8 @@ module Simplex.Chat.Store.Messages
     createSndMsgDelivery,
     createNewMessageAndRcvMsgDelivery,
     createNewRcvMessage,
-    createSndMsgDeliveryEvent,
+    updateSndMsgDeliveryStatus,
-    createRcvMsgDeliveryEvent,
+    updateRcvMsgDeliveryStatus,
     createPendingGroupMessage,
     getPendingGroupMessages,
     deletePendingGroupMessage,
@@ -99,6 +99,7 @@ module Simplex.Chat.Store.Messages
     updateGroupSndStatus,
     getGroupSndStatuses,
     getGroupSndStatusCounts,
+    getGroupHistoryItems,
   )
 where
 
@@ -159,49 +160,59 @@ deleteGroupCIs db User {userId} GroupInfo {groupId} = do
   DB.execute db "DELETE FROM chat_item_reactions WHERE group_id = ?" (Only groupId)
   DB.execute db "DELETE FROM chat_items WHERE user_id = ? AND group_id = ?" (userId, groupId)
 
-createNewSndMessage :: MsgEncodingI e => DB.Connection -> TVar ChaChaDRG -> ConnOrGroupId -> (SharedMsgId -> NewMessage e) -> ExceptT StoreError IO SndMessage
+createNewSndMessage :: MsgEncodingI e => DB.Connection -> TVar ChaChaDRG -> ConnOrGroupId -> ChatMsgEvent e -> (SharedMsgId -> EncodedChatMessage) -> ExceptT StoreError IO SndMessage
-createNewSndMessage db gVar connOrGroupId mkMessage =
+createNewSndMessage db gVar connOrGroupId chatMsgEvent encodeMessage =
-  createWithRandomId gVar $ \sharedMsgId -> do
+  createWithRandomId' gVar $ \sharedMsgId ->
-    let NewMessage {chatMsgEvent, msgBody} = mkMessage $ SharedMsgId sharedMsgId
+    case encodeMessage (SharedMsgId sharedMsgId) of
-    createdAt <- getCurrentTime
+      ECMLarge -> pure $ Left SELargeMsg
-    DB.execute
+      ECMEncoded msgBody -> do
-      db
+        createdAt <- getCurrentTime
-      [sql|
+        DB.execute
-        INSERT INTO messages (
+          db
-          msg_sent, chat_msg_event, msg_body, connection_id, group_id,
+          [sql|
-          shared_msg_id, shared_msg_id_user, created_at, updated_at
+            INSERT INTO messages (
-        ) VALUES (?,?,?,?,?,?,?,?,?)
+              msg_sent, chat_msg_event, msg_body, connection_id, group_id,
-      |]
+              shared_msg_id, shared_msg_id_user, created_at, updated_at
-      (MDSnd, toCMEventTag chatMsgEvent, msgBody, connId_, groupId_, sharedMsgId, Just True, createdAt, createdAt)
+            ) VALUES (?,?,?,?,?,?,?,?,?)
-    msgId <- insertedRowId db
+          |]
-    pure SndMessage {msgId, sharedMsgId = SharedMsgId sharedMsgId, msgBody}
+          (MDSnd, toCMEventTag chatMsgEvent, msgBody, connId_, groupId_, sharedMsgId, Just True, createdAt, createdAt)
+        msgId <- insertedRowId db
+        pure $ Right SndMessage {msgId, sharedMsgId = SharedMsgId sharedMsgId, msgBody}
   where
     (connId_, groupId_) = case connOrGroupId of
       ConnectionId connId -> (Just connId, Nothing)
       GroupId groupId -> (Nothing, Just groupId)
 
 createSndMsgDelivery :: DB.Connection -> SndMsgDelivery -> MessageId -> IO Int64
-createSndMsgDelivery db sndMsgDelivery messageId = do
+createSndMsgDelivery db SndMsgDelivery {connId, agentMsgId} messageId = do
   currentTs <- getCurrentTime
-  msgDeliveryId <- createSndMsgDelivery_ db sndMsgDelivery messageId currentTs
+  DB.execute
-  createMsgDeliveryEvent_ db msgDeliveryId MDSSndAgent currentTs
+    db
-  pure msgDeliveryId
+    [sql|
+      INSERT INTO msg_deliveries
+        (message_id, connection_id, agent_msg_id, chat_ts, created_at, updated_at, delivery_status)
+      VALUES (?,?,?,?,?,?,?)
+    |]
+    (messageId, connId, agentMsgId, currentTs, currentTs, currentTs, MDSSndAgent)
+  insertedRowId db
 
-createNewMessageAndRcvMsgDelivery :: forall e. MsgEncodingI e => DB.Connection -> ConnOrGroupId -> NewMessage e -> Maybe SharedMsgId -> RcvMsgDelivery -> Maybe GroupMemberId -> ExceptT StoreError IO RcvMessage
+createNewMessageAndRcvMsgDelivery :: forall e. MsgEncodingI e => DB.Connection -> ConnOrGroupId -> NewRcvMessage e -> Maybe SharedMsgId -> RcvMsgDelivery -> Maybe GroupMemberId -> ExceptT StoreError IO RcvMessage
 createNewMessageAndRcvMsgDelivery db connOrGroupId newMessage sharedMsgId_ RcvMsgDelivery {connId, agentMsgId, agentMsgMeta, agentAckCmdId} authorGroupMemberId_ = do
   msg@RcvMessage {msgId} <- createNewRcvMessage db connOrGroupId newMessage sharedMsgId_ authorGroupMemberId_ Nothing
   liftIO $ do
     currentTs <- getCurrentTime
     DB.execute
       db
-      "INSERT INTO msg_deliveries (message_id, connection_id, agent_msg_id, agent_msg_meta, agent_ack_cmd_id, chat_ts, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?)"
+      [sql|
-      (msgId, connId, agentMsgId, msgMetaJson agentMsgMeta, agentAckCmdId, snd $ broker agentMsgMeta, currentTs, currentTs)
+        INSERT INTO msg_deliveries
-    msgDeliveryId <- insertedRowId db
+          (message_id, connection_id, agent_msg_id, agent_msg_meta, agent_ack_cmd_id, chat_ts, created_at, updated_at, delivery_status)
-    createMsgDeliveryEvent_ db msgDeliveryId MDSRcvAgent currentTs
+        VALUES (?,?,?,?,?,?,?,?,?)
+      |]
+      (msgId, connId, agentMsgId, msgMetaJson agentMsgMeta, agentAckCmdId, snd $ broker agentMsgMeta, currentTs, currentTs, MDSRcvAgent)
   pure msg
 
-createNewRcvMessage :: forall e. MsgEncodingI e => DB.Connection -> ConnOrGroupId -> NewMessage e -> Maybe SharedMsgId -> Maybe GroupMemberId -> Maybe GroupMemberId -> ExceptT StoreError IO RcvMessage
+createNewRcvMessage :: forall e. MsgEncodingI e => DB.Connection -> ConnOrGroupId -> NewRcvMessage e -> Maybe SharedMsgId -> Maybe GroupMemberId -> Maybe GroupMemberId -> ExceptT StoreError IO RcvMessage
-createNewRcvMessage db connOrGroupId NewMessage {chatMsgEvent, msgBody} sharedMsgId_ authorMember forwardedByMember =
+createNewRcvMessage db connOrGroupId NewRcvMessage {chatMsgEvent, msgBody} sharedMsgId_ authorMember forwardedByMember =
   case connOrGroupId of
     ConnectionId connId -> liftIO $ insertRcvMsg (Just connId) Nothing
     GroupId groupId -> case sharedMsgId_ of
@@ -236,68 +247,29 @@ createNewRcvMessage db connOrGroupId NewMessage {chatMsgEvent, msgBody} sharedMs
       msgId <- insertedRowId db
       pure RcvMessage {msgId, chatMsgEvent = ACME (encoding @e) chatMsgEvent, sharedMsgId_, msgBody, authorMember, forwardedByMember}
 
-createSndMsgDeliveryEvent :: DB.Connection -> Int64 -> AgentMsgId -> MsgDeliveryStatus 'MDSnd -> ExceptT StoreError IO ()
+updateSndMsgDeliveryStatus :: DB.Connection -> Int64 -> AgentMsgId -> MsgDeliveryStatus 'MDSnd -> IO ()
-createSndMsgDeliveryEvent db connId agentMsgId sndMsgDeliveryStatus = do
+updateSndMsgDeliveryStatus db connId agentMsgId sndMsgDeliveryStatus = do
-  msgDeliveryId <- getMsgDeliveryId_ db connId agentMsgId
+  currentTs <- getCurrentTime
-  liftIO $ do
-    currentTs <- getCurrentTime
-    createMsgDeliveryEvent_ db msgDeliveryId sndMsgDeliveryStatus currentTs
-
-createRcvMsgDeliveryEvent :: DB.Connection -> Int64 -> CommandId -> MsgDeliveryStatus 'MDRcv -> IO ()
-createRcvMsgDeliveryEvent db connId cmdId rcvMsgDeliveryStatus = do
-  msgDeliveryId <- getMsgDeliveryIdByCmdId_ db connId cmdId
-  forM_ msgDeliveryId $ \mdId -> do
-    currentTs <- getCurrentTime
-    createMsgDeliveryEvent_ db mdId rcvMsgDeliveryStatus currentTs
-
-createSndMsgDelivery_ :: DB.Connection -> SndMsgDelivery -> MessageId -> UTCTime -> IO Int64
-createSndMsgDelivery_ db SndMsgDelivery {connId, agentMsgId} messageId createdAt = do
   DB.execute
     db
     [sql|
-      INSERT INTO msg_deliveries
+      UPDATE msg_deliveries
-        (message_id, connection_id, agent_msg_id, agent_msg_meta, chat_ts, created_at, updated_at)
+      SET delivery_status = ?, updated_at = ?
-      VALUES (?,?,?,NULL,?,?,?)
+      WHERE connection_id = ? AND agent_msg_id = ?
     |]
-    (messageId, connId, agentMsgId, createdAt, createdAt, createdAt)
+    (sndMsgDeliveryStatus, currentTs, connId, agentMsgId)
-  insertedRowId db
 
-createMsgDeliveryEvent_ :: DB.Connection -> Int64 -> MsgDeliveryStatus d -> UTCTime -> IO ()
+updateRcvMsgDeliveryStatus :: DB.Connection -> Int64 -> CommandId -> MsgDeliveryStatus 'MDRcv -> IO ()
-createMsgDeliveryEvent_ db msgDeliveryId msgDeliveryStatus createdAt = do
+updateRcvMsgDeliveryStatus db connId cmdId rcvMsgDeliveryStatus = do
+  currentTs <- getCurrentTime
   DB.execute
     db
     [sql|
-      INSERT INTO msg_delivery_events
+      UPDATE msg_deliveries
-        (msg_delivery_id, delivery_status, created_at, updated_at)
+      SET delivery_status = ?, updated_at = ?
-      VALUES (?,?,?,?)
+      WHERE connection_id = ? AND agent_ack_cmd_id = ?
     |]
-    (msgDeliveryId, msgDeliveryStatus, createdAt, createdAt)
+    (rcvMsgDeliveryStatus, currentTs, connId, cmdId)
-
-getMsgDeliveryId_ :: DB.Connection -> Int64 -> AgentMsgId -> ExceptT StoreError IO Int64
-getMsgDeliveryId_ db connId agentMsgId =
-  ExceptT . firstRow fromOnly (SENoMsgDelivery connId agentMsgId) $
-    DB.query
-      db
-      [sql|
-        SELECT msg_delivery_id
-        FROM msg_deliveries m
-        WHERE m.connection_id = ? AND m.agent_msg_id = ?
-        LIMIT 1
-      |]
-      (connId, agentMsgId)
-
-getMsgDeliveryIdByCmdId_ :: DB.Connection -> Int64 -> CommandId -> IO (Maybe AgentMsgId)
-getMsgDeliveryIdByCmdId_ db connId cmdId =
-  maybeFirstRow fromOnly $
-    DB.query
-      db
-      [sql|
-        SELECT msg_delivery_id
-        FROM msg_deliveries
-        WHERE connection_id = ? AND agent_ack_cmd_id = ?
-        LIMIT 1
-      |]
-      (connId, cmdId)
 
 createPendingGroupMessage :: DB.Connection -> Int64 -> MessageId -> Maybe Int64 -> IO ()
 createPendingGroupMessage db groupMemberId messageId introId_ = do
@@ -2107,3 +2079,25 @@ getGroupSndStatusCounts db itemId =
       GROUP BY group_snd_item_status
     |]
     (Only itemId)
+
+getGroupHistoryItems :: DB.Connection -> User -> GroupInfo -> Int -> IO [Either StoreError (CChatItem 'CTGroup)]
+getGroupHistoryItems db user@User {userId} GroupInfo {groupId} count = do
+  chatItemIds <- getLastItemIds_
+  -- use getGroupCIWithReactions to read reactions data
+  reverse <$> mapM (runExceptT . getGroupChatItem db user groupId) chatItemIds
+  where
+    getLastItemIds_ :: IO [ChatItemId]
+    getLastItemIds_ =
+      map fromOnly
+        <$> DB.query
+          db
+          [sql|
+            SELECT chat_item_id
+            FROM chat_items
+            WHERE user_id = ? AND group_id = ?
+              AND item_content_tag IN (?,?)
+              AND item_deleted = 0
+            ORDER BY item_ts DESC, chat_item_id DESC
+            LIMIT ?
+          |]
+          (userId, groupId, rcvMsgContentTag, sndMsgContentTag, count)

src/Simplex/Chat/Store/Migrations.hs

@@ -93,6 +93,7 @@ import Simplex.Chat.Migrations.M20231114_remote_control
 import Simplex.Chat.Migrations.M20231126_remote_ctrl_address
 import Simplex.Chat.Migrations.M20231207_chat_list_pagination
 import Simplex.Chat.Migrations.M20231214_item_content_tag
+import Simplex.Chat.Migrations.M20231215_recreate_msg_deliveries
 import Simplex.Messaging.Agent.Store.SQLite.Migrations (Migration (..))
 
 schemaMigrations :: [(String, Query, Maybe Query)]
@@ -185,7 +186,8 @@ schemaMigrations =
     ("20231114_remote_control", m20231114_remote_control, Just down_m20231114_remote_control),
     ("20231126_remote_ctrl_address", m20231126_remote_ctrl_address, Just down_m20231126_remote_ctrl_address),
     ("20231207_chat_list_pagination", m20231207_chat_list_pagination, Just down_m20231207_chat_list_pagination),
-    ("20231214_item_content_tag", m20231214_item_content_tag, Just down_m20231214_item_content_tag)
+    ("20231214_item_content_tag", m20231214_item_content_tag, Just down_m20231214_item_content_tag),
+    ("20231215_recreate_msg_deliveries", m20231215_recreate_msg_deliveries, Just down_m20231215_recreate_msg_deliveries)
   ]
 
 -- | The list of migrations in ascending order by date

src/Simplex/Chat/Store/Shared.hs

@@ -32,7 +32,7 @@ import Simplex.Chat.Protocol
 import Simplex.Chat.Remote.Types
 import Simplex.Chat.Types
 import Simplex.Chat.Types.Preferences
-import Simplex.Messaging.Agent.Protocol (AgentMsgId, ConnId, UserId)
+import Simplex.Messaging.Agent.Protocol (ConnId, UserId)
 import Simplex.Messaging.Agent.Store.SQLite (firstRow, maybeFirstRow)
 import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
 import qualified Simplex.Messaging.Crypto as C
@@ -86,8 +86,8 @@ data StoreError
   | SEPendingConnectionNotFound {connId :: Int64}
   | SEIntroNotFound
   | SEUniqueID
+  | SELargeMsg
   | SEInternalError {message :: String}
-  | SENoMsgDelivery {connId :: Int64, agentMsgId :: AgentMsgId}
   | SEBadChatItem {itemId :: ChatItemId}
   | SEChatItemNotFound {itemId :: ChatItemId}
   | SEChatItemNotFoundByText {text :: Text}
@@ -376,15 +376,21 @@ withLocalDisplayName db userId displayName action = getLdnSuffix >>= (`tryCreate
 createWithRandomId :: forall a. TVar ChaChaDRG -> (ByteString -> IO a) -> ExceptT StoreError IO a
 createWithRandomId = createWithRandomBytes 12
 
+createWithRandomId' :: forall a. TVar ChaChaDRG -> (ByteString -> IO (Either StoreError a)) -> ExceptT StoreError IO a
+createWithRandomId' = createWithRandomBytes' 12
+
 createWithRandomBytes :: forall a. Int -> TVar ChaChaDRG -> (ByteString -> IO a) -> ExceptT StoreError IO a
-createWithRandomBytes size gVar create = tryCreate 3
+createWithRandomBytes size gVar create = createWithRandomBytes' size gVar (fmap Right . create)
+
+createWithRandomBytes' :: forall a. Int -> TVar ChaChaDRG -> (ByteString -> IO (Either StoreError a)) -> ExceptT StoreError IO a
+createWithRandomBytes' size gVar create = tryCreate 3
   where
     tryCreate :: Int -> ExceptT StoreError IO a
     tryCreate 0 = throwError SEUniqueID
     tryCreate n = do
       id' <- liftIO $ encodedRandomBytes gVar size
       liftIO (E.try $ create id') >>= \case
-        Right x -> pure x
+        Right x -> liftEither x
         Left e
           | SQL.sqlError e == SQL.ErrorConstraint -> tryCreate (n - 1)
           | otherwise -> throwError . SEInternalError $ show e

src/Simplex/Chat/Types.hs

@@ -627,7 +627,8 @@ data GroupMember = GroupMember
     memberContactProfileId :: ProfileId,
     activeConn :: Maybe Connection,
     -- member chat protocol version range; if member has active connection, its version range is preferred;
-    -- for membership current supportedChatVRange is set, it's not updated on protocol version increase
+    -- for membership current supportedChatVRange is set, it's not updated on protocol version increase in database,
+    -- but it's correctly set on read (see toGroupInfo)
     memberChatVRange :: JVersionRange
   }
   deriving (Eq, Show)
@@ -1012,9 +1013,11 @@ data XFTPRcvFile = XFTPRcvFile
   }
   deriving (Eq, Show)
 
+type RcvFileDescrText = Text
+
 data RcvFileDescr = RcvFileDescr
   { fileDescrId :: Int64,
-    fileDescrText :: Text,
+    fileDescrText :: RcvFileDescrText,
     fileDescrPartNo :: Int,
     fileDescrComplete :: Bool
   }

src/Simplex/Chat/Types/Preferences.hs

@@ -149,6 +149,7 @@ data GroupFeature
   | GFReactions
   | GFVoice
   | GFFiles
+  | GFHistory
   deriving (Show)
 
 data SGroupFeature (f :: GroupFeature) where
@@ -158,6 +159,7 @@ data SGroupFeature (f :: GroupFeature) where
   SGFReactions :: SGroupFeature 'GFReactions
   SGFVoice :: SGroupFeature 'GFVoice
   SGFFiles :: SGroupFeature 'GFFiles
+  SGFHistory :: SGroupFeature 'GFHistory
 
 deriving instance Show (SGroupFeature f)
 
@@ -173,6 +175,7 @@ groupFeatureNameText = \case
   GFReactions -> "Message reactions"
   GFVoice -> "Voice messages"
   GFFiles -> "Files and media"
+  GFHistory -> "Recent history"
 
 groupFeatureNameText' :: SGroupFeature f -> Text
 groupFeatureNameText' = groupFeatureNameText . toGroupFeature
@@ -188,7 +191,8 @@ allGroupFeatures =
     AGF SGFFullDelete,
     AGF SGFReactions,
     AGF SGFVoice,
-    AGF SGFFiles
+    AGF SGFFiles,
+    AGF SGFHistory
   ]
 
 groupPrefSel :: SGroupFeature f -> GroupPreferences -> Maybe (GroupFeaturePreference f)
@@ -199,6 +203,7 @@ groupPrefSel f ps = case f of
   SGFReactions -> ps.reactions
   SGFVoice -> ps.voice
   SGFFiles -> ps.files
+  SGFHistory -> ps.history
 
 toGroupFeature :: SGroupFeature f -> GroupFeature
 toGroupFeature = \case
@@ -208,6 +213,7 @@ toGroupFeature = \case
   SGFReactions -> GFReactions
   SGFVoice -> GFVoice
   SGFFiles -> GFFiles
+  SGFHistory -> GFHistory
 
 class GroupPreferenceI p where
   getGroupPreference :: SGroupFeature f -> p -> GroupFeaturePreference f
@@ -226,6 +232,7 @@ instance GroupPreferenceI FullGroupPreferences where
     SGFReactions -> ps.reactions
     SGFVoice -> ps.voice
     SGFFiles -> ps.files
+    SGFHistory -> ps.history
   {-# INLINE getGroupPreference #-}
 
 -- collection of optional group preferences
@@ -235,7 +242,8 @@ data GroupPreferences = GroupPreferences
     fullDelete :: Maybe FullDeleteGroupPreference,
     reactions :: Maybe ReactionsGroupPreference,
     voice :: Maybe VoiceGroupPreference,
-    files :: Maybe FilesGroupPreference
+    files :: Maybe FilesGroupPreference,
+    history :: Maybe HistoryGroupPreference
   }
   deriving (Eq, Show)
 
@@ -260,6 +268,7 @@ setGroupPreference_ f pref prefs =
     SGFReactions -> prefs {reactions = pref}
     SGFVoice -> prefs {voice = pref}
     SGFFiles -> prefs {files = pref}
+    SGFHistory -> prefs {history = pref}
 
 setGroupTimedMessagesPreference :: TimedMessagesGroupPreference -> Maybe GroupPreferences -> GroupPreferences
 setGroupTimedMessagesPreference pref prefs_ =
@@ -286,7 +295,8 @@ data FullGroupPreferences = FullGroupPreferences
     fullDelete :: FullDeleteGroupPreference,
     reactions :: ReactionsGroupPreference,
     voice :: VoiceGroupPreference,
-    files :: FilesGroupPreference
+    files :: FilesGroupPreference,
+    history :: HistoryGroupPreference
   }
   deriving (Eq, Show)
 
@@ -341,11 +351,12 @@ defaultGroupPrefs =
       fullDelete = FullDeleteGroupPreference {enable = FEOff},
       reactions = ReactionsGroupPreference {enable = FEOn},
       voice = VoiceGroupPreference {enable = FEOn},
-      files = FilesGroupPreference {enable = FEOn}
+      files = FilesGroupPreference {enable = FEOn},
+      history = HistoryGroupPreference {enable = FEOff}
     }
 
 emptyGroupPrefs :: GroupPreferences
-emptyGroupPrefs = GroupPreferences Nothing Nothing Nothing Nothing Nothing Nothing
+emptyGroupPrefs = GroupPreferences Nothing Nothing Nothing Nothing Nothing Nothing Nothing
 
 data TimedMessagesPreference = TimedMessagesPreference
   { allow :: FeatureAllowed,
@@ -440,6 +451,10 @@ data FilesGroupPreference = FilesGroupPreference
   {enable :: GroupFeatureEnabled}
   deriving (Eq, Show)
 
+data HistoryGroupPreference = HistoryGroupPreference
+  {enable :: GroupFeatureEnabled}
+  deriving (Eq, Show)
+
 class (Eq (GroupFeaturePreference f), HasField "enable" (GroupFeaturePreference f) GroupFeatureEnabled) => GroupFeatureI f where
   type GroupFeaturePreference (f :: GroupFeature) = p | p -> f
   sGroupFeature :: SGroupFeature f
@@ -466,6 +481,9 @@ instance HasField "enable" VoiceGroupPreference GroupFeatureEnabled where
 instance HasField "enable" FilesGroupPreference GroupFeatureEnabled where
   hasField p = (\enable -> p {enable}, p.enable)
 
+instance HasField "enable" HistoryGroupPreference GroupFeatureEnabled where
+  hasField p = (\enable -> p {enable}, p.enable)
+
 instance GroupFeatureI 'GFTimedMessages where
   type GroupFeaturePreference 'GFTimedMessages = TimedMessagesGroupPreference
   sGroupFeature = SGFTimedMessages
@@ -496,6 +514,11 @@ instance GroupFeatureI 'GFFiles where
   sGroupFeature = SGFFiles
   groupPrefParam _ = Nothing
 
+instance GroupFeatureI 'GFHistory where
+  type GroupFeaturePreference 'GFHistory = HistoryGroupPreference
+  sGroupFeature = SGFHistory
+  groupPrefParam _ = Nothing
+
 groupPrefStateText :: HasField "enable" p GroupFeatureEnabled => GroupFeature -> p -> Maybe Int -> Text
 groupPrefStateText feature pref param =
   let enabled = getField @"enable" pref
@@ -618,7 +641,8 @@ mergeGroupPreferences groupPreferences =
       fullDelete = pref SGFFullDelete,
       reactions = pref SGFReactions,
       voice = pref SGFVoice,
-      files = pref SGFFiles
+      files = pref SGFFiles,
+      history = pref SGFHistory
     }
   where
     pref :: SGroupFeature f -> GroupFeaturePreference f
@@ -632,7 +656,8 @@ toGroupPreferences groupPreferences =
       fullDelete = pref SGFFullDelete,
       reactions = pref SGFReactions,
       voice = pref SGFVoice,
-      files = pref SGFFiles
+      files = pref SGFFiles,
+      history = pref SGFHistory
     }
   where
     pref :: SGroupFeature f -> Maybe (GroupFeaturePreference f)
@@ -738,6 +763,8 @@ $(J.deriveJSON defaultJSON ''VoiceGroupPreference)
 
 $(J.deriveJSON defaultJSON ''FilesGroupPreference)
 
+$(J.deriveJSON defaultJSON ''HistoryGroupPreference)
+
 $(J.deriveJSON defaultJSON ''GroupPreferences)
 
 instance ToField GroupPreferences where

src/Simplex/Chat/Util.hs

@@ -1,12 +1,18 @@
-module Simplex.Chat.Util (week, encryptFile, chunkSize) where
+{-# LANGUAGE TupleSections #-}
+
+module Simplex.Chat.Util (week, encryptFile, chunkSize, shuffle) where
 
 import Control.Monad
 import Control.Monad.Except
 import Control.Monad.IO.Class
 import qualified Data.ByteString.Lazy as LB
+import Data.List (sortBy)
+import Data.Ord (comparing)
 import Data.Time (NominalDiffTime)
+import Data.Word (Word16)
 import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs (..))
 import qualified Simplex.Messaging.Crypto.File as CF
+import System.Random (randomRIO)
 import UnliftIO.IO (IOMode (..), withFile)
 
 week :: NominalDiffTime
@@ -30,3 +36,9 @@ encryptFile fromPath toPath cfArgs = do
 chunkSize :: Num a => a
 chunkSize = 65536
 {-# INLINE chunkSize #-}
+
+shuffle :: [a] -> IO [a]
+shuffle xs = map snd . sortBy (comparing fst) <$> mapM (\x -> (,x) <$> random) xs
+  where
+    random :: IO Word16
+    random = randomRIO (0, 65535)

tests/ChatTests/Files.hs

@@ -16,14 +16,11 @@ import Simplex.Chat (roundedFDCount)
 import Simplex.Chat.Controller (ChatConfig (..), InlineFilesConfig (..), XFTPFileConfig (..), defaultInlineFilesConfig)
 import Simplex.Chat.Mobile.File
 import Simplex.Chat.Options (ChatOpts (..))
-import Simplex.FileTransfer.Client.Main (xftpClientCLI)
 import Simplex.FileTransfer.Server.Env (XFTPServerConfig (..))
 import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs (..))
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Util (unlessM)
 import System.Directory (copyFile, createDirectoryIfMissing, doesFileExist, getFileSize)
-import System.Environment (withArgs)
-import System.IO.Silently (capture_)
 import Test.Hspec
 
 chatFileTests :: SpecWith FilePath
@@ -1496,7 +1493,7 @@ testXFTPCancelRcvRepeat =
       dest <- B.readFile "./tests/tmp/testfile_1"
       dest `shouldBe` src
   where
-    cfg = testCfg {xftpFileConfig = Just $ XFTPFileConfig {minFileSize = 0}, tempDir = Just "./tests/tmp"}
+    cfg = testCfg {xftpDescrPartSize = 200, xftpFileConfig = Just $ XFTPFileConfig {minFileSize = 0}, tempDir = Just "./tests/tmp"}
 
 testAutoAcceptFile :: HasCallStack => FilePath -> IO ()
 testAutoAcceptFile =
@@ -1548,9 +1545,6 @@ testProhibitFiles =
   where
     cfg = testCfg {xftpFileConfig = Just $ XFTPFileConfig {minFileSize = 0}, tempDir = Just "./tests/tmp"}
 
-xftpCLI :: [String] -> IO [String]
-xftpCLI params = lines <$> capture_ (withArgs params xftpClientCLI)
-
 startFileTransfer :: HasCallStack => TestCC -> TestCC -> IO ()
 startFileTransfer alice bob =
   startFileTransfer' alice bob "test.jpg" "136.5 KiB / 139737 bytes"

tests/ChatTests/Groups.hs

@@ -115,6 +115,19 @@ chatGroupTests = do
     it "forward file (x.msg.file.descr)" testGroupMsgForwardFile
     it "forward role change (x.grp.mem.role)" testGroupMsgForwardChangeRole
     it "forward new member announcement (x.grp.mem.new)" testGroupMsgForwardNewMember
+  describe "group history" $ do
+    it "text messages" testGroupHistory
+    it "history is sent when joining via group link" testGroupHistoryGroupLink
+    it "history is not sent if preference is disabled" testGroupHistoryPreferenceOff
+    it "host's file" testGroupHistoryHostFile
+    it "member's file" testGroupHistoryMemberFile
+    it "large file with text" testGroupHistoryLargeFile
+    it "multiple files" testGroupHistoryMultipleFiles
+    it "cancelled files are not attached (text message is still sent)" testGroupHistoryFileCancel
+    it "cancelled files without text are excluded" testGroupHistoryFileCancelNoText
+    it "quoted messages" testGroupHistoryQuotes
+    it "deleted message is not included" testGroupHistoryDeletedMessage
+    it "disappearing message is sent as disappearing" testGroupHistoryDisappearingMessage
   where
     _0 = supportedChatVRange -- don't create direct connections
     _1 = groupCreateDirectVRange
@@ -1447,6 +1460,7 @@ testGroupDescription = testChat4 aliceProfile bobProfile cathProfile danProfile
       alice <## "Message reactions: on"
       alice <## "Voice messages: on"
       alice <## "Files and media: on"
+      alice <## "Recent history: on"
     bobAddedDan :: HasCallStack => TestCC -> IO ()
     bobAddedDan cc = do
       cc <## "#team: bob added dan (Daniel) to the group (connecting...)"
@@ -4116,3 +4130,735 @@ testGroupMsgForwardNewMember =
                "cath (Catherine): admin, connected",
                "dan (Daniel): member"
              ]
+
+testGroupHistory :: HasCallStack => FilePath -> IO ()
+testGroupHistory =
+  testChat3 aliceProfile bobProfile cathProfile $
+    \alice bob cath -> do
+      createGroup2 "team" alice bob
+
+      threadDelay 1000000
+
+      alice #> "#team hello"
+      bob <# "#team alice> hello"
+
+      threadDelay 1000000
+
+      bob #> "#team hey!"
+      alice <# "#team bob> hey!"
+
+      connectUsers alice cath
+      addMember "team" alice cath GRAdmin
+      cath ##> "/j team"
+      concurrentlyN_
+        [ alice <## "#team: cath joined the group",
+          cath
+            <### [ "#team: you joined the group",
+                   WithTime "#team alice> hello [>>]",
+                   WithTime "#team bob> hey! [>>]",
+                   "#team: member bob (Bob) is connected"
+                 ],
+          do
+            bob <## "#team: alice added cath (Catherine) to the group (connecting...)"
+            bob <## "#team: new member cath is connected"
+        ]
+
+      cath ##> "/_get chat #1 count=100"
+      r <- chat <$> getTermLine cath
+      r `shouldContain` [(0, "hello"), (0, "hey!")]
+
+      -- message delivery works after sending history
+      alice #> "#team 1"
+      [bob, cath] *<# "#team alice> 1"
+      bob #> "#team 2"
+      [alice, cath] *<# "#team bob> 2"
+      cath #> "#team 3"
+      [alice, bob] *<# "#team cath> 3"
+
+testGroupHistoryGroupLink :: HasCallStack => FilePath -> IO ()
+testGroupHistoryGroupLink =
+  testChat3 aliceProfile bobProfile cathProfile $
+    \alice bob cath -> do
+      createGroup2 "team" alice bob
+
+      threadDelay 1000000
+
+      alice #> "#team hello"
+      bob <# "#team alice> hello"
+
+      threadDelay 1000000
+
+      bob #> "#team hey!"
+      alice <# "#team bob> hey!"
+
+      alice ##> "/create link #team"
+      gLink <- getGroupLink alice "team" GRMember True
+
+      cath ##> ("/c " <> gLink)
+      cath <## "connection request sent!"
+      alice <## "cath (Catherine): accepting request to join group #team..."
+      concurrentlyN_
+        [ alice <## "#team: cath joined the group",
+          cath
+            <### [ "#team: joining the group...",
+                   "#team: you joined the group",
+                   WithTime "#team alice> hello [>>]",
+                   WithTime "#team bob> hey! [>>]",
+                   "#team: member bob (Bob) is connected"
+                 ],
+          do
+            bob <## "#team: alice added cath (Catherine) to the group (connecting...)"
+            bob <## "#team: new member cath is connected"
+        ]
+
+      cath ##> "/_get chat #1 count=100"
+      r <- chat <$> getTermLine cath
+      r `shouldContain` [(0, "hello"), (0, "hey!")]
+
+      -- message delivery works after sending history
+      alice #> "#team 1"
+      [bob, cath] *<# "#team alice> 1"
+      bob #> "#team 2"
+      [alice, cath] *<# "#team bob> 2"
+      cath #> "#team 3"
+      [alice, bob] *<# "#team cath> 3"
+
+testGroupHistoryPreferenceOff :: HasCallStack => FilePath -> IO ()
+testGroupHistoryPreferenceOff =
+  testChat4 aliceProfile bobProfile cathProfile danProfile $
+    \alice bob cath dan -> do
+      createGroup2 "team" alice bob
+
+      threadDelay 1000000
+
+      alice #> "#team hello"
+      bob <# "#team alice> hello"
+
+      threadDelay 1000000
+
+      bob #> "#team hey!"
+      alice <# "#team bob> hey!"
+
+      connectUsers alice cath
+      addMember "team" alice cath GRAdmin
+      cath ##> "/j team"
+      concurrentlyN_
+        [ alice <## "#team: cath joined the group",
+          cath
+            <### [ "#team: you joined the group",
+                   WithTime "#team alice> hello [>>]",
+                   WithTime "#team bob> hey! [>>]",
+                   "#team: member bob (Bob) is connected"
+                 ],
+          do
+            bob <## "#team: alice added cath (Catherine) to the group (connecting...)"
+            bob <## "#team: new member cath is connected"
+        ]
+
+      cath ##> "/_get chat #1 count=100"
+      r <- chat <$> getTermLine cath
+      r `shouldContain` [(0, "hello"), (0, "hey!")]
+
+      alice ##> "/set history #team off"
+      alice <## "updated group preferences:"
+      alice <## "Recent history: off"
+      concurrentlyN_
+        [ do
+            bob <## "alice updated group #team:"
+            bob <## "updated group preferences:"
+            bob <## "Recent history: off",
+          do
+            cath <## "alice updated group #team:"
+            cath <## "updated group preferences:"
+            cath <## "Recent history: off"
+        ]
+
+      connectUsers alice dan
+      addMember "team" alice dan GRAdmin
+      dan ##> "/j team"
+      concurrentlyN_
+        [ alice <## "#team: dan joined the group",
+          do
+            dan <## "#team: you joined the group"
+            dan
+              <### [ "#team: member bob (Bob) is connected",
+                     "#team: member cath (Catherine) is connected"
+                   ],
+          aliceAddedDan bob,
+          aliceAddedDan cath
+        ]
+
+      dan ##> "/_get chat #1 count=100"
+      r' <- chat <$> getTermLine dan
+      r' `shouldNotContain` [(0, "hello")]
+      r' `shouldNotContain` [(0, "hey!")]
+  where
+    aliceAddedDan :: HasCallStack => TestCC -> IO ()
+    aliceAddedDan cc = do
+      cc <## "#team: alice added dan (Daniel) to the group (connecting...)"
+      cc <## "#team: new member dan is connected"
+
+testGroupHistoryHostFile :: HasCallStack => FilePath -> IO ()
+testGroupHistoryHostFile =
+  testChatCfg3 cfg aliceProfile bobProfile cathProfile $
+    \alice bob cath -> withXFTPServer $ do
+      createGroup2 "team" alice bob
+
+      alice #> "/f #team ./tests/fixtures/test.jpg"
+      alice <## "use /fc 1 to cancel sending"
+      alice <## "completed uploading file 1 (test.jpg) for #team"
+
+      bob <# "#team alice> sends file test.jpg (136.5 KiB / 139737 bytes)"
+      bob <## "use /fr 1 [<dir>/ | <path>] to receive it"
+
+      connectUsers alice cath
+      addMember "team" alice cath GRAdmin
+      cath ##> "/j team"
+      concurrentlyN_
+        [ alice <## "#team: cath joined the group",
+          cath
+            <### [ "#team: you joined the group",
+                   WithTime "#team alice> sends file test.jpg (136.5 KiB / 139737 bytes) [>>]",
+                   "use /fr 1 [<dir>/ | <path>] to receive it [>>]",
+                   "#team: member bob (Bob) is connected"
+                 ],
+          do
+            bob <## "#team: alice added cath (Catherine) to the group (connecting...)"
+            bob <## "#team: new member cath is connected"
+        ]
+
+      cath ##> "/fr 1 ./tests/tmp"
+      cath
+        <### [ "saving file 1 from alice to ./tests/tmp/test.jpg",
+               "started receiving file 1 (test.jpg) from alice"
+             ]
+      cath <## "completed receiving file 1 (test.jpg) from alice"
+      src <- B.readFile "./tests/fixtures/test.jpg"
+      dest <- B.readFile "./tests/tmp/test.jpg"
+      dest `shouldBe` src
+  where
+    cfg = testCfg {xftpFileConfig = Just $ XFTPFileConfig {minFileSize = 0}, tempDir = Just "./tests/tmp"}
+
+testGroupHistoryMemberFile :: HasCallStack => FilePath -> IO ()
+testGroupHistoryMemberFile =
+  testChatCfg3 cfg aliceProfile bobProfile cathProfile $
+    \alice bob cath -> withXFTPServer $ do
+      createGroup2 "team" alice bob
+
+      bob #> "/f #team ./tests/fixtures/test.jpg"
+      bob <## "use /fc 1 to cancel sending"
+      bob <## "completed uploading file 1 (test.jpg) for #team"
+
+      alice <# "#team bob> sends file test.jpg (136.5 KiB / 139737 bytes)"
+      alice <## "use /fr 1 [<dir>/ | <path>] to receive it"
+
+      connectUsers alice cath
+      addMember "team" alice cath GRAdmin
+      cath ##> "/j team"
+      concurrentlyN_
+        [ alice <## "#team: cath joined the group",
+          cath
+            <### [ "#team: you joined the group",
+                   WithTime "#team bob> sends file test.jpg (136.5 KiB / 139737 bytes) [>>]",
+                   "use /fr 1 [<dir>/ | <path>] to receive it [>>]",
+                   "#team: member bob (Bob) is connected"
+                 ],
+          do
+            bob <## "#team: alice added cath (Catherine) to the group (connecting...)"
+            bob <## "#team: new member cath is connected"
+        ]
+
+      cath ##> "/fr 1 ./tests/tmp"
+      cath
+        <### [ "saving file 1 from bob to ./tests/tmp/test.jpg",
+               "started receiving file 1 (test.jpg) from bob"
+             ]
+      cath <## "completed receiving file 1 (test.jpg) from bob"
+      src <- B.readFile "./tests/fixtures/test.jpg"
+      dest <- B.readFile "./tests/tmp/test.jpg"
+      dest `shouldBe` src
+  where
+    cfg = testCfg {xftpFileConfig = Just $ XFTPFileConfig {minFileSize = 0}, tempDir = Just "./tests/tmp"}
+
+testGroupHistoryLargeFile :: HasCallStack => FilePath -> IO ()
+testGroupHistoryLargeFile =
+  testChatCfg3 cfg aliceProfile bobProfile cathProfile $
+    \alice bob cath -> withXFTPServer $ do
+      xftpCLI ["rand", "./tests/tmp/testfile", "17mb"] `shouldReturn` ["File created: " <> "./tests/tmp/testfile"]
+
+      createGroup2 "team" alice bob
+
+      bob ##> "/_send #1 json {\"filePath\": \"./tests/tmp/testfile\", \"msgContent\": {\"text\":\"hello\",\"type\":\"file\"}}"
+      bob <# "#team hello"
+      bob <# "/f #team ./tests/tmp/testfile"
+      bob <## "use /fc 1 to cancel sending"
+      bob <## "completed uploading file 1 (testfile) for #team"
+
+      alice <# "#team bob> hello"
+      alice <# "#team bob> sends file testfile (17.0 MiB / 17825792 bytes)"
+      alice <## "use /fr 1 [<dir>/ | <path>] to receive it"
+
+      -- admin receiving file does not prevent the new member from receiving it later
+      alice ##> "/fr 1 ./tests/tmp"
+      alice
+        <### [ "saving file 1 from bob to ./tests/tmp/testfile_1",
+               "started receiving file 1 (testfile) from bob"
+             ]
+      alice <## "completed receiving file 1 (testfile) from bob"
+      src <- B.readFile "./tests/tmp/testfile"
+      destAlice <- B.readFile "./tests/tmp/testfile_1"
+      destAlice `shouldBe` src
+
+      connectUsers alice cath
+      addMember "team" alice cath GRAdmin
+      cath ##> "/j team"
+      concurrentlyN_
+        [ alice <## "#team: cath joined the group",
+          cath
+            <### [ "#team: you joined the group",
+                   WithTime "#team bob> hello [>>]",
+                   WithTime "#team bob> sends file testfile (17.0 MiB / 17825792 bytes) [>>]",
+                   "use /fr 1 [<dir>/ | <path>] to receive it [>>]",
+                   "#team: member bob (Bob) is connected"
+                 ],
+          do
+            bob <## "#team: alice added cath (Catherine) to the group (connecting...)"
+            bob <## "#team: new member cath is connected"
+        ]
+
+      cath ##> "/fr 1 ./tests/tmp"
+      cath
+        <### [ "saving file 1 from bob to ./tests/tmp/testfile_2",
+               "started receiving file 1 (testfile) from bob"
+             ]
+      cath <## "completed receiving file 1 (testfile) from bob"
+
+      destCath <- B.readFile "./tests/tmp/testfile_2"
+      destCath `shouldBe` src
+  where
+    cfg = testCfg {xftpDescrPartSize = 200, xftpFileConfig = Just $ XFTPFileConfig {minFileSize = 0}, tempDir = Just "./tests/tmp"}
+
+testGroupHistoryMultipleFiles :: HasCallStack => FilePath -> IO ()
+testGroupHistoryMultipleFiles =
+  testChatCfg3 cfg aliceProfile bobProfile cathProfile $
+    \alice bob cath -> withXFTPServer $ do
+      xftpCLI ["rand", "./tests/tmp/testfile_bob", "2mb"] `shouldReturn` ["File created: " <> "./tests/tmp/testfile_bob"]
+      xftpCLI ["rand", "./tests/tmp/testfile_alice", "1mb"] `shouldReturn` ["File created: " <> "./tests/tmp/testfile_alice"]
+
+      createGroup2 "team" alice bob
+
+      threadDelay 1000000
+
+      bob ##> "/_send #1 json {\"filePath\": \"./tests/tmp/testfile_bob\", \"msgContent\": {\"text\":\"hi alice\",\"type\":\"file\"}}"
+      bob <# "#team hi alice"
+      bob <# "/f #team ./tests/tmp/testfile_bob"
+      bob <## "use /fc 1 to cancel sending"
+      bob <## "completed uploading file 1 (testfile_bob) for #team"
+
+      alice <# "#team bob> hi alice"
+      alice <# "#team bob> sends file testfile_bob (2.0 MiB / 2097152 bytes)"
+      alice <## "use /fr 1 [<dir>/ | <path>] to receive it"
+
+      threadDelay 1000000
+
+      alice ##> "/_send #1 json {\"filePath\": \"./tests/tmp/testfile_alice\", \"msgContent\": {\"text\":\"hey bob\",\"type\":\"file\"}}"
+      alice <# "#team hey bob"
+      alice <# "/f #team ./tests/tmp/testfile_alice"
+      alice <## "use /fc 2 to cancel sending"
+      alice <## "completed uploading file 2 (testfile_alice) for #team"
+
+      bob <# "#team alice> hey bob"
+      bob <# "#team alice> sends file testfile_alice (1.0 MiB / 1048576 bytes)"
+      bob <## "use /fr 2 [<dir>/ | <path>] to receive it"
+
+      connectUsers alice cath
+      addMember "team" alice cath GRAdmin
+      cath ##> "/j team"
+      concurrentlyN_
+        [ alice <## "#team: cath joined the group",
+          cath
+            <### [ "#team: you joined the group",
+                   WithTime "#team bob> hi alice [>>]",
+                   WithTime "#team bob> sends file testfile_bob (2.0 MiB / 2097152 bytes) [>>]",
+                   "use /fr 1 [<dir>/ | <path>] to receive it [>>]",
+                   WithTime "#team alice> hey bob [>>]",
+                   WithTime "#team alice> sends file testfile_alice (1.0 MiB / 1048576 bytes) [>>]",
+                   "use /fr 2 [<dir>/ | <path>] to receive it [>>]",
+                   "#team: member bob (Bob) is connected"
+                 ],
+          do
+            bob <## "#team: alice added cath (Catherine) to the group (connecting...)"
+            bob <## "#team: new member cath is connected"
+        ]
+
+      cath ##> "/fr 1 ./tests/tmp"
+      cath
+        <### [ "saving file 1 from bob to ./tests/tmp/testfile_bob_1",
+               "started receiving file 1 (testfile_bob) from bob"
+             ]
+      cath <## "completed receiving file 1 (testfile_bob) from bob"
+      srcBob <- B.readFile "./tests/tmp/testfile_bob"
+      destBob <- B.readFile "./tests/tmp/testfile_bob_1"
+      destBob `shouldBe` srcBob
+
+      cath ##> "/fr 2 ./tests/tmp"
+      cath
+        <### [ "saving file 2 from alice to ./tests/tmp/testfile_alice_1",
+               "started receiving file 2 (testfile_alice) from alice"
+             ]
+      cath <## "completed receiving file 2 (testfile_alice) from alice"
+      srcAlice <- B.readFile "./tests/tmp/testfile_alice"
+      destAlice <- B.readFile "./tests/tmp/testfile_alice_1"
+      destAlice `shouldBe` srcAlice
+
+      cath ##> "/_get chat #1 count=100"
+      r <- chatF <$> getTermLine cath
+      r
+        `shouldContain` [ ((0, "hi alice"), Just "./tests/tmp/testfile_bob_1"),
+                          ((0, "hey bob"), Just "./tests/tmp/testfile_alice_1")
+                        ]
+  where
+    cfg = testCfg {xftpFileConfig = Just $ XFTPFileConfig {minFileSize = 0}, tempDir = Just "./tests/tmp"}
+
+testGroupHistoryFileCancel :: HasCallStack => FilePath -> IO ()
+testGroupHistoryFileCancel =
+  testChatCfg3 cfg aliceProfile bobProfile cathProfile $
+    \alice bob cath -> withXFTPServer $ do
+      xftpCLI ["rand", "./tests/tmp/testfile_bob", "2mb"] `shouldReturn` ["File created: " <> "./tests/tmp/testfile_bob"]
+      xftpCLI ["rand", "./tests/tmp/testfile_alice", "1mb"] `shouldReturn` ["File created: " <> "./tests/tmp/testfile_alice"]
+
+      createGroup2 "team" alice bob
+
+      bob ##> "/_send #1 json {\"filePath\": \"./tests/tmp/testfile_bob\", \"msgContent\": {\"text\":\"hi alice\",\"type\":\"file\"}}"
+      bob <# "#team hi alice"
+      bob <# "/f #team ./tests/tmp/testfile_bob"
+      bob <## "use /fc 1 to cancel sending"
+      bob <## "completed uploading file 1 (testfile_bob) for #team"
+
+      alice <# "#team bob> hi alice"
+      alice <# "#team bob> sends file testfile_bob (2.0 MiB / 2097152 bytes)"
+      alice <## "use /fr 1 [<dir>/ | <path>] to receive it"
+
+      bob ##> "/fc 1"
+      bob <## "cancelled sending file 1 (testfile_bob) to alice"
+      alice <## "bob cancelled sending file 1 (testfile_bob)"
+
+      threadDelay 1000000
+
+      alice ##> "/_send #1 json {\"filePath\": \"./tests/tmp/testfile_alice\", \"msgContent\": {\"text\":\"hey bob\",\"type\":\"file\"}}"
+      alice <# "#team hey bob"
+      alice <# "/f #team ./tests/tmp/testfile_alice"
+      alice <## "use /fc 2 to cancel sending"
+      alice <## "completed uploading file 2 (testfile_alice) for #team"
+
+      bob <# "#team alice> hey bob"
+      bob <# "#team alice> sends file testfile_alice (1.0 MiB / 1048576 bytes)"
+      bob <## "use /fr 2 [<dir>/ | <path>] to receive it"
+
+      alice ##> "/fc 2"
+      alice <## "cancelled sending file 2 (testfile_alice) to bob"
+      bob <## "alice cancelled sending file 2 (testfile_alice)"
+
+      connectUsers alice cath
+      addMember "team" alice cath GRAdmin
+      cath ##> "/j team"
+      concurrentlyN_
+        [ alice <## "#team: cath joined the group",
+          cath
+            <### [ "#team: you joined the group",
+                   WithTime "#team bob> hi alice [>>]",
+                   WithTime "#team alice> hey bob [>>]",
+                   "#team: member bob (Bob) is connected"
+                 ],
+          do
+            bob <## "#team: alice added cath (Catherine) to the group (connecting...)"
+            bob <## "#team: new member cath is connected"
+        ]
+  where
+    cfg = testCfg {xftpFileConfig = Just $ XFTPFileConfig {minFileSize = 0}, tempDir = Just "./tests/tmp"}
+
+testGroupHistoryFileCancelNoText :: HasCallStack => FilePath -> IO ()
+testGroupHistoryFileCancelNoText =
+  testChatCfg3 cfg aliceProfile bobProfile cathProfile $
+    \alice bob cath -> withXFTPServer $ do
+      xftpCLI ["rand", "./tests/tmp/testfile_bob", "2mb"] `shouldReturn` ["File created: " <> "./tests/tmp/testfile_bob"]
+      xftpCLI ["rand", "./tests/tmp/testfile_alice", "1mb"] `shouldReturn` ["File created: " <> "./tests/tmp/testfile_alice"]
+
+      createGroup2 "team" alice bob
+
+      alice #> "#team hello"
+      bob <# "#team alice> hello"
+
+      -- bob file
+
+      bob #> "/f #team ./tests/tmp/testfile_bob"
+      bob <## "use /fc 1 to cancel sending"
+      bob <## "completed uploading file 1 (testfile_bob) for #team"
+
+      alice <# "#team bob> sends file testfile_bob (2.0 MiB / 2097152 bytes)"
+      alice <## "use /fr 1 [<dir>/ | <path>] to receive it"
+
+      bob ##> "/fc 1"
+      bob <## "cancelled sending file 1 (testfile_bob) to alice"
+      alice <## "bob cancelled sending file 1 (testfile_bob)"
+
+      -- alice file
+
+      alice #> "/f #team ./tests/tmp/testfile_alice"
+      alice <## "use /fc 2 to cancel sending"
+      alice <## "completed uploading file 2 (testfile_alice) for #team"
+
+      bob <# "#team alice> sends file testfile_alice (1.0 MiB / 1048576 bytes)"
+      bob <## "use /fr 2 [<dir>/ | <path>] to receive it"
+
+      alice ##> "/fc 2"
+      alice <## "cancelled sending file 2 (testfile_alice) to bob"
+      bob <## "alice cancelled sending file 2 (testfile_alice)"
+
+      -- other messages are sent
+
+      bob #> "#team hey!"
+      alice <# "#team bob> hey!"
+
+      connectUsers alice cath
+      addMember "team" alice cath GRAdmin
+      cath ##> "/j team"
+      concurrentlyN_
+        [ alice <## "#team: cath joined the group",
+          cath
+            <### [ "#team: you joined the group",
+                   WithTime "#team alice> hello [>>]",
+                   WithTime "#team bob> hey! [>>]",
+                   "#team: member bob (Bob) is connected"
+                 ],
+          do
+            bob <## "#team: alice added cath (Catherine) to the group (connecting...)"
+            bob <## "#team: new member cath is connected"
+        ]
+  where
+    cfg = testCfg {xftpFileConfig = Just $ XFTPFileConfig {minFileSize = 0}, tempDir = Just "./tests/tmp"}
+
+testGroupHistoryQuotes :: HasCallStack => FilePath -> IO ()
+testGroupHistoryQuotes =
+  testChat3 aliceProfile bobProfile cathProfile $
+    \alice bob cath -> do
+      createGroup2 "team" alice bob
+
+      threadDelay 1000000
+
+      alice #> "#team ALICE"
+      bob <# "#team alice> ALICE"
+
+      threadDelay 1000000
+
+      bob #> "#team BOB"
+      alice <# "#team bob> BOB"
+
+      threadDelay 1000000
+
+      alice `send` "> #team @alice (ALICE) 1"
+      alice <# "#team > alice ALICE"
+      alice <## "      1"
+      bob <# "#team alice> > alice ALICE"
+      bob <## "      1"
+
+      threadDelay 1000000
+
+      alice `send` "> #team @bob (BOB) 2"
+      alice <# "#team > bob BOB"
+      alice <## "      2"
+      bob <# "#team alice> > bob BOB"
+      bob <## "      2"
+
+      threadDelay 1000000
+
+      bob `send` "> #team @alice (ALICE) 3"
+      bob <# "#team > alice ALICE"
+      bob <## "      3"
+      alice <# "#team bob> > alice ALICE"
+      alice <## "      3"
+
+      threadDelay 1000000
+
+      bob `send` "> #team @bob (BOB) 4"
+      bob <# "#team > bob BOB"
+      bob <## "      4"
+      alice <# "#team bob> > bob BOB"
+      alice <## "      4"
+
+      alice
+        #$> ( "/_get chat #1 count=6",
+              chat',
+              [ ((1, "ALICE"), Nothing),
+                ((0, "BOB"), Nothing),
+                ((1, "1"), Just (1, "ALICE")),
+                ((1, "2"), Just (0, "BOB")),
+                ((0, "3"), Just (1, "ALICE")),
+                ((0, "4"), Just (0, "BOB"))
+              ]
+            )
+      bob
+        #$> ( "/_get chat #1 count=6",
+              chat',
+              [ ((0, "ALICE"), Nothing),
+                ((1, "BOB"), Nothing),
+                ((0, "1"), Just (0, "ALICE")),
+                ((0, "2"), Just (1, "BOB")),
+                ((1, "3"), Just (0, "ALICE")),
+                ((1, "4"), Just (1, "BOB"))
+              ]
+            )
+
+      connectUsers alice cath
+      addMember "team" alice cath GRAdmin
+      cath ##> "/j team"
+      concurrentlyN_
+        [ alice <## "#team: cath joined the group",
+          cath
+            <### [ "#team: you joined the group",
+                   WithTime "#team alice> ALICE [>>]",
+                   WithTime "#team bob> BOB [>>]",
+                   WithTime "#team alice> > alice ALICE [>>]",
+                   "      1 [>>]",
+                   WithTime "#team alice> > bob BOB [>>]",
+                   "      2 [>>]",
+                   WithTime "#team bob> > alice ALICE [>>]",
+                   "      3 [>>]",
+                   WithTime "#team bob> > bob BOB [>>]",
+                   "      4 [>>]",
+                   "#team: member bob (Bob) is connected"
+                 ],
+          do
+            bob <## "#team: alice added cath (Catherine) to the group (connecting...)"
+            bob <## "#team: new member cath is connected"
+        ]
+
+      cath ##> "/_get chat #1 count=100"
+      r <- chat' <$> getTermLine cath
+      r
+        `shouldContain` [ ((0, "ALICE"), Nothing),
+                          ((0, "BOB"), Nothing),
+                          ((0, "1"), Just (0, "ALICE")),
+                          ((0, "2"), Just (0, "BOB")),
+                          ((0, "3"), Just (0, "ALICE")),
+                          ((0, "4"), Just (0, "BOB"))
+                        ]
+
+testGroupHistoryDeletedMessage :: HasCallStack => FilePath -> IO ()
+testGroupHistoryDeletedMessage =
+  testChat3 aliceProfile bobProfile cathProfile $
+    \alice bob cath -> do
+      createGroup2 "team" alice bob
+
+      alice #> "#team hello"
+      bob <# "#team alice> hello"
+
+      threadDelay 1000000
+
+      bob #> "#team hey!"
+      alice <# "#team bob> hey!"
+
+      bobMsgId <- lastItemId bob
+      bob #$> ("/_delete item #1 " <> bobMsgId <> " broadcast", id, "message marked deleted")
+      alice <# "#team bob> [marked deleted] hey!"
+
+      connectUsers alice cath
+      addMember "team" alice cath GRAdmin
+      cath ##> "/j team"
+      concurrentlyN_
+        [ alice <## "#team: cath joined the group",
+          cath
+            <### [ "#team: you joined the group",
+                   WithTime "#team alice> hello [>>]",
+                   "#team: member bob (Bob) is connected"
+                 ],
+          do
+            bob <## "#team: alice added cath (Catherine) to the group (connecting...)"
+            bob <## "#team: new member cath is connected"
+        ]
+
+      cath ##> "/_get chat #1 count=100"
+      r <- chat <$> getTermLine cath
+      r `shouldContain` [(0, "hello")]
+      r `shouldNotContain` [(0, "hey!")]
+
+testGroupHistoryDisappearingMessage :: HasCallStack => FilePath -> IO ()
+testGroupHistoryDisappearingMessage =
+  testChat3 aliceProfile bobProfile cathProfile $
+    \alice bob cath -> do
+      createGroup2 "team" alice bob
+
+      threadDelay 1000000
+
+      alice #> "#team 1"
+      bob <# "#team alice> 1"
+
+      threadDelay 1000000
+
+      -- 3 seconds so that messages 2 and 3 are not deleted for alice before sending history to cath
+      alice ##> "/set disappear #team on 3"
+      alice <## "updated group preferences:"
+      alice <## "Disappearing messages: on (3 sec)"
+      bob <## "alice updated group #team:"
+      bob <## "updated group preferences:"
+      bob <## "Disappearing messages: on (3 sec)"
+
+      bob #> "#team 2"
+      alice <# "#team bob> 2"
+
+      threadDelay 1000000
+
+      alice #> "#team 3"
+      bob <# "#team alice> 3"
+
+      threadDelay 1000000
+
+      alice ##> "/set disappear #team off"
+      alice <## "updated group preferences:"
+      alice <## "Disappearing messages: off"
+      bob <## "alice updated group #team:"
+      bob <## "updated group preferences:"
+      bob <## "Disappearing messages: off"
+
+      bob #> "#team 4"
+      alice <# "#team bob> 4"
+
+      connectUsers alice cath
+      addMember "team" alice cath GRAdmin
+      cath ##> "/j team"
+      concurrentlyN_
+        [ alice <## "#team: cath joined the group",
+          cath
+            <### [ "#team: you joined the group",
+                   WithTime "#team alice> 1 [>>]",
+                   WithTime "#team bob> 2 [>>]",
+                   WithTime "#team alice> 3 [>>]",
+                   WithTime "#team bob> 4 [>>]",
+                   "#team: member bob (Bob) is connected"
+                 ],
+          do
+            bob <## "#team: alice added cath (Catherine) to the group (connecting...)"
+            bob <## "#team: new member cath is connected"
+        ]
+
+      cath ##> "/_get chat #1 count=100"
+      r1 <- chat <$> getTermLine cath
+      r1 `shouldContain` [(0, "1"), (0, "2"), (0, "3"), (0, "4")]
+
+      concurrentlyN_
+        [ do
+            alice <## "timed message deleted: 2"
+            alice <## "timed message deleted: 3",
+          do
+            bob <## "timed message deleted: 2"
+            bob <## "timed message deleted: 3",
+          do
+            cath <## "timed message deleted: 2"
+            cath <## "timed message deleted: 3"
+        ]
+
+      cath ##> "/_get chat #1 count=100"
+      r2 <- chat <$> getTermLine cath
+      r2 `shouldContain` [(0, "1"), (0, "4")]
+      r2 `shouldNotContain` [(0, "2")]
+      r2 `shouldNotContain` [(0, "3")]

tests/ChatTests/Profiles.hs

@@ -1601,7 +1601,7 @@ testUpdateGroupPrefs =
       alice #$> ("/_get chat #1 count=100", chat, [(0, "connected")])
       threadDelay 500000
       bob #$> ("/_get chat #1 count=100", chat, groupFeatures <> [(0, "connected")])
-      alice ##> "/_group_profile #1 {\"displayName\": \"team\", \"fullName\": \"\", \"groupPreferences\": {\"fullDelete\": {\"enable\": \"on\"}, \"directMessages\": {\"enable\": \"on\"}}}"
+      alice ##> "/_group_profile #1 {\"displayName\": \"team\", \"fullName\": \"\", \"groupPreferences\": {\"fullDelete\": {\"enable\": \"on\"}, \"directMessages\": {\"enable\": \"on\"}, \"history\": {\"enable\": \"on\"}}}"
       alice <## "updated group preferences:"
       alice <## "Full deletion: on"
       alice #$> ("/_get chat #1 count=100", chat, [(0, "connected"), (1, "Full deletion: on")])
@@ -1610,7 +1610,7 @@ testUpdateGroupPrefs =
       bob <## "Full deletion: on"
       threadDelay 500000
       bob #$> ("/_get chat #1 count=100", chat, groupFeatures <> [(0, "connected"), (0, "Full deletion: on")])
-      alice ##> "/_group_profile #1 {\"displayName\": \"team\", \"fullName\": \"\", \"groupPreferences\": {\"fullDelete\": {\"enable\": \"off\"}, \"voice\": {\"enable\": \"off\"}, \"directMessages\": {\"enable\": \"on\"}}}"
+      alice ##> "/_group_profile #1 {\"displayName\": \"team\", \"fullName\": \"\", \"groupPreferences\": {\"fullDelete\": {\"enable\": \"off\"}, \"voice\": {\"enable\": \"off\"}, \"directMessages\": {\"enable\": \"on\"}, \"history\": {\"enable\": \"on\"}}}"
       alice <## "updated group preferences:"
       alice <## "Full deletion: off"
       alice <## "Voice messages: off"
@@ -1621,7 +1621,6 @@ testUpdateGroupPrefs =
       bob <## "Voice messages: off"
       threadDelay 500000
       bob #$> ("/_get chat #1 count=100", chat, groupFeatures <> [(0, "connected"), (0, "Full deletion: on"), (0, "Full deletion: off"), (0, "Voice messages: off")])
-      -- alice ##> "/_group_profile #1 {\"displayName\": \"team\", \"fullName\": \"\", \"groupPreferences\": {\"fullDelete\": {\"enable\": \"off\"}, \"voice\": {\"enable\": \"on\"}}}"
       alice ##> "/set voice #team on"
       alice <## "updated group preferences:"
       alice <## "Voice messages: on"
@@ -1632,7 +1631,7 @@ testUpdateGroupPrefs =
       threadDelay 500000
       bob #$> ("/_get chat #1 count=100", chat, groupFeatures <> [(0, "connected"), (0, "Full deletion: on"), (0, "Full deletion: off"), (0, "Voice messages: off"), (0, "Voice messages: on")])
       threadDelay 500000
-      alice ##> "/_group_profile #1 {\"displayName\": \"team\", \"fullName\": \"\", \"groupPreferences\": {\"fullDelete\": {\"enable\": \"off\"}, \"voice\": {\"enable\": \"on\"}, \"directMessages\": {\"enable\": \"on\"}}}"
+      alice ##> "/_group_profile #1 {\"displayName\": \"team\", \"fullName\": \"\", \"groupPreferences\": {\"fullDelete\": {\"enable\": \"off\"}, \"voice\": {\"enable\": \"on\"}, \"directMessages\": {\"enable\": \"on\"}, \"history\": {\"enable\": \"on\"}}}"
       -- no update
       threadDelay 500000
       alice #$> ("/_get chat #1 count=100", chat, [(0, "connected"), (1, "Full deletion: on"), (1, "Full deletion: off"), (1, "Voice messages: off"), (1, "Voice messages: on")])
@@ -1798,7 +1797,7 @@ testEnableTimedMessagesGroup =
     \alice bob -> do
       createGroup2 "team" alice bob
       threadDelay 1000000
-      alice ##> "/_group_profile #1 {\"displayName\": \"team\", \"fullName\": \"\", \"groupPreferences\": {\"timedMessages\": {\"enable\": \"on\", \"ttl\": 1}, \"directMessages\": {\"enable\": \"on\"}}}"
+      alice ##> "/_group_profile #1 {\"displayName\": \"team\", \"fullName\": \"\", \"groupPreferences\": {\"timedMessages\": {\"enable\": \"on\", \"ttl\": 1}, \"directMessages\": {\"enable\": \"on\"}, \"history\": {\"enable\": \"on\"}}}"
       alice <## "updated group preferences:"
       alice <## "Disappearing messages: on (1 sec)"
       bob <## "alice updated group #team:"

tests/ChatTests/Utils.hs

@@ -23,13 +23,15 @@ import Simplex.Chat.Protocol
 import Simplex.Chat.Store.Profiles (getUserContactProfiles)
 import Simplex.Chat.Types
 import Simplex.Chat.Types.Preferences
+import Simplex.FileTransfer.Client.Main (xftpClientCLI)
 import Simplex.Messaging.Agent.Store.SQLite (maybeFirstRow, withTransaction)
 import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Version
 import System.Directory (doesFileExist)
-import System.Environment (lookupEnv)
+import System.Environment (lookupEnv, withArgs)
 import System.FilePath ((</>))
+import System.IO.Silently (capture_)
 import System.Info (os)
 import Test.Hspec
 
@@ -219,7 +221,8 @@ groupFeatures'' =
     ((0, "Full deletion: off"), Nothing, Nothing),
     ((0, "Message reactions: on"), Nothing, Nothing),
     ((0, "Voice messages: on"), Nothing, Nothing),
-    ((0, "Files and media: on"), Nothing, Nothing)
+    ((0, "Files and media: on"), Nothing, Nothing),
+    ((0, "Recent history: on"), Nothing, Nothing)
   ]
 
 itemId :: Int -> String
@@ -597,3 +600,6 @@ linkAnotherSchema link
   | "simplex:/" `isPrefixOf` link =
       T.unpack $ T.replace "simplex:/" "https://simplex.chat/" $ T.pack link
   | otherwise = error "link starts with neither https://simplex.chat/ nor simplex:/"
+
+xftpCLI :: [String] -> IO [String]
+xftpCLI params = lines <$> capture_ (withArgs params xftpClientCLI)

tests/MessageBatching.hs

@@ -0,0 +1,120 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+
+module MessageBatching (batchingTests) where
+
+import Crypto.Number.Serialize (os2ip)
+import Data.ByteString.Builder (toLazyByteString)
+import qualified Data.ByteString.Lazy as LB
+import Data.Either (partitionEithers)
+import Data.Int (Int64)
+import Data.String (IsString (..))
+import qualified Data.Text as T
+import Data.Text.Encoding (encodeUtf8)
+import Simplex.Chat.Messages.Batch
+import Simplex.Chat.Controller (ChatError (..), ChatErrorType (..))
+import Simplex.Chat.Messages (SndMessage (..))
+import Simplex.Chat.Protocol (SharedMsgId (..), maxChatMsgSize)
+import Test.Hspec
+
+batchingTests :: Spec
+batchingTests = describe "message batching tests" $ do
+  testBatchingCorrectness
+  it "image x.msg.new and x.msg.file.descr should fit into single batch" testImageFitsSingleBatch
+
+instance IsString SndMessage where
+  fromString s = SndMessage {msgId, sharedMsgId = SharedMsgId "", msgBody = LB.fromStrict s'}
+    where
+      s' = encodeUtf8 $ T.pack s
+      msgId = fromInteger $ os2ip s'
+
+deriving instance Eq SndMessage
+
+instance IsString ChatError where
+  fromString s = ChatError $ CEInternalError ("large message " <> show msgId)
+    where
+      s' = encodeUtf8 $ T.pack s
+      msgId = fromInteger (os2ip s') :: Int64
+
+testBatchingCorrectness :: Spec
+testBatchingCorrectness = describe "correctness tests" $ do
+  runBatcherTest 8 ["a"] [] ["a"]
+  runBatcherTest 8 ["a", "b"] [] ["[a,b]"]
+  runBatcherTest 8 ["a", "b", "c"] [] ["[a,b,c]"]
+  runBatcherTest 8 ["a", "bb", "c"] [] ["[a,bb,c]"]
+  runBatcherTest 8 ["a", "b", "c", "d"] [] ["a", "[b,c,d]"]
+  runBatcherTest 8 ["a", "bb", "c", "d"] [] ["a", "[bb,c,d]"]
+  runBatcherTest 8 ["a", "bb", "c", "de"] [] ["[a,bb]", "[c,de]"]
+  runBatcherTest 8 ["a", "b", "c", "d", "e"] [] ["[a,b]", "[c,d,e]"]
+  runBatcherTest 8 ["a", "b", "c", "d", "e", "f", "g", "h", "i", "j"] [] ["a", "[b,c,d]", "[e,f,g]", "[h,i,j]"]
+  runBatcherTest 8 ["aaaaa"] [] ["aaaaa"]
+  runBatcherTest 8 ["8aaaaaaa"] [] ["8aaaaaaa"]
+  runBatcherTest 8 ["aaaa", "bbbb"] [] ["aaaa", "bbbb"]
+  runBatcherTest 8 ["aa", "bbb", "cc", "dd"] [] ["[aa,bbb]", "[cc,dd]"]
+  runBatcherTest 8 ["aa", "bbb", "cc", "dd", "eee", "fff", "gg", "hh"] [] ["aa", "[bbb,cc]", "[dd,eee]", "fff", "[gg,hh]"]
+  runBatcherTest 8 ["9aaaaaaaa"] ["9aaaaaaaa"] []
+  runBatcherTest 8 ["aaaaa", "bbb", "cc"] [] ["aaaaa", "[bbb,cc]"]
+  runBatcherTest 8 ["8aaaaaaa", "bbb", "cc"] [] ["8aaaaaaa", "[bbb,cc]"]
+  runBatcherTest 8 ["9aaaaaaaa", "bbb", "cc"] ["9aaaaaaaa"] ["[bbb,cc]"]
+  runBatcherTest 8 ["9aaaaaaaa", "bbb", "cc", "dd"] ["9aaaaaaaa"] ["bbb", "[cc,dd]"]
+  runBatcherTest 8 ["9aaaaaaaa", "bbb", "cc", "dd", "e"] ["9aaaaaaaa"] ["[bbb,cc]", "[dd,e]"]
+  runBatcherTest 8 ["bbb", "cc", "aaaaa"] [] ["[bbb,cc]", "aaaaa"]
+  runBatcherTest 8 ["bbb", "cc", "8aaaaaaa"] [] ["[bbb,cc]", "8aaaaaaa"]
+  runBatcherTest 8 ["bbb", "cc", "9aaaaaaaa"] ["9aaaaaaaa"] ["[bbb,cc]"]
+  runBatcherTest 8 ["bbb", "cc", "dd", "9aaaaaaaa"] ["9aaaaaaaa"] ["bbb", "[cc,dd]"]
+  runBatcherTest 8 ["bbb", "cc", "dd", "e", "9aaaaaaaa"] ["9aaaaaaaa"] ["[bbb,cc]", "[dd,e]"]
+  runBatcherTest 8 ["bbb", "cc", "aaaaa", "dd"] [] ["[bbb,cc]", "aaaaa", "dd"]
+  runBatcherTest 8 ["bbb", "cc", "aaaaa", "dd", "e"] [] ["[bbb,cc]", "aaaaa", "[dd,e]"]
+  runBatcherTest 8 ["bbb", "cc", "8aaaaaaa", "dd"] [] ["[bbb,cc]", "8aaaaaaa", "dd"]
+  runBatcherTest 8 ["bbb", "cc", "8aaaaaaa", "dd", "e"] [] ["[bbb,cc]", "8aaaaaaa", "[dd,e]"]
+  runBatcherTest 8 ["bbb", "cc", "9aaaaaaaa"] ["9aaaaaaaa"] ["[bbb,cc]"]
+  runBatcherTest 8 ["bbb", "cc", "9aaaaaaaa", "dd"] ["9aaaaaaaa"] ["[bbb,cc]", "dd"]
+  runBatcherTest 8 ["bbb", "cc", "9aaaaaaaa", "dd", "e"] ["9aaaaaaaa"] ["[bbb,cc]", "[dd,e]"]
+  runBatcherTest 8 ["9aaaaaaaa", "10aaaaaaaa"] ["9aaaaaaaa", "10aaaaaaaa"] []
+  runBatcherTest 8 ["8aaaaaaa", "9aaaaaaaa", "10aaaaaaaa"] ["9aaaaaaaa", "10aaaaaaaa"] ["8aaaaaaa"]
+  runBatcherTest 8 ["9aaaaaaaa", "8aaaaaaa", "10aaaaaaaa"] ["9aaaaaaaa", "10aaaaaaaa"] ["8aaaaaaa"]
+  runBatcherTest 8 ["9aaaaaaaa", "10aaaaaaaa", "8aaaaaaa"] ["9aaaaaaaa", "10aaaaaaaa"] ["8aaaaaaa"]
+  runBatcherTest 8 ["bb", "cc", "dd", "9aaaaaaaa", "10aaaaaaaa"] ["9aaaaaaaa", "10aaaaaaaa"] ["bb", "[cc,dd]"]
+  runBatcherTest 8 ["bb", "cc", "9aaaaaaaa", "dd", "10aaaaaaaa"] ["9aaaaaaaa", "10aaaaaaaa"] ["[bb,cc]", "dd"]
+  runBatcherTest 8 ["bb", "9aaaaaaaa", "cc", "dd", "10aaaaaaaa"] ["9aaaaaaaa", "10aaaaaaaa"] ["bb", "[cc,dd]"]
+  runBatcherTest 8 ["bb", "9aaaaaaaa", "cc", "10aaaaaaaa", "dd"] ["9aaaaaaaa", "10aaaaaaaa"] ["bb", "cc", "dd"]
+  runBatcherTest 8 ["9aaaaaaaa", "bb", "cc", "dd", "10aaaaaaaa"] ["9aaaaaaaa", "10aaaaaaaa"] ["bb", "[cc,dd]"]
+  runBatcherTest 8 ["9aaaaaaaa", "bb", "10aaaaaaaa", "cc", "dd"] ["9aaaaaaaa", "10aaaaaaaa"] ["bb", "[cc,dd]"]
+  runBatcherTest 8 ["9aaaaaaaa", "10aaaaaaaa", "bb", "cc", "dd"] ["9aaaaaaaa", "10aaaaaaaa"] ["bb", "[cc,dd]"]
+
+testImageFitsSingleBatch :: IO ()
+testImageFitsSingleBatch = do
+  -- 14000 (limit for encoded image used in UI)
+  -- + 300 (remaining x.msg.new metadata, rounded up, actual example was 266)
+  let xMsgNewRoundedSize = 14300
+  -- size of x.msg.file.descr body for a file of size
+  -- 261_120 bytes (MAX_IMAGE_SIZE in UI), rounded up, example was 743
+  let descrRoundedSize = 800
+
+  let xMsgNewStr = LB.replicate xMsgNewRoundedSize 1
+      descrStr = LB.replicate descrRoundedSize 2
+      msg s = SndMessage {msgId = 0, sharedMsgId = SharedMsgId "", msgBody = s}
+      batched = "[" <> xMsgNewStr <> "," <> descrStr <> "]"
+
+  runBatcherTest' maxChatMsgSize [msg xMsgNewStr, msg descrStr] [] [batched]
+
+runBatcherTest :: Int64 -> [SndMessage] -> [ChatError] -> [LB.ByteString] -> Spec
+runBatcherTest maxLen msgs expectedErrors expectedBatches =
+  it
+    ( (show (map (\SndMessage {msgBody} -> msgBody) msgs) <> ", limit " <> show maxLen <> ": should return ")
+        <> (show (length expectedErrors) <> " large, ")
+        <> (show (length expectedBatches) <> " batches")
+    )
+    (runBatcherTest' maxLen msgs expectedErrors expectedBatches)
+
+runBatcherTest' :: Int64 -> [SndMessage] -> [ChatError] -> [LB.ByteString] -> IO ()
+runBatcherTest' maxLen msgs expectedErrors expectedBatches = do
+  let (errors, batches) = partitionEithers $ batchMessages maxLen msgs
+      batchedStrs = map (\(MsgBatch builder _) -> toLazyByteString builder) batches
+  testErrors errors `shouldBe` testErrors expectedErrors
+  batchedStrs `shouldBe` expectedBatches
+  where
+    testErrors = map (\case ChatError (CEInternalError s) -> Just s; _ -> Nothing)

tests/ProtocolTests.hs

@@ -7,6 +7,7 @@ module ProtocolTests where
 
 import qualified Data.Aeson as J
 import Data.ByteString.Char8 (ByteString)
+import qualified Data.ByteString.Lazy.Char8 as LB
 import Data.Time.Clock.System (SystemTime (..), systemToUTCTime)
 import Simplex.Chat.Protocol
 import Simplex.Chat.Types
@@ -14,8 +15,6 @@ import Simplex.Chat.Types.Preferences
 import Simplex.Messaging.Agent.Protocol
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Crypto.Ratchet
-import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Parsers (parseAll)
 import Simplex.Messaging.Protocol (supportedSMPClientVRange)
 import Simplex.Messaging.Version
 import Test.Hspec
@@ -62,13 +61,22 @@ quotedMsg =
 
 (==##) :: MsgEncodingI e => ByteString -> ChatMessage e -> Expectation
 s ==## msg = do
-  strDecode s `shouldBe` Right msg
+  case parseChatMessages s of
-  parseAll strP s `shouldBe` Right msg
+    [acMsg] -> case acMsg of
+      Right (ACMsg _ msg') -> case checkEncoding msg' of
+        Right msg'' -> msg'' `shouldBe` msg
+        Left e -> expectationFailure $ "checkEncoding error: " <> show e
+      Left e -> expectationFailure $ "parse error: " <> show e
+    _ -> expectationFailure "exactly one message expected"
 
 (##==) :: MsgEncodingI e => ByteString -> ChatMessage e -> Expectation
-s ##== msg =
+s ##== msg = do
-  J.eitherDecodeStrict' (strEncode msg)
+  let r = encodeChatMessage msg
-    `shouldBe` (J.eitherDecodeStrict' s :: Either String J.Value)
+  case r of
+    ECMEncoded encodedBody ->
+      J.eitherDecodeStrict' (LB.toStrict encodedBody)
+        `shouldBe` (J.eitherDecodeStrict' s :: Either String J.Value)
+    ECMLarge -> expectationFailure $ "large message"
 
 (##==##) :: MsgEncodingI e => ByteString -> ChatMessage e -> Expectation
 s ##==## msg = do
@@ -90,7 +98,7 @@ testChatPreferences :: Maybe Preferences
 testChatPreferences = Just Preferences {voice = Just VoicePreference {allow = FAYes}, fullDelete = Nothing, timedMessages = Nothing, calls = Nothing, reactions = Just ReactionsPreference {allow = FAYes}}
 
 testGroupPreferences :: Maybe GroupPreferences
-testGroupPreferences = Just GroupPreferences {timedMessages = Nothing, directMessages = Nothing, reactions = Just ReactionsGroupPreference {enable = FEOn}, voice = Just VoiceGroupPreference {enable = FEOn}, files = Nothing, fullDelete = Nothing}
+testGroupPreferences = Just GroupPreferences {timedMessages = Nothing, directMessages = Nothing, reactions = Just ReactionsGroupPreference {enable = FEOn}, voice = Just VoiceGroupPreference {enable = FEOn}, files = Nothing, fullDelete = Nothing, history = Nothing}
 
 testProfile :: Profile
 testProfile = Profile {displayName = "alice", fullName = "Alice", image = Just (ImageData "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII="), contactLink = Nothing, preferences = testChatPreferences}
@@ -122,7 +130,7 @@ decodeChatMessageTest = describe "Chat message encoding/decoding" $ do
     "{\"v\":\"1\",\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"}}}"
       ##==## ChatMessage chatInitialVRange (Just $ SharedMsgId "\1\2\3\4") (XMsgNew (MCSimple (extMsgContent (MCText "hello") Nothing)))
   it "x.msg.new chat message with chat version range" $
-    "{\"v\":\"1-4\",\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"}}}"
+    "{\"v\":\"1-5\",\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"}}}"
       ##==## ChatMessage supportedChatVRange (Just $ SharedMsgId "\1\2\3\4") (XMsgNew (MCSimple (extMsgContent (MCText "hello") Nothing)))
   it "x.msg.new quote" $
     "{\"v\":\"1\",\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello to you too\",\"type\":\"text\"},\"quote\":{\"content\":{\"text\":\"hello there!\",\"type\":\"text\"},\"msgRef\":{\"msgId\":\"BQYHCA==\",\"sent\":true,\"sentAt\":\"1970-01-01T00:00:01.000000001Z\"}}}}"
@@ -232,13 +240,13 @@ decodeChatMessageTest = describe "Chat message encoding/decoding" $ do
     "{\"v\":\"1\",\"event\":\"x.grp.mem.new\",\"params\":{\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}}"
       #==# XGrpMemNew MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, v = Nothing, profile = testProfile}
   it "x.grp.mem.new with member chat version range" $
-    "{\"v\":\"1\",\"event\":\"x.grp.mem.new\",\"params\":{\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"v\":\"1-4\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}}"
+    "{\"v\":\"1\",\"event\":\"x.grp.mem.new\",\"params\":{\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"v\":\"1-5\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}}"
       #==# XGrpMemNew MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, v = Just $ ChatVersionRange supportedChatVRange, profile = testProfile}
   it "x.grp.mem.intro" $
     "{\"v\":\"1\",\"event\":\"x.grp.mem.intro\",\"params\":{\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}}"
       #==# XGrpMemIntro MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, v = Nothing, profile = testProfile}
   it "x.grp.mem.intro with member chat version range" $
-    "{\"v\":\"1\",\"event\":\"x.grp.mem.intro\",\"params\":{\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"v\":\"1-4\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}}"
+    "{\"v\":\"1\",\"event\":\"x.grp.mem.intro\",\"params\":{\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"v\":\"1-5\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}}"
       #==# XGrpMemIntro MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, v = Just $ ChatVersionRange supportedChatVRange, profile = testProfile}
   it "x.grp.mem.inv" $
     "{\"v\":\"1\",\"event\":\"x.grp.mem.inv\",\"params\":{\"memberId\":\"AQIDBA==\",\"memberIntro\":{\"directConnReq\":\"simplex:/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-2%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D1-2%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\",\"groupConnReq\":\"simplex:/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-2%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D1-2%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\"}}}"
@@ -250,7 +258,7 @@ decodeChatMessageTest = describe "Chat message encoding/decoding" $ do
     "{\"v\":\"1\",\"event\":\"x.grp.mem.fwd\",\"params\":{\"memberIntro\":{\"directConnReq\":\"simplex:/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-2%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D1-2%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\",\"groupConnReq\":\"simplex:/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-2%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D1-2%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\"},\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}}"
       #==# XGrpMemFwd MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, v = Nothing, profile = testProfile} IntroInvitation {groupConnReq = testConnReq, directConnReq = Just testConnReq}
   it "x.grp.mem.fwd with member chat version range and w/t directConnReq" $
-    "{\"v\":\"1\",\"event\":\"x.grp.mem.fwd\",\"params\":{\"memberIntro\":{\"groupConnReq\":\"simplex:/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-2%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D1-2%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\"},\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"v\":\"1-4\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}}"
+    "{\"v\":\"1\",\"event\":\"x.grp.mem.fwd\",\"params\":{\"memberIntro\":{\"groupConnReq\":\"simplex:/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-2%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D1-2%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\"},\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"v\":\"1-5\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}}"
       #==# XGrpMemFwd MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, v = Just $ ChatVersionRange supportedChatVRange, profile = testProfile} IntroInvitation {groupConnReq = testConnReq, directConnReq = Nothing}
   it "x.grp.mem.info" $
     "{\"v\":\"1\",\"event\":\"x.grp.mem.info\",\"params\":{\"memberId\":\"AQIDBA==\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}"

tests/SchemaDump.hs

@@ -73,7 +73,9 @@ skipComparisonForDownMigrations =
     -- table and index definitions move down the file, so fields are re-created as not unique
     "20230914_member_probes",
     -- on down migration idx_connections_via_contact_uri_hash index moves down to the end of the file
-    "20231019_indexes"
+    "20231019_indexes",
+    -- table and indexes move down to the end of the file
+    "20231215_recreate_msg_deliveries"
   ]
 
 getSchema :: FilePath -> FilePath -> IO String

tests/Test.hs

@@ -7,6 +7,7 @@ import Control.Logger.Simple
 import Data.Time.Clock.System
 import JSONTests
 import MarkdownTests
+import MessageBatching
 import MobileTests
 import ProtocolTests
 import RemoteTests
@@ -28,6 +29,7 @@ main = do
     describe "SimpleX chat protocol" protocolTests
     around tmpBracket $ describe "WebRTC encryption" webRTCTests
     describe "Valid names" validNameTests
+    describe "Message batching" batchingTests
     around testBracket $ do
       describe "Mobile API Tests" mobileTests
       describe "SimpleX chat client" chatTests