WBP-5388 restrict contact search results according to team federation policy

changelog.d/2-features/WPB-5105

@@ -1,3 +1,4 @@
 Allowlist for who on cloud can connect to on-prem:
 - Internal API to configure allowlist
-(#3697)
+- Restrict federated user search according to team federation policy
+(#3697, #3732)

integration/integration.cabal

@@ -120,6 +120,7 @@ library
     Test.Notifications
     Test.Presence
     Test.Roles
+    Test.Search
     Test.User
     Testlib.App
     Testlib.Assertions

integration/test/API/BrigInternal.hs

@@ -4,6 +4,8 @@ import API.Common
 import Data.Aeson qualified as Aeson
 import Data.Function
 import Data.Maybe
+import Data.String.Conversions (cs)
+import Data.Vector qualified as Vector
 import Testlib.Prelude
 
 data CreateUser = CreateUser
@@ -54,7 +56,7 @@ createUser domain cu = do
 data FedConn = FedConn
   { domain :: String,
     searchStrategy :: String,
-    restriction :: String
+    restriction :: Maybe [String]
   }
   deriving (Eq, Ord, Show)
 
@@ -63,7 +65,13 @@ instance ToJSON FedConn where
     Aeson.object
       [ "domain" .= d,
         "search_policy" .= s,
-        "restriction" .= r
+        "restriction"
+          .= maybe
+            (Aeson.object ["tag" .= "allow_all", "value" .= Aeson.Null])
+            ( \teams ->
+                Aeson.object ["tag" .= "restrict_by_team", "value" .= Aeson.Array (Vector.fromList (Aeson.String . cs <$> teams))]
+            )
+            r
       ]
 
 instance MakesValue FedConn where
@@ -159,11 +167,15 @@ connectWithRemoteUser userFrom userTo = do
 
 addFederationRemoteTeam :: (HasCallStack, MakesValue domain, MakesValue remoteDomain, MakesValue team) => domain -> remoteDomain -> team -> App ()
 addFederationRemoteTeam domain remoteDomain team = do
+  res <- addFederationRemoteTeam' domain remoteDomain team
+  res.status `shouldMatchInt` 200
+
+addFederationRemoteTeam' :: (HasCallStack, MakesValue domain, MakesValue remoteDomain, MakesValue team) => domain -> remoteDomain -> team -> App Response
+addFederationRemoteTeam' domain remoteDomain team = do
   d <- asString remoteDomain
   t <- make team
   req <- baseRequest domain Brig Unversioned $ joinHttpPath ["i", "federation", "remotes", d, "teams"]
-  res <- submit "POST" (req & addJSONObject ["team_id" .= t])
-  res.status `shouldMatchInt` 200
+  submit "POST" (req & addJSONObject ["team_id" .= t])
 
 getFederationRemoteTeams :: (HasCallStack, MakesValue domain, MakesValue remoteDomain) => domain -> remoteDomain -> App Response
 getFederationRemoteTeams domain remoteDomain = do

integration/test/API/GalleyInternal.hs

@@ -37,6 +37,13 @@ getTeamFeature domain_ featureName tid = do
   req <- baseRequest domain_ Galley Unversioned $ joinHttpPath ["i", "teams", tid, "features", featureName]
   submit "GET" $ req
 
+setTeamFeatureStatus :: (HasCallStack, MakesValue domain, MakesValue team) => domain -> team -> String -> String -> App ()
+setTeamFeatureStatus domain team featureName status = do
+  tid <- asString team
+  req <- baseRequest domain Galley Unversioned $ joinHttpPath ["i", "teams", tid, "features", featureName]
+  res <- submit "PATCH" $ req & addJSONObject ["status" .= status]
+  res.status `shouldMatchInt` 200
+
 getFederationStatus ::
   ( HasCallStack,
     MakesValue user

integration/test/Test/Brig.hs

@@ -2,8 +2,7 @@ module Test.Brig where
 
 import API.Brig qualified as BrigP
 import API.BrigInternal qualified as BrigI
-import API.Common qualified as API
-import API.GalleyInternal qualified as GalleyI
+import API.Common (randomName)
 import Data.Aeson.Types hiding ((.=))
 import Data.Set qualified as Set
 import Data.String.Conversions
@@ -14,17 +13,6 @@ import SetupHelpers
 import Testlib.Assertions
 import Testlib.Prelude
 
-testSearchContactForExternalUsers :: HasCallStack => App ()
-testSearchContactForExternalUsers = do
-  owner <- randomUser OwnDomain def {BrigI.team = True}
-  partner <- randomUser OwnDomain def {BrigI.team = True}
-
-  bindResponse (GalleyI.putTeamMember partner (partner %. "team") (API.teamRole "partner")) $ \resp ->
-    resp.status `shouldMatchInt` 200
-
-  bindResponse (BrigP.searchContacts partner (owner %. "name") OwnDomain) $ \resp ->
-    resp.status `shouldMatchInt` 403
-
 testCrudFederationRemotes :: HasCallStack => App ()
 testCrudFederationRemotes = do
   otherDomain <- asString OtherDomain
@@ -54,11 +42,11 @@ testCrudFederationRemotes = do
     dom1 :: String <- (<> ".example.com") . UUID.toString <$> liftIO UUID.nextRandom
 
     let remote1, remote1' :: BrigI.FedConn
-        remote1 = BrigI.FedConn dom1 "no_search" "allow_all"
-        remote1' = remote1 {BrigI.searchStrategy = "full_search", BrigI.restriction = "restrict_by_team"}
+        remote1 = BrigI.FedConn dom1 "no_search" Nothing
+        remote1' = remote1 {BrigI.searchStrategy = "full_search", BrigI.restriction = Just []}
 
         cfgRemotesExpect :: BrigI.FedConn
-        cfgRemotesExpect = BrigI.FedConn (cs otherDomain) "full_search" "allow_all"
+        cfgRemotesExpect = BrigI.FedConn (cs otherDomain) "full_search" Nothing
 
     cfgRemotes <- parseFedConns =<< BrigI.readFedConns ownDomain
     cfgRemotes `shouldMatch` ([] @Value)
@@ -139,46 +127,17 @@ testSwagger = do
       resp.status `shouldMatchInt` 200
       void resp.json
 
-testRemoteUserSearch :: HasCallStack => App ()
-testRemoteUserSearch = do
-  startDynamicBackends [def, def] $ \[d1, d2] -> do
-    void $ BrigI.createFedConn d2 (BrigI.FedConn d1 "full_search" "allow_all")
-
-    u1 <- randomUser d1 def
-    u2 <- randomUser d2 def
-    BrigI.refreshIndex d2
-    uidD2 <- objId u2
-
-    bindResponse (BrigP.searchContacts u1 (u2 %. "name") d2) $ \resp -> do
-      resp.status `shouldMatchInt` 200
-      docs <- resp.json %. "documents" >>= asList
-      case docs of
-        [] -> assertFailure "Expected a non empty result, but got an empty one"
-        doc : _ -> doc %. "id" `shouldMatch` uidD2
-
-testRemoteUserSearchExactHandle :: HasCallStack => App ()
-testRemoteUserSearchExactHandle = do
-  startDynamicBackends [def, def] $ \[d1, d2] -> do
-    void $ BrigI.createFedConn d2 (BrigI.FedConn d1 "exact_handle_search" "allow_all")
-
-    u1 <- randomUser d1 def
-    u2 <- randomUser d2 def
-    u2Handle <- API.randomHandle
-    bindResponse (BrigP.putHandle u2 u2Handle) $ assertSuccess
-    BrigI.refreshIndex d2
-
-    bindResponse (BrigP.searchContacts u1 u2Handle d2) $ \resp -> do
-      resp.status `shouldMatchInt` 200
-      docs <- resp.json %. "documents" >>= asList
-      case docs of
-        [] -> assertFailure "Expected a non empty result, but got an empty one"
-        doc : _ -> objQid doc `shouldMatch` objQid u2
-
 testCrudFederationRemoteTeams :: HasCallStack => App ()
 testCrudFederationRemoteTeams = do
   (_, tid, _) <- createTeam OwnDomain 1
   (_, tid2, _) <- createTeam OwnDomain 1
-  let rd = "some-remote-domain.wire.com"
+  rd <- (\n -> n <> ".wire.com") <$> randomName
+  bindResponse (BrigI.addFederationRemoteTeam' OwnDomain rd tid) $ \resp -> do
+    resp.status `shouldMatchInt` 533
+  void $ BrigI.createFedConn OwnDomain $ BrigI.FedConn rd "full_search" Nothing
+  bindResponse (BrigI.addFederationRemoteTeam' OwnDomain rd tid) $ \resp -> do
+    resp.status `shouldMatchInt` 533
+  void $ BrigI.updateFedConn OwnDomain rd $ BrigI.FedConn rd "full_search" (Just [])
   bindResponse (BrigI.getFederationRemoteTeams OwnDomain rd) $ \resp -> do
     resp.status `shouldMatchInt` 200
     checkAbsence resp [tid, tid2]

integration/test/Test/Conversation.hs

@@ -78,7 +78,7 @@ testDynamicBackendsFullyConnectedWhenAllowDynamic = do
     -- Allowing 'full_search' or any type of search is how we enable federation
     -- between backends when the federation strategy is 'allowDynamic'.
     sequence_
-      [ createFedConn x (FedConn y "full_search" "allow_all")
+      [ createFedConn x (FedConn y "full_search" Nothing)
         | x <- [domainA, domainB, domainC],
           y <- [domainA, domainB, domainC],
           x /= y
@@ -100,10 +100,10 @@ testDynamicBackendsNotFullyConnected :: HasCallStack => App ()
 testDynamicBackendsNotFullyConnected = do
   withFederatingBackendsAllowDynamic $ \(domainA, domainB, domainC) -> do
     -- A is connected to B and C, but B and C are not connected to each other
-    void $ createFedConn domainA $ FedConn domainB "full_search" "allow_all"
-    void $ createFedConn domainB $ FedConn domainA "full_search" "allow_all"
-    void $ createFedConn domainA $ FedConn domainC "full_search" "allow_all"
-    void $ createFedConn domainC $ FedConn domainA "full_search" "allow_all"
+    void $ createFedConn domainA $ FedConn domainB "full_search" Nothing
+    void $ createFedConn domainB $ FedConn domainA "full_search" Nothing
+    void $ createFedConn domainA $ FedConn domainC "full_search" Nothing
+    void $ createFedConn domainC $ FedConn domainA "full_search" Nothing
     uidA <- randomUser domainA def {team = True}
     retryT
       $ bindResponse
@@ -149,10 +149,10 @@ testCreateConversationNonFullyConnected :: HasCallStack => App ()
 testCreateConversationNonFullyConnected = do
   withFederatingBackendsAllowDynamic $ \(domainA, domainB, domainC) -> do
     -- A is connected to B and C, but B and C are not connected to each other
-    void $ createFedConn domainA $ FedConn domainB "full_search" "allow_all"
-    void $ createFedConn domainB $ FedConn domainA "full_search" "allow_all"
-    void $ createFedConn domainA $ FedConn domainC "full_search" "allow_all"
-    void $ createFedConn domainC $ FedConn domainA "full_search" "allow_all"
+    void $ createFedConn domainA $ FedConn domainB "full_search" Nothing
+    void $ createFedConn domainB $ FedConn domainA "full_search" Nothing
+    void $ createFedConn domainA $ FedConn domainC "full_search" Nothing
+    void $ createFedConn domainC $ FedConn domainA "full_search" Nothing
     liftIO $ threadDelay (2 * 1000 * 1000)
 
     u1 <- randomUser domainA def
@@ -184,10 +184,10 @@ testAddMembersFullyConnectedProteus = do
 testAddMembersNonFullyConnectedProteus :: HasCallStack => App ()
 testAddMembersNonFullyConnectedProteus = do
   withFederatingBackendsAllowDynamic $ \(domainA, domainB, domainC) -> do
-    void $ createFedConn domainA (FedConn domainB "full_search" "allow_all")
-    void $ createFedConn domainB (FedConn domainA "full_search" "allow_all")
-    void $ createFedConn domainA (FedConn domainC "full_search" "allow_all")
-    void $ createFedConn domainC (FedConn domainA "full_search" "allow_all")
+    void $ createFedConn domainA (FedConn domainB "full_search" Nothing)
+    void $ createFedConn domainB (FedConn domainA "full_search" Nothing)
+    void $ createFedConn domainA (FedConn domainC "full_search" Nothing)
+    void $ createFedConn domainC (FedConn domainA "full_search" Nothing)
     liftIO $ threadDelay (2 * 1000 * 1000) -- wait for federation status to be updated
 
     -- add users
@@ -386,7 +386,7 @@ testAddingUserNonFullyConnectedFederation = do
 
     -- Ensure that dynamic backend only federates with own domain, but not other
     -- domain.
-    void $ createFedConn dynBackend (FedConn own "full_search" "allow_all")
+    void $ createFedConn dynBackend (FedConn own "full_search" Nothing)
 
     alice <- randomUser own def
     bob <- randomUser other def