[WPB-5389] Guard user connection requests by team-level federation se…

…ttings (#3774)

* Define the new user connection request error

* An effect utility to check team federation

* Perform team federation checks on the calling side

* Formatting the code

* Introduce 1-1 conv test setup helpers

* Test: Migrate "Remote connections: mutual Connect - local action then remote action"

* Test: Migrate "Remote connections: mutual Connect - remote action then local action"

This test is covered by the `testConnectWithRemoteUser` test

* [feat] move testRemoteUserGetsDeleted to new integration testsuite

* Test utility to assert on connection status

* Test: Migrate "Remote connections: ignore then accept"

* Test: Migrate "Remote connections: ignore, remote cancels, then accept"

* Test: Migrate "Remote connections: block then accept"

* Test: Migrate "Remote connections: block, remote cancels, then accept"

* Test: Migrate "Remote connections: send then cancel"

* [feat] move testInternalGetConStatusesAll to new testsuite

* Include the team ID in the fed connection request

* [feat] move testConnectionLimits to new integration test suite

* Revert the generalisation of 'ensureFederatesWith'

* [fix] comment back in test that is still broken

* Test: not federating with a remote team

* Test: connection attempt under non-mutual federation

* Test: connect under allow-all mutual federation

* Test: connect under allow-dynamic mutual federation

* Test: connect under mixed federation-allow policies

* Add a changelog

* Remove an unused fed client argument in tests

* fixup! Introduce 1-1 conv test setup helpers

---------

Co-authored-by: Magnus Viernickel <[email protected]>

changelog.d/2-features/WPB-5389-team-level-federation-guarded-user-connections

@@ -0,0 +1 @@
+Apply team-level federation policies when establishing and updating user connections

integration/integration.cabal

@@ -106,6 +106,7 @@ library
     Test.B2B
     Test.Brig
     Test.Client
+    Test.Connection
     Test.Conversation
     Test.Demo
     Test.Errors

integration/test/API/BrigInternal.hs

@@ -2,6 +2,7 @@ module API.BrigInternal where
 
 import API.Common
 import Data.Aeson qualified as Aeson
+import Data.Aeson.Types (Pair)
 import Data.Function
 import Data.Maybe
 import Testlib.Prelude
@@ -187,3 +188,20 @@ deleteFederationRemoteTeam domain remoteDomain team = do
   req <- baseRequest domain Brig Unversioned $ joinHttpPath ["i", "federation", "remotes", d, "teams", t]
   res <- submit "DELETE" req
   res.status `shouldMatchInt` 200
+
+getConnStatusForUsers :: (HasCallStack, MakesValue users) => users -> Domain -> App Response
+getConnStatusForUsers users domain = do
+  usersList <-
+    asList users >>= \us -> do
+      dom <- us `for` (%. "qualified_id.domain")
+      dom `for_` (`shouldMatch` make domain)
+      us `for` (%. "id")
+  usersJSON <- make usersList
+  getConnStatusInternal ["from" .= usersJSON] domain
+
+getConnStatusInternal :: (HasCallStack) => [Pair] -> Domain -> App Response
+getConnStatusInternal body dom = do
+  req <- baseRequest dom Brig Unversioned do
+    joinHttpPath ["i", "users", "connections-status", "v2"]
+  submit "POST" do
+    req & addJSONObject body

integration/test/SetupHelpers.hs

@@ -194,3 +194,54 @@ withFederatingBackendsAllowDynamic k = do
       def {brigCfg = setFederationConfig}
     ]
     $ \[domainA, domainB, domainC] -> k (domainA, domainB, domainC)
+
+-- | Create two users on different domains such that the one-to-one
+-- conversation, once finalised, will be hosted on the backend given by the
+-- input domain.
+createOne2OneConversation :: HasCallStack => Domain -> App (Value, Value, Value)
+createOne2OneConversation owningDomain = do
+  owningUser <- randomUser owningDomain def
+  domainName <- owningUser %. "qualified_id.domain"
+  let otherDomain = case owningDomain of
+        OwnDomain -> OtherDomain
+        OtherDomain -> OwnDomain
+  let go = do
+        otherUser <- randomUser otherDomain def
+        otherUserId <- otherUser %. "qualified_id"
+        conn <-
+          postConnection owningUser otherUser `bindResponse` \resp -> do
+            resp.status `shouldMatchInt` 201
+            payload <- resp.json
+            payload %. "status" `shouldMatch` "sent"
+            payload %. "qualified_to" `shouldMatch` otherUserId
+            pure payload
+        one2one <- conn %. "qualified_conversation"
+        one2oneDomain <- one2one %. "domain"
+        if domainName == one2oneDomain
+          then pure (owningUser, otherUser, one2one)
+          else SetupHelpers.deleteUser otherUser >> go
+  go
+
+data One2OneConvState = Established | Connect
+
+-- | Converts to an integer corresponding to the numeric representation of the
+-- 'Wire.API.Conversation.ConvType' type.
+toConvType :: One2OneConvState -> Int
+toConvType = \case
+  Established -> 2
+  Connect -> 3
+
+-- | Fetch the one-to-one conversation between the two users that is in one of
+-- two possible states.
+getOne2OneConversation :: HasCallStack => Value -> Value -> One2OneConvState -> App Value
+getOne2OneConversation user1 user2 cnvState = do
+  l <- getAllConvs user1
+  let isWith users c = do
+        -- The conversation type 2 is for 1-to-1 conversations. Type 3 is for
+        -- the connection conversation, which is the state of the conversation
+        -- before the connection is fully established.
+        t <- (== toConvType cnvState) <$> (c %. "type" & asInt)
+        others <- c %. "members.others" & asList
+        qIds <- for others (%. "qualified_id")
+        pure $ qIds == users && t
+  head <$> filterM (isWith [user2]) l