From 2176da8b82af61379e85b9ed02c6578ff3c4a97c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marko=20Dimja=C5=A1evi=C4=87?= Date: Fri, 11 Jun 2021 12:04:07 +0200 Subject: [PATCH 01/17] Notify remote users of being added to a new conversation --- services/galley/src/Galley/API/Create.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/services/galley/src/Galley/API/Create.hs b/services/galley/src/Galley/API/Create.hs index ea20270da0c..27befd79157 100644 --- a/services/galley/src/Galley/API/Create.hs +++ b/services/galley/src/Galley/API/Create.hs @@ -327,6 +327,8 @@ notifyCreatedConversation dtime usr conn c = do localDomain <- viewFederationDomain now <- maybe (liftIO getCurrentTime) pure dtime pushSome =<< mapM (toPush localDomain now) (Data.convLocalMembers c) + -- Notify remote users of being added to a conversation + updateRemoteConversationMemberships [] usr now c [] (Data.convRemoteMembers c) where route | Data.convType c == RegularConv = RouteAny From 9ae72a6894080489d7a69e8778c9d428d5a31cd7 Mon Sep 17 00:00:00 2001 From: jschaul Date: Fri, 11 Jun 2021 01:07:36 +0200 Subject: [PATCH 02/17] add galley2 to end2end tests; fix conversation domain in test and extend it a little --- services/brig/test/integration/Federation/End2end.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/services/brig/test/integration/Federation/End2end.hs b/services/brig/test/integration/Federation/End2end.hs index 4bd6fd1114c..25f8ea5aa3b 100644 --- a/services/brig/test/integration/Federation/End2end.hs +++ b/services/brig/test/integration/Federation/End2end.hs @@ -30,7 +30,7 @@ import qualified Data.Aeson as Aeson import Data.ByteString.Conversion (toByteString') import Data.Domain (Domain) import Data.Handle -import Data.Id (ClientId) +import Data.Id (ClientId, ConvId, UserId) import Data.List.NonEmpty (NonEmpty ((:|))) import qualified Data.Map as Map import Data.Qualified From 6d7438919be02eaae3118ba190142e80394f051c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marko=20Dimja=C5=A1evi=C4=87?= Date: Fri, 11 Jun 2021 14:58:29 +0200 Subject: [PATCH 03/17] Move federation utility functions to a Util module --- services/brig/test/integration/Federation/End2end.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/services/brig/test/integration/Federation/End2end.hs b/services/brig/test/integration/Federation/End2end.hs index 25f8ea5aa3b..e51f14ddc01 100644 --- a/services/brig/test/integration/Federation/End2end.hs +++ b/services/brig/test/integration/Federation/End2end.hs @@ -20,7 +20,7 @@ module Federation.End2end where import API.Search.Util import API.User.Util (getUserClientsQualified) import Bilge -import Bilge.Assert ((!!!), ( Date: Fri, 11 Jun 2021 16:09:22 +0200 Subject: [PATCH 04/17] Add an end-to-end test for a new conversation with a remote user --- .../test/integration/Federation/End2end.hs | 26 ++++++++++++++++++- 1 file changed, 25 insertions(+), 1 deletion(-) diff --git a/services/brig/test/integration/Federation/End2end.hs b/services/brig/test/integration/Federation/End2end.hs index e51f14ddc01..73586a54d33 100644 --- a/services/brig/test/integration/Federation/End2end.hs +++ b/services/brig/test/integration/Federation/End2end.hs @@ -71,7 +71,8 @@ spec _brigOpts mg brig galley _federator brigTwo galleyTwo = test mg "claim prekey bundle" $ testClaimPrekeyBundleSuccess brig brigTwo, test mg "claim multi-prekey bundle" $ testClaimMultiPrekeyBundleSuccess brig brigTwo, test mg "list user clients" $ testListUserClients brig brigTwo, - test mg "add remote users to local conversation" $ testAddRemoteUsersToLocalConv brig galley brigTwo galleyTwo + test mg "add remote users to local conversation" $ testAddRemoteUsersToLocalConv brig galley brigTwo galleyTwo, + test mg "include remote users to new conversation" $ testRemoteUsersInNewConv brig galley brigTwo galleyTwo ] -- | Path covered by this test: @@ -257,6 +258,29 @@ testAddRemoteUsersToLocalConv brig1 galley1 brig2 galley2 = do expected' = [OtherMember (userQualifiedId alice) Nothing roleNameWireAdmin] liftIO $ actual' @?= expected' +-- | This creates a new conversation with a remote user. The test checks that +-- Galleys on both ends of the federation see the same conversation members. +testRemoteUsersInNewConv :: Brig -> Galley -> Brig -> Galley -> Http () +testRemoteUsersInNewConv brig1 galley1 brig2 galley2 = do + alice <- randomUser brig1 + bob <- randomUser brig2 + + let conv = NewConvUnmanaged $ NewConv [] [userQualifiedId bob] (Just "gossip") mempty Nothing Nothing Nothing Nothing roleNameWireAdmin + convId <- + cnvId . responseJsonUnsafe + <$> post + ( galley1 + . path "/conversations" + . zUser (userId alice) + . zConn "conn" + . header "Z-Type" "access" + . json conv + ) + + -- test GET /conversations/:backend1Domain/:cnv + testQualifiedGetConversation galley1 "galley1" alice bob convId + testQualifiedGetConversation galley2 "galley2" alice bob convId + testListUserClients :: Brig -> Brig -> Http () testListUserClients brig1 brig2 = do alice <- randomUser brig1 From 83f53acd66f24402772f127319ebbe5fcde933d7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marko=20Dimja=C5=A1evi=C4=87?= Date: Fri, 11 Jun 2021 17:40:18 +0200 Subject: [PATCH 05/17] Fix a failing test by using appropriate users in each Brig --- services/brig/test/integration/Federation/End2end.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/services/brig/test/integration/Federation/End2end.hs b/services/brig/test/integration/Federation/End2end.hs index 73586a54d33..278331c9d8f 100644 --- a/services/brig/test/integration/Federation/End2end.hs +++ b/services/brig/test/integration/Federation/End2end.hs @@ -279,7 +279,7 @@ testRemoteUsersInNewConv brig1 galley1 brig2 galley2 = do -- test GET /conversations/:backend1Domain/:cnv testQualifiedGetConversation galley1 "galley1" alice bob convId - testQualifiedGetConversation galley2 "galley2" alice bob convId + testQualifiedGetConversation galley2 "galley2" bob alice convId testListUserClients :: Brig -> Brig -> Http () testListUserClients brig1 brig2 = do From e53652adce3773d4d913f0a18135463cd0a7696d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marko=20Dimja=C5=A1evi=C4=87?= Date: Mon, 14 Jun 2021 11:36:34 +0200 Subject: [PATCH 06/17] Update a couple of FUTUREWORK notes --- services/galley/src/Galley/API/Create.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/services/galley/src/Galley/API/Create.hs b/services/galley/src/Galley/API/Create.hs index 27befd79157..b85288b6aed 100644 --- a/services/galley/src/Galley/API/Create.hs +++ b/services/galley/src/Galley/API/Create.hs @@ -106,7 +106,7 @@ createRegularGroupConv zusr zcon (NewConvUnmanaged body) = do let (remotes, locals) = fromConvSize checkedPartitionedUsers ensureConnected zusr locals checkRemoteUsersExist remotes - -- FUTUREWORK: Implement (2) and (3) as per comments for Update.addMembers. (also for createTeamGroupConv) + -- FUTUREWORK: Implement (3) per comments for Update.addMembers. (also for createTeamGroupConv) c <- Data.createConversation localDomain @@ -167,7 +167,7 @@ createTeamGroupConv zusr zcon tinfo body = do ensureConnectedToLocals zusr (notTeamMember localUserIds (catMaybes convLocalMemberships)) pure checkedPartitionedUsers checkRemoteUsersExist remotes - -- FUTUREWORK: Implement (2) and (3) as per comments for Update.addMembers. + -- FUTUREWORK: Implement (3) per comments for Update.addMembers. conv <- Data.createConversation localDomain From 78b03412ce662e7e715c28f04a88b053cd248804 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marko=20Dimja=C5=A1evi=C4=87?= Date: Mon, 14 Jun 2021 15:56:38 +0200 Subject: [PATCH 07/17] WIP: inline helper function to debug an end2end test --- .../test/integration/Federation/End2end.hs | 35 ++++++++++--------- 1 file changed, 18 insertions(+), 17 deletions(-) diff --git a/services/brig/test/integration/Federation/End2end.hs b/services/brig/test/integration/Federation/End2end.hs index 278331c9d8f..fa22e6ea386 100644 --- a/services/brig/test/integration/Federation/End2end.hs +++ b/services/brig/test/integration/Federation/End2end.hs @@ -260,26 +260,27 @@ testAddRemoteUsersToLocalConv brig1 galley1 brig2 galley2 = do -- | This creates a new conversation with a remote user. The test checks that -- Galleys on both ends of the federation see the same conversation members. -testRemoteUsersInNewConv :: Brig -> Galley -> Brig -> Galley -> Http () -testRemoteUsersInNewConv brig1 galley1 brig2 galley2 = do - alice <- randomUser brig1 - bob <- randomUser brig2 +-- testRemoteUsersInNewConv :: Brig -> Galley -> Brig -> Galley -> Http () +-- testRemoteUsersInNewConv brig1 galley1 brig2 galley2 = do +-- alice <- randomUser brig1 +-- bob <- randomUser brig2 - let conv = NewConvUnmanaged $ NewConv [] [userQualifiedId bob] (Just "gossip") mempty Nothing Nothing Nothing Nothing roleNameWireAdmin - convId <- - cnvId . responseJsonUnsafe - <$> post - ( galley1 - . path "/conversations" - . zUser (userId alice) - . zConn "conn" - . header "Z-Type" "access" - . json conv - ) +-- let conv = NewConvUnmanaged $ NewConv [] [userQualifiedId bob] (Just "gossip") mempty Nothing Nothing Nothing Nothing roleNameWireAdmin +-- convId <- +-- cnvId . responseJsonUnsafe +-- <$> post +-- ( galley1 +-- . path "/conversations" +-- . zUser (userId alice) +-- . zConn "conn" +-- . header "Z-Type" "access" +-- . json conv +-- ) +-- undefined -- test GET /conversations/:backend1Domain/:cnv - testQualifiedGetConversation galley1 "galley1" alice bob convId - testQualifiedGetConversation galley2 "galley2" bob alice convId + -- testQualifiedGetConversation galley1 "galley1" alice bob convId + -- testQualifiedGetConversation galley2 "galley2" bob alice convId testListUserClients :: Brig -> Brig -> Http () testListUserClients brig1 brig2 = do From 74f04f31c66f9d369478e05a000eaef289fb1710 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marko=20Dimja=C5=A1evi=C4=87?= Date: Mon, 14 Jun 2021 15:58:08 +0200 Subject: [PATCH 08/17] WIP: Add missing changes for debugging an end2end test failure --- services/brig/test/integration/Federation/End2end.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/services/brig/test/integration/Federation/End2end.hs b/services/brig/test/integration/Federation/End2end.hs index fa22e6ea386..c8b6db50961 100644 --- a/services/brig/test/integration/Federation/End2end.hs +++ b/services/brig/test/integration/Federation/End2end.hs @@ -20,7 +20,7 @@ module Federation.End2end where import API.Search.Util import API.User.Util (getUserClientsQualified) import Bilge -import Bilge.Assert ((!!!), (===)) +import Bilge.Assert ((!!!), (===), ( Date: Tue, 15 Jun 2021 16:42:53 +0200 Subject: [PATCH 09/17] WIP: A new federation endpoint for creating a conversation --- .../src/Wire/API/Federation/API/Galley.hs | 26 +++++++++- services/galley/src/Galley/API/Create.hs | 2 +- services/galley/src/Galley/API/Federation.hs | 23 +++++++- services/galley/src/Galley/API/Util.hs | 52 +++++++++++++++---- 4 files changed, 88 insertions(+), 15 deletions(-) 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 9bc504c8c6e..ef6a50e7115 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 @@ -23,7 +23,7 @@ import Data.Id (ConvId, UserId) import Data.Qualified (Qualified) import Data.Time.Clock (UTCTime) import Imports -import Servant.API (JSON, Post, ReqBody, (:>)) +import Servant.API (JSON, Post, ReqBody, Summary, (:>)) import Servant.API.Generic ((:-)) import Servant.Client.Generic (AsClientT, genericClient) import Wire.API.Arbitrary (Arbitrary, GenericUniform (..)) @@ -38,7 +38,15 @@ import Wire.API.Federation.Util.Aeson (CustomEncoded (CustomEncoded)) -- for the current list we need. data Api routes = Api - { getConversations :: + { -- | Create a new conversation + createConversation :: + routes + :- "federation" + :> Summary "Create a new conversation" + :> "create-conversation" + :> ReqBody '[JSON] CreateConversation + :> Post '[JSON] (), + getConversations :: routes :- "federation" :> "get-conversations" @@ -70,6 +78,20 @@ newtype GetConversationsResponse = GetConversationsResponse deriving (Arbitrary) via (GenericUniform GetConversationsResponse) deriving (ToJSON, FromJSON) via (CustomEncoded GetConversationsResponse) +-- | A record type describing a new federated conversation +data CreateConversation = MkCreateConversation + { -- | The time when the conversation was created + ccTime :: UTCTime, + -- | The user creating the conversation + ccOrigUserId :: Qualified UserId, + -- | The qualified ID of the conversation created on the owning backend + ccConvId :: Qualified ConvId, + -- | Users that are added to the conversation + ccUsersAdd :: [(Qualified UserId, RoleName)] + } + deriving stock (Eq, Show, Generic) + deriving (ToJSON, FromJSON) via (CustomEncoded CreateConversation) + data ConversationMemberUpdate = ConversationMemberUpdate { cmuTime :: UTCTime, cmuOrigUserId :: Qualified UserId, diff --git a/services/galley/src/Galley/API/Create.hs b/services/galley/src/Galley/API/Create.hs index b85288b6aed..75b90835751 100644 --- a/services/galley/src/Galley/API/Create.hs +++ b/services/galley/src/Galley/API/Create.hs @@ -328,7 +328,7 @@ notifyCreatedConversation dtime usr conn c = do now <- maybe (liftIO getCurrentTime) pure dtime pushSome =<< mapM (toPush localDomain now) (Data.convLocalMembers c) -- Notify remote users of being added to a conversation - updateRemoteConversationMemberships [] usr now c [] (Data.convRemoteMembers c) + createRemoteConversationMemberships usr now c (Data.convLocalMembers c) (Data.convRemoteMembers c) where route | Data.convType c == RegularConv = RouteAny diff --git a/services/galley/src/Galley/API/Federation.hs b/services/galley/src/Galley/API/Federation.hs index 9b8487f5e42..cf66ba094a8 100644 --- a/services/galley/src/Galley/API/Federation.hs +++ b/services/galley/src/Galley/API/Federation.hs @@ -27,17 +27,36 @@ import Servant (ServerT) import Servant.API.Generic (ToServantApi) import Servant.Server.Generic (genericServerT) import Wire.API.Event.Conversation -import Wire.API.Federation.API.Galley (ConversationMemberUpdate (..), GetConversationsRequest (..), GetConversationsResponse (..)) +import Wire.API.Federation.API.Galley (ConversationMemberUpdate (..), CreateConversation (..), GetConversationsRequest (..), GetConversationsResponse (..)) import qualified Wire.API.Federation.API.Galley as FederationAPIGalley federationSitemap :: ServerT (ToServantApi FederationAPIGalley.Api) Galley federationSitemap = genericServerT $ FederationAPIGalley.Api - { FederationAPIGalley.getConversations = getConversations, + { FederationAPIGalley.createConversation = createConversation, + FederationAPIGalley.getConversations = getConversations, FederationAPIGalley.updateConversationMemberships = updateConversationMemberships } +createConversation :: CreateConversation -> Galley () +createConversation cc = do + localDomain <- viewFederationDomain + let localUsers = filter ((== localDomain) . qDomain . fst) (ccUsersAdd cc) + localUserIds = map (qUnqualified . fst) localUsers + -- TODO(md): This call to addLocalMembersToRemoteConv below makes no sense + unless (null localUsers) $ do + Data.addLocalMembersToRemoteConv localUserIds (ccConvId cc) + -- TODO(md): Implement holes below + let _event = + Event + ConvCreate + (ccConvId cc) + (ccOrigUserId cc) + (ccTime cc) + (EdConversation undefined) + undefined + getConversations :: GetConversationsRequest -> Galley GetConversationsResponse getConversations (GetConversationsRequest qUid gcrConvIds) = do domain <- viewFederationDomain diff --git a/services/galley/src/Galley/API/Util.hs b/services/galley/src/Galley/API/Util.hs index f7cc8f77b16..99f69c6aa3a 100644 --- a/services/galley/src/Galley/API/Util.hs +++ b/services/galley/src/Galley/API/Util.hs @@ -350,7 +350,39 @@ runFederated remoteDomain rpc = do runExceptT (executeFederated remoteDomain rpc) >>= either (throwM . federationErrorToWai) pure --- | Notify remote users of being added to a conversation +-- | Notify remote users of being added to a new conversation +createRemoteConversationMemberships :: UserId -> UTCTime -> Data.Conversation -> [LocalMember] -> [RemoteMember] -> Galley () +createRemoteConversationMemberships usr now c lmm rmm = do + localDomain <- viewFederationDomain + let members = catMembers localDomain lmm rmm + qcnv = Qualified (Data.convId c) localDomain + qusr = Qualified usr localDomain + -- FUTUREWORK: parallelise federated requests + traverse_ (createRemoteConversations members qusr qcnv) + . Map.keys + . partitionQualified + . nubOrd + . map (unTagged . rmId) + $ rmm + where + createRemoteConversations :: + [(Qualified UserId, RoleName)] -> + Qualified UserId -> + Qualified ConvId -> + Domain -> + Galley () + createRemoteConversations uids orig cnv domain = do + let cc = + FederatedGalley.MkCreateConversation + { ccTime = now, + ccOrigUserId = orig, + ccConvId = cnv, + ccUsersAdd = uids + } + let rpc = FederatedGalley.createConversation FederatedGalley.clientRoutes cc + runFederated domain rpc + +-- | Notify remote users of being added to an existing conversation updateRemoteConversationMemberships :: [RemoteMember] -> UserId -> UTCTime -> Data.Conversation -> [LocalMember] -> [RemoteMember] -> Galley () updateRemoteConversationMemberships existingRemotes usr now c lmm rmm = do localDomain <- viewFederationDomain @@ -364,15 +396,6 @@ updateRemoteConversationMemberships existingRemotes usr now c lmm rmm = do . nubOrd . map (unTagged . rmId) $ rmm <> existingRemotes - where - catMembers :: - Domain -> - [LocalMember] -> - [RemoteMember] -> - [(Qualified UserId, RoleName)] - catMembers localDomain ls rs = - map (((`Qualified` localDomain) . memId) &&& memConvRoleName) ls - <> map ((unTagged . rmId) &&& rmConvRoleName) rs updateRemoteConversations :: UTCTime -> @@ -394,3 +417,12 @@ updateRemoteConversations now uids orig cnv domain others = do } let rpc = FederatedGalley.updateConversationMemberships FederatedGalley.clientRoutes cmu runFederated domain rpc + +catMembers :: + Domain -> + [LocalMember] -> + [RemoteMember] -> + [(Qualified UserId, RoleName)] +catMembers localDomain ls rs = + map (((`Qualified` localDomain) . memId) &&& memConvRoleName) ls + <> map ((unTagged . rmId) &&& rmConvRoleName) rs From e2cb18bccc0374851d23b148c1701125681b03fd Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marko=20Dimja=C5=A1evi=C4=87?= Date: Fri, 18 Jun 2021 15:49:15 +0200 Subject: [PATCH 10/17] Introduce CreateConversation for remote backends - Update both the local and remote databases with information on a new conversation - Notify both local and remote users of the new conversation --- .../src/Wire/API/Federation/API/Galley.hs | 25 ++- libs/wire-api/src/Wire/API/Conversation.hs | 4 + .../test/integration/Federation/End2end.hs | 8 +- services/galley/src/Galley/API/Create.hs | 10 +- services/galley/src/Galley/API/Federation.hs | 37 +++-- services/galley/src/Galley/API/Util.hs | 150 +++++++++++++++--- services/galley/src/Galley/Data.hs | 6 +- 7 files changed, 189 insertions(+), 51 deletions(-) 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 ef6a50e7115..711c916b6dd 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 @@ -19,7 +19,9 @@ module Wire.API.Federation.API.Galley where import Control.Monad.Except (MonadError (..)) import Data.Aeson (FromJSON, ToJSON) +import Data.Domain (Domain) import Data.Id (ConvId, UserId) +import Data.Misc (Milliseconds) import Data.Qualified (Qualified) import Data.Time.Clock (UTCTime) import Imports @@ -27,7 +29,8 @@ import Servant.API (JSON, Post, ReqBody, Summary, (:>)) import Servant.API.Generic ((:-)) import Servant.Client.Generic (AsClientT, genericClient) import Wire.API.Arbitrary (Arbitrary, GenericUniform (..)) -import Wire.API.Conversation (Conversation) +import Wire.API.Conversation (Access, AccessRole, ConvType, Conversation, ReceiptMode) +import Wire.API.Conversation.Member (Member (..)) import Wire.API.Conversation.Role (RoleName) import Wire.API.Federation.Client (FederationClientFailure, FederatorClient) import qualified Wire.API.Federation.GRPC.Types as Proto @@ -82,12 +85,22 @@ newtype GetConversationsResponse = GetConversationsResponse data CreateConversation = MkCreateConversation { -- | The time when the conversation was created ccTime :: UTCTime, - -- | The user creating the conversation + -- | The user that created the conversation ccOrigUserId :: Qualified UserId, - -- | The qualified ID of the conversation created on the owning backend - ccConvId :: Qualified ConvId, - -- | Users that are added to the conversation - ccUsersAdd :: [(Qualified UserId, RoleName)] + -- | The qualified conversation ID + ccCnvId :: Qualified ConvId, + -- | The conversation type + ccCnvType :: ConvType, + -- | The user that created the conversation + ccCnvCreator :: Qualified UserId, + ccCnvAccess :: [Access], + ccCnvAccessRole :: AccessRole, + -- | The conversation name, + ccCnvName :: Maybe Text, + -- | Members of the conversation grouped by their domain + ccMembers :: Map Domain [Member], + ccMessageTimer :: Maybe Milliseconds, + ccReceiptMode :: Maybe ReceiptMode } deriving stock (Eq, Show, Generic) deriving (ToJSON, FromJSON) via (CustomEncoded CreateConversation) diff --git a/libs/wire-api/src/Wire/API/Conversation.hs b/libs/wire-api/src/Wire/API/Conversation.hs index fa9fc57bae4..d569205aaff 100644 --- a/libs/wire-api/src/Wire/API/Conversation.hs +++ b/libs/wire-api/src/Wire/API/Conversation.hs @@ -99,11 +99,15 @@ import Wire.API.Conversation.Role (RoleName, roleNameWireAdmin) data Conversation = Conversation { cnvId :: ConvId, cnvType :: ConvType, + -- FUTUREWORK: Make this a qualified user ID. This will break + -- backwards-compatibility with clients. cnvCreator :: UserId, cnvAccess :: [Access], cnvAccessRole :: AccessRole, cnvName :: Maybe Text, cnvMembers :: ConvMembers, + -- FUTUREWORK: Think if it makes sense to make the team ID qualified due to + -- federation. cnvTeam :: Maybe TeamId, cnvMessageTimer :: Maybe Milliseconds, cnvReceiptMode :: Maybe ReceiptMode diff --git a/services/brig/test/integration/Federation/End2end.hs b/services/brig/test/integration/Federation/End2end.hs index c8b6db50961..bb09e406508 100644 --- a/services/brig/test/integration/Federation/End2end.hs +++ b/services/brig/test/integration/Federation/End2end.hs @@ -20,7 +20,7 @@ module Federation.End2end where import API.Search.Util import API.User.Util (getUserClientsQualified) import Bilge -import Bilge.Assert ((!!!), (===), ( Brig -> Http () testListUserClients brig1 brig2 = do diff --git a/services/galley/src/Galley/API/Create.hs b/services/galley/src/Galley/API/Create.hs index 75b90835751..4514a3c8947 100644 --- a/services/galley/src/Galley/API/Create.hs +++ b/services/galley/src/Galley/API/Create.hs @@ -326,9 +326,15 @@ notifyCreatedConversation :: Maybe UTCTime -> UserId -> Maybe ConnId -> Data.Con notifyCreatedConversation dtime usr conn c = do localDomain <- viewFederationDomain now <- maybe (liftIO getCurrentTime) pure dtime + -- FUTUREWORK: Should these calls that push notifications to local and remote + -- users be made in this, or a different order, or in parallel/applicative + -- fashion? + -- + -- Ask remote server to store conversation membership and notify remote users + -- of being added to a conversation + createRemoteConversationMemberships now (Qualified usr localDomain) c + -- Notify local users pushSome =<< mapM (toPush localDomain now) (Data.convLocalMembers c) - -- Notify remote users of being added to a conversation - createRemoteConversationMemberships usr now c (Data.convLocalMembers c) (Data.convRemoteMembers c) where route | Data.convType c == RegularConv = RouteAny diff --git a/services/galley/src/Galley/API/Federation.hs b/services/galley/src/Galley/API/Federation.hs index cf66ba094a8..40a62f372cc 100644 --- a/services/galley/src/Galley/API/Federation.hs +++ b/services/galley/src/Galley/API/Federation.hs @@ -17,15 +17,19 @@ module Galley.API.Federation where import Data.Containers.ListUtils (nubOrd) +import Data.Domain (Domain) +import Data.Id (UserId) +import qualified Data.Map as Map import Data.Qualified (Qualified (..)) import qualified Galley.API.Mapping as Mapping -import Galley.API.Util (pushConversationEvent, viewFederationDomain) +import Galley.API.Util (fromCreateConversation, pushConversationEvent, viewFederationDomain) import Galley.App (Galley) import qualified Galley.Data as Data import Imports import Servant (ServerT) import Servant.API.Generic (ToServantApi) import Servant.Server.Generic (genericServerT) +import Wire.API.Conversation.Member (Member, memId) import Wire.API.Event.Conversation import Wire.API.Federation.API.Galley (ConversationMemberUpdate (..), CreateConversation (..), GetConversationsRequest (..), GetConversationsResponse (..)) import qualified Wire.API.Federation.API.Galley as FederationAPIGalley @@ -42,20 +46,25 @@ federationSitemap = createConversation :: CreateConversation -> Galley () createConversation cc = do localDomain <- viewFederationDomain - let localUsers = filter ((== localDomain) . qDomain . fst) (ccUsersAdd cc) - localUserIds = map (qUnqualified . fst) localUsers - -- TODO(md): This call to addLocalMembersToRemoteConv below makes no sense + let localUsers = fmap (toQualified localDomain) . getLocals $ localDomain + localUserIds = map qUnqualified localUsers unless (null localUsers) $ do - Data.addLocalMembersToRemoteConv localUserIds (ccConvId cc) - -- TODO(md): Implement holes below - let _event = - Event - ConvCreate - (ccConvId cc) - (ccOrigUserId cc) - (ccTime cc) - (EdConversation undefined) - undefined + Data.addLocalMembersToRemoteConv localUserIds (ccCnvId cc) + forM_ localUsers $ \usr -> do + c <- fromCreateConversation usr cc + let event = + Event + ConvCreate + (ccCnvId cc) + (ccOrigUserId cc) + (ccTime cc) + (EdConversation c) + pushConversationEvent event [qUnqualified usr] [] + where + getLocals :: Domain -> [Member] + getLocals localDomain = fromMaybe [] . Map.lookup localDomain . ccMembers $ cc + toQualified :: Domain -> Member -> Qualified UserId + toQualified domain mem = Qualified (memId mem) domain getConversations :: GetConversationsRequest -> Galley GetConversationsResponse getConversations (GetConversationsRequest qUid gcrConvIds) = do diff --git a/services/galley/src/Galley/API/Util.hs b/services/galley/src/Galley/API/Util.hs index 99f69c6aa3a..685954fe830 100644 --- a/services/galley/src/Galley/API/Util.hs +++ b/services/galley/src/Galley/API/Util.hs @@ -14,12 +14,13 @@ -- -- You should have received a copy of the GNU Affero General Public License along -- with this program. If not, see . +{-# LANGUAGE RecordWildCards #-} module Galley.API.Util where import Brig.Types (Relation (..)) import Brig.Types.Intra (ReAuthUser (..)) -import Control.Arrow ((&&&)) +import Control.Arrow (Arrow (second), (&&&)) import Control.Error (ExceptT) import Control.Lens (set, view, (.~), (^.)) import Control.Monad.Catch @@ -46,6 +47,7 @@ import Galley.Intra.User import Galley.Options (optSettings, setFederationDomain) import Galley.Types import Galley.Types.Conversations.Members (RemoteMember (..)) +import qualified Galley.Types.Conversations.Members as Members import Galley.Types.Conversations.Roles import Galley.Types.Teams hiding (Event) import Imports @@ -54,6 +56,8 @@ import Network.Wai import Network.Wai.Predicate hiding (Error) import Network.Wai.Utilities import UnliftIO (concurrently) +import qualified Wire.API.Conversation as Public +import qualified Wire.API.Conversation.Member as Member import qualified Wire.API.Federation.API.Brig as FederatedBrig import Wire.API.Federation.API.Galley as FederatedGalley import Wire.API.Federation.Client (FederationClientFailure, FederatorClient, executeFederated) @@ -305,7 +309,7 @@ canDeleteMember deleter deletee pushConversationEvent :: Event -> [UserId] -> [BotMember] -> Galley () pushConversationEvent e = pushJoinEvents (qUnqualified (evtFrom e)) Nothing e --- | Notify local users and bots of being added to a conversation +-- | Notify local users and bots of a conversation event pushJoinEvents :: UserId -> Maybe ConnId -> Event -> [UserId] -> [BotMember] -> Galley () pushJoinEvents usr conn e users bots = do for_ (newPush ListComplete usr (ConvEvent e) (userRecipient <$> users)) $ \p -> @@ -350,35 +354,137 @@ runFederated remoteDomain rpc = do runExceptT (executeFederated remoteDomain rpc) >>= either (throwM . federationErrorToWai) pure +-- | Convert an internal conversation representation 'Data.Conversation' to +-- 'CreateConversation' to be sent over the wire to a remote backend that will +-- reconstruct this into multiple public-facing +-- 'Wire.API.Conversation.Convevrsation' values, one per user from that remote +-- backend. +-- +-- FUTUREWORK: Include the team ID as well once it becomes qualified. +toCreateConversation :: + -- | The time stamp the conversation was created at + UTCTime -> + -- | The user that created the conversation + Qualified UserId -> + -- | The conversation to convert for sending to a remote Galley + Data.Conversation -> + -- | The resulting information to be sent to a remote Galley + CreateConversation +toCreateConversation now qusr@(Qualified _usr localDomain) Data.Conversation {..} = + MkCreateConversation + { ccTime = now, + ccOrigUserId = qusr, + ccCnvId = Qualified convId localDomain, + ccCnvType = convType, + ccCnvCreator = Qualified convCreator localDomain, + ccCnvAccess = convAccess, + ccCnvAccessRole = convAccessRole, + ccCnvName = convName, + ccMembers = toMembers convLocalMembers convRemoteMembers, + ccMessageTimer = convMessageTimer, + ccReceiptMode = convReceiptMode + } + where + toMembers :: + [LocalMember] -> + [RemoteMember] -> + Map Domain [Member.Member] + toMembers ls rs = + let locals = Map.singleton localDomain . fmap localToMember $ ls + remotesUngrouped = fmap (second pure . remoteToMember) rs + in foldl' (flip (uncurry (Map.insertWith (<>)))) locals remotesUngrouped + localToMember :: LocalMember -> Member.Member + localToMember Members.InternalMember {..} = + Member.Member + { memId = memId, + .. + } + remoteToMember :: RemoteMember -> (Domain, Member.Member) + remoteToMember RemoteMember {..} = + ( qDomain . unTagged $ rmId, + Member.Member + { memId = qUnqualified . unTagged $ rmId, + memService = Nothing, + memOtrMuted = False, + memOtrMutedStatus = Nothing, + memOtrMutedRef = Nothing, + memOtrArchived = False, + memOtrArchivedRef = Nothing, + memHidden = False, + memHiddenRef = Nothing, + memConvRoleName = rmConvRoleName + } + ) + +-- | The function converts a 'CreateConversation' value to a +-- 'Wire.API.Conversation.Conversation' value. The obtained value can be used in +-- e.g. creating an 'Event' to be sent out to users informing them that a new +-- conversation has been created. +fromCreateConversation :: + Qualified UserId -> + CreateConversation -> + Galley Public.Conversation +fromCreateConversation (Qualified usr localDomain) MkCreateConversation {..} = do + this <- me ccMembers + pure + Public.Conversation + { cnvId = qUnqualified ccCnvId, + cnvType = ccCnvType, + -- FUTUREWORK: a UserId from another instance is communicated here, which + -- without domain does not make much sense here. + cnvCreator = qUnqualified ccCnvCreator, + cnvAccess = ccCnvAccess, + cnvAccessRole = ccCnvAccessRole, + cnvName = ccCnvName, + cnvMembers = ConvMembers this (others ccMembers), + -- FUTUREWORK: Once conversation IDs become qualified, this information + -- should be sent from the hosting Galley and stored here in 'cnvTeam'. + cnvTeam = Nothing, + cnvMessageTimer = ccMessageTimer, + cnvReceiptMode = ccReceiptMode + } + where + me :: Map Domain [Public.Member] -> Galley Public.Member + me m = case Map.lookup localDomain m >>= find ((usr ==) . Member.memId) of + Nothing -> throwM convMemberNotFound + Just v -> pure v + others :: Map Domain [Public.Member] -> [OtherMember] + others = + Map.foldlWithKey' (\acc d mems -> fmap (memToOther d) mems <> acc) [] + -- make sure not to include 'usr' in the list of others + . Map.adjust (filter ((usr /=) . Public.memId)) localDomain + memToOther :: Domain -> Member.Member -> OtherMember + memToOther d mem = + OtherMember + { omQualifiedId = Qualified (Member.memId mem) d, + omService = Member.memService mem, + omConvRoleName = Member.memConvRoleName mem + } + -- | Notify remote users of being added to a new conversation -createRemoteConversationMemberships :: UserId -> UTCTime -> Data.Conversation -> [LocalMember] -> [RemoteMember] -> Galley () -createRemoteConversationMemberships usr now c lmm rmm = do - localDomain <- viewFederationDomain - let members = catMembers localDomain lmm rmm - qcnv = Qualified (Data.convId c) localDomain - qusr = Qualified usr localDomain - -- FUTUREWORK: parallelise federated requests - traverse_ (createRemoteConversations members qusr qcnv) +createRemoteConversationMemberships :: + -- | The time stamp when the conversation was created + UTCTime -> + -- | The user that created the conversation + Qualified UserId -> + Data.Conversation -> + Galley () +createRemoteConversationMemberships now qusr c = do + let cc = toCreateConversation now qusr c + -- FUTUREWORK: parallelise federated requests + traverse_ (createRemoteConversations cc) . Map.keys . partitionQualified . nubOrd . map (unTagged . rmId) - $ rmm + . Data.convRemoteMembers + $ c where createRemoteConversations :: - [(Qualified UserId, RoleName)] -> - Qualified UserId -> - Qualified ConvId -> + CreateConversation -> Domain -> Galley () - createRemoteConversations uids orig cnv domain = do - let cc = - FederatedGalley.MkCreateConversation - { ccTime = now, - ccOrigUserId = orig, - ccConvId = cnv, - ccUsersAdd = uids - } + createRemoteConversations cc domain = do let rpc = FederatedGalley.createConversation FederatedGalley.clientRoutes cc runFederated domain rpc diff --git a/services/galley/src/Galley/Data.hs b/services/galley/src/Galley/Data.hs index 9aea0e63b6c..d1a32b80908 100644 --- a/services/galley/src/Galley/Data.hs +++ b/services/galley/src/Galley/Data.hs @@ -856,9 +856,9 @@ addMembersUncheckedWithRole localDomain t conv (orig, _origRole) lusrs rusrs = d e = Event MemberJoin qconv qorig t (EdMembersJoin (SimpleMembers (lmems <> rmems))) return (e, fmap (uncurry newMemberWithRole) lusrs, fmap (uncurry RemoteMember) rusrs) --- | Set local users as belonging to a remote conversation. This is invoked by --- a remote galley (using the RPC updateConversationMembership) when users from --- the current backend are added to conversations on the remote end. +-- | Set local users as belonging to a remote conversation. This is invoked by a +-- remote galley when users from the current backend are added to conversations +-- on the remote end. addLocalMembersToRemoteConv :: MonadClient m => [UserId] -> Qualified ConvId -> m () addLocalMembersToRemoteConv users qconv = do -- FUTUREWORK: consider using pooledMapConcurrentlyN From 773982dc7842cc179bbe56ac1b434f3f09d6306b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marko=20Dimja=C5=A1evi=C4=87?= Date: Fri, 18 Jun 2021 16:42:43 +0200 Subject: [PATCH 11/17] Add documentation for a test helper --- .../test/integration/Federation/End2end.hs | 23 +++++++++++++++---- 1 file changed, 19 insertions(+), 4 deletions(-) diff --git a/services/brig/test/integration/Federation/End2end.hs b/services/brig/test/integration/Federation/End2end.hs index bb09e406508..f99ba65d315 100644 --- a/services/brig/test/integration/Federation/End2end.hs +++ b/services/brig/test/integration/Federation/End2end.hs @@ -277,10 +277,25 @@ testAddRemoteUsersToLocalConv brig1 galley1 brig2 galley2 = do -- . json conv -- ) --- undefined --- test GET /conversations/:backend1Domain/:cnv --- testQualifiedGetConversation galley1 "galley1" alice bob convId --- testQualifiedGetConversation galley2 "galley2" bob alice convId +-- | Test a scenario of a two-user conversation. +testQualifiedGetConversation :: + -- | A Galley to get information from + Galley -> + -- | A message to display during response parsing + String -> + -- | The user making the request + User -> + -- | The other user in the conversation + User -> + -- | A qualified conversation ID + Qualified ConvId -> + Http () +testQualifiedGetConversation galley msg alice bob qconvId = do + res <- getConvQualified galley (userId alice) qconvId " - get /conversations/domain/cnvId") res + actual = cmOthers $ cnvMembers conv + expected = [OtherMember (userQualifiedId bob) Nothing roleNameWireAdmin] + liftIO $ actual @?= expected testListUserClients :: Brig -> Brig -> Http () testListUserClients brig1 brig2 = do From f1eea64520a7a0259f04cb9a6be657fdf9cb2f6b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marko=20Dimja=C5=A1evi=C4=87?= Date: Fri, 18 Jun 2021 17:07:35 +0200 Subject: [PATCH 12/17] Reintroduce a test for a new conversation with a remote user --- .../test/integration/Federation/End2end.hs | 40 ++++++++++--------- 1 file changed, 22 insertions(+), 18 deletions(-) diff --git a/services/brig/test/integration/Federation/End2end.hs b/services/brig/test/integration/Federation/End2end.hs index f99ba65d315..45eacb74acd 100644 --- a/services/brig/test/integration/Federation/End2end.hs +++ b/services/brig/test/integration/Federation/End2end.hs @@ -30,7 +30,7 @@ import qualified Data.Aeson as Aeson import Data.ByteString.Conversion (toByteString') import Data.Domain (Domain) import Data.Handle -import Data.Id (ClientId) +import Data.Id (ClientId, ConvId) import Data.List.NonEmpty (NonEmpty ((:|))) import qualified Data.Map as Map import Data.Qualified @@ -71,8 +71,8 @@ spec _brigOpts mg brig galley _federator brigTwo galleyTwo = test mg "claim prekey bundle" $ testClaimPrekeyBundleSuccess brig brigTwo, test mg "claim multi-prekey bundle" $ testClaimMultiPrekeyBundleSuccess brig brigTwo, test mg "list user clients" $ testListUserClients brig brigTwo, - test mg "add remote users to local conversation" $ testAddRemoteUsersToLocalConv brig galley brigTwo galleyTwo - -- test mg "include remote users to new conversation" $ testRemoteUsersInNewConv brig galley brigTwo galleyTwo + test mg "add remote users to local conversation" $ testAddRemoteUsersToLocalConv brig galley brigTwo galleyTwo, + test mg "include remote users to new conversation" $ testRemoteUsersInNewConv brig galley brigTwo galleyTwo ] -- | Path covered by this test: @@ -260,22 +260,26 @@ testAddRemoteUsersToLocalConv brig1 galley1 brig2 galley2 = do -- | This creates a new conversation with a remote user. The test checks that -- Galleys on both ends of the federation see the same conversation members. --- testRemoteUsersInNewConv :: Brig -> Galley -> Brig -> Galley -> Http () --- testRemoteUsersInNewConv brig1 galley1 brig2 galley2 = do --- alice <- randomUser brig1 --- bob <- randomUser brig2 +testRemoteUsersInNewConv :: Brig -> Galley -> Brig -> Galley -> Http () +testRemoteUsersInNewConv brig1 galley1 brig2 galley2 = do + alice <- randomUser brig1 + bob <- randomUser brig2 --- let conv = NewConvUnmanaged $ NewConv [] [userQualifiedId bob] (Just "gossip") mempty Nothing Nothing Nothing Nothing roleNameWireAdmin --- convId <- --- cnvId . responseJsonUnsafe --- <$> post --- ( galley1 --- . path "/conversations" --- . zUser (userId alice) --- . zConn "conn" --- . header "Z-Type" "access" --- . json conv --- ) + let conv = NewConvUnmanaged $ NewConv [] [userQualifiedId bob] (Just "gossip") mempty Nothing Nothing Nothing Nothing roleNameWireAdmin + convId <- + cnvId . responseJsonUnsafe + <$> post + ( galley1 + . path "/conversations" + . zUser (userId alice) + . zConn "conn" + . header "Z-Type" "access" + . json conv + ) + let qconvId = Qualified convId (qDomain (userQualifiedId alice)) + -- test GET /conversations/:backend1Domain/:cnv + testQualifiedGetConversation galley1 "galley1" alice bob qconvId + testQualifiedGetConversation galley2 "galley2" bob alice qconvId -- | Test a scenario of a two-user conversation. testQualifiedGetConversation :: From ab01135f0bbd4ecaca34225921e1b24f66f34772 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marko=20Dimja=C5=A1evi=C4=87?= Date: Mon, 21 Jun 2021 10:14:46 +0200 Subject: [PATCH 13/17] Implement feedback by Paolo - Get rid of a redundant record field - Rename a data type to better reflect its purpose -- Rename fields and functions accordingly --- .../src/Wire/API/Federation/API/Galley.hs | 31 ++++---- libs/wire-api/src/Wire/API/Conversation.hs | 3 +- services/galley/src/Galley/API/Create.hs | 2 +- services/galley/src/Galley/API/Federation.hs | 20 ++--- services/galley/src/Galley/API/Util.hs | 75 +++++++++---------- 5 files changed, 65 insertions(+), 66 deletions(-) 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 711c916b6dd..fdff1147755 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 @@ -47,7 +47,7 @@ data Api routes = Api :- "federation" :> Summary "Create a new conversation" :> "create-conversation" - :> ReqBody '[JSON] CreateConversation + :> ReqBody '[JSON] RegisterConversation :> Post '[JSON] (), getConversations :: routes @@ -82,28 +82,29 @@ newtype GetConversationsResponse = GetConversationsResponse deriving (ToJSON, FromJSON) via (CustomEncoded GetConversationsResponse) -- | A record type describing a new federated conversation -data CreateConversation = MkCreateConversation +-- +-- FUTUREWORK: Think about extracting common conversation metadata into a +-- separarate data type that can be reused in several data types in this module. +data RegisterConversation = MkRegisterConversation { -- | The time when the conversation was created - ccTime :: UTCTime, + rcTime :: UTCTime, -- | The user that created the conversation - ccOrigUserId :: Qualified UserId, + rcOrigUserId :: Qualified UserId, -- | The qualified conversation ID - ccCnvId :: Qualified ConvId, + rcCnvId :: Qualified ConvId, -- | The conversation type - ccCnvType :: ConvType, - -- | The user that created the conversation - ccCnvCreator :: Qualified UserId, - ccCnvAccess :: [Access], - ccCnvAccessRole :: AccessRole, + rcCnvType :: ConvType, + rcCnvAccess :: [Access], + rcCnvAccessRole :: AccessRole, -- | The conversation name, - ccCnvName :: Maybe Text, + rcCnvName :: Maybe Text, -- | Members of the conversation grouped by their domain - ccMembers :: Map Domain [Member], - ccMessageTimer :: Maybe Milliseconds, - ccReceiptMode :: Maybe ReceiptMode + rcMembers :: Map Domain [Member], + rcMessageTimer :: Maybe Milliseconds, + rcReceiptMode :: Maybe ReceiptMode } deriving stock (Eq, Show, Generic) - deriving (ToJSON, FromJSON) via (CustomEncoded CreateConversation) + deriving (ToJSON, FromJSON) via (CustomEncoded RegisterConversation) data ConversationMemberUpdate = ConversationMemberUpdate { cmuTime :: UTCTime, diff --git a/libs/wire-api/src/Wire/API/Conversation.hs b/libs/wire-api/src/Wire/API/Conversation.hs index d569205aaff..5f4b7b6d5a1 100644 --- a/libs/wire-api/src/Wire/API/Conversation.hs +++ b/libs/wire-api/src/Wire/API/Conversation.hs @@ -99,8 +99,7 @@ import Wire.API.Conversation.Role (RoleName, roleNameWireAdmin) data Conversation = Conversation { cnvId :: ConvId, cnvType :: ConvType, - -- FUTUREWORK: Make this a qualified user ID. This will break - -- backwards-compatibility with clients. + -- FUTUREWORK: Make this a qualified user ID. cnvCreator :: UserId, cnvAccess :: [Access], cnvAccessRole :: AccessRole, diff --git a/services/galley/src/Galley/API/Create.hs b/services/galley/src/Galley/API/Create.hs index 4514a3c8947..624a88559a9 100644 --- a/services/galley/src/Galley/API/Create.hs +++ b/services/galley/src/Galley/API/Create.hs @@ -332,7 +332,7 @@ notifyCreatedConversation dtime usr conn c = do -- -- Ask remote server to store conversation membership and notify remote users -- of being added to a conversation - createRemoteConversationMemberships now (Qualified usr localDomain) c + registerRemoteConversationMemberships now (Qualified usr localDomain) c -- Notify local users pushSome =<< mapM (toPush localDomain now) (Data.convLocalMembers c) where diff --git a/services/galley/src/Galley/API/Federation.hs b/services/galley/src/Galley/API/Federation.hs index 40a62f372cc..f512c2daddd 100644 --- a/services/galley/src/Galley/API/Federation.hs +++ b/services/galley/src/Galley/API/Federation.hs @@ -22,7 +22,7 @@ import Data.Id (UserId) import qualified Data.Map as Map import Data.Qualified (Qualified (..)) import qualified Galley.API.Mapping as Mapping -import Galley.API.Util (fromCreateConversation, pushConversationEvent, viewFederationDomain) +import Galley.API.Util (fromRegisterConversation, pushConversationEvent, viewFederationDomain) import Galley.App (Galley) import qualified Galley.Data as Data import Imports @@ -31,7 +31,7 @@ import Servant.API.Generic (ToServantApi) import Servant.Server.Generic (genericServerT) import Wire.API.Conversation.Member (Member, memId) import Wire.API.Event.Conversation -import Wire.API.Federation.API.Galley (ConversationMemberUpdate (..), CreateConversation (..), GetConversationsRequest (..), GetConversationsResponse (..)) +import Wire.API.Federation.API.Galley (ConversationMemberUpdate (..), RegisterConversation (..), GetConversationsRequest (..), GetConversationsResponse (..)) import qualified Wire.API.Federation.API.Galley as FederationAPIGalley federationSitemap :: ServerT (ToServantApi FederationAPIGalley.Api) Galley @@ -43,26 +43,26 @@ federationSitemap = FederationAPIGalley.updateConversationMemberships = updateConversationMemberships } -createConversation :: CreateConversation -> Galley () -createConversation cc = do +createConversation :: RegisterConversation -> Galley () +createConversation rc = do localDomain <- viewFederationDomain let localUsers = fmap (toQualified localDomain) . getLocals $ localDomain localUserIds = map qUnqualified localUsers unless (null localUsers) $ do - Data.addLocalMembersToRemoteConv localUserIds (ccCnvId cc) + Data.addLocalMembersToRemoteConv localUserIds (rcCnvId rc) forM_ localUsers $ \usr -> do - c <- fromCreateConversation usr cc + c <- fromRegisterConversation usr rc let event = Event ConvCreate - (ccCnvId cc) - (ccOrigUserId cc) - (ccTime cc) + (rcCnvId rc) + (rcOrigUserId rc) + (rcTime rc) (EdConversation c) pushConversationEvent event [qUnqualified usr] [] where getLocals :: Domain -> [Member] - getLocals localDomain = fromMaybe [] . Map.lookup localDomain . ccMembers $ cc + getLocals localDomain = fromMaybe [] . Map.lookup localDomain . rcMembers $ rc toQualified :: Domain -> Member -> Qualified UserId toQualified domain mem = Qualified (memId mem) domain diff --git a/services/galley/src/Galley/API/Util.hs b/services/galley/src/Galley/API/Util.hs index 685954fe830..2cf89a0d292 100644 --- a/services/galley/src/Galley/API/Util.hs +++ b/services/galley/src/Galley/API/Util.hs @@ -355,13 +355,13 @@ runFederated remoteDomain rpc = do >>= either (throwM . federationErrorToWai) pure -- | Convert an internal conversation representation 'Data.Conversation' to --- 'CreateConversation' to be sent over the wire to a remote backend that will +-- 'RegisterConversation' to be sent over the wire to a remote backend that will -- reconstruct this into multiple public-facing -- 'Wire.API.Conversation.Convevrsation' values, one per user from that remote -- backend. -- -- FUTUREWORK: Include the team ID as well once it becomes qualified. -toCreateConversation :: +toRegisterConversation :: -- | The time stamp the conversation was created at UTCTime -> -- | The user that created the conversation @@ -369,20 +369,19 @@ toCreateConversation :: -- | The conversation to convert for sending to a remote Galley Data.Conversation -> -- | The resulting information to be sent to a remote Galley - CreateConversation -toCreateConversation now qusr@(Qualified _usr localDomain) Data.Conversation {..} = - MkCreateConversation - { ccTime = now, - ccOrigUserId = qusr, - ccCnvId = Qualified convId localDomain, - ccCnvType = convType, - ccCnvCreator = Qualified convCreator localDomain, - ccCnvAccess = convAccess, - ccCnvAccessRole = convAccessRole, - ccCnvName = convName, - ccMembers = toMembers convLocalMembers convRemoteMembers, - ccMessageTimer = convMessageTimer, - ccReceiptMode = convReceiptMode + RegisterConversation +toRegisterConversation now (Qualified _usr localDomain) Data.Conversation {..} = + MkRegisterConversation + { rcTime = now, + rcOrigUserId = Qualified convCreator localDomain, + rcCnvId = Qualified convId localDomain, + rcCnvType = convType, + rcCnvAccess = convAccess, + rcCnvAccessRole = convAccessRole, + rcCnvName = convName, + rcMembers = toMembers convLocalMembers convRemoteMembers, + rcMessageTimer = convMessageTimer, + rcReceiptMode = convReceiptMode } where toMembers :: @@ -416,32 +415,32 @@ toCreateConversation now qusr@(Qualified _usr localDomain) Data.Conversation {.. } ) --- | The function converts a 'CreateConversation' value to a +-- | The function converts a 'RegisterConversation' value to a -- 'Wire.API.Conversation.Conversation' value. The obtained value can be used in -- e.g. creating an 'Event' to be sent out to users informing them that a new -- conversation has been created. -fromCreateConversation :: +fromRegisterConversation :: Qualified UserId -> - CreateConversation -> + RegisterConversation -> Galley Public.Conversation -fromCreateConversation (Qualified usr localDomain) MkCreateConversation {..} = do - this <- me ccMembers +fromRegisterConversation (Qualified usr localDomain) MkRegisterConversation {..} = do + this <- me rcMembers pure Public.Conversation - { cnvId = qUnqualified ccCnvId, - cnvType = ccCnvType, + { cnvId = qUnqualified rcCnvId, + cnvType = rcCnvType, -- FUTUREWORK: a UserId from another instance is communicated here, which -- without domain does not make much sense here. - cnvCreator = qUnqualified ccCnvCreator, - cnvAccess = ccCnvAccess, - cnvAccessRole = ccCnvAccessRole, - cnvName = ccCnvName, - cnvMembers = ConvMembers this (others ccMembers), + cnvCreator = qUnqualified rcOrigUserId, + cnvAccess = rcCnvAccess, + cnvAccessRole = rcCnvAccessRole, + cnvName = rcCnvName, + cnvMembers = ConvMembers this (others rcMembers), -- FUTUREWORK: Once conversation IDs become qualified, this information -- should be sent from the hosting Galley and stored here in 'cnvTeam'. cnvTeam = Nothing, - cnvMessageTimer = ccMessageTimer, - cnvReceiptMode = ccReceiptMode + cnvMessageTimer = rcMessageTimer, + cnvReceiptMode = rcReceiptMode } where me :: Map Domain [Public.Member] -> Galley Public.Member @@ -462,17 +461,17 @@ fromCreateConversation (Qualified usr localDomain) MkCreateConversation {..} = d } -- | Notify remote users of being added to a new conversation -createRemoteConversationMemberships :: +registerRemoteConversationMemberships :: -- | The time stamp when the conversation was created UTCTime -> -- | The user that created the conversation Qualified UserId -> Data.Conversation -> Galley () -createRemoteConversationMemberships now qusr c = do - let cc = toCreateConversation now qusr c +registerRemoteConversationMemberships now qusr c = do + let rc = toRegisterConversation now qusr c -- FUTUREWORK: parallelise federated requests - traverse_ (createRemoteConversations cc) + traverse_ (registerRemoteConversations rc) . Map.keys . partitionQualified . nubOrd @@ -480,12 +479,12 @@ createRemoteConversationMemberships now qusr c = do . Data.convRemoteMembers $ c where - createRemoteConversations :: - CreateConversation -> + registerRemoteConversations :: + RegisterConversation -> Domain -> Galley () - createRemoteConversations cc domain = do - let rpc = FederatedGalley.createConversation FederatedGalley.clientRoutes cc + registerRemoteConversations rc domain = do + let rpc = FederatedGalley.createConversation FederatedGalley.clientRoutes rc runFederated domain rpc -- | Notify remote users of being added to an existing conversation From a7d60d43b4625e4aa2e378aa0d6182da20c7922e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marko=20Dimja=C5=A1evi=C4=87?= Date: Mon, 21 Jun 2021 10:45:03 +0200 Subject: [PATCH 14/17] More renaming and an endpoint summary clarification --- .../src/Wire/API/Federation/API/Galley.hs | 6 +++--- services/galley/src/Galley/API/Federation.hs | 6 +++--- services/galley/src/Galley/API/Util.hs | 2 +- 3 files changed, 7 insertions(+), 7 deletions(-) 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 fdff1147755..068f88c3074 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 @@ -41,11 +41,11 @@ import Wire.API.Federation.Util.Aeson (CustomEncoded (CustomEncoded)) -- for the current list we need. data Api routes = Api - { -- | Create a new conversation - createConversation :: + { -- | Register a new conversation + registerConversation :: routes :- "federation" - :> Summary "Create a new conversation" + :> Summary "Register users to be in a new remote conversation" :> "create-conversation" :> ReqBody '[JSON] RegisterConversation :> Post '[JSON] (), diff --git a/services/galley/src/Galley/API/Federation.hs b/services/galley/src/Galley/API/Federation.hs index f512c2daddd..a969f821057 100644 --- a/services/galley/src/Galley/API/Federation.hs +++ b/services/galley/src/Galley/API/Federation.hs @@ -38,13 +38,13 @@ federationSitemap :: ServerT (ToServantApi FederationAPIGalley.Api) Galley federationSitemap = genericServerT $ FederationAPIGalley.Api - { FederationAPIGalley.createConversation = createConversation, + { FederationAPIGalley.registerConversation = registerConversation, FederationAPIGalley.getConversations = getConversations, FederationAPIGalley.updateConversationMemberships = updateConversationMemberships } -createConversation :: RegisterConversation -> Galley () -createConversation rc = do +registerConversation :: RegisterConversation -> Galley () +registerConversation rc = do localDomain <- viewFederationDomain let localUsers = fmap (toQualified localDomain) . getLocals $ localDomain localUserIds = map qUnqualified localUsers diff --git a/services/galley/src/Galley/API/Util.hs b/services/galley/src/Galley/API/Util.hs index dcb164f1bef..f1813f6b28c 100644 --- a/services/galley/src/Galley/API/Util.hs +++ b/services/galley/src/Galley/API/Util.hs @@ -504,7 +504,7 @@ registerRemoteConversationMemberships now qusr c = do Domain -> Galley () registerRemoteConversations rc domain = do - let rpc = FederatedGalley.createConversation FederatedGalley.clientRoutes rc + let rpc = FederatedGalley.registerConversation FederatedGalley.clientRoutes rc runFederated domain rpc -- | Notify remote users of being added to an existing conversation From 20947bdbc73242f9f1f4662ef9aa679b30e6bb36 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marko=20Dimja=C5=A1evi=C4=87?= Date: Mon, 21 Jun 2021 11:13:10 +0200 Subject: [PATCH 15/17] Pass in only the needed domain, and not the whole qualified user ID --- services/galley/src/Galley/API/Create.hs | 2 +- services/galley/src/Galley/API/Util.hs | 14 +++++++------- 2 files changed, 8 insertions(+), 8 deletions(-) diff --git a/services/galley/src/Galley/API/Create.hs b/services/galley/src/Galley/API/Create.hs index 624a88559a9..e075123e50f 100644 --- a/services/galley/src/Galley/API/Create.hs +++ b/services/galley/src/Galley/API/Create.hs @@ -332,7 +332,7 @@ notifyCreatedConversation dtime usr conn c = do -- -- Ask remote server to store conversation membership and notify remote users -- of being added to a conversation - registerRemoteConversationMemberships now (Qualified usr localDomain) c + registerRemoteConversationMemberships now localDomain c -- Notify local users pushSome =<< mapM (toPush localDomain now) (Data.convLocalMembers c) where diff --git a/services/galley/src/Galley/API/Util.hs b/services/galley/src/Galley/API/Util.hs index f1813f6b28c..f5a597eafbf 100644 --- a/services/galley/src/Galley/API/Util.hs +++ b/services/galley/src/Galley/API/Util.hs @@ -384,13 +384,13 @@ runFederated remoteDomain rpc = do toRegisterConversation :: -- | The time stamp the conversation was created at UTCTime -> - -- | The user that created the conversation - Qualified UserId -> + -- | The domain of the user that created the conversation + Domain -> -- | The conversation to convert for sending to a remote Galley Data.Conversation -> -- | The resulting information to be sent to a remote Galley RegisterConversation -toRegisterConversation now (Qualified _usr localDomain) Data.Conversation {..} = +toRegisterConversation now localDomain Data.Conversation {..} = MkRegisterConversation { rcTime = now, rcOrigUserId = Qualified convCreator localDomain, @@ -484,12 +484,12 @@ fromRegisterConversation (Qualified usr localDomain) MkRegisterConversation {..} registerRemoteConversationMemberships :: -- | The time stamp when the conversation was created UTCTime -> - -- | The user that created the conversation - Qualified UserId -> + -- | The domain of the user that created the conversation + Domain -> Data.Conversation -> Galley () -registerRemoteConversationMemberships now qusr c = do - let rc = toRegisterConversation now qusr c +registerRemoteConversationMemberships now localDomain c = do + let rc = toRegisterConversation now localDomain c -- FUTUREWORK: parallelise federated requests traverse_ (registerRemoteConversations rc) . Map.keys From cc7a9e8af164a0b7d9704fb2dd5bb6eda72b4099 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marko=20Dimja=C5=A1evi=C4=87?= Date: Mon, 21 Jun 2021 13:16:53 +0200 Subject: [PATCH 16/17] Fix Ormolu formatting issues --- services/galley/src/Galley/API/Federation.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/services/galley/src/Galley/API/Federation.hs b/services/galley/src/Galley/API/Federation.hs index a969f821057..4bea962ab8e 100644 --- a/services/galley/src/Galley/API/Federation.hs +++ b/services/galley/src/Galley/API/Federation.hs @@ -31,7 +31,7 @@ import Servant.API.Generic (ToServantApi) import Servant.Server.Generic (genericServerT) import Wire.API.Conversation.Member (Member, memId) import Wire.API.Event.Conversation -import Wire.API.Federation.API.Galley (ConversationMemberUpdate (..), RegisterConversation (..), GetConversationsRequest (..), GetConversationsResponse (..)) +import Wire.API.Federation.API.Galley (ConversationMemberUpdate (..), GetConversationsRequest (..), GetConversationsResponse (..), RegisterConversation (..)) import qualified Wire.API.Federation.API.Galley as FederationAPIGalley federationSitemap :: ServerT (ToServantApi FederationAPIGalley.Api) Galley From c07078e2c89adcb3f05f80e0ee0dbb066d9f6f64 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marko=20Dimja=C5=A1evi=C4=87?= Date: Mon, 21 Jun 2021 16:43:45 +0200 Subject: [PATCH 17/17] Rename a path to a federation endpoint for new conversations --- libs/wire-api-federation/src/Wire/API/Federation/API/Galley.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) 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 068f88c3074..f78d5823df6 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 @@ -46,7 +46,7 @@ data Api routes = Api routes :- "federation" :> Summary "Register users to be in a new remote conversation" - :> "create-conversation" + :> "register-conversation" :> ReqBody '[JSON] RegisterConversation :> Post '[JSON] (), getConversations ::