diff --git a/changelog.d/2-features/WPB-5389-team-level-federation-guarded-user-connections b/changelog.d/2-features/WPB-5389-team-level-federation-guarded-user-connections new file mode 100644 index 00000000000..6e4cf6ba284 --- /dev/null +++ b/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 diff --git a/integration/integration.cabal b/integration/integration.cabal index dd1aa46f98b..406970323c8 100644 --- a/integration/integration.cabal +++ b/integration/integration.cabal @@ -106,6 +106,7 @@ library Test.B2B Test.Brig Test.Client + Test.Connection Test.Conversation Test.Demo Test.Errors diff --git a/integration/test/API/BrigInternal.hs b/integration/test/API/BrigInternal.hs index 28267ac3a5f..e08351b430f 100644 --- a/integration/test/API/BrigInternal.hs +++ b/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 diff --git a/integration/test/SetupHelpers.hs b/integration/test/SetupHelpers.hs index 270bed8bf7d..be86bbfc69f 100644 --- a/integration/test/SetupHelpers.hs +++ b/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 diff --git a/integration/test/Test/Connection.hs b/integration/test/Test/Connection.hs new file mode 100644 index 00000000000..0852552c1d4 --- /dev/null +++ b/integration/test/Test/Connection.hs @@ -0,0 +1,403 @@ +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2023 Wire Swiss GmbH +-- +-- This program is free software: you can redistribute it and/or modify it under +-- the terms of the GNU Affero General Public License as published by the Free +-- Software Foundation, either version 3 of the License, or (at your option) any +-- later version. +-- +-- This program is distributed in the hope that it will be useful, but WITHOUT +-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more +-- details. +-- +-- You should have received a copy of the GNU Affero General Public License along +-- with this program. If not, see . +module Test.Connection where + +import API.Brig (getConnection, postConnection, putConnection) +import API.BrigInternal +import API.Galley +import SetupHelpers +import Testlib.Prelude +import UnliftIO.Async (forConcurrently_) + +testConnectWithRemoteUser :: HasCallStack => Domain -> App () +testConnectWithRemoteUser owningDomain = do + (alice, bob, one2oneId) <- createOne2OneConversation owningDomain + aliceId <- alice %. "qualified_id" + getConversation alice one2oneId `bindResponse` \resp -> do + resp.status `shouldMatchInt` 200 + others <- resp.json %. "members.others" & asList + qIds <- for others (%. "qualified_id") + qIds `shouldMatchSet` ([] :: [Value]) + void $ putConnection bob alice "accepted" >>= getBody 200 + getConversation bob one2oneId `bindResponse` \resp -> do + resp.status `shouldMatchInt` 200 + others <- resp.json %. "members.others" & asList + qIds <- for others (%. "qualified_id") + qIds `shouldMatchSet` [aliceId] + +testRemoteUserGetsDeleted :: HasCallStack => App () +testRemoteUserGetsDeleted = do + alice <- randomUser OwnDomain def + + charlieConnected <- do + charlie <- randomUser OtherDomain def + connectTwoUsers alice charlie + pure charlie + + charliePending <- do + charlie <- randomUser OtherDomain def + -- the connection should be pending here + postConnection alice charlie `bindResponse` \resp -> + resp.status `shouldMatchInt` 201 + + getConnection alice charlie `bindResponse` \resp -> do + resp.json %. "status" `shouldMatch` "sent" + resp.status `shouldMatchInt` 200 + + getConnection charlie alice `waitForResponse` \resp -> do + resp.json %. "status" `shouldMatch` "pending" + resp.status `shouldMatchInt` 200 + + pure charlie + + charlieBlocked <- do + charlie <- randomUser OtherDomain def + postConnection alice charlie `bindResponse` \resp -> + resp.status `shouldMatchInt` 201 + + putConnection charlie alice "blocked" `bindResponse` \resp -> + resp.status `shouldMatchInt` 200 + + getConnection charlie alice `bindResponse` \resp -> do + resp.json %. "status" `shouldMatch` "blocked" + resp.status `shouldMatchInt` 200 + + pure charlie + + charlieUnconnected <- do + randomUser OtherDomain def + + forConcurrently_ [charliePending, charlieConnected, charlieBlocked, charlieUnconnected] \charlie -> do + deleteUser charlie + + -- charlie is on their local backend, so asking should be instant + getConnection charlie alice `bindResponse` \resp -> + resp.status `shouldMatchInt` 404 + + -- for alice, charlie is on the remote backend, so the status change + -- may not be instant + getConnection alice charlie `waitForResponse` \resp -> + resp.status `shouldMatchInt` 404 + +testInternalGetConStatusesAll :: HasCallStack => App () +testInternalGetConStatusesAll = + startDynamicBackends [mempty] \[dynBackend] -> do + let mkFiveUsers dom = replicateM 5 do + randomUser dom def + alices <- mkFiveUsers OwnDomain + bobs <- mkFiveUsers OwnDomain + charlies <- mkFiveUsers OtherDomain + dylans <- mkFiveUsers dynBackend + for_ alices \alicei -> do + let connectWith users = do + for_ users \useri -> + postConnection alicei useri `bindResponse` \resp -> + resp.status `shouldMatchInt` 201 + putConnection (head users) alicei "accepted" `bindResponse` \resp -> + resp.status `shouldMatchOneOf` [Number 200, Number 204] + -- local: connect each alice, accept only one + connectWith bobs + -- remote 1 & 2: connect each alice, accept only one + connectWith charlies + connectWith dylans + + getConnStatusForUsers alices OwnDomain `bindResponse` \resp -> do + resp.status `shouldMatchInt` 200 + conns <- asList resp.json + let statusIs f = + filterM + do + \conn -> do + s <- conn %. "status" & asString + pure $ f s + conns + + sent <- statusIs (== "sent") + accepted <- statusIs (== "accepted") + other <- statusIs \v -> v /= "sent" && v /= "accepted" + + length other `shouldMatchInt` 0 + length accepted `shouldMatchInt` 15 + length sent `shouldMatchInt` 60 + +assertConnectionStatus :: + ( HasCallStack, + MakesValue userFrom, + MakesValue userTo + ) => + userFrom -> + userTo -> + String -> + App () +assertConnectionStatus userFrom userTo connStatus = + getConnection userFrom userTo `bindResponse` \resp -> do + resp.status `shouldMatchInt` 200 + resp.json %. "status" `shouldMatch` connStatus + +testConnectFromIgnored :: HasCallStack => App () +testConnectFromIgnored = do + [alice, bob] <- forM [OwnDomain, OtherDomain] $ flip randomUser def + void $ postConnection bob alice >>= getBody 201 + -- set up an initial "ignored" state on Alice's side + assertConnectionStatus alice bob "pending" + void $ putConnection alice bob "ignored" >>= getBody 200 + assertConnectionStatus alice bob "ignored" + + -- if Bob sends a new connection request, Alice goes back to "pending" + void $ postConnection bob alice >>= getBody 200 + assertConnectionStatus alice bob "pending" + + -- if Alice accepts, and Bob still wants to connect, Alice transitions to + -- "accepted" + putConnection alice bob "accepted" `bindResponse` \resp -> do + resp.status `shouldMatchInt` 200 + resp.json %. "status" `shouldMatch` "accepted" + +testSentFromIgnored :: HasCallStack => App () +testSentFromIgnored = do + [alice, bob] <- forM [OwnDomain, OtherDomain] $ flip randomUser def + -- set up an initial "ignored" state + void $ postConnection bob alice >>= getBody 201 + void $ putConnection alice bob "ignored" >>= getBody 200 + assertConnectionStatus alice bob "ignored" + + -- if Bob rescinds, Alice stays in "ignored" + void $ putConnection bob alice "cancelled" >>= getBody 200 + assertConnectionStatus alice bob "ignored" + + -- if Alice accepts, and Bob does not want to connect anymore, Alice + -- transitions to "sent" + void $ putConnection alice bob "accepted" >>= getBody 200 + assertConnectionStatus alice bob "sent" + +testConnectFromBlocked :: HasCallStack => App () +testConnectFromBlocked = do + (alice, bob, one2oneId) <- createOne2OneConversation OwnDomain + bobId <- bob %. "qualified_id" + + -- set up an initial "blocked" state + void $ postConnection bob alice >>= getBody 200 + void $ putConnection alice bob "blocked" >>= getBody 200 + assertConnectionStatus alice bob "blocked" + getConversation alice one2oneId `bindResponse` \resp -> + resp.status `shouldMatchInt` 403 + + -- If Bob sends a new connection request, Alice ignores it + void $ postConnection bob alice >>= getBody 200 + assertConnectionStatus alice bob "blocked" + + -- if Alice accepts (or sends a connection request), and Bob still + -- wants to connect, Alice transitions to "accepted" + void $ postConnection alice bob >>= getBody 200 + assertConnectionStatus alice bob "accepted" + getConversation alice one2oneId `bindResponse` \resp -> do + resp.status `shouldMatchInt` 200 + others <- resp.json %. "members.others" & asList + qIds <- for others (%. "qualified_id") + qIds `shouldMatchSet` [bobId] + +testSentFromBlocked :: HasCallStack => App () +testSentFromBlocked = do + [alice, bob] <- forM [OwnDomain, OtherDomain] $ flip randomUser def + -- set up an initial "blocked" state + void $ postConnection bob alice >>= getBody 201 + void $ putConnection alice bob "blocked" >>= getBody 200 + assertConnectionStatus alice bob "blocked" + + -- if Bob rescinds, Alice stays in "blocked" + void $ putConnection bob alice "cancelled" >>= getBody 200 + assertConnectionStatus alice bob "blocked" + + -- if Alice accepts, and Bob does not want to connect anymore, Alice + -- transitions to "sent" + void $ putConnection alice bob "accepted" >>= getBody 200 + assertConnectionStatus alice bob "sent" + +testCancel :: HasCallStack => App () +testCancel = do + [alice, bob] <- forM [OwnDomain, OtherDomain] $ flip randomUser def + + void $ postConnection alice bob >>= getBody 201 + assertConnectionStatus alice bob "sent" + + void $ putConnection alice bob "cancelled" >>= getBody 200 + assertConnectionStatus alice bob "cancelled" + +testConnectionLimits :: HasCallStack => App () +testConnectionLimits = do + let connectionLimit = 16 + + alice <- randomUser OwnDomain def + [charlie1, charlie2, charlie3, charlie4] <- replicateM 4 do + randomUser OtherDomain def + -- connect to connectionLimit - 1 many users + (charlie5 : _) <- replicateM (connectionLimit - 1) do + charlie <- randomUser OtherDomain def + postConnection alice charlie `bindResponse` \resp -> + resp.status `shouldMatchInt` 201 + pure charlie + + -- CHARLIE 1 + + -- accepting one more connection should be fine + postConnection charlie1 alice `bindResponse` \resp -> + resp.status `shouldMatchInt` 201 + putConnection alice charlie1 "accepted" `waitForResponse` \resp -> + resp.status `shouldMatchInt` 200 + + -- resending a connection accept should be idempotent + putConnection alice charlie1 "accepted" `waitForResponse` \resp -> + resp.status `shouldMatchInt` 200 + + -- CHARLIE 2 + + -- an incoming connection beyond the limit should make it + -- impossible for alice to accept + postConnection charlie2 alice `bindResponse` \resp -> + resp.status `shouldMatchInt` 201 + + putConnection alice charlie2 "accepted" `waitForResponse` \resp -> do + resp.json %. "label" `shouldMatch` "connection-limit" + resp.status `shouldMatchInt` 403 + + -- the status should stay pending + getConnection alice charlie2 `bindResponse` \resp -> do + resp.json %. "status" `shouldMatch` "pending" + resp.status `shouldMatchInt` 200 + + -- CHARLIE 5 + + -- the remote should be able to accept + putConnection charlie5 alice "accepted" `waitForResponse` \resp -> + resp.status `shouldMatchInt` 200 + + -- the status should change for alice as well + getConnection alice charlie5 `waitForResponse` \resp -> do + resp.json %. "status" `shouldMatch` "accepted" + resp.status `shouldMatchInt` 200 + + -- CHARLIE 3 + + -- attempting to send a new connection request should also hit the limit + postConnection alice charlie3 `waitForResponse` \resp -> do + resp.json %. "label" `shouldMatch` "connection-limit" + resp.status `shouldMatchInt` 403 + + -- CHARLIE 4 + + -- blocking should not count towards the connection limit, so after blocking + -- charlie 1, we should be able establish another connection + putConnection alice charlie1 "blocked" `bindResponse` \resp -> + resp.status `shouldMatchInt` 200 + + postConnection alice charlie4 `bindResponse` \resp -> + resp.status `shouldMatchInt` 201 + +testNonFederatingRemoteTeam :: HasCallStack => App () +testNonFederatingRemoteTeam = + withFederatingBackendsAllowDynamic $ \(domainA, domainB, _) -> do + sequence_ + [ createFedConn domainA (FedConn domainB defSearchPolicy Nothing), + createFedConn domainB (FedConn domainA defSearchPolicy Nothing) + ] + void $ updateFedConn domainA domainB (FedConn domainB defSearchPolicy $ Just []) + alice <- randomUser domainA def + bob <- randomUser domainB def + postConnection alice bob `bindResponse` \resp -> do + resp.status `shouldMatchInt` 403 + resp.json %. "label" `shouldMatch` "team-not-federating" + where + defSearchPolicy = "full_search" + +testNonMutualFederationConnectionAttempt :: HasCallStack => App () +testNonMutualFederationConnectionAttempt = + withFederatingBackendsAllowDynamic $ \(domainA, domainB, _) -> do + sequence_ + [ createFedConn domainA (FedConn domainB defSearchPolicy Nothing), + createFedConn domainB (FedConn domainA defSearchPolicy Nothing) + ] + alice <- randomUser domainA def + bob <- randomUser domainB def {API.BrigInternal.team = True} + + -- Alice's backend federates with Bob's team + void $ updateFedConn domainA domainB (FedConn domainB defSearchPolicy $ Just []) + bobTeamId <- bob %. "team" + addFederationRemoteTeam domainA domainB bobTeamId + + -- Bob's backend federates with no team on Alice's backend + void $ updateFedConn domainB domainA (FedConn domainA defSearchPolicy $ Just []) + + postConnection alice bob `bindResponse` \resp -> do + resp.status `shouldMatchInt` 403 + resp.json %. "label" `shouldMatch` "team-not-federating" + where + defSearchPolicy = "full_search" + +testFederationAllowAllConnectWithRemote :: HasCallStack => App () +testFederationAllowAllConnectWithRemote = + withFederatingBackendsAllowDynamic $ \(domainA, domainB, _) -> do + sequence_ + [ createFedConn domainA (FedConn domainB defSearchPolicy Nothing), + createFedConn domainB (FedConn domainA defSearchPolicy Nothing) + ] + void $ createAndConnectUsers [domainA, domainB] + where + defSearchPolicy = "full_search" + +testFederationAllowDynamicConnectWithRemote :: HasCallStack => App () +testFederationAllowDynamicConnectWithRemote = + withFederatingBackendsAllowDynamic $ \(domainA, domainB, _) -> do + sequence_ + [ createFedConn domainA (FedConn domainB defSearchPolicy Nothing), + createFedConn domainB (FedConn domainA defSearchPolicy Nothing) + ] + alice <- randomUser domainA def {API.BrigInternal.team = True} + bob <- randomUser domainB def {API.BrigInternal.team = True} + + -- Alice's backend federates with Bob's team + void $ updateFedConn domainA domainB (FedConn domainB defSearchPolicy $ Just []) + bobTeamId <- bob %. "team" + addFederationRemoteTeam domainA domainB bobTeamId + + -- Bob's backend federates with Alice's team + void $ updateFedConn domainB domainA (FedConn domainA defSearchPolicy $ Just []) + aliceTeamId <- alice %. "team" + addFederationRemoteTeam domainB domainA aliceTeamId + + connectTwoUsers alice bob + where + defSearchPolicy = "full_search" + +testFederationAllowMixedConnectWithRemote :: HasCallStack => App () +testFederationAllowMixedConnectWithRemote = + withFederatingBackendsAllowDynamic $ \(domainA, domainB, _) -> do + sequence_ + [ createFedConn domainA (FedConn domainB defSearchPolicy Nothing), + createFedConn domainB (FedConn domainA defSearchPolicy Nothing) + ] + alice <- randomUser domainA def {API.BrigInternal.team = True} + bob <- randomUser domainB def {API.BrigInternal.team = True} + + -- Alice's backend federates with Bob's backend. Bob's backend federates + -- with Alice's team. + void $ updateFedConn domainB domainA (FedConn domainA defSearchPolicy $ Just []) + aliceTeamId <- alice %. "team" + addFederationRemoteTeam domainB domainA aliceTeamId + + connectTwoUsers alice bob + where + defSearchPolicy = "full_search" diff --git a/integration/test/Test/Conversation.hs b/integration/test/Test/Conversation.hs index 03a25b4b8b5..09839b33708 100644 --- a/integration/test/Test/Conversation.hs +++ b/integration/test/Test/Conversation.hs @@ -719,15 +719,8 @@ testOnUserDeletedConversations = do [alice, alex, bob, bart, chad] <- createUsers [ownDomain, ownDomain, otherDomain, otherDomain, dynDomain] forM_ [alex, bob, bart, chad] $ connectTwoUsers alice bobId <- bob %. "qualified_id" - ooConvId <- do - l <- getAllConvs alice - let isWith users c = do - t <- (==) <$> (c %. "type" & asInt) <*> pure 2 - others <- c %. "members.others" & asList - qIds <- for others (%. "qualified_id") - pure $ qIds == users && t - c <- head <$> filterM (isWith [bobId]) l - c %. "qualified_id" + ooConvId <- + getOne2OneConversation alice bobId Established >>= (%. "qualified_id") mainConvBefore <- postConversation alice (defProteus {qualifiedUsers = [alex, bob, bart, chad]}) diff --git a/integration/test/Test/Federation.hs b/integration/test/Test/Federation.hs index e1960f73f63..b52ea59f873 100644 --- a/integration/test/Test/Federation.hs +++ b/integration/test/Test/Federation.hs @@ -128,7 +128,7 @@ testNotificationsForOfflineBackends = do -- FUTUREWORK: Uncomment after fixing this bug: https://wearezeta.atlassian.net/browse/WPB-3664 -- void $ awaitNotification downUser1 downClient1 (Just newMsgNotif) 1 isOtherUser2LeaveUpConvNotif - -- void $ awaitNotification otherUser otherClient (Just newMsgNotif) 1 isDelUserLeaveDownConvNotif + -- void $ awaitNotification otherUser otherClient (Just newMsgNotif) isDelUserLeaveDownConvNotif delUserDeletedNotif <- nPayload $ awaitNotification downUser1 downClient1 (Just newMsgNotif) isDeleteUserNotif objQid delUserDeletedNotif `shouldMatch` objQid delUser diff --git a/integration/test/Testlib/Cannon.hs b/integration/test/Testlib/Cannon.hs index eb30cd74c5b..5be8be575ee 100644 --- a/integration/test/Testlib/Cannon.hs +++ b/integration/test/Testlib/Cannon.hs @@ -36,6 +36,7 @@ module Testlib.Cannon nPayload, printAwaitResult, printAwaitAtLeastResult, + waitForResponse, ) where @@ -43,6 +44,7 @@ import Control.Concurrent import Control.Concurrent.Async import Control.Concurrent.STM.TChan import Control.Exception (throwIO) +import Control.Exception qualified as E import Control.Monad import Control.Monad.Catch hiding (bracket) import Control.Monad.Catch qualified as Catch @@ -70,6 +72,7 @@ import Testlib.HTTP import Testlib.JSON import Testlib.Printing import Testlib.Types +import UnliftIO (withRunInIO) import Prelude data WebSocket = WebSocket @@ -463,3 +466,17 @@ nPayload :: MakesValue a => a -> App Value nPayload event = do payloads <- event %. "payload" & asList assertOne payloads + +-- | waits for an http response to satisfy a predicate +waitForResponse :: HasCallStack => App Response -> (Response -> App r) -> App r +waitForResponse act p = do + tSecs <- asks timeOutSeconds + r <- withRunInIO \inIO -> + timeout (1000 * 1000 * tSecs) do + let go = do + inIO (bindResponse act p) `E.catch` \(_ :: AssertionFailure) -> do + threadDelay 1000 + go + go + let err = unwords ["Expected event didn't come true after", show tSecs, "seconds"] + maybe (assertFailure err) pure r diff --git a/libs/wire-api-federation/src/Wire/API/Federation/API/Brig.hs b/libs/wire-api-federation/src/Wire/API/Federation/API/Brig.hs index 94ecad6dba2..e289ed8711f 100644 --- a/libs/wire-api-federation/src/Wire/API/Federation/API/Brig.hs +++ b/libs/wire-api-federation/src/Wire/API/Federation/API/Brig.hs @@ -147,6 +147,9 @@ instance ToSchema MLSClientsRequest data NewConnectionRequest = NewConnectionRequest { -- | The 'from' userId is understood to always have the domain of the backend making the connection request from :: UserId, + -- | The team ID of the 'from' user. If the user is not in a team, it is set + -- to 'Nothing'. It is implicitly qualified the same as the 'from' user. + fromTeam :: Maybe TeamId, -- | The 'to' userId is understood to always have the domain of the receiving backend. to :: UserId, action :: RemoteConnectionAction @@ -168,6 +171,7 @@ instance ToSchema RemoteConnectionAction data NewConnectionResponse = NewConnectionResponseUserNotActivated + | NewConnectionResponseNotFederating | NewConnectionResponseOk (Maybe RemoteConnectionAction) deriving stock (Eq, Show, Generic) deriving (Arbitrary) via (GenericUniform NewConnectionResponse) diff --git a/libs/wire-api-federation/test/Test/Wire/API/Federation/Golden/NewConnectionRequest.hs b/libs/wire-api-federation/test/Test/Wire/API/Federation/Golden/NewConnectionRequest.hs index de8b20ca950..071334cdee4 100644 --- a/libs/wire-api-federation/test/Test/Wire/API/Federation/Golden/NewConnectionRequest.hs +++ b/libs/wire-api-federation/test/Test/Wire/API/Federation/Golden/NewConnectionRequest.hs @@ -26,6 +26,7 @@ testObject_NewConnectionRequest1 :: NewConnectionRequest testObject_NewConnectionRequest1 = NewConnectionRequest { from = Id (fromJust (UUID.fromString "69f66843-6cf1-48fb-8c05-1cf58c23566a")), + fromTeam = Just . Id . fromJust . UUID.fromString $ "59f66843-6af1-48fb-8c05-1cf58c23566b", to = Id (fromJust (UUID.fromString "1669240c-c510-43e0-bf1a-33378fa4ba55")), action = RemoteConnect } @@ -34,6 +35,7 @@ testObject_NewConnectionRequest2 :: NewConnectionRequest testObject_NewConnectionRequest2 = NewConnectionRequest { from = Id (fromJust (UUID.fromString "69f66843-6cf1-48fb-8c05-1cf58c23566a")), + fromTeam = Nothing, to = Id (fromJust (UUID.fromString "1669240c-c510-43e0-bf1a-33378fa4ba55")), action = RemoteRescind } diff --git a/libs/wire-api-federation/test/golden/testObject_NewConnectionRequest1.json b/libs/wire-api-federation/test/golden/testObject_NewConnectionRequest1.json index 0657122cdbb..28e0af80d61 100644 --- a/libs/wire-api-federation/test/golden/testObject_NewConnectionRequest1.json +++ b/libs/wire-api-federation/test/golden/testObject_NewConnectionRequest1.json @@ -1,5 +1,6 @@ { "action": "RemoteConnect", "from": "69f66843-6cf1-48fb-8c05-1cf58c23566a", + "from_team": "59f66843-6af1-48fb-8c05-1cf58c23566b", "to": "1669240c-c510-43e0-bf1a-33378fa4ba55" } \ No newline at end of file diff --git a/libs/wire-api-federation/test/golden/testObject_NewConnectionRequest2.json b/libs/wire-api-federation/test/golden/testObject_NewConnectionRequest2.json index 32f52b7f307..7b1f918af82 100644 --- a/libs/wire-api-federation/test/golden/testObject_NewConnectionRequest2.json +++ b/libs/wire-api-federation/test/golden/testObject_NewConnectionRequest2.json @@ -1,5 +1,6 @@ { "action": "RemoteRescind", "from": "69f66843-6cf1-48fb-8c05-1cf58c23566a", + "from_team": null, "to": "1669240c-c510-43e0-bf1a-33378fa4ba55" } \ No newline at end of file diff --git a/libs/wire-api/src/Wire/API/Error/Brig.hs b/libs/wire-api/src/Wire/API/Error/Brig.hs index 467af72786d..5552453b222 100644 --- a/libs/wire-api/src/Wire/API/Error/Brig.hs +++ b/libs/wire-api/src/Wire/API/Error/Brig.hs @@ -91,6 +91,7 @@ data BrigError | VerificationCodeThrottled | InvalidProvider | ProviderNotFound + | TeamsNotFederating instance (Typeable (MapError e), KnownError (MapError e)) => IsSwaggerError (e :: BrigError) where addToOpenApi = addStaticErrorToSwagger @(MapError e) @@ -272,3 +273,5 @@ type instance MapError 'NotificationNotFound = 'StaticError 404 "not-found" "Not type instance MapError 'PendingInvitationNotFound = 'StaticError 404 "not-found" "No pending invitations exists." type instance MapError 'ConflictingInvitations = 'StaticError 409 "conflicting-invitations" "Multiple conflicting invitations to different teams exists." + +type instance MapError 'TeamsNotFederating = 'StaticError 403 "team-not-federating" "The target user is owned by a federated backend, but is not in an allow-listed team" diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs index d5b71ccde6a..205b207e402 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs @@ -971,6 +971,7 @@ type ConnectionAPI = :<|> Named "create-connection" ( Summary "Create a connection to another user" + :> MakesFederatedCall 'Brig "get-users-by-ids" :> MakesFederatedCall 'Brig "send-connection-action" :> CanThrow 'MissingLegalholdConsent :> CanThrow 'InvalidUser @@ -1078,6 +1079,7 @@ type ConnectionAPI = Named "update-connection" ( Summary "Update a connection to another user" + :> MakesFederatedCall 'Brig "get-users-by-ids" :> MakesFederatedCall 'Brig "send-connection-action" :> CanThrow 'MissingLegalholdConsent :> CanThrow 'InvalidUser diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Util.hs b/libs/wire-api/src/Wire/API/Routes/Public/Util.hs index ab34186bb12..5517bb6635e 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Util.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Util.hs @@ -21,6 +21,7 @@ module Wire.API.Routes.Public.Util where import Control.Comonad +import Data.Maybe import Data.SOP (I (..), NS (..)) import Servant import Servant.OpenApi.Internal.Orphans () @@ -62,6 +63,9 @@ data UpdateResult a | Updated !a deriving (Functor) +mkUpdateResult :: Maybe a -> UpdateResult a +mkUpdateResult = maybe Unchanged Updated + type UpdateResponses unchangedDesc updatedDesc a = '[ RespondEmpty 204 unchangedDesc, Respond 200 updatedDesc a diff --git a/services/brig/src/Brig/API/Connection.hs b/services/brig/src/Brig/API/Connection.hs index e298ebf14fb..88484ca4480 100644 --- a/services/brig/src/Brig/API/Connection.hs +++ b/services/brig/src/Brig/API/Connection.hs @@ -21,7 +21,9 @@ module Brig.API.Connection ( -- * Connections createConnection, + createConnectionToLocalUser, updateConnection, + updateConnectionToLocalUser, UpdateConnectionsInternal (..), updateConnectionInternal, lookupConnections, @@ -39,6 +41,7 @@ import Brig.App import Brig.Data.Connection qualified as Data import Brig.Data.Types (resultHasMore, resultList) import Brig.Data.User qualified as Data +import Brig.Effects.FederationConfigStore import Brig.Effects.GalleyProvider (GalleyProvider) import Brig.Effects.GalleyProvider qualified as GalleyProvider import Brig.IO.Intra qualified as Intra @@ -62,11 +65,6 @@ import Wire.API.Error import Wire.API.Error.Brig qualified as E import Wire.API.Routes.Public.Util (ResponseForExistedCreated (..)) -ensureIsActivated :: Local UserId -> MaybeT (AppT r) () -ensureIsActivated lusr = do - active <- lift . wrapClient $ Data.isActivated (tUnqualified lusr) - guard active - ensureNotSameTeam :: Member GalleyProvider r => Local UserId -> Local UserId -> (ConnectionM r) () ensureNotSameTeam self target = do selfTeam <- lift $ liftSem $ GalleyProvider.getTeamId (tUnqualified self) @@ -75,18 +73,14 @@ ensureNotSameTeam self target = do throwE ConnectSameBindingTeamUsers createConnection :: - (Member GalleyProvider r) => + ( Member FederationConfigStore r, + Member GalleyProvider r + ) => Local UserId -> ConnId -> Qualified UserId -> - (ConnectionM r) (ResponseForExistedCreated UserConnection) + ConnectionM r (ResponseForExistedCreated UserConnection) createConnection self con target = do - -- basic checks: no need to distinguish between local and remote at this point - when (tUntagged self == target) $ - throwE (InvalidUser target) - noteT ConnectNoIdentity $ - ensureIsActivated self - -- branch according to whether we are connecting to a local or remote user foldQualified self @@ -99,8 +93,9 @@ createConnectionToLocalUser :: Local UserId -> ConnId -> Local UserId -> - (ConnectionM r) (ResponseForExistedCreated UserConnection) + ConnectionM r (ResponseForExistedCreated UserConnection) createConnectionToLocalUser self conn target = do + ensureNotSameAndActivated self (tUntagged target) noteT (InvalidUser (tUntagged target)) $ ensureIsActivated target checkLegalholdPolicyConflict (tUnqualified self) (tUnqualified target) @@ -210,6 +205,7 @@ checkLegalholdPolicyConflict uid1 uid2 = do oneway status2 status1 updateConnection :: + Member FederationConfigStore r => Local UserId -> Qualified UserId -> Relation -> diff --git a/services/brig/src/Brig/API/Connection/Remote.hs b/services/brig/src/Brig/API/Connection/Remote.hs index 5dcd7b101e2..8d75155198a 100644 --- a/services/brig/src/Brig/API/Connection/Remote.hs +++ b/services/brig/src/Brig/API/Connection/Remote.hs @@ -23,20 +23,23 @@ module Brig.API.Connection.Remote ) where -import Brig.API.Connection.Util (ConnectionM, checkLimit) +import Brig.API.Connection.Util import Brig.API.Types (ConnectionError (..)) import Brig.App import Brig.Data.Connection qualified as Data -import Brig.Federation.Client (sendConnectionAction) +import Brig.Data.User qualified as Data +import Brig.Effects.FederationConfigStore +import Brig.Federation.Client import Brig.IO.Intra qualified as Intra import Brig.Types.User.Event import Control.Comonad import Control.Error.Util ((??)) -import Control.Monad.Trans.Except (runExceptT, throwE) +import Control.Monad.Trans.Except import Data.Id as Id import Data.Qualified import Imports import Network.Wai.Utilities.Error +import Polysemy import Wire.API.Connection import Wire.API.Federation.API.Brig ( NewConnectionResponse (..), @@ -44,6 +47,7 @@ import Wire.API.Federation.API.Brig ) import Wire.API.Routes.Internal.Galley.ConversationsIntra (Actor (..), DesiredMembership (..), UpsertOne2OneConversationRequest (..), UpsertOne2OneConversationResponse (uuorConvId)) import Wire.API.Routes.Public.Util (ResponseForExistedCreated (..)) +import Wire.API.User data LocalConnectionAction = LocalConnect @@ -198,9 +202,17 @@ performLocalAction self mzcon other mconnection action = do checkLimitForLocalAction self rel0 action mrel2 <- for (transition (LCA action) rel0) $ \rel1 -> do mreaction <- fmap join . for (remoteAction action) $ \ra -> do - response <- sendConnectionAction self other ra !>> ConnectFederationError + mSelfTeam <- lift . wrapClient . Data.lookupUserTeam . tUnqualified $ self + response <- + sendConnectionAction + self + (qualifyAs self <$> mSelfTeam) + other + ra + !>> ConnectFederationError case (response :: NewConnectionResponse) of NewConnectionResponseOk reaction -> pure reaction + NewConnectionResponseNotFederating -> throwE ConnectTeamFederationError NewConnectionResponseUserNotActivated -> throwE (InvalidUser (tUntagged other)) pure $ fromMaybe rel1 $ do @@ -251,21 +263,26 @@ performRemoteAction self other mconnection action = do reaction _ = Nothing createConnectionToRemoteUser :: + Member FederationConfigStore r => Local UserId -> ConnId -> Remote UserId -> - (ConnectionM r) (ResponseForExistedCreated UserConnection) + ConnectionM r (ResponseForExistedCreated UserConnection) createConnectionToRemoteUser self zcon other = do + ensureNotSameAndActivated self (tUntagged other) + ensureFederatesWith other mconnection <- lift . wrapClient $ Data.lookupConnection self (tUntagged other) fst <$> performLocalAction self (Just zcon) other mconnection LocalConnect updateConnectionToRemoteUser :: + Member FederationConfigStore r => Local UserId -> Remote UserId -> Relation -> Maybe ConnId -> (ConnectionM r) (Maybe UserConnection) updateConnectionToRemoteUser self other rel1 zcon = do + ensureFederatesWith other mconnection <- lift . wrapClient $ Data.lookupConnection self (tUntagged other) action <- actionForTransition rel1 @@ -285,3 +302,17 @@ checkLimitForLocalAction :: Local UserId -> Relation -> LocalConnectionAction -> checkLimitForLocalAction u oldRel action = when (oldRel `notElem` [Accepted, Sent] && (action == LocalConnect)) $ checkLimit u + +-- | Check if the local backend federates with the remote user's team. Throw an +-- exception if it does not federate. +ensureFederatesWith :: + Member FederationConfigStore r => + Remote UserId -> + ConnectionM r () +ensureFederatesWith remote = do + profiles <- + withExceptT ConnectFederationError $ + getUsersByIds (tDomain remote) [tUnqualified remote] + let rTeam = qualifyAs remote $ profileTeam =<< listToMaybe profiles + unlessM (lift . liftSem . backendFederatesWith $ rTeam) $ + throwE ConnectTeamFederationError diff --git a/services/brig/src/Brig/API/Connection/Util.hs b/services/brig/src/Brig/API/Connection/Util.hs index 7999d9cbe9f..6b3cf894483 100644 --- a/services/brig/src/Brig/API/Connection/Util.hs +++ b/services/brig/src/Brig/API/Connection/Util.hs @@ -18,18 +18,21 @@ module Brig.API.Connection.Util ( ConnectionM, checkLimit, + ensureIsActivated, + ensureNotSameAndActivated, ) where import Brig.API.Types import Brig.App import Brig.Data.Connection qualified as Data +import Brig.Data.User qualified as Data import Brig.Options (Settings (setUserMaxConnections)) -import Control.Error (noteT) +import Control.Error (MaybeT, noteT) import Control.Lens (view) import Control.Monad.Trans.Except import Data.Id (UserId) -import Data.Qualified (Local, tUnqualified) +import Data.Qualified import Imports import Wire.API.Connection (Relation (..)) @@ -42,3 +45,15 @@ checkLimit u = noteT (TooManyConnections (tUnqualified u)) $ do n <- lift . wrapClient $ Data.countConnections u [Accepted, Sent] l <- setUserMaxConnections <$> view settings guard (n < l) + +ensureNotSameAndActivated :: Local UserId -> Qualified UserId -> ConnectionM r () +ensureNotSameAndActivated self target = do + when (tUntagged self == target) $ + throwE (InvalidUser target) + noteT ConnectNoIdentity $ + ensureIsActivated self + +ensureIsActivated :: Local UserId -> MaybeT (AppT r) () +ensureIsActivated lusr = do + active <- lift . wrapClient $ Data.isActivated (tUnqualified lusr) + guard active diff --git a/services/brig/src/Brig/API/Error.hs b/services/brig/src/Brig/API/Error.hs index 376047ba874..d1d09ca01df 100644 --- a/services/brig/src/Brig/API/Error.hs +++ b/services/brig/src/Brig/API/Error.hs @@ -73,6 +73,7 @@ connError ConnectInvalidPhone {} = StdError (errorToWai @'E.InvalidPhone) connError ConnectSameBindingTeamUsers = StdError sameBindingTeamUsers connError ConnectMissingLegalholdConsent = StdError (errorToWai @'E.MissingLegalholdConsent) connError (ConnectFederationError e) = fedError e +connError ConnectTeamFederationError = StdError (errorToWai @'E.TeamsNotFederating) actError :: ActivationError -> Error actError (UserKeyExists _) = StdError (errorToWai @'E.UserKeyExists) diff --git a/services/brig/src/Brig/API/Federation.hs b/services/brig/src/Brig/API/Federation.hs index f956eef123c..1902ada4390 100644 --- a/services/brig/src/Brig/API/Federation.hs +++ b/services/brig/src/Brig/API/Federation.hs @@ -107,17 +107,26 @@ getFederationStatus _ request = do fedDomains <- fromList . fmap (.domain) . (.remotes) <$> lift (liftSem $ E.getFederationConfigs) pure $ NonConnectedBackends (request.domains \\ fedDomains) -sendConnectionAction :: Domain -> NewConnectionRequest -> Handler r NewConnectionResponse +sendConnectionAction :: + Member FederationConfigStore r => + Domain -> + NewConnectionRequest -> + Handler r NewConnectionResponse sendConnectionAction originDomain NewConnectionRequest {..} = do - active <- lift $ wrapClient $ Data.isActivated to - if active + let rTeam = qTagUnsafe (Qualified fromTeam originDomain) + federates <- lift . liftSem . E.backendFederatesWith $ rTeam + if federates then do - self <- qualifyLocal to - let other = toRemoteUnsafe originDomain from - mconnection <- lift . wrapClient $ Data.lookupConnection self (tUntagged other) - maction <- lift $ performRemoteAction self other mconnection action - pure $ NewConnectionResponseOk maction - else pure NewConnectionResponseUserNotActivated + active <- lift $ wrapClient $ Data.isActivated to + if active + then do + self <- qualifyLocal to + let other = toRemoteUnsafe originDomain from + mconnection <- lift . wrapClient $ Data.lookupConnection self (tUntagged other) + maction <- lift $ performRemoteAction self other mconnection action + pure $ NewConnectionResponseOk maction + else pure NewConnectionResponseUserNotActivated + else pure NewConnectionResponseNotFederating getUserByHandle :: ( Member GalleyProvider r, diff --git a/services/brig/src/Brig/API/Public.hs b/services/brig/src/Brig/API/Public.hs index 5d07821f192..120cf416c96 100644 --- a/services/brig/src/Brig/API/Public.hs +++ b/services/brig/src/Brig/API/Public.hs @@ -133,7 +133,7 @@ import Wire.API.Routes.Public.Galley import Wire.API.Routes.Public.Gundeck import Wire.API.Routes.Public.Proxy import Wire.API.Routes.Public.Spar -import Wire.API.Routes.Public.Util qualified as Public +import Wire.API.Routes.Public.Util import Wire.API.Routes.Version import Wire.API.SwaggerHelper (cleanupSwagger) import Wire.API.SystemSettings @@ -995,33 +995,47 @@ createConnectionUnqualified :: UserId -> ConnId -> Public.ConnectionRequest -> - (Handler r) (Public.ResponseForExistedCreated Public.UserConnection) + Handler r (ResponseForExistedCreated Public.UserConnection) createConnectionUnqualified self conn cr = do lself <- qualifyLocal self target <- qualifyLocal (Public.crUser cr) - API.createConnection lself conn (tUntagged target) !>> connError + API.createConnectionToLocalUser lself conn target !>> connError createConnection :: - (Member GalleyProvider r) => + ( Member FederationConfigStore r, + Member GalleyProvider r + ) => UserId -> ConnId -> Qualified UserId -> - (Handler r) (Public.ResponseForExistedCreated Public.UserConnection) + Handler r (ResponseForExistedCreated Public.UserConnection) createConnection self conn target = do lself <- qualifyLocal self API.createConnection lself conn target !>> connError -updateLocalConnection :: UserId -> ConnId -> UserId -> Public.ConnectionUpdate -> (Handler r) (Public.UpdateResult Public.UserConnection) -updateLocalConnection self conn other update = do +updateLocalConnection :: + UserId -> + ConnId -> + UserId -> + Public.ConnectionUpdate -> + Handler r (UpdateResult Public.UserConnection) +updateLocalConnection self conn other (Public.cuStatus -> newStatus) = do + lself <- qualifyLocal self lother <- qualifyLocal other - updateConnection self conn (tUntagged lother) update + mkUpdateResult + <$> API.updateConnectionToLocalUser lself lother newStatus (Just conn) !>> connError -updateConnection :: UserId -> ConnId -> Qualified UserId -> Public.ConnectionUpdate -> (Handler r) (Public.UpdateResult Public.UserConnection) -updateConnection self conn other update = do - let newStatus = Public.cuStatus update +updateConnection :: + Member FederationConfigStore r => + UserId -> + ConnId -> + Qualified UserId -> + Public.ConnectionUpdate -> + Handler r (UpdateResult Public.UserConnection) +updateConnection self conn other (Public.cuStatus -> newStatus) = do lself <- qualifyLocal self - mc <- API.updateConnection lself other newStatus (Just conn) !>> connError - pure $ maybe Public.Unchanged Public.Updated mc + mkUpdateResult + <$> API.updateConnection lself other newStatus (Just conn) !>> connError listLocalConnections :: UserId -> Maybe UserId -> Maybe (Range 1 500 Int32) -> (Handler r) Public.UserConnectionList listLocalConnections uid start msize = do diff --git a/services/brig/src/Brig/API/Types.hs b/services/brig/src/Brig/API/Types.hs index 3a6e8f606b3..8071bd7c4df 100644 --- a/services/brig/src/Brig/API/Types.hs +++ b/services/brig/src/Brig/API/Types.hs @@ -129,6 +129,8 @@ data ConnectionError ConnectMissingLegalholdConsent | -- | Remote connection creation or update failed because of a federation error ConnectFederationError FederationError + | -- | The teams of the users that want to connect do not federate + ConnectTeamFederationError data PasswordResetError = PasswordResetInProgress (Maybe Timeout) diff --git a/services/brig/src/Brig/Effects/FederationConfigStore.hs b/services/brig/src/Brig/Effects/FederationConfigStore.hs index 94c67b6112e..07ace482740 100644 --- a/services/brig/src/Brig/Effects/FederationConfigStore.hs +++ b/services/brig/src/Brig/Effects/FederationConfigStore.hs @@ -4,6 +4,7 @@ module Brig.Effects.FederationConfigStore where import Data.Domain import Data.Id +import Data.Qualified import Imports import Polysemy import Wire.API.Routes.FederationDomainConfig @@ -31,5 +32,7 @@ data FederationConfigStore m a where AddFederationRemoteTeam :: Domain -> TeamId -> FederationConfigStore m AddFederationRemoteTeamResult RemoveFederationRemoteTeam :: Domain -> TeamId -> FederationConfigStore m () GetFederationRemoteTeams :: Domain -> FederationConfigStore m [FederationRemoteTeam] + -- | Check if the local backend federates with a remote team. + BackendFederatesWith :: Remote (Maybe TeamId) -> FederationConfigStore m Bool makeSem ''FederationConfigStore diff --git a/services/brig/src/Brig/Effects/FederationConfigStore/Cassandra.hs b/services/brig/src/Brig/Effects/FederationConfigStore/Cassandra.hs index 8eb569920ba..0d348dd4e3b 100644 --- a/services/brig/src/Brig/Effects/FederationConfigStore/Cassandra.hs +++ b/services/brig/src/Brig/Effects/FederationConfigStore/Cassandra.hs @@ -31,6 +31,7 @@ import Control.Monad.Catch (throwM) import Data.Domain import Data.Id import Data.Map qualified as Map +import Data.Qualified import Database.CQL.Protocol (SerialConsistency (LocalSerialConsistency), serialConsistency) import Imports import Polysemy @@ -63,6 +64,7 @@ interpretFederationDomainConfig mFedStrategy fedCfgs = AddFederationRemoteTeam d t -> addFederationRemoteTeam' fedCfgs d t RemoveFederationRemoteTeam d t -> removeFederationRemoteTeam' d t GetFederationRemoteTeams d -> getFederationRemoteTeams' d + BackendFederatesWith mtid -> backendFederatesWithImpl mtid fedCfgs mFedStrategy -- | Compile config file list into a map indexed by domains. Use this to make sure the config -- file is consistent (ie., no two entries for the same domain). @@ -76,7 +78,12 @@ remotesMapFromCfgFile cfg = else error $ "error in config file: conflicting parameters on domain: " <> show (c, c') in Map.fromListWith merge dict -getFederationConfigs' :: forall m. (MonadClient m) => Maybe FederationStrategy -> Map Domain FederationDomainConfig -> m FederationDomainConfigs +getFederationConfigs' :: + forall m. + (MonadClient m) => + Maybe FederationStrategy -> + Map Domain FederationDomainConfig -> + m FederationDomainConfigs getFederationConfigs' mFedStrategy cfgs = do -- FUTUREWORK: we should solely rely on `db` in the future for remote domains; merging -- remote domains from `cfg` is just for providing an easier, more robust migration path. @@ -219,6 +226,31 @@ removeFederationRemoteTeam' rDomain rteam = delete :: PrepQuery W (Domain, TeamId) () delete = "DELETE FROM federation_remote_teams WHERE domain = ? AND team = ?" +backendFederatesWithImpl :: + MonadClient m => + Remote (Maybe TeamId) -> + Map Domain FederationDomainConfig -> + Maybe FederationStrategy -> + m Bool +backendFederatesWithImpl (tUntagged -> Qualified Nothing rDomain) staticCfgs = \case + Nothing -> pure False + Just AllowNone -> pure False + Just AllowAll -> pure True + Just AllowDynamic -> do + getFederationConfig' staticCfgs rDomain >>= \case + Nothing -> pure False + Just c -> pure $ restriction c == FederationRestrictionAllowAll +backendFederatesWithImpl (tUntagged -> Qualified (Just rTeam) rDomain) staticCfgs = \case + Nothing -> pure False + Just AllowNone -> pure False + Just AllowAll -> pure True + Just AllowDynamic -> + getFederationConfig' staticCfgs rDomain >>= \case + Nothing -> pure False + Just (FederationDomainConfig _ _ FederationRestrictionAllowAll) -> + pure True + Just (FederationDomainConfig _ _ (FederationRestrictionByTeam ts)) -> pure $ rTeam `elem` ts + data RestrictionException = RestrictionException Int32 instance Show RestrictionException where diff --git a/services/brig/src/Brig/Federation/Client.hs b/services/brig/src/Brig/Federation/Client.hs index 87c44ec4465..cd1de446d2e 100644 --- a/services/brig/src/Brig/Federation/Client.hs +++ b/services/brig/src/Brig/Federation/Client.hs @@ -27,7 +27,7 @@ import Control.Retry import Control.Timeout import Data.Domain import Data.Handle -import Data.Id (ClientId, UserId) +import Data.Id import Data.Qualified import Data.Range (Range) import Data.Text qualified as T @@ -127,11 +127,17 @@ getUserClients domain guc = do sendConnectionAction :: (MonadReader Env m, MonadIO m, Log.MonadLogger m) => Local UserId -> + Maybe (Local TeamId) -> Remote UserId -> RemoteConnectionAction -> ExceptT FederationError m NewConnectionResponse -sendConnectionAction self (tUntagged -> other) action = do - let req = NewConnectionRequest (tUnqualified self) (qUnqualified other) action +sendConnectionAction self mSelfTeam (tUntagged -> other) action = do + let req = + NewConnectionRequest + (tUnqualified self) + (tUnqualified <$> mSelfTeam) + (qUnqualified other) + action lift $ Log.info $ Log.msg @Text "Brig-federation: sending connection action to remote backend" runBrigFederatorClient (qDomain other) $ fedClient @'Brig @"send-connection-action" req diff --git a/services/brig/src/Brig/Options.hs b/services/brig/src/Brig/Options.hs index dac8446d2ac..df9e086d017 100644 --- a/services/brig/src/Brig/Options.hs +++ b/services/brig/src/Brig/Options.hs @@ -640,7 +640,8 @@ instance FromJSON ImplicitNoFederationRestriction where ( \obj -> do domain <- obj Aeson..: "domain" searchPolicy <- obj Aeson..: "search_policy" - pure $ ImplicitNoFederationRestriction $ FederationDomainConfig domain searchPolicy FederationRestrictionAllowAll + pure . ImplicitNoFederationRestriction $ + FederationDomainConfig domain searchPolicy FederationRestrictionAllowAll ) defaultTemplateLocale :: Locale diff --git a/services/brig/test/integration/API/Federation.hs b/services/brig/test/integration/API/Federation.hs index 7dd448eb307..2f0def2baef 100644 --- a/services/brig/test/integration/API/Federation.hs +++ b/services/brig/test/integration/API/Federation.hs @@ -19,7 +19,6 @@ module API.Federation where import API.Search.Util (refreshIndex) -import API.User.Util import Bilge hiding (head) import Bilge.Assert import Brig.Options qualified as Opt @@ -31,21 +30,16 @@ import Data.Handle (Handle (..)) import Data.Id import Data.Map qualified as Map import Data.Qualified -import Data.Range import Data.Set qualified as Set -import Data.Timeout import Data.UUID.V4 qualified as UUIDv4 import Federation.Util (generateClientPrekeys) import Imports import Network.Wai.Test qualified as WaiTest import Test.QuickCheck hiding ((===)) import Test.Tasty -import Test.Tasty.Cannon qualified as WS import Test.Tasty.HUnit import Util -import Wire.API.Connection import Wire.API.Federation.API.Brig -import Wire.API.Federation.API.Brig qualified as FedBrig import Wire.API.Federation.API.Brig qualified as S import Wire.API.Federation.Component import Wire.API.Federation.Version @@ -57,8 +51,8 @@ import Wire.API.User.Search import Wire.API.UserMap (UserMap (UserMap)) -- Note: POST /federation/send-connection-action is implicitly tested in API.User.Connection -tests :: Manager -> Opt.Opts -> Brig -> Cannon -> FedClient 'Brig -> IO TestTree -tests m opts brig cannon fedBrigClient = +tests :: Manager -> Opt.Opts -> Brig -> FedClient 'Brig -> IO TestTree +tests m opts brig fedBrigClient = pure $ testGroup "federation" @@ -79,7 +73,6 @@ tests m opts brig cannon fedBrigClient = test m "POST /federation/claim-multi-prekey-bundle : 200" (testClaimMultiPrekeyBundleSuccess brig fedBrigClient), test m "POST /federation/get-user-clients : 200" (testGetUserClients brig fedBrigClient), test m "POST /federation/get-user-clients : Not Found" (testGetUserClientsNotFound fedBrigClient), - test m "POST /federation/on-user-deleted-connections : 200" (testRemoteUserGetsDeleted opts brig cannon fedBrigClient), test m "POST /federation/api-version : 200" (testAPIVersion brig fedBrigClient) ] @@ -377,32 +370,6 @@ testGetUserClientsNotFound fedBrigClient = do (Just (Set.fromList [])) (fmap (Set.map pubClientId) . Map.lookup absentUserId $ userClients) -testRemoteUserGetsDeleted :: Opt.Opts -> Brig -> Cannon -> FedClient 'Brig -> Http () -testRemoteUserGetsDeleted opts brig cannon fedBrigClient = do - connectedUser <- (.userId) <$> randomUser brig - pendingUser <- (.userId) <$> randomUser brig - blockedUser <- (.userId) <$> randomUser brig - unconnectedUser <- (.userId) <$> randomUser brig - remoteUser <- fakeRemoteUser - - sendConnectionAction brig opts connectedUser remoteUser (Just FedBrig.RemoteConnect) Accepted - receiveConnectionAction brig fedBrigClient pendingUser remoteUser FedBrig.RemoteConnect Nothing Pending - sendConnectionAction brig opts blockedUser remoteUser (Just FedBrig.RemoteConnect) Accepted - putConnectionQualified brig blockedUser remoteUser Blocked !!! statusCode === const 200 - - let localUsers = [connectedUser, pendingUser, blockedUser, unconnectedUser] - void . WS.bracketRN cannon localUsers $ \[cc, pc, bc, uc] -> do - _ <- - runFedClient @"on-user-deleted-connections" fedBrigClient (qDomain remoteUser) $ - UserDeletedConnectionsNotification (qUnqualified remoteUser) (unsafeRange localUsers) - - retryT $ WS.assertMatchN_ (60 # Second) [cc] $ matchDeleteUserNotification remoteUser - retryT $ WS.assertNoEvent (1 # Second) [pc, bc, uc] - - for_ localUsers $ \u -> - getConnectionQualified brig u remoteUser !!! do - const 404 === statusCode - testAPIVersion :: Brig -> FedClient 'Brig -> Http () testAPIVersion _brig fedBrigClient = do vinfo <- runFedClient @"api-version" fedBrigClient (Domain "far-away.example.com") () diff --git a/services/brig/test/integration/API/User.hs b/services/brig/test/integration/API/User.hs index ab3402c38e7..59e79905156 100644 --- a/services/brig/test/integration/API/User.hs +++ b/services/brig/test/integration/API/User.hs @@ -46,7 +46,6 @@ import Wire.API.Federation.Component tests :: Opt.Opts -> FedClient 'Brig -> - FedClient 'Galley -> Manager -> Brig -> Cannon -> @@ -57,7 +56,7 @@ tests :: DB.ClientState -> UserJournalWatcher -> IO TestTree -tests conf fbc fgc p b c ch g n aws db userJournalWatcher = do +tests conf fbc p b c ch g n aws db userJournalWatcher = do let cl = ConnectionLimit $ Opt.setUserMaxConnections (Opt.optSettings conf) let at = Opt.setActivationTimeout (Opt.optSettings conf) z <- mkZAuthEnv (Just conf) @@ -67,7 +66,7 @@ tests conf fbc fgc p b c ch g n aws db userJournalWatcher = do [ API.User.Client.tests cl at conf p db n b c g, API.User.Account.tests cl at conf p b c ch g aws userJournalWatcher, API.User.Auth.tests conf p z db b g n, - API.User.Connection.tests cl at conf p b c g fbc fgc db, + API.User.Connection.tests cl at p b c g fbc db, API.User.Handles.tests cl at conf p b c g, API.User.PasswordReset.tests db cl at conf p b c g, API.User.Property.tests cl at conf p b c g, diff --git a/services/brig/test/integration/API/User/Connection.hs b/services/brig/test/integration/API/User/Connection.hs index f00bcb69db5..90559a710a1 100644 --- a/services/brig/test/integration/API/User/Connection.hs +++ b/services/brig/test/integration/API/User/Connection.hs @@ -44,7 +44,6 @@ import Util import Wire.API.Connection import Wire.API.Conversation import Wire.API.Federation.API.Brig -import Wire.API.Federation.API.Galley (GetConversationsRequest (..), GetConversationsResponse (convs), RemoteConvMembers (others), RemoteConversation (members)) import Wire.API.Federation.Component import Wire.API.Routes.Internal.Brig.Connection import Wire.API.Routes.MultiTablePaging @@ -53,16 +52,14 @@ import Wire.API.User tests :: ConnectionLimit -> Opt.Timeout -> - Opt.Opts -> Manager -> Brig -> Cannon -> Galley -> FedClient 'Brig -> - FedClient 'Galley -> DB.ClientState -> TestTree -tests cl _at opts p b _c g fedBrigClient fedGalleyClient db = +tests cl _at p b _c g fedBrigClient db = testGroup "connection" [ test p "post /connections" $ testCreateManualConnections b, @@ -99,16 +96,7 @@ tests cl _at opts p b _c g fedBrigClient fedGalleyClient db = test p "Remote connections: connect OK" (testConnectOK b g fedBrigClient), test p "Remote connections: connect with Anon" (testConnectWithAnon b fedBrigClient), test p "Remote connections: connection from Anon" (testConnectFromAnon b), - test p "Remote connections: mutual Connect - local action then remote action" (testConnectMutualLocalActionThenRemoteAction opts b g fedBrigClient), - test p "Remote connections: mutual Connect - remote action then local action" (testConnectMutualRemoteActionThenLocalAction opts b fedBrigClient fedGalleyClient), - test p "Remote connections: connect twice" (testConnectFromPending b fedBrigClient), - test p "Remote connections: ignore then accept" (testConnectFromIgnored opts b fedBrigClient), - test p "Remote connections: ignore, remote cancels, then accept" (testSentFromIgnored opts b fedBrigClient), - test p "Remote connections: block then accept" (testConnectFromBlocked opts b g fedBrigClient), - test p "Remote connections: block, remote cancels, then accept" (testSentFromBlocked opts b fedBrigClient), - test p "Remote connections: send then cancel" (testCancel opts b), - test p "Remote connections: limits" (testConnectionLimits opts b fedBrigClient), - test p "post /users/connections-status/v2 : All connections" (testInternalGetConnStatusesAll b opts fedBrigClient) + test p "Remote connections: connect twice" (testConnectFromPending b fedBrigClient) ] testCreateConnectionInvalidUser :: Brig -> Http () @@ -740,7 +728,7 @@ testConnectWithAnon brig fedBrigClient = do toUser <- (.userId) <$> createAnonUser "anon1234" brig res <- runFedClient @"send-connection-action" fedBrigClient (Domain "far-away.example.com") $ - NewConnectionRequest fromUser toUser RemoteConnect + NewConnectionRequest fromUser Nothing toUser RemoteConnect liftIO $ assertEqual "The response should specify that the user is not activated" NewConnectionResponseUserNotActivated res @@ -750,250 +738,9 @@ testConnectFromAnon brig = do remoteUser <- fakeRemoteUser postConnectionQualified brig anonUser remoteUser !!! const 403 === statusCode -testConnectMutualLocalActionThenRemoteAction :: Opt.Opts -> Brig -> Galley -> FedClient 'Brig -> Http () -testConnectMutualLocalActionThenRemoteAction opts brig galley fedBrigClient = do - let convIsLocal = True - (uid1, quid2, convId) <- localAndRemoteUserWithConvId brig convIsLocal - - -- First create a connection request from local to remote user, as this test - -- aims to test the behaviour of recieving a mutual request from remote - sendConnectionAction brig opts uid1 quid2 Nothing Sent - - do - res <- - getConversationQualified galley uid1 convId Brig -> FedClient 'Brig -> FedClient 'Galley -> Http () -testConnectMutualRemoteActionThenLocalAction opts brig fedBrigClient fedGalleyClient = do - let convIsLocal = True - (uid1, quid2, convId) <- localAndRemoteUserWithConvId brig convIsLocal - - -- First create a connection request from remote to local user, as this test - -- aims to test the behaviour of sending a mutual request to remote - receiveConnectionAction brig fedBrigClient uid1 quid2 RemoteConnect Nothing Pending - - let request = - GetConversationsRequest - { userId = qUnqualified quid2, - convIds = [qUnqualified convId] - } - - res <- runFedClient @"get-conversations" fedGalleyClient (qDomain quid2) request - liftIO $ - fmap (fmap omQualifiedId . others . members) res.convs @?= [[]] - - -- The mock response has 'RemoteConnect' as action, because the remote backend - -- cannot be sure if the local backend was previously in Ignored state or not - sendConnectionAction brig opts uid1 quid2 (Just RemoteConnect) Accepted - testConnectFromPending :: Brig -> FedClient 'Brig -> Http () testConnectFromPending brig fedBrigClient = do (uid1, quid2) <- localAndRemoteUser brig receiveConnectionAction brig fedBrigClient uid1 quid2 RemoteConnect Nothing Pending receiveConnectionAction brig fedBrigClient uid1 quid2 RemoteConnect Nothing Pending receiveConnectionAction brig fedBrigClient uid1 quid2 RemoteRescind Nothing Cancelled - -testConnectFromIgnored :: Opt.Opts -> Brig -> FedClient 'Brig -> Http () -testConnectFromIgnored opts brig fedBrigClient = do - (uid1, quid2) <- localAndRemoteUser brig - - -- set up an initial 'Ignored' state - receiveConnectionAction brig fedBrigClient uid1 quid2 RemoteConnect Nothing Pending - putConnectionQualified brig uid1 quid2 Ignored !!! statusCode === const 200 - assertConnectionQualified brig uid1 quid2 Ignored - - -- if the remote side sends a new connection request, we go back to 'Pending' - receiveConnectionAction brig fedBrigClient uid1 quid2 RemoteConnect Nothing Pending - - -- if we accept, and the remote side still wants to connect, we transition to 'Accepted' - sendConnectionAction brig opts uid1 quid2 (Just RemoteConnect) Accepted - -testSentFromIgnored :: Opt.Opts -> Brig -> FedClient 'Brig -> Http () -testSentFromIgnored opts brig fedBrigClient = do - (uid1, quid2) <- localAndRemoteUser brig - - -- set up an initial 'Ignored' state - receiveConnectionAction brig fedBrigClient uid1 quid2 RemoteConnect Nothing Pending - putConnectionQualified brig uid1 quid2 Ignored !!! statusCode === const 200 - assertConnectionQualified brig uid1 quid2 Ignored - - -- if the remote side rescinds, we stay in 'Ignored' - receiveConnectionAction brig fedBrigClient uid1 quid2 RemoteRescind Nothing Ignored - - -- if we accept, and the remote does not want to connect anymore, we transition to 'Sent' - sendConnectionAction brig opts uid1 quid2 Nothing Sent - -testConnectFromBlocked :: Opt.Opts -> Brig -> Galley -> FedClient 'Brig -> Http () -testConnectFromBlocked opts brig galley fedBrigClient = do - let convIsLocal = True - (uid1, quid2, convId) <- localAndRemoteUserWithConvId brig convIsLocal - - -- set up an initial 'Blocked' state - receiveConnectionAction brig fedBrigClient uid1 quid2 RemoteConnect Nothing Pending - putConnectionQualified brig uid1 quid2 Blocked !!! statusCode === const 200 - assertConnectionQualified brig uid1 quid2 Blocked - - getConversationQualified galley uid1 convId - !!! statusCode === const 403 - - -- if the remote side sends a new connection request, we ignore it - receiveConnectionAction brig fedBrigClient uid1 quid2 RemoteConnect Nothing Blocked - - -- if we accept (or send a connection request), and the remote side still - -- wants to connect, we transition to 'Accepted' - sendConnectionAction brig opts uid1 quid2 (Just RemoteConnect) Accepted - - do - res <- - getConversationQualified galley uid1 convId Brig -> FedClient 'Brig -> Http () -testSentFromBlocked opts brig fedBrigClient = do - (uid1, quid2) <- localAndRemoteUser brig - - -- set up an initial 'Blocked' state - receiveConnectionAction brig fedBrigClient uid1 quid2 RemoteConnect Nothing Pending - putConnectionQualified brig uid1 quid2 Blocked !!! statusCode === const 200 - assertConnectionQualified brig uid1 quid2 Blocked - - -- if the remote side rescinds, we stay in 'Blocked' - receiveConnectionAction brig fedBrigClient uid1 quid2 RemoteRescind Nothing Blocked - - -- if we accept, and the remote does not want to connect anymore, we transition to 'Sent' - sendConnectionAction brig opts uid1 quid2 Nothing Sent - -testCancel :: Opt.Opts -> Brig -> Http () -testCancel opts brig = do - (uid1, quid2) <- localAndRemoteUser brig - - sendConnectionAction brig opts uid1 quid2 Nothing Sent - sendConnectionUpdateAction brig opts uid1 quid2 Nothing Cancelled - -testConnectionLimits :: Opt.Opts -> Brig -> FedClient 'Brig -> Http () -testConnectionLimits opts brig fedBrigClient = do - let connectionLimit = Opt.setUserMaxConnections (Opt.optSettings opts) - (uid1, quid2) <- localAndRemoteUser brig - [quid3, quid4, quid5] <- replicateM 3 fakeRemoteUser - - -- set up N-1 connections from uid1 to remote users - (quid6Sent : _) <- replicateM (fromIntegral connectionLimit - 1) (newConn uid1) - - -- accepting another one should be allowed - receiveConnectionAction brig fedBrigClient uid1 quid2 RemoteConnect Nothing Pending - sendConnectionAction brig opts uid1 quid2 (Just RemoteConnect) Accepted - - -- get an incoming connection requests beyond the limit, This connection - -- cannot be accepted. This is also the behaviour without federation, if the - -- user wants to accept this one, they have to either sacrifice another - -- connection or ask the backend operator to increase the limit. - receiveConnectionAction brig fedBrigClient uid1 quid3 RemoteConnect Nothing Pending - - -- accepting the second one hits the limit (and relation stays Pending): - sendConnectionActionExpectLimit uid1 quid3 (Just RemoteConnect) - assertConnectionQualified brig uid1 quid3 Pending - - -- When a remote accepts, it is allowed, this does not break the limit as a - -- Sent becomes an Accepted. - assertConnectionQualified brig uid1 quid6Sent Sent - receiveConnectionAction brig fedBrigClient uid1 quid6Sent RemoteConnect (Just RemoteConnect) Accepted - - -- attempting to send an own new connection request also hits the limit - sendConnectionActionExpectLimit uid1 quid4 (Just RemoteConnect) - getConnectionQualified brig uid1 quid4 !!! const 404 === statusCode - - -- (re-)sending an already accepted connection does not affect the limit - sendConnectionAction brig opts uid1 quid2 (Just RemoteConnect) Accepted - - -- blocked connections do not count towards the limit - putConnectionQualified brig uid1 quid2 Blocked !!! statusCode === const 200 - assertConnectionQualified brig uid1 quid2 Blocked - - -- after blocking quid2, we can now accept another connection request - receiveConnectionAction brig fedBrigClient uid1 quid5 RemoteConnect Nothing Pending - sendConnectionAction brig opts uid1 quid5 (Just RemoteConnect) Accepted - where - newConn :: UserId -> Http (Qualified UserId) - newConn from = do - to <- fakeRemoteUser - sendConnectionAction brig opts from to Nothing Sent - pure to - - sendConnectionActionExpectLimit :: HasCallStack => UserId -> Qualified UserId -> Maybe RemoteConnectionAction -> Http () - sendConnectionActionExpectLimit uid1 quid2 _reaction = do - postConnectionQualified brig uid1 quid2 !!! do - const 403 === statusCode - const (Just "connection-limit") === fmap Error.label . responseJsonMaybe - -testInternalGetConnStatusesAll :: Brig -> Opt.Opts -> FedClient 'Brig -> Http () -testInternalGetConnStatusesAll brig opts fedBrigClient = do - quids <- replicateM 2 $ userQualifiedId <$> randomUser brig - let uids = qUnqualified <$> quids - - localUsers@(localUser1 : _) <- replicateM 5 $ userQualifiedId <$> randomUser brig - let remoteDomain1 = Domain "remote1.example.com" - remoteDomain1Users@(remoteDomain1User1 : _) <- replicateM 5 $ (`Qualified` remoteDomain1) <$> randomId - let remoteDomain2 = Domain "remote2.example.com" - remoteDomain2Users@(remoteDomain2User1 : _) <- replicateM 5 $ (`Qualified` remoteDomain2) <$> randomId - - for_ uids $ \uid -> do - -- Create 5 local connections, accept 1 - for_ localUsers $ \qOther -> do - postConnectionQualified brig uid qOther sendConnectionAction brig opts uid qOther Nothing Sent - receiveConnectionAction brig fedBrigClient uid remoteDomain1User1 RemoteConnect (Just RemoteConnect) Accepted - - -- Create 5 remote connections with remote2, accept 1 - for_ remoteDomain2Users $ \qOther -> sendConnectionAction brig opts uid qOther Nothing Sent - receiveConnectionAction brig fedBrigClient uid remoteDomain2User1 RemoteConnect (Just RemoteConnect) Accepted - - allStatuses :: [ConnectionStatusV2] <- - responseJsonError - =<< getConnStatusInternal brig (ConnectionsStatusRequestV2 uids Nothing Nothing) - remoteDomain1Users <> remoteDomain2Users - sort (map csv2To allStatuses) @?= sort (allUsers <> allUsers) - length (filter ((== Sent) . csv2Status) allStatuses) @?= 24 - length (filter ((== Accepted) . csv2Status) allStatuses) @?= 6 - - acceptedRemoteDomain1Only :: [ConnectionStatusV2] <- - responseJsonError - =<< getConnStatusInternal brig (ConnectionsStatusRequestV2 uids (Just remoteDomain1Users) (Just Accepted)) - ConnectionStatusV2 u remoteDomain1User1 Accepted) uids) - -getConnStatusInternal :: MonadHttp m => (Request -> Request) -> ConnectionsStatusRequestV2 -> m (Response (Maybe LByteString)) -getConnStatusInternal brig req = - post $ - brig - . path "/i/users/connections-status/v2" - . json req diff --git a/services/brig/test/integration/API/User/Util.hs b/services/brig/test/integration/API/User/Util.hs index 120d35f08fc..031a521e504 100644 --- a/services/brig/test/integration/API/User/Util.hs +++ b/services/brig/test/integration/API/User/Util.hs @@ -392,7 +392,7 @@ receiveConnectionAction :: receiveConnectionAction brig fedBrigClient uid1 quid2 action expectedReaction expectedRel = do res <- runFedClient @"send-connection-action" fedBrigClient (qDomain quid2) $ - F.NewConnectionRequest (qUnqualified quid2) uid1 action + F.NewConnectionRequest (qUnqualified quid2) Nothing uid1 action liftIO $ do res @?= F.NewConnectionResponseOk expectedReaction assertConnectionQualified brig uid1 quid2 expectedRel @@ -419,7 +419,7 @@ sendConnectionAction brig opts uid1 quid2 reaction expectedRel = do frComponent req @?= Brig frRPC req @?= "send-connection-action" eitherDecode (frBody req) - @?= Right (F.NewConnectionRequest uid1 (qUnqualified quid2) F.RemoteConnect) + @?= Right (F.NewConnectionRequest uid1 Nothing (qUnqualified quid2) F.RemoteConnect) liftIO $ assertBool "postConnectionQualified failed" $ statusCode res `elem` [200, 201] assertConnectionQualified brig uid1 quid2 expectedRel diff --git a/services/brig/test/integration/Federation/End2end.hs b/services/brig/test/integration/Federation/End2end.hs index 44415359f39..b696338e0fe 100644 --- a/services/brig/test/integration/Federation/End2end.hs +++ b/services/brig/test/integration/Federation/End2end.hs @@ -592,7 +592,15 @@ claimRemoteKeyPackages brig1 brig2 = do Set.map (\e -> (e.user, e.client)) bundle.entries @?= Set.fromList [(bob, c) | c <- bobClients] -testRemoteTypingIndicator :: Brig -> Brig -> Galley -> Galley -> Cannon -> Cannon -> Http () +testRemoteTypingIndicator :: + HasCallStack => + Brig -> + Brig -> + Galley -> + Galley -> + Cannon -> + Cannon -> + Http () testRemoteTypingIndicator brig1 brig2 galley1 galley2 cannon1 cannon2 = do alice <- randomUser brig1 bob <- randomUser brig2 diff --git a/services/brig/test/integration/Run.hs b/services/brig/test/integration/Run.hs index 3ad5570fb22..324dc92a6d8 100644 --- a/services/brig/test/integration/Run.hs +++ b/services/brig/test/integration/Run.hs @@ -141,11 +141,10 @@ runTests iConf brigOpts otherArgs = do db <- defInitCassandra casKey casHost casPort lg mg <- newManager tlsManagerSettings let fedBrigClient = FedClient @'Brig mg (brig iConf) - let fedGalleyClient = FedClient @'Galley mg (galley iConf) emailAWSOpts <- parseEmailAWSOpts awsEnv <- AWS.mkEnv lg awsOpts emailAWSOpts mg mUserJournalWatcher <- for (Opts.userJournalQueue awsOpts) $ SQS.watchSQSQueue (view AWS.amazonkaEnv awsEnv) - userApi <- User.tests brigOpts fedBrigClient fedGalleyClient mg b c ch g n awsEnv db mUserJournalWatcher + userApi <- User.tests brigOpts fedBrigClient mg b c ch g n awsEnv db mUserJournalWatcher providerApi <- Provider.tests localDomain (provider iConf) mg db b c g n searchApis <- Search.tests brigOpts mg g b teamApis <- Team.tests brigOpts mg n b c g mUserJournalWatcher @@ -157,7 +156,7 @@ runTests iConf brigOpts otherArgs = do browseTeam <- TeamUserSearch.tests brigOpts mg g b userPendingActivation <- UserPendingActivation.tests brigOpts mg db b g s federationEnd2End <- Federation.End2end.spec brigOpts mg b g ch c f brigTwo galleyTwo ch2 cannonTwo - federationEndpoints <- API.Federation.tests mg brigOpts b c fedBrigClient + federationEndpoints <- API.Federation.tests mg brigOpts b fedBrigClient internalApi <- API.Internal.tests brigOpts mg db b (brig iConf) gd g let smtp = SMTP.tests mg lg