diff --git a/changelog.d/6-federation/delete-conversations b/changelog.d/6-federation/delete-conversations new file mode 100644 index 0000000000..6fcac46d76 --- /dev/null +++ b/changelog.d/6-federation/delete-conversations @@ -0,0 +1 @@ +Support deleting conversations with federated users diff --git a/libs/wire-api/src/Wire/API/Conversation/Action.hs b/libs/wire-api/src/Wire/API/Conversation/Action.hs index 855376d852..a7bf22c23b 100644 --- a/libs/wire-api/src/Wire/API/Conversation/Action.hs +++ b/libs/wire-api/src/Wire/API/Conversation/Action.hs @@ -44,6 +44,7 @@ data ConversationAction | ConversationActionReceiptModeUpdate ConversationReceiptModeUpdate | ConversationActionMemberUpdate (Qualified UserId) OtherMemberUpdate | ConversationActionAccessUpdate ConversationAccessData + | ConversationActionDelete deriving stock (Eq, Show, Generic) deriving (Arbitrary) via (GenericUniform ConversationAction) deriving (ToJSON, FromJSON) via (CustomEncoded ConversationAction) @@ -71,6 +72,8 @@ conversationActionToEvent now quid qcnv (ConversationActionMemberUpdate target ( in Event MemberStateUpdate qcnv quid now (EdMemberUpdate update) conversationActionToEvent now quid qcnv (ConversationActionAccessUpdate update) = Event ConvAccessUpdate qcnv quid now (EdConvAccessUpdate update) +conversationActionToEvent now quid qcnv ConversationActionDelete = + Event ConvDelete qcnv quid now EdConvDelete conversationActionTag :: Qualified UserId -> ConversationAction -> Action conversationActionTag _ (ConversationActionAddMembers _ _) = AddConversationMember @@ -82,3 +85,4 @@ conversationActionTag _ (ConversationActionMessageTimerUpdate _) = ModifyConvers conversationActionTag _ (ConversationActionReceiptModeUpdate _) = ModifyConversationReceiptMode conversationActionTag _ (ConversationActionMemberUpdate _ _) = ModifyOtherConversationMember conversationActionTag _ (ConversationActionAccessUpdate _) = ModifyConversationAccess +conversationActionTag _ ConversationActionDelete = DeleteConversation diff --git a/services/galley/src/Galley/API/Federation.hs b/services/galley/src/Galley/API/Federation.hs index 3f1a7f2433..3870705d46 100644 --- a/services/galley/src/Galley/API/Federation.hs +++ b/services/galley/src/Galley/API/Federation.hs @@ -163,6 +163,9 @@ onConversationUpdated requestingDomain cu = do ConversationActionMemberUpdate _ _ -> pure (Just $ cuAction cu, []) ConversationActionReceiptModeUpdate _ -> pure (Just $ cuAction cu, []) ConversationActionAccessUpdate _ -> pure (Just $ cuAction cu, []) + ConversationActionDelete -> do + Data.removeLocalMembersFromRemoteConv rconvId presentUsers + pure (Just $ cuAction cu, []) unless allUsersArePresent $ Log.warn $ diff --git a/services/galley/src/Galley/API/Teams.hs b/services/galley/src/Galley/API/Teams.hs index d0221f3206..dd1c93e023 100644 --- a/services/galley/src/Galley/API/Teams.hs +++ b/services/galley/src/Galley/API/Teams.hs @@ -82,6 +82,7 @@ import qualified Data.UUID.Util as UUID import Galley.API.Error as Galley import Galley.API.LegalHold import qualified Galley.API.Teams.Notifications as APITeamQueue +import qualified Galley.API.Update as API import Galley.API.Util import Galley.App import qualified Galley.Data as Data @@ -89,7 +90,6 @@ import qualified Galley.Data.LegalHold as Data import qualified Galley.Data.SearchVisibility as SearchVisibilityData import Galley.Data.Services (BotMember) import qualified Galley.Data.TeamFeatures as TeamFeatures -import qualified Galley.Data.Types as Data import qualified Galley.External as External import qualified Galley.Intra.Journal as Journal import Galley.Intra.Push @@ -762,22 +762,10 @@ getTeamConversation zusr tid cid = do Data.teamConversation tid cid >>= maybe (throwErrorDescriptionType @ConvNotFound) pure deleteTeamConversation :: UserId -> ConnId -> TeamId -> ConvId -> Galley () -deleteTeamConversation zusr zcon tid cid = do - localDomain <- viewFederationDomain - let qconvId = Qualified cid localDomain - qusr = Qualified zusr localDomain - (bots, cmems) <- localBotsAndUsers <$> Data.members cid - ensureActionAllowed Roles.DeleteConversation =<< getSelfMemberFromLocalsLegacy zusr cmems - flip Data.deleteCode Data.ReusableCode =<< Data.mkKey cid - now <- liftIO getCurrentTime - let ce = Conv.Event Conv.ConvDelete qconvId qusr now Conv.EdConvDelete - let recps = fmap recipient cmems - let convPush = newPushLocal ListComplete zusr (ConvEvent ce) recps <&> pushConn .~ Just zcon - pushSome $ maybeToList convPush - void . forkIO $ void $ External.deliver (bots `zip` repeat ce) - -- TODO: we don't delete bots here, but we should do that, since every - -- bot user can only be in a single conversation - Data.removeTeamConv tid cid +deleteTeamConversation zusr zcon _tid cid = do + lusr <- qualifyLocal zusr + lconv <- qualifyLocal cid + void $ API.deleteLocalConversation lusr zcon lconv getSearchVisibilityH :: UserId ::: TeamId ::: JSON -> Galley Response getSearchVisibilityH (uid ::: tid ::: _) = do diff --git a/services/galley/src/Galley/API/Update.hs b/services/galley/src/Galley/API/Update.hs index 618834640f..ac0f1a5c3b 100644 --- a/services/galley/src/Galley/API/Update.hs +++ b/services/galley/src/Galley/API/Update.hs @@ -36,6 +36,7 @@ module Galley.API.Update updateLocalConversation, updateConversationAccessUnqualified, updateConversationAccess, + deleteLocalConversation, -- * Managing Members addMembersUnqualified, @@ -368,6 +369,15 @@ updateLocalConversationMessageTimer lusr con lcnv update = updateLocalConversation lcnv (qUntagged lusr) (Just con) $ ConversationActionMessageTimerUpdate update +deleteLocalConversation :: + Local UserId -> + ConnId -> + Local ConvId -> + Galley (UpdateResult Event) +deleteLocalConversation lusr con lcnv = + getUpdateResult $ + updateLocalConversation lcnv (qUntagged lusr) (Just con) ConversationActionDelete + -- | Update a local conversation, and notify all local and remote members. updateLocalConversation :: Local ConvId -> @@ -435,6 +445,13 @@ performAction qusr conv action = case action of ConversationActionAccessUpdate update -> do performAccessUpdateAction qusr conv update pure (mempty, action) + ConversationActionDelete -> lift $ do + let cid = Data.convId conv + (`Data.deleteCode` ReusableCode) =<< mkKey cid + case Data.convTeam conv of + Nothing -> Data.deleteConversation cid + Just tid -> Data.removeTeamConv tid cid + pure (mempty, action) addCodeH :: UserId ::: ConnId ::: ConvId -> Galley Response addCodeH (usr ::: zcon ::: cnv) = diff --git a/services/galley/src/Galley/API/Util.hs b/services/galley/src/Galley/API/Util.hs index 41274df90a..3b5485c09f 100644 --- a/services/galley/src/Galley/API/Util.hs +++ b/services/galley/src/Galley/API/Util.hs @@ -65,7 +65,7 @@ import Wire.API.ErrorDescription import qualified Wire.API.Federation.API.Brig as FederatedBrig import Wire.API.Federation.API.Galley as FederatedGalley import Wire.API.Federation.Client (FederationClientFailure, FederatorClient, executeFederated) -import Wire.API.Federation.Error (federationErrorToWai) +import Wire.API.Federation.Error (federationErrorToWai, federationNotImplemented) import Wire.API.Federation.GRPC.Types (Component (..)) import qualified Wire.API.User as User @@ -162,6 +162,19 @@ ensureConversationActionAllowed action conv self = do -- extra action-specific checks case action of ConversationActionAddMembers _ role -> ensureConvRoleNotElevated self role + ConversationActionDelete -> do + case Data.convTeam conv of + Just tid -> do + foldQualified + loc + ( \lusr -> do + void $ + Data.teamMember tid (tUnqualified lusr) + >>= ifNothing (errorDescriptionTypeToWai @NotATeamMember) + ) + (\_ -> throwM federationNotImplemented) + (convMemberId loc self) + Nothing -> pure () ConversationActionAccessUpdate target -> do -- 'PrivateAccessRole' is for self-conversations, 1:1 conversations and -- so on; users are not supposed to be able to make other conversations diff --git a/services/galley/src/Galley/Data.hs b/services/galley/src/Galley/Data.hs index 65feff542b..04353e202e 100644 --- a/services/galley/src/Galley/Data.hs +++ b/services/galley/src/Galley/Data.hs @@ -137,7 +137,7 @@ import Data.Id as Id import Data.Json.Util (UTCTimeMillis (..)) import Data.LegalHold (UserLegalHoldStatus (..), defUserLegalHoldStatus) import qualified Data.List.Extra as List -import Data.List.NonEmpty (NonEmpty) +import Data.List.NonEmpty (NonEmpty, nonEmpty) import Data.List.Split (chunksOf) import qualified Data.Map.Strict as Map import Data.Misc (Milliseconds) @@ -762,8 +762,15 @@ updateConversationMessageTimer cid mtimer = retry x5 $ write Cql.updateConvMessa deleteConversation :: (MonadClient m, Log.MonadLogger m, MonadThrow m) => ConvId -> m () deleteConversation cid = do retry x5 $ write Cql.markConvDeleted (params Quorum (Identity cid)) - mm <- members cid - for_ mm $ \m -> removeMember (lmId m) cid + + localMembers <- members cid + for_ (nonEmpty localMembers) $ \ms -> + removeLocalMembersFromLocalConv cid (lmId <$> ms) + + remoteMembers <- lookupRemoteMembers cid + for_ (nonEmpty remoteMembers) $ \ms -> + removeRemoteMembersFromLocalConv cid (rmId <$> ms) + retry x5 $ write Cql.deleteConv (params Quorum (Identity cid)) acceptConnect :: MonadClient m => ConvId -> m () diff --git a/services/galley/test/integration/API.hs b/services/galley/test/integration/API.hs index 4fc812f897..31e12d7970 100644 --- a/services/galley/test/integration/API.hs +++ b/services/galley/test/integration/API.hs @@ -87,7 +87,9 @@ import Wire.API.Conversation import Wire.API.Conversation.Action import qualified Wire.API.Federation.API.Brig as FederatedBrig import Wire.API.Federation.API.Galley - ( GetConversationsResponse (..), + ( Api (onConversationUpdated), + ConversationUpdate (cuAction, cuAlreadyPresentUsers, cuOrigUserId), + GetConversationsResponse (..), RemoteConvMembers (..), RemoteConversation (..), ) @@ -163,6 +165,7 @@ tests s = test s "fail to add members when not connected" postMembersFail, test s "fail to add too many members" postTooManyMembersFail, test s "add remote members" testAddRemoteMember, + test s "delete conversation with remote members" testDeleteTeamConversationWithRemoteMembers, test s "get conversations/:domain/:cnv - local" testGetQualifiedLocalConv, test s "get conversations/:domain/:cnv - local, not found" testGetQualifiedLocalConvNotFound, test s "get conversations/:domain/:cnv - local, not participating" testGetQualifiedLocalConvNotParticipating, @@ -1909,6 +1912,50 @@ testAddRemoteMember = do toJSON [mkProfile bob (Name "bob")] | otherwise = toJSON () +testDeleteTeamConversationWithRemoteMembers :: TestM () +testDeleteTeamConversationWithRemoteMembers = do + (alice, tid) <- createBindingTeam + localDomain <- viewFederationDomain + let qalice = Qualified alice localDomain + + bobId <- randomId + let remoteDomain = Domain "far-away.example.com" + remoteBob = Qualified bobId remoteDomain + + convId <- decodeConvId <$> postTeamConv tid alice [] (Just "remote gossip") [] Nothing Nothing + let _qconvId = Qualified convId localDomain + + connectWithRemoteUser alice remoteBob + + let brigApi = emptyFederatedBrig + galleyApi = + emptyFederatedGalley + { onConversationUpdated = \_domain _update -> pure () + } + + (_, received) <- withTempServantMockFederator brigApi galleyApi localDomain $ do + postQualifiedMembers alice (remoteBob :| []) convId + !!! const 200 === statusCode + + deleteTeamConv tid convId alice + !!! const 200 === statusCode + + liftIO $ do + let convUpdates = mapMaybe parseFedRequest received + convUpdate <- case (filter ((== ConversationActionDelete) . cuAction) convUpdates) of + [] -> assertFailure "No ConversationUpdate requests received" + [convDelete] -> pure convDelete + _ -> assertFailure "Multiple ConversationUpdate requests received" + cuAlreadyPresentUsers convUpdate @?= [bobId] + cuOrigUserId convUpdate @?= qalice + where + parseFedRequest :: FromJSON a => F.FederatedRequest -> Maybe a + parseFedRequest fr = + case F.request fr of + Just r -> + (decode . cs) (F.body r) + Nothing -> Nothing + testGetQualifiedLocalConv :: TestM () testGetQualifiedLocalConv = do alice <- randomUser diff --git a/services/galley/test/integration/API/Federation.hs b/services/galley/test/integration/API/Federation.hs index 2217ba41e1..5a7941bf2f 100644 --- a/services/galley/test/integration/API/Federation.hs +++ b/services/galley/test/integration/API/Federation.hs @@ -75,6 +75,7 @@ tests s = test s "POST /federation/on-conversation-updated : Notify local user about member update" notifyMemberUpdate, test s "POST /federation/on-conversation-updated : Notify local user about receipt mode update" notifyReceiptMode, test s "POST /federation/on-conversation-updated : Notify local user about access update" notifyAccess, + test s "POST /federation/on-conversation-updated : Notify local users about a deleted conversation" notifyDeletedConversation, test s "POST /federation/leave-conversation : Success" leaveConversationSuccess, test s "POST /federation/on-message-sent : Receive a message from another backend" onMessageSent, test s "POST /federation/send-message : Post a message sent from another backend" sendMessage @@ -488,6 +489,54 @@ notifyMemberUpdate = do MemberStateUpdate (EdMemberUpdate d) +notifyDeletedConversation :: TestM () +notifyDeletedConversation = do + c <- view tsCannon + + qalice <- randomQualifiedUser + let alice = qUnqualified qalice + + bob <- randomId + conv <- randomId + let bobDomain = Domain "bob.example.com" + qbob = Qualified bob bobDomain + qconv = Qualified conv bobDomain + mkMember quid = OtherMember quid Nothing roleNameWireMember + + mapM_ (`connectWithRemoteUser` qbob) [alice] + registerRemoteConv + qconv + bob + (Just "gossip") + (Set.fromList (map mkMember [qalice])) + + fedGalleyClient <- view tsFedGalleyClient + + do + aliceConvs <- listRemoteConvs bobDomain alice + liftIO $ aliceConvs @?= [qconv] + + WS.bracketR c alice $ \wsAlice -> do + now <- liftIO getCurrentTime + let cu = + FedGalley.ConversationUpdate + { FedGalley.cuTime = now, + FedGalley.cuOrigUserId = qbob, + FedGalley.cuConvId = qUnqualified qconv, + FedGalley.cuAlreadyPresentUsers = [alice], + FedGalley.cuAction = ConversationActionDelete + } + FedGalley.onConversationUpdated fedGalleyClient bobDomain cu + + liftIO $ do + WS.assertMatch_ (5 # Second) wsAlice $ \n -> do + let e = List1.head (WS.unpackPayload n) + ConvDelete @=? evtType e + + do + aliceConvs <- listRemoteConvs bobDomain alice + liftIO $ aliceConvs @?= [] + -- TODO: test adding non-existing users -- TODO: test adding resulting in an empty notification diff --git a/services/galley/test/integration/API/Teams.hs b/services/galley/test/integration/API/Teams.hs index ebc335b9fc..4529b88c4f 100644 --- a/services/galley/test/integration/API/Teams.hs +++ b/services/galley/test/integration/API/Teams.hs @@ -1161,7 +1161,6 @@ testDeleteBindingTeam ownerHasPassword = do testDeleteTeamConv :: TestM () testDeleteTeamConv = do localDomain <- viewFederationDomain - g <- view tsGalley c <- view tsCannon owner <- Util.randomUser let p = Util.symmPermissions [DoNotUseDeprecatedDeleteConversation] @@ -1179,14 +1178,9 @@ testDeleteTeamConv = do for_ [owner, member ^. userId, extern] $ \u -> Util.assertConvMember u cid1 for_ [owner, member ^. userId] $ \u -> Util.assertConvMember u cid2 WS.bracketR3 c owner extern (member ^. userId) $ \(wsOwner, wsExtern, wsMember) -> do - delete - ( g - . paths ["teams", toByteString' tid, "conversations", toByteString' cid2] - . zUser (member ^. userId) - . zConn "conn" - ) - !!! const 200 - === statusCode + deleteTeamConv tid cid2 (member ^. userId) + !!! const 200 === statusCode + -- We no longer send duplicate conv deletion events -- i.e., as both a regular "conversation.delete" to all -- conversation members and as "team.conversation-delete" @@ -1195,14 +1189,9 @@ testDeleteTeamConv = do checkConvDeleteEvent qcid2 wsOwner checkConvDeleteEvent qcid2 wsMember WS.assertNoEvent timeout [wsOwner, wsMember] - delete - ( g - . paths ["teams", toByteString' tid, "conversations", toByteString' cid1] - . zUser (member ^. userId) - . zConn "conn" - ) - !!! const 200 - === statusCode + + deleteTeamConv tid cid1 (member ^. userId) + !!! const 200 === statusCode -- We no longer send duplicate conv deletion events -- i.e., as both a regular "conversation.delete" to all -- conversation members and as "team.conversation-delete" diff --git a/services/galley/test/integration/API/Util.hs b/services/galley/test/integration/API/Util.hs index 6cbaadd04f..dbfe877d17 100644 --- a/services/galley/test/integration/API/Util.hs +++ b/services/galley/test/integration/API/Util.hs @@ -587,6 +587,16 @@ postTeamConv tid u us name a r mtimer = do let conv = NewConvUnmanaged $ NewConv us [] name (Set.fromList a) r (Just (ConvTeamInfo tid False)) mtimer Nothing roleNameWireAdmin post $ g . path "/conversations" . zUser u . zConn "conn" . zType "access" . json conv +deleteTeamConv :: (HasGalley m, MonadIO m, MonadHttp m) => TeamId -> ConvId -> UserId -> m ResponseLBS +deleteTeamConv tid convId zusr = do + g <- viewGalley + delete + ( g + . paths ["teams", toByteString' tid, "conversations", toByteString' convId] + . zUser zusr + . zConn "conn" + ) + postConvWithRole :: UserId -> [UserId] -> Maybe Text -> [Access] -> Maybe AccessRole -> Maybe Milliseconds -> RoleName -> TestM ResponseLBS postConvWithRole u members name access arole timer role = postConvQualified