diff --git a/changelog.d/6-federation/update-one2ones b/changelog.d/6-federation/update-one2ones new file mode 100644 index 0000000000..1d19a087c9 --- /dev/null +++ b/changelog.d/6-federation/update-one2ones @@ -0,0 +1 @@ +Update One2One conversation when connection status changes diff --git a/libs/galley-types/galley-types.cabal b/libs/galley-types/galley-types.cabal index 8af1c5e5f5..60a176f4a1 100644 --- a/libs/galley-types/galley-types.cabal +++ b/libs/galley-types/galley-types.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: d7419acbff460382bb822952b693f55513e729a4e3bcd0ddfdeea9e5285a805b +-- hash: ccecf8384a3050034fc05928ae9bd039006f4479289f73de11832052791a691f name: galley-types version: 0.81.0 @@ -24,6 +24,7 @@ library Galley.Types.Bot.Service Galley.Types.Conversations.Intra Galley.Types.Conversations.Members + Galley.Types.Conversations.One2One Galley.Types.Conversations.Roles Galley.Types.Teams Galley.Types.Teams.Intra @@ -38,17 +39,23 @@ library QuickCheck , aeson >=0.6 , base >=4 && <5 + , bytestring + , bytestring-conversion , containers >=0.5 + , cryptonite , currency-codes >=2.0 + , errors , exceptions >=0.10.0 , imports , lens >=4.12 + , memory , schema-profunctor , string-conversions , tagged , text >=0.11 , time >=1.4 , types-common >=0.16 + , uuid , wire-api default-language: Haskell2010 diff --git a/libs/galley-types/package.yaml b/libs/galley-types/package.yaml index 3d84f4036e..d692a08ae4 100644 --- a/libs/galley-types/package.yaml +++ b/libs/galley-types/package.yaml @@ -16,10 +16,15 @@ library: dependencies: - aeson >=0.6 - base >=4 && <5 + - bytestring + - bytestring-conversion - containers >=0.5 + - cryptonite - currency-codes >=2.0 + - errors - exceptions >=0.10.0 - lens >=4.12 + - memory - QuickCheck - schema-profunctor - string-conversions @@ -27,6 +32,7 @@ library: - text >=0.11 - time >=1.4 - types-common >=0.16 + - uuid tests: galley-types-tests: main: Main.hs diff --git a/libs/galley-types/src/Galley/Types/Conversations/One2One.hs b/libs/galley-types/src/Galley/Types/Conversations/One2One.hs new file mode 100644 index 0000000000..bc608b70da --- /dev/null +++ b/libs/galley-types/src/Galley/Types/Conversations/One2One.hs @@ -0,0 +1,116 @@ +-- 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 Galley.Types.Conversations.One2One (one2OneConvId) where + +import Control.Error (atMay) +import qualified Crypto.Hash as Crypto +import Data.Bits +import Data.ByteArray (convert) +import qualified Data.ByteString as B +import Data.ByteString.Conversion +import qualified Data.ByteString.Lazy as L +import Data.Id +import Data.Qualified +import Data.UUID (UUID) +import qualified Data.UUID as UUID +import qualified Data.UUID.Tagged as U +import Imports + +-- | The hash function used to obtain the 1-1 conversation ID for a pair of users. +-- +-- /Note/: the hash function must always return byte strings of length > 16. +hash :: ByteString -> ByteString +hash = convert . Crypto.hash @ByteString @Crypto.SHA256 + +-- | A randomly-generated UUID to use as a namespace for the UUIDv5 of 1-1 +-- conversation IDs +namespace :: UUID +namespace = UUID.fromWords 0x9a51edb8 0x060c0d9a 0x0c2950a8 0x5d152982 + +compareDomains :: Ord a => Qualified a -> Qualified a -> Ordering +compareDomains (Qualified a1 dom1) (Qualified a2 dom2) = + compare (dom1, a1) (dom2, a2) + +quidToByteString :: Qualified UserId -> ByteString +quidToByteString (Qualified uid domain) = toByteString' uid <> toByteString' domain + +-- | This function returns the 1-1 conversation for a given pair of users. +-- +-- Let A, B denote the (not necessarily distinct) backends of the two users, +-- with the domain of A less or equal than the domain of B in the lexicographic +-- ordering of their ascii encodings. Given users a@A and b@B, the UUID and +-- owning domain of the unique 1-1 conversation between a and b shall be a +-- deterministic function of the input data, plus some fixed parameters, as +-- described below. +-- +-- __Parameters__ +-- +-- * A (collision-resistant) hash function h with N bits of output, where N +-- s a multiple of 8 strictly larger than 128; this is set to SHA256. +-- * A "namespace" UUID n. +-- +-- __Algorithm__ +-- +-- First, in the special case where A and B are the same backend, assume that +-- the UUID of a is lower than that of b. If that is not the case, swap a +-- and b in the following. This is necessary to ensure that the function we +-- describe below is symmetric in its arguments. +-- Let c be the bytestring obtained as the concatenation of the following 5 +-- components: +-- +-- * the 16 bytes of the namespace n +-- * the 16 bytes of the UUID of a +-- * the ascii encoding of the domain of A +-- * the 16 bytes of the UUID of b +-- * the ascii encoding of the domain of B, +-- +-- and let x = h(c) be its hashed value. The UUID of the 1-1 conversation +-- between a and b is obtained by converting the first 128 bits of x to a UUID +-- V5. Note that our use of V5 here is not strictly compliant with RFC 4122, +-- since we are using a custom hash and not necessarily SHA1. +-- +-- The owning domain for the conversation is set to be A if bit 128 of x (i.e. +-- the most significant bit of the octet at index 16) is 0, and B otherwise. +-- This is well-defined, because we assumed the number of bits of x to be +-- strictly larger than 128. +one2OneConvId :: Qualified UserId -> Qualified UserId -> Qualified ConvId +one2OneConvId a b = case compareDomains a b of + GT -> one2OneConvId b a + _ -> + let c = + mconcat + [ L.toStrict (UUID.toByteString namespace), + quidToByteString a, + quidToByteString b + ] + x = hash c + result = + U.toUUID . U.mk @U.V5 + . fromMaybe UUID.nil + -- fromByteString only returns 'Nothing' when the input is not + -- exactly 16 bytes long, here this should not be a case since + -- 'hash' is supposed to return atleast 16 bytes and we use 'B.take + -- 16' to truncate it + . UUID.fromByteString + . L.fromStrict + . B.take 16 + $ x + domain + | fromMaybe 0 (atMay (B.unpack x) 16) .&. 0x80 == 0 = qDomain a + | otherwise = qDomain b + in Qualified (Id result) domain diff --git a/services/brig/src/Brig/API/Connection/Remote.hs b/services/brig/src/Brig/API/Connection/Remote.hs index 387b04c617..be1c64ecfe 100644 --- a/services/brig/src/Brig/API/Connection/Remote.hs +++ b/services/brig/src/Brig/API/Connection/Remote.hs @@ -36,7 +36,7 @@ import Control.Error.Util ((??)) import Control.Monad.Trans.Except (runExceptT, throwE) import Data.Id as Id import Data.Qualified -import Data.UUID.V4 +import Galley.Types.Conversations.Intra (Actor (..), DesiredMembership (..), UpsertOne2OneConversationRequest (..), UpsertOne2OneConversationResponse (uuorConvId)) import Imports import Network.Wai.Utilities.Error import Wire.API.Connection (relationWithHistory) @@ -107,11 +107,32 @@ updateOne2OneConv :: Remote UserId -> Maybe (Qualified ConvId) -> Relation -> + Actor -> AppIO (Qualified ConvId) -updateOne2OneConv _ _ _ _ _ = do - -- FUTUREWORK: use galley internal API to update 1-1 conversation and retrieve ID - uid <- liftIO nextRandom - qUntagged <$> qualifyLocal (Id uid) +updateOne2OneConv lUsr _mbConn remoteUser mbConvId rel actor = do + let request = + UpsertOne2OneConversationRequest + { uooLocalUser = lUsr, + uooRemoteUser = remoteUser, + uooActor = actor, + uooActorDesiredMembership = desiredMembership actor rel, + uooConvId = mbConvId + } + uuorConvId <$> Intra.upsertOne2OneConversation request + where + desiredMembership :: Actor -> Relation -> DesiredMembership + desiredMembership a r = + let isIncluded = + a + `elem` case r of + Accepted -> [LocalActor, RemoteActor] + Blocked -> [] + Pending -> [RemoteActor] + Ignored -> [RemoteActor] + Sent -> [LocalActor] + Cancelled -> [] + MissingLegalholdConsent -> [] + in if isIncluded then Included else Excluded -- | Perform a state transition on a connection, handle conversation updates and -- push events. @@ -126,14 +147,15 @@ transitionTo :: Remote UserId -> Maybe UserConnection -> Maybe Relation -> + Actor -> ConnectionM (ResponseForExistedCreated UserConnection, Bool) -transitionTo self _ _ Nothing Nothing = +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 (tUnqualified self)) -transitionTo self mzcon other Nothing (Just rel) = lift $ do +transitionTo self mzcon other Nothing (Just rel) actor = lift $ do -- update 1-1 connection - qcnv <- updateOne2OneConv self mzcon other Nothing rel + qcnv <- updateOne2OneConv self mzcon other Nothing rel actor -- create connection connection <- @@ -146,10 +168,10 @@ transitionTo self mzcon other Nothing (Just rel) = lift $ do -- 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 +transitionTo _self _zcon _other (Just connection) Nothing _actor = pure (Existed connection, False) +transitionTo self mzcon other (Just connection) (Just rel) actor = lift $ do -- update 1-1 conversation - void $ updateOne2OneConv self Nothing other (ucConvId connection) rel + void $ updateOne2OneConv self Nothing other (ucConvId connection) rel actor -- update connection connection' <- Data.updateConnection connection (relationWithHistory rel) @@ -184,7 +206,7 @@ performLocalAction self mzcon other mconnection action = do fromMaybe rel1 $ do reactionAction <- (mreaction :: Maybe RemoteConnectionAction) transition (RCA reactionAction) rel1 - transitionTo self mzcon other mconnection mrel2 + transitionTo self mzcon other mconnection mrel2 LocalActor where remoteAction :: LocalConnectionAction -> Maybe RemoteConnectionAction remoteAction LocalConnect = Just RemoteConnect @@ -220,7 +242,7 @@ performRemoteAction :: 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 + result <- runExceptT . void $ transitionTo self Nothing other mconnection rel1 RemoteActor pure $ either (const (Just RemoteRescind)) (const (reaction rel1)) result where reaction :: Maybe Relation -> Maybe RemoteConnectionAction diff --git a/services/brig/test/integration/API/User.hs b/services/brig/test/integration/API/User.hs index 0f9fcea946..8d3a357312 100644 --- a/services/brig/test/integration/API/User.hs +++ b/services/brig/test/integration/API/User.hs @@ -41,8 +41,8 @@ import Test.Tasty hiding (Timeout) import Util import Util.Options.Common -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 +tests :: Opt.Opts -> FedBrigClient -> FedGalleyClient -> Manager -> Brig -> Cannon -> CargoHold -> Galley -> Nginz -> AWS.Env -> DB.ClientState -> IO TestTree +tests conf fbc fgc 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 fbc 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 fbc db, + API.User.Connection.tests cl at conf p b c g fbc fgc 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 480b0dc558..b5b6346111 100644 --- a/services/brig/test/integration/API/User/Connection.hs +++ b/services/brig/test/integration/API/User/Connection.hs @@ -46,10 +46,12 @@ import Test.Tasty.HUnit import Util 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.MultiTablePaging -tests :: ConnectionLimit -> Opt.Timeout -> Opt.Opts -> Manager -> Brig -> Cannon -> Galley -> FedBrigClient -> DB.ClientState -> TestTree -tests cl _at opts p b _c g fedBrigClient db = +tests :: ConnectionLimit -> Opt.Timeout -> Opt.Opts -> Manager -> Brig -> Cannon -> Galley -> FedBrigClient -> FedGalleyClient -> DB.ClientState -> TestTree +tests cl _at opts p b _c g fedBrigClient fedGalleyClient db = testGroup "connection" [ test p "post /connections" $ testCreateManualConnections b, @@ -83,15 +85,15 @@ tests cl _at opts p b _c g fedBrigClient 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 "Remote connections: connect with no federation" (testConnectFederationNotAvailable b), - test p "Remote connections: connect OK" (testConnectOK b fedBrigClient), + test p "Remote connections: connect OK" (testConnectOK b g fedBrigClient), test p "Remote connections: connect with Anon" (testConnectWithAnon b fedBrigClient), test p "Remote connections: connection from Anon" (testConnectFromAnon b), - test p "Remote connections: mutual Connect - local action then remote action" (testConnectMutualLocalActionThenRemoteAction opts b fedBrigClient), - test p "Remote connections: mutual Connect - remote action then local action" (testConnectMutualRemoteActionThenLocalAction opts b fedBrigClient), + test p "Remote connections: mutual Connect - local action then remote action" (testConnectMutualLocalActionThenRemoteAction opts b g fedBrigClient), + test p "Remote connections: mutual Connect - remote action then local action" (testConnectMutualRemoteActionThenLocalAction opts b fedBrigClient fedGalleyClient), test p "Remote connections: connect twice" (testConnectFromPending b fedBrigClient), test p "Remote connections: ignore then accept" (testConnectFromIgnored opts b fedBrigClient), test p "Remote connections: ignore, remote cancels, then accept" (testSentFromIgnored opts b fedBrigClient), - test p "Remote connections: block then accept" (testConnectFromBlocked opts b fedBrigClient), + test p "Remote connections: block then accept" (testConnectFromBlocked opts b g fedBrigClient), test p "Remote connections: block, remote cancels, then accept" (testSentFromBlocked opts b fedBrigClient), test p "Remote connections: send then cancel" (testCancel opts b), test p "Remote connections: limits" (testConnectionLimits opts b fedBrigClient) @@ -710,11 +712,16 @@ testConnectFederationNotAvailable brig = do postConnectionQualified brig uid1 quid2 !!! const 422 === statusCode -testConnectOK :: Brig -> FedBrigClient -> Http () -testConnectOK brig fedBrigClient = do - (uid1, quid2) <- localAndRemoteUser brig +testConnectOK :: Brig -> Galley -> FedBrigClient -> Http () +testConnectOK brig galley fedBrigClient = do + let convIsLocal = True + (uid1, quid2, convId) <- localAndRemoteUserWithConvId brig convIsLocal receiveConnectionAction brig fedBrigClient uid1 quid2 F.RemoteConnect Nothing Pending + -- The conversation exists uid1 is not a participant however + getConversationQualified galley uid1 convId + !!! statusCode === const 403 + testConnectWithAnon :: Brig -> FedBrigClient -> Http () testConnectWithAnon brig fedBrigClient = do fromUser <- randomId @@ -729,26 +736,54 @@ testConnectFromAnon brig = do remoteUser <- fakeRemoteUser postConnectionQualified brig anonUser remoteUser !!! const 403 === statusCode -testConnectMutualLocalActionThenRemoteAction :: Opt.Opts -> Brig -> FedBrigClient -> Http () -testConnectMutualLocalActionThenRemoteAction opts brig fedBrigClient = do - (uid1, quid2) <- localAndRemoteUser brig +testConnectMutualLocalActionThenRemoteAction :: Opt.Opts -> Brig -> Galley -> FedBrigClient -> Http () +testConnectMutualLocalActionThenRemoteAction opts brig galley fedBrigClient = do + let convIsLocal = True + (uid1, quid2, convId) <- localAndRemoteUserWithConvId brig convIsLocal -- First create a connection request from local to remote user, as this test -- aims to test the behaviour of recieving a mutual request from remote sendConnectionAction brig opts uid1 quid2 Nothing Sent + do + res <- + getConversationQualified galley uid1 convId Brig -> FedBrigClient -> Http () -testConnectMutualRemoteActionThenLocalAction opts brig fedBrigClient = do - (uid1, quid2) <- localAndRemoteUser brig + do + res <- + getConversationQualified galley uid1 convId Brig -> FedBrigClient -> FedGalleyClient -> Http () +testConnectMutualRemoteActionThenLocalAction opts brig fedBrigClient fedGalleyClient = do + let convIsLocal = True + (uid1, quid2, convId) <- localAndRemoteUserWithConvId brig convIsLocal -- First create a connection request from remote to local user, as this test -- aims to test the behaviour of sending a mutual request to remote receiveConnectionAction brig fedBrigClient uid1 quid2 F.RemoteConnect Nothing Pending + let request = + GetConversationsRequest + { gcrUserId = qUnqualified quid2, + gcrConvIds = [qUnqualified convId] + } + + res <- F.getConversations fedGalleyClient (qDomain quid2) request + liftIO $ + fmap (fmap omQualifiedId . rcmOthers . rcnvMembers) (gcresConvs res) @?= [[]] + -- 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 @@ -790,15 +825,19 @@ testSentFromIgnored opts brig fedBrigClient = do -- 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 +testConnectFromBlocked :: Opt.Opts -> Brig -> Galley -> FedBrigClient -> Http () +testConnectFromBlocked opts brig galley fedBrigClient = do + let convIsLocal = True + (uid1, quid2, convId) <- localAndRemoteUserWithConvId brig convIsLocal -- set up an initial 'Blocked' state receiveConnectionAction brig fedBrigClient uid1 quid2 F.RemoteConnect Nothing Pending putConnectionQualified brig uid1 quid2 Blocked !!! statusCode === const 200 assertConnectionQualified brig uid1 quid2 Blocked + getConversationQualified galley uid1 convId + !!! statusCode === const 403 + -- if the remote side sends a new connection request, we ignore it receiveConnectionAction brig fedBrigClient uid1 quid2 F.RemoteConnect Nothing Blocked @@ -806,6 +845,14 @@ testConnectFromBlocked opts brig fedBrigClient = do -- wants to connect, we transition to 'Accepted' sendConnectionAction brig opts uid1 quid2 (Just F.RemoteConnect) Accepted + do + res <- + getConversationQualified galley uid1 convId Brig -> FedBrigClient -> Http () testSentFromBlocked opts brig fedBrigClient = do (uid1, quid2) <- localAndRemoteUser brig diff --git a/services/brig/test/integration/Main.hs b/services/brig/test/integration/Main.hs index 75906db35c..d0423fe8ce 100644 --- a/services/brig/test/integration/Main.hs +++ b/services/brig/test/integration/Main.hs @@ -50,16 +50,21 @@ import Network.HTTP.Client.TLS (tlsManagerSettings) import Network.Wai.Utilities.Server (compile) import OpenSSL (withOpenSSL) import Options.Applicative hiding (action) +import Servant.API.Generic (GenericServant, ToServant, ToServantApi) +import Servant.Client (HasClient) import qualified Servant.Client as Servant +import Servant.Client.Generic (AsClientT) import qualified Servant.Client.Generic as Servant import System.Environment (withArgs) import qualified System.Environment.Blank as Blank import qualified System.Logger as Logger import Test.Tasty import Test.Tasty.HUnit -import Util (FedBrigClient) +import Util (FedBrigClient, FedGalleyClient) import Util.Options import Util.Test +import qualified Wire.API.Federation.API.Brig as FedBrig +import qualified Wire.API.Federation.API.Galley as FedGalley data BackendConf = BackendConf { remoteBrig :: Endpoint, @@ -120,9 +125,10 @@ runTests iConf brigOpts otherArgs = do db <- defInitCassandra casKey casHost casPort lg mg <- newManager tlsManagerSettings let fedBrigClient = mkFedBrigClient mg (brig iConf) + let fedGalleyClient = mkFedGalleyClient mg (galley iConf) emailAWSOpts <- parseEmailAWSOpts awsEnv <- AWS.mkEnv lg awsOpts emailAWSOpts mg - userApi <- User.tests brigOpts fedBrigClient mg b c ch g n awsEnv db + userApi <- User.tests brigOpts fedBrigClient fedGalleyClient 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 @@ -214,12 +220,26 @@ parseConfigPaths = do ) mkFedBrigClient :: Manager -> Endpoint -> FedBrigClient -mkFedBrigClient mgr brigEndpoint = Servant.genericClientHoist servantClienMToHttp +mkFedBrigClient = mkFedBrigClientGen @FedBrig.Api + +mkFedGalleyClient :: Manager -> Endpoint -> FedGalleyClient +mkFedGalleyClient = mkFedBrigClientGen @FedGalley.Api + +mkFedBrigClientGen :: + forall routes. + ( HasClient Servant.ClientM (ToServantApi routes), + GenericServant routes (AsClientT (HttpT IO)), + Servant.Client (HttpT IO) (ToServantApi routes) ~ ToServant routes (AsClientT (HttpT IO)) + ) => + Manager -> + Endpoint -> + routes (AsClientT (HttpT IO)) +mkFedBrigClientGen mgr endpoint = Servant.genericClientHoist servantClienMToHttp where servantClienMToHttp :: Servant.ClientM a -> Http a servantClienMToHttp action = liftIO $ do - let brigHost = Text.unpack $ brigEndpoint ^. epHost - brigPort = fromInteger . toInteger $ brigEndpoint ^. epPort + let brigHost = Text.unpack $ endpoint ^. epHost + brigPort = fromInteger . toInteger $ endpoint ^. epPort baseUrl = Servant.BaseUrl Servant.Http brigHost brigPort "" clientEnv = Servant.ClientEnv mgr baseUrl Nothing Servant.defaultMakeClientRequest eitherRes <- Servant.runClientM action clientEnv diff --git a/services/brig/test/integration/Util.hs b/services/brig/test/integration/Util.hs index 06cdfa598d..c23223a0bb 100644 --- a/services/brig/test/integration/Util.hs +++ b/services/brig/test/integration/Util.hs @@ -60,6 +60,7 @@ import qualified Data.Text.Ascii as Ascii import Data.Text.Encoding (encodeUtf8) import qualified Data.UUID as UUID import qualified Data.UUID.V4 as UUID +import Galley.Types.Conversations.One2One (one2OneConvId) import qualified Galley.Types.Teams as Team import Gundeck.Types.Notification import Imports @@ -75,6 +76,7 @@ import Util.AWS import Wire.API.Conversation import Wire.API.Conversation.Role (roleNameWireAdmin) import qualified Wire.API.Federation.API.Brig as FedBrig +import qualified Wire.API.Federation.API.Galley as FedGalley import Wire.API.Routes.MultiTablePaging type Brig = Request -> Request @@ -93,6 +95,8 @@ type Spar = Request -> Request type FedBrigClient = FedBrig.Api (AsClientT (HttpT IO)) +type FedGalleyClient = FedGalley.Api (AsClientT (HttpT IO)) + instance ToJSON SESBounceType where toJSON BounceUndetermined = String "Undetermined" toJSON BouncePermanent = String "Permanent" @@ -140,6 +144,22 @@ localAndRemoteUser brig = do quid2 <- fakeRemoteUser pure (uid1, quid2) +localAndRemoteUserWithConvId :: + (MonadCatch m, MonadIO m, MonadHttp m, HasCallStack) => + Brig -> + Bool -> + m (UserId, Qualified UserId, Qualified ConvId) +localAndRemoteUserWithConvId brig shouldBeLocal = do + quid <- userQualifiedId <$> randomUser brig + let go = do + other <- Qualified <$> randomId <*> pure (Domain "far-away.example.com") + let convId = one2OneConvId quid other + isLocal = qDomain quid == qDomain convId + if shouldBeLocal == isLocal + then pure (qUnqualified quid, other, convId) + else go + go + fakeRemoteUser :: (HasCallStack, MonadIO m) => m (Qualified UserId) fakeRemoteUser = Qualified <$> randomId <*> pure (Domain "far-away.example.com") diff --git a/services/galley/src/Galley/API/One2One.hs b/services/galley/src/Galley/API/One2One.hs index fa9de3f254..d3bd30396a 100644 --- a/services/galley/src/Galley/API/One2One.hs +++ b/services/galley/src/Galley/API/One2One.hs @@ -22,108 +22,15 @@ module Galley.API.One2One ) where -import Control.Error (atMay) -import qualified Crypto.Hash as Crypto -import Data.Bits -import Data.ByteArray (convert) -import qualified Data.ByteString as B -import Data.ByteString.Conversion -import qualified Data.ByteString.Lazy as L import Data.Id import Data.Qualified -import Data.UUID (UUID) -import qualified Data.UUID as UUID -import qualified Data.UUID.Tagged as U import Galley.App (Galley) import qualified Galley.Data as Data import Galley.Types.Conversations.Intra (Actor (..), DesiredMembership (..), UpsertOne2OneConversationRequest (..), UpsertOne2OneConversationResponse (..)) +import Galley.Types.Conversations.One2One (one2OneConvId) import Galley.Types.UserList (UserList (..)) import Imports --- | The hash function used to obtain the 1-1 conversation ID for a pair of users. --- --- /Note/: the hash function must always return byte strings of length > 16. -hash :: ByteString -> ByteString -hash = convert . Crypto.hash @ByteString @Crypto.SHA256 - --- | A randomly-generated UUID to use as a namespace for the UUIDv5 of 1-1 --- conversation IDs -namespace :: UUID -namespace = UUID.fromWords 0x9a51edb8 0x060c0d9a 0x0c2950a8 0x5d152982 - -compareDomains :: Ord a => Qualified a -> Qualified a -> Ordering -compareDomains (Qualified a1 dom1) (Qualified a2 dom2) = - compare (dom1, a1) (dom2, a2) - -quidToByteString :: Qualified UserId -> ByteString -quidToByteString (Qualified uid domain) = toByteString' uid <> toByteString' domain - --- | This function returns the 1-1 conversation for a given pair of users. --- --- Let A, B denote the (not necessarily distinct) backends of the two users, --- with the domain of A less or equal than the domain of B in the lexicographic --- ordering of their ascii encodings. Given users a@A and b@B, the UUID and --- owning domain of the unique 1-1 conversation between a and b shall be a --- deterministic function of the input data, plus some fixed parameters, as --- described below. --- --- __Parameters__ --- --- * A (collision-resistant) hash function h with N bits of output, where N --- s a multiple of 8 strictly larger than 128; this is set to SHA256. --- * A "namespace" UUID n. --- --- __Algorithm__ --- --- First, in the special case where A and B are the same backend, assume that --- the UUID of a is lower than that of b. If that is not the case, swap a --- and b in the following. This is necessary to ensure that the function we --- describe below is symmetric in its arguments. --- Let c be the bytestring obtained as the concatenation of the following 5 --- components: --- --- * the 16 bytes of the namespace n --- * the 16 bytes of the UUID of a --- * the ascii encoding of the domain of A --- * the 16 bytes of the UUID of b --- * the ascii encoding of the domain of B, --- --- and let x = h(c) be its hashed value. The UUID of the 1-1 conversation --- between a and b is obtained by converting the first 128 bits of x to a UUID --- V5. Note that our use of V5 here is not strictly compliant with RFC 4122, --- since we are using a custom hash and not necessarily SHA1. --- --- The owning domain for the conversation is set to be A if bit 128 of x (i.e. --- the most significant bit of the octet at index 16) is 0, and B otherwise. --- This is well-defined, because we assumed the number of bits of x to be --- strictly larger than 128. -one2OneConvId :: Qualified UserId -> Qualified UserId -> Qualified ConvId -one2OneConvId a b = case compareDomains a b of - GT -> one2OneConvId b a - _ -> - let c = - mconcat - [ L.toStrict (UUID.toByteString namespace), - quidToByteString a, - quidToByteString b - ] - x = hash c - result = - U.toUUID . U.mk @U.V5 - . fromMaybe UUID.nil - -- fromByteString only returns 'Nothing' when the input is not - -- exactly 16 bytes long, here this should not be a case since - -- 'hash' is supposed to return atleast 16 bytes and we use 'B.take - -- 16' to truncate it - . UUID.fromByteString - . L.fromStrict - . B.take 16 - $ x - domain - | fromMaybe 0 (atMay (B.unpack x) 16) .&. 0x80 == 0 = qDomain a - | otherwise = qDomain b - in Qualified (Id result) domain - iUpsertOne2OneConversation :: UpsertOne2OneConversationRequest -> Galley UpsertOne2OneConversationResponse iUpsertOne2OneConversation UpsertOne2OneConversationRequest {..} = do let convId = fromMaybe (one2OneConvId (qUntagged uooLocalUser) (qUntagged uooRemoteUser)) uooConvId