diff --git a/changelog.d/3-bug-fixes/WPB-5603 b/changelog.d/3-bug-fixes/WPB-5603 new file mode 100644 index 0000000000..c7e8354eb8 --- /dev/null +++ b/changelog.d/3-bug-fixes/WPB-5603 @@ -0,0 +1 @@ +Fix a bug where non-team conversation members that are remote would not get a `conversation.member-leave` event diff --git a/integration/test/API/Galley.hs b/integration/test/API/Galley.hs index 66755cc8e7..4de181b0c9 100644 --- a/integration/test/API/Galley.hs +++ b/integration/test/API/Galley.hs @@ -3,6 +3,7 @@ module API.Galley where +import API.Common import Control.Lens hiding ((.=)) import Control.Monad.Reader import Data.Aeson qualified as Aeson @@ -100,6 +101,21 @@ deleteTeamConversation tid qcnv user = do req <- baseRequest user Galley Versioned path submit "DELETE" req +deleteTeamMember :: + ( HasCallStack, + MakesValue owner, + MakesValue member + ) => + String -> + owner -> + member -> + App Response +deleteTeamMember tid owner mem = do + memId <- objId mem + let path = joinHttpPath ["teams", tid, "members", memId] + req <- baseRequest owner Galley Versioned path + submit "DELETE" (addJSONObject ["password" .= defPassword] req) + putConversationProtocol :: ( HasCallStack, MakesValue user, diff --git a/integration/test/Notifications.hs b/integration/test/Notifications.hs index 861191fce9..ec92dd390b 100644 --- a/integration/test/Notifications.hs +++ b/integration/test/Notifications.hs @@ -110,6 +110,9 @@ isConvCreateNotif n = fieldEquals n "payload.0.type" "conversation.create" isConvDeleteNotif :: MakesValue a => a -> App Bool isConvDeleteNotif n = fieldEquals n "payload.0.type" "conversation.delete" +isTeamMemberLeaveNotif :: MakesValue a => a -> App Bool +isTeamMemberLeaveNotif n = nPayload n %. "type" `isEqual` "team.member-leave" + assertLeaveNotification :: ( HasCallStack, MakesValue fromUser, diff --git a/integration/test/Test/Conversation.hs b/integration/test/Test/Conversation.hs index 87b588614e..4b07747cd3 100644 --- a/integration/test/Test/Conversation.hs +++ b/integration/test/Test/Conversation.hs @@ -660,6 +660,33 @@ testDeleteTeamConversationWithUnreachableRemoteMembers = do notif <- awaitNotification bob bobClient noValue isConvDeleteNotif assertNotification notif +testDeleteTeamMember :: HasCallStack => App () +testDeleteTeamMember = do + (alice, team, [alex]) <- createTeam OwnDomain 2 + [amy, bob] <- for [OwnDomain, OtherDomain] $ flip randomUser def + forM_ [amy, bob] $ connectTwoUsers alice + [aliceId, alexId, amyId, bobId] <- + forM [alice, alex, amy, bob] (%. "qualified_id") + let nc = (defProteus {qualifiedUsers = [alexId, amyId, bobId], team = Just team}) + conv <- postConversation alice nc >>= getJSON 201 + withWebSockets [alice, amy, bob] $ \[wsAlice, wsAmy, wsBob] -> do + void $ deleteTeamMember team alice alex >>= getBody 202 + do + n <- awaitMatch isTeamMemberLeaveNotif wsAlice + alexUId <- alex %. "id" + nPayload n %. "data.user" `shouldMatch` alexUId + do + n <- awaitMatch isConvLeaveNotif wsAmy + nPayload n %. "data.qualified_user_ids.0" `shouldMatch` alexId + do + bindResponse (getConversation bob conv) $ \resp -> do + resp.status `shouldMatchInt` 200 + mems <- resp.json %. "members.others" & asList + memIds <- forM mems (%. "qualified_id") + memIds `shouldMatchSet` [aliceId, amyId] + n <- awaitMatch isConvLeaveNotif wsBob + nPayload n %. "data.qualified_user_ids.0" `shouldMatch` alexId + testLeaveConversationSuccess :: HasCallStack => App () testLeaveConversationSuccess = do [alice, bob, chad, dee] <- createUsers [OwnDomain, OwnDomain, OtherDomain, OtherDomain] diff --git a/services/galley/src/Galley/API/Teams.hs b/services/galley/src/Galley/API/Teams.hs index 98573b9ef8..55e048f8b9 100644 --- a/services/galley/src/Galley/API/Teams.hs +++ b/services/galley/src/Galley/API/Teams.hs @@ -81,7 +81,9 @@ import Data.Proxy import Data.Qualified import Data.Range as Range import Data.Set qualified as Set +import Data.Singletons import Data.Time.Clock (UTCTime) +import Galley.API.Action import Galley.API.Error as Galley import Galley.API.LegalHold.Team import Galley.API.Teams.Notifications qualified as APITeamQueue @@ -120,7 +122,7 @@ import Polysemy.Output import Polysemy.TinyLog qualified as P import SAML2.WebSSO qualified as SAML import System.Logger (Msg) -import System.Logger.Class qualified as Log +import System.Logger qualified as Log import Wire.API.Conversation.Role (Action (DeleteConversation), wireConvRoles) import Wire.API.Conversation.Role qualified as Public import Wire.API.Error @@ -866,7 +868,8 @@ updateTeamMember lzusr zcon tid newMember = do && permissionsRole targetPermissions /= Just RoleOwner deleteTeamMember :: - ( Member BrigAccess r, + ( Member BackendNotificationQueueAccess r, + Member BrigAccess r, Member ConversationStore r, Member (Error AuthenticationError) r, Member (Error InvalidInput) r, @@ -891,7 +894,8 @@ deleteTeamMember :: deleteTeamMember lusr zcon tid remove body = deleteTeamMember' lusr zcon tid remove (Just body) deleteNonBindingTeamMember :: - ( Member BrigAccess r, + ( Member BackendNotificationQueueAccess r, + Member BrigAccess r, Member ConversationStore r, Member (Error AuthenticationError) r, Member (Error InvalidInput) r, @@ -916,7 +920,8 @@ deleteNonBindingTeamMember lusr zcon tid remove = deleteTeamMember' lusr zcon ti -- | 'TeamMemberDeleteData' is only required for binding teams deleteTeamMember' :: - ( Member BrigAccess r, + ( Member BackendNotificationQueueAccess r, + Member BrigAccess r, Member ConversationStore r, Member (Error AuthenticationError) r, Member (Error InvalidInput) r, @@ -974,10 +979,12 @@ deleteTeamMember' lusr zcon tid remove mBody = do -- This function is "unchecked" because it does not validate that the user has the `RemoveTeamMember` permission. uncheckedDeleteTeamMember :: forall r. - ( Member ConversationStore r, + ( Member BackendNotificationQueueAccess r, + Member ConversationStore r, Member GundeckAccess r, Member ExternalAccess r, Member (Input UTCTime) r, + Member (P.Logger (Log.Msg -> Log.Msg)) r, Member MemberStore r, Member TeamStore r ) => @@ -991,7 +998,8 @@ uncheckedDeleteTeamMember lusr zcon tid remove admins = do now <- input pushMemberLeaveEvent now E.deleteTeamMember tid remove - removeFromConvsAndPushConvLeaveEvent now + -- notify all conversation members not in this team. + removeFromConvsAndPushConvLeaveEvent lusr zcon tid remove admins where -- notify team admins pushMemberLeaveEvent :: UTCTime -> Sem r () @@ -1004,26 +1012,51 @@ uncheckedDeleteTeamMember lusr zcon tid remove admins = do (filter (/= (tUnqualified lusr)) admins) E.push1 $ newPushLocal1 ListComplete (tUnqualified lusr) (TeamEvent e) r & pushConn .~ zcon & pushTransient .~ True - -- notify all conversation members not in this team. - removeFromConvsAndPushConvLeaveEvent :: UTCTime -> Sem r () - removeFromConvsAndPushConvLeaveEvent now = do - let tmids = Set.fromList admins - let edata = Conv.EdMembersLeave Conv.EdReasonDeleted (Conv.QualifiedUserIdList [tUntagged (qualifyAs lusr remove)]) - cc <- E.getTeamConversations tid - for_ cc $ \c -> - E.getConversation (c ^. conversationId) >>= \conv -> - for_ conv $ \dc -> when (remove `isMember` Data.convLocalMembers dc) $ do - E.deleteMembers (c ^. conversationId) (UserList [remove] []) - pushEvent tmids edata now dc - pushEvent :: Set UserId -> Conv.EventData -> UTCTime -> Data.Conversation -> Sem r () - pushEvent exceptTo edata now dc = do - let qconvId = tUntagged $ qualifyAs lusr (Data.convId dc) - let (bots, users) = localBotsAndUsers (Data.convLocalMembers dc) - let x = filter (\m -> not (Conv.lmId m `Set.member` exceptTo)) users - let y = Conv.Event qconvId Nothing (tUntagged lusr) now edata - for_ (newPushLocal ListComplete (tUnqualified lusr) (ConvEvent y) (recipient <$> x)) $ \p -> - E.push1 $ p & pushConn .~ zcon - E.deliverAsync (map (,y) bots) + +removeFromConvsAndPushConvLeaveEvent :: + forall r. + ( Member BackendNotificationQueueAccess r, + Member ConversationStore r, + Member ExternalAccess r, + Member GundeckAccess r, + Member (Input UTCTime) r, + Member (P.Logger (Log.Msg -> Log.Msg)) r, + Member MemberStore r, + Member TeamStore r + ) => + Local UserId -> + Maybe ConnId -> + TeamId -> + UserId -> + [UserId] -> + Sem r () +removeFromConvsAndPushConvLeaveEvent lusr zcon tid remove admins = do + let teamAdmins = Set.fromList admins + cc <- E.getTeamConversations tid + for_ cc $ \c -> + E.getConversation (c ^. conversationId) >>= \conv -> + for_ conv $ \dc -> + when (remove `isMember` Data.convLocalMembers dc) $ do + E.deleteMembers (c ^. conversationId) (UserList [remove] []) + let (bots, allLocUsers) = localBotsAndUsers (Data.convLocalMembers dc) + notAdmins = + foldMap + (\m -> guard (not (Conv.lmId m `Set.member` teamAdmins)) $> Conv.lmId m) + allLocUsers + targets = + BotsAndMembers + (Set.fromList notAdmins) + (Set.fromList $ Conv.rmId <$> Data.convRemoteMembers dc) + (Set.fromList bots) + void $ + notifyConversationAction + (sing @'ConversationRemoveMembersTag) + (tUntagged lusr) + True + zcon + (qualifyAs lusr dc) + targets + (pure . tUntagged . qualifyAs lusr $ remove) getTeamConversations :: ( Member (ErrorS 'NotATeamMember) r,