From e92c20f93af9147ae91bbe1a83ad61c00dc2f12a Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Wed, 8 Sep 2021 16:25:18 +0200 Subject: [PATCH 01/19] Add migration and update queries --- docs/reference/cassandra-schema.cql | 6 +++ services/galley/galley.cabal | 3 +- services/galley/schema/src/Main.hs | 4 +- .../schema/src/V53_AddRemoteConvStatus.hs | 38 +++++++++++++++++++ services/galley/src/Galley/Data.hs | 2 +- services/galley/src/Galley/Data/Queries.hs | 15 +++++++- 6 files changed, 64 insertions(+), 4 deletions(-) create mode 100644 services/galley/schema/src/V53_AddRemoteConvStatus.hs diff --git a/docs/reference/cassandra-schema.cql b/docs/reference/cassandra-schema.cql index e9383b3618..fd39a8753e 100644 --- a/docs/reference/cassandra-schema.cql +++ b/docs/reference/cassandra-schema.cql @@ -105,6 +105,12 @@ CREATE TABLE galley_test.user_remote_conv ( user uuid, conv_remote_domain text, conv_remote_id uuid, + hidden boolean, + hidden_ref text, + otr_archived boolean, + otr_archived_ref text, + otr_muted_ref text, + otr_muted_status int, PRIMARY KEY (user, conv_remote_domain, conv_remote_id) ) WITH CLUSTERING ORDER BY (conv_remote_domain ASC, conv_remote_id ASC) AND bloom_filter_fp_chance = 0.1 diff --git a/services/galley/galley.cabal b/services/galley/galley.cabal index 0357c2adca..3584ea4e7b 100644 --- a/services/galley/galley.cabal +++ b/services/galley/galley.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: 0acb724202f4ba39242c1ebbe5f5db555404624b7a6be922d5a4148d38c5786d +-- hash: 6e5e3f9e94d96cbfe4ae8b0a52783bc3e354f3c58a29208cfd6e120a25d871d6 name: galley version: 0.83.0 @@ -361,6 +361,7 @@ executable galley-schema V50_AddLegalholdWhitelisted V51_FeatureFileSharing V52_FeatureConferenceCalling + V53_AddRemoteConvStatus Paths_galley hs-source-dirs: schema/src diff --git a/services/galley/schema/src/Main.hs b/services/galley/schema/src/Main.hs index 5d2b408c42..c350df9f4d 100644 --- a/services/galley/schema/src/Main.hs +++ b/services/galley/schema/src/Main.hs @@ -55,6 +55,7 @@ import qualified V49_ReAddRemoteIdentifiers import qualified V50_AddLegalholdWhitelisted import qualified V51_FeatureFileSharing import qualified V52_FeatureConferenceCalling +import qualified V53_AddRemoteConvStatus main :: IO () main = do @@ -95,7 +96,8 @@ main = do V49_ReAddRemoteIdentifiers.migration, V50_AddLegalholdWhitelisted.migration, V51_FeatureFileSharing.migration, - V52_FeatureConferenceCalling.migration + V52_FeatureConferenceCalling.migration, + V53_AddRemoteConvStatus.migration -- When adding migrations here, don't forget to update -- 'schemaVersion' in Galley.Data -- (see also docs/developer/cassandra-interaction.md) diff --git a/services/galley/schema/src/V53_AddRemoteConvStatus.hs b/services/galley/schema/src/V53_AddRemoteConvStatus.hs new file mode 100644 index 0000000000..0688e82493 --- /dev/null +++ b/services/galley/schema/src/V53_AddRemoteConvStatus.hs @@ -0,0 +1,38 @@ +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2021 Wire Swiss GmbH +-- +-- This program is free software: you can redistribute it and/or modify it under +-- the terms of the GNU Affero General Public License as published by the Free +-- Software Foundation, either version 3 of the License, or (at your option) any +-- later version. +-- +-- This program is distributed in the hope that it will be useful, but WITHOUT +-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more +-- details. +-- +-- You should have received a copy of the GNU Affero General Public License along +-- with this program. If not, see . + +module V53_AddRemoteConvStatus (migration) where + +import Cassandra.Schema +import Imports +import Text.RawString.QQ + +-- This migration adds fields that track remote conversation status for a local user. +migration :: Migration +migration = + Migration 53 "Add fields for remote conversation status (hidden/archived/muted)" $ + schema' + [r| + ALTER TABLE user_remote_conv ADD ( + hidden boolean, + hidden_ref text, + otr_archived boolean, + otr_archived_ref text, + otr_muted_status int, + otr_muted_ref text + ) + |] diff --git a/services/galley/src/Galley/Data.hs b/services/galley/src/Galley/Data.hs index ef4d8f8a4b..7bf3abb6bd 100644 --- a/services/galley/src/Galley/Data.hs +++ b/services/galley/src/Galley/Data.hs @@ -191,7 +191,7 @@ mkResultSet page = ResultSet (result page) typ | otherwise = ResultSetComplete schemaVersion :: Int32 -schemaVersion = 52 +schemaVersion = 53 -- | Insert a conversation code insertCode :: MonadClient m => Code -> m () diff --git a/services/galley/src/Galley/Data/Queries.hs b/services/galley/src/Galley/Data/Queries.hs index a54d3dcbf0..2f0176287e 100644 --- a/services/galley/src/Galley/Data/Queries.hs +++ b/services/galley/src/Galley/Data/Queries.hs @@ -283,7 +283,6 @@ updateMemberConvRoleName = "update member set conversation_role = ? where conv = -- Federated conversations ----------------------------------------------------- -- -- FUTUREWORK(federation): allow queries for pagination to support more than 500 (?) conversations for a user. --- FUTUREWORK(federation): support other conversation attributes such as muted, archived, etc -- local conversation with remote members @@ -307,12 +306,26 @@ selectUserRemoteConvs = "select conv_remote_domain, conv_remote_id from user_rem selectRemoteConvMembership :: PrepQuery R (UserId, Domain, ConvId) (Identity UserId) selectRemoteConvMembership = "select user from user_remote_conv where user = ? and conv_remote_domain = ? and conv_remote_id = ?" +selectRemoteConvMember :: PrepQuery R (Domain, ConvId, UserId) (Maybe MutedStatus, Maybe Text, Maybe Bool, Maybe Text, Maybe Bool, Maybe Text, Maybe RoleName) +selectRemoteConvMember = "select otr_muted_status, otr_muted_ref, otr_archived, otr_archived_ref, hidden, hidden_ref, conversation_role from user_remote_conv where conv_remote_domain = ? and conv_remote_id = ? and user = ?" + selectRemoteConvMembershipIn :: PrepQuery R (UserId, Domain, [ConvId]) (Identity ConvId) selectRemoteConvMembershipIn = "select conv_remote_id from user_remote_conv where user = ? and conv_remote_domain = ? and conv_remote_id in ?" deleteUserRemoteConv :: PrepQuery W (UserId, Domain, ConvId) () deleteUserRemoteConv = "delete from user_remote_conv where user = ? and conv_remote_domain = ? and conv_remote_id = ?" +-- remote conversation status for local user + +updateRemoteOtrMemberMutedStatus :: PrepQuery W (MutedStatus, Maybe Text, Domain, ConvId, UserId) () +updateRemoteOtrMemberMutedStatus = "update user_remote_conv set otr_muted_status = ?, otr_muted_ref = ? where conv_remote_domain = ? and conv_remote_id = ? and user = ?" + +updateRemoteOtrMemberArchived :: PrepQuery W (Bool, Maybe Text, Domain, ConvId, UserId) () +updateRemoteOtrMemberArchived = "update user_remote_conv set otr_archived = ?, otr_archived_ref = ? where conv_remote_domain = ? and conv_remote_id = ? and user = ?" + +updateRemoteMemberHidden :: PrepQuery W (Bool, Maybe Text, Domain, ConvId, UserId) () +updateRemoteMemberHidden = "update user_remote_conv set otr_hidden = ?, otr_hidden_ref = ? where conv_remote_domain = ? and conv_remote_id = ? and user = ?" + -- Clients ------------------------------------------------------------------ selectClients :: PrepQuery R (Identity [UserId]) (UserId, C.Set ClientId) From f4132589c172b74192d257892eaee413c5ca453a Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Thu, 9 Sep 2021 09:24:56 +0200 Subject: [PATCH 02/19] Fix typo --- services/galley/test/integration/API.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/services/galley/test/integration/API.hs b/services/galley/test/integration/API.hs index aede4721e2..b8cdacf9a3 100644 --- a/services/galley/test/integration/API.hs +++ b/services/galley/test/integration/API.hs @@ -880,7 +880,7 @@ postMessageQualifiedLocalOwningBackendFailedToSendClients = do } galleyApi = emptyFederatedGalley - { FederatedGalley.onMessageSent = \_ _ -> throwError err503 {errBody = "Down for maintanance."} + { FederatedGalley.onMessageSent = \_ _ -> throwError err503 {errBody = "Down for maintenance."} } (resp2, _requests) <- postProteusMessageQualifiedWithMockFederator aliceUnqualified aliceClient convId message "data" Message.MismatchReportAll brigApi galleyApi @@ -914,7 +914,7 @@ postMessageQualifiedRemoteOwningBackendFailure = do let galleyApi = emptyFederatedGalley - { FederatedGalley.sendMessage = \_ _ -> throwError err503 {errBody = "Down for maintanance."} + { FederatedGalley.sendMessage = \_ _ -> throwError err503 {errBody = "Down for maintenance."} } (resp2, _requests) <- From e0a4640aa6cbcd5e5fefa71e923d6be23b6199ea Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Fri, 10 Sep 2021 11:33:42 +0200 Subject: [PATCH 03/19] Add failing test for remote conv status update --- services/galley/test/integration/API.hs | 75 ++++++++++++++++++- services/galley/test/integration/API/Roles.hs | 6 +- services/galley/test/integration/API/Util.hs | 6 +- 3 files changed, 81 insertions(+), 6 deletions(-) diff --git a/services/galley/test/integration/API.hs b/services/galley/test/integration/API.hs index b8cdacf9a3..1b5017355d 100644 --- a/services/galley/test/integration/API.hs +++ b/services/galley/test/integration/API.hs @@ -181,6 +181,7 @@ tests s = test s "member update (otr archive)" putMemberOtrArchiveOk, test s "member update (hidden)" putMemberHiddenOk, test s "member update (everything b)" putMemberAllOk, + test s "remote conversation member update (otr mute)" putRemoteConvMemberOtrMuteOk, test s "conversation receipt mode update" putReceiptModeOk, test s "send typing indicators" postTypingIndicators, test s "leave connect conversation" leaveConnectConversation, @@ -2578,6 +2579,10 @@ putMemberAllOk = } ) +putRemoteConvMemberOtrMuteOk :: TestM () +putRemoteConvMemberOtrMuteOk = + putRemoteConvMemberOk (memberUpdate {mupOtrMuteStatus = Just 0, mupOtrMuteRef = Just "ref"}) + putMemberOk :: MemberUpdate -> TestM () putMemberOk update = do c <- view tsCannon @@ -2603,7 +2608,7 @@ putMemberOk update = do } -- Update member state & verify push notification WS.bracketR c bob $ \ws -> do - putMember bob update conv !!! const 200 === statusCode + putMember bob update qconv !!! const 200 === statusCode void . liftIO . WS.assertMatch (5 # Second) ws $ \n -> do let e = List1.head (WS.unpackPayload n) ntfTransient n @?= False @@ -2633,6 +2638,74 @@ putMemberOk update = do assertEqual "hidden" (memHidden memberBob) (memHidden newBob) assertEqual "hidden_ref" (memHiddenRef memberBob) (memHiddenRef newBob) +putRemoteConvMemberOk :: MemberUpdate -> TestM () +putRemoteConvMemberOk update = do + c <- view tsCannon + qalice <- randomQualifiedUser + let alice = qUnqualified qalice + + -- create a remote conversation with alice + let remoteDomain = Domain "bobland.example.com" + qbob <- Qualified <$> randomId <*> pure remoteDomain + qconv <- Qualified <$> randomId <*> pure remoteDomain + fedGalleyClient <- view tsFedGalleyClient + now <- liftIO getCurrentTime + let cmu = + FederatedGalley.ConversationMemberUpdate + { cmuTime = now, + cmuOrigUserId = qbob, + cmuConvId = qUnqualified qconv, + cmuAlreadyPresentUsers = [], + cmuAction = + FederatedGalley.ConversationMembersActionAdd (pure (qalice, roleNameWireMember)) + } + FederatedGalley.onConversationMembershipsChanged fedGalleyClient remoteDomain cmu + + -- Expected member state + let memberAlice = + Member + { memId = alice, + memService = Nothing, + memOtrMutedStatus = mupOtrMuteStatus update, + memOtrMutedRef = mupOtrMuteRef update, + memOtrArchived = Just True == mupOtrArchive update, + memOtrArchivedRef = mupOtrArchiveRef update, + memHidden = Just True == mupHidden update, + memHiddenRef = mupHiddenRef update, + memConvRoleName = roleNameWireMember + } + -- Update member state & verify push notification + WS.bracketR c alice $ \ws -> do + putMember alice update qconv !!! const 200 === statusCode + void . liftIO . WS.assertMatch (5 # Second) ws $ \n -> do + let e = List1.head (WS.unpackPayload n) + ntfTransient n @?= False + evtConv e @?= qconv + evtType e @?= MemberStateUpdate + evtFrom e @?= qalice + case evtData e of + EdMemberUpdate mis -> do + assertEqual "otr_muted_status" (mupOtrMuteStatus update) (misOtrMutedStatus mis) + assertEqual "otr_muted_ref" (mupOtrMuteRef update) (misOtrMutedRef mis) + assertEqual "otr_archived" (mupOtrArchive update) (misOtrArchived mis) + assertEqual "otr_archived_ref" (mupOtrArchiveRef update) (misOtrArchivedRef mis) + assertEqual "hidden" (mupHidden update) (misHidden mis) + assertEqual "hidden_ref" (mupHiddenRef update) (misHiddenRef mis) + x -> assertFailure $ "Unexpected event data: " ++ show x + -- Verify new member state + rs <- getConvQualified alice qconv responseJsonUnsafe rs + liftIO $ do + assertBool "user" (isJust alice') + let newAlice = fromJust alice' + assertEqual "id" (memId memberAlice) (memId newAlice) + assertEqual "otr_muted_status" (memOtrMutedStatus memberAlice) (memOtrMutedStatus newAlice) + assertEqual "otr_muted_ref" (memOtrMutedRef memberAlice) (memOtrMutedRef newAlice) + assertEqual "otr_archived" (memOtrArchived memberAlice) (memOtrArchived newAlice) + assertEqual "otr_archived_ref" (memOtrArchivedRef memberAlice) (memOtrArchivedRef newAlice) + assertEqual "hidden" (memHidden memberAlice) (memHidden newAlice) + assertEqual "hidden_ref" (memHiddenRef memberAlice) (memHiddenRef newAlice) + putReceiptModeOk :: TestM () putReceiptModeOk = do c <- view tsCannon diff --git a/services/galley/test/integration/API/Roles.hs b/services/galley/test/integration/API/Roles.hs index 72928b1333..ae5d11d529 100644 --- a/services/galley/test/integration/API/Roles.hs +++ b/services/galley/test/integration/API/Roles.hs @@ -154,6 +154,7 @@ wireAdminChecks :: TestM () wireAdminChecks cid admin otherAdmin mem = do let role = roleNameWireAdmin + qcid <- Qualified cid <$> viewFederationDomain other <- randomUser connectUsers admin (singleton other) -- Admins can perform all operations on the conversation; creator is not relevant @@ -183,7 +184,7 @@ wireAdminChecks cid admin otherAdmin mem = do putAccessUpdate admin cid activatedAccess !!! assertActionSucceeded -- Update your own member state let memUpdate = memberUpdate {mupOtrArchive = Just True} - putMember admin memUpdate cid !!! assertActionSucceeded + putMember admin memUpdate qcid !!! assertActionSucceeded -- You can also leave a conversation deleteMemberUnqualified admin admin cid !!! assertActionSucceeded -- Readding the user @@ -199,6 +200,7 @@ wireMemberChecks :: TestM () wireMemberChecks cid mem admin otherMem = do let role = roleNameWireMember + qcid <- Qualified cid <$> viewFederationDomain other <- randomUser connectUsers mem (singleton other) -- Members cannot perform pretty much any action on the conversation @@ -227,7 +229,7 @@ wireMemberChecks cid mem admin otherMem = do -- Update your own member state let memUpdate = memberUpdate {mupOtrArchive = Just True} - putMember mem memUpdate cid !!! assertActionSucceeded + putMember mem memUpdate qcid !!! assertActionSucceeded -- Last option is to leave a conversation deleteMemberUnqualified mem mem cid !!! assertActionSucceeded -- Let's readd the user to make tests easier diff --git a/services/galley/test/integration/API/Util.hs b/services/galley/test/integration/API/Util.hs index aaea6c8a7b..d23d3e664f 100644 --- a/services/galley/test/integration/API/Util.hs +++ b/services/galley/test/integration/API/Util.hs @@ -945,12 +945,12 @@ getSelfMember u c = do . zConn "conn" . zType "access" -putMember :: UserId -> MemberUpdate -> ConvId -> TestM ResponseLBS -putMember u m c = do +putMember :: UserId -> MemberUpdate -> Qualified ConvId -> TestM ResponseLBS +putMember u m (Qualified c dom) = do g <- view tsGalley put $ g - . paths ["conversations", toByteString' c, "self"] + . paths ["conversations", toByteString' dom, toByteString' c, "self"] . zUser u . zConn "conn" . zType "access" From 55d112884fd8e82c726817538219cd8f44efc20c Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Fri, 10 Sep 2021 13:27:26 +0200 Subject: [PATCH 04/19] Refactor `Conversation` to include metadata This factors out metadata fields from the `Conversation` type so that they can be reused elsewhere without duplicating code. At the moment they are only used in the internal `GET i/conversations/:cnv/meta` endpoint, but later on this extraction will be useful to improve the `get-conversations` federation RPC. --- libs/galley-types/src/Galley/Types.hs | 57 ++----- libs/wire-api/src/Wire/API/Conversation.hs | 151 +++++++++++++----- .../ConversationList_20Conversation_user.hs | 45 ++---- .../API/Golden/Generated/Conversation_user.hs | 72 +++++---- .../Wire/API/Golden/Generated/Event_user.hs | 70 ++------ .../Golden/Manual/ConversationsResponse.hs | 72 +++++---- services/brig/src/Brig/Provider/API.hs | 2 +- .../brig/test/integration/API/Provider.hs | 2 +- services/galley/src/Galley/API/Mapping.hs | 2 +- services/galley/src/Galley/API/Query.hs | 5 +- services/galley/src/Galley/API/Util.hs | 31 ++-- services/galley/src/Galley/Data.hs | 16 +- services/galley/test/integration/API.hs | 41 ++--- services/galley/test/integration/API/Util.hs | 23 ++- 14 files changed, 291 insertions(+), 298 deletions(-) diff --git a/libs/galley-types/src/Galley/Types.hs b/libs/galley-types/src/Galley/Types.hs index 09edac1c76..0732b4253a 100644 --- a/libs/galley-types/src/Galley/Types.hs +++ b/libs/galley-types/src/Galley/Types.hs @@ -20,10 +20,19 @@ module Galley.Types ( foldrOtrRecipients, Accept (..), - ConversationMeta (..), -- * re-exports + ConversationMetadata (..), Conversation (..), + cnvQualifiedId, + cnvType, + cnvCreator, + cnvAccess, + cnvAccessRole, + cnvName, + cnvTeam, + cnvMessageTimer, + cnvReceiptMode, LocalMember, RemoteMember, InternalMember (..), @@ -74,10 +83,8 @@ module Galley.Types where import Data.Aeson -import Data.Id (ClientId, ConvId, TeamId, UserId) -import Data.Json.Util ((#)) +import Data.Id (ClientId, UserId) import qualified Data.Map.Strict as Map -import Data.Misc (Milliseconds) import Galley.Types.Conversations.Members (InternalMember (..), LocalMember, RemoteMember) import Imports import Wire.API.Conversation hiding (Member (..)) @@ -89,48 +96,6 @@ import Wire.API.Message import Wire.API.User (UserIdList (..)) import Wire.API.User.Client --------------------------------------------------------------------------------- --- ConversationMeta - -data ConversationMeta = ConversationMeta - { cmId :: !ConvId, - cmType :: !ConvType, - cmCreator :: !UserId, - cmAccess :: ![Access], - cmAccessRole :: !AccessRole, - cmName :: !(Maybe Text), - cmTeam :: !(Maybe TeamId), - cmMessageTimer :: !(Maybe Milliseconds), - cmReceiptMode :: !(Maybe ReceiptMode) - } - deriving (Eq, Show) - -instance ToJSON ConversationMeta where - toJSON c = - object $ - "id" .= cmId c - # "type" .= cmType c - # "creator" .= cmCreator c - # "access" .= cmAccess c - # "access_role" .= cmAccessRole c - # "name" .= cmName c - # "team" .= cmTeam c - # "message_timer" .= cmMessageTimer c - # "receipt_mode" .= cmReceiptMode c - # [] - -instance FromJSON ConversationMeta where - parseJSON = withObject "conversation-meta" $ \o -> - ConversationMeta <$> o .: "id" - <*> o .: "type" - <*> o .: "creator" - <*> o .: "access" - <*> o .: "access_role" - <*> o .: "name" - <*> o .:? "team" - <*> o .:? "message_timer" - <*> o .:? "receipt_mode" - -------------------------------------------------------------------------------- -- Accept diff --git a/libs/wire-api/src/Wire/API/Conversation.hs b/libs/wire-api/src/Wire/API/Conversation.hs index 36a397eb65..9b04d851ae 100644 --- a/libs/wire-api/src/Wire/API/Conversation.hs +++ b/libs/wire-api/src/Wire/API/Conversation.hs @@ -23,7 +23,18 @@ -- modules. module Wire.API.Conversation ( -- * Conversation + ConversationMetadata (..), Conversation (..), + mkConversation, + cnvQualifiedId, + cnvType, + cnvCreator, + cnvAccess, + cnvAccessRole, + cnvName, + cnvTeam, + cnvMessageTimer, + cnvReceiptMode, ConversationCoverView (..), ConversationList (..), ListConversations (..), @@ -80,6 +91,7 @@ import Control.Applicative import Control.Lens (at, (?~)) import Data.Aeson (FromJSON (..), ToJSON (..)) import qualified Data.Aeson as A +import qualified Data.Aeson.Types as A import qualified Data.Attoparsec.ByteString as AB import qualified Data.ByteString as BS import Data.Id @@ -105,62 +117,125 @@ import Wire.API.Conversation.Role (RoleName, roleNameWireAdmin) -------------------------------------------------------------------------------- -- Conversation +data ConversationMetadata = ConversationMetadata + { -- | A qualified conversation ID + cnvmQualifiedId :: Qualified ConvId, + cnvmType :: ConvType, + -- FUTUREWORK: Make this a qualified user ID. + cnvmCreator :: UserId, + cnvmAccess :: [Access], + cnvmAccessRole :: AccessRole, + cnvmName :: Maybe Text, + -- FUTUREWORK: Think if it makes sense to make the team ID qualified due to + -- federation. + cnvmTeam :: Maybe TeamId, + cnvmMessageTimer :: Maybe Milliseconds, + cnvmReceiptMode :: Maybe ReceiptMode + } + deriving stock (Eq, Show, Generic) + deriving (Arbitrary) via (GenericUniform ConversationMetadata) + deriving (FromJSON, ToJSON) via Schema ConversationMetadata + -- | Public-facing conversation type. Represents information that a -- particular user is allowed to see. -- -- Can be produced from the internal one ('Galley.Data.Types.Conversation') -- by using 'Galley.API.Mapping.conversationView'. data Conversation = Conversation - { -- | A qualified conversation ID - cnvQualifiedId :: Qualified 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 + { cnvMetadata :: ConversationMetadata, + cnvMembers :: ConvMembers } deriving stock (Eq, Show, Generic) deriving (Arbitrary) via (GenericUniform Conversation) deriving (FromJSON, ToJSON, S.ToSchema) via Schema Conversation +mkConversation :: + Qualified ConvId -> + ConvType -> + UserId -> + [Access] -> + AccessRole -> + Maybe Text -> + ConvMembers -> + Maybe TeamId -> + Maybe Milliseconds -> + Maybe ReceiptMode -> + Conversation +mkConversation qid ty uid acc role name mems tid ms rm = + Conversation (ConversationMetadata qid ty uid acc role name tid ms rm) mems + +cnvQualifiedId :: Conversation -> Qualified ConvId +cnvQualifiedId = cnvmQualifiedId . cnvMetadata + +cnvType :: Conversation -> ConvType +cnvType = cnvmType . cnvMetadata + +cnvCreator :: Conversation -> UserId +cnvCreator = cnvmCreator . cnvMetadata + +cnvAccess :: Conversation -> [Access] +cnvAccess = cnvmAccess . cnvMetadata + +cnvAccessRole :: Conversation -> AccessRole +cnvAccessRole = cnvmAccessRole . cnvMetadata + +cnvName :: Conversation -> Maybe Text +cnvName = cnvmName . cnvMetadata + +cnvTeam :: Conversation -> Maybe TeamId +cnvTeam = cnvmTeam . cnvMetadata + +cnvMessageTimer :: Conversation -> Maybe Milliseconds +cnvMessageTimer = cnvmMessageTimer . cnvMetadata + +cnvReceiptMode :: Conversation -> Maybe ReceiptMode +cnvReceiptMode = cnvmReceiptMode . cnvMetadata + +conversationMetadataObjectSchema :: + SchemaP + SwaggerDoc + A.Object + [A.Pair] + ConversationMetadata + ConversationMetadata +conversationMetadataObjectSchema = + ConversationMetadata + <$> cnvmQualifiedId .= field "qualified_id" schema + <* (qUnqualified . cnvmQualifiedId) + .= optional (field "id" (deprecatedSchema "qualified_id" schema)) + <*> cnvmType .= field "type" schema + <*> cnvmCreator + .= fieldWithDocModifier + "creator" + (description ?~ "The creator's user ID") + schema + <*> cnvmAccess .= field "access" (array schema) + <*> cnvmAccessRole .= field "access_role" schema + <*> cnvmName .= lax (field "name" (optWithDefault A.Null schema)) + <* const ("0.0" :: Text) .= optional (field "last_event" schema) + <* const ("1970-01-01T00:00:00.000Z" :: Text) + .= optional (field "last_event_time" schema) + <*> cnvmTeam .= lax (field "team" (optWithDefault A.Null schema)) + <*> cnvmMessageTimer + .= lax + ( fieldWithDocModifier + "message_timer" + (description ?~ "Per-conversation message timer (can be null)") + (optWithDefault A.Null schema) + ) + <*> cnvmReceiptMode .= lax (field "receipt_mode" (optWithDefault A.Null schema)) + +instance ToSchema ConversationMetadata where + schema = object "ConversationMetadata" conversationMetadataObjectSchema + instance ToSchema Conversation where schema = objectWithDocModifier "Conversation" (description ?~ "A conversation object as returned from the server") $ Conversation - <$> cnvQualifiedId .= field "qualified_id" schema - <* (qUnqualified . cnvQualifiedId) - .= optional (field "id" (deprecatedSchema "qualified_id" schema)) - <*> cnvType .= field "type" schema - <*> cnvCreator - .= fieldWithDocModifier - "creator" - (description ?~ "The creator's user ID") - schema - <*> cnvAccess .= field "access" (array schema) - <*> cnvAccessRole .= field "access_role" schema - <*> cnvName .= lax (field "name" (optWithDefault A.Null schema)) + <$> cnvMetadata .= conversationMetadataObjectSchema <*> cnvMembers .= field "members" schema - <* const ("0.0" :: Text) .= optional (field "last_event" schema) - <* const ("1970-01-01T00:00:00.000Z" :: Text) - .= optional (field "last_event_time" schema) - <*> cnvTeam .= lax (field "team" (optWithDefault A.Null schema)) - <*> cnvMessageTimer - .= lax - ( fieldWithDocModifier - "message_timer" - (description ?~ "Per-conversation message timer (can be null)") - (optWithDefault A.Null schema) - ) - <*> cnvReceiptMode .= lax (field "receipt_mode" (optWithDefault A.Null schema)) modelConversation :: Doc.Model modelConversation = Doc.defineModel "Conversation" $ do diff --git a/libs/wire-api/test/unit/Test/Wire/API/Golden/Generated/ConversationList_20Conversation_user.hs b/libs/wire-api/test/unit/Test/Wire/API/Golden/Generated/ConversationList_20Conversation_user.hs index 02ab9eb3ba..d23b8022f3 100644 --- a/libs/wire-api/test/unit/Test/Wire/API/Golden/Generated/ConversationList_20Conversation_user.hs +++ b/libs/wire-api/test/unit/Test/Wire/API/Golden/Generated/ConversationList_20Conversation_user.hs @@ -25,28 +25,6 @@ import Data.Qualified (Qualified (..)) import qualified Data.UUID as UUID (fromString) import Imports (Bool (False, True), Maybe (Just, Nothing), fromJust) import Wire.API.Conversation - ( AccessRole - ( PrivateAccessRole - ), - ConvMembers (ConvMembers, cmOthers, cmSelf), - ConvType (RegularConv), - Conversation (..), - ConversationList (..), - Member - ( Member, - memConvRoleName, - memHidden, - memHiddenRef, - memId, - memOtrArchived, - memOtrArchivedRef, - memOtrMutedRef, - memOtrMutedStatus, - memService - ), - MutedStatus (MutedStatus, fromMutedStatus), - ReceiptMode (ReceiptMode, unReceiptMode), - ) import Wire.API.Conversation.Role (parseRoleName) testObject_ConversationList_20Conversation_user_1 :: ConversationList Conversation @@ -54,12 +32,18 @@ testObject_ConversationList_20Conversation_user_1 = ConversationList { convList = [ Conversation - { cnvQualifiedId = Qualified (Id (fromJust (UUID.fromString "00000001-0000-0000-0000-000000000000"))) (Domain "golden.example.com"), - cnvType = RegularConv, - cnvCreator = Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000000000001")), - cnvAccess = [], - cnvAccessRole = PrivateAccessRole, - cnvName = Just "", + { cnvMetadata = + ConversationMetadata + { cnvmQualifiedId = Qualified (Id (fromJust (UUID.fromString "00000001-0000-0000-0000-000000000000"))) (Domain "golden.example.com"), + cnvmType = RegularConv, + cnvmCreator = Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000000000001")), + cnvmAccess = [], + cnvmAccessRole = PrivateAccessRole, + cnvmName = Just "", + cnvmTeam = Just (Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000100000001"))), + cnvmMessageTimer = Just (Ms {ms = 4760386328981119}), + cnvmReceiptMode = Just (ReceiptMode {unReceiptMode = 0}) + }, cnvMembers = ConvMembers { cmSelf = @@ -76,10 +60,7 @@ testObject_ConversationList_20Conversation_user_1 = fromJust (parseRoleName "71xuphsrwfoktrpiv4d08dxj6_1umizg67iisctw87gemvi114mtu") }, cmOthers = [] - }, - cnvTeam = Just (Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000100000001"))), - cnvMessageTimer = Just (Ms {ms = 4760386328981119}), - cnvReceiptMode = Just (ReceiptMode {unReceiptMode = 0}) + } } ], convHasMore = False diff --git a/libs/wire-api/test/unit/Test/Wire/API/Golden/Generated/Conversation_user.hs b/libs/wire-api/test/unit/Test/Wire/API/Golden/Generated/Conversation_user.hs index c59d97a208..0ea5ad8e86 100644 --- a/libs/wire-api/test/unit/Test/Wire/API/Golden/Generated/Conversation_user.hs +++ b/libs/wire-api/test/unit/Test/Wire/API/Golden/Generated/Conversation_user.hs @@ -34,12 +34,18 @@ domain = Domain "golden.example.com" testObject_Conversation_user_1 :: Conversation testObject_Conversation_user_1 = Conversation - { cnvQualifiedId = Qualified (Id (fromJust (UUID.fromString "00000001-0000-0000-0000-000000000000"))) (Domain "golden.example.com"), - cnvType = One2OneConv, - cnvCreator = Id (fromJust (UUID.fromString "00000001-0000-0001-0000-000200000001")), - cnvAccess = [], - cnvAccessRole = PrivateAccessRole, - cnvName = Just " 0", + { cnvMetadata = + ConversationMetadata + { cnvmQualifiedId = Qualified (Id (fromJust (UUID.fromString "00000001-0000-0000-0000-000000000000"))) (Domain "golden.example.com"), + cnvmType = One2OneConv, + cnvmCreator = Id (fromJust (UUID.fromString "00000001-0000-0001-0000-000200000001")), + cnvmAccess = [], + cnvmAccessRole = PrivateAccessRole, + cnvmName = Just " 0", + cnvmTeam = Just (Id (fromJust (UUID.fromString "00000001-0000-0001-0000-000100000002"))), + cnvmMessageTimer = Nothing, + cnvmReceiptMode = Just (ReceiptMode {unReceiptMode = -2}) + }, cnvMembers = ConvMembers { cmSelf = @@ -55,34 +61,37 @@ testObject_Conversation_user_1 = memConvRoleName = fromJust (parseRoleName "rhhdzf0j0njilixx0g0vzrp06b_5us") }, cmOthers = [] - }, - cnvTeam = Just (Id (fromJust (UUID.fromString "00000001-0000-0001-0000-000100000002"))), - cnvMessageTimer = Nothing, - cnvReceiptMode = Just (ReceiptMode {unReceiptMode = -2}) + } } testObject_Conversation_user_2 :: Conversation testObject_Conversation_user_2 = Conversation - { cnvQualifiedId = Qualified (Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000000000002"))) (Domain "golden.example.com"), - cnvType = SelfConv, - cnvCreator = Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000200000001")), - cnvAccess = - [ InviteAccess, - InviteAccess, - CodeAccess, - LinkAccess, - InviteAccess, - PrivateAccess, - LinkAccess, - CodeAccess, - CodeAccess, - LinkAccess, - PrivateAccess, - InviteAccess - ], - cnvAccessRole = NonActivatedAccessRole, - cnvName = Just "", + { cnvMetadata = + ConversationMetadata + { cnvmQualifiedId = Qualified (Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000000000002"))) (Domain "golden.example.com"), + cnvmType = SelfConv, + cnvmCreator = Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000200000001")), + cnvmAccess = + [ InviteAccess, + InviteAccess, + CodeAccess, + LinkAccess, + InviteAccess, + PrivateAccess, + LinkAccess, + CodeAccess, + CodeAccess, + LinkAccess, + PrivateAccess, + InviteAccess + ], + cnvmAccessRole = NonActivatedAccessRole, + cnvmName = Just "", + cnvmTeam = Nothing, + cnvmMessageTimer = Just (Ms {ms = 1319272593797015}), + cnvmReceiptMode = Nothing + }, cnvMembers = ConvMembers { cmSelf = @@ -117,8 +126,5 @@ testObject_Conversation_user_2 = ) } ] - }, - cnvTeam = Nothing, - cnvMessageTimer = Just (Ms {ms = 1319272593797015}), - cnvReceiptMode = Nothing + } } diff --git a/libs/wire-api/test/unit/Test/Wire/API/Golden/Generated/Event_user.hs b/libs/wire-api/test/unit/Test/Wire/API/Golden/Generated/Event_user.hs index ae6cb47adb..cdd9a029b2 100644 --- a/libs/wire-api/test/unit/Test/Wire/API/Golden/Generated/Event_user.hs +++ b/libs/wire-api/test/unit/Test/Wire/API/Golden/Generated/Event_user.hs @@ -28,51 +28,10 @@ import Data.Text.Ascii (validate) import qualified Data.UUID as UUID (fromString) import Imports (Bool (False, True), Maybe (Just, Nothing), fromJust, read, undefined) import Wire.API.Conversation -import Wire.API.Conversation.Code (ConversationCode (..), Key (..), Value (..)) +import Wire.API.Conversation.Code (Key (..), Value (..)) import Wire.API.Conversation.Role (parseRoleName) -import Wire.API.Conversation.Typing (TypingData (TypingData, tdStatus), TypingStatus (StoppedTyping)) +import Wire.API.Conversation.Typing (TypingStatus (..)) import Wire.API.Event.Conversation - ( Connect (Connect, cEmail, cMessage, cName, cRecipient), - Event (Event), - EventData (..), - EventType - ( ConvAccessUpdate, - ConvCodeDelete, - ConvCodeUpdate, - ConvConnect, - ConvCreate, - ConvDelete, - ConvMessageTimerUpdate, - ConvReceiptModeUpdate, - ConvRename, - MemberJoin, - MemberLeave, - MemberStateUpdate, - OtrMessageAdd, - Typing - ), - MemberUpdateData - ( MemberUpdateData, - misConvRoleName, - misHidden, - misHiddenRef, - misOtrArchived, - misOtrArchivedRef, - misOtrMutedRef, - misOtrMutedStatus, - misTarget - ), - OtrMessage - ( OtrMessage, - otrCiphertext, - otrData, - otrRecipient, - otrSender - ), - QualifiedUserIdList (QualifiedUserIdList, qualifiedUserIdList), - SimpleMember (..), - SimpleMembers (SimpleMembers, mMembers), - ) import Wire.API.Provider.Service (ServiceRef (ServiceRef, _serviceRefId, _serviceRefProvider)) domain :: Domain @@ -180,13 +139,19 @@ testObject_Event_user_8 = (read "1864-05-29 19:31:31.226 UTC") ( EdConversation ( Conversation - { cnvQualifiedId = Qualified (Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000100000001"))) (Domain "golden.example.com"), - cnvType = RegularConv, - cnvCreator = Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000200000001")), - cnvAccess = - [InviteAccess, PrivateAccess, LinkAccess, InviteAccess, InviteAccess, InviteAccess, LinkAccess], - cnvAccessRole = NonActivatedAccessRole, - cnvName = Just "\a\SO\r", + { cnvMetadata = + ConversationMetadata + { cnvmQualifiedId = Qualified (Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000100000001"))) (Domain "golden.example.com"), + cnvmType = RegularConv, + cnvmCreator = Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000200000001")), + cnvmAccess = + [InviteAccess, PrivateAccess, LinkAccess, InviteAccess, InviteAccess, InviteAccess, LinkAccess], + cnvmAccessRole = NonActivatedAccessRole, + cnvmName = Just "\a\SO\r", + cnvmTeam = Just (Id (fromJust (UUID.fromString "00000000-0000-0002-0000-000100000001"))), + cnvmMessageTimer = Just (Ms {ms = 283898987885780}), + cnvmReceiptMode = Just (ReceiptMode {unReceiptMode = -1}) + }, cnvMembers = ConvMembers { cmSelf = @@ -223,10 +188,7 @@ testObject_Event_user_8 = ) } ] - }, - cnvTeam = Just (Id (fromJust (UUID.fromString "00000000-0000-0002-0000-000100000001"))), - cnvMessageTimer = Just (Ms {ms = 283898987885780}), - cnvReceiptMode = Just (ReceiptMode {unReceiptMode = -1}) + } } ) ) diff --git a/libs/wire-api/test/unit/Test/Wire/API/Golden/Manual/ConversationsResponse.hs b/libs/wire-api/test/unit/Test/Wire/API/Golden/Manual/ConversationsResponse.hs index 306222effb..f91466f0dc 100644 --- a/libs/wire-api/test/unit/Test/Wire/API/Golden/Manual/ConversationsResponse.hs +++ b/libs/wire-api/test/unit/Test/Wire/API/Golden/Manual/ConversationsResponse.hs @@ -29,12 +29,18 @@ testObject_ConversationsResponse_1 = conv1 :: Conversation conv1 = Conversation - { cnvQualifiedId = Qualified (Id (fromJust (UUID.fromString "00000001-0000-0000-0000-000000000000"))) (Domain "golden.example.com"), - cnvType = One2OneConv, - cnvCreator = Id (fromJust (UUID.fromString "00000001-0000-0001-0000-000200000001")), - cnvAccess = [], - cnvAccessRole = PrivateAccessRole, - cnvName = Just " 0", + { cnvMetadata = + ConversationMetadata + { cnvmQualifiedId = Qualified (Id (fromJust (UUID.fromString "00000001-0000-0000-0000-000000000000"))) (Domain "golden.example.com"), + cnvmType = One2OneConv, + cnvmCreator = Id (fromJust (UUID.fromString "00000001-0000-0001-0000-000200000001")), + cnvmAccess = [], + cnvmAccessRole = PrivateAccessRole, + cnvmName = Just " 0", + cnvmTeam = Just (Id (fromJust (UUID.fromString "00000001-0000-0001-0000-000100000002"))), + cnvmMessageTimer = Nothing, + cnvmReceiptMode = Just (ReceiptMode {unReceiptMode = -2}) + }, cnvMembers = ConvMembers { cmSelf = @@ -50,34 +56,37 @@ conv1 = memConvRoleName = fromJust (parseRoleName "rhhdzf0j0njilixx0g0vzrp06b_5us") }, cmOthers = [] - }, - cnvTeam = Just (Id (fromJust (UUID.fromString "00000001-0000-0001-0000-000100000002"))), - cnvMessageTimer = Nothing, - cnvReceiptMode = Just (ReceiptMode {unReceiptMode = -2}) + } } conv2 :: Conversation conv2 = Conversation - { cnvQualifiedId = Qualified (Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000000000002"))) (Domain "golden.example.com"), - cnvType = SelfConv, - cnvCreator = Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000200000001")), - cnvAccess = - [ InviteAccess, - InviteAccess, - CodeAccess, - LinkAccess, - InviteAccess, - PrivateAccess, - LinkAccess, - CodeAccess, - CodeAccess, - LinkAccess, - PrivateAccess, - InviteAccess - ], - cnvAccessRole = NonActivatedAccessRole, - cnvName = Just "", + { cnvMetadata = + ConversationMetadata + { cnvmQualifiedId = Qualified (Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000000000002"))) (Domain "golden.example.com"), + cnvmType = SelfConv, + cnvmCreator = Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000200000001")), + cnvmAccess = + [ InviteAccess, + InviteAccess, + CodeAccess, + LinkAccess, + InviteAccess, + PrivateAccess, + LinkAccess, + CodeAccess, + CodeAccess, + LinkAccess, + PrivateAccess, + InviteAccess + ], + cnvmAccessRole = NonActivatedAccessRole, + cnvmName = Just "", + cnvmTeam = Just (Id (fromJust (UUID.fromString "00000000-0000-0001-0000-000200000000"))), + cnvmMessageTimer = Just (Ms {ms = 1319272593797015}), + cnvmReceiptMode = Just (ReceiptMode {unReceiptMode = 2}) + }, cnvMembers = ConvMembers { cmSelf = @@ -94,8 +103,5 @@ conv2 = fromJust (parseRoleName "9b2d3thyqh4ptkwtq2n2v9qsni_ln1ca66et_z8dlhfs9oamp328knl3rj9kcj") }, cmOthers = [] - }, - cnvTeam = Just (Id (fromJust (UUID.fromString "00000000-0000-0001-0000-000200000000"))), - cnvMessageTimer = Just (Ms {ms = 1319272593797015}), - cnvReceiptMode = Just (ReceiptMode {unReceiptMode = 2}) + } } diff --git a/services/brig/src/Brig/Provider/API.hs b/services/brig/src/Brig/Provider/API.hs index 55ba100025..ad2513d571 100644 --- a/services/brig/src/Brig/Provider/API.hs +++ b/services/brig/src/Brig/Provider/API.hs @@ -73,7 +73,7 @@ import qualified Data.Set as Set import qualified Data.Swagger.Build.Api as Doc import qualified Data.Text.Ascii as Ascii import qualified Data.Text.Encoding as Text -import Galley.Types (AccessRole (..), ConvMembers (..), ConvType (..), Conversation (..), OtherMember (..)) +import Galley.Types import Galley.Types.Bot (newServiceRef, serviceRefId, serviceRefProvider) import Galley.Types.Conversations.Roles (roleNameWireAdmin) import qualified Galley.Types.Teams as Teams diff --git a/services/brig/test/integration/API/Provider.hs b/services/brig/test/integration/API/Provider.hs index 277058debf..7af5a32541 100644 --- a/services/brig/test/integration/API/Provider.hs +++ b/services/brig/test/integration/API/Provider.hs @@ -66,7 +66,7 @@ import Data.Time.Clock import Data.Timeout (TimedOut (..), Timeout, TimeoutUnit (..), (#)) import qualified Data.UUID as UUID import qualified Data.ZAuth.Token as ZAuth -import Galley.Types (Access (..), AccessRole (..), ConvMembers (..), Conversation (..), ConversationAccessUpdate (..), Event (..), EventData (..), EventType (..), NewConv (..), NewConvUnmanaged (..), OtherMember (..), OtrMessage (..), QualifiedUserIdList (..), SimpleMember (..), SimpleMembers (..)) +import Galley.Types import Galley.Types.Bot (ServiceRef, newServiceRef, serviceRefId, serviceRefProvider) import Galley.Types.Conversations.Roles (roleNameWireAdmin) import qualified Galley.Types.Teams as Team diff --git a/services/galley/src/Galley/API/Mapping.hs b/services/galley/src/Galley/API/Mapping.hs index 4eb47d23cb..3c019c67c2 100644 --- a/services/galley/src/Galley/API/Mapping.hs +++ b/services/galley/src/Galley/API/Mapping.hs @@ -76,7 +76,7 @@ conversationViewMaybeQualified localDomain qUid Data.Conversation {..} = do else incompleteSelfMember <$> me selfMember <&> \m -> do let mems = Public.ConvMembers m otherMembers - Public.Conversation + Public.mkConversation (Qualified convId localDomain) convType convCreator diff --git a/services/galley/src/Galley/API/Query.hs b/services/galley/src/Galley/API/Query.hs index 7500ba068a..c459b57bce 100644 --- a/services/galley/src/Galley/API/Query.hs +++ b/services/galley/src/Galley/API/Query.hs @@ -364,11 +364,12 @@ getConversationMetaH cnv = do Nothing -> setStatus status404 empty Just meta -> json meta -getConversationMeta :: ConvId -> Galley (Maybe ConversationMeta) +getConversationMeta :: ConvId -> Galley (Maybe ConversationMetadata) getConversationMeta cnv = do alive <- Data.isConvAlive cnv + localDomain <- viewFederationDomain if alive - then Data.conversationMeta cnv + then Data.conversationMeta localDomain cnv else do Data.deleteConversation cnv pure Nothing diff --git a/services/galley/src/Galley/API/Util.hs b/services/galley/src/Galley/API/Util.hs index 98020dcfc9..2975a980c4 100644 --- a/services/galley/src/Galley/API/Util.hs +++ b/services/galley/src/Galley/API/Util.hs @@ -553,21 +553,22 @@ fromNewRemoteConversation d NewRemoteConversation {..} = conv :: Public.Member -> [OtherMember] -> Public.Conversation conv this others = Public.Conversation - { cnvQualifiedId = rcCnvId, - cnvType = rcCnvType, - -- FUTUREWORK: Document this is the same domain as the conversation - -- domain - cnvCreator = qUnqualified rcOrigUserId, - cnvAccess = rcCnvAccess, - cnvAccessRole = rcCnvAccessRole, - cnvName = rcCnvName, - cnvMembers = ConvMembers this others, - -- FUTUREWORK: Document this is the same domain as the conversation - -- domain. - cnvTeam = Nothing, - cnvMessageTimer = rcMessageTimer, - cnvReceiptMode = rcReceiptMode - } + ConversationMetadata + { cnvmQualifiedId = rcCnvId, + cnvmType = rcCnvType, + -- FUTUREWORK: Document this is the same domain as the conversation + -- domain + cnvmCreator = qUnqualified rcOrigUserId, + cnvmAccess = rcCnvAccess, + cnvmAccessRole = rcCnvAccessRole, + cnvmName = rcCnvName, + -- FUTUREWORK: Document this is the same domain as the conversation + -- domain. + cnvmTeam = Nothing, + cnvmMessageTimer = rcMessageTimer, + cnvmReceiptMode = rcReceiptMode + } + (ConvMembers this others) -- | Notify remote users of being added to a new conversation registerRemoteConversationMemberships :: diff --git a/services/galley/src/Galley/Data.hs b/services/galley/src/Galley/Data.hs index 7bf3abb6bd..e19a89dc44 100644 --- a/services/galley/src/Galley/Data.hs +++ b/services/galley/src/Galley/Data.hs @@ -535,12 +535,22 @@ toConv cid mms remoteMems conv = where f ms (cty, uid, acc, role, nme, ti, del, timer, rm) = Conversation cid cty uid nme (defAccess cty acc) (maybeRole cty role) ms remoteMems ti del timer rm -conversationMeta :: MonadClient m => ConvId -> m (Maybe ConversationMeta) -conversationMeta conv = +conversationMeta :: MonadClient m => Domain -> ConvId -> m (Maybe ConversationMetadata) +conversationMeta localDomain conv = fmap toConvMeta <$> retry x1 (query1 Cql.selectConv (params Quorum (Identity conv))) where - toConvMeta (t, c, a, r, n, i, _, mt, rm) = ConversationMeta conv t c (defAccess t a) (maybeRole t r) n i mt rm + toConvMeta (t, c, a, r, n, i, _, mt, rm) = + ConversationMetadata + (Qualified conv localDomain) + t + c + (defAccess t a) + (maybeRole t r) + n + i + mt + rm -- | Deprecated, use 'localConversationIdsPageFrom' conversationIdsFrom :: diff --git a/services/galley/test/integration/API.hs b/services/galley/test/integration/API.hs index 1b5017355d..bab369f8cf 100644 --- a/services/galley/test/integration/API.hs +++ b/services/galley/test/integration/API.hs @@ -1774,13 +1774,24 @@ getConvQualifiedOk = do accessConvMeta :: TestM () accessConvMeta = do + localDomain <- viewFederationDomain g <- view tsGalley alice <- randomUser bob <- randomUser chuck <- randomUser connectUsers alice (list1 bob [chuck]) conv <- decodeConvId <$> postConv alice [bob, chuck] (Just "gossip") [] Nothing Nothing - let meta = ConversationMeta conv RegularConv alice [InviteAccess] ActivatedAccessRole (Just "gossip") Nothing Nothing Nothing + let meta = + ConversationMetadata + (Qualified conv localDomain) + RegularConv + alice + [InviteAccess] + ActivatedAccessRole + (Just "gossip") + Nothing + Nothing + Nothing get (g . paths ["i/conversations", toByteString' conv, "meta"] . zUser alice) !!! do const 200 === statusCode const (Just meta) === (decode <=< responseBody) @@ -1881,19 +1892,7 @@ testGetQualifiedRemoteConv = do registerRemoteConv remoteConvId bobQ Nothing (Set.fromList [aliceAsOtherMember]) - let mockConversation = - Conversation - { cnvQualifiedId = remoteConvId, - cnvType = RegularConv, - cnvCreator = bobId, - cnvAccess = [], - cnvAccessRole = ActivatedAccessRole, - cnvName = Just "federated gossip", - cnvMembers = ConvMembers aliceAsMember [bobAsOtherMember], - cnvTeam = Nothing, - cnvMessageTimer = Nothing, - cnvReceiptMode = Nothing - } + let mockConversation = mkConv remoteConvId bobId aliceAsMember [bobAsOtherMember] remoteConversationResponse = GetConversationsResponse [mockConversation] opts <- view tsGConf @@ -1952,19 +1951,7 @@ testListRemoteConvs = do let aliceAsOtherMember = OtherMember aliceQ Nothing roleNameWireAdmin bobAsMember = Member bobId Nothing Nothing Nothing False Nothing False Nothing roleNameWireAdmin - mockConversation = - Conversation - { cnvQualifiedId = remoteConvId, - cnvType = RegularConv, - cnvCreator = alice, - cnvAccess = [], - cnvAccessRole = ActivatedAccessRole, - cnvName = Just "federated gossip", - cnvMembers = ConvMembers bobAsMember [aliceAsOtherMember], - cnvTeam = Nothing, - cnvMessageTimer = Nothing, - cnvReceiptMode = Nothing - } + mockConversation = mkConv remoteConvId alice bobAsMember [aliceAsOtherMember] remoteConversationResponse = GetConversationsResponse [mockConversation] opts <- view tsGConf diff --git a/services/galley/test/integration/API/Util.hs b/services/galley/test/integration/API/Util.hs index d23d3e664f..d871f67eeb 100644 --- a/services/galley/test/integration/API/Util.hs +++ b/services/galley/test/integration/API/Util.hs @@ -1870,18 +1870,17 @@ someLastPrekeys = mkConv :: Qualified ConvId -> UserId -> Member -> [OtherMember] -> Conversation mkConv cnvId creator selfMember otherMembers = - Conversation - { cnvQualifiedId = cnvId, - cnvType = RegularConv, - cnvCreator = creator, - cnvAccess = [], - cnvAccessRole = ActivatedAccessRole, - cnvName = Just "federated gossip", - cnvMembers = ConvMembers selfMember otherMembers, - cnvTeam = Nothing, - cnvMessageTimer = Nothing, - cnvReceiptMode = Nothing - } + mkConversation + cnvId + RegularConv + creator + [] + ActivatedAccessRole + (Just "federated gossip") + (ConvMembers selfMember otherMembers) + Nothing + Nothing + Nothing -- | ES is only refreshed occasionally; we don't want to wait for that in tests. refreshIndex :: TestM () From 2df4ba9c77535fcd2a808a1f4fd818685520d313 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Fri, 10 Sep 2021 14:40:14 +0200 Subject: [PATCH 05/19] Extract `MemberStatus` from `LocalMember` This is a refactoring of `LocalMember` to extract the member status fields (hidden/muted/archived) to their own type, so that they can later be reused to transform a remote conversation to a local one. Also, the `InternalMember` type constructor has been removed, since the only used instantiation of it was the `LocalMember` type synomyn. --- libs/galley-types/galley-types.cabal | 3 +- libs/galley-types/package.yaml | 1 + libs/galley-types/src/Galley/Types.hs | 7 +- .../src/Galley/Types/Conversations/Members.hs | 74 +++++++++++++----- services/galley/src/Galley/API/Create.hs | 2 +- services/galley/src/Galley/API/Federation.hs | 17 ++-- services/galley/src/Galley/API/LegalHold.hs | 14 ++-- services/galley/src/Galley/API/Mapping.hs | 77 +++++++++---------- services/galley/src/Galley/API/Message.hs | 8 +- services/galley/src/Galley/API/Query.hs | 6 +- services/galley/src/Galley/API/Teams.hs | 2 +- services/galley/src/Galley/API/Update.hs | 49 ++++++------ services/galley/src/Galley/API/Util.hs | 52 +++++-------- services/galley/src/Galley/Data.hs | 70 ++++++++--------- services/galley/src/Galley/Data/Services.hs | 8 +- services/galley/src/Galley/Intra/Push.hs | 2 +- services/galley/test/integration/API.hs | 2 +- services/galley/test/integration/API/Util.hs | 11 ++- .../galley/test/unit/Test/Galley/Mapping.hs | 20 ++--- 19 files changed, 211 insertions(+), 214 deletions(-) diff --git a/libs/galley-types/galley-types.cabal b/libs/galley-types/galley-types.cabal index 30ec27537f..891555cac7 100644 --- a/libs/galley-types/galley-types.cabal +++ b/libs/galley-types/galley-types.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: ebbe442ba952db0f975a3f93ffa72db3b1b971f506a30baaca5615f93b4b376a +-- hash: 8d07ea070b6384ec247f4473abb198bbb9639f72543920cbe46f561df96963ca name: galley-types version: 0.81.0 @@ -43,6 +43,7 @@ library , imports , lens >=4.12 , string-conversions + , tagged , text >=0.11 , time >=1.4 , types-common >=0.16 diff --git a/libs/galley-types/package.yaml b/libs/galley-types/package.yaml index 56f849f9c9..3c8971ad0a 100644 --- a/libs/galley-types/package.yaml +++ b/libs/galley-types/package.yaml @@ -22,6 +22,7 @@ library: - lens >=4.12 - QuickCheck - string-conversions + - tagged - text >=0.11 - time >=1.4 - types-common >=0.16 diff --git a/libs/galley-types/src/Galley/Types.hs b/libs/galley-types/src/Galley/Types.hs index 0732b4253a..9a9e2cdca8 100644 --- a/libs/galley-types/src/Galley/Types.hs +++ b/libs/galley-types/src/Galley/Types.hs @@ -33,9 +33,8 @@ module Galley.Types cnvTeam, cnvMessageTimer, cnvReceiptMode, - LocalMember, - RemoteMember, - InternalMember (..), + RemoteMember (..), + LocalMember (..), ConvMembers (..), OtherMember (..), Connect (..), @@ -85,7 +84,7 @@ where import Data.Aeson import Data.Id (ClientId, UserId) import qualified Data.Map.Strict as Map -import Galley.Types.Conversations.Members (InternalMember (..), LocalMember, RemoteMember) +import Galley.Types.Conversations.Members (LocalMember (..), RemoteMember (..)) import Imports import Wire.API.Conversation hiding (Member (..)) import Wire.API.Conversation.Code diff --git a/libs/galley-types/src/Galley/Types/Conversations/Members.hs b/libs/galley-types/src/Galley/Types/Conversations/Members.hs index c88e46c76e..7e6a88c6db 100644 --- a/libs/galley-types/src/Galley/Types/Conversations/Members.hs +++ b/libs/galley-types/src/Galley/Types/Conversations/Members.hs @@ -18,37 +18,73 @@ -- with this program. If not, see . module Galley.Types.Conversations.Members - ( LocalMember, - RemoteMember (..), - InternalMember (..), + ( RemoteMember (..), + remoteMemberToOther, + LocalMember (..), + localMemberToOther, + MemberStatus (..), + defMemberStatus, ) where +import Data.Domain import Data.Id as Id -import Data.Qualified (Remote) +import Data.Qualified +import Data.Tagged import Imports -import Wire.API.Conversation.Member (MutedStatus) +import Wire.API.Conversation import Wire.API.Conversation.Role (RoleName) import Wire.API.Provider.Service (ServiceRef) -type LocalMember = InternalMember Id.UserId - +-- | Internal (cassandra) representation of a remote conversation member. data RemoteMember = RemoteMember { rmId :: Remote UserId, rmConvRoleName :: RoleName } deriving stock (Show) --- | Internal (cassandra) representation of a conversation member. -data InternalMember id = InternalMember - { memId :: id, - memService :: Maybe ServiceRef, - memOtrMutedStatus :: Maybe MutedStatus, - memOtrMutedRef :: Maybe Text, - memOtrArchived :: Bool, - memOtrArchivedRef :: Maybe Text, - memHidden :: Bool, - memHiddenRef :: Maybe Text, - memConvRoleName :: RoleName +remoteMemberToOther :: RemoteMember -> OtherMember +remoteMemberToOther x = + OtherMember + { omQualifiedId = unTagged (rmId x), + omService = Nothing, + omConvRoleName = rmConvRoleName x + } + +-- | Internal (cassandra) representation of a local conversation member. +data LocalMember = LocalMember + { lmId :: UserId, + lmStatus :: MemberStatus, + lmService :: Maybe ServiceRef, + lmConvRoleName :: RoleName + } + deriving stock (Show) + +localMemberToOther :: Domain -> LocalMember -> OtherMember +localMemberToOther domain x = + OtherMember + { omQualifiedId = Qualified (lmId x) domain, + omService = lmService x, + omConvRoleName = lmConvRoleName x + } + +data MemberStatus = MemberStatus + { msOtrMutedStatus :: Maybe MutedStatus, + msOtrMutedRef :: Maybe Text, + msOtrArchived :: Bool, + msOtrArchivedRef :: Maybe Text, + msHidden :: Bool, + msHiddenRef :: Maybe Text } - deriving stock (Functor, Show) + deriving stock (Show) + +defMemberStatus :: MemberStatus +defMemberStatus = + MemberStatus + { msOtrMutedStatus = Nothing, + msOtrMutedRef = Nothing, + msOtrArchived = False, + msOtrArchivedRef = Nothing, + msHidden = False, + msHiddenRef = Nothing + } diff --git a/services/galley/src/Galley/API/Create.hs b/services/galley/src/Galley/API/Create.hs index 52921e4e5a..72f02735da 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 toPush dom t m = do let qconv = Qualified (Data.convId c) dom qusr = Qualified usr dom - c' <- conversationView (memId m) c + c' <- conversationView (lmId m) c let e = Event ConvCreate qconv qusr t (EdConversation c') return $ newPushLocal1 ListComplete usr (ConvEvent e) (list1 (recipient m) []) diff --git a/services/galley/src/Galley/API/Federation.hs b/services/galley/src/Galley/API/Federation.hs index f8e42b7548..107290acbc 100644 --- a/services/galley/src/Galley/API/Federation.hs +++ b/services/galley/src/Galley/API/Federation.hs @@ -38,7 +38,7 @@ import qualified Galley.API.Update as API import Galley.API.Util (fromNewRemoteConversation, pushConversationEvent, viewFederationDomain) import Galley.App (Galley) import qualified Galley.Data as Data -import Galley.Types.Conversations.Members (InternalMember (..), LocalMember) +import Galley.Types.Conversations.Members (LocalMember (..), defMemberStatus) import Imports import Servant (ServerT) import Servant.API.Generic (ToServantApi) @@ -186,16 +186,11 @@ onMessageSent domain rmUnqualified = do mkLocalMember :: UserId -> Galley LocalMember mkLocalMember m = pure $ - InternalMember - { memId = m, - memService = Nothing, - memOtrMutedStatus = Nothing, - memOtrMutedRef = Nothing, - memOtrArchived = False, - memOtrArchivedRef = Nothing, - memHidden = False, - memHiddenRef = Nothing, - memConvRoleName = Public.roleNameWireMember + LocalMember + { lmId = m, + lmService = Nothing, + lmStatus = defMemberStatus, + lmConvRoleName = Public.roleNameWireMember } sendMessage :: Domain -> MessageSendRequest -> Galley MessageSendResponse diff --git a/services/galley/src/Galley/API/LegalHold.hs b/services/galley/src/Galley/API/LegalHold.hs index d4f9120986..5a4bd6d8c3 100644 --- a/services/galley/src/Galley/API/LegalHold.hs +++ b/services/galley/src/Galley/API/LegalHold.hs @@ -61,7 +61,7 @@ import qualified Galley.External.LegalHoldService as LHService import qualified Galley.Intra.Client as Client import Galley.Intra.User (getConnections, putConnectionInternal) import qualified Galley.Options as Opts -import Galley.Types (LocalMember, memConvRoleName, memId) +import Galley.Types (LocalMember, lmConvRoleName, lmId) import Galley.Types.Teams as Team import Imports import Network.HTTP.Types (status200, status404) @@ -492,12 +492,12 @@ handleGroupConvPolicyConflicts uid hypotheticalLHStatus = membersAndLHStatus :: [(LocalMember, UserLegalHoldStatus)] <- do let mems = Data.convLocalMembers conv - uidsLHStatus <- getLHStatusForUsers (memId <$> mems) + uidsLHStatus <- getLHStatusForUsers (lmId <$> mems) pure $ zipWith ( \mem (mid, status) -> - assert (memId mem == mid) $ - if memId mem == uid + assert (lmId mem == mid) $ + if lmId mem == uid then (mem, hypotheticalLHStatus) else (mem, status) ) @@ -507,10 +507,10 @@ handleGroupConvPolicyConflicts uid hypotheticalLHStatus = let qconv = Data.convId conv `Qualified` localDomain if any ((== ConsentGiven) . consentGiven . snd) - (filter ((== roleNameWireAdmin) . memConvRoleName . fst) membersAndLHStatus) + (filter ((== roleNameWireAdmin) . lmConvRoleName . fst) membersAndLHStatus) then do for_ (filter ((== ConsentNotGiven) . consentGiven . snd) membersAndLHStatus) $ \(memberNoConsent, _) -> do - removeMember (memId memberNoConsent `Qualified` localDomain) Nothing qconv (Qualified (memId memberNoConsent) localDomain) + removeMember (lmId memberNoConsent `Qualified` localDomain) Nothing qconv (Qualified (lmId memberNoConsent) localDomain) else do for_ (filter (userLHEnabled . snd) membersAndLHStatus) $ \(legalholder, _) -> do - removeMember (memId legalholder `Qualified` localDomain) Nothing qconv (Qualified (memId legalholder) localDomain) + removeMember (lmId legalholder `Qualified` localDomain) Nothing qconv (Qualified (lmId legalholder) localDomain) diff --git a/services/galley/src/Galley/API/Mapping.hs b/services/galley/src/Galley/API/Mapping.hs index 3c019c67c2..1196567fdb 100644 --- a/services/galley/src/Galley/API/Mapping.hs +++ b/services/galley/src/Galley/API/Mapping.hs @@ -24,12 +24,11 @@ import Data.Domain (Domain) import Data.Id (UserId, idToText) import qualified Data.List as List import Data.Qualified (Qualified (..)) -import Data.Tagged (unTagged) import Galley.API.Util (viewFederationDomain) import Galley.App import qualified Galley.Data as Data import Galley.Data.Types (convId) -import qualified Galley.Types.Conversations.Members as Internal +import Galley.Types.Conversations.Members import Imports import Network.HTTP.Types.Status import Network.Wai.Utilities.Error @@ -62,18 +61,18 @@ conversationViewMaybe u conv = do -- Returns 'Nothing' when the user is not part of the conversation. conversationViewMaybeQualified :: Domain -> Qualified UserId -> Data.Conversation -> Maybe Public.Conversation conversationViewMaybeQualified localDomain qUid Data.Conversation {..} = do - let localMembers = localToOther localDomain <$> convLocalMembers - let remoteMembers = remoteToOther <$> convRemoteMembers + let localMembers = localMemberToOther localDomain <$> convLocalMembers + let remoteMembers = remoteMemberToOther <$> convRemoteMembers let me = List.find ((qUid ==) . Public.omQualifiedId) (localMembers <> remoteMembers) let otherMembers = filter ((qUid /=) . Public.omQualifiedId) (localMembers <> remoteMembers) - let userAndConvOnSameBackend = find ((qUnqualified qUid ==) . Internal.memId) convLocalMembers + let userAndConvOnSameBackend = find ((qUnqualified qUid ==) . lmId) convLocalMembers let selfMember = -- if the user and the conversation are on the same backend, we can create a real self member -- otherwise, we need to fall back to a default self member (see futurework) -- (Note: the extra domain check is done to catch the edge case where two users in a conversation have the same unqualified UUID) if isJust userAndConvOnSameBackend && localDomain == qDomain qUid - then toMember <$> userAndConvOnSameBackend - else incompleteSelfMember <$> me + then localToSelf <$> userAndConvOnSameBackend + else remoteToSelf <$> me selfMember <&> \m -> do let mems = Public.ConvMembers m otherMembers Public.mkConversation @@ -87,39 +86,35 @@ conversationViewMaybeQualified localDomain qUid Data.Conversation {..} = do convTeam convMessageTimer convReceiptMode - where - localToOther :: Domain -> Internal.LocalMember -> Public.OtherMember - localToOther domain x = - Public.OtherMember - { Public.omQualifiedId = Qualified (Internal.memId x) domain, - Public.omService = Internal.memService x, - Public.omConvRoleName = Internal.memConvRoleName x - } - - remoteToOther :: Internal.RemoteMember -> Public.OtherMember - remoteToOther x = - Public.OtherMember - { Public.omQualifiedId = unTagged (Internal.rmId x), - Public.omService = Nothing, - Public.omConvRoleName = Internal.rmConvRoleName x - } - -- FUTUREWORK(federation): we currently don't store muted, archived etc status for users who are on a different backend than a conversation - -- but we should. Once this information is available, the code should be changed to use the stored information, rather than these defaults. - incompleteSelfMember :: Public.OtherMember -> Public.Member - incompleteSelfMember m = - Public.Member - { memId = qUnqualified (Public.omQualifiedId m), - memService = Nothing, - memOtrMutedStatus = Nothing, - memOtrMutedRef = Nothing, - memOtrArchived = False, - memOtrArchivedRef = Nothing, - memHidden = False, - memHiddenRef = Nothing, - memConvRoleName = Public.omConvRoleName m - } +-- FUTUREWORK(federation): we currently don't store muted, archived etc status for users who are on a different backend than a conversation +-- but we should. Once this information is available, the code should be changed to use the stored information, rather than these defaults. +remoteToSelf :: Public.OtherMember -> Public.Member +remoteToSelf m = + Public.Member + { memId = qUnqualified (Public.omQualifiedId m), + memService = Nothing, + memOtrMutedStatus = Nothing, + memOtrMutedRef = Nothing, + memOtrArchived = False, + memOtrArchivedRef = Nothing, + memHidden = False, + memHiddenRef = Nothing, + memConvRoleName = Public.omConvRoleName m + } -toMember :: Internal.LocalMember -> Public.Member -toMember x@Internal.InternalMember {..} = - Public.Member {memId = Internal.memId x, ..} +localToSelf :: LocalMember -> Public.Member +localToSelf lm = + Public.Member + { memId = lmId lm, + memService = lmService lm, + memOtrMutedStatus = msOtrMutedStatus st, + memOtrMutedRef = msOtrMutedRef st, + memOtrArchived = msOtrArchived st, + memOtrArchivedRef = msOtrArchivedRef st, + memHidden = msHidden st, + memHiddenRef = msHiddenRef st, + memConvRoleName = lmConvRoleName lm + } + where + st = lmStatus lm diff --git a/services/galley/src/Galley/API/Message.hs b/services/galley/src/Galley/API/Message.hs index 8b2683ecaa..ab744e355d 100644 --- a/services/galley/src/Galley/API/Message.hs +++ b/services/galley/src/Galley/API/Message.hs @@ -225,9 +225,9 @@ postQualifiedOtrMessage senderType sender mconn convId msg = runExceptT $ do localMembers <- lift $ Data.members convId remoteMembers <- Data.lookupRemoteMembers convId - let localMemberIds = memId <$> localMembers + let localMemberIds = lmId <$> localMembers localMemberMap :: Map UserId LocalMember - localMemberMap = Map.fromList (map (\mem -> (memId mem, mem)) localMembers) + localMemberMap = Map.fromList (map (\mem -> (lmId mem, mem)) localMembers) members :: Set (Qualified UserId) members = Set.map (`Qualified` localDomain) (Map.keysSet localMemberMap) @@ -246,7 +246,7 @@ postQualifiedOtrMessage senderType sender mconn convId msg = runExceptT $ do else Data.lookupClients localMemberIds let qualifiedLocalClients = Map.mapKeys (localDomain,) - . makeUserMap (Set.fromList (map memId localMembers)) + . makeUserMap (Set.fromList (map lmId localMembers)) . Clients.toMap $ localClients @@ -463,7 +463,7 @@ newMessagePush localDomain members mconn mm (k, client) e = fromMaybe mempty $ d newUserMessagePush :: LocalMember -> Maybe MessagePush newUserMessagePush member = fmap newUserPush $ - newConversationEventPush localDomain e [memId member] + newConversationEventPush localDomain e [lmId member] <&> set pushConn mconn . set pushNativePriority (mmNativePriority mm) . set pushRoute (bool RouteDirect RouteAny (mmNativePush mm)) diff --git a/services/galley/src/Galley/API/Query.hs b/services/galley/src/Galley/API/Query.hs index c459b57bce..72f9ce7c98 100644 --- a/services/galley/src/Galley/API/Query.hs +++ b/services/galley/src/Galley/API/Query.hs @@ -85,10 +85,10 @@ getBotConversation zbot zcnv = do where mkMember :: Domain -> LocalMember -> Maybe OtherMember mkMember domain m - | memId m == botUserId zbot = + | lmId m == botUserId zbot = Nothing -- no need to list the bot itself | otherwise = - Just (OtherMember (Qualified (memId m) domain) (memService m) (memConvRoleName m)) + Just (OtherMember (Qualified (lmId m) domain) (lmService m) (lmConvRoleName m)) getUnqualifiedConversation :: UserId -> ConvId -> Galley Public.Conversation getUnqualifiedConversation zusr cnv = do @@ -355,7 +355,7 @@ getLocalSelf :: UserId -> ConvId -> Galley (Maybe Public.Member) getLocalSelf usr cnv = do alive <- Data.isConvAlive cnv if alive - then Mapping.toMember <$$> Data.member cnv usr + then Mapping.localToSelf <$$> Data.member cnv usr else Nothing <$ Data.deleteConversation cnv getConversationMetaH :: ConvId -> Galley Response diff --git a/services/galley/src/Galley/API/Teams.hs b/services/galley/src/Galley/API/Teams.hs index b2f8e53e38..49e6ee477b 100644 --- a/services/galley/src/Galley/API/Teams.hs +++ b/services/galley/src/Galley/API/Teams.hs @@ -742,7 +742,7 @@ uncheckedDeleteTeamMember zusr zcon tid remove mems = do let qconvId = Qualified (Data.convId dc) localDomain qusr = Qualified zusr localDomain let (bots, users) = localBotsAndUsers (Data.convLocalMembers dc) - let x = filter (\m -> not (Conv.memId m `Set.member` exceptTo)) users + let x = filter (\m -> not (Conv.lmId m `Set.member` exceptTo)) users let y = Conv.Event Conv.MemberLeave qconvId qusr now edata for_ (newPushLocal (mems ^. teamMemberListType) zusr (ConvEvent y) (recipient <$> x)) $ \p -> push1 $ p & pushConn .~ zcon diff --git a/services/galley/src/Galley/API/Update.hs b/services/galley/src/Galley/API/Update.hs index 7d6b656f7e..5dd70d1dc3 100644 --- a/services/galley/src/Galley/API/Update.hs +++ b/services/galley/src/Galley/API/Update.hs @@ -99,7 +99,6 @@ import Galley.Types import Galley.Types.Bot hiding (addBot) import Galley.Types.Clients (Clients) import qualified Galley.Types.Clients as Clients -import Galley.Types.Conversations.Members (RemoteMember (rmConvRoleName, rmId)) import Galley.Types.Conversations.Roles (Action (..), RoleName, roleNameWireMember) import Galley.Types.Teams hiding (Event, EventData (..), EventType (..), self) import Galley.Validation @@ -255,16 +254,16 @@ uncheckedUpdateConversationAccess body usr zcon conv (currentAccess, targetAcces -- to make assumption about the order of roles and implement policy -- based on those assumptions. when (currentRole > ActivatedAccessRole && targetRole <= ActivatedAccessRole) $ do - mIds <- map memId <$> use usersL + mIds <- map lmId <$> use usersL activated <- fmap User.userId <$> lift (lookupActivatedUsers mIds) - let isActivated user = memId user `elem` activated + let isActivated user = lmId user `elem` activated usersL %= filter isActivated -- In a team-only conversation we also want to remove bots and guests case (targetRole, Data.convTeam conv) of (TeamAccessRole, Just tid) -> do currentUsers <- use usersL onlyTeamUsers <- flip filterM currentUsers $ \user -> - lift $ isJust <$> Data.teamMember tid (memId user) + lift $ isJust <$> Data.teamMember tid (lmId user) assign usersL onlyTeamUsers botsL .= [] _ -> return () @@ -272,9 +271,9 @@ uncheckedUpdateConversationAccess body usr zcon conv (currentAccess, targetAcces now <- liftIO getCurrentTime let accessEvent = Event ConvAccessUpdate qcnv qusr now (EdConvAccessUpdate body) Data.updateConversationAccess cnv targetAccess targetRole - pushConversationEvent (Just zcon) accessEvent (map memId users) bots + pushConversationEvent (Just zcon) accessEvent (map lmId users) bots -- Remove users and bots - let removedUsers = map memId users \\ map memId newUsers + let removedUsers = map lmId users \\ map lmId newUsers removedBots = map botMemId bots \\ map botMemId newBots mapM_ (deleteBot cnv) removedBots case removedUsers of @@ -316,7 +315,7 @@ updateConversationReceiptMode usr zcon cnv receiptModeUpdate@(Public.Conversatio Data.updateConversationReceiptMode cnv target now <- liftIO getCurrentTime let receiptEvent = Event ConvReceiptModeUpdate qcnv qusr now (EdConvReceiptModeUpdate receiptModeUpdate) - pushConversationEvent (Just zcon) receiptEvent (map memId users) bots + pushConversationEvent (Just zcon) receiptEvent (map lmId users) bots pure receiptEvent updateConversationMessageTimerH :: UserId ::: ConnId ::: ConvId ::: JsonRequest Public.ConversationMessageTimerUpdate -> Galley Response @@ -345,7 +344,7 @@ updateConversationMessageTimer usr zcon cnv timerUpdate@(Public.ConversationMess now <- liftIO getCurrentTime let timerEvent = Event ConvMessageTimerUpdate qcnv qusr now (EdConvMessageTimerUpdate timerUpdate) Data.updateConversationMessageTimer cnv target - pushConversationEvent (Just zcon) timerEvent (map memId users) bots + pushConversationEvent (Just zcon) timerEvent (map lmId users) bots pure timerEvent addCodeH :: UserId ::: ConnId ::: ConvId -> Galley Response @@ -376,7 +375,7 @@ addCode usr zcon cnv = do now <- liftIO getCurrentTime conversationCode <- createCode code let event = Event ConvCodeUpdate qcnv qusr now (EdConvCodeUpdate conversationCode) - pushConversationEvent (Just zcon) event (map memId users) bots + pushConversationEvent (Just zcon) event (map lmId users) bots pure $ CodeAdded event Just code -> do conversationCode <- createCode code @@ -404,7 +403,7 @@ rmCode usr zcon cnv = do Data.deleteCode key ReusableCode now <- liftIO getCurrentTime let event = Event ConvCodeDelete qcnv qusr now EdConvCodeDelete - pushConversationEvent (Just zcon) event (map memId users) bots + pushConversationEvent (Just zcon) event (map lmId users) bots pure event getCodeH :: UserId ::: ConvId -> Galley Response @@ -494,7 +493,7 @@ addMembers zusr zcon convId invite = do checkRemoteUsersExist newRemotes checkLHPolicyConflictsLocal conv newLocals checkLHPolicyConflictsRemote (FutureWork newRemotes) - addToConversation mems rMems (zusr, memConvRoleName self) zcon (withRoles newLocals) (withRoles newRemotes) conv + addToConversation mems rMems (zusr, lmConvRoleName self) zcon (withRoles newLocals) (withRoles newRemotes) conv where userIsMember u = (^. userId . to (== u)) @@ -520,7 +519,7 @@ addMembers zusr zcon convId invite = do allNewUsersGaveConsent <- allLegalholdConsentGiven newUsers - whenM (anyLegalholdActivated (memId <$> convUsers)) $ + whenM (anyLegalholdActivated (lmId <$> convUsers)) $ unless allNewUsersGaveConsent $ throwErrorDescription missingLegalholdConsent @@ -529,12 +528,12 @@ addMembers zusr zcon convId invite = do throwErrorDescription missingLegalholdConsent convUsersLHStatus <- do - uidsStatus <- getLHStatusForUsers (memId <$> convUsers) + uidsStatus <- getLHStatusForUsers (lmId <$> convUsers) pure $ zipWith (\mem (_, status) -> (mem, status)) convUsers uidsStatus if any ( \(mem, status) -> - memConvRoleName mem == roleNameWireAdmin + lmConvRoleName mem == roleNameWireAdmin && consentGiven status == ConsentGiven ) convUsersLHStatus @@ -542,9 +541,9 @@ addMembers zusr zcon convId invite = do localDomain <- viewFederationDomain for_ convUsersLHStatus $ \(mem, status) -> when (consentGiven status == ConsentNotGiven) $ - let qvictim = Qualified (memId mem) localDomain + let qvictim = Qualified (lmId mem) localDomain in void $ - removeMember (memId mem `Qualified` localDomain) Nothing (Data.convId conv `Qualified` localDomain) qvictim + removeMember (lmId mem `Qualified` localDomain) Nothing (Data.convId conv `Qualified` localDomain) qvictim else throwErrorDescription missingLegalholdConsent checkLHPolicyConflictsRemote :: FutureWork 'LegalholdPlusFederationNotImplemented [Remote UserId] -> Galley () @@ -647,7 +646,7 @@ removeMemberFromLocalConv remover@(Qualified removerUid removerDomain) zcon conv removerRole <- withExceptT (const @_ @ConvNotFound RemoveFromConversationErrorNotFound) $ if localDomain == removerDomain - then memConvRoleName <$> getSelfMemberFromLocals removerUid locals + then lmConvRoleName <$> getSelfMemberFromLocals removerUid locals else rmConvRoleName <$> getSelfMemberFromRemotes (toRemote remover) (Data.convRemoteMembers conv) generalConvChecks localDomain removerRole conv @@ -838,7 +837,7 @@ newMessage qusr con qcnv msg now (m, c, t) ~(toBots, toUsers) = -- use recipient's client's self conversation on broadcast -- (with federation, this might not work for remote members) -- FUTUREWORK: for remote recipients, set the domain correctly here - qconv = fromMaybe ((`Qualified` qDomain qusr) . selfConv $ memId m) qcnv + qconv = fromMaybe ((`Qualified` qDomain qusr) . selfConv $ lmId m) qcnv e = Event OtrMessageAdd qconv qusr now (EdOtrMessage o) r = recipient m & recipientClients .~ RecipientClientsSome (singleton c) in case newBotMember m of @@ -1024,7 +1023,7 @@ addToConversation (bots, existingLocals) existingRemotes (usr, usrRole) conn new localDomain <- viewFederationDomain (e, lmm, rmm) <- Data.addMembersWithRole localDomain now (Data.convId c) (usr, usrRole) mems let newMembersWithRoles = - ((flip Qualified localDomain . memId &&& memConvRoleName) <$> lmm) + ((flip Qualified localDomain . lmId &&& lmConvRoleName) <$> lmm) <> ((unTagged . rmId &&& rmConvRoleName) <$> rmm) case newMembersWithRoles of [] -> @@ -1033,7 +1032,7 @@ addToConversation (bots, existingLocals) existingRemotes (usr, usrRole) conn new let action = FederatedGalley.ConversationMembersActionAdd (x :| xs) qusr = Qualified usr localDomain notifyRemoteAboutConvUpdate qusr (convId c) now action (rmId <$> existingRemotes <> rmm) - let localsToNotify = nubOrd . fmap memId $ existingLocals <> lmm + let localsToNotify = nubOrd . fmap lmId $ existingLocals <> lmm pushConversationEvent (Just conn) e localsToNotify bots pure $ Updated e @@ -1087,10 +1086,10 @@ processUpdateMemberEvent zusr zcon cid users target update = do localDomain <- viewFederationDomain let qcnv = Qualified cid localDomain qusr = Qualified zusr localDomain - up <- Data.updateMember cid (memId target) update + up <- Data.updateMember cid (lmId target) update now <- liftIO getCurrentTime let e = Event MemberStateUpdate qcnv qusr now (EdMemberUpdate up) - let recipients = fmap recipient (target : filter ((/= memId target) . memId) users) + let recipients = fmap recipient (target : filter ((/= lmId target) . lmId) users) for_ (newPushLocal ListComplete zusr (ConvEvent e) recipients) $ \p -> push1 $ p @@ -1175,7 +1174,7 @@ withValidOtrRecipients utype usr clt cnv rcps val now go = do pure $ OtrConversationNotFound convNotFound else do localMembers <- Data.members cnv - let localMemberIds = memId <$> localMembers + let localMemberIds = lmId <$> localMembers isInternal <- view $ options . optSettings . setIntraListing clts <- if isInternal @@ -1254,8 +1253,8 @@ checkOtrRecipients usr sid prs vms vcs val now | otherwise = Nothing -- Valid recipient members & clients - vmembers :: Map UserId (InternalMember UserId) - vmembers = Map.fromList $ map (\m -> (memId m, m)) vms + vmembers :: Map UserId LocalMember + vmembers = Map.fromList $ map (\m -> (lmId m, m)) vms vclients :: Clients vclients = Clients.rmClient usr sid vcs diff --git a/services/galley/src/Galley/API/Util.hs b/services/galley/src/Galley/API/Util.hs index 2975a980c4..e7bbd6d43a 100644 --- a/services/galley/src/Galley/API/Util.hs +++ b/services/galley/src/Galley/API/Util.hs @@ -50,8 +50,7 @@ import Galley.Intra.Push import Galley.Intra.User import Galley.Options (optSettings, setFeatureFlags, setFederationDomain) import Galley.Types -import Galley.Types.Conversations.Members (RemoteMember (..)) -import qualified Galley.Types.Conversations.Members as Members +import Galley.Types.Conversations.Members (localMemberToOther, remoteMemberToOther) import Galley.Types.Conversations.Roles import Galley.Types.Teams hiding (Event) import Imports @@ -143,9 +142,9 @@ ensureActionAllowed action role = case isActionAllowed action role of -- is permitted. -- If not, throw 'Member'; if the user is found and does not have the given permission, throw -- 'operationDenied'. Otherwise, return the found user. -ensureActionAllowedThrowing :: Action -> InternalMember a -> Galley () +ensureActionAllowedThrowing :: Action -> LocalMember -> Galley () ensureActionAllowedThrowing action mem = - case ensureActionAllowed action (memConvRoleName mem) of + case ensureActionAllowed action (lmConvRoleName mem) of ACOAllowed -> return () ACOActionDenied _ -> throwErrorDescription (actionDenied action) ACOCustomRolesNotSupported -> throwM (badRequest "Custom roles not supported") @@ -157,9 +156,9 @@ ensureActionAllowedThrowing action mem = -- own. This is used to ensure users cannot "elevate" allowed actions -- This function needs to be review when custom roles are introduced since only -- custom roles can cause `roleNameToActions` to return a Nothing -ensureConvRoleNotElevated :: InternalMember a -> RoleName -> Galley () +ensureConvRoleNotElevated :: LocalMember -> RoleName -> Galley () ensureConvRoleNotElevated origMember targetRole = do - case (roleNameToActions targetRole, roleNameToActions (memConvRoleName origMember)) of + case (roleNameToActions targetRole, roleNameToActions (lmConvRoleName origMember)) of (Just targetActions, Just memberActions) -> unless (Set.isSubsetOf targetActions memberActions) $ throwM invalidActions @@ -220,7 +219,7 @@ acceptOne2One usr conv conn = do throwM badConvState now <- liftIO getCurrentTime (e, mm) <- Data.addMember localDomain now cid usr - conv' <- if isJust (find ((usr /=) . memId) mems) then promote else pure conv + conv' <- if isJust (find ((usr /=) . lmId) mems) then promote else pure conv let mems' = mems <> toList mm for_ (newPushLocal ListComplete usr (ConvEvent e) (recipient <$> mems')) $ \p -> push1 $ p & pushConn .~ conn & pushRoute .~ RouteDirect @@ -237,22 +236,19 @@ acceptOne2One usr conv conn = do "Connect conversation with more than 2 members: " <> LT.pack (show cid) -isBot :: InternalMember a -> Bool -isBot = isJust . memService +isBot :: LocalMember -> Bool +isBot = isJust . lmService -isMember :: (Eq a, Foldable m) => a -> m (InternalMember a) -> Bool -isMember u = isJust . find ((u ==) . memId) +isMember :: Foldable m => UserId -> m LocalMember -> Bool +isMember u = isJust . find ((u ==) . lmId) -isRemoteMember :: (Foldable m) => Remote UserId -> m RemoteMember -> Bool +isRemoteMember :: Foldable m => Remote UserId -> m RemoteMember -> Bool isRemoteMember u = isJust . find ((u ==) . rmId) -findMember :: Data.Conversation -> UserId -> Maybe LocalMember -findMember c u = find ((u ==) . memId) (Data.convLocalMembers c) - localBotsAndUsers :: Foldable f => f LocalMember -> ([BotMember], [LocalMember]) localBotsAndUsers = foldMap botOrUser where - botOrUser m = case memService m of + botOrUser m = case lmService m of -- we drop invalid bots here, which shouldn't happen Just _ -> (toList (newBotMember m), []) Nothing -> ([], [m]) @@ -261,7 +257,7 @@ location :: ToByteString a => a -> Response -> Response location = addHeader hLocation . toByteString' nonTeamMembers :: [LocalMember] -> [TeamMember] -> [LocalMember] -nonTeamMembers cm tm = filter (not . isMemberOfTeam . memId) cm +nonTeamMembers cm tm = filter (not . isMemberOfTeam . lmId) cm where -- FUTUREWORK: remote members: teams and their members are always on the same backend isMemberOfTeam = \case @@ -269,7 +265,7 @@ nonTeamMembers cm tm = filter (not . isMemberOfTeam . memId) cm convMembsAndTeamMembs :: [LocalMember] -> [TeamMember] -> [Recipient] convMembsAndTeamMembs convMembs teamMembs = - fmap userRecipient . setnub $ map memId convMembs <> map (view userId) teamMembs + fmap userRecipient . setnub $ map lmId convMembs <> map (view userId) teamMembs where setnub = Set.toList . Set.fromList @@ -339,7 +335,7 @@ getLocalMember :: UserId -> t LocalMember -> ExceptT e m LocalMember -getLocalMember = getMember memId +getLocalMember = getMember lmId -- | Since we search by remote user ID, we know that the member must be remote. getRemoteMember :: @@ -498,21 +494,9 @@ toNewRemoteConversation now localDomain Data.Conversation {..} = [RemoteMember] -> Set OtherMember toMembers ls rs = - Set.fromList $ fmap localToOther ls <> fmap remoteToOther rs - localToOther :: LocalMember -> OtherMember - localToOther Members.InternalMember {..} = - OtherMember - { omQualifiedId = Qualified memId localDomain, - omService = Nothing, - omConvRoleName = memConvRoleName - } - remoteToOther :: RemoteMember -> OtherMember - remoteToOther RemoteMember {..} = - OtherMember - { omQualifiedId = unTagged rmId, - omService = Nothing, - omConvRoleName = rmConvRoleName - } + Set.fromList $ + map (localMemberToOther localDomain) ls + <> map remoteMemberToOther rs -- | The function converts a 'NewRemoteConversation' value to a -- 'Wire.API.Conversation.Conversation' value for each user that is on the given diff --git a/services/galley/src/Galley/Data.hs b/services/galley/src/Galley/Data.hs index e19a89dc44..9a9be8e9c9 100644 --- a/services/galley/src/Galley/Data.hs +++ b/services/galley/src/Galley/Data.hs @@ -711,7 +711,7 @@ deleteConversation :: (MonadClient m, Log.MonadLogger m, MonadThrow m) => ConvId deleteConversation cid = do retry x5 $ write Cql.markConvDeleted (params Quorum (Identity cid)) mm <- members cid - for_ mm $ \m -> removeMember (memId m) cid + for_ mm $ \m -> removeMember (lmId m) cid retry x5 $ write Cql.deleteConv (params Quorum (Identity cid)) acceptConnect :: MonadClient m => ConvId -> m () @@ -791,8 +791,8 @@ member :: UserId -> m (Maybe LocalMember) member cnv usr = - fmap (join @Maybe) . traverse toMember - =<< retry x1 (query1 Cql.selectMember (params Quorum (cnv, usr))) + (toMember =<<) + <$> retry x1 (query1 Cql.selectMember (params Quorum (cnv, usr))) remoteMemberLists :: (MonadClient m) => @@ -817,15 +817,15 @@ memberLists :: m [[LocalMember]] memberLists convs = do mems <- retry x1 $ query Cql.selectMembers (params Quorum (Identity convs)) - convMembers <- foldrM (\m acc -> liftA2 insert (mkMem m) (pure acc)) Map.empty mems + let convMembers = foldr (\m acc -> insert (mkMem m) acc) mempty mems return $ map (\c -> fromMaybe [] (Map.lookup c convMembers)) convs where - insert Nothing acc = acc - insert (Just (conv, mem)) acc = + insert (_, Nothing) acc = acc + insert (conv, Just mem) acc = let f = (Just . maybe [mem] (mem :)) in Map.alter f conv acc mkMem (cnv, usr, srv, prv, st, omus, omur, oar, oarr, hid, hidr, crn) = - fmap (cnv,) <$> toMember (usr, srv, prv, st, omus, omur, oar, oarr, hid, hidr, crn) + (cnv, toMember (usr, srv, prv, st, omus, omur, oar, oarr, hid, hidr, crn)) members :: (MonadClient m, Log.MonadLogger m, MonadThrow m) => ConvId -> m [LocalMember] members conv = join <$> memberLists [conv] @@ -1025,25 +1025,19 @@ removeMember usr cnv = retry x5 . batch $ do addPrepQuery Cql.removeMember (cnv, usr) addPrepQuery Cql.deleteUserConv (usr, cnv) -newMember :: a -> InternalMember a +newMember :: UserId -> LocalMember newMember = flip newMemberWithRole roleNameWireAdmin -newMemberWithRole :: a -> RoleName -> InternalMember a +newMemberWithRole :: UserId -> RoleName -> LocalMember newMemberWithRole u r = - InternalMember - { memId = u, - memService = Nothing, - memOtrMutedStatus = Nothing, - memOtrMutedRef = Nothing, - memOtrArchived = False, - memOtrArchivedRef = Nothing, - memHidden = False, - memHiddenRef = Nothing, - memConvRoleName = r + LocalMember + { lmId = u, + lmService = Nothing, + lmStatus = defMemberStatus, + lmConvRoleName = r } toMember :: - (Log.MonadLogger m, MonadThrow m) => ( UserId, Maybe ServiceId, Maybe ProviderId, @@ -1060,24 +1054,24 @@ toMember :: -- conversation role name Maybe RoleName ) -> - m (Maybe LocalMember) -- FUTUREWORK: remove monad -toMember (usr, srv, prv, sta, omus, omur, oar, oarr, hid, hidr, crn) = - pure $ - if sta /= Just 0 - then Nothing - else - Just $ - InternalMember - { memId = usr, - memService = newServiceRef <$> srv <*> prv, - memOtrMutedStatus = omus, - memOtrMutedRef = omur, - memOtrArchived = fromMaybe False oar, - memOtrArchivedRef = oarr, - memHidden = fromMaybe False hid, - memHiddenRef = hidr, - memConvRoleName = fromMaybe roleNameWireAdmin crn - } + Maybe LocalMember +toMember (usr, srv, prv, Just 0, omus, omur, oar, oarr, hid, hidr, crn) = + Just $ + LocalMember + { lmId = usr, + lmService = newServiceRef <$> srv <*> prv, + lmStatus = + MemberStatus + { msOtrMutedStatus = omus, + msOtrMutedRef = omur, + msOtrArchived = fromMaybe False oar, + msOtrArchivedRef = oarr, + msHidden = fromMaybe False hid, + msHiddenRef = hidr + }, + lmConvRoleName = fromMaybe roleNameWireAdmin crn + } +toMember _ = Nothing -- Clients ------------------------------------------------------------------ diff --git a/services/galley/src/Galley/Data/Services.hs b/services/galley/src/Galley/Data/Services.hs index 3ab4ab474f..0b633476bb 100644 --- a/services/galley/src/Galley/Data/Services.hs +++ b/services/galley/src/Galley/Data/Services.hs @@ -53,13 +53,13 @@ import Imports newtype BotMember = BotMember {fromBotMember :: LocalMember} newBotMember :: LocalMember -> Maybe BotMember -newBotMember m = const (BotMember m) <$> memService m +newBotMember m = const (BotMember m) <$> lmService m botMemId :: BotMember -> BotId -botMemId = BotId . memId . fromBotMember +botMemId = BotId . lmId . fromBotMember botMemService :: BotMember -> ServiceRef -botMemService = fromJust . memService . fromBotMember +botMemService = fromJust . lmService . fromBotMember addBotMember :: Qualified UserId -> ServiceRef -> BotId -> ConvId -> UTCTime -> Galley (Event, BotMember) addBotMember qorig s bot cnv now = do @@ -77,7 +77,7 @@ addBotMember qorig s bot cnv now = do localDomain = qDomain qorig -- FUTUREWORK: support remote bots e = Event MemberJoin qcnv qorig now (EdMembersJoin . SimpleMembers $ (fmap toSimpleMember [botUserId bot])) - mem = (newMember (botUserId bot)) {memService = Just s} + mem = (newMember (botUserId bot)) {lmService = Just s} toSimpleMember :: UserId -> SimpleMember toSimpleMember u = SimpleMember (Qualified u localDomain) roleNameWireAdmin diff --git a/services/galley/src/Galley/Intra/Push.hs b/services/galley/src/Galley/Intra/Push.hs index 036ec3d856..04c2e48b3e 100644 --- a/services/galley/src/Galley/Intra/Push.hs +++ b/services/galley/src/Galley/Intra/Push.hs @@ -105,7 +105,7 @@ data RecipientBy user = Recipient makeLenses ''RecipientBy recipient :: LocalMember -> Recipient -recipient = userRecipient . memId +recipient = userRecipient . lmId userRecipient :: user -> RecipientBy user userRecipient u = Recipient u RecipientClientsAll diff --git a/services/galley/test/integration/API.hs b/services/galley/test/integration/API.hs index bab369f8cf..18e155628e 100644 --- a/services/galley/test/integration/API.hs +++ b/services/galley/test/integration/API.hs @@ -60,7 +60,7 @@ import qualified Data.Text as T import qualified Data.Text.Ascii as Ascii import Data.Time.Clock (getCurrentTime) import Galley.Options (Opts, optFederator) -import Galley.Types hiding (InternalMember (..)) +import Galley.Types hiding (LocalMember (..)) import Galley.Types.Conversations.Roles import qualified Galley.Types.Teams as Teams import Gundeck.Types.Notification diff --git a/services/galley/test/integration/API/Util.hs b/services/galley/test/integration/API/Util.hs index d871f67eeb..c5fd657653 100644 --- a/services/galley/test/integration/API/Util.hs +++ b/services/galley/test/integration/API/Util.hs @@ -70,7 +70,7 @@ import Data.UUID.V4 import Galley.Intra.User (chunkify) import qualified Galley.Options as Opts import qualified Galley.Run as Run -import Galley.Types hiding (InternalMember, MemberJoin, MemberLeave, memConvRoleName, memId, memOtrArchived, memOtrArchivedRef, memOtrMutedRef) +import Galley.Types import qualified Galley.Types as Conv import Galley.Types.Conversations.Roles hiding (DeleteConversation) import Galley.Types.Teams hiding (Event, EventType (..)) @@ -107,7 +107,6 @@ import Util.Options import Web.Cookie import Wire.API.Conversation import qualified Wire.API.Conversation as Public -import Wire.API.Event.Team (EventType (MemberJoin, MemberLeave, TeamDelete, TeamUpdate)) import qualified Wire.API.Event.Team as TE import qualified Wire.API.Federation.API.Brig as FederatedBrig import qualified Wire.API.Federation.API.Galley as FederatedGalley @@ -2182,7 +2181,7 @@ checkTeamMemberJoin :: HasCallStack => TeamId -> UserId -> WS.WebSocket -> TestM checkTeamMemberJoin tid uid w = WS.awaitMatch_ checkTimeout w $ \notif -> do ntfTransient notif @?= False let e = List1.head (WS.unpackPayload notif) - e ^. eventType @?= MemberJoin + e ^. eventType @?= TE.MemberJoin e ^. eventTeam @?= tid e ^. eventData @?= Just (EdMemberJoin uid) @@ -2190,7 +2189,7 @@ checkTeamMemberLeave :: HasCallStack => TeamId -> UserId -> WS.WebSocket -> Test checkTeamMemberLeave tid usr w = WS.assertMatch_ checkTimeout w $ \notif -> do ntfTransient notif @?= False let e = List1.head (WS.unpackPayload notif) - e ^. eventType @?= MemberLeave + e ^. eventType @?= TE.MemberLeave e ^. eventTeam @?= tid e ^. eventData @?= Just (EdMemberLeave usr) @@ -2198,7 +2197,7 @@ checkTeamUpdateEvent :: (HasCallStack, MonadIO m, MonadCatch m) => TeamId -> Tea checkTeamUpdateEvent tid upd w = WS.assertMatch_ checkTimeout w $ \notif -> do ntfTransient notif @?= False let e = List1.head (WS.unpackPayload notif) - e ^. eventType @?= TeamUpdate + e ^. eventType @?= TE.TeamUpdate e ^. eventTeam @?= tid e ^. eventData @?= Just (EdTeamUpdate upd) @@ -2215,7 +2214,7 @@ checkTeamDeleteEvent :: HasCallStack => TeamId -> WS.WebSocket -> TestM () checkTeamDeleteEvent tid w = WS.assertMatch_ checkTimeout w $ \notif -> do ntfTransient notif @?= False let e = List1.head (WS.unpackPayload notif) - e ^. eventType @?= TeamDelete + e ^. eventType @?= TE.TeamDelete e ^. eventTeam @?= tid e ^. eventData @?= Nothing diff --git a/services/galley/test/unit/Test/Galley/Mapping.hs b/services/galley/test/unit/Test/Galley/Mapping.hs index 2f77de53b2..dba1da3369 100644 --- a/services/galley/test/unit/Test/Galley/Mapping.hs +++ b/services/galley/test/unit/Test/Galley/Mapping.hs @@ -26,8 +26,7 @@ import Data.Qualified import Galley.API () import Galley.API.Mapping import qualified Galley.Data as Data -import Galley.Types (LocalMember, RemoteMember) -import qualified Galley.Types.Conversations.Members as I +import Galley.Types.Conversations.Members import Imports import Test.Tasty import Test.Tasty.HUnit @@ -154,7 +153,7 @@ mkOtherMember :: Qualified UserId -> OtherMember mkOtherMember u = OtherMember u Nothing roleNameWireAdmin mkRemoteMember :: Qualified UserId -> RemoteMember -mkRemoteMember u = I.RemoteMember (toRemote u) roleNameWireAdmin +mkRemoteMember u = RemoteMember (toRemote u) roleNameWireAdmin mkInternalConv :: [LocalMember] -> [RemoteMember] -> IO Data.Conversation mkInternalConv locals remotes = do @@ -193,14 +192,9 @@ mkMember (Qualified userId _domain) = mkInternalMember :: Qualified UserId -> LocalMember mkInternalMember (Qualified userId _domain) = - I.InternalMember - { I.memId = userId, - I.memService = Nothing, - I.memOtrMutedStatus = Nothing, - I.memOtrMutedRef = Nothing, - I.memOtrArchived = False, - I.memOtrArchivedRef = Nothing, - I.memHidden = False, - I.memHiddenRef = Nothing, - I.memConvRoleName = roleNameWireAdmin + LocalMember + { lmId = userId, + lmService = Nothing, + lmStatus = defMemberStatus, + lmConvRoleName = roleNameWireAdmin } From 6fcc60307481968f72411c15ebdbff7251bf637e Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Fri, 10 Sep 2021 17:11:03 +0200 Subject: [PATCH 06/19] Make user id unqualified in get-conversations RPC The user domain has to be the same as the origin domain, so omitting it does not lose any information and saves us a check (which we weren't doing anyway). --- .../src/Wire/API/Federation/API/Galley.hs | 3 ++- services/galley/src/Galley/API/Federation.hs | 9 +++++---- services/galley/src/Galley/API/Query.hs | 10 ++++------ services/galley/test/integration/API.hs | 2 +- services/galley/test/integration/API/Federation.hs | 8 ++++---- 5 files changed, 16 insertions(+), 16 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 02a46ed39e..8e2e2c964c 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 @@ -60,6 +60,7 @@ data Api routes = Api routes :- "federation" :> "get-conversations" + :> OriginDomainHeader :> ReqBody '[JSON] GetConversationsRequest :> Post '[JSON] GetConversationsResponse, -- used by backend that owns the conversation to inform the backend about @@ -100,7 +101,7 @@ data Api routes = Api deriving (Generic) data GetConversationsRequest = GetConversationsRequest - { gcrUserId :: Qualified UserId, + { gcrUserId :: UserId, gcrConvIds :: [ConvId] } deriving stock (Eq, Show, Generic) diff --git a/services/galley/src/Galley/API/Federation.hs b/services/galley/src/Galley/API/Federation.hs index 107290acbc..072b4981fa 100644 --- a/services/galley/src/Galley/API/Federation.hs +++ b/services/galley/src/Galley/API/Federation.hs @@ -96,11 +96,12 @@ onConversationCreated domain rc = do (EdConversation c) pushConversationEvent Nothing event [Public.memId mem] [] -getConversations :: GetConversationsRequest -> Galley GetConversationsResponse -getConversations (GetConversationsRequest qUid gcrConvIds) = do - domain <- viewFederationDomain +getConversations :: Domain -> GetConversationsRequest -> Galley GetConversationsResponse +getConversations domain (GetConversationsRequest uid gcrConvIds) = do + let qUid = Qualified uid domain + localDomain <- viewFederationDomain convs <- Data.conversations gcrConvIds - let convViews = Mapping.conversationViewMaybeQualified domain qUid <$> convs + let convViews = Mapping.conversationViewMaybeQualified localDomain qUid <$> convs pure $ GetConversationsResponse . catMaybes $ convViews -- | Update the local database with information on conversation members joining diff --git a/services/galley/src/Galley/API/Query.hs b/services/galley/src/Galley/API/Query.hs index 72f9ce7c98..39a75f7603 100644 --- a/services/galley/src/Galley/API/Query.hs +++ b/services/galley/src/Galley/API/Query.hs @@ -116,22 +116,20 @@ getConversation zusr cnv = do getRemoteConversations :: UserId -> [Remote ConvId] -> Galley [Public.Conversation] getRemoteConversations zusr remoteConvs = do localDomain <- viewFederationDomain - let qualifiedZUser = Qualified zusr localDomain let convsByDomain = partitionRemote remoteConvs convs <- pooledForConcurrentlyN 8 convsByDomain $ \(remoteDomain, convIds) -> do - let req = FederatedGalley.GetConversationsRequest qualifiedZUser convIds - rpc = FederatedGalley.getConversations FederatedGalley.clientRoutes req + let req = FederatedGalley.GetConversationsRequest zusr convIds + rpc = FederatedGalley.getConversations FederatedGalley.clientRoutes localDomain req gcresConvs <$> runFederatedGalley remoteDomain rpc pure $ concat convs getRemoteConversationsWithFailures :: UserId -> [Remote ConvId] -> Galley ([Qualified ConvId], [Public.Conversation]) getRemoteConversationsWithFailures zusr remoteConvs = do localDomain <- viewFederationDomain - let qualifiedZUser = Qualified zusr localDomain let convsByDomain = partitionRemote remoteConvs convs <- pooledForConcurrentlyN 8 convsByDomain $ \(remoteDomain, convIds) -> handleFailures remoteDomain convIds $ do - let req = FederatedGalley.GetConversationsRequest qualifiedZUser convIds - rpc = FederatedGalley.getConversations FederatedGalley.clientRoutes req + let req = FederatedGalley.GetConversationsRequest zusr convIds + rpc = FederatedGalley.getConversations FederatedGalley.clientRoutes localDomain req gcresConvs <$> executeFederated remoteDomain rpc pure $ concatEithers convs where diff --git a/services/galley/test/integration/API.hs b/services/galley/test/integration/API.hs index 18e155628e..9ff4054333 100644 --- a/services/galley/test/integration/API.hs +++ b/services/galley/test/integration/API.hs @@ -226,7 +226,7 @@ emptyFederatedGalley = e s = throwError err501 {errBody = cs ("mock not implemented: " <> s)} in FederatedGalley.Api { FederatedGalley.onConversationCreated = \_ _ -> e "onConversationCreated", - FederatedGalley.getConversations = \_ -> e "getConversations", + FederatedGalley.getConversations = \_ _ -> e "getConversations", FederatedGalley.onConversationMembershipsChanged = \_ _ -> e "onConversationMembershipsChanged", FederatedGalley.leaveConversation = \_ _ -> e "leaveConversation", FederatedGalley.onMessageSent = \_ _ -> e "onMessageSent", diff --git a/services/galley/test/integration/API/Federation.hs b/services/galley/test/integration/API/Federation.hs index 1cb7090568..5b1112d71e 100644 --- a/services/galley/test/integration/API/Federation.hs +++ b/services/galley/test/integration/API/Federation.hs @@ -92,11 +92,11 @@ getConversationsAllFound = do fedGalleyClient <- view tsFedGalleyClient localDomain <- viewFederationDomain - let aliceQualified = Qualified alice localDomain GetConversationsResponse cs <- FedGalley.getConversations fedGalleyClient - (GetConversationsRequest aliceQualified $ qUnqualified . cnvQualifiedId <$> [cnv1, cnv2]) + localDomain + (GetConversationsRequest alice $ qUnqualified . cnvQualifiedId <$> [cnv1, cnv2]) let c1 = find ((== cnvQualifiedId cnv1) . cnvQualifiedId) cs let c2 = find ((== cnvQualifiedId cnv2) . cnvQualifiedId) cs liftIO . forM_ [(cnv1, c1), (cnv2, c2)] $ \(expected, actual) -> do @@ -127,11 +127,11 @@ getConversationsNotPartOf = do fedGalleyClient <- view tsFedGalleyClient localDomain <- viewFederationDomain rando <- Id <$> liftIO nextRandom - let randoQualified = Qualified rando localDomain GetConversationsResponse cs <- FedGalley.getConversations fedGalleyClient - (GetConversationsRequest randoQualified [qUnqualified . cnvQualifiedId $ cnv1]) + localDomain + (GetConversationsRequest rando [qUnqualified . cnvQualifiedId $ cnv1]) liftIO $ assertEqual "conversation list not empty" [] cs addLocalUser :: TestM () From b75a93f87dbdcd5b09f0bb0ccd9cb0281ecb708a Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Fri, 10 Sep 2021 17:36:09 +0200 Subject: [PATCH 07/19] Fix remote user self info in get-conversations RPC This removes the hack of returning a fake self member in the get-conversations RPC, by introducing a different type for remote conversations. A `RemoteConversation` object contains the same information as a normal `Conversation`, except the self member is replaced by simply a `RoleName`, which is the only bit of information for remote users that is actually stored locally. The functions in `Galley.API.Mapping` have been rewritten to fit the new convention. Notes: - the Mapping tests have been commented out; they probably should be rewritten and become unit tests; - remote conversation status flags are still always set to their default values. --- .../src/Wire/API/Federation/API/Galley.hs | 25 +- services/galley/src/Galley/API/Federation.hs | 13 +- services/galley/src/Galley/API/Mapping.hs | 138 ++++--- services/galley/src/Galley/API/Query.hs | 28 +- services/galley/src/Galley/Data.hs | 16 +- services/galley/test/integration/API.hs | 42 ++- .../galley/test/integration/API/Federation.hs | 17 +- services/galley/test/integration/API/Util.hs | 33 +- .../galley/test/unit/Test/Galley/Mapping.hs | 348 +++++++++--------- 9 files changed, 378 insertions(+), 282 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 8e2e2c964c..d80a55a5e2 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 @@ -30,8 +30,7 @@ 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 (Access, AccessRole, ConvType, Conversation, ReceiptMode) -import Wire.API.Conversation.Member (OtherMember) +import Wire.API.Conversation import Wire.API.Conversation.Role (RoleName) import Wire.API.Federation.Client (FederationClientFailure, FederatorClient) import Wire.API.Federation.Domain (OriginDomainHeader) @@ -108,8 +107,28 @@ data GetConversationsRequest = GetConversationsRequest deriving (Arbitrary) via (GenericUniform GetConversationsRequest) deriving (ToJSON, FromJSON) via (CustomEncoded GetConversationsRequest) +data RemoteConvMembers = RemoteConvMembers + { rcmSelfRole :: RoleName, + rcmOthers :: [OtherMember] + } + deriving stock (Eq, Show, Generic) + deriving (Arbitrary) via (GenericUniform RemoteConvMembers) + deriving (FromJSON, ToJSON) via (CustomEncoded RemoteConvMembers) + +-- | A conversation hosted on a remote backend. This contains the same +-- information as a 'Conversation', with the exception that conversation status +-- fields (muted/archived/hidden) are omitted, since they are not known by the +-- remote backend. +data RemoteConversation = RemoteConversation + { rcnvMetadata :: ConversationMetadata, + rcnvMembers :: RemoteConvMembers + } + deriving stock (Eq, Show, Generic) + deriving (Arbitrary) via (GenericUniform RemoteConversation) + deriving (FromJSON, ToJSON) via (CustomEncoded RemoteConversation) + newtype GetConversationsResponse = GetConversationsResponse - { gcresConvs :: [Conversation] + { gcresConvs :: [RemoteConversation] } deriving stock (Eq, Show, Generic) deriving (Arbitrary) via (GenericUniform GetConversationsResponse) diff --git a/services/galley/src/Galley/API/Federation.hs b/services/galley/src/Galley/API/Federation.hs index 072b4981fa..414e36d421 100644 --- a/services/galley/src/Galley/API/Federation.hs +++ b/services/galley/src/Galley/API/Federation.hs @@ -27,7 +27,7 @@ import Data.Json.Util (Base64ByteString (..)) import Data.List1 (list1) import qualified Data.Map as Map import Data.Map.Lens (toMapOf) -import Data.Qualified (Qualified (..)) +import Data.Qualified (Qualified (..), toRemote) import qualified Data.Set as Set import Data.Tagged import qualified Data.Text.Lazy as LT @@ -97,12 +97,13 @@ onConversationCreated domain rc = do pushConversationEvent Nothing event [Public.memId mem] [] getConversations :: Domain -> GetConversationsRequest -> Galley GetConversationsResponse -getConversations domain (GetConversationsRequest uid gcrConvIds) = do - let qUid = Qualified uid domain +getConversations domain (GetConversationsRequest uid cids) = do + let ruid = toRemote $ Qualified uid domain localDomain <- viewFederationDomain - convs <- Data.conversations gcrConvIds - let convViews = Mapping.conversationViewMaybeQualified localDomain qUid <$> convs - pure $ GetConversationsResponse . catMaybes $ convViews + GetConversationsResponse + . catMaybes + . map (Mapping.conversationToRemote localDomain ruid) + <$> Data.conversations cids -- | Update the local database with information on conversation members joining -- or leaving. Finally, push out notifications to local users. diff --git a/services/galley/src/Galley/API/Mapping.hs b/services/galley/src/Galley/API/Mapping.hs index 1196567fdb..f0c8f6329a 100644 --- a/services/galley/src/Galley/API/Mapping.hs +++ b/services/galley/src/Galley/API/Mapping.hs @@ -17,13 +17,18 @@ -- You should have received a copy of the GNU Affero General Public License along -- with this program. If not, see . -module Galley.API.Mapping where +module Galley.API.Mapping + ( conversationView, + remoteConversationView, + conversationToRemote, + localMemberToSelf, + ) +where import Control.Monad.Catch import Data.Domain (Domain) import Data.Id (UserId, idToText) -import qualified Data.List as List -import Data.Qualified (Qualified (..)) +import Data.Qualified import Galley.API.Util (viewFederationDomain) import Galley.App import qualified Galley.Data as Data @@ -34,13 +39,16 @@ import Network.HTTP.Types.Status import Network.Wai.Utilities.Error import qualified System.Logger.Class as Log import System.Logger.Message (msg, val, (+++)) -import qualified Wire.API.Conversation as Public +import Wire.API.Conversation +import Wire.API.Federation.API.Galley -- | View for a given user of a stored conversation. +-- -- Throws "bad-state" when the user is not part of the conversation. -conversationView :: UserId -> Data.Conversation -> Galley Public.Conversation +conversationView :: UserId -> Data.Conversation -> Galley Conversation conversationView uid conv = do - mbConv <- conversationViewMaybe uid conv + localDomain <- viewFederationDomain + let mbConv = conversationViewMaybe localDomain uid conv maybe memberNotFound pure mbConv where memberNotFound = do @@ -52,60 +60,76 @@ conversationView uid conv = do throwM badState badState = mkError status500 "bad-state" "Bad internal member state." -conversationViewMaybe :: UserId -> Data.Conversation -> Galley (Maybe Public.Conversation) -conversationViewMaybe u conv = do - localDomain <- viewFederationDomain - pure $ conversationViewMaybeQualified localDomain (Qualified u localDomain) conv - -- | View for a given user of a stored conversation. --- Returns 'Nothing' when the user is not part of the conversation. -conversationViewMaybeQualified :: Domain -> Qualified UserId -> Data.Conversation -> Maybe Public.Conversation -conversationViewMaybeQualified localDomain qUid Data.Conversation {..} = do - let localMembers = localMemberToOther localDomain <$> convLocalMembers - let remoteMembers = remoteMemberToOther <$> convRemoteMembers - let me = List.find ((qUid ==) . Public.omQualifiedId) (localMembers <> remoteMembers) - let otherMembers = filter ((qUid /=) . Public.omQualifiedId) (localMembers <> remoteMembers) - let userAndConvOnSameBackend = find ((qUnqualified qUid ==) . lmId) convLocalMembers - let selfMember = - -- if the user and the conversation are on the same backend, we can create a real self member - -- otherwise, we need to fall back to a default self member (see futurework) - -- (Note: the extra domain check is done to catch the edge case where two users in a conversation have the same unqualified UUID) - if isJust userAndConvOnSameBackend && localDomain == qDomain qUid - then localToSelf <$> userAndConvOnSameBackend - else remoteToSelf <$> me - selfMember <&> \m -> do - let mems = Public.ConvMembers m otherMembers - Public.mkConversation - (Qualified convId localDomain) - convType - convCreator - convAccess - convAccessRole - convName - mems - convTeam - convMessageTimer - convReceiptMode +-- +-- Returns 'Nothing' if the user is not part of the conversation. +conversationViewMaybe :: Domain -> UserId -> Data.Conversation -> Maybe Conversation +conversationViewMaybe localDomain uid conv = do + let (selfs, lothers) = partition ((uid ==) . lmId) (Data.convLocalMembers conv) + rothers = Data.convRemoteMembers conv + self <- localMemberToSelf <$> listToMaybe selfs + let others = + map (localMemberToOther localDomain) lothers + <> map remoteMemberToOther rothers + pure $ + Conversation + (Data.convMetadata localDomain conv) + (ConvMembers self others) --- FUTUREWORK(federation): we currently don't store muted, archived etc status for users who are on a different backend than a conversation --- but we should. Once this information is available, the code should be changed to use the stored information, rather than these defaults. -remoteToSelf :: Public.OtherMember -> Public.Member -remoteToSelf m = - Public.Member - { memId = qUnqualified (Public.omQualifiedId m), - memService = Nothing, - memOtrMutedStatus = Nothing, - memOtrMutedRef = Nothing, - memOtrArchived = False, - memOtrArchivedRef = Nothing, - memHidden = False, - memHiddenRef = Nothing, - memConvRoleName = Public.omConvRoleName m - } +-- | View for a local user of a remote conversation. +-- +-- If the local user is not actually present in the conversation, simply +-- discard the conversation altogether. This should only happen if the remote +-- backend is misbehaving. +remoteConversationView :: + UserId -> + MemberStatus -> + RemoteConversation -> + Maybe Conversation +remoteConversationView uid status rconv = do + let mems = rcnvMembers rconv + others = rcmOthers mems + self = + localMemberToSelf + LocalMember + { lmId = uid, + lmService = Nothing, + lmStatus = status, + lmConvRoleName = rcmSelfRole mems + } + pure $ Conversation (rcnvMetadata rconv) (ConvMembers self others) + +-- | Convert a local conversation to a structure to be returned to a remote +-- backend. +-- +-- This returns 'Nothing' if the given remote user is not part of the conversation. +conversationToRemote :: + Domain -> + Remote UserId -> + Data.Conversation -> + Maybe RemoteConversation +conversationToRemote localDomain ruid conv = do + let (selfs, rothers) = partition ((== ruid) . rmId) (Data.convRemoteMembers conv) + lothers = Data.convLocalMembers conv + selfRole <- rmConvRoleName <$> listToMaybe selfs + let others = + map (localMemberToOther localDomain) lothers + <> map remoteMemberToOther rothers + pure $ + RemoteConversation + { rcnvMetadata = Data.convMetadata localDomain conv, + rcnvMembers = + RemoteConvMembers + { rcmSelfRole = selfRole, + rcmOthers = others + } + } -localToSelf :: LocalMember -> Public.Member -localToSelf lm = - Public.Member +-- | Convert a local conversation member (as stored in the DB) to a publicly +-- facing 'Member' structure. +localMemberToSelf :: LocalMember -> Member +localMemberToSelf lm = + Member { memId = lmId lm, memService = lmService lm, memOtrMutedStatus = msOtrMutedStatus st, diff --git a/services/galley/src/Galley/API/Query.hs b/services/galley/src/Galley/API/Query.hs index 39a75f7603..2bcf4444af 100644 --- a/services/galley/src/Galley/API/Query.hs +++ b/services/galley/src/Galley/API/Query.hs @@ -54,6 +54,7 @@ import Galley.App import qualified Galley.Data as Data import qualified Galley.Data.Types as Data import Galley.Types +import Galley.Types.Conversations.Members import Galley.Types.Conversations.Roles import Imports import Network.HTTP.Types @@ -66,7 +67,7 @@ import Wire.API.Conversation (ConversationCoverView (..)) import qualified Wire.API.Conversation as Public import qualified Wire.API.Conversation.Role as Public import Wire.API.ErrorDescription (convNotFound) -import Wire.API.Federation.API.Galley (gcresConvs) +import Wire.API.Federation.API.Galley (RemoteConversation, gcresConvs) import qualified Wire.API.Federation.API.Galley as FederatedGalley import Wire.API.Federation.Client (FederationError, executeFederated) import Wire.API.Federation.Error @@ -113,25 +114,38 @@ getConversation zusr cnv = do [conv] -> pure conv _convs -> throwM (federationUnexpectedBody "expected one conversation, got multiple") +mapRemoteConversations :: UserId -> [(MemberStatus, RemoteConversation)] -> [Public.Conversation] +mapRemoteConversations uid = catMaybes . map (uncurry (Mapping.remoteConversationView uid)) + getRemoteConversations :: UserId -> [Remote ConvId] -> Galley [Public.Conversation] getRemoteConversations zusr remoteConvs = do localDomain <- viewFederationDomain let convsByDomain = partitionRemote remoteConvs - convs <- pooledForConcurrentlyN 8 convsByDomain $ \(remoteDomain, convIds) -> do + rconvs <- pooledForConcurrentlyN 8 convsByDomain $ \(remoteDomain, convIds) -> do let req = FederatedGalley.GetConversationsRequest zusr convIds rpc = FederatedGalley.getConversations FederatedGalley.clientRoutes localDomain req gcresConvs <$> runFederatedGalley remoteDomain rpc - pure $ concat convs + -- TODO: read member status from the database + pure + . mapRemoteConversations zusr + . (map (defMemberStatus,)) + . concat + $ rconvs getRemoteConversationsWithFailures :: UserId -> [Remote ConvId] -> Galley ([Qualified ConvId], [Public.Conversation]) getRemoteConversationsWithFailures zusr remoteConvs = do localDomain <- viewFederationDomain let convsByDomain = partitionRemote remoteConvs - convs <- pooledForConcurrentlyN 8 convsByDomain $ \(remoteDomain, convIds) -> handleFailures remoteDomain convIds $ do + rconvs <- pooledForConcurrentlyN 8 convsByDomain $ \(remoteDomain, convIds) -> handleFailures remoteDomain convIds $ do let req = FederatedGalley.GetConversationsRequest zusr convIds rpc = FederatedGalley.getConversations FederatedGalley.clientRoutes localDomain req gcresConvs <$> executeFederated remoteDomain rpc - pure $ concatEithers convs + pure + -- TODO: read member status from the database + . fmap (mapRemoteConversations zusr . map (defMemberStatus,)) + . bimap concat concat + . partitionEithers + $ (rconvs :: [Either [Qualified ConvId] [RemoteConversation]]) where handleFailures :: Domain -> [ConvId] -> ExceptT FederationError Galley a -> Galley (Either [Qualified ConvId] a) handleFailures domain convIds action = do @@ -143,8 +157,6 @@ getRemoteConversationsWithFailures zusr remoteConvs = do Logger.msg ("Error occurred while fetching remote conversations" :: ByteString) . Logger.field "error" (show e) pure . Left $ map (`Qualified` domain) convIds - concatEithers :: (Monoid a, Monoid b) => [Either a b] -> (a, b) - concatEithers = bimap mconcat mconcat . partitionEithers getConversationRoles :: UserId -> ConvId -> Galley Public.ConversationRolesList getConversationRoles zusr cnv = do @@ -353,7 +365,7 @@ getLocalSelf :: UserId -> ConvId -> Galley (Maybe Public.Member) getLocalSelf usr cnv = do alive <- Data.isConvAlive cnv if alive - then Mapping.localToSelf <$$> Data.member cnv usr + then Mapping.localMemberToSelf <$$> Data.member cnv usr else Nothing <$ Data.deleteConversation cnv getConversationMetaH :: ConvId -> Galley Response diff --git a/services/galley/src/Galley/Data.hs b/services/galley/src/Galley/Data.hs index 9a9be8e9c9..c560d15952 100644 --- a/services/galley/src/Galley/Data.hs +++ b/services/galley/src/Galley/Data.hs @@ -55,6 +55,7 @@ module Galley.Data -- * Conversations Conversation (..), + convMetadata, acceptConnect, conversation, conversationIdsFrom, @@ -62,8 +63,8 @@ module Galley.Data remoteConversationIdOf, localConversationIdsPageFrom, conversationIdRowsForPagination, - conversationMeta, conversations, + conversationMeta, conversationsRemote, createConnectConversation, createConversation, @@ -753,6 +754,19 @@ newConv cid ct usr mems rMems acc role name tid mtimer rMode = convReceiptMode = rMode } +convMetadata :: Domain -> Conversation -> ConversationMetadata +convMetadata localDomain c = + ConversationMetadata + (Qualified (convId c) localDomain) + (convType c) + (convCreator c) + (convAccess c) + (convAccessRole c) + (convName c) + (convTeam c) + (convMessageTimer c) + (convReceiptMode c) + defAccess :: ConvType -> Maybe (Set Access) -> [Access] defAccess SelfConv Nothing = [PrivateAccess] defAccess ConnectConv Nothing = [PrivateAccess] diff --git a/services/galley/test/integration/API.hs b/services/galley/test/integration/API.hs index 9ff4054333..e020de0d92 100644 --- a/services/galley/test/integration/API.hs +++ b/services/galley/test/integration/API.hs @@ -59,8 +59,10 @@ import Data.String.Conversions (cs) import qualified Data.Text as T import qualified Data.Text.Ascii as Ascii import Data.Time.Clock (getCurrentTime) +import Galley.API.Mapping import Galley.Options (Opts, optFederator) import Galley.Types hiding (LocalMember (..)) +import Galley.Types.Conversations.Members import Galley.Types.Conversations.Roles import qualified Galley.Types.Teams as Teams import Gundeck.Types.Notification @@ -79,7 +81,11 @@ import TestSetup import Util.Options (Endpoint (Endpoint)) import Wire.API.Conversation import qualified Wire.API.Federation.API.Brig as FederatedBrig -import Wire.API.Federation.API.Galley (GetConversationsResponse (..)) +import Wire.API.Federation.API.Galley + ( GetConversationsResponse (..), + RemoteConvMembers (..), + RemoteConversation (..), + ) import qualified Wire.API.Federation.API.Galley as FederatedGalley import qualified Wire.API.Federation.GRPC.Types as F import qualified Wire.API.Message as Message @@ -1886,14 +1892,19 @@ testGetQualifiedRemoteConv = do let remoteDomain = Domain "far-away.example.com" bobQ = Qualified bobId remoteDomain remoteConvId = Qualified convId remoteDomain - aliceAsOtherMember = OtherMember aliceQ Nothing roleNameWireAdmin bobAsOtherMember = OtherMember bobQ Nothing roleNameWireAdmin - aliceAsMember = Member aliceId Nothing Nothing Nothing False Nothing False Nothing roleNameWireAdmin + aliceAsLocal = LocalMember aliceId defMemberStatus Nothing roleNameWireAdmin + aliceAsOtherMember = localMemberToOther (qDomain aliceQ) aliceAsLocal + aliceAsSelfMember = localMemberToSelf aliceAsLocal registerRemoteConv remoteConvId bobQ Nothing (Set.fromList [aliceAsOtherMember]) - let mockConversation = mkConv remoteConvId bobId aliceAsMember [bobAsOtherMember] + let mockConversation = mkConv remoteConvId bobId roleNameWireAdmin [bobAsOtherMember] remoteConversationResponse = GetConversationsResponse [mockConversation] + expected = + Conversation + (rcnvMetadata mockConversation) + (ConvMembers aliceAsSelfMember (rcmOthers (rcnvMembers mockConversation))) opts <- view tsGConf (respAll, _) <- @@ -1906,7 +1917,7 @@ testGetQualifiedRemoteConv = do conv <- responseJsonUnsafe <$> (pure respAll (pure respAll (pure respAll maybeToList (remoteConversationView alice defMemberStatus mockConversationB) + <> [localConv] actualFound = sortOn cnvQualifiedId $ crFound convs assertEqual "found conversations" expectedFound actualFound diff --git a/services/galley/test/integration/API/Federation.hs b/services/galley/test/integration/API/Federation.hs index 5b1112d71e..59c352b074 100644 --- a/services/galley/test/integration/API/Federation.hs +++ b/services/galley/test/integration/API/Federation.hs @@ -48,8 +48,9 @@ import qualified Test.Tasty.Cannon as WS import Test.Tasty.HUnit import TestHelpers import TestSetup +import Wire.API.Conversation.Member (Member (..)) import Wire.API.Conversation.Role -import Wire.API.Federation.API.Galley (GetConversationsRequest (..), GetConversationsResponse (..)) +import Wire.API.Federation.API.Galley (GetConversationsRequest (..), GetConversationsResponse (..), RemoteConvMembers (..), RemoteConversation (..)) import qualified Wire.API.Federation.API.Galley as FedGalley import qualified Wire.API.Federation.GRPC.Types as F import Wire.API.Message (ClientMismatchStrategy (..), MessageSendingStatus (mssDeletedClients, mssFailedToSend, mssRedundantClients), mkQualifiedOtrPayload, mssMissingClients) @@ -97,21 +98,21 @@ getConversationsAllFound = do fedGalleyClient localDomain (GetConversationsRequest alice $ qUnqualified . cnvQualifiedId <$> [cnv1, cnv2]) - let c1 = find ((== cnvQualifiedId cnv1) . cnvQualifiedId) cs - let c2 = find ((== cnvQualifiedId cnv2) . cnvQualifiedId) cs + let c1 = find ((== cnvQualifiedId cnv1) . cnvmQualifiedId . rcnvMetadata) cs + let c2 = find ((== cnvQualifiedId cnv2) . cnvmQualifiedId . rcnvMetadata) cs liftIO . forM_ [(cnv1, c1), (cnv2, c2)] $ \(expected, actual) -> do assertEqual "name mismatch" (Just $ cnvName expected) - (cnvName <$> actual) + (cnvmName . rcnvMetadata <$> actual) assertEqual - "self member mismatch" - (Just . cmSelf $ cnvMembers expected) - (cmSelf . cnvMembers <$> actual) + "self member role mismatch" + (Just . memConvRoleName . cmSelf $ cnvMembers expected) + (rcmSelfRole . rcnvMembers <$> actual) assertEqual "other members mismatch" (Just []) - ((\c -> cmOthers (cnvMembers c) \\ cmOthers (cnvMembers expected)) <$> actual) + ((\c -> rcmOthers (rcnvMembers c) \\ cmOthers (cnvMembers expected)) <$> actual) getConversationsNotPartOf :: TestM () getConversationsNotPartOf = do diff --git a/services/galley/test/integration/API/Util.hs b/services/galley/test/integration/API/Util.hs index c5fd657653..1fd5a93040 100644 --- a/services/galley/test/integration/API/Util.hs +++ b/services/galley/test/integration/API/Util.hs @@ -1867,19 +1867,26 @@ someLastPrekeys = lastPrekey "pQABARn//wKhAFgg1rZEY6vbAnEz+Ern5kRny/uKiIrXTb/usQxGnceV2HADoQChAFgglacihnqg/YQJHkuHNFU7QD6Pb3KN4FnubaCF2EVOgRkE9g==" ] -mkConv :: Qualified ConvId -> UserId -> Member -> [OtherMember] -> Conversation -mkConv cnvId creator selfMember otherMembers = - mkConversation - cnvId - RegularConv - creator - [] - ActivatedAccessRole - (Just "federated gossip") - (ConvMembers selfMember otherMembers) - Nothing - Nothing - Nothing +mkConv :: + Qualified ConvId -> + UserId -> + RoleName -> + [OtherMember] -> + FederatedGalley.RemoteConversation +mkConv cnvId creator selfRole otherMembers = + FederatedGalley.RemoteConversation + ( ConversationMetadata + cnvId + RegularConv + creator + [] + ActivatedAccessRole + (Just "federated gossip") + Nothing + Nothing + Nothing + ) + (FederatedGalley.RemoteConvMembers selfRole otherMembers) -- | ES is only refreshed occasionally; we don't want to wait for that in tests. refreshIndex :: TestM () diff --git a/services/galley/test/unit/Test/Galley/Mapping.hs b/services/galley/test/unit/Test/Galley/Mapping.hs index dba1da3369..0eed89817e 100644 --- a/services/galley/test/unit/Test/Galley/Mapping.hs +++ b/services/galley/test/unit/Test/Galley/Mapping.hs @@ -20,181 +20,185 @@ module Test.Galley.Mapping where -import Data.Domain -import Data.Id -import Data.Qualified -import Galley.API () -import Galley.API.Mapping -import qualified Galley.Data as Data -import Galley.Types.Conversations.Members -import Imports +-- import Data.Domain +-- import Data.Id +-- import Data.Qualified +-- import Galley.API () +-- import Galley.API.Mapping +-- import qualified Galley.Data as Data +-- import Galley.Types.Conversations.Members +-- import Imports import Test.Tasty -import Test.Tasty.HUnit -import Wire.API.Conversation -import Wire.API.Conversation.Role (roleNameWireAdmin) + +-- import Test.Tasty.HUnit +-- import Wire.API.Conversation +-- import Wire.API.Conversation.Role (roleNameWireAdmin) tests :: TestTree tests = testGroup "ConversationMapping" - [ testCase "Alice@A Conv@A" runMappingSimple, - testCase "Alice@A Conv@A requester=not a member@A" runMappingNotAMemberA, - testCase "Alice@A Conv@A requester=not a member@B" runMappingNotAMemberB, - testCase "Alice@A Conv@A Bob@B" runMappingRemoteUser, - testCase "Alice@A Conv@B Bob@B" runMappingRemoteConv, - testCase "Alice@A Conv@B Bob@B bobUUID=aliceUUID" runMappingSameUnqualifiedUUID - ] - -runMappingSimple :: HasCallStack => IO () -runMappingSimple = do - let convDomain = Domain "backendA.example.com" - let userDomain = Domain "backendA.example.com" - alice <- randomId - let requester = Qualified alice userDomain - let expectedSelf = Just $ mkMember requester - let expectedOthers = Just [] - - let locals = [mkInternalMember requester] - let remotes = [] - conv <- mkInternalConv locals remotes - let actual = cnvMembers <$> conversationViewMaybeQualified convDomain requester conv - - assertEqual "self:" expectedSelf (cmSelf <$> actual) - assertEqual "others:" expectedOthers (cmOthers <$> actual) - -runMappingNotAMemberA :: HasCallStack => IO () -runMappingNotAMemberA = do - let convDomain = Domain "backendA.example.com" - let aliceDomain = Domain "backendA.example.com" - alice <- flip Qualified aliceDomain <$> randomId - requester <- flip Qualified aliceDomain <$> randomId - - let locals = [mkInternalMember alice] - let remotes = [] - conv <- mkInternalConv locals remotes - let actual = cnvMembers <$> conversationViewMaybeQualified convDomain requester conv - - assertEqual "members:" Nothing actual - -runMappingNotAMemberB :: HasCallStack => IO () -runMappingNotAMemberB = do - let convDomain = Domain "backendA.example.com" - let aliceDomain = Domain "backendA.example.com" - let requesterDomain = Domain "backendB.example.com" - alice <- flip Qualified aliceDomain <$> randomId - requester <- flip Qualified requesterDomain <$> randomId - - let locals = [mkInternalMember alice] - let remotes = [] - conv <- mkInternalConv locals remotes - let actual = cnvMembers <$> conversationViewMaybeQualified convDomain requester conv - - assertEqual "members:" Nothing actual - -runMappingRemoteUser :: HasCallStack => IO () -runMappingRemoteUser = do - let aliceDomain = Domain "backendA.example.com" - let convDomain = Domain "backendA.example.com" - let bobDomain = Domain "backendB.example.com" - alice <- flip Qualified aliceDomain <$> randomId - bob <- flip Qualified bobDomain <$> randomId - let expectedSelf = Just $ mkMember alice - let expectedOthers = Just [mkOtherMember bob] - - let locals = [mkInternalMember alice] - let remotes = [mkRemoteMember bob] - conv <- mkInternalConv locals remotes - let actual = cnvMembers <$> conversationViewMaybeQualified convDomain alice conv - - assertEqual "self:" expectedSelf (cmSelf <$> actual) - assertEqual "others:" expectedOthers (cmOthers <$> actual) - -runMappingRemoteConv :: HasCallStack => IO () -runMappingRemoteConv = do - let aliceDomain = Domain "backendA.example.com" - let convDomain = Domain "backendB.example.com" - let bobDomain = Domain "backendB.example.com" - alice <- flip Qualified aliceDomain <$> randomId - bob <- flip Qualified bobDomain <$> randomId - let expectedSelf = Just $ mkMember alice - let expectedOthers = Just [mkOtherMember bob] - - let locals = [mkInternalMember bob] - let remotes = [mkRemoteMember alice] - conv <- mkInternalConv locals remotes - let actual = cnvMembers <$> conversationViewMaybeQualified convDomain alice conv - - assertEqual "self:" expectedSelf (cmSelf <$> actual) - assertEqual "others:" expectedOthers (cmOthers <$> actual) - --- Here we expect the conversationView to return nothing, because Alice (the --- requester) is not part of the conversation (Her unqualified UUID is part of --- the conversation, but the function should catch this possibly malicious --- edge case) -runMappingSameUnqualifiedUUID :: HasCallStack => IO () -runMappingSameUnqualifiedUUID = do - let aliceDomain = Domain "backendA.example.com" - let convDomain = Domain "backendB.example.com" - let bobDomain = Domain "backendB.example.com" - uuid <- randomId - let alice = Qualified uuid aliceDomain - let bob = Qualified uuid bobDomain - - let locals = [mkInternalMember bob] - let remotes = [] - conv <- mkInternalConv locals remotes - let actual = cnvMembers <$> conversationViewMaybeQualified convDomain alice conv - - assertEqual "members:" Nothing actual - --------------------------------------------------------------- - -mkOtherMember :: Qualified UserId -> OtherMember -mkOtherMember u = OtherMember u Nothing roleNameWireAdmin - -mkRemoteMember :: Qualified UserId -> RemoteMember -mkRemoteMember u = RemoteMember (toRemote u) roleNameWireAdmin - -mkInternalConv :: [LocalMember] -> [RemoteMember] -> IO Data.Conversation -mkInternalConv locals remotes = do - -- for the conversationView unit tests, the creator plays no importance, so for simplicity this is set to a random value. - creator <- randomId - cnv <- randomId - pure $ - Data.Conversation - { Data.convId = cnv, - Data.convType = RegularConv, - Data.convCreator = creator, - Data.convName = Just "unit testing gossip", - Data.convAccess = [], - Data.convAccessRole = ActivatedAccessRole, - Data.convLocalMembers = locals, - Data.convRemoteMembers = remotes, - Data.convTeam = Nothing, - Data.convDeleted = Just False, - Data.convMessageTimer = Nothing, - Data.convReceiptMode = Nothing - } - -mkMember :: Qualified UserId -> Member -mkMember (Qualified userId _domain) = - Member - { memId = userId, - memService = Nothing, - memOtrMutedStatus = Nothing, - memOtrMutedRef = Nothing, - memOtrArchived = False, - memOtrArchivedRef = Nothing, - memHidden = False, - memHiddenRef = Nothing, - memConvRoleName = roleNameWireAdmin - } - -mkInternalMember :: Qualified UserId -> LocalMember -mkInternalMember (Qualified userId _domain) = - LocalMember - { lmId = userId, - lmService = Nothing, - lmStatus = defMemberStatus, - lmConvRoleName = roleNameWireAdmin - } + [] + +-- TODO: make these unit tests +-- [ testCase "Alice@A Conv@A" runMappingSimple, +-- testCase "Alice@A Conv@A requester=not a member@A" runMappingNotAMemberA, +-- testCase "Alice@A Conv@A requester=not a member@B" runMappingNotAMemberB, +-- testCase "Alice@A Conv@A Bob@B" runMappingRemoteUser, +-- testCase "Alice@A Conv@B Bob@B" runMappingRemoteConv, +-- testCase "Alice@A Conv@B Bob@B bobUUID=aliceUUID" runMappingSameUnqualifiedUUID +-- ] + +--runMappingSimple :: HasCallStack => IO () +--runMappingSimple = do +-- let convDomain = Domain "backendA.example.com" +-- let userDomain = Domain "backendA.example.com" +-- alice <- randomId +-- let requester = Qualified alice userDomain +-- let expectedSelf = Just $ mkMember requester +-- let expectedOthers = Just [] + +-- let locals = [mkInternalMember requester] +-- let remotes = [] +-- conv <- mkInternalConv locals remotes +-- let actual = cnvMembers <$> conversationViewMaybeQualified convDomain requester conv + +-- assertEqual "self:" expectedSelf (cmSelf <$> actual) +-- assertEqual "others:" expectedOthers (cmOthers <$> actual) + +--runMappingNotAMemberA :: HasCallStack => IO () +--runMappingNotAMemberA = do +-- let convDomain = Domain "backendA.example.com" +-- let aliceDomain = Domain "backendA.example.com" +-- alice <- flip Qualified aliceDomain <$> randomId +-- requester <- flip Qualified aliceDomain <$> randomId + +-- let locals = [mkInternalMember alice] +-- let remotes = [] +-- conv <- mkInternalConv locals remotes +-- let actual = cnvMembers <$> conversationViewMaybeQualified convDomain requester conv + +-- assertEqual "members:" Nothing actual + +--runMappingNotAMemberB :: HasCallStack => IO () +--runMappingNotAMemberB = do +-- let convDomain = Domain "backendA.example.com" +-- let aliceDomain = Domain "backendA.example.com" +-- let requesterDomain = Domain "backendB.example.com" +-- alice <- flip Qualified aliceDomain <$> randomId +-- requester <- flip Qualified requesterDomain <$> randomId + +-- let locals = [mkInternalMember alice] +-- let remotes = [] +-- conv <- mkInternalConv locals remotes +-- let actual = cnvMembers <$> conversationViewMaybeQualified convDomain requester conv + +-- assertEqual "members:" Nothing actual + +--runMappingRemoteUser :: HasCallStack => IO () +--runMappingRemoteUser = do +-- let aliceDomain = Domain "backendA.example.com" +-- let convDomain = Domain "backendA.example.com" +-- let bobDomain = Domain "backendB.example.com" +-- alice <- flip Qualified aliceDomain <$> randomId +-- bob <- flip Qualified bobDomain <$> randomId +-- let expectedSelf = Just $ mkMember alice +-- let expectedOthers = Just [mkOtherMember bob] + +-- let locals = [mkInternalMember alice] +-- let remotes = [mkRemoteMember bob] +-- conv <- mkInternalConv locals remotes +-- let actual = cnvMembers <$> conversationViewMaybeQualified convDomain alice conv + +-- assertEqual "self:" expectedSelf (cmSelf <$> actual) +-- assertEqual "others:" expectedOthers (cmOthers <$> actual) + +--runMappingRemoteConv :: HasCallStack => IO () +--runMappingRemoteConv = do +-- let aliceDomain = Domain "backendA.example.com" +-- let convDomain = Domain "backendB.example.com" +-- let bobDomain = Domain "backendB.example.com" +-- alice <- flip Qualified aliceDomain <$> randomId +-- bob <- flip Qualified bobDomain <$> randomId +-- let expectedSelf = Just $ mkMember alice +-- let expectedOthers = Just [mkOtherMember bob] + +-- let locals = [mkInternalMember bob] +-- let remotes = [mkRemoteMember alice] +-- conv <- mkInternalConv locals remotes +-- let actual = cnvMembers <$> conversationViewMaybeQualified convDomain alice conv + +-- assertEqual "self:" expectedSelf (cmSelf <$> actual) +-- assertEqual "others:" expectedOthers (cmOthers <$> actual) + +---- Here we expect the conversationView to return nothing, because Alice (the +---- requester) is not part of the conversation (Her unqualified UUID is part of +---- the conversation, but the function should catch this possibly malicious +---- edge case) +--runMappingSameUnqualifiedUUID :: HasCallStack => IO () +--runMappingSameUnqualifiedUUID = do +-- let aliceDomain = Domain "backendA.example.com" +-- let convDomain = Domain "backendB.example.com" +-- let bobDomain = Domain "backendB.example.com" +-- uuid <- randomId +-- let alice = Qualified uuid aliceDomain +-- let bob = Qualified uuid bobDomain + +-- let locals = [mkInternalMember bob] +-- let remotes = [] +-- conv <- mkInternalConv locals remotes +-- let actual = cnvMembers <$> conversationViewMaybeQualified convDomain alice conv + +-- assertEqual "members:" Nothing actual + +---------------------------------------------------------------- + +--mkOtherMember :: Qualified UserId -> OtherMember +--mkOtherMember u = OtherMember u Nothing roleNameWireAdmin + +--mkRemoteMember :: Qualified UserId -> RemoteMember +--mkRemoteMember u = RemoteMember (toRemote u) roleNameWireAdmin + +--mkInternalConv :: [LocalMember] -> [RemoteMember] -> IO Data.Conversation +--mkInternalConv locals remotes = do +-- -- for the conversationView unit tests, the creator plays no importance, so for simplicity this is set to a random value. +-- creator <- randomId +-- cnv <- randomId +-- pure $ +-- Data.Conversation +-- { Data.convId = cnv, +-- Data.convType = RegularConv, +-- Data.convCreator = creator, +-- Data.convName = Just "unit testing gossip", +-- Data.convAccess = [], +-- Data.convAccessRole = ActivatedAccessRole, +-- Data.convLocalMembers = locals, +-- Data.convRemoteMembers = remotes, +-- Data.convTeam = Nothing, +-- Data.convDeleted = Just False, +-- Data.convMessageTimer = Nothing, +-- Data.convReceiptMode = Nothing +-- } + +--mkMember :: Qualified UserId -> Member +--mkMember (Qualified userId _domain) = +-- Member +-- { memId = userId, +-- memService = Nothing, +-- memOtrMutedStatus = Nothing, +-- memOtrMutedRef = Nothing, +-- memOtrArchived = False, +-- memOtrArchivedRef = Nothing, +-- memHidden = False, +-- memHiddenRef = Nothing, +-- memConvRoleName = roleNameWireAdmin +-- } + +--mkInternalMember :: Qualified UserId -> LocalMember +--mkInternalMember (Qualified userId _domain) = +-- LocalMember +-- { lmId = userId, +-- lmService = Nothing, +-- lmStatus = defMemberStatus, +-- lmConvRoleName = roleNameWireAdmin +-- } From 9900989beb7dd627483807fff944eb7ffb87216e Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Mon, 13 Sep 2021 08:08:18 +0200 Subject: [PATCH 08/19] Fix federated conversation fetching test Since one2one conversations with remote users are not implemented yet, the test has been simplified, and it now only creates a group conversation. --- .../galley/test/integration/API/Federation.hs | 59 +++++++++++-------- 1 file changed, 35 insertions(+), 24 deletions(-) diff --git a/services/galley/test/integration/API/Federation.hs b/services/galley/test/integration/API/Federation.hs index 59c352b074..700ac15884 100644 --- a/services/galley/test/integration/API/Federation.hs +++ b/services/galley/test/integration/API/Federation.hs @@ -74,45 +74,56 @@ tests s = getConversationsAllFound :: TestM () getConversationsAllFound = do - -- FUTUREWORK: make alice / bob remote users [alice, bob] <- randomUsers 2 - connectUsers alice (singleton bob) - -- create & get one2one conv - cnv1 <- responseJsonUnsafeWithMsg "conversation" <$> postO2OConv alice bob (Just "gossip1") - getConvs alice (Just $ Left [qUnqualified . cnvQualifiedId $ cnv1]) Nothing !!! do - const 200 === statusCode - const (Just [cnvQualifiedId cnv1]) === fmap (map cnvQualifiedId . convList) . responseJsonUnsafe + let aliceQ = Qualified alice (Domain "far-away.example.com") + -- create & get group conv - carl <- randomUser - connectUsers alice (singleton carl) - cnv2 <- responseJsonUnsafeWithMsg "conversation" <$> postConv alice [bob, carl] (Just "gossip2") [] Nothing Nothing - getConvs alice (Just $ Left [qUnqualified . cnvQualifiedId $ cnv2]) Nothing !!! do + localDomain <- viewFederationDomain + carlQ <- Qualified <$> randomUser <*> pure localDomain + connectUsers bob (singleton (qUnqualified carlQ)) + + putStrLn $ "alice: " <> show (qUnqualified aliceQ) + putStrLn $ "bob: " <> show bob + putStrLn $ "carl: " <> show (qUnqualified carlQ) + + cnv2 <- + responseJsonError + =<< postConvWithRemoteUser (qDomain aliceQ) (mkProfile aliceQ (Name "alice")) bob [aliceQ, carlQ] + + getConvs bob (Just $ Left [qUnqualified (cnvQualifiedId cnv2)]) Nothing !!! do const 200 === statusCode - const (Just [cnvQualifiedId cnv2]) === fmap (map cnvQualifiedId . convList) . responseJsonUnsafe - -- get both + const (Just (Just [cnvQualifiedId cnv2])) + === fmap (fmap (map cnvQualifiedId . convList)) . responseJsonMaybe + + -- FUTUREWORK: also create a one2one conversation + + -- get conversations fedGalleyClient <- view tsFedGalleyClient - localDomain <- viewFederationDomain GetConversationsResponse cs <- FedGalley.getConversations fedGalleyClient - localDomain - (GetConversationsRequest alice $ qUnqualified . cnvQualifiedId <$> [cnv1, cnv2]) - let c1 = find ((== cnvQualifiedId cnv1) . cnvmQualifiedId . rcnvMetadata) cs + (qDomain aliceQ) + (GetConversationsRequest alice $ qUnqualified . cnvQualifiedId <$> [cnv2]) + let c2 = find ((== cnvQualifiedId cnv2) . cnvmQualifiedId . rcnvMetadata) cs - liftIO . forM_ [(cnv1, c1), (cnv2, c2)] $ \(expected, actual) -> do + + liftIO $ do assertEqual "name mismatch" - (Just $ cnvName expected) - (cnvmName . rcnvMetadata <$> actual) + (Just $ cnvName cnv2) + (cnvmName . rcnvMetadata <$> c2) assertEqual "self member role mismatch" - (Just . memConvRoleName . cmSelf $ cnvMembers expected) - (rcmSelfRole . rcnvMembers <$> actual) + (Just . memConvRoleName . cmSelf $ cnvMembers cnv2) + (rcmSelfRole . rcnvMembers <$> c2) + putStrLn $ "actual members " <> show (fmap (rcmOthers . rcnvMembers) c2) + putStrLn $ "expected members " <> show (cmOthers (cnvMembers cnv2)) assertEqual "other members mismatch" - (Just []) - ((\c -> rcmOthers (rcnvMembers c) \\ cmOthers (cnvMembers expected)) <$> actual) + (Just (sort [bob, qUnqualified carlQ])) + -- (fmap (sort . (map (qUnqualified . omQualifiedId) . rcmOthers . rcnvMembers) cnv2)) + (fmap (sort . map (qUnqualified . omQualifiedId) . rcmOthers . rcnvMembers) c2) getConversationsNotPartOf :: TestM () getConversationsNotPartOf = do From cf6ade81168cbd5f27a105e383b0b8cbb5f80cfa Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Mon, 13 Sep 2021 09:04:43 +0200 Subject: [PATCH 09/19] Turn Mapping tests into property tests --- services/galley/galley.cabal | 6 +- services/galley/package.yaml | 2 +- services/galley/src/Galley/API/Mapping.hs | 1 + .../galley/test/unit/Test/Galley/Mapping.hs | 307 ++++++++---------- 4 files changed, 139 insertions(+), 177 deletions(-) diff --git a/services/galley/galley.cabal b/services/galley/galley.cabal index 3584ea4e7b..5122ed04e0 100644 --- a/services/galley/galley.cabal +++ b/services/galley/galley.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: 6e5e3f9e94d96cbfe4ae8b0a52783bc3e354f3c58a29208cfd6e120a25d871d6 +-- hash: 0341ec52f506f40a39b7329c4eeccdccf25bcffc81318f535602bfc17e655f58 name: galley version: 0.83.0 @@ -176,6 +176,7 @@ executable galley , raw-strings-qq >=1.0 , safe >=0.3 , ssl-util + , tagged , types-common , wire-api , wire-api-federation @@ -314,6 +315,7 @@ executable galley-migrate-data , raw-strings-qq >=1.0 , safe >=0.3 , ssl-util + , tagged , text , time , tinylog @@ -377,6 +379,7 @@ executable galley-schema , raw-strings-qq >=1.0 , safe >=0.3 , ssl-util + , tagged , text , tinylog , wire-api @@ -414,6 +417,7 @@ test-suite galley-types-tests , safe >=0.3 , servant-swagger , ssl-util + , tagged , tasty , tasty-hspec , tasty-hunit diff --git a/services/galley/package.yaml b/services/galley/package.yaml index 795fe273d0..0ba2b59e4f 100644 --- a/services/galley/package.yaml +++ b/services/galley/package.yaml @@ -18,6 +18,7 @@ dependencies: - raw-strings-qq >=1.0 - wire-api - wire-api-federation +- tagged library: source-dirs: src @@ -76,7 +77,6 @@ library: - string-conversions - swagger >=0.1 - swagger2 - - tagged - text >=0.11 - time >=1.4 - tinylog >=0.10 diff --git a/services/galley/src/Galley/API/Mapping.hs b/services/galley/src/Galley/API/Mapping.hs index f0c8f6329a..e99921917e 100644 --- a/services/galley/src/Galley/API/Mapping.hs +++ b/services/galley/src/Galley/API/Mapping.hs @@ -19,6 +19,7 @@ module Galley.API.Mapping ( conversationView, + conversationViewMaybe, remoteConversationView, conversationToRemote, localMemberToSelf, diff --git a/services/galley/test/unit/Test/Galley/Mapping.hs b/services/galley/test/unit/Test/Galley/Mapping.hs index 0eed89817e..6f5b741899 100644 --- a/services/galley/test/unit/Test/Galley/Mapping.hs +++ b/services/galley/test/unit/Test/Galley/Mapping.hs @@ -20,185 +20,142 @@ module Test.Galley.Mapping where --- import Data.Domain --- import Data.Id --- import Data.Qualified --- import Galley.API () --- import Galley.API.Mapping --- import qualified Galley.Data as Data --- import Galley.Types.Conversations.Members --- import Imports +import Data.Domain +import Data.Id +import Data.Qualified +import Data.Tagged +import Galley.API.Mapping +import qualified Galley.Data as Data +import Galley.Types.Conversations.Members +import Imports import Test.Tasty - +import Test.Tasty.QuickCheck -- import Test.Tasty.HUnit --- import Wire.API.Conversation --- import Wire.API.Conversation.Role (roleNameWireAdmin) +import Wire.API.Conversation +import Wire.API.Conversation.Role +import Wire.API.Federation.API.Galley + ( RemoteConvMembers (..), + RemoteConversation (..), + ) tests :: TestTree tests = testGroup "ConversationMapping" - [] - --- TODO: make these unit tests --- [ testCase "Alice@A Conv@A" runMappingSimple, --- testCase "Alice@A Conv@A requester=not a member@A" runMappingNotAMemberA, --- testCase "Alice@A Conv@A requester=not a member@B" runMappingNotAMemberB, --- testCase "Alice@A Conv@A Bob@B" runMappingRemoteUser, --- testCase "Alice@A Conv@B Bob@B" runMappingRemoteConv, --- testCase "Alice@A Conv@B Bob@B bobUUID=aliceUUID" runMappingSameUnqualifiedUUID --- ] - ---runMappingSimple :: HasCallStack => IO () ---runMappingSimple = do --- let convDomain = Domain "backendA.example.com" --- let userDomain = Domain "backendA.example.com" --- alice <- randomId --- let requester = Qualified alice userDomain --- let expectedSelf = Just $ mkMember requester --- let expectedOthers = Just [] - --- let locals = [mkInternalMember requester] --- let remotes = [] --- conv <- mkInternalConv locals remotes --- let actual = cnvMembers <$> conversationViewMaybeQualified convDomain requester conv - --- assertEqual "self:" expectedSelf (cmSelf <$> actual) --- assertEqual "others:" expectedOthers (cmOthers <$> actual) - ---runMappingNotAMemberA :: HasCallStack => IO () ---runMappingNotAMemberA = do --- let convDomain = Domain "backendA.example.com" --- let aliceDomain = Domain "backendA.example.com" --- alice <- flip Qualified aliceDomain <$> randomId --- requester <- flip Qualified aliceDomain <$> randomId - --- let locals = [mkInternalMember alice] --- let remotes = [] --- conv <- mkInternalConv locals remotes --- let actual = cnvMembers <$> conversationViewMaybeQualified convDomain requester conv - --- assertEqual "members:" Nothing actual - ---runMappingNotAMemberB :: HasCallStack => IO () ---runMappingNotAMemberB = do --- let convDomain = Domain "backendA.example.com" --- let aliceDomain = Domain "backendA.example.com" --- let requesterDomain = Domain "backendB.example.com" --- alice <- flip Qualified aliceDomain <$> randomId --- requester <- flip Qualified requesterDomain <$> randomId - --- let locals = [mkInternalMember alice] --- let remotes = [] --- conv <- mkInternalConv locals remotes --- let actual = cnvMembers <$> conversationViewMaybeQualified convDomain requester conv - --- assertEqual "members:" Nothing actual - ---runMappingRemoteUser :: HasCallStack => IO () ---runMappingRemoteUser = do --- let aliceDomain = Domain "backendA.example.com" --- let convDomain = Domain "backendA.example.com" --- let bobDomain = Domain "backendB.example.com" --- alice <- flip Qualified aliceDomain <$> randomId --- bob <- flip Qualified bobDomain <$> randomId --- let expectedSelf = Just $ mkMember alice --- let expectedOthers = Just [mkOtherMember bob] - --- let locals = [mkInternalMember alice] --- let remotes = [mkRemoteMember bob] --- conv <- mkInternalConv locals remotes --- let actual = cnvMembers <$> conversationViewMaybeQualified convDomain alice conv - --- assertEqual "self:" expectedSelf (cmSelf <$> actual) --- assertEqual "others:" expectedOthers (cmOthers <$> actual) - ---runMappingRemoteConv :: HasCallStack => IO () ---runMappingRemoteConv = do --- let aliceDomain = Domain "backendA.example.com" --- let convDomain = Domain "backendB.example.com" --- let bobDomain = Domain "backendB.example.com" --- alice <- flip Qualified aliceDomain <$> randomId --- bob <- flip Qualified bobDomain <$> randomId --- let expectedSelf = Just $ mkMember alice --- let expectedOthers = Just [mkOtherMember bob] - --- let locals = [mkInternalMember bob] --- let remotes = [mkRemoteMember alice] --- conv <- mkInternalConv locals remotes --- let actual = cnvMembers <$> conversationViewMaybeQualified convDomain alice conv - --- assertEqual "self:" expectedSelf (cmSelf <$> actual) --- assertEqual "others:" expectedOthers (cmOthers <$> actual) - ----- Here we expect the conversationView to return nothing, because Alice (the ----- requester) is not part of the conversation (Her unqualified UUID is part of ----- the conversation, but the function should catch this possibly malicious ----- edge case) ---runMappingSameUnqualifiedUUID :: HasCallStack => IO () ---runMappingSameUnqualifiedUUID = do --- let aliceDomain = Domain "backendA.example.com" --- let convDomain = Domain "backendB.example.com" --- let bobDomain = Domain "backendB.example.com" --- uuid <- randomId --- let alice = Qualified uuid aliceDomain --- let bob = Qualified uuid bobDomain - --- let locals = [mkInternalMember bob] --- let remotes = [] --- conv <- mkInternalConv locals remotes --- let actual = cnvMembers <$> conversationViewMaybeQualified convDomain alice conv - --- assertEqual "members:" Nothing actual - ----------------------------------------------------------------- - ---mkOtherMember :: Qualified UserId -> OtherMember ---mkOtherMember u = OtherMember u Nothing roleNameWireAdmin - ---mkRemoteMember :: Qualified UserId -> RemoteMember ---mkRemoteMember u = RemoteMember (toRemote u) roleNameWireAdmin - ---mkInternalConv :: [LocalMember] -> [RemoteMember] -> IO Data.Conversation ---mkInternalConv locals remotes = do --- -- for the conversationView unit tests, the creator plays no importance, so for simplicity this is set to a random value. --- creator <- randomId --- cnv <- randomId --- pure $ --- Data.Conversation --- { Data.convId = cnv, --- Data.convType = RegularConv, --- Data.convCreator = creator, --- Data.convName = Just "unit testing gossip", --- Data.convAccess = [], --- Data.convAccessRole = ActivatedAccessRole, --- Data.convLocalMembers = locals, --- Data.convRemoteMembers = remotes, --- Data.convTeam = Nothing, --- Data.convDeleted = Just False, --- Data.convMessageTimer = Nothing, --- Data.convReceiptMode = Nothing --- } - ---mkMember :: Qualified UserId -> Member ---mkMember (Qualified userId _domain) = --- Member --- { memId = userId, --- memService = Nothing, --- memOtrMutedStatus = Nothing, --- memOtrMutedRef = Nothing, --- memOtrArchived = False, --- memOtrArchivedRef = Nothing, --- memHidden = False, --- memHiddenRef = Nothing, --- memConvRoleName = roleNameWireAdmin --- } - ---mkInternalMember :: Qualified UserId -> LocalMember ---mkInternalMember (Qualified userId _domain) = --- LocalMember --- { lmId = userId, --- lmService = Nothing, --- lmStatus = defMemberStatus, --- lmConvRoleName = roleNameWireAdmin --- } + [ testProperty "conversation view for a valid user is non-empty" $ + \(ConvWithLocalUser c uid) dom -> isJust (conversationViewMaybe dom uid c), + testProperty "self user in conversation view is correct" $ + \(ConvWithLocalUser c uid) dom -> + fmap (memId . cmSelf . cnvMembers) (conversationViewMaybe dom uid c) + == Just uid, + testProperty "conversation view metadata is correct" $ + \(ConvWithLocalUser c uid) dom -> + fmap cnvMetadata (conversationViewMaybe dom uid c) + == Just (Data.convMetadata dom c), + testProperty "other members in conversation view do not contain self" $ + \(ConvWithLocalUser c uid) dom -> case conversationViewMaybe dom uid c of + Nothing -> False + Just cnv -> + not + ( Qualified uid dom + `elem` (map omQualifiedId (cmOthers (cnvMembers cnv))) + ), + testProperty "conversation view contains all users" $ + \(ConvWithLocalUser c uid) dom -> + fmap (sort . cnvUids dom) (conversationViewMaybe dom uid c) + == Just (sort (convUids dom c)), + testProperty "conversation view for an invalid user is empty" $ + \(RandomConversation c) dom uid -> + not (elem uid (map lmId (Data.convLocalMembers c))) + ==> isNothing (conversationViewMaybe dom uid c), + testProperty "remote conversation view for a valid user is non-empty" $ + \(ConvWithRemoteUser c ruid) dom -> + qDomain (unTagged ruid) /= dom + ==> isJust (conversationToRemote dom ruid c), + testProperty "self user role in remote conversation view is correct" $ + \(ConvWithRemoteUser c ruid) dom -> + qDomain (unTagged ruid) /= dom + ==> fmap (rcmSelfRole . rcnvMembers) (conversationToRemote dom ruid c) + == Just roleNameWireMember, + testProperty "remote conversation view metadata is correct" $ + \(ConvWithRemoteUser c ruid) dom -> + qDomain (unTagged ruid) /= dom + ==> fmap (rcnvMetadata) (conversationToRemote dom ruid c) + == Just (Data.convMetadata dom c), + testProperty "remote conversation view does not contain self" $ + \(ConvWithRemoteUser c ruid) dom -> case conversationToRemote dom ruid c of + Nothing -> False + Just rcnv -> + not + ( unTagged ruid + `elem` (map omQualifiedId (rcmOthers (rcnvMembers rcnv))) + ) + ] + +cnvUids :: Domain -> Conversation -> [Qualified UserId] +cnvUids dom c = + let mems = cnvMembers c + in Qualified (memId (cmSelf mems)) dom : + map omQualifiedId (cmOthers mems) + +convUids :: Domain -> Data.Conversation -> [Qualified UserId] +convUids dom c = + map ((`Qualified` dom) . lmId) (Data.convLocalMembers c) + <> map (unTagged . rmId) (Data.convRemoteMembers c) + +genLocalMember :: Gen LocalMember +genLocalMember = + LocalMember + <$> arbitrary + <*> pure defMemberStatus + <*> pure Nothing + <*> pure roleNameWireAdmin + +genRemoteMember :: Gen RemoteMember +genRemoteMember = RemoteMember <$> arbitrary <*> pure roleNameWireMember + +genConversation :: [LocalMember] -> [RemoteMember] -> Gen Data.Conversation +genConversation locals remotes = + Data.Conversation + <$> arbitrary + <*> pure RegularConv + <*> arbitrary + <*> arbitrary + <*> pure [] + <*> pure ActivatedAccessRole + <*> pure locals + <*> pure remotes + <*> pure Nothing + <*> pure (Just False) + <*> pure Nothing + <*> pure Nothing + +newtype RandomConversation = RandomConversation Data.Conversation + deriving (Show) + +instance Arbitrary RandomConversation where + arbitrary = + RandomConversation <$> do + locals <- listOf genLocalMember + remotes <- listOf genRemoteMember + genConversation locals remotes + +data ConvWithLocalUser = ConvWithLocalUser Data.Conversation UserId + deriving (Show) + +instance Arbitrary ConvWithLocalUser where + arbitrary = do + RandomConversation conv <- arbitrary + member <- genLocalMember + let conv' = conv {Data.convLocalMembers = member : Data.convLocalMembers conv} + pure $ ConvWithLocalUser conv' (lmId member) + +data ConvWithRemoteUser = ConvWithRemoteUser Data.Conversation (Remote UserId) + deriving (Show) + +instance Arbitrary ConvWithRemoteUser where + arbitrary = do + RandomConversation conv <- arbitrary + member <- genRemoteMember + let conv' = conv {Data.convRemoteMembers = member : Data.convRemoteMembers conv} + pure $ ConvWithRemoteUser conv' (rmId member) From 3d39cee5fcd3a49c2d020e9cb52aa5c03df2edc4 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Mon, 13 Sep 2021 10:02:32 +0200 Subject: [PATCH 10/19] Get member status from db for remote convs --- services/galley/src/Galley/API/Query.hs | 144 +++++++++++++-------- services/galley/src/Galley/Data.hs | 70 ++++++---- services/galley/src/Galley/Data/Queries.hs | 15 +-- 3 files changed, 147 insertions(+), 82 deletions(-) diff --git a/services/galley/src/Galley/API/Query.hs b/services/galley/src/Galley/API/Query.hs index 2bcf4444af..be37e81e6d 100644 --- a/services/galley/src/Galley/API/Query.hs +++ b/services/galley/src/Galley/API/Query.hs @@ -36,12 +36,13 @@ where import qualified Cassandra as C import Control.Monad.Catch (throwM) -import Control.Monad.Except (ExceptT, runExceptT) +import Control.Monad.Trans.Except import qualified Data.ByteString.Lazy as LBS import Data.Code import Data.CommaSeparatedList import Data.Domain (Domain) import Data.Id as Id +import qualified Data.Map as Map import Data.Proxy import Data.Qualified (Qualified (..), Remote, partitionRemote, partitionRemoteOrLocalIds', toRemote) import Data.Range @@ -61,13 +62,14 @@ import Network.HTTP.Types import Network.Wai import Network.Wai.Predicate hiding (result, setStatus) import Network.Wai.Utilities +import qualified Network.Wai.Utilities.Error as Wai import qualified System.Logger.Class as Logger import UnliftIO (pooledForConcurrentlyN) import Wire.API.Conversation (ConversationCoverView (..)) import qualified Wire.API.Conversation as Public import qualified Wire.API.Conversation.Role as Public import Wire.API.ErrorDescription (convNotFound) -import Wire.API.Federation.API.Galley (RemoteConversation, gcresConvs) +import Wire.API.Federation.API.Galley (gcresConvs) import qualified Wire.API.Federation.API.Galley as FederatedGalley import Wire.API.Federation.Client (FederationError, executeFederated) import Wire.API.Federation.Error @@ -105,58 +107,97 @@ getConversation zusr cnv = do where getRemoteConversation :: Remote ConvId -> Galley Public.Conversation getRemoteConversation remoteConvId = do - foundConvs <- Data.remoteConversationIdOf zusr [remoteConvId] - unless (remoteConvId `elem` foundConvs) $ - throwErrorDescription convNotFound conversations <- getRemoteConversations zusr [remoteConvId] case conversations of [] -> throwErrorDescription convNotFound [conv] -> pure conv _convs -> throwM (federationUnexpectedBody "expected one conversation, got multiple") -mapRemoteConversations :: UserId -> [(MemberStatus, RemoteConversation)] -> [Public.Conversation] -mapRemoteConversations uid = catMaybes . map (uncurry (Mapping.remoteConversationView uid)) - getRemoteConversations :: UserId -> [Remote ConvId] -> Galley [Public.Conversation] -getRemoteConversations zusr remoteConvs = do - localDomain <- viewFederationDomain - let convsByDomain = partitionRemote remoteConvs - rconvs <- pooledForConcurrentlyN 8 convsByDomain $ \(remoteDomain, convIds) -> do - let req = FederatedGalley.GetConversationsRequest zusr convIds - rpc = FederatedGalley.getConversations FederatedGalley.clientRoutes localDomain req - gcresConvs <$> runFederatedGalley remoteDomain rpc - -- TODO: read member status from the database - pure - . mapRemoteConversations zusr - . (map (defMemberStatus,)) - . concat - $ rconvs - -getRemoteConversationsWithFailures :: UserId -> [Remote ConvId] -> Galley ([Qualified ConvId], [Public.Conversation]) -getRemoteConversationsWithFailures zusr remoteConvs = do +getRemoteConversations zusr remoteConvs = + getRemoteConversationsWithFailures zusr remoteConvs >>= \case + -- throw first error + (failed : _, _) -> throwM (fgcError failed) + ([], result) -> pure result + +data FailedGetConversationReason + = FailedGetConversationLocally + | FailedGetConversationRemotely FederationError + +fgcrError :: FailedGetConversationReason -> Wai.Error +fgcrError FailedGetConversationLocally = errorDescriptionToWai convNotFound +fgcrError (FailedGetConversationRemotely e) = federationErrorToWai e + +data FailedGetConversation + = FailedGetConversation + [Qualified ConvId] + FailedGetConversationReason + +fgcError :: FailedGetConversation -> Wai.Error +fgcError (FailedGetConversation _ r) = fgcrError r + +failedGetConversationRemotely :: + [Qualified ConvId] -> FederationError -> FailedGetConversation +failedGetConversationRemotely qconvs = + FailedGetConversation qconvs . FailedGetConversationRemotely + +failedGetConversationLocally :: + [Qualified ConvId] -> FailedGetConversation +failedGetConversationLocally qconvs = + FailedGetConversation qconvs FailedGetConversationLocally + +partitionGetConversationFailures :: + [FailedGetConversation] -> ([Qualified ConvId], [Qualified ConvId]) +partitionGetConversationFailures = bimap concat concat . partitionEithers . map split + where + split (FailedGetConversation convs FailedGetConversationLocally) = Left convs + split (FailedGetConversation convs (FailedGetConversationRemotely _)) = Right convs + +getRemoteConversationsWithFailures :: + UserId -> + [Remote ConvId] -> + Galley ([FailedGetConversation], [Public.Conversation]) +getRemoteConversationsWithFailures zusr convs = do localDomain <- viewFederationDomain - let convsByDomain = partitionRemote remoteConvs - rconvs <- pooledForConcurrentlyN 8 convsByDomain $ \(remoteDomain, convIds) -> handleFailures remoteDomain convIds $ do - let req = FederatedGalley.GetConversationsRequest zusr convIds - rpc = FederatedGalley.getConversations FederatedGalley.clientRoutes localDomain req - gcresConvs <$> executeFederated remoteDomain rpc - pure - -- TODO: read member status from the database - . fmap (mapRemoteConversations zusr . map (defMemberStatus,)) - . bimap concat concat - . partitionEithers - $ (rconvs :: [Either [Qualified ConvId] [RemoteConversation]]) + + -- get self member statuses from the database + statusMap <- Data.remoteConversationStatus zusr convs + let remoteView rconv = + Mapping.remoteConversationView + zusr + ( Map.findWithDefault + defMemberStatus + (toRemote (cnvmQualifiedId (FederatedGalley.rcnvMetadata rconv))) + statusMap + ) + rconv + (locallyFound, locallyNotFound) = partition (flip Map.member statusMap) convs + localFailures + | null locallyNotFound = [] + | otherwise = [failedGetConversationLocally (map unTagged locallyNotFound)] + + -- request conversations from remote backends + fmap (bimap (localFailures <>) concat . partitionEithers) + . pooledForConcurrentlyN 8 (partitionRemote locallyFound) + $ \(domain, someConvs) -> do + let req = FederatedGalley.GetConversationsRequest zusr someConvs + rpc = FederatedGalley.getConversations FederatedGalley.clientRoutes localDomain req + handleFailures (map (flip Qualified domain) someConvs) $ do + rconvs <- gcresConvs <$> executeFederated domain rpc + pure $ catMaybes (map remoteView rconvs) where - handleFailures :: Domain -> [ConvId] -> ExceptT FederationError Galley a -> Galley (Either [Qualified ConvId] a) - handleFailures domain convIds action = do - res <- runExceptT action - case res of - Right a -> pure $ Right a - Left e -> do - Logger.warn $ - Logger.msg ("Error occurred while fetching remote conversations" :: ByteString) - . Logger.field "error" (show e) - pure . Left $ map (`Qualified` domain) convIds + handleFailures :: + [Qualified ConvId] -> + ExceptT FederationError Galley a -> + Galley (Either FailedGetConversation a) + handleFailures qconvs action = runExceptT + . withExceptT (failedGetConversationRemotely qconvs) + . catchE action + $ \e -> do + lift . Logger.warn $ + Logger.msg ("Error occurred while fetching remote conversations" :: ByteString) + . Logger.field "error" (show e) + throwE e getConversationRoles :: UserId -> ConvId -> Galley Public.ConversationRolesList getConversationRoles zusr cnv = do @@ -302,7 +343,6 @@ listConversationsV2 user (Public.ListConversationsV2 ids) = do let (remoteIds, localIds) = partitionRemoteOrLocalIds' localDomain (fromRange ids) (foundLocalIds, notFoundLocalIds) <- foundsAndNotFounds (Data.localConversationIdsOf user) localIds - (foundRemoteIds, locallyNotFoundRemoteIds) <- foundsAndNotFounds (Data.remoteConversationIdOf user) remoteIds localInternalConversations <- Data.conversations foundLocalIds @@ -310,9 +350,11 @@ listConversationsV2 user (Public.ListConversationsV2 ids) = do >>= filterM (pure . isMember user . Data.convLocalMembers) localConversations <- mapM (Mapping.conversationView user) localInternalConversations - (remoteFailures, remoteConversations) <- getRemoteConversationsWithFailures user foundRemoteIds - let fetchedOrFailedRemoteIds = Set.fromList $ map Public.cnvQualifiedId remoteConversations <> remoteFailures - remoteNotFoundRemoteIds = filter (`Set.notMember` fetchedOrFailedRemoteIds) $ map unTagged foundRemoteIds + (remoteFailures, remoteConversations) <- getRemoteConversationsWithFailures user remoteIds + let (failedConvsLocally, failedConvsRemotely) = partitionGetConversationFailures remoteFailures + failedConvs = failedConvsLocally <> failedConvsRemotely + fetchedOrFailedRemoteIds = Set.fromList $ map Public.cnvQualifiedId remoteConversations <> failedConvs + remoteNotFoundRemoteIds = filter (`Set.notMember` fetchedOrFailedRemoteIds) $ map unTagged remoteIds unless (null remoteNotFoundRemoteIds) $ -- FUTUREWORK: This implies that the backends are out of sync. Maybe the -- current user should be considered removed from this conversation at this @@ -326,10 +368,10 @@ listConversationsV2 user (Public.ListConversationsV2 ids) = do Public.ConversationsResponse { crFound = allConvs, crNotFound = - map unTagged locallyNotFoundRemoteIds + failedConvsLocally <> remoteNotFoundRemoteIds <> map (`Qualified` localDomain) notFoundLocalIds, - crFailed = remoteFailures + crFailed = failedConvsRemotely } where removeDeleted :: Data.Conversation -> Galley Bool diff --git a/services/galley/src/Galley/Data.hs b/services/galley/src/Galley/Data.hs index c560d15952..eb71566405 100644 --- a/services/galley/src/Galley/Data.hs +++ b/services/galley/src/Galley/Data.hs @@ -60,7 +60,7 @@ module Galley.Data conversation, conversationIdsFrom, localConversationIdsOf, - remoteConversationIdOf, + remoteConversationStatus, localConversationIdsPageFrom, conversationIdRowsForPagination, conversations, @@ -593,16 +593,27 @@ localConversationIdsOf :: forall m. (MonadClient m, MonadUnliftIO m) => UserId - localConversationIdsOf usr cids = do runIdentity <$$> retry x1 (query Cql.selectUserConvsIn (params Quorum (usr, cids))) --- | Takes a list of remote conversation ids and splits them by those found for --- the given user -remoteConversationIdOf :: forall m. (MonadClient m, MonadLogger m, MonadUnliftIO m) => UserId -> [Remote ConvId] -> m [Remote ConvId] -remoteConversationIdOf usr cnvs = do - concat <$$> pooledMapConcurrentlyN 8 findRemoteConvs . Map.assocs . partitionQualified . map unTagged $ cnvs +-- | Takes a list of remote conversation ids and fetches member status flags +-- for the given user +remoteConversationStatus :: + (MonadClient m, MonadUnliftIO m) => + UserId -> + [Remote ConvId] -> + m (Map (Remote ConvId) MemberStatus) +remoteConversationStatus uid = + fmap mconcat + . pooledMapConcurrentlyN 8 (uncurry (remoteConversationStatusOnDomain uid)) + . partitionRemote + +remoteConversationStatusOnDomain :: MonadClient m => UserId -> Domain -> [ConvId] -> m (Map (Remote ConvId) MemberStatus) +remoteConversationStatusOnDomain uid domain convs = + Map.fromList . map toPair + <$> query Cql.selectRemoteConvMembers (params Quorum (uid, domain, convs)) where - findRemoteConvs :: (Domain, [ConvId]) -> m [Remote ConvId] - findRemoteConvs (domain, remoteConvIds) = do - foundCnvs <- runIdentity <$$> query Cql.selectRemoteConvMembershipIn (params Quorum (usr, domain, remoteConvIds)) - pure $ toRemote . (`Qualified` domain) <$> foundCnvs + toPair (conv, omus, omur, oar, oarr, hid, hidr) = + ( toRemote (Qualified conv domain), + toMemberStatus (omus, omur, oar, oarr, hid, hidr) + ) conversationsRemote :: (MonadClient m) => UserId -> m [Remote ConvId] conversationsRemote usr = do @@ -977,9 +988,10 @@ filterRemoteConvMembers users (Qualified conv dom) = <$> pooledMapConcurrentlyN 8 filterMember users where filterMember :: MonadClient m => UserId -> m [UserId] - filterMember user = do - let q = query Cql.selectRemoteConvMembership (params Quorum (user, dom, conv)) - map runIdentity <$> retry x1 q + filterMember user = + fmap (map (const user)) + . retry x1 + $ query Cql.selectRemoteConvMembers (params Quorum (user, dom, [conv])) removeLocalMembersFromLocalConv :: MonadClient m => @@ -1051,6 +1063,28 @@ newMemberWithRole u r = lmConvRoleName = r } +toMemberStatus :: + ( -- otr muted + Maybe MutedStatus, + Maybe Text, + -- otr archived + Maybe Bool, + Maybe Text, + -- hidden + Maybe Bool, + Maybe Text + ) -> + MemberStatus +toMemberStatus (omus, omur, oar, oarr, hid, hidr) = + MemberStatus + { msOtrMutedStatus = omus, + msOtrMutedRef = omur, + msOtrArchived = fromMaybe False oar, + msOtrArchivedRef = oarr, + msHidden = fromMaybe False hid, + msHiddenRef = hidr + } + toMember :: ( UserId, Maybe ServiceId, @@ -1074,15 +1108,7 @@ toMember (usr, srv, prv, Just 0, omus, omur, oar, oarr, hid, hidr, crn) = LocalMember { lmId = usr, lmService = newServiceRef <$> srv <*> prv, - lmStatus = - MemberStatus - { msOtrMutedStatus = omus, - msOtrMutedRef = omur, - msOtrArchived = fromMaybe False oar, - msOtrArchivedRef = oarr, - msHidden = fromMaybe False hid, - msHiddenRef = hidr - }, + lmStatus = toMemberStatus (omus, omur, oar, oarr, hid, hidr), lmConvRoleName = fromMaybe roleNameWireAdmin crn } toMember _ = Nothing diff --git a/services/galley/src/Galley/Data/Queries.hs b/services/galley/src/Galley/Data/Queries.hs index 2f0176287e..a07facd611 100644 --- a/services/galley/src/Galley/Data/Queries.hs +++ b/services/galley/src/Galley/Data/Queries.hs @@ -303,14 +303,8 @@ insertUserRemoteConv = "insert into user_remote_conv (user, conv_remote_domain, selectUserRemoteConvs :: PrepQuery R (Identity UserId) (Domain, ConvId) selectUserRemoteConvs = "select conv_remote_domain, conv_remote_id from user_remote_conv where user = ?" -selectRemoteConvMembership :: PrepQuery R (UserId, Domain, ConvId) (Identity UserId) -selectRemoteConvMembership = "select user from user_remote_conv where user = ? and conv_remote_domain = ? and conv_remote_id = ?" - -selectRemoteConvMember :: PrepQuery R (Domain, ConvId, UserId) (Maybe MutedStatus, Maybe Text, Maybe Bool, Maybe Text, Maybe Bool, Maybe Text, Maybe RoleName) -selectRemoteConvMember = "select otr_muted_status, otr_muted_ref, otr_archived, otr_archived_ref, hidden, hidden_ref, conversation_role from user_remote_conv where conv_remote_domain = ? and conv_remote_id = ? and user = ?" - -selectRemoteConvMembershipIn :: PrepQuery R (UserId, Domain, [ConvId]) (Identity ConvId) -selectRemoteConvMembershipIn = "select conv_remote_id from user_remote_conv where user = ? and conv_remote_domain = ? and conv_remote_id in ?" +selectRemoteConvMembers :: PrepQuery R (UserId, Domain, [ConvId]) (ConvId, Maybe MutedStatus, Maybe Text, Maybe Bool, Maybe Text, Maybe Bool, Maybe Text) +selectRemoteConvMembers = "select conv_remote_id, otr_muted_status, otr_muted_ref, otr_archived, otr_archived_ref, hidden, hidden_ref from user_remote_conv where user = ? and conv_remote_domain = ? and conv_remote_id in ?" deleteUserRemoteConv :: PrepQuery W (UserId, Domain, ConvId) () deleteUserRemoteConv = "delete from user_remote_conv where user = ? and conv_remote_domain = ? and conv_remote_id = ?" @@ -324,7 +318,10 @@ updateRemoteOtrMemberArchived :: PrepQuery W (Bool, Maybe Text, Domain, ConvId, updateRemoteOtrMemberArchived = "update user_remote_conv set otr_archived = ?, otr_archived_ref = ? where conv_remote_domain = ? and conv_remote_id = ? and user = ?" updateRemoteMemberHidden :: PrepQuery W (Bool, Maybe Text, Domain, ConvId, UserId) () -updateRemoteMemberHidden = "update user_remote_conv set otr_hidden = ?, otr_hidden_ref = ? where conv_remote_domain = ? and conv_remote_id = ? and user = ?" +updateRemoteMemberHidden = "update user_remote_conv set hidden = ?, hidden_ref = ? where conv_remote_domain = ? and conv_remote_id = ? and user = ?" + +selectRemoteMemberStatus :: PrepQuery R (Domain, ConvId, UserId) (Maybe MutedStatus, Maybe Text, Maybe Bool, Maybe Text, Maybe Bool, Maybe Text) +selectRemoteMemberStatus = "select otr_muted_status, otr_muted_ref, otr_archived, otr_archived_ref, hidden, hidden_ref from user_remote_conv where conv_remote_domain = ? and conv_remote_id = ? and user = ?" -- Clients ------------------------------------------------------------------ From 620ffe74051c98033c7ad2cef101420a010d400a Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Mon, 13 Sep 2021 17:58:25 +0200 Subject: [PATCH 11/19] Implement updating member state for remote convs --- changelog.d/6-federation/self-member-status | 1 + libs/types-common/src/Data/Qualified.hs | 9 +++ services/galley/src/Galley/API/Public.hs | 2 +- services/galley/src/Galley/API/Update.hs | 69 ++++++++++++++----- services/galley/src/Galley/Data.hs | 57 ++++++++++++--- .../galley/test/integration/API/Federation.hs | 1 - 6 files changed, 109 insertions(+), 30 deletions(-) create mode 100644 changelog.d/6-federation/self-member-status diff --git a/changelog.d/6-federation/self-member-status b/changelog.d/6-federation/self-member-status new file mode 100644 index 0000000000..92794080bc --- /dev/null +++ b/changelog.d/6-federation/self-member-status @@ -0,0 +1 @@ +Added support for updating self member status of remote conversations diff --git a/libs/types-common/src/Data/Qualified.hs b/libs/types-common/src/Data/Qualified.hs index d116210003..779cae9908 100644 --- a/libs/types-common/src/Data/Qualified.hs +++ b/libs/types-common/src/Data/Qualified.hs @@ -23,6 +23,8 @@ module Data.Qualified Qualified (..), Remote, toRemote, + Local, + toLocal, renderQualifiedId, partitionRemoteOrLocalIds, partitionRemoteOrLocalIds', @@ -66,6 +68,13 @@ type Remote a = Tagged "remote" (Qualified a) toRemote :: Qualified a -> Remote a toRemote = Tagged +-- | A type representing a Qualified value where the domain is guaranteed to be +-- the local one. +type Local a = Tagged "local" (Qualified a) + +toLocal :: Qualified a -> Local a +toLocal = Tagged + -- | FUTUREWORK: Maybe delete this, it is only used in printing federation not -- implemented errors renderQualified :: (a -> Text) -> Qualified a -> Text diff --git a/services/galley/src/Galley/API/Public.hs b/services/galley/src/Galley/API/Public.hs index 6fb84c5664..191d37ccc2 100644 --- a/services/galley/src/Galley/API/Public.hs +++ b/services/galley/src/Galley/API/Public.hs @@ -96,7 +96,7 @@ servantSitemap = GalleyAPI.updateConversationNameUnqualified = Update.updateLocalConversationName, GalleyAPI.updateConversationName = Update.updateConversationName, GalleyAPI.getConversationSelfUnqualified = Query.getLocalSelf, - GalleyAPI.updateConversationSelfUnqualified = Update.updateLocalSelfMember, + GalleyAPI.updateConversationSelfUnqualified = Update.updateUnqualifiedSelfMember, GalleyAPI.updateConversationSelf = Update.updateSelfMember, GalleyAPI.getTeamConversationRoles = Teams.getTeamConversationRoles, GalleyAPI.getTeamConversations = Teams.getTeamConversations, diff --git a/services/galley/src/Galley/API/Update.hs b/services/galley/src/Galley/API/Update.hs index 5dd70d1dc3..0d2ea6c72e 100644 --- a/services/galley/src/Galley/API/Update.hs +++ b/services/galley/src/Galley/API/Update.hs @@ -36,7 +36,7 @@ module Galley.API.Update -- * Managing Members addMembersH, addMembers, - updateLocalSelfMember, + updateUnqualifiedSelfMember, updateSelfMember, updateOtherMemberH, removeMember, @@ -553,14 +553,36 @@ updateSelfMember :: UserId -> ConnId -> Qualified ConvId -> Public.MemberUpdate updateSelfMember zusr zcon qcnv update = do localDomain <- viewFederationDomain if qDomain qcnv == localDomain - then updateLocalSelfMember zusr zcon (qUnqualified qcnv) update - else throwM federationNotImplemented + then updateLocalSelfMember zusr zcon (toLocal qcnv) update + else updateRemoteSelfMember zusr zcon (toRemote qcnv) update -updateLocalSelfMember :: UserId -> ConnId -> ConvId -> Public.MemberUpdate -> Galley () -updateLocalSelfMember zusr zcon cid update = do - conv <- getConversationAndCheckMembership zusr cid +updateUnqualifiedSelfMember :: UserId -> ConnId -> ConvId -> Public.MemberUpdate -> Galley () +updateUnqualifiedSelfMember zusr zcon cid update = do + localDomain <- viewFederationDomain + updateLocalSelfMember zusr zcon (toLocal (Qualified cid localDomain)) update + +updateLocalSelfMember :: UserId -> ConnId -> Local ConvId -> Public.MemberUpdate -> Galley () +updateLocalSelfMember zusr zcon (Tagged qcid) update = do + -- FUTUREWORK: no need to fetch the whole conversation here: the + -- getConversationAndCheckMembership function results in 3 queries (for the + -- conversation metadata, remote members and local members respectively), but + -- only one is really needed (local members). + conv <- getConversationAndCheckMembership zusr (qUnqualified qcid) m <- getSelfMemberFromLocalsLegacy zusr (Data.convLocalMembers conv) - void $ processUpdateMemberEvent zusr zcon cid [m] m update + void $ processUpdateMemberEvent zusr zcon qcid [lmId m] (lmId m) update + +updateRemoteSelfMember :: + UserId -> + ConnId -> + Remote ConvId -> + Public.MemberUpdate -> + Galley () +updateRemoteSelfMember zusr zcon rcid update = do + statusMap <- Data.remoteConversationStatus zusr [rcid] + case Map.lookup rcid statusMap of + Nothing -> throwM convMemberNotFound + Just _ -> + void $ processUpdateMemberEvent zusr zcon (unTagged rcid) [zusr] zusr update updateOtherMemberH :: UserId ::: ConnId ::: ConvId ::: UserId ::: JsonRequest Public.OtherMemberUpdate -> Galley Response updateOtherMemberH (zusr ::: zcon ::: cid ::: victim ::: req) = do @@ -570,13 +592,15 @@ updateOtherMemberH (zusr ::: zcon ::: cid ::: victim ::: req) = do updateOtherMember :: UserId -> ConnId -> ConvId -> UserId -> Public.OtherMemberUpdate -> Galley () updateOtherMember zusr zcon cid victim update = do + localDomain <- viewFederationDomain when (zusr == victim) $ throwM invalidTargetUserOp conv <- getConversationAndCheckMembership zusr cid let (bots, users) = localBotsAndUsers (Data.convLocalMembers conv) ensureActionAllowedThrowing ModifyOtherConversationMember =<< getSelfMemberFromLocalsLegacy zusr users + -- this has the side effect of checking that the victim is indeed part of the conversation memTarget <- getOtherMemberLegacy victim users - e <- processUpdateMemberEvent zusr zcon cid users memTarget update + e <- processUpdateMemberEvent zusr zcon (Qualified cid localDomain) (map lmId users) (lmId memTarget) update void . forkIO $ void $ External.deliver (bots `zip` repeat e) -- | A general conversation member removal function used both by the unqualified @@ -1073,23 +1097,34 @@ ensureConvMember users usr = unless (usr `isMember` users) $ throwErrorDescription convNotFound +-- | Update a member of a conversation and propagate events. +-- +-- Note: the target is assumed to be a member of the conversation. processUpdateMemberEvent :: Data.IsMemberUpdate mu => + -- | Originating user UserId -> + -- | Connection ID for the originating user ConnId -> - ConvId -> - [LocalMember] -> - LocalMember -> + -- | Conversation whose members are being updated + Qualified ConvId -> + -- | Recipients of the notification + [UserId] -> + -- | User being updated + UserId -> + -- | Update structure mu -> Galley Event -processUpdateMemberEvent zusr zcon cid users target update = do +processUpdateMemberEvent zusr zcon qcid users target update = do localDomain <- viewFederationDomain - let qcnv = Qualified cid localDomain - qusr = Qualified zusr localDomain - up <- Data.updateMember cid (lmId target) update + let qusr = Qualified zusr localDomain + up <- + if localDomain == qDomain qcid + then Data.updateMember (qUnqualified qcid) target update + else Data.updateMemberRemoteConv (toRemote qcid) target update now <- liftIO getCurrentTime - let e = Event MemberStateUpdate qcnv qusr now (EdMemberUpdate up) - let recipients = fmap recipient (target : filter ((/= lmId target) . lmId) users) + let e = Event MemberStateUpdate qcid qusr now (EdMemberUpdate up) + let recipients = fmap userRecipient (target : filter (/= target) users) for_ (newPushLocal ListComplete zusr (ConvEvent e) recipients) $ \p -> push1 $ p diff --git a/services/galley/src/Galley/Data.hs b/services/galley/src/Galley/Data.hs index eb71566405..2d9fc2aa90 100644 --- a/services/galley/src/Galley/Data.hs +++ b/services/galley/src/Galley/Data.hs @@ -935,6 +935,20 @@ addLocalMembersToRemoteConv users qconv = do class IsMemberUpdate mu where updateMember :: MonadClient m => ConvId -> UserId -> mu -> m MemberUpdateData + updateMemberRemoteConv :: MonadClient m => Remote ConvId -> UserId -> mu -> m MemberUpdateData + +memberUpdateToData :: UserId -> MemberUpdate -> MemberUpdateData +memberUpdateToData uid mup = + MemberUpdateData + { misTarget = Just uid, + misOtrMutedStatus = mupOtrMuteStatus mup, + misOtrMutedRef = mupOtrMuteRef mup, + misOtrArchived = mupOtrArchive mup, + misOtrArchivedRef = mupOtrArchiveRef mup, + misHidden = mupHidden mup, + misHiddenRef = mupHiddenRef mup, + misConvRoleName = Nothing + } instance IsMemberUpdate MemberUpdate where updateMember cid uid mup = do @@ -947,17 +961,24 @@ instance IsMemberUpdate MemberUpdate where addPrepQuery Cql.updateOtrMemberArchived (a, mupOtrArchiveRef mup, cid, uid) for_ (mupHidden mup) $ \h -> addPrepQuery Cql.updateMemberHidden (h, mupHiddenRef mup, cid, uid) - return - MemberUpdateData - { misTarget = Just uid, - misOtrMutedStatus = mupOtrMuteStatus mup, - misOtrMutedRef = mupOtrMuteRef mup, - misOtrArchived = mupOtrArchive mup, - misOtrArchivedRef = mupOtrArchiveRef mup, - misHidden = mupHidden mup, - misHiddenRef = mupHiddenRef mup, - misConvRoleName = Nothing - } + pure (memberUpdateToData uid mup) + updateMemberRemoteConv (Tagged (Qualified cid domain)) uid mup = do + retry x5 . batch $ do + setType BatchUnLogged + setConsistency Quorum + for_ (mupOtrMuteStatus mup) $ \ms -> + addPrepQuery + Cql.updateRemoteOtrMemberMutedStatus + (ms, mupOtrMuteRef mup, domain, cid, uid) + for_ (mupOtrArchive mup) $ \a -> + addPrepQuery + Cql.updateRemoteOtrMemberArchived + (a, mupOtrArchiveRef mup, domain, cid, uid) + for_ (mupHidden mup) $ \h -> + addPrepQuery + Cql.updateRemoteOtrMemberArchived + (h, mupHiddenRef mup, domain, cid, uid) + pure (memberUpdateToData uid mup) instance IsMemberUpdate OtherMemberUpdate where updateMember cid uid omu = do @@ -978,6 +999,20 @@ instance IsMemberUpdate OtherMemberUpdate where misConvRoleName = omuConvRoleName omu } + -- FUTUREWORK: https://wearezeta.atlassian.net/browse/SQCORE-887 + updateMemberRemoteConv _ _ _ = + pure + MemberUpdateData + { misTarget = Nothing, + misOtrMutedStatus = Nothing, + misOtrMutedRef = Nothing, + misOtrArchived = Nothing, + misOtrArchivedRef = Nothing, + misHidden = Nothing, + misHiddenRef = Nothing, + misConvRoleName = Nothing + } + -- | Select only the members of a remote conversation from a list of users. -- Return the filtered list and a boolean indicating whether the all the input -- users are members. diff --git a/services/galley/test/integration/API/Federation.hs b/services/galley/test/integration/API/Federation.hs index 700ac15884..05f08812bc 100644 --- a/services/galley/test/integration/API/Federation.hs +++ b/services/galley/test/integration/API/Federation.hs @@ -122,7 +122,6 @@ getConversationsAllFound = do assertEqual "other members mismatch" (Just (sort [bob, qUnqualified carlQ])) - -- (fmap (sort . (map (qUnqualified . omQualifiedId) . rcmOthers . rcnvMembers) cnv2)) (fmap (sort . map (qUnqualified . omQualifiedId) . rcmOthers . rcnvMembers) c2) getConversationsNotPartOf :: TestM () From b6109b4350b5a7e7f8c6b63cdd0a15e677582ecc Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Tue, 14 Sep 2021 09:40:22 +0200 Subject: [PATCH 12/19] Mock federator in remote conv status update test --- services/galley/test/integration/API.hs | 21 ++++++++++++++++++++- 1 file changed, 20 insertions(+), 1 deletion(-) diff --git a/services/galley/test/integration/API.hs b/services/galley/test/integration/API.hs index e020de0d92..97d2437c1b 100644 --- a/services/galley/test/integration/API.hs +++ b/services/galley/test/integration/API.hs @@ -2693,8 +2693,27 @@ putRemoteConvMemberOk update = do assertEqual "hidden" (mupHidden update) (misHidden mis) assertEqual "hidden_ref" (mupHiddenRef update) (misHiddenRef mis) x -> assertFailure $ "Unexpected event data: " ++ show x + + -- Fetch remote conversation + + let bobAsLocal = LocalMember (qUnqualified qbob) defMemberStatus Nothing roleNameWireAdmin + let mockConversation = + mkConv + qconv + (qUnqualified qbob) + roleNameWireMember + [localMemberToOther remoteDomain bobAsLocal] + remoteConversationResponse = GetConversationsResponse [mockConversation] + opts <- view tsGConf + (rs, _) <- + withTempMockFederator + opts + remoteDomain + (const remoteConversationResponse) + $ getConvQualified alice qconv + responseJsonUnsafe rs liftIO $ do assertBool "user" (isJust alice') From 9e63618272a7f8df20bb0343e4156fe1f214bcaa Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Tue, 14 Sep 2021 10:05:00 +0200 Subject: [PATCH 13/19] Add more member status update tests and fix bug Attempting to set hidden flag would incorrectly set the archived flag. This is now fixed. --- services/galley/src/Galley/Data.hs | 2 +- services/galley/test/integration/API.hs | 32 ++++++++++++++++++++++--- 2 files changed, 30 insertions(+), 4 deletions(-) diff --git a/services/galley/src/Galley/Data.hs b/services/galley/src/Galley/Data.hs index 2d9fc2aa90..3592ab08e6 100644 --- a/services/galley/src/Galley/Data.hs +++ b/services/galley/src/Galley/Data.hs @@ -976,7 +976,7 @@ instance IsMemberUpdate MemberUpdate where (a, mupOtrArchiveRef mup, domain, cid, uid) for_ (mupHidden mup) $ \h -> addPrepQuery - Cql.updateRemoteOtrMemberArchived + Cql.updateRemoteMemberHidden (h, mupHiddenRef mup, domain, cid, uid) pure (memberUpdateToData uid mup) diff --git a/services/galley/test/integration/API.hs b/services/galley/test/integration/API.hs index 97d2437c1b..3925ca54ce 100644 --- a/services/galley/test/integration/API.hs +++ b/services/galley/test/integration/API.hs @@ -188,6 +188,9 @@ tests s = test s "member update (hidden)" putMemberHiddenOk, test s "member update (everything b)" putMemberAllOk, test s "remote conversation member update (otr mute)" putRemoteConvMemberOtrMuteOk, + test s "remote conversation member update (otr archive)" putRemoteConvMemberOtrArchiveOk, + test s "remote conversation member update (otr hidden)" putRemoteConvMemberHiddenOk, + test s "remote conversation member update (everything)" putRemoteConvMemberAllOk, test s "conversation receipt mode update" putReceiptModeOk, test s "send typing indicators" postTypingIndicators, test s "leave connect conversation" leaveConnectConversation, @@ -2581,8 +2584,32 @@ putMemberAllOk = ) putRemoteConvMemberOtrMuteOk :: TestM () -putRemoteConvMemberOtrMuteOk = - putRemoteConvMemberOk (memberUpdate {mupOtrMuteStatus = Just 0, mupOtrMuteRef = Just "ref"}) +putRemoteConvMemberOtrMuteOk = do + putRemoteConvMemberOk (memberUpdate {mupOtrMuteStatus = Just 1, mupOtrMuteRef = Just "ref"}) + putRemoteConvMemberOk (memberUpdate {mupOtrMuteStatus = Just 0}) + +putRemoteConvMemberOtrArchiveOk :: TestM () +putRemoteConvMemberOtrArchiveOk = do + putRemoteConvMemberOk (memberUpdate {mupOtrArchive = Just True, mupOtrArchiveRef = Just "ref"}) + putRemoteConvMemberOk (memberUpdate {mupOtrArchive = Just False}) + +putRemoteConvMemberHiddenOk :: TestM () +putRemoteConvMemberHiddenOk = do + putRemoteConvMemberOk (memberUpdate {mupHidden = Just True, mupHiddenRef = Just "ref"}) + putRemoteConvMemberOk (memberUpdate {mupHidden = Just False}) + +putRemoteConvMemberAllOk :: TestM () +putRemoteConvMemberAllOk = + putRemoteConvMemberOk + ( memberUpdate + { mupOtrMuteStatus = Just 0, + mupOtrMuteRef = Just "mref", + mupOtrArchive = Just True, + mupOtrArchiveRef = Just "aref", + mupHidden = Just True, + mupHiddenRef = Just "href" + } + ) putMemberOk :: MemberUpdate -> TestM () putMemberOk update = do @@ -2695,7 +2722,6 @@ putRemoteConvMemberOk update = do x -> assertFailure $ "Unexpected event data: " ++ show x -- Fetch remote conversation - let bobAsLocal = LocalMember (qUnqualified qbob) defMemberStatus Nothing roleNameWireAdmin let mockConversation = mkConv From 6d867cdfa5535a6521cc9e72c4015548fc1542ef Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Tue, 14 Sep 2021 15:25:56 +0200 Subject: [PATCH 14/19] Remove debug prints MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Co-authored-by: Marko Dimjašević --- services/galley/test/integration/API/Federation.hs | 5 ----- 1 file changed, 5 deletions(-) diff --git a/services/galley/test/integration/API/Federation.hs b/services/galley/test/integration/API/Federation.hs index 05f08812bc..89dad6f46d 100644 --- a/services/galley/test/integration/API/Federation.hs +++ b/services/galley/test/integration/API/Federation.hs @@ -82,9 +82,6 @@ getConversationsAllFound = do carlQ <- Qualified <$> randomUser <*> pure localDomain connectUsers bob (singleton (qUnqualified carlQ)) - putStrLn $ "alice: " <> show (qUnqualified aliceQ) - putStrLn $ "bob: " <> show bob - putStrLn $ "carl: " <> show (qUnqualified carlQ) cnv2 <- responseJsonError @@ -117,8 +114,6 @@ getConversationsAllFound = do "self member role mismatch" (Just . memConvRoleName . cmSelf $ cnvMembers cnv2) (rcmSelfRole . rcnvMembers <$> c2) - putStrLn $ "actual members " <> show (fmap (rcmOthers . rcnvMembers) c2) - putStrLn $ "expected members " <> show (cmOthers (cnvMembers cnv2)) assertEqual "other members mismatch" (Just (sort [bob, qUnqualified carlQ])) From a0df7f6ceabb7003a798d80212fde68749e6e806 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Wed, 15 Sep 2021 08:48:06 +0200 Subject: [PATCH 15/19] Move schema closer to the definition of the type Moved the schema definition of `ConversationMetadata` closer to the type definition. --- libs/wire-api/src/Wire/API/Conversation.hs | 74 +++++++++++----------- 1 file changed, 37 insertions(+), 37 deletions(-) diff --git a/libs/wire-api/src/Wire/API/Conversation.hs b/libs/wire-api/src/Wire/API/Conversation.hs index 9b04d851ae..735bd55f10 100644 --- a/libs/wire-api/src/Wire/API/Conversation.hs +++ b/libs/wire-api/src/Wire/API/Conversation.hs @@ -136,6 +136,43 @@ data ConversationMetadata = ConversationMetadata deriving (Arbitrary) via (GenericUniform ConversationMetadata) deriving (FromJSON, ToJSON) via Schema ConversationMetadata +conversationMetadataObjectSchema :: + SchemaP + SwaggerDoc + A.Object + [A.Pair] + ConversationMetadata + ConversationMetadata +conversationMetadataObjectSchema = + ConversationMetadata + <$> cnvmQualifiedId .= field "qualified_id" schema + <* (qUnqualified . cnvmQualifiedId) + .= optional (field "id" (deprecatedSchema "qualified_id" schema)) + <*> cnvmType .= field "type" schema + <*> cnvmCreator + .= fieldWithDocModifier + "creator" + (description ?~ "The creator's user ID") + schema + <*> cnvmAccess .= field "access" (array schema) + <*> cnvmAccessRole .= field "access_role" schema + <*> cnvmName .= lax (field "name" (optWithDefault A.Null schema)) + <* const ("0.0" :: Text) .= optional (field "last_event" schema) + <* const ("1970-01-01T00:00:00.000Z" :: Text) + .= optional (field "last_event_time" schema) + <*> cnvmTeam .= lax (field "team" (optWithDefault A.Null schema)) + <*> cnvmMessageTimer + .= lax + ( fieldWithDocModifier + "message_timer" + (description ?~ "Per-conversation message timer (can be null)") + (optWithDefault A.Null schema) + ) + <*> cnvmReceiptMode .= lax (field "receipt_mode" (optWithDefault A.Null schema)) + +instance ToSchema ConversationMetadata where + schema = object "ConversationMetadata" conversationMetadataObjectSchema + -- | Public-facing conversation type. Represents information that a -- particular user is allowed to see. -- @@ -191,43 +228,6 @@ cnvMessageTimer = cnvmMessageTimer . cnvMetadata cnvReceiptMode :: Conversation -> Maybe ReceiptMode cnvReceiptMode = cnvmReceiptMode . cnvMetadata -conversationMetadataObjectSchema :: - SchemaP - SwaggerDoc - A.Object - [A.Pair] - ConversationMetadata - ConversationMetadata -conversationMetadataObjectSchema = - ConversationMetadata - <$> cnvmQualifiedId .= field "qualified_id" schema - <* (qUnqualified . cnvmQualifiedId) - .= optional (field "id" (deprecatedSchema "qualified_id" schema)) - <*> cnvmType .= field "type" schema - <*> cnvmCreator - .= fieldWithDocModifier - "creator" - (description ?~ "The creator's user ID") - schema - <*> cnvmAccess .= field "access" (array schema) - <*> cnvmAccessRole .= field "access_role" schema - <*> cnvmName .= lax (field "name" (optWithDefault A.Null schema)) - <* const ("0.0" :: Text) .= optional (field "last_event" schema) - <* const ("1970-01-01T00:00:00.000Z" :: Text) - .= optional (field "last_event_time" schema) - <*> cnvmTeam .= lax (field "team" (optWithDefault A.Null schema)) - <*> cnvmMessageTimer - .= lax - ( fieldWithDocModifier - "message_timer" - (description ?~ "Per-conversation message timer (can be null)") - (optWithDefault A.Null schema) - ) - <*> cnvmReceiptMode .= lax (field "receipt_mode" (optWithDefault A.Null schema)) - -instance ToSchema ConversationMetadata where - schema = object "ConversationMetadata" conversationMetadataObjectSchema - instance ToSchema Conversation where schema = objectWithDocModifier From b74752ebc1fb7c1b4d776245233c4d95bae217f7 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Wed, 15 Sep 2021 08:51:15 +0200 Subject: [PATCH 16/19] Arbitrary role names in mapping tests Replaced the hardcoded admin role for local members to a randomly generated role. --- services/galley/test/unit/Test/Galley/Mapping.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/services/galley/test/unit/Test/Galley/Mapping.hs b/services/galley/test/unit/Test/Galley/Mapping.hs index 6f5b741899..f48ac6d312 100644 --- a/services/galley/test/unit/Test/Galley/Mapping.hs +++ b/services/galley/test/unit/Test/Galley/Mapping.hs @@ -109,7 +109,7 @@ genLocalMember = <$> arbitrary <*> pure defMemberStatus <*> pure Nothing - <*> pure roleNameWireAdmin + <*> arbitrary genRemoteMember :: Gen RemoteMember genRemoteMember = RemoteMember <$> arbitrary <*> pure roleNameWireMember From 9cd866088f01f24a4629a9e083c0f00d8f8343d4 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Wed, 15 Sep 2021 08:54:16 +0200 Subject: [PATCH 17/19] Use `randomQualifiedUser` instead of `randomUser` --- services/galley/test/integration/API/Federation.hs | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/services/galley/test/integration/API/Federation.hs b/services/galley/test/integration/API/Federation.hs index 89dad6f46d..60fca97cf3 100644 --- a/services/galley/test/integration/API/Federation.hs +++ b/services/galley/test/integration/API/Federation.hs @@ -78,11 +78,9 @@ getConversationsAllFound = do let aliceQ = Qualified alice (Domain "far-away.example.com") -- create & get group conv - localDomain <- viewFederationDomain - carlQ <- Qualified <$> randomUser <*> pure localDomain + carlQ <- randomQualifiedUser connectUsers bob (singleton (qUnqualified carlQ)) - cnv2 <- responseJsonError =<< postConvWithRemoteUser (qDomain aliceQ) (mkProfile aliceQ (Name "alice")) bob [aliceQ, carlQ] From 77b62c13cf8022b87afcadc92de82d4154a7a352 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Wed, 15 Sep 2021 08:59:45 +0200 Subject: [PATCH 18/19] Make alice remote only in get-conversation test The user alice was incorrectly created as a local user, only to be then regarded as a remote one. This didn't impact the functionality of the test, but it created an unnecessary local user, and made the logic of the test confusing. --- services/galley/test/integration/API/Federation.hs | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/services/galley/test/integration/API/Federation.hs b/services/galley/test/integration/API/Federation.hs index 60fca97cf3..0daa10e4c5 100644 --- a/services/galley/test/integration/API/Federation.hs +++ b/services/galley/test/integration/API/Federation.hs @@ -74,10 +74,10 @@ tests s = getConversationsAllFound :: TestM () getConversationsAllFound = do - [alice, bob] <- randomUsers 2 - let aliceQ = Qualified alice (Domain "far-away.example.com") + bob <- randomUser -- create & get group conv + aliceQ <- Qualified <$> randomId <*> pure (Domain "far-away.example.com") carlQ <- randomQualifiedUser connectUsers bob (singleton (qUnqualified carlQ)) @@ -99,7 +99,10 @@ getConversationsAllFound = do FedGalley.getConversations fedGalleyClient (qDomain aliceQ) - (GetConversationsRequest alice $ qUnqualified . cnvQualifiedId <$> [cnv2]) + ( GetConversationsRequest + (qUnqualified aliceQ) + (map (qUnqualified . cnvQualifiedId) [cnv2]) + ) let c2 = find ((== cnvQualifiedId cnv2) . cnvmQualifiedId . rcnvMetadata) cs From fe55625f3a10ecd600b47e35cf90042df9403857 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Wed, 15 Sep 2021 09:02:58 +0200 Subject: [PATCH 19/19] Remove outdated FUTUREWORK comment --- services/galley/test/integration/API.hs | 2 -- 1 file changed, 2 deletions(-) diff --git a/services/galley/test/integration/API.hs b/services/galley/test/integration/API.hs index 3925ca54ce..289ee3c0b2 100644 --- a/services/galley/test/integration/API.hs +++ b/services/galley/test/integration/API.hs @@ -1918,8 +1918,6 @@ testGetQualifiedRemoteConv = do (getConvQualified aliceId remoteConvId) conv <- responseJsonUnsafe <$> (pure respAll