diff --git a/changelog.d/6-federation/fed-connections b/changelog.d/6-federation/fed-connections new file mode 100644 index 0000000000..f5aa2e774d --- /dev/null +++ b/changelog.d/6-federation/fed-connections @@ -0,0 +1 @@ +Allow connecting to remote users. One to one conversations are not created yet. 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 1e714c58c0..9599b40e4c 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 @@ -20,7 +20,7 @@ module Wire.API.Federation.API.Brig where import Control.Monad.Except (MonadError (..)) import Data.Aeson (FromJSON, ToJSON) import Data.Handle (Handle) -import Data.Id (ClientId, UserId) +import Data.Id import Imports import Servant.API import Servant.API.Generic @@ -28,6 +28,7 @@ import Servant.Client.Generic (AsClientT, genericClient) import Test.QuickCheck (Arbitrary) import Wire.API.Arbitrary (GenericUniform (..)) import Wire.API.Federation.Client (FederationClientFailure, FederatorClient) +import Wire.API.Federation.Domain (OriginDomainHeader) import qualified Wire.API.Federation.GRPC.Types as Proto import Wire.API.Message (UserClients) import Wire.API.User (UserProfile) @@ -92,7 +93,14 @@ data Api routes = Api :- "federation" :> "get-user-clients" :> ReqBody '[JSON] GetUserClients - :> Post '[JSON] (UserMap (Set PubClient)) + :> Post '[JSON] (UserMap (Set PubClient)), + sendConnectionAction :: + routes + :- "federation" + :> "send-connection-action" + :> OriginDomainHeader + :> ReqBody '[JSON] NewConnectionRequest + :> Post '[JSON] NewConnectionResponse } deriving (Generic) @@ -102,5 +110,46 @@ newtype GetUserClients = GetUserClients deriving stock (Eq, Show, Generic) deriving (ToJSON, FromJSON) via (CustomEncoded GetUserClients) +-- NOTE: ConversationId for remote connections +-- +-- The plan is to model the connect/one2one conversationId as deterministically derived from +-- the combination of both userIds and both domains. It may be in the domain +-- of the sending OR the receiving backend (with a 50/50 probability). +-- However at the level of the federation API, we are only concerned about +-- the question of which backend has the authority over the conversationId. +-- +-- (Backend A should not prescribe backend B to use a certain UUID for its +-- conversation; as that could lead to a potential malicious override of an +-- existing conversation) +-- +-- The deterministic conversation Id should be seen as a 'best effort' +-- attempt only. (we cannot guarantee a backend won't change the code in the +-- future) + +data NewConnectionRequest = NewConnectionRequest + { -- | The 'from' userId is understood to always have the domain of the backend making the connection request + ncrFrom :: UserId, + -- | The 'to' userId is understood to always have the domain of the receiving backend. + ncrTo :: UserId, + ncrAction :: RemoteConnectionAction + } + deriving stock (Eq, Show, Generic) + deriving (Arbitrary) via (GenericUniform NewConnectionRequest) + deriving (FromJSON, ToJSON) via (CustomEncoded NewConnectionRequest) + +data RemoteConnectionAction + = RemoteConnect + | RemoteRescind + deriving stock (Eq, Show, Generic) + deriving (Arbitrary) via (GenericUniform RemoteConnectionAction) + deriving (FromJSON, ToJSON) via (CustomEncoded RemoteConnectionAction) + +data NewConnectionResponse + = NewConnectionResponseUserNotActivated + | NewConnectionResponseOk (Maybe RemoteConnectionAction) + deriving stock (Eq, Show, Generic) + deriving (Arbitrary) via (GenericUniform NewConnectionResponse) + deriving (FromJSON, ToJSON) via (CustomEncoded NewConnectionResponse) + clientRoutes :: (MonadError FederationClientFailure m, MonadIO m) => Api (AsClientT (FederatorClient 'Proto.Brig m)) clientRoutes = genericClient diff --git a/libs/wire-api-federation/test/Test/Wire/API/Federation/Golden/GoldenSpec.hs b/libs/wire-api-federation/test/Test/Wire/API/Federation/Golden/GoldenSpec.hs index eb9fded308..8142d17ae1 100644 --- a/libs/wire-api-federation/test/Test/Wire/API/Federation/Golden/GoldenSpec.hs +++ b/libs/wire-api-federation/test/Test/Wire/API/Federation/Golden/GoldenSpec.hs @@ -23,6 +23,8 @@ import qualified Test.Wire.API.Federation.Golden.ConversationUpdate as Conversat import qualified Test.Wire.API.Federation.Golden.LeaveConversationRequest as LeaveConversationRequest import qualified Test.Wire.API.Federation.Golden.LeaveConversationResponse as LeaveConversationResponse import qualified Test.Wire.API.Federation.Golden.MessageSendResponse as MessageSendResponse +import qualified Test.Wire.API.Federation.Golden.NewConnectionRequest as NewConnectionRequest +import qualified Test.Wire.API.Federation.Golden.NewConnectionResponse as NewConnectionResponse import Test.Wire.API.Federation.Golden.Runner (testObjects) spec :: Spec @@ -50,3 +52,13 @@ spec = (LeaveConversationResponse.testObject_LeaveConversationResponse7, "testObject_LeaveConversationResponse7.json"), (LeaveConversationResponse.testObject_LeaveConversationResponse8, "testObject_LeaveConversationResponse8.json") ] + testObjects + [ (NewConnectionRequest.testObject_NewConnectionRequest1, "testObject_NewConnectionRequest1.json"), + (NewConnectionRequest.testObject_NewConnectionRequest2, "testObject_NewConnectionRequest2.json") + ] + testObjects + [ (NewConnectionResponse.testObject_NewConnectionResponse1, "testObject_NewConnectionResponse1.json"), + (NewConnectionResponse.testObject_NewConnectionResponse2, "testObject_NewConnectionResponse2.json"), + (NewConnectionResponse.testObject_NewConnectionResponse3, "testObject_NewConnectionResponse3.json"), + (NewConnectionResponse.testObject_NewConnectionResponse4, "testObject_NewConnectionResponse4.json") + ] 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 new file mode 100644 index 0000000000..07a4d0306f --- /dev/null +++ b/libs/wire-api-federation/test/Test/Wire/API/Federation/Golden/NewConnectionRequest.hs @@ -0,0 +1,39 @@ +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2021 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.Wire.API.Federation.Golden.NewConnectionRequest where + +import Data.Id +import qualified Data.UUID as UUID +import Imports +import Wire.API.Federation.API.Brig + +testObject_NewConnectionRequest1 :: NewConnectionRequest +testObject_NewConnectionRequest1 = + NewConnectionRequest + { ncrFrom = Id (fromJust (UUID.fromString "69f66843-6cf1-48fb-8c05-1cf58c23566a")), + ncrTo = Id (fromJust (UUID.fromString "1669240c-c510-43e0-bf1a-33378fa4ba55")), + ncrAction = RemoteConnect + } + +testObject_NewConnectionRequest2 :: NewConnectionRequest +testObject_NewConnectionRequest2 = + NewConnectionRequest + { ncrFrom = Id (fromJust (UUID.fromString "69f66843-6cf1-48fb-8c05-1cf58c23566a")), + ncrTo = Id (fromJust (UUID.fromString "1669240c-c510-43e0-bf1a-33378fa4ba55")), + ncrAction = RemoteRescind + } diff --git a/libs/wire-api-federation/test/Test/Wire/API/Federation/Golden/NewConnectionResponse.hs b/libs/wire-api-federation/test/Test/Wire/API/Federation/Golden/NewConnectionResponse.hs new file mode 100644 index 0000000000..23c8833459 --- /dev/null +++ b/libs/wire-api-federation/test/Test/Wire/API/Federation/Golden/NewConnectionResponse.hs @@ -0,0 +1,33 @@ +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2021 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.Wire.API.Federation.Golden.NewConnectionResponse where + +import Imports +import Wire.API.Federation.API.Brig + +testObject_NewConnectionResponse1 :: NewConnectionResponse +testObject_NewConnectionResponse1 = NewConnectionResponseOk Nothing + +testObject_NewConnectionResponse2 :: NewConnectionResponse +testObject_NewConnectionResponse2 = NewConnectionResponseOk (Just RemoteConnect) + +testObject_NewConnectionResponse3 :: NewConnectionResponse +testObject_NewConnectionResponse3 = NewConnectionResponseOk (Just RemoteRescind) + +testObject_NewConnectionResponse4 :: NewConnectionResponse +testObject_NewConnectionResponse4 = NewConnectionResponseUserNotActivated diff --git a/libs/wire-api-federation/test/golden/testObject_NewConnectionRequest1.json b/libs/wire-api-federation/test/golden/testObject_NewConnectionRequest1.json new file mode 100644 index 0000000000..cebe1dfa47 --- /dev/null +++ b/libs/wire-api-federation/test/golden/testObject_NewConnectionRequest1.json @@ -0,0 +1,5 @@ +{ + "to": "1669240c-c510-43e0-bf1a-33378fa4ba55", + "from": "69f66843-6cf1-48fb-8c05-1cf58c23566a", + "action": "RemoteConnect" +} \ 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 new file mode 100644 index 0000000000..4610970610 --- /dev/null +++ b/libs/wire-api-federation/test/golden/testObject_NewConnectionRequest2.json @@ -0,0 +1,5 @@ +{ + "to": "1669240c-c510-43e0-bf1a-33378fa4ba55", + "from": "69f66843-6cf1-48fb-8c05-1cf58c23566a", + "action": "RemoteRescind" +} \ No newline at end of file diff --git a/libs/wire-api-federation/test/golden/testObject_NewConnectionResponse1.json b/libs/wire-api-federation/test/golden/testObject_NewConnectionResponse1.json new file mode 100644 index 0000000000..61c94bf0db --- /dev/null +++ b/libs/wire-api-federation/test/golden/testObject_NewConnectionResponse1.json @@ -0,0 +1,4 @@ +{ + "tag": "NewConnectionResponseOk", + "contents": null +} \ No newline at end of file diff --git a/libs/wire-api-federation/test/golden/testObject_NewConnectionResponse2.json b/libs/wire-api-federation/test/golden/testObject_NewConnectionResponse2.json new file mode 100644 index 0000000000..84fa71d736 --- /dev/null +++ b/libs/wire-api-federation/test/golden/testObject_NewConnectionResponse2.json @@ -0,0 +1,4 @@ +{ + "tag": "NewConnectionResponseOk", + "contents": "RemoteConnect" +} \ No newline at end of file diff --git a/libs/wire-api-federation/test/golden/testObject_NewConnectionResponse3.json b/libs/wire-api-federation/test/golden/testObject_NewConnectionResponse3.json new file mode 100644 index 0000000000..aeee3a6db9 --- /dev/null +++ b/libs/wire-api-federation/test/golden/testObject_NewConnectionResponse3.json @@ -0,0 +1,4 @@ +{ + "tag": "NewConnectionResponseOk", + "contents": "RemoteRescind" +} \ No newline at end of file diff --git a/libs/wire-api-federation/test/golden/testObject_NewConnectionResponse4.json b/libs/wire-api-federation/test/golden/testObject_NewConnectionResponse4.json new file mode 100644 index 0000000000..06b6310771 --- /dev/null +++ b/libs/wire-api-federation/test/golden/testObject_NewConnectionResponse4.json @@ -0,0 +1,3 @@ +{ + "tag": "NewConnectionResponseUserNotActivated" +} \ No newline at end of file diff --git a/libs/wire-api-federation/wire-api-federation.cabal b/libs/wire-api-federation/wire-api-federation.cabal index 5fada7cdf1..e8729651c8 100644 --- a/libs/wire-api-federation/wire-api-federation.cabal +++ b/libs/wire-api-federation/wire-api-federation.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: 8106f61fbca587df7a82a89effeec838bb9d9326c84bd7af8f615502cedc152f +-- hash: 03f7245b036ccc38819ed5f5654dae8d96b7ec5917b2f898be3305193bc3faf5 name: wire-api-federation version: 0.1.0 @@ -82,6 +82,8 @@ test-suite spec Test.Wire.API.Federation.Golden.LeaveConversationRequest Test.Wire.API.Federation.Golden.LeaveConversationResponse Test.Wire.API.Federation.Golden.MessageSendResponse + Test.Wire.API.Federation.Golden.NewConnectionRequest + Test.Wire.API.Federation.Golden.NewConnectionResponse Test.Wire.API.Federation.Golden.Runner Test.Wire.API.Federation.GRPC.TypesSpec Paths_wire_api_federation diff --git a/libs/wire-api/package.yaml b/libs/wire-api/package.yaml index b08c802a5a..18108e1cd3 100644 --- a/libs/wire-api/package.yaml +++ b/libs/wire-api/package.yaml @@ -28,6 +28,7 @@ library: - cassandra-util - cassava >= 0.5 - cereal + - comonad - cookie - cryptonite - currency-codes >=2.0 diff --git a/libs/wire-api/src/Wire/API/Connection.hs b/libs/wire-api/src/Wire/API/Connection.hs index 73e60c5028..7a6e51d906 100644 --- a/libs/wire-api/src/Wire/API/Connection.hs +++ b/libs/wire-api/src/Wire/API/Connection.hs @@ -31,6 +31,7 @@ module Wire.API.Connection Relation (..), RelationWithHistory (..), relationDropHistory, + relationWithHistory, -- * Requests ConnectionRequest (..), @@ -192,6 +193,17 @@ data RelationWithHistory deriving stock (Eq, Ord, Show, Generic) deriving (Arbitrary) via (GenericUniform RelationWithHistory) +-- | Convert a 'Relation' to 'RelationWithHistory'. This is to be used only if +-- the MissingLegalholdConsent case does not need to be supported. +relationWithHistory :: Relation -> RelationWithHistory +relationWithHistory Accepted = AcceptedWithHistory +relationWithHistory Blocked = BlockedWithHistory +relationWithHistory Pending = PendingWithHistory +relationWithHistory Ignored = IgnoredWithHistory +relationWithHistory Sent = SentWithHistory +relationWithHistory Cancelled = CancelledWithHistory +relationWithHistory MissingLegalholdConsent = MissingLegalholdConsentFromCancelled + relationDropHistory :: RelationWithHistory -> Relation relationDropHistory = \case AcceptedWithHistory -> Accepted 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 a2479de2af..3779cdad36 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Util.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Util.hs @@ -20,8 +20,8 @@ module Wire.API.Routes.Public.Util where +import Control.Comonad import Data.SOP (I (..), NS (..)) -import Imports import Servant import Servant.Swagger.Internal.Orphans () import Wire.API.Routes.MultiVerb @@ -45,6 +45,13 @@ data ResponseForExistedCreated a | Created !a deriving (Functor) +instance Comonad ResponseForExistedCreated where + extract (Existed x) = x + extract (Created x) = x + + duplicate r@(Existed _) = Existed r + duplicate r@(Created _) = Created r + type ResponsesForExistedCreated eDesc cDesc a = '[ Respond 200 eDesc a, Respond 201 cDesc a diff --git a/libs/wire-api/wire-api.cabal b/libs/wire-api/wire-api.cabal index d76a81d602..e365d0a9b4 100644 --- a/libs/wire-api/wire-api.cabal +++ b/libs/wire-api/wire-api.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: c6591983c73573c4734c452218e0831333768e896f0ab08718ba9f2c6b110567 +-- hash: 3acb28729470b6c8562eb847a9eb27f8ba8f9999ecce268b3a5a404e5f4794b6 name: wire-api version: 0.1.0 @@ -113,6 +113,7 @@ library , cassandra-util , cassava >=0.5 , cereal + , comonad , containers >=0.5 , cookie , cryptonite diff --git a/services/brig/brig.cabal b/services/brig/brig.cabal index 0fafc20c83..5ff67e3f5c 100644 --- a/services/brig/brig.cabal +++ b/services/brig/brig.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: 74882d161b7ecee96907491a40139775942d4f15987cbe1aa30d13b30fc79e0e +-- hash: 33acd5be229059e16903857f1923a9afcf55f285461298721a15d8d8c5b88a12 name: brig version: 1.35.0 @@ -22,6 +22,8 @@ library Brig.API Brig.API.Client Brig.API.Connection + Brig.API.Connection.Remote + Brig.API.Connection.Util Brig.API.Error Brig.API.Federation Brig.API.Handler @@ -137,6 +139,7 @@ library , bytestring >=0.10 , bytestring-conversion >=0.2 , cassandra-util >=0.16.2 + , comonad , conduit >=1.2.8 , containers >=0.5 , cookie >=0.4 diff --git a/services/brig/package.yaml b/services/brig/package.yaml index ff6f5a8574..3adddffd60 100644 --- a/services/brig/package.yaml +++ b/services/brig/package.yaml @@ -31,6 +31,7 @@ library: - bytestring >=0.10 - bytestring-conversion >=0.2 - cassandra-util >=0.16.2 + - comonad - conduit >=1.2.8 - containers >=0.5 - cookie >=0.4 diff --git a/services/brig/src/Brig/API/Connection.hs b/services/brig/src/Brig/API/Connection.hs index d8c7b4b97e..fbf217927c 100644 --- a/services/brig/src/Brig/API/Connection.hs +++ b/services/brig/src/Brig/API/Connection.hs @@ -14,7 +14,6 @@ -- -- You should have received a copy of the GNU Affero General Public License along -- with this program. If not, see . - -- TODO: Move to Brig.User.Connection (& split out Brig.User.Invitation?) -- | > docs/reference/user/connection.md {#RefConnection} @@ -33,6 +32,8 @@ module Brig.API.Connection ) where +import Brig.API.Connection.Remote +import Brig.API.Connection.Util import Brig.API.Error (errorDescriptionTypeToWai) import Brig.API.Types import Brig.API.User (getLegalHoldStatus) @@ -41,11 +42,9 @@ import qualified Brig.Data.Connection as Data import Brig.Data.Types (resultHasMore, resultList) import qualified Brig.Data.User as Data import qualified Brig.IO.Intra as Intra -import Brig.Options (setUserMaxConnections) import Brig.Types import Brig.Types.User.Event import Control.Error -import Control.Lens (view) import Control.Monad.Catch (throwM) import Data.Id as Id import qualified Data.LegalHold as LH @@ -59,21 +58,38 @@ import qualified System.Logger.Class as Log import System.Logger.Message import Wire.API.Connection (RelationWithHistory (..)) import Wire.API.ErrorDescription -import Wire.API.Federation.Error (federationNotImplemented) import Wire.API.Routes.Public.Util (ResponseForExistedCreated (..)) -type ConnectionM = ExceptT ConnectionError AppIO +ensureIsActivated :: Local UserId -> MaybeT AppIO () +ensureIsActivated lusr = do + active <- lift $ Data.isActivated (lUnqualified lusr) + guard active + +ensureNotSameTeam :: Local UserId -> Local UserId -> ConnectionM () +ensureNotSameTeam self target = do + selfTeam <- lift $ Intra.getTeamId (lUnqualified self) + targetTeam <- lift $ Intra.getTeamId (lUnqualified target) + when (isJust selfTeam && selfTeam == targetTeam) $ + throwE ConnectSameBindingTeamUsers createConnection :: Local UserId -> ConnId -> Qualified UserId -> ConnectionM (ResponseForExistedCreated UserConnection) -createConnection lusr con = +createConnection self con target = do + -- basic checks: no need to distinguish between local and remote at this point + when (unTagged self == target) $ + throwE (InvalidUser target) + noteT ConnectNoIdentity $ + ensureIsActivated self + + -- branch according to whether we are connecting to a local or remote user foldQualified - lusr - (createConnectionToLocalUser lusr con) - (createConnectionToRemoteUser lusr con) + self + (createConnectionToLocalUser self con) + (createConnectionToRemoteUser self con) + target createConnectionToLocalUser :: Local UserId -> @@ -81,20 +97,10 @@ createConnectionToLocalUser :: Local UserId -> ConnectionM (ResponseForExistedCreated UserConnection) createConnectionToLocalUser self conn target = do - when (self == target) $ - throwE (InvalidUser (unTagged target)) - selfActive <- lift $ Data.isActivated (lUnqualified self) - unless selfActive $ - throwE ConnectNoIdentity - otherActive <- lift $ Data.isActivated (lUnqualified target) - unless otherActive $ - throwE (InvalidUser (unTagged target)) + noteT (InvalidUser (unTagged target)) $ + ensureIsActivated target checkLegalholdPolicyConflict (lUnqualified self) (lUnqualified target) - -- Users belonging to the same team are always treated as connected, so creating a - -- connection between them is useless. {#RefConnectionTeam} - sameTeam <- lift belongSameTeam - when sameTeam $ - throwE ConnectSameBindingTeamUsers + ensureNotSameTeam self target s2o <- lift $ Data.lookupConnection self (unTagged target) o2s <- lift $ Data.lookupConnection target (unTagged self) @@ -109,7 +115,7 @@ createConnectionToLocalUser self conn target = do Log.info $ logConnection (lUnqualified self) (unTagged target) . msg (val "Creating connection") - qcnv <- Intra.createConnectConv self (unTagged target) Nothing (Just conn) + qcnv <- Intra.createConnectConv (unTagged self) (unTagged target) Nothing (Just conn) s2o' <- Data.insertConnection self (unTagged target) SentWithHistory qcnv o2s' <- Data.insertConnection target (unTagged self) PendingWithHistory qcnv e2o <- @@ -121,12 +127,12 @@ createConnectionToLocalUser self conn target = do update :: UserConnection -> UserConnection -> ExceptT ConnectionError AppIO (ResponseForExistedCreated UserConnection) update s2o o2s = case (ucStatus s2o, ucStatus o2s) of - (MissingLegalholdConsent, _) -> throwE $ InvalidTransition (lUnqualified self) Sent - (_, MissingLegalholdConsent) -> throwE $ InvalidTransition (lUnqualified self) Sent + (MissingLegalholdConsent, _) -> throwE $ InvalidTransition (lUnqualified self) + (_, MissingLegalholdConsent) -> throwE $ InvalidTransition (lUnqualified self) (Accepted, Accepted) -> return $ Existed s2o (Accepted, Blocked) -> return $ Existed s2o (Sent, Blocked) -> return $ Existed s2o - (Blocked, _) -> throwE $ InvalidTransition (lUnqualified self) Sent + (Blocked, _) -> throwE $ InvalidTransition (lUnqualified self) (_, Blocked) -> change s2o SentWithHistory (_, Sent) -> accept s2o o2s (_, Accepted) -> accept s2o o2s @@ -169,19 +175,6 @@ createConnectionToLocalUser self conn target = do change :: UserConnection -> RelationWithHistory -> ExceptT ConnectionError AppIO (ResponseForExistedCreated UserConnection) change c s = Existed <$> lift (Data.updateConnection c s) - belongSameTeam :: AppIO Bool - belongSameTeam = do - selfTeam <- Intra.getTeamId (lUnqualified self) - crTeam <- Intra.getTeamId (lUnqualified target) - pure $ isJust selfTeam && selfTeam == crTeam - -createConnectionToRemoteUser :: - Local UserId -> - ConnId -> - Remote UserId -> - ConnectionM (ResponseForExistedCreated UserConnection) -createConnectionToRemoteUser _ _ _ = throwM federationNotImplemented - -- | Throw error if one user has a LH device and the other status `no_consent` or vice versa. -- -- FUTUREWORK: we may want to move this to the LH application logic, so we can recycle it for @@ -208,12 +201,26 @@ checkLegalholdPolicyConflict uid1 uid2 = do oneway status1 status2 oneway status2 status1 +updateConnection :: + Local UserId -> + Qualified UserId -> + Relation -> + Maybe ConnId -> + ConnectionM (Maybe UserConnection) +updateConnection self other newStatus conn = + let doUpdate = + foldQualified + self + (updateConnectionToLocalUser self) + (updateConnectionToRemoteUser self) + in doUpdate other newStatus conn + -- | Change the status of a connection from one user to another. -- -- Note: 'updateConnection' doesn't explicitly check that users don't belong to the same team, -- because a connection between two team members can not exist in the first place. -- {#RefConnectionTeam} -updateConnection :: +updateConnectionToLocalUser :: -- | From Local UserId -> -- | To @@ -222,15 +229,15 @@ updateConnection :: Relation -> -- | Acting device connection ID Maybe ConnId -> - ExceptT ConnectionError AppIO (Maybe UserConnection) -updateConnection self other newStatus conn = do + ConnectionM (Maybe UserConnection) +updateConnectionToLocalUser self other newStatus conn = do s2o <- localConnection self other o2s <- localConnection other self s2o' <- case (ucStatus s2o, ucStatus o2s, newStatus) of -- missing legalhold consent: call 'updateConectionInternal' instead. - (MissingLegalholdConsent, _, _) -> throwE $ InvalidTransition (lUnqualified self) newStatus - (_, MissingLegalholdConsent, _) -> throwE $ InvalidTransition (lUnqualified self) newStatus - (_, _, MissingLegalholdConsent) -> throwE $ InvalidTransition (lUnqualified self) newStatus + (MissingLegalholdConsent, _, _) -> throwE $ InvalidTransition (lUnqualified self) + (_, MissingLegalholdConsent, _) -> throwE $ InvalidTransition (lUnqualified self) + (_, _, MissingLegalholdConsent) -> throwE $ InvalidTransition (lUnqualified self) -- Pending -> {Blocked, Ignored, Accepted} (Pending, _, Blocked) -> block s2o (Pending, _, Ignored) -> change s2o Ignored @@ -266,7 +273,7 @@ updateConnection self other newStatus conn = do -- no change (old, _, new) | old == new -> return Nothing -- invalid - _ -> throwE $ InvalidTransition (lUnqualified self) newStatus + _ -> throwE $ InvalidTransition (lUnqualified self) let s2oUserConn = s2o' lift . for_ s2oUserConn $ \c -> let e2s = ConnectionUpdated c (Just $ ucStatus s2o) Nothing @@ -464,13 +471,3 @@ lookupConnections from start size = do lusr <- qualifyLocal from rs <- Data.lookupLocalConnections lusr start size return $! UserConnectionList (Data.resultList rs) (Data.resultHasMore rs) - --- Helpers - -checkLimit :: Local UserId -> ExceptT ConnectionError AppIO () -checkLimit u = do - n <- lift $ Data.countConnections u [Accepted, Sent] - l <- setUserMaxConnections <$> view settings - unless (n < l) $ - throwE $ - TooManyConnections (lUnqualified u) diff --git a/services/brig/src/Brig/API/Connection/Remote.hs b/services/brig/src/Brig/API/Connection/Remote.hs new file mode 100644 index 0000000000..12213cfbd1 --- /dev/null +++ b/services/brig/src/Brig/API/Connection/Remote.hs @@ -0,0 +1,266 @@ +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2021 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 Brig.API.Connection.Remote + ( performLocalAction, + performRemoteAction, + createConnectionToRemoteUser, + updateConnectionToRemoteUser, + ) +where + +import Brig.API.Connection.Util (ConnectionM, checkLimit) +import Brig.API.Types (ConnectionError (..)) +import Brig.App +import qualified Brig.Data.Connection as Data +import Brig.Federation.Client (sendConnectionAction) +import qualified Brig.IO.Intra as Intra +import Brig.Types +import Brig.Types.User.Event +import Control.Comonad +import Control.Error.Util ((??)) +import Control.Monad.Trans.Except (runExceptT, throwE) +import Data.Id as Id +import Data.Qualified +import Data.Tagged +import Data.UUID.V4 +import Imports +import Network.Wai.Utilities.Error +import Wire.API.Connection (relationWithHistory) +import Wire.API.Federation.API.Brig + ( NewConnectionResponse (..), + RemoteConnectionAction (..), + ) +import Wire.API.Routes.Public.Util (ResponseForExistedCreated (..)) + +data LocalConnectionAction + = LocalConnect + | LocalBlock + | LocalIgnore + | LocalRescind + deriving (Eq) + +data ConnectionAction + = LCA LocalConnectionAction + | RCA RemoteConnectionAction + +-- | Connection state transition logic. +-- +-- In the following, A is a local user, and B is a remote user. +-- +-- LocalConnect: A communicates that they now want to connect. This +-- transitions Pending → Accepted, and every other state (but including Sent) to Sent. +-- LocalBlock: A communicates that they do not want to connect. This +-- transitions every state except Blocked to Blocked. +-- LocalIgnore: A ignores the connection. Pending → Ignored. +-- LocalRescind: A withdraws their intention to connect. Sent → Cancelled, Accepted → Pending. +-- RemoteConnect: B communicates that they now want to connect. Sent → Accepted, Cancelled → Pending, Accepted → Accepted. +-- RemoteRescind: B withdraws their intention to connect. Pending → Cancelled, Accepted → Sent. +-- +-- Returns 'Nothing' if no transition is possible from the current state for +-- the given action. This results in an 'InvalidTransition' error if the +-- connection does not exist. +transition :: ConnectionAction -> Relation -> Maybe Relation +-- MissingLegalholdConsent is treated exactly like blocked +transition action MissingLegalholdConsent = transition action Blocked +transition (LCA LocalConnect) Pending = Just Accepted +transition (LCA LocalConnect) Accepted = Just Accepted +transition (LCA LocalConnect) _ = Just Sent +transition (LCA LocalBlock) Blocked = Nothing +transition (LCA LocalBlock) _ = Just Blocked +transition (LCA LocalIgnore) Pending = Just Ignored +transition (LCA LocalIgnore) _ = Nothing +transition (LCA LocalRescind) Sent = Just Cancelled +-- The following transition is to make sure we always end up in state P +-- when we start in S and receive the two actions RC and LR in an arbitrary +-- order. +transition (LCA LocalRescind) Accepted = Just Pending +transition (LCA LocalRescind) _ = Nothing +transition (RCA RemoteConnect) Sent = Just Accepted +transition (RCA RemoteConnect) Accepted = Just Accepted +transition (RCA RemoteConnect) Blocked = Nothing +transition (RCA RemoteConnect) _ = Just Pending +transition (RCA RemoteRescind) Pending = Just Cancelled +-- The following transition is to make sure we always end up in state S +-- when we start in P and receive the two actions LC and RR in an arbitrary +-- order. +transition (RCA RemoteRescind) Accepted = Just Sent +transition (RCA RemoteRescind) _ = Nothing + +-- When user A has made a request -> Only user A's membership in conv is affected -> User A wants to be in one2one conv with B, or User A doesn't want to be in one2one conv with B +updateOne2OneConv :: + Local UserId -> + Maybe ConnId -> + Remote UserId -> + Maybe (Qualified ConvId) -> + Relation -> + AppIO (Qualified ConvId) +updateOne2OneConv _ _ _ _ _ = do + -- FUTUREWORK: use galley internal API to update 1-1 conversation and retrieve ID + uid <- liftIO nextRandom + unTagged <$> qualifyLocal (Id uid) + +-- | Perform a state transition on a connection, handle conversation updates and +-- push events. +-- +-- NOTE: This function does not check whether the max connection limit has been +-- reached, the consumers must ensure of this. +-- +-- Returns the connection, and whether it was updated or not. +transitionTo :: + Local UserId -> + Maybe ConnId -> + Remote UserId -> + Maybe UserConnection -> + Maybe Relation -> + ConnectionM (ResponseForExistedCreated UserConnection, Bool) +transitionTo self _ _ Nothing Nothing = + -- This can only happen if someone tries to ignore as a first action on a + -- connection. This shouldn't be possible. + throwE (InvalidTransition (lUnqualified self)) +transitionTo self mzcon other Nothing (Just rel) = lift $ do + -- update 1-1 connection + qcnv <- updateOne2OneConv self mzcon other Nothing rel + + -- create connection + connection <- + Data.insertConnection + self + (unTagged other) + (relationWithHistory rel) + qcnv + + -- send event + pushEvent self mzcon connection + pure (Created connection, True) +transitionTo _self _zcon _other (Just connection) Nothing = pure (Existed connection, False) +transitionTo self mzcon other (Just connection) (Just rel) = lift $ do + -- update 1-1 conversation + void $ updateOne2OneConv self Nothing other (ucConvId connection) rel + + -- update connection + connection' <- Data.updateConnection connection (relationWithHistory rel) + + -- send event + pushEvent self mzcon connection' + pure (Existed connection', True) + +-- | Send an event to the local user when the state of a connection changes. +pushEvent :: Local UserId -> Maybe ConnId -> UserConnection -> AppIO () +pushEvent self mzcon connection = do + let event = ConnectionUpdated connection Nothing Nothing + Intra.onConnectionEvent (lUnqualified self) mzcon event + +performLocalAction :: + Local UserId -> + Maybe ConnId -> + Remote UserId -> + Maybe UserConnection -> + LocalConnectionAction -> + ConnectionM (ResponseForExistedCreated UserConnection, Bool) +performLocalAction self mzcon other mconnection action = do + let rel0 = maybe Cancelled ucStatus mconnection + 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 + case (response :: NewConnectionResponse) of + NewConnectionResponseOk reaction -> pure reaction + NewConnectionResponseUserNotActivated -> throwE (InvalidUser (unTagged other)) + pure $ + fromMaybe rel1 $ do + reactionAction <- (mreaction :: Maybe RemoteConnectionAction) + transition (RCA reactionAction) rel1 + transitionTo self mzcon other mconnection mrel2 + where + remoteAction :: LocalConnectionAction -> Maybe RemoteConnectionAction + remoteAction LocalConnect = Just RemoteConnect + remoteAction LocalRescind = Just RemoteRescind + remoteAction _ = Nothing + +-- | The 'RemoteConnectionAction' "reaction" that may be returned is processed +-- by the remote caller. This extra action allows to automatically resolve some +-- inconsistent states, for example: +-- +-- Without any reaction +-- @ +-- A B +-- A connects: Sent Pending +-- B ignores: Sent Ignore +-- B connects: Accepted Sent +-- @ +-- +-- Using the reaction returned by A +-- +-- @ +-- A B +-- A connects: Sent Pending +-- B ignores: Sent Ignore +-- B connects & A reacts: Accepted Accepted +-- @ +performRemoteAction :: + Local UserId -> + Remote UserId -> + Maybe UserConnection -> + RemoteConnectionAction -> + AppIO (Maybe RemoteConnectionAction) +performRemoteAction self other mconnection action = do + let rel0 = maybe Cancelled ucStatus mconnection + let rel1 = transition (RCA action) rel0 + result <- runExceptT . void $ transitionTo self Nothing other mconnection rel1 + pure $ either (const (Just RemoteRescind)) (const (reaction rel1)) result + where + reaction :: Maybe Relation -> Maybe RemoteConnectionAction + reaction (Just Accepted) = Just RemoteConnect + reaction (Just Sent) = Just RemoteConnect + reaction _ = Nothing + +createConnectionToRemoteUser :: + Local UserId -> + ConnId -> + Remote UserId -> + ConnectionM (ResponseForExistedCreated UserConnection) +createConnectionToRemoteUser self zcon other = do + mconnection <- lift $ Data.lookupConnection self (unTagged other) + fst <$> performLocalAction self (Just zcon) other mconnection LocalConnect + +updateConnectionToRemoteUser :: + Local UserId -> + Remote UserId -> + Relation -> + Maybe ConnId -> + ConnectionM (Maybe UserConnection) +updateConnectionToRemoteUser self other rel1 zcon = do + mconnection <- lift $ Data.lookupConnection self (unTagged other) + action <- + actionForTransition rel1 + ?? InvalidTransition (lUnqualified self) + (conn, wasUpdated) <- performLocalAction self zcon other mconnection action + pure $ guard wasUpdated $> extract conn + where + actionForTransition Cancelled = Just LocalRescind + actionForTransition Sent = Just LocalConnect + actionForTransition Accepted = Just LocalConnect + actionForTransition Blocked = Just LocalBlock + actionForTransition Ignored = Just LocalIgnore + actionForTransition Pending = Nothing + actionForTransition MissingLegalholdConsent = Nothing + +checkLimitForLocalAction :: Local UserId -> Relation -> LocalConnectionAction -> ConnectionM () +checkLimitForLocalAction u oldRel action = + when (oldRel `notElem` [Accepted, Sent] && (action == LocalConnect)) $ + checkLimit u diff --git a/services/brig/src/Brig/API/Connection/Util.hs b/services/brig/src/Brig/API/Connection/Util.hs new file mode 100644 index 0000000000..bc054986ca --- /dev/null +++ b/services/brig/src/Brig/API/Connection/Util.hs @@ -0,0 +1,44 @@ +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2021 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 Brig.API.Connection.Util + ( ConnectionM, + checkLimit, + ) +where + +import Brig.API.Types +import Brig.App +import qualified Brig.Data.Connection as Data +import Brig.Options (Settings (setUserMaxConnections)) +import Control.Error (noteT) +import Control.Lens (view) +import Control.Monad.Trans.Except +import Data.Id (UserId) +import Data.Qualified (Local, lUnqualified) +import Imports +import Wire.API.Connection (Relation (..)) + +type ConnectionM = ExceptT ConnectionError AppIO + +-- Helpers + +checkLimit :: Local UserId -> ExceptT ConnectionError AppIO () +checkLimit u = noteT (TooManyConnections (lUnqualified u)) $ do + n <- lift $ Data.countConnections u [Accepted, Sent] + l <- setUserMaxConnections <$> view settings + guard (n < l) diff --git a/services/brig/src/Brig/API/Error.hs b/services/brig/src/Brig/API/Error.hs index edce388008..a2c87b1b06 100644 --- a/services/brig/src/Brig/API/Error.hs +++ b/services/brig/src/Brig/API/Error.hs @@ -116,6 +116,7 @@ connError (ConnectInvalidEmail _ _) = StdError invalidEmail connError ConnectInvalidPhone {} = StdError invalidPhone connError ConnectSameBindingTeamUsers = StdError sameBindingTeamUsers connError ConnectMissingLegalholdConsent = StdError (errorDescriptionTypeToWai @MissingLegalholdConsent) +connError (ConnectFederationError e) = fedError e actError :: ActivationError -> Error actError (UserKeyExists _) = StdError userKeyExists diff --git a/services/brig/src/Brig/API/Federation.hs b/services/brig/src/Brig/API/Federation.hs index 9ef12ad8a1..a397357e3b 100644 --- a/services/brig/src/Brig/API/Federation.hs +++ b/services/brig/src/Brig/API/Federation.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE RecordWildCards #-} + -- This file is part of the Wire Server implementation. -- -- Copyright (C) 2020 Wire Swiss GmbH @@ -18,13 +20,20 @@ module Brig.API.Federation (federationSitemap) where import qualified Brig.API.Client as API +import Brig.API.Connection.Remote (performRemoteAction) import Brig.API.Error (clientError) import Brig.API.Handler (Handler) import qualified Brig.API.User as API +import Brig.App (qualifyLocal) +import qualified Brig.Data.Connection as Data +import qualified Brig.Data.User as Data import Brig.Types (PrekeyBundle) import Brig.User.API.Handle +import Data.Domain import Data.Handle (Handle (..), parseHandle) import Data.Id (ClientId, UserId) +import Data.Qualified +import Data.Tagged (Tagged (unTagged)) import Imports import Network.Wai.Utilities.Error ((!>>)) import Servant (ServerT) @@ -51,9 +60,22 @@ federationSitemap = Federated.claimPrekeyBundle = claimPrekeyBundle, Federated.claimMultiPrekeyBundle = claimMultiPrekeyBundle, Federated.searchUsers = searchUsers, - Federated.getUserClients = getUserClients + Federated.getUserClients = getUserClients, + Federated.sendConnectionAction = sendConnectionAction } +sendConnectionAction :: Domain -> NewConnectionRequest -> Handler NewConnectionResponse +sendConnectionAction originDomain NewConnectionRequest {..} = do + active <- lift $ Data.isActivated ncrTo + if active + then do + self <- qualifyLocal ncrTo + let other = toRemote $ Qualified ncrFrom originDomain + mconnection <- lift $ Data.lookupConnection self (unTagged other) + maction <- lift $ performRemoteAction self other mconnection ncrAction + pure $ NewConnectionResponseOk maction + else pure NewConnectionResponseUserNotActivated + getUserByHandle :: Handle -> Handler (Maybe UserProfile) getUserByHandle handle = lift $ do maybeOwnerId <- API.lookupHandle handle diff --git a/services/brig/src/Brig/API/Public.hs b/services/brig/src/Brig/API/Public.hs index 4b2ec723dc..057006c2b8 100644 --- a/services/brig/src/Brig/API/Public.hs +++ b/services/brig/src/Brig/API/Public.hs @@ -98,7 +98,6 @@ import qualified System.Logger.Class as Log import Util.Logging (logFunction, logHandle, logTeam, logUser) import qualified Wire.API.Connection as Public import Wire.API.ErrorDescription -import Wire.API.Federation.Error (federationNotImplemented) import qualified Wire.API.Properties as Public import qualified Wire.API.Routes.MultiTablePaging as Public import Wire.API.Routes.Public.Brig (Api (updateConnectionUnqualified)) @@ -1098,19 +1097,15 @@ createConnection self conn target = do updateLocalConnection :: UserId -> ConnId -> UserId -> Public.ConnectionUpdate -> Handler (Public.UpdateResult Public.UserConnection) updateLocalConnection self conn other update = do - let newStatus = Public.cuStatus update - lself <- qualifyLocal self lother <- qualifyLocal other - mc <- API.updateConnection lself lother newStatus (Just conn) !>> connError - return $ maybe Public.Unchanged Public.Updated mc + updateConnection self conn (unTagged lother) update --- | FUTUREWORK: also update remote connections: https://wearezeta.atlassian.net/browse/SQCORE-959 updateConnection :: UserId -> ConnId -> Qualified UserId -> Public.ConnectionUpdate -> Handler (Public.UpdateResult Public.UserConnection) -updateConnection self conn (Qualified otherUid otherDomain) update = do - localDomain <- viewFederationDomain - if localDomain == otherDomain - then updateLocalConnection self conn otherUid update - else throwM federationNotImplemented +updateConnection self conn other update = do + let newStatus = Public.cuStatus update + lself <- qualifyLocal self + mc <- API.updateConnection lself other newStatus (Just conn) !>> connError + return $ maybe Public.Unchanged Public.Updated mc listLocalConnections :: UserId -> Maybe UserId -> Maybe (Range 1 500 Int32) -> Handler Public.UserConnectionList listLocalConnections uid start msize = do @@ -1161,16 +1156,13 @@ listConnections uid Public.GetMultiTablePageRequest {..} = do getLocalConnection :: UserId -> UserId -> Handler (Maybe Public.UserConnection) getLocalConnection self other = do - lself <- qualifyLocal self lother <- qualifyLocal other - lift $ Data.lookupConnection lself (unTagged lother) + getConnection self (unTagged lother) getConnection :: UserId -> Qualified UserId -> Handler (Maybe Public.UserConnection) -getConnection self (Qualified otherUser otherDomain) = do - localDomain <- viewFederationDomain - if localDomain == otherDomain - then getLocalConnection self otherUser - else throwM federationNotImplemented +getConnection self other = do + lself <- qualifyLocal self + lift $ Data.lookupConnection lself other deleteUser :: UserId -> diff --git a/services/brig/src/Brig/API/Types.hs b/services/brig/src/Brig/API/Types.hs index db2a8d95aa..a0d4244199 100644 --- a/services/brig/src/Brig/API/Types.hs +++ b/services/brig/src/Brig/API/Types.hs @@ -115,7 +115,7 @@ data ConnectionError -- when attempting to create or accept a connection. TooManyConnections UserId | -- | An invalid connection status change. - InvalidTransition UserId Relation + InvalidTransition UserId | -- | The target user in an connection attempt is invalid, e.g. not activated. InvalidUser (Qualified UserId) | -- | An attempt at updating a non-existent connection. @@ -133,6 +133,8 @@ data ConnectionError ConnectSameBindingTeamUsers | -- | Something doesn't work because somebody has a LH device and somebody else has not granted consent. ConnectMissingLegalholdConsent + | -- | Remote connection creation or update failed because of a federation error + ConnectFederationError FederationError data PasswordResetError = PasswordResetInProgress (Maybe Timeout) diff --git a/services/brig/src/Brig/Data/Connection.hs b/services/brig/src/Brig/Data/Connection.hs index 583f186e86..dbd7db7d91 100644 --- a/services/brig/src/Brig/Data/Connection.hs +++ b/services/brig/src/Brig/Data/Connection.hs @@ -21,7 +21,9 @@ module Brig.Data.Connection ( -- * DB Operations insertConnection, updateConnection, + updateConnectionStatus, lookupConnection, + lookupRelation, lookupLocalConnectionsPage, lookupRemoteConnectionsPage, lookupRelationWithHistory, @@ -91,6 +93,15 @@ insertConnection self target rel qcnv@(Qualified cnv cdomain) = do updateConnection :: UserConnection -> RelationWithHistory -> AppIO UserConnection updateConnection c status = do self <- qualifyLocal (ucFrom c) + now <- updateConnectionStatus self (ucTo c) status + pure $ + c + { ucStatus = relationDropHistory status, + ucLastUpdate = now + } + +updateConnectionStatus :: Local UserId -> Qualified UserId -> RelationWithHistory -> AppIO UTCTimeMillis +updateConnectionStatus self target status = do now <- toUTCTimeMillis <$> liftIO getCurrentTime let local (lUnqualified -> ltarget) = write connectionUpdate $ @@ -98,12 +109,8 @@ updateConnection c status = do let remote (unTagged -> Qualified rtarget domain) = write remoteConnectionUpdate $ params Quorum (status, now, lUnqualified self, domain, rtarget) - retry x5 $ foldQualified self local remote (ucTo c) - pure $ - c - { ucStatus = relationDropHistory status, - ucLastUpdate = now - } + retry x5 $ foldQualified self local remote target + pure now -- | Lookup the connection from a user 'A' to a user 'B' (A -> B). lookupConnection :: Local UserId -> Qualified UserId -> AppIO (Maybe UserConnection) @@ -142,6 +149,12 @@ lookupRelationWithHistory self target = do query1 remoteRelationSelect (params Quorum (lUnqualified self, domain, rtarget)) runIdentity <$$> retry x1 (foldQualified self local remote target) +lookupRelation :: Local UserId -> Qualified UserId -> AppIO Relation +lookupRelation self target = + lookupRelationWithHistory self target <&> \case + Nothing -> Cancelled + Just relh -> (relationDropHistory relh) + -- | For a given user 'A', lookup their outgoing connections (A -> X) to other users. lookupLocalConnections :: Local UserId -> Maybe UserId -> Range 1 500 Int32 -> AppIO (ResultPage UserConnection) lookupLocalConnections lfrom start (fromRange -> size) = @@ -209,11 +222,16 @@ lookupContactListWithRelation u = countConnections :: Local UserId -> [Relation] -> AppIO Int64 countConnections u r = do rels <- retry x1 . query selectStatus $ params One (Identity (lUnqualified u)) - return $ foldl' count 0 rels + relsRemote <- retry x1 . query selectStatusRemote $ params One (Identity (lUnqualified u)) + + return $ foldl' count 0 rels + foldl' count 0 relsRemote where selectStatus :: QueryString R (Identity UserId) (Identity RelationWithHistory) selectStatus = "SELECT status FROM connection WHERE left = ?" + selectStatusRemote :: QueryString R (Identity UserId) (Identity RelationWithHistory) + selectStatusRemote = "SELECT status FROM connection_remote WHERE left = ?" + count n (Identity s) | (relationDropHistory s) `elem` r = n + 1 count n _ = n @@ -270,13 +288,13 @@ remoteConnectionSelect :: PrepQuery R (Identity UserId) (Domain, UserId, Relatio remoteConnectionSelect = "SELECT right_domain, right_user, status, last_update, conv_domain, conv_id FROM connection_remote where left = ?" remoteConnectionSelectFrom :: PrepQuery R (UserId, Domain, UserId) (RelationWithHistory, UTCTimeMillis, Domain, ConvId) -remoteConnectionSelectFrom = "SELECT status, last_update, conv_domain, conv_id FROM connection_remote where left = ? AND right_domain = ? AND right = ?" +remoteConnectionSelectFrom = "SELECT status, last_update, conv_domain, conv_id FROM connection_remote where left = ? AND right_domain = ? AND right_user = ?" remoteConnectionUpdate :: PrepQuery W (RelationWithHistory, UTCTimeMillis, UserId, Domain, UserId) () remoteConnectionUpdate = "UPDATE connection_remote set status = ?, last_update = ? WHERE left = ? and right_domain = ? and right_user = ?" remoteConnectionDelete :: PrepQuery W (UserId, Domain, UserId) () -remoteConnectionDelete = "DELETE FROM connection_remote where left = ? AND right_domain = ? AND right = ?" +remoteConnectionDelete = "DELETE FROM connection_remote where left = ? AND right_domain = ? AND right_user = ?" remoteConnectionClear :: PrepQuery W (Identity UserId) () remoteConnectionClear = "DELETE FROM connection_remote where left = ?" diff --git a/services/brig/src/Brig/Federation/Client.hs b/services/brig/src/Brig/Federation/Client.hs index e0b732d315..78bd55a573 100644 --- a/services/brig/src/Brig/Federation/Client.hs +++ b/services/brig/src/Brig/Federation/Client.hs @@ -31,6 +31,7 @@ import Data.Domain import Data.Handle import Data.Id (ClientId, UserId) import Data.Qualified +import Data.Tagged import qualified Data.Text as T import Imports import qualified System.Logger.Class as Log @@ -84,3 +85,13 @@ getUserClients :: Domain -> GetUserClients -> FederationAppIO (UserMap (Set PubC getUserClients domain guc = do Log.info $ Log.msg @Text "Brig-federation: get users' clients from remote backend" executeFederated domain $ FederatedBrig.getUserClients clientRoutes guc + +sendConnectionAction :: + Local UserId -> + Remote UserId -> + RemoteConnectionAction -> + FederationAppIO NewConnectionResponse +sendConnectionAction self (unTagged -> other) action = do + let req = NewConnectionRequest (lUnqualified self) (qUnqualified other) action + Log.info $ Log.msg @Text "Brig-federation: sending connection action to remote backend" + executeFederated (qDomain other) $ FederatedBrig.sendConnectionAction clientRoutes (lDomain self) req diff --git a/services/brig/src/Brig/IO/Intra.hs b/services/brig/src/Brig/IO/Intra.hs index 8ab904015c..28472c4779 100644 --- a/services/brig/src/Brig/IO/Intra.hs +++ b/services/brig/src/Brig/IO/Intra.hs @@ -288,7 +288,7 @@ rawPush (toList -> events) usrs orig route conn = do g ( method POST . path "/i/push/v2" - . zUser orig + . zUser orig -- FUTUREWORK: Remove, because gundeck handler ignores this. . json (map (mkPush rcps . snd) events) . expect2xx ) @@ -559,16 +559,22 @@ createLocalConnectConv from to cname conn = do . lbytes (encode $ Connect (lUnqualified to) Nothing cname Nothing) . expect2xx -createConnectConv :: Local UserId -> Qualified UserId -> Maybe Text -> Maybe ConnId -> AppIO (Qualified ConvId) -createConnectConv from to cname conn = - foldQualified - from - ( \lto -> - unTagged . qualifyAs from - <$> createLocalConnectConv from lto cname conn - ) - (\_ -> throwM federationNotImplemented) - to +createConnectConv :: + Qualified UserId -> + Qualified UserId -> + Maybe Text -> + Maybe ConnId -> + AppIO (Qualified ConvId) +createConnectConv from to cname conn = do + lfrom <- ensureLocal from + lto <- ensureLocal to + unTagged . qualifyAs lfrom + <$> createLocalConnectConv lfrom lto cname conn + where + ensureLocal :: Qualified a -> AppIO (Local a) + ensureLocal x = do + loc <- qualifyLocal () + foldQualified loc pure (\_ -> throwM federationNotImplemented) x -- | Calls 'Galley.API.acceptConvH'. acceptLocalConnectConv :: Local UserId -> Maybe ConnId -> ConvId -> AppIO Conversation diff --git a/services/brig/test/integration/API/Federation.hs b/services/brig/test/integration/API/Federation.hs index 15e6a50840..8825e3240d 100644 --- a/services/brig/test/integration/API/Federation.hs +++ b/services/brig/test/integration/API/Federation.hs @@ -24,9 +24,9 @@ import Brig.Types import Control.Arrow (Arrow (first), (&&&)) import Data.Aeson (encode) import Data.Handle (Handle (..)) -import Data.Id (Id (..), UserId) +import Data.Id import qualified Data.Map as Map -import Data.Qualified (qUnqualified) +import Data.Qualified import qualified Data.Set as Set import qualified Data.UUID.V4 as UUIDv4 import Federation.Util (generateClientPrekeys) @@ -42,21 +42,22 @@ import Wire.API.Message (UserClients (..)) import Wire.API.User.Client (mkUserClientPrekeyMap) import Wire.API.UserMap (UserMap (UserMap)) +-- Note: POST /federation/send-connection-action is implicitly tested in API.User.Connection tests :: Manager -> Brig -> FedBrigClient -> IO TestTree tests m brig fedBrigClient = return $ testGroup "federation" - [ test m "GET /federation/search-users : Found" (testSearchSuccess brig fedBrigClient), - test m "GET /federation/search-users : NotFound" (testSearchNotFound fedBrigClient), - test m "GET /federation/search-users : Empty Input - NotFound" (testSearchNotFoundEmpty fedBrigClient), - test m "GET /federation/get-user-by-handle : Found" (testGetUserByHandleSuccess brig fedBrigClient), - test m "GET /federation/get-user-by-handle : NotFound" (testGetUserByHandleNotFound fedBrigClient), - test m "GET /federation/get-users-by-ids : 200 all found" (testGetUsersByIdsSuccess brig fedBrigClient), - test m "GET /federation/get-users-by-ids : 200 partially found" (testGetUsersByIdsPartial brig fedBrigClient), - test m "GET /federation/get-users-by-ids : 200 none found" (testGetUsersByIdsNoneFound fedBrigClient), - test m "GET /federation/claim-prekey : 200" (testClaimPrekeySuccess brig fedBrigClient), - test m "GET /federation/claim-prekey-bundle : 200" (testClaimPrekeyBundleSuccess brig fedBrigClient), + [ test m "POST /federation/search-users : Found" (testSearchSuccess brig fedBrigClient), + test m "POST /federation/search-users : NotFound" (testSearchNotFound fedBrigClient), + test m "POST /federation/search-users : Empty Input - NotFound" (testSearchNotFoundEmpty fedBrigClient), + test m "POST /federation/get-user-by-handle : Found" (testGetUserByHandleSuccess brig fedBrigClient), + test m "POST /federation/get-user-by-handle : NotFound" (testGetUserByHandleNotFound fedBrigClient), + test m "POST /federation/get-users-by-ids : 200 all found" (testGetUsersByIdsSuccess brig fedBrigClient), + test m "POST /federation/get-users-by-ids : 200 partially found" (testGetUsersByIdsPartial brig fedBrigClient), + test m "POST /federation/get-users-by-ids : 200 none found" (testGetUsersByIdsNoneFound fedBrigClient), + test m "POST /federation/claim-prekey : 200" (testClaimPrekeySuccess brig fedBrigClient), + test m "POST /federation/claim-prekey-bundle : 200" (testClaimPrekeyBundleSuccess brig 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) @@ -203,7 +204,7 @@ testGetUserClients brig fedBrigClient = do testGetUserClientsNotFound :: FedBrigClient -> Http () testGetUserClientsNotFound fedBrigClient = do - absentUserId :: UserId <- Id <$> lift UUIDv4.nextRandom + absentUserId <- randomId UserMap userClients <- FedBrig.getUserClients fedBrigClient (GetUserClients [absentUserId]) liftIO $ assertEqual diff --git a/services/brig/test/integration/API/Team/Util.hs b/services/brig/test/integration/API/Team/Util.hs index f2bea23d82..2e7329bf5c 100644 --- a/services/brig/test/integration/API/Team/Util.hs +++ b/services/brig/test/integration/API/Team/Util.hs @@ -85,7 +85,9 @@ createPopulatedBindingTeamWithNames brig names = do invitees <- forM names $ \name -> do inviteeEmail <- randomEmail let invite = stdInvitationRequest inviteeEmail - inv <- responseJsonError =<< postInvitation brig tid (userId inviter) invite + inv <- + responseJsonError =<< postInvitation brig tid (userId inviter) invite + Manager -> Brig -> Cannon -> CargoHold -> Galley -> Nginz -> AWS.Env -> DB.ClientState -> IO TestTree -tests conf p b c ch g n aws db = do +tests :: Opt.Opts -> FedBrigClient -> Manager -> Brig -> Cannon -> CargoHold -> Galley -> Nginz -> AWS.Env -> DB.ClientState -> IO TestTree +tests conf fbc p b c ch g n aws db = do let cl = ConnectionLimit $ Opt.setUserMaxConnections (Opt.optSettings conf) let at = Opt.setActivationTimeout (Opt.optSettings conf) z <- mkZAuthEnv (Just conf) @@ -52,7 +52,7 @@ tests conf p b c ch g n aws db = do [ API.User.Client.tests cl at conf p b c g, API.User.Account.tests cl at conf p b c ch g aws, API.User.Auth.tests conf p z b g n, - API.User.Connection.tests cl at conf p b c g db, + API.User.Connection.tests cl at conf p b c g fbc db, API.User.Handles.tests cl at conf p b c g, API.User.PasswordReset.tests 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 eff003c679..480b0dc558 100644 --- a/services/brig/test/integration/API/User/Connection.hs +++ b/services/brig/test/integration/API/User/Connection.hs @@ -32,7 +32,7 @@ import Brig.Types.Intra import qualified Cassandra as DB import Control.Arrow ((&&&)) import Data.ByteString.Conversion -import Data.Domain (Domain (..)) +import Data.Domain import Data.Id hiding (client) import Data.Json.Util (UTCTimeMillis, toUTCTimeMillis) import Data.Qualified @@ -45,10 +45,11 @@ import Test.Tasty hiding (Timeout) import Test.Tasty.HUnit import Util import Wire.API.Connection +import qualified Wire.API.Federation.API.Brig as F import Wire.API.Routes.MultiTablePaging -tests :: ConnectionLimit -> Opt.Timeout -> Opt.Opts -> Manager -> Brig -> Cannon -> Galley -> DB.ClientState -> TestTree -tests cl _at _conf p b _c g db = +tests :: ConnectionLimit -> Opt.Timeout -> Opt.Opts -> Manager -> Brig -> Cannon -> Galley -> FedBrigClient -> DB.ClientState -> TestTree +tests cl _at opts p b _c g fedBrigClient db = testGroup "connection" [ test p "post /connections" $ testCreateManualConnections b, @@ -80,7 +81,20 @@ tests cl _at _conf p b _c g db = test p "get /connections - 200 (paging)" $ testLocalConnectionsPaging b, test p "post /list-connections - 200 (paging)" $ testAllConnectionsPaging b db, test p "post /connections - 400 (max conns)" $ testConnectionLimit b cl, - test p "post /connections/:domain/:id - 400 (max conns)" $ testConnectionLimitQualified b cl + test p "post /connections/:domain/:id - 400 (max conns)" $ testConnectionLimitQualified b cl, + test p "Remote connections: connect with no federation" (testConnectFederationNotAvailable b), + test p "Remote connections: connect OK" (testConnectOK b 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 fedBrigClient), + test p "Remote connections: mutual Connect - remote action then local action" (testConnectMutualRemoteActionThenLocalAction opts b fedBrigClient), + 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 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) ] testCreateConnectionInvalidUser :: Brig -> Http () @@ -689,3 +703,182 @@ testConnectionLimitQualified brig (ConnectionLimit l) = do assertLimited = do const 403 === statusCode const (Just "connection-limit") === fmap Error.label . responseJsonMaybe + +testConnectFederationNotAvailable :: Brig -> Http () +testConnectFederationNotAvailable brig = do + (uid1, quid2) <- localAndRemoteUser brig + postConnectionQualified brig uid1 quid2 + !!! const 422 === statusCode + +testConnectOK :: Brig -> FedBrigClient -> Http () +testConnectOK brig fedBrigClient = do + (uid1, quid2) <- localAndRemoteUser brig + receiveConnectionAction brig fedBrigClient uid1 quid2 F.RemoteConnect Nothing Pending + +testConnectWithAnon :: Brig -> FedBrigClient -> Http () +testConnectWithAnon brig fedBrigClient = do + fromUser <- randomId + toUser <- userId <$> createAnonUser "anon1234" brig + res <- F.sendConnectionAction fedBrigClient (Domain "far-away.example.com") (F.NewConnectionRequest fromUser toUser F.RemoteConnect) + liftIO $ + assertEqual "The response should specify that the user is not activated" F.NewConnectionResponseUserNotActivated res + +testConnectFromAnon :: Brig -> Http () +testConnectFromAnon brig = do + anonUser <- userId <$> createAnonUser "anon1234" brig + remoteUser <- fakeRemoteUser + postConnectionQualified brig anonUser remoteUser !!! const 403 === statusCode + +testConnectMutualLocalActionThenRemoteAction :: Opt.Opts -> Brig -> FedBrigClient -> Http () +testConnectMutualLocalActionThenRemoteAction opts brig fedBrigClient = do + (uid1, quid2) <- localAndRemoteUser brig + + -- 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 + + -- The response should have 'RemoteConnect' as action, because we cannot be + -- sure if the remote was previously in Ignored state or not + receiveConnectionAction brig fedBrigClient uid1 quid2 F.RemoteConnect (Just F.RemoteConnect) Accepted + +testConnectMutualRemoteActionThenLocalAction :: Opt.Opts -> Brig -> FedBrigClient -> Http () +testConnectMutualRemoteActionThenLocalAction opts brig fedBrigClient = do + (uid1, quid2) <- localAndRemoteUser brig + + -- 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 F.RemoteConnect Nothing Pending + + -- 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 F.RemoteConnect) Accepted + +testConnectFromPending :: Brig -> FedBrigClient -> Http () +testConnectFromPending brig fedBrigClient = do + (uid1, quid2) <- localAndRemoteUser brig + receiveConnectionAction brig fedBrigClient uid1 quid2 F.RemoteConnect Nothing Pending + receiveConnectionAction brig fedBrigClient uid1 quid2 F.RemoteConnect Nothing Pending + receiveConnectionAction brig fedBrigClient uid1 quid2 F.RemoteRescind Nothing Cancelled + +testConnectFromIgnored :: Opt.Opts -> Brig -> FedBrigClient -> Http () +testConnectFromIgnored opts brig fedBrigClient = do + (uid1, quid2) <- localAndRemoteUser brig + + -- set up an initial 'Ignored' state + receiveConnectionAction brig fedBrigClient uid1 quid2 F.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 F.RemoteConnect Nothing Pending + + -- if we accept, and the remote side still wants to connect, we transition to 'Accepted' + sendConnectionAction brig opts uid1 quid2 (Just F.RemoteConnect) Accepted + +testSentFromIgnored :: Opt.Opts -> Brig -> FedBrigClient -> Http () +testSentFromIgnored opts brig fedBrigClient = do + (uid1, quid2) <- localAndRemoteUser brig + + -- set up an initial 'Ignored' state + receiveConnectionAction brig fedBrigClient uid1 quid2 F.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 F.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 -> FedBrigClient -> Http () +testConnectFromBlocked opts brig fedBrigClient = do + (uid1, quid2) <- localAndRemoteUser brig + + -- set up an initial 'Blocked' state + receiveConnectionAction brig fedBrigClient uid1 quid2 F.RemoteConnect Nothing Pending + putConnectionQualified brig uid1 quid2 Blocked !!! statusCode === const 200 + assertConnectionQualified brig uid1 quid2 Blocked + + -- if the remote side sends a new connection request, we ignore it + receiveConnectionAction brig fedBrigClient uid1 quid2 F.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 F.RemoteConnect) Accepted + +testSentFromBlocked :: Opt.Opts -> Brig -> FedBrigClient -> Http () +testSentFromBlocked opts brig fedBrigClient = do + (uid1, quid2) <- localAndRemoteUser brig + + -- set up an initial 'Blocked' state + receiveConnectionAction brig fedBrigClient uid1 quid2 F.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 F.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 -> FedBrigClient -> 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 F.RemoteConnect Nothing Pending + sendConnectionAction brig opts uid1 quid2 (Just F.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 F.RemoteConnect Nothing Pending + + -- accepting the second one hits the limit (and relation stays Pending): + sendConnectionActionExpectLimit uid1 quid3 (Just F.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 F.RemoteConnect (Just F.RemoteConnect) Accepted + + -- attempting to send an own new connection request also hits the limit + sendConnectionActionExpectLimit uid1 quid4 (Just F.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 F.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 F.RemoteConnect Nothing Pending + sendConnectionAction brig opts uid1 quid5 (Just F.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 F.RemoteConnectionAction -> Http () + sendConnectionActionExpectLimit uid1 quid2 _reaction = do + postConnectionQualified brig uid1 quid2 !!! do + const 403 === statusCode + const (Just "connection-limit") === fmap Error.label . responseJsonMaybe diff --git a/services/brig/test/integration/API/User/Util.hs b/services/brig/test/integration/API/User/Util.hs index 155a5c7e83..88febee65a 100644 --- a/services/brig/test/integration/API/User/Util.hs +++ b/services/brig/test/integration/API/User/Util.hs @@ -22,6 +22,7 @@ module API.User.Util where import Bilge hiding (accept, timeout) import Bilge.Assert import Brig.Data.PasswordReset +import Brig.Options (Opts) import Brig.Types import Brig.Types.Intra import Brig.Types.Team.LegalHold (LegalHoldClientRequest (..)) @@ -37,17 +38,22 @@ import Data.ByteString.Builder (toLazyByteString) import Data.ByteString.Char8 (pack) import Data.ByteString.Conversion import qualified Data.ByteString.Lazy as LB -import Data.Domain (Domain) +import Data.Domain (Domain, domainText) import Data.Handle (Handle (Handle)) import Data.Id hiding (client) import Data.Misc (PlainTextPassword (..)) import Data.Qualified import Data.Range (unsafeRange) +import Data.String.Conversions (cs) import qualified Data.Text.Ascii as Ascii import qualified Data.Vector as Vec +import Federation.Util (withTempMockFederator) import Imports import Test.Tasty.HUnit import Util +import qualified Wire.API.Federation.API.Brig as F +import Wire.API.Federation.GRPC.Types hiding (body, path) +import qualified Wire.API.Federation.GRPC.Types as F import Wire.API.Routes.MultiTablePaging (LocalOrRemoteTable, MultiTablePagingState) newtype ConnectionLimit = ConnectionLimit Int64 @@ -310,12 +316,12 @@ countCookies brig u label = do return $ Vec.length <$> (preview (key "cookies" . _Array) =<< responseJsonMaybe @Value r) assertConnections :: (MonadCatch m, MonadIO m, MonadHttp m, HasCallStack) => Brig -> UserId -> [ConnectionStatus] -> m () -assertConnections brig u cs = +assertConnections brig u connections = listConnections brig u !!! do const 200 === statusCode const (Just True) === fmap (check . map status . clConnections) . responseJsonMaybe where - check xs = all (`elem` xs) cs + check xs = all (`elem` xs) connections status c = ConnectionStatus (ucFrom c) (qUnqualified $ ucTo c) (ucStatus c) assertConnectionQualified :: (MonadCatch m, MonadIO m, MonadHttp m, HasCallStack) => Brig -> UserId -> Qualified UserId -> Relation -> m () @@ -324,6 +330,68 @@ assertConnectionQualified brig u1 qu2 rel = const 200 === statusCode const (Right rel) === fmap ucStatus . responseJsonEither +receiveConnectionAction :: + HasCallStack => + Brig -> + FedBrigClient -> + UserId -> + Qualified UserId -> + F.RemoteConnectionAction -> + Maybe F.RemoteConnectionAction -> + Relation -> + Http () +receiveConnectionAction brig fedBrigClient uid1 quid2 action expectedReaction expectedRel = do + res <- + F.sendConnectionAction fedBrigClient (qDomain quid2) $ + F.NewConnectionRequest (qUnqualified quid2) uid1 action + liftIO $ do + res @?= F.NewConnectionResponseOk expectedReaction + assertConnectionQualified brig uid1 quid2 expectedRel + +sendConnectionAction :: + HasCallStack => + Brig -> + Opts -> + UserId -> + Qualified UserId -> + Maybe F.RemoteConnectionAction -> + Relation -> + Http () +sendConnectionAction brig opts uid1 quid2 reaction expectedRel = do + let mockConnectionResponse = F.NewConnectionResponseOk reaction + mockResponse = OutwardResponseBody (cs $ encode mockConnectionResponse) + (res, reqs) <- + liftIO . withTempMockFederator opts (qDomain quid2) mockResponse $ + postConnectionQualified brig uid1 quid2 + + liftIO $ do + req <- assertOne reqs + F.domain req @?= domainText (qDomain quid2) + fmap F.component (F.request req) @?= Just F.Brig + fmap F.path (F.request req) @?= Just "/federation/send-connection-action" + eitherDecode . cs . F.body <$> F.request req + @?= Just (Right (F.NewConnectionRequest uid1 (qUnqualified quid2) F.RemoteConnect)) + + liftIO $ assertBool "postConnectionQualified failed" $ statusCode res `elem` [200, 201] + assertConnectionQualified brig uid1 quid2 expectedRel + +sendConnectionUpdateAction :: + HasCallStack => + Brig -> + Opts -> + UserId -> + Qualified UserId -> + Maybe F.RemoteConnectionAction -> + Relation -> + Http () +sendConnectionUpdateAction brig opts uid1 quid2 reaction expectedRel = do + let mockConnectionResponse = F.NewConnectionResponseOk reaction + mockResponse = OutwardResponseBody (cs $ encode mockConnectionResponse) + void $ + liftIO . withTempMockFederator opts (qDomain quid2) mockResponse $ + putConnectionQualified brig uid1 quid2 expectedRel !!! const 200 === statusCode + assertConnectionQualified brig uid1 quid2 expectedRel + assertEmailVisibility :: (MonadCatch m, MonadIO m, MonadHttp m, HasCallStack) => Brig -> User -> User -> Bool -> m () assertEmailVisibility brig a b visible = get (brig . paths ["users", pack . show $ userId b] . zUser (userId a)) !!! do diff --git a/services/brig/test/integration/Main.hs b/services/brig/test/integration/Main.hs index 566c4dd0b9..75906db35c 100644 --- a/services/brig/test/integration/Main.hs +++ b/services/brig/test/integration/Main.hs @@ -122,7 +122,7 @@ runTests iConf brigOpts otherArgs = do let fedBrigClient = mkFedBrigClient mg (brig iConf) emailAWSOpts <- parseEmailAWSOpts awsEnv <- AWS.mkEnv lg awsOpts emailAWSOpts mg - userApi <- User.tests brigOpts mg b c ch g n awsEnv db + userApi <- User.tests brigOpts fedBrigClient mg b c ch g n awsEnv db providerApi <- Provider.tests localDomain (provider iConf) mg db b c g searchApis <- Search.tests brigOpts mg g b teamApis <- Team.tests brigOpts mg n b c g awsEnv diff --git a/services/brig/test/integration/Util.hs b/services/brig/test/integration/Util.hs index cc9963d6c7..06cdfa598d 100644 --- a/services/brig/test/integration/Util.hs +++ b/services/brig/test/integration/Util.hs @@ -46,7 +46,7 @@ import qualified Data.ByteString as BS import Data.ByteString.Char8 (pack) import qualified Data.ByteString.Char8 as C8 import Data.ByteString.Conversion -import Data.Domain (Domain, domainText, mkDomain) +import Data.Domain (Domain (..), domainText, mkDomain) import Data.Handle (Handle (..)) import Data.Id import Data.List1 (List1) @@ -131,6 +131,18 @@ twoRandomUsers brig = do uid2 = qUnqualified quid2 pure (quid1, uid1, quid2, uid2) +localAndRemoteUser :: + (MonadCatch m, MonadIO m, MonadHttp m, HasCallStack) => + Brig -> + m (UserId, Qualified UserId) +localAndRemoteUser brig = do + uid1 <- userId <$> randomUser brig + quid2 <- fakeRemoteUser + pure (uid1, quid2) + +fakeRemoteUser :: (HasCallStack, MonadIO m) => m (Qualified UserId) +fakeRemoteUser = Qualified <$> randomId <*> pure (Domain "far-away.example.com") + randomUser :: (MonadCatch m, MonadIO m, MonadHttp m, HasCallStack) => Brig -> @@ -886,3 +898,7 @@ aFewTimes (exponentialBackoff 1000 <> limitRetries retries) (\_ -> pure . not . good) (\_ -> action) + +assertOne :: (HasCallStack, MonadIO m, Show a) => [a] -> m a +assertOne [a] = pure a +assertOne xs = liftIO . assertFailure $ "Expected exactly one element, found " <> show xs diff --git a/services/galley/test/integration/API.hs b/services/galley/test/integration/API.hs index 2bcbf2ba80..065f4f9768 100644 --- a/services/galley/test/integration/API.hs +++ b/services/galley/test/integration/API.hs @@ -229,7 +229,8 @@ emptyFederatedBrig = FederatedBrig.claimPrekeyBundle = \_ -> e "claimPrekeyBundle", FederatedBrig.claimMultiPrekeyBundle = \_ -> e "claimMultiPrekeyBundle", FederatedBrig.searchUsers = \_ -> e "searchUsers", - FederatedBrig.getUserClients = \_ -> e "getUserClients" + FederatedBrig.getUserClients = \_ -> e "getUserClients", + FederatedBrig.sendConnectionAction = \_ _ -> e "sendConnectionAction" } emptyFederatedGalley :: FederatedGalley.Api (AsServerT Handler)