mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2025-03-14 09:45:42 +00:00
core: batch apis - remove, block, change role of members (#5674)
* core: core: batch remove members * order * foldr * list * style * batch block * change role * test * if
This commit is contained in:
spaced4ndy
GitHub
parent
dce8502165
commit
dcea008fb9
10 changed files with 320 additions and 162 deletions
|
|
@ -366,9 +366,9 @@ data ChatCommand
|
|||
| ApiGetConnNtfMessages {connIds :: NonEmpty AgentConnId}
|
||||
| APIAddMember GroupId ContactId GroupMemberRole
|
||||
| APIJoinGroup {groupId :: GroupId, enableNtfs :: MsgFilter}
|
||||
| APIMemberRole GroupId GroupMemberId GroupMemberRole
|
||||
| APIBlockMemberForAll GroupId GroupMemberId Bool
|
||||
| APIRemoveMember GroupId GroupMemberId
|
||||
| APIMembersRole GroupId (NonEmpty GroupMemberId) GroupMemberRole
|
||||
| APIBlockMembersForAll GroupId (NonEmpty GroupMemberId) Bool
|
||||
| APIRemoveMembers GroupId (NonEmpty GroupMemberId)
|
||||
| APILeaveGroup GroupId
|
||||
| APIListMembers GroupId
|
||||
| APIUpdateGroupProfile GroupId GroupProfile
|
||||
|
|
@ -673,7 +673,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}
|
||||
| CRUserDeletedMember {user :: User, groupInfo :: GroupInfo, member :: GroupMember}
|
||||
| CRUserDeletedMembers {user :: User, groupInfo :: GroupInfo, members :: [GroupMember]}
|
||||
| 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
|
||||
|
|
@ -758,9 +758,9 @@ data ChatResponse
|
|||
| CRJoinedGroupMember {user :: User, groupInfo :: GroupInfo, member :: GroupMember}
|
||||
| CRJoinedGroupMemberConnecting {user :: User, groupInfo :: GroupInfo, hostMember :: GroupMember, member :: GroupMember}
|
||||
| CRMemberRole {user :: User, groupInfo :: GroupInfo, byMember :: GroupMember, member :: GroupMember, fromRole :: GroupMemberRole, toRole :: GroupMemberRole}
|
||||
| CRMemberRoleUser {user :: User, groupInfo :: GroupInfo, member :: GroupMember, fromRole :: GroupMemberRole, toRole :: GroupMemberRole}
|
||||
| CRMembersRoleUser {user :: User, groupInfo :: GroupInfo, members :: [GroupMember], toRole :: GroupMemberRole}
|
||||
| CRMemberBlockedForAll {user :: User, groupInfo :: GroupInfo, byMember :: GroupMember, member :: GroupMember, blocked :: Bool}
|
||||
| CRMemberBlockedForAllUser {user :: User, groupInfo :: GroupInfo, 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}
|
||||
|
|
|
|||
|
|
@ -2023,75 +2023,170 @@ processChatCommand' vr = \case
|
|||
updateCIGroupInvitationStatus user g CIGISAccepted `catchChatError` (toView . CRChatError (Just user))
|
||||
pure $ CRUserAcceptedGroupSent user g {membership = membership {memberStatus = GSMemAccepted}} Nothing
|
||||
Nothing -> throwChatError $ CEContactNotActive ct
|
||||
APIMemberRole groupId memberId memRole -> withUser $ \user -> do
|
||||
Group gInfo@GroupInfo {membership} members <- withFastStore $ \db -> getGroup db vr user groupId
|
||||
if memberId == groupMemberId' membership
|
||||
then changeMemberRole user gInfo members membership $ SGEUserRole memRole
|
||||
else case find ((== memberId) . groupMemberId') members of
|
||||
Just m -> changeMemberRole user gInfo members m $ SGEMemberRole memberId (fromLocalProfile $ memberProfile m) memRole
|
||||
_ -> throwChatError CEGroupMemberNotFound
|
||||
APIMembersRole groupId memberIds newRole -> withUser $ \user ->
|
||||
withGroupLock "memberRole" groupId . procCmd $ do
|
||||
g@(Group gInfo members) <- withFastStore $ \db -> getGroup db vr user groupId
|
||||
when (selfSelected gInfo) $ throwChatError $ CECommandError "can't change role for self"
|
||||
let (invitedMems, currentMems, unchangedMems, maxRole, anyAdmin) = selectMembers members
|
||||
when (length invitedMems + length currentMems + length unchangedMems /= length memberIds) $ throwChatError CEGroupMemberNotFound
|
||||
when (length memberIds > 1 && (anyAdmin || newRole >= GRAdmin)) $
|
||||
throwChatError $ CECommandError "can't change role of multiple members when admins selected, or new role is admin"
|
||||
assertUserGroupRole gInfo $ maximum ([GRAdmin, maxRole, newRole] :: [GroupMemberRole])
|
||||
(errs1, changed1) <- changeRoleInvitedMems user gInfo invitedMems
|
||||
(errs2, changed2, acis) <- changeRoleCurrentMems user g currentMems
|
||||
unless (null acis) $ toView $ CRNewChatItems user acis
|
||||
let errs = errs1 <> errs2
|
||||
unless (null errs) $ toView $ CRChatErrors (Just user) errs
|
||||
pure $ CRMembersRoleUser {user, groupInfo = gInfo, members = changed1 <> changed2, toRole = newRole} -- same order is not guaranteed
|
||||
where
|
||||
changeMemberRole user gInfo members m gEvent = do
|
||||
let GroupMember {memberId = mId, memberRole = mRole, memberStatus = mStatus, memberContactId, localDisplayName = cName} = m
|
||||
assertUserGroupRole gInfo $ maximum ([GRAdmin, mRole, memRole] :: [GroupMemberRole])
|
||||
withGroupLock "memberRole" groupId . procCmd $ do
|
||||
unless (mRole == memRole) $ do
|
||||
withFastStore' $ \db -> updateGroupMemberRole db user m memRole
|
||||
case mStatus of
|
||||
GSMemInvited -> do
|
||||
withFastStore (\db -> (,) <$> mapM (getContact db vr user) memberContactId <*> liftIO (getMemberInvitation db user $ groupMemberId' m)) >>= \case
|
||||
(Just ct, Just cReq) -> sendGrpInvitation user ct gInfo (m :: GroupMember) {memberRole = memRole} cReq
|
||||
_ -> throwChatError $ CEGroupCantResendInvitation gInfo cName
|
||||
_ -> do
|
||||
msg <- sendGroupMessage user gInfo members $ XGrpMemRole mId memRole
|
||||
ci <- saveSndChatItem user (CDGroupSnd gInfo) msg (CISndGroupEvent gEvent)
|
||||
toView $ CRNewChatItems user [AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci]
|
||||
pure CRMemberRoleUser {user, groupInfo = gInfo, member = m {memberRole = memRole}, fromRole = mRole, toRole = memRole}
|
||||
APIBlockMemberForAll groupId memberId blocked -> withUser $ \user -> do
|
||||
Group gInfo@GroupInfo {membership} members <- withFastStore $ \db -> getGroup db vr user groupId
|
||||
when (memberId == groupMemberId' membership) $ throwChatError $ CECommandError "can't block/unblock self"
|
||||
case splitMember memberId members of
|
||||
Nothing -> throwChatError $ CEException "expected to find a single blocked member"
|
||||
Just (bm, remainingMembers) -> do
|
||||
let GroupMember {memberId = bmMemberId, memberRole = bmRole, memberProfile = bmp} = bm
|
||||
-- TODO GRModerator when most users migrate
|
||||
assertUserGroupRole gInfo $ max GRAdmin bmRole
|
||||
when (blocked == blockedByAdmin bm) $ throwChatError $ CECommandError $ if blocked then "already blocked" else "already unblocked"
|
||||
withGroupLock "blockForAll" groupId . procCmd $ do
|
||||
let mrs = if blocked then MRSBlocked else MRSUnrestricted
|
||||
event = XGrpMemRestrict bmMemberId MemberRestrictions {restriction = mrs}
|
||||
msg <- sendGroupMessage' user gInfo remainingMembers event
|
||||
let ciContent = CISndGroupEvent $ SGEMemberBlocked memberId (fromLocalProfile bmp) blocked
|
||||
ci <- saveSndChatItem user (CDGroupSnd gInfo) msg ciContent
|
||||
toView $ CRNewChatItems user [AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci]
|
||||
bm' <- withFastStore $ \db -> do
|
||||
liftIO $ updateGroupMemberBlocked db user groupId memberId mrs
|
||||
getGroupMember db vr user groupId memberId
|
||||
toggleNtf user bm' (not blocked)
|
||||
pure CRMemberBlockedForAllUser {user, groupInfo = gInfo, member = bm', blocked}
|
||||
selfSelected GroupInfo {membership} = elem (groupMemberId' membership) memberIds
|
||||
selectMembers :: [GroupMember] -> ([GroupMember], [GroupMember], [GroupMember], GroupMemberRole, Bool)
|
||||
selectMembers = foldr' addMember ([], [], [], GRObserver, False)
|
||||
where
|
||||
addMember m@GroupMember {groupMemberId, memberStatus, memberRole} (invited, current, unchanged, maxRole, anyAdmin)
|
||||
| groupMemberId `elem` memberIds =
|
||||
let maxRole' = max maxRole memberRole
|
||||
anyAdmin' = anyAdmin || memberRole >= GRAdmin
|
||||
in
|
||||
if
|
||||
| memberRole == newRole -> (invited, current, m : unchanged, maxRole', anyAdmin')
|
||||
| memberStatus == GSMemInvited -> (m : invited, current, unchanged, maxRole', anyAdmin')
|
||||
| otherwise -> (invited, m : current, unchanged, maxRole', anyAdmin')
|
||||
| otherwise = (invited, current, unchanged, maxRole, anyAdmin)
|
||||
changeRoleInvitedMems :: User -> GroupInfo -> [GroupMember] -> CM ([ChatError], [GroupMember])
|
||||
changeRoleInvitedMems user gInfo memsToChange = do
|
||||
-- not batched, as we need to send different invitations to different connections anyway
|
||||
mems_ <- forM memsToChange $ \m -> (Right <$> changeRole m) `catchChatError` (pure . Left)
|
||||
pure $ partitionEithers mems_
|
||||
where
|
||||
changeRole :: GroupMember -> CM GroupMember
|
||||
changeRole m@GroupMember {groupMemberId, memberContactId, localDisplayName = cName} = do
|
||||
withFastStore (\db -> (,) <$> mapM (getContact db vr user) memberContactId <*> liftIO (getMemberInvitation db user groupMemberId)) >>= \case
|
||||
(Just ct, Just cReq) -> do
|
||||
sendGrpInvitation user ct gInfo (m :: GroupMember) {memberRole = newRole} cReq
|
||||
withFastStore' $ \db -> updateGroupMemberRole db user m newRole
|
||||
pure (m :: GroupMember) {memberRole = newRole}
|
||||
_ -> throwChatError $ CEGroupCantResendInvitation gInfo cName
|
||||
changeRoleCurrentMems :: User -> Group -> [GroupMember] -> CM ([ChatError], [GroupMember], [AChatItem])
|
||||
changeRoleCurrentMems user (Group gInfo members) memsToChange = case L.nonEmpty memsToChange of
|
||||
Nothing -> pure ([], [], [])
|
||||
Just memsToChange' -> do
|
||||
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
|
||||
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_
|
||||
pure (errs, changed, acis)
|
||||
where
|
||||
sndItemData :: GroupMember -> SndMessage -> NewSndChatItemData c
|
||||
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
|
||||
updMember db m = do
|
||||
updateGroupMemberRole db user m newRole
|
||||
pure (m :: GroupMember) {memberRole = newRole}
|
||||
APIBlockMembersForAll groupId memberIds blockFlag -> withUser $ \user ->
|
||||
withGroupLock "blockForAll" groupId . procCmd $ do
|
||||
Group gInfo members <- withFastStore $ \db -> getGroup db vr user groupId
|
||||
when (selfSelected gInfo) $ throwChatError $ CECommandError "can't block/unblock self"
|
||||
let (blockMems, remainingMems, maxRole, anyAdmin) = selectMembers members
|
||||
when (length blockMems /= length memberIds) $ throwChatError CEGroupMemberNotFound
|
||||
when (length memberIds > 1 && anyAdmin) $ throwChatError $ CECommandError "can't block/unblock multiple members when admins selected"
|
||||
assertUserGroupRole gInfo $ max GRModerator maxRole
|
||||
blockMembers user gInfo blockMems remainingMems
|
||||
where
|
||||
splitMember mId ms = case break ((== mId) . groupMemberId') ms of
|
||||
(_, []) -> Nothing
|
||||
(ms1, bm : ms2) -> Just (bm, ms1 <> ms2)
|
||||
APIRemoveMember groupId memberId -> withUser $ \user -> do
|
||||
Group gInfo members <- withFastStore $ \db -> getGroup db vr user groupId
|
||||
case find ((== memberId) . groupMemberId') members of
|
||||
Nothing -> throwChatError CEGroupMemberNotFound
|
||||
Just m@GroupMember {memberId = mId, memberRole = mRole, memberStatus = mStatus, memberProfile} -> do
|
||||
assertUserGroupRole gInfo $ max GRAdmin mRole
|
||||
withGroupLock "removeMember" groupId . procCmd $ do
|
||||
case mStatus of
|
||||
GSMemInvited -> do
|
||||
deleteMemberConnection user m
|
||||
withFastStore' $ \db -> deleteGroupMember db user m
|
||||
_ -> do
|
||||
msg <- sendGroupMessage user gInfo members $ XGrpMemDel mId
|
||||
ci <- saveSndChatItem user (CDGroupSnd gInfo) msg (CISndGroupEvent $ SGEMemberDeleted memberId (fromLocalProfile memberProfile))
|
||||
toView $ CRNewChatItems user [AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci]
|
||||
deleteMemberConnection' user m True
|
||||
-- undeleted "member connected" chat item will prevent deletion of member record
|
||||
deleteOrUpdateMemberRecord user m
|
||||
pure $ CRUserDeletedMember user gInfo m {memberStatus = GSMemRemoved}
|
||||
selfSelected GroupInfo {membership} = elem (groupMemberId' membership) memberIds
|
||||
selectMembers :: [GroupMember] -> ([GroupMember], [GroupMember], GroupMemberRole, Bool)
|
||||
selectMembers = foldr' addMember ([], [], GRObserver, False)
|
||||
where
|
||||
addMember m@GroupMember {groupMemberId, memberRole} (block, remaining, maxRole, anyAdmin)
|
||||
| groupMemberId `elem` memberIds =
|
||||
let maxRole' = max maxRole memberRole
|
||||
anyAdmin' = anyAdmin || memberRole >= GRAdmin
|
||||
in (m : block, remaining, maxRole', anyAdmin')
|
||||
| otherwise = (block, m : remaining, maxRole, anyAdmin)
|
||||
blockMembers :: User -> GroupInfo -> [GroupMember] -> [GroupMember] -> CM ChatResponse
|
||||
blockMembers user gInfo blockMems remainingMems = case L.nonEmpty blockMems of
|
||||
Nothing -> throwChatError $ CECommandError "no members to block/unblock"
|
||||
Just blockMems' -> do
|
||||
let mrs = if blockFlag then MRSBlocked else MRSUnrestricted
|
||||
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
|
||||
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
|
||||
(errs, blocked) <- lift $ partitionEithers <$> withStoreBatch' (\db -> map (updateGroupMemberBlocked db user gInfo mrs) blockMems)
|
||||
unless (null errs) $ toView $ CRChatErrors (Just user) errs
|
||||
-- TODO not batched - requires agent batch api
|
||||
forM_ blocked $ \m -> toggleNtf user m (not blockFlag)
|
||||
pure CRMembersBlockedForAllUser {user, groupInfo = gInfo, members = blocked, blocked = blockFlag}
|
||||
where
|
||||
sndItemData :: GroupMember -> SndMessage -> NewSndChatItemData c
|
||||
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
|
||||
APIRemoveMembers groupId memberIds -> withUser $ \user ->
|
||||
withGroupLock "removeMembers" groupId . procCmd $ do
|
||||
g@(Group gInfo members) <- withFastStore $ \db -> getGroup db vr user groupId
|
||||
let (invitedMems, currentMems, maxRole, anyAdmin) = selectMembers members
|
||||
when (length invitedMems + length currentMems /= length memberIds) $ throwChatError CEGroupMemberNotFound
|
||||
when (length memberIds > 1 && anyAdmin) $ throwChatError $ CECommandError "can't remove multiple members when admins selected"
|
||||
assertUserGroupRole gInfo $ max GRAdmin maxRole
|
||||
(errs1, deleted1) <- deleteInvitedMems user invitedMems
|
||||
(errs2, deleted2, acis) <- deleteCurrentMems user g currentMems
|
||||
unless (null acis) $ toView $ CRNewChatItems user acis
|
||||
let errs = errs1 <> errs2
|
||||
unless (null errs) $ toView $ CRChatErrors (Just user) errs
|
||||
pure $ CRUserDeletedMembers user gInfo (deleted1 <> deleted2) -- same order is not guaranteed
|
||||
where
|
||||
selectMembers :: [GroupMember] -> ([GroupMember], [GroupMember], GroupMemberRole, Bool)
|
||||
selectMembers = foldr' addMember ([], [], GRObserver, False)
|
||||
where
|
||||
addMember m@GroupMember {groupMemberId, memberStatus, memberRole} (invited, current, maxRole, anyAdmin)
|
||||
| groupMemberId `elem` memberIds =
|
||||
let maxRole' = max maxRole memberRole
|
||||
anyAdmin' = anyAdmin || memberRole >= GRAdmin
|
||||
in
|
||||
if memberStatus == GSMemInvited
|
||||
then (m : invited, current, maxRole', anyAdmin')
|
||||
else (invited, m : current, maxRole', anyAdmin')
|
||||
| otherwise = (invited, current, maxRole, anyAdmin)
|
||||
deleteInvitedMems :: User -> [GroupMember] -> CM ([ChatError], [GroupMember])
|
||||
deleteInvitedMems user memsToDelete = do
|
||||
deleteMembersConnections user memsToDelete
|
||||
lift $ partitionEithers <$> withStoreBatch' (\db -> map (delMember db) memsToDelete)
|
||||
where
|
||||
delMember db m = do
|
||||
deleteGroupMember db user m
|
||||
pure m {memberStatus = GSMemRemoved}
|
||||
deleteCurrentMems :: User -> Group -> [GroupMember] -> CM ([ChatError], [GroupMember], [AChatItem])
|
||||
deleteCurrentMems user (Group gInfo members) memsToDelete = case L.nonEmpty memsToDelete of
|
||||
Nothing -> pure ([], [], [])
|
||||
Just memsToDelete' -> do
|
||||
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
|
||||
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)
|
||||
let acis = map (AChatItem SCTGroup SMDSnd (GroupChat gInfo)) $ rights cis_
|
||||
pure (errs, deleted, acis)
|
||||
where
|
||||
sndItemData :: GroupMember -> SndMessage -> NewSndChatItemData c
|
||||
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
|
||||
delMember db m = do
|
||||
deleteOrUpdateMemberRecordIO db user m
|
||||
pure m {memberStatus = GSMemRemoved}
|
||||
APILeaveGroup groupId -> withUser $ \user@User {userId} -> do
|
||||
Group gInfo@GroupInfo {membership} members <- withFastStore $ \db -> getGroup db vr user groupId
|
||||
filesInfo <- withFastStore' $ \db -> getGroupFileInfo db user gInfo
|
||||
|
|
@ -2114,18 +2209,14 @@ processChatCommand' vr = \case
|
|||
JoinGroup gName enableNtfs -> withUser $ \user -> do
|
||||
groupId <- withFastStore $ \db -> getGroupIdByName db user gName
|
||||
processChatCommand $ APIJoinGroup groupId enableNtfs
|
||||
MemberRole gName gMemberName memRole -> withMemberName gName gMemberName $ \gId gMemberId -> APIMemberRole gId gMemberId memRole
|
||||
BlockForAll gName gMemberName blocked -> withMemberName gName gMemberName $ \gId gMemberId -> APIBlockMemberForAll gId gMemberId blocked
|
||||
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
|
||||
(gId, gMemberIds) <- withStore $ \db -> do
|
||||
gId <- getGroupIdByName db user gName
|
||||
gMemberIds <- forM gMemberNames $ getGroupMemberIdByName db user gId
|
||||
pure (gId, gMemberIds)
|
||||
rs <- forM (L.zip (L.fromList [1..]) gMemberIds) $ \(i, memId) -> do
|
||||
r <- processChatCommand (APIRemoveMember gId memId)
|
||||
when (i < length gMemberIds) $ toView r
|
||||
pure r
|
||||
pure $ L.last rs
|
||||
processChatCommand $ APIRemoveMembers gId gMemberIds
|
||||
LeaveGroup gName -> withUser $ \user -> do
|
||||
groupId <- withFastStore $ \db -> getGroupIdByName db user gName
|
||||
processChatCommand $ APILeaveGroup groupId
|
||||
|
|
@ -3090,7 +3181,7 @@ processChatCommand' vr = \case
|
|||
(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
|
||||
when (length itemsData /= length cmrs) $ logError "sendGroupContentMessages: cmrs and cis_ length mismatch"
|
||||
when (length cis_ /= length cmrs) $ logError "sendGroupContentMessages: cmrs and cis_ length mismatch"
|
||||
createMemberSndStatuses cis_ msgs_ gsr
|
||||
let r@(_, cis) = partitionEithers cis_
|
||||
processSendErrs user r
|
||||
|
|
@ -3795,9 +3886,9 @@ chatCommandP =
|
|||
"/_ntf conn messages " *> (ApiGetConnNtfMessages <$> strP),
|
||||
"/_add #" *> (APIAddMember <$> A.decimal <* A.space <*> A.decimal <*> memberRole),
|
||||
"/_join #" *> (APIJoinGroup <$> A.decimal <*> pure MFAll), -- needs to be changed to support in UI
|
||||
"/_member role #" *> (APIMemberRole <$> A.decimal <* A.space <*> A.decimal <*> memberRole),
|
||||
"/_block #" *> (APIBlockMemberForAll <$> A.decimal <* A.space <*> A.decimal <* A.space <* "blocked=" <*> onOffP),
|
||||
"/_remove #" *> (APIRemoveMember <$> A.decimal <* A.space <*> A.decimal),
|
||||
"/_member role #" *> (APIMembersRole <$> A.decimal <*> _strP <*> memberRole),
|
||||
"/_block #" *> (APIBlockMembersForAll <$> A.decimal <*> _strP <* A.space <* "blocked=" <*> onOffP),
|
||||
"/_remove #" *> (APIRemoveMembers <$> A.decimal <*> _strP),
|
||||
"/_leave #" *> (APILeaveGroup <$> A.decimal),
|
||||
"/_members #" *> (APIListMembers <$> A.decimal),
|
||||
"/_server test " *> (APITestProtoServer <$> A.decimal <* A.space <*> strP),
|
||||
|
|
|
|||
|
|
@ -1251,11 +1251,14 @@ deleteMemberConnection' user GroupMember {activeConn} waitDelivery = do
|
|||
withStore' $ \db -> updateConnectionStatus db conn ConnDeleted
|
||||
|
||||
deleteOrUpdateMemberRecord :: User -> GroupMember -> CM ()
|
||||
deleteOrUpdateMemberRecord user@User {userId} member =
|
||||
withStore' $ \db ->
|
||||
checkGroupMemberHasItems db user member >>= \case
|
||||
Just _ -> updateGroupMemberStatus db userId member GSMemRemoved
|
||||
Nothing -> deleteGroupMember db user member
|
||||
deleteOrUpdateMemberRecord user member =
|
||||
withStore' $ \db -> deleteOrUpdateMemberRecordIO db user member
|
||||
|
||||
deleteOrUpdateMemberRecordIO :: DB.Connection -> User -> GroupMember -> IO ()
|
||||
deleteOrUpdateMemberRecordIO db user@User {userId} member =
|
||||
checkGroupMemberHasItems db user member >>= \case
|
||||
Just _ -> updateGroupMemberStatus db userId member GSMemRemoved
|
||||
Nothing -> deleteGroupMember db user member
|
||||
|
||||
sendDirectContactMessages :: MsgEncodingI e => User -> Contact -> NonEmpty (ChatMsgEvent e) -> CM [Either ChatError SndMessage]
|
||||
sendDirectContactMessages user ct events = do
|
||||
|
|
|
|||
|
|
@ -2608,7 +2608,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
|||
|
||||
xGrpMemRestrict :: GroupInfo -> GroupMember -> MemberId -> MemberRestrictions -> RcvMessage -> UTCTime -> CM ()
|
||||
xGrpMemRestrict
|
||||
gInfo@GroupInfo {groupId, membership = GroupMember {memberId = membershipMemId}}
|
||||
gInfo@GroupInfo {membership = GroupMember {memberId = membershipMemId}}
|
||||
m@GroupMember {memberRole = senderRole}
|
||||
memId
|
||||
MemberRestrictions {restriction}
|
||||
|
|
@ -2619,10 +2619,11 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
|||
messageError "x.grp.mem.restrict: admin blocks you"
|
||||
| otherwise =
|
||||
withStore' (\db -> runExceptT $ getGroupMemberByMemberId db vr user gInfo memId) >>= \case
|
||||
Right bm@GroupMember {groupMemberId = bmId, memberRole, memberProfile = bmp}
|
||||
Right bm@GroupMember {groupMemberId = bmId, memberRole, blockedByAdmin, memberProfile = bmp}
|
||||
| blockedByAdmin == mrsBlocked restriction -> pure ()
|
||||
| senderRole < GRModerator || senderRole < memberRole -> messageError "x.grp.mem.restrict with insufficient member permissions"
|
||||
| otherwise -> do
|
||||
bm' <- setMemberBlocked bmId
|
||||
bm' <- setMemberBlocked bm
|
||||
toggleNtf user bm' (not blocked)
|
||||
let ciContent = CIRcvGroupEvent $ RGEMemberBlocked bmId (fromLocalProfile bmp) blocked
|
||||
ci <- saveRcvChatItemNoParse user (CDGroupRcv gInfo m) msg brokerTs ciContent
|
||||
|
|
@ -2630,14 +2631,11 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
|||
toView CRMemberBlockedForAll {user, groupInfo = gInfo, byMember = m, member = bm, blocked}
|
||||
Left (SEGroupMemberNotFoundByMemberId _) -> do
|
||||
bm <- createUnknownMember gInfo memId
|
||||
bm' <- setMemberBlocked $ groupMemberId' bm
|
||||
bm' <- setMemberBlocked bm
|
||||
toView $ CRUnknownMemberBlocked user gInfo m bm'
|
||||
Left e -> throwError $ ChatErrorStore e
|
||||
where
|
||||
setMemberBlocked bmId =
|
||||
withStore $ \db -> do
|
||||
liftIO $ updateGroupMemberBlocked db user groupId bmId restriction
|
||||
getGroupMember db vr user groupId bmId
|
||||
setMemberBlocked bm = withStore' $ \db -> updateGroupMemberBlocked db user gInfo restriction bm
|
||||
blocked = mrsBlocked restriction
|
||||
|
||||
xGrpMemCon :: GroupInfo -> GroupMember -> MemberId -> CM ()
|
||||
|
|
|
|||
|
|
@ -33,9 +33,9 @@ data RcvGroupEvent
|
|||
|
||||
data SndGroupEvent
|
||||
= SGEMemberRole {groupMemberId :: GroupMemberId, profile :: Profile, role :: GroupMemberRole}
|
||||
| SGEMemberBlocked {groupMemberId :: GroupMemberId, profile :: Profile, blocked :: Bool} -- CRMemberBlockedForAllUser
|
||||
| SGEMemberBlocked {groupMemberId :: GroupMemberId, profile :: Profile, blocked :: Bool} -- CRMembersBlockedForAllUser
|
||||
| SGEUserRole {role :: GroupMemberRole}
|
||||
| SGEMemberDeleted {groupMemberId :: GroupMemberId, profile :: Profile} -- CRUserDeletedMember
|
||||
| SGEMemberDeleted {groupMemberId :: GroupMemberId, profile :: Profile} -- CRUserDeletedMembers
|
||||
| SGEUserLeft -- CRLeftMemberUser
|
||||
| SGEGroupUpdated {groupProfile :: GroupProfile} -- CRGroupUpdated
|
||||
deriving (Show)
|
||||
|
|
|
|||
|
|
@ -2062,8 +2062,8 @@ updateGroupMemberSettings db User {userId} gId gMemberId GroupMemberSettings {sh
|
|||
|]
|
||||
(BI showMessages, currentTs, userId, gId, gMemberId)
|
||||
|
||||
updateGroupMemberBlocked :: DB.Connection -> User -> GroupId -> GroupMemberId -> MemberRestrictionStatus -> IO ()
|
||||
updateGroupMemberBlocked db User {userId} gId gMemberId memberBlocked = do
|
||||
updateGroupMemberBlocked :: DB.Connection -> User -> GroupInfo -> MemberRestrictionStatus -> GroupMember -> IO GroupMember
|
||||
updateGroupMemberBlocked db User {userId} GroupInfo {groupId} mrs m@GroupMember {groupMemberId} = do
|
||||
currentTs <- getCurrentTime
|
||||
DB.execute
|
||||
db
|
||||
|
|
@ -2072,7 +2072,8 @@ updateGroupMemberBlocked db User {userId} gId gMemberId memberBlocked = do
|
|||
SET member_restriction = ?, updated_at = ?
|
||||
WHERE user_id = ? AND group_id = ? AND group_member_id = ?
|
||||
|]
|
||||
(memberBlocked, currentTs, userId, gId, gMemberId)
|
||||
(mrs, currentTs, userId, groupId, groupMemberId)
|
||||
pure m {blockedByAdmin = mrsBlocked mrs}
|
||||
|
||||
getXGrpMemIntroContDirect :: DB.Connection -> User -> Contact -> IO (Maybe (Int64, XGrpMemIntroCont))
|
||||
getXGrpMemIntroContDirect db User {userId} Contact {contactId} = do
|
||||
|
|
|
|||
|
|
@ -220,7 +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..."]
|
||||
CRUserDeletedMember u g m -> ttyUser u [ttyGroup' g <> ": you removed " <> ttyMember m <> " from 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"]
|
||||
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]
|
||||
|
|
@ -301,9 +303,9 @@ responseToView hu@(currentRH, user_) ChatConfig {logLevel, showReactions, showRe
|
|||
CRJoinedGroupMemberConnecting u g host m -> ttyUser u [ttyGroup' g <> ": " <> ttyMember host <> " added " <> ttyFullMember m <> " to the group (connecting...)"]
|
||||
CRConnectedToGroupMember u g m _ -> ttyUser u [ttyGroup' g <> ": " <> connectedMember m <> " is connected"]
|
||||
CRMemberRole u g by m r r' -> ttyUser u $ viewMemberRoleChanged g by m r r'
|
||||
CRMemberRoleUser u g m r r' -> ttyUser u $ viewMemberRoleUserChanged g m r r'
|
||||
CRMembersRoleUser u g members r' -> ttyUser u $ viewMemberRoleUserChanged g members r'
|
||||
CRMemberBlockedForAll u g by m blocked -> ttyUser u $ viewMemberBlockedForAll g by m blocked
|
||||
CRMemberBlockedForAllUser u g m blocked -> ttyUser u $ viewMemberBlockedForAllUser g 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"]
|
||||
CRLeftMember u g m -> ttyUser u [ttyGroup' g <> ": " <> ttyMember m <> " left the group"]
|
||||
|
|
@ -1109,21 +1111,19 @@ viewMemberRoleChanged g@GroupInfo {membership} by m r r'
|
|||
memId = groupMemberId' m
|
||||
view s = [ttyGroup' g <> ": " <> ttyMember by <> " changed " <> s <> " from " <> showRole r <> " to " <> showRole r']
|
||||
|
||||
viewMemberRoleUserChanged :: GroupInfo -> GroupMember -> GroupMemberRole -> GroupMemberRole -> [StyledString]
|
||||
viewMemberRoleUserChanged g@GroupInfo {membership} m r r'
|
||||
| r == r' = [ttyGroup' g <> ": member role did not change"]
|
||||
| groupMemberId' membership == groupMemberId' m = view "your role"
|
||||
| otherwise = view $ "the role of " <> ttyMember m
|
||||
where
|
||||
view s = [ttyGroup' g <> ": you changed " <> s <> " from " <> showRole r <> " to " <> showRole r']
|
||||
viewMemberRoleUserChanged :: GroupInfo -> [GroupMember] -> GroupMemberRole -> [StyledString]
|
||||
viewMemberRoleUserChanged g members r = case members of
|
||||
[m] -> [ttyGroup' g <> ": you changed the role of " <> ttyMember m <> " to " <> showRole r]
|
||||
mems' -> [ttyGroup' g <> ": you changed the role of " <> sShow (length mems') <> " members to " <> showRole r]
|
||||
|
||||
viewMemberBlockedForAll :: GroupInfo -> GroupMember -> GroupMember -> Bool -> [StyledString]
|
||||
viewMemberBlockedForAll g by m blocked =
|
||||
[ttyGroup' g <> ": " <> ttyMember by <> " " <> (if blocked then "blocked" else "unblocked") <> " " <> ttyMember m]
|
||||
|
||||
viewMemberBlockedForAllUser :: GroupInfo -> GroupMember -> Bool -> [StyledString]
|
||||
viewMemberBlockedForAllUser g m blocked =
|
||||
[ttyGroup' g <> ": you " <> (if blocked then "blocked" else "unblocked") <> " " <> ttyMember m]
|
||||
viewMembersBlockedForAllUser :: GroupInfo -> [GroupMember] -> Bool -> [StyledString]
|
||||
viewMembersBlockedForAllUser g members blocked = case members of
|
||||
[m] -> [ttyGroup' g <> ": you " <> (if blocked then "blocked" else "unblocked") <> " " <> ttyMember m]
|
||||
mems' -> [ttyGroup' g <> ": you " <> (if blocked then "blocked" else "unblocked") <> " " <> sShow (length mems') <> " members"]
|
||||
|
||||
showRole :: GroupMemberRole -> StyledString
|
||||
showRole = plain . strEncode
|
||||
|
|
|
|||
|
|
@ -122,7 +122,7 @@ testDirectoryService ps =
|
|||
bob <# "SimpleX-Directory> You must grant directory service admin role to register the group"
|
||||
bob ##> "/mr PSA SimpleX-Directory admin"
|
||||
-- putStrLn "*** discover service joins group and creates the link for profile"
|
||||
bob <## "#PSA: you changed the role of SimpleX-Directory from member to admin"
|
||||
bob <## "#PSA: you changed the role of SimpleX-Directory to admin"
|
||||
bob <# "SimpleX-Directory> Joining the group PSA…"
|
||||
bob <## "#PSA: SimpleX-Directory joined the group"
|
||||
bob <# "SimpleX-Directory> Joined the group PSA, creating the link…"
|
||||
|
|
@ -579,7 +579,7 @@ testDelistedRoleChanges ps =
|
|||
groupFoundN 3 cath "privacy"
|
||||
-- de-listed if service role changed
|
||||
bob ##> "/mr privacy SimpleX-Directory member"
|
||||
bob <## "#privacy: you changed the role of SimpleX-Directory from admin to member"
|
||||
bob <## "#privacy: you changed the role of SimpleX-Directory to member"
|
||||
cath <## "#privacy: bob changed the role of SimpleX-Directory from admin to member"
|
||||
bob <# "SimpleX-Directory> SimpleX-Directory role in the group ID 1 (privacy) is changed to member."
|
||||
bob <## ""
|
||||
|
|
@ -588,7 +588,7 @@ testDelistedRoleChanges ps =
|
|||
groupNotFound cath "privacy"
|
||||
-- re-listed if service role changed back without profile changes
|
||||
cath ##> "/mr privacy SimpleX-Directory admin"
|
||||
cath <## "#privacy: you changed the role of SimpleX-Directory from member to admin"
|
||||
cath <## "#privacy: you changed the role of SimpleX-Directory to admin"
|
||||
bob <## "#privacy: cath changed the role of SimpleX-Directory from member to admin"
|
||||
bob <# "SimpleX-Directory> SimpleX-Directory role in the group ID 1 (privacy) is changed to admin."
|
||||
bob <## ""
|
||||
|
|
@ -597,7 +597,7 @@ testDelistedRoleChanges ps =
|
|||
groupFoundN 3 cath "privacy"
|
||||
-- de-listed if owner role changed
|
||||
cath ##> "/mr privacy bob admin"
|
||||
cath <## "#privacy: you changed the role of bob from owner to admin"
|
||||
cath <## "#privacy: you changed the role of bob to admin"
|
||||
bob <## "#privacy: cath changed your role from owner to admin"
|
||||
bob <# "SimpleX-Directory> Your role in the group ID 1 (privacy) is changed to admin."
|
||||
bob <## ""
|
||||
|
|
@ -606,7 +606,7 @@ testDelistedRoleChanges ps =
|
|||
groupNotFound cath "privacy"
|
||||
-- re-listed if owner role changed back without profile changes
|
||||
cath ##> "/mr privacy bob owner"
|
||||
cath <## "#privacy: you changed the role of bob from admin to owner"
|
||||
cath <## "#privacy: you changed the role of bob to owner"
|
||||
bob <## "#privacy: cath changed your role from admin to owner"
|
||||
bob <# "SimpleX-Directory> Your role in the group ID 1 (privacy) is changed to owner."
|
||||
bob <## ""
|
||||
|
|
@ -627,7 +627,7 @@ testNotDelistedMemberRoleChanged ps =
|
|||
cath <## "use @SimpleX-Directory <message> to send messages"
|
||||
groupFoundN 3 cath "privacy"
|
||||
bob ##> "/mr privacy cath member"
|
||||
bob <## "#privacy: you changed the role of cath from owner to member"
|
||||
bob <## "#privacy: you changed the role of cath to member"
|
||||
cath <## "#privacy: bob changed your role from owner to member"
|
||||
groupFoundN 3 cath "privacy"
|
||||
|
||||
|
|
@ -641,11 +641,11 @@ testNotSentApprovalBadRoles ps =
|
|||
submitGroup bob "privacy" "Privacy"
|
||||
welcomeWithLink <- groupAccepted bob "privacy"
|
||||
bob ##> "/mr privacy SimpleX-Directory member"
|
||||
bob <## "#privacy: you changed the role of SimpleX-Directory from admin to member"
|
||||
bob <## "#privacy: you changed the role of SimpleX-Directory to member"
|
||||
updateProfileWithLink bob "privacy" welcomeWithLink 1
|
||||
bob <# "SimpleX-Directory> You must grant directory service admin role to register the group"
|
||||
bob ##> "/mr privacy SimpleX-Directory admin"
|
||||
bob <## "#privacy: you changed the role of SimpleX-Directory from member to admin"
|
||||
bob <## "#privacy: you changed the role of SimpleX-Directory to admin"
|
||||
bob <# "SimpleX-Directory> SimpleX-Directory role in the group ID 1 (privacy) is changed to admin."
|
||||
bob <## ""
|
||||
bob <## "The group is submitted for approval."
|
||||
|
|
@ -666,14 +666,14 @@ testNotApprovedBadRoles ps =
|
|||
updateProfileWithLink bob "privacy" welcomeWithLink 1
|
||||
notifySuperUser superUser bob "privacy" "Privacy" welcomeWithLink 1
|
||||
bob ##> "/mr privacy SimpleX-Directory member"
|
||||
bob <## "#privacy: you changed the role of SimpleX-Directory from admin to member"
|
||||
bob <## "#privacy: you changed the role of SimpleX-Directory to member"
|
||||
let approve = "/approve 1:privacy 1"
|
||||
superUser #> ("@SimpleX-Directory " <> approve)
|
||||
superUser <# ("SimpleX-Directory> > " <> approve)
|
||||
superUser <## " Group is not approved: SimpleX-Directory is not an admin."
|
||||
groupNotFound cath "privacy"
|
||||
bob ##> "/mr privacy SimpleX-Directory admin"
|
||||
bob <## "#privacy: you changed the role of SimpleX-Directory from member to admin"
|
||||
bob <## "#privacy: you changed the role of SimpleX-Directory to admin"
|
||||
bob <# "SimpleX-Directory> SimpleX-Directory role in the group ID 1 (privacy) is changed to admin."
|
||||
bob <## ""
|
||||
bob <## "The group is submitted for approval."
|
||||
|
|
@ -940,7 +940,7 @@ testListUserGroups ps =
|
|||
-- with de-listed group
|
||||
groupFound cath "anonymity"
|
||||
cath ##> "/mr anonymity SimpleX-Directory member"
|
||||
cath <## "#anonymity: you changed the role of SimpleX-Directory from admin to member"
|
||||
cath <## "#anonymity: you changed the role of SimpleX-Directory to member"
|
||||
cath <# "SimpleX-Directory> SimpleX-Directory role in the group ID 1 (anonymity) is changed to member."
|
||||
cath <## ""
|
||||
cath <## "The group is no longer listed in the directory."
|
||||
|
|
|
|||
|
|
@ -173,7 +173,8 @@ chatGroupTests = do
|
|||
it "messages are fully deleted" testBlockForAllFullDelete
|
||||
it "another admin can unblock" testBlockForAllAnotherAdminUnblocks
|
||||
it "member was blocked before joining group" testBlockForAllBeforeJoining
|
||||
it "can't repeat block, unblock" testBlockForAllCantRepeat
|
||||
it "repeat block, unblock" testBlockForAllRepeat
|
||||
it "block multiple members" testBlockForAllMultipleMembers
|
||||
describe "group member inactivity" $ do
|
||||
it "mark member inactive on reaching quota" testGroupMemberInactive
|
||||
describe "group member reports" $ do
|
||||
|
|
@ -265,7 +266,7 @@ testGroupShared alice bob cath checkMessages = do
|
|||
-- test observer role
|
||||
alice ##> "/mr team bob observer"
|
||||
concurrentlyN_
|
||||
[ alice <## "#team: you changed the role of bob from admin to observer",
|
||||
[ alice <## "#team: you changed the role of bob to observer",
|
||||
bob <## "#team: alice changed your role from admin to observer",
|
||||
cath <## "#team: alice changed the role of bob from admin to observer"
|
||||
]
|
||||
|
|
@ -280,7 +281,7 @@ testGroupShared alice bob cath checkMessages = do
|
|||
]
|
||||
alice ##> "/mr team bob admin"
|
||||
concurrentlyN_
|
||||
[ alice <## "#team: you changed the role of bob from observer to admin",
|
||||
[ alice <## "#team: you changed the role of bob to admin",
|
||||
bob <## "#team: alice changed your role from observer to admin",
|
||||
cath <## "#team: alice changed the role of bob from observer to admin"
|
||||
]
|
||||
|
|
@ -1460,7 +1461,7 @@ testUpdateMemberRole =
|
|||
alice <## "to add members use /a team <name> or /create link #team"
|
||||
addMember "team" alice bob GRAdmin
|
||||
alice ##> "/mr team bob member"
|
||||
alice <## "#team: you changed the role of bob from admin to member"
|
||||
alice <## "#team: you changed the role of bob to member"
|
||||
bob <## "#team: alice invites you to join the group as member"
|
||||
bob <## "use /j team to accept"
|
||||
bob ##> "/j team"
|
||||
|
|
@ -1472,7 +1473,7 @@ testUpdateMemberRole =
|
|||
bob <## "#team: you have insufficient permissions for this action, the required role is admin"
|
||||
alice ##> "/mr team bob admin"
|
||||
concurrently_
|
||||
(alice <## "#team: you changed the role of bob from member to admin")
|
||||
(alice <## "#team: you changed the role of bob to admin")
|
||||
(bob <## "#team: alice changed your role from member to admin")
|
||||
bob ##> "/a team cath owner"
|
||||
bob <## "#team: you have insufficient permissions for this action, the required role is owner"
|
||||
|
|
@ -1488,13 +1489,7 @@ testUpdateMemberRole =
|
|||
alice <## "#team: new member cath is connected"
|
||||
]
|
||||
alice ##> "/mr team alice admin"
|
||||
concurrentlyN_
|
||||
[ alice <## "#team: you changed your role from owner to admin",
|
||||
bob <## "#team: alice changed the role from owner to admin",
|
||||
cath <## "#team: alice changed the role from owner to admin"
|
||||
]
|
||||
alice ##> "/d #team"
|
||||
alice <## "#team: you have insufficient permissions for this action, the required role is owner"
|
||||
alice <## "bad chat command: can't change role for self"
|
||||
|
||||
testGroupDescription :: HasCallStack => TestParams -> IO ()
|
||||
testGroupDescription = testChat4 aliceProfile bobProfile cathProfile danProfile $ \alice bob cath dan -> do
|
||||
|
|
@ -1579,7 +1574,7 @@ testGroupModerate =
|
|||
-- disableFullDeletion3 "team" alice bob cath
|
||||
alice ##> "/mr team cath member"
|
||||
concurrentlyN_
|
||||
[ alice <## "#team: you changed the role of cath from admin to member",
|
||||
[ alice <## "#team: you changed the role of cath to member",
|
||||
bob <## "#team: alice changed the role of cath from admin to member",
|
||||
cath <## "#team: alice changed your role from admin to member"
|
||||
]
|
||||
|
|
@ -1662,7 +1657,7 @@ testGroupModerateFullDelete =
|
|||
-- disableFullDeletion3 "team" alice bob cath
|
||||
alice ##> "/mr team cath member"
|
||||
concurrentlyN_
|
||||
[ alice <## "#team: you changed the role of cath from admin to member",
|
||||
[ alice <## "#team: you changed the role of cath to member",
|
||||
bob <## "#team: alice changed the role of cath from admin to member",
|
||||
cath <## "#team: alice changed your role from admin to member"
|
||||
]
|
||||
|
|
@ -2691,7 +2686,7 @@ testGroupLinkMemberRole =
|
|||
bob <## "#team: you don't have permission to send messages"
|
||||
|
||||
alice ##> "/mr #team bob member"
|
||||
alice <## "#team: you changed the role of bob from observer to member"
|
||||
alice <## "#team: you changed the role of bob to member"
|
||||
bob <## "#team: alice changed your role from observer to member"
|
||||
|
||||
bob #> "#team hey now"
|
||||
|
|
@ -2721,7 +2716,7 @@ testGroupLinkMemberRole =
|
|||
cath <## "#team: you don't have permission to send messages"
|
||||
|
||||
alice ##> "/mr #team cath admin"
|
||||
alice <## "#team: you changed the role of cath from observer to admin"
|
||||
alice <## "#team: you changed the role of cath to admin"
|
||||
cath <## "#team: alice changed your role from observer to admin"
|
||||
bob <## "#team: alice changed the role of cath from observer to admin"
|
||||
|
||||
|
|
@ -2730,7 +2725,7 @@ testGroupLinkMemberRole =
|
|||
bob <# "#team cath> hey"
|
||||
|
||||
cath ##> "/mr #team bob admin"
|
||||
cath <## "#team: you changed the role of bob from member to admin"
|
||||
cath <## "#team: you changed the role of bob to admin"
|
||||
bob <## "#team: cath changed your role from member to admin"
|
||||
alice <## "#team: cath changed the role of bob from member to admin"
|
||||
|
||||
|
|
@ -4132,14 +4127,14 @@ testGroupMsgForwardReport =
|
|||
|
||||
alice ##> "/mr team bob moderator"
|
||||
concurrentlyN_
|
||||
[ alice <## "#team: you changed the role of bob from admin to moderator",
|
||||
[ alice <## "#team: you changed the role of bob to moderator",
|
||||
bob <## "#team: alice changed your role from admin to moderator",
|
||||
cath <## "#team: alice changed the role of bob from admin to moderator"
|
||||
]
|
||||
|
||||
alice ##> "/mr team cath member"
|
||||
concurrentlyN_
|
||||
[ alice <## "#team: you changed the role of cath from admin to member",
|
||||
[ alice <## "#team: you changed the role of cath to member",
|
||||
bob <## "#team: alice changed the role of cath from admin to member",
|
||||
cath <## "#team: alice changed your role from admin to member"
|
||||
]
|
||||
|
|
@ -4157,7 +4152,7 @@ testGroupMsgForwardReport =
|
|||
|
||||
alice ##> "/mr team bob member"
|
||||
concurrentlyN_
|
||||
[ alice <## "#team: you changed the role of bob from moderator to member",
|
||||
[ alice <## "#team: you changed the role of bob to member",
|
||||
bob <## "#team: alice changed your role from moderator to member",
|
||||
cath <## "#team: alice changed the role of bob from moderator to member"
|
||||
]
|
||||
|
|
@ -4315,7 +4310,7 @@ testGroupMsgForwardChangeRole =
|
|||
setupGroupForwarding3 "team" alice bob cath
|
||||
|
||||
cath ##> "/mr #team bob member"
|
||||
cath <## "#team: you changed the role of bob from admin to member"
|
||||
cath <## "#team: you changed the role of bob to member"
|
||||
alice <## "#team: cath changed the role of bob from admin to member"
|
||||
bob <## "#team: cath changed your role from admin to member" -- TODO show as forwarded
|
||||
|
||||
|
|
@ -5942,19 +5937,13 @@ testBlockForAllBeforeJoining =
|
|||
cc <## "#team: alice added dan (Daniel) to the group (connecting...)"
|
||||
cc <## "#team: new member dan is connected"
|
||||
|
||||
testBlockForAllCantRepeat :: HasCallStack => TestParams -> IO ()
|
||||
testBlockForAllCantRepeat =
|
||||
testBlockForAllRepeat :: HasCallStack => TestParams -> IO ()
|
||||
testBlockForAllRepeat =
|
||||
testChat3 aliceProfile bobProfile cathProfile $
|
||||
\alice bob cath -> do
|
||||
createGroup3 "team" alice bob cath
|
||||
-- disableFullDeletion3 "team" alice bob cath
|
||||
|
||||
alice ##> "/unblock for all #team bob"
|
||||
alice <## "bad chat command: already unblocked"
|
||||
|
||||
cath ##> "/unblock for all #team bob"
|
||||
cath <## "bad chat command: already unblocked"
|
||||
|
||||
bob #> "#team 1"
|
||||
[alice, cath] *<# "#team bob> 1"
|
||||
|
||||
|
|
@ -5964,10 +5953,10 @@ testBlockForAllCantRepeat =
|
|||
bob <// 50000
|
||||
|
||||
alice ##> "/block for all #team bob"
|
||||
alice <## "bad chat command: already blocked"
|
||||
alice <## "#team: you blocked bob"
|
||||
|
||||
cath ##> "/block for all #team bob"
|
||||
cath <## "bad chat command: already blocked"
|
||||
cath <## "#team: you blocked bob"
|
||||
|
||||
bob #> "#team 2"
|
||||
alice <# "#team bob> 2 [blocked by admin] <muted>"
|
||||
|
|
@ -5979,16 +5968,92 @@ testBlockForAllCantRepeat =
|
|||
bob <// 50000
|
||||
|
||||
alice ##> "/unblock for all #team bob"
|
||||
alice <## "bad chat command: already unblocked"
|
||||
alice <## "#team: you unblocked bob"
|
||||
|
||||
cath ##> "/unblock for all #team bob"
|
||||
cath <## "bad chat command: already unblocked"
|
||||
cath <## "#team: you unblocked bob"
|
||||
|
||||
bob #> "#team 3"
|
||||
[alice, cath] *<# "#team bob> 3"
|
||||
|
||||
bob #$> ("/_get chat #1 count=3", chat, [(1, "1"), (1, "2"), (1, "3")])
|
||||
|
||||
testBlockForAllMultipleMembers :: HasCallStack => TestParams -> IO ()
|
||||
testBlockForAllMultipleMembers =
|
||||
testChat4 aliceProfile bobProfile cathProfile danProfile $
|
||||
\alice bob cath dan -> do
|
||||
createGroup3 "team" alice bob cath
|
||||
|
||||
connectUsers alice dan
|
||||
addMember "team" alice dan GRMember
|
||||
dan ##> "/j team"
|
||||
concurrentlyN_
|
||||
[ alice <## "#team: dan joined the group",
|
||||
do
|
||||
dan <## "#team: you joined the group"
|
||||
dan
|
||||
<### [ "#team: member bob (Bob) is connected",
|
||||
"#team: member cath (Catherine) is connected"
|
||||
],
|
||||
do
|
||||
bob <## "#team: alice added dan (Daniel) to the group (connecting...)"
|
||||
bob <## "#team: new member dan is connected",
|
||||
do
|
||||
cath <## "#team: alice added dan (Daniel) to the group (connecting...)"
|
||||
cath <## "#team: new member dan is connected"
|
||||
]
|
||||
|
||||
-- lower roles to for batch block to be allowed (can't batch block if admins are selected)
|
||||
alice ##> "/mr team bob member"
|
||||
concurrentlyN_
|
||||
[ alice <## "#team: you changed the role of bob to member",
|
||||
bob <## "#team: alice changed your role from admin to member",
|
||||
cath <## "#team: alice changed the role of bob from admin to member",
|
||||
dan <## "#team: alice changed the role of bob from admin to member"
|
||||
]
|
||||
alice ##> "/mr team cath member"
|
||||
concurrentlyN_
|
||||
[ alice <## "#team: you changed the role of cath to member",
|
||||
bob <## "#team: alice changed the role of cath from admin to member",
|
||||
cath <## "#team: alice changed your role from admin to member",
|
||||
dan <## "#team: alice changed the role of cath from admin to member"
|
||||
]
|
||||
|
||||
bob #> "#team 1"
|
||||
[alice, cath, dan] *<# "#team bob> 1"
|
||||
|
||||
cath #> "#team 2"
|
||||
[alice, bob, dan] *<# "#team cath> 2"
|
||||
|
||||
alice ##> "/_block #1 2,3 blocked=on"
|
||||
alice <## "#team: you blocked 2 members"
|
||||
dan <## "#team: alice blocked bob"
|
||||
dan <## "#team: alice blocked cath"
|
||||
bob <// 50000
|
||||
cath <// 50000
|
||||
|
||||
-- bob and cath don't know they are blocked and receive each other's messages
|
||||
bob #> "#team 3"
|
||||
[alice, dan] *<# "#team bob> 3 [blocked by admin] <muted>"
|
||||
cath <# "#team bob> 3"
|
||||
|
||||
cath #> "#team 4"
|
||||
[alice, dan] *<# "#team cath> 4 [blocked by admin] <muted>"
|
||||
bob <# "#team cath> 4"
|
||||
|
||||
alice ##> "/_block #1 2,3 blocked=off"
|
||||
alice <## "#team: you unblocked 2 members"
|
||||
dan <## "#team: alice unblocked bob"
|
||||
dan <## "#team: alice unblocked cath"
|
||||
bob <// 50000
|
||||
cath <// 50000
|
||||
|
||||
bob #> "#team 5"
|
||||
[alice, cath, dan] *<# "#team bob> 5"
|
||||
|
||||
cath #> "#team 6"
|
||||
[alice, bob, dan] *<# "#team cath> 6"
|
||||
|
||||
testGroupMemberInactive :: HasCallStack => TestParams -> IO ()
|
||||
testGroupMemberInactive ps = do
|
||||
withSmpServer' serverCfg' $ do
|
||||
|
|
@ -6067,13 +6132,13 @@ testGroupMemberReports =
|
|||
-- disableFullDeletion3 "jokes" alice bob cath
|
||||
alice ##> "/mr jokes bob moderator"
|
||||
concurrentlyN_
|
||||
[ alice <## "#jokes: you changed the role of bob from admin to moderator",
|
||||
[ alice <## "#jokes: you changed the role of bob to moderator",
|
||||
bob <## "#jokes: alice changed your role from admin to moderator",
|
||||
cath <## "#jokes: alice changed the role of bob from admin to moderator"
|
||||
]
|
||||
alice ##> "/mr jokes cath member"
|
||||
concurrentlyN_
|
||||
[ alice <## "#jokes: you changed the role of cath from admin to member",
|
||||
[ alice <## "#jokes: you changed the role of cath to member",
|
||||
bob <## "#jokes: alice changed the role of cath from admin to member",
|
||||
cath <## "#jokes: alice changed your role from admin to member"
|
||||
]
|
||||
|
|
|
|||
|
|
@ -773,7 +773,7 @@ testBusinessUpdateProfiles = withTestOutput $ testChat4 businessProfile alicePro
|
|||
biz <# "#alisa alisa_1> hello again"
|
||||
-- customer can invite members too, if business allows
|
||||
biz ##> "/mr alisa alisa_1 admin"
|
||||
biz <## "#alisa: you changed the role of alisa_1 from member to admin"
|
||||
biz <## "#alisa: you changed the role of alisa_1 to admin"
|
||||
alice <## "#biz: biz_1 changed your role from member to admin"
|
||||
connectUsers alice bob
|
||||
alice ##> "/a #biz bob"
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue