Federation: Notify Remote Users of Being Added to a New Conversation

libs/wire-api-federation/src/Wire/API/Federation/API/Galley.hs

@@ -19,15 +19,18 @@ 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
-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 (..))
-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
@@ -38,7 +41,15 @@ import Wire.API.Federation.Util.Aeson (CustomEncoded (CustomEncoded))
 -- for the current list we need.
 
 data Api routes = Api
-  { getConversations ::
+  { -- | Register a new conversation
+    registerConversation ::
+      routes
+        :- "federation"
+        :> Summary "Register users to be in a new remote conversation"
+        :> "register-conversation"
+        :> ReqBody '[JSON] RegisterConversation
+        :> Post '[JSON] (),
+    getConversations ::
       routes
         :- "federation"
         :> "get-conversations"
@@ -70,6 +81,31 @@ newtype GetConversationsResponse = GetConversationsResponse
   deriving (Arbitrary) via (GenericUniform GetConversationsResponse)
   deriving (ToJSON, FromJSON) via (CustomEncoded GetConversationsResponse)
 
+-- | A record type describing a new federated conversation
+--
+-- 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
+    rcTime :: UTCTime,
+    -- | The user that created the conversation
+    rcOrigUserId :: Qualified UserId,
+    -- | The qualified conversation ID
+    rcCnvId :: Qualified ConvId,
+    -- | The conversation type
+    rcCnvType :: ConvType,
+    rcCnvAccess :: [Access],
+    rcCnvAccessRole :: AccessRole,
+    -- | The conversation name,
+    rcCnvName :: Maybe Text,
+    -- | Members of the conversation grouped by their domain
+    rcMembers :: Map Domain [Member],
+    rcMessageTimer :: Maybe Milliseconds,
+    rcReceiptMode :: Maybe ReceiptMode
+  }
+  deriving stock (Eq, Show, Generic)
+  deriving (ToJSON, FromJSON) via (CustomEncoded RegisterConversation)
+
 data ConversationMemberUpdate = ConversationMemberUpdate
   { cmuTime :: UTCTime,
     cmuOrigUserId :: Qualified UserId,

libs/wire-api/src/Wire/API/Conversation.hs

@@ -100,11 +100,14 @@ import Wire.API.Conversation.Role (RoleName, roleNameWireAdmin)
 data Conversation = Conversation
   { cnvId :: ConvId,
     cnvType :: ConvType,
+    -- FUTUREWORK: Make this a qualified user ID.
     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

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,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,49 @@ 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
+        )
+  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 ::
+  -- | 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 <!! (const 200 === statusCode)
+  let conv = responseJsonUnsafeWithMsg (msg <> " - 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
   alice <- randomUser brig1

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
@@ -326,6 +326,14 @@ 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
+  registerRemoteConversationMemberships now localDomain c
+  -- Notify local users
   pushSome =<< mapM (toPush localDomain now) (Data.convLocalMembers c)
   where
     route

services/galley/src/Galley/API/Federation.hs

@@ -17,27 +17,55 @@
 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 (fromRegisterConversation, 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 (..), 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
 federationSitemap =
   genericServerT $
     FederationAPIGalley.Api
-      { FederationAPIGalley.getConversations = getConversations,
+      { FederationAPIGalley.registerConversation = registerConversation,
+        FederationAPIGalley.getConversations = getConversations,
         FederationAPIGalley.updateConversationMemberships = updateConversationMemberships
       }
 
+registerConversation :: RegisterConversation -> Galley ()
+registerConversation rc = do
+  localDomain <- viewFederationDomain
+  let localUsers = fmap (toQualified localDomain) . getLocals $ localDomain
+      localUserIds = map qUnqualified localUsers
+  unless (null localUsers) $ do
+    Data.addLocalMembersToRemoteConv localUserIds (rcCnvId rc)
+  forM_ localUsers $ \usr -> do
+    c <- fromRegisterConversation usr rc
+    let event =
+          Event
+            ConvCreate
+            (rcCnvId rc)
+            (rcOrigUserId rc)
+            (rcTime rc)
+            (EdConversation c)
+    pushConversationEvent event [qUnqualified usr] []
+  where
+    getLocals :: Domain -> [Member]
+    getLocals localDomain = fromMaybe [] . Map.lookup localDomain . rcMembers $ rc
+    toQualified :: Domain -> Member -> Qualified UserId
+    toQualified domain mem = Qualified (memId mem) domain
+
 getConversations :: GetConversationsRequest -> Galley GetConversationsResponse
 getConversations (GetConversationsRequest qUid gcrConvIds) = do
   domain <- viewFederationDomain