diff --git a/services/galley/src/Galley/API/Federation.hs b/services/galley/src/Galley/API/Federation.hs index 2824835dd5..a03cdb2c51 100644 --- a/services/galley/src/Galley/API/Federation.hs +++ b/services/galley/src/Galley/API/Federation.hs @@ -23,11 +23,9 @@ import Control.Error import Control.Lens (itraversed, preview, to, (<.>)) import Data.Bifunctor import Data.ByteString.Conversion (toByteString') -import Data.Containers.ListUtils (nubOrd) import Data.Domain (Domain) import Data.Id import Data.Json.Util -import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.Map as Map import Data.Map.Lens (toMapOf) import Data.Qualified @@ -48,11 +46,11 @@ import Galley.API.MLS.Welcome import qualified Galley.API.Mapping as Mapping import Galley.API.Message import Galley.API.Push +import Galley.API.Update import Galley.API.Util import Galley.App import qualified Galley.Data.Conversation as Data import Galley.Effects -import qualified Galley.Effects.BrigAccess as E import qualified Galley.Effects.ConversationStore as E import qualified Galley.Effects.FireAndForget as E import qualified Galley.Effects.MemberStore as E @@ -71,7 +69,6 @@ import qualified Polysemy.TinyLog as P import Servant (ServerT) import Servant.API import qualified System.Logger.Class as Log -import Wire.API.Connection import Wire.API.Conversation hiding (Member) import qualified Wire.API.Conversation as Public import Wire.API.Conversation.Action @@ -93,7 +90,6 @@ import Wire.API.MLS.Serialisation import Wire.API.MLS.SubConversation import Wire.API.MLS.Welcome import Wire.API.Message -import Wire.API.Routes.Internal.Brig.Connection import Wire.API.Routes.Named import Wire.API.ServantProto @@ -216,9 +212,6 @@ getConversations domain (F.GetConversationsRequest uid cids) = do . mapMaybe (Mapping.conversationToRemote (tDomain loc) ruid) <$> E.getConversations cids -getLocalUsers :: Domain -> NonEmpty (Qualified UserId) -> [UserId] -getLocalUsers localDomain = map qUnqualified . filter ((== localDomain) . qDomain) . toList - -- | Update the local database with information on conversation members joining -- or leaving. Finally, push out notifications to local users. onConversationUpdated :: @@ -232,99 +225,7 @@ onConversationUpdated :: Domain -> F.ConversationUpdate -> Sem r () -onConversationUpdated requestingDomain cu = do - loc <- qualifyLocal () - let rconvId = toRemoteUnsafe requestingDomain (F.cuConvId cu) - qconvId = tUntagged rconvId - - -- Note: we generally do not send notifications to users that are not part of - -- the conversation (from our point of view), to prevent spam from the remote - -- backend. See also the comment below. - (presentUsers, allUsersArePresent) <- - E.selectRemoteMembers (F.cuAlreadyPresentUsers cu) rconvId - - -- Perform action, and determine extra notification targets. - -- - -- When new users are being added to the conversation, we consider them as - -- notification targets. Since we check connections before letting - -- people being added, this is safe against spam. However, if users that - -- are not in the conversations are being removed or have their membership state - -- updated, we do **not** add them to the list of targets, because we have no - -- way to make sure that they are actually supposed to receive that notification. - - (mActualAction :: Maybe SomeConversationAction, extraTargets :: [UserId]) <- case F.cuAction cu of - sca@(SomeConversationAction singTag action) -> case singTag of - SConversationJoinTag -> do - let ConversationJoin toAdd role = action - let (localUsers, remoteUsers) = partitionQualified loc toAdd - addedLocalUsers <- Set.toList <$> addLocalUsersToRemoteConv rconvId (F.cuOrigUserId cu) localUsers - let allAddedUsers = map (tUntagged . qualifyAs loc) addedLocalUsers <> map tUntagged remoteUsers - case allAddedUsers of - [] -> pure (Nothing, []) -- If no users get added, its like no action was performed. - (u : us) -> pure (Just (SomeConversationAction (sing @'ConversationJoinTag) (ConversationJoin (u :| us) role)), addedLocalUsers) - SConversationLeaveTag -> do - let users = foldQualified loc (pure . tUnqualified) (const []) (F.cuOrigUserId cu) - E.deleteMembersInRemoteConversation rconvId users - pure (Just sca, []) - SConversationRemoveMembersTag -> do - let localUsers = getLocalUsers (tDomain loc) action - E.deleteMembersInRemoteConversation rconvId localUsers - pure (Just sca, []) - SConversationMemberUpdateTag -> - pure (Just sca, []) - SConversationDeleteTag -> do - E.deleteMembersInRemoteConversation rconvId presentUsers - pure (Just sca, []) - SConversationRenameTag -> pure (Just sca, []) - SConversationMessageTimerUpdateTag -> pure (Just sca, []) - SConversationReceiptModeUpdateTag -> pure (Just sca, []) - SConversationAccessDataTag -> pure (Just sca, []) - - unless allUsersArePresent $ - P.warn $ - Log.field "conversation" (toByteString' (F.cuConvId cu)) - . Log.field "domain" (toByteString' requestingDomain) - . Log.msg - ( "Attempt to send notification about conversation update \ - \to users not in the conversation" :: - ByteString - ) - - -- Send notifications - for_ mActualAction $ \(SomeConversationAction tag action) -> do - let event = conversationActionToEvent tag (F.cuTime cu) (F.cuOrigUserId cu) qconvId Nothing action - targets = nubOrd $ presentUsers <> extraTargets - -- FUTUREWORK: support bots? - pushConversationEvent Nothing event (qualifyAs loc targets) [] - -addLocalUsersToRemoteConv :: - ( Member BrigAccess r, - Member MemberStore r, - Member P.TinyLog r - ) => - Remote ConvId -> - Qualified UserId -> - [UserId] -> - Sem r (Set UserId) -addLocalUsersToRemoteConv remoteConvId qAdder localUsers = do - connStatus <- E.getConnections localUsers (Just [qAdder]) (Just Accepted) - let localUserIdsSet = Set.fromList localUsers - connected = Set.fromList $ fmap csv2From connStatus - unconnected = Set.difference localUserIdsSet connected - connectedList = Set.toList connected - - -- FUTUREWORK: Consider handling the discrepancy between the views of the - -- conversation-owning backend and the local backend - unless (Set.null unconnected) $ - P.warn $ - Log.msg ("A remote user is trying to add unconnected local users to a remote conversation" :: Text) - . Log.field "remote_user" (show qAdder) - . Log.field "local_unconnected_users" (show unconnected) - - -- Update the local view of the remote conversation by adding only those local - -- users that are connected to the adder - E.createMembersInRemoteConversation remoteConvId connectedList - pure connected +onConversationUpdated requestingDomain cu = updateLocalStateOfRemoteConv requestingDomain cu -- as of now this will not generate the necessary events on the leaver's domain leaveConversation :: diff --git a/services/galley/src/Galley/API/Update.hs b/services/galley/src/Galley/API/Update.hs index c09a74bba7..b97eac005c 100644 --- a/services/galley/src/Galley/API/Update.hs +++ b/services/galley/src/Galley/API/Update.hs @@ -39,6 +39,7 @@ module Galley.API.Update updateConversationAccess, deleteLocalConversation, updateRemoteConversation, + updateLocalStateOfRemoteConv, -- * Managing Members addMembersUnqualified, @@ -52,6 +53,7 @@ module Galley.API.Update removeMemberUnqualified, removeMemberFromLocalConv, removeMemberFromRemoteConv, + addLocalUsersToRemoteConv, -- * Talking postProteusMessage, @@ -73,9 +75,13 @@ where import Control.Error.Util (hush) import Control.Lens import Control.Monad.State +import Data.ByteString.Conversion import Data.Code +import Data.Domain import Data.Id import Data.Json.Util +import Data.List.Extra (nubOrd) +import Data.List.NonEmpty (NonEmpty (..)) import Data.List1 import qualified Data.Map.Strict as Map import Data.Qualified @@ -84,7 +90,6 @@ import Data.Singletons import Data.Time import Galley.API.Action import Galley.API.Error -import Galley.API.Federation (onConversationUpdated) import Galley.API.Mapping import Galley.API.Message import qualified Galley.API.Query as Query @@ -94,6 +99,7 @@ import qualified Galley.Data.Conversation as Data import Galley.Data.Services as Data import Galley.Data.Types hiding (Conversation) import Galley.Effects +import qualified Galley.Effects.BrigAccess as E import qualified Galley.Effects.ClientStore as E import qualified Galley.Effects.CodeStore as E import qualified Galley.Effects.ConversationStore as E @@ -120,7 +126,10 @@ import Polysemy import Polysemy.Error import Polysemy.Input import Polysemy.TinyLog +import qualified Polysemy.TinyLog as P import System.Logger (Msg) +import qualified System.Logger.Class as Log +import Wire.API.Connection (Relation (Accepted)) import Wire.API.Conversation hiding (Member) import Wire.API.Conversation.Action import Wire.API.Conversation.Code @@ -131,10 +140,12 @@ import Wire.API.Error.Galley import Wire.API.Event.Conversation import Wire.API.Federation.API import Wire.API.Federation.API.Galley +import qualified Wire.API.Federation.API.Galley as F import Wire.API.Federation.Error import Wire.API.Message import Wire.API.Password (mkSafePassword) import Wire.API.Provider.Service (ServiceRef) +import Wire.API.Routes.Internal.Brig.Connection import Wire.API.Routes.Public.Galley.Messaging import Wire.API.Routes.Public.Util (UpdateResult (..)) import Wire.API.ServantProto (RawProto (..)) @@ -372,7 +383,7 @@ updateRemoteConversation rcnv lusr conn action = getUpdateResult $ do ConversationUpdateResponseError err' -> rethrowErrors @(HasConversationActionGalleyErrors tag) err' ConversationUpdateResponseUpdate convUpdate -> pure convUpdate - onConversationUpdated (tDomain rcnv) convUpdate + updateLocalStateOfRemoteConv (tDomain rcnv) convUpdate notifyRemoteConversationAction lusr (qualifyAs rcnv convUpdate) (Just conn) updateConversationReceiptModeUnqualified :: @@ -1596,6 +1607,113 @@ rmBot lusr zcon b = do E.deliverAsync (bots `zip` repeat e) pure $ Updated e +-- | Update the local database with information on conversation members joining +-- or leaving. Finally, push out notifications to local users. +updateLocalStateOfRemoteConv :: + ( Member BrigAccess r, + Member GundeckAccess r, + Member ExternalAccess r, + Member (Input (Local ())) r, + Member MemberStore r, + Member P.TinyLog r + ) => + Domain -> + F.ConversationUpdate -> + Sem r () +updateLocalStateOfRemoteConv requestingDomain cu = do + loc <- qualifyLocal () + let rconvId = toRemoteUnsafe requestingDomain (F.cuConvId cu) + qconvId = tUntagged rconvId + + -- Note: we generally do not send notifications to users that are not part of + -- the conversation (from our point of view), to prevent spam from the remote + -- backend. See also the comment below. + (presentUsers, allUsersArePresent) <- + E.selectRemoteMembers (F.cuAlreadyPresentUsers cu) rconvId + + -- Perform action, and determine extra notification targets. + -- + -- When new users are being added to the conversation, we consider them as + -- notification targets. Since we check connections before letting + -- people being added, this is safe against spam. However, if users that + -- are not in the conversations are being removed or have their membership state + -- updated, we do **not** add them to the list of targets, because we have no + -- way to make sure that they are actually supposed to receive that notification. + + (mActualAction :: Maybe SomeConversationAction, extraTargets :: [UserId]) <- case F.cuAction cu of + sca@(SomeConversationAction singTag action) -> case singTag of + SConversationJoinTag -> do + let ConversationJoin toAdd role = action + let (localUsers, remoteUsers) = partitionQualified loc toAdd + addedLocalUsers <- Set.toList <$> addLocalUsersToRemoteConv rconvId (F.cuOrigUserId cu) localUsers + let allAddedUsers = map (tUntagged . qualifyAs loc) addedLocalUsers <> map tUntagged remoteUsers + case allAddedUsers of + [] -> pure (Nothing, []) -- If no users get added, its like no action was performed. + (u : us) -> pure (Just (SomeConversationAction (sing @'ConversationJoinTag) (ConversationJoin (u :| us) role)), addedLocalUsers) + SConversationLeaveTag -> do + let users = foldQualified loc (pure . tUnqualified) (const []) (F.cuOrigUserId cu) + E.deleteMembersInRemoteConversation rconvId users + pure (Just sca, []) + SConversationRemoveMembersTag -> do + let localUsers = getLocalUsers (tDomain loc) action + E.deleteMembersInRemoteConversation rconvId localUsers + pure (Just sca, []) + SConversationMemberUpdateTag -> + pure (Just sca, []) + SConversationDeleteTag -> do + E.deleteMembersInRemoteConversation rconvId presentUsers + pure (Just sca, []) + SConversationRenameTag -> pure (Just sca, []) + SConversationMessageTimerUpdateTag -> pure (Just sca, []) + SConversationReceiptModeUpdateTag -> pure (Just sca, []) + SConversationAccessDataTag -> pure (Just sca, []) + + unless allUsersArePresent $ + P.warn $ + Log.field "conversation" (toByteString' (F.cuConvId cu)) + . Log.field "domain" (toByteString' requestingDomain) + . Log.msg + ( "Attempt to send notification about conversation update \ + \to users not in the conversation" :: + ByteString + ) + + -- Send notifications + for_ mActualAction $ \(SomeConversationAction tag action) -> do + let event = conversationActionToEvent tag (F.cuTime cu) (F.cuOrigUserId cu) qconvId Nothing action + targets = nubOrd $ presentUsers <> extraTargets + -- FUTUREWORK: support bots? + pushConversationEvent Nothing event (qualifyAs loc targets) [] + +addLocalUsersToRemoteConv :: + ( Member BrigAccess r, + Member MemberStore r, + Member P.TinyLog r + ) => + Remote ConvId -> + Qualified UserId -> + [UserId] -> + Sem r (Set UserId) +addLocalUsersToRemoteConv remoteConvId qAdder localUsers = do + connStatus <- E.getConnections localUsers (Just [qAdder]) (Just Accepted) + let localUserIdsSet = Set.fromList localUsers + connected = Set.fromList $ fmap csv2From connStatus + unconnected = Set.difference localUserIdsSet connected + connectedList = Set.toList connected + + -- FUTUREWORK: Consider handling the discrepancy between the views of the + -- conversation-owning backend and the local backend + unless (Set.null unconnected) $ + P.warn $ + Log.msg ("A remote user is trying to add unconnected local users to a remote conversation" :: Text) + . Log.field "remote_user" (show qAdder) + . Log.field "local_unconnected_users" (show unconnected) + + -- Update the local view of the remote conversation by adding only those local + -- users that are connected to the adder + E.createMembersInRemoteConversation remoteConvId connectedList + pure connected + ------------------------------------------------------------------------------- -- Helpers diff --git a/services/galley/src/Galley/API/Util.hs b/services/galley/src/Galley/API/Util.hs index 040b327a17..9ab0748eef 100644 --- a/services/galley/src/Galley/API/Util.hs +++ b/services/galley/src/Galley/API/Util.hs @@ -28,6 +28,7 @@ import Data.Domain (Domain) import Data.Id as Id import Data.LegalHold (UserLegalHoldStatus (..), defUserLegalHoldStatus) import Data.List.Extra (chunksOf, nubOrd) +import Data.List.NonEmpty (NonEmpty) import qualified Data.Map as Map import Data.Misc (PlainTextPassword6, PlainTextPassword8) import Data.Qualified @@ -905,6 +906,9 @@ conversationExisted :: Sem r ConversationResponse conversationExisted lusr cnv = Existed <$> conversationView lusr cnv +getLocalUsers :: Domain -> NonEmpty (Qualified UserId) -> [UserId] +getLocalUsers localDomain = map qUnqualified . filter ((== localDomain) . qDomain) . toList + -------------------------------------------------------------------------------- -- Handling remote errors