diff --git a/changelog.d/5-internal/delete-internal-get-conn-status b/changelog.d/5-internal/delete-internal-get-conn-status new file mode 100644 index 00000000000..ce78ab05b0d --- /dev/null +++ b/changelog.d/5-internal/delete-internal-get-conn-status @@ -0,0 +1 @@ +Brig: Delete deprecated `GET /i/users/connections-status` endpoint. \ No newline at end of file diff --git a/changelog.d/6-federation/check-connections b/changelog.d/6-federation/check-connections new file mode 100644 index 00000000000..ee2c5674c77 --- /dev/null +++ b/changelog.d/6-federation/check-connections @@ -0,0 +1 @@ +Check connections when adding remote users to a local conversation and local users to remote conversations. diff --git a/changelog.d/6-federation/fix-remote-conv b/changelog.d/6-federation/fix-remote-conv new file mode 100644 index 00000000000..e3932e6d28b --- /dev/null +++ b/changelog.d/6-federation/fix-remote-conv @@ -0,0 +1 @@ +The creator of a conversation now appears as a member when the conversation is fetched from a remote backend diff --git a/libs/brig-types/src/Brig/Types/Connection.hs b/libs/brig-types/src/Brig/Types/Connection.hs index dc80c88c750..73bb4a802a9 100644 --- a/libs/brig-types/src/Brig/Types/Connection.hs +++ b/libs/brig-types/src/Brig/Types/Connection.hs @@ -25,7 +25,6 @@ module Brig.Types.Connection ( module C, UserIds (..), - ConnectionsStatusRequest (..), UpdateConnectionsInternal (..), -- * re-exports @@ -40,6 +39,7 @@ where import Brig.Types.Common as C import Data.Aeson import Data.Id (UserId) +import Data.Qualified import Imports import Wire.API.Arbitrary import Wire.API.Connection @@ -51,13 +51,6 @@ data UserIds = UserIds {cUsers :: [UserId]} deriving (Eq, Show, Generic) --- | Data that is passed to the @\/i\/users\/connections-status@ endpoint. -data ConnectionsStatusRequest = ConnectionsStatusRequest - { csrFrom :: ![UserId], - csrTo :: !(Maybe [UserId]) - } - deriving (Eq, Show, Generic) - -- FUTUREWORK: This needs to get Qualified IDs when implementing -- Legalhold + Federation, as it's used in the internal -- putConnectionInternal / galley->Brig "/i/users/connections-status" @@ -67,6 +60,8 @@ data ConnectionsStatusRequest = ConnectionsStatusRequest data UpdateConnectionsInternal = BlockForMissingLHConsent UserId [UserId] | RemoveLHBlocksInvolving UserId + | -- | This must only be used by tests + CreateConnectionForTest UserId (Qualified UserId) deriving (Eq, Show, Generic) deriving (Arbitrary) via (GenericUniform UpdateConnectionsInternal) @@ -86,16 +81,3 @@ instance ToJSON UserIds where toJSON (UserIds us) = object ["ids" .= us] - -instance FromJSON ConnectionsStatusRequest where - parseJSON = withObject "ConnectionsStatusRequest" $ \o -> do - csrFrom <- o .: "from" - csrTo <- o .: "to" - pure ConnectionsStatusRequest {..} - -instance ToJSON ConnectionsStatusRequest where - toJSON ConnectionsStatusRequest {csrFrom, csrTo} = - object - [ "from" .= csrFrom, - "to" .= csrTo - ] diff --git a/libs/brig-types/src/Brig/Types/Intra.hs b/libs/brig-types/src/Brig/Types/Intra.hs index 7093688a1a9..1a29afb02f1 100644 --- a/libs/brig-types/src/Brig/Types/Intra.hs +++ b/libs/brig-types/src/Brig/Types/Intra.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-} -- This file is part of the Wire Server implementation. @@ -24,7 +23,6 @@ module Brig.Types.Intra ( AccountStatus (..), AccountStatusUpdate (..), AccountStatusResp (..), - ConnectionStatus (..), UserAccount (..), NewUserScimInvitation (..), UserSet (..), @@ -91,30 +89,6 @@ instance FromJSON AccountStatusUpdate where instance ToJSON AccountStatusUpdate where toJSON s = object ["status" .= suStatus s] -------------------------------------------------------------------------------- --- ConnectionStatus - -data ConnectionStatus = ConnectionStatus - { csFrom :: !UserId, - csTo :: !UserId, - csStatus :: !Relation - } - deriving (Eq, Show, Generic) - -instance FromJSON ConnectionStatus where - parseJSON = withObject "connection-status" $ \o -> - ConnectionStatus <$> o .: "from" - <*> o .: "to" - <*> o .: "status" - -instance ToJSON ConnectionStatus where - toJSON cs = - object - [ "from" .= csFrom cs, - "to" .= csTo cs, - "status" .= csStatus cs - ] - ------------------------------------------------------------------------------- -- UserAccount diff --git a/libs/types-common/src/Data/Qualified.hs b/libs/types-common/src/Data/Qualified.hs index 84b6eb1572a..a1b9209d2bc 100644 --- a/libs/types-common/src/Data/Qualified.hs +++ b/libs/types-common/src/Data/Qualified.hs @@ -36,6 +36,7 @@ module Data.Qualified foldQualified, partitionQualified, indexQualified, + bucketQualified, indexRemote, deprecatedSchema, ) @@ -131,6 +132,11 @@ indexQualified = foldr add mempty add :: Qualified a -> Map Domain [a] -> Map Domain [a] add (Qualified x domain) = Map.insertWith (<>) domain [x] +-- | Bucket a list of qualified values by domain. +bucketQualified :: Foldable f => f (Qualified a) -> [Qualified [a]] +bucketQualified = map (\(d, a) -> Qualified a d) . Map.assocs . indexQualified + +-- FUTUREWORK: Rename this to 'bucketRemote' indexRemote :: (Functor f, Foldable f) => f (Remote a) -> [Remote [a]] indexRemote = map (uncurry toRemoteUnsafe) diff --git a/libs/wire-api-federation/src/Wire/API/Federation/API/Galley.hs b/libs/wire-api-federation/src/Wire/API/Federation/API/Galley.hs index 7a8f3b5b4a8..bdb02efccb3 100644 --- a/libs/wire-api-federation/src/Wire/API/Federation/API/Galley.hs +++ b/libs/wire-api-federation/src/Wire/API/Federation/API/Galley.hs @@ -151,7 +151,11 @@ newtype GetConversationsResponse = GetConversationsResponse data NewRemoteConversation conv = NewRemoteConversation { -- | The time when the conversation was created rcTime :: UTCTime, - -- | The user that created the conversation + -- | The user that created the conversation. + -- + -- FUTUREWORK: Make this unqualified and assume that this user has the same domain + -- as the backend invoking this RPC. Otehrwise a third party can figure out + -- connections. rcOrigUserId :: Qualified UserId, -- | The conversation ID, local to the backend invoking the RPC rcCnvId :: conv, diff --git a/libs/wire-api/src/Wire/API/Connection.hs b/libs/wire-api/src/Wire/API/Connection.hs index 7a6e51d9067..612c867f265 100644 --- a/libs/wire-api/src/Wire/API/Connection.hs +++ b/libs/wire-api/src/Wire/API/Connection.hs @@ -48,17 +48,16 @@ where import Control.Applicative (optional) import Control.Lens ((?~)) import Data.Aeson as Aeson -import Data.Attoparsec.ByteString (takeByteString) -import Data.ByteString.Conversion import Data.Id import Data.Json.Util (UTCTimeMillis) import Data.Qualified (Qualified (qUnqualified), deprecatedSchema) import Data.Range import qualified Data.Schema as P +import Data.Swagger as S import qualified Data.Swagger.Build.Api as Doc -import Data.Swagger.Schema as S import Data.Text as Text import Imports +import Servant.API import Wire.API.Arbitrary (Arbitrary (..), GenericUniform (..)) import Wire.API.Routes.MultiTablePaging @@ -173,6 +172,9 @@ data Relation deriving (Arbitrary) via (GenericUniform Relation) deriving (FromJSON, ToJSON, S.ToSchema) via (P.Schema Relation) +instance S.ToParamSchema Relation where + toParamSchema _ = mempty & S.type_ ?~ S.SwaggerString + -- | 'updateConnectionInternal', requires knowledge of the previous state (before -- 'MissingLegalholdConsent'), but the clients don't need that information. To avoid having -- to change the API, we introduce an internal variant of 'Relation' with surjective mapping @@ -245,20 +247,19 @@ instance P.ToSchema Relation where P.element "missing-legalhold-consent" MissingLegalholdConsent ] -instance FromByteString Relation where - parser = - takeByteString >>= \case - "accepted" -> return Accepted - "blocked" -> return Blocked - "pending" -> return Pending - "ignored" -> return Ignored - "sent" -> return Sent - "cancelled" -> return Cancelled - "missing-legalhold-consent" -> return MissingLegalholdConsent - x -> fail $ "Invalid relation-type " <> show x - -instance ToByteString Relation where - builder = \case +instance FromHttpApiData Relation where + parseQueryParam = \case + "accepted" -> return Accepted + "blocked" -> return Blocked + "pending" -> return Pending + "ignored" -> return Ignored + "sent" -> return Sent + "cancelled" -> return Cancelled + "missing-legalhold-consent" -> return MissingLegalholdConsent + x -> Left $ "Invalid relation-type " <> x + +instance ToHttpApiData Relation where + toQueryParam = \case Accepted -> "accepted" Blocked -> "blocked" Pending -> "pending" @@ -267,7 +268,7 @@ instance ToByteString Relation where Cancelled -> "cancelled" MissingLegalholdConsent -> "missing-legalhold-consent" --------------------------------------------------------------------------------- +---------------- -- Requests -- | Payload type for a connection request from one user to another. diff --git a/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs b/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs index ed89cf2c5e8..51e34b18d40 100644 --- a/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs +++ b/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs @@ -36,6 +36,8 @@ import qualified Servant import Servant.Swagger (HasSwagger (toSwagger)) import Servant.Swagger.Internal.Orphans () import Servant.Swagger.UI +import Wire.API.Connection +import Wire.API.Routes.Internal.Brig.Connection import Wire.API.Routes.Internal.Brig.EJPD import qualified Wire.API.Team.Feature as ApiFt @@ -85,12 +87,36 @@ type DeleteAccountFeatureConfig = :> "conferenceCalling" :> Delete '[Servant.JSON] NoContent +type GetAllConnectionsUnqualified = + Summary "Get all connections of a given user" + :> "users" + :> "connections-status" + :> ReqBody '[Servant.JSON] ConnectionsStatusRequest + :> QueryParam' + [ Optional, + Strict, + Description "Only returns connections with the given relation, if omitted, returns all connections" + ] + "filter" + Relation + :> Post '[Servant.JSON] [ConnectionStatus] + +type GetAllConnections = + Summary "Get all connections of a given user" + :> "users" + :> "connections-status" + :> "v2" + :> ReqBody '[Servant.JSON] ConnectionsStatusRequestV2 + :> Post '[Servant.JSON] [ConnectionStatusV2] + type API = "i" :> ( EJPDRequest :<|> GetAccountFeatureConfig :<|> PutAccountFeatureConfig :<|> DeleteAccountFeatureConfig + :<|> GetAllConnectionsUnqualified + :<|> GetAllConnections ) type SwaggerDocsAPI = "api" :> "internal" :> SwaggerSchemaUI "swagger-ui" "swagger.json" diff --git a/libs/wire-api/src/Wire/API/Routes/Internal/Brig/Connection.hs b/libs/wire-api/src/Wire/API/Routes/Internal/Brig/Connection.hs new file mode 100644 index 00000000000..1132c6f920f --- /dev/null +++ b/libs/wire-api/src/Wire/API/Routes/Internal/Brig/Connection.hs @@ -0,0 +1,73 @@ +{-# LANGUAGE RecordWildCards #-} + +module Wire.API.Routes.Internal.Brig.Connection where + +import Data.Aeson (FromJSON, ToJSON) +import Data.Id +import Data.Qualified +import Data.Schema +import qualified Data.Swagger as S +import Imports +import Wire.API.Connection + +data ConnectionsStatusRequest = ConnectionsStatusRequest + { csrFrom :: ![UserId], + csrTo :: !(Maybe [UserId]) + } + deriving (Eq, Show, Generic) + deriving (ToJSON, FromJSON, S.ToSchema) via (Schema ConnectionsStatusRequest) + +instance ToSchema ConnectionsStatusRequest where + schema = + object "ConnectionsStatusRequest" $ + ConnectionsStatusRequest + <$> csrFrom .= field "from" (array schema) + <*> csrTo .= optField "to" Nothing (array schema) + +data ConnectionsStatusRequestV2 = ConnectionsStatusRequestV2 + { csrv2From :: ![UserId], + csrv2To :: !(Maybe [Qualified UserId]), + csrv2Relation :: !(Maybe Relation) + } + deriving (Eq, Show, Generic) + deriving (ToJSON, FromJSON, S.ToSchema) via (Schema ConnectionsStatusRequestV2) + +instance ToSchema ConnectionsStatusRequestV2 where + schema = + object "ConnectionsStatusRequestV2" $ + ConnectionsStatusRequestV2 + <$> csrv2From .= field "from" (array schema) + <*> csrv2To .= optField "to" Nothing (array schema) + <*> csrv2Relation .= optField "relation" Nothing schema + +data ConnectionStatus = ConnectionStatus + { csFrom :: !UserId, + csTo :: !UserId, + csStatus :: !Relation + } + deriving (Eq, Show, Generic) + deriving (ToJSON, FromJSON, S.ToSchema) via (Schema ConnectionStatus) + +instance ToSchema ConnectionStatus where + schema = + object "ConnectionStatus" $ + ConnectionStatus + <$> csFrom .= field "from" schema + <*> csTo .= field "to" schema + <*> csStatus .= field "status" schema + +data ConnectionStatusV2 = ConnectionStatusV2 + { csv2From :: !UserId, + csv2To :: !(Qualified UserId), + csv2Status :: !Relation + } + deriving (Eq, Show, Generic) + deriving (ToJSON, FromJSON, S.ToSchema) via (Schema ConnectionStatusV2) + +instance ToSchema ConnectionStatusV2 where + schema = + object "ConnectionStatusV2" $ + ConnectionStatusV2 + <$> csv2From .= field "from" schema + <*> csv2To .= field "qualified_to" schema + <*> csv2Status .= field "status" schema diff --git a/libs/wire-api/test/unit/Test/Wire/API/Roundtrip/ByteString.hs b/libs/wire-api/test/unit/Test/Wire/API/Roundtrip/ByteString.hs index d79ed2a6708..58a2e1c27b5 100644 --- a/libs/wire-api/test/unit/Test/Wire/API/Roundtrip/ByteString.hs +++ b/libs/wire-api/test/unit/Test/Wire/API/Roundtrip/ByteString.hs @@ -26,7 +26,6 @@ import qualified Wire.API.Arbitrary as Arbitrary () import qualified Wire.API.Asset.V3 as Asset.V3 import qualified Wire.API.Asset.V3.Resumable as Asset.V3.Resumable import qualified Wire.API.Call.Config as Call.Config -import qualified Wire.API.Connection as Connection import qualified Wire.API.Conversation.Code as Conversation.Code import qualified Wire.API.Conversation.Role as Conversation.Role import qualified Wire.API.Properties as Properties @@ -58,7 +57,6 @@ tests = testRoundTrip @Call.Config.Transport, testRoundTrip @Call.Config.TurnHost, testRoundTrip @Call.Config.TurnURI, - testRoundTrip @Connection.Relation, testRoundTrip @Conversation.Code.Key, testRoundTrip @Conversation.Code.Value, testRoundTrip @Conversation.Role.RoleName, diff --git a/libs/wire-api/wire-api.cabal b/libs/wire-api/wire-api.cabal index f4694d109cd..623fa0c173f 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: d2c9713a3cbd002394d82471bd12407b388620823e1087fb4dd300cbecde7c25 +-- hash: 2d17ec32d1990b4f59c918291cd7a1286d20e5c54ad921ecd5eb9d01b4b9f1c8 name: wire-api version: 0.1.0 @@ -50,6 +50,7 @@ library Wire.API.Push.Token Wire.API.Push.V2.Token Wire.API.Routes.Internal.Brig + Wire.API.Routes.Internal.Brig.Connection Wire.API.Routes.Internal.Brig.EJPD Wire.API.Routes.MultiTablePaging Wire.API.Routes.MultiTablePaging.State diff --git a/services/brig/src/Brig/API/Connection.hs b/services/brig/src/Brig/API/Connection.hs index 6f4906622fc..d2e1a1d08f1 100644 --- a/services/brig/src/Brig/API/Connection.hs +++ b/services/brig/src/Brig/API/Connection.hs @@ -51,6 +51,7 @@ import qualified Data.LegalHold as LH import Data.Proxy (Proxy (Proxy)) import Data.Qualified import Data.Range +import qualified Data.UUID.V4 as UUID import Galley.Types (ConvType (..), cnvType) import Imports import qualified System.Logger.Class as Log @@ -381,6 +382,14 @@ updateConnectionInternal = \case self <- qualifyLocal uid blockForMissingLegalholdConsent self others RemoveLHBlocksInvolving uid -> removeLHBlocksInvolving =<< qualifyLocal uid + CreateConnectionForTest usr other -> do + lusr <- qualifyLocal usr + lift $ + foldQualified + lusr + (createLocalConnectionUnchecked lusr) + (createRemoteConnectionUnchecked lusr) + other where -- inspired by @block@ in 'updateConnection'. blockForMissingLegalholdConsent :: Local UserId -> [UserId] -> ExceptT ConnectionError AppIO () @@ -465,6 +474,17 @@ updateConnectionInternal = \case SentWithHistory -> SentWithHistory CancelledWithHistory -> CancelledWithHistory +createLocalConnectionUnchecked :: Local UserId -> Local UserId -> AppIO () +createLocalConnectionUnchecked self other = do + qcnv <- liftIO $ qUntagged . qualifyAs self <$> (Id <$> UUID.nextRandom) + void $ Data.insertConnection self (qUntagged other) AcceptedWithHistory qcnv + void $ Data.insertConnection other (qUntagged self) AcceptedWithHistory qcnv + +createRemoteConnectionUnchecked :: Local UserId -> Remote UserId -> AppIO () +createRemoteConnectionUnchecked self other = do + qcnv <- liftIO $ qUntagged . qualifyAs self <$> (Id <$> UUID.nextRandom) + void $ Data.insertConnection self (qUntagged other) AcceptedWithHistory qcnv + lookupConnections :: UserId -> Maybe UserId -> Range 1 500 Int32 -> AppIO UserConnectionList lookupConnections from start size = do lusr <- qualifyLocal from diff --git a/services/brig/src/Brig/API/Internal.hs b/services/brig/src/Brig/API/Internal.hs index 225c4784ee7..9ad43d1bdb1 100644 --- a/services/brig/src/Brig/API/Internal.hs +++ b/services/brig/src/Brig/API/Internal.hs @@ -33,6 +33,7 @@ import qualified Brig.API.User as API import Brig.API.Util (validateHandle) import Brig.App import qualified Brig.Data.Client as Data +import qualified Brig.Data.Connection as Data import qualified Brig.Data.User as Data import qualified Brig.IO.Intra as Intra import Brig.Options hiding (internalEvents, sesQueue) @@ -55,6 +56,7 @@ import Data.Handle (Handle) import Data.Id as Id import qualified Data.List1 as List1 import qualified Data.Map.Strict as Map +import Data.Qualified import qualified Data.Set as Set import Galley.Types (UserClients (..)) import Imports hiding (head) @@ -70,6 +72,7 @@ import Servant.Swagger.UI import qualified System.Logger.Class as Log import Wire.API.ErrorDescription import qualified Wire.API.Routes.Internal.Brig as BrigIRoutes +import Wire.API.Routes.Internal.Brig.Connection import qualified Wire.API.Team.Feature as ApiFt import Wire.API.User import Wire.API.User.Client (UserClientsFull (..)) @@ -84,6 +87,8 @@ servantSitemap = :<|> getAccountFeatureConfig :<|> putAccountFeatureConfig :<|> deleteAccountFeatureConfig + :<|> getConnectionsStatusUnqualified + :<|> getConnectionsStatus -- | Responds with 'Nothing' if field is NULL in existing user or user does not exist. getAccountFeatureConfig :: UserId -> Handler ApiFt.TeamFeatureStatusNoConfig @@ -131,13 +136,6 @@ sitemap = do -- - MemberLeave event to members for all conversations the user was in (via galley) delete "/i/users/:uid" (continue deleteUserNoVerifyH) $ capture "uid" - get "/i/users/connections-status" (continue deprecatedGetConnectionsStatusH) $ - query "users" - .&. opt (query "filter") - post "/i/users/connections-status" (continue getConnectionsStatusH) $ - accept "application" "json" - .&. jsonRequest @ConnectionsStatusRequest - .&. opt (query "filter") put "/i/connections/connection-update" (continue updateConnectionInternalH) $ accept "application" "json" @@ -450,20 +448,25 @@ getAccountStatusH (_ ::: usr) = do Just s -> json $ AccountStatusResp s Nothing -> setStatus status404 empty -getConnectionsStatusH :: - JSON ::: JsonRequest ConnectionsStatusRequest ::: Maybe Relation -> - Handler Response -getConnectionsStatusH (_ ::: req ::: flt) = do - body <- parseJsonBody req - json <$> lift (getConnectionsStatus body flt) - -getConnectionsStatus :: ConnectionsStatusRequest -> Maybe Relation -> AppIO [ConnectionStatus] -getConnectionsStatus ConnectionsStatusRequest {csrFrom, csrTo} flt = do +getConnectionsStatusUnqualified :: ConnectionsStatusRequest -> Maybe Relation -> Handler [ConnectionStatus] +getConnectionsStatusUnqualified ConnectionsStatusRequest {csrFrom, csrTo} flt = lift $ do r <- maybe (API.lookupConnectionStatus' csrFrom) (API.lookupConnectionStatus csrFrom) csrTo return $ maybe r (filterByRelation r) flt where filterByRelation l rel = filter ((== rel) . csStatus) l +getConnectionsStatus :: ConnectionsStatusRequestV2 -> Handler [ConnectionStatusV2] +getConnectionsStatus (ConnectionsStatusRequestV2 froms mtos mrel) = do + loc <- qualifyLocal () + conns <- lift $ case mtos of + Nothing -> Data.lookupAllStatuses =<< qualifyLocal froms + Just tos -> do + let getStatusesForOneDomain = foldQualified loc (Data.lookupLocalConnectionStatuses froms) (Data.lookupRemoteConnectionStatuses froms) + concat <$> mapM getStatusesForOneDomain (bucketQualified tos) + pure $ maybe conns (filterByRelation conns) mrel + where + filterByRelation l rel = filter ((== rel) . csv2Status) l + revokeIdentityH :: Either Email Phone -> Handler Response revokeIdentityH emailOrPhone = do lift $ API.revokeIdentity emailOrPhone @@ -599,19 +602,6 @@ getContactListH (_ ::: uid) = do contacts <- lift $ API.lookupContactList uid return $ json $ UserIds contacts --- Deprecated - --- Deprecated and to be removed after new versions of brig and galley are --- deployed. Reason for deprecation: it returns N^2 things (which is not --- needed), it doesn't scale, and it accepts everything in URL parameters, --- which doesn't work when the list of users is long. -deprecatedGetConnectionsStatusH :: List UserId ::: Maybe Relation -> Handler Response -deprecatedGetConnectionsStatusH (users ::: flt) = do - r <- lift $ API.lookupConnectionStatus (fromList users) (fromList users) - return . json $ maybe r (filterByRelation r) flt - where - filterByRelation l rel = filter ((== rel) . csStatus) l - -- Utilities ifNothing :: Utilities.Error -> Maybe a -> Handler a diff --git a/services/brig/src/Brig/API/User.hs b/services/brig/src/Brig/API/User.hs index f2021ee936c..79f827f616d 100644 --- a/services/brig/src/Brig/API/User.hs +++ b/services/brig/src/Brig/API/User.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE RecordWildCards #-} - -- This file is part of the Wire Server implementation. -- -- Copyright (C) 2020 Wire Swiss GmbH @@ -154,6 +152,7 @@ import Network.Wai.Utilities import qualified System.Logger.Class as Log import System.Logger.Message import Wire.API.Federation.Client (FederationError (..)) +import Wire.API.Routes.Internal.Brig.Connection import Wire.API.Team.Member (legalHoldStatus) data AllowSCIMUpdates diff --git a/services/brig/src/Brig/Data/Connection.hs b/services/brig/src/Brig/Data/Connection.hs index 342704fc711..cc1d9f0543d 100644 --- a/services/brig/src/Brig/Data/Connection.hs +++ b/services/brig/src/Brig/Data/Connection.hs @@ -32,6 +32,9 @@ module Brig.Data.Connection lookupConnectionStatus', lookupContactList, lookupContactListWithRelation, + lookupLocalConnectionStatuses, + lookupRemoteConnectionStatuses, + lookupAllStatuses, countConnections, deleteConnections, remoteConnectionInsert, @@ -49,7 +52,6 @@ import Brig.App (AppIO, qualifyLocal) import Brig.Data.Instances () import Brig.Data.Types as T import Brig.Types -import Brig.Types.Intra import Cassandra import Control.Monad.Morph import Control.Monad.Trans.Maybe @@ -62,8 +64,9 @@ import Data.Qualified import Data.Range import Data.Time (getCurrentTime) import Imports hiding (local) -import UnliftIO.Async (pooledMapConcurrentlyN_) +import UnliftIO.Async (pooledMapConcurrentlyN, pooledMapConcurrentlyN_) import Wire.API.Connection +import Wire.API.Routes.Internal.Brig.Connection insertConnection :: Local UserId -> @@ -204,6 +207,41 @@ lookupConnectionStatus' from = map toConnectionStatus <$> retry x1 (query connectionStatusSelect' (params Quorum (Identity from))) +lookupLocalConnectionStatuses :: [UserId] -> Local [UserId] -> AppIO [ConnectionStatusV2] +lookupLocalConnectionStatuses froms tos = do + concat <$> pooledMapConcurrentlyN 16 lookupStatuses froms + where + lookupStatuses :: UserId -> AppIO [ConnectionStatusV2] + lookupStatuses from = + map (uncurry $ toConnectionStatusV2 from (tDomain tos)) + <$> retry x1 (query relationsSelect (params Quorum (from, tUnqualified tos))) + +lookupRemoteConnectionStatuses :: [UserId] -> Remote [UserId] -> AppIO [ConnectionStatusV2] +lookupRemoteConnectionStatuses froms tos = do + concat <$> pooledMapConcurrentlyN 16 lookupStatuses froms + where + lookupStatuses :: UserId -> AppIO [ConnectionStatusV2] + lookupStatuses from = + map (uncurry $ toConnectionStatusV2 from (tDomain tos)) + <$> retry x1 (query remoteRelationsSelect (params Quorum (from, tDomain tos, tUnqualified tos))) + +lookupAllStatuses :: Local [UserId] -> AppIO [ConnectionStatusV2] +lookupAllStatuses lfroms = do + let froms = tUnqualified lfroms + concat <$> pooledMapConcurrentlyN 16 lookupAndCombine froms + where + lookupAndCombine :: UserId -> AppIO [ConnectionStatusV2] + lookupAndCombine u = (<>) <$> lookupLocalStatuses u <*> lookupRemoteStatuses u + + lookupLocalStatuses :: UserId -> AppIO [ConnectionStatusV2] + lookupLocalStatuses from = + map (uncurry $ toConnectionStatusV2 from (tDomain lfroms)) + <$> retry x1 (query relationsSelectAll (params Quorum (Identity from))) + lookupRemoteStatuses :: UserId -> AppIO [ConnectionStatusV2] + lookupRemoteStatuses from = + map (\(d, u, r) -> toConnectionStatusV2 from d u r) + <$> retry x1 (query remoteRelationsSelectAll (params Quorum (Identity from))) + -- | See 'lookupContactListWithRelation'. lookupContactList :: UserId -> AppIO [UserId] lookupContactList u = @@ -257,9 +295,19 @@ connectionSelect = "SELECT left, right, status, last_update, conv FROM connectio relationSelect :: PrepQuery R (UserId, UserId) (Identity RelationWithHistory) relationSelect = "SELECT status FROM connection WHERE left = ? AND right = ?" +relationsSelect :: PrepQuery R (UserId, [UserId]) (UserId, RelationWithHistory) +relationsSelect = "SELECT right, status FROM connection where left = ? AND right IN ?" + +relationsSelectAll :: PrepQuery R (Identity UserId) (UserId, RelationWithHistory) +relationsSelectAll = "SELECT right, status FROM connection where left = ?" + +-- FUTUREWORK: Delete this query, we shouldn't use `IN` with the primary key of +-- the table. connectionStatusSelect :: PrepQuery R ([UserId], [UserId]) (UserId, UserId, RelationWithHistory) connectionStatusSelect = "SELECT left, right, status FROM connection WHERE left IN ? AND right IN ?" +-- FUTUREWORK: Delete this query, we shouldn't use `IN` with the primary key of +-- the table. connectionStatusSelect' :: PrepQuery R (Identity [UserId]) (UserId, UserId, RelationWithHistory) connectionStatusSelect' = "SELECT left, right, status FROM connection WHERE left IN ?" @@ -301,6 +349,12 @@ remoteConnectionClear = "DELETE FROM connection_remote where left = ?" remoteRelationSelect :: PrepQuery R (UserId, Domain, UserId) (Identity RelationWithHistory) remoteRelationSelect = "SELECT status FROM connection_remote WHERE left = ? AND right_domain = ? AND right_user = ?" +remoteRelationsSelect :: PrepQuery R (UserId, Domain, [UserId]) (UserId, RelationWithHistory) +remoteRelationsSelect = "SELECT right_user, status FROM connection_remote WHERE left = ? AND right_domain = ? AND right_user IN ?" + +remoteRelationsSelectAll :: PrepQuery R (Identity UserId) (Domain, UserId, RelationWithHistory) +remoteRelationsSelectAll = "SELECT right_domain, right_user, status FROM connection_remote WHERE left = ?" + -- Conversions toLocalUserConnection :: @@ -319,3 +373,7 @@ toRemoteUserConnection l (rDomain, r, relationDropHistory -> rel, time, cDomain, toConnectionStatus :: (UserId, UserId, RelationWithHistory) -> ConnectionStatus toConnectionStatus (l, r, relationDropHistory -> rel) = ConnectionStatus l r rel + +toConnectionStatusV2 :: UserId -> Domain -> UserId -> RelationWithHistory -> ConnectionStatusV2 +toConnectionStatusV2 from toDomain toUser relWithHistory = + ConnectionStatusV2 from (Qualified toUser toDomain) (relationDropHistory relWithHistory) diff --git a/services/brig/test/integration/API/User/Connection.hs b/services/brig/test/integration/API/User/Connection.hs index b5b63461110..e2678598c97 100644 --- a/services/brig/test/integration/API/User/Connection.hs +++ b/services/brig/test/integration/API/User/Connection.hs @@ -28,7 +28,6 @@ import Bilge.Assert import Brig.Data.Connection (remoteConnectionInsert) import qualified Brig.Options as Opt import Brig.Types -import Brig.Types.Intra import qualified Cassandra as DB import Control.Arrow ((&&&)) import Data.ByteString.Conversion @@ -48,6 +47,7 @@ import Wire.API.Connection import qualified Wire.API.Federation.API.Brig as F import Wire.API.Federation.API.Galley (GetConversationsRequest (..), GetConversationsResponse (gcresConvs), RemoteConvMembers (rcmOthers), RemoteConversation (rcnvMembers)) import qualified Wire.API.Federation.API.Galley as F +import Wire.API.Routes.Internal.Brig.Connection import Wire.API.Routes.MultiTablePaging tests :: ConnectionLimit -> Opt.Timeout -> Opt.Opts -> Manager -> Brig -> Cannon -> Galley -> FedBrigClient -> FedGalleyClient -> DB.ClientState -> TestTree @@ -96,7 +96,8 @@ tests cl _at opts p b _c g fedBrigClient fedGalleyClient db = 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 "Remote connections: limits" (testConnectionLimits opts b fedBrigClient), + test p "post /users/connections-status/v2 : All connections" (testInternalGetConnStatusesAll b opts fedBrigClient) ] testCreateConnectionInvalidUser :: Brig -> Http () @@ -929,3 +930,55 @@ testConnectionLimits opts brig fedBrigClient = do postConnectionQualified brig uid1 quid2 !!! do const 403 === statusCode const (Just "connection-limit") === fmap Error.label . responseJsonMaybe + +testInternalGetConnStatusesAll :: Brig -> Opt.Opts -> FedBrigClient -> 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 F.RemoteConnect (Just F.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 F.RemoteConnect (Just F.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)) + (csv2From x, csv2To x)) + sortOn ordFn acceptedRemoteDomain1Only @?= sortOn ordFn (map (\u -> ConnectionStatusV2 u remoteDomain1User1 Accepted) uids) + +getConnStatusInternal :: (MonadIO m, 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 88febee65a3..77cfd2e45a4 100644 --- a/services/brig/test/integration/API/User/Util.hs +++ b/services/brig/test/integration/API/User/Util.hs @@ -24,7 +24,6 @@ import Bilge.Assert import Brig.Data.PasswordReset import Brig.Options (Opts) import Brig.Types -import Brig.Types.Intra import Brig.Types.Team.LegalHold (LegalHoldClientRequest (..)) import Brig.Types.User.Auth hiding (user) import qualified Brig.ZAuth @@ -54,6 +53,7 @@ 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.Internal.Brig.Connection import Wire.API.Routes.MultiTablePaging (LocalOrRemoteTable, MultiTablePagingState) newtype ConnectionLimit = ConnectionLimit Int64 diff --git a/services/brig/test/integration/Federation/End2end.hs b/services/brig/test/integration/Federation/End2end.hs index 867bc7c6905..d197a6b3c8f 100644 --- a/services/brig/test/integration/Federation/End2end.hs +++ b/services/brig/test/integration/Federation/End2end.hs @@ -39,7 +39,7 @@ import qualified Data.ProtoLens as Protolens import Data.Qualified import Data.Range (checked) import qualified Data.Set as Set -import Federation.Util (generateClientPrekeys, getConvQualified) +import Federation.Util (connectUsersEnd2End, generateClientPrekeys, getConvQualified) import Gundeck.Types.Notification (ntfTransient) import Imports import qualified System.Logger as Log @@ -244,8 +244,8 @@ testAddRemoteUsersToLocalConv brig1 galley1 brig2 galley2 = do let newConv = NewConvUnmanaged $ NewConv [] [] (Just "gossip") mempty Nothing Nothing Nothing Nothing roleNameWireAdmin convId <- - cnvQualifiedId . responseJsonUnsafe - <$> post + fmap cnvQualifiedId . responseJsonError + =<< post ( galley1 . path "/conversations" . zUser (userId alice) @@ -254,6 +254,8 @@ testAddRemoteUsersToLocalConv brig1 galley1 brig2 galley2 = do . json newConv ) + connectUsersEnd2End brig1 brig2 (userQualifiedId alice) (userQualifiedId bob) + let invite = InviteQualified (userQualifiedId bob :| []) roleNameWireAdmin post ( galley1 @@ -287,7 +289,12 @@ testRemoveRemoteUserFromLocalConv brig1 galley1 brig2 galley2 = do let aliceId = userQualifiedId alice let bobId = userQualifiedId bob - convId <- cnvQualifiedId . responseJsonUnsafe <$> createConversation galley1 (userId alice) [bobId] + connectUsersEnd2End brig1 brig2 aliceId bobId + + convId <- + fmap cnvQualifiedId . responseJsonError + =<< createConversation galley1 (userId alice) [bobId] + getConversationQualified galley1 (userId alice) convId liftIO $ map omQualifiedId (cmOthers (cnvMembers aliceConvBeforeDelete)) @?= [bobId] @@ -324,7 +331,12 @@ leaveRemoteConversation brig1 galley1 brig2 galley2 = do let aliceId = userQualifiedId alice let bobId = userQualifiedId bob - convId <- cnvQualifiedId . responseJsonUnsafe <$> createConversation galley1 (userId alice) [bobId] + connectUsersEnd2End brig1 brig2 aliceId bobId + + convId <- + fmap cnvQualifiedId . responseJsonError + =<< createConversation galley1 (userId alice) [bobId] + getConversationQualified galley1 (userId alice) convId liftIO $ map omQualifiedId (cmOthers (cnvMembers aliceConvBeforeDelete)) @?= [bobId] @@ -360,9 +372,13 @@ testRemoteUsersInNewConv :: Brig -> Galley -> Brig -> Galley -> Http () testRemoteUsersInNewConv brig1 galley1 brig2 galley2 = do alice <- randomUser brig1 bob <- randomUser brig2 + + connectUsersEnd2End brig1 brig2 (userQualifiedId alice) (userQualifiedId bob) convId <- - cnvQualifiedId . responseJsonUnsafe - <$> createConversation galley1 (userId alice) [userQualifiedId bob] + fmap cnvQualifiedId . responseJsonError + =<< createConversation galley1 (userId alice) [userQualifiedId bob] + createConversation galley1 (userId alice) [userQualifiedId bob] - cnv2 <- responseJsonUnsafe <$> createConversation galley2 (userId bob) [userQualifiedId alice] + cnv1 <- + responseJsonError + =<< createConversation galley1 (userId alice) [userQualifiedId bob] + createConversation galley2 (userId bob) [userQualifiedId alice] + fmap (qUnqualified . cnvQualifiedId) . responseJsonError + =<< createConversation galley2 (userId bob) [userQualifiedId alice] + addClient - brig1 - (userId alice) - (defNewClient PermanentClientType [] (someLastPrekeys !! 0)) + fmap clientId . responseJsonError + =<< addClient brig1 (userId alice) (defNewClient PermanentClientType [] (someLastPrekeys !! 0)) + addClient - brig2 - (userId bob) - (defNewClient PermanentClientType [] (someLastPrekeys !! 1)) + fmap clientId . responseJsonError + =<< addClient brig2 (userId bob) (defNewClient PermanentClientType [] (someLastPrekeys !! 1)) + createConversation galley1 (userId alice) [userQualifiedId bob] + fmap (qUnqualified . cnvQualifiedId) . responseJsonError + =<< createConversation galley1 (userId alice) [userQualifiedId bob] + Brig -> Qualified UserId -> Qualified UserId -> Http () +connectUsersEnd2End brig1 brig2 quid1 quid2 = do + postConnectionQualified brig1 (qUnqualified quid1) quid2 + !!! const 201 === statusCode + putConnectionQualified brig2 (qUnqualified quid2) quid1 Accepted + !!! const 200 === statusCode diff --git a/services/galley/src/Galley/API/Federation.hs b/services/galley/src/Galley/API/Federation.hs index 8e63653b402..359f301ba11 100644 --- a/services/galley/src/Galley/API/Federation.hs +++ b/services/galley/src/Galley/API/Federation.hs @@ -16,6 +16,7 @@ -- with this program. If not, see . module Galley.API.Federation where +import Brig.Types.Connection (Relation (Accepted)) import Control.Lens (itraversed, (<.>)) import Control.Monad.Catch (throwM) import Control.Monad.Trans.Maybe (runMaybeT) @@ -24,10 +25,10 @@ import Data.Containers.ListUtils (nubOrd) import Data.Domain import Data.Id (ConvId, UserId) import Data.Json.Util (Base64ByteString (..)) -import Data.List.NonEmpty (NonEmpty) +import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.Map as Map import Data.Map.Lens (toMapOf) -import Data.Qualified (Qualified (..), qUntagged, toRemoteUnsafe) +import Data.Qualified (Qualified (..), Remote, partitionQualified, qUntagged, qualifyAs, toRemoteUnsafe) import qualified Data.Set as Set import qualified Data.Text.Lazy as LT import Galley.API.Error (invalidPayload) @@ -37,6 +38,7 @@ import qualified Galley.API.Update as API import Galley.API.Util import Galley.App (Galley) import qualified Galley.Data as Data +import Galley.Intra.User (getConnections) import Galley.Types.Conversations.Members (LocalMember (..), defMemberStatus) import Imports import Servant (ServerT) @@ -60,6 +62,7 @@ import Wire.API.Federation.API.Galley RemoteMessage (..), ) import qualified Wire.API.Federation.API.Galley as FederationAPIGalley +import Wire.API.Routes.Internal.Brig.Connection import Wire.API.Routes.Public.Galley.Responses (RemoveFromConversationError (..)) import Wire.API.ServantProto (FromProto (..)) import Wire.API.User.Client (userClientMap) @@ -78,20 +81,25 @@ federationSitemap = onConversationCreated :: Domain -> NewRemoteConversation ConvId -> Galley () onConversationCreated domain rc = do - let qrc = fmap (`Qualified` domain) rc + let qrc = fmap (toRemoteUnsafe domain) rc localDomain <- viewFederationDomain - let localUsers = - foldMap (\om -> guard (qDomain (omQualifiedId om) == localDomain) $> omQualifiedId om) + let (localMembers, remoteMembers) = + Set.partition (\om -> qDomain (omQualifiedId om) == localDomain) . rcMembers $ rc - localUserIds = fmap qUnqualified localUsers - unless (null localUsers) $ do - Data.addLocalMembersToRemoteConv (rcCnvId qrc) localUserIds - forM_ (fromNewRemoteConversation localDomain qrc) $ \(mem, c) -> do + localUserIds = qUnqualified . omQualifiedId <$> Set.toList localMembers + + addedUserIds <- addLocalUsersToRemoteConv (rcCnvId qrc) (rcOrigUserId rc) localUserIds + + let connectedLocalMembers = Set.filter (\m -> (qUnqualified . omQualifiedId) m `Set.member` addedUserIds) localMembers + -- Make sure to notify only about local users connected to the adder + let qrcConnected = qrc {rcMembers = Set.union remoteMembers connectedLocalMembers} + + forM_ (fromNewRemoteConversation localDomain qrcConnected) $ \(mem, c) -> do let event = Event ConvCreate - (rcCnvId qrc) + (qUntagged (rcCnvId qrc)) (rcOrigUserId rc) (rcTime rc) (EdConversation c) @@ -113,7 +121,9 @@ getLocalUsers localDomain = map qUnqualified . filter ((== localDomain) . qDomai onConversationUpdated :: Domain -> ConversationUpdate -> Galley () onConversationUpdated requestingDomain cu = do localDomain <- viewFederationDomain - let qconvId = Qualified (cuConvId cu) requestingDomain + loc <- qualifyLocal () + let rconvId = toRemoteUnsafe requestingDomain (cuConvId cu) + qconvId = qUntagged rconvId -- Note: we generally do not send notifications to users that are not part of -- the conversation (from our point of view), to prevent spam from the remote @@ -128,37 +138,62 @@ onConversationUpdated requestingDomain cu = do -- are not in the conversations are being removed or have their membership state -- updated, we do **not** add them to the list of targets, because we have no -- way to make sure that they are actually supposed to receive that notification. - extraTargets <- case cuAction cu of - ConversationActionAddMembers toAdd _ -> do - let localUsers = getLocalUsers localDomain toAdd - Data.addLocalMembersToRemoteConv qconvId localUsers - pure localUsers + (mActualAction, extraTargets) <- case cuAction cu of + ConversationActionAddMembers toAdd role -> do + let (localUsers, remoteUsers) = partitionQualified loc toAdd + addedLocalUsers <- Set.toList <$> addLocalUsersToRemoteConv rconvId (cuOrigUserId cu) localUsers + let allAddedUsers = map (qUntagged . qualifyAs loc) addedLocalUsers <> map qUntagged remoteUsers + case allAddedUsers of + [] -> pure (Nothing, []) -- If no users get added, its like no action was performed. + (u : us) -> pure (Just $ ConversationActionAddMembers (u :| us) role, addedLocalUsers) ConversationActionRemoveMembers toRemove -> do let localUsers = getLocalUsers localDomain toRemove Data.removeLocalMembersFromRemoteConv qconvId localUsers - pure [] - ConversationActionRename _ -> pure [] - ConversationActionMessageTimerUpdate _ -> pure [] - ConversationActionMemberUpdate _ _ -> pure [] - ConversationActionReceiptModeUpdate _ -> pure [] - ConversationActionAccessUpdate _ -> pure [] - - -- Send notifications - let event = conversationActionToEvent (cuTime cu) (cuOrigUserId cu) qconvId (cuAction cu) - targets = nubOrd $ presentUsers <> extraTargets + pure (Just $ cuAction cu, []) + ConversationActionRename _ -> pure (Just $ cuAction cu, []) + ConversationActionMessageTimerUpdate _ -> pure (Just $ cuAction cu, []) + ConversationActionMemberUpdate _ _ -> pure (Just $ cuAction cu, []) + ConversationActionReceiptModeUpdate _ -> pure (Just $ cuAction cu, []) + ConversationActionAccessUpdate _ -> pure (Just $ cuAction cu, []) unless allUsersArePresent $ Log.warn $ Log.field "conversation" (toByteString' (cuConvId cu)) - Log.~~ Log.field "domain" (toByteString' requestingDomain) - Log.~~ Log.msg + . Log.field "domain" (toByteString' requestingDomain) + . Log.msg ( "Attempt to send notification about conversation update \ \to users not in the conversation" :: ByteString ) - -- FUTUREWORK: support bots? - pushConversationEvent Nothing event targets [] + -- Send notifications + for_ mActualAction $ \action -> do + let event = conversationActionToEvent (cuTime cu) (cuOrigUserId cu) qconvId action + targets = nubOrd $ presentUsers <> extraTargets + + -- FUTUREWORK: support bots? + pushConversationEvent Nothing event targets [] + +addLocalUsersToRemoteConv :: Remote ConvId -> Qualified UserId -> [UserId] -> Galley (Set UserId) +addLocalUsersToRemoteConv remoteConvId qAdder localUsers = do + connStatus <- getConnections localUsers (Just [qAdder]) (Just Accepted) + let localUserIdsSet = Set.fromList localUsers + connected = Set.fromList $ fmap csv2From connStatus + unconnected = Set.difference localUserIdsSet connected + connectedList = Set.toList connected + + -- FUTUREWORK: Consider handling the discrepancy between the views of the + -- conversation-owning backend and the local backend + unless (Set.null unconnected) $ + Log.warn $ + Log.msg ("A remote user is trying to add unconnected local users to a remote conversation" :: Text) + . Log.field "remote_user" (show qAdder) + . Log.field "local_unconnected_users" (show unconnected) + + -- Update the local view of the remote conversation by adding only those local + -- users that are connected to the adder + Data.addLocalMembersToRemoteConv (qUntagged remoteConvId) connectedList + pure connected -- FUTUREWORK: actually return errors as part of the response instead of throwing leaveConversation :: diff --git a/services/galley/src/Galley/API/LegalHold.hs b/services/galley/src/Galley/API/LegalHold.hs index 1755eec74cc..bd40fa575f6 100644 --- a/services/galley/src/Galley/API/LegalHold.hs +++ b/services/galley/src/Galley/API/LegalHold.hs @@ -34,7 +34,6 @@ where import Brig.Types.Client.Prekey import Brig.Types.Connection (UpdateConnectionsInternal (..)) -import Brig.Types.Intra (ConnectionStatus (..)) import Brig.Types.Provider import Brig.Types.Team.LegalHold hiding (userId) import Control.Exception (assert) @@ -59,7 +58,7 @@ import qualified Galley.Data.LegalHold as LegalHoldData import qualified Galley.Data.TeamFeatures as TeamFeatures import qualified Galley.External.LegalHoldService as LHService import qualified Galley.Intra.Client as Client -import Galley.Intra.User (getConnections, putConnectionInternal) +import Galley.Intra.User (getConnectionsUnqualified, putConnectionInternal) import qualified Galley.Options as Opts import Galley.Types (LocalMember, lmConvRoleName, lmId) import Galley.Types.Teams as Team @@ -73,6 +72,7 @@ import qualified System.Logger.Class as Log import UnliftIO.Async (pooledMapConcurrentlyN_) import Wire.API.Conversation (ConvType (..)) import Wire.API.Conversation.Role (roleNameWireAdmin) +import Wire.API.Routes.Internal.Brig.Connection import qualified Wire.API.Team.Feature as Public import Wire.API.Team.LegalHold (LegalholdProtectee (LegalholdPlusFederationNotImplemented)) import qualified Wire.API.Team.LegalHold as Public @@ -415,7 +415,7 @@ changeLegalholdStatus tid uid old new = do -- FUTUREWORK: make this async? blockNonConsentingConnections :: UserId -> Galley () blockNonConsentingConnections uid = do - conns <- getConnections [uid] Nothing Nothing + conns <- getConnectionsUnqualified [uid] Nothing Nothing errmsgs <- do conflicts <- mconcat <$> findConflicts conns blockConflicts uid conflicts diff --git a/services/galley/src/Galley/API/Update.hs b/services/galley/src/Galley/API/Update.hs index ad643767047..4a4dce798e7 100644 --- a/services/galley/src/Galley/API/Update.hs +++ b/services/galley/src/Galley/API/Update.hs @@ -125,7 +125,8 @@ import Wire.API.ErrorDescription import qualified Wire.API.ErrorDescription as Public import qualified Wire.API.Event.Conversation as Public import qualified Wire.API.Federation.API.Galley as FederatedGalley -import Wire.API.Federation.Error (federationNotImplemented) +import Wire.API.Federation.Client (HasFederatorConfig (..)) +import Wire.API.Federation.Error (federationNotConfigured, federationNotImplemented) import qualified Wire.API.Message as Public import Wire.API.Routes.Public.Galley.Responses import Wire.API.Routes.Public.Util (UpdateResult (..)) @@ -591,7 +592,7 @@ performAddMemberAction qusr conv invited role = do ensureMemberLimit (toList (Data.convLocalMembers conv)) newMembers ensureAccess conv InviteAccess checkLocals lcnv (Data.convTeam conv) (ulLocals newMembers) - checkRemoteUsersExist (ulRemotes newMembers) + checkRemotes (ulRemotes newMembers) checkLHPolicyConflictsLocal lcnv (ulLocals newMembers) checkLHPolicyConflictsRemote (FutureWork (ulRemotes newMembers)) addMembersToLocalConversation lcnv newMembers role @@ -611,6 +612,23 @@ performAddMemberAction qusr conv invited role = do ensureAccessRole (Data.convAccessRole conv) (zip newUsers $ repeat Nothing) ensureConnectedOrSameTeam qusr newUsers + checkRemotes :: [Remote UserId] -> Galley () + checkRemotes remotes = do + -- if federator is not configured, we fail early, so we avoid adding + -- remote members to the database + unless (null remotes) $ do + endpoint <- federatorEndpoint + when (isNothing endpoint) $ + throwM federationNotConfigured + + loc <- qualifyLocal () + foldQualified + loc + ensureConnectedToRemotes + (\_ _ -> throwM federationNotImplemented) + qusr + remotes + checkLHPolicyConflictsLocal :: Local ConvId -> [UserId] -> Galley () checkLHPolicyConflictsLocal lcnv newUsers = do let convUsers = Data.convLocalMembers conv diff --git a/services/galley/src/Galley/API/Util.hs b/services/galley/src/Galley/API/Util.hs index c6a940d3552..fae4c5a54c6 100644 --- a/services/galley/src/Galley/API/Util.hs +++ b/services/galley/src/Galley/API/Util.hs @@ -108,18 +108,25 @@ ensureConnectedOrSameTeam (Qualified u domain) uids = do -- that they are connected). ensureConnected :: Local UserId -> UserList UserId -> Galley () ensureConnected self others = do - -- FUTUREWORK(federation, #1262): check remote connections ensureConnectedToLocals (tUnqualified self) (ulLocals others) + ensureConnectedToRemotes self (ulRemotes others) ensureConnectedToLocals :: UserId -> [UserId] -> Galley () ensureConnectedToLocals _ [] = pure () ensureConnectedToLocals u uids = do (connsFrom, connsTo) <- - getConnections [u] (Just uids) (Just Accepted) - `concurrently` getConnections uids (Just [u]) (Just Accepted) + getConnectionsUnqualified [u] (Just uids) (Just Accepted) + `concurrently` getConnectionsUnqualified uids (Just [u]) (Just Accepted) unless (length connsFrom == length uids && length connsTo == length uids) $ throwErrorDescriptionType @NotConnected +ensureConnectedToRemotes :: Local UserId -> [Remote UserId] -> Galley () +ensureConnectedToRemotes _ [] = pure () +ensureConnectedToRemotes u remotes = do + acceptedConns <- getConnections [tUnqualified u] (Just $ map qUntagged remotes) (Just Accepted) + when (length acceptedConns /= length remotes) $ + throwErrorDescriptionType @NotConnected + ensureReAuthorised :: UserId -> Maybe PlainTextPassword -> Galley () ensureReAuthorised u secret = do reAuthed <- reAuthUser u (ReAuthUser secret) @@ -675,13 +682,14 @@ toNewRemoteConversation now localDomain Data.Conversation {..} = -- conversation. fromNewRemoteConversation :: Domain -> - NewRemoteConversation (Qualified ConvId) -> + NewRemoteConversation (Remote ConvId) -> [(Public.Member, Public.Conversation)] fromNewRemoteConversation d NewRemoteConversation {..} = let membersView = fmap (second Set.toList) . setHoles $ rcMembers + creatorOther = OtherMember rcOrigUserId Nothing roleNameWireAdmin in foldMap ( \(me, others) -> - guard (inDomain me) $> let mem = toMember me in (mem, conv mem others) + guard (inDomain me) $> let mem = toMember me in (mem, conv mem (creatorOther : others)) ) membersView where @@ -707,7 +715,7 @@ fromNewRemoteConversation d NewRemoteConversation {..} = conv :: Public.Member -> [OtherMember] -> Public.Conversation conv this others = Public.Conversation - rcCnvId + (qUntagged rcCnvId) ConversationMetadata { cnvmType = rcCnvType, -- FUTUREWORK: Document this is the same domain as the conversation diff --git a/services/galley/src/Galley/Intra/User.hs b/services/galley/src/Galley/Intra/User.hs index 3a8b52c3cfc..29a077222a6 100644 --- a/services/galley/src/Galley/Intra/User.hs +++ b/services/galley/src/Galley/Intra/User.hs @@ -17,6 +17,7 @@ module Galley.Intra.User ( getConnections, + getConnectionsUnqualified, putConnectionInternal, deleteBot, reAuthUser, @@ -32,7 +33,7 @@ where import Bilge hiding (getHeader, options, statusCode) import Bilge.RPC -import Brig.Types.Connection (ConnectionsStatusRequest (..), Relation (..), UpdateConnectionsInternal (..), UserIds (..)) +import Brig.Types.Connection (Relation (..), UpdateConnectionsInternal (..), UserIds (..)) import Brig.Types.Intra import Brig.Types.User (User) import Control.Monad.Catch (throwM) @@ -40,6 +41,7 @@ import Data.ByteString.Char8 (pack) import qualified Data.ByteString.Char8 as BSC import Data.ByteString.Conversion import Data.Id +import Data.Qualified import Galley.App import Galley.Intra.Util import Imports @@ -48,6 +50,7 @@ import qualified Network.HTTP.Client.Internal as Http import Network.HTTP.Types.Method import Network.HTTP.Types.Status import Network.Wai.Utilities.Error +import Wire.API.Routes.Internal.Brig.Connection import Wire.API.User.RichInfo (RichInfo) -- | Get statuses of all connections between two groups of users (the usual @@ -55,9 +58,9 @@ import Wire.API.User.RichInfo (RichInfo) -- several users to one). -- -- When a connection does not exist, it is skipped. --- Calls 'Brig.API.getConnectionsStatusH'. -getConnections :: [UserId] -> Maybe [UserId] -> Maybe Relation -> Galley [ConnectionStatus] -getConnections uFrom uTo rlt = do +-- Calls 'Brig.API.Internal.getConnectionsStatusUnqualified'. +getConnectionsUnqualified :: [UserId] -> Maybe [UserId] -> Maybe Relation -> Galley [ConnectionStatus] +getConnectionsUnqualified uFrom uTo rlt = do (h, p) <- brigReq r <- call "brig" $ @@ -70,6 +73,24 @@ getConnections uFrom uTo rlt = do where rfilter = queryItem "filter" . (pack . map toLower . show) +-- | Get statuses of all connections between two groups of users (the usual +-- pattern is to check all connections from one user to several, or from +-- several users to one). +-- +-- When a connection does not exist, it is skipped. +-- Calls 'Brig.API.Internal.getConnectionsStatus'. +getConnections :: [UserId] -> Maybe [Qualified UserId] -> Maybe Relation -> Galley [ConnectionStatusV2] +getConnections [] _ _ = pure [] +getConnections uFrom uTo rlt = do + (h, p) <- brigReq + r <- + call "brig" $ + method POST . host h . port p + . path "/i/users/connections-status/v2" + . json (ConnectionsStatusRequestV2 uFrom uTo rlt) + . expect2xx + parseResponse (mkError status502 "server-error") r + putConnectionInternal :: UpdateConnectionsInternal -> Galley Status putConnectionInternal updateConn = do (h, p) <- brigReq diff --git a/services/galley/test/integration/API.hs b/services/galley/test/integration/API.hs index c0a63c5ebd9..4ea430c9b94 100644 --- a/services/galley/test/integration/API.hs +++ b/services/galley/test/integration/API.hs @@ -37,7 +37,7 @@ import Bilge hiding (timeout) import Bilge.Assert import Brig.Types import qualified Control.Concurrent.Async as Async -import Control.Lens (at, ix, preview, view, (.~), (?~), (^.)) +import Control.Lens (at, ix, preview, view, (.~), (?~)) import Control.Monad.Except (MonadError (throwError)) import Data.Aeson hiding (json) import qualified Data.ByteString as BS @@ -140,8 +140,9 @@ tests s = test s "M:N conversation creation must have randomId + postConvQualified alice defNewConv {newConvQualifiedUsers = [bob]} + !!! const 403 === statusCode + postConvQualifiedNonExistentDomain :: TestM () postConvQualifiedNonExistentDomain = do alice <- randomUser bob <- flip Qualified (Domain "non-existent.example.com") <$> randomId + connectWithRemoteUser alice bob postConvQualified alice defNewConv {newConvQualifiedUsers = [bob]} !!! do const 422 === statusCode -postConvQualifiedNonExistentUser :: TestM () -postConvQualifiedNonExistentUser = do - alice <- randomUser - bobId <- randomId - charlieId <- randomId - let remoteDomain = Domain "far-away.example.com" - bob = Qualified bobId remoteDomain - charlie = Qualified charlieId remoteDomain - opts <- view tsGConf - void . withTempMockFederator opts remoteDomain (const [mkProfile charlie (Name "charlie")]) $ - postConvQualified alice defNewConv {newConvQualifiedUsers = [bob, charlie]} - !!! do - const 400 === statusCode - const (Right "unknown-remote-user") === fmap label . responseJsonEither - postConvQualifiedFederationNotEnabled :: TestM () postConvQualifiedFederationNotEnabled = do g <- view tsGalley alice <- randomUser bob <- flip Qualified (Domain "some-remote-backend.example.com") <$> randomId opts <- view tsGConf + connectWithRemoteUser alice bob let federatorNotConfigured :: Opts = opts & optFederator .~ Nothing withSettingsOverrides federatorNotConfigured $ postConvHelper g alice [bob] !!! do @@ -1852,8 +1857,6 @@ leaveConnectConversation = do let c = maybe (error "invalid connect conversation") (qUnqualified . cnvQualifiedId) (responseJsonUnsafe bdy) deleteMemberUnqualified alice alice c !!! const 403 === statusCode --- FUTUREWORK: Add more tests for scenarios of federation. --- See also the comment in Galley.API.Update.addMembers for some other checks that are necessary. testAddRemoteMember :: TestM () testAddRemoteMember = do qalice <- randomQualifiedUser @@ -1864,21 +1867,24 @@ testAddRemoteMember = do remoteBob = Qualified bobId remoteDomain convId <- decodeConvId <$> postConv alice [] (Just "remote gossip") [] Nothing Nothing let qconvId = Qualified convId localDomain + + postQualifiedMembers alice (remoteBob :| []) convId !!! do + const 403 === statusCode + const (Right (Just "not-connected")) === fmap (view (at "label")) . responseJsonEither @Object + + connectWithRemoteUser alice remoteBob + opts <- view tsGConf (resp, reqs) <- - withTempMockFederator - opts - remoteDomain - (respond remoteBob) - (postQualifiedMembers alice (remoteBob :| []) convId) + withTempMockFederator opts remoteDomain (respond remoteBob) $ + postQualifiedMembers alice (remoteBob :| []) convId + (pure resp postConv alice [] (Just "gossip") [] Nothing Nothing let localConvId = cnvQualifiedId localConv @@ -2095,54 +2105,19 @@ testBulkGetQualifiedConvs = do assertEqual "not founds" expectedNotFound actualNotFound assertEqual "failures" [remoteConvIdCFailure] (crFailed convs) -testAddRemoteMemberFailure :: TestM () -testAddRemoteMemberFailure = do - alice <- randomUser - bobId <- randomId - charlieId <- randomId - let remoteDomain = Domain "far-away.example.com" - remoteBob = Qualified bobId remoteDomain - remoteCharlie = Qualified charlieId remoteDomain - convId <- decodeConvId <$> postConv alice [] (Just "remote gossip") [] Nothing Nothing - opts <- view tsGConf - (resp, _) <- - withTempMockFederator - opts - remoteDomain - (const [mkProfile remoteCharlie (Name "charlie")]) - (postQualifiedMembers alice (remoteBob :| [remoteCharlie]) convId) - liftIO $ statusCode resp @?= 400 - let err = responseJsonUnsafe resp :: Object - liftIO $ (err ^. at "label") @?= Just "unknown-remote-user" - -testAddDeletedRemoteUser :: TestM () -testAddDeletedRemoteUser = do - alice <- randomUser - bobId <- randomId - let remoteDomain = Domain "far-away.example.com" - remoteBob = Qualified bobId remoteDomain - convId <- decodeConvId <$> postConv alice [] (Just "remote gossip") [] Nothing Nothing - opts <- view tsGConf - (resp, _) <- - withTempMockFederator - opts - remoteDomain - (const [(mkProfile remoteBob (Name "bob")) {profileDeleted = True}]) - (postQualifiedMembers alice (remoteBob :| []) convId) - liftIO $ statusCode resp @?= 400 - let err = responseJsonUnsafe resp :: Object - liftIO $ (err ^. at "label") @?= Just "unknown-remote-user" - testAddRemoteMemberInvalidDomain :: TestM () testAddRemoteMemberInvalidDomain = do alice <- randomUser bobId <- randomId let remoteBob = Qualified bobId (Domain "invalid.example.com") convId <- decodeConvId <$> postConv alice [] (Just "remote gossip") [] Nothing Nothing + + connectWithRemoteUser alice remoteBob + postQualifiedMembers alice (remoteBob :| []) convId !!! do const 422 === statusCode - const (Just "/federation/get-users-by-ids") + const (Just "/federation/on-conversation-updated") === preview (ix "data" . ix "path") . responseJsonUnsafe @Value const (Just "invalid.example.com") === preview (ix "data" . ix "domain") . responseJsonUnsafe @Value @@ -2154,6 +2129,8 @@ testAddRemoteMemberFederationDisabled = do alice <- randomUser remoteBob <- flip Qualified (Domain "some-remote-backend.example.com") <$> randomId convId <- decodeConvId <$> postConv alice [] (Just "remote gossip") [] Nothing Nothing + connectWithRemoteUser alice remoteBob + opts <- view tsGConf -- federator endpoint not configured is equivalent to federation being disabled -- This is the case on staging/production in May 2021. @@ -2161,7 +2138,20 @@ testAddRemoteMemberFederationDisabled = do withSettingsOverrides federatorNotConfigured $ postQualifiedMembers alice (remoteBob :| []) convId !!! do const 400 === statusCode - const (Just "federation-not-enabled") === fmap label . responseJsonUnsafe + const (Right "federation-not-enabled") === fmap label . responseJsonEither + + -- the member is not actually added to the conversation + conv <- responseJsonError =<< getConv alice convId randomId + convId <- decodeConvId <$> postConv alice [] (Just "remote gossip") [] Nothing Nothing + connectWithRemoteUser alice remoteBob + + opts <- view tsGConf -- federator endpoint being configured in brig and/or galley, but not being -- available (i.e. no service listing on that IP/port) can happen due to a -- misconfiguration of federator. That should give a 500. @@ -2170,7 +2160,12 @@ testAddRemoteMemberFederationDisabled = do withSettingsOverrides federatorUnavailable $ postQualifiedMembers alice (remoteBob :| []) convId !!! do const 500 === statusCode - const (Just "federation-not-available") === fmap label . responseJsonUnsafe + const (Right "federation-not-available") === fmap label . responseJsonEither + + -- in this case, we discover that federation is unavailable too late, and the + -- member has already been added to the conversation + conv <- responseJsonError =<< getConv alice convId postConv alice [bob, chuck] (Just "gossip") [] Nothing Nothing let qconv = Qualified conv (qDomain qalice) - e <- responseJsonUnsafe <$> (postMembers alice (singleton eve) conv postConvWithRemoteUsers @@ -2364,6 +2360,7 @@ deleteRemoteMemberConvLocalQualifiedOk = do qDee <- (`Qualified` remoteDomain1) <$> randomId qEve <- (`Qualified` remoteDomain2) <$> randomId connectUsers alice (singleton bob) + mapM_ (connectWithRemoteUser alice) [qChad, qDee, qEve] opts <- view tsGConf let mockedResponse fedReq = do @@ -2381,10 +2378,11 @@ deleteRemoteMemberConvLocalQualifiedOk = do (convId, _) <- withTempMockFederator' opts remoteDomain1 mockedResponse $ - decodeConvId - <$> postConvQualified + fmap decodeConvId $ + postConvQualified alice defNewConv {newConvQualifiedUsers = [qBob, qChad, qDee, qEve]} + randomId <*> pure remoteDomain qconv <- Qualified <$> randomId <*> pure remoteDomain + connectWithRemoteUser alice qbob + fedGalleyClient <- view tsFedGalleyClient now <- liftIO getCurrentTime let cu = @@ -2928,6 +2931,8 @@ putReceiptModeWithRemotesOk = do qbob <- randomQualifiedUser let bob = qUnqualified qbob + connectWithRemoteUser bob qalice + resp <- postConvWithRemoteUsers remoteDomain @@ -2996,7 +3001,11 @@ removeUser = do [alice, bob, carl] <- replicateM 3 randomQualifiedUser dee <- (`Qualified` remoteDomain) <$> randomId let [alice', bob', carl'] = qUnqualified <$> [alice, bob, carl] + connectUsers alice' (list1 bob' [carl']) + connectWithRemoteUser alice' dee + connectWithRemoteUser bob' dee + conv1 <- decodeConvId <$> postConv alice' [bob'] (Just "gossip") [] Nothing Nothing conv2 <- decodeConvId <$> postConv alice' [bob', carl'] (Just "gossip2") [] Nothing Nothing conv3 <- decodeConvId <$> postConv alice' [carl'] (Just "gossip3") [] Nothing Nothing diff --git a/services/galley/test/integration/API/Federation.hs b/services/galley/test/integration/API/Federation.hs index 0a16eeb34c6..f114ee2ac83 100644 --- a/services/galley/test/integration/API/Federation.hs +++ b/services/galley/test/integration/API/Federation.hs @@ -64,7 +64,9 @@ tests s = "federation" [ test s "POST /federation/get-conversations : All Found" getConversationsAllFound, test s "POST /federation/get-conversations : Conversations user is not a part of are excluded from result" getConversationsNotPartOf, + test s "POST /federation/on-conversation-created : Add local user to remote conversation" onConvCreated, test s "POST /federation/on-conversation-updated : Add local user to remote conversation" addLocalUser, + test s "POST /federation/on-conversation-updated : Add only unconnected local users to remote conversation" addUnconnectedUsersOnly, test s "POST /federation/on-conversation-updated : Notify local user about other members joining" addRemoteUser, test s "POST /federation/on-conversation-updated : Remove a local user from a remote conversation" removeLocalUser, test s "POST /federation/on-conversation-updated : Remove a remote user from a remote conversation" removeRemoteUser, @@ -85,7 +87,9 @@ getConversationsAllFound = do -- create & get group conv aliceQ <- Qualified <$> randomId <*> pure (Domain "far-away.example.com") carlQ <- randomQualifiedUser + connectUsers bob (singleton (qUnqualified carlQ)) + connectWithRemoteUser bob aliceQ cnv2 <- responseJsonError @@ -151,6 +155,36 @@ getConversationsNotPartOf = do (GetConversationsRequest rando [qUnqualified . cnvQualifiedId $ cnv1]) liftIO $ assertEqual "conversation list not empty" [] cs +onConvCreated :: TestM () +onConvCreated = do + c <- view tsCannon + (alice, qAlice) <- randomUserTuple + let remoteDomain = Domain "bobland.example.com" + qBob <- Qualified <$> randomId <*> pure remoteDomain + qDee <- Qualified <$> randomId <*> pure remoteDomain + + (charlie, qCharlie) <- randomUserTuple + conv <- randomId + let qconv = Qualified conv remoteDomain + + connectWithRemoteUser alice qBob + -- Remote Bob creates a conversation with local Alice and Charlie; + -- however Bob is not connected to Charlie but only to Alice. + let requestMembers = Set.fromList (map asOtherMember [qAlice, qCharlie, qDee]) + + WS.bracketR2 c alice charlie $ \(wsA, wsC) -> do + registerRemoteConv qconv qBob (Just "gossip") requestMembers + liftIO $ do + let expectedSelf = alice + expectedOthers = [(qBob, roleNameWireAdmin), (qDee, roleNameWireMember)] + expectedFrom = qBob + -- since Charlie is not connected to Bob; expect a conversation with Alice&Bob only + WS.assertMatch_ (5 # Second) wsA $ + wsAssertConvCreateWithRole qconv expectedFrom expectedSelf expectedOthers + WS.assertNoEvent (1 # Second) [wsC] + convs <- listRemoteConvs remoteDomain alice + liftIO $ convs @?= [Qualified conv remoteDomain] + addLocalUser :: TestM () addLocalUser = do localDomain <- viewFederationDomain @@ -161,8 +195,13 @@ addLocalUser = do bob <- randomId let qbob = Qualified bob remoteDomain charlie <- randomUser + dee <- randomUser + let qdee = Qualified dee localDomain conv <- randomId let qconv = Qualified conv remoteDomain + + connectWithRemoteUser alice qbob + fedGalleyClient <- view tsFedGalleyClient now <- liftIO getCurrentTime let cu = @@ -172,16 +211,65 @@ addLocalUser = do FedGalley.cuConvId = conv, FedGalley.cuAlreadyPresentUsers = [charlie], FedGalley.cuAction = - ConversationActionAddMembers (pure qalice) roleNameWireMember + ConversationActionAddMembers (qalice :| [qdee]) roleNameWireMember } - WS.bracketR2 c alice charlie $ \(wsA, wsC) -> do + WS.bracketRN c [alice, charlie, dee] $ \[wsA, wsC, wsD] -> do FedGalley.onConversationUpdated fedGalleyClient remoteDomain cu liftIO $ do WS.assertMatch_ (5 # Second) wsA $ wsAssertMemberJoinWithRole qconv qbob [qalice] roleNameWireMember + -- Since charlie is not really present in the conv, they don't get any + -- notifications WS.assertNoEvent (1 # Second) [wsC] - convs <- listRemoteConvs remoteDomain alice - liftIO $ convs @?= [Qualified conv remoteDomain] + -- Since dee is not connected to bob, they don't get any notifications + WS.assertNoEvent (1 # Second) [wsD] + aliceConvs <- listRemoteConvs remoteDomain alice + liftIO $ aliceConvs @?= [Qualified conv remoteDomain] + deeConvs <- listRemoteConvs remoteDomain dee + liftIO $ deeConvs @?= [] + +addUnconnectedUsersOnly :: TestM () +addUnconnectedUsersOnly = do + c <- view tsCannon + (alice, qAlice) <- randomUserTuple + (_charlie, qCharlie) <- randomUserTuple + + let remoteDomain = Domain "bobland.example.com" + qBob <- Qualified <$> randomId <*> pure remoteDomain + conv <- randomId + let qconv = Qualified conv remoteDomain + + -- Bob is connected to Alice + -- Bob is not connected to Charlie + connectWithRemoteUser alice qBob + let requestMembers = Set.fromList (map asOtherMember [qAlice]) + + now <- liftIO getCurrentTime + fedGalleyClient <- view tsFedGalleyClient + + WS.bracketR c alice $ \wsA -> do + -- Remote Bob creates a conversation with local Alice + registerRemoteConv qconv qBob (Just "gossip") requestMembers + liftIO $ do + let expectedSelf = alice + expectedOthers = [(qBob, roleNameWireAdmin)] + expectedFrom = qBob + WS.assertMatch_ (5 # Second) wsA $ + wsAssertConvCreateWithRole qconv expectedFrom expectedSelf expectedOthers + + -- Bob attempts to add unconnected Charlie (possible abuse) + let cu = + FedGalley.ConversationUpdate + { FedGalley.cuTime = now, + FedGalley.cuOrigUserId = qBob, + FedGalley.cuConvId = conv, + FedGalley.cuAlreadyPresentUsers = [alice], + FedGalley.cuAction = + ConversationActionAddMembers (qCharlie :| []) roleNameWireMember + } + -- Alice receives no notifications from this + FedGalley.onConversationUpdated fedGalleyClient remoteDomain cu + WS.assertNoEvent (5 # Second) [wsA] -- | This test invokes the federation endpoint: -- @@ -223,6 +311,7 @@ removeLocalUser = do ConversationActionRemoveMembers (pure qAlice) } + connectWithRemoteUser alice qBob WS.bracketR c alice $ \ws -> do FedGalley.onConversationUpdated fedGalleyClient remoteDomain cuAdd afterAddition <- listRemoteConvs remoteDomain alice @@ -273,6 +362,7 @@ removeRemoteUser = do fedGalleyClient <- view tsFedGalleyClient now <- liftIO getCurrentTime + mapM_ (`connectWithRemoteUser` qBob) [alice, dee] registerRemoteConv qconv qBob (Just "gossip") (Set.fromList [aliceAsOtherMember, deeAsOtherMember, eveAsOtherMember]) let cuRemove user = @@ -320,6 +410,7 @@ notifyUpdate extras action etype edata = do mkMember quid = OtherMember quid Nothing roleNameWireMember fedGalleyClient <- view tsFedGalleyClient + mapM_ (`connectWithRemoteUser` qbob) [alice] registerRemoteConv qconv qbob @@ -431,7 +522,8 @@ addRemoteUser = do fedGalleyClient <- view tsFedGalleyClient now <- liftIO getCurrentTime - let asOtherMember quid = OtherMember quid Nothing roleNameWireMember + mapM_ (flip connectWithRemoteUser qbob . qUnqualified) [qalice, qdee] + registerRemoteConv qconv qbob (Just "gossip") (Set.fromList (map asOtherMember [qalice, qdee, qeve])) -- The conversation owning @@ -440,16 +532,17 @@ addRemoteUser = do { FedGalley.cuTime = now, FedGalley.cuOrigUserId = qbob, FedGalley.cuConvId = qUnqualified qconv, - FedGalley.cuAlreadyPresentUsers = (map qUnqualified [qalice, qcharlie]), + FedGalley.cuAlreadyPresentUsers = map qUnqualified [qalice, qcharlie], FedGalley.cuAction = ConversationActionAddMembers (qdee :| [qeve, qflo]) roleNameWireMember } WS.bracketRN c (map qUnqualified [qalice, qcharlie, qdee, qflo]) $ \[wsA, wsC, wsD, wsF] -> do FedGalley.onConversationUpdated fedGalleyClient bdom cu void . liftIO $ do - WS.assertMatchN_ (5 # Second) [wsA, wsD, wsF] $ - wsAssertMemberJoinWithRole qconv qbob [qeve, qdee, qflo] roleNameWireMember + WS.assertMatchN_ (5 # Second) [wsA, wsD] $ + wsAssertMemberJoinWithRole qconv qbob [qeve, qdee] roleNameWireMember WS.assertNoEvent (1 # Second) [wsC] + WS.assertNoEvent (1 # Second) [wsF] leaveConversationSuccess :: TestM () leaveConversationSuccess = do @@ -463,6 +556,9 @@ leaveConversationSuccess = do qDee <- (`Qualified` remoteDomain1) <$> randomId qEve <- (`Qualified` remoteDomain2) <$> randomId connectUsers alice (singleton bob) + connectWithRemoteUser alice qChad + connectWithRemoteUser alice qDee + connectWithRemoteUser alice qEve opts <- view tsGConf let mockedResponse fedReq = do @@ -535,6 +631,7 @@ onMessageSent = do fedGalleyClient <- view tsFedGalleyClient -- only add alice to the remote conversation + connectWithRemoteUser alice qbob let cu = FedGalley.ConversationUpdate { FedGalley.cuTime = now, @@ -616,6 +713,8 @@ sendMessage = do let chad = Qualified chadId remoteDomain chadProfile = mkProfile chad (Name "Chad") + connectWithRemoteUser aliceId bob + connectWithRemoteUser aliceId chad -- conversation opts <- view tsGConf let responses1 req diff --git a/services/galley/test/integration/API/MessageTimer.hs b/services/galley/test/integration/API/MessageTimer.hs index 87e48a2427c..d7b435cc24a 100644 --- a/services/galley/test/integration/API/MessageTimer.hs +++ b/services/galley/test/integration/API/MessageTimer.hs @@ -149,6 +149,7 @@ messageTimerChangeWithRemotes = do qalice <- Qualified <$> randomId <*> pure remoteDomain qbob <- randomQualifiedUser let bob = qUnqualified qbob + connectWithRemoteUser bob qalice resp <- postConvWithRemoteUsers diff --git a/services/galley/test/integration/API/Roles.hs b/services/galley/test/integration/API/Roles.hs index 3c9be9a35e7..a90682dd957 100644 --- a/services/galley/test/integration/API/Roles.hs +++ b/services/galley/test/integration/API/Roles.hs @@ -167,6 +167,7 @@ roleUpdateRemoteMember = do qcharlie <- Qualified <$> randomId <*> pure remoteDomain let bob = qUnqualified qbob + traverse_ (connectWithRemoteUser bob) [qalice, qcharlie] resp <- postConvWithRemoteUsers remoteDomain @@ -238,6 +239,7 @@ roleUpdateWithRemotes = do charlie = qUnqualified qcharlie connectUsers bob (singleton charlie) + connectWithRemoteUser bob qalice resp <- postConvWithRemoteUsers remoteDomain @@ -298,6 +300,7 @@ accessUpdateWithRemotes = do charlie = qUnqualified qcharlie connectUsers bob (singleton charlie) + connectWithRemoteUser bob qalice resp <- postConvWithRemoteUsers remoteDomain diff --git a/services/galley/test/integration/API/Teams/LegalHold.hs b/services/galley/test/integration/API/Teams/LegalHold.hs index d5b1b2cbb6f..4ba95817758 100644 --- a/services/galley/test/integration/API/Teams/LegalHold.hs +++ b/services/galley/test/integration/API/Teams/LegalHold.hs @@ -31,7 +31,7 @@ import Bilge hiding (accept, head, timeout, trace) import Bilge.Assert import qualified Bilge.TestSession as BilgeTest import Brig.Types.Client -import Brig.Types.Intra (ConnectionStatus (ConnectionStatus), UserSet (..)) +import Brig.Types.Intra (UserSet (..)) import Brig.Types.Provider import Brig.Types.Team.LegalHold hiding (userId) import Brig.Types.Test.Arbitrary () @@ -91,6 +91,7 @@ import Wire.API.Connection (UserConnection) import qualified Wire.API.Connection as Conn import Wire.API.Conversation.Role (roleNameWireAdmin, roleNameWireMember) import qualified Wire.API.Message as Msg +import Wire.API.Routes.Internal.Brig.Connection import qualified Wire.API.Team.Feature as Public import Wire.API.User (UserProfile (..)) import Wire.API.User.Client (UserClients (..), UserClientsFull (userClientsFull)) diff --git a/services/galley/test/integration/API/Util.hs b/services/galley/test/integration/API/Util.hs index dedf01e17a3..92871f49cf1 100644 --- a/services/galley/test/integration/API/Util.hs +++ b/services/galley/test/integration/API/Util.hs @@ -25,7 +25,7 @@ import Bilge hiding (timeout) import Bilge.Assert import Bilge.TestSession import Brig.Types -import Brig.Types.Intra (ConnectionStatus (ConnectionStatus), UserAccount (..), UserSet (..)) +import Brig.Types.Intra (UserAccount (..), UserSet (..)) import Brig.Types.Team.Invitation import Brig.Types.User.Auth (CookieLabel (..)) import Control.Lens hiding (from, to, (#), (.=)) @@ -73,7 +73,7 @@ import Galley.Types import qualified Galley.Types as Conv import Galley.Types.Conversations.Intra (UpsertOne2OneConversationRequest (..)) import Galley.Types.Conversations.Roles hiding (DeleteConversation) -import Galley.Types.Teams hiding (Event, EventType (..)) +import Galley.Types.Teams hiding (Event, EventType (..), self) import qualified Galley.Types.Teams as Team import Galley.Types.Teams.Intra import Gundeck.Types.Notification @@ -108,7 +108,7 @@ import Web.Cookie import Wire.API.Conversation import qualified Wire.API.Conversation as Public import Wire.API.Conversation.Action -import Wire.API.Event.Conversation (_EdMembersJoin, _EdMembersLeave) +import Wire.API.Event.Conversation (_EdConversation, _EdMembersJoin, _EdMembersLeave) import qualified Wire.API.Event.Team as TE import qualified Wire.API.Federation.API.Brig as FederatedBrig import qualified Wire.API.Federation.API.Galley as FederatedGalley @@ -118,6 +118,7 @@ import qualified Wire.API.Federation.GRPC.Types as F import qualified Wire.API.Federation.Mock as Mock import Wire.API.Message import qualified Wire.API.Message.Proto as Proto +import Wire.API.Routes.Internal.Brig.Connection import Wire.API.Routes.MultiTablePaging import Wire.API.User.Client (ClientCapability (..), UserClientsFull (UserClientsFull)) import qualified Wire.API.User.Client as Client @@ -548,7 +549,7 @@ defNewConv :: NewConv defNewConv = NewConv [] [] Nothing mempty Nothing Nothing Nothing Nothing roleNameWireAdmin postConvQualified :: - (HasGalley m, MonadIO m, MonadMask m, MonadHttp m) => + (HasCallStack, HasGalley m, MonadIO m, MonadMask m, MonadHttp m) => UserId -> NewConv -> m ResponseLBS @@ -1235,6 +1236,9 @@ getTeamQueue' zusr msince msize onlyLast = do ] ) +asOtherMember :: Qualified UserId -> OtherMember +asOtherMember quid = OtherMember quid Nothing roleNameWireMember + registerRemoteConv :: Qualified ConvId -> Qualified UserId -> Maybe Text -> Set OtherMember -> TestM () registerRemoteConv convId originUser name othMembers = do fedGalleyClient <- view tsFedGalleyClient @@ -1568,6 +1572,25 @@ connectUsersWith fn u = mapM connectTo ) return (r1, r2) +connectWithRemoteUser :: + (MonadReader TestSetup m, MonadIO m, MonadHttp m, MonadCatch m, HasCallStack) => + UserId -> + Qualified UserId -> + m () +connectWithRemoteUser self other = do + let req = CreateConnectionForTest self other + b <- view tsBrig + put + ( b + . zUser self + . contentJson + . zConn "conn" + . paths ["i", "connections", "connection-update"] + . json req + ) + !!! const 200 + === statusCode + -- | A copy of 'postConnection' from Brig integration tests. postConnection :: UserId -> UserId -> TestM ResponseLBS postConnection from to = do @@ -1584,6 +1607,16 @@ postConnection from to = do RequestBodyLBS . encode $ ConnectionRequest to (unsafeRange "some conv name") +postConnectionQualified :: UserId -> Qualified UserId -> TestM ResponseLBS +postConnectionQualified from (Qualified toUser toDomain) = do + brig <- view tsBrig + post $ + brig + . paths ["/connections", toByteString' toDomain, toByteString' toUser] + . contentJson + . zUser from + . zConn "conn" + -- | A copy of 'putConnection' from Brig integration tests. putConnection :: UserId -> UserId -> Relation -> TestM ResponseLBS putConnection from to r = do @@ -1635,6 +1668,11 @@ assertConnections u cstat = do randomUsers :: Int -> TestM [UserId] randomUsers n = replicateM n randomUser +randomUserTuple :: HasCallStack => TestM (UserId, Qualified UserId) +randomUserTuple = do + qUid <- randomQualifiedUser + pure (qUnqualified qUid, qUid) + randomUser :: HasCallStack => TestM UserId randomUser = qUnqualified <$> randomUser' False True True @@ -2294,6 +2332,18 @@ checkConvCreateEvent cid w = WS.assertMatch_ checkTimeout w $ \notif -> do Conv.EdConversation x -> (qUnqualified . cnvQualifiedId) x @?= cid other -> assertFailure $ "Unexpected event data: " <> show other +wsAssertConvCreateWithRole :: HasCallStack => Qualified ConvId -> Qualified UserId -> UserId -> [(Qualified UserId, RoleName)] -> Notification -> IO () +wsAssertConvCreateWithRole conv eventFrom selfMember otherMembers n = do + let e = List1.head (WS.unpackPayload n) + ntfTransient n @?= False + evtConv e @?= conv + evtType e @?= Conv.ConvCreate + evtFrom e @?= eventFrom + fmap (memId . cmSelf . cnvMembers) (evtData e ^? _EdConversation) @?= Just selfMember + fmap (sort . cmOthers . cnvMembers) (evtData e ^? _EdConversation) @?= Just (sort (toOtherMember <$> otherMembers)) + where + toOtherMember (quid, role) = OtherMember quid Nothing role + checkTeamDeleteEvent :: HasCallStack => TeamId -> WS.WebSocket -> TestM () checkTeamDeleteEvent tid w = WS.assertMatch_ checkTimeout w $ \notif -> do ntfTransient notif @?= False diff --git a/tools/stern/src/Stern/Intra.hs b/tools/stern/src/Stern/Intra.hs index 86adc975301..e930aa76e03 100644 --- a/tools/stern/src/Stern/Intra.hs +++ b/tools/stern/src/Stern/Intra.hs @@ -96,6 +96,7 @@ import Stern.Types import System.Logger.Class hiding (Error, name, (.=)) import qualified System.Logger.Class as Log import UnliftIO.Exception hiding (Handler) +import Wire.API.Routes.Internal.Brig.Connection import qualified Wire.API.Routes.Internal.Brig.EJPD as EJPD import qualified Wire.API.Team.Feature as Public @@ -171,20 +172,19 @@ getUsersConnections :: List UserId -> Handler [ConnectionStatus] getUsersConnections uids = do info $ msg "Getting user connections" b <- view brig + let reqBody = ConnectionsStatusRequest (fromList uids) Nothing r <- catchRpcErrors $ rpc' "brig" b - ( method GET + ( method POST . path "/i/users/connections-status" - . queryItem "users" users + . Bilge.json reqBody . expect2xx ) info $ msg ("Response" ++ show r) parseResponse (mkError status502 "bad-upstream") r - where - users = BS.intercalate "," $ map toByteString' (fromList uids) getUserProfiles :: Either [UserId] [Handle] -> Handler [UserAccount] getUserProfiles uidsOrHandles = do