diff --git a/libs/wire-api/src/Wire/API/Error/Galley.hs b/libs/wire-api/src/Wire/API/Error/Galley.hs index d714737c03c..c53fa996b60 100644 --- a/libs/wire-api/src/Wire/API/Error/Galley.hs +++ b/libs/wire-api/src/Wire/API/Error/Galley.hs @@ -84,7 +84,6 @@ data GalleyError | MLSWelcomeMismatch | MLSMissingGroupInfo | MLSMissingSenderClient - | MLSUnexpectedSenderClient | -- NoBindingTeamMembers | NoBindingTeam @@ -204,8 +203,6 @@ type instance MapError 'MLSGroupConversationMismatch = 'StaticError 400 "mls-gro type instance MapError 'MLSClientSenderUserMismatch = 'StaticError 400 "mls-client-sender-user-mismatch" "User ID resolved from Client ID does not match message's sender user ID" -type instance MapError 'MLSUnexpectedSenderClient = 'StaticError 422 "mls-unexpected-sender-client-found" "Unexpected creator client set. This is a newly created conversation and it expected exactly one client." - type instance MapError 'MLSWelcomeMismatch = 'StaticError 400 "mls-welcome-mismatch" "The list of targets of a welcome message does not match the list of new clients in a group" type instance MapError 'MLSMissingGroupInfo = 'StaticError 404 "mls-missing-group-info" "The conversation has no group information" diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Galley/MLS.hs b/libs/wire-api/src/Wire/API/Routes/Public/Galley/MLS.hs index 03421544b04..6b3666208eb 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Galley/MLS.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Galley/MLS.hs @@ -60,7 +60,6 @@ type MLSMessagingAPI = :> CanThrow 'MLSStaleMessage :> CanThrow 'MLSUnsupportedMessage :> CanThrow 'MLSUnsupportedProposal - :> CanThrow 'MLSUnexpectedSenderClient :> CanThrow 'MLSClientSenderUserMismatch :> CanThrow 'MLSGroupConversationMismatch :> CanThrow 'MLSMissingSenderClient @@ -89,7 +88,6 @@ type MLSMessagingAPI = :> CanThrow 'MLSStaleMessage :> CanThrow 'MLSUnsupportedMessage :> CanThrow 'MLSUnsupportedProposal - :> CanThrow 'MLSUnexpectedSenderClient :> CanThrow 'MLSClientSenderUserMismatch :> CanThrow 'MLSGroupConversationMismatch :> CanThrow 'MLSMissingSenderClient @@ -118,7 +116,6 @@ type MLSMessagingAPI = :> CanThrow 'MLSStaleMessage :> CanThrow 'MLSUnsupportedMessage :> CanThrow 'MLSUnsupportedProposal - :> CanThrow 'MLSUnexpectedSenderClient :> CanThrow 'MLSClientSenderUserMismatch :> CanThrow 'MLSGroupConversationMismatch :> CanThrow 'MLSMissingSenderClient diff --git a/services/galley/src/Galley/API/Action.hs b/services/galley/src/Galley/API/Action.hs index 44e9d9d4338..2acdd7858c6 100644 --- a/services/galley/src/Galley/API/Action.hs +++ b/services/galley/src/Galley/API/Action.hs @@ -52,6 +52,7 @@ import Data.Singletons import Data.Time.Clock import Galley.API.Error import Galley.API.MLS.Removal +import Galley.API.MLS.Util (globalTeamConvToConversation) import Galley.API.Util import Galley.App import Galley.Data.Conversation @@ -89,6 +90,7 @@ import Wire.API.Event.Conversation import Wire.API.Federation.API (Component (Galley), fedClient) import Wire.API.Federation.API.Galley import Wire.API.Federation.Error +import Wire.API.MLS.GlobalTeamConversation import Wire.API.Team.LegalHold import Wire.API.Team.Member import qualified Wire.API.User as User @@ -595,7 +597,17 @@ updateLocalConversation lcnv qusr con action = do let tag = sing @tag -- retrieve conversation - conv <- getConversationWithError lcnv (qUnqualified qusr) + conv <- do + -- Check if global or not, if global, map it to conversation + E.getGlobalTeamConversationById lcnv >>= \case + Just gtc -> + let c = gtcCreator gtc + in case c of + Nothing -> + throwS @'ConvNotFound + Just creator -> + pure $ globalTeamConvToConversation gtc creator mempty + Nothing -> getConversationWithError lcnv -- check that the action does not bypass the underlying protocol unless (protocolValidAction (convProtocol conv) (fromSing tag)) $ diff --git a/services/galley/src/Galley/API/MLS/Message.hs b/services/galley/src/Galley/API/MLS/Message.hs index 7080b94941f..7bd31569e0a 100644 --- a/services/galley/src/Galley/API/MLS/Message.hs +++ b/services/galley/src/Galley/API/MLS/Message.hs @@ -105,7 +105,6 @@ type MLSMessageStaticErrors = ErrorS 'MLSCommitMissingReferences, ErrorS 'MLSSelfRemovalNotAllowed, ErrorS 'MLSClientSenderUserMismatch, - ErrorS 'MLSUnexpectedSenderClient, ErrorS 'MLSGroupConversationMismatch, ErrorS 'MLSMissingSenderClient ] @@ -123,6 +122,7 @@ postMLSMessageFromLocalUserV1 :: ErrorS 'ConvAccessDenied, ErrorS 'ConvMemberNotFound, ErrorS 'ConvNotFound, + ErrorS 'MissingLegalholdConsent, ErrorS 'MLSClientSenderUserMismatch, ErrorS 'MLSCommitMissingReferences, ErrorS 'MLSGroupConversationMismatch, @@ -130,9 +130,7 @@ postMLSMessageFromLocalUserV1 :: ErrorS 'MLSProposalNotFound, ErrorS 'MLSSelfRemovalNotAllowed, ErrorS 'MLSStaleMessage, - ErrorS 'MLSUnexpectedSenderClient, ErrorS 'MLSUnsupportedMessage, - ErrorS 'MissingLegalholdConsent, Input (Local ()), ProposalStore, Resource, @@ -159,6 +157,7 @@ postMLSMessageFromLocalUser :: ErrorS 'ConvAccessDenied, ErrorS 'ConvMemberNotFound, ErrorS 'ConvNotFound, + ErrorS 'MissingLegalholdConsent, ErrorS 'MLSClientSenderUserMismatch, ErrorS 'MLSCommitMissingReferences, ErrorS 'MLSGroupConversationMismatch, @@ -166,9 +165,7 @@ postMLSMessageFromLocalUser :: ErrorS 'MLSProposalNotFound, ErrorS 'MLSSelfRemovalNotAllowed, ErrorS 'MLSStaleMessage, - ErrorS 'MLSUnexpectedSenderClient, ErrorS 'MLSUnsupportedMessage, - ErrorS 'MissingLegalholdConsent, Input (Local ()), ProposalStore, Resource, @@ -370,6 +367,7 @@ postMLSMessage :: ErrorS 'ConvAccessDenied, ErrorS 'ConvMemberNotFound, ErrorS 'ConvNotFound, + ErrorS 'MissingLegalholdConsent, ErrorS 'MLSClientSenderUserMismatch, ErrorS 'MLSCommitMissingReferences, ErrorS 'MLSGroupConversationMismatch, @@ -377,9 +375,7 @@ postMLSMessage :: ErrorS 'MLSProposalNotFound, ErrorS 'MLSSelfRemovalNotAllowed, ErrorS 'MLSStaleMessage, - ErrorS 'MLSUnexpectedSenderClient, ErrorS 'MLSUnsupportedMessage, - ErrorS 'MissingLegalholdConsent, Input (Local ()), ProposalStore, Resource, @@ -459,15 +455,14 @@ postMLSMessageToLocalConv :: '[ Error FederationError, Error InternalError, ErrorS 'ConvNotFound, + ErrorS 'MissingLegalholdConsent, ErrorS 'MLSClientSenderUserMismatch, ErrorS 'MLSCommitMissingReferences, ErrorS 'MLSMissingSenderClient, ErrorS 'MLSProposalNotFound, ErrorS 'MLSSelfRemovalNotAllowed, ErrorS 'MLSStaleMessage, - ErrorS 'MLSUnexpectedSenderClient, ErrorS 'MLSUnsupportedMessage, - ErrorS 'MissingLegalholdConsent, ProposalStore, Resource, TinyLog @@ -544,29 +539,26 @@ postMLSMessageToRemoteConv loc qusr _senderClient con smsg rcnv = do pure (LocalConversationUpdate e update) type HasProposalEffects r = - ( Members - '[ BrigAccess, - ConversationStore, - Error InternalError, - Error MLSProposalFailure, - Error MLSProtocolError, - ErrorS 'MLSClientMismatch, - ErrorS 'MLSKeyPackageRefNotFound, - ErrorS 'MLSUnsupportedProposal, - ExternalAccess, - FederatorAccess, - GundeckAccess, - Input Env, - Input (Local ()), - Input Opts, - Input UTCTime, - LegalHoldStore, - MemberStore, - ProposalStore, - TeamStore, - TinyLog - ] - r + ( Member BrigAccess r, + Member ConversationStore r, + Member (Error InternalError) r, + Member (Error MLSProposalFailure) r, + Member (Error MLSProtocolError) r, + Member (ErrorS 'MLSClientMismatch) r, + Member (ErrorS 'MLSKeyPackageRefNotFound) r, + Member (ErrorS 'MLSUnsupportedProposal) r, + Member ExternalAccess r, + Member FederatorAccess r, + Member GundeckAccess r, + Member (Input Env) r, + Member (Input (Local ())) r, + Member (Input Opts) r, + Member (Input UTCTime) r, + Member LegalHoldStore r, + Member MemberStore r, + Member ProposalStore r, + Member TeamStore r, + Member TinyLog r ) data ProposalAction = ProposalAction @@ -624,24 +616,20 @@ getCommitData lconv mlsMeta epoch commit = do processCommit :: ( HasProposalEffects r, - Members - '[ Error FederationError, - Error InternalError, - ErrorS 'ConvNotFound, - ErrorS 'MLSClientSenderUserMismatch, - ErrorS 'MLSCommitMissingReferences, - ErrorS 'MLSMissingSenderClient, - ErrorS 'MLSProposalNotFound, - ErrorS 'MLSSelfRemovalNotAllowed, - ErrorS 'MLSStaleMessage, - ErrorS 'MLSUnexpectedSenderClient, - ErrorS 'MissingLegalholdConsent, - Input (Local ()), - ProposalStore, - BrigAccess, - Resource - ] - r + Member (Error FederationError) r, + Member (Error InternalError) r, + Member (ErrorS 'ConvNotFound) r, + Member (ErrorS 'MLSClientSenderUserMismatch) r, + Member (ErrorS 'MLSCommitMissingReferences) r, + Member (ErrorS 'MLSMissingSenderClient) r, + Member (ErrorS 'MLSProposalNotFound) r, + Member (ErrorS 'MLSSelfRemovalNotAllowed) r, + Member (ErrorS 'MLSStaleMessage) r, + Member (ErrorS 'MissingLegalholdConsent) r, + Member (Input (Local ())) r, + Member ProposalStore r, + Member BrigAccess r, + Member Resource r ) => Qualified UserId -> Maybe ClientId -> @@ -770,24 +758,20 @@ processExternalCommit qusr mSenderClient lconv mlsMeta cm epoch action updatePat processCommitWithAction :: forall r. ( HasProposalEffects r, - Members - '[ Error FederationError, - Error InternalError, - ErrorS 'ConvNotFound, - ErrorS 'MLSClientSenderUserMismatch, - ErrorS 'MLSCommitMissingReferences, - ErrorS 'MLSMissingSenderClient, - ErrorS 'MLSProposalNotFound, - ErrorS 'MLSSelfRemovalNotAllowed, - ErrorS 'MLSStaleMessage, - ErrorS 'MLSUnexpectedSenderClient, - ErrorS 'MissingLegalholdConsent, - Input (Local ()), - ProposalStore, - BrigAccess, - Resource - ] - r + Member (Error FederationError) r, + Member (Error InternalError) r, + Member (ErrorS 'ConvNotFound) r, + Member (ErrorS 'MLSClientSenderUserMismatch) r, + Member (ErrorS 'MLSCommitMissingReferences) r, + Member (ErrorS 'MLSMissingSenderClient) r, + Member (ErrorS 'MLSProposalNotFound) r, + Member (ErrorS 'MLSSelfRemovalNotAllowed) r, + Member (ErrorS 'MLSStaleMessage) r, + Member (ErrorS 'MissingLegalholdConsent) r, + Member (Input (Local ())) r, + Member ProposalStore r, + Member BrigAccess r, + Member Resource r ) => Qualified UserId -> Maybe ClientId -> @@ -809,24 +793,20 @@ processCommitWithAction qusr senderClient con lconv mlsMeta cm epoch action send processInternalCommit :: forall r. ( HasProposalEffects r, - Members - [ Error FederationError, - Error InternalError, - ErrorS 'ConvNotFound, - ErrorS 'MLSClientSenderUserMismatch, - ErrorS 'MLSCommitMissingReferences, - ErrorS 'MLSMissingSenderClient, - ErrorS 'MLSProposalNotFound, - ErrorS 'MLSSelfRemovalNotAllowed, - ErrorS 'MLSStaleMessage, - ErrorS 'MLSUnexpectedSenderClient, - ErrorS 'MissingLegalholdConsent, - Input (Local ()), - ProposalStore, - BrigAccess, - Resource - ] - r + Member (Error FederationError) r, + Member (Error InternalError) r, + Member (ErrorS 'ConvNotFound) r, + Member (ErrorS 'MLSClientSenderUserMismatch) r, + Member (ErrorS 'MLSCommitMissingReferences) r, + Member (ErrorS 'MLSMissingSenderClient) r, + Member (ErrorS 'MLSProposalNotFound) r, + Member (ErrorS 'MLSSelfRemovalNotAllowed) r, + Member (ErrorS 'MLSStaleMessage) r, + Member (ErrorS 'MissingLegalholdConsent) r, + Member (Input (Local ())) r, + Member ProposalStore r, + Member BrigAccess r, + Member Resource r ) => Qualified UserId -> Maybe ClientId -> @@ -863,9 +843,11 @@ processInternalCommit qusr senderClient con lconv mlsMeta cm epoch action sender qusr (Set.singleton (creatorClient, creatorRef)) (Left _, SelfConv, _) -> - -- this is a newly created conversation, and it should contain exactly one - -- client (the creator) - throwS @'MLSUnexpectedSenderClient + throw . InternalErrorWithDescription $ + "Unexpected creator client set in a self-conversation" + -- this is a newly created conversation, and it should contain exactly one + -- client (the creator) + (Left _, GlobalTeamConv, []) -> do creatorClient <- noteS @'MLSMissingSenderClient senderClient creatorRef <- @@ -876,15 +858,13 @@ processInternalCommit qusr senderClient con lconv mlsMeta cm epoch action sender . upLeaf ) $ cPath commit - -- add user to global conv as a member as well - lusr <- qualifyLocal (qUnqualified qusr) - void $ createMember (convId <$> lconv) lusr addMLSClients (cnvmlsGroupId mlsMeta) qusr (Set.singleton (creatorClient, creatorRef)) (Left _, GlobalTeamConv, _) -> - throwS @'MLSUnexpectedSenderClient + throw . InternalErrorWithDescription $ + "Unexpected creator client set in a global teamconversation" (Left lm, _, [(qu, (creatorClient, _))]) | qu == qUntagged (qualifyAs lconv (lmId lm)) -> do -- use update path as sender reference and if not existing fall back to sender diff --git a/services/galley/src/Galley/API/MLS/Util.hs b/services/galley/src/Galley/API/MLS/Util.hs index 9738b5b0464..0fefb44af15 100644 --- a/services/galley/src/Galley/API/MLS/Util.hs +++ b/services/galley/src/Galley/API/MLS/Util.hs @@ -41,6 +41,31 @@ import Wire.API.MLS.KeyPackage import Wire.API.MLS.Proposal import Wire.API.MLS.Serialisation +globalTeamConvToConversation :: + GlobalTeamConversation -> + UserId -> + [LocalMember] -> + Conversation +globalTeamConvToConversation gtc creator lMembers = + Conversation + { convId = qUnqualified $ gtcId gtc, + convLocalMembers = lMembers, + convRemoteMembers = mempty, + convDeleted = False, + convMetadata = + ConversationMetadata + { cnvmType = GlobalTeamConv, + cnvmCreator = creator, + cnvmAccess = gtcAccess gtc, + cnvmAccessRoles = mempty, + cnvmName = Just (gtcName gtc), + cnvmTeam = Just (gtcTeam gtc), + cnvmMessageTimer = Nothing, + cnvmReceiptMode = Nothing + }, + convProtocol = ProtocolMLS (gtcMlsMetadata gtc) + } + getLocalConvForUser :: Members '[ ErrorS 'ConvNotFound, @@ -55,8 +80,16 @@ getLocalConvForUser qusr lcnv = do gtc <- getGlobalTeamConversationById lcnv conv <- case gtc of Just conv -> do + let creator = gtcCreator conv localMembers <- getLocalMembers (qUnqualified . gtcId $ conv) - pure $ gtcToConv conv (qUnqualified qusr) localMembers + + -- no creator means the conversation has been setup on backend but not on MLS. + case creator of + Nothing -> do + setGlobalTeamConversationCreator conv (qUnqualified qusr) + pure $ globalTeamConvToConversation conv (qUnqualified qusr) localMembers + Just creator' -> + pure $ globalTeamConvToConversation conv creator' localMembers Nothing -> do getConversation (tUnqualified lcnv) >>= noteS @'ConvNotFound @@ -90,29 +123,3 @@ getPendingBackendRemoveProposals gid epoch = do TinyLog.warn $ Log.msg ("found pending proposal without origin, ignoring" :: ByteString) pure Nothing ) - -gtcToConv :: - GlobalTeamConversation -> - UserId -> - [LocalMember] -> - Conversation -gtcToConv gtc usr lm = - let mlsData = gtcMlsMetadata gtc - in Conversation - { convId = qUnqualified $ gtcId gtc, - convLocalMembers = lm, - convRemoteMembers = mempty, - convDeleted = False, - convMetadata = - ConversationMetadata - { cnvmType = GlobalTeamConv, - cnvmCreator = usr, - cnvmAccess = [SelfInviteAccess], - cnvmAccessRoles = mempty, - cnvmName = Just $ gtcName gtc, - cnvmTeam = Just $ gtcTeam gtc, - cnvmMessageTimer = Nothing, - cnvmReceiptMode = Nothing - }, - convProtocol = ProtocolMLS mlsData - } diff --git a/services/galley/src/Galley/API/Query.hs b/services/galley/src/Galley/API/Query.hs index 56bbd626617..8e8a152d068 100644 --- a/services/galley/src/Galley/API/Query.hs +++ b/services/galley/src/Galley/API/Query.hs @@ -52,7 +52,6 @@ import Data.Proxy import Data.Qualified import Data.Range import qualified Data.Set as Set -import Data.Tagged import Galley.API.Error import Galley.API.MLS.Keys import Galley.API.MLS.Types @@ -113,11 +112,7 @@ getBotConversation :: Local ConvId -> Sem r Public.BotConvView getBotConversation zbot lcnv = do - (c, _) <- - getConversationAndMemberWithError - @'ConvNotFound - (qUntagged . qualifyAs lcnv . botUserId $ zbot) - lcnv + (c, _) <- getConversationAndMemberWithError @'ConvNotFound (botUserId zbot) lcnv let domain = tDomain lcnv cmems = mapMaybe (mkMember domain) (toList (Data.convLocalMembers c)) pure $ Public.botConvView (tUnqualified lcnv) (Data.convName c) cmems @@ -149,6 +144,7 @@ getGlobalTeamConversation :: Members '[ ConversationStore, ErrorS 'NotATeamMember, + Error InternalError, MemberStore, TeamStore ] @@ -303,24 +299,12 @@ getConversationRoles lusr cnv = do pure $ Public.ConversationRolesList wireConvRoles conversationIdsPageFromUnqualified :: - Members - [ ListItems LegacyPaging ConvId, - ConversationStore, - MemberStore, - TeamStore - ] - r => + Member (ListItems LegacyPaging ConvId) r => Local UserId -> Maybe ConvId -> Maybe (Range 1 1000 Int32) -> Sem r (Public.ConversationList ConvId) conversationIdsPageFromUnqualified lusr start msize = do - void $ - E.getUserTeams (tUnqualified lusr) >>= \tids -> - runError @InternalError $ - runError @(Tagged 'NotATeamMember ()) - (for_ tids $ \tid -> getGlobalTeamConversation lusr tid) - let size = fromMaybe (toRange (Proxy @1000)) msize ids <- E.listItems (tUnqualified lusr) start size pure $ diff --git a/services/galley/src/Galley/API/Util.hs b/services/galley/src/Galley/API/Util.hs index 4234d409e54..47e1a9182e9 100644 --- a/services/galley/src/Galley/API/Util.hs +++ b/services/galley/src/Galley/API/Util.hs @@ -36,7 +36,6 @@ import Data.Singletons import qualified Data.Text as T import Data.Time import Galley.API.Error -import Galley.API.MLS.Util import Galley.API.Mapping import qualified Galley.Data.Conversation as Data import Galley.Data.Services (BotMember, newBotMember) @@ -509,7 +508,7 @@ getConversationAndCheckMembership uid lcnv = do (conv, _) <- getConversationAndMemberWithError @'ConvAccessDenied - (qUntagged $ qualifyAs lcnv uid) + uid lcnv pure conv @@ -518,27 +517,18 @@ getConversationWithError :: Member (ErrorS 'ConvNotFound) r ) => Local ConvId -> - UserId -> Sem r Data.Conversation -getConversationWithError lcnv uid = - let cid = tUnqualified lcnv - in getConversation cid >>= \case - Just c -> pure c - Nothing -> do - gtc <- noteS @'ConvNotFound =<< getGlobalTeamConversationById lcnv - pure $ gtcToConv gtc uid mempty +getConversationWithError lcnv = + getConversation (tUnqualified lcnv) >>= noteS @'ConvNotFound getConversationAndMemberWithError :: forall e uid mem r. - ( Members '[ConversationStore, ErrorS 'ConvNotFound, ErrorS e] r, - IsConvMemberId uid mem, - uid ~ Qualified UserId - ) => + (Members '[ConversationStore, ErrorS 'ConvNotFound, ErrorS e] r, IsConvMemberId uid mem) => uid -> Local ConvId -> Sem r (Data.Conversation, mem) getConversationAndMemberWithError usr lcnv = do - c <- getConversationWithError lcnv (qUnqualified usr) + c <- getConversationWithError lcnv member <- noteS @e $ getConvMember lcnv c usr pure (c, member) diff --git a/services/galley/src/Galley/Cassandra/Conversation.hs b/services/galley/src/Galley/Cassandra/Conversation.hs index de72cc1264f..d02ecbc473d 100644 --- a/services/galley/src/Galley/Cassandra/Conversation.hs +++ b/services/galley/src/Galley/Cassandra/Conversation.hs @@ -316,6 +316,25 @@ createGlobalTeamConversation tid = do "Global team conversation" (tUnqualified tid) +setGlobalTeamConversationCreator :: + GlobalTeamConversation -> + UserId -> + Client () +setGlobalTeamConversationCreator gtc uid = do + retry x5 . batch $ do + setType BatchLogged + setConsistency LocalQuorum + addPrepQuery + Cql.setGlobalTeamConvCreator + ( uid, + qUnqualified . gtcId $ gtc + ) + addPrepQuery + Cql.insertUserConv + ( uid, + qUnqualified . gtcId $ gtc + ) + -- | "Garbage collect" a 'Conversation', i.e. if the conversation is -- marked as deleted, actually remove it from the database and return -- 'Nothing'. @@ -451,6 +470,7 @@ interpretConversationStoreToCassandra = interpret $ \case GetGlobalTeamConversation tid -> embedClient $ getGlobalTeamConversation tid GetGlobalTeamConversationById lconv -> embedClient $ getGlobalTeamConversationById lconv CreateGlobalTeamConversation tid -> embedClient $ createGlobalTeamConversation tid + SetGlobalTeamConversationCreator gtc uid -> embedClient $ setGlobalTeamConversationCreator gtc uid GetConversationIdByGroupId gId -> embedClient $ lookupGroupId gId GetConversations cids -> localConversations cids GetConversationMetadata cid -> embedClient $ conversationMeta cid diff --git a/services/galley/src/Galley/Effects/ConversationStore.hs b/services/galley/src/Galley/Effects/ConversationStore.hs index f1d9f374951..6c6ac31b08a 100644 --- a/services/galley/src/Galley/Effects/ConversationStore.hs +++ b/services/galley/src/Galley/Effects/ConversationStore.hs @@ -46,6 +46,7 @@ module Galley.Effects.ConversationStore setConversationReceiptMode, setConversationMessageTimer, setConversationEpoch, + setGlobalTeamConversationCreator, acceptConnectConversation, setGroupId, setPublicGroupState, @@ -85,6 +86,7 @@ data ConversationStore m a where GetGlobalTeamConversation :: Local TeamId -> ConversationStore m (Maybe GlobalTeamConversation) GetGlobalTeamConversationById :: Local ConvId -> ConversationStore m (Maybe GlobalTeamConversation) CreateGlobalTeamConversation :: Local TeamId -> ConversationStore m GlobalTeamConversation + SetGlobalTeamConversationCreator :: GlobalTeamConversation -> UserId -> ConversationStore m () GetConversationIdByGroupId :: GroupId -> ConversationStore m (Maybe (Qualified ConvId)) GetConversations :: [ConvId] -> ConversationStore m [Conversation] GetConversationMetadata :: ConvId -> ConversationStore m (Maybe ConversationMetadata) diff --git a/services/galley/test/integration/API/MLS.hs b/services/galley/test/integration/API/MLS.hs index a43c091be36..660ea3b3bfd 100644 --- a/services/galley/test/integration/API/MLS.hs +++ b/services/galley/test/integration/API/MLS.hs @@ -25,7 +25,6 @@ import API.Util as Util import Bilge hiding (head) import Bilge.Assert import Cassandra -import Control.Error.Util (hush) import Control.Lens (view, (^.)) import qualified Control.Monad.State as State import Crypto.Error @@ -202,9 +201,7 @@ tests s = test s "Global team conversation is created on get if not present" (testGetGlobalTeamConv s), test s "Can't leave global team conversation" testGlobalTeamConversationLeave, test s "Send message in global team conversation" testGlobalTeamConversationMessage, - test s "Listing convs includes global team conversation" testConvListIncludesGlobal, - test s "Listing convs includes global team conversation for new users" testConvListIncludesGlobalForNewUsers, - test s "Listing convs before calling GET on global team conversation still includes it" testConvListIncludesGlobalBeforeGet + test s "Listing convs includes global team conversation" testConvListIncludesGlobal ], testGroup "Self conversation" @@ -2227,7 +2224,7 @@ testConvListIncludesGlobal = do let paginationOpts = GetPaginatedConversationIds Nothing (toRange (Proxy @5)) listConvIds alice paginationOpts !!! do const 200 === statusCode - const (Just [globalTeamConv tid]) =/~= (hush . (<$$>) qUnqualified . decodeQualifiedConvIdList) + const (Just [globalTeamConv tid]) =/~= (rightToMaybe . (<$$>) qUnqualified . decodeQualifiedConvIdList) -- add user to conv runMLSTest $ do @@ -2247,39 +2244,10 @@ testConvListIncludesGlobal = do -- Now we should have the user as part of that conversation also in the backend listConvIds alice paginationOpts !!! do const 200 === statusCode - const (Just [globalTeamConv tid]) =~= (hush . (<$$>) qUnqualified . decodeQualifiedConvIdList) + const (Just [globalTeamConv tid]) =~= (rightToMaybe . (<$$>) qUnqualified . decodeQualifiedConvIdList) -testConvListIncludesGlobalBeforeGet :: TestM () -testConvListIncludesGlobalBeforeGet = do - (tid, alice, []) <- Util.createBindingTeamWithMembers 1 - let paginationOpts = GetPaginatedConversationIds Nothing (toRange (Proxy @5)) - listConvIds alice paginationOpts !!! do - const 200 === statusCode - const (Just [globalTeamConv tid]) =/~= (hush . (<$$>) qUnqualified . decodeQualifiedConvIdList) - -testConvListIncludesGlobalForNewUsers :: TestM () -testConvListIncludesGlobalForNewUsers = do - localDomain <- viewFederationDomain - -- c <- view tsCannon - (tid, alice, [bob]) <- Util.createBindingTeamWithMembers 2 - let aliceQ = Qualified alice localDomain - bobQ = Qualified bob localDomain - - runMLSTest $ do - [alice1, bob1] <- traverse createMLSClient [aliceQ, bobQ] - void $ uploadNewKeyPackage bob1 - - void $ setupMLSGroup alice1 - void $ createAddCommit alice1 [bobQ] >>= sendAndConsumeCommitBundle - - let paginationOpts = GetPaginatedConversationIds Nothing (toRange (Proxy @5)) - listConvIds alice paginationOpts !!! do - const 200 === statusCode - const (Just [globalTeamConv tid]) =/~= (hush . (<$$>) qUnqualified . decodeQualifiedConvIdList) - - listConvIds bob paginationOpts !!! do - const 200 === statusCode - const (Just [globalTeamConv tid]) =/~= (hush . (<$$>) qUnqualified . decodeQualifiedConvIdList) +rightToMaybe :: Either a b -> Maybe b +rightToMaybe = either (const Nothing) Just testGlobalTeamConversationMessage :: TestM () testGlobalTeamConversationMessage = do