[WPB-3633] client receives conversation deleted conversation events after federation delete event

changelog.d/3-bug-fixes/pr-3485

@@ -0,0 +1 @@
+No `conversation.delete` event is sent to users during de-federation clean up

integration/test/API/Brig.hs

@@ -181,6 +181,21 @@ postConnection userFrom userTo = do
       joinHttpPath ["/connections", userToDomain, userToId]
   submit "POST" req
 
+getConnection ::
+  ( HasCallStack,
+    MakesValue userFrom,
+    MakesValue userTo
+  ) =>
+  userFrom ->
+  userTo ->
+  App Response
+getConnection userFrom userTo = do
+  (userToDomain, userToId) <- objQid userTo
+  req <-
+    baseRequest userFrom Brig Versioned $
+      joinHttpPath ["/connections", userToDomain, userToId]
+  submit "GET" req
+
 putConnection ::
   ( HasCallStack,
     MakesValue userFrom,

integration/test/Test/Conversation.hs

@@ -1,8 +1,10 @@
 module Test.Conversation where
 
+import API.Brig (getConnection)
 import API.BrigInternal qualified as Internal
-import API.Galley (defProteus, postConversation, qualifiedUsers)
+import API.Galley (defProteus, getConversation, postConversation, qualifiedUsers)
 import API.GalleyInternal qualified as API
+import API.Gundeck (getNotifications)
 import Control.Applicative
 import Data.Aeson qualified as Aeson
 import GHC.Stack
@@ -177,3 +179,128 @@ testCreateConversationNonFullyConnected = do
       bindResponse (postConversation u1 (defProteus {qualifiedUsers = [u2, u3]})) $ \resp -> do
         resp.status `shouldMatchInt` 409
         resp.json %. "non_federating_backends" `shouldMatchSet` [domainB, domainC]
+
+testDefederationGroupConversation :: HasCallStack => App ()
+testDefederationGroupConversation = do
+  let setFederationConfig =
+        setField "optSettings.setFederationStrategy" "allowDynamic"
+          >=> removeField "optSettings.setFederationDomainConfigs"
+          >=> setField "optSettings.setFederationDomainConfigsUpdateFreq" (Aeson.Number 1)
+  startDynamicBackends
+    [ def {dbBrig = setFederationConfig},
+      def {dbBrig = setFederationConfig}
+    ]
+    $ \dynDomains -> do
+      domains@[domainA, domainB] <- pure dynDomains
+      connectAllDomainsAndWaitToSync 1 domains
+      [uA, uB] <- createAndConnectUsers [domainA, domainB]
+      withWebSocket uA $ \ws -> do
+        -- create group conversation owned by domainB
+        convId <- bindResponse (postConversation uB (defProteus {qualifiedUsers = [uA]})) $ \r -> do
+          r.status `shouldMatchInt` 201
+          r.json %. "qualified_id"
+
+        -- check conversation exists and uB is a member from POV of uA
+        bindResponse (getConversation uA convId) $ \r -> do
+          r.status `shouldMatchInt` 200
+          members <- r.json %. "members.others" & asList
+          qIds <- for members (\m -> m %. "qualified_id")
+          uBQId <- objQidObject uB
+          qIds `shouldMatchSet` [uBQId]
+
+        -- check conversation exists and uA is a member from POV of uB
+        bindResponse (getConversation uB convId) $ \r -> do
+          r.status `shouldMatchInt` 200
+          members <- r.json %. "members.others" & asList
+          qIds <- for members (\m -> m %. "qualified_id")
+          uAQId <- objQidObject uA
+          qIds `shouldMatchSet` [uAQId]
+
+        -- domainA stops federating with domainB
+        void $ Internal.deleteFedConn domainA domainB
+
+        -- assert conversation deleted from domainA
+        retryT $
+          bindResponse (getConversation uA convId) $ \r ->
+            r.status `shouldMatchInt` 404
+
+        -- assert federation.delete event is sent twice
+        void $ awaitNMatches 2 3 (\n -> nPayload n %. "type" `isEqual` "federation.delete") ws
+
+      -- assert no conversation.delete event is sent to uA
+      eventPayloads <-
+        getNotifications uA "cA" def
+          >>= getJSON 200
+          >>= \n -> n %. "notifications" & asList >>= \ns -> for ns nPayload
+
+      forM_ eventPayloads $ \p ->
+        p %. "type" `shouldNotMatch` "conversation.delete"
+
+testDefederationOneOnOne :: HasCallStack => App ()
+testDefederationOneOnOne = do
+  let setFederationConfig =
+        setField "optSettings.setFederationStrategy" "allowDynamic"
+          >=> removeField "optSettings.setFederationDomainConfigs"
+          >=> setField "optSettings.setFederationDomainConfigsUpdateFreq" (Aeson.Number 1)
+  startDynamicBackends
+    [ def {dbBrig = setFederationConfig},
+      def {dbBrig = setFederationConfig}
+    ]
+    $ \dynDomains -> do
+      domains@[domainA, domainB] <- pure dynDomains
+      connectAllDomainsAndWaitToSync 1 domains
+      [uA, uB] <- createAndConnectUsers [domainA, domainB]
+      -- figure out on which backend the 1:1 conversation is created
+      qConvId <- getConnection uA uB >>= \c -> c.json %. "qualified_conversation"
+
+      -- check conversation exists and uB is a member from POV of uA
+      bindResponse (getConversation uA qConvId) $ \r -> do
+        r.status `shouldMatchInt` 200
+        members <- r.json %. "members.others" & asList
+        qIds <- for members (\m -> m %. "qualified_id")
+        uBQId <- objQidObject uB
+        qIds `shouldMatchSet` [uBQId]
+
+      -- check conversation exists and uA is a member from POV of uB
+      bindResponse (getConversation uB qConvId) $ \r -> do
+        r.status `shouldMatchInt` 200
+        members <- r.json %. "members.others" & asList
+        qIds <- for members (\m -> m %. "qualified_id")
+        uAQId <- objQidObject uA
+        qIds `shouldMatchSet` [uAQId]
+
+      conversationOwningDomain <- objDomain qConvId
+
+      when (domainA == conversationOwningDomain) $ do
+        -- conversation is created on domainA
+        assertFederationTerminatingUserNoConvDeleteEvent uB qConvId domainB domainA
+
+      when (domainB == conversationOwningDomain) $ do
+        -- conversation is created on domainB
+        assertFederationTerminatingUserNoConvDeleteEvent uA qConvId domainA domainB
+
+      when (domainA /= conversationOwningDomain && domainB /= conversationOwningDomain) $ do
+        -- this should not happen
+        error "impossible"
+  where
+    assertFederationTerminatingUserNoConvDeleteEvent :: Value -> Value -> String -> String -> App ()
+    assertFederationTerminatingUserNoConvDeleteEvent user convId ownDomain otherDomain = do
+      withWebSocket user $ \ws -> do
+        void $ Internal.deleteFedConn ownDomain otherDomain
+
+        -- assert conversation deleted eventually
+        retryT $
+          bindResponse (getConversation user convId) $ \r ->
+            r.status `shouldMatchInt` 404
+
+        -- assert federation.delete event is sent twice
+        void $ awaitNMatches 2 3 (\n -> nPayload n %. "type" `isEqual` "federation.delete") ws
+
+      -- assert no conversation.delete event is sent to uA
+      eventPayloads <-
+        getNotifications user "user-client" def
+          >>= getJSON 200
+          >>= \n -> n %. "notifications" & asList >>= \ns -> for ns nPayload
+
+      forM_ eventPayloads $ \p ->
+        p %. "type" `shouldNotMatch` "conversation.delete"

integration/test/Testlib/Assertions.hs

@@ -72,7 +72,7 @@ a `shouldNotMatch` b = do
 
   when (xa == xb) $ do
     pa <- prettyJSON xa
-    assertFailure $ "Expected different value but got twice:\n" <> pa
+    assertFailure $ "Expected different value but got this:\n" <> pa
 
 -- | Specialized variant of `shouldMatch` to avoid the need for type annotations.
 shouldMatchInt ::

integration/test/Testlib/Cannon.hs

@@ -249,8 +249,8 @@ awaitAnyEvent tSecs = liftIO . timeout (tSecs * 1000 * 1000) . atomically . read
 -- | 'await' an expected number of notification events on the websocket that
 -- satisfy the provided predicate. If there isn't any new event (matching or
 -- non-matching) for a 'tSecs' seconds then AwaitResult is a failure. This
--- funciton will never terminate if there is a constant stream of events
--- received. When this functions retruns it will push any non-matching
+-- function will never terminate if there is a constant stream of events
+-- received. When this functions returns it will push any non-matching
 -- events back to the websocket.
 awaitNMatchesResult ::
   HasCallStack =>

services/brig/src/Brig/API/Internal.hs

@@ -366,13 +366,12 @@ deleteFederationRemote dom = do
     queue = routingKey defederationQueue
 
 -- | Remove one-on-one conversations for the given remote domain. This is called from Galley as
--- part of the defederation process, and should not be called duriung the initial domain removal
+-- part of the defederation process, and should not be called during the initial domain removal
 -- call to brig. This is so we can ensure that domains are correctly cleaned up if a service
 -- falls over for whatever reason.
 deleteFederationRemoteGalley :: Domain -> ExceptT Brig.API.Error.Error (AppT r) ()
 deleteFederationRemoteGalley dom = do
   lift . wrapClient . Data.deleteRemoteConnectionsDomain $ dom
-  assertNoDomainsFromConfigFiles dom
 
 -- | Responds with 'Nothing' if field is NULL in existing user or user does not exist.
 getAccountConferenceCallingConfig :: UserId -> (Handler r) (ApiFt.WithStatusNoLock ApiFt.ConferenceCallingConfig)

services/galley/src/Galley/API/Internal.hs

@@ -45,7 +45,6 @@ import Galley.API.Clients qualified as Clients
 import Galley.API.Create qualified as Create
 import Galley.API.CustomBackend qualified as CustomBackend
 import Galley.API.Error
-import Galley.API.Federation (onConversationUpdated)
 import Galley.API.LegalHold (unsetTeamLegalholdWhitelistedH)
 import Galley.API.LegalHold.Conflicts
 import Galley.API.MLS.Removal
@@ -94,7 +93,6 @@ import Network.Wai.Utilities.ZAuth
 import Polysemy
 import Polysemy.Error
 import Polysemy.Input
-import Polysemy.TinyLog (logAndIgnoreErrors)
 import Polysemy.TinyLog qualified as P
 import Servant hiding (JSON, WithStatus)
 import Servant.Client (BaseUrl (BaseUrl), ClientEnv (ClientEnv), Scheme (Http), defaultMakeClientRequest)
@@ -109,7 +107,6 @@ import Wire.API.Error.Galley
 import Wire.API.Event.Conversation
 import Wire.API.Federation.API
 import Wire.API.Federation.API.Galley
-import Wire.API.Federation.API.Galley qualified as F
 import Wire.API.Federation.Error
 import Wire.API.FederationUpdate
 import Wire.API.Provider.Service hiding (Service)
@@ -508,15 +505,12 @@ deleteFederationDomain ::
   ( Member (Input Env) r,
     Member (P.Logger (Msg -> Msg)) r,
     Member (Error FederationError) r,
-    Member (Input (Local ())) r,
     Member MemberStore r,
     Member ConversationStore r,
     Member (Embed IO) r,
     Member CodeStore r,
     Member TeamStore r,
-    Member BrigAccess r,
-    Member GundeckAccess r,
-    Member ExternalAccess r
+    Member (Error InternalError) r
   ) =>
   Domain ->
   Sem r ()
@@ -529,16 +523,13 @@ internalDeleteFederationDomainH ::
   ( Member (Input Env) r,
     Member (P.Logger (Msg -> Msg)) r,
     Member (Error FederationError) r,
-    Member (Input (Local ())) r,
     Member MemberStore r,
     Member ConversationStore r,
     Member (Embed IO) r,
     Member CodeStore r,
     Member TeamStore r,
-    Member BrigAccess r,
-    Member GundeckAccess r,
-    Member ExternalAccess r,
-    Member DefederationNotifications r
+    Member DefederationNotifications r,
+    Member (Error InternalError) r
   ) =>
   Domain ::: JSON ->
   Sem r Response
@@ -611,50 +602,17 @@ deleteFederationDomainRemoteUserFromLocalConversations dom = do
 
 -- Remove local members from remote conversations
 deleteFederationDomainLocalUserFromRemoteConversation ::
-  ( Member (Input (Local ())) r,
-    Member (Input Env) r,
-    Member (P.Logger (Msg -> Msg)) r,
-    Member MemberStore r,
-    Member (Embed IO) r,
-    Member BrigAccess r,
-    Member GundeckAccess r,
-    Member ExternalAccess r
+  ( Member (Error InternalError) r,
+    Member MemberStore r
   ) =>
   Domain ->
   Sem r ()
 deleteFederationDomainLocalUserFromRemoteConversation dom = do
-  localUsers <- E.getLocalMembersByDomain dom
-  env <- input
-  -- As above, build the map so we can get all local users per conversation
-  let rCnvMap = foldr insertIntoMap mempty localUsers
-      localDomain = env ^. Galley.App.options . optSettings . setFederationDomain
-  -- Process each user.
-  for_ (Map.toList rCnvMap) $ \(cnv, lUsers) -> do
-    let catchBaddies =
-          logAndIgnoreErrors @NoChanges
-            ( const "NoChanges: Could not remove a local member from a remote conversation."
-            -- `NoChanges` doesn't contain too many details, so no point in showing it here.
-            )
-            "Federation domain removal"
-    catchBaddies $ do
-      now <- liftIO $ getCurrentTime
-      for_ lUsers $ \user -> do
-        let lUser = toLocalUnsafe localDomain user
-            convUpdate =
-              F.ConversationUpdate
-                { cuTime = now,
-                  cuOrigUserId = tUntagged lUser,
-                  cuConvId = cnv,
-                  cuAlreadyPresentUsers = [user],
-                  cuAction = SomeConversationAction (sing @'ConversationDeleteTag) ()
-                }
-        -- These functions are used directly rather than as part of a larger conversation
-        -- delete function, as we don't have an originating user, and we can't send data
-        -- to the remote backend.
-        -- We don't need to check the conversation type here, as we can't tell the
-        -- remote federation server to delete the conversation. They will have to do a
-        -- similar processing run for removing the local domain from their federation list.
-        onConversationUpdated dom convUpdate
+  remoteConvs <- foldr insertIntoMap mempty <$> E.getLocalMembersByDomain dom
+  for_ (Map.toList remoteConvs) $ \(cnv, lUsers) -> do
+    -- All errors, either exceptions or Either e, get thrown into IO
+    mapError @NoChanges (const (InternalErrorWithDescription "No Changes: Could not remove a local member from a remote conversation.")) $ do
+      E.deleteMembersInRemoteConversation (toRemoteUnsafe dom cnv) (N.toList lUsers)
 
 -- These need to be recoverable?
 -- This is recoverable with the following flow conditions.