From ab4ff7b5933a82cf79e0cab01ca6292d43fb4c14 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Tue, 15 Nov 2022 09:43:41 +0100 Subject: [PATCH 01/11] Implement global team conversations --- .../1-api-changes/fs-926-add-global-team-conv | 1 + libs/wire-api/src/Wire/API/Conversation.hs | 22 ++++-- .../src/Wire/API/Conversation/Action.hs | 6 ++ .../src/Wire/API/Conversation/Action/Tag.hs | 2 + .../src/Wire/API/Conversation/Protocol.hs | 1 + .../Wire/API/MLS/GlobalTeamConversation.hs | 54 +++++++++++++ .../API/Routes/Public/Galley/Conversation.hs | 14 ++++ .../src/Wire/API/Routes/Public/Galley/Team.hs | 2 +- libs/wire-api/wire-api.cabal | 1 + services/brig/src/Brig/RPC.hs | 3 + services/brig/test/integration/Util.hs | 2 +- services/galley/src/Galley/API/Action.hs | 39 +++++++--- services/galley/src/Galley/API/Federation.hs | 6 +- services/galley/src/Galley/API/Internal.hs | 38 ++++----- .../src/Galley/API/Public/Conversation.hs | 1 + services/galley/src/Galley/API/Query.hs | 46 +++++++++++ services/galley/src/Galley/API/Teams.hs | 45 +++++++---- .../galley/src/Galley/Cassandra/Access.hs | 1 + .../galley/src/Galley/Cassandra/Client.hs | 5 +- .../src/Galley/Cassandra/Conversation.hs | 57 ++++++++++++++ .../galley/src/Galley/Cassandra/Instances.hs | 4 + .../galley/src/Galley/Cassandra/Queries.hs | 3 + services/galley/src/Galley/Cassandra/Team.hs | 19 ++--- .../galley/src/Galley/Data/Conversation.hs | 4 + .../src/Galley/Effects/ConversationStore.hs | 4 + services/galley/test/integration/API.hs | 3 +- .../galley/test/integration/API/Federation.hs | 2 + services/galley/test/integration/API/MLS.hs | 77 ++++++++++++++++++- services/galley/test/integration/API/Teams.hs | 17 ++-- .../test/integration/API/Teams/Feature.hs | 4 +- services/galley/test/integration/API/Util.hs | 39 ++++++++-- 31 files changed, 438 insertions(+), 84 deletions(-) create mode 100644 changelog.d/1-api-changes/fs-926-add-global-team-conv create mode 100644 libs/wire-api/src/Wire/API/MLS/GlobalTeamConversation.hs diff --git a/changelog.d/1-api-changes/fs-926-add-global-team-conv b/changelog.d/1-api-changes/fs-926-add-global-team-conv new file mode 100644 index 0000000000..85996cd9ec --- /dev/null +++ b/changelog.d/1-api-changes/fs-926-add-global-team-conv @@ -0,0 +1 @@ +Added global conversation type and GET endpoint (`GET /teams/:tid/conversations/global`). diff --git a/libs/wire-api/src/Wire/API/Conversation.hs b/libs/wire-api/src/Wire/API/Conversation.hs index e55df61782..b23282926f 100644 --- a/libs/wire-api/src/Wire/API/Conversation.hs +++ b/libs/wire-api/src/Wire/API/Conversation.hs @@ -25,6 +25,7 @@ module Wire.API.Conversation ConversationMetadata (..), defConversationMetadata, Conversation (..), + conversationMetadataObjectSchema, cnvType, cnvCreator, cnvAccess, @@ -100,7 +101,7 @@ import Data.Aeson (FromJSON (..), ToJSON (..)) import qualified Data.Aeson as A import qualified Data.ByteString.Lazy as LBS import Data.Id -import Data.List.Extra (disjointOrd) +import Data.List.Extra (disjointOrd, enumerate) import Data.List.NonEmpty (NonEmpty) import Data.List1 import Data.Misc @@ -259,8 +260,7 @@ instance ToSchema Conversation where (description ?~ "A conversation object as returned from the server") $ Conversation <$> cnvQualifiedId .= field "qualified_id" schema - <* (qUnqualified . cnvQualifiedId) - .= optional (field "id" (deprecatedSchema "qualified_id" schema)) + <* (qUnqualified . cnvQualifiedId) .= optional (field "id" (deprecatedSchema "qualified_id" schema)) <*> cnvMetadata .= conversationMetadataObjectSchema <*> cnvMembers .= field "members" schema <*> cnvProtocol .= protocolSchema @@ -436,6 +436,10 @@ data Access LinkAccess | -- | User can join knowing [changeable/revokable] code CodeAccess + | -- | In MLS the user can join the global team conversation with their + -- | clients via an external commit, thereby inviting their own clients to + -- | join. + SelfInviteAccess deriving stock (Eq, Ord, Bounded, Enum, Show, Generic) deriving (Arbitrary) via (GenericUniform Access) deriving (ToJSON, FromJSON, S.ToSchema) via Schema Access @@ -448,7 +452,8 @@ instance ToSchema Access where [ element "private" PrivateAccess, element "invite" InviteAccess, element "link" LinkAccess, - element "code" CodeAccess + element "code" CodeAccess, + element "self_invite" SelfInviteAccess ] typeAccess :: Doc.DataType @@ -496,6 +501,7 @@ defRole = activatedAccessRole maybeRole :: ConvType -> Maybe (Set AccessRoleV2) -> Set AccessRoleV2 maybeRole SelfConv _ = privateAccessRole +maybeRole GlobalTeamConv _ = teamAccessRole maybeRole ConnectConv _ = privateAccessRole maybeRole One2OneConv _ = privateAccessRole maybeRole RegularConv Nothing = defRole @@ -578,7 +584,8 @@ data ConvType | SelfConv | One2OneConv | ConnectConv - deriving stock (Eq, Show, Generic) + | GlobalTeamConv + deriving stock (Eq, Show, Generic, Enum, Bounded) deriving (Arbitrary) via (GenericUniform ConvType) deriving (FromJSON, ToJSON, S.ToSchema) via Schema ConvType @@ -589,11 +596,12 @@ instance ToSchema ConvType where [ element 0 RegularConv, element 1 SelfConv, element 2 One2OneConv, - element 3 ConnectConv + element 3 ConnectConv, + element 4 GlobalTeamConv ] typeConversationType :: Doc.DataType -typeConversationType = Doc.int32 $ Doc.enum [0, 1, 2, 3] +typeConversationType = Doc.int32 $ Doc.enum $ fromIntegral . fromEnum <$> enumerate @ConvType -- | Define whether receipts should be sent in the given conversation -- This datatype is defined as an int32 but the Backend does not diff --git a/libs/wire-api/src/Wire/API/Conversation/Action.hs b/libs/wire-api/src/Wire/API/Conversation/Action.hs index 2d92ec4365..b4a4124d22 100644 --- a/libs/wire-api/src/Wire/API/Conversation/Action.hs +++ b/libs/wire-api/src/Wire/API/Conversation/Action.hs @@ -47,12 +47,14 @@ import Wire.API.Conversation import Wire.API.Conversation.Action.Tag import Wire.API.Conversation.Role import Wire.API.Event.Conversation +import Wire.API.MLS.GlobalTeamConversation (GlobalTeamConversation) import Wire.Arbitrary (Arbitrary (..)) -- | We use this type family instead of a sum type to be able to define -- individual effects per conversation action. See 'HasConversationActionEffects'. type family ConversationAction (tag :: ConversationActionTag) :: * where ConversationAction 'ConversationJoinTag = ConversationJoin + ConversationAction 'ConversationSelfInviteTag = GlobalTeamConversation ConversationAction 'ConversationLeaveTag = () ConversationAction 'ConversationMemberUpdateTag = ConversationMemberUpdate ConversationAction 'ConversationDeleteTag = () @@ -103,6 +105,7 @@ conversationActionSchema SConversationRenameTag = schema conversationActionSchema SConversationMessageTimerUpdateTag = schema conversationActionSchema SConversationReceiptModeUpdateTag = schema conversationActionSchema SConversationAccessDataTag = schema +conversationActionSchema SConversationSelfInviteTag = schema instance FromJSON SomeConversationAction where parseJSON = A.withObject "SomeConversationAction" $ \ob -> do @@ -150,6 +153,9 @@ conversationActionToEvent tag now quid qcnv action = SConversationJoinTag -> let ConversationJoin newMembers role = action in EdMembersJoin $ SimpleMembers (map (`SimpleMember` role) (toList newMembers)) + SConversationSelfInviteTag -> + -- this event will not be sent anyway so this is a dummy event + EdMembersJoin $ SimpleMembers [] SConversationLeaveTag -> EdMembersLeave (QualifiedUserIdList [quid]) SConversationRemoveMembersTag -> diff --git a/libs/wire-api/src/Wire/API/Conversation/Action/Tag.hs b/libs/wire-api/src/Wire/API/Conversation/Action/Tag.hs index 3445e3794f..3b0c782c37 100644 --- a/libs/wire-api/src/Wire/API/Conversation/Action/Tag.hs +++ b/libs/wire-api/src/Wire/API/Conversation/Action/Tag.hs @@ -30,6 +30,7 @@ import Wire.Arbitrary (Arbitrary (..)) data ConversationActionTag = ConversationJoinTag + | ConversationSelfInviteTag | ConversationLeaveTag | ConversationRemoveMembersTag | ConversationMemberUpdateTag @@ -48,6 +49,7 @@ instance ToSchema ConversationActionTag where enum @Text "ConversationActionTag" $ mconcat [ element "ConversationJoinTag" ConversationJoinTag, + element "ConversationSelfInviteTag" ConversationSelfInviteTag, element "ConversationLeaveTag" ConversationLeaveTag, element "ConversationRemoveMembersTag" ConversationRemoveMembersTag, element "ConversationMemberUpdateTag" ConversationMemberUpdateTag, diff --git a/libs/wire-api/src/Wire/API/Conversation/Protocol.hs b/libs/wire-api/src/Wire/API/Conversation/Protocol.hs index 30ca0b6591..d580e5be88 100644 --- a/libs/wire-api/src/Wire/API/Conversation/Protocol.hs +++ b/libs/wire-api/src/Wire/API/Conversation/Protocol.hs @@ -28,6 +28,7 @@ module Wire.API.Conversation.Protocol _ProtocolMLS, _ProtocolProteus, protocolSchema, + mlsDataSchema, ConversationMLSData (..), ) where diff --git a/libs/wire-api/src/Wire/API/MLS/GlobalTeamConversation.hs b/libs/wire-api/src/Wire/API/MLS/GlobalTeamConversation.hs new file mode 100644 index 0000000000..c15feb1093 --- /dev/null +++ b/libs/wire-api/src/Wire/API/MLS/GlobalTeamConversation.hs @@ -0,0 +1,54 @@ +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2022 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 Wire.API.MLS.GlobalTeamConversation where + +import Control.Lens ((?~)) +import Data.Aeson (FromJSON, ToJSON) +import Data.Id +import Data.Qualified +import Data.Schema +import qualified Data.Swagger as S +import Imports +import Wire.API.Conversation +import Wire.API.Conversation.Protocol +import Wire.Arbitrary (Arbitrary (..), GenericUniform (..)) + +-- | Public-facing global team conversation. +-- Membership is implicit. Every member of a team is part of it. +-- Protocol is also implicit: it's always MLS. +data GlobalTeamConversation = GlobalTeamConversation + { gtcId :: Qualified ConvId, + gtcMetadata :: ConversationMetadata, + gtcMlsMetadata :: ConversationMLSData + } + deriving stock (Eq, Show, Generic) + deriving (Arbitrary) via (GenericUniform GlobalTeamConversation) + deriving (FromJSON, ToJSON, S.ToSchema) via Schema GlobalTeamConversation + +instance ToSchema GlobalTeamConversation where + schema = + objectWithDocModifier + "GlobalTeamConversation" + (description ?~ "The global team conversation object as returned from the server") + $ GlobalTeamConversation + <$> gtcId + .= field "id" schema + <*> gtcMetadata + .= conversationMetadataObjectSchema + <*> gtcMlsMetadata + .= mlsDataSchema diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Galley/Conversation.hs b/libs/wire-api/src/Wire/API/Routes/Public/Galley/Conversation.hs index 7e945ea4c5..b5c489f34c 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Galley/Conversation.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Galley/Conversation.hs @@ -29,6 +29,7 @@ import Wire.API.Conversation.Role import Wire.API.Error import Wire.API.Error.Galley import Wire.API.Event.Conversation +import Wire.API.MLS.GlobalTeamConversation import Wire.API.MLS.PublicGroupState import Wire.API.MLS.Servant import Wire.API.Routes.MultiVerb @@ -114,6 +115,19 @@ type ConversationAPI = :> QualifiedCapture "cnv" ConvId :> Get '[Servant.JSON] Conversation ) + :<|> Named + "get-global-team-conversation" + ( Summary "Get the global conversation for a given team ID" + :> CanThrow 'ConvNotFound + :> CanThrow 'NotATeamMember + :> ZLocalUser + :> ZClient + :> "teams" + :> Capture "tid" TeamId + :> "conversations" + :> "global" + :> Get '[Servant.JSON] GlobalTeamConversation + ) :<|> Named "get-conversation-roles" ( Summary "Get existing roles available for the given conversation" diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Galley/Team.hs b/libs/wire-api/src/Wire/API/Routes/Public/Galley/Team.hs index 0a81f55c27..4a8f3924f0 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Galley/Team.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Galley/Team.hs @@ -34,7 +34,7 @@ type TeamAPI = "create-non-binding-team" ( Summary "Create a new non binding team" -- FUTUREWORK: deprecated in https://github.com/wireapp/wire-server/pull/2607 - :> ZUser + :> ZLocalUser :> ZConn :> CanThrow 'NotConnected :> CanThrow 'UserBindingExists diff --git a/libs/wire-api/wire-api.cabal b/libs/wire-api/wire-api.cabal index 75e296c708..05a66ba54c 100644 --- a/libs/wire-api/wire-api.cabal +++ b/libs/wire-api/wire-api.cabal @@ -48,6 +48,7 @@ library Wire.API.MLS.Credential Wire.API.MLS.Epoch Wire.API.MLS.Extension + Wire.API.MLS.GlobalTeamConversation Wire.API.MLS.Group Wire.API.MLS.GroupInfoBundle Wire.API.MLS.KeyPackage diff --git a/services/brig/src/Brig/RPC.hs b/services/brig/src/Brig/RPC.hs index 986ea5725f..bdba711649 100644 --- a/services/brig/src/Brig/RPC.hs +++ b/services/brig/src/Brig/RPC.hs @@ -43,6 +43,9 @@ x3 = limitRetries 3 <> exponentialBackoff 100000 zUser :: UserId -> Request -> Request zUser = header "Z-User" . toByteString' +zClient :: ClientId -> Request -> Request +zClient = header "Z-Client" . toByteString' + remote :: ByteString -> Msg -> Msg remote = field "remote" diff --git a/services/brig/test/integration/Util.hs b/services/brig/test/integration/Util.hs index 4d85118766..7c1bfa38e0 100644 --- a/services/brig/test/integration/Util.hs +++ b/services/brig/test/integration/Util.hs @@ -17,7 +17,7 @@ -- You should have received a copy of the GNU Affero General Public License along -- with this program. If not, see . -- for SES notifications -{-# OPTIONS_GHC -fno-warn-orphans -Wno-deprecations #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} module Util where diff --git a/services/galley/src/Galley/API/Action.hs b/services/galley/src/Galley/API/Action.hs index dcae8353e8..6b11b96302 100644 --- a/services/galley/src/Galley/API/Action.hs +++ b/services/galley/src/Galley/API/Action.hs @@ -96,6 +96,11 @@ import qualified Wire.API.User as User data NoChanges = NoChanges type family HasConversationActionEffects (tag :: ConversationActionTag) r :: Constraint where + HasConversationActionEffects 'ConversationSelfInviteTag r = + Members + '[ ErrorS 'InvalidOperation + ] + r HasConversationActionEffects 'ConversationJoinTag r = Members '[ BrigAccess, @@ -130,6 +135,7 @@ type family HasConversationActionEffects (tag :: ConversationActionTag) r :: Con '[ MemberStore, Error InternalError, Error NoChanges, + ErrorS 'InvalidOperation, ExternalAccess, FederatorAccess, GundeckAccess, @@ -157,6 +163,7 @@ type family HasConversationActionEffects (tag :: ConversationActionTag) r :: Con Error InvalidInput, Error NoChanges, ErrorS 'InvalidTargetAccess, + ErrorS 'InvalidOperation, ErrorS ('ActionDenied 'RemoveConversationMember), ExternalAccess, FederatorAccess, @@ -270,6 +277,13 @@ ensureAllowed tag loc action conv origUser = do -- not a team conv, so one of the other access roles has to allow this. when (Set.null $ cupAccessRoles action Set.\\ Set.fromList [TeamMemberAccessRole]) $ throwS @'InvalidTargetAccess + SConversationSelfInviteTag -> + unless + (convType conv == GlobalTeamConv) + $ throwS @'InvalidOperation + SConversationLeaveTag -> + when (convType conv == GlobalTeamConv) $ + throwS @'InvalidOperation _ -> pure () -- | Returns additional members that resulted from the action (e.g. ConversationJoin) @@ -342,6 +356,8 @@ performAction tag origUser lconv action = do SConversationAccessDataTag -> do (bm, act) <- performConversationAccessData origUser lconv action pure (bm, act) + SConversationSelfInviteTag -> + pure (mempty, action) performConversationJoin :: (HasConversationActionEffects 'ConversationJoinTag r) => @@ -789,16 +805,19 @@ notifyRemoteConversationAction loc rconvUpdate con = do -- leave, but then sends notifications as if the user was removed by someone -- else. kickMember :: - ( Member (Error InternalError) r, - Member ExternalAccess r, - Member FederatorAccess r, - Member GundeckAccess r, - Member ProposalStore r, - Member (Input UTCTime) r, - Member (Input Env) r, - Member MemberStore r, - Member TinyLog r - ) => + Members + '[ Error InternalError, + ErrorS 'InvalidOperation, + ExternalAccess, + FederatorAccess, + GundeckAccess, + ProposalStore, + Input UTCTime, + Input Env, + MemberStore, + TinyLog + ] + r => Qualified UserId -> Local Conversation -> BotsAndMembers -> diff --git a/services/galley/src/Galley/API/Federation.hs b/services/galley/src/Galley/API/Federation.hs index 06f461f911..3ff13aaeb6 100644 --- a/services/galley/src/Galley/API/Federation.hs +++ b/services/galley/src/Galley/API/Federation.hs @@ -279,7 +279,7 @@ onConversationUpdated requestingDomain cu = do SConversationMessageTimerUpdateTag -> pure (Just sca, []) SConversationReceiptModeUpdateTag -> pure (Just sca, []) SConversationAccessDataTag -> pure (Just sca, []) - + SConversationSelfInviteTag -> pure (Nothing, []) -- TODO(elland): Should not happen. Should we throw? unless allUsersArePresent $ P.warn $ Log.field "conversation" (toByteString' (F.cuConvId cu)) @@ -495,6 +495,8 @@ onUserDeleted origDomain udcn = do Public.ConnectConv -> pure () -- The self conv cannot be on a remote backend. Public.SelfConv -> pure () + -- The global team conv cannot be on a remote backend. + Public.GlobalTeamConv -> pure () Public.RegularConv -> do let botsAndMembers = convBotsAndMembers conv removeUser (qualifyAs lc conv) (qUntagged deletedUser) @@ -588,6 +590,8 @@ updateConversation origDomain updateRequest = do @(HasConversationActionGalleyErrors 'ConversationAccessDataTag) . fmap lcuUpdate $ updateLocalConversation @'ConversationAccessDataTag lcnv (qUntagged rusr) Nothing action + SConversationSelfInviteTag -> + throw InvalidOperation where mkResponse = fmap toResponse . runError @GalleyError . runError @NoChanges diff --git a/services/galley/src/Galley/API/Internal.hs b/services/galley/src/Galley/API/Internal.hs index b2e55a7bce..b620ed6c38 100644 --- a/services/galley/src/Galley/API/Internal.hs +++ b/services/galley/src/Galley/API/Internal.hs @@ -303,7 +303,7 @@ type ITeamsAPIBase = Named "get-team-internal" (CanThrow 'TeamNotFound :> Get '[Servant.JSON] TeamData) :<|> Named "create-binding-team" - ( ZUser + ( ZLocalUser :> ReqBody '[Servant.JSON] BindingNewTeam :> MultiVerb1 'PUT @@ -691,28 +691,30 @@ rmUser lusr conn = do let qUser = qUntagged lusr cc <- getConversations ids now <- input - pp <- for cc $ \c -> case Data.convType c of - SelfConv -> pure Nothing - One2OneConv -> deleteMembers (Data.convId c) (UserList [tUnqualified lusr] []) $> Nothing - ConnectConv -> deleteMembers (Data.convId c) (UserList [tUnqualified lusr] []) $> Nothing - RegularConv - | tUnqualified lusr `isMember` Data.convLocalMembers c -> do + let deleteIfNeeded c = + when (tUnqualified lusr `isMember` Data.convLocalMembers c) $ do runError (removeUser (qualifyAs lusr c) (qUntagged lusr)) >>= \case Left e -> P.err $ Log.msg ("failed to send remove proposal: " <> internalErrorDescription e) Right _ -> pure () deleteMembers (Data.convId c) (UserList [tUnqualified lusr] []) - let e = - Event - (qUntagged (qualifyAs lusr (Data.convId c))) - (qUntagged lusr) - now - (EdMembersLeave (QualifiedUserIdList [qUser])) for_ (bucketRemote (fmap rmId (Data.convRemoteMembers c))) $ notifyRemoteMembers now qUser (Data.convId c) - pure $ - Intra.newPushLocal ListComplete (tUnqualified lusr) (Intra.ConvEvent e) (Intra.recipient <$> Data.convLocalMembers c) - <&> set Intra.pushConn conn - . set Intra.pushRoute Intra.RouteDirect - | otherwise -> pure Nothing + fireEvent c = + let e = + Event + (qUntagged (qualifyAs lusr (Data.convId c))) + (qUntagged lusr) + now + (EdMembersLeave (QualifiedUserIdList [qUser])) + in pure $ + Intra.newPushLocal ListComplete (tUnqualified lusr) (Intra.ConvEvent e) (Intra.recipient <$> Data.convLocalMembers c) + <&> set Intra.pushConn conn + . set Intra.pushRoute Intra.RouteDirect + pp <- for cc $ \c -> case Data.convType c of + SelfConv -> pure Nothing + One2OneConv -> deleteMembers (Data.convId c) (UserList [tUnqualified lusr] []) $> Nothing + ConnectConv -> deleteMembers (Data.convId c) (UserList [tUnqualified lusr] []) $> Nothing + RegularConv -> deleteIfNeeded c >> fireEvent c + GlobalTeamConv -> deleteIfNeeded c >> pure Nothing for_ (maybeList1 (catMaybes pp)) diff --git a/services/galley/src/Galley/API/Public/Conversation.hs b/services/galley/src/Galley/API/Public/Conversation.hs index 8e7d0ab959..c69d977771 100644 --- a/services/galley/src/Galley/API/Public/Conversation.hs +++ b/services/galley/src/Galley/API/Public/Conversation.hs @@ -31,6 +31,7 @@ conversationAPI = mkNamedAPI @"get-unqualified-conversation" getUnqualifiedConversation <@> mkNamedAPI @"get-unqualified-conversation-legalhold-alias" getUnqualifiedConversation <@> mkNamedAPI @"get-conversation" getConversation + <@> mkNamedAPI @"get-global-team-conversation" getGlobalTeamConversation <@> mkNamedAPI @"get-conversation-roles" getConversationRoles <@> mkNamedAPI @"get-group-info" getGroupInfo <@> mkNamedAPI @"list-conversation-ids-unqualified" conversationIdsPageFromUnqualified diff --git a/services/galley/src/Galley/API/Query.hs b/services/galley/src/Galley/API/Query.hs index 8b6b19ca72..31b391eeb2 100644 --- a/services/galley/src/Galley/API/Query.hs +++ b/services/galley/src/Galley/API/Query.hs @@ -37,6 +37,7 @@ module Galley.API.Query ( getBotConversationH, getUnqualifiedConversation, getConversation, + getGlobalTeamConversation, getConversationRoles, conversationIdsPageFromUnqualified, conversationIdsPageFrom, @@ -71,6 +72,7 @@ import Galley.API.MLS.Keys import Galley.API.Mapping import qualified Galley.API.Mapping as Mapping import Galley.API.Util +import qualified Galley.Data.Conversation as Conv import qualified Galley.Data.Conversation as Data import Galley.Data.Types (Code (codeConversation)) import Galley.Effects @@ -97,6 +99,7 @@ import qualified System.Logger.Class as Logger import Wire.API.Conversation hiding (Member) import qualified Wire.API.Conversation as Public import Wire.API.Conversation.Code +import Wire.API.Conversation.Protocol import Wire.API.Conversation.Role import qualified Wire.API.Conversation.Role as Public import Wire.API.Error @@ -104,6 +107,8 @@ import Wire.API.Error.Galley import Wire.API.Federation.API import Wire.API.Federation.API.Galley import Wire.API.Federation.Error +import Wire.API.MLS.GlobalTeamConversation +import qualified Wire.API.MLS.GlobalTeamConversation as Public import qualified Wire.API.Provider.Bot as Public import qualified Wire.API.Routes.MultiTablePaging as Public import Wire.API.Team.Feature as Public hiding (setStatus) @@ -151,6 +156,47 @@ getUnqualifiedConversation lusr cnv = do c <- getConversationAndCheckMembership (tUnqualified lusr) (qualifyAs lusr cnv) Mapping.conversationView lusr c +getGlobalTeamConversation :: + Members + '[ ConversationStore, + ErrorS 'NotATeamMember, + Error InternalError, + MemberStore, + TeamStore + ] + r => + Local UserId -> + ClientId -> + TeamId -> + Sem r Public.GlobalTeamConversation +getGlobalTeamConversation lusr cid tid = do + let uid = tUnqualified lusr + void $ noteS @'NotATeamMember =<< E.getTeamMember tid (tUnqualified lusr) + E.getGlobalTeamConversation tid >>= \case + Nothing -> do + conv <- E.createGlobalTeamConversation (qualifyAs lusr tid) uid + mlsData <- case Conv.convProtocol conv of + ProtocolMLS mls -> pure mls + ProtocolProteus -> throw (InternalErrorWithDescription "Wrong protocol, expected MLS, got Proteus.") + -- FUTUREWORK: remove this. we are planning to remove the need for a nullKeyPackageRef + let convId = Conv.convId conv + lconv = qualifyAs lusr convId + E.addMLSClients lconv (qUntagged lusr) (Set.singleton (cid, nullKeyPackageRef)) + pure $ + GlobalTeamConversation + (qUntagged lconv) + (Conv.convMetadata conv) + mlsData + Just conv -> do + mlsData <- case Conv.convProtocol conv of + ProtocolMLS mls -> pure mls + ProtocolProteus -> throw (InternalErrorWithDescription "Wrong protocol, expected MLS, got Proteus.") + pure $ + GlobalTeamConversation + (qUntagged . qualifyAs lusr $ Conv.convId conv) + (Conv.convMetadata conv) + mlsData + getConversation :: forall r. Members diff --git a/services/galley/src/Galley/API/Teams.hs b/services/galley/src/Galley/API/Teams.hs index 7e79d38213..2f44cc4be2 100644 --- a/services/galley/src/Galley/API/Teams.hs +++ b/services/galley/src/Galley/API/Teams.hs @@ -219,21 +219,25 @@ lookupTeam zusr tid = do else pure Nothing createNonBindingTeamH :: - forall r. - ( Member BrigAccess r, - Member (ErrorS 'UserBindingExists) r, - Member (ErrorS 'NotConnected) r, - Member GundeckAccess r, - Member (Input UTCTime) r, - Member P.TinyLog r, - Member TeamStore r, - Member WaiRoutes r - ) => - UserId -> + Members + '[ ConversationStore, + ErrorS 'NotConnected, + ErrorS 'UserBindingExists, + GundeckAccess, + Input UTCTime, + MemberStore, + P.TinyLog, + TeamStore, + WaiRoutes, + BrigAccess + ] + r => + Local UserId -> ConnId -> Public.NonBindingNewTeam -> Sem r TeamId -createNonBindingTeamH zusr zcon (Public.NonBindingNewTeam body) = do +createNonBindingTeamH lusr zcon (Public.NonBindingNewTeam body) = do + let zusr = tUnqualified lusr let owner = Public.mkTeamMember zusr fullPermissions Nothing LH.defUserLegalHoldStatus let others = filter ((zusr /=) . view userId) @@ -254,15 +258,24 @@ createNonBindingTeamH zusr zcon (Public.NonBindingNewTeam body) = do (body ^. newTeamIconKey) NonBinding finishCreateTeam team owner others (Just zcon) - pure (team ^. teamId) + let tid = team ^. teamId + pure tid createBindingTeam :: - Members '[GundeckAccess, Input UTCTime, TeamStore] r => + Members + '[ GundeckAccess, + Input UTCTime, + MemberStore, + TeamStore, + ConversationStore + ] + r => TeamId -> - UserId -> + Local UserId -> BindingNewTeam -> Sem r TeamId -createBindingTeam tid zusr (BindingNewTeam body) = do +createBindingTeam tid lusr (BindingNewTeam body) = do + let zusr = tUnqualified lusr let owner = Public.mkTeamMember zusr fullPermissions Nothing LH.defUserLegalHoldStatus team <- E.createTeam (Just tid) zusr (body ^. newTeamName) (body ^. newTeamIcon) (body ^. newTeamIconKey) Binding diff --git a/services/galley/src/Galley/Cassandra/Access.hs b/services/galley/src/Galley/Cassandra/Access.hs index 05c566bfd1..9357320d95 100644 --- a/services/galley/src/Galley/Cassandra/Access.hs +++ b/services/galley/src/Galley/Cassandra/Access.hs @@ -31,6 +31,7 @@ defAccess SelfConv (Just (Set [])) = [PrivateAccess] defAccess ConnectConv (Just (Set [])) = [PrivateAccess] defAccess One2OneConv (Just (Set [])) = [PrivateAccess] defAccess RegularConv (Just (Set [])) = defRegularConvAccess +defAccess GlobalTeamConv s = maybe [SelfInviteAccess] fromSet s defAccess _ (Just (Set (x : xs))) = x : xs privateOnly :: Set Access diff --git a/services/galley/src/Galley/Cassandra/Client.hs b/services/galley/src/Galley/Cassandra/Client.hs index 25fb2a44d2..2b7f1c4d9a 100644 --- a/services/galley/src/Galley/Cassandra/Client.hs +++ b/services/galley/src/Galley/Cassandra/Client.hs @@ -40,9 +40,10 @@ import Polysemy.Input import qualified UnliftIO updateClient :: Bool -> UserId -> ClientId -> Client () -updateClient add usr cls = do +updateClient add usr cid = do + -- add or remove client let q = if add then Cql.addMemberClient else Cql.rmMemberClient - retry x5 $ write (q cls) (params LocalQuorum (Identity usr)) + retry x5 $ write (q cid) (params LocalQuorum (Identity usr)) -- Do, at most, 16 parallel lookups of up to 128 users each lookupClients :: [UserId] -> Client Clients diff --git a/services/galley/src/Galley/Cassandra/Conversation.hs b/services/galley/src/Galley/Cassandra/Conversation.hs index 9c670a017c..17ed2afde1 100644 --- a/services/galley/src/Galley/Cassandra/Conversation.hs +++ b/services/galley/src/Galley/Cassandra/Conversation.hs @@ -249,6 +249,61 @@ getConversation conv = do <*> UnliftIO.wait cdata runMaybeT $ conversationGC =<< maybe mzero pure mbConv +getGlobalTeamConversation :: TeamId -> Client (Maybe Conversation) +getGlobalTeamConversation tid = + (\c -> c {convLocalMembers = [], convRemoteMembers = []}) + <$$> getConversation (globalTeamConv tid) + +createGlobalTeamConversation :: + Local TeamId -> + UserId -> + Client Conversation +createGlobalTeamConversation tid uid = do + let lconv = qualifyAs tid (globalTeamConv $ tUnqualified tid) + meta = + ConversationMetadata + { cnvmType = GlobalTeamConv, + cnvmCreator = uid, + cnvmAccess = [SelfInviteAccess], + cnvmAccessRoles = mempty, + cnvmName = Just "Global team conversation", + cnvmTeam = Just (tUnqualified tid), + cnvmMessageTimer = Nothing, + cnvmReceiptMode = Nothing + } + gid = convToGroupId lconv + cs = MLS_128_DHKEMX25519_AES128GCM_SHA256_Ed25519 + proto = + ProtocolMLS + ( ConversationMLSData + gid + (Epoch 0) + cs + ) + retry x5 . batch $ do + setType BatchLogged + setConsistency LocalQuorum + addPrepQuery + Cql.insertGlobalTeamConv + ( tUnqualified lconv, + Cql.Set (cnvmAccess meta), + cnvmName meta, + cnvmTeam meta, + Just gid, + Just cs + ) + addPrepQuery Cql.insertTeamConv (tUnqualified tid, tUnqualified lconv) + addPrepQuery Cql.insertGroupId (gid, tUnqualified lconv, tDomain lconv) + pure + Conversation + { convId = tUnqualified lconv, + convLocalMembers = mempty, + convRemoteMembers = mempty, + convDeleted = False, + convMetadata = meta, + convProtocol = proto + } + -- | "Garbage collect" a 'Conversation', i.e. if the conversation is -- marked as deleted, actually remove it from the database and return -- 'Nothing'. @@ -380,6 +435,8 @@ interpretConversationStoreToCassandra = interpret $ \case CreateConversation loc nc -> embedClient $ createConversation loc nc CreateMLSSelfConversation lusr -> embedClient $ createMLSSelfConversation lusr GetConversation cid -> embedClient $ getConversation cid + GetGlobalTeamConversation tid -> embedClient $ getGlobalTeamConversation tid + CreateGlobalTeamConversation tid uid -> embedClient $ createGlobalTeamConversation tid uid GetConversationIdByGroupId gId -> embedClient $ lookupGroupId gId GetConversations cids -> localConversations cids GetConversationMetadata cid -> embedClient $ conversationMeta cid diff --git a/services/galley/src/Galley/Cassandra/Instances.hs b/services/galley/src/Galley/Cassandra/Instances.hs index 1c4c5aaa40..e9e9764561 100644 --- a/services/galley/src/Galley/Cassandra/Instances.hs +++ b/services/galley/src/Galley/Cassandra/Instances.hs @@ -56,12 +56,14 @@ instance Cql ConvType where toCql SelfConv = CqlInt 1 toCql One2OneConv = CqlInt 2 toCql ConnectConv = CqlInt 3 + toCql GlobalTeamConv = CqlInt 4 fromCql (CqlInt i) = case i of 0 -> pure RegularConv 1 -> pure SelfConv 2 -> pure One2OneConv 3 -> pure ConnectConv + 4 -> pure GlobalTeamConv n -> Left $ "unexpected conversation-type: " ++ show n fromCql _ = Left "conv-type: int expected" @@ -72,12 +74,14 @@ instance Cql Access where toCql InviteAccess = CqlInt 2 toCql LinkAccess = CqlInt 3 toCql CodeAccess = CqlInt 4 + toCql SelfInviteAccess = CqlInt 5 fromCql (CqlInt i) = case i of 1 -> pure PrivateAccess 2 -> pure InviteAccess 3 -> pure LinkAccess 4 -> pure CodeAccess + 5 -> pure SelfInviteAccess n -> Left $ "Unexpected Access value: " ++ show n fromCql _ = Left "Access value: int expected" diff --git a/services/galley/src/Galley/Cassandra/Queries.hs b/services/galley/src/Galley/Cassandra/Queries.hs index 4ba7f3b76f..0631fd2962 100644 --- a/services/galley/src/Galley/Cassandra/Queries.hs +++ b/services/galley/src/Galley/Cassandra/Queries.hs @@ -235,6 +235,9 @@ insertMLSSelfConv = <> show (fromEnum ProtocolMLSTag) <> ", ?, ?)" +insertGlobalTeamConv :: PrepQuery W (ConvId, C.Set Access, Maybe Text, Maybe TeamId, Maybe GroupId, Maybe CipherSuiteTag) () +insertGlobalTeamConv = "insert into conversation (conv, type, access, name, team, group_id, cipher_suite) values (?, 4, ?, ?, ?, ?, ?)" + updateConvAccess :: PrepQuery W (C.Set Access, C.Set AccessRoleV2, ConvId) () updateConvAccess = "update conversation set access = ?, access_roles_v2 = ? where conv = ?" diff --git a/services/galley/src/Galley/Cassandra/Team.hs b/services/galley/src/Galley/Cassandra/Team.hs index 1dc85be7a7..52d900f45f 100644 --- a/services/galley/src/Galley/Cassandra/Team.hs +++ b/services/galley/src/Galley/Cassandra/Team.hs @@ -14,6 +14,7 @@ -- -- You should have received a copy of the GNU Affero General Public License along -- with this program. If not, see . +{-# LANGUAGE LambdaCase #-} module Galley.Cassandra.Team ( interpretTeamStoreToCassandra, @@ -157,23 +158,23 @@ createTeam t uid (fromRange -> n) i k b = do listBillingTeamMembers :: TeamId -> Client [UserId] listBillingTeamMembers tid = - fmap runIdentity - <$> retry x1 (query Cql.listBillingTeamMembers (params LocalQuorum (Identity tid))) + runIdentity + <$$> retry x1 (query Cql.listBillingTeamMembers (params LocalQuorum (Identity tid))) getTeamName :: TeamId -> Client (Maybe Text) getTeamName tid = - fmap runIdentity - <$> retry x1 (query1 Cql.selectTeamName (params LocalQuorum (Identity tid))) + runIdentity + <$$> retry x1 (query1 Cql.selectTeamName (params LocalQuorum (Identity tid))) teamConversation :: TeamId -> ConvId -> Client (Maybe TeamConversation) teamConversation t c = - fmap (newTeamConversation . runIdentity) - <$> retry x1 (query1 Cql.selectTeamConv (params LocalQuorum (t, c))) + newTeamConversation . runIdentity + <$$> retry x1 (query1 Cql.selectTeamConv (params LocalQuorum (t, c))) getTeamConversations :: TeamId -> Client [TeamConversation] getTeamConversations t = - map (newTeamConversation . runIdentity) - <$> retry x1 (query Cql.selectTeamConvs (params LocalQuorum (Identity t))) + newTeamConversation . runIdentity + <$$> retry x1 (query Cql.selectTeamConvs (params LocalQuorum (Identity t))) teamIdsFrom :: UserId -> Maybe TeamId -> Range 1 100 Int32 -> Client (ResultSet TeamId) teamIdsFrom usr range (fromRange -> max) = @@ -185,7 +186,7 @@ teamIdsFrom usr range (fromRange -> max) = teamIdsForPagination :: UserId -> Maybe TeamId -> Range 1 100 Int32 -> Client (Page TeamId) teamIdsForPagination usr range (fromRange -> max) = - fmap runIdentity <$> case range of + runIdentity <$$> case range of Just c -> paginate Cql.selectUserTeamsFrom (paramsP LocalQuorum (usr, c) max) Nothing -> paginate Cql.selectUserTeams (paramsP LocalQuorum (Identity usr) max) diff --git a/services/galley/src/Galley/Data/Conversation.hs b/services/galley/src/Galley/Data/Conversation.hs index 71f3dcd5ac..3f83ecc9da 100644 --- a/services/galley/src/Galley/Data/Conversation.hs +++ b/services/galley/src/Galley/Data/Conversation.hs @@ -23,6 +23,7 @@ module Galley.Data.Conversation -- * Utilities isConvDeleted, selfConv, + globalTeamConv, localOne2OneConvId, convAccess, convAccessData, @@ -58,6 +59,9 @@ isConvDeleted = convDeleted selfConv :: UserId -> ConvId selfConv uid = Id (toUUID uid) +globalTeamConv :: TeamId -> ConvId +globalTeamConv tid = Id (toUUID tid) + -- | We deduce the conversation ID by adding the 4 components of the V4 UUID -- together pairwise, and then setting the version bits (v4) and variant bits -- (variant 2). This means that we always know what the UUID is for a diff --git a/services/galley/src/Galley/Effects/ConversationStore.hs b/services/galley/src/Galley/Effects/ConversationStore.hs index 1660c2f689..53bcfededf 100644 --- a/services/galley/src/Galley/Effects/ConversationStore.hs +++ b/services/galley/src/Galley/Effects/ConversationStore.hs @@ -28,6 +28,8 @@ module Galley.Effects.ConversationStore -- * Read conversation getConversation, + getGlobalTeamConversation, + createGlobalTeamConversation, getConversationIdByGroupId, getConversations, getConversationMetadata, @@ -78,6 +80,8 @@ data ConversationStore m a where ConversationStore m Conversation DeleteConversation :: ConvId -> ConversationStore m () GetConversation :: ConvId -> ConversationStore m (Maybe Conversation) + GetGlobalTeamConversation :: TeamId -> ConversationStore m (Maybe Conversation) + CreateGlobalTeamConversation :: Local TeamId -> UserId -> ConversationStore m Conversation 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.hs b/services/galley/test/integration/API.hs index 3f30b17bed..9f1e8ac539 100644 --- a/services/galley/test/integration/API.hs +++ b/services/galley/test/integration/API.hs @@ -3837,7 +3837,8 @@ testOne2OneConversationRequest shouldBeLocal actor desired = do let req = UpsertOne2OneConversationRequest alice bob actor desired Nothing res <- iUpsertOne2OneConversation req - responseJsonError res liftIO $ convId @?= expectedConvId diff --git a/services/galley/test/integration/API/Federation.hs b/services/galley/test/integration/API/Federation.hs index 89ef4c2ebd..3a186a9a56 100644 --- a/services/galley/test/integration/API/Federation.hs +++ b/services/galley/test/integration/API/Federation.hs @@ -1150,3 +1150,5 @@ getConvAction tquery (SomeConversationAction tag action) = (SConversationAccessDataTag, _) -> Nothing (SConversationRemoveMembersTag, SConversationRemoveMembersTag) -> Just action (SConversationRemoveMembersTag, _) -> Nothing + (SConversationSelfInviteTag, SConversationSelfInviteTag) -> Just action + (SConversationSelfInviteTag, _) -> Nothing diff --git a/services/galley/test/integration/API/MLS.hs b/services/galley/test/integration/API/MLS.hs index 5de91f2a38..fb779276a3 100644 --- a/services/galley/test/integration/API/MLS.hs +++ b/services/galley/test/integration/API/MLS.hs @@ -20,11 +20,12 @@ module API.MLS (tests) where import API.MLS.Util -import API.Util +import API.SQS +import API.Util as Util import Bilge hiding (head) import Bilge.Assert import Cassandra -import Control.Lens (view) +import Control.Lens (view, (^.)) import qualified Control.Monad.State as State import Crypto.Error import qualified Crypto.PubKey.Ed25519 as Ed25519 @@ -45,6 +46,8 @@ import Data.String.Conversions import qualified Data.Text as T import Data.Time import Federator.MockServer hiding (withTempMockFederator) +import Galley.Data.Conversation +import Galley.Options import Imports import qualified Network.Wai.Utilities.Error as Wai import Test.QuickCheck (Arbitrary (arbitrary), generate) @@ -61,11 +64,15 @@ import Wire.API.Conversation.Role import Wire.API.Error.Galley import Wire.API.Federation.API.Common import Wire.API.Federation.API.Galley +import Wire.API.MLS.CipherSuite import Wire.API.MLS.Credential +import Wire.API.MLS.GlobalTeamConversation +import Wire.API.MLS.Group import Wire.API.MLS.Keys import Wire.API.MLS.Serialisation import Wire.API.MLS.Welcome import Wire.API.Message +import Wire.API.Team (teamCreator) import Wire.API.User.Client tests :: IO TestSetup -> TestTree @@ -186,6 +193,12 @@ tests s = test s "add user with a commit bundle to a remote conversation" testAddUserToRemoteConvWithBundle, test s "remote user posts commit bundle" testRemoteUserPostsCommitBundle ], + testGroup + "GlobalTeamConv" + [ test s "Non-existing team returns 403" testGetGlobalTeamConvNonExistant, + test s "Non member of team returns 403" testGetGlobalTeamConvNonMember, + test s "Global team conversation is created on get if not present" (testGetGlobalTeamConv s) + ], testGroup "Self conversation" [ test s "create a self conversation" testSelfConversation, @@ -2040,7 +2053,7 @@ testDeleteMLSConv :: TestM () testDeleteMLSConv = do localDomain <- viewFederationDomain -- c <- view tsCannon - (tid, aliceUnq, [bobUnq]) <- API.Util.createBindingTeamWithMembers 2 + (tid, aliceUnq, [bobUnq]) <- Util.createBindingTeamWithMembers 2 let alice = Qualified aliceUnq localDomain bob = Qualified bobUnq localDomain @@ -2139,6 +2152,64 @@ testRemoteUserPostsCommitBundle = do pure () +testGetGlobalTeamConvNonExistant :: TestM () +testGetGlobalTeamConvNonExistant = do + uid <- randomUser + cid <- Util.randomClient uid (head Util.someLastPrekeys) + tid <- randomId + -- authorisation fails b/c not a team member + getGlobalTeamConv uid cid tid !!! const 403 === statusCode + +testGetGlobalTeamConvNonMember :: TestM () +testGetGlobalTeamConvNonMember = do + owner <- randomUser + tid <- createBindingTeamInternal "sample-team" owner + team <- getTeam owner tid + assertQueue "create team" tActivate + liftIO $ assertEqual "owner" owner (team ^. teamCreator) + assertQueueEmpty + + -- authorisation fails b/c not a team member + uid <- randomUser + cid <- Util.randomClient uid (head Util.someLastPrekeys) + getGlobalTeamConv uid cid tid !!! const 403 === statusCode + +testGetGlobalTeamConv :: IO TestSetup -> TestM () +testGetGlobalTeamConv setup = do + owner <- randomUser + tid <- createBindingTeamInternal "sample-team" owner + team <- getTeam owner tid + assertQueue "create team" tActivate + liftIO $ assertEqual "owner" owner (team ^. teamCreator) + assertQueueEmpty + cid <- Util.randomClient owner (head Util.someLastPrekeys) + + s <- liftIO setup + let domain = s ^. tsGConf . optSettings . setFederationDomain + + let response = getGlobalTeamConv owner cid tid response + let convoId = globalTeamConv tid + lconv = toLocalUnsafe domain convoId + expected = + GlobalTeamConversation + (qUntagged lconv) + ( (defConversationMetadata owner) + { cnvmType = GlobalTeamConv, + cnvmAccess = [SelfInviteAccess], + cnvmAccessRoles = mempty, + cnvmName = Just "Global team conversation", + cnvmTeam = Just tid + } + ) + ( ConversationMLSData + (convToGroupId lconv) + (Epoch 0) + MLS_128_DHKEMX25519_AES128GCM_SHA256_Ed25519 + ) + let cm = Aeson.decode rs :: Maybe GlobalTeamConversation + liftIO $ assertEqual "conversation metadata" cm (Just expected) + testSelfConversation :: TestM () testSelfConversation = do alice <- randomQualifiedUser diff --git a/services/galley/test/integration/API/Teams.hs b/services/galley/test/integration/API/Teams.hs index fce7e7f3c3..379d159881 100644 --- a/services/galley/test/integration/API/Teams.hs +++ b/services/galley/test/integration/API/Teams.hs @@ -171,7 +171,7 @@ tests s = [ test s "message" (postCryptoBroadcastMessage bcast), test s "filtered only, too large team" (postCryptoBroadcastMessageFilteredTooLargeTeam bcast), test s "report missing in body" (postCryptoBroadcastMessageReportMissingBody bcast), - test s "redundant/missing" (postCryptoBroadcastMessage2 bcast), + test s "redundant or missing" (postCryptoBroadcastMessage2 bcast), test s "no-team" (postCryptoBroadcastMessageNoTeam bcast), test s "100 (or max conns)" (postCryptoBroadcastMessage100OrMaxConns bcast) ] @@ -192,16 +192,17 @@ testCreateTeam = do testGetTeams :: TestM () testGetTeams = do owner <- Util.randomUser - Util.getTeams owner [] >>= checkTeamList Nothing + let getTeams' = Util.getTeams owner + getTeams' [] >>= checkTeamList Nothing tid <- Util.createBindingTeamInternal "foo" owner <* assertQueue "create team" tActivate wrongTid <- (Util.randomUser >>= Util.createBindingTeamInternal "foobar") <* assertQueue "create team" tActivate - Util.getTeams owner [] >>= checkTeamList (Just tid) - Util.getTeams owner [("size", Just "1")] >>= checkTeamList (Just tid) - Util.getTeams owner [("ids", Just $ toByteString' tid)] >>= checkTeamList (Just tid) - Util.getTeams owner [("ids", Just $ toByteString' tid <> "," <> toByteString' wrongTid)] >>= checkTeamList (Just tid) + getTeams' [] >>= checkTeamList (Just tid) + getTeams' [("size", Just "1")] >>= checkTeamList (Just tid) + getTeams' [("ids", Just $ toByteString' tid)] >>= checkTeamList (Just tid) + getTeams' [("ids", Just $ toByteString' tid <> "," <> toByteString' wrongTid)] >>= checkTeamList (Just tid) -- these two queries do not yield responses that are equivalent to the old wai route API - Util.getTeams owner [("ids", Just $ toByteString' wrongTid)] >>= checkTeamList (Just tid) - Util.getTeams owner [("start", Just $ toByteString' tid)] >>= checkTeamList (Just tid) + getTeams' [("ids", Just $ toByteString' wrongTid)] >>= checkTeamList (Just tid) + getTeams' [("start", Just $ toByteString' tid)] >>= checkTeamList (Just tid) where checkTeamList :: Maybe TeamId -> TeamList -> TestM () checkTeamList mbTid tl = liftIO $ do diff --git a/services/galley/test/integration/API/Teams/Feature.hs b/services/galley/test/integration/API/Teams/Feature.hs index 3df6b0271d..205505d51a 100644 --- a/services/galley/test/integration/API/Teams/Feature.hs +++ b/services/galley/test/integration/API/Teams/Feature.hs @@ -7,7 +7,6 @@ -- 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 @@ -15,6 +14,9 @@ -- -- You should have received a copy of the GNU Affero General Public License along -- with this program. If not, see . +{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} + +{-# HLINT ignore "Use head" #-} module API.Teams.Feature (tests) where diff --git a/services/galley/test/integration/API/Util.hs b/services/galley/test/integration/API/Util.hs index a02b492911..20cba5c4c6 100644 --- a/services/galley/test/integration/API/Util.hs +++ b/services/galley/test/integration/API/Util.hs @@ -15,6 +15,9 @@ -- You should have received a copy of the GNU Affero General Public License along -- with this program. If not, see . {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} +{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} + +{-# HLINT ignore "Use head" #-} module API.Util where @@ -275,9 +278,17 @@ createBindingTeamInternalNoActivate name owner = do tid <- randomId let nt = BindingNewTeam $ newNewTeam (unsafeRange name) DefaultIcon _ <- - put (g . paths ["/i/teams", toByteString' tid] . zUser owner . zConn "conn" . zType "access" . json nt) Text -> UserId -> Currency.Alpha -> TestM TeamId @@ -1018,6 +1029,22 @@ getConv u c = do . zConn "conn" . zType "access" +getGlobalTeamConv :: + (MonadIO m, MonadHttp m, HasGalley m, HasCallStack) => + UserId -> + ClientId -> + TeamId -> + m ResponseLBS +getGlobalTeamConv u cid tid = do + g <- viewGalley + get $ + g + . paths ["teams", toByteString' tid, "conversations", "global"] + . zUser u + . zClient cid + . zConn "conn" + . zType "access" + getConvQualified :: (MonadIO m, MonadHttp m, HasGalley m, HasCallStack) => UserId -> Qualified ConvId -> m ResponseLBS getConvQualified u (Qualified conv domain) = do g <- viewGalley @@ -1842,12 +1869,12 @@ decodeQualifiedConvIdList = fmap mtpResults . responseJsonEither @ConvIdsPage zUser :: UserId -> Request -> Request zUser = header "Z-User" . toByteString' -zBot :: UserId -> Request -> Request -zBot = header "Z-Bot" . toByteString' - zClient :: ClientId -> Request -> Request zClient = header "Z-Client" . toByteString' +zBot :: UserId -> Request -> Request +zBot = header "Z-Bot" . toByteString' + zConn :: ByteString -> Request -> Request zConn = header "Z-Connection" From 4c08c0ca559c90483079a5df49d9e41c6143a39f Mon Sep 17 00:00:00 2001 From: Igor Ranieri Date: Wed, 16 Nov 2022 13:29:24 +0000 Subject: [PATCH 02/11] Implemented create/retrieve for global team conv --- .../src/Wire/API/Conversation/Action.hs | 3 +- .../src/Wire/API/Conversation/Role.hs | 1 + .../Wire/API/MLS/GlobalTeamConversation.hs | 34 ++++- .../brig/test/integration/API/Provider.hs | 14 +- .../brig/test/integration/API/Team/Util.hs | 13 +- services/galley/src/Galley/API/Action.hs | 59 ++++++++- services/galley/src/Galley/API/Internal.hs | 24 ++-- services/galley/src/Galley/API/MLS/Message.hs | 35 ++++- services/galley/src/Galley/API/Query.hs | 34 ++--- services/galley/src/Galley/API/Teams.hs | 3 +- services/galley/src/Galley/API/Util.hs | 2 +- .../src/Galley/Cassandra/Conversation.hs | 121 +++++++++++++----- .../galley/src/Galley/Cassandra/Queries.hs | 40 +++++- .../src/Galley/Effects/ConversationStore.hs | 9 +- services/galley/test/integration/API.hs | 28 +++- services/galley/test/integration/API/MLS.hs | 45 +++++-- services/galley/test/integration/API/Util.hs | 68 +++++++++- 17 files changed, 425 insertions(+), 108 deletions(-) diff --git a/libs/wire-api/src/Wire/API/Conversation/Action.hs b/libs/wire-api/src/Wire/API/Conversation/Action.hs index b4a4124d22..815903cb3e 100644 --- a/libs/wire-api/src/Wire/API/Conversation/Action.hs +++ b/libs/wire-api/src/Wire/API/Conversation/Action.hs @@ -47,14 +47,13 @@ import Wire.API.Conversation import Wire.API.Conversation.Action.Tag import Wire.API.Conversation.Role import Wire.API.Event.Conversation -import Wire.API.MLS.GlobalTeamConversation (GlobalTeamConversation) import Wire.Arbitrary (Arbitrary (..)) -- | We use this type family instead of a sum type to be able to define -- individual effects per conversation action. See 'HasConversationActionEffects'. type family ConversationAction (tag :: ConversationActionTag) :: * where ConversationAction 'ConversationJoinTag = ConversationJoin - ConversationAction 'ConversationSelfInviteTag = GlobalTeamConversation + ConversationAction 'ConversationSelfInviteTag = ConvId ConversationAction 'ConversationLeaveTag = () ConversationAction 'ConversationMemberUpdateTag = ConversationMemberUpdate ConversationAction 'ConversationDeleteTag = () diff --git a/libs/wire-api/src/Wire/API/Conversation/Role.hs b/libs/wire-api/src/Wire/API/Conversation/Role.hs index e215b72db8..1878b99b65 100644 --- a/libs/wire-api/src/Wire/API/Conversation/Role.hs +++ b/libs/wire-api/src/Wire/API/Conversation/Role.hs @@ -36,6 +36,7 @@ module Wire.API.Conversation.Role wireConvRoleNames, roleNameWireAdmin, roleNameWireMember, + roleToRoleName, -- * Action Action (..), diff --git a/libs/wire-api/src/Wire/API/MLS/GlobalTeamConversation.hs b/libs/wire-api/src/Wire/API/MLS/GlobalTeamConversation.hs index c15feb1093..590d1d43f9 100644 --- a/libs/wire-api/src/Wire/API/MLS/GlobalTeamConversation.hs +++ b/libs/wire-api/src/Wire/API/MLS/GlobalTeamConversation.hs @@ -33,7 +33,7 @@ import Wire.Arbitrary (Arbitrary (..), GenericUniform (..)) -- Protocol is also implicit: it's always MLS. data GlobalTeamConversation = GlobalTeamConversation { gtcId :: Qualified ConvId, - gtcMetadata :: ConversationMetadata, + gtcMetadata :: GlobalTeamConversationMetadata, gtcMlsMetadata :: ConversationMLSData } deriving stock (Eq, Show, Generic) @@ -46,9 +46,29 @@ instance ToSchema GlobalTeamConversation where "GlobalTeamConversation" (description ?~ "The global team conversation object as returned from the server") $ GlobalTeamConversation - <$> gtcId - .= field "id" schema - <*> gtcMetadata - .= conversationMetadataObjectSchema - <*> gtcMlsMetadata - .= mlsDataSchema + <$> gtcId .= field "qualified_id" schema + <*> gtcMetadata .= gtcMetadataSchema + <*> gtcMlsMetadata .= mlsDataSchema + +data GlobalTeamConversationMetadata = GlobalTeamConversationMetadata + { gtcmCreator :: Maybe UserId, + gtcmAccess :: [Access], + gtcmName :: Text, + gtcmTeam :: TeamId + } + deriving stock (Eq, Show, Generic) + deriving (Arbitrary) via (GenericUniform GlobalTeamConversationMetadata) + +gtcMetadataSchema :: ObjectSchema SwaggerDoc GlobalTeamConversationMetadata +gtcMetadataSchema = + GlobalTeamConversationMetadata + <$> gtcmCreator + .= maybe_ + ( optFieldWithDocModifier + "creator" + (description ?~ "The creator's user ID") + schema + ) + <*> gtcmAccess .= field "access" (array schema) + <*> gtcmName .= field "name" schema + <*> gtcmTeam .= field "team" schema diff --git a/services/brig/test/integration/API/Provider.hs b/services/brig/test/integration/API/Provider.hs index 1449ce29c5..aa05c55d7d 100644 --- a/services/brig/test/integration/API/Provider.hs +++ b/services/brig/test/integration/API/Provider.hs @@ -1328,7 +1328,19 @@ createConvWithAccessRoles ars g u us = . contentJson . body (RequestBodyLBS (encode conv)) where - conv = NewConv us [] Nothing Set.empty ars Nothing Nothing Nothing roleNameWireAdmin ProtocolProteusTag Nothing + conv = + NewConv + us + [] + Nothing + Set.empty + ars + Nothing + Nothing + Nothing + roleNameWireAdmin + ProtocolProteusTag + Nothing postMessage :: Galley -> diff --git a/services/brig/test/integration/API/Team/Util.hs b/services/brig/test/integration/API/Team/Util.hs index bc55820c78..36c273f625 100644 --- a/services/brig/test/integration/API/Team/Util.hs +++ b/services/brig/test/integration/API/Team/Util.hs @@ -217,7 +217,18 @@ createTeamConv :: HasCallStack => Galley -> TeamId -> UserId -> [UserId] -> Mayb createTeamConv g tid u us mtimer = do let tinfo = Just $ ConvTeamInfo tid let conv = - NewConv us [] Nothing (Set.fromList []) Nothing tinfo mtimer Nothing roleNameWireAdmin ProtocolProteusTag Nothing + NewConv + us + [] + Nothing + (Set.fromList []) + Nothing + tinfo + mtimer + Nothing + roleNameWireAdmin + ProtocolProteusTag + Nothing r <- post ( g diff --git a/services/galley/src/Galley/API/Action.hs b/services/galley/src/Galley/API/Action.hs index 6b11b96302..f38b98dfb8 100644 --- a/services/galley/src/Galley/API/Action.hs +++ b/services/galley/src/Galley/API/Action.hs @@ -89,6 +89,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 @@ -282,7 +283,7 @@ ensureAllowed tag loc action conv origUser = do (convType conv == GlobalTeamConv) $ throwS @'InvalidOperation SConversationLeaveTag -> - when (convType conv == GlobalTeamConv) $ + when (convType conv == GlobalTeamConv) $ do throwS @'InvalidOperation _ -> pure () @@ -595,7 +596,17 @@ updateLocalConversation lcnv qusr con action = do let tag = sing @tag -- retrieve conversation - conv <- getConversationWithError lcnv + conv <- do + -- Check if global or not, if global, map it to conversation + E.getGlobalTeamConversationById lcnv >>= \case + Just gtc -> + let c = (gtcmCreator . gtcMetadata $ gtc) + in case c of + Nothing -> + throwS @'ConvNotFound + Just creator -> + pure $ gtcToConv creator gtc + Nothing -> getConversationWithError lcnv -- check that the action does not bypass the underlying protocol unless (protocolValidAction (convProtocol conv) (fromSing tag)) $ @@ -603,6 +614,27 @@ updateLocalConversation lcnv qusr con action = do -- perform all authorisation checks and, if successful, the update itself updateLocalConversationUnchecked @tag (qualifyAs lcnv conv) qusr con action + where + gtcToConv creator gtc = + let meta = gtcMetadata gtc + in Conversation + { convId = qUnqualified $ gtcId gtc, + convLocalMembers = mempty, + convRemoteMembers = mempty, + convDeleted = False, + convMetadata = + ConversationMetadata + { cnvmType = GlobalTeamConv, + cnvmCreator = creator, + cnvmAccess = [SelfInviteAccess], + cnvmAccessRoles = mempty, + cnvmName = Just $ gtcmName meta, + cnvmTeam = Just $ gtcmTeam meta, + cnvmMessageTimer = Nothing, + cnvmReceiptMode = Nothing + }, + convProtocol = ProtocolMLS (gtcMlsMetadata gtc) + } -- | Similar to 'updateLocalConversationWithLocalUser', but takes a -- 'Conversation' value directly, instead of a 'ConvId', and skips protocol @@ -634,7 +666,26 @@ updateLocalConversationUnchecked lconv qusr con action = do conv = tUnqualified lconv -- retrieve member - self <- noteS @'ConvNotFound $ getConvMember lconv conv qusr + self <- + if (cnvmType . convMetadata . tUnqualified $ lconv) == GlobalTeamConv + then + -- TODO(elland): address this problem + pure . Left $ + LocalMember + { lmId = qUnqualified qusr, + lmStatus = + MemberStatus + { msOtrMutedStatus = Nothing, + msOtrMutedRef = Nothing, + msOtrArchived = False, + msOtrArchivedRef = Nothing, + msHidden = False, + msHiddenRef = Nothing + }, + lmService = Nothing, + lmConvRoleName = roleToRoleName convRoleWireMember + } + else noteS @'ConvNotFound $ getConvMember lconv conv qusr -- perform checks ensureConversationActionAllowed (sing @tag) lcnv action conv self @@ -674,7 +725,7 @@ ensureConversationActionAllowed tag loc action conv self = do -- general action check ensureActionAllowed (sConversationActionPermission tag) self - -- check if it is a group conversation (except for rename actions) + -- check if it is a group or global conversation (except for rename actions) when (fromSing tag /= ConversationRenameTag) $ ensureGroupConversation conv diff --git a/services/galley/src/Galley/API/Internal.hs b/services/galley/src/Galley/API/Internal.hs index b620ed6c38..87e9de0345 100644 --- a/services/galley/src/Galley/API/Internal.hs +++ b/services/galley/src/Galley/API/Internal.hs @@ -691,30 +691,38 @@ rmUser lusr conn = do let qUser = qUntagged lusr cc <- getConversations ids now <- input - let deleteIfNeeded c = + let deleteIfNeeded c = do when (tUnqualified lusr `isMember` Data.convLocalMembers c) $ do runError (removeUser (qualifyAs lusr c) (qUntagged lusr)) >>= \case Left e -> P.err $ Log.msg ("failed to send remove proposal: " <> internalErrorDescription e) Right _ -> pure () deleteMembers (Data.convId c) (UserList [tUnqualified lusr] []) for_ (bucketRemote (fmap rmId (Data.convRemoteMembers c))) $ notifyRemoteMembers now qUser (Data.convId c) - fireEvent c = let e = Event (qUntagged (qualifyAs lusr (Data.convId c))) (qUntagged lusr) now (EdMembersLeave (QualifiedUserIdList [qUser])) - in pure $ - Intra.newPushLocal ListComplete (tUnqualified lusr) (Intra.ConvEvent e) (Intra.recipient <$> Data.convLocalMembers c) - <&> set Intra.pushConn conn - . set Intra.pushRoute Intra.RouteDirect + pure $ + Intra.newPushLocal ListComplete (tUnqualified lusr) (Intra.ConvEvent e) (Intra.recipient <$> Data.convLocalMembers c) + <&> set Intra.pushConn conn + . set Intra.pushRoute Intra.RouteDirect + + deleteClientsFromGlobal c = do + runError (removeUser (qualifyAs lusr c) (qUntagged lusr)) >>= \case + Left e -> P.err $ Log.msg ("failed to send remove proposal: " <> internalErrorDescription e) + Right _ -> pure () + deleteMembers (Data.convId c) (UserList [tUnqualified lusr] []) + for_ (bucketRemote (fmap rmId (Data.convRemoteMembers c))) $ notifyRemoteMembers now qUser (Data.convId c) + pure Nothing + pp <- for cc $ \c -> case Data.convType c of SelfConv -> pure Nothing One2OneConv -> deleteMembers (Data.convId c) (UserList [tUnqualified lusr] []) $> Nothing ConnectConv -> deleteMembers (Data.convId c) (UserList [tUnqualified lusr] []) $> Nothing - RegularConv -> deleteIfNeeded c >> fireEvent c - GlobalTeamConv -> deleteIfNeeded c >> pure Nothing + RegularConv -> deleteIfNeeded c + GlobalTeamConv -> deleteClientsFromGlobal c for_ (maybeList1 (catMaybes pp)) diff --git a/services/galley/src/Galley/API/MLS/Message.hs b/services/galley/src/Galley/API/MLS/Message.hs index 6e2a04aaf2..ecd21bf50e 100644 --- a/services/galley/src/Galley/API/MLS/Message.hs +++ b/services/galley/src/Galley/API/MLS/Message.hs @@ -79,6 +79,7 @@ import Wire.API.MLS.CipherSuite import Wire.API.MLS.Commit import Wire.API.MLS.CommitBundle import Wire.API.MLS.Credential +import Wire.API.MLS.GlobalTeamConversation import Wire.API.MLS.GroupInfoBundle import Wire.API.MLS.KeyPackage import Wire.API.MLS.Message @@ -475,7 +476,14 @@ postMLSMessageToLocalConv :: Sem r [LocalConversationUpdate] postMLSMessageToLocalConv qusr senderClient con smsg lcnv = case rmValue smsg of SomeMessage tag msg -> do - conv <- getLocalConvForUser qusr lcnv + gtc <- getGlobalTeamConversationById lcnv + conv <- case gtc of + Just conv -> do + when (isNothing (gtcmCreator $ gtcMetadata $ conv)) $ do + setGlobalTeamConversationCreator conv (qUnqualified qusr) + pure . gtcToConv $ conv + Nothing -> + getLocalConvForUser qusr lcnv -- construct client map cm <- lookupMLSClients lcnv @@ -487,7 +495,7 @@ postMLSMessageToLocalConv qusr senderClient con smsg lcnv = case rmValue smsg of CommitMessage c -> processCommit qusr senderClient con lconv cm (msgEpoch msg) (msgSender msg) c ApplicationMessage _ -> throwS @'MLSUnsupportedMessage - ProposalMessage prop -> + ProposalMessage prop -> processProposal qusr conv msg prop $> mempty SMLSCipherText -> case toMLSEnum' (msgContentType (msgPayload msg)) of Right CommitMessageTag -> throwS @'MLSUnsupportedMessage @@ -499,6 +507,28 @@ postMLSMessageToLocalConv qusr senderClient con smsg lcnv = case rmValue smsg of propagateMessage qusr lconv cm con (rmRaw smsg) pure events + where + gtcToConv :: GlobalTeamConversation -> Data.Conversation + gtcToConv gtc = + let meta = gtcMetadata gtc + in Data.Conversation + { convId = qUnqualified $ gtcId gtc, + convLocalMembers = mempty, -- Should be full team + convRemoteMembers = mempty, + convDeleted = False, + convMetadata = + ConversationMetadata + { cnvmType = GlobalTeamConv, + cnvmCreator = undefined, + cnvmAccess = gtcmAccess meta, + cnvmAccessRoles = mempty, + cnvmName = Just (gtcmName meta), + cnvmTeam = Just (gtcmTeam meta), + cnvmMessageTimer = Nothing, + cnvmReceiptMode = Nothing + }, + convProtocol = ProtocolMLS (gtcMlsMetadata gtc) + } postMLSMessageToRemoteConv :: ( Members MLSMessageStaticErrors r, @@ -556,7 +586,6 @@ type HasProposalEffects r = Member MemberStore r, Member ProposalStore r, Member TeamStore r, - Member TeamStore r, Member TinyLog r ) diff --git a/services/galley/src/Galley/API/Query.hs b/services/galley/src/Galley/API/Query.hs index 31b391eeb2..64de4edb9e 100644 --- a/services/galley/src/Galley/API/Query.hs +++ b/services/galley/src/Galley/API/Query.hs @@ -72,7 +72,6 @@ import Galley.API.MLS.Keys import Galley.API.Mapping import qualified Galley.API.Mapping as Mapping import Galley.API.Util -import qualified Galley.Data.Conversation as Conv import qualified Galley.Data.Conversation as Data import Galley.Data.Types (Code (codeConversation)) import Galley.Effects @@ -99,7 +98,6 @@ import qualified System.Logger.Class as Logger import Wire.API.Conversation hiding (Member) import qualified Wire.API.Conversation as Public import Wire.API.Conversation.Code -import Wire.API.Conversation.Protocol import Wire.API.Conversation.Role import qualified Wire.API.Conversation.Role as Public import Wire.API.Error @@ -107,7 +105,6 @@ import Wire.API.Error.Galley import Wire.API.Federation.API import Wire.API.Federation.API.Galley import Wire.API.Federation.Error -import Wire.API.MLS.GlobalTeamConversation import qualified Wire.API.MLS.GlobalTeamConversation as Public import qualified Wire.API.Provider.Bot as Public import qualified Wire.API.Routes.MultiTablePaging as Public @@ -171,31 +168,16 @@ getGlobalTeamConversation :: Sem r Public.GlobalTeamConversation getGlobalTeamConversation lusr cid tid = do let uid = tUnqualified lusr + ltid = qualifyAs lusr tid void $ noteS @'NotATeamMember =<< E.getTeamMember tid (tUnqualified lusr) - E.getGlobalTeamConversation tid >>= \case + E.getGlobalTeamConversation ltid >>= \case Nothing -> do - conv <- E.createGlobalTeamConversation (qualifyAs lusr tid) uid - mlsData <- case Conv.convProtocol conv of - ProtocolMLS mls -> pure mls - ProtocolProteus -> throw (InternalErrorWithDescription "Wrong protocol, expected MLS, got Proteus.") - -- FUTUREWORK: remove this. we are planning to remove the need for a nullKeyPackageRef - let convId = Conv.convId conv - lconv = qualifyAs lusr convId - E.addMLSClients lconv (qUntagged lusr) (Set.singleton (cid, nullKeyPackageRef)) - pure $ - GlobalTeamConversation - (qUntagged lconv) - (Conv.convMetadata conv) - mlsData - Just conv -> do - mlsData <- case Conv.convProtocol conv of - ProtocolMLS mls -> pure mls - ProtocolProteus -> throw (InternalErrorWithDescription "Wrong protocol, expected MLS, got Proteus.") - pure $ - GlobalTeamConversation - (qUntagged . qualifyAs lusr $ Conv.convId conv) - (Conv.convMetadata conv) - mlsData + gtc <- E.createGlobalTeamConversation ltid uid + E.addMLSClients (localGtcId gtc) (qUntagged lusr) (Set.fromList [(cid, nullKeyPackageRef)]) + pure gtc + Just conv -> pure conv + where + localGtcId = qualifyAs lusr . qUnqualified . Public.gtcId getConversation :: forall r. diff --git a/services/galley/src/Galley/API/Teams.hs b/services/galley/src/Galley/API/Teams.hs index 2f44cc4be2..6fed769289 100644 --- a/services/galley/src/Galley/API/Teams.hs +++ b/services/galley/src/Galley/API/Teams.hs @@ -258,8 +258,7 @@ createNonBindingTeamH lusr zcon (Public.NonBindingNewTeam body) = do (body ^. newTeamIconKey) NonBinding finishCreateTeam team owner others (Just zcon) - let tid = team ^. teamId - pure tid + pure $ team ^. teamId createBindingTeam :: Members diff --git a/services/galley/src/Galley/API/Util.hs b/services/galley/src/Galley/API/Util.hs index 29d03b8151..47e1a9182e 100644 --- a/services/galley/src/Galley/API/Util.hs +++ b/services/galley/src/Galley/API/Util.hs @@ -192,7 +192,7 @@ ensureActionAllowed action self = case isActionAllowed (fromSing action) (convMe ensureGroupConversation :: Member (ErrorS 'InvalidOperation) r => Data.Conversation -> Sem r () ensureGroupConversation conv = do let ty = Data.convType conv - when (ty /= RegularConv) $ throwS @'InvalidOperation + unless (ty `elem` [RegularConv, GlobalTeamConv]) $ throwS @'InvalidOperation -- | Ensure that the set of actions provided are not "greater" than the user's -- own. This is used to ensure users cannot "elevate" allowed actions diff --git a/services/galley/src/Galley/Cassandra/Conversation.hs b/services/galley/src/Galley/Cassandra/Conversation.hs index 17ed2afde1..fbd93e247b 100644 --- a/services/galley/src/Galley/Cassandra/Conversation.hs +++ b/services/galley/src/Galley/Cassandra/Conversation.hs @@ -19,6 +19,7 @@ module Galley.Cassandra.Conversation ( createConversation, deleteConversation, interpretConversationStoreToCassandra, + getGlobalTeamConversationById, ) where @@ -54,6 +55,7 @@ import qualified UnliftIO import Wire.API.Conversation hiding (Conversation, Member) import Wire.API.Conversation.Protocol import Wire.API.MLS.CipherSuite +import Wire.API.MLS.GlobalTeamConversation import Wire.API.MLS.Group import Wire.API.MLS.PublicGroupState @@ -249,60 +251,111 @@ getConversation conv = do <*> UnliftIO.wait cdata runMaybeT $ conversationGC =<< maybe mzero pure mbConv -getGlobalTeamConversation :: TeamId -> Client (Maybe Conversation) -getGlobalTeamConversation tid = - (\c -> c {convLocalMembers = [], convRemoteMembers = []}) - <$$> getConversation (globalTeamConv tid) +getGlobalTeamConversation :: + Local TeamId -> + Client (Maybe GlobalTeamConversation) +getGlobalTeamConversation qtid = do + let tid = tUnqualified qtid + cid = globalTeamConv tid + mconv <- retry x1 (query1 Cql.selectGlobalTeamConv (params LocalQuorum (Identity cid))) + pure $ toGlobalConv cid tid mconv + where + toGlobalConv cid tid mconv = do + (muid, mname, _mtid, mgid, mepoch, mcs) <- mconv + mlsData <- ConversationMLSData <$> mgid <*> (mepoch <|> Just (Epoch 0)) <*> mcs + name <- mname + + pure $ + GlobalTeamConversation + (qUntagged $ qualifyAs qtid cid) + ( GlobalTeamConversationMetadata + { gtcmCreator = muid, + gtcmAccess = [SelfInviteAccess], + gtcmName = name, + gtcmTeam = tid + } + ) + mlsData + +getGlobalTeamConversationById :: + Local ConvId -> + Client (Maybe GlobalTeamConversation) +getGlobalTeamConversationById lconv = do + let cid = tUnqualified lconv + mconv <- retry x1 (query1 Cql.selectGlobalTeamConv (params LocalQuorum (Identity cid))) + pure $ toGlobalConv mconv + where + toGlobalConv mconv = do + (muid, mname, mtid, mgid, mepoch, mcs) <- mconv + tid <- mtid + name <- mname + mlsData <- ConversationMLSData <$> mgid <*> (mepoch <|> Just (Epoch 0)) <*> mcs + + pure $ + GlobalTeamConversation + (qUntagged lconv) + ( GlobalTeamConversationMetadata + { gtcmCreator = muid, + gtcmAccess = [SelfInviteAccess], + gtcmName = name, + gtcmTeam = tid + } + ) + mlsData createGlobalTeamConversation :: Local TeamId -> UserId -> - Client Conversation + Client GlobalTeamConversation createGlobalTeamConversation tid uid = do let lconv = qualifyAs tid (globalTeamConv $ tUnqualified tid) meta = - ConversationMetadata - { cnvmType = GlobalTeamConv, - cnvmCreator = uid, - cnvmAccess = [SelfInviteAccess], - cnvmAccessRoles = mempty, - cnvmName = Just "Global team conversation", - cnvmTeam = Just (tUnqualified tid), - cnvmMessageTimer = Nothing, - cnvmReceiptMode = Nothing + GlobalTeamConversationMetadata + { gtcmCreator = Just uid, + gtcmAccess = [SelfInviteAccess], + gtcmName = "Global team conversation", + gtcmTeam = tUnqualified tid } gid = convToGroupId lconv cs = MLS_128_DHKEMX25519_AES128GCM_SHA256_Ed25519 - proto = - ProtocolMLS - ( ConversationMLSData - gid - (Epoch 0) - cs - ) retry x5 . batch $ do setType BatchLogged setConsistency LocalQuorum addPrepQuery Cql.insertGlobalTeamConv ( tUnqualified lconv, - Cql.Set (cnvmAccess meta), - cnvmName meta, - cnvmTeam meta, + Cql.Set (gtcmAccess meta), + gtcmName meta, + gtcmTeam meta, + uid, Just gid, Just cs ) addPrepQuery Cql.insertTeamConv (tUnqualified tid, tUnqualified lconv) addPrepQuery Cql.insertGroupId (gid, tUnqualified lconv, tDomain lconv) - pure - Conversation - { convId = tUnqualified lconv, - convLocalMembers = mempty, - convRemoteMembers = mempty, - convDeleted = False, - convMetadata = meta, - convProtocol = proto - } + pure $ + GlobalTeamConversation + (qUntagged lconv) + meta + ( ConversationMLSData + gid + (Epoch 0) + cs + ) + +setGlobalTeamConversationCreator :: + GlobalTeamConversation -> + UserId -> + Client () +setGlobalTeamConversationCreator gtc uid = do + retry x5 . batch $ do + setType BatchLogged + setConsistency LocalQuorum + addPrepQuery + Cql.setGlobalTeamConvCreator + ( 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 @@ -436,7 +489,9 @@ interpretConversationStoreToCassandra = interpret $ \case CreateMLSSelfConversation lusr -> embedClient $ createMLSSelfConversation lusr GetConversation cid -> embedClient $ getConversation cid GetGlobalTeamConversation tid -> embedClient $ getGlobalTeamConversation tid + GetGlobalTeamConversationById lconv -> embedClient $ getGlobalTeamConversationById lconv CreateGlobalTeamConversation tid uid -> embedClient $ createGlobalTeamConversation tid uid + 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/Cassandra/Queries.hs b/services/galley/src/Galley/Cassandra/Queries.hs index 0631fd2962..125b5da35c 100644 --- a/services/galley/src/Galley/Cassandra/Queries.hs +++ b/services/galley/src/Galley/Cassandra/Queries.hs @@ -198,9 +198,40 @@ updateTeamSplashScreen = "update team set splash_screen = ? where team = ?" -- Conversations ------------------------------------------------------------ -selectConv :: PrepQuery R (Identity ConvId) (ConvType, UserId, Maybe (C.Set Access), Maybe AccessRoleLegacy, Maybe (C.Set AccessRoleV2), Maybe Text, Maybe TeamId, Maybe Bool, Maybe Milliseconds, Maybe ReceiptMode, Maybe ProtocolTag, Maybe GroupId, Maybe Epoch, Maybe CipherSuiteTag) +selectConv :: + PrepQuery + R + (Identity ConvId) + ( ConvType, + UserId, + Maybe (C.Set Access), + Maybe AccessRoleLegacy, + Maybe (C.Set AccessRoleV2), + Maybe Text, + Maybe TeamId, + Maybe Bool, + Maybe Milliseconds, + Maybe ReceiptMode, + Maybe ProtocolTag, + Maybe GroupId, + Maybe Epoch, + Maybe CipherSuiteTag + ) selectConv = "select type, creator, access, access_role, access_roles_v2, name, team, deleted, message_timer, receipt_mode, protocol, group_id, epoch, cipher_suite from conversation where conv = ?" +selectGlobalTeamConv :: + PrepQuery + R + (Identity ConvId) + ( Maybe UserId, + Maybe Text, + Maybe TeamId, + Maybe GroupId, + Maybe Epoch, + Maybe CipherSuiteTag + ) +selectGlobalTeamConv = "select creator, name, team, group_id, epoch, cipher_suite from conversation where conv = ?" + selectReceiptMode :: PrepQuery R (Identity ConvId) (Identity (Maybe ReceiptMode)) selectReceiptMode = "select receipt_mode from conversation where conv = ?" @@ -235,8 +266,11 @@ insertMLSSelfConv = <> show (fromEnum ProtocolMLSTag) <> ", ?, ?)" -insertGlobalTeamConv :: PrepQuery W (ConvId, C.Set Access, Maybe Text, Maybe TeamId, Maybe GroupId, Maybe CipherSuiteTag) () -insertGlobalTeamConv = "insert into conversation (conv, type, access, name, team, group_id, cipher_suite) values (?, 4, ?, ?, ?, ?, ?)" +insertGlobalTeamConv :: PrepQuery W (ConvId, C.Set Access, Text, TeamId, UserId, Maybe GroupId, Maybe CipherSuiteTag) () +insertGlobalTeamConv = "insert into conversation (conv, type, access, name, team, creator, group_id, cipher_suite) values (?, 4, ?, ?, ?, ?, ?, ?)" + +setGlobalTeamConvCreator :: PrepQuery W (UserId, ConvId) () +setGlobalTeamConvCreator = "update conversation set creator = ? where conv = ?" updateConvAccess :: PrepQuery W (C.Set Access, C.Set AccessRoleV2, ConvId) () updateConvAccess = "update conversation set access = ?, access_roles_v2 = ? where conv = ?" diff --git a/services/galley/src/Galley/Effects/ConversationStore.hs b/services/galley/src/Galley/Effects/ConversationStore.hs index 53bcfededf..c2b19579f3 100644 --- a/services/galley/src/Galley/Effects/ConversationStore.hs +++ b/services/galley/src/Galley/Effects/ConversationStore.hs @@ -29,6 +29,7 @@ module Galley.Effects.ConversationStore -- * Read conversation getConversation, getGlobalTeamConversation, + getGlobalTeamConversationById, createGlobalTeamConversation, getConversationIdByGroupId, getConversations, @@ -45,6 +46,7 @@ module Galley.Effects.ConversationStore setConversationReceiptMode, setConversationMessageTimer, setConversationEpoch, + setGlobalTeamConversationCreator, acceptConnectConversation, setGroupId, setPublicGroupState, @@ -70,6 +72,7 @@ import Imports import Polysemy import Wire.API.Conversation hiding (Conversation, Member) import Wire.API.MLS.Epoch +import Wire.API.MLS.GlobalTeamConversation import Wire.API.MLS.PublicGroupState data ConversationStore m a where @@ -80,8 +83,10 @@ data ConversationStore m a where ConversationStore m Conversation DeleteConversation :: ConvId -> ConversationStore m () GetConversation :: ConvId -> ConversationStore m (Maybe Conversation) - GetGlobalTeamConversation :: TeamId -> ConversationStore m (Maybe Conversation) - CreateGlobalTeamConversation :: Local TeamId -> UserId -> ConversationStore m Conversation + GetGlobalTeamConversation :: Local TeamId -> ConversationStore m (Maybe GlobalTeamConversation) + GetGlobalTeamConversationById :: Local ConvId -> ConversationStore m (Maybe GlobalTeamConversation) + CreateGlobalTeamConversation :: Local TeamId -> UserId -> 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.hs b/services/galley/test/integration/API.hs index 9f1e8ac539..8476da3284 100644 --- a/services/galley/test/integration/API.hs +++ b/services/galley/test/integration/API.hs @@ -2075,7 +2075,19 @@ postConvQualifiedFederationNotEnabled = do -- FUTUREWORK: figure out how to use functions in the TestM monad inside withSettingsOverrides and remove this duplication postConvHelper :: (MonadIO m, MonadHttp m) => (Request -> Request) -> UserId -> [Qualified UserId] -> m ResponseLBS postConvHelper g zusr newUsers = do - let conv = NewConv [] newUsers (checked "gossip") (Set.fromList []) Nothing Nothing Nothing Nothing roleNameWireAdmin ProtocolProteusTag Nothing + let conv = + NewConv + [] + newUsers + (checked "gossip") + (Set.fromList []) + Nothing + Nothing + Nothing + Nothing + roleNameWireAdmin + ProtocolProteusTag + Nothing post $ g . path "/conversations" . zUser zusr . zConn "conn" . zType "access" . json conv postSelfConvOk :: TestM () @@ -2104,7 +2116,19 @@ postConvO2OFailWithSelf :: TestM () postConvO2OFailWithSelf = do g <- viewGalley alice <- randomUser - let inv = NewConv [alice] [] Nothing mempty Nothing Nothing Nothing Nothing roleNameWireAdmin ProtocolProteusTag Nothing + let inv = + NewConv + [alice] + [] + Nothing + mempty + Nothing + Nothing + Nothing + Nothing + roleNameWireAdmin + ProtocolProteusTag + Nothing post (g . path "/conversations/one2one" . zUser alice . zConn "conn" . zType "access" . json inv) !!! do const 403 === statusCode const (Just "invalid-op") === fmap label . responseJsonUnsafe diff --git a/services/galley/test/integration/API/MLS.hs b/services/galley/test/integration/API/MLS.hs index fb779276a3..fe2435fc68 100644 --- a/services/galley/test/integration/API/MLS.hs +++ b/services/galley/test/integration/API/MLS.hs @@ -197,7 +197,8 @@ tests s = "GlobalTeamConv" [ test s "Non-existing team returns 403" testGetGlobalTeamConvNonExistant, test s "Non member of team returns 403" testGetGlobalTeamConvNonMember, - test s "Global team conversation is created on get if not present" (testGetGlobalTeamConv s) + test s "Global team conversation is created on get if not present" (testGetGlobalTeamConv s), + test s "Can't leave global team conversation" testGlobalTeamConversationLeave ], testGroup "Self conversation" @@ -2182,11 +2183,11 @@ testGetGlobalTeamConv setup = do assertQueue "create team" tActivate liftIO $ assertEqual "owner" owner (team ^. teamCreator) assertQueueEmpty - cid <- Util.randomClient owner (head Util.someLastPrekeys) s <- liftIO setup let domain = s ^. tsGConf . optSettings . setFederationDomain + cid <- Util.randomClient owner (head Util.someLastPrekeys) let response = getGlobalTeamConv owner cid tid response let convoId = globalTeamConv tid @@ -2194,12 +2195,11 @@ testGetGlobalTeamConv setup = do expected = GlobalTeamConversation (qUntagged lconv) - ( (defConversationMetadata owner) - { cnvmType = GlobalTeamConv, - cnvmAccess = [SelfInviteAccess], - cnvmAccessRoles = mempty, - cnvmName = Just "Global team conversation", - cnvmTeam = Just tid + ( GlobalTeamConversationMetadata + { gtcmCreator = Just owner, + gtcmAccess = [SelfInviteAccess], + gtcmName = "Global team conversation", + gtcmTeam = tid } ) ( ConversationMLSData @@ -2210,6 +2210,35 @@ testGetGlobalTeamConv setup = do let cm = Aeson.decode rs :: Maybe GlobalTeamConversation liftIO $ assertEqual "conversation metadata" cm (Just expected) +testGlobalTeamConversationLeave :: TestM () +testGlobalTeamConversationLeave = do + alice <- randomQualifiedUser + let aliceUnq = qUnqualified alice + + tid <- createBindingTeamInternal "sample-team" aliceUnq + team <- getTeam aliceUnq tid + assertQueue "create team" tActivate + liftIO $ assertEqual "owner" aliceUnq (team ^. teamCreator) + assertQueueEmpty + + runMLSTest $ do + alice1 <- createMLSClient alice + + let response = getGlobalTeamConv aliceUnq (ciClient alice1) tid response + let (Just gtc) = Aeson.decode rs :: Maybe GlobalTeamConversation + gid = cnvmlsGroupId $ gtcMlsMetadata gtc + + void $ uploadNewKeyPackage alice1 + createGroup alice1 gid + mlsBracket [alice1] $ \wss -> do + liftTest $ + deleteMemberQualified (qUnqualified alice) alice (gtcId gtc) + !!! do + const 403 === statusCode + const (Just "invalid-op") === fmap Wai.label . responseJsonError + WS.assertNoEvent (1 # WS.Second) wss + testSelfConversation :: TestM () testSelfConversation = do alice <- randomQualifiedUser diff --git a/services/galley/test/integration/API/Util.hs b/services/galley/test/integration/API/Util.hs index 20cba5c4c6..ba269fa48a 100644 --- a/services/galley/test/integration/API/Util.hs +++ b/services/galley/test/integration/API/Util.hs @@ -617,7 +617,18 @@ createTeamConvAccessRaw u tid us name acc role mtimer convRole = do g <- viewGalley let tinfo = ConvTeamInfo tid let conv = - NewConv us [] (name >>= checked) (fromMaybe (Set.fromList []) acc) role (Just tinfo) mtimer Nothing (fromMaybe roleNameWireAdmin convRole) ProtocolProteusTag Nothing + NewConv + us + [] + (name >>= checked) + (fromMaybe (Set.fromList []) acc) + role + (Just tinfo) + mtimer + Nothing + (fromMaybe roleNameWireAdmin convRole) + ProtocolProteusTag + Nothing post ( g . path "/conversations" @@ -684,7 +695,18 @@ createOne2OneTeamConv :: UserId -> UserId -> Maybe Text -> TeamId -> TestM Respo createOne2OneTeamConv u1 u2 n tid = do g <- viewGalley let conv = - NewConv [u2] [] (n >>= checked) mempty Nothing (Just $ ConvTeamInfo tid) Nothing Nothing roleNameWireAdmin ProtocolProteusTag Nothing + NewConv + [u2] + [] + (n >>= checked) + mempty + Nothing + (Just $ ConvTeamInfo tid) + Nothing + Nothing + roleNameWireAdmin + ProtocolProteusTag + Nothing post $ g . path "/conversations/one2one" . zUser u1 . zConn "conn" . zType "access" . json conv postConv :: @@ -740,7 +762,19 @@ postConvWithRemoteUsers u n = postTeamConv :: TeamId -> UserId -> [UserId] -> Maybe Text -> [Access] -> Maybe (Set AccessRoleV2) -> Maybe Milliseconds -> TestM ResponseLBS postTeamConv tid u us name a r mtimer = do g <- viewGalley - let conv = NewConv us [] (name >>= checked) (Set.fromList a) r (Just (ConvTeamInfo tid)) mtimer Nothing roleNameWireAdmin ProtocolProteusTag Nothing + let conv = + NewConv + us + [] + (name >>= checked) + (Set.fromList a) + r + (Just (ConvTeamInfo tid)) + mtimer + Nothing + roleNameWireAdmin + ProtocolProteusTag + Nothing post $ g . path "/conversations" . zUser u . zConn "conn" . zType "access" . json conv deleteTeamConv :: (HasGalley m, MonadIO m, MonadHttp m) => TeamId -> ConvId -> UserId -> m ResponseLBS @@ -777,7 +811,19 @@ postConvWithRole u members name access arole timer role = postConvWithReceipt :: UserId -> [UserId] -> Maybe Text -> [Access] -> Maybe (Set AccessRoleV2) -> Maybe Milliseconds -> ReceiptMode -> TestM ResponseLBS postConvWithReceipt u us name a r mtimer rcpt = do g <- viewGalley - let conv = NewConv us [] (name >>= checked) (Set.fromList a) r Nothing mtimer (Just rcpt) roleNameWireAdmin ProtocolProteusTag Nothing + let conv = + NewConv + us + [] + (name >>= checked) + (Set.fromList a) + r + Nothing + mtimer + (Just rcpt) + roleNameWireAdmin + ProtocolProteusTag + Nothing post $ g . path "/conversations" . zUser u . zConn "conn" . zType "access" . json conv postSelfConv :: UserId -> TestM ResponseLBS @@ -788,7 +834,19 @@ postSelfConv u = do postO2OConv :: UserId -> UserId -> Maybe Text -> TestM ResponseLBS postO2OConv u1 u2 n = do g <- viewGalley - let conv = NewConv [u2] [] (n >>= checked) mempty Nothing Nothing Nothing Nothing roleNameWireAdmin ProtocolProteusTag Nothing + let conv = + NewConv + [u2] + [] + (n >>= checked) + mempty + Nothing + Nothing + Nothing + Nothing + roleNameWireAdmin + ProtocolProteusTag + Nothing post $ g . path "/conversations/one2one" . zUser u1 . zConn "conn" . zType "access" . json conv postConnectConv :: UserId -> UserId -> Text -> Text -> Maybe Text -> TestM ResponseLBS From 21877d1a124c5f11766d24b7f8f2b104e722d9a0 Mon Sep 17 00:00:00 2001 From: Igor Ranieri Date: Thu, 17 Nov 2022 15:31:12 +0000 Subject: [PATCH 03/11] Implemented MLS side of global team conv --- .../Wire/API/MLS/GlobalTeamConversation.hs | 2 +- .../API/Routes/Public/Galley/Conversation.hs | 1 - nix/pkgs/mls-test-cli/default.nix | 4 +- services/galley/src/Galley/API/Action.hs | 6 +- services/galley/src/Galley/API/MLS/Message.hs | 35 ++++++-- services/galley/src/Galley/API/MLS/Util.hs | 47 +++++++++-- services/galley/src/Galley/API/Query.hs | 14 +--- .../src/Galley/Cassandra/Conversation.hs | 16 ++-- .../Galley/Cassandra/Conversation/Members.hs | 43 ++++++++-- .../galley/src/Galley/Cassandra/Queries.hs | 6 +- .../src/Galley/Effects/ConversationStore.hs | 2 +- services/galley/test/integration/API/MLS.hs | 81 ++++++++++++++++--- .../galley/test/integration/API/MLS/Util.hs | 15 ++-- services/galley/test/integration/API/Util.hs | 4 +- 14 files changed, 206 insertions(+), 70 deletions(-) diff --git a/libs/wire-api/src/Wire/API/MLS/GlobalTeamConversation.hs b/libs/wire-api/src/Wire/API/MLS/GlobalTeamConversation.hs index 590d1d43f9..83ca7a5116 100644 --- a/libs/wire-api/src/Wire/API/MLS/GlobalTeamConversation.hs +++ b/libs/wire-api/src/Wire/API/MLS/GlobalTeamConversation.hs @@ -24,7 +24,7 @@ import Data.Qualified import Data.Schema import qualified Data.Swagger as S import Imports -import Wire.API.Conversation +import Wire.API.Conversation hiding (Conversation) import Wire.API.Conversation.Protocol import Wire.Arbitrary (Arbitrary (..), GenericUniform (..)) diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Galley/Conversation.hs b/libs/wire-api/src/Wire/API/Routes/Public/Galley/Conversation.hs index b5c489f34c..a5731fc412 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Galley/Conversation.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Galley/Conversation.hs @@ -121,7 +121,6 @@ type ConversationAPI = :> CanThrow 'ConvNotFound :> CanThrow 'NotATeamMember :> ZLocalUser - :> ZClient :> "teams" :> Capture "tid" TeamId :> "conversations" diff --git a/nix/pkgs/mls-test-cli/default.nix b/nix/pkgs/mls-test-cli/default.nix index 7d7d696113..b49f61ceaa 100644 --- a/nix/pkgs/mls-test-cli/default.nix +++ b/nix/pkgs/mls-test-cli/default.nix @@ -15,8 +15,8 @@ rustPlatform.buildRustPackage rec { src = fetchFromGitHub { owner = "wireapp"; repo = "mls-test-cli"; - sha256 = "sha256-/XQ/9oQTPkRqgMzDGRm+Oh9jgkdeDM1vRJ6/wEf2+bY="; - rev = "c6f80be2839ac1ed2894e96044541d1c3cf6ecdf"; + sha256 = "sha256-FjgAcYdUr/ZWdQxbck2UEG6NEEQLuz0S4a55hrAxUs4="; + rev = "82fc148964ef5baa92a90d086fdc61adaa2b5dbf"; }; doCheck = false; cargoSha256 = "sha256-AlZrxa7f5JwxxrzFBgeFSaYU6QttsUpfLYfq1HzsdbE="; diff --git a/services/galley/src/Galley/API/Action.hs b/services/galley/src/Galley/API/Action.hs index f38b98dfb8..3d4c000d9f 100644 --- a/services/galley/src/Galley/API/Action.hs +++ b/services/galley/src/Galley/API/Action.hs @@ -602,7 +602,7 @@ updateLocalConversation lcnv qusr con action = do Just gtc -> let c = (gtcmCreator . gtcMetadata $ gtc) in case c of - Nothing -> + Nothing -> throwS @'ConvNotFound Just creator -> pure $ gtcToConv creator gtc @@ -668,8 +668,8 @@ updateLocalConversationUnchecked lconv qusr con action = do -- retrieve member self <- if (cnvmType . convMetadata . tUnqualified $ lconv) == GlobalTeamConv - then - -- TODO(elland): address this problem + then -- TODO(elland): address this problem + pure . Left $ LocalMember { lmId = qUnqualified qusr, diff --git a/services/galley/src/Galley/API/MLS/Message.hs b/services/galley/src/Galley/API/MLS/Message.hs index ecd21bf50e..ee5088ba8c 100644 --- a/services/galley/src/Galley/API/MLS/Message.hs +++ b/services/galley/src/Galley/API/MLS/Message.hs @@ -481,7 +481,8 @@ postMLSMessageToLocalConv qusr senderClient con smsg lcnv = case rmValue smsg of Just conv -> do when (isNothing (gtcmCreator $ gtcMetadata $ conv)) $ do setGlobalTeamConversationCreator conv (qUnqualified qusr) - pure . gtcToConv $ conv + localMembers <- getLocalMembers (qUnqualified . gtcId $ conv) + pure $ gtcToConv conv localMembers Nothing -> getLocalConvForUser qusr lcnv @@ -495,7 +496,7 @@ postMLSMessageToLocalConv qusr senderClient con smsg lcnv = case rmValue smsg of CommitMessage c -> processCommit qusr senderClient con lconv cm (msgEpoch msg) (msgSender msg) c ApplicationMessage _ -> throwS @'MLSUnsupportedMessage - ProposalMessage prop -> + ProposalMessage prop -> processProposal qusr conv msg prop $> mempty SMLSCipherText -> case toMLSEnum' (msgContentType (msgPayload msg)) of Right CommitMessageTag -> throwS @'MLSUnsupportedMessage @@ -503,23 +504,22 @@ postMLSMessageToLocalConv qusr senderClient con smsg lcnv = case rmValue smsg of Right ApplicationMessageTag -> pure mempty Left _ -> throwS @'MLSUnsupportedMessage - -- forward message propagateMessage qusr lconv cm con (rmRaw smsg) pure events where - gtcToConv :: GlobalTeamConversation -> Data.Conversation - gtcToConv gtc = + gtcToConv gtc lm = let meta = gtcMetadata gtc in Data.Conversation { convId = qUnqualified $ gtcId gtc, - convLocalMembers = mempty, -- Should be full team + -- FUTUREWORK: Look into reworking things if needed for performance + convLocalMembers = lm, convRemoteMembers = mempty, convDeleted = False, convMetadata = ConversationMetadata { cnvmType = GlobalTeamConv, - cnvmCreator = undefined, + cnvmCreator = fromJust . gtcmCreator . gtcMetadata $ gtc, cnvmAccess = gtcmAccess meta, cnvmAccessRoles = mempty, cnvmName = Just (gtcmName meta), @@ -866,11 +866,32 @@ processInternalCommit qusr senderClient con lconv cm epoch groupId action sender (convId <$> lconv) qusr (Set.singleton (creatorClient, creatorRef)) + (Left _, SelfConv, _) -> 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 <- + maybe + (pure senderRef) + ( note (mlsProtocolError "Could not compute key package ref") + . kpRef' + . upLeaf + ) + $ cPath commit + addMLSClients + (convId <$> lconv) + qusr + (Set.singleton (creatorClient, creatorRef)) + + (Left _, GlobalTeamConv, _) -> + 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 1095e1ef62..0a1f1264ca 100644 --- a/services/galley/src/Galley/API/MLS/Util.hs +++ b/services/galley/src/Galley/API/MLS/Util.hs @@ -20,7 +20,7 @@ module Galley.API.MLS.Util where import Control.Comonad import Data.Id import Data.Qualified -import Galley.Data.Conversation.Types hiding (Conversation) +import Galley.Data.Conversation import qualified Galley.Data.Conversation.Types as Data import Galley.Effects import Galley.Effects.ConversationStore @@ -28,13 +28,15 @@ import Galley.Effects.MemberStore import Galley.Effects.ProposalStore import Imports import Polysemy +import Polysemy.Input import Polysemy.TinyLog (TinyLog) import qualified Polysemy.TinyLog as TinyLog import qualified System.Logger as Log +import Wire.API.Conversation hiding (Conversation) +import Wire.API.Conversation.Protocol import Wire.API.Error import Wire.API.Error.Galley -import Wire.API.MLS.Epoch -import Wire.API.MLS.Group +import Wire.API.MLS.GlobalTeamConversation import Wire.API.MLS.KeyPackage import Wire.API.MLS.Proposal import Wire.API.MLS.Serialisation @@ -43,20 +45,55 @@ getLocalConvForUser :: Members '[ ErrorS 'ConvNotFound, ConversationStore, - MemberStore + MemberStore, + Input (Local ()) ] r => Qualified UserId -> Local ConvId -> Sem r Data.Conversation getLocalConvForUser qusr lcnv = do - conv <- getConversation (tUnqualified lcnv) >>= noteS @'ConvNotFound + gtc <- getGlobalTeamConversationById lcnv + conv <- case gtc of + Just conv -> do + -- TODO(elland): clean this up + let creator = gtcmCreator . gtcMetadata $ conv + localMembers <- getLocalMembers (qUnqualified . gtcId $ conv) + + if isNothing creator + then do + setGlobalTeamConversationCreator conv (qUnqualified qusr) + pure $ gtcToConv conv (qUnqualified qusr) localMembers + else pure $ gtcToConv conv (fromJust creator) localMembers + Nothing -> do + getConversation (tUnqualified lcnv) >>= noteS @'ConvNotFound -- check that sender is part of conversation isMember' <- foldQualified lcnv (fmap isJust . getLocalMember (convId conv) . tUnqualified) (fmap isJust . getRemoteMember (convId conv)) qusr unless isMember' $ throwS @'ConvNotFound pure conv + where + gtcToConv gtc creator lMembers = + let meta = gtcMetadata gtc + in Conversation + { convId = qUnqualified $ gtcId gtc, + convLocalMembers = lMembers, + convRemoteMembers = mempty, + convDeleted = False, + convMetadata = + ConversationMetadata + { cnvmType = GlobalTeamConv, + cnvmCreator = creator, + cnvmAccess = gtcmAccess meta, + cnvmAccessRoles = mempty, + cnvmName = Just (gtcmName meta), + cnvmTeam = Just (gtcmTeam meta), + cnvmMessageTimer = Nothing, + cnvmReceiptMode = Nothing + }, + convProtocol = ProtocolMLS (gtcMlsMetadata gtc) + } getPendingBackendRemoveProposals :: Members '[ProposalStore, TinyLog] r => diff --git a/services/galley/src/Galley/API/Query.hs b/services/galley/src/Galley/API/Query.hs index 64de4edb9e..c5b21ee1dd 100644 --- a/services/galley/src/Galley/API/Query.hs +++ b/services/galley/src/Galley/API/Query.hs @@ -163,21 +163,15 @@ getGlobalTeamConversation :: ] r => Local UserId -> - ClientId -> TeamId -> Sem r Public.GlobalTeamConversation -getGlobalTeamConversation lusr cid tid = do - let uid = tUnqualified lusr - ltid = qualifyAs lusr tid +getGlobalTeamConversation lusr tid = do + let ltid = qualifyAs lusr tid void $ noteS @'NotATeamMember =<< E.getTeamMember tid (tUnqualified lusr) E.getGlobalTeamConversation ltid >>= \case - Nothing -> do - gtc <- E.createGlobalTeamConversation ltid uid - E.addMLSClients (localGtcId gtc) (qUntagged lusr) (Set.fromList [(cid, nullKeyPackageRef)]) - pure gtc + Nothing -> + E.createGlobalTeamConversation (qualifyAs lusr tid) Just conv -> pure conv - where - localGtcId = qualifyAs lusr . qUnqualified . Public.gtcId getConversation :: forall r. diff --git a/services/galley/src/Galley/Cassandra/Conversation.hs b/services/galley/src/Galley/Cassandra/Conversation.hs index fbd93e247b..1a013e4ceb 100644 --- a/services/galley/src/Galley/Cassandra/Conversation.hs +++ b/services/galley/src/Galley/Cassandra/Conversation.hs @@ -189,7 +189,8 @@ conversationMeta conv = (toConvMeta =<<) <$> retry x1 (query1 Cql.selectConv (params LocalQuorum (Identity conv))) where - toConvMeta (t, c, a, r, r', n, i, _, mt, rm, _, _, _, _) = do + toConvMeta (t, mc, a, r, r', n, i, _, mt, rm, _, _, _, _) = do + c <- mc let mbAccessRolesV2 = Set.fromList . Cql.fromSet <$> r' accessRoles = maybeRole t $ parseAccessRoles r mbAccessRolesV2 pure $ ConversationMetadata t c (defAccess t a) accessRoles n i mt rm @@ -305,13 +306,12 @@ getGlobalTeamConversationById lconv = do createGlobalTeamConversation :: Local TeamId -> - UserId -> Client GlobalTeamConversation -createGlobalTeamConversation tid uid = do +createGlobalTeamConversation tid = do let lconv = qualifyAs tid (globalTeamConv $ tUnqualified tid) meta = GlobalTeamConversationMetadata - { gtcmCreator = Just uid, + { gtcmCreator = Nothing, gtcmAccess = [SelfInviteAccess], gtcmName = "Global team conversation", gtcmTeam = tUnqualified tid @@ -327,7 +327,6 @@ createGlobalTeamConversation tid uid = do Cql.Set (gtcmAccess meta), gtcmName meta, gtcmTeam meta, - uid, Just gid, Just cs ) @@ -444,10 +443,11 @@ toConv :: ConvId -> [LocalMember] -> [RemoteMember] -> - Maybe (ConvType, UserId, Maybe (Cql.Set Access), Maybe AccessRoleLegacy, Maybe (Cql.Set AccessRoleV2), Maybe Text, Maybe TeamId, Maybe Bool, Maybe Milliseconds, Maybe ReceiptMode, Maybe ProtocolTag, Maybe GroupId, Maybe Epoch, Maybe CipherSuiteTag) -> + Maybe (ConvType, Maybe UserId, Maybe (Cql.Set Access), Maybe AccessRoleLegacy, Maybe (Cql.Set AccessRoleV2), Maybe Text, Maybe TeamId, Maybe Bool, Maybe Milliseconds, Maybe ReceiptMode, Maybe ProtocolTag, Maybe GroupId, Maybe Epoch, Maybe CipherSuiteTag) -> Maybe Conversation toConv cid ms remoteMems mconv = do - (cty, uid, acc, role, roleV2, nme, ti, del, timer, rm, ptag, mgid, mep, mcs) <- mconv + (cty, muid, acc, role, roleV2, nme, ti, del, timer, rm, ptag, mgid, mep, mcs) <- mconv + uid <- muid let mbAccessRolesV2 = Set.fromList . Cql.fromSet <$> roleV2 accessRoles = maybeRole cty $ parseAccessRoles role mbAccessRolesV2 proto <- toProtocol ptag mgid mep mcs @@ -490,7 +490,7 @@ interpretConversationStoreToCassandra = interpret $ \case GetConversation cid -> embedClient $ getConversation cid GetGlobalTeamConversation tid -> embedClient $ getGlobalTeamConversation tid GetGlobalTeamConversationById lconv -> embedClient $ getGlobalTeamConversationById lconv - CreateGlobalTeamConversation tid uid -> embedClient $ createGlobalTeamConversation tid uid + CreateGlobalTeamConversation tid -> embedClient $ createGlobalTeamConversation tid SetGlobalTeamConversationCreator gtc uid -> embedClient $ setGlobalTeamConversationCreator gtc uid GetConversationIdByGroupId gId -> embedClient $ lookupGroupId gId GetConversations cids -> localConversations cids diff --git a/services/galley/src/Galley/Cassandra/Conversation/Members.hs b/services/galley/src/Galley/Cassandra/Conversation/Members.hs index a4d4622e8c..30a5a4c7da 100644 --- a/services/galley/src/Galley/Cassandra/Conversation/Members.hs +++ b/services/galley/src/Galley/Cassandra/Conversation/Members.hs @@ -45,7 +45,7 @@ import Imports hiding (Set) import Polysemy import Polysemy.Input import qualified UnliftIO -import Wire.API.Conversation.Member hiding (Member) +import Wire.API.Conversation import Wire.API.Conversation.Role import Wire.API.MLS.KeyPackage import Wire.API.Provider.Service @@ -117,9 +117,32 @@ removeRemoteMembersFromLocalConv cnv victims = do addPrepQuery Cql.removeRemoteMember (cnv, domain, uid) members :: ConvId -> Client [LocalMember] -members conv = - fmap (mapMaybe toMember) . retry x1 $ - query Cql.selectMembers (params LocalQuorum (Identity conv)) +members conv = do + mconv <- retry x1 $ query1 Cql.selectConv (params LocalQuorum (Identity conv)) + case mconv of + Just (GlobalTeamConv, _, _, _, _, _, Just tid, _, _, _, _, _, _, _) -> do + res <- + retry x1 $ + query + Cql.selectTeamMembers + (params LocalQuorum (Identity tid)) + let uids = mapMaybe fst' $ res + pure $ mapMaybe toMemberFromId uids + _ -> + fmap (mapMaybe toMember) . retry x1 $ + query Cql.selectMembers (params LocalQuorum (Identity conv)) + where + fst' (a, _, _, _, _) = Just a + +toMemberFromId :: UserId -> Maybe LocalMember +toMemberFromId usr = + Just $ + LocalMember + { lmId = usr, + lmService = Nothing, + lmStatus = toMemberStatus (Nothing, Nothing, Nothing, Nothing, Nothing, Nothing), + lmConvRoleName = roleNameWireMember + } toMemberStatus :: ( -- otr muted @@ -202,9 +225,15 @@ member :: ConvId -> UserId -> Client (Maybe LocalMember) -member cnv usr = - (toMember =<<) - <$> retry x1 (query1 Cql.selectMember (params LocalQuorum (cnv, usr))) +member conv usr = do + mconv <- retry x1 $ query1 Cql.selectConv (params LocalQuorum (Identity conv)) + case mconv of + Just (GlobalTeamConv, _, _, _, _, _, _, _, _, _, _, _, _, _) -> + pure $ toMemberFromId usr + _ -> do + fmap (toMember =<<) $ + retry x1 $ + query1 Cql.selectMember (params LocalQuorum (conv, usr)) -- | Set local users as belonging to a remote conversation. This is invoked by a -- remote galley when users from the current backend are added to conversations diff --git a/services/galley/src/Galley/Cassandra/Queries.hs b/services/galley/src/Galley/Cassandra/Queries.hs index 125b5da35c..2dabd2ab72 100644 --- a/services/galley/src/Galley/Cassandra/Queries.hs +++ b/services/galley/src/Galley/Cassandra/Queries.hs @@ -203,7 +203,7 @@ selectConv :: R (Identity ConvId) ( ConvType, - UserId, + Maybe UserId, Maybe (C.Set Access), Maybe AccessRoleLegacy, Maybe (C.Set AccessRoleV2), @@ -266,8 +266,8 @@ insertMLSSelfConv = <> show (fromEnum ProtocolMLSTag) <> ", ?, ?)" -insertGlobalTeamConv :: PrepQuery W (ConvId, C.Set Access, Text, TeamId, UserId, Maybe GroupId, Maybe CipherSuiteTag) () -insertGlobalTeamConv = "insert into conversation (conv, type, access, name, team, creator, group_id, cipher_suite) values (?, 4, ?, ?, ?, ?, ?, ?)" +insertGlobalTeamConv :: PrepQuery W (ConvId, C.Set Access, Text, TeamId, Maybe GroupId, Maybe CipherSuiteTag) () +insertGlobalTeamConv = "insert into conversation (conv, type, access, name, team, group_id, cipher_suite) values (?, 4, ?, ?, ?, ?, ?)" setGlobalTeamConvCreator :: PrepQuery W (UserId, ConvId) () setGlobalTeamConvCreator = "update conversation set creator = ? where conv = ?" diff --git a/services/galley/src/Galley/Effects/ConversationStore.hs b/services/galley/src/Galley/Effects/ConversationStore.hs index c2b19579f3..6c6ac31b08 100644 --- a/services/galley/src/Galley/Effects/ConversationStore.hs +++ b/services/galley/src/Galley/Effects/ConversationStore.hs @@ -85,7 +85,7 @@ data ConversationStore m a where GetConversation :: ConvId -> ConversationStore m (Maybe Conversation) GetGlobalTeamConversation :: Local TeamId -> ConversationStore m (Maybe GlobalTeamConversation) GetGlobalTeamConversationById :: Local ConvId -> ConversationStore m (Maybe GlobalTeamConversation) - CreateGlobalTeamConversation :: Local TeamId -> UserId -> ConversationStore m GlobalTeamConversation + CreateGlobalTeamConversation :: Local TeamId -> ConversationStore m GlobalTeamConversation SetGlobalTeamConversationCreator :: GlobalTeamConversation -> UserId -> ConversationStore m () GetConversationIdByGroupId :: GroupId -> ConversationStore m (Maybe (Qualified ConvId)) GetConversations :: [ConvId] -> ConversationStore m [Conversation] diff --git a/services/galley/test/integration/API/MLS.hs b/services/galley/test/integration/API/MLS.hs index fe2435fc68..2483c66cee 100644 --- a/services/galley/test/integration/API/MLS.hs +++ b/services/galley/test/integration/API/MLS.hs @@ -1,4 +1,4 @@ -{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} +{-# OPTIONS_GHC -Wno-incomplete-uni-patterns -Wno-unused-imports #-} -- This file is part of the Wire Server implementation. -- @@ -45,6 +45,7 @@ import Data.Singletons import Data.String.Conversions import qualified Data.Text as T import Data.Time +import Debug.Trace import Federator.MockServer hiding (withTempMockFederator) import Galley.Data.Conversation import Galley.Options @@ -198,7 +199,8 @@ tests s = [ test s "Non-existing team returns 403" testGetGlobalTeamConvNonExistant, test s "Non member of team returns 403" testGetGlobalTeamConvNonMember, 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 "Can't leave global team conversation" testGlobalTeamConversationLeave, + test s "Send message in global team conversation" testGlobalTeamConversationMessage ], testGroup "Self conversation" @@ -399,7 +401,7 @@ testAddUserWithBundleIncompleteWelcome = do bundle <- createBundle commit err <- responseJsonError - =<< postCommitBundle (ciUser (mpSender commit)) bundle + =<< postCommitBundle (mpSender commit) bundle getGroupInfo (ciUser alice1) qcnv mp <- createExternalCommit bob1 (Just pgs) qcnv bundle <- createBundle mp - postCommitBundle (ciUser (mpSender mp)) bundle + postCommitBundle (mpSender mp) bundle !!! const 404 === statusCode testExternalCommitSameClient :: TestM () @@ -2156,10 +2158,9 @@ testRemoteUserPostsCommitBundle = do testGetGlobalTeamConvNonExistant :: TestM () testGetGlobalTeamConvNonExistant = do uid <- randomUser - cid <- Util.randomClient uid (head Util.someLastPrekeys) tid <- randomId -- authorisation fails b/c not a team member - getGlobalTeamConv uid cid tid !!! const 403 === statusCode + getGlobalTeamConv uid tid !!! const 403 === statusCode testGetGlobalTeamConvNonMember :: TestM () testGetGlobalTeamConvNonMember = do @@ -2172,8 +2173,7 @@ testGetGlobalTeamConvNonMember = do -- authorisation fails b/c not a team member uid <- randomUser - cid <- Util.randomClient uid (head Util.someLastPrekeys) - getGlobalTeamConv uid cid tid !!! const 403 === statusCode + getGlobalTeamConv uid tid !!! const 403 === statusCode testGetGlobalTeamConv :: IO TestSetup -> TestM () testGetGlobalTeamConv setup = do @@ -2187,8 +2187,7 @@ testGetGlobalTeamConv setup = do s <- liftIO setup let domain = s ^. tsGConf . optSettings . setFederationDomain - cid <- Util.randomClient owner (head Util.someLastPrekeys) - let response = getGlobalTeamConv owner cid tid response let convoId = globalTeamConv tid lconv = toLocalUnsafe domain convoId @@ -2196,7 +2195,7 @@ testGetGlobalTeamConv setup = do GlobalTeamConversation (qUntagged lconv) ( GlobalTeamConversationMetadata - { gtcmCreator = Just owner, + { gtcmCreator = Nothing, gtcmAccess = [SelfInviteAccess], gtcmName = "Global team conversation", gtcmTeam = tid @@ -2210,6 +2209,63 @@ testGetGlobalTeamConv setup = do let cm = Aeson.decode rs :: Maybe GlobalTeamConversation liftIO $ assertEqual "conversation metadata" cm (Just expected) +testGlobalTeamConversationMessage :: TestM () +testGlobalTeamConversationMessage = do + alice <- randomQualifiedUser + let aliceUnq = qUnqualified alice + + tid <- createBindingTeamInternal "sample-team" aliceUnq + team <- getTeam aliceUnq tid + assertQueue "create team" tActivate + liftIO $ assertEqual "owner" aliceUnq (team ^. teamCreator) + assertQueueEmpty + + runMLSTest $ do + clients@[alice1, alice2, alice3] <- traverse createMLSClient (replicate 3 alice) + + let response = getGlobalTeamConv aliceUnq tid response + let (Just gtc) = Aeson.decode rs :: Maybe GlobalTeamConversation + qcnv = gtcId gtc + gid = cnvmlsGroupId $ gtcMlsMetadata gtc + + traverse_ uploadNewKeyPackage clients + + createGroup alice1 gid + void $ createAddCommit alice1 [] >>= sendAndConsumeCommitBundle + + pgs <- + LBS.toStrict . fromJust . responseBody + <$> getGroupInfo (ciUser alice1) qcnv + void $ createExternalCommit alice2 (Just pgs) qcnv >>= sendAndConsumeCommitBundle + + -- FUTUREWORK: add tests for race conditions when adding two commits with same epoch? + -- TODO(elland): test racing conditions for get global team conv + pgs' <- + LBS.toStrict . fromJust . responseBody + <$> getGroupInfo (ciUser alice1) qcnv + void $ createExternalCommit alice3 (Just pgs') qcnv >>= sendAndConsumeCommitBundle + + do + message <- createApplicationMessage alice1 "some text" + + mlsBracket [alice2, alice3] $ \wss -> do + events <- sendAndConsumeMessage message + liftIO $ events @?= [] + liftIO $ + WS.assertMatchN_ (5 # WS.Second) wss $ + wsAssertMLSMessage qcnv alice (mpMessage message) + + do + message <- createApplicationMessage alice2 "some text new" + + mlsBracket [alice1, alice3] $ \wss -> do + events <- sendAndConsumeMessage message + liftIO $ events @?= [] + liftIO $ + WS.assertMatchN_ (5 # WS.Second) wss $ + wsAssertMLSMessage qcnv alice (mpMessage message) + testGlobalTeamConversationLeave :: TestM () testGlobalTeamConversationLeave = do alice <- randomQualifiedUser @@ -2224,13 +2280,14 @@ testGlobalTeamConversationLeave = do runMLSTest $ do alice1 <- createMLSClient alice - let response = getGlobalTeamConv aliceUnq (ciClient alice1) tid response let (Just gtc) = Aeson.decode rs :: Maybe GlobalTeamConversation gid = cnvmlsGroupId $ gtcMlsMetadata gtc void $ uploadNewKeyPackage alice1 createGroup alice1 gid + void $ createAddCommit alice1 [] >>= sendAndConsumeCommitBundle mlsBracket [alice1] $ \wss -> do liftTest $ deleteMemberQualified (qUnqualified alice) alice (gtcId gtc) diff --git a/services/galley/test/integration/API/MLS/Util.hs b/services/galley/test/integration/API/MLS/Util.hs index 5e2c332550..59d9e89be1 100644 --- a/services/galley/test/integration/API/MLS/Util.hs +++ b/services/galley/test/integration/API/MLS/Util.hs @@ -130,7 +130,7 @@ postCommitBundle :: MonadHttp m, HasGalley m ) => - UserId -> + ClientIdentity -> ByteString -> m ResponseLBS postCommitBundle sender bundle = do @@ -138,7 +138,8 @@ postCommitBundle sender bundle = do post ( galley . paths ["mls", "commit-bundles"] - . zUser sender + . zUser (ciUser sender) + . zClient (ciClient sender) . zConn "conn" . content "application/x-protobuf" . bytes bundle @@ -641,13 +642,13 @@ createAddCommitWithKeyPackages qcid clientsAndKeyPackages = do { mlsNewMembers = Set.fromList (map fst clientsAndKeyPackages) } - welcome <- liftIO $ BS.readFile welcomeFile + welcome <- liftIO $ readWelcome welcomeFile pgs <- liftIO $ BS.readFile pgsFile pure $ MessagePackage { mpSender = qcid, mpMessage = commit, - mpWelcome = Just welcome, + mpWelcome = welcome, mpPublicGroupState = Just pgs } @@ -862,7 +863,7 @@ sendAndConsumeCommit mp = do pure events -mkBundle :: MessagePackage -> Either Text CommitBundle +mkBundle :: HasCallStack => MessagePackage -> Either Text CommitBundle mkBundle mp = do commitB <- decodeMLS' (mpMessage mp) welcomeB <- traverse decodeMLS' (mpWelcome mp) @@ -872,7 +873,7 @@ mkBundle mp = do CommitBundle commitB welcomeB $ GroupInfoBundle UnencryptedGroupInfo TreeFull pgsB -createBundle :: MonadIO m => MessagePackage -> m ByteString +createBundle :: (HasCallStack, MonadIO m) => MessagePackage -> m ByteString createBundle mp = do bundle <- either (liftIO . assertFailure . T.unpack) pure $ @@ -888,7 +889,7 @@ sendAndConsumeCommitBundle mp = do events <- fmap mmssEvents . responseJsonError - =<< postCommitBundle (ciUser (mpSender mp)) bundle + =<< postCommitBundle (mpSender mp) bundle UserId -> - ClientId -> TeamId -> m ResponseLBS -getGlobalTeamConv u cid tid = do +getGlobalTeamConv u tid = do g <- viewGalley get $ g . paths ["teams", toByteString' tid, "conversations", "global"] . zUser u - . zClient cid . zConn "conn" . zType "access" From 2489270a6cb8149e4747eb3718c23499cb948f50 Mon Sep 17 00:00:00 2001 From: Igor Ranieri Date: Thu, 17 Nov 2022 15:44:37 +0000 Subject: [PATCH 04/11] Cleaned up utility function --- services/galley/src/Galley/API/MLS/Util.hs | 20 ++++++++++++-------- 1 file changed, 12 insertions(+), 8 deletions(-) diff --git a/services/galley/src/Galley/API/MLS/Util.hs b/services/galley/src/Galley/API/MLS/Util.hs index 0a1f1264ca..6e5e55c81d 100644 --- a/services/galley/src/Galley/API/MLS/Util.hs +++ b/services/galley/src/Galley/API/MLS/Util.hs @@ -28,7 +28,6 @@ import Galley.Effects.MemberStore import Galley.Effects.ProposalStore import Imports import Polysemy -import Polysemy.Input import Polysemy.TinyLog (TinyLog) import qualified Polysemy.TinyLog as TinyLog import qualified System.Logger as Log @@ -45,8 +44,7 @@ getLocalConvForUser :: Members '[ ErrorS 'ConvNotFound, ConversationStore, - MemberStore, - Input (Local ()) + MemberStore ] r => Qualified UserId -> @@ -56,20 +54,26 @@ getLocalConvForUser qusr lcnv = do gtc <- getGlobalTeamConversationById lcnv conv <- case gtc of Just conv -> do - -- TODO(elland): clean this up let creator = gtcmCreator . gtcMetadata $ conv localMembers <- getLocalMembers (qUnqualified . gtcId $ conv) - if isNothing creator - then do + -- no creator means the conversation has been setup on backend but not on MLS. + case creator of + Nothing -> do setGlobalTeamConversationCreator conv (qUnqualified qusr) pure $ gtcToConv conv (qUnqualified qusr) localMembers - else pure $ gtcToConv conv (fromJust creator) localMembers + Just creator' -> + pure $ gtcToConv conv creator' localMembers Nothing -> do getConversation (tUnqualified lcnv) >>= noteS @'ConvNotFound -- check that sender is part of conversation - isMember' <- foldQualified lcnv (fmap isJust . getLocalMember (convId conv) . tUnqualified) (fmap isJust . getRemoteMember (convId conv)) qusr + isMember' <- + foldQualified + lcnv + (fmap isJust . getLocalMember (convId conv) . tUnqualified) + (fmap isJust . getRemoteMember (convId conv)) + qusr unless isMember' $ throwS @'ConvNotFound pure conv From 81bfe6f44608a60dbee55c6798df76bdc7a4b168 Mon Sep 17 00:00:00 2001 From: Igor Ranieri Date: Thu, 17 Nov 2022 15:57:57 +0000 Subject: [PATCH 05/11] Another missed spot from ormolu --- libs/wire-api/src/Wire/API/Conversation.hs | 3 ++- services/galley/src/Galley/API/Query.hs | 1 + services/galley/test/integration/API.hs | 3 +-- 3 files changed, 4 insertions(+), 3 deletions(-) diff --git a/libs/wire-api/src/Wire/API/Conversation.hs b/libs/wire-api/src/Wire/API/Conversation.hs index b23282926f..283c6a0a85 100644 --- a/libs/wire-api/src/Wire/API/Conversation.hs +++ b/libs/wire-api/src/Wire/API/Conversation.hs @@ -260,7 +260,8 @@ instance ToSchema Conversation where (description ?~ "A conversation object as returned from the server") $ Conversation <$> cnvQualifiedId .= field "qualified_id" schema - <* (qUnqualified . cnvQualifiedId) .= optional (field "id" (deprecatedSchema "qualified_id" schema)) + <* (qUnqualified . cnvQualifiedId) + .= optional (field "id" (deprecatedSchema "qualified_id" schema)) <*> cnvMetadata .= conversationMetadataObjectSchema <*> cnvMembers .= field "members" schema <*> cnvProtocol .= protocolSchema diff --git a/services/galley/src/Galley/API/Query.hs b/services/galley/src/Galley/API/Query.hs index c5b21ee1dd..80bc0853f6 100644 --- a/services/galley/src/Galley/API/Query.hs +++ b/services/galley/src/Galley/API/Query.hs @@ -110,6 +110,7 @@ import qualified Wire.API.Provider.Bot as Public import qualified Wire.API.Routes.MultiTablePaging as Public import Wire.API.Team.Feature as Public hiding (setStatus) import Wire.Sem.Paging.Cassandra +import qualified Galley.Effects.TeamStore as E getBotConversationH :: Members '[ConversationStore, ErrorS 'ConvNotFound, Input (Local ())] r => diff --git a/services/galley/test/integration/API.hs b/services/galley/test/integration/API.hs index 8476da3284..2d95bbb996 100644 --- a/services/galley/test/integration/API.hs +++ b/services/galley/test/integration/API.hs @@ -3861,8 +3861,7 @@ testOne2OneConversationRequest shouldBeLocal actor desired = do let req = UpsertOne2OneConversationRequest alice bob actor desired Nothing res <- iUpsertOne2OneConversation req - responseJsonError res liftIO $ convId @?= expectedConvId From 4f235e5930c387a71875ad785a1805b29649a1d7 Mon Sep 17 00:00:00 2001 From: Igor Ranieri Date: Mon, 21 Nov 2022 08:49:51 +0000 Subject: [PATCH 06/11] Deleted outdated todo --- services/galley/src/Galley/API/Federation.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/services/galley/src/Galley/API/Federation.hs b/services/galley/src/Galley/API/Federation.hs index 3ff13aaeb6..1ce9c5f337 100644 --- a/services/galley/src/Galley/API/Federation.hs +++ b/services/galley/src/Galley/API/Federation.hs @@ -279,7 +279,7 @@ onConversationUpdated requestingDomain cu = do SConversationMessageTimerUpdateTag -> pure (Just sca, []) SConversationReceiptModeUpdateTag -> pure (Just sca, []) SConversationAccessDataTag -> pure (Just sca, []) - SConversationSelfInviteTag -> pure (Nothing, []) -- TODO(elland): Should not happen. Should we throw? + SConversationSelfInviteTag -> pure (Nothing, []) unless allUsersArePresent $ P.warn $ Log.field "conversation" (toByteString' (F.cuConvId cu)) From 520114df1f8702b27856b064d11f41eb3c8d0132 Mon Sep 17 00:00:00 2001 From: Igor Ranieri Date: Mon, 21 Nov 2022 09:28:56 +0000 Subject: [PATCH 07/11] Removed redundant imports, including missed spots from previous PRs. --- .../test/integration/API/TeamUserSearch.hs | 7 +--- .../brig/test/integration/Federation/Util.hs | 31 +------------- .../federator/src/Federator/InternalServer.hs | 40 +------------------ services/galley/src/Galley/API/MLS/Message.hs | 3 -- services/galley/src/Galley/API/Query.hs | 2 +- services/galley/test/integration/API/MLS.hs | 3 +- .../test/unit/Test/Galley/Intra/User.hs | 1 - tools/db/migrate-sso-feature-flag/src/Work.hs | 4 +- tools/db/move-team/src/Work.hs | 2 +- 9 files changed, 8 insertions(+), 85 deletions(-) diff --git a/services/brig/test/integration/API/TeamUserSearch.hs b/services/brig/test/integration/API/TeamUserSearch.hs index 68c0f00768..26159afdcd 100644 --- a/services/brig/test/integration/API/TeamUserSearch.hs +++ b/services/brig/test/integration/API/TeamUserSearch.hs @@ -1,5 +1,3 @@ -{-# OPTIONS_GHC -Wno-unused-imports #-} - -- This file is part of the Wire Server implementation. -- -- Copyright (C) 2022 Wire Swiss GmbH @@ -24,16 +22,13 @@ import API.Team.Util (createPopulatedBindingTeamWithNamesAndHandles) import API.User.Util (activateEmail, initiateEmailUpdateNoSend) import Bilge (Manager, MonadHttp) import qualified Brig.Options as Opt -import Brig.User.Search.TeamUserSearch (TeamUserSearchSortBy (..), TeamUserSearchSortOrder (..)) import Control.Monad.Catch (MonadCatch) import Control.Retry () -import Data.ByteString.Conversion (ToByteString (..), toByteString) +import Data.ByteString.Conversion (toByteString) import Data.Handle (fromHandle) import Data.Id (TeamId, UserId) -import qualified Data.Map.Strict as M import Data.String.Conversions (cs) import Imports -import System.Random import System.Random.Shuffle (shuffleM) import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit (assertBool, assertEqual) diff --git a/services/brig/test/integration/Federation/Util.hs b/services/brig/test/integration/Federation/Util.hs index dbc08acb71..5c7e1552cb 100644 --- a/services/brig/test/integration/Federation/Util.hs +++ b/services/brig/test/integration/Federation/Util.hs @@ -1,7 +1,6 @@ {-# LANGUAGE PartialTypeSignatures #-} {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} {-# OPTIONS_GHC -Wno-partial-type-signatures #-} -{-# OPTIONS_GHC -Wno-unused-imports #-} -- This file is part of the Wire Server implementation. -- @@ -23,47 +22,19 @@ module Federation.Util where import Bilge -import Bilge.Assert ((!!!), ( lconv) qusr (Set.singleton (creatorClient, creatorRef)) - (Left _, SelfConv, _) -> throw . InternalErrorWithDescription $ "Unexpected creator client set in a self-conversation" @@ -887,11 +886,9 @@ processInternalCommit qusr senderClient con lconv cm epoch groupId action sender (convId <$> lconv) qusr (Set.singleton (creatorClient, creatorRef)) - (Left _, GlobalTeamConv, _) -> 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/Query.hs b/services/galley/src/Galley/API/Query.hs index 80bc0853f6..fabaff7544 100644 --- a/services/galley/src/Galley/API/Query.hs +++ b/services/galley/src/Galley/API/Query.hs @@ -81,6 +81,7 @@ import qualified Galley.Effects.ListItems as E import qualified Galley.Effects.MemberStore as E import Galley.Effects.TeamFeatureStore (FeaturePersistentConstraint) import qualified Galley.Effects.TeamFeatureStore as TeamFeatures +import qualified Galley.Effects.TeamStore as E import Galley.Env import Galley.Options import Galley.Types.Conversations.Members @@ -110,7 +111,6 @@ import qualified Wire.API.Provider.Bot as Public import qualified Wire.API.Routes.MultiTablePaging as Public import Wire.API.Team.Feature as Public hiding (setStatus) import Wire.Sem.Paging.Cassandra -import qualified Galley.Effects.TeamStore as E getBotConversationH :: Members '[ConversationStore, ErrorS 'ConvNotFound, Input (Local ())] r => diff --git a/services/galley/test/integration/API/MLS.hs b/services/galley/test/integration/API/MLS.hs index 2483c66cee..f80b6d8b32 100644 --- a/services/galley/test/integration/API/MLS.hs +++ b/services/galley/test/integration/API/MLS.hs @@ -1,4 +1,4 @@ -{-# OPTIONS_GHC -Wno-incomplete-uni-patterns -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} -- This file is part of the Wire Server implementation. -- @@ -45,7 +45,6 @@ import Data.Singletons import Data.String.Conversions import qualified Data.Text as T import Data.Time -import Debug.Trace import Federator.MockServer hiding (withTempMockFederator) import Galley.Data.Conversation import Galley.Options diff --git a/services/galley/test/unit/Test/Galley/Intra/User.hs b/services/galley/test/unit/Test/Galley/Intra/User.hs index c6bec86487..1138e79f0a 100644 --- a/services/galley/test/unit/Test/Galley/Intra/User.hs +++ b/services/galley/test/unit/Test/Galley/Intra/User.hs @@ -20,7 +20,6 @@ module Test.Galley.Intra.User where --- import Debug.Trace (traceShow) import Galley.Intra.User (chunkify) import Imports import Test.QuickCheck diff --git a/tools/db/migrate-sso-feature-flag/src/Work.hs b/tools/db/migrate-sso-feature-flag/src/Work.hs index 9223659ed1..b8b09cfe8f 100644 --- a/tools/db/migrate-sso-feature-flag/src/Work.hs +++ b/tools/db/migrate-sso-feature-flag/src/Work.hs @@ -2,7 +2,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} -{-# OPTIONS_GHC -Wno-orphans -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-orphans #-} -- This file is part of the Wire Server implementation. -- @@ -28,12 +28,10 @@ import Data.Conduit import Data.Conduit.Internal (zipSources) import qualified Data.Conduit.List as C import Data.Id -import Data.Misc import Galley.Cassandra.Instances () import Imports import System.Logger (Logger) import qualified System.Logger as Log -import UnliftIO.Async (pooledMapConcurrentlyN) import Wire.API.Team.Feature import Wire.API.User diff --git a/tools/db/move-team/src/Work.hs b/tools/db/move-team/src/Work.hs index a10a9a13f8..8ec807152f 100644 --- a/tools/db/move-team/src/Work.hs +++ b/tools/db/move-team/src/Work.hs @@ -4,7 +4,7 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} -{-# OPTIONS_GHC -Wno-orphans -Wno-unused-imports #-} +{-# OPTIONS_GHC -Wno-orphans #-} -- This file is part of the Wire Server implementation. -- From e3df592922b888f22e656c62954ff18c0867adfc Mon Sep 17 00:00:00 2001 From: Igor Ranieri Date: Mon, 21 Nov 2022 15:10:58 +0000 Subject: [PATCH 08/11] Simplify code / feedback from review --- .../Wire/API/MLS/GlobalTeamConversation.hs | 41 ++++++-------- services/galley/src/Galley/API/Action.hs | 28 ++-------- services/galley/src/Galley/API/MLS/Message.hs | 41 +++++++------- services/galley/src/Galley/API/MLS/Util.hs | 53 +++++++++--------- .../src/Galley/Cassandra/Conversation.hs | 54 +++++-------------- services/galley/test/integration/API/MLS.hs | 12 ++--- 6 files changed, 87 insertions(+), 142 deletions(-) diff --git a/libs/wire-api/src/Wire/API/MLS/GlobalTeamConversation.hs b/libs/wire-api/src/Wire/API/MLS/GlobalTeamConversation.hs index 83ca7a5116..f9f1096860 100644 --- a/libs/wire-api/src/Wire/API/MLS/GlobalTeamConversation.hs +++ b/libs/wire-api/src/Wire/API/MLS/GlobalTeamConversation.hs @@ -33,8 +33,11 @@ import Wire.Arbitrary (Arbitrary (..), GenericUniform (..)) -- Protocol is also implicit: it's always MLS. data GlobalTeamConversation = GlobalTeamConversation { gtcId :: Qualified ConvId, - gtcMetadata :: GlobalTeamConversationMetadata, - gtcMlsMetadata :: ConversationMLSData + gtcMlsMetadata :: ConversationMLSData, + gtcCreator :: Maybe UserId, + gtcAccess :: [Access], + gtcName :: Text, + gtcTeam :: TeamId } deriving stock (Eq, Show, Generic) deriving (Arbitrary) via (GenericUniform GlobalTeamConversation) @@ -47,28 +50,14 @@ instance ToSchema GlobalTeamConversation where (description ?~ "The global team conversation object as returned from the server") $ GlobalTeamConversation <$> gtcId .= field "qualified_id" schema - <*> gtcMetadata .= gtcMetadataSchema <*> gtcMlsMetadata .= mlsDataSchema - -data GlobalTeamConversationMetadata = GlobalTeamConversationMetadata - { gtcmCreator :: Maybe UserId, - gtcmAccess :: [Access], - gtcmName :: Text, - gtcmTeam :: TeamId - } - deriving stock (Eq, Show, Generic) - deriving (Arbitrary) via (GenericUniform GlobalTeamConversationMetadata) - -gtcMetadataSchema :: ObjectSchema SwaggerDoc GlobalTeamConversationMetadata -gtcMetadataSchema = - GlobalTeamConversationMetadata - <$> gtcmCreator - .= maybe_ - ( optFieldWithDocModifier - "creator" - (description ?~ "The creator's user ID") - schema - ) - <*> gtcmAccess .= field "access" (array schema) - <*> gtcmName .= field "name" schema - <*> gtcmTeam .= field "team" schema + <*> gtcCreator + .= maybe_ + ( optFieldWithDocModifier + "creator" + (description ?~ "The creator's user ID") + schema + ) + <*> gtcAccess .= field "access" (array schema) + <*> gtcName .= field "name" schema + <*> gtcTeam .= field "team" schema diff --git a/services/galley/src/Galley/API/Action.hs b/services/galley/src/Galley/API/Action.hs index 3d4c000d9f..f55fe65e32 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 @@ -283,7 +284,7 @@ ensureAllowed tag loc action conv origUser = do (convType conv == GlobalTeamConv) $ throwS @'InvalidOperation SConversationLeaveTag -> - when (convType conv == GlobalTeamConv) $ do + when (convType conv == GlobalTeamConv) $ throwS @'InvalidOperation _ -> pure () @@ -600,12 +601,12 @@ updateLocalConversation lcnv qusr con action = do -- Check if global or not, if global, map it to conversation E.getGlobalTeamConversationById lcnv >>= \case Just gtc -> - let c = (gtcmCreator . gtcMetadata $ gtc) + let c = gtcCreator gtc in case c of Nothing -> throwS @'ConvNotFound Just creator -> - pure $ gtcToConv creator gtc + pure $ globalTeamConvToConversation gtc creator mempty Nothing -> getConversationWithError lcnv -- check that the action does not bypass the underlying protocol @@ -614,27 +615,6 @@ updateLocalConversation lcnv qusr con action = do -- perform all authorisation checks and, if successful, the update itself updateLocalConversationUnchecked @tag (qualifyAs lcnv conv) qusr con action - where - gtcToConv creator gtc = - let meta = gtcMetadata gtc - in Conversation - { convId = qUnqualified $ gtcId gtc, - convLocalMembers = mempty, - convRemoteMembers = mempty, - convDeleted = False, - convMetadata = - ConversationMetadata - { cnvmType = GlobalTeamConv, - cnvmCreator = creator, - cnvmAccess = [SelfInviteAccess], - cnvmAccessRoles = mempty, - cnvmName = Just $ gtcmName meta, - cnvmTeam = Just $ gtcmTeam meta, - cnvmMessageTimer = Nothing, - cnvmReceiptMode = Nothing - }, - convProtocol = ProtocolMLS (gtcMlsMetadata gtc) - } -- | Similar to 'updateLocalConversationWithLocalUser', but takes a -- 'Conversation' value directly, instead of a 'ConvId', and skips protocol diff --git a/services/galley/src/Galley/API/MLS/Message.hs b/services/galley/src/Galley/API/MLS/Message.hs index e515950c43..324479651c 100644 --- a/services/galley/src/Galley/API/MLS/Message.hs +++ b/services/galley/src/Galley/API/MLS/Message.hs @@ -479,7 +479,7 @@ postMLSMessageToLocalConv qusr senderClient con smsg lcnv = case rmValue smsg of gtc <- getGlobalTeamConversationById lcnv conv <- case gtc of Just conv -> do - when (isNothing (gtcmCreator $ gtcMetadata $ conv)) $ do + when (isNothing (gtcCreator conv)) $ do setGlobalTeamConversationCreator conv (qUnqualified qusr) localMembers <- getLocalMembers (qUnqualified . gtcId $ conv) pure $ gtcToConv conv localMembers @@ -509,26 +509,25 @@ postMLSMessageToLocalConv qusr senderClient con smsg lcnv = case rmValue smsg of pure events where gtcToConv gtc lm = - let meta = gtcMetadata gtc - in Data.Conversation - { convId = qUnqualified $ gtcId gtc, - -- FUTUREWORK: Look into reworking things if needed for performance - convLocalMembers = lm, - convRemoteMembers = mempty, - convDeleted = False, - convMetadata = - ConversationMetadata - { cnvmType = GlobalTeamConv, - cnvmCreator = fromJust . gtcmCreator . gtcMetadata $ gtc, - cnvmAccess = gtcmAccess meta, - cnvmAccessRoles = mempty, - cnvmName = Just (gtcmName meta), - cnvmTeam = Just (gtcmTeam meta), - cnvmMessageTimer = Nothing, - cnvmReceiptMode = Nothing - }, - convProtocol = ProtocolMLS (gtcMlsMetadata gtc) - } + Data.Conversation + { convId = qUnqualified $ gtcId gtc, + -- FUTUREWORK: Look into reworking things if needed for performance + convLocalMembers = lm, + convRemoteMembers = mempty, + convDeleted = False, + convMetadata = + ConversationMetadata + { cnvmType = GlobalTeamConv, + cnvmCreator = fromJust . gtcCreator $ gtc, + cnvmAccess = gtcAccess gtc, + cnvmAccessRoles = mempty, + cnvmName = Just (gtcName gtc), + cnvmTeam = Just (gtcTeam gtc), + cnvmMessageTimer = Nothing, + cnvmReceiptMode = Nothing + }, + convProtocol = ProtocolMLS (gtcMlsMetadata gtc) + } postMLSMessageToRemoteConv :: ( Members MLSMessageStaticErrors r, diff --git a/services/galley/src/Galley/API/MLS/Util.hs b/services/galley/src/Galley/API/MLS/Util.hs index 6e5e55c81d..0fefb44af1 100644 --- a/services/galley/src/Galley/API/MLS/Util.hs +++ b/services/galley/src/Galley/API/MLS/Util.hs @@ -26,6 +26,7 @@ import Galley.Effects import Galley.Effects.ConversationStore import Galley.Effects.MemberStore import Galley.Effects.ProposalStore +import Galley.Types.Conversations.Members import Imports import Polysemy import Polysemy.TinyLog (TinyLog) @@ -40,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, @@ -54,16 +80,16 @@ getLocalConvForUser qusr lcnv = do gtc <- getGlobalTeamConversationById lcnv conv <- case gtc of Just conv -> do - let creator = gtcmCreator . gtcMetadata $ conv + let creator = gtcCreator conv localMembers <- getLocalMembers (qUnqualified . gtcId $ conv) -- no creator means the conversation has been setup on backend but not on MLS. case creator of Nothing -> do setGlobalTeamConversationCreator conv (qUnqualified qusr) - pure $ gtcToConv conv (qUnqualified qusr) localMembers + pure $ globalTeamConvToConversation conv (qUnqualified qusr) localMembers Just creator' -> - pure $ gtcToConv conv creator' localMembers + pure $ globalTeamConvToConversation conv creator' localMembers Nothing -> do getConversation (tUnqualified lcnv) >>= noteS @'ConvNotFound @@ -77,27 +103,6 @@ getLocalConvForUser qusr lcnv = do unless isMember' $ throwS @'ConvNotFound pure conv - where - gtcToConv gtc creator lMembers = - let meta = gtcMetadata gtc - in Conversation - { convId = qUnqualified $ gtcId gtc, - convLocalMembers = lMembers, - convRemoteMembers = mempty, - convDeleted = False, - convMetadata = - ConversationMetadata - { cnvmType = GlobalTeamConv, - cnvmCreator = creator, - cnvmAccess = gtcmAccess meta, - cnvmAccessRoles = mempty, - cnvmName = Just (gtcmName meta), - cnvmTeam = Just (gtcmTeam meta), - cnvmMessageTimer = Nothing, - cnvmReceiptMode = Nothing - }, - convProtocol = ProtocolMLS (gtcMlsMetadata gtc) - } getPendingBackendRemoveProposals :: Members '[ProposalStore, TinyLog] r => diff --git a/services/galley/src/Galley/Cassandra/Conversation.hs b/services/galley/src/Galley/Cassandra/Conversation.hs index 1a013e4ceb..dac40f8114 100644 --- a/services/galley/src/Galley/Cassandra/Conversation.hs +++ b/services/galley/src/Galley/Cassandra/Conversation.hs @@ -255,28 +255,9 @@ getConversation conv = do getGlobalTeamConversation :: Local TeamId -> Client (Maybe GlobalTeamConversation) -getGlobalTeamConversation qtid = do - let tid = tUnqualified qtid - cid = globalTeamConv tid - mconv <- retry x1 (query1 Cql.selectGlobalTeamConv (params LocalQuorum (Identity cid))) - pure $ toGlobalConv cid tid mconv - where - toGlobalConv cid tid mconv = do - (muid, mname, _mtid, mgid, mepoch, mcs) <- mconv - mlsData <- ConversationMLSData <$> mgid <*> (mepoch <|> Just (Epoch 0)) <*> mcs - name <- mname - - pure $ - GlobalTeamConversation - (qUntagged $ qualifyAs qtid cid) - ( GlobalTeamConversationMetadata - { gtcmCreator = muid, - gtcmAccess = [SelfInviteAccess], - gtcmName = name, - gtcmTeam = tid - } - ) - mlsData +getGlobalTeamConversation qtid = + let cid = qualifyAs qtid (globalTeamConv (tUnqualified qtid)) + in getGlobalTeamConversationById cid getGlobalTeamConversationById :: Local ConvId -> @@ -295,27 +276,17 @@ getGlobalTeamConversationById lconv = do pure $ GlobalTeamConversation (qUntagged lconv) - ( GlobalTeamConversationMetadata - { gtcmCreator = muid, - gtcmAccess = [SelfInviteAccess], - gtcmName = name, - gtcmTeam = tid - } - ) mlsData + muid + [SelfInviteAccess] + name + tid createGlobalTeamConversation :: Local TeamId -> Client GlobalTeamConversation createGlobalTeamConversation tid = do let lconv = qualifyAs tid (globalTeamConv $ tUnqualified tid) - meta = - GlobalTeamConversationMetadata - { gtcmCreator = Nothing, - gtcmAccess = [SelfInviteAccess], - gtcmName = "Global team conversation", - gtcmTeam = tUnqualified tid - } gid = convToGroupId lconv cs = MLS_128_DHKEMX25519_AES128GCM_SHA256_Ed25519 retry x5 . batch $ do @@ -324,9 +295,9 @@ createGlobalTeamConversation tid = do addPrepQuery Cql.insertGlobalTeamConv ( tUnqualified lconv, - Cql.Set (gtcmAccess meta), - gtcmName meta, - gtcmTeam meta, + Cql.Set [SelfInviteAccess], + "Global team conversation", + tUnqualified tid, Just gid, Just cs ) @@ -335,12 +306,15 @@ createGlobalTeamConversation tid = do pure $ GlobalTeamConversation (qUntagged lconv) - meta ( ConversationMLSData gid (Epoch 0) cs ) + Nothing + [SelfInviteAccess] + "Global team conversation" + (tUnqualified tid) setGlobalTeamConversationCreator :: GlobalTeamConversation -> diff --git a/services/galley/test/integration/API/MLS.hs b/services/galley/test/integration/API/MLS.hs index f80b6d8b32..d64d205644 100644 --- a/services/galley/test/integration/API/MLS.hs +++ b/services/galley/test/integration/API/MLS.hs @@ -2193,18 +2193,16 @@ testGetGlobalTeamConv setup = do expected = GlobalTeamConversation (qUntagged lconv) - ( GlobalTeamConversationMetadata - { gtcmCreator = Nothing, - gtcmAccess = [SelfInviteAccess], - gtcmName = "Global team conversation", - gtcmTeam = tid - } - ) ( ConversationMLSData (convToGroupId lconv) (Epoch 0) MLS_128_DHKEMX25519_AES128GCM_SHA256_Ed25519 ) + Nothing + [SelfInviteAccess] + "Global team conversation" + tid + let cm = Aeson.decode rs :: Maybe GlobalTeamConversation liftIO $ assertEqual "conversation metadata" cm (Just expected) From 1517fb974f2f0c6c7fb73bc766e5120a1850dae2 Mon Sep 17 00:00:00 2001 From: Igor Ranieri Date: Mon, 21 Nov 2022 15:15:06 +0000 Subject: [PATCH 09/11] Extracted function --- services/galley/src/Galley/API/Action.hs | 35 ++++++++++++------------ 1 file changed, 18 insertions(+), 17 deletions(-) diff --git a/services/galley/src/Galley/API/Action.hs b/services/galley/src/Galley/API/Action.hs index f55fe65e32..2acdd7858c 100644 --- a/services/galley/src/Galley/API/Action.hs +++ b/services/galley/src/Galley/API/Action.hs @@ -648,23 +648,7 @@ updateLocalConversationUnchecked lconv qusr con action = do -- retrieve member self <- if (cnvmType . convMetadata . tUnqualified $ lconv) == GlobalTeamConv - then -- TODO(elland): address this problem - - pure . Left $ - LocalMember - { lmId = qUnqualified qusr, - lmStatus = - MemberStatus - { msOtrMutedStatus = Nothing, - msOtrMutedRef = Nothing, - msOtrArchived = False, - msOtrArchivedRef = Nothing, - msHidden = False, - msHiddenRef = Nothing - }, - lmService = Nothing, - lmConvRoleName = roleToRoleName convRoleWireMember - } + then pure $ Left $ localMemberFromUser (qUnqualified qusr) else noteS @'ConvNotFound $ getConvMember lconv conv qusr -- perform checks @@ -685,6 +669,23 @@ updateLocalConversationUnchecked lconv qusr con action = do -- -------------------------------------------------------------------------------- -- -- Utilities +localMemberFromUser :: UserId -> LocalMember +localMemberFromUser uid = + LocalMember + { lmId = uid, + lmStatus = + MemberStatus + { msOtrMutedStatus = Nothing, + msOtrMutedRef = Nothing, + msOtrArchived = False, + msOtrArchivedRef = Nothing, + msHidden = False, + msHiddenRef = Nothing + }, + lmService = Nothing, + lmConvRoleName = roleToRoleName convRoleWireMember + } + ensureConversationActionAllowed :: forall tag mem x r. ( IsConvMember mem, From ba582e2c7fbb3b9fc5e5f37ea7497c1cc28374ad Mon Sep 17 00:00:00 2001 From: Igor Ranieri Date: Tue, 22 Nov 2022 11:45:35 +0000 Subject: [PATCH 10/11] Test listing conversations --- libs/bilge/src/Bilge/Assert.hs | 10 +++++ .../src/Galley/Cassandra/Conversation.hs | 5 +++ services/galley/test/integration/API/MLS.hs | 42 ++++++++++++++++++- 3 files changed, 56 insertions(+), 1 deletion(-) diff --git a/libs/bilge/src/Bilge/Assert.hs b/libs/bilge/src/Bilge/Assert.hs index 2a584e5b6d..512aa0f925 100644 --- a/libs/bilge/src/Bilge/Assert.hs +++ b/libs/bilge/src/Bilge/Assert.hs @@ -26,6 +26,7 @@ module Bilge.Assert (===), (=/=), (=~=), + (=/~=), assertResponse, assertTrue, assertTrue_, @@ -141,6 +142,15 @@ f =/= g = Assertions $ tell [\r -> test " === " (/=) (f r) (g r)] Assertions () f =~= g = Assertions $ tell [\r -> test " not in " contains (f r) (g r)] +-- | Tests the assertion that the left-hand side is **not** contained in the right-hand side. +-- If it is, actual values will be printed. +(=/~=) :: + (HasCallStack, Show a, Contains a) => + (Response (Maybe Lazy.ByteString) -> a) -> + (Response (Maybe Lazy.ByteString) -> a) -> + Assertions () +f =/~= g = Assertions $ tell [\r -> test " in " ((not .) . contains) (f r) (g r)] + -- | Most generic assertion on a request. If the test function evaluates to -- @(Just msg)@ then the assertion fails with the error message @msg@. assertResponse :: HasCallStack => (Response (Maybe Lazy.ByteString) -> Maybe String) -> Assertions () diff --git a/services/galley/src/Galley/Cassandra/Conversation.hs b/services/galley/src/Galley/Cassandra/Conversation.hs index dac40f8114..d02ecbc473 100644 --- a/services/galley/src/Galley/Cassandra/Conversation.hs +++ b/services/galley/src/Galley/Cassandra/Conversation.hs @@ -329,6 +329,11 @@ setGlobalTeamConversationCreator gtc uid = do ( 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 diff --git a/services/galley/test/integration/API/MLS.hs b/services/galley/test/integration/API/MLS.hs index d64d205644..623766cdb4 100644 --- a/services/galley/test/integration/API/MLS.hs +++ b/services/galley/test/integration/API/MLS.hs @@ -199,7 +199,8 @@ tests s = test s "Non member of team returns 403" testGetGlobalTeamConvNonMember, 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 "Send message in global team conversation" testGlobalTeamConversationMessage, + test s "Listing convs includes global team conversation" testConvListIncludesGlobal ], testGroup "Self conversation" @@ -2206,6 +2207,45 @@ testGetGlobalTeamConv setup = do let cm = Aeson.decode rs :: Maybe GlobalTeamConversation liftIO $ assertEqual "conversation metadata" cm (Just expected) +testConvListIncludesGlobal :: TestM () +testConvListIncludesGlobal = do + aliceQ <- randomQualifiedUser + let alice = qUnqualified aliceQ + tid <- createBindingTeamInternal "sample-team" alice + team <- getTeam alice tid + assertQueue "create team" tActivate + liftIO $ assertEqual "alice" alice (team ^. teamCreator) + assertQueueEmpty + + -- global team conv doesn't yet include user + let paginationOpts = GetPaginatedConversationIds Nothing (toRange (Proxy @5)) + listConvIds alice paginationOpts !!! do + const 200 === statusCode + const (Just [globalTeamConv tid]) =/~= (rightToMaybe . (<$$>) qUnqualified . decodeQualifiedConvIdList) + + -- add user to conv + runMLSTest $ do + alice1 <- createMLSClient aliceQ + + let response = getGlobalTeamConv alice tid response + let (Just gtc) = Aeson.decode rs :: Maybe GlobalTeamConversation + gid = cnvmlsGroupId $ gtcMlsMetadata gtc + + void $ uploadNewKeyPackage alice1 + + -- create mls group + createGroup alice1 gid + void $ createAddCommit alice1 [] >>= sendAndConsumeCommitBundle + + -- 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]) =~= (rightToMaybe . (<$$>) qUnqualified . decodeQualifiedConvIdList) + +rightToMaybe :: Either a b -> Maybe b +rightToMaybe = either (const Nothing) Just + testGlobalTeamConversationMessage :: TestM () testGlobalTeamConversationMessage = do alice <- randomQualifiedUser From 2aafc6f742e0cccdc18a928d1a59ce6484198407 Mon Sep 17 00:00:00 2001 From: Igor Ranieri Date: Wed, 23 Nov 2022 07:28:17 +0000 Subject: [PATCH 11/11] Revert redundant changes now that member list is fetched. --- services/galley/src/Galley/API/MLS/Message.hs | 32 +------------------ 1 file changed, 1 insertion(+), 31 deletions(-) diff --git a/services/galley/src/Galley/API/MLS/Message.hs b/services/galley/src/Galley/API/MLS/Message.hs index 324479651c..d3d259c880 100644 --- a/services/galley/src/Galley/API/MLS/Message.hs +++ b/services/galley/src/Galley/API/MLS/Message.hs @@ -79,7 +79,6 @@ import Wire.API.MLS.CipherSuite import Wire.API.MLS.Commit import Wire.API.MLS.CommitBundle import Wire.API.MLS.Credential -import Wire.API.MLS.GlobalTeamConversation import Wire.API.MLS.GroupInfoBundle import Wire.API.MLS.KeyPackage import Wire.API.MLS.Message @@ -476,15 +475,7 @@ postMLSMessageToLocalConv :: Sem r [LocalConversationUpdate] postMLSMessageToLocalConv qusr senderClient con smsg lcnv = case rmValue smsg of SomeMessage tag msg -> do - gtc <- getGlobalTeamConversationById lcnv - conv <- case gtc of - Just conv -> do - when (isNothing (gtcCreator conv)) $ do - setGlobalTeamConversationCreator conv (qUnqualified qusr) - localMembers <- getLocalMembers (qUnqualified . gtcId $ conv) - pure $ gtcToConv conv localMembers - Nothing -> - getLocalConvForUser qusr lcnv + conv <- getLocalConvForUser qusr lcnv -- construct client map cm <- lookupMLSClients lcnv @@ -507,27 +498,6 @@ postMLSMessageToLocalConv qusr senderClient con smsg lcnv = case rmValue smsg of propagateMessage qusr lconv cm con (rmRaw smsg) pure events - where - gtcToConv gtc lm = - Data.Conversation - { convId = qUnqualified $ gtcId gtc, - -- FUTUREWORK: Look into reworking things if needed for performance - convLocalMembers = lm, - convRemoteMembers = mempty, - convDeleted = False, - convMetadata = - ConversationMetadata - { cnvmType = GlobalTeamConv, - cnvmCreator = fromJust . gtcCreator $ gtc, - cnvmAccess = gtcAccess gtc, - cnvmAccessRoles = mempty, - cnvmName = Just (gtcName gtc), - cnvmTeam = Just (gtcTeam gtc), - cnvmMessageTimer = Nothing, - cnvmReceiptMode = Nothing - }, - convProtocol = ProtocolMLS (gtcMlsMetadata gtc) - } postMLSMessageToRemoteConv :: ( Members MLSMessageStaticErrors r,