From f55ce93af89fc61427b7f25008c42d3d920ef5e3 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Fri, 9 Jun 2023 10:06:11 +0200 Subject: [PATCH 1/7] One2One GET endpoint stub --- .../Wire/API/Routes/Public/Galley/Conversation.hs | 10 ++++++++++ .../galley/src/Galley/API/Public/Conversation.hs | 1 + services/galley/src/Galley/API/Query.hs | 15 +++++++++++++++ 3 files changed, 26 insertions(+) diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Galley/Conversation.hs b/libs/wire-api/src/Wire/API/Routes/Public/Galley/Conversation.hs index a1f9254b62a..8de9bedf801 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Galley/Conversation.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Galley/Conversation.hs @@ -588,6 +588,16 @@ type ConversationAPI = :> ReqBody '[JSON] NewConv :> ConversationVerb ) + :<|> Named + "get-one-to-one-mls-conversation" + ( Summary "Get an MLS 1:1 conversation" + :> ZLocalUser + :> CanThrow 'MLSNotEnabled + :> "conversations" + :> "one2one" + :> QualifiedCapture "usr" UserId + :> MultiVerb1 'GET '[JSON] (Respond 200 "MLS 1-1 conversation" Conversation) + ) -- This endpoint can lead to the following events being sent: -- - MemberJoin event to members :<|> Named diff --git a/services/galley/src/Galley/API/Public/Conversation.hs b/services/galley/src/Galley/API/Public/Conversation.hs index 070d996823d..6341091e356 100644 --- a/services/galley/src/Galley/API/Public/Conversation.hs +++ b/services/galley/src/Galley/API/Public/Conversation.hs @@ -57,6 +57,7 @@ conversationAPI = <@> mkNamedAPI @"get-subconversation-group-info" (callsFed getSubConversationGroupInfo) <@> mkNamedAPI @"create-one-to-one-conversation@v2" (callsFed createOne2OneConversation) <@> mkNamedAPI @"create-one-to-one-conversation" (callsFed createOne2OneConversation) + <@> mkNamedAPI @"get-one-to-one-mls-conversation" getMLSOne2OneConversation <@> mkNamedAPI @"add-members-to-conversation-unqualified" (callsFed addMembersUnqualified) <@> mkNamedAPI @"add-members-to-conversation-unqualified2" (callsFed addMembersUnqualifiedV2) <@> mkNamedAPI @"add-members-to-conversation" (callsFed addMembers) diff --git a/services/galley/src/Galley/API/Query.hs b/services/galley/src/Galley/API/Query.hs index 43f2d4399ca..0e8fa9edfc4 100644 --- a/services/galley/src/Galley/API/Query.hs +++ b/services/galley/src/Galley/API/Query.hs @@ -37,6 +37,7 @@ module Galley.API.Query ensureConvAdmin, getMLSSelfConversation, getMLSSelfConversationWithError, + getMLSOne2OneConversation, ) where @@ -734,6 +735,20 @@ getMLSSelfConversation lusr = do cnv <- maybe (E.createMLSSelfConversation lusr) pure mconv conversationView lusr cnv +-- | Get an MLS 1-1 conversation. The conversation object is created on the +-- fly, but not persisted. The conversation will only be stored in the database +-- when its first commit arrives. +getMLSOne2OneConversation :: + ( Member (Input Env) r, + Member (ErrorS 'MLSNotEnabled) r + ) => + Local UserId -> + Qualified UserId -> + Sem r Conversation +getMLSOne2OneConversation _lusr _qtarget = do + assertMLSEnabled + pure (error "TODO") + ------------------------------------------------------------------------------- -- Helpers From b4b597349d53b8e0b41da6fe51e19a4ba242fd10 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Fri, 9 Jun 2023 10:12:22 +0200 Subject: [PATCH 2/7] Make one2one conversation ID protocol-dependent --- .../src/Galley/Types/Conversations/One2One.hs | 14 ++++++++------ services/galley/src/Galley/API/Create.hs | 3 ++- services/galley/src/Galley/API/One2One.hs | 12 ++++++++++-- 3 files changed, 20 insertions(+), 9 deletions(-) diff --git a/libs/galley-types/src/Galley/Types/Conversations/One2One.hs b/libs/galley-types/src/Galley/Types/Conversations/One2One.hs index bd2afdc7fd3..cd02c8824d8 100644 --- a/libs/galley-types/src/Galley/Types/Conversations/One2One.hs +++ b/libs/galley-types/src/Galley/Types/Conversations/One2One.hs @@ -30,6 +30,7 @@ import Data.UUID (UUID) import qualified Data.UUID as UUID import qualified Data.UUID.Tagged as U import Imports +import Wire.API.User -- | The hash function used to obtain the 1-1 conversation ID for a pair of users. -- @@ -39,8 +40,9 @@ 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 +namespace :: BaseProtocolTag -> UUID +namespace BaseProtocolProteusTag = UUID.fromWords 0x9a51edb8 0x060c0d9a 0x0c2950a8 0x5d152982 +namespace BaseProtocolMLSTag = UUID.fromWords 0x95589dd5 0xb04540dc 0xa6aadd9c 0x4fad1c2f compareDomains :: Ord a => Qualified a -> Qualified a -> Ordering compareDomains (Qualified a1 dom1) (Qualified a2 dom2) = @@ -88,13 +90,13 @@ quidToByteString (Qualified uid domain) = toByteString' uid <> toByteString' dom -- 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 +one2OneConvId :: BaseProtocolTag -> Qualified UserId -> Qualified UserId -> Qualified ConvId +one2OneConvId protocol a b = case compareDomains a b of + GT -> one2OneConvId protocol b a _ -> let c = mconcat - [ L.toStrict (UUID.toByteString namespace), + [ L.toStrict (UUID.toByteString (namespace protocol)), quidToByteString a, quidToByteString b ] diff --git a/services/galley/src/Galley/API/Create.hs b/services/galley/src/Galley/API/Create.hs index 80382af9ed7..43189f0c356 100644 --- a/services/galley/src/Galley/API/Create.hs +++ b/services/galley/src/Galley/API/Create.hs @@ -79,6 +79,7 @@ import Wire.API.Team import Wire.API.Team.LegalHold (LegalholdProtectee (LegalholdPlusFederationNotImplemented)) import Wire.API.Team.Member import Wire.API.Team.Permission hiding (self) +import Wire.API.User ---------------------------------------------------------------------------- -- Group conversations @@ -422,7 +423,7 @@ createOne2OneConversationUnchecked self zcon name mtid other = do self createOne2OneConversationLocally createOne2OneConversationRemotely - create (one2OneConvId (tUntagged self) other) self zcon name mtid other + create (one2OneConvId BaseProtocolProteusTag (tUntagged self) other) self zcon name mtid other createOne2OneConversationLocally :: ( Member ConversationStore r, diff --git a/services/galley/src/Galley/API/One2One.hs b/services/galley/src/Galley/API/One2One.hs index 8bd2b4d9d1f..b58850b95fb 100644 --- a/services/galley/src/Galley/API/One2One.hs +++ b/services/galley/src/Galley/API/One2One.hs @@ -35,7 +35,8 @@ import Galley.Types.UserList import Imports import Polysemy import Wire.API.Conversation hiding (Member) -import Wire.API.Routes.Internal.Galley.ConversationsIntra (Actor (..), DesiredMembership (..), UpsertOne2OneConversationRequest (..), UpsertOne2OneConversationResponse (..)) +import Wire.API.Routes.Internal.Galley.ConversationsIntra +import Wire.API.User newConnectConversationWithRemote :: Local UserId -> @@ -59,7 +60,14 @@ iUpsertOne2OneConversation :: UpsertOne2OneConversationRequest -> Sem r UpsertOne2OneConversationResponse iUpsertOne2OneConversation UpsertOne2OneConversationRequest {..} = do - let convId = fromMaybe (one2OneConvId (tUntagged uooLocalUser) (tUntagged uooRemoteUser)) uooConvId + let convId = + fromMaybe + ( one2OneConvId + BaseProtocolProteusTag + (tUntagged uooLocalUser) + (tUntagged uooRemoteUser) + ) + uooConvId let dolocal :: Local ConvId -> Sem r () dolocal lconvId = do From bb4c4862dad048c65146a59c8f9945e45f091e94 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Fri, 9 Jun 2023 11:34:46 +0200 Subject: [PATCH 3/7] Create MLS 1-1 conversation object --- .../src/Wire/API/Conversation/Member.hs | 24 +++++++++++++ services/galley/src/Galley/API/Query.hs | 36 +++++++++++++++++-- 2 files changed, 58 insertions(+), 2 deletions(-) diff --git a/libs/wire-api/src/Wire/API/Conversation/Member.hs b/libs/wire-api/src/Wire/API/Conversation/Member.hs index b6f76ec19e8..c3a41ece88e 100644 --- a/libs/wire-api/src/Wire/API/Conversation/Member.hs +++ b/libs/wire-api/src/Wire/API/Conversation/Member.hs @@ -23,8 +23,10 @@ module Wire.API.Conversation.Member -- * Member Member (..), + defMember, MutedStatus (..), OtherMember (..), + defOtherMember, -- * Member Update MemberUpdate (..), @@ -88,6 +90,20 @@ data Member = Member deriving (Arbitrary) via (GenericUniform Member) deriving (FromJSON, ToJSON, S.ToSchema) via Schema Member +defMember :: Qualified UserId -> Member +defMember uid = + Member + { memId = uid, + memService = Nothing, + memOtrMutedStatus = Nothing, + memOtrMutedRef = Nothing, + memOtrArchived = False, + memOtrArchivedRef = Nothing, + memHidden = False, + memHiddenRef = Nothing, + memConvRoleName = roleNameWireMember + } + instance ToSchema Member where schema = object "Member" $ @@ -133,6 +149,14 @@ data OtherMember = OtherMember deriving (Arbitrary) via (GenericUniform OtherMember) deriving (FromJSON, ToJSON, S.ToSchema) via Schema OtherMember +defOtherMember :: Qualified UserId -> OtherMember +defOtherMember uid = + OtherMember + { omQualifiedId = uid, + omService = Nothing, + omConvRoleName = roleNameWireMember + } + instance ToSchema OtherMember where schema = object "OtherMember" $ diff --git a/services/galley/src/Galley/API/Query.hs b/services/galley/src/Galley/API/Query.hs index 0e8fa9edfc4..f89c28f82bc 100644 --- a/services/galley/src/Galley/API/Query.hs +++ b/services/galley/src/Galley/API/Query.hs @@ -59,6 +59,7 @@ import Galley.API.MLS.Keys import Galley.API.MLS.Types import Galley.API.Mapping import qualified Galley.API.Mapping as Mapping +import Galley.API.One2One import Galley.API.Util import qualified Galley.Data.Conversation as Data import Galley.Data.Types (Code (codeConversation)) @@ -86,6 +87,7 @@ import qualified System.Logger.Class as Logger import Wire.API.Conversation hiding (Member) import qualified Wire.API.Conversation as Public import Wire.API.Conversation.Code +import Wire.API.Conversation.Protocol import Wire.API.Conversation.Role import qualified Wire.API.Conversation.Role as Public import Wire.API.Error @@ -94,9 +96,13 @@ import Wire.API.Federation.API import Wire.API.Federation.API.Galley import Wire.API.Federation.Client (FederatorClient) import Wire.API.Federation.Error +import Wire.API.MLS.CipherSuite +import Wire.API.MLS.Group.Serialisation +import Wire.API.MLS.SubConversation import qualified Wire.API.Provider.Bot as Public import qualified Wire.API.Routes.MultiTablePaging as Public import Wire.API.Team.Feature as Public hiding (setStatus) +import Wire.API.User import Wire.Sem.Paging.Cassandra getBotConversationH :: @@ -745,9 +751,35 @@ getMLSOne2OneConversation :: Local UserId -> Qualified UserId -> Sem r Conversation -getMLSOne2OneConversation _lusr _qtarget = do +getMLSOne2OneConversation lself qother = do assertMLSEnabled - pure (error "TODO") + let convId = one2OneConvId BaseProtocolMLSTag (tUntagged lself) qother + metadata = + ( defConversationMetadata + (tUnqualified lself) + ) + { cnvmType = One2OneConv + } + groupId = convToGroupId' (fmap Conv convId) + mlsData = + ConversationMLSData + { cnvmlsGroupId = groupId, + cnvmlsEpoch = Epoch 0, + cnvmlsEpochTimestamp = Nothing, + cnvmlsCipherSuite = MLS_128_DHKEMX25519_AES128GCM_SHA256_Ed25519 + } + let members = + ConvMembers + { cmSelf = defMember (tUntagged lself), + cmOthers = [defOtherMember qother] + } + pure + Conversation + { cnvQualifiedId = convId, + cnvMetadata = metadata, + cnvMembers = members, + cnvProtocol = ProtocolMLS mlsData + } ------------------------------------------------------------------------------- -- Helpers From 59c1d553e8a230000f3d04da716b97faa02f6e4d Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Fri, 9 Jun 2023 12:02:01 +0200 Subject: [PATCH 4/7] Add MLS one2one integration tests --- integration/integration.cabal | 1 + integration/test/API/Galley.hs | 12 ++++++ integration/test/Test/MLS/One2One.hs | 37 +++++++++++++++++++ services/brig/test/integration/Util.hs | 2 +- services/galley/test/integration/API/Util.hs | 2 +- .../test/unit/Test/Galley/API/One2One.hs | 7 ++-- 6 files changed, 56 insertions(+), 5 deletions(-) create mode 100644 integration/test/Test/MLS/One2One.hs diff --git a/integration/integration.cabal b/integration/integration.cabal index 54b4254745f..cc68a257c74 100644 --- a/integration/integration.cabal +++ b/integration/integration.cabal @@ -93,6 +93,7 @@ library Test.Demo Test.MLS Test.MLS.KeyPackage + Test.MLS.One2One Test.User Testlib.App Testlib.Assertions diff --git a/integration/test/API/Galley.hs b/integration/test/API/Galley.hs index 37903ed1b40..f3a984fb34f 100644 --- a/integration/test/API/Galley.hs +++ b/integration/test/API/Galley.hs @@ -200,3 +200,15 @@ deleteTeamConv team conv user = do convId <- objId conv req <- baseRequest user Galley Versioned (joinHttpPath ["teams", teamId, "conversations", convId]) submit "DELETE" req + +getMLSOne2OneConversation :: + (HasCallStack, MakesValue self, MakesValue other) => + self -> + other -> + App Response +getMLSOne2OneConversation self other = do + (domain, uid) <- objQid other + req <- + baseRequest self Galley Versioned $ + joinHttpPath ["conversations", "one2one", domain, uid] + submit "GET" req diff --git a/integration/test/Test/MLS/One2One.hs b/integration/test/Test/MLS/One2One.hs new file mode 100644 index 00000000000..5a16126ef00 --- /dev/null +++ b/integration/test/Test/MLS/One2One.hs @@ -0,0 +1,37 @@ +module Test.MLS.One2One where + +import API.Galley +import SetupHelpers +import Testlib.Prelude + +testGetMLSOne2One :: HasCallStack => Domain -> App () +testGetMLSOne2One otherDomain = do + [alice, bob] <- createAndConnectUsers [OwnDomain, otherDomain] + + conv <- getMLSOne2OneConversation alice bob >>= getJSON 200 + + conv %. "type" `shouldMatchInt` 2 + others <- conv %. "members.others" & asList + other <- assertOne others + other %. "conversation_role" `shouldMatch` "wire_member" + other %. "qualified_id" `shouldMatch` (bob %. "qualified_id") + + conv %. "members.self.conversation_role" `shouldMatch` "wire_member" + conv %. "members.self.qualified_id" `shouldMatch` (alice %. "qualified_id") + + convId <- conv %. "qualified_id" + + -- check that the conversation has the same ID on the other side + conv2 <- bindResponse (getMLSOne2OneConversation bob alice) $ \resp -> do + resp.status `shouldMatchInt` 200 + resp.json + + conv2 %. "type" `shouldMatchInt` 2 + conv2 %. "qualified_id" `shouldMatch` convId + +testGetMLSOne2OneUnconnected :: HasCallStack => Domain -> App () +testGetMLSOne2OneUnconnected otherDomain = do + [alice, bob] <- for [OwnDomain, otherDomain] $ \domain -> randomUser domain def + + bindResponse (getMLSOne2OneConversation alice bob) $ \resp -> + resp.status `shouldMatchInt` 403 diff --git a/services/brig/test/integration/Util.hs b/services/brig/test/integration/Util.hs index 389a1182bfb..d2f70780f8a 100644 --- a/services/brig/test/integration/Util.hs +++ b/services/brig/test/integration/Util.hs @@ -253,7 +253,7 @@ 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 + let convId = one2OneConvId BaseProtocolProteusTag quid other isLocal = qDomain quid == qDomain convId if shouldBeLocal == isLocal then pure (qUnqualified quid, other, convId) diff --git a/services/galley/test/integration/API/Util.hs b/services/galley/test/integration/API/Util.hs index 658b2e2e489..d92c01eb823 100644 --- a/services/galley/test/integration/API/Util.hs +++ b/services/galley/test/integration/API/Util.hs @@ -2863,7 +2863,7 @@ generateRemoteAndConvId = generateRemoteAndConvIdWithDomain (Domain "far-away.ex generateRemoteAndConvIdWithDomain :: Domain -> Bool -> Local UserId -> TestM (Remote UserId, Qualified ConvId) generateRemoteAndConvIdWithDomain remoteDomain shouldBeLocal lUserId = do other <- Qualified <$> randomId <*> pure remoteDomain - let convId = one2OneConvId (tUntagged lUserId) other + let convId = one2OneConvId BaseProtocolProteusTag (tUntagged lUserId) other isLocal = tDomain lUserId == qDomain convId if shouldBeLocal == isLocal then pure (qTagUnsafe other, convId) diff --git a/services/galley/test/unit/Test/Galley/API/One2One.hs b/services/galley/test/unit/Test/Galley/API/One2One.hs index 40580d29146..9a93da22743 100644 --- a/services/galley/test/unit/Test/Galley/API/One2One.hs +++ b/services/galley/test/unit/Test/Galley/API/One2One.hs @@ -26,6 +26,7 @@ import Imports import Test.Tasty import Test.Tasty.HUnit (Assertion, testCase, (@?=)) import Test.Tasty.QuickCheck +import Wire.API.User tests :: TestTree tests = @@ -35,8 +36,8 @@ tests = testCase "non-collision" one2OneConvIdNonCollision ] -one2OneConvIdSymmetry :: Qualified UserId -> Qualified UserId -> Property -one2OneConvIdSymmetry quid1 quid2 = one2OneConvId quid1 quid2 === one2OneConvId quid2 quid1 +one2OneConvIdSymmetry :: BaseProtocolTag -> Qualified UserId -> Qualified UserId -> Property +one2OneConvIdSymmetry proto quid1 quid2 = one2OneConvId proto quid1 quid2 === one2OneConvId proto quid2 quid1 -- | Make sure that we never get the same conversation ID for a pair of -- (assumingly) distinct qualified user IDs @@ -46,5 +47,5 @@ one2OneConvIdNonCollision = do -- A generator of lists of length 'len' of qualified user ID pairs let gen = vectorOf len arbitrary quids <- nubOrd <$> generate gen - let hashes = nubOrd (fmap (uncurry one2OneConvId) quids) + let hashes = nubOrd (fmap (uncurry (one2OneConvId BaseProtocolProteusTag)) quids) length hashes @?= length quids From f2a1e1a860a62778a17a249eec9b6fd7ade96ec4 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Fri, 9 Jun 2023 14:37:17 +0200 Subject: [PATCH 5/7] Test MLS 1-1 for teammates --- integration/test/API/Brig.hs | 44 +++++++++++++++++++ integration/test/API/BrigInternal.hs | 9 ++++ integration/test/API/Common.hs | 21 +++++++-- integration/test/SetupHelpers.hs | 8 ++++ integration/test/Test/MLS/One2One.hs | 6 +++ .../API/Routes/Public/Galley/Conversation.hs | 1 + services/galley/src/Galley/API/Action.hs | 4 +- services/galley/src/Galley/API/Query.hs | 8 +++- services/galley/src/Galley/API/Util.hs | 21 +++++++-- 9 files changed, 112 insertions(+), 10 deletions(-) diff --git a/integration/test/API/Brig.hs b/integration/test/API/Brig.hs index da77c21f74a..710314406f1 100644 --- a/integration/test/API/Brig.hs +++ b/integration/test/API/Brig.hs @@ -8,6 +8,29 @@ import qualified Data.Text.Encoding as T import GHC.Stack import Testlib.Prelude +data AddUser = AddUser + { name :: Maybe String, + email :: Maybe String, + teamCode :: Maybe String, + password :: Maybe String + } + +instance Default AddUser where + def = AddUser Nothing Nothing Nothing Nothing + +addUser :: (HasCallStack, MakesValue dom) => dom -> AddUser -> App Response +addUser dom opts = do + req <- baseRequest dom Brig Versioned "register" + name <- maybe randomName pure opts.name + submit "POST" $ + req + & addJSONObject + [ "name" .= name, + "email" .= opts.email, + "team_code" .= opts.teamCode, + "password" .= fromMaybe defPassword opts.password + ] + getUser :: (HasCallStack, MakesValue user, MakesValue target) => user -> @@ -213,3 +236,24 @@ putUserSupportedProtocols user ps = do baseRequest user Brig Versioned $ joinHttpPath ["self", "supported-protocols"] submit "PUT" (req & addJSONObject ["supported_protocols" .= ps]) + +data PostInvitation = PostInvitation + { email :: Maybe String + } + +instance Default PostInvitation where + def = PostInvitation Nothing + +postInvitation :: + (HasCallStack, MakesValue user) => + user -> + PostInvitation -> + App Response +postInvitation user inv = do + tid <- user %. "team" & asString + req <- + baseRequest user Brig Versioned $ + joinHttpPath ["teams", tid, "invitations"] + email <- maybe randomEmail pure inv.email + submit "POST" $ + req & addJSONObject ["email" .= email] diff --git a/integration/test/API/BrigInternal.hs b/integration/test/API/BrigInternal.hs index 68ce8666065..639be27d56f 100644 --- a/integration/test/API/BrigInternal.hs +++ b/integration/test/API/BrigInternal.hs @@ -73,3 +73,12 @@ deleteOAuthClient user cid = do clientId <- objId cid req <- baseRequest user Brig Unversioned $ "i/oauth/clients/" <> clientId submit "DELETE" req + +getInvitationCode :: (HasCallStack, MakesValue user, MakesValue inv) => user -> inv -> App Response +getInvitationCode user inv = do + tid <- user %. "team" & asString + invId <- inv %. "id" & asString + req <- + baseRequest user Brig Unversioned $ + "i/teams/invitation-code?team=" <> tid <> "&invitation_id=" <> invId + submit "GET" req diff --git a/integration/test/API/Common.hs b/integration/test/API/Common.hs index 88ed7bfe3c7..33c2c5ce336 100644 --- a/integration/test/API/Common.hs +++ b/integration/test/API/Common.hs @@ -17,9 +17,8 @@ defPassword :: String defPassword = "hunter2!" randomEmail :: App String -randomEmail = liftIO $ do - n <- randomRIO (8, 15) - u <- replicateM n pick +randomEmail = do + u <- randomName pure $ u <> "@example.com" where chars :: Array.Array Int Char @@ -32,3 +31,19 @@ randomEmail = liftIO $ do pick = do i <- randomRIO (Array.bounds chars) pure (chars Array.! i) + +randomName :: App String +randomName = liftIO $ do + n <- randomRIO (8, 15) + replicateM n pick + where + chars :: Array.Array Int Char + chars = mkArray $ ['A' .. 'Z'] <> ['a' .. 'z'] <> ['0' .. '9'] + + mkArray :: [a] -> Array.Array Int a + mkArray l = Array.listArray (0, length l - 1) l + + pick :: IO Char + pick = do + i <- randomRIO (Array.bounds chars) + pure (chars Array.! i) diff --git a/integration/test/SetupHelpers.hs b/integration/test/SetupHelpers.hs index 79b13bb58a6..ee1b9a995e6 100644 --- a/integration/test/SetupHelpers.hs +++ b/integration/test/SetupHelpers.hs @@ -94,3 +94,11 @@ supportMLS u = do let prots' = "mls" : prots bindResponse (putUserSupportedProtocols u prots') $ \resp -> resp.status `shouldMatchInt` 200 + +addUserToTeam :: (HasCallStack, MakesValue u) => u -> App Value +addUserToTeam u = do + inv <- postInvitation u def >>= getJSON 201 + email <- inv %. "email" & asString + resp <- getInvitationCode u inv >>= getJSON 200 + code <- resp %. "code" & asString + addUser u def {email = Just email, teamCode = Just code} >>= getJSON 201 diff --git a/integration/test/Test/MLS/One2One.hs b/integration/test/Test/MLS/One2One.hs index 5a16126ef00..fb0eda7b36b 100644 --- a/integration/test/Test/MLS/One2One.hs +++ b/integration/test/Test/MLS/One2One.hs @@ -35,3 +35,9 @@ testGetMLSOne2OneUnconnected otherDomain = do bindResponse (getMLSOne2OneConversation alice bob) $ \resp -> resp.status `shouldMatchInt` 403 + +testGetMLSOne2OneSameTeam :: App () +testGetMLSOne2OneSameTeam = do + (alice, _) <- createTeam OwnDomain + bob <- addUserToTeam alice + void $ getMLSOne2OneConversation alice bob >>= getJSON 200 diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Galley/Conversation.hs b/libs/wire-api/src/Wire/API/Routes/Public/Galley/Conversation.hs index 8de9bedf801..969af7e49f6 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Galley/Conversation.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Galley/Conversation.hs @@ -593,6 +593,7 @@ type ConversationAPI = ( Summary "Get an MLS 1:1 conversation" :> ZLocalUser :> CanThrow 'MLSNotEnabled + :> CanThrow 'NotConnected :> "conversations" :> "one2one" :> QualifiedCapture "usr" UserId diff --git a/services/galley/src/Galley/API/Action.hs b/services/galley/src/Galley/API/Action.hs index c1d03dba6d3..c4734c57632 100644 --- a/services/galley/src/Galley/API/Action.hs +++ b/services/galley/src/Galley/API/Action.hs @@ -476,10 +476,10 @@ performConversationJoin qusr lconv (ConversationJoin invited role) = do <$> E.selectTeamMembers tid newUsers let userMembershipMap = map (id &&& flip Map.lookup tms) newUsers ensureAccessRole (convAccessRoles conv) userMembershipMap - ensureConnectedOrSameTeam lusr newUsers + ensureConnectedToLocalsOrSameTeam lusr newUsers checkLocals lusr Nothing newUsers = do ensureAccessRole (convAccessRoles conv) (zip newUsers $ repeat Nothing) - ensureConnectedOrSameTeam lusr newUsers + ensureConnectedToLocalsOrSameTeam lusr newUsers checkRemotes :: ( Member BrigAccess r, diff --git a/services/galley/src/Galley/API/Query.hs b/services/galley/src/Galley/API/Query.hs index f89c28f82bc..7d5912ae588 100644 --- a/services/galley/src/Galley/API/Query.hs +++ b/services/galley/src/Galley/API/Query.hs @@ -745,14 +745,18 @@ getMLSSelfConversation lusr = do -- fly, but not persisted. The conversation will only be stored in the database -- when its first commit arrives. getMLSOne2OneConversation :: - ( Member (Input Env) r, - Member (ErrorS 'MLSNotEnabled) r + ( Member BrigAccess r, + Member (Input Env) r, + Member (ErrorS 'MLSNotEnabled) r, + Member (ErrorS 'NotConnected) r, + Member TeamStore r ) => Local UserId -> Qualified UserId -> Sem r Conversation getMLSOne2OneConversation lself qother = do assertMLSEnabled + ensureConnectedOrSameTeam lself [qother] let convId = one2OneConvId BaseProtocolMLSTag (tUntagged lself) qother metadata = ( defConversationMetadata diff --git a/services/galley/src/Galley/API/Util.hs b/services/galley/src/Galley/API/Util.hs index 657207c2101..9d3addbb8ae 100644 --- a/services/galley/src/Galley/API/Util.hs +++ b/services/galley/src/Galley/API/Util.hs @@ -108,12 +108,27 @@ ensureAccessRole roles users = do let botsExist = any (isJust . User.userService) activated unless (not botsExist || ServiceAccessRole `Set.member` roles) $ throwS @'ConvAccessDenied +-- | Check that the given user is either part of the same team as the other +-- users OR that there is a connection. +ensureConnectedOrSameTeam :: + ( Member BrigAccess r, + Member (ErrorS 'NotConnected) r, + Member TeamStore r + ) => + Local UserId -> + [Qualified UserId] -> + Sem r () +ensureConnectedOrSameTeam lusr others = do + let (locals, remotes) = partitionQualified lusr others + ensureConnectedToLocalsOrSameTeam lusr locals + ensureConnectedToRemotes lusr remotes + -- | Check that the given user is either part of the same team(s) as the other -- users OR that there is a connection. -- -- Team members are always considered connected, so we only check 'ensureConnected' -- for non-team-members of the _given_ user -ensureConnectedOrSameTeam :: +ensureConnectedToLocalsOrSameTeam :: ( Member BrigAccess r, Member (ErrorS 'NotConnected) r, Member TeamStore r @@ -121,8 +136,8 @@ ensureConnectedOrSameTeam :: Local UserId -> [UserId] -> Sem r () -ensureConnectedOrSameTeam _ [] = pure () -ensureConnectedOrSameTeam (tUnqualified -> u) uids = do +ensureConnectedToLocalsOrSameTeam _ [] = pure () +ensureConnectedToLocalsOrSameTeam (tUnqualified -> u) uids = do uTeams <- getUserTeams u -- We collect all the relevant uids from same teams as the origin user sameTeamUids <- forM uTeams $ \team -> From dfe022c86486c3b1c4933f09337c3743f7b5779e Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Fri, 9 Jun 2023 14:43:41 +0200 Subject: [PATCH 6/7] Add CHANGELOG entry --- changelog.d/1-api-changes/get-mls-one2one | 1 + 1 file changed, 1 insertion(+) create mode 100644 changelog.d/1-api-changes/get-mls-one2one diff --git a/changelog.d/1-api-changes/get-mls-one2one b/changelog.d/1-api-changes/get-mls-one2one new file mode 100644 index 00000000000..b34d49e3c21 --- /dev/null +++ b/changelog.d/1-api-changes/get-mls-one2one @@ -0,0 +1 @@ +Add new endpoint `GET /conversations/one2one/:domain/:uid` to fetch the MLS 1-1 conversation with another user From 91d038b394539f49e506225ed1a9f51acd3c6bcf Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Mon, 12 Jun 2023 08:56:34 +0200 Subject: [PATCH 7/7] Warnings --- integration/test/API/Common.hs | 11 ----------- 1 file changed, 11 deletions(-) diff --git a/integration/test/API/Common.hs b/integration/test/API/Common.hs index 33c2c5ce336..b2b3dfdc1b0 100644 --- a/integration/test/API/Common.hs +++ b/integration/test/API/Common.hs @@ -20,17 +20,6 @@ randomEmail :: App String randomEmail = do u <- randomName pure $ u <> "@example.com" - where - chars :: Array.Array Int Char - chars = mkArray $ ['A' .. 'Z'] <> ['a' .. 'z'] <> ['0' .. '9'] - - mkArray :: [a] -> Array.Array Int a - mkArray l = Array.listArray (0, length l - 1) l - - pick :: IO Char - pick = do - i <- randomRIO (Array.bounds chars) - pure (chars Array.! i) randomName :: App String randomName = liftIO $ do