From 37e4bb136901b459442f352cab92579688b0467a Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Fri, 23 Sep 2022 10:21:36 +0200 Subject: [PATCH] Restore previous behaviour of kicking After #2667, when users are kicked out of a conversation, the events being sent out would look like normal leave events. This commit restores the previous behaviour: the events reflect the fact that the user was kicked out, with the originating user set to the user who caused the change that required users to be removed. --- changelog.d/1-api-changes/backend-removal-fix | 1 + services/galley/src/Galley/API/Action.hs | 67 +++++++++++++------ services/galley/test/integration/API.hs | 41 ++++++------ 3 files changed, 69 insertions(+), 40 deletions(-) create mode 100644 changelog.d/1-api-changes/backend-removal-fix diff --git a/changelog.d/1-api-changes/backend-removal-fix b/changelog.d/1-api-changes/backend-removal-fix new file mode 100644 index 00000000000..e855500394a --- /dev/null +++ b/changelog.d/1-api-changes/backend-removal-fix @@ -0,0 +1 @@ +Users being kicked out results in member-leave events originating from the user who caused the change in the conversation diff --git a/services/galley/src/Galley/API/Action.hs b/services/galley/src/Galley/API/Action.hs index d7e3ad707eb..dcae8353e87 100644 --- a/services/galley/src/Galley/API/Action.hs +++ b/services/galley/src/Galley/API/Action.hs @@ -340,7 +340,7 @@ performAction tag origUser lconv action = do E.setConversationReceiptMode (tUnqualified lcnv) (cruReceiptMode action) pure (mempty, action) SConversationAccessDataTag -> do - (bm, act) <- performConversationAccessData lconv action + (bm, act) <- performConversationAccessData origUser lconv action pure (bm, act) performConversationJoin :: @@ -457,14 +457,11 @@ performConversationJoin qusr lconv (ConversationJoin invited role) = do then do for_ convUsersLHStatus $ \(mem, status) -> when (consentGiven status == ConsentNotGiven) $ do - let lvictim = qualifyAs lconv (lmId mem) - void . runError @NoChanges $ - updateLocalConversation - @'ConversationLeaveTag - (fmap convId lconv) - (qUntagged lvictim) - Nothing - () + kickMember + qusr + lconv + (convBotsAndMembers (tUnqualified lconv)) + (qUntagged (qualifyAs lconv (lmId mem))) else throwS @'MissingLegalholdConsent checkLHPolicyConflictsRemote :: @@ -474,10 +471,11 @@ performConversationJoin qusr lconv (ConversationJoin invited role) = do performConversationAccessData :: (HasConversationActionEffects 'ConversationAccessDataTag r) => + Qualified UserId -> Local Conversation -> ConversationAccessData -> Sem r (BotsAndMembers, ConversationAccessData) -performConversationAccessData lconv action = do +performConversationAccessData qusr lconv action = do when (convAccessData conv == action) noChanges -- Remove conversation codes if CodeAccess is revoked when @@ -506,16 +504,8 @@ performConversationAccessData lconv action = do let bmToNotify = current {bmBots = bmBots desired} -- Remove users and notify everyone - for_ (bmQualifiedMembers lcnv toRemove) $ \userToRemove -> do - (extraTargets, action') <- performAction SConversationLeaveTag userToRemove lconv () - notifyConversationAction - (sing @'ConversationLeaveTag) - userToRemove - True - Nothing - lconv - (bmToNotify <> extraTargets) - action' + for_ (bmQualifiedMembers lcnv toRemove) $ + kickMember qusr lconv bmToNotify pure (mempty, action) where @@ -792,3 +782,40 @@ notifyRemoteConversationAction loc rconvUpdate con = do let bots = [] pushConversationEvent con event localPresentUsers bots $> event + +-- | Kick a user from a conversation and send notifications. +-- +-- This function removes the given victim from the conversation by making them +-- leave, but then sends notifications as if the user was removed by someone +-- else. +kickMember :: + ( Member (Error InternalError) r, + Member ExternalAccess r, + Member FederatorAccess r, + Member GundeckAccess r, + Member ProposalStore r, + Member (Input UTCTime) r, + Member (Input Env) r, + Member MemberStore r, + Member TinyLog r + ) => + Qualified UserId -> + Local Conversation -> + BotsAndMembers -> + Qualified UserId -> + Sem r () +kickMember qusr lconv targets victim = void . runError @NoChanges $ do + (extraTargets, _) <- + performAction + SConversationLeaveTag + victim + lconv + () + notifyConversationAction + (sing @'ConversationRemoveMembersTag) + qusr + True + Nothing + lconv + (targets <> extraTargets) + (pure victim) diff --git a/services/galley/test/integration/API.hs b/services/galley/test/integration/API.hs index 7ecd707a9f0..19c775fc400 100644 --- a/services/galley/test/integration/API.hs +++ b/services/galley/test/integration/API.hs @@ -1483,9 +1483,9 @@ postConvertTeamConv = do -- non-team members get kicked out liftIO $ do WS.assertMatchN_ (5 # Second) [wsA, wsB, wsE, wsM] $ - wsAssertMemberLeave qconv qeve (pure qeve) + wsAssertMemberLeave qconv qalice (pure qeve) WS.assertMatchN_ (5 # Second) [wsA, wsB, wsE, wsM] $ - wsAssertMemberLeave qconv qmallory (pure qmallory) + wsAssertMemberLeave qconv qalice (pure qmallory) -- joining (for mallory) is no longer possible postJoinCodeConv mallory j !!! const 403 === statusCode -- team members (dave) can still join @@ -1537,14 +1537,17 @@ testAccessUpdateGuestRemoved = do -- note that removing users happens asynchronously, so this check should -- happen while the mock federator is still available WS.assertMatchN_ (5 # Second) [wsA, wsB, wsC] $ - wsAssertMembersLeave (cnvQualifiedId conv) charlie [charlie] + wsAssertMembersLeave (cnvQualifiedId conv) alice [charlie] WS.assertMatchN_ (5 # Second) [wsA, wsB, wsC] $ - wsAssertMembersLeave (cnvQualifiedId conv) dee [dee] + wsAssertMembersLeave (cnvQualifiedId conv) alice [dee] -- dee's remote receives a notification + let compareLists [] ys = [] @?= ys + compareLists (x : xs) ys = case break (== x) ys of + (ys1, _ : ys2) -> compareLists xs (ys1 <> ys2) + _ -> assertFailure $ "Could not find " <> show x <> " in " <> show ys liftIO $ - sortOn - (fmap fst) + compareLists ( map ( \fr -> do cu <- eitherDecode (frBody fr) @@ -1558,20 +1561,18 @@ testAccessUpdateGuestRemoved = do reqs ) ) - @?= sortOn - (fmap fst) - [ Right (charlie, SomeConversationAction (sing @'ConversationLeaveTag) ()), - Right (dee, SomeConversationAction (sing @'ConversationLeaveTag) ()), - Right - ( alice, - SomeConversationAction - (sing @'ConversationAccessDataTag) - ConversationAccessData - { cupAccess = mempty, - cupAccessRoles = Set.fromList [TeamMemberAccessRole] - } - ) - ] + [ Right (alice, SomeConversationAction (sing @'ConversationRemoveMembersTag) (pure charlie)), + Right (alice, SomeConversationAction (sing @'ConversationRemoveMembersTag) (pure dee)), + Right + ( alice, + SomeConversationAction + (sing @'ConversationAccessDataTag) + ConversationAccessData + { cupAccess = mempty, + cupAccessRoles = Set.fromList [TeamMemberAccessRole] + } + ) + ] -- only alice and bob remain conv2 <-