mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2025-03-14 09:45:42 +00:00
core: delete members with messages (#5711)
* core: delete members with messages (WIP) * remove messages * fix, test * update query plans
This commit is contained in:
Evgeny
GitHub
parent
5bef7349d8
commit
a6631ce629
11 changed files with 302 additions and 92 deletions
|
|
@ -503,8 +503,8 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
|
|||
rejectPendingMember rjctNotice = do
|
||||
let gmId = groupMemberId' m
|
||||
sendComposedMessages cc (SRGroup groupId $ Just gmId) [MCText rjctNotice]
|
||||
sendChatCmd cc (APIRemoveMembers groupId [gmId]) >>= \case
|
||||
CRUserDeletedMembers _ _ (_ : _) -> do
|
||||
sendChatCmd cc (APIRemoveMembers groupId [gmId] False) >>= \case
|
||||
CRUserDeletedMembers _ _ (_ : _) _ -> do
|
||||
atomically $ TM.delete gmId $ pendingCaptchas env
|
||||
logInfo $ "Member " <> viewName displayName <> " rejected, group " <> tshow groupId <> ":" <> viewGroupName g
|
||||
r -> logError $ "unexpected remove member response: " <> tshow r
|
||||
|
|
|
|||
|
|
@ -41,6 +41,7 @@ import Data.List.NonEmpty (NonEmpty)
|
|||
import Data.Map.Strict (Map)
|
||||
import qualified Data.Map.Strict as M
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Data.Set (Set)
|
||||
import Data.String
|
||||
import Data.Text (Text)
|
||||
import Data.Text.Encoding (decodeLatin1)
|
||||
|
|
@ -359,7 +360,7 @@ data ChatCommand
|
|||
| APIAcceptMember GroupId GroupMemberId GroupMemberRole
|
||||
| APIMembersRole GroupId (NonEmpty GroupMemberId) GroupMemberRole
|
||||
| APIBlockMembersForAll GroupId (NonEmpty GroupMemberId) Bool
|
||||
| APIRemoveMembers GroupId (NonEmpty GroupMemberId)
|
||||
| APIRemoveMembers {groupId :: GroupId, groupMemberIds :: Set GroupMemberId, withMessages :: Bool}
|
||||
| APILeaveGroup GroupId
|
||||
| APIListMembers GroupId
|
||||
| APIUpdateGroupProfile GroupId GroupProfile
|
||||
|
|
@ -480,7 +481,7 @@ data ChatCommand
|
|||
| JoinGroup {groupName :: GroupName, enableNtfs :: MsgFilter}
|
||||
| MemberRole GroupName ContactName GroupMemberRole
|
||||
| BlockForAll GroupName ContactName Bool
|
||||
| RemoveMembers GroupName (NonEmpty ContactName)
|
||||
| RemoveMembers {groupName :: GroupName, members :: Set ContactName, withMessages :: Bool}
|
||||
| LeaveGroup GroupName
|
||||
| DeleteGroup GroupName
|
||||
| ClearGroup GroupName
|
||||
|
|
@ -664,7 +665,7 @@ data ChatResponse
|
|||
| CRUserAcceptedGroupSent {user :: User, groupInfo :: GroupInfo, hostContact :: Maybe Contact}
|
||||
| CRGroupLinkConnecting {user :: User, groupInfo :: GroupInfo, hostMember :: GroupMember}
|
||||
| CRBusinessLinkConnecting {user :: User, groupInfo :: GroupInfo, hostMember :: GroupMember, fromContact :: Contact}
|
||||
| CRUserDeletedMembers {user :: User, groupInfo :: GroupInfo, members :: [GroupMember]}
|
||||
| CRUserDeletedMembers {user :: User, groupInfo :: GroupInfo, members :: [GroupMember], withMessages :: Bool}
|
||||
| CRGroupsList {user :: User, groups :: [(GroupInfo, GroupSummary)]}
|
||||
| CRSentGroupInvitation {user :: User, groupInfo :: GroupInfo, contact :: Contact, member :: GroupMember}
|
||||
| CRFileTransferStatus User (FileTransfer, [Integer]) -- TODO refactor this type to FileTransferStatus
|
||||
|
|
@ -753,8 +754,8 @@ data ChatResponse
|
|||
| CRMemberBlockedForAll {user :: User, groupInfo :: GroupInfo, byMember :: GroupMember, member :: GroupMember, blocked :: Bool}
|
||||
| CRMembersBlockedForAllUser {user :: User, groupInfo :: GroupInfo, members :: [GroupMember], blocked :: Bool}
|
||||
| CRConnectedToGroupMember {user :: User, groupInfo :: GroupInfo, member :: GroupMember, memberContact :: Maybe Contact}
|
||||
| CRDeletedMember {user :: User, groupInfo :: GroupInfo, byMember :: GroupMember, deletedMember :: GroupMember}
|
||||
| CRDeletedMemberUser {user :: User, groupInfo :: GroupInfo, member :: GroupMember}
|
||||
| CRDeletedMember {user :: User, groupInfo :: GroupInfo, byMember :: GroupMember, deletedMember :: GroupMember, withMessages :: Bool}
|
||||
| CRDeletedMemberUser {user :: User, groupInfo :: GroupInfo, member :: GroupMember, withMessages :: Bool}
|
||||
| CRLeftMember {user :: User, groupInfo :: GroupInfo, member :: GroupMember}
|
||||
| CRUnknownMemberCreated {user :: User, groupInfo :: GroupInfo, forwardedByMember :: GroupMember, member :: GroupMember}
|
||||
| CRUnknownMemberBlocked {user :: User, groupInfo :: GroupInfo, blockedByMember :: GroupMember, member :: GroupMember}
|
||||
|
|
|
|||
|
|
@ -43,6 +43,7 @@ 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 qualified Data.Set as S
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import Data.Text.Encoding (decodeLatin1, encodeUtf8)
|
||||
|
|
@ -1043,8 +1044,7 @@ processChatCommand' vr = \case
|
|||
withContactLock "deleteChat direct" chatId . procCmd $
|
||||
case cdm of
|
||||
CDMFull notify -> do
|
||||
cancelFilesInProgress user filesInfo
|
||||
deleteFilesLocally filesInfo
|
||||
deleteCIFiles user filesInfo
|
||||
sendDelDeleteConns ct notify
|
||||
-- functions below are called in separate transactions to prevent crashes on android
|
||||
-- (possibly, race condition on integrity check?)
|
||||
|
|
@ -1084,8 +1084,7 @@ processChatCommand' vr = \case
|
|||
unless canDelete $ throwChatError $ CEGroupUserRole gInfo GROwner
|
||||
filesInfo <- withFastStore' $ \db -> getGroupFileInfo db user gInfo
|
||||
withGroupLock "deleteChat group" chatId . procCmd $ do
|
||||
cancelFilesInProgress user filesInfo
|
||||
deleteFilesLocally filesInfo
|
||||
deleteCIFiles user filesInfo
|
||||
let doSendDel = memberActive membership && isOwner
|
||||
-- TODO [knocking] send to pending approval members (move `memberCurrent` filter from sendGroupMessages_ to call sites)
|
||||
when doSendDel . void $ sendGroupMessage' user gInfo members XGrpDel
|
||||
|
|
@ -1103,15 +1102,13 @@ processChatCommand' vr = \case
|
|||
CTDirect -> do
|
||||
ct <- withFastStore $ \db -> getContact db vr user chatId
|
||||
filesInfo <- withFastStore' $ \db -> getContactFileInfo db user ct
|
||||
cancelFilesInProgress user filesInfo
|
||||
deleteFilesLocally filesInfo
|
||||
deleteCIFiles user filesInfo
|
||||
withFastStore' $ \db -> deleteContactCIs db user ct
|
||||
pure $ CRChatCleared user (AChatInfo SCTDirect $ DirectChat ct)
|
||||
CTGroup -> do
|
||||
gInfo <- withFastStore $ \db -> getGroupInfo db vr user chatId
|
||||
filesInfo <- withFastStore' $ \db -> getGroupFileInfo db user gInfo
|
||||
cancelFilesInProgress user filesInfo
|
||||
deleteFilesLocally filesInfo
|
||||
deleteCIFiles user filesInfo
|
||||
withFastStore' $ \db -> deleteGroupChatItemsMessages db user gInfo
|
||||
membersToDelete <- withFastStore' $ \db -> getGroupMembersForExpiration db vr user gInfo
|
||||
forM_ membersToDelete $ \m -> withFastStore' $ \db -> deleteGroupMember db user m
|
||||
|
|
@ -2152,36 +2149,38 @@ processChatCommand' vr = \case
|
|||
let content = CISndGroupEvent $ SGEMemberBlocked groupMemberId (fromLocalProfile memberProfile) blockFlag
|
||||
ts = ciContentTexts content
|
||||
in NewSndChatItemData msg content ts M.empty Nothing Nothing Nothing
|
||||
APIRemoveMembers groupId memberIds -> withUser $ \user ->
|
||||
APIRemoveMembers {groupId, groupMemberIds, withMessages} -> withUser $ \user ->
|
||||
withGroupLock "removeMembers" groupId . procCmd $ do
|
||||
Group gInfo members <- withFastStore $ \db -> getGroup db vr user groupId
|
||||
let (invitedMems, pendingMems, currentMems, maxRole, anyAdmin) = selectMembers members
|
||||
when (length invitedMems + length pendingMems + length currentMems /= length memberIds) $ throwChatError CEGroupMemberNotFound
|
||||
when (length memberIds > 1 && anyAdmin) $ throwChatError $ CECommandError "can't remove multiple members when admins selected"
|
||||
let (count, invitedMems, pendingMems, currentMems, maxRole, anyAdmin) = selectMembers members
|
||||
memCount = S.size groupMemberIds
|
||||
when (count /= memCount) $ throwChatError CEGroupMemberNotFound
|
||||
when (memCount > 1 && anyAdmin) $ throwChatError $ CECommandError "can't remove multiple members when admins selected"
|
||||
assertUserGroupRole gInfo $ max GRAdmin maxRole
|
||||
(errs1, deleted1) <- deleteInvitedMems user invitedMems
|
||||
(errs2, deleted2, acis2) <- deleteMemsSend user gInfo members currentMems
|
||||
rs <- forM pendingMems $ \m -> deleteMemsSend user gInfo [m] [m]
|
||||
rs <- forM pendingMems $ \m -> deleteMemsSend user gInfo [m] [m] -- TODO [knocking]
|
||||
let (errs3, deleted3, acis3) = concatTuples rs
|
||||
acis = acis2 <> acis3
|
||||
errs = errs1 <> errs2 <> errs3
|
||||
unless (null acis) $ toView $ CRNewChatItems user acis
|
||||
unless (null errs) $ toView $ CRChatErrors (Just user) errs
|
||||
pure $ CRUserDeletedMembers user gInfo (deleted1 <> deleted2 <> deleted3) -- same order is not guaranteed
|
||||
when withMessages $ deleteMessages user gInfo $ currentMems <> pendingMems
|
||||
pure $ CRUserDeletedMembers user gInfo (deleted1 <> deleted2 <> deleted3) withMessages -- same order is not guaranteed
|
||||
where
|
||||
selectMembers :: [GroupMember] -> ([GroupMember], [GroupMember], [GroupMember], GroupMemberRole, Bool)
|
||||
selectMembers = foldr' addMember ([], [], [], GRObserver, False)
|
||||
selectMembers :: [GroupMember] -> (Int, [GroupMember], [GroupMember], [GroupMember], GroupMemberRole, Bool)
|
||||
selectMembers = foldl' addMember (0, [], [], [], GRObserver, False)
|
||||
where
|
||||
addMember m@GroupMember {groupMemberId, memberStatus, memberRole} (invited, pending, current, maxRole, anyAdmin)
|
||||
| groupMemberId `elem` memberIds =
|
||||
addMember acc@(n, invited, pending, current, maxRole, anyAdmin) m@GroupMember {groupMemberId, memberStatus, memberRole}
|
||||
| groupMemberId `S.member` groupMemberIds =
|
||||
let maxRole' = max maxRole memberRole
|
||||
anyAdmin' = anyAdmin || memberRole >= GRAdmin
|
||||
in
|
||||
case memberStatus of
|
||||
GSMemInvited -> (m : invited, pending, current, maxRole', anyAdmin')
|
||||
GSMemPendingApproval -> (invited, m : pending, current, maxRole', anyAdmin')
|
||||
_ -> (invited, pending, m : current, maxRole', anyAdmin')
|
||||
| otherwise = (invited, pending, current, maxRole, anyAdmin)
|
||||
n' = n + 1
|
||||
in case memberStatus of
|
||||
GSMemInvited -> (n', m : invited, pending, current, maxRole', anyAdmin')
|
||||
GSMemPendingApproval -> (n', invited, m : pending, current, maxRole', anyAdmin')
|
||||
_ -> (n', invited, pending, m : current, maxRole', anyAdmin')
|
||||
| otherwise = acc
|
||||
deleteInvitedMems :: User -> [GroupMember] -> CM ([ChatError], [GroupMember])
|
||||
deleteInvitedMems user memsToDelete = do
|
||||
deleteMembersConnections user memsToDelete
|
||||
|
|
@ -2194,7 +2193,7 @@ processChatCommand' vr = \case
|
|||
deleteMemsSend user gInfo sendToMems memsToDelete = case L.nonEmpty memsToDelete of
|
||||
Nothing -> pure ([], [], [])
|
||||
Just memsToDelete' -> do
|
||||
let events = L.map (\GroupMember {memberId} -> XGrpMemDel memberId) memsToDelete'
|
||||
let events = L.map (\GroupMember {memberId} -> XGrpMemDel memberId withMessages) memsToDelete'
|
||||
(msgs_, _gsr) <- sendGroupMessages user gInfo sendToMems events
|
||||
let itemsData = zipWith (fmap . sndItemData) memsToDelete (L.toList msgs_)
|
||||
cis_ <- saveSndChatItems user (CDGroupSnd gInfo) Nothing itemsData Nothing False
|
||||
|
|
@ -2212,6 +2211,9 @@ processChatCommand' vr = \case
|
|||
delMember db m = do
|
||||
deleteOrUpdateMemberRecordIO db user m
|
||||
pure m {memberStatus = GSMemRemoved}
|
||||
deleteMessages user gInfo@GroupInfo {membership} ms
|
||||
| groupFeatureMemberAllowed SGFFullDelete membership gInfo = deleteGroupMembersCIs user gInfo ms membership
|
||||
| otherwise = markGroupMembersCIsDeleted user gInfo ms membership
|
||||
concatTuples :: [([a], [b], [c])] -> ([a], [b], [c])
|
||||
concatTuples xs = (concat as, concat bs, concat cs)
|
||||
where (as, bs, cs) = unzip3 xs
|
||||
|
|
@ -2240,12 +2242,12 @@ processChatCommand' vr = \case
|
|||
processChatCommand $ APIJoinGroup groupId enableNtfs
|
||||
MemberRole gName gMemberName memRole -> withMemberName gName gMemberName $ \gId gMemberId -> APIMembersRole gId [gMemberId] memRole
|
||||
BlockForAll gName gMemberName blocked -> withMemberName gName gMemberName $ \gId gMemberId -> APIBlockMembersForAll gId [gMemberId] blocked
|
||||
RemoveMembers gName gMemberNames -> withUser $ \user -> do
|
||||
RemoveMembers gName gMemberNames withMessages -> withUser $ \user -> do
|
||||
(gId, gMemberIds) <- withStore $ \db -> do
|
||||
gId <- getGroupIdByName db user gName
|
||||
gMemberIds <- forM gMemberNames $ getGroupMemberIdByName db user gId
|
||||
gMemberIds <- S.fromList <$> mapM (getGroupMemberIdByName db user gId) (S.toList gMemberNames)
|
||||
pure (gId, gMemberIds)
|
||||
processChatCommand $ APIRemoveMembers gId gMemberIds
|
||||
processChatCommand $ APIRemoveMembers gId gMemberIds withMessages
|
||||
LeaveGroup gName -> withUser $ \user -> do
|
||||
groupId <- withFastStore $ \db -> getGroupIdByName db user gName
|
||||
processChatCommand $ APILeaveGroup groupId
|
||||
|
|
@ -3010,8 +3012,7 @@ processChatCommand' vr = \case
|
|||
deleteChatUser :: User -> Bool -> CM ChatResponse
|
||||
deleteChatUser user delSMPQueues = do
|
||||
filesInfo <- withFastStore' (`getUserFileInfo` user)
|
||||
cancelFilesInProgress user filesInfo
|
||||
deleteFilesLocally filesInfo
|
||||
deleteCIFiles user filesInfo
|
||||
withAgent (\a -> deleteUser a (aUserId user) delSMPQueues)
|
||||
`catchChatError` \case
|
||||
e@(ChatErrorAgent NO_USER _) -> toView $ CRChatError (Just user) e
|
||||
|
|
@ -3783,8 +3784,7 @@ expireContactChatItems user vr globalTTL ctId =
|
|||
withExpirationDate globalTTL chatItemTTL $ \expirationDate -> do
|
||||
lift waitChatStartedAndActivated
|
||||
filesInfo <- withStore' $ \db -> getContactExpiredFileInfo db user ct expirationDate
|
||||
cancelFilesInProgress user filesInfo
|
||||
deleteFilesLocally filesInfo
|
||||
deleteCIFiles user filesInfo
|
||||
withStore' $ \db -> deleteContactExpiredCIs db user ct expirationDate
|
||||
|
||||
expireGroupChatItems :: User -> VersionRangeChat -> Int64 -> UTCTime -> GroupId -> CM ()
|
||||
|
|
@ -3795,8 +3795,7 @@ expireGroupChatItems user vr globalTTL createdAtCutoff groupId =
|
|||
withExpirationDate globalTTL chatItemTTL $ \expirationDate -> do
|
||||
lift waitChatStartedAndActivated
|
||||
filesInfo <- withStore' $ \db -> getGroupExpiredFileInfo db user gInfo expirationDate createdAtCutoff
|
||||
cancelFilesInProgress user filesInfo
|
||||
deleteFilesLocally filesInfo
|
||||
deleteCIFiles user filesInfo
|
||||
withStore' $ \db -> deleteGroupExpiredCIs db user gInfo expirationDate createdAtCutoff
|
||||
membersToDelete <- withStore' $ \db -> getGroupMembersForExpiration db vr user gInfo
|
||||
forM_ membersToDelete $ \m -> withStore' $ \db -> deleteGroupMember db user m
|
||||
|
|
@ -3939,8 +3938,8 @@ chatCommandP =
|
|||
"/_join #" *> (APIJoinGroup <$> A.decimal <*> pure MFAll), -- needs to be changed to support in UI
|
||||
"/_accept member #" *> (APIAcceptMember <$> A.decimal <* A.space <*> A.decimal <*> memberRole),
|
||||
"/_member role #" *> (APIMembersRole <$> A.decimal <*> _strP <*> memberRole),
|
||||
"/_block #" *> (APIBlockMembersForAll <$> A.decimal <*> _strP <* A.space <* "blocked=" <*> onOffP),
|
||||
"/_remove #" *> (APIRemoveMembers <$> A.decimal <*> _strP),
|
||||
"/_block #" *> (APIBlockMembersForAll <$> A.decimal <*> _strP <* " blocked=" <*> onOffP),
|
||||
"/_remove #" *> (APIRemoveMembers <$> A.decimal <*> _strP <*> (" messages=" *> onOffP <|> pure False)),
|
||||
"/_leave #" *> (APILeaveGroup <$> A.decimal),
|
||||
"/_members #" *> (APIListMembers <$> A.decimal),
|
||||
"/_server test " *> (APITestProtoServer <$> A.decimal <* A.space <*> strP),
|
||||
|
|
@ -4026,7 +4025,7 @@ chatCommandP =
|
|||
("/member role " <|> "/mr ") *> char_ '#' *> (MemberRole <$> displayNameP <* A.space <* char_ '@' <*> displayNameP <*> memberRole),
|
||||
"/block for all #" *> (BlockForAll <$> displayNameP <* A.space <*> (char_ '@' *> displayNameP) <*> pure True),
|
||||
"/unblock for all #" *> (BlockForAll <$> displayNameP <* A.space <*> (char_ '@' *> displayNameP) <*> pure False),
|
||||
("/remove " <|> "/rm ") *> char_ '#' *> (RemoveMembers <$> displayNameP <* A.space <*> (L.fromList <$> (char_ '@' *> displayNameP) `A.sepBy1'` A.char ',')),
|
||||
("/remove " <|> "/rm ") *> char_ '#' *> (RemoveMembers <$> displayNameP <* A.space <*> (S.fromList <$> (char_ '@' *> displayNameP) `A.sepBy1'` A.char ',') <*> (" messages=" *> onOffP <|> pure False)),
|
||||
("/leave " <|> "/l ") *> char_ '#' *> (LeaveGroup <$> displayNameP),
|
||||
("/delete #" <|> "/d #") *> (DeleteGroup <$> displayNameP),
|
||||
("/delete " <|> "/d ") *> char_ '@' *> (DeleteContact <$> displayNameP <*> chatDeleteMode),
|
||||
|
|
|
|||
|
|
@ -468,6 +468,24 @@ deleteGroupCIs user gInfo items byUser timed byGroupMember_ deletedTs = do
|
|||
Nothing -> Nothing <$ deleteGroupChatItem db user gInfo ci
|
||||
pure $ groupDeletion md gInfo ci ci'
|
||||
|
||||
deleteGroupMemberCIs :: MsgDirectionI d => User -> GroupInfo -> GroupMember -> GroupMember -> SMsgDirection d -> CM ()
|
||||
deleteGroupMemberCIs user gInfo member byGroupMember msgDir = do
|
||||
deletedTs <- liftIO getCurrentTime
|
||||
filesInfo <- withStore' $ \db -> deleteGroupMemberCIs_ db user gInfo member byGroupMember msgDir deletedTs
|
||||
deleteCIFiles user filesInfo
|
||||
|
||||
deleteGroupMembersCIs :: User -> GroupInfo -> [GroupMember] -> GroupMember -> CM ()
|
||||
deleteGroupMembersCIs user gInfo members byGroupMember = do
|
||||
deletedTs <- liftIO getCurrentTime
|
||||
filesInfo <- withStore' $ \db -> fmap concat $ forM members $ \m -> deleteGroupMemberCIs_ db user gInfo m byGroupMember SMDRcv deletedTs
|
||||
deleteCIFiles user filesInfo
|
||||
|
||||
deleteGroupMemberCIs_ :: MsgDirectionI d => DB.Connection -> User -> GroupInfo -> GroupMember -> GroupMember -> SMsgDirection d -> UTCTime -> IO [CIFileInfo]
|
||||
deleteGroupMemberCIs_ db user gInfo member byGroupMember msgDir deletedTs = do
|
||||
fs <- getGroupMemberFileInfo db user gInfo member
|
||||
updateMemberCIsModerated db user gInfo member byGroupMember msgDir deletedTs
|
||||
pure fs
|
||||
|
||||
deleteLocalCIs :: User -> NoteFolder -> [CChatItem 'CTLocal] -> Bool -> Bool -> CM ChatResponse
|
||||
deleteLocalCIs user nf items byUser timed = do
|
||||
let ciFilesInfo = mapMaybe (\(CChatItem _ ChatItem {file}) -> mkCIFileInfo <$> file) items
|
||||
|
|
@ -511,6 +529,24 @@ markGroupCIsDeleted user gInfo items byUser byGroupMember_ deletedTs = do
|
|||
ci' <- markGroupChatItemDeleted db user gInfo ci byGroupMember_ deletedTs
|
||||
pure $ groupDeletion md gInfo ci (Just ci')
|
||||
|
||||
markGroupMemberCIsDeleted :: User -> GroupInfo -> GroupMember -> GroupMember -> CM ()
|
||||
markGroupMemberCIsDeleted user gInfo member byGroupMember = do
|
||||
deletedTs <- liftIO getCurrentTime
|
||||
filesInfo <- withStore' $ \db -> markGroupMemberCIsDeleted_ db user gInfo member byGroupMember deletedTs
|
||||
cancelFilesInProgress user filesInfo
|
||||
|
||||
markGroupMembersCIsDeleted :: User -> GroupInfo -> [GroupMember] -> GroupMember -> CM ()
|
||||
markGroupMembersCIsDeleted user gInfo members byGroupMember = do
|
||||
deletedTs <- liftIO getCurrentTime
|
||||
filesInfo <- withStore' $ \db -> fmap concat $ forM members $ \m -> markGroupMemberCIsDeleted_ db user gInfo m byGroupMember deletedTs
|
||||
cancelFilesInProgress user filesInfo
|
||||
|
||||
markGroupMemberCIsDeleted_ :: DB.Connection -> User -> GroupInfo -> GroupMember -> GroupMember -> UTCTime -> IO [CIFileInfo]
|
||||
markGroupMemberCIsDeleted_ db user gInfo member byGroupMember deletedTs = do
|
||||
fs <- getGroupMemberFileInfo db user gInfo member
|
||||
markMemberCIsDeleted db user gInfo member byGroupMember deletedTs
|
||||
pure fs
|
||||
|
||||
groupDeletion :: MsgDirectionI d => SMsgDirection d -> GroupInfo -> ChatItem 'CTGroup d -> Maybe (ChatItem 'CTGroup d) -> ChatItemDeletion
|
||||
groupDeletion md g ci ci' = ChatItemDeletion (gItem ci) (gItem <$> ci')
|
||||
where
|
||||
|
|
|
|||
|
|
@ -867,7 +867,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
|||
XGrpMemRole memId memRole -> xGrpMemRole gInfo m' memId memRole msg brokerTs
|
||||
XGrpMemRestrict memId memRestrictions -> xGrpMemRestrict gInfo m' memId memRestrictions msg brokerTs
|
||||
XGrpMemCon memId -> xGrpMemCon gInfo m' memId
|
||||
XGrpMemDel memId -> xGrpMemDel gInfo m' memId msg brokerTs
|
||||
XGrpMemDel memId withMessages -> xGrpMemDel gInfo m' memId withMessages msg brokerTs
|
||||
XGrpLeave -> xGrpLeave gInfo m' msg brokerTs
|
||||
XGrpDel -> xGrpDel gInfo m' msg brokerTs
|
||||
XGrpInfo p' -> xGrpInfo gInfo m' p' msg brokerTs
|
||||
|
|
@ -2570,8 +2570,8 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
|||
_ -> updateStatus introId GMIntroReConnected
|
||||
updateStatus introId status = withStore' $ \db -> updateIntroStatus db introId status
|
||||
|
||||
xGrpMemDel :: GroupInfo -> GroupMember -> MemberId -> RcvMessage -> UTCTime -> CM ()
|
||||
xGrpMemDel gInfo@GroupInfo {membership} m@GroupMember {memberRole = senderRole} memId msg brokerTs = do
|
||||
xGrpMemDel :: GroupInfo -> GroupMember -> MemberId -> Bool -> RcvMessage -> UTCTime -> CM ()
|
||||
xGrpMemDel gInfo@GroupInfo {membership} m@GroupMember {memberRole = senderRole} memId withMessages msg brokerTs = do
|
||||
let GroupMember {memberId = membershipMemId} = membership
|
||||
if membershipMemId == memId
|
||||
then checkRole membership $ do
|
||||
|
|
@ -2580,8 +2580,9 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
|||
members <- withStore' $ \db -> getGroupMembers db vr user gInfo
|
||||
deleteMembersConnections user members
|
||||
withStore' $ \db -> updateGroupMemberStatus db userId membership GSMemRemoved
|
||||
when withMessages $ deleteMessages membership SMDSnd
|
||||
deleteMemberItem RGEUserDeleted
|
||||
toView $ CRDeletedMemberUser user gInfo {membership = membership {memberStatus = GSMemRemoved}} m
|
||||
toView $ CRDeletedMemberUser user gInfo {membership = membership {memberStatus = GSMemRemoved}} m withMessages
|
||||
else
|
||||
withStore' (\db -> runExceptT $ getGroupMemberByMemberId db vr user gInfo memId) >>= \case
|
||||
Left _ -> messageError "x.grp.mem.del with unknown member ID"
|
||||
|
|
@ -2591,8 +2592,9 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
|||
deleteMemberConnection user member
|
||||
-- undeleted "member connected" chat item will prevent deletion of member record
|
||||
deleteOrUpdateMemberRecord user member
|
||||
when withMessages $ deleteMessages member SMDRcv
|
||||
deleteMemberItem $ RGEMemberDeleted groupMemberId (fromLocalProfile memberProfile)
|
||||
toView $ CRDeletedMember user gInfo m member {memberStatus = GSMemRemoved}
|
||||
toView $ CRDeletedMember user gInfo m member {memberStatus = GSMemRemoved} withMessages
|
||||
where
|
||||
checkRole GroupMember {memberRole} a
|
||||
| senderRole < GRAdmin || senderRole < memberRole =
|
||||
|
|
@ -2601,6 +2603,10 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
|||
deleteMemberItem gEvent = do
|
||||
ci <- saveRcvChatItemNoParse user (CDGroupRcv gInfo m) msg brokerTs (CIRcvGroupEvent gEvent)
|
||||
groupMsgToView gInfo ci
|
||||
deleteMessages :: MsgDirectionI d => GroupMember -> SMsgDirection d -> CM ()
|
||||
deleteMessages delMem msgDir
|
||||
| groupFeatureMemberAllowed SGFFullDelete m gInfo = deleteGroupMemberCIs user gInfo delMem m msgDir
|
||||
| otherwise = markGroupMemberCIsDeleted user gInfo delMem m
|
||||
|
||||
xGrpLeave :: GroupInfo -> GroupMember -> RcvMessage -> UTCTime -> CM ()
|
||||
xGrpLeave gInfo m msg brokerTs = do
|
||||
|
|
@ -2726,7 +2732,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
|||
XInfo p -> xInfoMember gInfo author p msgTs
|
||||
XGrpMemNew memInfo -> xGrpMemNew gInfo author memInfo rcvMsg msgTs
|
||||
XGrpMemRole memId memRole -> xGrpMemRole gInfo author memId memRole rcvMsg msgTs
|
||||
XGrpMemDel memId -> xGrpMemDel gInfo author memId rcvMsg msgTs
|
||||
XGrpMemDel memId withMessages -> xGrpMemDel gInfo author memId withMessages rcvMsg msgTs
|
||||
XGrpLeave -> xGrpLeave gInfo author rcvMsg msgTs
|
||||
XGrpDel -> xGrpDel gInfo author rcvMsg msgTs
|
||||
XGrpInfo p' -> xGrpInfo gInfo author p' rcvMsg msgTs
|
||||
|
|
|
|||
|
|
@ -29,10 +29,12 @@ import qualified Data.Aeson.KeyMap as JM
|
|||
import qualified Data.Aeson.TH as JQ
|
||||
import qualified Data.Aeson.Types as JT
|
||||
import qualified Data.Attoparsec.ByteString.Char8 as A
|
||||
import Data.Bifunctor (first)
|
||||
import Data.ByteString.Char8 (ByteString)
|
||||
import qualified Data.ByteString.Char8 as B
|
||||
import Data.ByteString.Internal (c2w, w2c)
|
||||
import qualified Data.ByteString.Lazy.Char8 as LB
|
||||
import Data.Either (fromRight)
|
||||
import Data.List.NonEmpty (NonEmpty (..))
|
||||
import qualified Data.List.NonEmpty as L
|
||||
import Data.Map.Strict (Map)
|
||||
|
|
@ -343,7 +345,7 @@ data ChatMsgEvent (e :: MsgEncoding) where
|
|||
XGrpMemRestrict :: MemberId -> MemberRestrictions -> ChatMsgEvent 'Json
|
||||
XGrpMemCon :: MemberId -> ChatMsgEvent 'Json
|
||||
XGrpMemConAll :: MemberId -> ChatMsgEvent 'Json -- TODO not implemented
|
||||
XGrpMemDel :: MemberId -> ChatMsgEvent 'Json
|
||||
XGrpMemDel :: MemberId -> Bool -> ChatMsgEvent 'Json
|
||||
XGrpLeave :: ChatMsgEvent 'Json
|
||||
XGrpDel :: ChatMsgEvent 'Json
|
||||
XGrpInfo :: GroupProfile -> ChatMsgEvent 'Json
|
||||
|
|
@ -384,7 +386,7 @@ isForwardedGroupMsg ev = case ev of
|
|||
XGrpMemNew _ -> True
|
||||
XGrpMemRole {} -> True
|
||||
XGrpMemRestrict {} -> True
|
||||
XGrpMemDel _ -> True -- TODO there should be a special logic when deleting host member (e.g., host forwards it before deleting connections)
|
||||
XGrpMemDel {} -> True -- TODO there should be a special logic when deleting host member (e.g., host forwards it before deleting connections)
|
||||
XGrpLeave -> True
|
||||
XGrpDel -> True -- TODO there should be a special logic - host should forward before deleting connections
|
||||
XGrpInfo _ -> True
|
||||
|
|
@ -991,7 +993,7 @@ toCMEventTag msg = case msg of
|
|||
XGrpMemRestrict _ _ -> XGrpMemRestrict_
|
||||
XGrpMemCon _ -> XGrpMemCon_
|
||||
XGrpMemConAll _ -> XGrpMemConAll_
|
||||
XGrpMemDel _ -> XGrpMemDel_
|
||||
XGrpMemDel {} -> XGrpMemDel_
|
||||
XGrpLeave -> XGrpLeave_
|
||||
XGrpDel -> XGrpDel_
|
||||
XGrpInfo _ -> XGrpInfo_
|
||||
|
|
@ -1094,7 +1096,7 @@ appJsonToCM AppMessageJson {v, msgId, event, params} = do
|
|||
XGrpMemRestrict_ -> XGrpMemRestrict <$> p "memberId" <*> p "memberRestrictions"
|
||||
XGrpMemCon_ -> XGrpMemCon <$> p "memberId"
|
||||
XGrpMemConAll_ -> XGrpMemConAll <$> p "memberId"
|
||||
XGrpMemDel_ -> XGrpMemDel <$> p "memberId"
|
||||
XGrpMemDel_ -> XGrpMemDel <$> p "memberId" <*> Right (fromRight False $ p "messages")
|
||||
XGrpLeave_ -> pure XGrpLeave
|
||||
XGrpDel_ -> pure XGrpDel
|
||||
XGrpInfo_ -> XGrpInfo <$> p "groupProfile"
|
||||
|
|
@ -1158,7 +1160,7 @@ chatToAppMessage ChatMessage {chatVRange, msgId, chatMsgEvent} = case encoding @
|
|||
XGrpMemRestrict memId memRestrictions -> o ["memberId" .= memId, "memberRestrictions" .= memRestrictions]
|
||||
XGrpMemCon memId -> o ["memberId" .= memId]
|
||||
XGrpMemConAll memId -> o ["memberId" .= memId]
|
||||
XGrpMemDel memId -> o ["memberId" .= memId]
|
||||
XGrpMemDel memId messages -> o $ ("messages" .=? if messages then Just True else Nothing) ["memberId" .= memId]
|
||||
XGrpLeave -> JM.empty
|
||||
XGrpDel -> JM.empty
|
||||
XGrpInfo p -> o ["groupProfile" .= p]
|
||||
|
|
|
|||
|
|
@ -21,6 +21,7 @@ module Simplex.Chat.Store.Messages
|
|||
-- * Message and chat item functions
|
||||
deleteContactCIs,
|
||||
getGroupFileInfo,
|
||||
getGroupMemberFileInfo,
|
||||
deleteGroupChatItemsMessages,
|
||||
createNewSndMessage,
|
||||
createSndMsgDelivery,
|
||||
|
|
@ -57,8 +58,10 @@ module Simplex.Chat.Store.Messages
|
|||
updateGroupCIMentions,
|
||||
deleteGroupChatItem,
|
||||
updateGroupChatItemModerated,
|
||||
updateMemberCIsModerated,
|
||||
updateGroupCIBlockedByAdmin,
|
||||
markGroupChatItemDeleted,
|
||||
markMemberCIsDeleted,
|
||||
markGroupChatItemBlocked,
|
||||
markGroupCIBlockedByAdmin,
|
||||
markMessageReportsDeleted,
|
||||
|
|
@ -193,6 +196,11 @@ getGroupFileInfo db User {userId} GroupInfo {groupId} =
|
|||
map toFileInfo
|
||||
<$> DB.query db (fileInfoQuery <> " WHERE i.user_id = ? AND i.group_id = ?") (userId, groupId)
|
||||
|
||||
getGroupMemberFileInfo :: DB.Connection -> User -> GroupInfo -> GroupMember -> IO [CIFileInfo]
|
||||
getGroupMemberFileInfo db User {userId} GroupInfo {groupId} GroupMember {groupMemberId} =
|
||||
map toFileInfo
|
||||
<$> DB.query db (fileInfoQuery <> " WHERE i.user_id = ? AND i.group_id = ? AND i.group_member_id = ?") (userId, groupId, groupMemberId)
|
||||
|
||||
deleteGroupChatItemsMessages :: DB.Connection -> User -> GroupInfo -> IO ()
|
||||
deleteGroupChatItemsMessages db User {userId} GroupInfo {groupId} = do
|
||||
DB.execute db "DELETE FROM messages WHERE group_id = ?" (Only groupId)
|
||||
|
|
@ -2150,18 +2158,18 @@ deleteDirectChatItem db User {userId} Contact {contactId} ci = do
|
|||
(userId, contactId, itemId)
|
||||
|
||||
deleteChatItemMessages_ :: DB.Connection -> ChatItemId -> IO ()
|
||||
deleteChatItemMessages_ db itemId =
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
DELETE FROM messages
|
||||
WHERE message_id IN (
|
||||
SELECT message_id
|
||||
FROM chat_item_messages
|
||||
WHERE chat_item_id = ?
|
||||
)
|
||||
|]
|
||||
(Only itemId)
|
||||
deleteChatItemMessages_ db itemId = DB.execute db deleteChatItemMessagesQuery (Only itemId)
|
||||
|
||||
deleteChatItemMessagesQuery :: Query
|
||||
deleteChatItemMessagesQuery =
|
||||
[sql|
|
||||
DELETE FROM messages
|
||||
WHERE message_id IN (
|
||||
SELECT message_id
|
||||
FROM chat_item_messages
|
||||
WHERE chat_item_id = ?
|
||||
)
|
||||
|]
|
||||
|
||||
deleteChatItemVersions_ :: DB.Connection -> ChatItemId -> IO ()
|
||||
deleteChatItemVersions_ db itemId =
|
||||
|
|
@ -2359,6 +2367,34 @@ updateGroupChatItemModerated db User {userId} GroupInfo {groupId} ci m@GroupMemb
|
|||
(deletedTs, groupMemberId, toContent, toText, currentTs, userId, groupId, itemId)
|
||||
pure ci {content = toContent, meta = (meta ci) {itemText = toText, itemDeleted = Just (CIModerated (Just deletedTs) m), editable = False, deletable = False}, formattedText = Nothing}
|
||||
|
||||
updateMemberCIsModerated :: MsgDirectionI d => DB.Connection -> User -> GroupInfo -> GroupMember -> GroupMember -> SMsgDirection d -> UTCTime -> IO ()
|
||||
updateMemberCIsModerated db User {userId} GroupInfo {groupId, membership} member byGroupMember md deletedTs = do
|
||||
itemIds <- updateCIs =<< getCurrentTime
|
||||
DB.executeMany db deleteChatItemMessagesQuery itemIds
|
||||
DB.executeMany db "DELETE FROM chat_item_versions WHERE chat_item_id = ?" itemIds
|
||||
where
|
||||
memId = groupMemberId' member
|
||||
updateQuery =
|
||||
[sql|
|
||||
UPDATE chat_items
|
||||
SET item_deleted = 1, item_deleted_ts = ?, item_deleted_by_group_member_id = ?, item_content = ?, item_text = ?, updated_at = ?
|
||||
WHERE user_id = ? AND group_id = ?
|
||||
|]
|
||||
updateCIs :: UTCTime -> IO [Only Int64]
|
||||
updateCIs currentTs
|
||||
| memId == groupMemberId' membership =
|
||||
DB.query
|
||||
db
|
||||
(updateQuery <> " AND group_member_id IS NULL AND item_sent = 1 RETURNING chat_item_id")
|
||||
(columns :. (userId, groupId))
|
||||
| otherwise =
|
||||
DB.query
|
||||
db
|
||||
(updateQuery <> " AND group_member_id = ? RETURNING chat_item_id")
|
||||
(columns :. (userId, groupId, memId))
|
||||
where
|
||||
columns = (deletedTs, groupMemberId' byGroupMember, msgDirToModeratedContent_ md, ciModeratedText, currentTs)
|
||||
|
||||
updateGroupCIBlockedByAdmin :: DB.Connection -> User -> GroupInfo -> ChatItem 'CTGroup d -> UTCTime -> IO (ChatItem 'CTGroup d)
|
||||
updateGroupCIBlockedByAdmin db User {userId} GroupInfo {groupId} ci deletedTs = do
|
||||
currentTs <- getCurrentTime
|
||||
|
|
@ -2405,6 +2441,31 @@ markGroupChatItemDeleted db User {userId} GroupInfo {groupId} ci@ChatItem {meta}
|
|||
(DBCIDeleted, deletedTs, deletedByGroupMemberId, currentTs, userId, groupId, itemId)
|
||||
pure ci {meta = meta {itemDeleted, editable = False, deletable = False}}
|
||||
|
||||
markMemberCIsDeleted :: DB.Connection -> User -> GroupInfo -> GroupMember -> GroupMember -> UTCTime -> IO ()
|
||||
markMemberCIsDeleted db User {userId} GroupInfo {groupId, membership} member byGroupMember deletedTs =
|
||||
updateCIs =<< getCurrentTime
|
||||
where
|
||||
memId = groupMemberId' member
|
||||
updateQuery =
|
||||
[sql|
|
||||
UPDATE chat_items
|
||||
SET item_deleted = ?, item_deleted_ts = ?, item_deleted_by_group_member_id = ?, updated_at = ?
|
||||
WHERE user_id = ? AND group_id = ?
|
||||
|]
|
||||
updateCIs currentTs
|
||||
| memId == groupMemberId' membership =
|
||||
DB.execute
|
||||
db
|
||||
(updateQuery <> " AND group_member_id IS NULL AND item_sent = 1")
|
||||
(columns :. (userId, groupId))
|
||||
| otherwise =
|
||||
DB.execute
|
||||
db
|
||||
(updateQuery <> " AND group_member_id = ?")
|
||||
(columns :. (userId, groupId, memId))
|
||||
where
|
||||
columns = (DBCIDeleted, deletedTs, groupMemberId' byGroupMember, currentTs)
|
||||
|
||||
markGroupChatItemBlocked :: DB.Connection -> User -> GroupInfo -> ChatItem 'CTGroup 'MDRcv -> IO (ChatItem 'CTGroup 'MDRcv)
|
||||
markGroupChatItemBlocked db User {userId} GroupInfo {groupId} ci@ChatItem {meta} = do
|
||||
deletedTs <- getCurrentTime
|
||||
|
|
|
|||
|
|
@ -3314,6 +3314,22 @@ Query:
|
|||
Plan:
|
||||
SEARCH usage_conditions USING INTEGER PRIMARY KEY (rowid=?)
|
||||
|
||||
Query:
|
||||
UPDATE chat_items
|
||||
SET item_deleted = 1, item_deleted_ts = ?, item_deleted_by_group_member_id = ?, item_content = ?, item_text = ?, updated_at = ?
|
||||
WHERE user_id = ? AND group_id = ?
|
||||
AND group_member_id = ? RETURNING chat_item_id
|
||||
Plan:
|
||||
SEARCH chat_items USING COVERING INDEX idx_chat_items_group_shared_msg_id (user_id=? AND group_id=? AND group_member_id=?)
|
||||
|
||||
Query:
|
||||
UPDATE chat_items
|
||||
SET item_deleted = 1, item_deleted_ts = ?, item_deleted_by_group_member_id = ?, item_content = ?, item_text = ?, updated_at = ?
|
||||
WHERE user_id = ? AND group_id = ?
|
||||
AND group_member_id IS NULL AND item_sent = 1 RETURNING chat_item_id
|
||||
Plan:
|
||||
SEARCH chat_items USING INDEX idx_chat_items_group_shared_msg_id (user_id=? AND group_id=? AND group_member_id=?)
|
||||
|
||||
Query:
|
||||
UPDATE chat_items
|
||||
SET item_deleted = 1, item_deleted_ts = ?, item_deleted_by_group_member_id = ?, item_content = ?, item_text = ?, updated_at = ?
|
||||
|
|
@ -3322,6 +3338,22 @@ Query:
|
|||
Plan:
|
||||
SEARCH chat_items USING INTEGER PRIMARY KEY (rowid=?)
|
||||
|
||||
Query:
|
||||
UPDATE chat_items
|
||||
SET item_deleted = ?, item_deleted_ts = ?, item_deleted_by_group_member_id = ?, updated_at = ?
|
||||
WHERE user_id = ? AND group_id = ?
|
||||
AND group_member_id = ?
|
||||
Plan:
|
||||
SEARCH chat_items USING COVERING INDEX idx_chat_items_group_shared_msg_id (user_id=? AND group_id=? AND group_member_id=?)
|
||||
|
||||
Query:
|
||||
UPDATE chat_items
|
||||
SET item_deleted = ?, item_deleted_ts = ?, item_deleted_by_group_member_id = ?, updated_at = ?
|
||||
WHERE user_id = ? AND group_id = ?
|
||||
AND group_member_id IS NULL AND item_sent = 1
|
||||
Plan:
|
||||
SEARCH chat_items USING INDEX idx_chat_items_group_shared_msg_id (user_id=? AND group_id=? AND group_member_id=?)
|
||||
|
||||
Query:
|
||||
UPDATE chat_items
|
||||
SET item_deleted = ?, item_deleted_ts = ?, item_deleted_by_group_member_id = ?, updated_at = ?
|
||||
|
|
@ -3861,25 +3893,6 @@ LIST SUBQUERY 1
|
|||
SEARCH groups USING INTEGER PRIMARY KEY (rowid=?)
|
||||
SEARCH groups USING COVERING INDEX idx_groups_group_profile_id (group_profile_id=?)
|
||||
|
||||
Query:
|
||||
DELETE FROM messages
|
||||
WHERE message_id IN (
|
||||
SELECT message_id
|
||||
FROM chat_item_messages
|
||||
WHERE chat_item_id = ?
|
||||
)
|
||||
|
||||
Plan:
|
||||
SEARCH messages USING INTEGER PRIMARY KEY (rowid=?)
|
||||
LIST SUBQUERY 1
|
||||
SEARCH chat_item_messages USING COVERING INDEX sqlite_autoindex_chat_item_messages_2 (chat_item_id=?)
|
||||
SEARCH msg_deliveries USING COVERING INDEX idx_msg_deliveries_message_id (message_id=?)
|
||||
SEARCH chat_item_moderations USING COVERING INDEX idx_chat_item_moderations_created_by_msg_id (created_by_msg_id=?)
|
||||
SEARCH chat_item_reactions USING COVERING INDEX idx_chat_item_reactions_created_by_msg_id (created_by_msg_id=?)
|
||||
SEARCH chat_item_messages USING COVERING INDEX sqlite_autoindex_chat_item_messages_1 (message_id=?)
|
||||
SEARCH chat_items USING COVERING INDEX sqlite_autoindex_chat_items_1 (created_by_msg_id=?)
|
||||
SEARCH pending_group_messages USING COVERING INDEX idx_pending_group_messages_message_id (message_id=?)
|
||||
|
||||
Query:
|
||||
INSERT INTO calls
|
||||
(contact_id, shared_call_id, call_uuid, chat_item_id, call_state, call_ts, user_id, created_at, updated_at)
|
||||
|
|
@ -4414,6 +4427,25 @@ Query:
|
|||
Plan:
|
||||
SEARCH xftp_file_descriptions USING INTEGER PRIMARY KEY (rowid=?)
|
||||
|
||||
Query:
|
||||
DELETE FROM messages
|
||||
WHERE message_id IN (
|
||||
SELECT message_id
|
||||
FROM chat_item_messages
|
||||
WHERE chat_item_id = ?
|
||||
)
|
||||
|
||||
Plan:
|
||||
SEARCH messages USING INTEGER PRIMARY KEY (rowid=?)
|
||||
LIST SUBQUERY 1
|
||||
SEARCH chat_item_messages USING COVERING INDEX sqlite_autoindex_chat_item_messages_2 (chat_item_id=?)
|
||||
SEARCH msg_deliveries USING COVERING INDEX idx_msg_deliveries_message_id (message_id=?)
|
||||
SEARCH chat_item_moderations USING COVERING INDEX idx_chat_item_moderations_created_by_msg_id (created_by_msg_id=?)
|
||||
SEARCH chat_item_reactions USING COVERING INDEX idx_chat_item_reactions_created_by_msg_id (created_by_msg_id=?)
|
||||
SEARCH chat_item_messages USING COVERING INDEX sqlite_autoindex_chat_item_messages_1 (message_id=?)
|
||||
SEARCH chat_items USING COVERING INDEX sqlite_autoindex_chat_items_1 (created_by_msg_id=?)
|
||||
SEARCH pending_group_messages USING COVERING INDEX idx_pending_group_messages_message_id (message_id=?)
|
||||
|
||||
Query:
|
||||
SELECT
|
||||
-- GroupInfo
|
||||
|
|
@ -4654,6 +4686,15 @@ Plan:
|
|||
SEARCH i USING COVERING INDEX idx_chat_items_groups_user_mention (user_id=? AND group_id=?)
|
||||
SEARCH f USING INDEX idx_files_chat_item_id (chat_item_id=?)
|
||||
|
||||
Query:
|
||||
SELECT f.file_id, f.ci_file_status, f.file_path
|
||||
FROM chat_items i
|
||||
JOIN files f ON f.chat_item_id = i.chat_item_id
|
||||
WHERE i.user_id = ? AND i.group_id = ? AND i.group_member_id = ?
|
||||
Plan:
|
||||
SEARCH i USING COVERING INDEX idx_chat_items_group_shared_msg_id (user_id=? AND group_id=? AND group_member_id=?)
|
||||
SEARCH f USING INDEX idx_files_chat_item_id (chat_item_id=?)
|
||||
|
||||
Query:
|
||||
SELECT f.file_id, f.ci_file_status, f.file_path
|
||||
FROM chat_items i
|
||||
|
|
|
|||
|
|
@ -220,9 +220,9 @@ responseToView hu@(currentRH, user_) ChatConfig {logLevel, showReactions, showRe
|
|||
CRUserAcceptedGroupSent u _g _ -> ttyUser u [] -- [ttyGroup' g <> ": joining the group..."]
|
||||
CRGroupLinkConnecting u g _ -> ttyUser u [ttyGroup' g <> ": joining the group..."]
|
||||
CRBusinessLinkConnecting u g _ _ -> ttyUser u [ttyGroup' g <> ": joining the group..."]
|
||||
CRUserDeletedMembers u g members -> case members of
|
||||
[m] -> ttyUser u [ttyGroup' g <> ": you removed " <> ttyMember m <> " from the group"]
|
||||
mems' -> ttyUser u [ttyGroup' g <> ": you removed " <> sShow (length mems') <> " members from the group"]
|
||||
CRUserDeletedMembers u g members wm -> case members of
|
||||
[m] -> ttyUser u [ttyGroup' g <> ": you removed " <> ttyMember m <> " from the group" <> withMessages wm]
|
||||
mems' -> ttyUser u [ttyGroup' g <> ": you removed " <> sShow (length mems') <> " members from the group" <> withMessages wm]
|
||||
CRLeftMemberUser u g -> ttyUser u $ [ttyGroup' g <> ": you left the group"] <> groupPreserved g
|
||||
CRUnknownMemberCreated u g fwdM um -> ttyUser u [ttyGroup' g <> ": " <> ttyMember fwdM <> " forwarded a message from an unknown member, creating unknown member record " <> ttyMember um]
|
||||
CRUnknownMemberBlocked u g byM um -> ttyUser u [ttyGroup' g <> ": " <> ttyMember byM <> " blocked an unknown member, creating unknown member record " <> ttyMember um]
|
||||
|
|
@ -306,8 +306,8 @@ responseToView hu@(currentRH, user_) ChatConfig {logLevel, showReactions, showRe
|
|||
CRMembersRoleUser u g members r' -> ttyUser u $ viewMemberRoleUserChanged g members r'
|
||||
CRMemberBlockedForAll u g by m blocked -> ttyUser u $ viewMemberBlockedForAll g by m blocked
|
||||
CRMembersBlockedForAllUser u g members blocked -> ttyUser u $ viewMembersBlockedForAllUser g members blocked
|
||||
CRDeletedMemberUser u g by -> ttyUser u $ [ttyGroup' g <> ": " <> ttyMember by <> " removed you from the group"] <> groupPreserved g
|
||||
CRDeletedMember u g by m -> ttyUser u [ttyGroup' g <> ": " <> ttyMember by <> " removed " <> ttyMember m <> " from the group"]
|
||||
CRDeletedMemberUser u g by wm -> ttyUser u $ [ttyGroup' g <> ": " <> ttyMember by <> " removed you from the group" <> withMessages wm] <> groupPreserved g
|
||||
CRDeletedMember u g by m wm -> ttyUser u [ttyGroup' g <> ": " <> ttyMember by <> " removed " <> ttyMember m <> " from the group" <> withMessages wm]
|
||||
CRLeftMember u g m -> ttyUser u [ttyGroup' g <> ": " <> ttyMember m <> " left the group"]
|
||||
CRGroupEmpty u ShortGroupInfo {groupName = g} -> ttyUser u [ttyGroup g <> ": group is empty"]
|
||||
CRGroupDeleted u g m -> ttyUser u [ttyGroup' g <> ": " <> ttyMember m <> " deleted the group", "use " <> highlight ("/d #" <> viewGroupName g) <> " to delete the local copy of the group"]
|
||||
|
|
@ -511,6 +511,7 @@ responseToView hu@(currentRH, user_) ChatConfig {logLevel, showReactions, showRe
|
|||
| chatDirNtf u chat chatDir mention = s
|
||||
| testView = map (<> " <muted>") s
|
||||
| otherwise = []
|
||||
withMessages wm = if wm then " with all messages" else ""
|
||||
|
||||
userNtf :: User -> Bool
|
||||
userNtf User {showNtfs, activeUser} = showNtfs || activeUser
|
||||
|
|
|
|||
|
|
@ -79,6 +79,8 @@ chatGroupTests = do
|
|||
it "moderate message of another group member (full delete)" testGroupModerateFullDelete
|
||||
it "moderate message that arrives after the event of moderation" testGroupDelayedModeration
|
||||
it "moderate message that arrives after the event of moderation (full delete)" testGroupDelayedModerationFullDelete
|
||||
it "remove member with messages (full deletion is enabled)" testDeleteMemberWithMessages
|
||||
it "remove member with messages mark deleted" testDeleteMemberMarkMessagesDeleted
|
||||
describe "batch send messages" $ do
|
||||
it "send multiple messages api" testSendMulti
|
||||
it "send multiple timed messages" testSendMultiTimed
|
||||
|
|
@ -1801,6 +1803,67 @@ testGroupDelayedModerationFullDelete ps = do
|
|||
-- version before forwarding, so cath doesn't expect alice to forward messages (groupForwardVersion = 4)
|
||||
cfg = testCfg {chatVRange = mkVersionRange (VersionChat 1) (VersionChat 3)}
|
||||
|
||||
testDeleteMemberWithMessages :: HasCallStack => TestParams -> IO ()
|
||||
testDeleteMemberWithMessages =
|
||||
testChat3 aliceProfile bobProfile cathProfile $
|
||||
\alice bob cath -> do
|
||||
createGroup3 "team" alice bob cath
|
||||
threadDelay 750000
|
||||
alice ##> "/set delete #team on"
|
||||
alice <## "updated group preferences:"
|
||||
alice <## "Full deletion: on"
|
||||
threadDelay 750000
|
||||
concurrentlyN_
|
||||
[ do
|
||||
bob <## "alice updated group #team:"
|
||||
bob <## "updated group preferences:"
|
||||
bob <## "Full deletion: on",
|
||||
do
|
||||
cath <## "alice updated group #team:"
|
||||
cath <## "updated group preferences:"
|
||||
cath <## "Full deletion: on"
|
||||
]
|
||||
threadDelay 750000
|
||||
bob #> "#team hello"
|
||||
concurrently_
|
||||
(alice <# "#team bob> hello")
|
||||
(cath <# "#team bob> hello")
|
||||
alice #$> ("/_get chat #1 count=1", chat, [(0, "hello")])
|
||||
bob #$> ("/_get chat #1 count=1", chat, [(1, "hello")])
|
||||
cath #$> ("/_get chat #1 count=1", chat, [(0, "hello")])
|
||||
threadDelay 1000000
|
||||
alice ##> "/rm #team bob messages=on"
|
||||
alice <## "#team: you removed bob from the group with all messages"
|
||||
bob <## "#team: alice removed you from the group with all messages"
|
||||
bob <## "use /d #team to delete the group"
|
||||
cath <## "#team: alice removed bob from the group with all messages"
|
||||
alice #$> ("/_get chat #1 count=2", chat, [(0, "moderated [deleted by you]"), (1, "removed bob (Bob)")])
|
||||
bob #$> ("/_get chat #1 count=2", chat, [(1, "moderated [deleted by alice]"), (0, "removed you")])
|
||||
cath #$> ("/_get chat #1 count=2", chat, [(0, "moderated [deleted by alice]"), (0, "removed bob (Bob)")])
|
||||
|
||||
testDeleteMemberMarkMessagesDeleted :: HasCallStack => TestParams -> IO ()
|
||||
testDeleteMemberMarkMessagesDeleted =
|
||||
testChat3 aliceProfile bobProfile cathProfile $
|
||||
\alice bob cath -> do
|
||||
createGroup3 "team" alice bob cath
|
||||
threadDelay 1000000
|
||||
bob #> "#team hello"
|
||||
concurrently_
|
||||
(alice <# "#team bob> hello")
|
||||
(cath <# "#team bob> hello")
|
||||
alice #$> ("/_get chat #1 count=1", chat, [(0, "hello")])
|
||||
bob #$> ("/_get chat #1 count=1", chat, [(1, "hello")])
|
||||
cath #$> ("/_get chat #1 count=1", chat, [(0, "hello")])
|
||||
threadDelay 1000000
|
||||
alice ##> "/rm #team bob messages=on"
|
||||
alice <## "#team: you removed bob from the group with all messages"
|
||||
bob <## "#team: alice removed you from the group with all messages"
|
||||
bob <## "use /d #team to delete the group"
|
||||
cath <## "#team: alice removed bob from the group with all messages"
|
||||
alice #$> ("/_get chat #1 count=2", chat, [(0, "hello [marked deleted by you]"), (1, "removed bob (Bob)")])
|
||||
bob #$> ("/_get chat #1 count=2", chat, [(1, "hello [marked deleted by alice]"), (0, "removed you")])
|
||||
cath #$> ("/_get chat #1 count=2", chat, [(0, "hello [marked deleted by alice]"), (0, "removed bob (Bob)")])
|
||||
|
||||
testSendMulti :: HasCallStack => TestParams -> IO ()
|
||||
testSendMulti =
|
||||
testChat3 aliceProfile bobProfile cathProfile $
|
||||
|
|
|
|||
|
|
@ -283,7 +283,7 @@ decodeChatMessageTest = describe "Chat message encoding/decoding" $ do
|
|||
#==# XGrpMemConAll (MemberId "\1\2\3\4")
|
||||
it "x.grp.mem.del" $
|
||||
"{\"v\":\"1\",\"event\":\"x.grp.mem.del\",\"params\":{\"memberId\":\"AQIDBA==\"}}"
|
||||
#==# XGrpMemDel (MemberId "\1\2\3\4")
|
||||
#==# XGrpMemDel (MemberId "\1\2\3\4") False
|
||||
it "x.grp.leave" $
|
||||
"{\"v\":\"1\",\"event\":\"x.grp.leave\",\"params\":{}}"
|
||||
==# XGrpLeave
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue