diff --git a/simplex-chat.cabal b/simplex-chat.cabal index 8e93b72194..4274784ead 100644 --- a/simplex-chat.cabal +++ b/simplex-chat.cabal @@ -95,7 +95,6 @@ library Simplex.Chat.Options.Postgres Simplex.Chat.Store.Postgres.Migrations Simplex.Chat.Store.Postgres.Migrations.M20241220_initial - Simplex.Chat.Store.Postgres.Migrations.M20250227_member_acceptance else exposed-modules: Simplex.Chat.Archive @@ -225,7 +224,6 @@ library Simplex.Chat.Store.SQLite.Migrations.M20250126_mentions Simplex.Chat.Store.SQLite.Migrations.M20250129_delete_unused_contacts Simplex.Chat.Store.SQLite.Migrations.M20250130_indexes - Simplex.Chat.Store.SQLite.Migrations.M20250227_member_acceptance other-modules: Paths_simplex_chat hs-source-dirs: diff --git a/src/Simplex/Chat/Library/Commands.hs b/src/Simplex/Chat/Library/Commands.hs index b0d9c87a3c..f066ea26c3 100644 --- a/src/Simplex/Chat/Library/Commands.hs +++ b/src/Simplex/Chat/Library/Commands.hs @@ -543,12 +543,12 @@ processChatCommand' vr = \case mapM_ assertNoMentions cms withContactLock "sendMessage" chatId $ sendContactContentMessages user chatId live itemTTL (L.map composedMessageReq cms) - SRGroup chatId directMemberId -> + SRGroup chatId directMemId_ -> withGroupLock "sendMessage" chatId $ do (gInfo, cmrs) <- withFastStore $ \db -> do g <- getGroupInfo db vr user chatId (g,) <$> mapM (composedMessageReqMentions db user g) cms - sendGroupContentMessages user gInfo directMemberId live itemTTL cmrs + sendGroupContentMessages user gInfo directMemId_ live itemTTL cmrs APICreateChatTag (ChatTagData emoji text) -> withUser $ \user -> withFastStore' $ \db -> do _ <- createChatTag db user emoji text CRChatTags user <$> getUserChatTags db user @@ -583,7 +583,7 @@ processChatCommand' vr = \case cm = ComposedMessage {fileSource = Nothing, quotedItemId = Just reportedItemId, msgContent = mc, mentions = M.empty} when (null ms') $ throwChatError $ CECommandError "no moderators support receiving reports" let numFileInvs = length $ filter memberCurrent ms' - sendGroupContentMessages_ user gInfo ms' numFileInvs False Nothing [composedMessageReq cm] + sendGroupContentMessages_ user gInfo Nothing ms' numFileInvs False Nothing [composedMessageReq cm] where compatibleModerator GroupMember {activeConn, memberChatVRange} = maxVersion (maybe memberChatVRange peerChatVRange activeConn) >= contentReportsVersion @@ -1923,7 +1923,7 @@ processChatCommand' vr = \case combineResults _ _ (Left e) = Left e createCI :: DB.Connection -> User -> UTCTime -> (Contact, SndMessage) -> IO () createCI db user createdAt (ct, sndMsg) = - void $ createNewSndChatItem db user (CDDirectSnd ct) sndMsg (CISndMsgContent mc) Nothing Nothing Nothing False createdAt + void $ createNewSndChatItem db user (CDDirectSnd ct) Nothing sndMsg (CISndMsgContent mc) Nothing Nothing Nothing False createdAt SendMessageQuote cName (AMsgDirection msgDir) quotedMsg msg -> withUser $ \user@User {userId} -> do contactId <- withFastStore $ \db -> getContactIdByName db user cName quotedItemId <- withFastStore $ \db -> getDirectChatItemIdByText db userId contactId msgDir quotedMsg @@ -2087,7 +2087,7 @@ processChatCommand' vr = \case let events = L.map (\GroupMember {memberId} -> XGrpMemRole memberId newRole) memsToChange' (msgs_, _gsr) <- sendGroupMessages user gInfo members events let itemsData = zipWith (fmap . sndItemData) memsToChange (L.toList msgs_) - cis_ <- saveSndChatItems user (CDGroupSnd gInfo) itemsData Nothing False + cis_ <- saveSndChatItems user (CDGroupSnd gInfo) Nothing itemsData Nothing False when (length cis_ /= length memsToChange) $ logError "changeRoleCurrentMems: memsToChange and cis_ length mismatch" (errs, changed) <- lift $ partitionEithers <$> withStoreBatch' (\db -> map (updMember db) memsToChange) let acis = map (AChatItem SCTGroup SMDSnd (GroupChat gInfo)) $ rights cis_ @@ -2097,7 +2097,7 @@ processChatCommand' vr = \case sndItemData GroupMember {groupMemberId, memberProfile} msg = let content = CISndGroupEvent $ SGEMemberRole groupMemberId (fromLocalProfile memberProfile) newRole ts = ciContentTexts content - in NewSndChatItemData msg content ts M.empty Nothing Nothing Nothing + in NewSndChatItemData msg content ts M.empty Nothing Nothing Nothing updMember db m = do updateGroupMemberRole db user m newRole pure (m :: GroupMember) {memberRole = newRole} @@ -2129,7 +2129,7 @@ processChatCommand' vr = \case events = L.map (\GroupMember {memberId} -> XGrpMemRestrict memberId MemberRestrictions {restriction = mrs}) blockMems' (msgs_, _gsr) <- sendGroupMessages user gInfo remainingMems events let itemsData = zipWith (fmap . sndItemData) blockMems (L.toList msgs_) - cis_ <- saveSndChatItems user (CDGroupSnd gInfo) itemsData Nothing False + cis_ <- saveSndChatItems user (CDGroupSnd gInfo) Nothing itemsData Nothing False when (length cis_ /= length blockMems) $ logError "blockMembers: blockMems and cis_ length mismatch" let acis = map (AChatItem SCTGroup SMDSnd (GroupChat gInfo)) $ rights cis_ unless (null acis) $ toView $ CRNewChatItems user acis @@ -2143,7 +2143,7 @@ processChatCommand' vr = \case sndItemData GroupMember {groupMemberId, memberProfile} msg = let content = CISndGroupEvent $ SGEMemberBlocked groupMemberId (fromLocalProfile memberProfile) blockFlag ts = ciContentTexts content - in NewSndChatItemData msg content ts M.empty Nothing Nothing Nothing + in NewSndChatItemData msg content ts M.empty Nothing Nothing Nothing APIRemoveMembers groupId memberIds -> withUser $ \user -> withGroupLock "removeMembers" groupId . procCmd $ do g@(Group gInfo members) <- withFastStore $ \db -> getGroup db vr user groupId @@ -2185,7 +2185,7 @@ processChatCommand' vr = \case let events = L.map (\GroupMember {memberId} -> XGrpMemDel memberId) memsToDelete' (msgs_, _gsr) <- sendGroupMessages user gInfo members events let itemsData = zipWith (fmap . sndItemData) memsToDelete (L.toList msgs_) - cis_ <- saveSndChatItems user (CDGroupSnd gInfo) itemsData Nothing False + cis_ <- saveSndChatItems user (CDGroupSnd gInfo) Nothing itemsData Nothing False when (length cis_ /= length memsToDelete) $ logError "deleteCurrentMems: memsToDelete and cis_ length mismatch" deleteMembersConnections' user memsToDelete True (errs, deleted) <- lift $ partitionEithers <$> withStoreBatch' (\db -> map (delMember db) memsToDelete) @@ -2196,7 +2196,7 @@ processChatCommand' vr = \case sndItemData GroupMember {groupMemberId, memberProfile} msg = let content = CISndGroupEvent $ SGEMemberDeleted groupMemberId (fromLocalProfile memberProfile) ts = ciContentTexts content - in NewSndChatItemData msg content ts M.empty Nothing Nothing Nothing + in NewSndChatItemData msg content ts M.empty Nothing Nothing Nothing delMember db m = do deleteOrUpdateMemberRecordIO db user m pure m {memberStatus = GSMemRemoved} @@ -3129,7 +3129,7 @@ processChatCommand' vr = \case msgs_ <- sendDirectContactMessages user ct $ L.map XMsgNew msgContainers let itemsData = prepareSndItemsData (L.toList cmrs) (L.toList ciFiles_) (L.toList quotedItems_) msgs_ when (length itemsData /= length cmrs) $ logError "sendContactContentMessages: cmrs and itemsData length mismatch" - r@(_, cis) <- partitionEithers <$> saveSndChatItems user (CDDirectSnd ct) itemsData timed_ live + r@(_, cis) <- partitionEithers <$> saveSndChatItems user (CDDirectSnd ct) Nothing itemsData timed_ live processSendErrs user r forM_ (timed_ >>= timedDeleteAt') $ \deleteAt -> forM_ cis $ \ci -> @@ -3166,20 +3166,20 @@ processChatCommand' vr = \case quoteData ChatItem {content = CIRcvMsgContent qmc} = pure (qmc, CIQDirectRcv, False) quoteData _ = throwError SEInvalidQuote sendGroupContentMessages :: User -> GroupInfo -> Maybe GroupMemberId -> Bool -> Maybe Int -> NonEmpty ComposedMessageReq -> CM ChatResponse - sendGroupContentMessages user gInfo@GroupInfo {membership} directMemberId live itemTTL cmrs = do + sendGroupContentMessages user gInfo@GroupInfo {membership} directMemId_ live itemTTL cmrs = do assertMultiSendable live cmrs - (ms, numFileInvs) <- case directMemberId of + (ms, numFileInvs, notInHistory_) <- case directMemId_ of Nothing -> do ms <- withFastStore' $ \db -> getGroupMembers db vr user gInfo - pure (ms, length $ filter memberCurrent ms) + pure (ms, length $ filter memberCurrent ms, Nothing) Just dmId -> do when (dmId == groupMemberId' membership) $ throwChatError $ CECommandError "cannot send to self" dm <- withFastStore $ \db -> getGroupMemberById db vr user dmId unless (memberStatus dm == GSMemPendingApproval) $ throwChatError $ CECommandError "cannot send directly to member not pending approval" - pure ([dm], 1) - sendGroupContentMessages_ user gInfo ms numFileInvs live itemTTL cmrs - sendGroupContentMessages_ :: User -> GroupInfo -> [GroupMember] -> Int -> Bool -> Maybe Int -> NonEmpty ComposedMessageReq -> CM ChatResponse - sendGroupContentMessages_ user gInfo@GroupInfo {groupId, membership} ms numFileInvs live itemTTL cmrs = do + pure ([dm], 1, Just NotInHistory) + sendGroupContentMessages_ user gInfo notInHistory_ ms numFileInvs live itemTTL cmrs + sendGroupContentMessages_ :: User -> GroupInfo -> Maybe NotInHistory -> [GroupMember] -> Int -> Bool -> Maybe Int -> NonEmpty ComposedMessageReq -> CM ChatResponse + sendGroupContentMessages_ user gInfo@GroupInfo {groupId, membership} notInHistory_ ms numFileInvs live itemTTL cmrs = do -- TODO [knocking] pass GroupSndScope? let allowedRole = case ms of [m] | memberCategory m == GCHostMember && memberStatus membership == GSMemPendingApproval -> GRObserver @@ -3206,7 +3206,7 @@ processChatCommand' vr = \case (chatMsgEvents, quotedItems_) <- L.unzip <$> prepareMsgs (L.zip cmrs fInvs_) timed_ (msgs_, gsr) <- sendGroupMessages user gInfo ms chatMsgEvents let itemsData = prepareSndItemsData (L.toList cmrs) (L.toList ciFiles_) (L.toList quotedItems_) (L.toList msgs_) - cis_ <- saveSndChatItems user (CDGroupSnd gInfo) itemsData timed_ live + cis_ <- saveSndChatItems user (CDGroupSnd gInfo) notInHistory_ itemsData timed_ live when (length cis_ /= length cmrs) $ logError "sendGroupContentMessages: cmrs and cis_ length mismatch" createMemberSndStatuses cis_ msgs_ gsr let r@(_, cis) = partitionEithers cis_ diff --git a/src/Simplex/Chat/Library/Internal.hs b/src/Simplex/Chat/Library/Internal.hs index d2a6d42140..b8aedbebbd 100644 --- a/src/Simplex/Chat/Library/Internal.hs +++ b/src/Simplex/Chat/Library/Internal.hs @@ -1824,7 +1824,7 @@ saveSndChatItem user cd msg content = saveSndChatItem' user cd msg content Nothi saveSndChatItem' :: ChatTypeI c => User -> ChatDirection c 'MDSnd -> SndMessage -> CIContent 'MDSnd -> Maybe (CIFile 'MDSnd) -> Maybe (CIQuote c) -> Maybe CIForwardedFrom -> Maybe CITimed -> Bool -> CM (ChatItem c 'MDSnd) saveSndChatItem' user cd msg content ciFile quotedItem itemForwarded itemTimed live = do let itemTexts = ciContentTexts content - saveSndChatItems user cd [Right NewSndChatItemData {msg, content, itemTexts, itemMentions = M.empty, ciFile, quotedItem, itemForwarded}] itemTimed live >>= \case + saveSndChatItems user cd Nothing [Right NewSndChatItemData {msg, content, itemTexts, itemMentions = M.empty, ciFile, quotedItem, itemForwarded}] itemTimed live >>= \case [Right ci] -> pure ci _ -> throwChatError $ CEInternalError "saveSndChatItem': expected 1 item" @@ -1843,11 +1843,12 @@ saveSndChatItems :: ChatTypeI c => User -> ChatDirection c 'MDSnd -> + Maybe NotInHistory -> [Either ChatError (NewSndChatItemData c)] -> Maybe CITimed -> Bool -> CM [Either ChatError (ChatItem c 'MDSnd)] -saveSndChatItems user cd itemsData itemTimed live = do +saveSndChatItems user cd notInHistory_ itemsData itemTimed live = do createdAt <- liftIO getCurrentTime when (contactChatDeleted cd || any (\NewSndChatItemData {content} -> ciRequiresAttention content) (rights itemsData)) $ withStore' (\db -> updateChatTs db user cd createdAt) @@ -1855,7 +1856,7 @@ saveSndChatItems user cd itemsData itemTimed live = do where createItem :: DB.Connection -> UTCTime -> NewSndChatItemData c -> IO (Either ChatError (ChatItem c 'MDSnd)) createItem db createdAt NewSndChatItemData {msg = msg@SndMessage {sharedMsgId}, content, itemTexts, itemMentions, ciFile, quotedItem, itemForwarded} = do - ciId <- createNewSndChatItem db user cd msg content quotedItem itemForwarded itemTimed live createdAt + ciId <- createNewSndChatItem db user cd notInHistory_ msg content quotedItem itemForwarded itemTimed live createdAt forM_ ciFile $ \CIFile {fileId} -> updateFileTransferChatItemId db fileId ciId createdAt let ci = mkChatItem_ cd ciId content itemTexts ciFile quotedItem (Just sharedMsgId) itemForwarded itemTimed live False createdAt Nothing createdAt Right <$> case cd of @@ -1867,13 +1868,13 @@ saveRcvChatItemNoParse user cd msg brokerTs = saveRcvChatItem user cd msg broker saveRcvChatItem :: (ChatTypeI c, ChatTypeQuotable c) => User -> ChatDirection c 'MDRcv -> RcvMessage -> UTCTime -> (CIContent 'MDRcv, (Text, Maybe MarkdownList)) -> CM (ChatItem c 'MDRcv) saveRcvChatItem user cd msg@RcvMessage {sharedMsgId_} brokerTs content = - saveRcvChatItem' user cd msg sharedMsgId_ brokerTs content Nothing Nothing False M.empty + saveRcvChatItem' user cd Nothing msg sharedMsgId_ brokerTs content Nothing Nothing False M.empty ciContentNoParse :: CIContent 'MDRcv -> (CIContent 'MDRcv, (Text, Maybe MarkdownList)) ciContentNoParse content = (content, (ciContentToText content, Nothing)) -saveRcvChatItem' :: (ChatTypeI c, ChatTypeQuotable c) => User -> ChatDirection c 'MDRcv -> RcvMessage -> Maybe SharedMsgId -> UTCTime -> (CIContent 'MDRcv, (Text, Maybe MarkdownList)) -> Maybe (CIFile 'MDRcv) -> Maybe CITimed -> Bool -> Map MemberName MsgMention -> CM (ChatItem c 'MDRcv) -saveRcvChatItem' user cd msg@RcvMessage {chatMsgEvent, forwardedByMember} sharedMsgId_ brokerTs (content, (t, ft_)) ciFile itemTimed live mentions = do +saveRcvChatItem' :: (ChatTypeI c, ChatTypeQuotable c) => User -> ChatDirection c 'MDRcv -> Maybe NotInHistory -> RcvMessage -> Maybe SharedMsgId -> UTCTime -> (CIContent 'MDRcv, (Text, Maybe MarkdownList)) -> Maybe (CIFile 'MDRcv) -> Maybe CITimed -> Bool -> Map MemberName MsgMention -> CM (ChatItem c 'MDRcv) +saveRcvChatItem' user cd notInHistory_ msg@RcvMessage {chatMsgEvent, forwardedByMember} sharedMsgId_ brokerTs (content, (t, ft_)) ciFile itemTimed live mentions = do createdAt <- liftIO getCurrentTime withStore' $ \db -> do when (ciRequiresAttention content || contactChatDeleted cd) $ updateChatTs db user cd createdAt @@ -1886,7 +1887,7 @@ saveRcvChatItem' user cd msg@RcvMessage {chatMsgEvent, forwardedByMember} shared userMention' = userReply || any (\CIMention {memberId} -> sameMemberId memberId membership) mentions' in pure (mentions', userMention') CDDirectRcv _ -> pure (M.empty, False) - (ciId, quotedItem, itemForwarded) <- createNewRcvChatItem db user cd msg sharedMsgId_ content itemTimed live userMention brokerTs createdAt + (ciId, quotedItem, itemForwarded) <- createNewRcvChatItem db user cd notInHistory_ msg sharedMsgId_ content itemTimed live userMention brokerTs createdAt forM_ ciFile $ \CIFile {fileId} -> updateFileTransferChatItemId db fileId ciId createdAt let ci = mkChatItem_ cd ciId content (t, ft_) ciFile quotedItem sharedMsgId_ itemForwarded itemTimed live userMention brokerTs forwardedByMember createdAt case cd of @@ -2132,7 +2133,7 @@ createLocalChatItems user cd itemsData createdAt = do where createItem :: DB.Connection -> (CIContent 'MDSnd, Maybe (CIFile 'MDSnd), Maybe CIForwardedFrom, (Text, Maybe MarkdownList)) -> IO (ChatItem 'CTLocal 'MDSnd) createItem db (content, ciFile, itemForwarded, ts) = do - ciId <- createNewChatItem_ db user cd Nothing Nothing content (Nothing, Nothing, Nothing, Nothing, Nothing) itemForwarded Nothing False False createdAt Nothing createdAt + ciId <- createNewChatItem_ db user cd Nothing Nothing Nothing content (Nothing, Nothing, Nothing, Nothing, Nothing) itemForwarded Nothing False False createdAt Nothing createdAt forM_ ciFile $ \CIFile {fileId} -> updateFileTransferChatItemId db fileId ciId createdAt pure $ mkChatItem_ cd ciId content ts ciFile Nothing Nothing itemForwarded Nothing False False createdAt Nothing createdAt diff --git a/src/Simplex/Chat/Library/Subscriber.hs b/src/Simplex/Chat/Library/Subscriber.hs index 90dc5b8d1a..e06c5d0d85 100644 --- a/src/Simplex/Chat/Library/Subscriber.hs +++ b/src/Simplex/Chat/Library/Subscriber.hs @@ -1450,7 +1450,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = where brokerTs = metaBrokerTs msgMeta newChatItem content ciFile_ timed_ live = do - ci <- saveRcvChatItem' user (CDDirectRcv ct) msg sharedMsgId_ brokerTs content ciFile_ timed_ live M.empty + ci <- saveRcvChatItem' user (CDDirectRcv ct) Nothing msg sharedMsgId_ brokerTs content ciFile_ timed_ live M.empty reactions <- maybe (pure []) (\sharedMsgId -> withStore' $ \db -> getDirectCIReactions db ct sharedMsgId) sharedMsgId_ toView $ CRNewChatItems user [AChatItem SCTDirect SMDRcv (DirectChat ct) ci {reactions}] @@ -1517,7 +1517,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = -- Chat item and update message which created it will have different sharedMsgId in this case... let timed_ = rcvContactCITimed ct ttl ts = ciContentTexts content - ci <- saveRcvChatItem' user (CDDirectRcv ct) msg (Just sharedMsgId) brokerTs (content, ts) Nothing timed_ live M.empty + ci <- saveRcvChatItem' user (CDDirectRcv ct) Nothing msg (Just sharedMsgId) brokerTs (content, ts) Nothing timed_ live M.empty ci' <- withStore' $ \db -> do createChatItemVersion db (chatItemId' ci) brokerTs mc updateDirectChatItem' db user contactId ci content True live Nothing Nothing @@ -1634,10 +1634,11 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = live' = fromMaybe False live_ ExtMsgContent content mentions fInv_ itemTTL live_ = mcExtMsgContent mc ts@(_, ft_) = msgContentTexts content + saveRcvCI = saveRcvChatItem' user (CDGroupRcv gInfo m) (memberNotInHistory m) msg sharedMsgId_ brokerTs createBlockedByAdmin | groupFeatureAllowed SGFFullDelete gInfo = do -- ignores member role when blocked by admin - ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg sharedMsgId_ brokerTs (ciContentNoParse CIRcvBlocked) Nothing timed' False M.empty + ci <- saveRcvCI (ciContentNoParse CIRcvBlocked) Nothing timed' False M.empty ci' <- withStore' $ \db -> updateGroupCIBlockedByAdmin db user gInfo ci brokerTs groupMsgToView gInfo ci' | otherwise = do @@ -1649,7 +1650,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = | moderatorRole < GRModerator || moderatorRole < memberRole = createContentItem | groupFeatureMemberAllowed SGFFullDelete moderator gInfo = do - ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg sharedMsgId_ brokerTs (ciContentNoParse CIRcvModerated) Nothing timed' False M.empty + ci <- saveRcvCI (ciContentNoParse CIRcvModerated) Nothing timed' False M.empty ci' <- withStore' $ \db -> updateGroupChatItemModerated db user gInfo ci moderator moderatedAt groupMsgToView gInfo ci' | otherwise = do @@ -1657,7 +1658,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = ci <- createNonLive file_ toView =<< markGroupCIsDeleted user gInfo [CChatItem SMDRcv ci] False (Just moderator) moderatedAt createNonLive file_ = - saveRcvChatItem' user (CDGroupRcv gInfo m) msg sharedMsgId_ brokerTs (CIRcvMsgContent content, ts) (snd <$> file_) timed' False mentions + saveRcvCI (CIRcvMsgContent content, ts) (snd <$> file_) timed' False mentions createContentItem = do file_ <- processFileInv newChatItem (CIRcvMsgContent content, ts) (snd <$> file_) timed' live' @@ -1666,7 +1667,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = processFileInvitation fInv_ content $ \db -> createRcvGroupFileTransfer db userId m newChatItem ciContent ciFile_ timed_ live = do let mentions' = if showMessages (memberSettings m) then mentions else [] - ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg sharedMsgId_ brokerTs ciContent ciFile_ timed_ live mentions' + ci <- saveRcvCI ciContent ciFile_ timed_ live mentions' ci' <- blockedMember m ci $ withStore' $ \db -> markGroupChatItemBlocked db user gInfo ci reactions <- maybe (pure []) (\sharedMsgId -> withStore' $ \db -> getGroupCIReactions db gInfo memberId sharedMsgId) sharedMsgId_ groupMsgToView gInfo ci' {reactions} @@ -1682,7 +1683,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = -- Chat item and update message which created it will have different sharedMsgId in this case... let timed_ = rcvGroupCITimed gInfo ttl_ mentions' = if showMessages (memberSettings m) then mentions else [] - ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg (Just sharedMsgId) brokerTs (content, ts) Nothing timed_ live mentions' + ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) (memberNotInHistory m) msg (Just sharedMsgId) brokerTs (content, ts) Nothing timed_ live mentions' ci' <- withStore' $ \db -> do createChatItemVersion db (chatItemId' ci) brokerTs mc ci' <- updateGroupChatItem db user groupId ci content True live Nothing @@ -1715,6 +1716,11 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = else messageError "x.msg.update: group member attempted to update a message of another member" _ -> messageError "x.msg.update: group member attempted invalid message update" + memberNotInHistory :: GroupMember -> Maybe NotInHistory + memberNotInHistory = \case + GroupMember {memberStatus = GSMemPendingApproval} -> Just NotInHistory + _ -> Nothing + groupMessageDelete :: GroupInfo -> GroupMember -> SharedMsgId -> Maybe MemberId -> RcvMessage -> UTCTime -> CM () groupMessageDelete gInfo@GroupInfo {membership} m@GroupMember {memberId, memberRole = senderRole} sharedMsgId sndMemberId_ RcvMessage {msgId} brokerTs = do let msgMemberId = fromMaybe memberId sndMemberId_ @@ -1770,7 +1776,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = let fileProtocol = if isJust xftpRcvFile then FPXFTP else FPSMP ciFile = Just $ CIFile {fileId, fileName, fileSize, fileSource = Nothing, fileStatus = CIFSRcvInvitation, fileProtocol} content = ciContentNoParse $ CIRcvMsgContent $ MCFile "" - ci <- saveRcvChatItem' user (CDDirectRcv ct) msg sharedMsgId_ brokerTs content ciFile Nothing False M.empty + ci <- saveRcvChatItem' user (CDDirectRcv ct) Nothing msg sharedMsgId_ brokerTs content ciFile Nothing False M.empty toView $ CRNewChatItems user [AChatItem SCTDirect SMDRcv (DirectChat ct) ci] where brokerTs = metaBrokerTs msgMeta @@ -1784,7 +1790,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = let fileProtocol = if isJust xftpRcvFile then FPXFTP else FPSMP ciFile = Just $ CIFile {fileId, fileName, fileSize, fileSource = Nothing, fileStatus = CIFSRcvInvitation, fileProtocol} content = ciContentNoParse $ CIRcvMsgContent $ MCFile "" - ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg sharedMsgId_ brokerTs content ciFile Nothing False M.empty + ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) Nothing msg sharedMsgId_ brokerTs content ciFile Nothing False M.empty ci' <- blockedMember m ci $ withStore' $ \db -> markGroupChatItemBlocked db user gInfo ci groupMsgToView gInfo ci' @@ -2215,7 +2221,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = saveCallItem status = saveRcvChatItemNoParse user (CDDirectRcv ct) msg brokerTs (CIRcvCall status 0) featureRejected f = do let content = ciContentNoParse $ CIRcvChatFeatureRejected f - ci <- saveRcvChatItem' user (CDDirectRcv ct) msg sharedMsgId_ brokerTs content Nothing Nothing False M.empty + ci <- saveRcvChatItem' user (CDDirectRcv ct) Nothing msg sharedMsgId_ brokerTs content Nothing Nothing False M.empty toView $ CRNewChatItems user [AChatItem SCTDirect SMDRcv (DirectChat ct) ci] -- to party initiating call diff --git a/src/Simplex/Chat/Messages.hs b/src/Simplex/Chat/Messages.hs index 5562f016c9..ae88bc796b 100644 --- a/src/Simplex/Chat/Messages.hs +++ b/src/Simplex/Chat/Messages.hs @@ -162,6 +162,8 @@ data ChatItem (c :: ChatType) (d :: MsgDirection) = ChatItem } deriving (Show) +data NotInHistory = NotInHistory + data CIMention = CIMention { memberId :: MemberId, -- member record can be created later than the mention is received diff --git a/src/Simplex/Chat/Store/Messages.hs b/src/Simplex/Chat/Store/Messages.hs index 06bebda62b..00158e0054 100644 --- a/src/Simplex/Chat/Store/Messages.hs +++ b/src/Simplex/Chat/Store/Messages.hs @@ -142,7 +142,7 @@ import Data.List.NonEmpty (NonEmpty) import qualified Data.List.NonEmpty as L import Data.Map.Strict (Map) import qualified Data.Map.Strict as M -import Data.Maybe (catMaybes, fromMaybe, isJust, mapMaybe) +import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing, mapMaybe) import Data.Ord (Down (..), comparing) import Data.Text (Text) import qualified Data.Text as T @@ -372,9 +372,9 @@ updateChatTs db User {userId} chatDirection chatTs = case toChatInfo chatDirecti (chatTs, userId, noteFolderId) _ -> pure () -createNewSndChatItem :: DB.Connection -> User -> ChatDirection c 'MDSnd -> SndMessage -> CIContent 'MDSnd -> Maybe (CIQuote c) -> Maybe CIForwardedFrom -> Maybe CITimed -> Bool -> UTCTime -> IO ChatItemId -createNewSndChatItem db user chatDirection SndMessage {msgId, sharedMsgId} ciContent quotedItem itemForwarded timed live createdAt = - createNewChatItem_ db user chatDirection createdByMsgId (Just sharedMsgId) ciContent quoteRow itemForwarded timed live False createdAt Nothing createdAt +createNewSndChatItem :: DB.Connection -> User -> ChatDirection c 'MDSnd -> Maybe NotInHistory -> SndMessage -> CIContent 'MDSnd -> Maybe (CIQuote c) -> Maybe CIForwardedFrom -> Maybe CITimed -> Bool -> UTCTime -> IO ChatItemId +createNewSndChatItem db user chatDirection notInHistory_ SndMessage {msgId, sharedMsgId} ciContent quotedItem itemForwarded timed live createdAt = + createNewChatItem_ db user chatDirection notInHistory_ createdByMsgId (Just sharedMsgId) ciContent quoteRow itemForwarded timed live False createdAt Nothing createdAt where createdByMsgId = if msgId == 0 then Nothing else Just msgId quoteRow :: NewQuoteRow @@ -388,9 +388,9 @@ createNewSndChatItem db user chatDirection SndMessage {msgId, sharedMsgId} ciCon CIQGroupRcv (Just GroupMember {memberId}) -> (Just False, Just memberId) CIQGroupRcv Nothing -> (Just False, Nothing) -createNewRcvChatItem :: ChatTypeQuotable c => DB.Connection -> User -> ChatDirection c 'MDRcv -> RcvMessage -> Maybe SharedMsgId -> CIContent 'MDRcv -> Maybe CITimed -> Bool -> Bool -> UTCTime -> UTCTime -> IO (ChatItemId, Maybe (CIQuote c), Maybe CIForwardedFrom) -createNewRcvChatItem db user chatDirection RcvMessage {msgId, chatMsgEvent, forwardedByMember} sharedMsgId_ ciContent timed live userMention itemTs createdAt = do - ciId <- createNewChatItem_ db user chatDirection (Just msgId) sharedMsgId_ ciContent quoteRow itemForwarded timed live userMention itemTs forwardedByMember createdAt +createNewRcvChatItem :: ChatTypeQuotable c => DB.Connection -> User -> ChatDirection c 'MDRcv -> Maybe NotInHistory -> RcvMessage -> Maybe SharedMsgId -> CIContent 'MDRcv -> Maybe CITimed -> Bool -> Bool -> UTCTime -> UTCTime -> IO (ChatItemId, Maybe (CIQuote c), Maybe CIForwardedFrom) +createNewRcvChatItem db user chatDirection notInHistory_ RcvMessage {msgId, chatMsgEvent, forwardedByMember} sharedMsgId_ ciContent timed live userMention itemTs createdAt = do + ciId <- createNewChatItem_ db user chatDirection notInHistory_ (Just msgId) sharedMsgId_ ciContent quoteRow itemForwarded timed live userMention itemTs forwardedByMember createdAt quotedItem <- mapM (getChatItemQuote_ db user chatDirection) quotedMsg pure (ciId, quotedItem, itemForwarded) where @@ -407,13 +407,13 @@ createNewRcvChatItem db user chatDirection RcvMessage {msgId, chatMsgEvent, forw createNewChatItemNoMsg :: forall c d. MsgDirectionI d => DB.Connection -> User -> ChatDirection c d -> CIContent d -> UTCTime -> UTCTime -> IO ChatItemId createNewChatItemNoMsg db user chatDirection ciContent itemTs = - createNewChatItem_ db user chatDirection Nothing Nothing ciContent quoteRow Nothing Nothing False False itemTs Nothing + createNewChatItem_ db user chatDirection Nothing Nothing Nothing ciContent quoteRow Nothing Nothing False False itemTs Nothing where quoteRow :: NewQuoteRow quoteRow = (Nothing, Nothing, Nothing, Nothing, Nothing) -createNewChatItem_ :: forall c d. MsgDirectionI d => DB.Connection -> User -> ChatDirection c d -> Maybe MessageId -> Maybe SharedMsgId -> CIContent d -> NewQuoteRow -> Maybe CIForwardedFrom -> Maybe CITimed -> Bool -> Bool -> UTCTime -> Maybe GroupMemberId -> UTCTime -> IO ChatItemId -createNewChatItem_ db User {userId} chatDirection msgId_ sharedMsgId ciContent quoteRow itemForwarded timed live userMention itemTs forwardedByMember createdAt = do +createNewChatItem_ :: forall c d. MsgDirectionI d => DB.Connection -> User -> ChatDirection c d -> Maybe NotInHistory -> Maybe MessageId -> Maybe SharedMsgId -> CIContent d -> NewQuoteRow -> Maybe CIForwardedFrom -> Maybe CITimed -> Bool -> Bool -> UTCTime -> Maybe GroupMemberId -> UTCTime -> IO ChatItemId +createNewChatItem_ db User {userId} chatDirection notInHistory_ msgId_ sharedMsgId ciContent quoteRow itemForwarded timed live userMention itemTs forwardedByMember createdAt = do DB.execute db [sql| @@ -448,7 +448,7 @@ createNewChatItem_ db User {userId} chatDirection msgId_ sharedMsgId ciContent q includeInHistory :: Bool includeInHistory = let (_, groupId_, _, _) = idsRow - in isJust groupId_ && isJust (ciMsgContent ciContent) && ((msgContentTag <$> ciMsgContent ciContent) /= Just MCReport_) + in isJust groupId_ && isNothing notInHistory_ && isJust (ciMsgContent ciContent) && ((msgContentTag <$> ciMsgContent ciContent) /= Just MCReport_) forwardedFromRow :: (Maybe CIForwardedFromTag, Maybe Text, Maybe MsgDirection, Maybe Int64, Maybe Int64, Maybe Int64) forwardedFromRow = case itemForwarded of Nothing -> @@ -3138,10 +3138,9 @@ getGroupSndStatusCounts db itemId = |] (Only itemId) --- TODO [knocking] Better filter than `i.group_member_id != ? ... OR ... i.group_member_id IS NULL`? --- TODO Plan would be better if we could base it on single check. +-- TODO [knocking] filter out messages sent to member only getGroupHistoryItems :: DB.Connection -> User -> GroupInfo -> GroupMember -> Int -> IO [Either StoreError (CChatItem 'CTGroup)] -getGroupHistoryItems db user@User {userId} g@GroupInfo {groupId} GroupMember {groupMemberId} count = do +getGroupHistoryItems db user@User {userId} g@GroupInfo {groupId} m count = do ciIds <- getLastItemIds_ reverse <$> mapM (runExceptT . getGroupCIWithReactions db user g) ciIds where @@ -3150,25 +3149,15 @@ getGroupHistoryItems db user@User {userId} g@GroupInfo {groupId} GroupMember {gr map fromOnly <$> DB.query db - -- `i.group_member_id != ?` check is to exclude messages received from pending approval member [sql| SELECT i.chat_item_id FROM chat_items i LEFT JOIN group_snd_item_statuses s ON s.chat_item_id = i.chat_item_id AND s.group_member_id = ? - WHERE - ( s.group_snd_item_status_id IS NULL - AND i.user_id = ? AND i.group_id = ? - AND i.include_in_history = 1 - AND i.item_deleted = 0 - AND i.group_member_id != ? - ) OR - ( s.group_snd_item_status_id IS NULL - AND i.user_id = ? AND i.group_id = ? - AND i.include_in_history = 1 - AND i.item_deleted = 0 - AND i.group_member_id IS NULL - ) + WHERE s.group_snd_item_status_id IS NULL + AND i.user_id = ? AND i.group_id = ? + AND i.include_in_history = 1 + AND i.item_deleted = 0 ORDER BY i.item_ts DESC, i.chat_item_id DESC LIMIT ? |] - (groupMemberId, userId, groupId, groupMemberId, userId, groupId, count) + (groupMemberId' m, userId, groupId, count) diff --git a/src/Simplex/Chat/Store/Postgres/Migrations.hs b/src/Simplex/Chat/Store/Postgres/Migrations.hs index cc8bc630e0..285a952279 100644 --- a/src/Simplex/Chat/Store/Postgres/Migrations.hs +++ b/src/Simplex/Chat/Store/Postgres/Migrations.hs @@ -5,13 +5,11 @@ module Simplex.Chat.Store.Postgres.Migrations (migrations) where import Data.List (sortOn) import Data.Text (Text) import Simplex.Chat.Store.Postgres.Migrations.M20241220_initial -import Simplex.Chat.Store.Postgres.Migrations.M20250227_member_acceptance import Simplex.Messaging.Agent.Store.Shared (Migration (..)) schemaMigrations :: [(String, Text, Maybe Text)] schemaMigrations = - [ ("20241220_initial", m20241220_initial, Nothing), - ("20250227_member_acceptance", m20250227_member_acceptance, Just down_m20250227_member_acceptance) + [ ("20241220_initial", m20241220_initial, Nothing) ] -- | The list of migrations in ascending order by date diff --git a/src/Simplex/Chat/Store/Postgres/Migrations/M20250227_member_acceptance.hs b/src/Simplex/Chat/Store/Postgres/Migrations/M20250227_member_acceptance.hs deleted file mode 100644 index 40d38ef4bc..0000000000 --- a/src/Simplex/Chat/Store/Postgres/Migrations/M20250227_member_acceptance.hs +++ /dev/null @@ -1,38 +0,0 @@ -{-# LANGUAGE QuasiQuotes #-} - -module Simplex.Chat.Store.Postgres.Migrations.M20250227_member_acceptance where - -import Data.Text (Text) -import qualified Data.Text as T -import Text.RawString.QQ (r) - -m20250227_member_acceptance :: Text -m20250227_member_acceptance = - T.pack - [r| -DROP INDEX idx_chat_items_groups_history; -CREATE INDEX idx_chat_items_groups_history ON chat_items( - user_id, - group_id, - include_in_history, - item_deleted, - group_member_id, - item_ts, - chat_item_id -); -|] - -down_m20250227_member_acceptance :: Text -down_m20250227_member_acceptance = - T.pack - [r| -DROP INDEX idx_chat_items_groups_history; -CREATE INDEX idx_chat_items_groups_history ON chat_items( - user_id, - group_id, - include_in_history, - item_deleted, - item_ts, - chat_item_id -); -|] diff --git a/src/Simplex/Chat/Store/SQLite/Migrations.hs b/src/Simplex/Chat/Store/SQLite/Migrations.hs index 3e7a326f67..5865cd180e 100644 --- a/src/Simplex/Chat/Store/SQLite/Migrations.hs +++ b/src/Simplex/Chat/Store/SQLite/Migrations.hs @@ -128,7 +128,6 @@ import Simplex.Chat.Store.SQLite.Migrations.M20250122_chat_items_include_in_hist import Simplex.Chat.Store.SQLite.Migrations.M20250126_mentions import Simplex.Chat.Store.SQLite.Migrations.M20250129_delete_unused_contacts import Simplex.Chat.Store.SQLite.Migrations.M20250130_indexes -import Simplex.Chat.Store.SQLite.Migrations.M20250227_member_acceptance import Simplex.Messaging.Agent.Store.Shared (Migration (..)) schemaMigrations :: [(String, Query, Maybe Query)] @@ -256,8 +255,7 @@ schemaMigrations = ("20250122_chat_items_include_in_history", m20250122_chat_items_include_in_history, Just down_m20250122_chat_items_include_in_history), ("20250126_mentions", m20250126_mentions, Just down_m20250126_mentions), ("20250129_delete_unused_contacts", m20250129_delete_unused_contacts, Just down_m20250129_delete_unused_contacts), - ("20250130_indexes", m20250130_indexes, Just down_m20250130_indexes), - ("20250227_member_acceptance", m20250227_member_acceptance, Just down_m20250227_member_acceptance) + ("20250130_indexes", m20250130_indexes, Just down_m20250130_indexes) ] -- | The list of migrations in ascending order by date diff --git a/src/Simplex/Chat/Store/SQLite/Migrations/M20250227_member_acceptance.hs b/src/Simplex/Chat/Store/SQLite/Migrations/M20250227_member_acceptance.hs deleted file mode 100644 index 6b3f287c7e..0000000000 --- a/src/Simplex/Chat/Store/SQLite/Migrations/M20250227_member_acceptance.hs +++ /dev/null @@ -1,35 +0,0 @@ -{-# LANGUAGE QuasiQuotes #-} - -module Simplex.Chat.Store.SQLite.Migrations.M20250227_member_acceptance where - -import Database.SQLite.Simple (Query) -import Database.SQLite.Simple.QQ (sql) - -m20250227_member_acceptance :: Query -m20250227_member_acceptance = - [sql| -DROP INDEX idx_chat_items_groups_history; -CREATE INDEX idx_chat_items_groups_history ON chat_items( - user_id, - group_id, - include_in_history, - item_deleted, - group_member_id, - item_ts, - chat_item_id -); -|] - -down_m20250227_member_acceptance :: Query -down_m20250227_member_acceptance = - [sql| -DROP INDEX idx_chat_items_groups_history; -CREATE INDEX idx_chat_items_groups_history ON chat_items( - user_id, - group_id, - include_in_history, - item_deleted, - item_ts, - chat_item_id -); -|] diff --git a/src/Simplex/Chat/Store/SQLite/Migrations/chat_query_plans.txt b/src/Simplex/Chat/Store/SQLite/Migrations/chat_query_plans.txt index 1277f92363..88836035e5 100644 --- a/src/Simplex/Chat/Store/SQLite/Migrations/chat_query_plans.txt +++ b/src/Simplex/Chat/Store/SQLite/Migrations/chat_query_plans.txt @@ -483,7 +483,7 @@ Query: LIMIT ? Plan: -SEARCH chat_items USING INDEX idx_chat_items_groups_history (user_id=?) +SEARCH chat_items USING INDEX idx_chat_items_groups_user_mention (user_id=?) USE TEMP B-TREE FOR ORDER BY Query: @@ -494,7 +494,7 @@ Query: LIMIT ? Plan: -SEARCH chat_items USING INDEX idx_chat_items_groups_history (user_id=?) +SEARCH chat_items USING INDEX idx_chat_items_groups_user_mention (user_id=?) USE TEMP B-TREE FOR ORDER BY Query: @@ -541,30 +541,16 @@ Query: SELECT i.chat_item_id FROM chat_items i LEFT JOIN group_snd_item_statuses s ON s.chat_item_id = i.chat_item_id AND s.group_member_id = ? - WHERE - ( s.group_snd_item_status_id IS NULL - AND i.user_id = ? AND i.group_id = ? - AND i.include_in_history = 1 - AND i.item_deleted = 0 - AND i.group_member_id != ? - ) OR - ( s.group_snd_item_status_id IS NULL - AND i.user_id = ? AND i.group_id = ? - AND i.include_in_history = 1 - AND i.item_deleted = 0 - AND i.group_member_id IS NULL - ) + WHERE s.group_snd_item_status_id IS NULL + AND i.user_id = ? AND i.group_id = ? + AND i.include_in_history = 1 + AND i.item_deleted = 0 ORDER BY i.item_ts DESC, i.chat_item_id DESC LIMIT ? Plan: -MULTI-INDEX OR -INDEX 1 SEARCH i USING COVERING INDEX idx_chat_items_groups_history (user_id=? AND group_id=? AND include_in_history=? AND item_deleted=?) -INDEX 2 -SEARCH i USING COVERING INDEX idx_chat_items_groups_history (user_id=? AND group_id=? AND include_in_history=? AND item_deleted=? AND group_member_id=?) SEARCH s USING COVERING INDEX idx_group_snd_item_statuses_chat_item_id_group_member_id (chat_item_id=? AND group_member_id=?) LEFT-JOIN -USE TEMP B-TREE FOR ORDER BY Query: SELECT i.chat_item_id, @@ -991,7 +977,7 @@ Query: LIMIT ? Plan: -SEARCH chat_items USING INDEX idx_chat_items_groups_history (user_id=?) +SEARCH chat_items USING INDEX idx_chat_items_groups_user_mention (user_id=?) USE TEMP B-TREE FOR ORDER BY Query: @@ -4638,7 +4624,7 @@ Query: JOIN files f ON f.chat_item_id = i.chat_item_id WHERE i.user_id = ? Plan: -SEARCH i USING COVERING INDEX idx_chat_items_groups_history (user_id=?) +SEARCH i USING COVERING INDEX idx_chat_items_groups_user_mention (user_id=?) SEARCH f USING INDEX idx_files_chat_item_id (chat_item_id=?) Query: @@ -5261,7 +5247,7 @@ SEARCH protocol_servers USING COVERING INDEX idx_smp_servers_user_id (user_id=?) SEARCH settings USING COVERING INDEX idx_settings_user_id (user_id=?) SEARCH commands USING COVERING INDEX idx_commands_user_id (user_id=?) SEARCH calls USING COVERING INDEX idx_calls_user_id (user_id=?) -SEARCH chat_items USING COVERING INDEX idx_chat_items_groups_history (user_id=?) +SEARCH chat_items USING COVERING INDEX idx_chat_items_groups_user_mention (user_id=?) SEARCH contact_requests USING COVERING INDEX sqlite_autoindex_contact_requests_2 (user_id=?) SEARCH user_contact_links USING COVERING INDEX sqlite_autoindex_user_contact_links_1 (user_id=?) SEARCH connections USING COVERING INDEX idx_connections_group_member (user_id=?) diff --git a/src/Simplex/Chat/Store/SQLite/Migrations/chat_schema.sql b/src/Simplex/Chat/Store/SQLite/Migrations/chat_schema.sql index 45e91a46f8..f4cf2bccb8 100644 --- a/src/Simplex/Chat/Store/SQLite/Migrations/chat_schema.sql +++ b/src/Simplex/Chat/Store/SQLite/Migrations/chat_schema.sql @@ -982,6 +982,14 @@ CREATE INDEX idx_chat_items_groups_msg_content_tag_deleted ON chat_items( item_deleted, item_sent ); +CREATE INDEX idx_chat_items_groups_history ON chat_items( + user_id, + group_id, + include_in_history, + item_deleted, + item_ts, + chat_item_id +); CREATE INDEX idx_group_snd_item_statuses_chat_item_id_group_member_id ON group_snd_item_statuses( chat_item_id, group_member_id @@ -1010,12 +1018,3 @@ CREATE INDEX idx_chat_items_group_id_shared_msg_id ON chat_items( group_id, shared_msg_id ); -CREATE INDEX idx_chat_items_groups_history ON chat_items( - user_id, - group_id, - include_in_history, - item_deleted, - group_member_id, - item_ts, - chat_item_id -);