Skip to content

Commit

Permalink
Complete FUTUREWORK: remove import dependency (#3291)
Browse files Browse the repository at this point in the history
  • Loading branch information
@smatting
smatting authored May 11, 2023
1 parent 2fd31da commit 0b1e04c
Show file tree
Hide file tree
Showing 3 changed files with 126 additions and 103 deletions.
103 changes: 2 additions & 101 deletions services/galley/src/Galley/API/Federation.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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

Expand Down Expand Up @@ -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 ::
Expand All @@ -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 ::
Expand Down
122 changes: 120 additions & 2 deletions services/galley/src/Galley/API/Update.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -39,6 +39,7 @@ module Galley.API.Update
updateConversationAccess,
deleteLocalConversation,
updateRemoteConversation,
updateLocalStateOfRemoteConv,

-- * Managing Members
addMembersUnqualified,
Expand All @@ -52,6 +53,7 @@ module Galley.API.Update
removeMemberUnqualified,
removeMemberFromLocalConv,
removeMemberFromRemoteConv,
addLocalUsersToRemoteConv,

-- * Talking
postProteusMessage,
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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 (..))
Expand Down Expand Up @@ -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 ::
Expand Down Expand Up @@ -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

Expand Down
4 changes: 4 additions & 0 deletions services/galley/src/Galley/API/Util.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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

Expand Down

0 comments on commit 0b1e04c

Please sign in to comment.