Merge branch 'master' into master-ghc8107

src/Simplex/Chat.hs

@@ -28,6 +28,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
@@ -37,20 +38,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.NonEmpty (NonEmpty, nonEmpty)
+import Data.List (find, foldl', isSuffixOf, partition, sortOn)
+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
@@ -58,6 +58,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
@@ -76,7 +77,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)
@@ -196,79 +197,84 @@ createChatDatabase filePrefix key keepKey confirmMigrations = runExceptT $ do
   agentStore <- ExceptT $ createAgentStore (agentStoreFile filePrefix) key keepKey confirmMigrations
   pure ChatDatabase {chatStore, agentStore}
 
-newChatController :: ChatDatabase -> Maybe User -> ChatConfig -> ChatOpts -> IO ChatController
-newChatController ChatDatabase {chatStore, agentStore} user cfg@ChatConfig {agentConfig = aCfg, defaultServers, inlineFiles, tempDir, deviceNameForRemote} ChatOpts {coreOptions = CoreChatOpts {smpServers, xftpServers, networkConfig, logLevel, logConnections, logServerHosts, logFile, tbqSize, highlyAvailable}, deviceName, optFilesFolder, showReactions, allowInstantFiles, autoAcceptFileSize} = do
-  let inlineFiles' = if allowInstantFiles || autoAcceptFileSize > 0 then inlineFiles else inlineFiles {sendChunks = 0, receiveInstant = False}
-      config = cfg {logLevel, showReactions, tbqSize, subscriptionEvents = logConnections, hostEvents = logServerHosts, defaultServers = configServers, inlineFiles = inlineFiles', autoAcceptFileSize, highlyAvailable}
-      firstTime = dbNew chatStore
-  currentUser <- newTVarIO user
-  currentRemoteHost <- newTVarIO Nothing
-  servers <- agentServers config
-  smpAgent <- getSMPAgentClient aCfg {tbqSize} servers agentStore
-  agentAsync <- newTVarIO Nothing
-  random <- liftIO C.newRandom
-  inputQ <- newTBQueueIO tbqSize
-  outputQ <- newTBQueueIO tbqSize
-  connNetworkStatuses <- atomically TM.empty
-  subscriptionMode <- newTVarIO SMSubscribe
-  chatLock <- newEmptyTMVarIO
-  sndFiles <- newTVarIO M.empty
-  rcvFiles <- newTVarIO M.empty
-  currentCalls <- atomically TM.empty
-  localDeviceName <- newTVarIO $ fromMaybe deviceNameForRemote deviceName
-  multicastSubscribers <- newTMVarIO 0
-  remoteSessionSeq <- newTVarIO 0
-  remoteHostSessions <- atomically TM.empty
-  remoteHostsFolder <- newTVarIO Nothing
-  remoteCtrlSession <- newTVarIO Nothing
-  filesFolder <- newTVarIO optFilesFolder
-  chatStoreChanged <- newTVarIO False
-  expireCIThreads <- newTVarIO M.empty
-  expireCIFlags <- newTVarIO M.empty
-  cleanupManagerAsync <- newTVarIO Nothing
-  timedItemThreads <- atomically TM.empty
-  showLiveItems <- newTVarIO False
-  encryptLocalFiles <- newTVarIO False
-  userXFTPFileConfig <- newTVarIO $ xftpFileConfig cfg
-  tempDirectory <- newTVarIO tempDir
-  contactMergeEnabled <- newTVarIO True
-  pure
-    ChatController
-      { firstTime,
-        currentUser,
-        currentRemoteHost,
-        smpAgent,
-        agentAsync,
-        chatStore,
-        chatStoreChanged,
-        random,
-        inputQ,
-        outputQ,
-        connNetworkStatuses,
-        subscriptionMode,
-        chatLock,
-        sndFiles,
-        rcvFiles,
-        currentCalls,
-        localDeviceName,
-        multicastSubscribers,
-        remoteSessionSeq,
-        remoteHostSessions,
-        remoteHostsFolder,
-        remoteCtrlSession,
-        config,
-        filesFolder,
-        expireCIThreads,
-        expireCIFlags,
-        cleanupManagerAsync,
-        timedItemThreads,
-        showLiveItems,
-        encryptLocalFiles,
-        userXFTPFileConfig,
-        tempDirectory,
-        logFilePath = logFile,
-        contactMergeEnabled
-      }
+newChatController :: ChatDatabase -> Maybe User -> ChatConfig -> ChatOpts -> Bool -> IO ChatController
+newChatController
+  ChatDatabase {chatStore, agentStore}
+  user
+  cfg@ChatConfig {agentConfig = aCfg, defaultServers, inlineFiles, tempDir, deviceNameForRemote}
+  ChatOpts {coreOptions = CoreChatOpts {smpServers, xftpServers, networkConfig, logLevel, logConnections, logServerHosts, logFile, tbqSize, highlyAvailable}, deviceName, optFilesFolder, showReactions, allowInstantFiles, autoAcceptFileSize}
+  backgroundMode = do
+    let inlineFiles' = if allowInstantFiles || autoAcceptFileSize > 0 then inlineFiles else inlineFiles {sendChunks = 0, receiveInstant = False}
+        config = cfg {logLevel, showReactions, tbqSize, subscriptionEvents = logConnections, hostEvents = logServerHosts, defaultServers = configServers, inlineFiles = inlineFiles', autoAcceptFileSize, highlyAvailable}
+        firstTime = dbNew chatStore
+    currentUser <- newTVarIO user
+    currentRemoteHost <- newTVarIO Nothing
+    servers <- agentServers config
+    smpAgent <- getSMPAgentClient aCfg {tbqSize} servers agentStore backgroundMode
+    agentAsync <- newTVarIO Nothing
+    random <- liftIO C.newRandom
+    inputQ <- newTBQueueIO tbqSize
+    outputQ <- newTBQueueIO tbqSize
+    connNetworkStatuses <- atomically TM.empty
+    subscriptionMode <- newTVarIO SMSubscribe
+    chatLock <- newEmptyTMVarIO
+    sndFiles <- newTVarIO M.empty
+    rcvFiles <- newTVarIO M.empty
+    currentCalls <- atomically TM.empty
+    localDeviceName <- newTVarIO $ fromMaybe deviceNameForRemote deviceName
+    multicastSubscribers <- newTMVarIO 0
+    remoteSessionSeq <- newTVarIO 0
+    remoteHostSessions <- atomically TM.empty
+    remoteHostsFolder <- newTVarIO Nothing
+    remoteCtrlSession <- newTVarIO Nothing
+    filesFolder <- newTVarIO optFilesFolder
+    chatStoreChanged <- newTVarIO False
+    expireCIThreads <- newTVarIO M.empty
+    expireCIFlags <- newTVarIO M.empty
+    cleanupManagerAsync <- newTVarIO Nothing
+    timedItemThreads <- atomically TM.empty
+    showLiveItems <- newTVarIO False
+    encryptLocalFiles <- newTVarIO False
+    userXFTPFileConfig <- newTVarIO $ xftpFileConfig cfg
+    tempDirectory <- newTVarIO tempDir
+    contactMergeEnabled <- newTVarIO True
+    pure
+      ChatController
+        { firstTime,
+          currentUser,
+          currentRemoteHost,
+          smpAgent,
+          agentAsync,
+          chatStore,
+          chatStoreChanged,
+          random,
+          inputQ,
+          outputQ,
+          connNetworkStatuses,
+          subscriptionMode,
+          chatLock,
+          sndFiles,
+          rcvFiles,
+          currentCalls,
+          localDeviceName,
+          multicastSubscribers,
+          remoteSessionSeq,
+          remoteHostSessions,
+          remoteHostsFolder,
+          remoteCtrlSession,
+          config,
+          filesFolder,
+          expireCIThreads,
+          expireCIFlags,
+          cleanupManagerAsync,
+          timedItemThreads,
+          showLiveItems,
+          encryptLocalFiles,
+          userXFTPFileConfig,
+          tempDirectory,
+          logFilePath = logFile,
+          contactMergeEnabled
+        }
   where
     configServers :: DefaultAgentServers
     configServers =
@@ -601,7 +607,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
@@ -682,7 +688,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
@@ -696,22 +702,22 @@ 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
-            (msg@SndMessage {sharedMsgId}, sentToMembers) <- sendGroupMessage user gInfo ms (XMsgNew msgContainer)
-            ci <- saveSndChatItem' user (CDGroupSnd gInfo) msg (CISndMsgContent mc) ciFile_ quotedItem_ timed_ live
-            withStore' $ \db ->
-              forM_ sentToMembers $ \GroupMember {groupMemberId} ->
-                createGroupSndStatus db (chatItemId' ci) groupMemberId CISSndNew
-            mapM_ (sendGroupFileInline ms sharedMsgId) ft_
-            forM_ (timed_ >>= timedDeleteAt') $
-              startProximateTimedItemThread user (ChatRef CTGroup groupId, chatItemId' ci)
-            pure $ CRNewChatItem user (AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci)
+              (fInv_, ciFile_, ft_) <- unzipMaybe3 <$> setupSndFileTransfer g (length $ filter memberCurrent ms)
+              timed_ <- sndGroupCITimed live gInfo itemTTL
+              (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 ->
+                forM_ sentToMembers $ \GroupMember {groupMemberId} ->
+                  createGroupSndStatus db (chatItemId' ci) groupMemberId CISSndNew
+              mapM_ (sendGroupFileInline ms sharedMsgId) ft_
+              forM_ (timed_ >>= timedDeleteAt') $
+                startProximateTimedItemThread user (ChatRef CTGroup groupId, chatItemId' ci)
+              pure $ CRNewChatItem user (AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci)
         notAllowedError f = pure $ chatCmdError (Just user) ("feature not allowed " <> T.unpack (groupFeatureNameText f))
         setupSndFileTransfer :: Group -> Int -> m (Maybe (FileInvitation, CIFile 'MDSnd, FileTransferMeta))
         setupSndFileTransfer g@(Group gInfo _) n = forM file_ $ \file -> do
@@ -742,51 +748,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
@@ -1831,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
@@ -2301,7 +2265,7 @@ processChatCommand = \case
       tryChatError (withStore (`getUser` userId)) >>= \case
         Left _ -> throwChatError CEUserUnknown
         Right user -> pure user
-    validateUserPassword :: User -> User -> Maybe UserPwd -> m ()        
+    validateUserPassword :: User -> User -> Maybe UserPwd -> m ()
     validateUserPassword = validateUserPassword_ . Just
     validateUserPassword_ :: Maybe User -> User -> Maybe UserPwd -> m ()
     validateUserPassword_ user_ User {userId = userId', viewPwdHash} viewPwd_ =
@@ -2429,6 +2393,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 $
@@ -2606,7 +2614,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
@@ -3184,17 +3192,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
-          sendParts 1 partSize rfdText
+          parts <- splitFileDescr rfdText
+          loopSend parts
           where
-            sendParts partNo partSize rfdText = do
-              let (part, rest) = T.splitAt partSize rfdText
-                  complete = T.null rest
-                  fileDescr = FileDescr {fileDescrText = part, fileDescrPartNo = partNo, fileDescrComplete = complete}
+            -- returns msgDeliveryId of the last file description message
+            loopSend :: NonEmpty FileDescr -> m Int64
+            loopSend (fileDescr :| fds) = do
               (_, msgDeliveryId) <- sendMsg $ XMsgFileDescr {msgId, fileDescr}
-              if complete
-                then pure msgDeliveryId
-                else sendParts (partNo + 1) partSize rest
+              case L.nonEmpty fds of
+                Just fds' -> loopSend fds'
+                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 =
@@ -3289,6 +3309,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
@@ -3564,21 +3587,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
-            forM_ shuffledIntros $ \intro ->
-              processIntro intro `catchChatError` (toView . CRChatError (Just user))
+            sendIntroductions members
+            when (groupFeatureAllowed SGFHistory gInfo) sendHistory
             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
@@ -3606,41 +3713,27 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
                       void $ sendDirectMessage imConn (XGrpMemCon $ memberId (m :: GroupMember)) (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
-          Right (ACMsg _ chatMsg, withRcpt) -> do
-            ackMsg agentConnId cmdId msgMeta $ if withRcpt then Just "" else Nothing
-            when (memberRole (membership :: GroupMember) >= GRAdmin) $ forwardMsg_ chatMsg
-          Left e -> ackMsg agentConnId cmdId msgMeta Nothing >> throwError e
+        let aChatMsgs = parseChatMessages msgBody
+        withAckMessage agentConnId cmdId msgMeta $ do
+          forM_ aChatMsgs $ \case
+            Right (ACMsg _ chatMsg) ->
+              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 (memberRole (membership :: GroupMember) >= 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 ()
-          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 :: MsgEncodingI e => CommandId -> ChatMessage e -> m ()
           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
@@ -3668,15 +3761,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 :: ChatMsgEvent e -> m Bool
-          checkSendRcpt event = do
+          checkSendRcpt :: [AChatMessage] -> m Bool
+          checkSendRcpt aChatMsgs = 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
@@ -4013,15 +4108,11 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
 
     ackMsgDeliveryEvent :: Connection -> CommandId -> m ()
     ackMsgDeliveryEvent Connection {connId} ackCmdId =
-      withStoreCtx'
-        (Just $ "createRcvMsgDeliveryEvent, connId: " <> show connId <> ", ackCmdId: " <> show ackCmdId <> ", msgDeliveryStatus: MDSRcvAcknowledged")
-        $ \db -> createRcvMsgDeliveryEvent db connId ackCmdId MDSRcvAcknowledged
+      withStore' $ \db -> updateRcvMsgDeliveryStatus db connId ackCmdId MDSRcvAcknowledged
 
     sentMsgDeliveryEvent :: Connection -> AgentMsgId -> m ()
     sentMsgDeliveryEvent Connection {connId} msgId =
-      withStoreCtx
-        (Just $ "createSndMsgDeliveryEvent, connId: " <> show connId <> ", msgId: " <> show msgId <> ", msgDeliveryStatus: MDSSndSent")
-        $ \db -> createSndMsgDeliveryEvent db connId msgId MDSSndSent
+      withStore' $ \db -> updateSndMsgDeliveryStatus db connId msgId MDSSndSent
 
     agentErrToItemStatus :: AgentErrorType -> CIStatus 'MDSnd
     agentErrToItemStatus (SMP AUTH) = CISSndErrorAuth
@@ -4283,20 +4374,21 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
         ChatErrorStore (SEChatItemSharedMsgIdNotFound sharedMsgId) -> handle sharedMsgId
         e -> throwError e
 
-    newGroupContentMessage :: GroupInfo -> GroupMember -> MsgContainer -> RcvMessage -> UTCTime -> m ()
-    newGroupContentMessage gInfo m@GroupMember {memberId, memberRole} mc msg@RcvMessage {sharedMsgId_} brokerTs
+    newGroupContentMessage :: GroupInfo -> GroupMember -> MsgContainer -> RcvMessage -> UTCTime -> Bool -> m ()
+    newGroupContentMessage gInfo m@GroupMember {memberId, memberRole} mc msg@RcvMessage {sharedMsgId_} brokerTs forwarded
       | isVoice content && not (groupFeatureAllowed SGFVoice gInfo) = rejected GFVoice
       | not (isVoice content) && isJust fInv_ && not (groupFeatureAllowed SGFFiles gInfo) = rejected GFFiles
       | otherwise = do
-        -- TODO integrity message check
-        -- check if message moderation event was received ahead of message
-        let timed_ = rcvGroupCITimed gInfo itemTTL
-            live = fromMaybe False live_
-        withStore' (\db -> getCIModeration db user gInfo memberId sharedMsgId_) >>= \case
-          Just ciModeration -> do
-            applyModeration timed_ live ciModeration
-            withStore' $ \db -> deleteCIModeration db gInfo memberId sharedMsgId_
-          Nothing -> createItem timed_ live
+          let timed_ =
+                if forwarded
+                  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
+              applyModeration timed_ live ciModeration
+              withStore' $ \db -> deleteCIModeration db gInfo memberId sharedMsgId_
+            Nothing -> createItem timed_ live
       where
         rejected f = void $ newChatItem (CIRcvGroupFeatureRejected f) Nothing Nothing False
         ExtMsgContent content fInv_ itemTTL live_ = mcExtMsgContent mc
@@ -5217,7 +5309,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
@@ -5236,14 +5328,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 ()
@@ -5334,17 +5431,13 @@ sendFileInline_ FileTransferMeta {filePath, chunkSize} sharedMsgId sendMsg =
     chSize = fromIntegral chunkSize
 
 parseChatMessage :: ChatMonad m => Connection -> ByteString -> m (ChatMessage 'Json)
-parseChatMessage conn = parseChatMessage_ conn Nothing
-{-# INLINE parseChatMessage #-}
-
-parseAChatMessage :: ChatMonad m => Connection -> MsgMeta -> ByteString -> m AChatMessage
-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
+parseChatMessage conn s = do
+  case parseChatMessages s of
+    [msg] -> liftEither . first (ChatError . errType) $ (\(ACMsg _ m) -> checkEncoding m) =<< msg
+    _ -> throwChatError $ CEException "parseChatMessage: single message is expected"
   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} =
@@ -5521,40 +5614,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 ->
-    let msgBody = strEncode ChatMessage {chatVRange, msgId = Just sharedMsgId, chatMsgEvent}
-     in NewMessage {chatMsgEvent, msgBody}
+  withStore $ \db -> createNewSndMessage db gVar connOrGroupId chatMsgEvent (encodeMessage chatVRange)
+  where
+    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 conn cmEventTag msgBody msgId =
-  deliverMessages [(conn, cmEventTag, msgBody, msgId)] >>= \case
+deliverMessage :: ChatMonad m => Connection -> CMEventTag e -> LazyMsgBody -> MessageId -> m Int64
+deliverMessage conn cmEventTag msgBody msgId = do
+  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
-    msgFlags cmEvTag = MsgFlags {notification = hasNotification cmEvTag}
+    aReqs = map (\(conn, msgFlags, msgBody, _msgId) -> (aConnId conn, msgFlags, LB.toStrict msgBody)) msgReqs
     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
-  let tag = toCMEventTag chatMsgEvent
+  recipientMembers <- liftIO $ shuffleMembers (filter memberCurrent members)
+  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
@@ -5562,6 +5692,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)
@@ -5610,15 +5746,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
@@ -5635,21 +5762,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
-  ACMsg _ ChatMessage {chatVRange, msgId = sharedMsgId_, chatMsgEvent} <- parseAChatMessage conn agentMsgMeta msgBody
-  conn' <- updatePeerChatVRange conn chatVRange
-  let agentMsgId = fst $ recipient agentMsgMeta
-      newMsg = NewMessage {chatMsgEvent, msgBody}
-      rcvMsgDelivery = RcvMsgDelivery {connId, agentMsgId, agentMsgMeta, agentAckCmdId}
-  msg <- withStore $ \db -> createNewMessageAndRcvMsgDelivery db (ConnectionId connId) newMsg sharedMsgId_ rcvMsgDelivery Nothing
-  pure (conn', msg)
+saveDirectRcvMSG conn@Connection {connId} agentMsgMeta agentAckCmdId msgBody =
+  case parseChatMessages msgBody of
+    [Right (ACMsg _ ChatMessage {chatVRange, msgId = sharedMsgId_, chatMsgEvent})] -> do
+      conn' <- updatePeerChatVRange conn chatVRange
+      let agentMsgId = fst $ recipient agentMsgMeta
+          newMsg = NewRcvMessage {chatMsgEvent, msgBody}
+          rcvMsgDelivery = RcvMsgDelivery {connId, agentMsgId, agentMsgMeta, agentAckCmdId}
+      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 $ groupMemberId' am'
   msg <-
@@ -5665,7 +5796,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)
@@ -6229,6 +6360,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)),
@@ -6316,7 +6448,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
@@ -6354,6 +6491,7 @@ chatCommandP =
         <|> ("day" $> 86400)
         <|> ("week" $> (7 * 86400))
         <|> ("month" $> (30 * 86400))
+        <|> A.decimal
     timedTTLOnOffP =
       optional ("on" *> A.space) *> (Just <$> timedTTLP)
         <|> ("off" $> Nothing)

src/Simplex/Chat/Core.hs

@@ -28,7 +28,7 @@ simplexChatCore cfg@ChatConfig {confirmMigrations, testView} opts@ChatOpts {core
       exitFailure
     run db@ChatDatabase {chatStore} = do
       u <- getCreateActiveUser chatStore testView
-      cc <- newChatController db (Just u) cfg opts
+      cc <- newChatController db (Just u) cfg opts False
       runSimplexChat opts u cc chat
 
 runSimplexChat :: ChatOpts -> User -> ChatController -> (User -> ChatController -> IO ()) -> IO ()

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

@@ -21,6 +21,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)
@@ -369,6 +370,9 @@ data CIQuote (c :: ChatType) = CIQuote
   }
   deriving (Show)
 
+quoteItemId :: CIQuote c -> Maybe ChatItemId
+quoteItemId CIQuote {itemId} = itemId
+
 data CIReaction (c :: ChatType) (d :: MsgDirection) = CIReaction
   { chatDir :: CIDirection c d,
     chatItem :: CChatItem c,
@@ -759,17 +763,20 @@ checkChatType x = case testEquality (chatTypeI @c) (chatTypeI @c') of
   Just Refl -> Right x
   Nothing -> Left "bad chat type"
 
-data NewMessage e = NewMessage
-  { chatMsgEvent :: ChatMsgEvent e,
-    msgBody :: MsgBody
-  }
-  deriving (Show)
+type LazyMsgBody = L.ByteString
 
 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,
@@ -783,7 +790,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"
-  CIRcvMsgContent _ -> "rcvMsgContent"
+  CISndMsgContent _ -> sndMsgContentTag
+  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/Mobile.hs

@@ -72,7 +72,7 @@ $(JQ.deriveToJSON defaultJSON ''APIResponse)
 
 foreign export ccall "chat_migrate_init" cChatMigrateInit :: CString -> CString -> CString -> Ptr (StablePtr ChatController) -> IO CJSONString
 
-foreign export ccall "chat_migrate_init_key" cChatMigrateInitKey :: CString -> CString -> CInt -> CString -> Ptr (StablePtr ChatController) -> IO CJSONString
+foreign export ccall "chat_migrate_init_key" cChatMigrateInitKey :: CString -> CString -> CInt -> CString -> CInt -> Ptr (StablePtr ChatController) -> IO CJSONString
 
 foreign export ccall "chat_close_store" cChatCloseStore :: StablePtr ChatController -> IO CString
 
@@ -108,10 +108,10 @@ foreign export ccall "chat_decrypt_file" cChatDecryptFile :: CString -> CString
 
 -- | check / migrate database and initialize chat controller on success
 cChatMigrateInit :: CString -> CString -> CString -> Ptr (StablePtr ChatController) -> IO CJSONString
-cChatMigrateInit fp key = cChatMigrateInitKey fp key 0
+cChatMigrateInit fp key conf = cChatMigrateInitKey fp key 0 conf 0
 
-cChatMigrateInitKey :: CString -> CString -> CInt -> CString -> Ptr (StablePtr ChatController) -> IO CJSONString
-cChatMigrateInitKey fp key keepKey conf ctrl = do
+cChatMigrateInitKey :: CString -> CString -> CInt -> CString -> CInt -> Ptr (StablePtr ChatController) -> IO CJSONString
+cChatMigrateInitKey fp key keepKey conf background ctrl = do
   -- ensure we are set to UTF-8; iOS does not have locale, and will default to
   -- US-ASCII all the time.
   setLocaleEncoding utf8
@@ -122,7 +122,7 @@ cChatMigrateInitKey fp key keepKey conf ctrl = do
   dbKey <- BA.convert <$> B.packCString key
   confirm <- peekCAString conf
   r <-
-    chatMigrateInitKey dbPath dbKey (keepKey /= 0) confirm >>= \case
+    chatMigrateInitKey dbPath dbKey (keepKey /= 0) confirm (background /= 0) >>= \case
       Right cc -> (newStablePtr cc >>= poke ctrl) $> DBMOk
       Left e -> pure e
   newCStringFromLazyBS $ J.encode r
@@ -220,10 +220,10 @@ getActiveUser_ :: SQLiteStore -> IO (Maybe User)
 getActiveUser_ st = find activeUser <$> withTransaction st getUsers
 
 chatMigrateInit :: String -> ScrubbedBytes -> String -> IO (Either DBMigrationResult ChatController)
-chatMigrateInit dbFilePrefix dbKey = chatMigrateInitKey dbFilePrefix dbKey False
+chatMigrateInit dbFilePrefix dbKey confirm = chatMigrateInitKey dbFilePrefix dbKey False confirm False
 
-chatMigrateInitKey :: String -> ScrubbedBytes -> Bool -> String -> IO (Either DBMigrationResult ChatController)
-chatMigrateInitKey dbFilePrefix dbKey keepKey confirm = runExceptT $ do
+chatMigrateInitKey :: String -> ScrubbedBytes -> Bool -> String -> Bool -> IO (Either DBMigrationResult ChatController)
+chatMigrateInitKey dbFilePrefix dbKey keepKey confirm backgroundMode = runExceptT $ do
   confirmMigrations <- liftEitherWith (const DBMInvalidConfirmation) $ strDecode $ B.pack confirm
   chatStore <- migrate createChatStore (chatStoreFile dbFilePrefix) confirmMigrations
   agentStore <- migrate createAgentStore (agentStoreFile dbFilePrefix) confirmMigrations
@@ -231,7 +231,7 @@ chatMigrateInitKey dbFilePrefix dbKey keepKey confirm = runExceptT $ do
   where
     initialize st db = do
       user_ <- getActiveUser_ st
-      newChatController db user_ defaultMobileConfig (mobileChatOpts dbFilePrefix)
+      newChatController db user_ defaultMobileConfig (mobileChatOpts dbFilePrefix) backgroundMode
     migrate createStore dbFile confirmMigrations =
       ExceptT $
         (first (DBMErrorMigration dbFile) <$> createStore dbFile dbKey keepKey confirmMigrations)

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
-  strEncode msg = case chatToAppMessage msg of
-    AMJson m -> LB.toStrict $ J.encode m
-    AMBinary m -> strEncode m
-  strP = (\(ACMsg _ m) -> checkEncoding m) <$?> strP
+-- this limit reserves space for metadata in forwarded messages
+-- 15780 (limit used for fileChunkSize) - 161 (x.grp.msg.forward overhead) = 15619, round to 15610
+maxChatMsgSize :: Int64
+maxChatMsgSize = 15610
 
-instance StrEncoding AChatMessage where
-  strEncode (ACMsg _ m) = strEncode m
-  strP =
-    A.peekChar' >>= \case
-      '{' -> ACMsg SJson <$> ((appJsonToCM <=< J.eitherDecodeStrict') <$?> A.takeByteString)
-      _ -> ACMsg SBinary <$> (appBinaryToCM <$?> strP)
+data EncodedChatMessage = ECMEncoded L.ByteString | ECMLarge
+
+encodeChatMessage :: MsgEncodingI e => ChatMessage e -> EncodedChatMessage
+encodeChatMessage msg = do
+  case chatToAppMessage msg of
+    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

@@ -46,7 +46,8 @@ module Simplex.Chat.Store.Files
     createRcvFileTransfer,
     createRcvGroupFileTransfer,
     appendRcvFD,
-    getRcvFileDescrByFileId,
+    getRcvFileDescrByRcvFileId,
+    getRcvFileDescrBySndFileId,
     updateRcvFileAgentId,
     getRcvFileTransferById,
     getRcvFileTransfer,
@@ -542,7 +543,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 $
@@ -571,14 +572,14 @@ appendRcvFD db userId fileId fd@FileDescr {fileDescrText, fileDescrPartNo, fileD
             (fileDescrText', fileDescrPartNo, fileDescrComplete, fileDescrId)
         pure RcvFileDescr {fileDescrId, fileDescrText = fileDescrText', fileDescrPartNo, fileDescrComplete}
 
-getRcvFileDescrByFileId :: DB.Connection -> FileTransferId -> ExceptT StoreError IO RcvFileDescr
-getRcvFileDescrByFileId db fileId = do
-  liftIO (getRcvFileDescrByFileId_ db fileId) >>= \case
+getRcvFileDescrByRcvFileId :: DB.Connection -> FileTransferId -> ExceptT StoreError IO RcvFileDescr
+getRcvFileDescrByRcvFileId db fileId = do
+  liftIO (getRcvFileDescrByRcvFileId_ db fileId) >>= \case
     Nothing -> throwError $ SERcvFileDescrNotFound fileId
     Just rfd -> pure rfd
 
-getRcvFileDescrByFileId_ :: DB.Connection -> FileTransferId -> IO (Maybe RcvFileDescr)
-getRcvFileDescrByFileId_ db fileId =
+getRcvFileDescrByRcvFileId_ :: DB.Connection -> FileTransferId -> IO (Maybe RcvFileDescr)
+getRcvFileDescrByRcvFileId_ db fileId =
   maybeFirstRow toRcvFileDescr $
     DB.query
       db
@@ -590,10 +591,30 @@ getRcvFileDescrByFileId_ db fileId =
         LIMIT 1
       |]
       (Only fileId)
-  where
-    toRcvFileDescr :: (Int64, Text, Int, Bool) -> RcvFileDescr
-    toRcvFileDescr (fileDescrId, fileDescrText, fileDescrPartNo, fileDescrComplete) =
-      RcvFileDescr {fileDescrId, fileDescrText, fileDescrPartNo, fileDescrComplete}
+
+getRcvFileDescrBySndFileId :: DB.Connection -> FileTransferId -> ExceptT StoreError IO RcvFileDescr
+getRcvFileDescrBySndFileId db fileId = do
+  liftIO (getRcvFileDescrBySndFileId_ db fileId) >>= \case
+    Nothing -> throwError $ SERcvFileDescrNotFound fileId
+    Just rfd -> pure rfd
+
+getRcvFileDescrBySndFileId_ :: DB.Connection -> FileTransferId -> IO (Maybe RcvFileDescr)
+getRcvFileDescrBySndFileId_ db fileId =
+  maybeFirstRow toRcvFileDescr $
+    DB.query
+      db
+      [sql|
+        SELECT d.file_descr_id, d.file_descr_text, d.file_descr_part_no, d.file_descr_complete
+        FROM xftp_file_descriptions d
+        JOIN snd_files f ON f.file_descr_id = d.file_descr_id
+        WHERE f.file_id = ?
+        LIMIT 1
+      |]
+      (Only fileId)
+
+toRcvFileDescr :: (Int64, Text, Int, Bool) -> RcvFileDescr
+toRcvFileDescr (fileDescrId, fileDescrText, fileDescrPartNo, fileDescrComplete) =
+  RcvFileDescr {fileDescrId, fileDescrText, fileDescrPartNo, fileDescrComplete}
 
 updateRcvFileAgentId :: DB.Connection -> FileTransferId -> Maybe AgentRcvFileId -> IO ()
 updateRcvFileAgentId db fileId aFileId = do
@@ -626,7 +647,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

@@ -149,7 +149,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,
-    createRcvMsgDeliveryEvent,
+    updateSndMsgDeliveryStatus,
+    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 db gVar connOrGroupId mkMessage =
-  createWithRandomId gVar $ \sharedMsgId -> do
-    let NewMessage {chatMsgEvent, msgBody} = mkMessage $ SharedMsgId sharedMsgId
-    createdAt <- getCurrentTime
-    DB.execute
-      db
-      [sql|
-        INSERT INTO messages (
-          msg_sent, chat_msg_event, msg_body, connection_id, group_id,
-          shared_msg_id, shared_msg_id_user, created_at, updated_at
-        ) VALUES (?,?,?,?,?,?,?,?,?)
-      |]
-      (MDSnd, toCMEventTag chatMsgEvent, msgBody, connId_, groupId_, sharedMsgId, Just True, createdAt, createdAt)
-    msgId <- insertedRowId db
-    pure SndMessage {msgId, sharedMsgId = SharedMsgId sharedMsgId, msgBody}
+createNewSndMessage :: MsgEncodingI e => DB.Connection -> TVar ChaChaDRG -> ConnOrGroupId -> ChatMsgEvent e -> (SharedMsgId -> EncodedChatMessage) -> ExceptT StoreError IO SndMessage
+createNewSndMessage db gVar connOrGroupId chatMsgEvent encodeMessage =
+  createWithRandomId' gVar $ \sharedMsgId ->
+    case encodeMessage (SharedMsgId sharedMsgId) of
+      ECMLarge -> pure $ Left SELargeMsg
+      ECMEncoded msgBody -> do
+        createdAt <- getCurrentTime
+        DB.execute
+          db
+          [sql|
+            INSERT INTO messages (
+              msg_sent, chat_msg_event, msg_body, connection_id, group_id,
+              shared_msg_id, shared_msg_id_user, created_at, updated_at
+            ) VALUES (?,?,?,?,?,?,?,?,?)
+          |]
+          (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
-  createMsgDeliveryEvent_ db msgDeliveryId MDSSndAgent currentTs
-  pure msgDeliveryId
+  DB.execute
+    db
+    [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 (?,?,?,?,?,?,?,?)"
-      (msgId, connId, agentMsgId, msgMetaJson agentMsgMeta, agentAckCmdId, snd $ broker agentMsgMeta, currentTs, currentTs)
-    msgDeliveryId <- insertedRowId db
-    createMsgDeliveryEvent_ db msgDeliveryId MDSRcvAgent currentTs
+      [sql|
+        INSERT INTO msg_deliveries
+          (message_id, connection_id, agent_msg_id, agent_msg_meta, agent_ack_cmd_id, chat_ts, created_at, updated_at, delivery_status)
+        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 db connOrGroupId NewMessage {chatMsgEvent, msgBody} sharedMsgId_ authorMember forwardedByMember =
+createNewRcvMessage :: forall e. MsgEncodingI e => DB.Connection -> ConnOrGroupId -> NewRcvMessage e -> Maybe SharedMsgId -> Maybe GroupMemberId -> Maybe GroupMemberId -> ExceptT StoreError IO RcvMessage
+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 ()
-createSndMsgDeliveryEvent db connId agentMsgId sndMsgDeliveryStatus = do
-  msgDeliveryId <- getMsgDeliveryId_ db connId agentMsgId
-  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
+updateSndMsgDeliveryStatus :: DB.Connection -> Int64 -> AgentMsgId -> MsgDeliveryStatus 'MDSnd -> IO ()
+updateSndMsgDeliveryStatus db connId agentMsgId sndMsgDeliveryStatus = do
+  currentTs <- getCurrentTime
   DB.execute
     db
     [sql|
-      INSERT INTO msg_deliveries
-        (message_id, connection_id, agent_msg_id, agent_msg_meta, chat_ts, created_at, updated_at)
-      VALUES (?,?,?,NULL,?,?,?)
+      UPDATE msg_deliveries
+      SET delivery_status = ?, updated_at = ?
+      WHERE connection_id = ? AND agent_msg_id = ?
     |]
-    (messageId, connId, agentMsgId, createdAt, createdAt, createdAt)
-  insertedRowId db
+    (sndMsgDeliveryStatus, currentTs, connId, agentMsgId)
 
-createMsgDeliveryEvent_ :: DB.Connection -> Int64 -> MsgDeliveryStatus d -> UTCTime -> IO ()
-createMsgDeliveryEvent_ db msgDeliveryId msgDeliveryStatus createdAt = do
+updateRcvMsgDeliveryStatus :: DB.Connection -> Int64 -> CommandId -> MsgDeliveryStatus 'MDRcv -> IO ()
+updateRcvMsgDeliveryStatus db connId cmdId rcvMsgDeliveryStatus = do
+  currentTs <- getCurrentTime
   DB.execute
     db
     [sql|
-      INSERT INTO msg_delivery_events
-        (msg_delivery_id, delivery_status, created_at, updated_at)
-      VALUES (?,?,?,?)
+      UPDATE msg_deliveries
+      SET delivery_status = ?, updated_at = ?
+      WHERE connection_id = ? AND agent_ack_cmd_id = ?
     |]
-    (msgDeliveryId, msgDeliveryStatus, createdAt, createdAt)
-
-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)
+    (rcvMsgDeliveryStatus, currentTs, 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

@@ -626,7 +626,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)
@@ -1011,9 +1012,11 @@ data XFTPRcvFile = XFTPRcvFile
   }
   deriving (Eq, Show)
 
+type RcvFileDescrText = Text
+
 data RcvFileDescr = RcvFileDescr
   { fileDescrId :: Int64,
-    fileDescrText :: Text,
+    fileDescrText :: RcvFileDescrText,
     fileDescrPartNo :: Int,
     fileDescrComplete :: Bool
   }

src/Simplex/Chat/Types/Preferences.hs

@@ -147,6 +147,7 @@ data GroupFeature
   | GFReactions
   | GFVoice
   | GFFiles
+  | GFHistory
   deriving (Show)
 
 data SGroupFeature (f :: GroupFeature) where
@@ -156,6 +157,7 @@ data SGroupFeature (f :: GroupFeature) where
   SGFReactions :: SGroupFeature 'GFReactions
   SGFVoice :: SGroupFeature 'GFVoice
   SGFFiles :: SGroupFeature 'GFFiles
+  SGFHistory :: SGroupFeature 'GFHistory
 
 deriving instance Show (SGroupFeature f)
 
@@ -171,6 +173,7 @@ groupFeatureNameText = \case
   GFReactions -> "Message reactions"
   GFVoice -> "Voice messages"
   GFFiles -> "Files and media"
+  GFHistory -> "Recent history"
 
 groupFeatureNameText' :: SGroupFeature f -> Text
 groupFeatureNameText' = groupFeatureNameText . toGroupFeature
@@ -186,7 +189,8 @@ allGroupFeatures =
     AGF SGFFullDelete,
     AGF SGFReactions,
     AGF SGFVoice,
-    AGF SGFFiles
+    AGF SGFFiles,
+    AGF SGFHistory
   ]
 
 groupPrefSel :: SGroupFeature f -> GroupPreferences -> Maybe (GroupFeaturePreference f)
@@ -197,6 +201,7 @@ groupPrefSel = \case
   SGFReactions -> reactions
   SGFVoice -> voice
   SGFFiles -> files
+  SGFHistory -> history
 
 toGroupFeature :: SGroupFeature f -> GroupFeature
 toGroupFeature = \case
@@ -206,6 +211,7 @@ toGroupFeature = \case
   SGFReactions -> GFReactions
   SGFVoice -> GFVoice
   SGFFiles -> GFFiles
+  SGFHistory -> GFHistory
 
 class GroupPreferenceI p where
   getGroupPreference :: SGroupFeature f -> p -> GroupFeaturePreference f
@@ -224,6 +230,7 @@ instance GroupPreferenceI FullGroupPreferences where
     SGFReactions -> reactions
     SGFVoice -> voice
     SGFFiles -> files
+    SGFHistory -> history
   {-# INLINE getGroupPreference #-}
 
 -- collection of optional group preferences
@@ -233,7 +240,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)
 
@@ -258,6 +266,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_ =
@@ -284,7 +293,8 @@ data FullGroupPreferences = FullGroupPreferences
     fullDelete :: FullDeleteGroupPreference,
     reactions :: ReactionsGroupPreference,
     voice :: VoiceGroupPreference,
-    files :: FilesGroupPreference
+    files :: FilesGroupPreference,
+    history :: HistoryGroupPreference
   }
   deriving (Eq, Show)
 
@@ -339,11 +349,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,
@@ -438,6 +449,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
@@ -464,6 +479,9 @@ instance HasField "enable" VoiceGroupPreference GroupFeatureEnabled where
 instance HasField "enable" FilesGroupPreference GroupFeatureEnabled where
   hasField p = (\enable -> p {enable}, enable (p :: FilesGroupPreference))
 
+instance HasField "enable" HistoryGroupPreference GroupFeatureEnabled where
+  hasField p = (\enable -> p {enable}, p.enable)
+
 instance GroupFeatureI 'GFTimedMessages where
   type GroupFeaturePreference 'GFTimedMessages = TimedMessagesGroupPreference
   sGroupFeature = SGFTimedMessages
@@ -494,6 +512,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
@@ -616,7 +639,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
@@ -630,7 +654,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)
@@ -736,6 +761,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)