From 090e762ec0a2026a266c1fd2a288301b3759d92f Mon Sep 17 00:00:00 2001 From: Stefan Matting Date: Fri, 9 Dec 2022 15:48:33 +0100 Subject: [PATCH] Remove Global Team Conversations (#2916) * Revert "[FS-1267] Patch issue with initial commit bundle throwing a global team conversation error (#2887)" This reverts commit 1cc2bd2d1d0fe5b9842cd212576d2a9bab10825b. * Revert "Commented out GTC for release. (#2879)" This reverts commit 49da31089f63fcf9f744299f907ef07436c35fcb. * Revert "Improve global team conversation handling and self conversation creation error. (#2862)" This reverts commit 381bf7b3fc0e5e8099da95760d27a30038a8c8ab. * Revert "[FS-926] Create new conversation type for global team conversation (#2753)" This reverts commit c4c9ea298ad8db2dac8b931f6f7a3178c7f2e626. --- libs/bilge/src/Bilge/Assert.hs | 10 - libs/wire-api/src/Wire/API/Conversation.hs | 19 +- .../src/Wire/API/Conversation/Action.hs | 5 - .../src/Wire/API/Conversation/Action/Tag.hs | 2 - .../src/Wire/API/Conversation/Protocol.hs | 1 - .../src/Wire/API/Conversation/Role.hs | 1 - libs/wire-api/src/Wire/API/Error/Galley.hs | 3 - .../Wire/API/MLS/GlobalTeamConversation.hs | 63 ----- .../API/Routes/Public/Galley/Conversation.hs | 12 - .../src/Wire/API/Routes/Public/Galley/MLS.hs | 3 - .../src/Wire/API/Routes/Public/Galley/Team.hs | 2 +- libs/wire-api/wire-api.cabal | 1 - nix/pkgs/mls-test-cli/default.nix | 4 +- services/brig/src/Brig/RPC.hs | 3 - .../brig/test/integration/API/Provider.hs | 14 +- .../brig/test/integration/Federation/Util.hs | 31 +- services/brig/test/integration/Util.hs | 2 +- .../federator/src/Federator/InternalServer.hs | 40 ++- services/galley/src/Galley/API/Action.hs | 65 +---- services/galley/src/Galley/API/Federation.hs | 6 +- services/galley/src/Galley/API/Internal.hs | 46 ++- services/galley/src/Galley/API/MLS/Message.hs | 180 +++++------- services/galley/src/Galley/API/MLS/Util.hs | 49 +--- .../src/Galley/API/Public/Conversation.hs | 1 - services/galley/src/Galley/API/Query.hs | 43 +-- services/galley/src/Galley/API/Teams.hs | 44 ++- services/galley/src/Galley/API/Util.hs | 22 +- .../galley/src/Galley/Cassandra/Access.hs | 1 - .../galley/src/Galley/Cassandra/Client.hs | 5 +- .../src/Galley/Cassandra/Conversation.hs | 70 ----- .../Galley/Cassandra/Conversation/Members.hs | 44 +-- .../galley/src/Galley/Cassandra/Instances.hs | 4 - .../galley/src/Galley/Cassandra/Queries.hs | 20 -- services/galley/src/Galley/Cassandra/Team.hs | 19 +- .../galley/src/Galley/Data/Conversation.hs | 4 - .../src/Galley/Effects/ConversationStore.hs | 7 - services/galley/test/integration/API.hs | 28 +- .../galley/test/integration/API/Federation.hs | 2 - services/galley/test/integration/API/MLS.hs | 265 +----------------- .../galley/test/integration/API/MLS/Util.hs | 21 +- services/galley/test/integration/API/Teams.hs | 17 +- .../test/integration/API/Teams/Feature.hs | 4 +- services/galley/test/integration/API/Util.hs | 108 +------ .../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 +- 46 files changed, 265 insertions(+), 1033 deletions(-) delete mode 100644 libs/wire-api/src/Wire/API/MLS/GlobalTeamConversation.hs diff --git a/libs/bilge/src/Bilge/Assert.hs b/libs/bilge/src/Bilge/Assert.hs index 512aa0f9251..2a584e5b6d9 100644 --- a/libs/bilge/src/Bilge/Assert.hs +++ b/libs/bilge/src/Bilge/Assert.hs @@ -26,7 +26,6 @@ module Bilge.Assert (===), (=/=), (=~=), - (=/~=), assertResponse, assertTrue, assertTrue_, @@ -142,15 +141,6 @@ 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/libs/wire-api/src/Wire/API/Conversation.hs b/libs/wire-api/src/Wire/API/Conversation.hs index 20ec4756365..e89ae461077 100644 --- a/libs/wire-api/src/Wire/API/Conversation.hs +++ b/libs/wire-api/src/Wire/API/Conversation.hs @@ -25,7 +25,6 @@ module Wire.API.Conversation ConversationMetadata (..), defConversationMetadata, Conversation (..), - conversationMetadataObjectSchema, cnvType, cnvCreator, cnvAccess, @@ -103,7 +102,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, enumerate) +import Data.List.Extra (disjointOrd) import Data.List.NonEmpty (NonEmpty) import Data.List1 import Data.Misc @@ -466,10 +465,6 @@ 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 @@ -482,8 +477,7 @@ instance ToSchema Access where [ element "private" PrivateAccess, element "invite" InviteAccess, element "link" LinkAccess, - element "code" CodeAccess, - element "self_invite" SelfInviteAccess + element "code" CodeAccess ] typeAccess :: Doc.DataType @@ -531,7 +525,6 @@ defRole = activatedAccessRole maybeRole :: ConvType -> Maybe (Set AccessRole) -> Set AccessRole maybeRole SelfConv _ = privateAccessRole -maybeRole GlobalTeamConv _ = teamAccessRole maybeRole ConnectConv _ = privateAccessRole maybeRole One2OneConv _ = privateAccessRole maybeRole RegularConv Nothing = defRole @@ -617,8 +610,7 @@ data ConvType | SelfConv | One2OneConv | ConnectConv - | GlobalTeamConv - deriving stock (Eq, Show, Generic, Enum, Bounded) + deriving stock (Eq, Show, Generic) deriving (Arbitrary) via (GenericUniform ConvType) deriving (FromJSON, ToJSON, S.ToSchema) via Schema ConvType @@ -629,12 +621,11 @@ instance ToSchema ConvType where [ element 0 RegularConv, element 1 SelfConv, element 2 One2OneConv, - element 3 ConnectConv, - element 4 GlobalTeamConv + element 3 ConnectConv ] typeConversationType :: Doc.DataType -typeConversationType = Doc.int32 $ Doc.enum $ fromIntegral . fromEnum <$> enumerate @ConvType +typeConversationType = Doc.int32 $ Doc.enum [0, 1, 2, 3] -- | 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 815903cb3ea..2d92ec43651 100644 --- a/libs/wire-api/src/Wire/API/Conversation/Action.hs +++ b/libs/wire-api/src/Wire/API/Conversation/Action.hs @@ -53,7 +53,6 @@ import Wire.Arbitrary (Arbitrary (..)) -- individual effects per conversation action. See 'HasConversationActionEffects'. type family ConversationAction (tag :: ConversationActionTag) :: * where ConversationAction 'ConversationJoinTag = ConversationJoin - ConversationAction 'ConversationSelfInviteTag = ConvId ConversationAction 'ConversationLeaveTag = () ConversationAction 'ConversationMemberUpdateTag = ConversationMemberUpdate ConversationAction 'ConversationDeleteTag = () @@ -104,7 +103,6 @@ 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 @@ -152,9 +150,6 @@ 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 3b0c782c37b..3445e3794ff 100644 --- a/libs/wire-api/src/Wire/API/Conversation/Action/Tag.hs +++ b/libs/wire-api/src/Wire/API/Conversation/Action/Tag.hs @@ -30,7 +30,6 @@ import Wire.Arbitrary (Arbitrary (..)) data ConversationActionTag = ConversationJoinTag - | ConversationSelfInviteTag | ConversationLeaveTag | ConversationRemoveMembersTag | ConversationMemberUpdateTag @@ -49,7 +48,6 @@ 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 d580e5be887..30ca0b6591d 100644 --- a/libs/wire-api/src/Wire/API/Conversation/Protocol.hs +++ b/libs/wire-api/src/Wire/API/Conversation/Protocol.hs @@ -28,7 +28,6 @@ module Wire.API.Conversation.Protocol _ProtocolMLS, _ProtocolProteus, protocolSchema, - mlsDataSchema, ConversationMLSData (..), ) where diff --git a/libs/wire-api/src/Wire/API/Conversation/Role.hs b/libs/wire-api/src/Wire/API/Conversation/Role.hs index 1878b99b658..e215b72db88 100644 --- a/libs/wire-api/src/Wire/API/Conversation/Role.hs +++ b/libs/wire-api/src/Wire/API/Conversation/Role.hs @@ -36,7 +36,6 @@ module Wire.API.Conversation.Role wireConvRoleNames, roleNameWireAdmin, roleNameWireMember, - roleToRoleName, -- * Action Action (..), diff --git a/libs/wire-api/src/Wire/API/Error/Galley.hs b/libs/wire-api/src/Wire/API/Error/Galley.hs index 6c2dd332e8f..65596d70fac 100644 --- a/libs/wire-api/src/Wire/API/Error/Galley.hs +++ b/libs/wire-api/src/Wire/API/Error/Galley.hs @@ -85,7 +85,6 @@ data GalleyError | MLSWelcomeMismatch | MLSMissingGroupInfo | MLSMissingSenderClient - | MLSUnexpectedSenderClient | -- NoBindingTeamMembers | NoBindingTeam @@ -212,8 +211,6 @@ type instance MapError 'MLSGroupConversationMismatch = 'StaticError 400 "mls-gro type instance MapError 'MLSClientSenderUserMismatch = 'StaticError 400 "mls-client-sender-user-mismatch" "User ID resolved from Client ID does not match message's sender user ID" -type instance MapError 'MLSUnexpectedSenderClient = 'StaticError 422 "mls-unexpected-sender-client-found" "Unexpected creator client set. This is a newly created conversation and it expected exactly one client." - type instance MapError 'MLSWelcomeMismatch = 'StaticError 400 "mls-welcome-mismatch" "The list of targets of a welcome message does not match the list of new clients in a group" type instance MapError 'MLSMissingGroupInfo = 'StaticError 404 "mls-missing-group-info" "The conversation has no group information" diff --git a/libs/wire-api/src/Wire/API/MLS/GlobalTeamConversation.hs b/libs/wire-api/src/Wire/API/MLS/GlobalTeamConversation.hs deleted file mode 100644 index f9f10968601..00000000000 --- a/libs/wire-api/src/Wire/API/MLS/GlobalTeamConversation.hs +++ /dev/null @@ -1,63 +0,0 @@ --- 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 hiding (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, - gtcMlsMetadata :: ConversationMLSData, - gtcCreator :: Maybe UserId, - gtcAccess :: [Access], - gtcName :: Text, - gtcTeam :: TeamId - } - 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 "qualified_id" schema - <*> gtcMlsMetadata .= mlsDataSchema - <*> 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/libs/wire-api/src/Wire/API/Routes/Public/Galley/Conversation.hs b/libs/wire-api/src/Wire/API/Routes/Public/Galley/Conversation.hs index 59da0e111d7..407a18070dc 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 @@ -130,18 +130,6 @@ 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 - -- :> "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/MLS.hs b/libs/wire-api/src/Wire/API/Routes/Public/Galley/MLS.hs index b8f0dfe2008..09dbc3c77d9 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Galley/MLS.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Galley/MLS.hs @@ -62,7 +62,6 @@ type MLSMessagingAPI = :> CanThrow 'MLSStaleMessage :> CanThrow 'MLSUnsupportedMessage :> CanThrow 'MLSUnsupportedProposal - :> CanThrow 'MLSUnexpectedSenderClient :> CanThrow 'MLSClientSenderUserMismatch :> CanThrow 'MLSGroupConversationMismatch :> CanThrow 'MLSMissingSenderClient @@ -92,7 +91,6 @@ type MLSMessagingAPI = :> CanThrow 'MLSStaleMessage :> CanThrow 'MLSUnsupportedMessage :> CanThrow 'MLSUnsupportedProposal - :> CanThrow 'MLSUnexpectedSenderClient :> CanThrow 'MLSClientSenderUserMismatch :> CanThrow 'MLSGroupConversationMismatch :> CanThrow 'MLSMissingSenderClient @@ -122,7 +120,6 @@ type MLSMessagingAPI = :> CanThrow 'MLSStaleMessage :> CanThrow 'MLSUnsupportedMessage :> CanThrow 'MLSUnsupportedProposal - :> CanThrow 'MLSUnexpectedSenderClient :> CanThrow 'MLSClientSenderUserMismatch :> CanThrow 'MLSGroupConversationMismatch :> CanThrow 'MLSMissingSenderClient 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 4a8f3924f02..0a81f55c276 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 - :> ZLocalUser + :> ZUser :> ZConn :> CanThrow 'NotConnected :> CanThrow 'UserBindingExists diff --git a/libs/wire-api/wire-api.cabal b/libs/wire-api/wire-api.cabal index bf841e4d756..ed7e1bb8eb1 100644 --- a/libs/wire-api/wire-api.cabal +++ b/libs/wire-api/wire-api.cabal @@ -48,7 +48,6 @@ 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/nix/pkgs/mls-test-cli/default.nix b/nix/pkgs/mls-test-cli/default.nix index b49f61ceaa1..7d7d6961133 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-FjgAcYdUr/ZWdQxbck2UEG6NEEQLuz0S4a55hrAxUs4="; - rev = "82fc148964ef5baa92a90d086fdc61adaa2b5dbf"; + sha256 = "sha256-/XQ/9oQTPkRqgMzDGRm+Oh9jgkdeDM1vRJ6/wEf2+bY="; + rev = "c6f80be2839ac1ed2894e96044541d1c3cf6ecdf"; }; doCheck = false; cargoSha256 = "sha256-AlZrxa7f5JwxxrzFBgeFSaYU6QttsUpfLYfq1HzsdbE="; diff --git a/services/brig/src/Brig/RPC.hs b/services/brig/src/Brig/RPC.hs index bdba7116496..986ea5725f3 100644 --- a/services/brig/src/Brig/RPC.hs +++ b/services/brig/src/Brig/RPC.hs @@ -43,9 +43,6 @@ 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/API/Provider.hs b/services/brig/test/integration/API/Provider.hs index 91f9e7388a0..ddc19e01966 100644 --- a/services/brig/test/integration/API/Provider.hs +++ b/services/brig/test/integration/API/Provider.hs @@ -1378,19 +1378,7 @@ 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/Federation/Util.hs b/services/brig/test/integration/Federation/Util.hs index 5c7e1552cbb..dbc08acb711 100644 --- a/services/brig/test/integration/Federation/Util.hs +++ b/services/brig/test/integration/Federation/Util.hs @@ -1,6 +1,7 @@ {-# 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. -- @@ -22,19 +23,47 @@ module Federation.Util where import Bilge -import Bilge.Assert ((!!!), (===)) +import Bilge.Assert ((!!!), (. -- for SES notifications -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -fno-warn-orphans -Wno-deprecations #-} module Util where diff --git a/services/federator/src/Federator/InternalServer.hs b/services/federator/src/Federator/InternalServer.hs index 1a7d33bce1f..084907c6eb1 100644 --- a/services/federator/src/Federator/InternalServer.hs +++ b/services/federator/src/Federator/InternalServer.hs @@ -1,5 +1,5 @@ {-# LANGUAGE PartialTypeSignatures #-} -{-# OPTIONS_GHC -Wno-partial-type-signatures #-} +{-# OPTIONS_GHC -Wno-partial-type-signatures -Wno-unused-imports #-} -- This file is part of the Wire Server implementation. -- @@ -20,22 +20,58 @@ module Federator.InternalServer where +import Control.Exception (bracketOnError) +import qualified Control.Exception as E +import Control.Lens (view) import Data.Binary.Builder import qualified Data.ByteString as BS +import qualified Data.ByteString.Char8 as C8 +import qualified Data.ByteString.Lazy as LBS +import Data.Default +import Data.Domain (domainText) +import Data.Either.Validation (Validation (..)) import qualified Data.Text as Text -import Federator.Env (Env) +import qualified Data.Text.Encoding as Text +import Data.X509.CertificateStore +import Federator.App (runAppT) +import Federator.Discovery (DiscoverFederator, DiscoveryFailure (DiscoveryFailureDNSError, DiscoveryFailureSrvNotAvailable), runFederatorDiscovery) +import Federator.Env (Env, TLSSettings, applog, caStore, dnsResolver, runSettings, tls) import Federator.Error.ServerError import Federator.Options (RunSettings) import Federator.Remote import Federator.Response import Federator.Validation +import Foreign (mallocBytes) +import Foreign.Marshal (free) import Imports +import Network.HPACK (BufferSize) +import Network.HTTP.Client.Internal (openSocketConnection) +import Network.HTTP.Client.OpenSSL (withOpenSSL) import qualified Network.HTTP.Types as HTTP +import qualified Network.HTTP2.Client as HTTP2 +import Network.Socket (Socket) +import qualified Network.Socket as NS +import Network.TLS +import qualified Network.TLS as TLS +import qualified Network.TLS.Extra.Cipher as TLS import qualified Network.Wai as Wai +import qualified Network.Wai.Handler.Warp as Warp import Polysemy import Polysemy.Error +import qualified Polysemy.Error as Polysemy +import Polysemy.IO (embedToMonadIO) import Polysemy.Input +import qualified Polysemy.Input as Polysemy +import qualified Polysemy.Resource as Polysemy +import Polysemy.TinyLog (TinyLog) +import qualified Polysemy.TinyLog as Log +import Servant.Client.Core +import qualified System.TimeManager as T +import qualified System.X509 as TLS import Wire.API.Federation.Component +import Wire.Network.DNS.Effect (DNSLookup) +import qualified Wire.Network.DNS.Effect as Lookup +import Wire.Network.DNS.SRV (SrvTarget (..)) data RequestData = RequestData { rdTargetDomain :: Text, diff --git a/services/galley/src/Galley/API/Action.hs b/services/galley/src/Galley/API/Action.hs index 44e9d9d4338..dcae8353e87 100644 --- a/services/galley/src/Galley/API/Action.hs +++ b/services/galley/src/Galley/API/Action.hs @@ -96,11 +96,6 @@ 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, @@ -135,7 +130,6 @@ type family HasConversationActionEffects (tag :: ConversationActionTag) r :: Con '[ MemberStore, Error InternalError, Error NoChanges, - ErrorS 'InvalidOperation, ExternalAccess, FederatorAccess, GundeckAccess, @@ -163,7 +157,6 @@ type family HasConversationActionEffects (tag :: ConversationActionTag) r :: Con Error InvalidInput, Error NoChanges, ErrorS 'InvalidTargetAccess, - ErrorS 'InvalidOperation, ErrorS ('ActionDenied 'RemoveConversationMember), ExternalAccess, FederatorAccess, @@ -277,13 +270,6 @@ 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) @@ -356,8 +342,6 @@ 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) => @@ -595,7 +579,7 @@ updateLocalConversation lcnv qusr con action = do let tag = sing @tag -- retrieve conversation - conv <- getConversationWithError lcnv (qUnqualified qusr) + conv <- getConversationWithError lcnv -- check that the action does not bypass the underlying protocol unless (protocolValidAction (convProtocol conv) (fromSing tag)) $ @@ -634,10 +618,7 @@ updateLocalConversationUnchecked lconv qusr con action = do conv = tUnqualified lconv -- retrieve member - self <- - if (cnvmType . convMetadata . tUnqualified $ lconv) == GlobalTeamConv - then pure $ Left $ localMemberFromUser (qUnqualified qusr) - else noteS @'ConvNotFound $ getConvMember lconv conv qusr + self <- noteS @'ConvNotFound $ getConvMember lconv conv qusr -- perform checks ensureConversationActionAllowed (sing @tag) lcnv action conv self @@ -657,23 +638,6 @@ 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, @@ -694,7 +658,7 @@ ensureConversationActionAllowed tag loc action conv self = do -- general action check ensureActionAllowed (sConversationActionPermission tag) self - -- check if it is a group or global conversation (except for rename actions) + -- check if it is a group conversation (except for rename actions) when (fromSing tag /= ConversationRenameTag) $ ensureGroupConversation conv @@ -825,19 +789,16 @@ notifyRemoteConversationAction loc rconvUpdate con = do -- leave, but then sends notifications as if the user was removed by someone -- else. kickMember :: - Members - '[ Error InternalError, - ErrorS 'InvalidOperation, - ExternalAccess, - FederatorAccess, - GundeckAccess, - ProposalStore, - Input UTCTime, - Input Env, - MemberStore, - TinyLog - ] - r => + ( 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 + ) => Qualified UserId -> Local Conversation -> BotsAndMembers -> diff --git a/services/galley/src/Galley/API/Federation.hs b/services/galley/src/Galley/API/Federation.hs index c6818ff6768..a7eb1858153 100644 --- a/services/galley/src/Galley/API/Federation.hs +++ b/services/galley/src/Galley/API/Federation.hs @@ -282,7 +282,7 @@ onConversationUpdated requestingDomain cu = do SConversationMessageTimerUpdateTag -> pure (Just sca, []) SConversationReceiptModeUpdateTag -> pure (Just sca, []) SConversationAccessDataTag -> pure (Just sca, []) - SConversationSelfInviteTag -> pure (Nothing, []) + unless allUsersArePresent $ P.warn $ Log.field "conversation" (toByteString' (F.cuConvId cu)) @@ -498,8 +498,6 @@ 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) @@ -593,8 +591,6 @@ 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 730aabd7678..d6eeb320f88 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" - ( ZLocalUser + ( ZUser :> ReqBody '[Servant.JSON] BindingNewTeam :> MultiVerb1 'PUT @@ -704,38 +704,28 @@ rmUser lusr conn = do let qUser = qUntagged lusr cc <- getConversations ids now <- input - let deleteIfNeeded c = do - when (tUnqualified lusr `isMember` Data.convLocalMembers c) $ do + 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 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) - let e = - Event - (qUntagged (qualifyAs lusr (Data.convId c))) - (qUntagged lusr) - now - (EdMembersLeave (QualifiedUserIdList [qUser])) - 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 - GlobalTeamConv -> deleteClientsFromGlobal 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 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 9b06ab40a92..2ce6f7e5d64 100644 --- a/services/galley/src/Galley/API/MLS/Message.hs +++ b/services/galley/src/Galley/API/MLS/Message.hs @@ -107,7 +107,6 @@ type MLSMessageStaticErrors = ErrorS 'MLSCommitMissingReferences, ErrorS 'MLSSelfRemovalNotAllowed, ErrorS 'MLSClientSenderUserMismatch, - ErrorS 'MLSUnexpectedSenderClient, ErrorS 'MLSGroupConversationMismatch, ErrorS 'MLSMissingSenderClient ] @@ -125,6 +124,7 @@ postMLSMessageFromLocalUserV1 :: ErrorS 'ConvAccessDenied, ErrorS 'ConvMemberNotFound, ErrorS 'ConvNotFound, + ErrorS 'MissingLegalholdConsent, ErrorS 'MLSClientSenderUserMismatch, ErrorS 'MLSCommitMissingReferences, ErrorS 'MLSGroupConversationMismatch, @@ -133,9 +133,7 @@ postMLSMessageFromLocalUserV1 :: ErrorS 'MLSProposalNotFound, ErrorS 'MLSSelfRemovalNotAllowed, ErrorS 'MLSStaleMessage, - ErrorS 'MLSUnexpectedSenderClient, ErrorS 'MLSUnsupportedMessage, - ErrorS 'MissingLegalholdConsent, Input (Local ()), ProposalStore, Resource, @@ -164,6 +162,7 @@ postMLSMessageFromLocalUser :: ErrorS 'ConvAccessDenied, ErrorS 'ConvMemberNotFound, ErrorS 'ConvNotFound, + ErrorS 'MissingLegalholdConsent, ErrorS 'MLSClientSenderUserMismatch, ErrorS 'MLSCommitMissingReferences, ErrorS 'MLSGroupConversationMismatch, @@ -172,9 +171,7 @@ postMLSMessageFromLocalUser :: ErrorS 'MLSProposalNotFound, ErrorS 'MLSSelfRemovalNotAllowed, ErrorS 'MLSStaleMessage, - ErrorS 'MLSUnexpectedSenderClient, ErrorS 'MLSUnsupportedMessage, - ErrorS 'MissingLegalholdConsent, Input (Local ()), ProposalStore, Resource, @@ -380,6 +377,7 @@ postMLSMessage :: ErrorS 'ConvMemberNotFound, ErrorS 'ConvNotFound, ErrorS 'MLSNotEnabled, + ErrorS 'MissingLegalholdConsent, ErrorS 'MLSClientSenderUserMismatch, ErrorS 'MLSCommitMissingReferences, ErrorS 'MLSGroupConversationMismatch, @@ -387,9 +385,7 @@ postMLSMessage :: ErrorS 'MLSProposalNotFound, ErrorS 'MLSSelfRemovalNotAllowed, ErrorS 'MLSStaleMessage, - ErrorS 'MLSUnexpectedSenderClient, ErrorS 'MLSUnsupportedMessage, - ErrorS 'MissingLegalholdConsent, Input (Local ()), ProposalStore, Resource, @@ -469,15 +465,14 @@ postMLSMessageToLocalConv :: '[ Error FederationError, Error InternalError, ErrorS 'ConvNotFound, + ErrorS 'MissingLegalholdConsent, ErrorS 'MLSClientSenderUserMismatch, ErrorS 'MLSCommitMissingReferences, ErrorS 'MLSMissingSenderClient, ErrorS 'MLSProposalNotFound, ErrorS 'MLSSelfRemovalNotAllowed, ErrorS 'MLSStaleMessage, - ErrorS 'MLSUnexpectedSenderClient, ErrorS 'MLSUnsupportedMessage, - ErrorS 'MissingLegalholdConsent, ProposalStore, Resource, TinyLog @@ -513,6 +508,7 @@ 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 @@ -554,29 +550,27 @@ postMLSMessageToRemoteConv loc qusr _senderClient con smsg rcnv = do pure (LocalConversationUpdate e update) type HasProposalEffects r = - ( Members - '[ BrigAccess, - ConversationStore, - Error InternalError, - Error MLSProposalFailure, - Error MLSProtocolError, - ErrorS 'MLSClientMismatch, - ErrorS 'MLSKeyPackageRefNotFound, - ErrorS 'MLSUnsupportedProposal, - ExternalAccess, - FederatorAccess, - GundeckAccess, - Input Env, - Input (Local ()), - Input Opts, - Input UTCTime, - LegalHoldStore, - MemberStore, - ProposalStore, - TeamStore, - TinyLog - ] - r + ( Member BrigAccess r, + Member ConversationStore r, + Member (Error InternalError) r, + Member (Error MLSProposalFailure) r, + Member (Error MLSProtocolError) r, + Member (ErrorS 'MLSClientMismatch) r, + Member (ErrorS 'MLSKeyPackageRefNotFound) r, + Member (ErrorS 'MLSUnsupportedProposal) r, + Member ExternalAccess r, + Member FederatorAccess r, + Member GundeckAccess r, + Member (Input Env) r, + Member (Input (Local ())) r, + Member (Input Opts) r, + Member (Input UTCTime) r, + Member LegalHoldStore r, + Member MemberStore r, + Member ProposalStore r, + Member TeamStore r, + Member TeamStore r, + Member TinyLog r ) data ProposalAction = ProposalAction @@ -634,24 +628,20 @@ getCommitData lconv mlsMeta epoch commit = do processCommit :: ( HasProposalEffects r, - Members - '[ Error FederationError, - Error InternalError, - ErrorS 'ConvNotFound, - ErrorS 'MLSClientSenderUserMismatch, - ErrorS 'MLSCommitMissingReferences, - ErrorS 'MLSMissingSenderClient, - ErrorS 'MLSProposalNotFound, - ErrorS 'MLSSelfRemovalNotAllowed, - ErrorS 'MLSStaleMessage, - ErrorS 'MLSUnexpectedSenderClient, - ErrorS 'MissingLegalholdConsent, - Input (Local ()), - ProposalStore, - BrigAccess, - Resource - ] - r + Member (Error FederationError) r, + Member (Error InternalError) r, + Member (ErrorS 'ConvNotFound) r, + Member (ErrorS 'MLSClientSenderUserMismatch) r, + Member (ErrorS 'MLSCommitMissingReferences) r, + Member (ErrorS 'MLSMissingSenderClient) r, + Member (ErrorS 'MLSProposalNotFound) r, + Member (ErrorS 'MLSSelfRemovalNotAllowed) r, + Member (ErrorS 'MLSStaleMessage) r, + Member (ErrorS 'MissingLegalholdConsent) r, + Member (Input (Local ())) r, + Member ProposalStore r, + Member BrigAccess r, + Member Resource r ) => Qualified UserId -> Maybe ClientId -> @@ -780,24 +770,20 @@ processExternalCommit qusr mSenderClient lconv mlsMeta cm epoch action updatePat processCommitWithAction :: forall r. ( HasProposalEffects r, - Members - '[ Error FederationError, - Error InternalError, - ErrorS 'ConvNotFound, - ErrorS 'MLSClientSenderUserMismatch, - ErrorS 'MLSCommitMissingReferences, - ErrorS 'MLSMissingSenderClient, - ErrorS 'MLSProposalNotFound, - ErrorS 'MLSSelfRemovalNotAllowed, - ErrorS 'MLSStaleMessage, - ErrorS 'MLSUnexpectedSenderClient, - ErrorS 'MissingLegalholdConsent, - Input (Local ()), - ProposalStore, - BrigAccess, - Resource - ] - r + Member (Error FederationError) r, + Member (Error InternalError) r, + Member (ErrorS 'ConvNotFound) r, + Member (ErrorS 'MLSClientSenderUserMismatch) r, + Member (ErrorS 'MLSCommitMissingReferences) r, + Member (ErrorS 'MLSMissingSenderClient) r, + Member (ErrorS 'MLSProposalNotFound) r, + Member (ErrorS 'MLSSelfRemovalNotAllowed) r, + Member (ErrorS 'MLSStaleMessage) r, + Member (ErrorS 'MissingLegalholdConsent) r, + Member (Input (Local ())) r, + Member ProposalStore r, + Member BrigAccess r, + Member Resource r ) => Qualified UserId -> Maybe ClientId -> @@ -819,24 +805,20 @@ processCommitWithAction qusr senderClient con lconv mlsMeta cm epoch action send processInternalCommit :: forall r. ( HasProposalEffects r, - Members - [ Error FederationError, - Error InternalError, - ErrorS 'ConvNotFound, - ErrorS 'MLSClientSenderUserMismatch, - ErrorS 'MLSCommitMissingReferences, - ErrorS 'MLSMissingSenderClient, - ErrorS 'MLSProposalNotFound, - ErrorS 'MLSSelfRemovalNotAllowed, - ErrorS 'MLSStaleMessage, - ErrorS 'MLSUnexpectedSenderClient, - ErrorS 'MissingLegalholdConsent, - Input (Local ()), - ProposalStore, - BrigAccess, - Resource - ] - r + Member (Error FederationError) r, + Member (Error InternalError) r, + Member (ErrorS 'ConvNotFound) r, + Member (ErrorS 'MLSClientSenderUserMismatch) r, + Member (ErrorS 'MLSCommitMissingReferences) r, + Member (ErrorS 'MLSMissingSenderClient) r, + Member (ErrorS 'MLSProposalNotFound) r, + Member (ErrorS 'MLSSelfRemovalNotAllowed) r, + Member (ErrorS 'MLSStaleMessage) r, + Member (ErrorS 'MissingLegalholdConsent) r, + Member (Input (Local ())) r, + Member ProposalStore r, + Member BrigAccess r, + Member Resource r ) => Qualified UserId -> Maybe ClientId -> @@ -873,28 +855,10 @@ processInternalCommit qusr senderClient con lconv mlsMeta cm epoch action sender qusr (Set.singleton (creatorClient, creatorRef)) (Left _, SelfConv, _) -> - -- this is a newly created conversation, and it should contain exactly one - -- client (the creator) - throwS @'MLSUnexpectedSenderClient - (Left _, GlobalTeamConv, []) -> do - creatorClient <- noteS @'MLSMissingSenderClient senderClient - creatorRef <- - maybe - (pure senderRef) - ( note (mlsProtocolError "Could not compute key package ref") - . kpRef' - . upLeaf - ) - $ cPath commit - -- add user to global conv as a member as well - lusr <- qualifyLocal (qUnqualified qusr) - void $ createMember (convId <$> lconv) lusr - addMLSClients - (cnvmlsGroupId mlsMeta) - qusr - (Set.singleton (creatorClient, creatorRef)) - (Left _, GlobalTeamConv, _) -> - throwS @'MLSUnexpectedSenderClient + throw . InternalErrorWithDescription $ + "Unexpected creator client set in a self-conversation" + -- this is a newly created conversation, and it should contain exactly one + -- client (the creator) (Left lm, _, [(qu, (creatorClient, _))]) | qu == qUntagged (qualifyAs lconv (lmId lm)) -> do -- use update path as sender reference and if not existing fall back to sender diff --git a/services/galley/src/Galley/API/MLS/Util.hs b/services/galley/src/Galley/API/MLS/Util.hs index 9738b5b0464..1095e1ef62a 100644 --- a/services/galley/src/Galley/API/MLS/Util.hs +++ b/services/galley/src/Galley/API/MLS/Util.hs @@ -20,23 +20,21 @@ module Galley.API.MLS.Util where import Control.Comonad import Data.Id import Data.Qualified -import Galley.Data.Conversation +import Galley.Data.Conversation.Types hiding (Conversation) import qualified Galley.Data.Conversation.Types as Data 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) 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.GlobalTeamConversation +import Wire.API.MLS.Epoch +import Wire.API.MLS.Group import Wire.API.MLS.KeyPackage import Wire.API.MLS.Proposal import Wire.API.MLS.Serialisation @@ -52,21 +50,10 @@ getLocalConvForUser :: Local ConvId -> Sem r Data.Conversation getLocalConvForUser qusr lcnv = do - gtc <- getGlobalTeamConversationById lcnv - conv <- case gtc of - Just conv -> do - localMembers <- getLocalMembers (qUnqualified . gtcId $ conv) - pure $ gtcToConv conv (qUnqualified qusr) localMembers - Nothing -> do - getConversation (tUnqualified lcnv) >>= noteS @'ConvNotFound + conv <- 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 @@ -90,29 +77,3 @@ getPendingBackendRemoveProposals gid epoch = do TinyLog.warn $ Log.msg ("found pending proposal without origin, ignoring" :: ByteString) pure Nothing ) - -gtcToConv :: - GlobalTeamConversation -> - UserId -> - [LocalMember] -> - Conversation -gtcToConv gtc usr lm = - let mlsData = gtcMlsMetadata gtc - in Conversation - { convId = qUnqualified $ gtcId gtc, - convLocalMembers = lm, - convRemoteMembers = mempty, - convDeleted = False, - convMetadata = - ConversationMetadata - { cnvmType = GlobalTeamConv, - cnvmCreator = usr, - cnvmAccess = [SelfInviteAccess], - cnvmAccessRoles = mempty, - cnvmName = Just $ gtcName gtc, - cnvmTeam = Just $ gtcTeam gtc, - cnvmMessageTimer = Nothing, - cnvmReceiptMode = Nothing - }, - convProtocol = ProtocolMLS mlsData - } diff --git a/services/galley/src/Galley/API/Public/Conversation.hs b/services/galley/src/Galley/API/Public/Conversation.hs index fc00eaceff2..f14ee733977 100644 --- a/services/galley/src/Galley/API/Public/Conversation.hs +++ b/services/galley/src/Galley/API/Public/Conversation.hs @@ -32,7 +32,6 @@ 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 38c848c66c4..926509f116c 100644 --- a/services/galley/src/Galley/API/Query.hs +++ b/services/galley/src/Galley/API/Query.hs @@ -21,7 +21,6 @@ module Galley.API.Query ( getBotConversationH, getUnqualifiedConversation, getConversation, - getGlobalTeamConversation, getConversationRoles, conversationIdsPageFromUnqualified, conversationIdsPageFromV2, @@ -53,7 +52,6 @@ import Data.Proxy import Data.Qualified import Data.Range import qualified Data.Set as Set -import Data.Tagged import Galley.API.Error import Galley.API.MLS import Galley.API.MLS.Keys @@ -70,7 +68,6 @@ 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 @@ -95,7 +92,6 @@ import Wire.API.Error.Galley import Wire.API.Federation.API import Wire.API.Federation.API.Galley import Wire.API.Federation.Error -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) @@ -115,11 +111,7 @@ getBotConversation :: Local ConvId -> Sem r Public.BotConvView getBotConversation zbot lcnv = do - (c, _) <- - getConversationAndMemberWithError - @'ConvNotFound - (qUntagged . qualifyAs lcnv . botUserId $ zbot) - lcnv + (c, _) <- getConversationAndMemberWithError @'ConvNotFound (botUserId zbot) lcnv let domain = tDomain lcnv cmems = mapMaybe (mkMember domain) (toList (Data.convLocalMembers c)) pure $ Public.botConvView (tUnqualified lcnv) (Data.convName c) cmems @@ -147,25 +139,6 @@ getUnqualifiedConversation lusr cnv = do c <- getConversationAndCheckMembership (tUnqualified lusr) (qualifyAs lusr cnv) Mapping.conversationView lusr c -getGlobalTeamConversation :: - Members - '[ ConversationStore, - ErrorS 'NotATeamMember, - MemberStore, - TeamStore - ] - r => - Local UserId -> - TeamId -> - Sem r Public.GlobalTeamConversation -getGlobalTeamConversation lusr tid = do - let ltid = qualifyAs lusr tid - void $ noteS @'NotATeamMember =<< E.getTeamMember tid (tUnqualified lusr) - E.getGlobalTeamConversation ltid >>= \case - Nothing -> - E.createGlobalTeamConversation (qualifyAs lusr tid) - Just conv -> pure conv - getConversation :: forall r. Members @@ -305,24 +278,12 @@ getConversationRoles lusr cnv = do pure $ Public.ConversationRolesList wireConvRoles conversationIdsPageFromUnqualified :: - Members - [ ListItems LegacyPaging ConvId, - ConversationStore, - MemberStore, - TeamStore - ] - r => + Member (ListItems LegacyPaging ConvId) r => Local UserId -> Maybe ConvId -> Maybe (Range 1 1000 Int32) -> Sem r (Public.ConversationList ConvId) conversationIdsPageFromUnqualified lusr start msize = do - void $ - E.getUserTeams (tUnqualified lusr) >>= \tids -> - runError @InternalError $ - runError @(Tagged 'NotATeamMember ()) - (for_ tids $ \tid -> getGlobalTeamConversation lusr tid) - let size = fromMaybe (toRange (Proxy @1000)) msize ids <- E.listItems (tUnqualified lusr) start size pure $ diff --git a/services/galley/src/Galley/API/Teams.hs b/services/galley/src/Galley/API/Teams.hs index 2a48570e0ce..acff3286cf5 100644 --- a/services/galley/src/Galley/API/Teams.hs +++ b/services/galley/src/Galley/API/Teams.hs @@ -220,25 +220,21 @@ lookupTeam zusr tid = do else pure Nothing createNonBindingTeamH :: - Members - '[ ConversationStore, - ErrorS 'NotConnected, - ErrorS 'UserBindingExists, - GundeckAccess, - Input UTCTime, - MemberStore, - P.TinyLog, - TeamStore, - WaiRoutes, - BrigAccess - ] - r => - Local UserId -> + 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 -> ConnId -> Public.NonBindingNewTeam -> Sem r TeamId -createNonBindingTeamH lusr zcon (Public.NonBindingNewTeam body) = do - let zusr = tUnqualified lusr +createNonBindingTeamH zusr zcon (Public.NonBindingNewTeam body) = do let owner = Public.mkTeamMember zusr fullPermissions Nothing LH.defUserLegalHoldStatus let others = filter ((zusr /=) . view userId) @@ -259,23 +255,15 @@ createNonBindingTeamH lusr zcon (Public.NonBindingNewTeam body) = do (body ^. newTeamIconKey) NonBinding finishCreateTeam team owner others (Just zcon) - pure $ team ^. teamId + pure (team ^. teamId) createBindingTeam :: - Members - '[ GundeckAccess, - Input UTCTime, - MemberStore, - TeamStore, - ConversationStore - ] - r => + Members '[GundeckAccess, Input UTCTime, TeamStore] r => TeamId -> - Local UserId -> + UserId -> BindingNewTeam -> Sem r TeamId -createBindingTeam tid lusr (BindingNewTeam body) = do - let zusr = tUnqualified lusr +createBindingTeam tid zusr (BindingNewTeam body) = do 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/API/Util.hs b/services/galley/src/Galley/API/Util.hs index 835560e5f4c..0a675a3e1a0 100644 --- a/services/galley/src/Galley/API/Util.hs +++ b/services/galley/src/Galley/API/Util.hs @@ -36,7 +36,6 @@ import Data.Singletons import qualified Data.Text as T import Data.Time import Galley.API.Error -import Galley.API.MLS.Util import Galley.API.Mapping import qualified Galley.Data.Conversation as Data import Galley.Data.Services (BotMember, newBotMember) @@ -193,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 - unless (ty `elem` [RegularConv, GlobalTeamConv]) $ throwS @'InvalidOperation + when (ty /= RegularConv) $ 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 @@ -509,7 +508,7 @@ getConversationAndCheckMembership uid lcnv = do (conv, _) <- getConversationAndMemberWithError @'ConvAccessDenied - (qUntagged $ qualifyAs lcnv uid) + uid lcnv pure conv @@ -518,27 +517,18 @@ getConversationWithError :: Member (ErrorS 'ConvNotFound) r ) => Local ConvId -> - UserId -> Sem r Data.Conversation -getConversationWithError lcnv uid = - let cid = tUnqualified lcnv - in getConversation cid >>= \case - Just c -> pure c - Nothing -> do - gtc <- noteS @'ConvNotFound =<< getGlobalTeamConversationById lcnv - pure $ gtcToConv gtc uid mempty +getConversationWithError lcnv = + getConversation (tUnqualified lcnv) >>= noteS @'ConvNotFound getConversationAndMemberWithError :: forall e uid mem r. - ( Members '[ConversationStore, ErrorS 'ConvNotFound, ErrorS e] r, - IsConvMemberId uid mem, - uid ~ Qualified UserId - ) => + (Members '[ConversationStore, ErrorS 'ConvNotFound, ErrorS e] r, IsConvMemberId uid mem) => uid -> Local ConvId -> Sem r (Data.Conversation, mem) getConversationAndMemberWithError usr lcnv = do - c <- getConversationWithError lcnv (qUnqualified usr) + c <- getConversationWithError lcnv member <- noteS @e $ getConvMember lcnv c usr pure (c, member) diff --git a/services/galley/src/Galley/Cassandra/Access.hs b/services/galley/src/Galley/Cassandra/Access.hs index 9357320d95c..05c566bfd11 100644 --- a/services/galley/src/Galley/Cassandra/Access.hs +++ b/services/galley/src/Galley/Cassandra/Access.hs @@ -31,7 +31,6 @@ 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 2b7f1c4d9a5..25fb2a44d22 100644 --- a/services/galley/src/Galley/Cassandra/Client.hs +++ b/services/galley/src/Galley/Cassandra/Client.hs @@ -40,10 +40,9 @@ import Polysemy.Input import qualified UnliftIO updateClient :: Bool -> UserId -> ClientId -> Client () -updateClient add usr cid = do - -- add or remove client +updateClient add usr cls = do let q = if add then Cql.addMemberClient else Cql.rmMemberClient - retry x5 $ write (q cid) (params LocalQuorum (Identity usr)) + retry x5 $ write (q cls) (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 10a87ff2c89..1b26c2207fd 100644 --- a/services/galley/src/Galley/Cassandra/Conversation.hs +++ b/services/galley/src/Galley/Cassandra/Conversation.hs @@ -19,7 +19,6 @@ module Galley.Cassandra.Conversation ( createConversation, deleteConversation, interpretConversationStoreToCassandra, - getGlobalTeamConversationById, ) where @@ -55,7 +54,6 @@ 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 @@ -252,71 +250,6 @@ getConversation conv = do <*> UnliftIO.wait cdata runMaybeT $ conversationGC =<< maybe mzero pure mbConv -getGlobalTeamConversation :: - Local TeamId -> - Client (Maybe GlobalTeamConversation) -getGlobalTeamConversation qtid = - let cid = qualifyAs qtid (globalTeamConv (tUnqualified qtid)) - in getGlobalTeamConversationById cid - -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, mty, mgid, mepoch, mcs) <- mconv - guard (mty == Just GlobalTeamConv) - tid <- mtid - name <- mname - mlsData <- ConversationMLSData <$> mgid <*> (mepoch <|> Just (Epoch 0)) <*> mcs - - pure $ - GlobalTeamConversation - (qUntagged lconv) - mlsData - muid - [SelfInviteAccess] - name - tid - -createGlobalTeamConversation :: - Local TeamId -> - Client GlobalTeamConversation -createGlobalTeamConversation tid = do - let lconv = qualifyAs tid (globalTeamConv $ tUnqualified tid) - gid = convToGroupId lconv - cs = MLS_128_DHKEMX25519_AES128GCM_SHA256_Ed25519 - retry x5 . batch $ do - setType BatchLogged - setConsistency LocalQuorum - addPrepQuery - Cql.insertGlobalTeamConv - ( tUnqualified lconv, - Cql.Set [SelfInviteAccess], - "Global team conversation", - tUnqualified tid, - Just gid, - Just cs - ) - addPrepQuery Cql.insertTeamConv (tUnqualified tid, tUnqualified lconv) - addPrepQuery Cql.insertGroupId (gid, tUnqualified lconv, tDomain lconv) - pure $ - GlobalTeamConversation - (qUntagged lconv) - ( ConversationMLSData - gid - (Epoch 0) - cs - ) - Nothing - [SelfInviteAccess] - "Global team conversation" - (tUnqualified tid) - -- | "Garbage collect" a 'Conversation', i.e. if the conversation is -- marked as deleted, actually remove it from the database and return -- 'Nothing'. @@ -449,9 +382,6 @@ 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 - GetGlobalTeamConversationById lconv -> embedClient $ getGlobalTeamConversationById lconv - CreateGlobalTeamConversation tid -> embedClient $ createGlobalTeamConversation tid GetConversationIdByGroupId gId -> embedClient $ lookupGroupId gId GetConversations cids -> localConversations cids GetConversationMetadata cid -> embedClient $ conversationMeta cid diff --git a/services/galley/src/Galley/Cassandra/Conversation/Members.hs b/services/galley/src/Galley/Cassandra/Conversation/Members.hs index 85b37b634eb..590fa6676c3 100644 --- a/services/galley/src/Galley/Cassandra/Conversation/Members.hs +++ b/services/galley/src/Galley/Cassandra/Conversation/Members.hs @@ -45,8 +45,9 @@ import Imports hiding (Set) import Polysemy import Polysemy.Input import qualified UnliftIO -import Wire.API.Conversation +import Wire.API.Conversation.Member hiding (Member) import Wire.API.Conversation.Role +import Wire.API.MLS.Group import Wire.API.MLS.KeyPackage import Wire.API.Provider.Service @@ -117,32 +118,9 @@ removeRemoteMembersFromLocalConv cnv victims = do addPrepQuery Cql.removeRemoteMember (cnv, domain, uid) members :: ConvId -> Client [LocalMember] -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 - } +members conv = + fmap (mapMaybe toMember) . retry x1 $ + query Cql.selectMembers (params LocalQuorum (Identity conv)) toMemberStatus :: ( -- otr muted @@ -225,15 +203,9 @@ member :: ConvId -> UserId -> Client (Maybe LocalMember) -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)) +member cnv usr = + (toMember =<<) + <$> retry x1 (query1 Cql.selectMember (params LocalQuorum (cnv, 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/Instances.hs b/services/galley/src/Galley/Cassandra/Instances.hs index e0ceb402552..90b648e8ff3 100644 --- a/services/galley/src/Galley/Cassandra/Instances.hs +++ b/services/galley/src/Galley/Cassandra/Instances.hs @@ -56,14 +56,12 @@ 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" @@ -74,14 +72,12 @@ 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 0be8fc57b42..5cdac44f74d 100644 --- a/services/galley/src/Galley/Cassandra/Queries.hs +++ b/services/galley/src/Galley/Cassandra/Queries.hs @@ -219,20 +219,6 @@ selectConv :: ) 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 ConvType, - Maybe GroupId, - Maybe Epoch, - Maybe CipherSuiteTag - ) -selectGlobalTeamConv = "select creator, name, team, type, 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 = ?" @@ -267,12 +253,6 @@ insertMLSSelfConv = <> show (fromEnum ProtocolMLSTag) <> ", ?, ?)" -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 = ?" - updateConvAccess :: PrepQuery W (C.Set Access, C.Set AccessRole, 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 52d900f45fd..1dc85be7a77 100644 --- a/services/galley/src/Galley/Cassandra/Team.hs +++ b/services/galley/src/Galley/Cassandra/Team.hs @@ -14,7 +14,6 @@ -- -- 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, @@ -158,23 +157,23 @@ createTeam t uid (fromRange -> n) i k b = do listBillingTeamMembers :: TeamId -> Client [UserId] listBillingTeamMembers tid = - runIdentity - <$$> retry x1 (query Cql.listBillingTeamMembers (params LocalQuorum (Identity tid))) + fmap runIdentity + <$> retry x1 (query Cql.listBillingTeamMembers (params LocalQuorum (Identity tid))) getTeamName :: TeamId -> Client (Maybe Text) getTeamName tid = - runIdentity - <$$> retry x1 (query1 Cql.selectTeamName (params LocalQuorum (Identity tid))) + fmap runIdentity + <$> retry x1 (query1 Cql.selectTeamName (params LocalQuorum (Identity tid))) teamConversation :: TeamId -> ConvId -> Client (Maybe TeamConversation) teamConversation t c = - newTeamConversation . runIdentity - <$$> retry x1 (query1 Cql.selectTeamConv (params LocalQuorum (t, c))) + fmap (newTeamConversation . runIdentity) + <$> retry x1 (query1 Cql.selectTeamConv (params LocalQuorum (t, c))) getTeamConversations :: TeamId -> Client [TeamConversation] getTeamConversations t = - newTeamConversation . runIdentity - <$$> retry x1 (query Cql.selectTeamConvs (params LocalQuorum (Identity t))) + map (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) = @@ -186,7 +185,7 @@ teamIdsFrom usr range (fromRange -> max) = teamIdsForPagination :: UserId -> Maybe TeamId -> Range 1 100 Int32 -> Client (Page TeamId) teamIdsForPagination usr range (fromRange -> max) = - runIdentity <$$> case range of + fmap 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 378262560fe..519e8608a6a 100644 --- a/services/galley/src/Galley/Data/Conversation.hs +++ b/services/galley/src/Galley/Data/Conversation.hs @@ -23,7 +23,6 @@ module Galley.Data.Conversation -- * Utilities isConvDeleted, selfConv, - globalTeamConv, localOne2OneConvId, convAccess, convAccessData, @@ -59,9 +58,6 @@ 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 f1d9f374951..1660c2f6893 100644 --- a/services/galley/src/Galley/Effects/ConversationStore.hs +++ b/services/galley/src/Galley/Effects/ConversationStore.hs @@ -28,9 +28,6 @@ module Galley.Effects.ConversationStore -- * Read conversation getConversation, - getGlobalTeamConversation, - getGlobalTeamConversationById, - createGlobalTeamConversation, getConversationIdByGroupId, getConversations, getConversationMetadata, @@ -71,7 +68,6 @@ 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 @@ -82,9 +78,6 @@ data ConversationStore m a where ConversationStore m Conversation DeleteConversation :: ConvId -> ConversationStore m () GetConversation :: ConvId -> ConversationStore m (Maybe Conversation) - GetGlobalTeamConversation :: Local TeamId -> ConversationStore m (Maybe GlobalTeamConversation) - GetGlobalTeamConversationById :: Local ConvId -> ConversationStore m (Maybe GlobalTeamConversation) - CreateGlobalTeamConversation :: Local TeamId -> ConversationStore m GlobalTeamConversation 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 02db8616a01..c8bc82ee6f5 100644 --- a/services/galley/test/integration/API.hs +++ b/services/galley/test/integration/API.hs @@ -2122,19 +2122,7 @@ 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 () @@ -2163,19 +2151,7 @@ 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/Federation.hs b/services/galley/test/integration/API/Federation.hs index 59a399b382e..98def36aa38 100644 --- a/services/galley/test/integration/API/Federation.hs +++ b/services/galley/test/integration/API/Federation.hs @@ -1159,5 +1159,3 @@ 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 9f0c8965b15..654350086c2 100644 --- a/services/galley/test/integration/API/MLS.hs +++ b/services/galley/test/integration/API/MLS.hs @@ -20,8 +20,7 @@ module API.MLS (tests) where import API.MLS.Util -import API.SQS -import API.Util as Util +import API.Util import Bilge hiding (head) import Bilge.Assert import Cassandra @@ -187,20 +186,8 @@ tests s = "CommitBundle" [ test s "add user with a commit bundle" testAddUserWithBundle, test s "add user with a commit bundle to a remote conversation" testAddUserToRemoteConvWithBundle, - test s "remote user posts commit bundle" testRemoteUserPostsCommitBundle, - test s "add user with a commit bundle and a team conv" testAddTeamUserWithBundle + 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), - -- test s "Can't leave global team conversation" testGlobalTeamConversationLeave, - -- test s "Send message in global team conversation" testGlobalTeamConversationMessage, - -- test s "Listing convs includes global team conversation" testConvListIncludesGlobal, - -- test s "Listing convs includes global team conversation for new users" testConvListIncludesGlobalForNewUsers, - -- test s "Listing convs before calling GET on global team conversation still includes it" testConvListIncludesGlobalBeforeGet - -- ], testGroup "Self conversation" [ test s "create a self conversation" testSelfConversation, @@ -2053,7 +2040,7 @@ testDeleteMLSConv :: TestM () testDeleteMLSConv = do localDomain <- viewFederationDomain -- c <- view tsCannon - (tid, aliceUnq, [bobUnq]) <- Util.createBindingTeamWithMembers 2 + (tid, aliceUnq, [bobUnq]) <- API.Util.createBindingTeamWithMembers 2 let alice = Qualified aliceUnq localDomain bob = Qualified bobUnq localDomain @@ -2152,213 +2139,6 @@ testRemoteUserPostsCommitBundle = do pure () --- testGetGlobalTeamConvNonExistant :: TestM () --- testGetGlobalTeamConvNonExistant = do --- uid <- randomUser --- tid <- randomId --- -- authorisation fails b/c not a team member --- getGlobalTeamConv uid 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 --- getGlobalTeamConv uid 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 --- --- s <- liftIO setup --- let domain = s ^. tsGConf . optSettings . setFederationDomain --- --- let response = getGlobalTeamConv owner tid response --- let convoId = globalTeamConv tid --- lconv = toLocalUnsafe domain convoId --- expected = --- GlobalTeamConversation --- (qUntagged lconv) --- ( 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) --- --- 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]) =/~= (hush . (<$$>) 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]) =~= (hush . (<$$>) qUnqualified . decodeQualifiedConvIdList) --- --- testConvListIncludesGlobalBeforeGet :: TestM () --- testConvListIncludesGlobalBeforeGet = do --- (tid, alice, []) <- Util.createBindingTeamWithMembers 1 --- let paginationOpts = GetPaginatedConversationIds Nothing (toRange (Proxy @5)) --- listConvIds alice paginationOpts !!! do --- const 200 === statusCode --- const (Just [globalTeamConv tid]) =~= (hush . (<$$>) qUnqualified . decodeQualifiedConvIdList) --- --- testConvListIncludesGlobalForNewUsers :: TestM () --- testConvListIncludesGlobalForNewUsers = do --- localDomain <- viewFederationDomain --- -- c <- view tsCannon --- (tid, alice, [bob]) <- Util.createBindingTeamWithMembers 2 --- let aliceQ = Qualified alice localDomain --- bobQ = Qualified bob localDomain --- --- runMLSTest $ do --- [alice1, bob1] <- traverse createMLSClient [aliceQ, bobQ] --- void $ uploadNewKeyPackage bob1 --- --- void $ setupMLSGroup alice1 --- void $ createAddCommit alice1 [bobQ] >>= sendAndConsumeCommitBundle --- --- let paginationOpts = GetPaginatedConversationIds Nothing (toRange (Proxy @5)) --- listConvIds alice paginationOpts !!! do --- const 200 === statusCode --- const (Just [globalTeamConv tid]) =~= (hush . (<$$>) qUnqualified . decodeQualifiedConvIdList) --- --- listConvIds bob paginationOpts !!! do --- const 200 === statusCode --- const (Just [globalTeamConv tid]) =~= (hush . (<$$>) qUnqualified . decodeQualifiedConvIdList) --- --- 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 --- 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 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) --- !!! do --- const 403 === statusCode --- const (Just "invalid-op") === fmap Wai.label . responseJsonError --- WS.assertNoEvent (1 # WS.Second) wss - testSelfConversation :: TestM () testSelfConversation = do alice <- randomQualifiedUser @@ -2444,45 +2224,6 @@ testSelfConversationLeave = do const (Just "invalid-op") === fmap Wai.label . responseJsonError WS.assertNoEvent (1 # WS.Second) wss -testAddTeamUserWithBundle :: TestM () -testAddTeamUserWithBundle = do - [alice, bob] <- createAndConnectUsers [Nothing, Nothing] - tid <- createBindingTeamInternal "sample-team" (qUnqualified alice) - assertQueue "create team" tActivate - assertQueueEmpty - - (qcnv, commit) <- runMLSTest $ do - (alice1 : bobClients) <- traverse createMLSClient [alice, bob, bob] - traverse_ uploadNewKeyPackage bobClients - (_, qcnv) <- setupMLSGroupWithTeam tid alice1 - commit <- createAddCommit alice1 [bob] - welcome <- assertJust (mpWelcome commit) - - events <- mlsBracket bobClients $ \wss -> do - events <- sendAndConsumeCommitBundle commit - for_ (zip bobClients wss) $ \(c, ws) -> - WS.assertMatch (5 # Second) ws $ - wsAssertMLSWelcome (cidQualifiedUser c) welcome - pure events - - event <- assertOne events - liftIO $ assertJoinEvent qcnv alice [bob] roleNameWireMember event - pure (qcnv, commit) - - -- check that bob can now see the conversation - convs <- getAllConvs (qUnqualified bob) - liftIO $ - assertBool - "Users added to an MLS group should find it when listing conversations" - (qcnv `elem` map cnvQualifiedId convs) - - returnedGS <- - fmap responseBody $ - getGroupInfo (qUnqualified alice) qcnv - returnedGS - assertMLSNotEnabled :: Assertions () assertMLSNotEnabled = do const 400 === statusCode diff --git a/services/galley/test/integration/API/MLS/Util.hs b/services/galley/test/integration/API/MLS/Util.hs index 069b48cedfc..49a8181c9fd 100644 --- a/services/galley/test/integration/API/MLS/Util.hs +++ b/services/galley/test/integration/API/MLS/Util.hs @@ -426,19 +426,6 @@ setupMLSGroup creator = setupMLSGroupWithConv action creator ) TeamId -> ClientIdentity -> MLSTest (GroupId, Qualified ConvId) -setupMLSGroupWithTeam tid creator = setupMLSGroupWithConv action creator - where - action = - responseJsonError - =<< liftTest - ( postConvQualified - (ciUser creator) - (defNewMLSConv (ciClient creator)) {newConvTeam = Just $ ConvTeamInfo tid} - ) - ClientIdentity -> MLSTest (GroupId, Qualified ConvId) setupMLSSelfGroup creator = setupMLSGroupWithConv action creator @@ -656,13 +643,13 @@ createAddCommitWithKeyPackages qcid clientsAndKeyPackages = do { mlsNewMembers = Set.fromList (map fst clientsAndKeyPackages) } - welcome <- liftIO $ readWelcome welcomeFile + welcome <- liftIO $ BS.readFile welcomeFile pgs <- liftIO $ BS.readFile pgsFile pure $ MessagePackage { mpSender = qcid, mpMessage = commit, - mpWelcome = welcome, + mpWelcome = Just welcome, mpPublicGroupState = Just pgs } @@ -877,7 +864,7 @@ sendAndConsumeCommit mp = do pure events -mkBundle :: HasCallStack => MessagePackage -> Either Text CommitBundle +mkBundle :: MessagePackage -> Either Text CommitBundle mkBundle mp = do commitB <- decodeMLS' (mpMessage mp) welcomeB <- traverse decodeMLS' (mpWelcome mp) @@ -887,7 +874,7 @@ mkBundle mp = do CommitBundle commitB welcomeB $ GroupInfoBundle UnencryptedGroupInfo TreeFull pgsB -createBundle :: (HasCallStack, MonadIO m) => MessagePackage -> m ByteString +createBundle :: MonadIO m => MessagePackage -> m ByteString createBundle mp = do bundle <- either (liftIO . assertFailure . T.unpack) pure $ diff --git a/services/galley/test/integration/API/Teams.hs b/services/galley/test/integration/API/Teams.hs index ef7ed1e94f0..72cb13c55bc 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 or missing" (postCryptoBroadcastMessage2 bcast), + test s "redundant/missing" (postCryptoBroadcastMessage2 bcast), test s "no-team" (postCryptoBroadcastMessageNoTeam bcast), test s "100 (or max conns)" (postCryptoBroadcastMessage100OrMaxConns bcast) ] @@ -192,17 +192,16 @@ testCreateTeam = do testGetTeams :: TestM () testGetTeams = do owner <- Util.randomUser - let getTeams' = Util.getTeams owner - getTeams' [] >>= checkTeamList Nothing + Util.getTeams owner [] >>= checkTeamList Nothing tid <- Util.createBindingTeamInternal "foo" owner <* assertQueue "create team" tActivate wrongTid <- (Util.randomUser >>= Util.createBindingTeamInternal "foobar") <* assertQueue "create team" tActivate - 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) + 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) -- these two queries do not yield responses that are equivalent to the old wai route API - getTeams' [("ids", Just $ toByteString' wrongTid)] >>= checkTeamList (Just tid) - getTeams' [("start", Just $ toByteString' tid)] >>= checkTeamList (Just tid) + Util.getTeams owner [("ids", Just $ toByteString' wrongTid)] >>= checkTeamList (Just tid) + Util.getTeams owner [("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 205505d51a4..3df6b0271d4 100644 --- a/services/galley/test/integration/API/Teams/Feature.hs +++ b/services/galley/test/integration/API/Teams/Feature.hs @@ -7,6 +7,7 @@ -- 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 @@ -14,9 +15,6 @@ -- -- 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 b5b2b532caf..b38042d4edf 100644 --- a/services/galley/test/integration/API/Util.hs +++ b/services/galley/test/integration/API/Util.hs @@ -15,9 +15,6 @@ -- 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 @@ -280,17 +277,9 @@ 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 @@ -619,18 +608,7 @@ 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" @@ -697,18 +675,7 @@ 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 :: @@ -728,8 +695,7 @@ defNewMLSConv :: ClientId -> NewConv defNewMLSConv c = defNewProteusConv { newConvProtocol = ProtocolMLSTag, - newConvCreatorClient = Just c, - newConvName = Just (unsafeRange "Test conv") + newConvCreatorClient = Just c } postConvQualified :: @@ -765,19 +731,7 @@ postConvWithRemoteUsers u n = postTeamConv :: TeamId -> UserId -> [UserId] -> Maybe Text -> [Access] -> Maybe (Set AccessRole) -> 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 @@ -814,19 +768,7 @@ postConvWithRole u members name access arole timer role = postConvWithReceipt :: UserId -> [UserId] -> Maybe Text -> [Access] -> Maybe (Set AccessRole) -> 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 @@ -837,19 +779,7 @@ 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 @@ -1113,20 +1043,6 @@ getConv u c = do . zConn "conn" . zType "access" -getGlobalTeamConv :: - (MonadIO m, MonadHttp m, HasGalley m, HasCallStack) => - UserId -> - TeamId -> - m ResponseLBS -getGlobalTeamConv u tid = do - g <- viewGalley - get $ - g - . paths ["teams", toByteString' tid, "conversations", "global"] - . zUser u - . 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 @@ -1967,12 +1883,12 @@ decodeQualifiedConvIdList = fmap mtpResults . responseJsonEither @ConvIdsPage zUser :: UserId -> Request -> Request zUser = header "Z-User" . toByteString' -zClient :: ClientId -> Request -> Request -zClient = header "Z-Client" . toByteString' - zBot :: UserId -> Request -> Request zBot = header "Z-Bot" . toByteString' +zClient :: ClientId -> Request -> Request +zClient = header "Z-Client" . toByteString' + zConn :: ByteString -> Request -> Request zConn = header "Z-Connection" diff --git a/services/galley/test/unit/Test/Galley/Intra/User.hs b/services/galley/test/unit/Test/Galley/Intra/User.hs index 1138e79f0a3..c6bec864870 100644 --- a/services/galley/test/unit/Test/Galley/Intra/User.hs +++ b/services/galley/test/unit/Test/Galley/Intra/User.hs @@ -20,6 +20,7 @@ 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 b8b09cfe8f1..9223659ed11 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 #-} +{-# OPTIONS_GHC -Wno-orphans -Wno-unused-imports #-} -- This file is part of the Wire Server implementation. -- @@ -28,10 +28,12 @@ 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 8ec807152fe..a10a9a13f8c 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 #-} +{-# OPTIONS_GHC -Wno-orphans -Wno-unused-imports #-} -- This file is part of the Wire Server implementation. --