Make conversation creator unqualified in on-conversation-created RPC

changelog.d/6-federation/unqualify-creator-id

@@ -0,0 +1 @@
+Make the conversation creator field in the `on-conversation-created` RPC unqualified.

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

@@ -22,7 +22,7 @@ import Data.Aeson (FromJSON, ToJSON)
 import Data.Id (ClientId, ConvId, UserId)
 import Data.Json.Util (Base64ByteString)
 import Data.Misc (Milliseconds)
-import Data.Qualified (Qualified)
+import Data.Qualified
 import Data.Time.Clock (UTCTime)
 import Imports
 import Servant.API (JSON, Post, ReqBody, Summary, (:>))
@@ -151,12 +151,10 @@ newtype GetConversationsResponse = GetConversationsResponse
 data NewRemoteConversation conv = NewRemoteConversation
   { -- | The time when the conversation was created
     rcTime :: UTCTime,
-    -- | The user that created the conversation.
-    --
-    -- FUTUREWORK: Make this unqualified and assume that this user has the same domain
-    -- as the backend invoking this RPC. Otehrwise a third party can figure out
-    -- connections.
-    rcOrigUserId :: Qualified UserId,
+    -- | The user that created the conversation. This is implicitly qualified
+    -- by the requesting domain, since it is impossible to create a regular/group
+    -- conversation on a remote backend.
+    rcOrigUserId :: UserId,
     -- | The conversation ID, local to the backend invoking the RPC
     rcCnvId :: conv,
     -- | The conversation type
@@ -173,6 +171,9 @@ data NewRemoteConversation conv = NewRemoteConversation
   deriving stock (Eq, Show, Generic, Functor)
   deriving (ToJSON, FromJSON) via (CustomEncoded (NewRemoteConversation conv))
 
+rcRemoteOrigUserId :: NewRemoteConversation (Remote ConvId) -> Remote UserId
+rcRemoteOrigUserId rc = qualifyAs (rcCnvId rc) (rcOrigUserId rc)
+
 data ConversationUpdate = ConversationUpdate
   { cuTime :: UTCTime,
     cuOrigUserId :: Qualified UserId,

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

@@ -28,7 +28,7 @@ import Data.Json.Util (Base64ByteString (..))
 import Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.Map as Map
 import Data.Map.Lens (toMapOf)
-import Data.Qualified (Qualified (..), Remote, partitionQualified, qUntagged, qualifyAs, toRemoteUnsafe)
+import Data.Qualified
 import qualified Data.Set as Set
 import qualified Data.Text.Lazy as LT
 import Galley.API.Error (invalidPayload)
@@ -82,26 +82,34 @@ federationSitemap =
 onConversationCreated :: Domain -> NewRemoteConversation ConvId -> Galley ()
 onConversationCreated domain rc = do
   let qrc = fmap (toRemoteUnsafe domain) rc
-  localDomain <- viewFederationDomain
-  let (localMembers, remoteMembers) =
-        Set.partition (\om -> qDomain (omQualifiedId om) == localDomain)
-          . rcMembers
-          $ rc
-      localUserIds = qUnqualified . omQualifiedId <$> Set.toList localMembers
+  loc <- qualifyLocal ()
+  let (localUserIds, _) = partitionQualified loc (map omQualifiedId (toList (rcMembers rc)))
 
-  addedUserIds <- addLocalUsersToRemoteConv (rcCnvId qrc) (rcOrigUserId rc) localUserIds
+  addedUserIds <-
+    addLocalUsersToRemoteConv
+      (rcCnvId qrc)
+      (qUntagged (FederationAPIGalley.rcRemoteOrigUserId qrc))
+      localUserIds
 
-  let connectedLocalMembers = Set.filter (\m -> (qUnqualified . omQualifiedId) m `Set.member` addedUserIds) localMembers
+  let connectedMembers =
+        Set.filter
+          ( foldQualified
+              loc
+              (flip Set.member addedUserIds . tUnqualified)
+              (const True)
+              . omQualifiedId
+          )
+          (rcMembers rc)
   -- Make sure to notify only about local users connected to the adder
-  let qrcConnected = qrc {rcMembers = Set.union remoteMembers connectedLocalMembers}
+  let qrcConnected = qrc {rcMembers = connectedMembers}
 
-  forM_ (fromNewRemoteConversation localDomain qrcConnected) $ \(mem, c) -> do
+  forM_ (fromNewRemoteConversation loc qrcConnected) $ \(mem, c) -> do
     let event =
           Event
             ConvCreate
-            (qUntagged (rcCnvId qrc))
-            (rcOrigUserId rc)
-            (rcTime rc)
+            (qUntagged (rcCnvId qrcConnected))
+            (qUntagged (FederationAPIGalley.rcRemoteOrigUserId qrcConnected))
+            (rcTime qrcConnected)
             (EdConversation c)
     pushConversationEvent Nothing event [Public.memId mem] []
 
@@ -148,7 +156,7 @@ onConversationUpdated requestingDomain cu = do
         (u : us) -> pure (Just $ ConversationActionAddMembers (u :| us) role, addedLocalUsers)
     ConversationActionRemoveMembers toRemove -> do
       let localUsers = getLocalUsers localDomain toRemove
-      Data.removeLocalMembersFromRemoteConv qconvId localUsers
+      Data.removeLocalMembersFromRemoteConv rconvId localUsers
       pure (Just $ cuAction cu, [])
     ConversationActionRename _ -> pure (Just $ cuAction cu, [])
     ConversationActionMessageTimerUpdate _ -> pure (Just $ cuAction cu, [])
@@ -192,7 +200,7 @@ addLocalUsersToRemoteConv remoteConvId qAdder localUsers = do
 
   -- Update the local view of the remote conversation by adding only those local
   -- users that are connected to the adder
-  Data.addLocalMembersToRemoteConv (qUntagged remoteConvId) connectedList
+  Data.addLocalMembersToRemoteConv remoteConvId connectedList
   pure connected
 
 -- FUTUREWORK: actually return errors as part of the response instead of throwing

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

@@ -64,9 +64,9 @@ iUpsertOne2OneConversation UpsertOne2OneConversationRequest {..} = do
       doremote rconvId =
         case (uooActor, uooActorDesiredMembership) of
           (LocalActor, Included) -> do
-            Data.addLocalMembersToRemoteConv (qUntagged rconvId) [tUnqualified uooLocalUser]
+            Data.addLocalMembersToRemoteConv rconvId [tUnqualified uooLocalUser]
           (LocalActor, Excluded) -> do
-            Data.removeLocalMembersFromRemoteConv (qUntagged rconvId) [tUnqualified uooLocalUser]
+            Data.removeLocalMembersFromRemoteConv rconvId [tUnqualified uooLocalUser]
           (RemoteActor, _) -> pure ()
 
   foldQualified uooLocalUser dolocal doremote convId

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

@@ -655,7 +655,7 @@ toNewRemoteConversation ::
 toNewRemoteConversation now localDomain Data.Conversation {..} =
   NewRemoteConversation
     { rcTime = now,
-      rcOrigUserId = Qualified convCreator localDomain,
+      rcOrigUserId = convCreator,
       rcCnvId = convId,
       rcCnvType = convType,
       rcCnvAccess = convAccess,
@@ -681,20 +681,24 @@ toNewRemoteConversation now localDomain Data.Conversation {..} =
 -- be sent out to users informing them that they were added to a new
 -- conversation.
 fromNewRemoteConversation ::
-  Domain ->
+  Local x ->
   NewRemoteConversation (Remote ConvId) ->
   [(Public.Member, Public.Conversation)]
-fromNewRemoteConversation d NewRemoteConversation {..} =
+fromNewRemoteConversation loc rc@NewRemoteConversation {..} =
   let membersView = fmap (second Set.toList) . setHoles $ rcMembers
-      creatorOther = OtherMember rcOrigUserId Nothing roleNameWireAdmin
+      creatorOther =
+        OtherMember
+          (qUntagged (rcRemoteOrigUserId rc))
+          Nothing
+          roleNameWireAdmin
    in foldMap
         ( \(me, others) ->
             guard (inDomain me) $> let mem = toMember me in (mem, conv mem (creatorOther : others))
         )
         membersView
   where
     inDomain :: OtherMember -> Bool
-    inDomain = (== d) . qDomain . omQualifiedId
+    inDomain = (== tDomain loc) . qDomain . omQualifiedId
     setHoles :: Ord a => Set a -> [(a, Set a)]
     setHoles s = foldMap (\x -> [(x, Set.delete x s)]) s
     -- Currently this function creates a Member with default conversation attributes
@@ -720,7 +724,7 @@ fromNewRemoteConversation d NewRemoteConversation {..} =
           { cnvmType = rcCnvType,
             -- FUTUREWORK: Document this is the same domain as the conversation
             -- domain
-            cnvmCreator = qUnqualified rcOrigUserId,
+            cnvmCreator = rcOrigUserId,
             cnvmAccess = rcCnvAccess,
             cnvmAccessRole = rcCnvAccessRole,
             cnvmName = rcCnvName,

services/galley/src/Galley/Data.hs

@@ -966,9 +966,9 @@ addMembers (tUnqualified -> conv) (fmap toUserRole -> UserList lusers rusers) =
 -- | 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 => Qualified ConvId -> [UserId] -> m ()
+addLocalMembersToRemoteConv :: MonadClient m => Remote ConvId -> [UserId] -> m ()
 addLocalMembersToRemoteConv _ [] = pure ()
-addLocalMembersToRemoteConv qconv users = do
+addLocalMembersToRemoteConv rconv users = do
   -- FUTUREWORK: consider using pooledMapConcurrentlyN
   for_ (List.chunksOf 32 users) $ \chunk ->
     retry x5 . batch $ do
@@ -977,7 +977,7 @@ addLocalMembersToRemoteConv qconv users = do
       for_ chunk $ \u ->
         addPrepQuery
           Cql.insertUserRemoteConv
-          (u, qDomain qconv, qUnqualified qconv)
+          (u, tDomain rconv, tUnqualified rconv)
 
 updateSelfMember ::
   MonadClient m =>
@@ -1117,12 +1117,12 @@ removeRemoteMembersFromLocalConv cnv victims = do
 removeLocalMembersFromRemoteConv ::
   MonadClient m =>
   -- | The conversation to remove members from
-  Qualified ConvId ->
+  Remote ConvId ->
   -- | Members to remove local to this backend
   [UserId] ->
   m ()
 removeLocalMembersFromRemoteConv _ [] = pure ()
-removeLocalMembersFromRemoteConv (Qualified conv convDomain) victims =
+removeLocalMembersFromRemoteConv (qUntagged -> Qualified conv convDomain) victims =
   retry x5 . batch $ do
     setType BatchLogged
     setConsistency Quorum

services/galley/test/integration/API.hs

@@ -287,7 +287,6 @@ postConvOk = do
     rsp <-
       postConv alice [bob, jane] (Just nameMaxSize) [] Nothing Nothing
         <!! const 201 === statusCode
-    print rsp
     cid <- assertConv rsp RegularConv alice alice [bob, jane] (Just nameMaxSize) Nothing
     cvs <- mapM (convView cid) [alice, bob, jane]
     liftIO $ mapM_ WS.assertSuccess =<< Async.mapConcurrently (checkWs qalice) (zip cvs [wsA, wsB, wsJ])
@@ -1945,7 +1944,7 @@ testGetQualifiedRemoteConv = do
       aliceAsSelfMember = localMemberToSelf aliceAsLocal
 
   connectWithRemoteUser aliceId bobQ
-  registerRemoteConv remoteConvId bobQ Nothing (Set.fromList [aliceAsOtherMember])
+  registerRemoteConv remoteConvId bobId Nothing (Set.fromList [aliceAsOtherMember])
 
   let mockConversation = mkConv convId bobId roleNameWireAdmin [bobAsOtherMember]
       remoteConversationResponse = GetConversationsResponse [mockConversation]
@@ -1983,11 +1982,10 @@ testGetQualifiedRemoteConvNotFoundOnRemote = do
   bobId <- randomId
   convId <- randomId
   let remoteDomain = Domain "far-away.example.com"
-      bobQ = Qualified bobId remoteDomain
       remoteConvId = Qualified convId remoteDomain
       aliceAsOtherMember = OtherMember aliceQ Nothing roleNameWireAdmin
 
-  registerRemoteConv remoteConvId bobQ Nothing (Set.fromList [aliceAsOtherMember])
+  registerRemoteConv remoteConvId bobId Nothing (Set.fromList [aliceAsOtherMember])
 
   opts <- view tsGConf
   void . withTempMockFederator opts remoteDomain (const (GetConversationsResponse [])) $ do
@@ -2011,7 +2009,7 @@ testGetQualifiedRemoteConvNotFoundOnRemote = do
 -- - A remote conv on b.far-away.example.com, it is found in the local DB but
 --   the remote does not return it
 --
--- - A remote conv on c.far-away.example.com, for which the federated call fails
+-- - A remote conv on c.far-away.example.com (with Dee), for which the federated call fails
 --
 -- - A local conversation which doesn't exist
 --
@@ -2023,14 +2021,17 @@ testBulkGetQualifiedConvs = do
   let alice = qUnqualified aliceQ
   bobId <- randomId
   carlId <- randomId
+  deeId <- randomId
   let remoteDomainA = Domain "a.far-away.example.com"
       remoteDomainB = Domain "b.far-away.example.com"
       remoteDomainC = Domain "c.far-away.example.com"
       bobQ = Qualified bobId remoteDomainA
       carlQ = Qualified carlId remoteDomainB
+      deeQ = Qualified deeId remoteDomainC
 
   connectWithRemoteUser alice bobQ
   connectWithRemoteUser alice carlQ
+  connectWithRemoteUser alice deeQ
 
   localConv <- responseJsonUnsafe <$> postConv alice [] (Just "gossip") [] Nothing Nothing
   let localConvId = cnvQualifiedId localConv
@@ -2046,10 +2047,10 @@ testBulkGetQualifiedConvs = do
   localConvIdNotParticipating <- decodeQualifiedConvId <$> postConv (qUnqualified eve) [] (Just "gossip about alice!") [] Nothing Nothing
 
   let aliceAsOtherMember = OtherMember aliceQ Nothing roleNameWireAdmin
-  registerRemoteConv remoteConvIdA bobQ Nothing (Set.fromList [aliceAsOtherMember])
-  registerRemoteConv remoteConvIdB carlQ Nothing (Set.fromList [aliceAsOtherMember])
-  registerRemoteConv remoteConvIdBNotFoundOnRemote carlQ Nothing (Set.fromList [aliceAsOtherMember])
-  registerRemoteConv remoteConvIdCFailure carlQ Nothing (Set.fromList [aliceAsOtherMember])
+  registerRemoteConv remoteConvIdA bobId Nothing (Set.fromList [aliceAsOtherMember])
+  registerRemoteConv remoteConvIdB carlId Nothing (Set.fromList [aliceAsOtherMember])
+  registerRemoteConv remoteConvIdBNotFoundOnRemote carlId Nothing (Set.fromList [aliceAsOtherMember])
+  registerRemoteConv remoteConvIdCFailure deeId Nothing (Set.fromList [aliceAsOtherMember])
 
   let bobAsOtherMember = OtherMember bobQ Nothing roleNameWireAdmin
       carlAsOtherMember = OtherMember carlQ Nothing roleNameWireAdmin
@@ -3018,7 +3019,7 @@ removeUser = do
   let nc =
         FederatedGalley.NewRemoteConversation
           { FederatedGalley.rcTime = now,
-            FederatedGalley.rcOrigUserId = dee,
+            FederatedGalley.rcOrigUserId = qUnqualified dee,
             FederatedGalley.rcCnvId = conv4,
             FederatedGalley.rcCnvType = RegularConv,
             FederatedGalley.rcCnvAccess = [],

services/galley/test/integration/API/Federation.hs

@@ -173,7 +173,7 @@ onConvCreated = do
   let requestMembers = Set.fromList (map asOtherMember [qAlice, qCharlie, qDee])
 
   WS.bracketR2 c alice charlie $ \(wsA, wsC) -> do
-    registerRemoteConv qconv qBob (Just "gossip") requestMembers
+    registerRemoteConv qconv (qUnqualified qBob) (Just "gossip") requestMembers
     liftIO $ do
       let expectedSelf = alice
           expectedOthers = [(qBob, roleNameWireAdmin), (qDee, roleNameWireMember)]
@@ -249,7 +249,7 @@ addUnconnectedUsersOnly = do
 
   WS.bracketR c alice $ \wsA -> do
     -- Remote Bob creates a conversation with local Alice
-    registerRemoteConv qconv qBob (Just "gossip") requestMembers
+    registerRemoteConv qconv (qUnqualified qBob) (Just "gossip") requestMembers
     liftIO $ do
       let expectedSelf = alice
           expectedOthers = [(qBob, roleNameWireAdmin)]
@@ -363,7 +363,7 @@ removeRemoteUser = do
   now <- liftIO getCurrentTime
 
   mapM_ (`connectWithRemoteUser` qBob) [alice, dee]
-  registerRemoteConv qconv qBob (Just "gossip") (Set.fromList [aliceAsOtherMember, deeAsOtherMember, eveAsOtherMember])
+  registerRemoteConv qconv (qUnqualified qBob) (Just "gossip") (Set.fromList [aliceAsOtherMember, deeAsOtherMember, eveAsOtherMember])
 
   let cuRemove user =
         FedGalley.ConversationUpdate
@@ -413,7 +413,7 @@ notifyUpdate extras action etype edata = do
   mapM_ (`connectWithRemoteUser` qbob) [alice]
   registerRemoteConv
     qconv
-    qbob
+    bob
     (Just "gossip")
     (Set.fromList (map mkMember (qalice : extras)))
 
@@ -524,7 +524,7 @@ addRemoteUser = do
 
   mapM_ (flip connectWithRemoteUser qbob . qUnqualified) [qalice, qdee]
 
-  registerRemoteConv qconv qbob (Just "gossip") (Set.fromList (map asOtherMember [qalice, qdee, qeve]))
+  registerRemoteConv qconv (qUnqualified qbob) (Just "gossip") (Set.fromList (map asOtherMember [qalice, qdee, qeve]))
 
   -- The conversation owning
   let cu =

services/galley/test/integration/API/Util.hs

@@ -1239,7 +1239,7 @@ getTeamQueue' zusr msince msize onlyLast = do
 asOtherMember :: Qualified UserId -> OtherMember
 asOtherMember quid = OtherMember quid Nothing roleNameWireMember
 
-registerRemoteConv :: Qualified ConvId -> Qualified UserId -> Maybe Text -> Set OtherMember -> TestM ()
+registerRemoteConv :: Qualified ConvId -> UserId -> Maybe Text -> Set OtherMember -> TestM ()
 registerRemoteConv convId originUser name othMembers = do
   fedGalleyClient <- view tsFedGalleyClient
   now <- liftIO getCurrentTime