diff --git a/changelog.d/3-bug-fixes/WPB-3842-federation-completeness-checks b/changelog.d/3-bug-fixes/WPB-3842-federation-completeness-checks new file mode 100644 index 0000000000..4795920979 --- /dev/null +++ b/changelog.d/3-bug-fixes/WPB-3842-federation-completeness-checks @@ -0,0 +1 @@ +Adding users to a conversation now enforces that all federation domains that will be in the conversation are federated with each other. \ No newline at end of file diff --git a/integration/test/Test/Conversation.hs b/integration/test/Test/Conversation.hs index 7f974103b1..3324089b0c 100644 --- a/integration/test/Test/Conversation.hs +++ b/integration/test/Test/Conversation.hs @@ -364,7 +364,7 @@ testAddReachableWithUnreachableRemoteUsers = do let overrides = def {dbBrig = setField "optSettings.setFederationStrategy" "allowAll"} <> fullSearchWithAll - ([alex, bob], conv) <- + ([alex, bob], conv, domains) <- startDynamicBackends [overrides, overrides] $ \domains -> do own <- make OwnDomain & asString other <- make OtherDomain & asString @@ -373,18 +373,24 @@ testAddReachableWithUnreachableRemoteUsers = do let newConv = defProteus {qualifiedUsers = [alex, charlie, dylan]} conv <- postConversation alice newConv >>= getJSON 201 - pure ([alex, bob], conv) + pure ([alex, bob], conv, domains) bobId <- bob %. "qualified_id" bindResponse (addMembers alex conv [bobId]) $ \resp -> do - resp.status `shouldMatchInt` 200 + -- This test is updated to reflect the changes in `performConversationJoin` + -- `performConversationJoin` now does a full check between all federation members + -- that will be in the conversation when adding users to a conversation. This is + -- to ensure that users from domains that aren't federating are not directly + -- connected to each other. + resp.status `shouldMatchInt` 533 + resp.jsonBody %. "unreachable_backends" `shouldMatchSet` domains testAddUnreachable :: HasCallStack => App () testAddUnreachable = do let overrides = def {dbBrig = setField "optSettings.setFederationStrategy" "allowAll"} <> fullSearchWithAll - ([alex, charlie], [charlieDomain, _dylanDomain], conv) <- + ([alex, charlie], [charlieDomain, dylanDomain], conv) <- startDynamicBackends [overrides, overrides] $ \domains -> do own <- make OwnDomain & asString [alice, alex, charlie, dylan] <- @@ -397,4 +403,26 @@ testAddUnreachable = do charlieId <- charlie %. "qualified_id" bindResponse (addMembers alex conv [charlieId]) $ \resp -> do resp.status `shouldMatchInt` 533 - resp.json %. "unreachable_backends" `shouldMatchSet` [charlieDomain] + -- All of the domains that are in the conversation, or will be in the conversation, + -- need to be reachable so we can check that the graph for those domains is fully connected. + resp.json %. "unreachable_backends" `shouldMatchSet` [charlieDomain, dylanDomain] + +testAddingUserNonFullyConnectedFederation :: HasCallStack => App () +testAddingUserNonFullyConnectedFederation = do + let overrides = + def {dbBrig = setField "optSettings.setFederationStrategy" "allowAll"} + <> fullSearchWithAll + startDynamicBackends [overrides] $ \domains -> do + own <- make OwnDomain & asString + other <- make OtherDomain & asString + [alice, alex, bob, charlie] <- + createAndConnectUsers $ [own, own, other] <> domains + + let newConv = defProteus {qualifiedUsers = [alex]} + conv <- postConversation alice newConv >>= getJSON 201 + + bobId <- bob %. "qualified_id" + charlieId <- charlie %. "qualified_id" + bindResponse (addMembers alex conv [bobId, charlieId]) $ \resp -> do + resp.status `shouldMatchInt` 409 + resp.json %. "non_federating_backends" `shouldMatchSet` (other : domains) diff --git a/integration/test/Testlib/Run.hs b/integration/test/Testlib/Run.hs index 70fa733c7c..b53ec16cab 100644 --- a/integration/test/Testlib/Run.hs +++ b/integration/test/Testlib/Run.hs @@ -11,6 +11,7 @@ import Data.Function import Data.Functor import Data.List import Data.Time.Clock +import Data.Traversable (for) import RunAllTests import System.Directory import System.Environment @@ -134,7 +135,7 @@ runTests tests cfg = do genv <- createGlobalEnv cfg withAsync displayOutput $ \displayThread -> do - report <- fmap mconcat $ pooledForConcurrently tests $ \(qname, _, _, action) -> do + report <- fmap mconcat $ for tests $ \(qname, _, _, action) -> do do (mErr, tm) <- withTime (runTest genv action) case mErr of diff --git a/services/galley/src/Galley/API/Action.hs b/services/galley/src/Galley/API/Action.hs index 6e577eb032..9e1ff71130 100644 --- a/services/galley/src/Galley/API/Action.hs +++ b/services/galley/src/Galley/API/Action.hs @@ -442,7 +442,9 @@ performConversationJoin qusr lconv (ConversationJoin invited role) = do Local UserId -> Sem r () checkRemoteBackendsConnected lusr = do - let remoteDomains = tDomain <$> snd (partitionQualified lusr $ NE.toList invited) + let invitedDomains = tDomain <$> snd (partitionQualified lusr $ NE.toList invited) + existingDomains = tDomain . rmId <$> convRemoteMembers (tUnqualified lconv) + -- Note: -- -- In some cases, this federation status check might be redundant (for @@ -450,7 +452,7 @@ performConversationJoin qusr lconv (ConversationJoin invited role) = do -- it is important that we attempt to connect to the backends of the new -- users here, because that results in the correct error when those -- backends are not reachable. - checkFederationStatus (RemoteDomains $ Set.fromList remoteDomains) + checkFederationStatus (RemoteDomains . Set.fromList $ invitedDomains <> existingDomains) conv :: Data.Conversation conv = tUnqualified lconv