From 2d3faff06b51450a8992ee02d9e8df461a2f538f Mon Sep 17 00:00:00 2001 From: Stefan Matting Date: Thu, 1 Sep 2022 12:59:56 +0200 Subject: [PATCH 01/58] MLS: Backend sends remove proposal upon user deletion (#2650) Co-authored-by: Paolo Capriotti --- cassandra-schema.cql | 4 +- .../mls-remove-proposals-on-user-deletion | 1 + .../developer/reference/cassandra-schema.cql | 2 +- .../src/Galley/Types/Conversations/Members.hs | 5 +- libs/wire-api/src/Wire/API/Error/Galley.hs | 2 +- libs/wire-api/src/Wire/API/MLS/Credential.hs | 9 + libs/wire-api/src/Wire/API/MLS/KeyPackage.hs | 14 ++ libs/wire-api/src/Wire/API/MLS/Message.hs | 17 +- .../src/Wire/API/MLS/Serialisation.hs | 9 + libs/wire-api/test/unit/Test/Wire/API/MLS.hs | 18 +- services/brig/src/Brig/Data/Instances.hs | 24 --- services/galley/galley.cabal | 1 + services/galley/schema/src/Main.hs | 4 +- .../schema/src/V71_MemberClientKeypackage.hs | 50 +++++ services/galley/src/Galley/API/Create.hs | 3 +- services/galley/src/Galley/API/Error.hs | 5 + services/galley/src/Galley/API/Federation.hs | 10 +- services/galley/src/Galley/API/Internal.hs | 9 + .../galley/src/Galley/API/MLS/KeyPackage.hs | 4 + services/galley/src/Galley/API/MLS/Message.hs | 179 ++++++++++++------ services/galley/src/Galley/Cassandra.hs | 2 +- .../Galley/Cassandra/Conversation/Members.hs | 37 +++- .../galley/src/Galley/Cassandra/Queries.hs | 35 ++-- .../src/Galley/Data/Conversation/Types.hs | 10 + .../galley/src/Galley/Effects/MemberStore.hs | 5 +- services/galley/test/integration/API/MLS.hs | 103 +++++++++- .../galley/test/integration/API/MLS/Util.hs | 15 ++ services/galley/test/integration/API/Util.hs | 27 +++ 28 files changed, 486 insertions(+), 118 deletions(-) create mode 100644 changelog.d/2-features/mls-remove-proposals-on-user-deletion create mode 100644 services/galley/schema/src/V71_MemberClientKeypackage.hs diff --git a/cassandra-schema.cql b/cassandra-schema.cql index c4666a1071b..f14091ddbd6 100644 --- a/cassandra-schema.cql +++ b/cassandra-schema.cql @@ -169,7 +169,7 @@ CREATE TABLE galley_test.member ( conversation_role text, hidden boolean, hidden_ref text, - mls_clients set, + mls_clients_keypackages set>>, otr_archived boolean, otr_archived_ref text, otr_muted boolean, @@ -263,7 +263,7 @@ CREATE TABLE galley_test.member_remote_user ( user_remote_domain text, user_remote_id uuid, conversation_role text, - mls_clients set, + mls_clients_keypackages set>>, PRIMARY KEY (conv, user_remote_domain, user_remote_id) ) WITH CLUSTERING ORDER BY (user_remote_domain ASC, user_remote_id ASC) AND bloom_filter_fp_chance = 0.1 diff --git a/changelog.d/2-features/mls-remove-proposals-on-user-deletion b/changelog.d/2-features/mls-remove-proposals-on-user-deletion new file mode 100644 index 00000000000..cacb36e122a --- /dev/null +++ b/changelog.d/2-features/mls-remove-proposals-on-user-deletion @@ -0,0 +1 @@ +External remove proposals are now sent to a group when a user is deleted diff --git a/docs/src/developer/reference/cassandra-schema.cql b/docs/src/developer/reference/cassandra-schema.cql index 0939aa54a6e..8382d360503 120000 --- a/docs/src/developer/reference/cassandra-schema.cql +++ b/docs/src/developer/reference/cassandra-schema.cql @@ -1 +1 @@ -../../../cassandra-schema.cql \ No newline at end of file +../../../../cassandra-schema.cql \ No newline at end of file diff --git a/libs/galley-types/src/Galley/Types/Conversations/Members.hs b/libs/galley-types/src/Galley/Types/Conversations/Members.hs index 12926efced7..9c6b9b5eb0a 100644 --- a/libs/galley-types/src/Galley/Types/Conversations/Members.hs +++ b/libs/galley-types/src/Galley/Types/Conversations/Members.hs @@ -37,13 +37,14 @@ import qualified Data.Set as Set import Imports import Wire.API.Conversation import Wire.API.Conversation.Role (RoleName, roleNameWireAdmin) +import Wire.API.MLS.KeyPackage import Wire.API.Provider.Service (ServiceRef) -- | Internal (cassandra) representation of a remote conversation member. data RemoteMember = RemoteMember { rmId :: Remote UserId, rmConvRoleName :: RoleName, - rmMLSClients :: Set ClientId + rmMLSClients :: Set (ClientId, KeyPackageRef) } deriving stock (Show) @@ -64,7 +65,7 @@ data LocalMember = LocalMember lmStatus :: MemberStatus, lmService :: Maybe ServiceRef, lmConvRoleName :: RoleName, - lmMLSClients :: Set ClientId + lmMLSClients :: Set (ClientId, KeyPackageRef) } deriving stock (Show) diff --git a/libs/wire-api/src/Wire/API/Error/Galley.hs b/libs/wire-api/src/Wire/API/Error/Galley.hs index 7ba3239c8b0..f6344289905 100644 --- a/libs/wire-api/src/Wire/API/Error/Galley.hs +++ b/libs/wire-api/src/Wire/API/Error/Galley.hs @@ -192,7 +192,7 @@ type instance MapError 'MLSClientMismatch = 'StaticError 409 "mls-client-mismatc type instance MapError 'MLSStaleMessage = 'StaticError 409 "mls-stale-message" "The conversation epoch in a message is too old" -type instance MapError 'MLSCommitMissingReferences = 'StaticError 409 "mls-commit-missing-references" "The commit is not refrencing all pending proposals" +type instance MapError 'MLSCommitMissingReferences = 'StaticError 409 "mls-commit-missing-references" "The commit is not referencing all pending proposals" type instance MapError 'MLSSelfRemovalNotAllowed = 'StaticError 409 "mls-self-removal-not-allowed" "Self removal from group is not allowed" diff --git a/libs/wire-api/src/Wire/API/MLS/Credential.hs b/libs/wire-api/src/Wire/API/MLS/Credential.hs index 6cd03be33fc..c3cb28c6c5e 100644 --- a/libs/wire-api/src/Wire/API/MLS/Credential.hs +++ b/libs/wire-api/src/Wire/API/MLS/Credential.hs @@ -19,6 +19,7 @@ module Wire.API.MLS.Credential where +import Cassandra.CQL import Control.Error.Util import Control.Lens ((?~)) import Data.Aeson (FromJSON (..), FromJSONKey (..), ToJSON (..), ToJSONKey (..)) @@ -84,6 +85,14 @@ data SignatureSchemeTag = Ed25519 deriving stock (Bounded, Enum, Eq, Ord, Show, Generic) deriving (Arbitrary) via GenericUniform SignatureSchemeTag +instance Cql SignatureSchemeTag where + ctype = Tagged TextColumn + toCql = CqlText . signatureSchemeName + fromCql (CqlText name) = + note ("Unexpected signature scheme: " <> T.unpack name) $ + signatureSchemeFromName name + fromCql _ = Left "SignatureScheme: Text expected" + signatureSchemeNumber :: SignatureSchemeTag -> Word16 signatureSchemeNumber Ed25519 = 0x807 diff --git a/libs/wire-api/src/Wire/API/MLS/KeyPackage.hs b/libs/wire-api/src/Wire/API/MLS/KeyPackage.hs index 3d39d778c5f..ae4dd7a1552 100644 --- a/libs/wire-api/src/Wire/API/MLS/KeyPackage.hs +++ b/libs/wire-api/src/Wire/API/MLS/KeyPackage.hs @@ -37,6 +37,7 @@ module Wire.API.MLS.KeyPackage ) where +import Cassandra.CQL hiding (Set) import Control.Applicative import Control.Lens hiding (set, (.=)) import Data.Aeson (FromJSON, ToJSON) @@ -44,6 +45,7 @@ import Data.Binary import Data.Binary.Get import Data.Binary.Put import qualified Data.ByteString as B +import qualified Data.ByteString.Lazy as LBS import Data.Id import Data.Json.Util import Data.Qualified @@ -79,6 +81,12 @@ instance ToSchema KeyPackageData where .= named "KeyPackage" base64Schema ) +instance Cql KeyPackageData where + ctype = Tagged BlobColumn + toCql = CqlBlob . LBS.fromStrict . kpData + fromCql (CqlBlob b) = pure . KeyPackageData . LBS.toStrict $ b + fromCql _ = Left "Expected CqlBlob" + data KeyPackageBundleEntry = KeyPackageBundleEntry { kpbeUser :: Qualified UserId, kpbeClient :: ClientId, @@ -132,6 +140,12 @@ instance ParseMLS KeyPackageRef where instance SerialiseMLS KeyPackageRef where serialiseMLS = putByteString . unKeyPackageRef +instance Cql KeyPackageRef where + ctype = Tagged BlobColumn + toCql = CqlBlob . LBS.fromStrict . unKeyPackageRef + fromCql (CqlBlob b) = pure . KeyPackageRef . LBS.toStrict $ b + fromCql _ = Left "Expected CqlBlob" + -- | Compute key package ref given a ciphersuite and the raw key package data. kpRef :: CipherSuiteTag -> KeyPackageData -> KeyPackageRef kpRef cs = diff --git a/libs/wire-api/src/Wire/API/MLS/Message.hs b/libs/wire-api/src/Wire/API/MLS/Message.hs index 721f63c9c35..28594f36237 100644 --- a/libs/wire-api/src/Wire/API/MLS/Message.hs +++ b/libs/wire-api/src/Wire/API/MLS/Message.hs @@ -38,12 +38,11 @@ module Wire.API.MLS.Message MLSMessageSendingStatus (..), KnownFormatTag (..), verifyMessageSignature, - mkRemoveProposalMessage, + mkSignedMessage, ) where import Control.Lens ((?~)) -import Crypto.Error import Crypto.PubKey.Ed25519 import qualified Data.Aeson as A import Data.Binary @@ -341,14 +340,14 @@ verifyMessageSignature :: CipherSuiteTag -> Message 'MLSPlainText -> ByteString verifyMessageSignature cs msg pubkey = csVerifySignature cs pubkey (rmRaw (msgTBS msg)) (msgSignature (msgExtraFields msg)) -mkRemoveProposalMessage :: +mkSignedMessage :: SecretKey -> PublicKey -> GroupId -> Epoch -> - KeyPackageRef -> - Maybe (Message 'MLSPlainText) -mkRemoveProposalMessage priv pub gid epoch ref = maybeCryptoError $ do + MessagePayload 'MLSPlainText -> + Message 'MLSPlainText +mkSignedMessage priv pub gid epoch payload = let tbs = mkRawMLS $ MessageTBS @@ -357,7 +356,7 @@ mkRemoveProposalMessage priv pub gid epoch ref = maybeCryptoError $ do tbsMsgEpoch = epoch, tbsMsgAuthData = mempty, tbsMsgSender = PreconfiguredSender 0, - tbsMsgPayload = ProposalMessage (mkRemoveProposal ref) + tbsMsgPayload = payload } - let sig = BA.convert $ sign priv pub (rmRaw tbs) - pure (Message tbs (MessageExtraFields sig Nothing Nothing)) + sig = BA.convert $ sign priv pub (rmRaw tbs) + in Message tbs (MessageExtraFields sig Nothing Nothing) diff --git a/libs/wire-api/src/Wire/API/MLS/Serialisation.hs b/libs/wire-api/src/Wire/API/MLS/Serialisation.hs index 6510ac31008..a55d9e3fa24 100644 --- a/libs/wire-api/src/Wire/API/MLS/Serialisation.hs +++ b/libs/wire-api/src/Wire/API/MLS/Serialisation.hs @@ -32,6 +32,8 @@ module Wire.API.MLS.Serialisation fromMLSEnum, toMLSEnum', toMLSEnum, + encodeMLS, + encodeMLS', decodeMLS, decodeMLS', decodeMLSWith, @@ -173,6 +175,13 @@ newtype BinaryMLS a = BinaryMLS a instance Binary a => ParseMLS (BinaryMLS a) where parseMLS = BinaryMLS <$> get +-- | Encode an MLS value to a lazy bytestring. +encodeMLS :: SerialiseMLS a => a -> LByteString +encodeMLS = runPut . serialiseMLS + +encodeMLS' :: SerialiseMLS a => a -> ByteString +encodeMLS' = LBS.toStrict . encodeMLS + -- | Decode an MLS value from a lazy bytestring. Return an error message in case of failure. decodeMLS :: ParseMLS a => LByteString -> Either Text a decodeMLS = decodeMLSWith parseMLS diff --git a/libs/wire-api/test/unit/Test/Wire/API/MLS.hs b/libs/wire-api/test/unit/Test/Wire/API/MLS.hs index d13573dd596..9040f432d49 100644 --- a/libs/wire-api/test/unit/Test/Wire/API/MLS.hs +++ b/libs/wire-api/test/unit/Test/Wire/API/MLS.hs @@ -192,13 +192,27 @@ testRemoveProposalMessageSignature = withSystemTempDirectory "mls" $ \tmp -> do secretKey <- Ed25519.generateSecretKey let publicKey = Ed25519.toPublic secretKey - let message = fromJust (mkRemoveProposalMessage secretKey publicKey gid (Epoch 1) (fromJust (kpRef' kp))) + let message = mkSignedMessage secretKey publicKey gid (Epoch 1) (ProposalMessage (mkRemoveProposal (fromJust (kpRef' kp)))) + let messageFilename = "signed-message.mls" BS.writeFile (tmp messageFilename) (rmRaw (mkRawMLS message)) let signerKeyFilename = "signer-key.bin" BS.writeFile (tmp signerKeyFilename) (convert publicKey) - void . liftIO $ spawn (cli qcid tmp ["check-signature", "--group", tmp groupFilename, "--message", tmp messageFilename, "--signer-key", tmp signerKeyFilename]) Nothing + void . liftIO $ + spawn + ( cli + qcid + tmp + [ "consume", + "--group", + tmp groupFilename, + "--signer-key", + tmp signerKeyFilename, + tmp messageFilename + ] + ) + Nothing createGroup :: FilePath -> String -> String -> GroupId -> IO () createGroup tmp store groupName gid = do diff --git a/services/brig/src/Brig/Data/Instances.hs b/services/brig/src/Brig/Data/Instances.hs index cea0641b7fe..4ec4e3890c1 100644 --- a/services/brig/src/Brig/Data/Instances.hs +++ b/services/brig/src/Brig/Data/Instances.hs @@ -31,20 +31,16 @@ import Control.Error (note) import Data.Aeson (eitherDecode, encode) import qualified Data.Aeson as JSON import Data.ByteString.Conversion -import qualified Data.ByteString.Lazy as LBS import Data.Domain (Domain, domainText, mkDomain) import Data.Handle (Handle (..)) import Data.Id () import Data.Range () import Data.String.Conversions (LBS, ST, cs) -import qualified Data.Text as T import Data.Text.Ascii () import Data.Text.Encoding (encodeUtf8) import Imports import Wire.API.Asset (AssetKey, assetKeyToText, nilAssetKey) import Wire.API.Connection (RelationWithHistory (..)) -import Wire.API.MLS.Credential -import Wire.API.MLS.KeyPackage import Wire.API.Properties import Wire.API.User import Wire.API.User.Activation @@ -283,26 +279,6 @@ instance Cql Domain where fromCql (CqlText txt) = mkDomain txt fromCql _ = Left "Domain: Text expected" -instance Cql SignatureSchemeTag where - ctype = Tagged TextColumn - toCql = CqlText . signatureSchemeName - fromCql (CqlText name) = - note ("Unexpected signature scheme: " <> T.unpack name) $ - signatureSchemeFromName name - fromCql _ = Left "SignatureScheme: Text expected" - -instance Cql KeyPackageRef where - ctype = Tagged BlobColumn - toCql = CqlBlob . LBS.fromStrict . unKeyPackageRef - fromCql (CqlBlob b) = pure . KeyPackageRef . LBS.toStrict $ b - fromCql _ = Left "Expected CqlBlob" - -instance Cql KeyPackageData where - ctype = Tagged BlobColumn - toCql = CqlBlob . LBS.fromStrict . kpData - fromCql (CqlBlob b) = pure . KeyPackageData . LBS.toStrict $ b - fromCql _ = Left "Expected CqlBlob" - instance Cql SearchVisibilityInbound where ctype = Tagged IntColumn diff --git a/services/galley/galley.cabal b/services/galley/galley.cabal index f10581474ee..f6c3689b8ff 100644 --- a/services/galley/galley.cabal +++ b/services/galley/galley.cabal @@ -660,6 +660,7 @@ executable galley-schema V68_MLSCommitLock V69_MLSProposal V70_MLSCipherSuite + V71_MemberClientKeypackage hs-source-dirs: schema/src default-extensions: diff --git a/services/galley/schema/src/Main.hs b/services/galley/schema/src/Main.hs index 1d26cc7a89f..e77d65cfed2 100644 --- a/services/galley/schema/src/Main.hs +++ b/services/galley/schema/src/Main.hs @@ -73,6 +73,7 @@ import qualified V67_MLSFeature import qualified V68_MLSCommitLock import qualified V69_MLSProposal import qualified V70_MLSCipherSuite +import qualified V71_MemberClientKeypackage main :: IO () main = do @@ -131,7 +132,8 @@ main = do V67_MLSFeature.migration, V68_MLSCommitLock.migration, V69_MLSProposal.migration, - V70_MLSCipherSuite.migration + V70_MLSCipherSuite.migration, + V71_MemberClientKeypackage.migration -- When adding migrations here, don't forget to update -- 'schemaVersion' in Galley.Cassandra -- (see also docs/developer/cassandra-interaction.md) diff --git a/services/galley/schema/src/V71_MemberClientKeypackage.hs b/services/galley/schema/src/V71_MemberClientKeypackage.hs new file mode 100644 index 00000000000..1695957905c --- /dev/null +++ b/services/galley/schema/src/V71_MemberClientKeypackage.hs @@ -0,0 +1,50 @@ +-- 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 V71_MemberClientKeypackage where + +import Cassandra.Schema +import Imports +import Text.RawString.QQ + +migration :: Migration +migration = + Migration 71 "Replace mls_clients with mls_clients_keypackages in member table" $ do + schema' + [r| + ALTER TABLE member ADD ( + mls_clients_keypackages set>> + ); + |] + schema' + [r| + ALTER TABLE member DROP ( + mls_clients + ); + |] + schema' + [r| + ALTER TABLE member_remote_user ADD ( + mls_clients_keypackages set>> + ); + |] + schema' + [r| + ALTER TABLE member_remote_user DROP ( + mls_clients + ); + |] diff --git a/services/galley/src/Galley/API/Create.hs b/services/galley/src/Galley/API/Create.hs index 17e2ee5edf5..85fd3e3c00b 100644 --- a/services/galley/src/Galley/API/Create.hs +++ b/services/galley/src/Galley/API/Create.hs @@ -40,6 +40,7 @@ import qualified Data.Set as Set import Data.Time import qualified Data.UUID.Tagged as U import Galley.API.Error +import Galley.API.MLS.KeyPackage (nullKeyPackageRef) import Galley.API.Mapping import Galley.API.One2One import Galley.API.Util @@ -117,7 +118,7 @@ createGroupConversation lusr conn newConv = do case (newConvProtocol newConv, newConvCreatorClient newConv) of (ProtocolProteusTag, _) -> pure () (ProtocolMLSTag, Just c) -> - E.addMLSClients lcnv (qUntagged lusr) (Set.singleton c) + E.addMLSClients lcnv (qUntagged lusr) (Set.singleton (c, nullKeyPackageRef)) (ProtocolMLSTag, Nothing) -> throw (InvalidPayload "Missing creator_client field when creating an MLS conversation") diff --git a/services/galley/src/Galley/API/Error.hs b/services/galley/src/Galley/API/Error.hs index 6d5714720f1..e43688e0c18 100644 --- a/services/galley/src/Galley/API/Error.hs +++ b/services/galley/src/Galley/API/Error.hs @@ -23,6 +23,7 @@ module Galley.API.Error InvalidInput (..), InternalError (..), internalErrorWithDescription, + internalErrorDescription, legalHoldServiceUnavailable, -- * Errors thrown by wai-routing handlers @@ -34,6 +35,7 @@ import Data.Id import Data.Text.Lazy as LT (pack) import Imports import Network.HTTP.Types.Status +import Network.Wai.Utilities (Error (message)) import qualified Network.Wai.Utilities.Error as Wai import Wire.API.Error @@ -44,6 +46,9 @@ data InternalError | CannotCreateManagedConv | InternalErrorWithDescription LText +internalErrorDescription :: InternalError -> LText +internalErrorDescription = message . toWai + instance APIError InternalError where toWai (BadConvState convId) = badConvState convId toWai BadMemberState = Wai.mkError status500 "bad-state" "Bad internal member state." diff --git a/services/galley/src/Galley/API/Federation.hs b/services/galley/src/Galley/API/Federation.hs index 4a93480e8cf..2aa7f3a092b 100644 --- a/services/galley/src/Galley/API/Federation.hs +++ b/services/galley/src/Galley/API/Federation.hs @@ -62,6 +62,7 @@ import Polysemy.Error import Polysemy.Input import Polysemy.Internal.Kind (Append) import Polysemy.Resource +import Polysemy.TinyLog import qualified Polysemy.TinyLog as P import Servant (ServerT) import Servant.API @@ -422,9 +423,13 @@ onUserDeleted :: FireAndForget, ExternalAccess, GundeckAccess, + Error InternalError, Input (Local ()), Input UTCTime, - MemberStore + Input Env, + MemberStore, + ProposalStore, + TinyLog ] r => Domain -> @@ -454,6 +459,7 @@ onUserDeleted origDomain udcn = do Public.RegularConv -> do let action = pure untaggedDeletedUser botsAndMembers = convBotsAndMembers conv + mlsRemoveUser conv (qUntagged deletedUser) void $ notifyConversationAction (sing @'ConversationLeaveTag) @@ -578,6 +584,8 @@ sendMLSMessage remoteDomain msr = . runError . fmap (either (F.MLSMessageResponseProposalFailure . pfInner) id) . runError + . fmap (either (F.MLSMessageResponseProposalFailure . pfInner) id) + . runError $ do loc <- qualifyLocal () let sender = toRemoteUnsafe remoteDomain (F.msrSender msr) diff --git a/services/galley/src/Galley/API/Internal.hs b/services/galley/src/Galley/API/Internal.hs index 04497a56828..120845565a8 100644 --- a/services/galley/src/Galley/API/Internal.hs +++ b/services/galley/src/Galley/API/Internal.hs @@ -37,8 +37,10 @@ import GHC.TypeLits (AppendSymbol) import qualified Galley.API.Clients as Clients import qualified Galley.API.Create as Create import qualified Galley.API.CustomBackend as CustomBackend +import Galley.API.Error import Galley.API.LegalHold (unsetTeamLegalholdWhitelistedH) import Galley.API.LegalHold.Conflicts +import Galley.API.MLS.Message (mlsRemoveUser) import Galley.API.One2One import Galley.API.Public import Galley.API.Public.Servant @@ -58,6 +60,7 @@ import Galley.Effects.FederatorAccess import Galley.Effects.GundeckAccess import Galley.Effects.LegalHoldStore as LegalHoldStore import Galley.Effects.MemberStore +import Galley.Effects.ProposalStore import Galley.Effects.TeamStore import qualified Galley.Intra.Push as Intra import Galley.Monad @@ -629,10 +632,13 @@ rmUser :: FederatorAccess, GundeckAccess, Input UTCTime, + Input Env, ListItems p1 ConvId, ListItems p1 (Remote ConvId), ListItems p2 TeamId, + Input (Local ()), MemberStore, + ProposalStore, TeamStore, P.TinyLog ] @@ -678,6 +684,9 @@ rmUser lusr conn = do ConnectConv -> deleteMembers (Data.convId c) (UserList [tUnqualified lusr] []) $> Nothing RegularConv | tUnqualified lusr `isMember` Data.convLocalMembers c -> do + runError (mlsRemoveUser 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 diff --git a/services/galley/src/Galley/API/MLS/KeyPackage.hs b/services/galley/src/Galley/API/MLS/KeyPackage.hs index 2acbab1185a..c5e42031a4b 100644 --- a/services/galley/src/Galley/API/MLS/KeyPackage.hs +++ b/services/galley/src/Galley/API/MLS/KeyPackage.hs @@ -17,6 +17,7 @@ module Galley.API.MLS.KeyPackage where +import qualified Data.ByteString as BS import Galley.Effects.BrigAccess import Imports import Polysemy @@ -25,6 +26,9 @@ import Wire.API.Error.Galley import Wire.API.MLS.Credential import Wire.API.MLS.KeyPackage +nullKeyPackageRef :: KeyPackageRef +nullKeyPackageRef = KeyPackageRef (BS.replicate 16 0) + derefKeyPackage :: Members '[ BrigAccess, diff --git a/services/galley/src/Galley/API/MLS/Message.hs b/services/galley/src/Galley/API/MLS/Message.hs index 8e0ea8ef87f..900d91170e2 100644 --- a/services/galley/src/Galley/API/MLS/Message.hs +++ b/services/galley/src/Galley/API/MLS/Message.hs @@ -20,12 +20,13 @@ module Galley.API.MLS.Message ( postMLSMessageFromLocalUser, postMLSMessageFromLocalUserV1, postMLSMessage, + mlsRemoveUser, MLSMessageStaticErrors, ) where import Control.Comonad -import Control.Lens (preview, to) +import Control.Lens (preview, to, view) import Data.Bifunctor import Data.Domain import Data.Id @@ -51,6 +52,7 @@ import Galley.Effects.ConversationStore import Galley.Effects.FederatorAccess import Galley.Effects.MemberStore import Galley.Effects.ProposalStore +import Galley.Env import Galley.Options import Galley.Types.Conversations.Members import Imports @@ -76,6 +78,7 @@ import Wire.API.MLS.CipherSuite import Wire.API.MLS.Commit import Wire.API.MLS.Credential import Wire.API.MLS.KeyPackage +import Wire.API.MLS.Keys import Wire.API.MLS.Message import Wire.API.MLS.Proposal import qualified Wire.API.MLS.Proposal as Proposal @@ -198,48 +201,48 @@ postMLSMessage :: Sem r [LocalConversationUpdate] postMLSMessage loc qusr qcnv con smsg = case rmValue smsg of SomeMessage _ msg -> do - unless (msgEpoch msg == Epoch 0) $ - flip unless (throwS @'MLSClientSenderUserMismatch) =<< isUserSender qusr smsg + mcid <- if msgEpoch msg == Epoch 0 then pure Nothing else getSenderClient smsg + -- Check that the MLS client who created the message belongs to the user who + -- is the sender of the REST request, identified by HTTP header. + -- + -- This is only relevant in an ongoing conversation. The check should be skipped + -- in case of + -- encrypted messages in which we don't have access to the sending client's + -- key package, + -- messages sent by the backend, and + -- external add proposals which propose fresh key packages for new clients and + -- thus the validity of the key package cannot be known at the time of this + -- check. + -- For these cases the function will return True. + for_ mcid $ \cid -> + when (fmap fst (cidQualifiedClient cid) /= qusr) $ + throwS @'MLSClientSenderUserMismatch + foldQualified loc - (postMLSMessageToLocalConv qusr con smsg) - (postMLSMessageToRemoteConv loc qusr con smsg) + (postMLSMessageToLocalConv qusr (fmap ciClient mcid) con smsg) + (postMLSMessageToRemoteConv loc qusr (fmap ciClient mcid) con smsg) qcnv --- | Check that the MLS client who created the message belongs to the user who --- is the sender of the REST request, identified by HTTP header. --- --- This is only relevant in an ongoing conversation. The check should be skipped --- in case of --- * encrypted messages in which we don't have access to the sending client's --- key package, --- * messages sent by the backend, and --- * external add proposals which propose fresh key packages for new clients and --- thus the validity of the key package cannot be known at the time of this --- check. --- For these cases the function will return True. -isUserSender :: +getSenderClient :: ( Members '[ ErrorS 'MLSKeyPackageRefNotFound, BrigAccess ] r ) => - Qualified UserId -> RawMLS SomeMessage -> - Sem r Bool -isUserSender qusr smsg = case rmValue smsg of + Sem r (Maybe ClientIdentity) +getSenderClient smsg = case rmValue smsg of SomeMessage tag msg -> case tag of -- skip encrypted message - SMLSCipherText -> pure True + SMLSCipherText -> pure Nothing SMLSPlainText -> case msgSender msg of -- skip message sent by backend - PreconfiguredSender _ -> pure True + PreconfiguredSender _ -> pure Nothing -- skip external add proposal - NewMemberSender -> pure True - MemberSender ref -> do - ci <- derefKeyPackage ref - pure $ fmap fst (cidQualifiedClient ci) == qusr + NewMemberSender -> pure Nothing + MemberSender ref -> Just <$> derefKeyPackage ref postMLSMessageToLocalConv :: ( HasProposalEffects r, @@ -261,11 +264,12 @@ postMLSMessageToLocalConv :: r ) => Qualified UserId -> + Maybe ClientId -> Maybe ConnId -> RawMLS SomeMessage -> Local ConvId -> Sem r [LocalConversationUpdate] -postMLSMessageToLocalConv qusr con smsg lcnv = case rmValue smsg of +postMLSMessageToLocalConv qusr senderClient con smsg lcnv = case rmValue smsg of SomeMessage tag msg -> do conv <- getConversation (tUnqualified lcnv) >>= noteS @'ConvNotFound @@ -278,7 +282,7 @@ postMLSMessageToLocalConv qusr con smsg lcnv = case rmValue smsg of events <- case tag of SMLSPlainText -> case msgPayload msg of CommitMessage c -> - processCommit qusr con (qualifyAs lcnv conv) (msgEpoch msg) (msgSender msg) c + processCommit qusr senderClient con (qualifyAs lcnv conv) (msgEpoch msg) (msgSender msg) c ApplicationMessage _ -> throwS @'MLSUnsupportedMessage ProposalMessage prop -> processProposal qusr conv msg prop $> mempty @@ -300,11 +304,12 @@ postMLSMessageToRemoteConv :: ) => Local x -> Qualified UserId -> + Maybe ClientId -> Maybe ConnId -> RawMLS SomeMessage -> Remote ConvId -> Sem r [LocalConversationUpdate] -postMLSMessageToRemoteConv loc qusr con smsg rcnv = do +postMLSMessageToRemoteConv loc qusr _senderClient con smsg rcnv = do -- only local users can send messages to remote conversations lusr <- foldQualified loc pure (\_ -> throwS @'ConvAccessDenied) qusr -- only members may send messages to the remote conversation @@ -346,7 +351,7 @@ type HasProposalEffects r = Member TeamStore r ) -type ClientMap = Map (Qualified UserId) (Set ClientId) +type ClientMap = Map (Qualified UserId) (Set (ClientId, KeyPackageRef)) data ProposalAction = ProposalAction { paAdd :: ClientMap, @@ -362,10 +367,10 @@ instance Semigroup ProposalAction where instance Monoid ProposalAction where mempty = ProposalAction mempty mempty -paAddClient :: Qualified (UserId, ClientId) -> ProposalAction +paAddClient :: Qualified (UserId, (ClientId, KeyPackageRef)) -> ProposalAction paAddClient quc = mempty {paAdd = Map.singleton (fmap fst quc) (Set.singleton (snd (qUnqualified quc)))} -paRemoveClient :: Qualified (UserId, ClientId) -> ProposalAction +paRemoveClient :: Qualified (UserId, (ClientId, KeyPackageRef)) -> ProposalAction paRemoveClient quc = mempty {paRemove = Map.singleton (fmap fst quc) (Set.singleton (snd (qUnqualified quc)))} processCommit :: @@ -384,13 +389,14 @@ processCommit :: Member Resource r ) => Qualified UserId -> + Maybe ClientId -> Maybe ConnId -> Local Data.Conversation -> Epoch -> Sender 'MLSPlainText -> Commit -> Sem r [LocalConversationUpdate] -processCommit qusr con lconv epoch sender commit = do +processCommit qusr senderClient con lconv epoch sender commit = do self <- noteS @'ConvNotFound $ getConvMember lconv (tUnqualified lconv) qusr -- check epoch number @@ -411,7 +417,7 @@ processCommit qusr con lconv epoch sender commit = do then do -- this is a newly created conversation, and it should contain exactly one -- client (the creator) - case (sender, first (toList . lmMLSClients) self) of + case (sender, first (fmap fst . toList . lmMLSClients) self) of (MemberSender currentRef, Left [creatorClient]) -> do -- use update path as sender reference and if not existing fall back to sender senderRef <- @@ -423,11 +429,7 @@ processCommit qusr con lconv epoch sender commit = do ) $ cPath commit -- register the creator client - addKeyPackageRef - senderRef - qusr - creatorClient - (qUntagged (fmap Data.convId lconv)) + updateKeyPackageMapping lconv qusr creatorClient Nothing senderRef -- remote clients cannot send the first commit (_, Right _) -> throwS @'MLSStaleMessage -- uninitialised conversations should contain exactly one client @@ -440,11 +442,9 @@ processCommit qusr con lconv epoch sender commit = do (MemberSender senderRef, Just updatedKeyPackage) -> do updatedRef <- kpRef' updatedKeyPackage & note (mlsProtocolError "Could not compute key package ref") -- postpone key package ref update until other checks/processing passed - pure . updateKeyPackageRef $ - KeyPackageUpdate - { kpupPrevious = senderRef, - kpupNext = updatedRef - } + case senderClient of + Just cli -> pure $ updateKeyPackageMapping lconv qusr cli (Just senderRef) updatedRef + Nothing -> pure $ pure () (_, Nothing) -> pure $ pure () -- ignore commits without update path _ -> throw (mlsProtocolError "Unexpected sender") @@ -465,6 +465,33 @@ processCommit qusr con lconv epoch sender commit = do pure updates +updateKeyPackageMapping :: + Members '[BrigAccess, MemberStore] r => + Local Data.Conversation -> + Qualified UserId -> + ClientId -> + Maybe KeyPackageRef -> + KeyPackageRef -> + Sem r () +updateKeyPackageMapping lconv qusr cid mOld new = do + let lcnv = fmap Data.convId lconv + -- update actual mapping in brig + case mOld of + Nothing -> + addKeyPackageRef new qusr cid (qUntagged lcnv) + Just old -> + updateKeyPackageRef + KeyPackageUpdate + { kpupPrevious = old, + kpupNext = new + } + + -- remove old (client, key package) pair + let old = fromMaybe nullKeyPackageRef mOld + removeMLSClients lcnv qusr (Set.singleton (cid, old)) + -- add new (client, key package) pair + addMLSClients lcnv qusr (Set.singleton (cid, new)) + applyProposalRef :: ( HasProposalEffects r, Members @@ -498,10 +525,10 @@ applyProposal (AddProposal kp) = do kpRef' kp & note (mlsProtocolError "Could not compute ref of a key package in an Add proposal") qclient <- cidQualifiedClient <$> derefKeyPackage ref - pure (paAddClient qclient) + pure (paAddClient ((,ref) <$$> qclient)) applyProposal (RemoveProposal ref) = do qclient <- cidQualifiedClient <$> derefKeyPackage ref - pure (paRemoveClient qclient) + pure (paRemoveClient ((,ref) <$$> qclient)) applyProposal _ = pure mempty checkProposalCipherSuite :: @@ -673,7 +700,7 @@ executeProposalAction qusr con lconv action = do -- new user Nothing -> do -- final set of clients in the conversation - let clients = newclients <> Map.findWithDefault mempty qtarget cm + let clients = Set.map fst (newclients <> Map.findWithDefault mempty qtarget cm) -- get list of mls clients from brig clientInfo <- getMLSClients lconv qtarget ss let allClients = Set.map ciId clientInfo @@ -700,19 +727,29 @@ executeProposalAction qusr con lconv action = do -- add users to the conversation and send events addEvents <- foldMap addMembers . nonEmpty . map fst $ newUserClients - -- add clients to the database + + -- add clients in the conversation state for_ newUserClients $ \(qtarget, newClients) -> do addMLSClients (fmap convId lconv) qtarget newClients -- remove users from the conversation and send events removeEvents <- foldMap removeMembers (nonEmpty membersToRemove) + -- remove clients in the conversation state + for_ removeUserClients $ \(qtarget, clients) -> do + removeMLSClients (fmap convId lconv) qtarget clients + pure (addEvents <> removeEvents) where -- This also filters out client removals for clients that don't exist anymore -- For these clients there is nothing left to do - checkRemoval :: Local x -> SignatureSchemeTag -> Qualified UserId -> Set ClientId -> Sem r (Maybe (Qualified UserId)) - checkRemoval loc ss qtarget clients = do + checkRemoval :: + Local x -> + SignatureSchemeTag -> + Qualified UserId -> + Set (ClientId, KeyPackageRef) -> + Sem r (Maybe (Qualified UserId)) + checkRemoval loc ss qtarget (Set.map fst -> clients) = do allClients <- Set.map ciId <$> getMLSClients loc qtarget ss let allClientsDontExist = Set.null (clients `Set.intersection` allClients) if allClientsDontExist @@ -814,13 +851,13 @@ propagateMessage loc qusr conv con raw = do cToList (u, s) = (u,) <$> Set.toList s clients :: LocalMember -> Local (UserId, Set ClientId) - clients LocalMember {..} = qualifyAs loc (lmId, lmMLSClients) + clients LocalMember {..} = qualifyAs loc (lmId, Set.map fst lmMLSClients) remoteMemberMLSClients :: RemoteMember -> [(UserId, ClientId)] remoteMemberMLSClients rm = map (tUnqualified (rmId rm),) - (toList (rmMLSClients rm)) + (toList (Set.map fst (rmMLSClients rm))) handleError :: Member TinyLog r => Either (Remote [a], FederationError) x -> Sem r () handleError (Right _) = pure () @@ -943,3 +980,39 @@ withCommitLock gid epoch ttl action = ) (const $ releaseCommitLock gid epoch) (const action) + +mlsRemoveUser :: + ( Members + '[ Input UTCTime, + TinyLog, + ExternalAccess, + FederatorAccess, + GundeckAccess, + Error InternalError, + ProposalStore, + Input Env, + Input (Local ()) + ] + r + ) => + Data.Conversation -> + Qualified UserId -> + Sem r () +mlsRemoveUser c qusr = do + loc <- qualifyLocal () + case Data.convProtocol c of + ProtocolProteus -> pure () + ProtocolMLS meta -> do + keyPair <- mlsKeyPair_ed25519 <$> (inputs (view mlsKeys) <*> pure RemovalPurpose) + (secKey, pubKey) <- note (InternalErrorWithDescription "backend removal key missing") $ keyPair + for_ (getConvMemberMLSClients loc c qusr) $ \cpks -> + for_ cpks $ \(_client, kpref) -> do + let proposal = mkRemoveProposal kpref + msg = mkSignedMessage secKey pubKey (cnvmlsGroupId meta) (cnvmlsEpoch meta) (ProposalMessage proposal) + msgEncoded = encodeMLS' msg + storeProposal + (cnvmlsGroupId meta) + (cnvmlsEpoch meta) + (proposalRef (cnvmlsCipherSuite meta) proposal) + proposal + propagateMessage loc qusr c Nothing msgEncoded diff --git a/services/galley/src/Galley/Cassandra.hs b/services/galley/src/Galley/Cassandra.hs index 4d70622b88b..e256f18aba0 100644 --- a/services/galley/src/Galley/Cassandra.hs +++ b/services/galley/src/Galley/Cassandra.hs @@ -20,4 +20,4 @@ module Galley.Cassandra (schemaVersion) where import Imports schemaVersion :: Int32 -schemaVersion = 70 +schemaVersion = 71 diff --git a/services/galley/src/Galley/Cassandra/Conversation/Members.hs b/services/galley/src/Galley/Cassandra/Conversation/Members.hs index 12fa07c4d17..25e2a3cb3db 100644 --- a/services/galley/src/Galley/Cassandra/Conversation/Members.hs +++ b/services/galley/src/Galley/Cassandra/Conversation/Members.hs @@ -46,6 +46,7 @@ import Polysemy.Input import qualified UnliftIO import Wire.API.Conversation.Member hiding (Member) import Wire.API.Conversation.Role +import Wire.API.MLS.KeyPackage import Wire.API.Provider.Service -- | Add members to a local conversation. @@ -157,7 +158,7 @@ toMember :: Maybe Text, -- conversation role name Maybe RoleName, - Maybe (Cassandra.Set ClientId) + Maybe (Cassandra.Set (ClientId, KeyPackageRef)) ) -> Maybe LocalMember toMember (usr, srv, prv, Just 0, omus, omur, oar, oarr, hid, hidr, crn, cs) = @@ -344,14 +345,14 @@ removeLocalMembersFromRemoteConv (qUntagged -> Qualified conv convDomain) victim setConsistency LocalQuorum for_ victims $ \u -> addPrepQuery Cql.deleteUserRemoteConv (u, convDomain, conv) -addMLSClients :: Local ConvId -> Qualified UserId -> Set.Set ClientId -> Client () +addMLSClients :: Local ConvId -> Qualified UserId -> Set.Set (ClientId, KeyPackageRef) -> Client () addMLSClients lcnv = foldQualified lcnv (addLocalMLSClients (tUnqualified lcnv)) (addRemoteMLSClients (tUnqualified lcnv)) -addRemoteMLSClients :: ConvId -> Remote UserId -> Set.Set ClientId -> Client () +addRemoteMLSClients :: ConvId -> Remote UserId -> Set.Set (ClientId, KeyPackageRef) -> Client () addRemoteMLSClients cid ruid cs = retry x5 $ write @@ -361,7 +362,7 @@ addRemoteMLSClients cid ruid cs = (Cassandra.Set (toList cs), cid, tDomain ruid, tUnqualified ruid) ) -addLocalMLSClients :: ConvId -> Local UserId -> Set.Set ClientId -> Client () +addLocalMLSClients :: ConvId -> Local UserId -> Set.Set (ClientId, KeyPackageRef) -> Client () addLocalMLSClients cid lusr cs = retry x5 $ write @@ -371,6 +372,33 @@ addLocalMLSClients cid lusr cs = (Cassandra.Set (toList cs), cid, tUnqualified lusr) ) +removeMLSClients :: Local ConvId -> Qualified UserId -> Set.Set (ClientId, KeyPackageRef) -> Client () +removeMLSClients lcnv = + foldQualified + lcnv + (removeLocalMLSClients (tUnqualified lcnv)) + (removeRemoteMLSClients (tUnqualified lcnv)) + +removeLocalMLSClients :: ConvId -> Local UserId -> Set.Set (ClientId, KeyPackageRef) -> Client () +removeLocalMLSClients cid lusr cs = + retry x5 $ + write + Cql.removeLocalMLSClients + ( params + LocalQuorum + (Cassandra.Set (toList cs), cid, tUnqualified lusr) + ) + +removeRemoteMLSClients :: ConvId -> Remote UserId -> Set.Set (ClientId, KeyPackageRef) -> Client () +removeRemoteMLSClients cid rusr cs = + retry x5 $ + write + Cql.removeRemoteMLSClients + ( params + LocalQuorum + (Cassandra.Set (toList cs), cid, tDomain rusr, tUnqualified rusr) + ) + interpretMemberStoreToCassandra :: Members '[Embed IO, Input ClientState] r => Sem (MemberStore ': r) a -> @@ -394,3 +422,4 @@ interpretMemberStoreToCassandra = interpret $ \case embedClient $ removeLocalMembersFromRemoteConv rcnv uids AddMLSClients lcnv quid cs -> embedClient $ addMLSClients lcnv quid cs + RemoveMLSClients lcnv quid cs -> embedClient $ removeMLSClients lcnv quid cs diff --git a/services/galley/src/Galley/Cassandra/Queries.hs b/services/galley/src/Galley/Cassandra/Queries.hs index 5d77b62df40..c46fb5afdb3 100644 --- a/services/galley/src/Galley/Cassandra/Queries.hs +++ b/services/galley/src/Galley/Cassandra/Queries.hs @@ -34,6 +34,7 @@ import Wire.API.Conversation.Code import Wire.API.Conversation.Protocol import Wire.API.Conversation.Role import Wire.API.MLS.CipherSuite +import Wire.API.MLS.KeyPackage import Wire.API.Provider import Wire.API.Provider.Service import Wire.API.Team @@ -271,14 +272,14 @@ lookupGroupId = "SELECT conv_id, domain from group_id_conv_id where group_id = ? type MemberStatus = Int32 -selectMember :: PrepQuery R (ConvId, UserId) (UserId, Maybe ServiceId, Maybe ProviderId, Maybe MemberStatus, Maybe MutedStatus, Maybe Text, Maybe Bool, Maybe Text, Maybe Bool, Maybe Text, Maybe RoleName, Maybe (C.Set ClientId)) -selectMember = "select user, service, provider, status, otr_muted_status, otr_muted_ref, otr_archived, otr_archived_ref, hidden, hidden_ref, conversation_role, mls_clients from member where conv = ? and user = ?" +selectMember :: PrepQuery R (ConvId, UserId) (UserId, Maybe ServiceId, Maybe ProviderId, Maybe MemberStatus, Maybe MutedStatus, Maybe Text, Maybe Bool, Maybe Text, Maybe Bool, Maybe Text, Maybe RoleName, Maybe (C.Set (ClientId, KeyPackageRef))) +selectMember = "select user, service, provider, status, otr_muted_status, otr_muted_ref, otr_archived, otr_archived_ref, hidden, hidden_ref, conversation_role, mls_clients_keypackages from member where conv = ? and user = ?" -selectMembers :: PrepQuery R (Identity ConvId) (UserId, Maybe ServiceId, Maybe ProviderId, Maybe MemberStatus, Maybe MutedStatus, Maybe Text, Maybe Bool, Maybe Text, Maybe Bool, Maybe Text, Maybe RoleName, Maybe (C.Set ClientId)) -selectMembers = "select user, service, provider, status, otr_muted_status, otr_muted_ref, otr_archived, otr_archived_ref, hidden, hidden_ref, conversation_role, mls_clients from member where conv = ?" +selectMembers :: PrepQuery R (Identity ConvId) (UserId, Maybe ServiceId, Maybe ProviderId, Maybe MemberStatus, Maybe MutedStatus, Maybe Text, Maybe Bool, Maybe Text, Maybe Bool, Maybe Text, Maybe RoleName, Maybe (C.Set (ClientId, KeyPackageRef))) +selectMembers = "select user, service, provider, status, otr_muted_status, otr_muted_ref, otr_archived, otr_archived_ref, hidden, hidden_ref, conversation_role, mls_clients_keypackages from member where conv = ?" -insertMember :: PrepQuery W (ConvId, UserId, Maybe ServiceId, Maybe ProviderId, RoleName, Maybe (C.Set ClientId)) () -insertMember = "insert into member (conv, user, service, provider, status, conversation_role, mls_clients) values (?, ?, ?, ?, 0, ?, ?)" +insertMember :: PrepQuery W (ConvId, UserId, Maybe ServiceId, Maybe ProviderId, RoleName, Maybe (C.Set (ClientId, KeyPackageRef))) () +insertMember = "insert into member (conv, user, service, provider, status, conversation_role, mls_clients_keypackages) values (?, ?, ?, ?, 0, ?, ?)" removeMember :: PrepQuery W (ConvId, UserId) () removeMember = "delete from member where conv = ? and user = ?" @@ -307,11 +308,11 @@ insertRemoteMember = "insert into member_remote_user (conv, user_remote_domain, removeRemoteMember :: PrepQuery W (ConvId, Domain, UserId) () removeRemoteMember = "delete from member_remote_user where conv = ? and user_remote_domain = ? and user_remote_id = ?" -selectRemoteMember :: PrepQuery R (ConvId, Domain, UserId) (RoleName, C.Set ClientId) -selectRemoteMember = "select conversation_role, mls_clients from member_remote_user where conv = ? and user_remote_domain = ? and user_remote_id = ?" +selectRemoteMember :: PrepQuery R (ConvId, Domain, UserId) (RoleName, C.Set (ClientId, KeyPackageRef)) +selectRemoteMember = "select conversation_role, mls_clients_keypackages from member_remote_user where conv = ? and user_remote_domain = ? and user_remote_id = ?" -selectRemoteMembers :: PrepQuery R (Identity ConvId) (Domain, UserId, RoleName, C.Set ClientId) -selectRemoteMembers = "select user_remote_domain, user_remote_id, conversation_role, mls_clients from member_remote_user where conv = ?" +selectRemoteMembers :: PrepQuery R (Identity ConvId) (Domain, UserId, RoleName, C.Set (ClientId, KeyPackageRef)) +selectRemoteMembers = "select user_remote_domain, user_remote_id, conversation_role, mls_clients_keypackages from member_remote_user where conv = ?" updateRemoteMemberConvRoleName :: PrepQuery W (RoleName, ConvId, Domain, UserId) () updateRemoteMemberConvRoleName = "update member_remote_user set conversation_role = ? where conv = ? and user_remote_domain = ? and user_remote_id = ?" @@ -367,11 +368,17 @@ rmMemberClient c = -- MLS Clients -------------------------------------------------------------- -addLocalMLSClients :: PrepQuery W (C.Set ClientId, ConvId, UserId) () -addLocalMLSClients = "update member set mls_clients = mls_clients + ? where conv = ? and user = ?" +addLocalMLSClients :: PrepQuery W (C.Set (ClientId, KeyPackageRef), ConvId, UserId) () +addLocalMLSClients = "update member set mls_clients_keypackages = mls_clients_keypackages + ? where conv = ? and user = ?" -addRemoteMLSClients :: PrepQuery W (C.Set ClientId, ConvId, Domain, UserId) () -addRemoteMLSClients = "update member_remote_user set mls_clients = mls_clients + ? where conv = ? and user_remote_domain = ? and user_remote_id = ?" +addRemoteMLSClients :: PrepQuery W (C.Set (ClientId, KeyPackageRef), ConvId, Domain, UserId) () +addRemoteMLSClients = "update member_remote_user set mls_clients_keypackages = mls_clients_keypackages + ? where conv = ? and user_remote_domain = ? and user_remote_id = ?" + +removeLocalMLSClients :: PrepQuery W (C.Set (ClientId, KeyPackageRef), ConvId, UserId) () +removeLocalMLSClients = "update member set mls_clients_keypackages = mls_clients_keypackages - ? where conv = ? and user = ?" + +removeRemoteMLSClients :: PrepQuery W (C.Set (ClientId, KeyPackageRef), ConvId, Domain, UserId) () +removeRemoteMLSClients = "update member_remote_user set mls_clients_keypackages = mls_clients_keypackages - ? where conv = ? and user_remote_domain = ? and user_remote_id = ?" acquireCommitLock :: PrepQuery W (GroupId, Epoch, Int32) Row acquireCommitLock = "insert into mls_commit_locks (group_id, epoch) values (?, ?) if not exists using ttl ?" diff --git a/services/galley/src/Galley/Data/Conversation/Types.hs b/services/galley/src/Galley/Data/Conversation/Types.hs index b93bd616c57..5f7add65558 100644 --- a/services/galley/src/Galley/Data/Conversation/Types.hs +++ b/services/galley/src/Galley/Data/Conversation/Types.hs @@ -18,12 +18,14 @@ module Galley.Data.Conversation.Types where import Data.Id +import Data.Qualified import Galley.Types.Conversations.Members import Galley.Types.UserList import Imports import Wire.API.Conversation hiding (Conversation) import Wire.API.Conversation.Protocol import Wire.API.Conversation.Role +import Wire.API.MLS.KeyPackage -- | Internal conversation type, corresponding directly to database schema. -- Should never be sent to users (and therefore doesn't have 'FromJSON' or @@ -43,3 +45,11 @@ data NewConversation = NewConversation ncUsers :: UserList (UserId, RoleName), ncProtocol :: ProtocolTag } + +getConvMemberMLSClients :: Local () -> Conversation -> Qualified UserId -> Maybe (Set (ClientId, KeyPackageRef)) +getConvMemberMLSClients loc conv qusr = + foldQualified + loc + (\lusr -> lmMLSClients <$> find ((==) (tUnqualified lusr) . lmId) (convLocalMembers conv)) + (\rusr -> rmMLSClients <$> find ((==) rusr . rmId) (convRemoteMembers conv)) + qusr diff --git a/services/galley/src/Galley/Effects/MemberStore.hs b/services/galley/src/Galley/Effects/MemberStore.hs index 11dbe2f836e..d9d8c779f87 100644 --- a/services/galley/src/Galley/Effects/MemberStore.hs +++ b/services/galley/src/Galley/Effects/MemberStore.hs @@ -39,6 +39,7 @@ module Galley.Effects.MemberStore setSelfMember, setOtherMember, addMLSClients, + removeMLSClients, -- * Delete members deleteMembers, @@ -55,6 +56,7 @@ import Galley.Types.UserList import Imports import Polysemy import Wire.API.Conversation.Member hiding (Member) +import Wire.API.MLS.KeyPackage import Wire.API.Provider.Service data MemberStore m a where @@ -71,7 +73,8 @@ data MemberStore m a where SetOtherMember :: Local ConvId -> Qualified UserId -> OtherMemberUpdate -> MemberStore m () DeleteMembers :: ConvId -> UserList UserId -> MemberStore m () DeleteMembersInRemoteConversation :: Remote ConvId -> [UserId] -> MemberStore m () - AddMLSClients :: Local ConvId -> Qualified UserId -> Set ClientId -> MemberStore m () + AddMLSClients :: Local ConvId -> Qualified UserId -> Set (ClientId, KeyPackageRef) -> MemberStore m () + RemoveMLSClients :: Local ConvId -> Qualified UserId -> Set (ClientId, KeyPackageRef) -> MemberStore m () makeSem ''MemberStore diff --git a/services/galley/test/integration/API/MLS.hs b/services/galley/test/integration/API/MLS.hs index 086a206f7d2..a08bca53ee2 100644 --- a/services/galley/test/integration/API/MLS.hs +++ b/services/galley/test/integration/API/MLS.hs @@ -153,11 +153,16 @@ tests s = test s "forward an unsupported proposal" propUnsupported ], testGroup - "External Proposal" + "External Add Proposal" [ test s "member adds new client" testExternalAddProposal, test s "non-member adds new client" testExternalAddProposalWrongUser, test s "member adds unknown new client" testExternalAddProposalWrongClient ], + testGroup + "Backend-side External Remove Proposals" + [ test s "local conversation, local user deleted" testBackendRemoveProposalLocalConvLocalUser, + test s "local conversation, remote user deleted" testBackendRemoveProposalLocalConvRemoteUser + ], testGroup "Protocol mismatch" [ test s "send a commit to a proteus conversation" testAddUsersToProteus, @@ -1701,3 +1706,99 @@ propUnsupported = withSystemTempDirectory "mls" $ \tmp -> do postMessage (qUnqualified . pUserId $ creator) msgSerialised !!! const 201 === statusCode + +testBackendRemoveProposalLocalConvLocalUser :: TestM () +testBackendRemoveProposalLocalConvLocalUser = withSystemTempDirectory "mls" $ \tmp -> do + saveRemovalKey (tmp "removal.key") + MessagingSetup {..} <- aliceInvitesBobWithTmp tmp (2, LocalUser) def {createConv = CreateConv} + let [bobParticipant] = users + let bob = pUserId bobParticipant + let alice = pUserId creator + testSuccessfulCommit MessagingSetup {users = [bobParticipant], ..} + + kprefs <- (fromJust . kpRef' . snd) <$$> liftIO (readKeyPackages tmp bobParticipant) + + c <- view tsCannon + WS.bracketR c (qUnqualified alice) $ \wsA -> do + deleteUser (qUnqualified bob) !!! const 200 === statusCode + + for_ kprefs $ \kp -> + WS.assertMatch_ (5 # WS.Second) wsA $ \notification -> do + msg <- wsAssertBackendRemoveProposal bob conversation kp notification + void . liftIO $ + spawn + ( cli + (pClientQid creator) + tmp + $ [ "consume", + "--group", + tmp "group", + "--in-place", + "--signer-key", + tmp "removal.key", + "-" + ] + ) + (Just msg) + + -- alice commits the external proposals + (commit', _) <- liftIO $ pendingProposalsCommit tmp creator "group" + events <- + postCommit + MessagingSetup + { commit = commit', + .. + } + liftIO $ events @?= [] + +testBackendRemoveProposalLocalConvRemoteUser :: TestM () +testBackendRemoveProposalLocalConvRemoteUser = withSystemTempDirectory "mls" $ \tmp -> do + let opts = + def + { createClients = DontCreateClients, + createConv = CreateConv + } + (alice, [bob]) <- + withLastPrekeys $ + setupParticipants tmp opts [(1, RemoteUser (Domain "faraway.example.com"))] + (groupId, conversation) <- setupGroup tmp CreateConv alice "group" + (commit, welcome) <- liftIO $ setupCommit tmp alice "group" "group" (pClients bob) + + let mock req = case frRPC req of + "on-conversation-updated" -> pure (Aeson.encode ()) + "on-new-remote-conversation" -> pure (Aeson.encode EmptyResponse) + "on-mls-message-sent" -> pure (Aeson.encode EmptyResponse) + "get-mls-clients" -> + pure + . Aeson.encode + . Set.fromList + . map (flip ClientInfo True . snd) + . toList + . pClients + $ bob + ms -> assertFailure ("unmocked endpoint called: " <> cs ms) + + void $ + withTempMockFederator' mock $ do + c <- view tsCannon + WS.bracketR c (qUnqualified (pUserId alice)) $ \wsA -> do + void $ postCommit MessagingSetup {creator = alice, users = [bob], ..} + + kprefs <- (fromJust . kpRef' . snd) <$$> liftIO (readKeyPackages tmp bob) + + fedGalleyClient <- view tsFedGalleyClient + void $ + runFedClient + @"on-user-deleted-conversations" + fedGalleyClient + (qDomain (pUserId bob)) + ( UserDeletedConversationsNotification + { udcvUser = qUnqualified (pUserId bob), + udcvConversations = unsafeRange [qUnqualified conversation] + } + ) + + for_ kprefs $ \kp -> + WS.assertMatch_ (5 # WS.Second) wsA $ \notification -> + void $ + wsAssertBackendRemoveProposal (pUserId bob) conversation kp notification diff --git a/services/galley/test/integration/API/MLS/Util.hs b/services/galley/test/integration/API/MLS/Util.hs index c4cca7bf2cd..5e3feaae1f7 100644 --- a/services/galley/test/integration/API/MLS/Util.hs +++ b/services/galley/test/integration/API/MLS/Util.hs @@ -39,6 +39,8 @@ import qualified Data.Map as Map import Data.Qualified import qualified Data.Set as Set import qualified Data.Text as T +import Galley.Keys +import Galley.Options import Imports import System.FilePath import System.IO.Temp @@ -52,6 +54,7 @@ import Wire.API.Conversation.Protocol import Wire.API.Event.Conversation import Wire.API.MLS.Credential import Wire.API.MLS.KeyPackage +import Wire.API.MLS.Keys import Wire.API.MLS.Message import Wire.API.MLS.Proposal import Wire.API.MLS.Serialisation @@ -142,6 +145,11 @@ pClientQid p = userClientQid (pUserId p) (NonEmpty.head (pClientIds p)) pClientId :: Participant -> ClientId pClientId = NonEmpty.head . pClientIds +readKeyPackages :: FilePath -> Participant -> IO (NonEmpty (ClientId, RawMLS KeyPackage)) +readKeyPackages tmp participant = for (pClients participant) $ \(qcid, cid) -> do + b <- BS.readFile (tmp qcid) + pure (cid, fromRight (error "parsing RawMLS KeyPackage") (decodeMLS' b)) + setupUserClient :: HasCallStack => FilePath -> @@ -606,3 +614,10 @@ mkAppAckProposalMessage gid epoch ref mrs priv pub = do } sig = BA.convert $ sign priv pub (rmRaw tbs) in (Message tbs (MessageExtraFields sig Nothing Nothing)) + +saveRemovalKey :: FilePath -> TestM () +saveRemovalKey fp = do + keys <- fromJust <$> view (tsGConf . optSettings . setMlsPrivateKeyPaths) + keysByPurpose <- liftIO $ loadAllMLSKeys keys + let (_, pub) = fromJust (mlsKeyPair_ed25519 (keysByPurpose RemovalPurpose)) + liftIO $ BS.writeFile fp (BA.convert pub) diff --git a/services/galley/test/integration/API/Util.hs b/services/galley/test/integration/API/Util.hs index 4556a34a1bd..e24b608ca88 100644 --- a/services/galley/test/integration/API/Util.hs +++ b/services/galley/test/integration/API/Util.hs @@ -111,6 +111,9 @@ import Wire.API.Federation.API import Wire.API.Federation.API.Galley import Wire.API.Federation.Domain (originDomainHeaderName) import Wire.API.Internal.Notification hiding (target) +import Wire.API.MLS.KeyPackage +import Wire.API.MLS.Message +import Wire.API.MLS.Proposal import Wire.API.MLS.Serialisation import Wire.API.Message import qualified Wire.API.Message.Proto as Proto @@ -2760,3 +2763,27 @@ wsAssertConvReceiptModeUpdate conv usr new n = do evtType e @?= ConvReceiptModeUpdate evtFrom e @?= usr evtData e @?= EdConvReceiptModeUpdate (ConversationReceiptModeUpdate new) + +wsAssertBackendRemoveProposal :: HasCallStack => Qualified UserId -> Qualified ConvId -> KeyPackageRef -> Notification -> IO ByteString +wsAssertBackendRemoveProposal fromUser convId kpref n = do + let e = List1.head (WS.unpackPayload n) + ntfTransient n @?= False + evtConv e @?= convId + evtType e @?= MLSMessageAdd + evtFrom e @?= fromUser + let bs = getMLSMessageData (evtData e) + let msg = fromRight (error "Failed to parse Message 'MLSPlaintext") $ decodeMLS' bs + let tbs = rmValue . msgTBS $ msg + tbsMsgSender tbs @?= PreconfiguredSender 0 + case tbsMsgPayload tbs of + ProposalMessage rp -> + case rmValue rp of + RemoveProposal kpRefRemove -> + kpRefRemove @?= kpref + otherProp -> error ("Exepected RemoveProposal but got " <> show otherProp) + otherPayload -> error ("Exepected ProposalMessage but got " <> show otherPayload) + pure bs + where + getMLSMessageData :: Conv.EventData -> ByteString + getMLSMessageData (EdMLSMessage bs) = bs + getMLSMessageData d = error ("Excepected EdMLSMessage, but got " <> show d) From 931e570c1d333a7cdf5d94e4b32589a1389bd52a Mon Sep 17 00:00:00 2001 From: jschaul Date: Thu, 1 Sep 2022 13:24:05 +0200 Subject: [PATCH 02/58] gundeck/cassandra: TWCS for 'notifications' table (#2615) * gundeck/cassandra: TWCS for 'notifications' table In Gundeck's 'notifications' cassandra table, switch to [TWCS](https://cassandra.apache.org/doc/latest/cassandra/operating/compaction/twcs.html) compaction strategy, which should be more efficient for this workload, and possibly bring performance benefits to latencies. It may be beneficial to run a manual compaction before rolling out this change (but things should also work without this manual operation). In case you have time, run the following before deploying this update: ``` nodetool compact gundeck notifications ``` Co-authored-by: Akshay Mankar --- cassandra-schema.cql | 2 +- ...otifications-cassandra-compaction-strategy | 4 +++ services/gundeck/gundeck.cabal | 1 + services/gundeck/schema/src/Main.hs | 4 ++- services/gundeck/schema/src/V9.hs | 33 +++++++++++++++++++ 5 files changed, 42 insertions(+), 2 deletions(-) create mode 100644 changelog.d/5-internal/gundeck-notifications-cassandra-compaction-strategy create mode 100644 services/gundeck/schema/src/V9.hs diff --git a/cassandra-schema.cql b/cassandra-schema.cql index f14091ddbd6..2f83dadcb47 100644 --- a/cassandra-schema.cql +++ b/cassandra-schema.cql @@ -602,7 +602,7 @@ CREATE TABLE gundeck_test.notifications ( AND bloom_filter_fp_chance = 0.1 AND caching = {'keys': 'ALL', 'rows_per_partition': 'NONE'} AND comment = '' - AND compaction = {'class': 'org.apache.cassandra.db.compaction.LeveledCompactionStrategy', 'tombstone_threshold': '0.1'} + AND compaction = {'class': 'org.apache.cassandra.db.compaction.TimeWindowCompactionStrategy', 'compaction_window_size': '1', 'compaction_window_unit': 'DAYS', 'max_threshold': '32', 'min_threshold': '4'} AND compression = {'chunk_length_in_kb': '64', 'class': 'org.apache.cassandra.io.compress.LZ4Compressor'} AND crc_check_chance = 1.0 AND dclocal_read_repair_chance = 0.1 diff --git a/changelog.d/5-internal/gundeck-notifications-cassandra-compaction-strategy b/changelog.d/5-internal/gundeck-notifications-cassandra-compaction-strategy new file mode 100644 index 00000000000..6eff7f41c73 --- /dev/null +++ b/changelog.d/5-internal/gundeck-notifications-cassandra-compaction-strategy @@ -0,0 +1,4 @@ +In Gundeck's 'notifications' cassandra table, switch to [TWCS](https://cassandra.apache.org/doc/latest/cassandra/operating/compaction/twcs.html) compaction strategy, which should be more efficient for this workload, and possibly bring performance benefits to latencies. +It may be beneficial to run a manual compaction before rolling out this +change (but things should also work without this manual operation). +In case you have time, run the following from a cassandra machine before deploying this update: `nodetool compact gundeck notifications`. diff --git a/services/gundeck/gundeck.cabal b/services/gundeck/gundeck.cabal index 7ee97b7d79e..ccb7d9d00e2 100644 --- a/services/gundeck/gundeck.cabal +++ b/services/gundeck/gundeck.cabal @@ -338,6 +338,7 @@ executable gundeck-schema V6 V7 V8 + V9 hs-source-dirs: schema/src default-extensions: diff --git a/services/gundeck/schema/src/Main.hs b/services/gundeck/schema/src/Main.hs index 86d75348e8a..e8b72ef8d89 100644 --- a/services/gundeck/schema/src/Main.hs +++ b/services/gundeck/schema/src/Main.hs @@ -30,6 +30,7 @@ import qualified V5 import qualified V6 import qualified V7 import qualified V8 +import qualified V9 main :: IO () main = do @@ -45,7 +46,8 @@ main = do V5.migration, V6.migration, V7.migration, - V8.migration + V8.migration, + V9.migration ] `finally` Log.close l where diff --git a/services/gundeck/schema/src/V9.hs b/services/gundeck/schema/src/V9.hs new file mode 100644 index 00000000000..2583384eff0 --- /dev/null +++ b/services/gundeck/schema/src/V9.hs @@ -0,0 +1,33 @@ +-- 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 V9 + ( migration, + ) +where + +import Cassandra.Schema +import Imports +import Text.RawString.QQ + +migration :: Migration +migration = Migration 9 "Remove deprecated tables" $ do + -- all data in notifications is written with a TTL, therefore should be a good fit for TWCS. + -- TTL is 28 days (see https://github.com/wireapp/wire-server/blob/434f7a874ce5e3f7e3e57aa98afb6441d4a53169/charts/gundeck/templates/configmap.yaml#L51) + -- so 28 windows of 1 day each fits well with the suggestion of 20-30 windows. + -- https://cassandra.apache.org/doc/latest/cassandra/operating/compaction/twcs.html + schema' [r| ALTER TABLE notifications WITH compaction = {'class': 'TimeWindowCompactionStrategy', 'compaction_window_unit': 'DAYS', 'compaction_window_size': 1}; |] From 21805c2f6ea8ba03ac4618a028c06aabf1a6eb26 Mon Sep 17 00:00:00 2001 From: Boyd Stephen Smith Jr Date: Thu, 1 Sep 2022 08:33:50 -0500 Subject: [PATCH 03/58] [FS-672] Improve swagger docs for Client fields. (#2657) * docs(swagger): Remove old swagger Client model Old swagger Client model was unused. * docs(swagger): Add mls_public_keys description * docs(swagger): Add base64-specific example string * docs(swagger): Add MLSPublicKeys example value * refactor(split): MLSPublicKeys: separate modifiers General type modifiers for MLSPublicKeys (like name, description) are applied in one location, but adapter for use as an optional field named "mls_public_keys" are done separately. Also, generalize a HasDescription instance. * docs(changelog) * refactor: where clause taste * refactor: allow overlaps of HasExample like HasDescription Co-authored-by: fisx --- changelog.d/4-docs/FS-672 | 2 + libs/schema-profunctor/src/Data/Schema.hs | 9 ++-- libs/types-common/src/Data/Json/Util.hs | 8 +-- libs/wire-api/src/Wire/API/Swagger.hs | 1 - libs/wire-api/src/Wire/API/User/Client.hs | 64 +++++++++-------------- 5 files changed, 38 insertions(+), 46 deletions(-) create mode 100644 changelog.d/4-docs/FS-672 diff --git a/changelog.d/4-docs/FS-672 b/changelog.d/4-docs/FS-672 new file mode 100644 index 00000000000..be428706747 --- /dev/null +++ b/changelog.d/4-docs/FS-672 @@ -0,0 +1,2 @@ +Drop Client model (unused) from old swagger. +Add a description and example data for mls_public_keys field in new swagger. diff --git a/libs/schema-profunctor/src/Data/Schema.hs b/libs/schema-profunctor/src/Data/Schema.hs index 3ff9e560f30..f2cdd73dcb3 100644 --- a/libs/schema-profunctor/src/Data/Schema.hs +++ b/libs/schema-profunctor/src/Data/Schema.hs @@ -888,8 +888,11 @@ instance S.HasSchema NamedSwaggerDoc S.Schema where instance S.HasSchema d S.Schema => S.HasSchema (SchemaP d v w a b) S.Schema where schema = doc . S.schema -instance S.HasDescription SwaggerDoc (Maybe Text) where - description = declared . S.description - instance S.HasDescription NamedSwaggerDoc (Maybe Text) where description = declared . S.schema . S.description + +instance {-# OVERLAPPABLE #-} S.HasDescription s a => S.HasDescription (WithDeclare s) a where + description = declared . S.description + +instance {-# OVERLAPPABLE #-} S.HasExample s a => S.HasExample (WithDeclare s) a where + example = declared . S.example diff --git a/libs/types-common/src/Data/Json/Util.hs b/libs/types-common/src/Data/Json/Util.hs index ab58254a871..daeed518526 100644 --- a/libs/types-common/src/Data/Json/Util.hs +++ b/libs/types-common/src/Data/Json/Util.hs @@ -49,13 +49,12 @@ module Data.Json.Util where import qualified Cassandra as CQL -import Control.Lens (coerced, (%~), (?~)) +import Control.Lens hiding ((#), (.=)) import Data.Aeson (FromJSON (..), ToJSON (..)) import qualified Data.Aeson as A import qualified Data.Aeson.Types as A import qualified Data.Attoparsec.Text as Atto import qualified Data.Attoparsec.Time as Atto -import Data.Bifunctor import qualified Data.ByteString.Base64 as B64 import qualified Data.ByteString.Base64.URL as B64U import qualified Data.ByteString.Builder as BB @@ -205,8 +204,11 @@ instance ToHttpApiData Base64ByteString where instance S.ToParamSchema Base64ByteString where toParamSchema _ = mempty & S.type_ ?~ S.SwaggerString +-- base64("example") ~> "ZXhhbXBsZQo=" base64SchemaN :: ValueSchema NamedSwaggerDoc ByteString -base64SchemaN = toBase64Text .= parsedText "Base64ByteString" fromBase64Text +base64SchemaN = + (toBase64Text .= parsedText "Base64ByteString" fromBase64Text) + & doc %~ fmap (S.schema . S.example ?~ A.String "ZXhhbXBsZQo=") base64Schema :: ValueSchema SwaggerDoc ByteString base64Schema = unnamed base64SchemaN diff --git a/libs/wire-api/src/Wire/API/Swagger.hs b/libs/wire-api/src/Wire/API/Swagger.hs index a83d78587a6..a9915a6b35e 100644 --- a/libs/wire-api/src/Wire/API/Swagger.hs +++ b/libs/wire-api/src/Wire/API/Swagger.hs @@ -118,7 +118,6 @@ models = User.Client.modelNewClient, User.Client.modelUpdateClient, User.Client.modelDeleteClient, - User.Client.modelClient, User.Client.modelSigkeys, User.Client.modelLocation, -- re-export from types-common User.Client.Prekey.modelPrekey, diff --git a/libs/wire-api/src/Wire/API/User/Client.hs b/libs/wire-api/src/Wire/API/User/Client.hs index 6f38cc75f67..7efbe1b78f7 100644 --- a/libs/wire-api/src/Wire/API/User/Client.hs +++ b/libs/wire-api/src/Wire/API/User/Client.hs @@ -72,7 +72,6 @@ module Wire.API.User.Client modelClientCapabilityList, typeClientCapability, modelDeleteClient, - modelClient, modelSigkeys, modelLocation, -- re-export from types-common ) @@ -80,7 +79,7 @@ where import qualified Cassandra as Cql import Control.Applicative -import Control.Lens (over, view, (?~), (^.)) +import Control.Lens hiding (element, enum, set, (#), (.=)) import Data.Aeson (FromJSON (..), ToJSON (..)) import qualified Data.Aeson as A import qualified Data.Aeson.Key as Key @@ -97,6 +96,7 @@ import Data.Qualified import Data.Schema import qualified Data.Semigroup as Semigroup import qualified Data.Set as Set +import Data.Swagger hiding (Schema, ToSchema, schema) import qualified Data.Swagger as Swagger import qualified Data.Swagger.Build.Api as Doc import qualified Data.Text.Encoding as Text.E @@ -477,6 +477,24 @@ data Client = Client type MLSPublicKeys = Map SignatureSchemeTag ByteString +mlsPublicKeysSchema :: ValueSchema NamedSwaggerDoc MLSPublicKeys +mlsPublicKeysSchema = + mapSchema + & doc + %~ ( (description ?~ "Mapping from signature scheme (tags) to public key data") + . (example ?~ toJSON (Map.fromList $ map (,exampleValue) keys)) + ) + & named "MLSPublicKeys" + where + keys :: [SignatureSchemeTag] + keys = [minBound .. maxBound] + + exampleValue :: A.Value + exampleValue = fromMaybe (toJSON ("base64==" :: Text)) (base64Schema ^. doc . example) + + mapSchema :: ValueSchema SwaggerDoc MLSPublicKeys + mapSchema = map_ base64Schema + instance ToSchema Client where schema = object "Client" $ @@ -490,42 +508,10 @@ instance ToSchema Client where <*> clientLocation .= maybe_ (optField "location" schema) <*> clientModel .= maybe_ (optField "model" schema) <*> clientCapabilities .= (fromMaybe mempty <$> optField "capabilities" schema) - <*> clientMLSPublicKeys .= mlsPublicKeysSchema + <*> clientMLSPublicKeys .= mlsPublicKeysFieldSchema -mlsPublicKeysSchema :: ObjectSchema SwaggerDoc MLSPublicKeys -mlsPublicKeysSchema = - fmap - (fromMaybe mempty) - ( optField - "mls_public_keys" - (map_ base64Schema) - ) - -modelClient :: Doc.Model -modelClient = Doc.defineModel "Client" $ do - Doc.description "A registered client." - Doc.property "type" typeClientType $ - Doc.description "The client type." - Doc.property "id" Doc.string' $ - Doc.description "The client ID." - Doc.property "label" Doc.string' $ do - Doc.description "An optional label associated with the client." - Doc.optional - Doc.property "time" Doc.dateTime' $ - Doc.description "The date and time when this client was registered." - Doc.property "class" typeClientClass $ - Doc.description "The device class this client belongs to." - Doc.property "cookie" Doc.string' $ - Doc.description "The cookie label of this client." - Doc.property "address" Doc.string' $ do - Doc.description "IP address from which this client has been registered" - Doc.optional - Doc.property "location" (Doc.ref modelLocation) $ do - Doc.description "Location from which this client has been registered." - Doc.optional - Doc.property "model" Doc.string' $ do - Doc.description "Optional model information of this client" - Doc.optional +mlsPublicKeysFieldSchema :: ObjectSchema SwaggerDoc MLSPublicKeys +mlsPublicKeysFieldSchema = fromMaybe mempty <$> optField "mls_public_keys" mlsPublicKeysSchema -------------------------------------------------------------------------------- -- PubClient @@ -738,7 +724,7 @@ instance ToSchema NewClient where ) <*> newClientModel .= maybe_ (optField "model" schema) <*> newClientCapabilities .= maybe_ capabilitiesFieldSchema - <*> newClientMLSPublicKeys .= mlsPublicKeysSchema + <*> newClientMLSPublicKeys .= mlsPublicKeysFieldSchema <*> newClientVerificationCode .= maybe_ (optField "verification_code" schema) newClient :: ClientType -> LastPrekey -> NewClient @@ -808,7 +794,7 @@ instance ToSchema UpdateClient where schema ) <*> updateClientCapabilities .= maybe_ capabilitiesFieldSchema - <*> updateClientMLSPublicKeys .= mlsPublicKeysSchema + <*> updateClientMLSPublicKeys .= mlsPublicKeysFieldSchema modelUpdateClient :: Doc.Model modelUpdateClient = Doc.defineModel "UpdateClient" $ do From e084f131c4fec095ee62d703d7a21638d89cbf24 Mon Sep 17 00:00:00 2001 From: Igor Ranieri Elland <54423+elland@users.noreply.github.com> Date: Thu, 1 Sep 2022 17:08:55 +0200 Subject: [PATCH 04/58] Added linting scripts. (#2663) --- .hlint.yaml | 4 +- Makefile | 16 ++++++ libs/api-bot/src/Network/Wire/Bot/Assert.hs | 1 - libs/api-bot/src/Network/Wire/Bot/Cache.hs | 14 ++--- .../src/Network/Wire/Client/Monad.hs | 1 - libs/bilge/src/Bilge/Request.hs | 2 +- libs/brig-types/src/Brig/Types/Common.hs | 2 +- libs/extended/src/Servant/API/Extended.hs | 6 +-- libs/hscim/src/Web/Scim/Client.hs | 6 +-- libs/hscim/src/Web/Scim/ContentType.hs | 3 ++ libs/hscim/src/Web/Scim/Filter.hs | 8 +-- libs/hscim/src/Web/Scim/Schema/PatchOp.hs | 6 +-- libs/hscim/src/Web/Scim/Schema/User.hs | 3 +- libs/hscim/src/Web/Scim/Server.hs | 1 - libs/hscim/src/Web/Scim/Server/Mock.hs | 28 +++++----- libs/hscim/src/Web/Scim/Test/Acceptance.hs | 2 +- libs/metrics-wai/src/Data/Metrics/Test.hs | 2 +- libs/ropes/src/Ropes/Twilio.hs | 12 ++--- libs/types-common-aws/src/AWS/Util.hs | 2 +- libs/types-common/src/Data/Range.hs | 8 +-- .../src/Wire/API/Event/Conversation.hs | 3 +- libs/wire-api/src/Wire/API/MLS/Keys.hs | 2 +- .../src/Wire/API/User/IdentityProvider.hs | 2 +- libs/wire-api/src/Wire/API/User/Scim.hs | 8 +-- libs/zauth/main/Main.hs | 3 +- nix/default.nix | 3 +- services/brig/src/Brig/API/Connection.hs | 4 +- services/brig/src/Brig/API/Internal.hs | 4 +- services/brig/src/Brig/AWS.hs | 4 +- services/brig/src/Brig/App.hs | 4 +- services/brig/src/Brig/Calling.hs | 4 +- .../BlacklistPhonePrefixStore/Cassandra.hs | 2 - .../Brig/Effects/BlacklistStore/Cassandra.hs | 2 - .../UserPendingActivationStore/Cassandra.hs | 2 +- services/galley/src/Galley/API/Teams.hs | 4 +- services/galley/src/Galley/App.hs | 4 +- .../galley/src/Galley/Cassandra/Proposal.hs | 2 - services/gundeck/src/Gundeck/Env.hs | 4 +- services/gundeck/src/Gundeck/Instances.hs | 2 +- services/spar/src/Spar/API.hs | 2 +- services/spar/src/Spar/Run.hs | 4 +- tools/db/assets/src/Assets/Lib.hs | 4 +- tools/db/move-team/src/Work.hs | 4 +- tools/hlint.sh | 51 +++++++++++++++++++ 44 files changed, 157 insertions(+), 98 deletions(-) create mode 100755 tools/hlint.sh diff --git a/.hlint.yaml b/.hlint.yaml index ad6303e32d4..d919816d412 100644 --- a/.hlint.yaml +++ b/.hlint.yaml @@ -8,8 +8,10 @@ # Left for the programmer to decide. See discussion at https://github.com/wireapp/wire-server/pull/2382#discussion_r871194424 - ignore: { name: Avoid lambda } - ignore: { name: Avoid lambda using `infix` } - +- ignore: { name: Eta reduce } - ignore: { name: Use section } +- ignore: { name: Use underscore } + # custom rules: - hint: { lhs: (() <$), rhs: void } - hint: { lhs: return, rhs: pure } diff --git a/Makefile b/Makefile index 90c9a95208f..2121a2332d8 100644 --- a/Makefile +++ b/Makefile @@ -117,6 +117,22 @@ cabal-fmt: ghcid: ghcid -l=hlint --command "cabal repl $(target)" +.PHONY: hlint-check-all +hlint-check-all: + ./tools/hlint.sh -f all -m check + +.PHONY: hlint-inplace-all +hlint-inplace-all: + ./tools/hlint.sh -f all -m inplace + +.PHONY: hlint-check +hlint-check: + ./tools/hlint.sh -f changeset -m check + +.PHONY: hlint-inplace +hlint-inplace: + ./tools/hlint.sh -f changeset -m inplace + # reset db using cabal .PHONY: db-reset-package db-reset-package: c diff --git a/libs/api-bot/src/Network/Wire/Bot/Assert.hs b/libs/api-bot/src/Network/Wire/Bot/Assert.hs index ed40c15e955..3457ee2eef8 100644 --- a/libs/api-bot/src/Network/Wire/Bot/Assert.hs +++ b/libs/api-bot/src/Network/Wire/Bot/Assert.hs @@ -1,5 +1,4 @@ {-# LANGUAGE LambdaCase #-} -{-# LANGUAGE OverloadedStrings #-} -- This file is part of the Wire Server implementation. -- diff --git a/libs/api-bot/src/Network/Wire/Bot/Cache.hs b/libs/api-bot/src/Network/Wire/Bot/Cache.hs index 1a8b41d2cd5..5ef86e566b8 100644 --- a/libs/api-bot/src/Network/Wire/Bot/Cache.hs +++ b/libs/api-bot/src/Network/Wire/Bot/Cache.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} -- This file is part of the Wire Server implementation. @@ -64,13 +65,12 @@ empty :: IO Cache empty = Cache <$> newIORef [] get :: (MonadIO m, HasCallStack) => Cache -> m CachedUser -get c = liftIO . atomicModifyIORef (cache c) $ \u -> - case u of - [] -> - error - "Cache.get: an account was requested from the cache, \ - \but the cache of available user accounts is empty" - (x : xs) -> (xs, x) +get c = liftIO . atomicModifyIORef (cache c) $ \case + [] -> + error + "Cache.get: an account was requested from the cache, \ + \but the cache of available user accounts is empty" + (x : xs) -> (xs, x) put :: MonadIO m => Cache -> CachedUser -> m () put c a = liftIO . atomicModifyIORef (cache c) $ \u -> (a : u, ()) diff --git a/libs/api-client/src/Network/Wire/Client/Monad.hs b/libs/api-client/src/Network/Wire/Client/Monad.hs index cb6af59bd3d..ffaff6ea468 100644 --- a/libs/api-client/src/Network/Wire/Client/Monad.hs +++ b/libs/api-client/src/Network/Wire/Client/Monad.hs @@ -1,6 +1,5 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE OverloadedStrings #-} -- This file is part of the Wire Server implementation. -- diff --git a/libs/bilge/src/Bilge/Request.hs b/libs/bilge/src/Bilge/Request.hs index 99d4acfc381..ce095faef53 100644 --- a/libs/bilge/src/Bilge/Request.hs +++ b/libs/bilge/src/Bilge/Request.hs @@ -156,7 +156,7 @@ expectStatus property r = r {Rq.checkResponse = check} | property (HTTP.statusCode (Rq.responseStatus res)) = pure () | otherwise = do some <- Lazy.toStrict <$> brReadSome (Rq.responseBody res) 1024 - throwHttp $ Rq.StatusCodeException (() <$ res) some + throwHttp $ Rq.StatusCodeException (void res) some checkStatus :: (Status -> ResponseHeaders -> CookieJar -> Maybe SomeException) -> Request -> Request checkStatus f r = r {Rq.checkResponse = check} diff --git a/libs/brig-types/src/Brig/Types/Common.hs b/libs/brig-types/src/Brig/Types/Common.hs index d5946b2b20f..2b95cb7639c 100644 --- a/libs/brig-types/src/Brig/Types/Common.hs +++ b/libs/brig-types/src/Brig/Types/Common.hs @@ -80,7 +80,7 @@ isValidPhonePrefix = isRight . parseOnly e164Prefix -- | get all valid prefixes of a phone number or phone number prefix -- e.g. from +123456789 get prefixes ["+1", "+12", "+123", ..., "+123456789" ] allPrefixes :: Text -> [PhonePrefix] -allPrefixes t = catMaybes $ parsePhonePrefix <$> Text.inits t +allPrefixes t = mapMaybe parsePhonePrefix (Text.inits t) instance FromJSON PhonePrefix where parseJSON = withText "PhonePrefix" $ \s -> diff --git a/libs/extended/src/Servant/API/Extended.hs b/libs/extended/src/Servant/API/Extended.hs index e0457115995..f87fc5d2146 100644 --- a/libs/extended/src/Servant/API/Extended.hs +++ b/libs/extended/src/Servant/API/Extended.hs @@ -94,7 +94,7 @@ instance requestHeaders request case canHandleCTypeH (Proxy :: Proxy list) (cs contentTypeH) :: Maybe (BL.ByteString -> Either String a) of Nothing -> delayedFail err415 - Just f -> return f + Just f -> pure f -- Body check, we get a body parsing functions as the first argument. bodyCheck :: (BL.ByteString -> Either String a) -> @@ -102,10 +102,10 @@ instance bodyCheck f = withRequest $ \request -> do mrqbody <- fmapL (makeCustomError @tag @a) . f <$> liftIO (lazyRequestBody request) case sbool :: SBool (FoldLenient mods) of - STrue -> return mrqbody + STrue -> pure mrqbody SFalse -> case mrqbody of Left e -> delayedFailFatal e - Right v -> return v + Right v -> pure v instance HasSwagger (ReqBody' '[Required, Strict] cts a :> api) => diff --git a/libs/hscim/src/Web/Scim/Client.hs b/libs/hscim/src/Web/Scim/Client.hs index abbafc62c1e..477e90b4270 100644 --- a/libs/hscim/src/Web/Scim/Client.hs +++ b/libs/hscim/src/Web/Scim/Client.hs @@ -75,7 +75,7 @@ type HasScimClient tag = ) scimClients :: HasScimClient tag => ClientEnv -> Site tag (AsClientT IO) -scimClients env = genericClientHoist $ \x -> runClientM x env >>= either throwIO return +scimClients env = genericClientHoist $ \x -> runClientM x env >>= either throwIO pure -- config @@ -130,7 +130,7 @@ postUser :: HasScimClient tag => ClientEnv -> Maybe (AuthData tag) -> - (User tag) -> + User tag -> IO (StoredUser tag) postUser env tok = case users (scimClients env) tok of ((_ :<|> (_ :<|> r)) :<|> (_ :<|> (_ :<|> _))) -> r @@ -139,7 +139,7 @@ putUser :: ClientEnv -> Maybe (AuthData tag) -> UserId tag -> - (User tag) -> + User tag -> IO (StoredUser tag) putUser env tok = case users (scimClients env) tok of ((_ :<|> (_ :<|> _)) :<|> (r :<|> (_ :<|> _))) -> r diff --git a/libs/hscim/src/Web/Scim/ContentType.hs b/libs/hscim/src/Web/Scim/ContentType.hs index 3e9d203c893..4b6a2e803f1 100644 --- a/libs/hscim/src/Web/Scim/ContentType.hs +++ b/libs/hscim/src/Web/Scim/ContentType.hs @@ -14,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 list literal" #-} -- | SCIM defines its own content type (application/scim+json). It's -- intended to be used for all requests and responses; see the first diff --git a/libs/hscim/src/Web/Scim/Filter.hs b/libs/hscim/src/Web/Scim/Filter.hs index 46b96e70411..5862f6a36bf 100644 --- a/libs/hscim/src/Web/Scim/Filter.hs +++ b/libs/hscim/src/Web/Scim/Filter.hs @@ -57,7 +57,7 @@ module Web.Scim.Filter ) where -import Control.Applicative (optional, (<|>)) +import Control.Applicative (optional) import Data.Aeson as Aeson import Data.Aeson.Parser as Aeson import Data.Aeson.Text as Aeson @@ -176,7 +176,7 @@ parseFilter supportedSchemas = -- @ pAttrPath :: [Schema] -> Parser AttrPath pAttrPath supportedSchemas = do - schema <- (Just <$> (pSchema supportedSchemas <* char ':')) <|> pure Nothing + schema <- optional (pSchema supportedSchemas <* char ':') AttrPath schema <$> pAttrName <*> optional pSubAttr -- | subAttr = "." ATTRNAME @@ -193,8 +193,8 @@ pCompValue :: Parser CompValue pCompValue = choice [ ValNull <$ string "null", - ValBool True <$ (stringCI "true"), - ValBool False <$ (stringCI "false"), + ValBool True <$ stringCI "true", + ValBool False <$ stringCI "false", ValNumber <$> Aeson.scientific, ValString <$> Aeson.jstring ] diff --git a/libs/hscim/src/Web/Scim/Schema/PatchOp.hs b/libs/hscim/src/Web/Scim/Schema/PatchOp.hs index 7c4fb3b692c..686e58b3ba7 100644 --- a/libs/hscim/src/Web/Scim/Schema/PatchOp.hs +++ b/libs/hscim/src/Web/Scim/Schema/PatchOp.hs @@ -105,16 +105,16 @@ operationFromJSON schemas' = let o = KeyMap.fromList . map (first lowerKey) . KeyMap.toList $ v Operation <$> (o .: "op") - <*> (Aeson.explicitParseFieldMaybe (pathFromJSON schemas') o "path") + <*> Aeson.explicitParseFieldMaybe (pathFromJSON schemas') o "path" <*> (o .:? "value") pathFromJSON :: [Schema] -> Value -> Aeson.Parser Path pathFromJSON schemas' = - withText "Path" $ either fail pure . (parsePath schemas') + withText "Path" $ either fail pure . parsePath schemas' instance ToJSON Operation where toJSON (Operation op' path' value') = - object $ ("op" .= op') : concat [optionalField "path" path', optionalField "value" value'] + object $ ("op" .= op') : optionalField "path" path' ++ optionalField "value" value' where optionalField fname = \case Nothing -> [] diff --git a/libs/hscim/src/Web/Scim/Schema/User.hs b/libs/hscim/src/Web/Scim/Schema/User.hs index 4525ccb275f..2da8ae9b31e 100644 --- a/libs/hscim/src/Web/Scim/Schema/User.hs +++ b/libs/hscim/src/Web/Scim/Schema/User.hs @@ -3,7 +3,6 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE UndecidableInstances #-} -{-# LANGUAGE ViewPatterns #-} -- This file is part of the Wire Server implementation. -- @@ -349,7 +348,7 @@ instance (UserTypes tag, FromJSON (User tag), Patchable (UserExtra tag)) => Patc | isUserSchema schema = applyUserOperation user op | isSupportedCustomSchema schema = (\x -> user {extra = x}) <$> applyOperation (extra user) op | otherwise = - throwError $ badRequest InvalidPath $ Just $ "we only support these schemas: " <> (Text.intercalate ", " $ map getSchemaUri (supportedSchemas @tag)) + throwError $ badRequest InvalidPath $ Just $ "we only support these schemas: " <> Text.intercalate ", " (map getSchemaUri (supportedSchemas @tag)) where isSupportedCustomSchema = maybe False (`elem` supportedSchemas @tag) applyOperation user op = applyUserOperation user op diff --git a/libs/hscim/src/Web/Scim/Server.hs b/libs/hscim/src/Web/Scim/Server.hs index 9b3fe16beda..2d51c437159 100644 --- a/libs/hscim/src/Web/Scim/Server.hs +++ b/libs/hscim/src/Web/Scim/Server.hs @@ -94,7 +94,6 @@ siteServer conf = users = \authData -> toServant (userServer @tag authData), groups = \authData -> toServant (groupServer @tag authData) } - where ---------------------------------------------------------------------------- -- Server-starting utilities diff --git a/libs/hscim/src/Web/Scim/Server/Mock.hs b/libs/hscim/src/Web/Scim/Server/Mock.hs index d92adc109f6..adeccdb05df 100644 --- a/libs/hscim/src/Web/Scim/Server/Mock.hs +++ b/libs/hscim/src/Web/Scim/Server/Mock.hs @@ -104,7 +104,7 @@ instance UserTypes Mock where instance UserDB Mock TestServer where getUsers () mbFilter = do - m <- userDB <$> ask + m <- asks userDB users <- liftSTM $ ListT.toList $ STMMap.listT m let check user = case mbFilter of Nothing -> pure True @@ -116,20 +116,20 @@ instance UserDB Mock TestServer where fromList . sortWith (Common.id . thing) <$> filterM check (snd <$> users) getUser () uid = do - m <- userDB <$> ask + m <- asks userDB liftSTM (STMMap.lookup uid m) >>= \case Nothing -> throwScim (notFound "User" (pack (show uid))) Just x -> pure x postUser () user = do - m <- userDB <$> ask + m <- asks userDB uid <- Id <$> liftSTM (STMMap.size m) let newUser = WithMeta (createMeta UserResource) $ WithId uid user liftSTM $ STMMap.insert newUser uid m - return newUser + pure newUser putUser () uid user = do - m <- userDB <$> ask + m <- asks userDB liftSTM (STMMap.lookup uid m) >>= \case Nothing -> throwScim (notFound "User" (pack (show uid))) Just stored -> do @@ -138,7 +138,7 @@ instance UserDB Mock TestServer where pure newUser deleteUser () uid = do - m <- userDB <$> ask + m <- asks userDB liftSTM (STMMap.lookup uid m) >>= \case Nothing -> throwScim (notFound "User" (pack (show uid))) Just _ -> liftSTM $ STMMap.delete uid m @@ -155,25 +155,25 @@ instance GroupTypes Mock where instance GroupDB Mock TestServer where getGroups () = do - m <- groupDB <$> ask + m <- asks groupDB groups <- liftSTM $ ListT.toList $ STMMap.listT m - return $ fromList . sortWith (Common.id . thing) $ snd <$> groups + pure $ fromList . sortWith (Common.id . thing) $ snd <$> groups getGroup () gid = do - m <- groupDB <$> ask + m <- asks groupDB liftSTM (STMMap.lookup gid m) >>= \case Nothing -> throwScim (notFound "Group" (pack (show gid))) Just grp -> pure grp postGroup () grp = do - m <- groupDB <$> ask + m <- asks groupDB gid <- Id <$> liftSTM (STMMap.size m) let newGroup = WithMeta (createMeta GroupResource) $ WithId gid grp liftSTM $ STMMap.insert newGroup gid m - return newGroup + pure newGroup putGroup () gid grp = do - m <- groupDB <$> ask + m <- asks groupDB liftSTM (STMMap.lookup gid m) >>= \case Nothing -> throwScim (notFound "Group" (pack (show gid))) Just stored -> do @@ -184,7 +184,7 @@ instance GroupDB Mock TestServer where patchGroup _ _ _ = throwScim (serverError "PATCH /Users not implemented") deleteGroup () gid = do - m <- groupDB <$> ask + m <- asks groupDB liftSTM (STMMap.lookup gid m) >>= \case Nothing -> throwScim (notFound "Group" (pack (show gid))) Just _ -> liftSTM $ STMMap.delete gid m @@ -243,7 +243,7 @@ filterUser :: Filter -> User extra -> Either Text Bool filterUser (FilterAttrCompare (AttrPath schema' attrib subAttr) op val) user | isUserSchema schema' = case (subAttr, val) of - (Nothing, (ValString str)) + (Nothing, ValString str) | attrib == "userName" -> Right (compareStr op (CI.foldCase (userName user)) (CI.foldCase str)) (Nothing, _) diff --git a/libs/hscim/src/Web/Scim/Test/Acceptance.hs b/libs/hscim/src/Web/Scim/Test/Acceptance.hs index 12e165375df..c4eea4122a8 100644 --- a/libs/hscim/src/Web/Scim/Test/Acceptance.hs +++ b/libs/hscim/src/Web/Scim/Test/Acceptance.hs @@ -264,7 +264,7 @@ microsoftAzure AcceptanceConfig {..} = do -- Delete User delete' queryConfig ("/Users/" <> testuid) "" `shouldRespondWith` 204 delete' queryConfig ("/Users/" <> testuid) "" `shouldEventuallyRespondWith` 404 - it "Group operations" $ \_ -> pending + it "Group operations" $ const pending sampleUser1 :: Text -> L.ByteString sampleUser1 userName1 = diff --git a/libs/metrics-wai/src/Data/Metrics/Test.hs b/libs/metrics-wai/src/Data/Metrics/Test.hs index 50e07b98119..308824e2fd7 100644 --- a/libs/metrics-wai/src/Data/Metrics/Test.hs +++ b/libs/metrics-wai/src/Data/Metrics/Test.hs @@ -48,7 +48,7 @@ pathsConsistencyCheck (Paths forest) = mconcat $ go [] <$> forest where here = findSiteConsistencyError (reverse $ root : prefix) trees findSiteConsistencyError :: [PathSegment] -> Tree.Forest PathSegment -> Maybe SiteConsistencyError - findSiteConsistencyError prefix subtrees = case catMaybes $ captureVars <$> subtrees of + findSiteConsistencyError prefix subtrees = case mapMaybe captureVars subtrees of [] -> Nothing [_] -> Nothing bad@(_ : _ : _) -> Just $ SiteConsistencyError (either cs cs <$> prefix) bad diff --git a/libs/ropes/src/Ropes/Twilio.hs b/libs/ropes/src/Ropes/Twilio.hs index 5696708135e..9776ffffdee 100644 --- a/libs/ropes/src/Ropes/Twilio.hs +++ b/libs/ropes/src/Ropes/Twilio.hs @@ -1,4 +1,5 @@ {-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} -- This file is part of the Wire Server implementation. @@ -140,12 +141,11 @@ instance FromJSON CarrierInfo where <*> o .:? "type" instance FromJSON PhoneType where - parseJSON = withText "PhoneType" $ \t -> - case t of - "mobile" -> pure Mobile - "landline" -> pure Landline - "voip" -> pure VoIp - x -> fail $ "Unexpected phone type: " ++ show x + parseJSON = withText "PhoneType" $ \case + "mobile" -> pure Mobile + "landline" -> pure Landline + "voip" -> pure VoIp + x -> fail $ "Unexpected phone type: " ++ show x -- * Functions diff --git a/libs/types-common-aws/src/AWS/Util.hs b/libs/types-common-aws/src/AWS/Util.hs index dac97a3e6e0..1eff3fe67e3 100644 --- a/libs/types-common-aws/src/AWS/Util.hs +++ b/libs/types-common-aws/src/AWS/Util.hs @@ -29,4 +29,4 @@ readAuthExpiration env = do AWS.Ref _ ref -> do readIORef ref now <- getCurrentTime - pure $ ((`diffUTCTime` now) . AWS.fromTime) <$> (AWS._authExpiration authEnv) + pure $ (`diffUTCTime` now) . AWS.fromTime <$> AWS._authExpiration authEnv diff --git a/libs/types-common/src/Data/Range.hs b/libs/types-common/src/Data/Range.hs index 137b1ed8403..ffceb0fddf9 100644 --- a/libs/types-common/src/Data/Range.hs +++ b/libs/types-common/src/Data/Range.hs @@ -390,13 +390,13 @@ instance Bounds (List1 a) where within x = within (toNonEmpty x) instance Bounds (Set a) where - within x y z = rangeCheck (Set.size x) y z + within x = rangeCheck (Set.size x) instance Bounds (Seq a) where - within x y z = rangeCheck (Seq.length x) y z + within x = rangeCheck (Seq.length x) instance Bounds (Map k a) where - within x y z = rangeCheck (Map.size x) y z + within x = rangeCheck (Map.size x) instance Bounds (HashMap k a) where within x y z = rangeCheck (length (take (fromIntegral z + 1) (HashMap.toList x))) y z @@ -409,7 +409,7 @@ instance Bounds a => Bounds (Maybe a) where within (Just x) y z = within x y z instance Bounds (AsciiText r) where - within x y z = within (Ascii.toText x) y z + within x = within (Ascii.toText x) ----------------------------------------------------------------------------- diff --git a/libs/wire-api/src/Wire/API/Event/Conversation.hs b/libs/wire-api/src/Wire/API/Event/Conversation.hs index 9571ed8d86c..f05018432db 100644 --- a/libs/wire-api/src/Wire/API/Event/Conversation.hs +++ b/libs/wire-api/src/Wire/API/Event/Conversation.hs @@ -400,11 +400,10 @@ eventObjectSchema = mk (_, d) cid uid tm = Event cid uid tm d instance ToJSONObject Event where - toJSONObject e = + toJSONObject = KeyMap.fromList . fromMaybe [] . schemaOut eventObjectSchema - $ e instance FromJSON Event where parseJSON = schemaParseJSON diff --git a/libs/wire-api/src/Wire/API/MLS/Keys.hs b/libs/wire-api/src/Wire/API/MLS/Keys.hs index df7989ffd95..0aa187bb8cb 100644 --- a/libs/wire-api/src/Wire/API/MLS/Keys.hs +++ b/libs/wire-api/src/Wire/API/MLS/Keys.hs @@ -59,7 +59,7 @@ instance ToSchema MLSPublicKeys where mlsKeysToPublic1 :: MLSKeys -> Map SignatureSchemeTag ByteString mlsKeysToPublic1 (MLSKeys mEd25519key) = - fold $ Map.singleton Ed25519 . convert . snd <$> mEd25519key + foldMap (Map.singleton Ed25519 . convert . snd) mEd25519key mlsKeysToPublic :: (SignaturePurpose -> MLSKeys) -> MLSPublicKeys mlsKeysToPublic f = flip foldMap [minBound .. maxBound] $ \purpose -> diff --git a/libs/wire-api/src/Wire/API/User/IdentityProvider.hs b/libs/wire-api/src/Wire/API/User/IdentityProvider.hs index e573b19a93d..ceb1200b688 100644 --- a/libs/wire-api/src/Wire/API/User/IdentityProvider.hs +++ b/libs/wire-api/src/Wire/API/User/IdentityProvider.hs @@ -190,7 +190,7 @@ instance ToSchema IdPMetadataInfo where & properties .~ properties_ & minProperties ?~ 1 & maxProperties ?~ 1 - & type_ .~ Just SwaggerObject + & type_ ?~ SwaggerObject where properties_ :: InsOrdHashMap Text (Referenced Schema) properties_ = diff --git a/libs/wire-api/src/Wire/API/User/Scim.hs b/libs/wire-api/src/Wire/API/User/Scim.hs index 129ec635312..45fd51a09b6 100644 --- a/libs/wire-api/src/Wire/API/User/Scim.hs +++ b/libs/wire-api/src/Wire/API/User/Scim.hs @@ -462,7 +462,7 @@ instance ToSchema ScimTokenInfo where pure $ NamedSchema (Just "ScimTokenInfo") $ mempty - & type_ .~ Just SwaggerObject + & type_ ?~ SwaggerObject & properties .~ [ ("team", teamSchema), ("id", idSchema), @@ -478,7 +478,7 @@ instance ToSchema CreateScimToken where pure $ NamedSchema (Just "CreateScimToken") $ mempty - & type_ .~ Just SwaggerObject + & type_ ?~ SwaggerObject & properties .~ [ ("description", textSchema), ("password", textSchema), @@ -493,7 +493,7 @@ instance ToSchema CreateScimTokenResponse where pure $ NamedSchema (Just "CreateScimTokenResponse") $ mempty - & type_ .~ Just SwaggerObject + & type_ ?~ SwaggerObject & properties .~ [ ("token", tokenSchema), ("info", infoSchema) @@ -506,7 +506,7 @@ instance ToSchema ScimTokenList where pure $ NamedSchema (Just "ScimTokenList") $ mempty - & type_ .~ Just SwaggerObject + & type_ ?~ SwaggerObject & properties .~ [ ("tokens", infoListSchema) ] diff --git a/libs/zauth/main/Main.hs b/libs/zauth/main/Main.hs index e09be731bfc..5f486acc797 100644 --- a/libs/zauth/main/Main.hs +++ b/libs/zauth/main/Main.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} @@ -180,7 +181,7 @@ options = <> metavar "STRING" <> help "token data" toMode = - readerAsk >>= \s -> case s of + readerAsk >>= \case "create-user" -> pure CreateUser "create-session" -> pure CreateSession "create-access" -> pure CreateAccess diff --git a/nix/default.nix b/nix/default.nix index ce8cecf1cc7..8ad4517f70e 100644 --- a/nix/default.nix +++ b/nix/default.nix @@ -84,7 +84,8 @@ let pkgs.gnused pkgs.helm pkgs.helmfile - pkgs.hlint + pkgs.haskellPackages.hlint_3_4_1 + pkgs.haskellPackages.apply-refact pkgs.jq pkgs.kind pkgs.kubectl diff --git a/services/brig/src/Brig/API/Connection.hs b/services/brig/src/Brig/API/Connection.hs index c455e8c1de5..4a222ec790c 100644 --- a/services/brig/src/Brig/API/Connection.hs +++ b/services/brig/src/Brig/API/Connection.hs @@ -435,9 +435,7 @@ updateConnectionInternal = \case handleConns (resultList page) case resultList page of (conn : rest) -> - if resultHasMore page - then go (Just (maximum (qUnqualified . ucTo <$> (conn : rest)))) - else pure () + when (resultHasMore page) $ go (Just (maximum (qUnqualified . ucTo <$> (conn : rest)))) [] -> pure () unblockDirected :: UserConnection -> UserConnection -> ExceptT ConnectionError (AppT r) () diff --git a/services/brig/src/Brig/API/Internal.hs b/services/brig/src/Brig/API/Internal.hs index 83bf3e28cec..13db5dca749 100644 --- a/services/brig/src/Brig/API/Internal.hs +++ b/services/brig/src/Brig/API/Internal.hs @@ -198,8 +198,8 @@ getMLSClients usr _ss = do | otherwise = getResult rs getValidity lusr cid = - fmap ((cid,) . (> 0)) $ - Data.countKeyPackages lusr cid + (cid,) . (> 0) + <$> Data.countKeyPackages lusr cid mapKeyPackageRefsInternal :: KeyPackageBundle -> Handler r () mapKeyPackageRefsInternal bundle = do diff --git a/services/brig/src/Brig/AWS.hs b/services/brig/src/Brig/AWS.hs index 640bb3c8309..33e55bb6d45 100644 --- a/services/brig/src/Brig/AWS.hs +++ b/services/brig/src/Brig/AWS.hs @@ -200,8 +200,8 @@ enqueueFIFO url group dedup m = retrying retry5x (const canRetry) (const (sendCa where req = SQS.newSendMessage url (Text.decodeLatin1 (BL.toStrict m)) - & SQS.sendMessage_messageGroupId .~ Just group - & SQS.sendMessage_messageDeduplicationId .~ Just (toText dedup) + & SQS.sendMessage_messageGroupId ?~ group + & SQS.sendMessage_messageDeduplicationId ?~ toText dedup ------------------------------------------------------------------------------- -- SES diff --git a/services/brig/src/Brig/App.hs b/services/brig/src/Brig/App.hs index aa6765dcef1..4a18a47ec86 100644 --- a/services/brig/src/Brig/App.hs +++ b/services/brig/src/Brig/App.hs @@ -387,8 +387,8 @@ initCassandra o g = do c <- maybe (Cas.initialContactsPlain (Opt.cassandra o ^. casEndpoint . epHost)) - (Cas.initialContactsDisco "cassandra_brig") - (unpack <$> Opt.discoUrl o) + (Cas.initialContactsDisco "cassandra_brig" . unpack) + (Opt.discoUrl o) p <- Cas.init $ Cas.setLogger (Cas.mkLogger (Log.clone (Just "cassandra.brig") g)) diff --git a/services/brig/src/Brig/Calling.hs b/services/brig/src/Brig/Calling.hs index 48f892c64e9..49ee66e6774 100644 --- a/services/brig/src/Brig/Calling.hs +++ b/services/brig/src/Brig/Calling.hs @@ -180,9 +180,7 @@ discoverSRVRecords domain = srvDiscoveryLoop :: Members [DNSLookup, TinyLog, Delay] r => DNS.Domain -> Int -> (NonEmpty SrvEntry -> Sem r ()) -> Sem r () srvDiscoveryLoop domain discoveryInterval saveAction = forever $ do servers <- discoverSRVRecords domain - case servers of - Nothing -> pure () - Just es -> saveAction es + forM_ servers saveAction delay discoveryInterval mkSFTDomain :: SFTOptions -> DNS.Domain diff --git a/services/brig/src/Brig/Effects/BlacklistPhonePrefixStore/Cassandra.hs b/services/brig/src/Brig/Effects/BlacklistPhonePrefixStore/Cassandra.hs index 0fc2d05c671..e8c1713f91b 100644 --- a/services/brig/src/Brig/Effects/BlacklistPhonePrefixStore/Cassandra.hs +++ b/services/brig/src/Brig/Effects/BlacklistPhonePrefixStore/Cassandra.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE TemplateHaskell #-} - module Brig.Effects.BlacklistPhonePrefixStore.Cassandra ( interpretBlacklistPhonePrefixStoreToCassandra, ) diff --git a/services/brig/src/Brig/Effects/BlacklistStore/Cassandra.hs b/services/brig/src/Brig/Effects/BlacklistStore/Cassandra.hs index 06746441d64..995926b7040 100644 --- a/services/brig/src/Brig/Effects/BlacklistStore/Cassandra.hs +++ b/services/brig/src/Brig/Effects/BlacklistStore/Cassandra.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE TemplateHaskell #-} - module Brig.Effects.BlacklistStore.Cassandra ( interpretBlacklistStoreToCassandra, ) diff --git a/services/brig/src/Brig/Sem/UserPendingActivationStore/Cassandra.hs b/services/brig/src/Brig/Sem/UserPendingActivationStore/Cassandra.hs index 9521af20d44..5aa923ddc10 100644 --- a/services/brig/src/Brig/Sem/UserPendingActivationStore/Cassandra.hs +++ b/services/brig/src/Brig/Sem/UserPendingActivationStore/Cassandra.hs @@ -21,7 +21,7 @@ userPendingActivationStoreToCassandra = interpretH $ liftT . embed @Client . \case Add upa -> usersPendingActivationAdd upa - List Nothing -> (flip PC.mkInternalPage pure) =<< usersPendingActivationList + List Nothing -> flip PC.mkInternalPage pure =<< usersPendingActivationList List (Just ps) -> PC.ipNext ps RemoveMultiple uids -> usersPendingActivationRemoveMultiple uids diff --git a/services/galley/src/Galley/API/Teams.hs b/services/galley/src/Galley/API/Teams.hs index ca2643e5618..73ff6660d31 100644 --- a/services/galley/src/Galley/API/Teams.hs +++ b/services/galley/src/Galley/API/Teams.hs @@ -579,12 +579,12 @@ getTeamMembersCSV lusr tid = do lookupInviterHandle :: Member BrigAccess r => [TeamMember] -> Sem r (UserId -> Maybe Handle.Handle) lookupInviterHandle members = do let inviterIds :: [UserId] - inviterIds = nub $ catMaybes $ fmap fst . view invitation <$> members + inviterIds = nub $ mapMaybe (fmap fst . view invitation) members userList :: [User] <- accountUser <$$> E.getUsers inviterIds let userMap :: M.Map UserId Handle.Handle - userMap = M.fromList . catMaybes $ extract <$> userList + userMap = M.fromList (mapMaybe extract userList) where extract u = (U.userId u,) <$> U.userHandle u diff --git a/services/galley/src/Galley/App.hs b/services/galley/src/Galley/App.hs index a145b9b446d..97cd4b2bf41 100644 --- a/services/galley/src/Galley/App.hs +++ b/services/galley/src/Galley/App.hs @@ -165,8 +165,8 @@ initCassandra o l = do c <- maybe (C.initialContactsPlain (o ^. optCassandra . casEndpoint . epHost)) - (C.initialContactsDisco "cassandra_galley") - (unpack <$> o ^. optDiscoUrl) + (C.initialContactsDisco "cassandra_galley" . unpack) + (o ^. optDiscoUrl) C.init . C.setLogger (C.mkLogger (Logger.clone (Just "cassandra.galley") l)) . C.setContacts (NE.head c) (NE.tail c) diff --git a/services/galley/src/Galley/Cassandra/Proposal.hs b/services/galley/src/Galley/Cassandra/Proposal.hs index e033d97372d..eb5e5d9dd29 100644 --- a/services/galley/src/Galley/Cassandra/Proposal.hs +++ b/services/galley/src/Galley/Cassandra/Proposal.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving #-} - -- This file is part of the Wire Server implementation. -- -- Copyright (C) 2022 Wire Swiss GmbH diff --git a/services/gundeck/src/Gundeck/Env.hs b/services/gundeck/src/Gundeck/Env.hs index 96cb36f211f..e841205deab 100644 --- a/services/gundeck/src/Gundeck/Env.hs +++ b/services/gundeck/src/Gundeck/Env.hs @@ -71,8 +71,8 @@ createEnv m o = do c <- maybe (C.initialContactsPlain (o ^. optCassandra . casEndpoint . epHost)) - (C.initialContactsDisco "cassandra_gundeck") - (unpack <$> o ^. optDiscoUrl) + (C.initialContactsDisco "cassandra_gundeck" . unpack) + (o ^. optDiscoUrl) n <- newManager tlsManagerSettings diff --git a/services/gundeck/src/Gundeck/Instances.hs b/services/gundeck/src/Gundeck/Instances.hs index 9b2087b5b73..f06fb8e2a76 100644 --- a/services/gundeck/src/Gundeck/Instances.hs +++ b/services/gundeck/src/Gundeck/Instances.hs @@ -63,7 +63,7 @@ instance Cql ConnId where instance Cql EndpointArn where ctype = Tagged TextColumn toCql = CqlText . toText - fromCql (CqlText txt) = either Left pure (fromText txt) + fromCql (CqlText txt) = fromText txt fromCql _ = Left "EndpointArn: Text expected" instance Cql Token where diff --git a/services/spar/src/Spar/API.hs b/services/spar/src/Spar/API.hs index a0d02df3c76..fefd72221f5 100644 --- a/services/spar/src/Spar/API.hs +++ b/services/spar/src/Spar/API.hs @@ -519,7 +519,7 @@ idpCreateXML zusr raw idpmeta mReplaces (fromMaybe defWireIdPAPIVersion -> apive teamid <- Brig.getZUsrCheckPerm zusr CreateUpdateDeleteIdp GalleyAccess.assertSSOEnabled teamid assertNoScimOrNoIdP teamid - handle <- maybe (IdPConfigStore.newHandle teamid) pure (IdPHandle . fromRange <$> mHandle) + handle <- maybe (IdPConfigStore.newHandle teamid) (pure . IdPHandle . fromRange) mHandle idp <- validateNewIdP apiversion idpmeta teamid mReplaces handle IdPRawMetadataStore.store (idp ^. SAML.idpId) raw IdPConfigStore.insertConfig idp diff --git a/services/spar/src/Spar/Run.hs b/services/spar/src/Spar/Run.hs index 1bf505a9a24..8cb2339da30 100644 --- a/services/spar/src/Spar/Run.hs +++ b/services/spar/src/Spar/Run.hs @@ -66,8 +66,8 @@ initCassandra opts lgr = do connectString <- maybe (Cas.initialContactsPlain (cassOpts ^. casEndpoint . epHost)) - (Cas.initialContactsDisco "cassandra_spar") - (cs <$> Types.discoUrl opts) + (Cas.initialContactsDisco "cassandra_spar" . cs) + (Types.discoUrl opts) cas <- Cas.init $ Cas.defSettings diff --git a/tools/db/assets/src/Assets/Lib.hs b/tools/db/assets/src/Assets/Lib.hs index f150e90ed6f..c4947b4d52d 100644 --- a/tools/db/assets/src/Assets/Lib.hs +++ b/tools/db/assets/src/Assets/Lib.hs @@ -175,12 +175,12 @@ instance Show Result where <> "\nnum_invalid_assets: " <> show (length i) <> "\ninvalid_assets:\n" - <> concat (showRow <$> i) + <> concatMap showRow i where showRow (uid, Nothing) = " - user_id: " <> show uid <> "\n" showRow (uid, Just as) = " - user_id: " <> show uid <> "\n" <> showAssets as showAsset a = " key: " <> show (txtAssetKey a) <> "\n" - showAssets assets = concat $ showAsset <$> assets + showAssets assets = concatMap showAsset assets instance Semigroup Result where (<>) (Result n1 v1 i1) (Result n2 v2 i2) = diff --git a/tools/db/move-team/src/Work.hs b/tools/db/move-team/src/Work.hs index c5e69475e90..a10a9a13f8c 100644 --- a/tools/db/move-team/src/Work.hs +++ b/tools/db/move-team/src/Work.hs @@ -101,7 +101,7 @@ runGalleyTeamMembers env@Env {..} = handleTeamMembers :: Env -> (Int32, [RowGalleyTeamMember]) -> IO [RowGalleyTeamMember] handleTeamMembers env@Env {..} (i, members) = do Log.info envLogger (Log.field "number of team members loaded: " (show (i * envPageSize))) - let uids = catMaybes $ fmap Id . view _2 <$> members + let uids = mapMaybe (fmap Id . view _2) members appendJsonLines (envTargetPath "brig.clients") (readBrigClients env uids) appendJsonLines (envTargetPath "brig.connection") (readBrigConnection env uids) @@ -131,7 +131,7 @@ runGalleyTeamConv env@Env {..} = handleTeamConv :: Env -> (Int32, [RowGalleyTeamConv]) -> IO [RowGalleyTeamConv] handleTeamConv env@Env {..} (i, convs) = do Log.info envLogger (Log.field "number of team convs loaded: " (show (i * envPageSize))) - let cids = catMaybes $ fmap Id . view _2 <$> convs + let cids = mapMaybe (fmap Id . view _2) convs appendJsonLines (envTargetPath "galley.conversation") (readGalleyConversation env cids) appendJsonLines (envTargetPath "galley.member") (readGalleyMember env cids) pure convs diff --git a/tools/hlint.sh b/tools/hlint.sh new file mode 100755 index 00000000000..84e30d837a9 --- /dev/null +++ b/tools/hlint.sh @@ -0,0 +1,51 @@ +#!/usr/bin/env bash + +usage() { echo "Usage: $0 -f [all, changeset] -m [check, inplace]" 1>&2; exit 1; } + +files='' +check=true + +while getopts ':f:m:' opt + do + case $opt in + f) f=${OPTARG} + if [ "$f" = "all" ]; then + files=$(find libs/ services/ -not -path "*/test/*" -name "*.hs") + echo "WARNING: not linting tests." + elif [ "$f" = "changeset" ]; then + files=$(git diff --name-only HEAD | grep \.hs\$) + echo "WARNING: linting test files with changes. This may lead to some hard to fix warnings/errors, it is safe to ignore those!" + else + usage + fi + ;; + m) m=${OPTARG} + if [ "$m" = "inplace" ]; then + check=false + elif [ "$m" = "check" ]; then + check=true + else + usage + fi + ;; + *) usage;; + esac +done + +if [ -z "${f}" ] || [ -z "${m}" ]; then + usage +fi + +count=$(echo "$files" | grep -c -v -e '^[[:space:]]*$') + +echo "Analysing $count file(s)…" + +for f in $files +do + echo "$f" + if [ $check = true ]; then + hlint "$f" | grep -v 'No hints' + else + hlint --refactor --refactor-options="--inplace" "$f" + fi +done From 914bbe141e2799039875672461e11c5c92a5c2b7 Mon Sep 17 00:00:00 2001 From: Stefan Matting Date: Fri, 2 Sep 2022 10:41:30 +0200 Subject: [PATCH 05/58] Git ignore ingeration-ca pems --- .gitignore | 3 +++ 1 file changed, 3 insertions(+) diff --git a/.gitignore b/.gitignore index 47112aa3707..a70cae14b5b 100644 --- a/.gitignore +++ b/.gitignore @@ -116,3 +116,6 @@ result-* # emacs misc .dir-locals.el + +/integration-ca-key.pem +/integration-ca.pem From d7997fb155aa0ff2a350a7067c87e4d2353dd1ab Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Fri, 2 Sep 2022 11:44:56 +0200 Subject: [PATCH 06/58] PR template formatting (#2668) --- .github/pull_request_template.md | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/.github/pull_request_template.md b/.github/pull_request_template.md index dc8abfb10dc..0f27e2b42af 100644 --- a/.github/pull_request_template.md +++ b/.github/pull_request_template.md @@ -1,5 +1,4 @@ ## Checklist - [ ] Add a new entry in an appropriate subdirectory of `changelog.d` - - [ ] Read and follow the -[PR guidelines](https://github.com/wireapp/wire-server/blob/develop/docs/developer/pr-guidelines.md) + - [ ] Read and follow the [PR guidelines](https://github.com/wireapp/wire-server/blob/develop/docs/developer/pr-guidelines.md) From c664349a872a54a6ae05629502329700ee5a6ca9 Mon Sep 17 00:00:00 2001 From: Stefan Berthold Date: Fri, 2 Sep 2022 13:05:57 +0200 Subject: [PATCH 07/58] allow external add proposals without previously uploading key packages (#2661) Co-authored-by: Stefan Matting --- changelog.d/5-internal/FS-921 | 1 + libs/wire-api/src/Wire/API/MLS/KeyPackage.hs | 7 ++ .../src/Wire/API/Routes/Internal/Brig.hs | 40 ++++++++ services/brig/src/Brig/API/Internal.hs | 38 +++++++- .../Brig/API/MLS/KeyPackages/Validation.hs | 1 + services/galley/src/Galley/API/MLS/Message.hs | 58 +++++++++--- .../galley/src/Galley/Effects/BrigAccess.hs | 3 + services/galley/src/Galley/Intra/Client.hs | 19 ++++ services/galley/src/Galley/Intra/Effects.hs | 3 + services/galley/test/integration/API/MLS.hs | 93 +++++++++++++++++-- 10 files changed, 239 insertions(+), 24 deletions(-) create mode 100644 changelog.d/5-internal/FS-921 diff --git a/changelog.d/5-internal/FS-921 b/changelog.d/5-internal/FS-921 new file mode 100644 index 00000000000..b2901852cdb --- /dev/null +++ b/changelog.d/5-internal/FS-921 @@ -0,0 +1 @@ +Allow external add proposals without previously uploading key packages. \ No newline at end of file diff --git a/libs/wire-api/src/Wire/API/MLS/KeyPackage.hs b/libs/wire-api/src/Wire/API/MLS/KeyPackage.hs index ae4dd7a1552..1a878a40b39 100644 --- a/libs/wire-api/src/Wire/API/MLS/KeyPackage.hs +++ b/libs/wire-api/src/Wire/API/MLS/KeyPackage.hs @@ -29,6 +29,7 @@ module Wire.API.MLS.KeyPackage kpInitKey, kpCredential, kpExtensions, + kpIdentity, kpRef, kpRef', KeyPackageTBS (..), @@ -188,6 +189,9 @@ data KeyPackage = KeyPackage } deriving stock (Eq, Show) +instance S.ToSchema KeyPackage where + declareNamedSchema _ = pure (mlsSwagger "KeyPackage") + kpProtocolVersion :: KeyPackage -> ProtocolVersion kpProtocolVersion = kpuProtocolVersion . rmValue . kpTBS @@ -203,6 +207,9 @@ kpCredential = kpuCredential . rmValue . kpTBS kpExtensions :: KeyPackage -> [Extension] kpExtensions = kpuExtensions . rmValue . kpTBS +kpIdentity :: KeyPackage -> Either Text ClientIdentity +kpIdentity = decodeMLS' @ClientIdentity . bcIdentity . kpCredential + rawKeyPackageSchema :: ValueSchema NamedSwaggerDoc (RawMLS KeyPackage) rawKeyPackageSchema = rawMLSSchema "KeyPackage" decodeMLS' diff --git a/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs b/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs index eec1d208efd..1c03b4f6e96 100644 --- a/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs +++ b/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs @@ -30,6 +30,8 @@ module Wire.API.Routes.Internal.Brig swaggerDoc, module Wire.API.Routes.Internal.Brig.EJPD, NewKeyPackageRef (..), + NewKeyPackage (..), + NewKeyPackageResult (..), ) where @@ -155,6 +157,7 @@ type AccountAPI = :> MultiVerb 'POST '[Servant.JSON] CreateUserSparInternalResponses (Either CreateUserSparError SelfProfile) ) +-- | The missing ref is implicit by the capture data NewKeyPackageRef = NewKeyPackageRef { nkprUserId :: Qualified UserId, nkprClientId :: ClientId, @@ -171,6 +174,34 @@ instance ToSchema NewKeyPackageRef where <*> nkprClientId .= field "client_id" schema <*> nkprConversation .= field "conversation" schema +data NewKeyPackage = NewKeyPackage + { nkpConversation :: Qualified ConvId, + nkpKeyPackage :: KeyPackageData + } + deriving stock (Eq, Show, Generic) + deriving (ToJSON, FromJSON, S.ToSchema) via (Schema NewKeyPackage) + +instance ToSchema NewKeyPackage where + schema = + object "NewKeyPackage" $ + NewKeyPackage + <$> nkpConversation .= field "conversation" schema + <*> nkpKeyPackage .= field "key_package" schema + +data NewKeyPackageResult = NewKeyPackageResult + { nkpresClientIdentity :: ClientIdentity, + nkpresKeyPackageRef :: KeyPackageRef + } + deriving stock (Eq, Show, Generic) + deriving (ToJSON, FromJSON, S.ToSchema) via (Schema NewKeyPackageResult) + +instance ToSchema NewKeyPackageResult where + schema = + object "NewKeyPackageResult" $ + NewKeyPackageResult + <$> nkpresClientIdentity .= field "client_identity" schema + <*> nkpresKeyPackageRef .= field "key_package_ref" schema + type MLSAPI = "mls" :> ( ( "key-packages" :> Capture "ref" KeyPackageRef @@ -214,6 +245,15 @@ type MLSAPI = ) :<|> GetMLSClients :<|> MapKeyPackageRefs + :<|> Named + "put-key-package-add" + ( "key-package-add" + :> ReqBody '[Servant.JSON] NewKeyPackage + :> MultiVerb1 + 'PUT + '[Servant.JSON] + (Respond 200 "Key package ref mapping updated" NewKeyPackageResult) + ) ) type PutConversationByKeyPackageRef = diff --git a/services/brig/src/Brig/API/Internal.hs b/services/brig/src/Brig/API/Internal.hs index 13db5dca749..5efb8ab1c0f 100644 --- a/services/brig/src/Brig/API/Internal.hs +++ b/services/brig/src/Brig/API/Internal.hs @@ -28,6 +28,7 @@ import qualified Brig.API.Client as API import qualified Brig.API.Connection as API import Brig.API.Error import Brig.API.Handler +import Brig.API.MLS.KeyPackages.Validation import Brig.API.Types import qualified Brig.API.User as API import qualified Brig.API.User as Api @@ -86,7 +87,8 @@ import Wire.API.Error import qualified Wire.API.Error.Brig as E import Wire.API.MLS.Credential import Wire.API.MLS.KeyPackage -import Wire.API.Routes.Internal.Brig (NewKeyPackageRef) +import Wire.API.MLS.Serialisation +import Wire.API.Routes.Internal.Brig import qualified Wire.API.Routes.Internal.Brig as BrigIRoutes import Wire.API.Routes.Internal.Brig.Connection import Wire.API.Routes.Named @@ -130,6 +132,7 @@ mlsAPI = ) :<|> getMLSClients :<|> mapKeyPackageRefsInternal + :<|> Named @"put-key-package-add" upsertKeyPackage accountAPI :: Members @@ -184,6 +187,39 @@ getConvIdByKeyPackageRef = runMaybeT . mapMaybeT wrapClientE . Data.keyPackageRe postKeyPackageRef :: KeyPackageRef -> KeyPackageRef -> Handler r () postKeyPackageRef ref = lift . wrapClient . Data.updateKeyPackageRef ref +-- Used by galley to update key package refs and also validate +upsertKeyPackage :: NewKeyPackage -> Handler r NewKeyPackageResult +upsertKeyPackage nkp = do + kp <- + either + (const $ mlsProtocolError "upsertKeyPackage: Cannot decocode KeyPackage") + pure + $ decodeMLS' @(RawMLS KeyPackage) (kpData . nkpKeyPackage $ nkp) + ref <- kpRef' kp & noteH "upsertKeyPackage: Unsupported CipherSuite" + + identity <- + either + (const $ mlsProtocolError "upsertKeyPackage: Cannot decode ClientIdentity") + pure + $ kpIdentity (rmValue kp) + mp <- lift . wrapClient . runMaybeT $ Data.derefKeyPackage ref + when (isNothing mp) $ do + void $ validateKeyPackage identity kp + lift . wrapClient $ + Data.addKeyPackageRef + ref + ( NewKeyPackageRef + (fst <$> cidQualifiedClient identity) + (ciClient identity) + (nkpConversation nkp) + ) + + pure $ NewKeyPackageResult identity ref + where + noteH :: Text -> Maybe a -> Handler r a + noteH errMsg Nothing = mlsProtocolError errMsg + noteH _ (Just y) = pure y + getMLSClients :: UserId -> SignatureSchemeTag -> Handler r (Set ClientInfo) getMLSClients usr _ss = do -- FUTUREWORK: check existence of key packages with a given ciphersuite diff --git a/services/brig/src/Brig/API/MLS/KeyPackages/Validation.hs b/services/brig/src/Brig/API/MLS/KeyPackages/Validation.hs index 0c5408e455c..8b64dc030bb 100644 --- a/services/brig/src/Brig/API/MLS/KeyPackages/Validation.hs +++ b/services/brig/src/Brig/API/MLS/KeyPackages/Validation.hs @@ -19,6 +19,7 @@ module Brig.API.MLS.KeyPackages.Validation ( -- * Main key package validation function validateKeyPackage, reLifetime, + mlsProtocolError, -- * Exported for unit tests findExtensions, diff --git a/services/galley/src/Galley/API/MLS/Message.hs b/services/galley/src/Galley/API/MLS/Message.hs index 900d91170e2..fc6edcfcf01 100644 --- a/services/galley/src/Galley/API/MLS/Message.hs +++ b/services/galley/src/Galley/API/MLS/Message.hs @@ -84,6 +84,7 @@ import Wire.API.MLS.Proposal import qualified Wire.API.MLS.Proposal as Proposal import Wire.API.MLS.Serialisation import Wire.API.Message +import Wire.API.Routes.Internal.Brig import Wire.API.User.Client type MLSMessageStaticErrors = @@ -348,7 +349,8 @@ type HasProposalEffects r = Member (Input UTCTime) r, Member LegalHoldStore r, Member MemberStore r, - Member TeamStore r + Member TeamStore r, + Member (Input (Local ())) r ) type ClientMap = Map (Qualified UserId) (Set (ClientId, KeyPackageRef)) @@ -465,6 +467,7 @@ processCommit qusr senderClient con lconv epoch sender commit = do pure updates +-- | Note: Use this only for KeyPackage that are already validated updateKeyPackageMapping :: Members '[BrigAccess, MemberStore] r => Local Data.Conversation -> @@ -511,25 +514,52 @@ applyProposalRef conv groupId epoch (Ref ref) = do p <- getProposal groupId epoch ref >>= noteS @'MLSProposalNotFound checkEpoch epoch conv checkGroup groupId conv - applyProposal (rmValue p) + applyProposal (convId conv) (rmValue p) applyProposalRef conv _groupId _epoch (Inline p) = do suite <- preview (to convProtocol . _ProtocolMLS . to cnvmlsCipherSuite) conv & noteS @'ConvNotFound checkProposalCipherSuite suite p - applyProposal p + applyProposal (convId conv) p -applyProposal :: HasProposalEffects r => Proposal -> Sem r ProposalAction -applyProposal (AddProposal kp) = do - ref <- - kpRef' kp - & note (mlsProtocolError "Could not compute ref of a key package in an Add proposal") - qclient <- cidQualifiedClient <$> derefKeyPackage ref - pure (paAddClient ((,ref) <$$> qclient)) -applyProposal (RemoveProposal ref) = do +applyProposal :: + HasProposalEffects r => + ConvId -> + Proposal -> + Sem r ProposalAction +applyProposal convId (AddProposal kp) = do + ref <- kpRef' kp & note (mlsProtocolError "Could not compute ref of a key package in an Add proposal") + mbClientIdentity <- getClientByKeyPackageRef ref + clientIdentity <- case mbClientIdentity of + Nothing -> do + -- external add proposal for a new key package unknown to the backend + lconvId <- qualifyLocal convId + ci <- addKeyPackageMapping lconvId ref (KeyPackageData (rmRaw kp)) + pure ci + Just ci -> + -- ad-hoc add proposal in commit, the key package has been claimed before + pure ci + pure (paAddClient . (<$$>) (,ref) . cidQualifiedClient $ clientIdentity) + where + addKeyPackageMapping lconv ref kpdata = do + -- validate and update mapping in brig + mCid <- + nkpresClientIdentity + <$$> validateAndAddKeyPackageRef + NewKeyPackage + { nkpConversation = qUntagged lconv, + nkpKeyPackage = kpdata + } + cid <- mCid & note (mlsProtocolError "Tried to add invalid KeyPackage") + let qcid = cidQualifiedClient cid + let qusr = fst <$> qcid + -- update mapping in galley + addMLSClients lconv qusr (Set.singleton (ciClient cid, ref)) + pure cid +applyProposal _conv (RemoveProposal ref) = do qclient <- cidQualifiedClient <$> derefKeyPackage ref pure (paRemoveClient ((,ref) <$$> qclient)) -applyProposal _ = pure mempty +applyProposal _conv _ = pure mempty checkProposalCipherSuite :: Members @@ -643,7 +673,9 @@ checkExternalProposalUser qusr prop = do either (const $ throwS @'MLSUnsupportedProposal) pure - $ decodeMLS' @ClientIdentity (bcIdentity . kpCredential . rmValue $ keyPackage) + . kpIdentity + . rmValue + $ keyPackage -- requesting user must match key package owner when (tUnqualified lusr /= ciUser) $ throwS @'MLSUnsupportedProposal -- client referenced in key package must be one of the user's clients diff --git a/services/galley/src/Galley/Effects/BrigAccess.hs b/services/galley/src/Galley/Effects/BrigAccess.hs index 31390adcd95..eb0c3e754d2 100644 --- a/services/galley/src/Galley/Effects/BrigAccess.hs +++ b/services/galley/src/Galley/Effects/BrigAccess.hs @@ -51,6 +51,7 @@ module Galley.Effects.BrigAccess getClientByKeyPackageRef, getLocalMLSClients, addKeyPackageRef, + validateAndAddKeyPackageRef, updateKeyPackageRef, -- * Features @@ -73,6 +74,7 @@ import Wire.API.Connection import Wire.API.Error.Galley import Wire.API.MLS.Credential import Wire.API.MLS.KeyPackage +import Wire.API.Routes.Internal.Brig import Wire.API.Routes.Internal.Brig.Connection import qualified Wire.API.Routes.Internal.Galley.TeamFeatureNoConfigMulti as Multi import Wire.API.Team.Feature @@ -129,6 +131,7 @@ data BrigAccess m a where GetClientByKeyPackageRef :: KeyPackageRef -> BrigAccess m (Maybe ClientIdentity) GetLocalMLSClients :: Local UserId -> SignatureSchemeTag -> BrigAccess m (Set ClientInfo) AddKeyPackageRef :: KeyPackageRef -> Qualified UserId -> ClientId -> Qualified ConvId -> BrigAccess m () + ValidateAndAddKeyPackageRef :: NewKeyPackage -> BrigAccess m (Maybe NewKeyPackageResult) UpdateKeyPackageRef :: KeyPackageUpdate -> BrigAccess m () UpdateSearchVisibilityInbound :: Multi.TeamStatus SearchVisibilityInboundConfig -> diff --git a/services/galley/src/Galley/Intra/Client.hs b/services/galley/src/Galley/Intra/Client.hs index 43ff1ab5b1d..fdd4514de94 100644 --- a/services/galley/src/Galley/Intra/Client.hs +++ b/services/galley/src/Galley/Intra/Client.hs @@ -26,6 +26,7 @@ module Galley.Intra.Client getLocalMLSClients, addKeyPackageRef, updateKeyPackageRef, + validateAndAddKeyPackageRef, ) where @@ -34,6 +35,7 @@ import Bilge.RPC import Brig.Types.Intra import Brig.Types.Team.LegalHold (LegalHoldClientRequest (..)) import Brig.Types.User.Auth (LegalHoldLogin (..)) +import Control.Monad.Catch import Data.ByteString.Conversion (toByteString') import Data.Id import Data.Misc @@ -47,6 +49,8 @@ import Galley.External.LegalHoldService.Types import Galley.Intra.Util import Galley.Monad import Imports +import qualified Network.HTTP.Client as Rq +import qualified Network.HTTP.Types as HTTP import Network.HTTP.Types.Method import Network.HTTP.Types.Status import Network.Wai.Utilities.Error hiding (Error) @@ -222,3 +226,18 @@ updateKeyPackageRef keyPackageRef = . json (kpupNext keyPackageRef) . expect2xx ) + +validateAndAddKeyPackageRef :: NewKeyPackage -> App (Maybe NewKeyPackageResult) +validateAndAddKeyPackageRef nkp = do + res <- + call + Brig + ( method PUT + . paths ["i", "mls", "key-package-add"] + . json nkp + ) + let statusCode = HTTP.statusCode (Rq.responseStatus res) + if + | statusCode `div` 100 == 2 -> Just <$> parseResponse (mkError status502 "server-error") res + | statusCode `div` 100 == 4 -> pure Nothing + | otherwise -> throwM (mkError status502 "server-error" "Unexpected http status returned from /i/mls/key-packages/add") diff --git a/services/galley/src/Galley/Intra/Effects.hs b/services/galley/src/Galley/Intra/Effects.hs index 46e017d8133..c42b7f1d632 100644 --- a/services/galley/src/Galley/Intra/Effects.hs +++ b/services/galley/src/Galley/Intra/Effects.hs @@ -82,6 +82,9 @@ interpretBrigAccess = interpret $ \case AddKeyPackageRef ref qusr cl qcnv -> embedApp $ addKeyPackageRef ref qusr cl qcnv + ValidateAndAddKeyPackageRef nkp -> + embedApp $ + validateAndAddKeyPackageRef nkp UpdateKeyPackageRef update -> embedApp $ updateKeyPackageRef update diff --git a/services/galley/test/integration/API/MLS.hs b/services/galley/test/integration/API/MLS.hs index a08bca53ee2..b40d09cdefd 100644 --- a/services/galley/test/integration/API/MLS.hs +++ b/services/galley/test/integration/API/MLS.hs @@ -76,6 +76,7 @@ import Wire.API.MLS.Group (convToGroupId) import Wire.API.MLS.KeyPackage import Wire.API.MLS.Keys import Wire.API.MLS.Message +import Wire.API.MLS.Proposal import Wire.API.MLS.Serialisation import Wire.API.Message import Wire.API.Routes.Version @@ -1574,24 +1575,96 @@ propInvalidEpoch = withSystemTempDirectory "mls" $ \tmp -> do testExternalAddProposal :: TestM () testExternalAddProposal = withSystemTempDirectory "mls" $ \tmp -> do - (creator, [bob]) <- withLastPrekeys $ setupParticipants tmp def [(1, LocalUser)] - (groupId, conversation) <- setupGroup tmp CreateConv creator "group" + let opts@SetupOptions {..} = def {createConv = CreateConv} + (creator, users@[bob], bobClient2, bobClient3) <- withLastPrekeys $ do + (creator, users@[bob]) <- setupParticipants tmp opts [(1, LocalUser)] + userClient2 <- setupUserClient tmp CreateWithKey True (pUserId bob) + userClient3 <- setupUserClient tmp CreateWithKey True (pUserId bob) + pure (creator, users, userClient2, userClient3) + let bobClient2Qid = userClientQid (pUserId bob) bobClient2 - bobClient1 <- assertOne . toList $ pClients bob + -- create a group + (groupId, conversation) <- setupGroup tmp createConv creator "group" + + -- add clients to it and get welcome message (commit, welcome) <- liftIO $ setupCommit tmp creator "group" "group" $ - NonEmpty.tail (pClients creator) <> [bobClient1] - testSuccessfulCommit MessagingSetup {users = [bob], ..} + NonEmpty.tail (pClients creator) <> toList (pClients bob) - liftIO $ mergeWelcome tmp (fst bobClient1) "group" "group" "welcome" + testSuccessfulCommit MessagingSetup {..} + + -- we use alice's group state "group" here, so that the mls client knows the group id + externalProposal <- liftIO $ createExternalProposal tmp bobClient2Qid "group" "bobClient2-group" + + -- extract signature key from proposal + do + msg <- liftIO $ decodeMLSError @(Message 'MLSPlainText) externalProposal + let payload = tbsMsgPayload . rmValue . msgTBS $ msg + let proposal = + case payload of + ProposalMessage rprop -> rmValue rprop + x -> error ("Expected ProposalMessage but got <> " <> show x) + let kp = case proposal of + (AddProposal kp') -> kp' + x -> error ("Expected AddProposal but got <> " <> show x) + let signerKey = bcSignatureKey . kpuCredential . rmValue . kpTBS . rmValue $ kp + liftIO $ BS.writeFile (tmp "proposal-signer.key") signerKey - bobClient2Qid <- - userClientQid (pUserId bob) - <$> withLastPrekeys (setupUserClient tmp CreateWithKey True (pUserId bob)) - externalProposal <- liftIO $ createExternalProposal tmp bobClient2Qid "group" "group" postMessage (qUnqualified (pUserId bob)) externalProposal !!! const 201 === statusCode + void . liftIO $ + spawn + ( cli + (pClientQid creator) + tmp + [ "consume", + "--group", + tmp "group", + "--in-place", + "--signer-key", + tmp "proposal-signer.key", + "-" + ] + ) + (Just externalProposal) + + (commitExternalAdd, Just welcomeBobClient2) <- + liftIO $ + pendingProposalsCommit tmp creator "group" + + -- Create bobWithClient2 here so that the new client of bob is used + let bobWithClient2 = Participant (pUserId bob) (bobClient2 NonEmpty.<| pClientIds bob) + void $ postCommit MessagingSetup {users = [bobWithClient2], commit = commitExternalAdd, ..} + liftIO $ BS.writeFile (tmp "welcomeBobClient2") welcomeBobClient2 + -- reset bobWithClient2's group state + void . liftIO $ + spawn + ( cli + (pClientQid bobWithClient2) + tmp + [ "group", + "from-welcome", + "--group-out", + tmp "bobClient2-group", + tmp "welcomeBobClient2" + ] + ) + Nothing + + -- Bob's bobClient2 and its keypackage ref is known to backend, so this client + -- is able able to send an unencrypted message, e.g. a bare add proposal + prop <- + liftIO $ + bareAddProposal + tmp + bobWithClient2 + (Participant (pUserId bob) (pure bobClient3)) + "bobClient2-group" + "bobClient2-group" + postMessage (qUnqualified (pUserId bobWithClient2)) prop + !!! const 201 === statusCode + testExternalAddProposalWrongUser :: TestM () testExternalAddProposalWrongUser = withSystemTempDirectory "mls" $ \tmp -> do (creator, [bob, charly]) <- withLastPrekeys $ setupParticipants tmp def [(1, LocalUser), (1, LocalUser)] From a942046de579ac18e64a96b5afb5a18add0cd866 Mon Sep 17 00:00:00 2001 From: fisx Date: Mon, 5 Sep 2022 15:55:21 +0200 Subject: [PATCH 08/58] Fix link in PR template (#2673) --- .github/pull_request_template.md | 2 +- changelog.d/5-internal/fix-pr-template | 1 + 2 files changed, 2 insertions(+), 1 deletion(-) create mode 100644 changelog.d/5-internal/fix-pr-template diff --git a/.github/pull_request_template.md b/.github/pull_request_template.md index 0f27e2b42af..0e874934718 100644 --- a/.github/pull_request_template.md +++ b/.github/pull_request_template.md @@ -1,4 +1,4 @@ ## Checklist - [ ] Add a new entry in an appropriate subdirectory of `changelog.d` - - [ ] Read and follow the [PR guidelines](https://github.com/wireapp/wire-server/blob/develop/docs/developer/pr-guidelines.md) + - [ ] Read and follow the [PR guidelines](https://docs.wire.com/developer/developer/pr-guidelines.html) diff --git a/changelog.d/5-internal/fix-pr-template b/changelog.d/5-internal/fix-pr-template new file mode 100644 index 00000000000..2fb12fbc358 --- /dev/null +++ b/changelog.d/5-internal/fix-pr-template @@ -0,0 +1 @@ +Fix link in PR template From 27353e63ce7f086bd389efd494567071c8b543b9 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Tue, 6 Sep 2022 14:10:41 +0200 Subject: [PATCH 09/58] Add /mls/public-keys to nginz (#2676) * Add /mls/public-keys to nginz chart * Add /mls/public-keys to demo conf --- changelog.d/1-api-changes/add-mls-public-keys-to-nginz | 1 + charts/nginz/values.yaml | 3 +++ deploy/services-demo/conf/nginz/nginx.conf | 5 +++++ 3 files changed, 9 insertions(+) create mode 100644 changelog.d/1-api-changes/add-mls-public-keys-to-nginz diff --git a/changelog.d/1-api-changes/add-mls-public-keys-to-nginz b/changelog.d/1-api-changes/add-mls-public-keys-to-nginz new file mode 100644 index 00000000000..67c245c7d7d --- /dev/null +++ b/changelog.d/1-api-changes/add-mls-public-keys-to-nginz @@ -0,0 +1 @@ +Add /mls/public-keys to nginz chart diff --git a/charts/nginz/values.yaml b/charts/nginz/values.yaml index 3cd3e6d2b5a..0d760702f96 100644 --- a/charts/nginz/values.yaml +++ b/charts/nginz/values.yaml @@ -476,6 +476,9 @@ nginx_conf: - path: /mls/messages envs: - all + - path: /mls/public-keys + envs: + - all - path: /nonce/clients envs: - all diff --git a/deploy/services-demo/conf/nginz/nginx.conf b/deploy/services-demo/conf/nginz/nginx.conf index 36ae5cd9023..ca1e9041ba2 100644 --- a/deploy/services-demo/conf/nginz/nginx.conf +++ b/deploy/services-demo/conf/nginz/nginx.conf @@ -421,6 +421,11 @@ http { proxy_pass http://galley; } + location /mls/public-keys { + include common_response_with_zauth.conf; + proxy_pass http://galley; + } + # Gundeck Endpoints rewrite ^/api-docs/push /push/api-docs?base_url=http://127.0.0.1:8080/ break; From 1bd111734607a0dfcc0c96407b330b6d0ff49888 Mon Sep 17 00:00:00 2001 From: Molly Miller <33266253+sysvinit@users.noreply.github.com> Date: Wed, 7 Sep 2022 10:32:01 +0200 Subject: [PATCH 10/58] coturn: refactor resource labels, expose ServiceMonitor for metrics endpoint (#2677) * charts/coturn: refactor labels. This adds the labels app, chart, heritage, and release to the coturn chart (same as the wire-server charts), and removes the boilerplate for overriding resource names. * changelog: update. * charts/coturn: add optional ServiceMonitor * charts/coturn: add metrics port to Service. The Service is headless, so this port is not exposed to the outside world; this is required so that the metrics endpoint is visible to the metrics collection agent which consumes the ServiceMonitor. * changelog: update. --- changelog.d/0-release-notes/coturn-labels | 6 +++ changelog.d/2-features/coturn-metrics | 2 + changelog.d/5-internal/coturn-labels | 2 + charts/coturn/templates/_helpers.yaml | 45 ------------------- .../configmap-coturn-conf-template.yaml | 4 +- charts/coturn/templates/secret.yaml | 5 ++- charts/coturn/templates/service-account.yaml | 25 +++++++---- charts/coturn/templates/service.yaml | 13 ++++-- charts/coturn/templates/servicemonitor.yaml | 19 ++++++++ charts/coturn/templates/statefulset.yaml | 18 +++++--- charts/coturn/values.yaml | 4 ++ 11 files changed, 75 insertions(+), 68 deletions(-) create mode 100644 changelog.d/0-release-notes/coturn-labels create mode 100644 changelog.d/2-features/coturn-metrics create mode 100644 changelog.d/5-internal/coturn-labels delete mode 100644 charts/coturn/templates/_helpers.yaml create mode 100644 charts/coturn/templates/servicemonitor.yaml diff --git a/changelog.d/0-release-notes/coturn-labels b/changelog.d/0-release-notes/coturn-labels new file mode 100644 index 00000000000..043dfd539f6 --- /dev/null +++ b/changelog.d/0-release-notes/coturn-labels @@ -0,0 +1,6 @@ +For users of the (currently alpha) coturn Helm chart, **manual action is +required** when upgrading to this version. The labels applied to the Kubernetes +manifests in this chart have changed, in order to match the conventions used +in the wire-server charts. However, this may mean that upgrading with Helm can +fail, due to changes to the `StatefulSet` included in this chart -- in this +case, the `StatefulSet` must be deleted before the chart is upgraded. diff --git a/changelog.d/2-features/coturn-metrics b/changelog.d/2-features/coturn-metrics new file mode 100644 index 00000000000..717a9c795a0 --- /dev/null +++ b/changelog.d/2-features/coturn-metrics @@ -0,0 +1,2 @@ +The coturn chart now has support for exposing its metric endpoint with a +ServiceMonitor, which can be ingested by third-party metrics collection tools. diff --git a/changelog.d/5-internal/coturn-labels b/changelog.d/5-internal/coturn-labels new file mode 100644 index 00000000000..33c3a3f5b06 --- /dev/null +++ b/changelog.d/5-internal/coturn-labels @@ -0,0 +1,2 @@ +The labels applied to resources in the coturn chart have been changed to +reflect the conventions in the wire-server charts. diff --git a/charts/coturn/templates/_helpers.yaml b/charts/coturn/templates/_helpers.yaml deleted file mode 100644 index 32fea225209..00000000000 --- a/charts/coturn/templates/_helpers.yaml +++ /dev/null @@ -1,45 +0,0 @@ -{{- define "coturn.name" -}} -{{- default .Chart.Name .Values.nameOverride | trunc 63 | trimSuffix "-" }} -{{- end }} - -{{/* -Create chart name and version as used by the chart label. -*/}} -{{- define "coturn.chart" -}} -{{- printf "%s-%s" .Chart.Name .Chart.Version | replace "+" "_" | trunc 63 | trimSuffix "-" }} -{{- end }} - -{{/* -Common labels -*/}} -{{- define "coturn.labels" -}} -helm.sh/chart: {{ include "coturn.chart" . }} -{{ include "coturn.selectorLabels" . }} -{{- if .Chart.AppVersion }} -app.kubernetes.io/version: {{ .Values.image.tag | default .Chart.AppVersion | quote }} -{{- end }} -app.kubernetes.io/managed-by: {{ .Release.Service }} -{{- end }} - -{{/* -Create a default fully qualified app name. -We truncate at 63 chars because some Kubernetes name fields are limited to this (by the DNS naming spec). -If release name contains chart name it will be used as a full name. -*/}} -{{- define "coturn.fullname" -}} -{{- if .Values.fullnameOverride }} -{{- .Values.fullnameOverride | trunc 63 | trimSuffix "-" }} -{{- else }} -{{- $name := default .Chart.Name .Values.nameOverride }} -{{- if contains $name .Release.Name }} -{{- .Release.Name | trunc 63 | trimSuffix "-" }} -{{- else }} -{{- printf "%s-%s" .Release.Name $name | trunc 63 | trimSuffix "-" }} -{{- end }} -{{- end }} -{{- end }} - -{{- define "coturn.selectorLabels" -}} -app.kubernetes.io/name: {{ include "coturn.name" . }} -app.kubernetes.io/instance: {{ .Release.Name }} -{{- end }} diff --git a/charts/coturn/templates/configmap-coturn-conf-template.yaml b/charts/coturn/templates/configmap-coturn-conf-template.yaml index 76e0f95605d..4a2a4c4c066 100644 --- a/charts/coturn/templates/configmap-coturn-conf-template.yaml +++ b/charts/coturn/templates/configmap-coturn-conf-template.yaml @@ -1,9 +1,7 @@ apiVersion: v1 kind: ConfigMap metadata: - name: {{ include "coturn.fullname" . }} - labels: - {{- include "coturn.selectorLabels" . | nindent 4 }} + name: coturn data: coturn.conf.template: | diff --git a/charts/coturn/templates/secret.yaml b/charts/coturn/templates/secret.yaml index af6a8563cf3..6dd55212066 100644 --- a/charts/coturn/templates/secret.yaml +++ b/charts/coturn/templates/secret.yaml @@ -8,9 +8,10 @@ kind: Secret metadata: name: coturn labels: + app: coturn chart: {{ .Chart.Name }}-{{ .Chart.Version | replace "+" "_" }} - release: "{{ .Release.Name }}" - heritage: "{{ .Release.Service }}" + release: {{ .Release.Name }} + heritage: {{ .Release.Service }} type: Opaque stringData: zrest_secret.txt: | diff --git a/charts/coturn/templates/service-account.yaml b/charts/coturn/templates/service-account.yaml index 1bea5d59085..ce2803840f1 100644 --- a/charts/coturn/templates/service-account.yaml +++ b/charts/coturn/templates/service-account.yaml @@ -2,16 +2,22 @@ apiVersion: v1 kind: ServiceAccount metadata: - name: {{ include "coturn.fullname" . }} + name: coturn labels: - {{- include "coturn.labels" . | nindent 4 }} + app: coturn + chart: {{ .Chart.Name }}-{{ .Chart.Version | replace "+" "_" }} + release: {{ .Release.Name }} + heritage: {{ .Release.Service }} --- apiVersion: rbac.authorization.k8s.io/v1 kind: ClusterRole metadata: - name: {{ include "coturn.fullname" . }} + name: coturn labels: - {{- include "coturn.labels" . | nindent 4 }} + app: coturn + chart: {{ .Chart.Name }}-{{ .Chart.Version | replace "+" "_" }} + release: {{ .Release.Name }} + heritage: {{ .Release.Service }} rules: - apiGroups: [""] resources: [nodes] @@ -20,14 +26,17 @@ rules: apiVersion: rbac.authorization.k8s.io/v1 kind: ClusterRoleBinding metadata: - name: {{ include "coturn.fullname" . }} + name: coturn labels: - {{- include "coturn.labels" . | nindent 4 }} + app: coturn + chart: {{ .Chart.Name }}-{{ .Chart.Version | replace "+" "_" }} + release: {{ .Release.Name }} + heritage: {{ .Release.Service }} roleRef: kind: ClusterRole apiGroup: rbac.authorization.k8s.io - name: {{ include "coturn.fullname" . }} + name: coturn subjects: - kind: ServiceAccount - name: {{ include "coturn.fullname" . }} + name: coturn namespace: {{ .Release.Namespace }} diff --git a/charts/coturn/templates/service.yaml b/charts/coturn/templates/service.yaml index a5f8f15bd5c..f1420c44d62 100644 --- a/charts/coturn/templates/service.yaml +++ b/charts/coturn/templates/service.yaml @@ -2,9 +2,12 @@ apiVersion: v1 kind: Service metadata: - name: {{ include "coturn.fullname" . }} + name: coturn labels: - {{- include "coturn.labels" . | nindent 4 }} + app: coturn + chart: {{ .Chart.Name }}-{{ .Chart.Version | replace "+" "_" }} + release: {{ .Release.Name }} + heritage: {{ .Release.Service }} spec: # Needs to be headless # See: https://kubernetes.io/docs/concepts/workloads/controllers/statefulset/ @@ -22,5 +25,9 @@ spec: port: {{ .Values.coturnTurnTlsListenPort }} targetPort: coturn-tls {{- end }} + - name: status-http + port: {{ .Values.coturnMetricsListenPort }} + targetPort: status-http selector: - {{- include "coturn.selectorLabels" . | nindent 4 }} + app: coturn + release: {{ .Release.Name }} diff --git a/charts/coturn/templates/servicemonitor.yaml b/charts/coturn/templates/servicemonitor.yaml new file mode 100644 index 00000000000..a21f0faea4e --- /dev/null +++ b/charts/coturn/templates/servicemonitor.yaml @@ -0,0 +1,19 @@ +{{- if .Values.metrics.serviceMonitor.enabled }} +apiVersion: monitoring.coreos.com/v1 +kind: ServiceMonitor +metadata: + name: coturn + labels: + app: coturn + chart: {{ .Chart.Name }}-{{ .Chart.Version | replace "+" "_" }} + release: {{ .Release.Name }} + heritage: {{ .Release.Service }} +spec: + endpoints: + - port: status-http + path: /metrics + selector: + matchLabels: + app: coturn + release: {{ .Release.Name }} +{{- end }} diff --git a/charts/coturn/templates/statefulset.yaml b/charts/coturn/templates/statefulset.yaml index daf90ace402..8ab28192b5d 100644 --- a/charts/coturn/templates/statefulset.yaml +++ b/charts/coturn/templates/statefulset.yaml @@ -1,9 +1,12 @@ apiVersion: apps/v1 kind: StatefulSet metadata: - name: {{ include "coturn.fullname" . }} + name: coturn labels: - {{- include "coturn.labels" . | nindent 4 }} + app: coturn + chart: {{ .Chart.Name }}-{{ .Chart.Version | replace "+" "_" }} + release: {{ .Release.Name }} + heritage: {{ .Release.Service }} spec: replicas: {{ .Values.replicaCount }} @@ -12,10 +15,10 @@ spec: # affect upgrades. podManagementPolicy: Parallel - serviceName: {{ include "coturn.fullname" . }} + serviceName: coturn selector: matchLabels: - {{- include "coturn.selectorLabels" . | nindent 6 }} + app: coturn template: metadata: {{- with .Values.podAnnotations }} @@ -24,7 +27,8 @@ spec: {{- end }} labels: - {{- include "coturn.selectorLabels" . | nindent 8 }} + app: coturn + release: {{ .Release.Name }} spec: securityContext: {{- toYaml .Values.podSecurityContext | nindent 8 }} @@ -33,7 +37,7 @@ spec: shareProcessNamespace: true {{- end }} hostNetwork: true - serviceAccountName: {{ include "coturn.fullname" . }} + serviceAccountName: coturn volumes: - name: external-ip emptyDir: {} @@ -41,7 +45,7 @@ spec: emptyDir: {} - name: coturn-config-template configMap: - name: {{ include "coturn.fullname" . }} + name: coturn - name: secrets secret: secretName: coturn diff --git a/charts/coturn/values.yaml b/charts/coturn/values.yaml index 1504bbcdcad..eede1626bec 100644 --- a/charts/coturn/values.yaml +++ b/charts/coturn/values.yaml @@ -36,6 +36,10 @@ tls: pullPolicy: IfNotPresent tag: 1aa6cbbf2ce3a5182ec47e3579bbcb8f47e22fdc +metrics: + serviceMonitor: + enabled: false + # This chart optionally supports waiting for traffic to drain from coturn # before pods are terminated. Warning: coturn does not have any way to steer # incoming client traffic away from itself on its own, so this functionality From ee0ad1decd2555735e2b94a171ab6a26e90928de Mon Sep 17 00:00:00 2001 From: fisx Date: Wed, 7 Sep 2022 10:50:22 +0200 Subject: [PATCH 11/58] Cleanup module structure (#2672) * Move module files. * Change module names inside files. find ./services/brig/ -name '*.hs' -exec perl -i -pe 's/Brig.Sem/Brig.Effects/g' {} \; * Fix cabal file. * changelog --- changelog.d/5-internal/cleanup-module-structure | 1 + services/brig/brig.cabal | 12 ++++++------ services/brig/src/Brig/API.hs | 6 +++--- services/brig/src/Brig/API/Internal.hs | 6 +++--- services/brig/src/Brig/API/Public.hs | 6 +++--- services/brig/src/Brig/API/User.hs | 12 ++++++------ services/brig/src/Brig/CanonicalInterpreter.hs | 12 ++++++------ services/brig/src/Brig/Data/Activation.hs | 4 ++-- services/brig/src/Brig/{Sem => Effects}/CodeStore.hs | 2 +- .../src/Brig/{Sem => Effects}/CodeStore/Cassandra.hs | 4 ++-- .../src/Brig/{Sem => Effects}/PasswordResetStore.hs | 2 +- .../{Sem => Effects}/PasswordResetStore/CodeStore.hs | 6 +++--- .../{Sem => Effects}/UserPendingActivationStore.hs | 2 +- .../UserPendingActivationStore/Cassandra.hs | 4 ++-- services/brig/src/Brig/Run.hs | 4 ++-- services/brig/src/Brig/Team/API.hs | 2 +- services/brig/test/integration/API/User/Util.hs | 4 ++-- 17 files changed, 45 insertions(+), 44 deletions(-) create mode 100644 changelog.d/5-internal/cleanup-module-structure rename services/brig/src/Brig/{Sem => Effects}/CodeStore.hs (97%) rename services/brig/src/Brig/{Sem => Effects}/CodeStore/Cassandra.hs (98%) rename services/brig/src/Brig/{Sem => Effects}/PasswordResetStore.hs (96%) rename services/brig/src/Brig/{Sem => Effects}/PasswordResetStore/CodeStore.hs (95%) rename services/brig/src/Brig/{Sem => Effects}/UserPendingActivationStore.hs (93%) rename services/brig/src/Brig/{Sem => Effects}/UserPendingActivationStore/Cassandra.hs (94%) diff --git a/changelog.d/5-internal/cleanup-module-structure b/changelog.d/5-internal/cleanup-module-structure new file mode 100644 index 00000000000..c89b9673391 --- /dev/null +++ b/changelog.d/5-internal/cleanup-module-structure @@ -0,0 +1 @@ +Move Brig.Sem.* modules to Brig.Effects (consistency) \ No newline at end of file diff --git a/services/brig/brig.cabal b/services/brig/brig.cabal index 661b91679ea..353fb359f77 100644 --- a/services/brig/brig.cabal +++ b/services/brig/brig.cabal @@ -58,8 +58,14 @@ library Brig.Effects.BlacklistPhonePrefixStore.Cassandra Brig.Effects.BlacklistStore Brig.Effects.BlacklistStore.Cassandra + Brig.Effects.CodeStore + Brig.Effects.CodeStore.Cassandra Brig.Effects.Delay + Brig.Effects.PasswordResetStore + Brig.Effects.PasswordResetStore.CodeStore Brig.Effects.SFT + Brig.Effects.UserPendingActivationStore + Brig.Effects.UserPendingActivationStore.Cassandra Brig.Email Brig.Federation.Client Brig.Index.Eval @@ -85,12 +91,6 @@ library Brig.Queue.Types Brig.RPC Brig.Run - Brig.Sem.CodeStore - Brig.Sem.CodeStore.Cassandra - Brig.Sem.PasswordResetStore - Brig.Sem.PasswordResetStore.CodeStore - Brig.Sem.UserPendingActivationStore - Brig.Sem.UserPendingActivationStore.Cassandra Brig.SMTP Brig.Team.API Brig.Team.DB diff --git a/services/brig/src/Brig/API.hs b/services/brig/src/Brig/API.hs index d724135c50f..9b7ce571d21 100644 --- a/services/brig/src/Brig/API.hs +++ b/services/brig/src/Brig/API.hs @@ -25,9 +25,9 @@ import qualified Brig.API.Internal as Internal import qualified Brig.API.Public as Public import Brig.Effects.BlacklistPhonePrefixStore (BlacklistPhonePrefixStore) import Brig.Effects.BlacklistStore (BlacklistStore) -import Brig.Sem.CodeStore -import Brig.Sem.PasswordResetStore (PasswordResetStore) -import Brig.Sem.UserPendingActivationStore (UserPendingActivationStore) +import Brig.Effects.CodeStore +import Brig.Effects.PasswordResetStore (PasswordResetStore) +import Brig.Effects.UserPendingActivationStore (UserPendingActivationStore) import qualified Data.Swagger.Build.Api as Doc import Network.Wai.Routing (Routes) import Polysemy diff --git a/services/brig/src/Brig/API/Internal.hs b/services/brig/src/Brig/API/Internal.hs index 5efb8ab1c0f..d5f62c1472e 100644 --- a/services/brig/src/Brig/API/Internal.hs +++ b/services/brig/src/Brig/API/Internal.hs @@ -45,9 +45,9 @@ import Brig.Effects.BlacklistStore (BlacklistStore) import qualified Brig.IO.Intra as Intra import Brig.Options hiding (internalEvents, sesQueue) import qualified Brig.Provider.API as Provider -import Brig.Sem.CodeStore (CodeStore) -import Brig.Sem.PasswordResetStore (PasswordResetStore) -import Brig.Sem.UserPendingActivationStore (UserPendingActivationStore) +import Brig.Effects.CodeStore (CodeStore) +import Brig.Effects.PasswordResetStore (PasswordResetStore) +import Brig.Effects.UserPendingActivationStore (UserPendingActivationStore) import qualified Brig.Team.API as Team import Brig.Team.DB (lookupInvitationByEmail) import Brig.Types.Connection diff --git a/services/brig/src/Brig/API/Public.hs b/services/brig/src/Brig/API/Public.hs index fa51d1b9255..1e44ef1bd09 100644 --- a/services/brig/src/Brig/API/Public.hs +++ b/services/brig/src/Brig/API/Public.hs @@ -49,9 +49,9 @@ import Brig.Effects.BlacklistStore (BlacklistStore) import qualified Brig.IO.Intra as Intra import Brig.Options hiding (internalEvents, sesQueue) import qualified Brig.Provider.API as Provider -import Brig.Sem.CodeStore (CodeStore) -import Brig.Sem.PasswordResetStore (PasswordResetStore) -import Brig.Sem.UserPendingActivationStore (UserPendingActivationStore) +import Brig.Effects.CodeStore (CodeStore) +import Brig.Effects.PasswordResetStore (PasswordResetStore) +import Brig.Effects.UserPendingActivationStore (UserPendingActivationStore) import qualified Brig.Team.API as Team import qualified Brig.Team.Email as Team import Brig.Types.Activation (ActivationPair) diff --git a/services/brig/src/Brig/API/User.hs b/services/brig/src/Brig/API/User.hs index afd82173ec9..3fd0834bcd5 100644 --- a/services/brig/src/Brig/API/User.hs +++ b/services/brig/src/Brig/API/User.hs @@ -116,12 +116,12 @@ import qualified Brig.InternalEvent.Types as Internal import Brig.Options hiding (Timeout, internalEvents) import Brig.Password import qualified Brig.Queue as Queue -import Brig.Sem.CodeStore (CodeStore) -import qualified Brig.Sem.CodeStore as E -import Brig.Sem.PasswordResetStore (PasswordResetStore) -import qualified Brig.Sem.PasswordResetStore as E -import Brig.Sem.UserPendingActivationStore (UserPendingActivation (..), UserPendingActivationStore) -import qualified Brig.Sem.UserPendingActivationStore as UserPendingActivationStore +import Brig.Effects.CodeStore (CodeStore) +import qualified Brig.Effects.CodeStore as E +import Brig.Effects.PasswordResetStore (PasswordResetStore) +import qualified Brig.Effects.PasswordResetStore as E +import Brig.Effects.UserPendingActivationStore (UserPendingActivation (..), UserPendingActivationStore) +import qualified Brig.Effects.UserPendingActivationStore as UserPendingActivationStore import qualified Brig.Team.DB as Team import Brig.Types.Activation (ActivationPair) import Brig.Types.Connection diff --git a/services/brig/src/Brig/CanonicalInterpreter.hs b/services/brig/src/Brig/CanonicalInterpreter.hs index 6460a79c42f..37b22f92336 100644 --- a/services/brig/src/Brig/CanonicalInterpreter.hs +++ b/services/brig/src/Brig/CanonicalInterpreter.hs @@ -5,12 +5,12 @@ import Brig.Effects.BlacklistPhonePrefixStore (BlacklistPhonePrefixStore) import Brig.Effects.BlacklistPhonePrefixStore.Cassandra (interpretBlacklistPhonePrefixStoreToCassandra) import Brig.Effects.BlacklistStore (BlacklistStore) import Brig.Effects.BlacklistStore.Cassandra (interpretBlacklistStoreToCassandra) -import Brig.Sem.CodeStore (CodeStore) -import Brig.Sem.CodeStore.Cassandra (codeStoreToCassandra, interpretClientToIO) -import Brig.Sem.PasswordResetStore (PasswordResetStore) -import Brig.Sem.PasswordResetStore.CodeStore (passwordResetStoreToCodeStore) -import Brig.Sem.UserPendingActivationStore (UserPendingActivationStore) -import Brig.Sem.UserPendingActivationStore.Cassandra (userPendingActivationStoreToCassandra) +import Brig.Effects.CodeStore (CodeStore) +import Brig.Effects.CodeStore.Cassandra (codeStoreToCassandra, interpretClientToIO) +import Brig.Effects.PasswordResetStore (PasswordResetStore) +import Brig.Effects.PasswordResetStore.CodeStore (passwordResetStoreToCodeStore) +import Brig.Effects.UserPendingActivationStore (UserPendingActivationStore) +import Brig.Effects.UserPendingActivationStore.Cassandra (userPendingActivationStoreToCassandra) import qualified Cassandra as Cas import Control.Lens ((^.)) import Imports diff --git a/services/brig/src/Brig/Data/Activation.hs b/services/brig/src/Brig/Data/Activation.hs index 71efc8a17f9..a360a4c8d12 100644 --- a/services/brig/src/Brig/Data/Activation.hs +++ b/services/brig/src/Brig/Data/Activation.hs @@ -35,8 +35,8 @@ import Brig.App (Env) import Brig.Data.User import Brig.Data.UserKey import Brig.Options -import qualified Brig.Sem.CodeStore as E -import Brig.Sem.CodeStore.Cassandra +import qualified Brig.Effects.CodeStore as E +import Brig.Effects.CodeStore.Cassandra import Brig.Types.Intra import Cassandra import Control.Error diff --git a/services/brig/src/Brig/Sem/CodeStore.hs b/services/brig/src/Brig/Effects/CodeStore.hs similarity index 97% rename from services/brig/src/Brig/Sem/CodeStore.hs rename to services/brig/src/Brig/Effects/CodeStore.hs index 7c449c61ab0..96f3e7c63be 100644 --- a/services/brig/src/Brig/Sem/CodeStore.hs +++ b/services/brig/src/Brig/Effects/CodeStore.hs @@ -16,7 +16,7 @@ -- with this program. If not, see . {-# LANGUAGE TemplateHaskell #-} -module Brig.Sem.CodeStore where +module Brig.Effects.CodeStore where import Data.Id import Data.Time.Clock diff --git a/services/brig/src/Brig/Sem/CodeStore/Cassandra.hs b/services/brig/src/Brig/Effects/CodeStore/Cassandra.hs similarity index 98% rename from services/brig/src/Brig/Sem/CodeStore/Cassandra.hs rename to services/brig/src/Brig/Effects/CodeStore/Cassandra.hs index 786fc636437..e6cae090996 100644 --- a/services/brig/src/Brig/Sem/CodeStore/Cassandra.hs +++ b/services/brig/src/Brig/Effects/CodeStore/Cassandra.hs @@ -16,14 +16,14 @@ -- with this program. If not, see . {-# LANGUAGE RecordWildCards #-} -module Brig.Sem.CodeStore.Cassandra +module Brig.Effects.CodeStore.Cassandra ( codeStoreToCassandra, interpretClientToIO, ) where import Brig.Data.Instances () -import Brig.Sem.CodeStore +import Brig.Effects.CodeStore import Cassandra import Data.ByteString.Conversion (toByteString') import Data.Id diff --git a/services/brig/src/Brig/Sem/PasswordResetStore.hs b/services/brig/src/Brig/Effects/PasswordResetStore.hs similarity index 96% rename from services/brig/src/Brig/Sem/PasswordResetStore.hs rename to services/brig/src/Brig/Effects/PasswordResetStore.hs index fe696473f1a..aab8274893e 100644 --- a/services/brig/src/Brig/Sem/PasswordResetStore.hs +++ b/services/brig/src/Brig/Effects/PasswordResetStore.hs @@ -16,7 +16,7 @@ -- with this program. If not, see . {-# LANGUAGE TemplateHaskell #-} -module Brig.Sem.PasswordResetStore where +module Brig.Effects.PasswordResetStore where import Brig.Types.User (PasswordResetPair) import Data.Id diff --git a/services/brig/src/Brig/Sem/PasswordResetStore/CodeStore.hs b/services/brig/src/Brig/Effects/PasswordResetStore/CodeStore.hs similarity index 95% rename from services/brig/src/Brig/Sem/PasswordResetStore/CodeStore.hs rename to services/brig/src/Brig/Effects/PasswordResetStore/CodeStore.hs index 2104d01ee46..c0248aa4e55 100644 --- a/services/brig/src/Brig/Sem/PasswordResetStore/CodeStore.hs +++ b/services/brig/src/Brig/Effects/PasswordResetStore/CodeStore.hs @@ -15,13 +15,13 @@ -- You should have received a copy of the GNU Affero General Public License along -- with this program. If not, see . -module Brig.Sem.PasswordResetStore.CodeStore +module Brig.Effects.PasswordResetStore.CodeStore ( passwordResetStoreToCodeStore, ) where -import Brig.Sem.CodeStore -import Brig.Sem.PasswordResetStore +import Brig.Effects.CodeStore +import Brig.Effects.PasswordResetStore import Brig.Types.User (PasswordResetPair) import Data.Id import Data.Time diff --git a/services/brig/src/Brig/Sem/UserPendingActivationStore.hs b/services/brig/src/Brig/Effects/UserPendingActivationStore.hs similarity index 93% rename from services/brig/src/Brig/Sem/UserPendingActivationStore.hs rename to services/brig/src/Brig/Effects/UserPendingActivationStore.hs index a23f1d5a878..69a1db7397d 100644 --- a/services/brig/src/Brig/Sem/UserPendingActivationStore.hs +++ b/services/brig/src/Brig/Effects/UserPendingActivationStore.hs @@ -1,6 +1,6 @@ {-# LANGUAGE TemplateHaskell #-} -module Brig.Sem.UserPendingActivationStore where +module Brig.Effects.UserPendingActivationStore where import Data.Id import Data.Time.Clock diff --git a/services/brig/src/Brig/Sem/UserPendingActivationStore/Cassandra.hs b/services/brig/src/Brig/Effects/UserPendingActivationStore/Cassandra.hs similarity index 94% rename from services/brig/src/Brig/Sem/UserPendingActivationStore/Cassandra.hs rename to services/brig/src/Brig/Effects/UserPendingActivationStore/Cassandra.hs index 5aa923ddc10..f3c4f8835ed 100644 --- a/services/brig/src/Brig/Sem/UserPendingActivationStore/Cassandra.hs +++ b/services/brig/src/Brig/Effects/UserPendingActivationStore/Cassandra.hs @@ -1,9 +1,9 @@ -module Brig.Sem.UserPendingActivationStore.Cassandra +module Brig.Effects.UserPendingActivationStore.Cassandra ( userPendingActivationStoreToCassandra, ) where -import Brig.Sem.UserPendingActivationStore +import Brig.Effects.UserPendingActivationStore import Cassandra import Data.Id (UserId) import Data.Time (UTCTime) diff --git a/services/brig/src/Brig/Run.hs b/services/brig/src/Brig/Run.hs index 8a5eba0a1c3..732f3a03c32 100644 --- a/services/brig/src/Brig/Run.hs +++ b/services/brig/src/Brig/Run.hs @@ -39,8 +39,8 @@ import Brig.CanonicalInterpreter import qualified Brig.InternalEvent.Process as Internal import Brig.Options hiding (internalEvents, sesQueue) import qualified Brig.Queue as Queue -import Brig.Sem.UserPendingActivationStore (UserPendingActivation (UserPendingActivation), UserPendingActivationStore) -import qualified Brig.Sem.UserPendingActivationStore as UsersPendingActivationStore +import Brig.Effects.UserPendingActivationStore (UserPendingActivation (UserPendingActivation), UserPendingActivationStore) +import qualified Brig.Effects.UserPendingActivationStore as UsersPendingActivationStore import Brig.Types.Intra (AccountStatus (PendingInvitation)) import Brig.Version import qualified Control.Concurrent.Async as Async diff --git a/services/brig/src/Brig/Team/API.hs b/services/brig/src/Brig/Team/API.hs index 9afa8b0a361..373c4087af0 100644 --- a/services/brig/src/Brig/Team/API.hs +++ b/services/brig/src/Brig/Team/API.hs @@ -35,7 +35,7 @@ import qualified Brig.Email as Email import qualified Brig.IO.Intra as Intra import Brig.Options (setMaxTeamSize, setTeamInvitationTimeout) import qualified Brig.Phone as Phone -import Brig.Sem.UserPendingActivationStore (UserPendingActivationStore) +import Brig.Effects.UserPendingActivationStore (UserPendingActivationStore) import qualified Brig.Team.DB as DB import Brig.Team.Email import Brig.Team.Util (ensurePermissionToAddUser, ensurePermissions) diff --git a/services/brig/test/integration/API/User/Util.hs b/services/brig/test/integration/API/User/Util.hs index 8c23cb39a0e..a2573fc269e 100644 --- a/services/brig/test/integration/API/User/Util.hs +++ b/services/brig/test/integration/API/User/Util.hs @@ -23,8 +23,8 @@ import Bilge hiding (accept, timeout) import Bilge.Assert import qualified Brig.Code as Code import Brig.Options (Opts) -import Brig.Sem.CodeStore -import Brig.Sem.CodeStore.Cassandra +import Brig.Effects.CodeStore +import Brig.Effects.CodeStore.Cassandra import Brig.Types.Team.LegalHold (LegalHoldClientRequest (..)) import qualified Brig.ZAuth import qualified Cassandra as DB From ca31215e52f4277c07acfc130652a89c65c301e9 Mon Sep 17 00:00:00 2001 From: jschaul Date: Wed, 7 Sep 2022 15:26:24 +0200 Subject: [PATCH 12/58] wire-server helm chart: Adjust default CPU/Memory (#2675) * Remove CPU limits to avoid CPU throttling * adjust request CPU and memory based on observed values. Overall this decreases the amount of CPU/memory that the wire-server chart needs to install/schedule pods. --- changelog.d/0-release-notes/helm-chart-default-resources | 1 + charts/backoffice/values.yaml | 7 +++---- charts/brig/values.yaml | 3 +-- charts/cannon/values.yaml | 3 +-- charts/cargohold/values.yaml | 5 ++--- charts/galley/values.yaml | 5 ++--- charts/gundeck/values.yaml | 5 ++--- charts/nginz/values.yaml | 3 +-- charts/proxy/values.yaml | 7 +++---- charts/spar/values.yaml | 7 +++---- 10 files changed, 19 insertions(+), 27 deletions(-) create mode 100644 changelog.d/0-release-notes/helm-chart-default-resources diff --git a/changelog.d/0-release-notes/helm-chart-default-resources b/changelog.d/0-release-notes/helm-chart-default-resources new file mode 100644 index 00000000000..19d3f0516b6 --- /dev/null +++ b/changelog.d/0-release-notes/helm-chart-default-resources @@ -0,0 +1 @@ +wire-server helm charts: Adjust default CPU/Memory resources: Remove CPU limits to avoid CPU throttling; adjust request CPU and memory based on observed values. Overall this decreases the amount of CPU/memory that the wire-server chart needs to install/schedule pods. diff --git a/charts/backoffice/values.yaml b/charts/backoffice/values.yaml index cb7b10bdfdb..bbdb1e881e3 100644 --- a/charts/backoffice/values.yaml +++ b/charts/backoffice/values.yaml @@ -13,11 +13,10 @@ service: externalPort: 8080 resources: requests: - memory: 128Mi - cpu: 125m + memory: 20Mi + cpu: 30m limits: - memory: 512Mi - cpu: 500m + memory: 50Mi config: logLevel: Info galebHost: galeb.integrations diff --git a/charts/brig/values.yaml b/charts/brig/values.yaml index ced8902dcfc..efb2ecf525c 100644 --- a/charts/brig/values.yaml +++ b/charts/brig/values.yaml @@ -7,11 +7,10 @@ service: internalPort: 8080 resources: requests: - memory: "256Mi" + memory: "200Mi" cpu: "100m" limits: memory: "512Mi" - cpu: "500m" metrics: serviceMonitor: enable: false diff --git a/charts/cannon/values.yaml b/charts/cannon/values.yaml index f5ca6b721a5..2a8ac452326 100644 --- a/charts/cannon/values.yaml +++ b/charts/cannon/values.yaml @@ -84,8 +84,7 @@ resources: memory: "256Mi" cpu: "100m" limits: - memory: "512Mi" - cpu: "500m" + memory: "1024Mi" service: name: cannon internalPort: 8080 diff --git a/charts/cargohold/values.yaml b/charts/cargohold/values.yaml index 77198b778d8..3c46d9cf431 100644 --- a/charts/cargohold/values.yaml +++ b/charts/cargohold/values.yaml @@ -10,11 +10,10 @@ metrics: enable: false resources: requests: - memory: "256Mi" + memory: "80Mi" cpu: "100m" limits: - memory: "512Mi" - cpu: "500m" + memory: "200Mi" config: logLevel: Info logFormat: StructuredJSON diff --git a/charts/galley/values.yaml b/charts/galley/values.yaml index 76406d88aab..2c6fa9a6c4e 100644 --- a/charts/galley/values.yaml +++ b/charts/galley/values.yaml @@ -11,11 +11,10 @@ metrics: enable: false resources: requests: - memory: "256Mi" + memory: "100Mi" cpu: "100m" limits: - memory: "512Mi" - cpu: "500m" + memory: "200Mi" config: logLevel: Info logFormat: StructuredJSON diff --git a/charts/gundeck/values.yaml b/charts/gundeck/values.yaml index d9b10037e2b..67d35e937a5 100644 --- a/charts/gundeck/values.yaml +++ b/charts/gundeck/values.yaml @@ -10,11 +10,10 @@ metrics: enable: false resources: requests: - memory: "256Mi" + memory: "300Mi" cpu: "100m" limits: - memory: "512Mi" - cpu: "500m" + memory: "1Gi" config: logLevel: Info logFormat: StructuredJSON diff --git a/charts/nginz/values.yaml b/charts/nginz/values.yaml index 0d760702f96..7c5dd2c6851 100644 --- a/charts/nginz/values.yaml +++ b/charts/nginz/values.yaml @@ -4,8 +4,7 @@ resources: memory: "256Mi" cpu: "100m" limits: - memory: "1024Mi" - cpu: "2" + memory: "800Mi" metrics: serviceMonitor: enabled: false diff --git a/charts/proxy/values.yaml b/charts/proxy/values.yaml index 94dbcd70d6b..90605af0479 100644 --- a/charts/proxy/values.yaml +++ b/charts/proxy/values.yaml @@ -10,11 +10,10 @@ metrics: enable: false resources: requests: - memory: "128Mi" - cpu: "100m" + memory: "25Mi" + cpu: "50m" limits: - memory: "512Mi" - cpu: "500m" + memory: "50Mi" config: logLevel: Info logFormat: StructuredJSON diff --git a/charts/spar/values.yaml b/charts/spar/values.yaml index 28a9681871b..89631616cfe 100644 --- a/charts/spar/values.yaml +++ b/charts/spar/values.yaml @@ -7,11 +7,10 @@ metrics: enable: false resources: requests: - memory: "128Mi" - cpu: "100m" + memory: "25Mi" + cpu: "50m" limits: - memory: "512Mi" - cpu: "500m" + memory: "50Mi" service: externalPort: 8080 internalPort: 8080 From 7a5e7181a7daf5803a74073144f15a2214ee5196 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Thu, 8 Sep 2022 08:03:15 +0200 Subject: [PATCH 13/58] Make deletions via SCIM more stable (#2637) Cassandra doesn't support transactions. Thus, in rare circumstances, a user could be only partially deleted in brig (e.g. due to the pod shutting down). To be able to clean up a partially deleted user/account, the SCIM user deletion handler now executes the internal deletion function in brig again even if the user is not found in brig as it's only a "tombstone". This internal deletion function then figures out if the user ever existed and if there are any left overs. In case, deletion is executed for the user/account again. To gather the result of a user deletion, the brig endpoint is now synchronous (was asynchronous before). Co-authored-by: Matthias Fischmann --- .../more-stable-user-deletion-via-scim | 1 + libs/wire-api/src/Wire/API/Connection.hs | 2 +- libs/wire-api/src/Wire/API/User.hs | 11 + services/brig/brig.cabal | 1 + services/brig/src/Brig/API/Internal.hs | 30 +-- services/brig/src/Brig/API/Public.hs | 6 +- services/brig/src/Brig/API/User.hs | 76 +++++-- services/brig/src/Brig/Data/Activation.hs | 2 +- services/brig/src/Brig/Data/UserKey.hs | 16 ++ services/brig/src/Brig/Run.hs | 4 +- services/brig/src/Brig/Team/API.hs | 2 +- services/brig/src/Brig/User/Handle.hs | 10 +- .../brig/test/integration/API/User/Account.hs | 98 +++++++-- .../brig/test/integration/API/User/Util.hs | 2 +- services/galley/src/Galley/API/MLS/Message.hs | 3 +- services/galley/src/Galley/Intra/User.hs | 2 +- services/spar/spar.cabal | 1 + services/spar/src/Spar/API.hs | 2 +- services/spar/src/Spar/Intra/Brig.hs | 18 +- services/spar/src/Spar/Scim/User.hs | 73 +++++-- services/spar/src/Spar/Sem/BrigAccess.hs | 6 +- services/spar/src/Spar/Sem/BrigAccess/Http.hs | 2 +- .../spar/src/Spar/Sem/SAMLUserStore/Mem.hs | 3 +- .../Test/Spar/Intra/BrigSpec.hs | 12 +- services/spar/test-integration/Util/Scim.hs | 2 +- services/spar/test/Test/Spar/Scim/UserSpec.hs | 189 ++++++++++++++++++ 26 files changed, 481 insertions(+), 93 deletions(-) create mode 100644 changelog.d/3-bug-fixes/more-stable-user-deletion-via-scim create mode 100644 services/spar/test/Test/Spar/Scim/UserSpec.hs diff --git a/changelog.d/3-bug-fixes/more-stable-user-deletion-via-scim b/changelog.d/3-bug-fixes/more-stable-user-deletion-via-scim new file mode 100644 index 00000000000..bbbca33cabb --- /dev/null +++ b/changelog.d/3-bug-fixes/more-stable-user-deletion-via-scim @@ -0,0 +1 @@ +SCIM user deletion suffered from a couple of race conditions. The user in now first deleted in spar, because this process depends on data from brig. Then, the user is deleted in brig. If any error occurs, the SCIM deletion request can be made again. This change depends on brig being completely deployed before using the SCIM deletion endpoint in brig. In the unlikely event of using SCIM deletion during the deployment, these requests can be retried (in case of error). diff --git a/libs/wire-api/src/Wire/API/Connection.hs b/libs/wire-api/src/Wire/API/Connection.hs index fa3fc2af11e..6da96c6345b 100644 --- a/libs/wire-api/src/Wire/API/Connection.hs +++ b/libs/wire-api/src/Wire/API/Connection.hs @@ -168,7 +168,7 @@ data Relation | Cancelled | -- | behaves like blocked, the extra constructor is just to inform why. MissingLegalholdConsent - deriving stock (Eq, Ord, Show, Generic) + deriving stock (Bounded, Enum, Eq, Ord, Show, Generic) deriving (Arbitrary) via (GenericUniform Relation) deriving (FromJSON, ToJSON, S.ToSchema) via (Schema Relation) diff --git a/libs/wire-api/src/Wire/API/User.hs b/libs/wire-api/src/Wire/API/User.hs index 87f9d1fa3e8..e61446113f8 100644 --- a/libs/wire-api/src/Wire/API/User.hs +++ b/libs/wire-api/src/Wire/API/User.hs @@ -95,6 +95,7 @@ module Wire.API.User VerifyDeleteUser (..), mkVerifyDeleteUser, DeletionCodeTimeout (..), + DeleteUserResult (..), -- * List Users ListUsersQuery (..), @@ -1356,6 +1357,16 @@ instance FromJSON DeletionCodeTimeout where parseJSON = A.withObject "DeletionCodeTimeout" $ \o -> DeletionCodeTimeout <$> o A..: "expires_in" +-- | Result of an internal user/account deletion +data DeleteUserResult + = -- | User never existed + NoUser + | -- | User/account was deleted before + AccountAlreadyDeleted + | -- | User/account was deleted in this call + AccountDeleted + deriving (Eq, Show) + data ListUsersQuery = ListUsersByIds [Qualified UserId] | ListUsersByHandles (Range 1 4 [Qualified Handle]) diff --git a/services/brig/brig.cabal b/services/brig/brig.cabal index 353fb359f77..392f90d30ee 100644 --- a/services/brig/brig.cabal +++ b/services/brig/brig.cabal @@ -204,6 +204,7 @@ library , errors >=1.4 , exceptions >=0.5 , extended + , extra , file-embed , file-embed-lzma , filepath >=1.3 diff --git a/services/brig/src/Brig/API/Internal.hs b/services/brig/src/Brig/API/Internal.hs index d5f62c1472e..4a548f766d4 100644 --- a/services/brig/src/Brig/API/Internal.hs +++ b/services/brig/src/Brig/API/Internal.hs @@ -42,12 +42,12 @@ import qualified Brig.Data.MLS.KeyPackage as Data import qualified Brig.Data.User as Data import Brig.Effects.BlacklistPhonePrefixStore (BlacklistPhonePrefixStore) import Brig.Effects.BlacklistStore (BlacklistStore) -import qualified Brig.IO.Intra as Intra -import Brig.Options hiding (internalEvents, sesQueue) -import qualified Brig.Provider.API as Provider import Brig.Effects.CodeStore (CodeStore) import Brig.Effects.PasswordResetStore (PasswordResetStore) import Brig.Effects.UserPendingActivationStore (UserPendingActivationStore) +import qualified Brig.IO.Intra as Intra +import Brig.Options hiding (internalEvents, sesQueue) +import qualified Brig.Provider.API as Provider import qualified Brig.Team.API as Team import Brig.Team.DB (lookupInvitationByEmail) import Brig.Types.Connection @@ -286,7 +286,7 @@ sitemap = do -- This endpoint will lead to the following events being sent: -- - UserDeleted event to all of its contacts -- - MemberLeave event to members for all conversations the user was in (via galley) - delete "/i/users/:uid" (continue deleteUserNoVerifyH) $ + delete "/i/users/:uid" (continue deleteUserNoAuthH) $ capture "uid" put "/i/connections/connection-update" (continue updateConnectionInternalH) $ @@ -508,16 +508,13 @@ createUserNoVerifySpar uData = in API.activate key code (Just uid) !>> CreateUserSparRegistrationError . activationErrorToRegisterError pure . SelfProfile $ usr -deleteUserNoVerifyH :: UserId -> (Handler r) Response -deleteUserNoVerifyH uid = do - setStatus status202 empty <$ deleteUserNoVerify uid - -deleteUserNoVerify :: UserId -> (Handler r) () -deleteUserNoVerify uid = do - void $ - lift (wrapClient $ API.lookupAccount uid) - >>= ifNothing (errorToWai @'E.UserNotFound) - lift $ API.deleteUserNoVerify uid +deleteUserNoAuthH :: UserId -> (Handler r) Response +deleteUserNoAuthH uid = do + r <- lift $ wrapHttp $ API.ensureAccountDeleted uid + case r of + NoUser -> throwStd (errorToWai @'E.UserNotFound) + AccountAlreadyDeleted -> pure $ setStatus ok200 empty + AccountDeleted -> pure $ setStatus accepted202 empty changeSelfEmailMaybeSendH :: Member BlacklistStore r => UserId ::: Bool ::: JsonRequest EmailUpdate -> (Handler r) Response changeSelfEmailMaybeSendH (u ::: validate ::: req) = do @@ -796,8 +793,3 @@ getContactListH :: JSON ::: UserId -> (Handler r) Response getContactListH (_ ::: uid) = do contacts <- lift . wrapClient $ API.lookupContactList uid pure $ json $ UserIds contacts - --- Utilities - -ifNothing :: Utilities.Error -> Maybe a -> (Handler r) a -ifNothing e = maybe (throwStd e) pure diff --git a/services/brig/src/Brig/API/Public.hs b/services/brig/src/Brig/API/Public.hs index 1e44ef1bd09..e6159d34687 100644 --- a/services/brig/src/Brig/API/Public.hs +++ b/services/brig/src/Brig/API/Public.hs @@ -46,12 +46,12 @@ import qualified Brig.Data.User as Data import qualified Brig.Data.UserKey as UserKey import Brig.Effects.BlacklistPhonePrefixStore (BlacklistPhonePrefixStore) import Brig.Effects.BlacklistStore (BlacklistStore) -import qualified Brig.IO.Intra as Intra -import Brig.Options hiding (internalEvents, sesQueue) -import qualified Brig.Provider.API as Provider import Brig.Effects.CodeStore (CodeStore) import Brig.Effects.PasswordResetStore (PasswordResetStore) import Brig.Effects.UserPendingActivationStore (UserPendingActivationStore) +import qualified Brig.IO.Intra as Intra +import Brig.Options hiding (internalEvents, sesQueue) +import qualified Brig.Provider.API as Provider import qualified Brig.Team.API as Team import qualified Brig.Team.Email as Team import Brig.Types.Activation (ActivationPair) diff --git a/services/brig/src/Brig/API/User.hs b/services/brig/src/Brig/API/User.hs index 3fd0834bcd5..ce19c9bdde1 100644 --- a/services/brig/src/Brig/API/User.hs +++ b/services/brig/src/Brig/API/User.hs @@ -54,6 +54,7 @@ module Brig.API.User deleteUsersNoVerify, deleteSelfUser, verifyDeleteUser, + ensureAccountDeleted, deleteAccount, checkHandles, isBlacklistedHandle, @@ -100,6 +101,7 @@ import qualified Brig.Code as Code import Brig.Data.Activation (ActivationEvent (..), activationErrorToRegisterError) import qualified Brig.Data.Activation as Data import qualified Brig.Data.Client as Data +import Brig.Data.Connection (countConnections) import qualified Brig.Data.Connection as Data import qualified Brig.Data.Properties as Data import Brig.Data.User @@ -110,25 +112,25 @@ import Brig.Effects.BlacklistPhonePrefixStore (BlacklistPhonePrefixStore) import qualified Brig.Effects.BlacklistPhonePrefixStore as BlacklistPhonePrefixStore import Brig.Effects.BlacklistStore (BlacklistStore) import qualified Brig.Effects.BlacklistStore as BlacklistStore -import qualified Brig.Federation.Client as Federation -import qualified Brig.IO.Intra as Intra -import qualified Brig.InternalEvent.Types as Internal -import Brig.Options hiding (Timeout, internalEvents) -import Brig.Password -import qualified Brig.Queue as Queue import Brig.Effects.CodeStore (CodeStore) import qualified Brig.Effects.CodeStore as E import Brig.Effects.PasswordResetStore (PasswordResetStore) import qualified Brig.Effects.PasswordResetStore as E import Brig.Effects.UserPendingActivationStore (UserPendingActivation (..), UserPendingActivationStore) import qualified Brig.Effects.UserPendingActivationStore as UserPendingActivationStore +import qualified Brig.Federation.Client as Federation +import qualified Brig.IO.Intra as Intra +import qualified Brig.InternalEvent.Types as Internal +import Brig.Options hiding (Timeout, internalEvents) +import Brig.Password +import qualified Brig.Queue as Queue import qualified Brig.Team.DB as Team import Brig.Types.Activation (ActivationPair) import Brig.Types.Connection import Brig.Types.Intra import Brig.Types.User (HavePendingInvitations (..), ManagedByUpdate (..), PasswordResetPair) import Brig.Types.User.Event -import Brig.User.Auth.Cookie (revokeAllCookies) +import Brig.User.Auth.Cookie (listCookies, revokeAllCookies) import Brig.User.Email import Brig.User.Handle import Brig.User.Handle.Blacklist @@ -147,6 +149,7 @@ import Data.Handle (Handle (fromHandle), parseHandle) import Data.Id as Id import Data.Json.Util import Data.LegalHold (UserLegalHoldStatus (..), defUserLegalHoldStatus) +import Data.List.Extra import Data.List1 as List1 (List1, singleton) import qualified Data.Map.Strict as Map import qualified Data.Metrics as Metrics @@ -1230,10 +1233,57 @@ verifyDeleteUser d = do for_ account $ lift . wrapHttpClient . deleteAccount lift . wrapClient $ Code.delete key Code.AccountDeletion --- | Internal deletion without validation. Called via @delete /i/user/:uid@, or indirectly --- via deleting self. --- Team owners can be deleted if the team is not orphaned, i.e. there is at least one --- other owner left. +-- | Check if `deleteAccount` succeeded and run it again if needed. +-- Called via @delete /i/user/:uid@. +ensureAccountDeleted :: + ( MonadLogger m, + MonadCatch m, + MonadThrow m, + MonadIndexIO m, + MonadReader Env m, + MonadIO m, + MonadMask m, + MonadHttp m, + HasRequestId m, + MonadUnliftIO m, + MonadClient m, + MonadReader Env m + ) => + UserId -> + m DeleteUserResult +ensureAccountDeleted uid = do + mbAcc <- lookupAccount uid + case mbAcc of + Nothing -> pure NoUser + Just acc -> do + probs <- Data.lookupPropertyKeysAndValues uid + + let accIsDeleted = accountStatus acc == Deleted + clients <- Data.lookupClients uid + + localUid <- qualifyLocal uid + conCount <- countConnections localUid [(minBound @Relation) .. maxBound] + cookies <- listCookies uid [] + + if notNull probs + || not accIsDeleted + || notNull clients + || conCount > 0 + || notNull cookies + then do + deleteAccount acc + pure AccountDeleted + else pure AccountAlreadyDeleted + +-- | Internal deletion without validation. +-- +-- Called via @delete /i/user/:uid@ (through `ensureAccountDeleted`), or +-- indirectly via deleting self. Team owners can be deleted if the team is not +-- orphaned, i.e. there is at least one other owner left. +-- +-- N.B.: As Cassandra doesn't support transactions, the order of database +-- statements matters! Other functions reason upon some states to imply other +-- states. Please change this order only with care! deleteAccount :: ( MonadLogger m, MonadIndexIO m, @@ -1250,8 +1300,8 @@ deleteAccount account@(accountUser -> user) = do let uid = userId user Log.info $ field "user" (toByteString uid) . msg (val "Deleting account") -- Free unique keys - for_ (userEmail user) $ deleteKey . userEmailKey - for_ (userPhone user) $ deleteKey . userPhoneKey + for_ (userEmail user) $ deleteKeyForUser uid . userEmailKey + for_ (userPhone user) $ deleteKeyForUser uid . userPhoneKey for_ (userHandle user) $ freeHandle (userId user) -- Wipe data Data.clearProperties uid diff --git a/services/brig/src/Brig/Data/Activation.hs b/services/brig/src/Brig/Data/Activation.hs index a360a4c8d12..3de71d39827 100644 --- a/services/brig/src/Brig/Data/Activation.hs +++ b/services/brig/src/Brig/Data/Activation.hs @@ -34,9 +34,9 @@ where import Brig.App (Env) import Brig.Data.User import Brig.Data.UserKey -import Brig.Options import qualified Brig.Effects.CodeStore as E import Brig.Effects.CodeStore.Cassandra +import Brig.Options import Brig.Types.Intra import Cassandra import Control.Error diff --git a/services/brig/src/Brig/Data/UserKey.hs b/services/brig/src/Brig/Data/UserKey.hs index 1fbd4cb87c6..28c42124353 100644 --- a/services/brig/src/Brig/Data/UserKey.hs +++ b/services/brig/src/Brig/Data/UserKey.hs @@ -29,6 +29,7 @@ module Brig.Data.UserKey keyAvailable, lookupKey, deleteKey, + deleteKeyForUser, lookupPhoneHashes, ) where @@ -164,6 +165,21 @@ deleteKey k = do retry x5 $ write deleteHashed (params LocalQuorum (Identity hk)) retry x5 $ write keyDelete (params LocalQuorum (Identity $ keyText k)) +-- | Delete `UserKey` for `UserId` +-- +-- This function ensures that keys of other users aren't accidentally deleted. +-- E.g. the email address or phone number of a partially deleted user could +-- already belong to a new user. To not interrupt deletion flows (that may be +-- executed several times due to cassandra not supporting transactions) +-- `deleteKeyForUser` does not fail for missing keys or keys that belong to +-- another user: It always returns `()` as result. +deleteKeyForUser :: (MonadClient m, MonadReader Env m) => UserId -> UserKey -> m () +deleteKeyForUser uid k = do + mbKeyUid <- lookupKey k + case mbKeyUid of + Just keyUid | keyUid == uid -> deleteKey k + _ -> pure () + hashKey :: MonadReader Env m => UserKey -> m UserKeyHash hashKey uk = do d <- view digestSHA256 diff --git a/services/brig/src/Brig/Run.hs b/services/brig/src/Brig/Run.hs index 732f3a03c32..d4813c5dc43 100644 --- a/services/brig/src/Brig/Run.hs +++ b/services/brig/src/Brig/Run.hs @@ -36,11 +36,11 @@ import qualified Brig.AWS.SesNotification as SesNotification import Brig.App import qualified Brig.Calling as Calling import Brig.CanonicalInterpreter +import Brig.Effects.UserPendingActivationStore (UserPendingActivation (UserPendingActivation), UserPendingActivationStore) +import qualified Brig.Effects.UserPendingActivationStore as UsersPendingActivationStore import qualified Brig.InternalEvent.Process as Internal import Brig.Options hiding (internalEvents, sesQueue) import qualified Brig.Queue as Queue -import Brig.Effects.UserPendingActivationStore (UserPendingActivation (UserPendingActivation), UserPendingActivationStore) -import qualified Brig.Effects.UserPendingActivationStore as UsersPendingActivationStore import Brig.Types.Intra (AccountStatus (PendingInvitation)) import Brig.Version import qualified Control.Concurrent.Async as Async diff --git a/services/brig/src/Brig/Team/API.hs b/services/brig/src/Brig/Team/API.hs index 373c4087af0..74bda2dead8 100644 --- a/services/brig/src/Brig/Team/API.hs +++ b/services/brig/src/Brig/Team/API.hs @@ -31,11 +31,11 @@ import Brig.Data.UserKey import qualified Brig.Data.UserKey as Data import Brig.Effects.BlacklistStore (BlacklistStore) import qualified Brig.Effects.BlacklistStore as BlacklistStore +import Brig.Effects.UserPendingActivationStore (UserPendingActivationStore) import qualified Brig.Email as Email import qualified Brig.IO.Intra as Intra import Brig.Options (setMaxTeamSize, setTeamInvitationTimeout) import qualified Brig.Phone as Phone -import Brig.Effects.UserPendingActivationStore (UserPendingActivationStore) import qualified Brig.Team.DB as DB import Brig.Team.Email import Brig.Team.Util (ensurePermissionToAddUser, ensurePermissions) diff --git a/services/brig/src/Brig/User/Handle.hs b/services/brig/src/Brig/User/Handle.hs index 710f61affc8..256337cc9ee 100644 --- a/services/brig/src/Brig/User/Handle.hs +++ b/services/brig/src/Brig/User/Handle.hs @@ -59,9 +59,13 @@ claimHandle uid oldHandle newHandle = -- | Free a 'Handle', making it available to be claimed again. freeHandle :: MonadClient m => UserId -> Handle -> m () freeHandle uid h = do - retry x5 $ write handleDelete (params LocalQuorum (Identity h)) - let key = "@" <> fromHandle h - deleteClaim uid key (30 # Minute) + mbHandleUid <- lookupHandle h + case mbHandleUid of + Just handleUid | handleUid == uid -> do + retry x5 $ write handleDelete (params LocalQuorum (Identity h)) + let key = "@" <> fromHandle h + deleteClaim uid key (30 # Minute) + _ -> pure () -- this shouldn't happen, the call side should always check that `h` and `uid` belong to the same account. -- | Lookup the current owner of a 'Handle'. lookupHandle :: MonadClient m => Handle -> m (Maybe UserId) diff --git a/services/brig/test/integration/API/User/Account.hs b/services/brig/test/integration/API/User/Account.hs index e00b11c54f3..07a4ef632c7 100644 --- a/services/brig/test/integration/API/User/Account.hs +++ b/services/brig/test/integration/API/User/Account.hs @@ -46,6 +46,7 @@ import qualified Data.ByteString as C8 import Data.ByteString.Char8 (pack) import Data.ByteString.Conversion import Data.Domain +import Data.Handle import Data.Id hiding (client) import Data.Json.Util (fromUTCTimeMillis) import Data.List1 (singleton) @@ -72,6 +73,7 @@ import qualified Network.HTTP.Types as Http import qualified Network.Wai as Wai import qualified Network.Wai.Utilities.Error as Error import qualified Network.Wai.Utilities.Error as Wai +import Test.QuickCheck (arbitrary, generate) import Test.Tasty hiding (Timeout) import Test.Tasty.Cannon hiding (Cannon) import qualified Test.Tasty.Cannon as WS @@ -148,7 +150,6 @@ tests _ at opts p b c ch g aws = test' aws p "delete/with-legalhold" $ testDeleteUserWithLegalHold b c aws, test' aws p "delete/by-code" $ testDeleteUserByCode b, test' aws p "delete/anonymous" $ testDeleteAnonUser b, - test' aws p "delete /i/users/:uid - 202" $ testDeleteInternal b c aws, test' aws p "delete with profile pic" $ testDeleteWithProfilePic b ch, test' aws p "delete with connected remote users" $ testDeleteWithRemotes opts b, test' aws p "delete with connected remote users and failed remote notifcations" $ testDeleteWithRemotesAndFailedNotifications opts b c, @@ -160,6 +161,13 @@ tests _ at opts p b c ch g aws = testGroup "update user email by team owner" [ test' aws p "put /users/:uid/email" $ testUpdateUserEmailByTeamOwner b + ], + testGroup + "delete /i/users/:uid" + [ test' aws p "does nothing for completely deleted user" $ testDeleteUserWithCompletelyDeletedUser b c aws, + test' aws p "does nothing when the user doesn't exist" $ testDeleteUserWithNoUser b, + test' aws p "deletes a not deleted user" $ testDeleteUserWithNotDeletedUser b c aws, + test' aws p "delete again because of dangling property" $ testDeleteUserWithDanglingProperty b c aws ] ] @@ -1336,13 +1344,6 @@ testDeleteAnonUser brig = do deleteUser uid Nothing brig !!! const 200 === statusCode -testDeleteInternal :: Brig -> Cannon -> AWS.Env -> Http () -testDeleteInternal brig cannon aws = do - u <- randomUser brig - liftIO $ Util.assertUserJournalQueue "user activate testDeleteInternal1: " aws (userActivateJournaled u) - setHandleAndDeleteUser brig cannon u [] aws $ - \uid -> delete (brig . paths ["/i/users", toByteString' uid]) !!! const 202 === statusCode - testDeleteWithProfilePic :: Brig -> CargoHold -> Http () testDeleteWithProfilePic brig cargohold = do uid <- userId <$> createAnonUser "anon" brig @@ -1632,18 +1633,91 @@ testTooManyMembersForLegalhold opts brig = do const 403 === statusCode const (Right "too-many-members-for-legalhold") === fmap Wai.label . responseJsonEither +testDeleteUserWithCompletelyDeletedUser :: Brig -> Cannon -> AWS.Env -> Http () +testDeleteUserWithCompletelyDeletedUser brig cannon aws = do + u <- randomUser brig + liftIO $ Util.assertUserJournalQueue "user activate testDeleteUserWithCompletelyDeletedUser" aws (userActivateJournaled u) + setHandleAndDeleteUser brig cannon u [] aws $ + \uid -> deleteUserInternal uid brig !!! const 202 === statusCode + do + let uid = userId u + deleteUserInternal uid brig + !!! do + const 200 === statusCode + +testDeleteUserWithNoUser :: Brig -> Http () +testDeleteUserWithNoUser brig = do + nonExistingUid :: UserId <- liftIO $ generate arbitrary + deleteUserInternal nonExistingUid brig + !!! do + const 404 === statusCode + +testDeleteUserWithNotDeletedUser :: HasCallStack => Brig -> Cannon -> AWS.Env -> Http () +testDeleteUserWithNotDeletedUser brig cannon aws = do + u <- randomUser brig + liftIO $ Util.assertUserJournalQueue "user activate testDeleteUserWithNotDeletedUser" aws (userActivateJournaled u) + do + setHandleAndDeleteUser brig cannon u [] aws $ + ( \uid' -> + deleteUserInternal uid' brig + !!! do + const 202 === statusCode + ) + +testDeleteUserWithDanglingProperty :: Brig -> Cannon -> AWS.Env -> Http () +testDeleteUserWithDanglingProperty brig cannon aws = do + u <- randomUser brig + liftIO $ Util.assertUserJournalQueue "user activate testDeleteUserWithDanglingProperty" aws (userActivateJournaled u) + + let uid = userId u + -- First set a unique handle (to verify freeing of the handle) + hdl <- randomHandle + let update = RequestBodyLBS . encode $ HandleUpdate hdl + put (brig . path "/self/handle" . contentJson . zUser uid . zConn "c" . body update) + !!! const 200 === statusCode + + deleteUserInternal uid brig !!! const 202 === statusCode + liftIO $ Util.assertUserJournalQueue "user deletion testDeleteUserWithDanglingProperty" aws (userDeleteJournaled uid) + + setProperty brig (userId u) "foo" objectProp + !!! const 200 === statusCode + getProperty brig (userId u) "foo" !!! do + const 200 === statusCode + const (Just objectProp) === responseJsonMaybe + + execAndAssertUserDeletion brig cannon u (Handle hdl) [] aws $ \uid' -> do + deleteUserInternal uid' brig + !!! do + const 202 === statusCode + + getProperty brig (userId u) "foo" !!! do + const 404 === statusCode + where + objectProp = + object + [ "key.1" .= ("val1" :: Text), + "key.2" .= ("val2" :: Text) + ] + -- helpers setHandleAndDeleteUser :: Brig -> Cannon -> User -> [UserId] -> AWS.Env -> (UserId -> HttpT IO ()) -> Http () setHandleAndDeleteUser brig cannon u others aws execDelete = do let uid = userId u - quid = userQualifiedId u - email = fromMaybe (error "Must have an email set") (userEmail u) -- First set a unique handle (to verify freeing of the handle) hdl <- randomHandle let update = RequestBodyLBS . encode $ HandleUpdate hdl put (brig . path "/self/handle" . contentJson . zUser uid . zConn "c" . body update) !!! const 200 === statusCode + + execAndAssertUserDeletion brig cannon u (Handle hdl) others aws execDelete + +execAndAssertUserDeletion :: Brig -> Cannon -> User -> Handle -> [UserId] -> AWS.Env -> (UserId -> HttpT IO ()) -> Http () +execAndAssertUserDeletion brig cannon u hdl others aws execDelete = do + let uid = userId u + quid = userQualifiedId u + email = fromMaybe (error "Must have an email set") (userEmail u) + -- Delete the user WS.bracketRN cannon (uid : others) $ \wss -> do execDelete uid @@ -1667,7 +1741,7 @@ setHandleAndDeleteUser brig cannon u others aws execDelete = do forM_ others $ \usr -> do get (brig . paths ["users", toByteString' uid] . zUser usr) !!! assertDeletedProfilePublic Search.assertCan'tFind brig usr quid (fromName (userDisplayName u)) - Search.assertCan'tFind brig usr quid hdl + Search.assertCan'tFind brig usr quid (fromHandle hdl) -- Email address is available again let Object o = object @@ -1677,7 +1751,7 @@ setHandleAndDeleteUser brig cannon u others aws execDelete = do ] -- This will generate a new event, we need to consume it here usr <- postUserInternal o brig - liftIO $ Util.assertUserJournalQueue "user activate testDeleteInternal: " aws (userActivateJournaled usr) + liftIO $ Util.assertUserJournalQueue "user activate execAndAssertUserDeletion" aws (userActivateJournaled usr) -- Handle is available again Bilge.head (brig . paths ["users", "handles", toByteString' hdl] . zUser uid) !!! const 404 === statusCode diff --git a/services/brig/test/integration/API/User/Util.hs b/services/brig/test/integration/API/User/Util.hs index a2573fc269e..b54f1c30252 100644 --- a/services/brig/test/integration/API/User/Util.hs +++ b/services/brig/test/integration/API/User/Util.hs @@ -22,9 +22,9 @@ module API.User.Util where import Bilge hiding (accept, timeout) import Bilge.Assert import qualified Brig.Code as Code -import Brig.Options (Opts) import Brig.Effects.CodeStore import Brig.Effects.CodeStore.Cassandra +import Brig.Options (Opts) import Brig.Types.Team.LegalHold (LegalHoldClientRequest (..)) import qualified Brig.ZAuth import qualified Cassandra as DB diff --git a/services/galley/src/Galley/API/MLS/Message.hs b/services/galley/src/Galley/API/MLS/Message.hs index fc6edcfcf01..2ace16c5d34 100644 --- a/services/galley/src/Galley/API/MLS/Message.hs +++ b/services/galley/src/Galley/API/MLS/Message.hs @@ -534,8 +534,7 @@ applyProposal convId (AddProposal kp) = do Nothing -> do -- external add proposal for a new key package unknown to the backend lconvId <- qualifyLocal convId - ci <- addKeyPackageMapping lconvId ref (KeyPackageData (rmRaw kp)) - pure ci + addKeyPackageMapping lconvId ref (KeyPackageData (rmRaw kp)) Just ci -> -- ad-hoc add proposal in commit, the key package has been claimed before pure ci diff --git a/services/galley/src/Galley/Intra/User.hs b/services/galley/src/Galley/Intra/User.hs index 0a5ed99992d..90b24af2e56 100644 --- a/services/galley/src/Galley/Intra/User.hs +++ b/services/galley/src/Galley/Intra/User.hs @@ -205,7 +205,7 @@ getUsers = chunkify $ \uids -> do . expect2xx pure . fromMaybe [] . responseJsonMaybe $ resp --- | Calls 'Brig.API.deleteUserNoVerifyH'. +-- | Calls 'Brig.API.deleteUserNoAuthH'. deleteUser :: UserId -> App () deleteUser uid = do void $ diff --git a/services/spar/spar.cabal b/services/spar/spar.cabal index 9cb59ca37ee..655f2b34010 100644 --- a/services/spar/spar.cabal +++ b/services/spar/spar.cabal @@ -748,6 +748,7 @@ test-suite spec Test.Spar.DataSpec Test.Spar.Intra.BrigSpec Test.Spar.Roundtrip.ByteString + Test.Spar.Scim.UserSpec Test.Spar.ScimSpec Test.Spar.Sem.DefaultSsoCodeSpec Test.Spar.Sem.IdPRawMetadataStoreSpec diff --git a/services/spar/src/Spar/API.hs b/services/spar/src/Spar/API.hs index fefd72221f5..0a81b08c3a7 100644 --- a/services/spar/src/Spar/API.hs +++ b/services/spar/src/Spar/API.hs @@ -443,8 +443,8 @@ idpDelete mbzusr idpid (fromMaybe False -> purge) = withDebugLog "idpDelete" (co when (mUserTeam == Just team) $ do if purge then do - BrigAccess.delete uid SAMLUserStore.delete uid uref + void $ BrigAccess.deleteUser uid else do throwSparSem SparIdPHasBoundUsers when (Cas.hasMore page) $ diff --git a/services/spar/src/Spar/Intra/Brig.hs b/services/spar/src/Spar/Intra/Brig.hs index 5d23d79655c..2a2f088ef7c 100644 --- a/services/spar/src/Spar/Intra/Brig.hs +++ b/services/spar/src/Spar/Intra/Brig.hs @@ -29,7 +29,7 @@ module Spar.Intra.Brig setBrigUserRichInfo, setBrigUserLocale, checkHandleAvailable, - deleteBrigUser, + deleteBrigUserInternal, createBrigUserSAML, createBrigUserNoSAML, updateEmail, @@ -329,15 +329,19 @@ checkHandleAvailable hnd = do | otherwise -> rethrow "brig" resp --- | Call brig to delete a user -deleteBrigUser :: (HasCallStack, MonadSparToBrig m, MonadIO m) => UserId -> m () -deleteBrigUser buid = do - resp :: ResponseLBS <- +-- | Call brig to delete a user. +-- If the user wasn't deleted completely before, another deletion attempt will be made. +deleteBrigUserInternal :: (HasCallStack, MonadSparToBrig m, MonadIO m) => UserId -> m DeleteUserResult +deleteBrigUserInternal buid = do + resp <- call $ method DELETE . paths ["/i/users", toByteString' buid] - unless (statusCode resp == 202) $ - rethrow "brig" resp + case statusCode resp of + 200 -> pure AccountAlreadyDeleted + 202 -> pure AccountDeleted + 404 -> pure NoUser + _ -> rethrow "brig" resp -- | Verify user's password (needed for certain powerful operations). ensureReAuthorised :: diff --git a/services/spar/src/Spar/Scim/User.hs b/services/spar/src/Spar/Scim/User.hs index 637f28ac993..4b9c97b7acc 100644 --- a/services/spar/src/Spar/Scim/User.hs +++ b/services/spar/src/Spar/Scim/User.hs @@ -38,10 +38,12 @@ module Spar.Scim.User toScimStoredUser', mkValidExternalId, scimFindUserByEmail, + deleteScimUser, ) where import Brig.Types.Intra (AccountStatus, UserAccount (accountStatus, accountUser)) +import Brig.Types.User (HavePendingInvitations (..)) import qualified Control.Applicative as Applicative (empty) import Control.Lens (view, (^.)) import Control.Monad.Error.Class (MonadError) @@ -698,11 +700,20 @@ deleteScimUser tokeninfo@ScimTokenInfo {stiTeam, stiIdP} uid = ) (const id) $ do - mbBrigUser <- lift (Brig.getBrigUser Brig.WithPendingInvitations uid) - case mbBrigUser of + -- `getBrigUser` does not include deleted users. This is fine: these + -- ("tombstones") would not have the needed values (`userIdentity = + -- Nothing`) to delete a user in spar. I.e. `SAML.UserRef` and `Email` + -- cannot be figured out when a `User` has status `Deleted`. + mbBrigUser <- lift $ Brig.getBrigUser WithPendingInvitations uid + deletionStatus <- case mbBrigUser of Nothing -> - -- double-deletion gets you a 404. - throwError $ Scim.notFound "user" (idToText uid) + -- Ensure there's no left-over of this user in brig. This is safe + -- because the user has either been deleted (tombstone) or does not + -- exist. Asserting the correct team id here is not needed (and would + -- be hard as the check relies on the data of `mbBrigUser`): The worst + -- thing that could happen is that foreign users cleanup particially + -- deleted users. + lift $ BrigAccess.deleteUser uid Just brigUser -> do -- FUTUREWORK: currently it's impossible to delete the last available team owner via SCIM -- (because that owner won't be managed by SCIM in the first place), but if it ever becomes @@ -712,21 +723,47 @@ deleteScimUser tokeninfo@ScimTokenInfo {stiTeam, stiIdP} uid = throwError $ Scim.notFound "user" (idToText uid) - mIdpConfig <- mapM (lift . IdPConfigStore.getConfig) stiIdP - - case Brig.veidFromBrigUser brigUser ((^. SAML.idpMetadata . SAML.edIssuer) <$> mIdpConfig) of - Left _ -> pure () - Right veid -> - lift $ - ST.runValidExternalIdBoth - (>>) - (SAMLUserStore.delete uid) - (ScimExternalIdStore.delete stiTeam) - veid - - lift $ ScimUserTimesStore.delete uid - lift $ BrigAccess.delete uid + -- This deletion needs data from the non-deleted User in brig. So, + -- execute it first, then delete the user in brig. Unfortunately, this + -- dependency prevents us from cleaning up the spar fragments of users + -- that have been deleted in brig. Deleting scim-managed users in brig + -- (via the TM app) is blocked, though, so there is no legal way to enter + -- that situation. + deleteUserInSpar brigUser + lift $ BrigAccess.deleteUser uid + case deletionStatus of + NoUser -> + throwError $ + Scim.notFound "user" (idToText uid) + AccountAlreadyDeleted -> + throwError $ + Scim.notFound "user" (idToText uid) + AccountDeleted -> pure () + where + deleteUserInSpar :: + Members + '[ IdPConfigStore, + SAMLUserStore, + ScimExternalIdStore, + ScimUserTimesStore + ] + r => + User -> + Scim.ScimHandler (Sem r) () + deleteUserInSpar brigUser = do + mIdpConfig <- mapM (lift . IdPConfigStore.getConfig) stiIdP + + case Brig.veidFromBrigUser brigUser ((^. SAML.idpMetadata . SAML.edIssuer) <$> mIdpConfig) of + Left _ -> pure () + Right veid -> + lift $ + ST.runValidExternalIdBoth + (>>) + (SAMLUserStore.delete uid) + (ScimExternalIdStore.delete stiTeam) + veid + lift $ ScimUserTimesStore.delete uid ---------------------------------------------------------------------------- -- Utilities diff --git a/services/spar/src/Spar/Sem/BrigAccess.hs b/services/spar/src/Spar/Sem/BrigAccess.hs index b756f4f2625..0e35976d5a6 100644 --- a/services/spar/src/Spar/Sem/BrigAccess.hs +++ b/services/spar/src/Spar/Sem/BrigAccess.hs @@ -33,7 +33,7 @@ module Spar.Sem.BrigAccess setLocale, getRichInfo, checkHandleAvailable, - delete, + deleteUser, ensureReAuthorised, ssoLogin, getStatus, @@ -53,7 +53,7 @@ import Imports import Polysemy import qualified SAML2.WebSSO as SAML import Web.Cookie -import Wire.API.User (VerificationAction) +import Wire.API.User (DeleteUserResult, VerificationAction) import Wire.API.User.Identity import Wire.API.User.Profile import Wire.API.User.RichInfo as RichInfo @@ -74,7 +74,7 @@ data BrigAccess m a where SetLocale :: UserId -> Maybe Locale -> BrigAccess m () GetRichInfo :: UserId -> BrigAccess m RichInfo CheckHandleAvailable :: Handle -> BrigAccess m Bool - Delete :: UserId -> BrigAccess m () + DeleteUser :: UserId -> BrigAccess m DeleteUserResult EnsureReAuthorised :: Maybe UserId -> Maybe PlainTextPassword -> Maybe Code.Value -> Maybe VerificationAction -> BrigAccess m () SsoLogin :: UserId -> BrigAccess m SetCookie GetStatus :: UserId -> BrigAccess m AccountStatus diff --git a/services/spar/src/Spar/Sem/BrigAccess/Http.hs b/services/spar/src/Spar/Sem/BrigAccess/Http.hs index 122bdc3496b..cbcafe8ad38 100644 --- a/services/spar/src/Spar/Sem/BrigAccess/Http.hs +++ b/services/spar/src/Spar/Sem/BrigAccess/Http.hs @@ -54,7 +54,7 @@ brigAccessToHttp mgr req = SetLocale itlu l -> Intra.setBrigUserLocale itlu l GetRichInfo itlu -> Intra.getBrigUserRichInfo itlu CheckHandleAvailable h -> Intra.checkHandleAvailable h - Delete itlu -> Intra.deleteBrigUser itlu + DeleteUser itlu -> Intra.deleteBrigUserInternal itlu EnsureReAuthorised mitlu mp mc ma -> Intra.ensureReAuthorised mitlu mp mc ma SsoLogin itlu -> Intra.ssoLogin itlu GetStatus itlu -> Intra.getStatus itlu diff --git a/services/spar/src/Spar/Sem/SAMLUserStore/Mem.hs b/services/spar/src/Spar/Sem/SAMLUserStore/Mem.hs index 8e66f0e732e..131ae266814 100644 --- a/services/spar/src/Spar/Sem/SAMLUserStore/Mem.hs +++ b/services/spar/src/Spar/Sem/SAMLUserStore/Mem.hs @@ -19,6 +19,7 @@ module Spar.Sem.SAMLUserStore.Mem ( samlUserStoreToMem, + UserRefOrd, ) where @@ -33,7 +34,7 @@ import qualified SAML2.WebSSO as SAML import Spar.Sem.SAMLUserStore newtype UserRefOrd = UserRefOrd {unUserRefOrd :: SAML.UserRef} - deriving (Eq) + deriving (Eq, Show) instance Ord UserRefOrd where compare (UserRefOrd (SAML.UserRef is ni)) (UserRefOrd (SAML.UserRef is' ni')) = diff --git a/services/spar/test-integration/Test/Spar/Intra/BrigSpec.hs b/services/spar/test-integration/Test/Spar/Intra/BrigSpec.hs index b400a32e926..822a4ee99bf 100644 --- a/services/spar/test-integration/Test/Spar/Intra/BrigSpec.hs +++ b/services/spar/test-integration/Test/Spar/Intra/BrigSpec.hs @@ -21,13 +21,15 @@ module Test.Spar.Intra.BrigSpec where import Control.Lens ((^.)) -import Data.Id (Id (Id)) +import Data.Id (Id (Id), UserId) import qualified Data.UUID as UUID import Imports hiding (head) import qualified Spar.Intra.BrigApp as Intra +import qualified Spar.Sem.BrigAccess as BrigAccess +import Test.QuickCheck import Util import qualified Web.Scim.Schema.User as Scim.User -import Wire.API.User (fromEmail) +import Wire.API.User (DeleteUserResult (..), fromEmail) spec :: SpecWith TestEnv spec = do @@ -37,6 +39,12 @@ spec = do it "if a user gets deleted on spar, it will be deleted on brig as well." $ do pendingWith "or deactivated? we should decide what we want here." + describe "deleteBrigUserInternal" $ do + it "does not throw for non-existing users" $ do + uid :: UserId <- liftIO $ generate arbitrary + r <- runSpar $ BrigAccess.deleteUser uid + liftIO $ r `shouldBe` NoUser + describe "getBrigUser" $ do it "return Nothing if n/a" $ do musr <- runSpar $ Intra.getBrigUser Intra.WithPendingInvitations (Id . fromJust $ UUID.fromText "29546d9e-ed5b-11ea-8228-c324b1ea1030") diff --git a/services/spar/test-integration/Util/Scim.hs b/services/spar/test-integration/Util/Scim.hs index 93a2eaa33bf..08f72bb750b 100644 --- a/services/spar/test-integration/Util/Scim.hs +++ b/services/spar/test-integration/Util/Scim.hs @@ -409,7 +409,7 @@ patchUser_ auth muid patchop spar_ = . acceptScim ) --- | Update a user. +-- | Delete a user. deleteUser_ :: -- | Authentication Maybe ScimToken -> diff --git a/services/spar/test/Test/Spar/Scim/UserSpec.hs b/services/spar/test/Test/Spar/Scim/UserSpec.hs new file mode 100644 index 00000000000..93918199e5d --- /dev/null +++ b/services/spar/test/Test/Spar/Scim/UserSpec.hs @@ -0,0 +1,189 @@ +module Test.Spar.Scim.UserSpec where + +import Arbitrary () +import Brig.Types.Intra +import Brig.Types.User +import Control.Monad.Except (runExceptT) +import Data.Handle (parseHandle) +import Data.Id +import qualified Data.Json.Util +import Imports +import Polysemy +import Polysemy.TinyLog +import Spar.Scim.User (deleteScimUser) +import Spar.Sem.BrigAccess +import Spar.Sem.IdPConfigStore +import Spar.Sem.IdPConfigStore.Mem (TypedState, idPToMem) +import Spar.Sem.SAMLUserStore +import Spar.Sem.SAMLUserStore.Mem (UserRefOrd, samlUserStoreToMem) +import qualified Spar.Sem.ScimExternalIdStore as ScimExternalIdStore +import Spar.Sem.ScimExternalIdStore.Mem (scimExternalIdStoreToMem) +import Spar.Sem.ScimUserTimesStore +import Spar.Sem.ScimUserTimesStore.Mem (scimUserTimesStoreToMem) +import System.Logger (Msg) +import Test.Hspec +import Test.QuickCheck +import Web.Scim.Schema.Error +import Wire.API.User +import qualified Wire.API.User.Identity +import Wire.API.User.Scim +import Wire.Sem.Logger.TinyLog (discardTinyLogs) + +spec :: Spec +spec = describe "deleteScimUser" $ do + it "returns no error when the account was deleted for the first time (or partially)" $ do + tokenInfo <- generate arbitrary + acc <- someActiveUser tokenInfo + r <- + interpretWithBrigAccessMock + (mockBrigForActiveUser acc AccountDeleted) + (deleteUserAndAssertDeletionInSpar acc tokenInfo) + handlerResult r `shouldBe` Right () + it "returns an error when the account was deleted before" $ do + tokenInfo <- generate arbitrary + acc <- someActiveUser tokenInfo + r <- + interpretWithBrigAccessMock + (mockBrigForActiveUser acc AccountAlreadyDeleted) + (deleteUserAndAssertDeletionInSpar acc tokenInfo) + handlerResult r `shouldBe` Left (notFound "user" ((idToText . userId . accountUser) acc)) + it "returns an error when there never was an account" $ do + uid <- generate arbitrary + tokenInfo <- generate arbitrary + r <- + interpretWithBrigAccessMock + mockBrigForNonExistendUser + (runExceptT $ deleteScimUser tokenInfo uid) + handlerResult r `shouldBe` Left (notFound "user" (idToText uid)) + it "returns no error when there was a partially deleted account" $ do + uid <- generate arbitrary + tokenInfo <- generate arbitrary + r <- + interpretWithBrigAccessMock + mockBrigForPartiallyDeletedUser + (runExceptT $ deleteScimUser tokenInfo uid) + handlerResult r `shouldBe` Right () + +deleteUserAndAssertDeletionInSpar :: + forall (r :: EffectRow). + Members + '[ Logger (Msg -> Msg), + BrigAccess, + ScimExternalIdStore.ScimExternalIdStore, + ScimUserTimesStore, + SAMLUserStore, + IdPConfigStore, + Embed IO + ] + r => + UserAccount -> + ScimTokenInfo -> + Sem r (Either ScimError ()) +deleteUserAndAssertDeletionInSpar acc tokenInfo = do + let tid = stiTeam tokenInfo + email = (fromJust . emailIdentity . fromJust . userIdentity . accountUser) acc + uid = (userId . accountUser) acc + ScimExternalIdStore.insert tid email uid + r <- runExceptT $ deleteScimUser tokenInfo uid + lr <- ScimExternalIdStore.lookup tid email + liftIO $ lr `shouldBe` Nothing + pure r + +type EffsWithoutBrigAccess = + '[ IdPConfigStore, + SAMLUserStore, + ScimUserTimesStore, + ScimExternalIdStore.ScimExternalIdStore, + Logger (Msg -> Msg), + Embed IO, + Final IO + ] + +type Effs = BrigAccess ': EffsWithoutBrigAccess + +type InterpreterState = + ( Map (Data.Id.TeamId, Wire.API.User.Identity.Email) Data.Id.UserId, + ( Map Data.Id.UserId (Data.Json.Util.UTCTimeMillis, Data.Json.Util.UTCTimeMillis), + ( Map UserRefOrd UserId, + (Spar.Sem.IdPConfigStore.Mem.TypedState, Either ScimError ()) + ) + ) + ) + +handlerResult :: InterpreterState -> Either ScimError () +handlerResult = snd . snd . snd . snd + +interpretWithBrigAccessMock :: + ( Sem Effs (Either ScimError ()) -> + Sem EffsWithoutBrigAccess (Either ScimError ()) + ) -> + Sem Effs (Either ScimError ()) -> + IO InterpreterState +interpretWithBrigAccessMock mock = + runFinal + . embedToFinal @IO + . discardTinyLogs + . scimExternalIdStoreToMem + . scimUserTimesStoreToMem + . samlUserStoreToMem + . idPToMem + . mock + +mockBrigForNonExistendUser :: + forall (r :: EffectRow). + Members '[Embed IO] r => + Sem (BrigAccess ': r) (Either ScimError ()) -> + Sem r (Either ScimError ()) +mockBrigForNonExistendUser = interpret $ \case + (GetAccount WithPendingInvitations _) -> pure Nothing + (Spar.Sem.BrigAccess.DeleteUser _) -> pure NoUser + _ -> do + liftIO $ expectationFailure $ "Unexpected effect (call to brig)" + error "Throw error here to avoid implementation of all cases." + +mockBrigForPartiallyDeletedUser :: + forall (r :: EffectRow). + Members '[Embed IO] r => + Sem (BrigAccess ': r) (Either ScimError ()) -> + Sem r (Either ScimError ()) +mockBrigForPartiallyDeletedUser = interpret $ \case + (GetAccount WithPendingInvitations _) -> pure Nothing + (Spar.Sem.BrigAccess.DeleteUser _) -> pure AccountDeleted + _ -> do + liftIO $ expectationFailure $ "Unexpected effect (call to brig)" + error "Throw error here to avoid implementation of all cases." + +mockBrigForActiveUser :: + forall (r :: EffectRow). + Members '[Embed IO] r => + UserAccount -> + DeleteUserResult -> + Sem (BrigAccess ': r) (Either ScimError ()) -> + Sem r (Either ScimError ()) +mockBrigForActiveUser acc deletionResult = interpret $ \case + (GetAccount WithPendingInvitations uid) -> + if uid == (userId . accountUser) acc + then pure $ Just acc + else pure Nothing + (Spar.Sem.BrigAccess.DeleteUser _) -> pure deletionResult + _ -> do + liftIO $ expectationFailure $ "Unexpected effect (call to brig)" + error "Throw error here to avoid implementation of all cases." + +someActiveUser :: ScimTokenInfo -> IO UserAccount +someActiveUser tokenInfo = do + user <- generate arbitrary + pure $ + UserAccount + { accountStatus = Active, + accountUser = + user + { userDisplayName = Name "Some User", + userAccentId = defaultAccentId, + userPict = noPict, + userAssets = [], + userHandle = parseHandle "some-handle", + userIdentity = (Just . EmailIdentity . fromJust . parseEmail) "someone@wire.com", + userTeam = Just $ stiTeam tokenInfo + } + } From 1826a765056600aa33b77a936928b0a05007c41e Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Thu, 8 Sep 2022 10:39:38 +0200 Subject: [PATCH 14/58] removed/replaced todo comments (#2679) --- libs/wire-api/src/Wire/API/Routes/Public/Spar.hs | 6 ++++-- services/spar/src/Spar/Sem/IdPConfigStore/Mem.hs | 4 +++- 2 files changed, 7 insertions(+), 3 deletions(-) diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Spar.hs b/libs/wire-api/src/Wire/API/Routes/Public/Spar.hs index 2ad6cb25ae1..26bd5205d01 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Spar.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Spar.hs @@ -107,13 +107,15 @@ type IdpCreate = ReqBodyCustomError '[RawXML, JSON] "wai-error" IdPMetadataInfo :> QueryParam' '[Optional, Strict] "replaces" SAML.IdPId :> QueryParam' '[Optional, Strict] "api_version" WireIdPAPIVersion - :> QueryParam' '[Optional, Strict] "handle" (Range 1 32 Text) -- todo(leif): check length limitation + -- FUTUREWORK: The handle is restricted to 32 characters. Can we find a more reasonable upper bound and create a type for it? Also see `IdpUpdate`. + :> QueryParam' '[Optional, Strict] "handle" (Range 1 32 Text) :> PostCreated '[JSON] IdP type IdpUpdate = ReqBodyCustomError '[RawXML, JSON] "wai-error" IdPMetadataInfo :> Capture "id" SAML.IdPId - :> QueryParam' '[Optional, Strict] "handle" (Range 1 32 Text) -- todo(leif): check length limitation + -- FUTUREWORK: The handle is restricted to 32 characters. Can we find a more reasonable upper bound and create a type for it? Also see `IdpCreate`. + :> QueryParam' '[Optional, Strict] "handle" (Range 1 32 Text) :> Put '[JSON] IdP type IdpDelete = diff --git a/services/spar/src/Spar/Sem/IdPConfigStore/Mem.hs b/services/spar/src/Spar/Sem/IdPConfigStore/Mem.hs index da125f84f43..2c3a5ad0b02 100644 --- a/services/spar/src/Spar/Sem/IdPConfigStore/Mem.hs +++ b/services/spar/src/Spar/Sem/IdPConfigStore/Mem.hs @@ -46,7 +46,9 @@ idPToMem = evState . evEff evEff = reinterpret @_ @(State TypedState) $ \case InsertConfig iw -> modify' (insertConfig iw) - NewHandle _tid -> pure $ IdPHandle "IdP 1" --todo(leif): generate a new handle + NewHandle _tid -> + -- Same handle for all IdPs is good enough, for now + pure $ IdPHandle "IdP 1" GetConfig i -> gets (getConfig i) GetIdPByIssuerV1Maybe issuer -> From cacd00b2bcf873333827a13ac4d1454316aee526 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Vedran=20Ivankovi=C4=87?= <33936733+Veki301@users.noreply.github.com> Date: Thu, 8 Sep 2022 11:52:32 +0200 Subject: [PATCH 15/58] SER-191: update release notes --- docs/src/release-notes.rst | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/docs/src/release-notes.rst b/docs/src/release-notes.rst index df1f346eabe..497af3cca32 100644 --- a/docs/src/release-notes.rst +++ b/docs/src/release-notes.rst @@ -7,5 +7,8 @@ This page previously contained the release notes for the project, and they were However, Github since updated the feature, making this page un-necessary. -You can find the list of releases, including full release notes, at the following link: `Release Notes `_ +Go to → `GitHub - wireapp/wire-server: Wire back-end services `_ +→ Look at releases on right hand side. They are shown by date of release. `Release Notes `_ + +→ Open the CHANGELOG.md. This will give you chart version. \ No newline at end of file From 8abc5b0f17fe6ff0b7a11956e7b9fb71ef2f02fc Mon Sep 17 00:00:00 2001 From: Stefan Matting Date: Thu, 8 Sep 2022 15:21:34 +0200 Subject: [PATCH 16/58] Update documentation for legalhold whitlisted implicit consent (#2681) --- docs/src/developer/reference/team/legalhold.md | 18 +++++++++++------- 1 file changed, 11 insertions(+), 7 deletions(-) diff --git a/docs/src/developer/reference/team/legalhold.md b/docs/src/developer/reference/team/legalhold.md index b1cee83b9bc..081796610e4 100644 --- a/docs/src/developer/reference/team/legalhold.md +++ b/docs/src/developer/reference/team/legalhold.md @@ -137,23 +137,27 @@ blocked from using wire by their team admin (if they are a team user), but they cannot be assigned a LH device, and they cannot enter conversations with LH devices present. -For now, there is on way in the UI for the user to grant consent. -Instead, "implict consent" can be given by the site operator for any -team in the server configuration file `galley.yaml`: +For now, there isn't any UI for the user to grant their initial consent. +Instead, an "implict consent" can be given by the site operator by setting ```yaml featureFlags: # [...] legalhold: whitelist-teams-and-implicit-consent - legalHoldTeamsWhitelist: - - 14172c08-b3c8-11eb-a763-6fe8c2ea993d - - 162d7894-b3c8-11eb-b137-074ff453399d ``` +in galley's config and then using non-exposed, internal endpoints on the galley +pod to update the set of teams whose users are considered to have given their +initial consent: + +- `put /i/legalhold/whitelisted-teams/:team-id` - Add team +- `delete /i/legalhold/whitelisted-teams/:team-id` - Remove team +- `get /i/legalhold/whitelisted-teams` - List all teams + Since consent is required for LH to work, users in teams that are not whitelisted cannot be assigned LH devices (pull request #1502), and they are blocked or removed from conversations that are exposed to LH -devices (TODO: name the PRs where this happens). +devices (#1507, #1595). ### Implementation status and future work From 66e0a986f3baea0d1d055447ca6a89c765189ab6 Mon Sep 17 00:00:00 2001 From: Stefan Berthold Date: Thu, 8 Sep 2022 17:56:36 +0200 Subject: [PATCH 17/58] Make client deletion asynchronous (#2669) Co-authored-by: Stefan Matting --- changelog.d/5-internal/FS-905-async | 1 + services/brig/src/Brig/API/Client.hs | 14 +++++++------ services/brig/src/Brig/IO/Intra.hs | 11 ++++++++-- .../brig/src/Brig/InternalEvent/Process.hs | 10 ++++++++++ services/brig/src/Brig/InternalEvent/Types.hs | 16 +++++++++++++-- .../brig/test/integration/API/User/Client.hs | 17 +++++++++++----- services/galley/test/integration/API.hs | 3 +++ services/galley/test/integration/API/MLS.hs | 18 ++++++++++++++--- services/galley/test/integration/API/Teams.hs | 3 +++ .../test/integration/API/Teams/LegalHold.hs | 20 ++++++++++++++----- services/galley/test/integration/API/Util.hs | 12 +++++++++++ 11 files changed, 102 insertions(+), 23 deletions(-) create mode 100644 changelog.d/5-internal/FS-905-async diff --git a/changelog.d/5-internal/FS-905-async b/changelog.d/5-internal/FS-905-async new file mode 100644 index 00000000000..6abf8850d64 --- /dev/null +++ b/changelog.d/5-internal/FS-905-async @@ -0,0 +1 @@ +Make client deletion asynchronous diff --git a/services/brig/src/Brig/API/Client.hs b/services/brig/src/Brig/API/Client.hs index 691bc360600..a705eda0ae8 100644 --- a/services/brig/src/Brig/API/Client.hs +++ b/services/brig/src/Brig/API/Client.hs @@ -56,7 +56,9 @@ import Brig.Federation.Client (getUserClients) import qualified Brig.Federation.Client as Federation import Brig.IO.Intra (guardLegalhold) import qualified Brig.IO.Intra as Intra +import qualified Brig.InternalEvent.Types as Internal import qualified Brig.Options as Opt +import qualified Brig.Queue as Queue import Brig.Types.Intra import Brig.Types.Team.LegalHold (LegalHoldClientRequest (..)) import Brig.Types.User.Event @@ -166,8 +168,9 @@ addClientWithReAuthPolicy policy u con ip new = do let usr = accountUser acc lift $ do for_ old $ execDelete u con - wrapHttp $ Intra.newClient u (clientId clt) - Intra.onClientEvent u con (ClientAdded u clt) + wrapHttp $ do + Intra.newClient u (clientId clt) + Intra.onClientEvent u con (ClientAdded u clt) when (clientType clt == LegalHoldClientType) $ wrapHttpClient $ Intra.onUserEvent u con (UserLegalHoldEnabled u) when (count > 1) $ for_ (userEmail usr) $ @@ -373,13 +376,12 @@ claimLocalMultiPrekeyBundles protectee userClients = do -- Utilities --- | Perform an orderly deletion of an existing client. +-- | Enqueue an orderly deletion of an existing client. execDelete :: UserId -> Maybe ConnId -> Client -> (AppT r) () execDelete u con c = do - wrapHttp $ Intra.rmClient u (clientId c) for_ (clientCookie c) $ \l -> wrapClient $ Auth.revokeCookies u [] [l] - Intra.onClientEvent u con (ClientRemoved u c) - wrapClient $ Data.rmClient u (clientId c) + queue <- view internalEvents + Queue.enqueue queue (Internal.DeleteClient (clientId c) u con) -- | Defensive measure when no prekey is found for a -- requested client: Ensure that the client does indeed diff --git a/services/brig/src/Brig/IO/Intra.hs b/services/brig/src/Brig/IO/Intra.hs index c22c8a178ae..51695d0a0fc 100644 --- a/services/brig/src/Brig/IO/Intra.hs +++ b/services/brig/src/Brig/IO/Intra.hs @@ -195,20 +195,27 @@ onPropertyEvent orig conn e = (pure $ list1 orig []) onClientEvent :: + ( MonadIO m, + Log.MonadLogger m, + MonadReader Env m, + MonadMask m, + MonadHttp m, + HasRequestId m + ) => -- | Originator of the event. UserId -> -- | Client connection ID. Maybe ConnId -> -- | The event. ClientEvent -> - (AppT r) () + m () onClientEvent orig conn e = do let events = singleton (ClientEvent e) let rcps = list1 orig [] -- Synchronous push for better delivery guarantees of these -- events and to make sure new clients have a first notification -- in the stream. - wrapHttp $ push events rcps orig Push.RouteAny conn + push events rcps orig Push.RouteAny conn updateSearchIndex :: ( MonadClient m, diff --git a/services/brig/src/Brig/InternalEvent/Process.hs b/services/brig/src/Brig/InternalEvent/Process.hs index abfd920e89e..abd6a3902b5 100644 --- a/services/brig/src/Brig/InternalEvent/Process.hs +++ b/services/brig/src/Brig/InternalEvent/Process.hs @@ -24,9 +24,13 @@ import Bilge.IO (MonadHttp) import Bilge.RPC (HasRequestId) import qualified Brig.API.User as API import Brig.App +import qualified Brig.Data.Client as Data +import Brig.IO.Intra (rmClient) +import qualified Brig.IO.Intra as Intra import Brig.InternalEvent.Types import Brig.Options (defDeleteThrottleMillis, setDeleteThrottleMillis) import qualified Brig.Provider.API as API +import Brig.Types.User.Event import Brig.User.Search.Index (MonadIndexIO) import Cassandra (MonadClient) import Control.Lens (view) @@ -54,6 +58,12 @@ onEvent :: InternalNotification -> m () onEvent n = handleTimeout $ case n of + DeleteClient cid uid mcon -> do + mc <- Data.lookupClient uid cid + for_ mc $ \c -> do + rmClient uid cid + Data.rmClient uid cid + Intra.onClientEvent uid mcon (ClientRemoved uid c) DeleteUser uid -> do Log.info $ msg (val "Processing user delete event") diff --git a/services/brig/src/Brig/InternalEvent/Types.hs b/services/brig/src/Brig/InternalEvent/Types.hs index c9ac85e3ac9..fdb52fdf5bc 100644 --- a/services/brig/src/Brig/InternalEvent/Types.hs +++ b/services/brig/src/Brig/InternalEvent/Types.hs @@ -25,22 +25,26 @@ import Data.Aeson import Data.Id data InternalNotification - = DeleteUser !UserId + = DeleteClient !ClientId !UserId !(Maybe ConnId) + | DeleteUser !UserId | DeleteService !ProviderId !ServiceId deriving (Eq, Show) data InternalNotificationType - = UserDeletion + = ClientDeletion + | UserDeletion | ServiceDeletion deriving (Eq, Show) instance FromJSON InternalNotificationType where parseJSON = \case + "client.delete" -> pure ClientDeletion "user.delete" -> pure UserDeletion "service.delete" -> pure ServiceDeletion x -> fail $ "InternalNotificationType: Unknown type " <> show x instance ToJSON InternalNotificationType where + toJSON ClientDeletion = "client.delete" toJSON UserDeletion = "user.delete" toJSON ServiceDeletion = "service.delete" @@ -48,10 +52,18 @@ instance FromJSON InternalNotification where parseJSON = withObject "InternalNotification" $ \o -> do t <- o .: "type" case (t :: InternalNotificationType) of + ClientDeletion -> DeleteClient <$> o .: "client" <*> o .: "user" <*> o .: "connection" UserDeletion -> DeleteUser <$> o .: "user" ServiceDeletion -> DeleteService <$> o .: "provider" <*> o .: "service" instance ToJSON InternalNotification where + toJSON (DeleteClient cid uid con) = + object + [ "client" .= cid, + "user" .= uid, + "connection" .= con, + "type" .= ClientDeletion + ] toJSON (DeleteUser uid) = object [ "user" .= uid, diff --git a/services/brig/test/integration/API/User/Client.hs b/services/brig/test/integration/API/User/Client.hs index 239de959d72..ef2abc5109b 100644 --- a/services/brig/test/integration/API/User/Client.hs +++ b/services/brig/test/integration/API/User/Client.hs @@ -105,7 +105,7 @@ tests _cl _at opts p db b c g = test p "put /clients/:client - 200 (mls keys)" $ testMLSPublicKeyUpdate b, test p "get /clients/:client - 404" $ testMissingClient b, test p "get /clients/:client - 200" $ testMLSClient b, - test p "post /clients - 200 multiple temporary" $ testAddMultipleTemporary b g, + test p "post /clients - 200 multiple temporary" $ testAddMultipleTemporary b g c, test p "client/prekeys/race" $ testPreKeyRace b, test p "get/head nonce/clients" $ testNewNonce b ] @@ -892,15 +892,15 @@ testMissingClient brig = do -- brig) have registered it. Add second temporary client, check -- again. (NB: temp clients replace each other, there can always be -- at most one per account.) -testAddMultipleTemporary :: Brig -> Galley -> Http () -testAddMultipleTemporary brig galley = do +testAddMultipleTemporary :: Brig -> Galley -> Cannon -> Http () +testAddMultipleTemporary brig galley cannon = do uid <- userId <$> randomUser brig let clt1 = (defNewClient TemporaryClientType [somePrekeys !! 0] (someLastPrekeys !! 0)) { newClientClass = Just PhoneClient, newClientModel = Just "featurephone1" } - _ <- addClient brig uid clt1 + client <- responseJsonError =<< addClient brig uid clt1 brigClients1 <- numOfBrigClients uid galleyClients1 <- numOfGalleyClients uid liftIO $ assertEqual "Too many clients found" (Just 1) brigClients1 @@ -910,7 +910,14 @@ testAddMultipleTemporary brig galley = do { newClientClass = Just PhoneClient, newClientModel = Just "featurephone2" } - _ <- addClient brig uid clt2 + WS.bracketR cannon uid $ \ws -> do + _ <- addClient brig uid clt2 + void . liftIO . WS.assertMatch (5 # Second) ws $ \n -> do + let j = Object $ List1.head (ntfPayload n) + let etype = j ^? key "type" . _String + let eclient = j ^? key "client" . key "id" . _String + etype @?= Just "user.client-remove" + fmap ClientId eclient @?= Just (clientId client) brigClients2 <- numOfBrigClients uid galleyClients2 <- numOfGalleyClients uid liftIO $ assertEqual "Too many clients found" (Just 1) brigClients2 diff --git a/services/galley/test/integration/API.hs b/services/galley/test/integration/API.hs index b6fc4c9aa14..7bccfdaefa3 100644 --- a/services/galley/test/integration/API.hs +++ b/services/galley/test/integration/API.hs @@ -388,6 +388,9 @@ postCryptoMessageVerifyMsgSentAndRejectIfMissingClient = do -- Deleted eve WS.bracketR2 c bob eve $ \(wsB, wsE) -> do deleteClient eve ec (Just defPassword) !!! const 200 === statusCode + liftIO $ + WS.assertMatch_ (5 # WS.Second) wsE $ + wsAssertClientRemoved ec let m4 = [(bob, bc, toBase64Text "ciphertext4"), (eve, ec, toBase64Text "ciphertext4")] postOtrMessage id alice ac conv m4 !!! do const 201 === statusCode diff --git a/services/galley/test/integration/API/MLS.hs b/services/galley/test/integration/API/MLS.hs index b40d09cdefd..ab37b621f48 100644 --- a/services/galley/test/integration/API/MLS.hs +++ b/services/galley/test/integration/API/MLS.hs @@ -851,9 +851,21 @@ testRemoveDeletedClient deleteClientBefore = withSystemTempDirectory "mls" $ \tm let (_bobClient1, bobClient2) = assertTwo (toList (pClients bob)) - when deleteClientBefore $ - deleteClient (qUnqualified (pUserId bob)) (snd bobClient2) (Just defPassword) - !!! statusCode === const 200 + when deleteClientBefore $ do + cannon <- view tsCannon + WS.bracketR + cannon + (qUnqualified . pUserId $ bob) + $ \ws -> do + deleteClient (qUnqualified (pUserId bob)) (snd bobClient2) (Just defPassword) + !!! statusCode + === const + 200 + -- check that the corresponding event is received + + liftIO $ + WS.assertMatch_ (5 # WS.Second) ws $ + wsAssertClientRemoved (snd bobClient2) void . liftIO $ spawn diff --git a/services/galley/test/integration/API/Teams.hs b/services/galley/test/integration/API/Teams.hs index 489e3c3cab8..0d25f0b8cb1 100644 --- a/services/galley/test/integration/API/Teams.hs +++ b/services/galley/test/integration/API/Teams.hs @@ -1910,6 +1910,9 @@ postCryptoBroadcastMessage2 bcast = do -- Deleted charlie WS.bracketR2 c bob charlie $ \(wsB, wsE) -> do deleteClient charlie cc (Just defPassword) !!! const 200 === statusCode + liftIO $ + WS.assertMatch_ (5 # WS.Second) wsE $ + wsAssertClientRemoved cc let m4 = [(bob, bc, toBase64Text "ciphertext4"), (charlie, cc, toBase64Text "ciphertext4")] Util.postBroadcast (q alice) ac bcast {bMessage = m4} !!! do const 201 === statusCode diff --git a/services/galley/test/integration/API/Teams/LegalHold.hs b/services/galley/test/integration/API/Teams/LegalHold.hs index 63ec84cfe7d..115b547161d 100644 --- a/services/galley/test/integration/API/Teams/LegalHold.hs +++ b/services/galley/test/integration/API/Teams/LegalHold.hs @@ -36,7 +36,7 @@ import qualified Control.Concurrent.Async as Async import Control.Concurrent.Chan import Control.Concurrent.Timeout hiding (threadDelay) import Control.Exception (asyncExceptionFromException) -import Control.Lens +import Control.Lens hiding ((#)) import Control.Monad.Catch import Control.Retry (RetryPolicy, RetryStatus, exponentialBackoff, limitRetries, retrying) import qualified Data.Aeson as Aeson @@ -59,6 +59,7 @@ import qualified Data.Set as Set import Data.String.Conversions (LBS, cs) import Data.Text.Encoding (encodeUtf8) import qualified Data.Time.Clock as Time +import Data.Timeout import Galley.Cassandra.Client import Galley.Cassandra.LegalHold import qualified Galley.Cassandra.LegalHold as LegalHoldData @@ -149,10 +150,13 @@ testsPublic s = "teams listed" [ test s "happy flow" testInWhitelist, test s "handshake between LH device and user with old clients is blocked" testOldClientsBlockDeviceHandshake, - testGroup "no-consent" $ - flip fmap [(a, b, c, d) | a <- [minBound ..], b <- [minBound ..], c <- [minBound ..], d <- [minBound ..]] $ - \args@(a, b, c, d) -> - test s (show args) $ testNoConsentBlockOne2OneConv a b c d, + testGroup "no-consent" $ do + connectFirst <- ("connectFirst",) <$> [False, True] + teamPeer <- ("teamPeer",) <$> [False, True] + approveLH <- ("approveLH",) <$> [False, True] + testPendingConnection <- ("testPendingConnection",) <$> [False, True] + let name = intercalate ", " $ map (\(n, b) -> n <> "=" <> show b) [connectFirst, teamPeer, approveLH, testPendingConnection] + pure . test s name $ testNoConsentBlockOne2OneConv (snd connectFirst) (snd teamPeer) (snd approveLH) (snd testPendingConnection), testGroup "Legalhold is activated for user A in a group conversation" [ test s "All admins are consenting: all non-consenters get removed from conversation" (onlyIfLhWhitelisted (testNoConsentRemoveFromGroupConv LegalholderIsAdmin)), @@ -908,6 +912,12 @@ testNoConsentBlockOne2OneConv connectFirst teamPeer approveLH testPendingConnect do doDisableLH + + when approveLH $ do + legalholderLHDevice <- assertJust mbLegalholderLHDevice + WS.assertMatch_ (5 # Second) legalholderWs $ + wsAssertClientRemoved legalholderLHDevice + assertConnections legalholder [ ConnectionStatus legalholder peer $ diff --git a/services/galley/test/integration/API/Util.hs b/services/galley/test/integration/API/Util.hs index e24b608ca88..53472850b07 100644 --- a/services/galley/test/integration/API/Util.hs +++ b/services/galley/test/integration/API/Util.hs @@ -1574,6 +1574,18 @@ wsAssertMLSMessage conv u message n = do ntfTransient n @?= False assertMLSMessageEvent conv u message e +wsAssertClientRemoved :: + HasCallStack => + ClientId -> + Notification -> + IO () +wsAssertClientRemoved cid n = do + let j = Object $ List1.head (ntfPayload n) + let etype = j ^? key "type" . _String + let eclient = j ^? key "client" . key "id" . _String + etype @?= Just "user.client-remove" + fmap ClientId eclient @?= Just cid + assertMLSMessageEvent :: HasCallStack => Qualified ConvId -> From 40f81847fc80c564f8d356d32c5063470f8a7315 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marko=20Dimja=C5=A1evi=C4=87?= Date: Thu, 8 Sep 2022 21:45:46 +0200 Subject: [PATCH 18/58] Drop the `managed` Column from `team_conv` Table in Galley (#2127) * Drop the `managed` column from `team_conv` table * Improve the description of the managed key --- cassandra-schema.cql | 1 - changelog.d/5-internal/drop-managed-db-schema | 1 + docs/src/developer/reference/conversation.md | 1 - libs/wire-api/src/Wire/API/Conversation.hs | 11 +- .../src/Wire/API/Team/Conversation.hs | 72 ++- .../golden/Test/Wire/API/Golden/Generated.hs | 18 +- .../Generated/TeamConversationList_team.hs | 461 +----------------- .../Golden/Generated/TeamConversation_team.hs | 78 +-- .../testObject_NewConvManaged_user_2.json | 24 - .../testObject_NewConvUnmanaged_user_1.json | 22 - .../testObject_NewConvUnmanaged_user_2.json | 18 - ...estObject_TeamConversationList_team_1.json | 60 --- ...stObject_TeamConversationList_team_10.json | 28 -- ...stObject_TeamConversationList_team_11.json | 20 - ...stObject_TeamConversationList_team_12.json | 92 ---- ...stObject_TeamConversationList_team_13.json | 88 ---- ...stObject_TeamConversationList_team_14.json | 84 ---- ...stObject_TeamConversationList_team_15.json | 28 -- ...stObject_TeamConversationList_team_16.json | 112 ----- ...stObject_TeamConversationList_team_17.json | 112 ----- ...stObject_TeamConversationList_team_18.json | 72 --- ...stObject_TeamConversationList_team_19.json | 100 ---- ...estObject_TeamConversationList_team_2.json | 100 ---- ...stObject_TeamConversationList_team_20.json | 12 - ...estObject_TeamConversationList_team_3.json | 44 -- ...estObject_TeamConversationList_team_4.json | 120 ----- ...estObject_TeamConversationList_team_5.json | 16 - ...estObject_TeamConversationList_team_6.json | 40 -- ...estObject_TeamConversationList_team_7.json | 40 -- ...estObject_TeamConversationList_team_8.json | 124 ----- ...estObject_TeamConversationList_team_9.json | 120 ----- .../testObject_TeamConversation_team_10.json | 4 - .../testObject_TeamConversation_team_11.json | 4 - .../testObject_TeamConversation_team_12.json | 4 - .../testObject_TeamConversation_team_13.json | 4 - .../testObject_TeamConversation_team_14.json | 4 - .../testObject_TeamConversation_team_15.json | 4 - .../testObject_TeamConversation_team_16.json | 4 - .../testObject_TeamConversation_team_17.json | 4 - .../testObject_TeamConversation_team_18.json | 4 - .../testObject_TeamConversation_team_19.json | 4 - .../testObject_TeamConversation_team_20.json | 4 - .../testObject_TeamConversation_team_3.json | 4 - .../testObject_TeamConversation_team_4.json | 4 - .../testObject_TeamConversation_team_5.json | 4 - .../testObject_TeamConversation_team_6.json | 4 - .../testObject_TeamConversation_team_7.json | 4 - .../testObject_TeamConversation_team_8.json | 4 - .../testObject_TeamConversation_team_9.json | 4 - services/galley/galley.cabal | 1 + services/galley/schema/src/Main.hs | 4 +- .../src/V72_DropManagedConversations.hs | 30 ++ services/galley/src/Galley/Cassandra.hs | 2 +- .../galley/src/Galley/Cassandra/Instances.hs | 5 +- services/galley/src/Galley/Cassandra/Team.hs | 6 +- 55 files changed, 110 insertions(+), 2129 deletions(-) create mode 100644 changelog.d/5-internal/drop-managed-db-schema delete mode 100644 libs/wire-api/test/golden/fromJSON/testObject_NewConvManaged_user_2.json delete mode 100644 libs/wire-api/test/golden/fromJSON/testObject_NewConvUnmanaged_user_1.json delete mode 100644 libs/wire-api/test/golden/fromJSON/testObject_NewConvUnmanaged_user_2.json delete mode 100644 libs/wire-api/test/golden/testObject_TeamConversationList_team_10.json delete mode 100644 libs/wire-api/test/golden/testObject_TeamConversationList_team_11.json delete mode 100644 libs/wire-api/test/golden/testObject_TeamConversationList_team_12.json delete mode 100644 libs/wire-api/test/golden/testObject_TeamConversationList_team_13.json delete mode 100644 libs/wire-api/test/golden/testObject_TeamConversationList_team_14.json delete mode 100644 libs/wire-api/test/golden/testObject_TeamConversationList_team_15.json delete mode 100644 libs/wire-api/test/golden/testObject_TeamConversationList_team_16.json delete mode 100644 libs/wire-api/test/golden/testObject_TeamConversationList_team_17.json delete mode 100644 libs/wire-api/test/golden/testObject_TeamConversationList_team_18.json delete mode 100644 libs/wire-api/test/golden/testObject_TeamConversationList_team_19.json delete mode 100644 libs/wire-api/test/golden/testObject_TeamConversationList_team_20.json delete mode 100644 libs/wire-api/test/golden/testObject_TeamConversationList_team_3.json delete mode 100644 libs/wire-api/test/golden/testObject_TeamConversationList_team_4.json delete mode 100644 libs/wire-api/test/golden/testObject_TeamConversationList_team_5.json delete mode 100644 libs/wire-api/test/golden/testObject_TeamConversationList_team_6.json delete mode 100644 libs/wire-api/test/golden/testObject_TeamConversationList_team_7.json delete mode 100644 libs/wire-api/test/golden/testObject_TeamConversationList_team_8.json delete mode 100644 libs/wire-api/test/golden/testObject_TeamConversationList_team_9.json delete mode 100644 libs/wire-api/test/golden/testObject_TeamConversation_team_10.json delete mode 100644 libs/wire-api/test/golden/testObject_TeamConversation_team_11.json delete mode 100644 libs/wire-api/test/golden/testObject_TeamConversation_team_12.json delete mode 100644 libs/wire-api/test/golden/testObject_TeamConversation_team_13.json delete mode 100644 libs/wire-api/test/golden/testObject_TeamConversation_team_14.json delete mode 100644 libs/wire-api/test/golden/testObject_TeamConversation_team_15.json delete mode 100644 libs/wire-api/test/golden/testObject_TeamConversation_team_16.json delete mode 100644 libs/wire-api/test/golden/testObject_TeamConversation_team_17.json delete mode 100644 libs/wire-api/test/golden/testObject_TeamConversation_team_18.json delete mode 100644 libs/wire-api/test/golden/testObject_TeamConversation_team_19.json delete mode 100644 libs/wire-api/test/golden/testObject_TeamConversation_team_20.json delete mode 100644 libs/wire-api/test/golden/testObject_TeamConversation_team_3.json delete mode 100644 libs/wire-api/test/golden/testObject_TeamConversation_team_4.json delete mode 100644 libs/wire-api/test/golden/testObject_TeamConversation_team_5.json delete mode 100644 libs/wire-api/test/golden/testObject_TeamConversation_team_6.json delete mode 100644 libs/wire-api/test/golden/testObject_TeamConversation_team_7.json delete mode 100644 libs/wire-api/test/golden/testObject_TeamConversation_team_8.json delete mode 100644 libs/wire-api/test/golden/testObject_TeamConversation_team_9.json create mode 100644 services/galley/schema/src/V72_DropManagedConversations.hs diff --git a/cassandra-schema.cql b/cassandra-schema.cql index 2f83dadcb47..0474d89325c 100644 --- a/cassandra-schema.cql +++ b/cassandra-schema.cql @@ -38,7 +38,6 @@ CREATE TABLE galley_test.meta ( CREATE TABLE galley_test.team_conv ( team uuid, conv uuid, - managed boolean, PRIMARY KEY (team, conv) ) WITH CLUSTERING ORDER BY (conv ASC) AND bloom_filter_fp_chance = 0.1 diff --git a/changelog.d/5-internal/drop-managed-db-schema b/changelog.d/5-internal/drop-managed-db-schema new file mode 100644 index 00000000000..265b0595cd9 --- /dev/null +++ b/changelog.d/5-internal/drop-managed-db-schema @@ -0,0 +1 @@ +Drop the `managed` column from `team_conv` table in Galley diff --git a/docs/src/developer/reference/conversation.md b/docs/src/developer/reference/conversation.md index eedbfa7ce0b..44db3a28603 100644 --- a/docs/src/developer/reference/conversation.md +++ b/docs/src/developer/reference/conversation.md @@ -82,7 +82,6 @@ export WIRE_CONV='{ "users": [], "name": "'${WIRE_CONV_NAME}'", "team": { - "managed": false, "teamid": "'${WIRE_TEAMID}'" }, "receipt_mode": 0, diff --git a/libs/wire-api/src/Wire/API/Conversation.hs b/libs/wire-api/src/Wire/API/Conversation.hs index f9ad1b122ea..affad99eb3f 100644 --- a/libs/wire-api/src/Wire/API/Conversation.hs +++ b/libs/wire-api/src/Wire/API/Conversation.hs @@ -722,7 +722,12 @@ newtype ConvTeamInfo = ConvTeamInfo } deriving stock (Eq, Show, Generic) deriving (Arbitrary) via (GenericUniform ConvTeamInfo) - deriving (FromJSON, ToJSON, S.ToSchema) via Schema ConvTeamInfo + deriving (FromJSON, ToJSON, S.ToSchema) via (Schema ConvTeamInfo) + +managedDesc :: Text +managedDesc = + "This field MUST NOT be used by clients. " + <> "It is here only for backwards compatibility of the interface." instance ToSchema ConvTeamInfo where schema = @@ -734,7 +739,7 @@ instance ToSchema ConvTeamInfo where <* const () .= fieldWithDocModifier "managed" - (description ?~ "(Not parsed any more) Whether this is a managed team conversation") + (description ?~ managedDesc) (c (False :: Bool)) where c :: ToJSON a => a -> ValueSchema SwaggerDoc () @@ -746,7 +751,7 @@ modelTeamInfo = Doc.defineModel "TeamInfo" $ do Doc.property "teamid" Doc.bytes' $ Doc.description "Team ID" Doc.property "managed" Doc.bool' $ - Doc.description "Is this a managed team conversation?" + Doc.description managedDesc -------------------------------------------------------------------------------- -- invite diff --git a/libs/wire-api/src/Wire/API/Team/Conversation.hs b/libs/wire-api/src/Wire/API/Team/Conversation.hs index 3fd614cd6b8..207ba65422c 100644 --- a/libs/wire-api/src/Wire/API/Team/Conversation.hs +++ b/libs/wire-api/src/Wire/API/Team/Conversation.hs @@ -36,11 +36,11 @@ module Wire.API.Team.Conversation ) where -import Control.Lens (At (at), makeLenses, over, (?~)) -import Data.Aeson hiding (fieldLabelModifier) +import Control.Lens (makeLenses, (?~)) +import qualified Data.Aeson as A import Data.Id (ConvId) -import Data.Proxy -import Data.Swagger +import Data.Schema +import qualified Data.Swagger as S import qualified Data.Swagger.Build.Api as Doc import Imports import Wire.Arbitrary (Arbitrary, GenericUniform (..)) @@ -53,17 +53,28 @@ newtype TeamConversation = TeamConversation } deriving stock (Eq, Show, Generic) deriving (Arbitrary) via (GenericUniform TeamConversation) + deriving (A.ToJSON, A.FromJSON, S.ToSchema) via (Schema TeamConversation) + +managedDesc :: Text +managedDesc = + "This field MUST NOT be used by clients. " + <> "It is here only for backwards compatibility of the interface." instance ToSchema TeamConversation where - declareNamedSchema _ = do - idSchema <- declareSchemaRef (Proxy @ConvId) - pure $ - NamedSchema (Just "TeamConversation") $ - mempty - & description ?~ "team conversation data" - & over - properties - (at "conversation" ?~ idSchema) + schema = + objectWithDocModifier + "TeamConversation" + (description ?~ "Team conversation data") + $ TeamConversation + <$> _conversationId .= field "conversation" schema + <* const () + .= fieldWithDocModifier + "managed" + (description ?~ managedDesc) + (c (False :: Bool)) + where + c :: A.ToJSON a => a -> ValueSchema SwaggerDoc () + c val = mkSchema mempty (const (pure ())) (const (pure (A.toJSON val))) newTeamConversation :: ConvId -> TeamConversation newTeamConversation = TeamConversation @@ -73,18 +84,8 @@ modelTeamConversation = Doc.defineModel "TeamConversation" $ do Doc.description "team conversation data" Doc.property "conversation" Doc.bytes' $ Doc.description "conversation ID" - -instance ToJSON TeamConversation where - toJSON t = - object - [ "conversation" .= _conversationId t, - -- FUTUREWORK: get rid of the "managed" field in the next version of the API - "managed" .= False - ] - -instance FromJSON TeamConversation where - parseJSON = withObject "team conversation" $ \o -> - TeamConversation <$> o .: "conversation" + Doc.property "managed" Doc.bytes' $ + Doc.description managedDesc -------------------------------------------------------------------------------- -- TeamConversationList @@ -95,15 +96,15 @@ newtype TeamConversationList = TeamConversationList deriving (Generic) deriving stock (Eq, Show) deriving newtype (Arbitrary) + deriving (A.ToJSON, A.FromJSON, S.ToSchema) via (Schema TeamConversationList) instance ToSchema TeamConversationList where - declareNamedSchema _ = do - convs <- declareSchema (Proxy @[TeamConversation]) - pure $ - NamedSchema (Just "TeamConversationList") $ - mempty - & description ?~ "team conversation list" - & properties . at "conversations" ?~ Inline convs + schema = + objectWithDocModifier + "TeamConversationList" + (description ?~ "Team conversation list") + $ TeamConversationList + <$> _teamConversations .= field "conversations" (array schema) newTeamConversationList :: [TeamConversation] -> TeamConversationList newTeamConversationList = TeamConversationList @@ -114,12 +115,5 @@ modelTeamConversationList = Doc.defineModel "TeamConversationListList" $ do Doc.property "conversations" (Doc.unique $ Doc.array (Doc.ref modelTeamConversation)) $ Doc.description "the array of team conversations" -instance ToJSON TeamConversationList where - toJSON t = object ["conversations" .= _teamConversations t] - -instance FromJSON TeamConversationList where - parseJSON = withObject "team conversation list" $ \o -> do - TeamConversationList <$> o .: "conversations" - makeLenses ''TeamConversation makeLenses ''TeamConversationList diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated.hs index 049b631f568..ccff53d7278 100644 --- a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated.hs +++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated.hs @@ -1145,9 +1145,23 @@ tests = testGroup "Golden: TeamDeleteData_team" $ testObjects [(Test.Wire.API.Golden.Generated.TeamDeleteData_team.testObject_TeamDeleteData_team_1, "testObject_TeamDeleteData_team_1.json"), (Test.Wire.API.Golden.Generated.TeamDeleteData_team.testObject_TeamDeleteData_team_2, "testObject_TeamDeleteData_team_2.json"), (Test.Wire.API.Golden.Generated.TeamDeleteData_team.testObject_TeamDeleteData_team_3, "testObject_TeamDeleteData_team_3.json"), (Test.Wire.API.Golden.Generated.TeamDeleteData_team.testObject_TeamDeleteData_team_4, "testObject_TeamDeleteData_team_4.json"), (Test.Wire.API.Golden.Generated.TeamDeleteData_team.testObject_TeamDeleteData_team_5, "testObject_TeamDeleteData_team_5.json"), (Test.Wire.API.Golden.Generated.TeamDeleteData_team.testObject_TeamDeleteData_team_6, "testObject_TeamDeleteData_team_6.json"), (Test.Wire.API.Golden.Generated.TeamDeleteData_team.testObject_TeamDeleteData_team_7, "testObject_TeamDeleteData_team_7.json"), (Test.Wire.API.Golden.Generated.TeamDeleteData_team.testObject_TeamDeleteData_team_8, "testObject_TeamDeleteData_team_8.json"), (Test.Wire.API.Golden.Generated.TeamDeleteData_team.testObject_TeamDeleteData_team_9, "testObject_TeamDeleteData_team_9.json"), (Test.Wire.API.Golden.Generated.TeamDeleteData_team.testObject_TeamDeleteData_team_10, "testObject_TeamDeleteData_team_10.json"), (Test.Wire.API.Golden.Generated.TeamDeleteData_team.testObject_TeamDeleteData_team_11, "testObject_TeamDeleteData_team_11.json"), (Test.Wire.API.Golden.Generated.TeamDeleteData_team.testObject_TeamDeleteData_team_12, "testObject_TeamDeleteData_team_12.json"), (Test.Wire.API.Golden.Generated.TeamDeleteData_team.testObject_TeamDeleteData_team_13, "testObject_TeamDeleteData_team_13.json"), (Test.Wire.API.Golden.Generated.TeamDeleteData_team.testObject_TeamDeleteData_team_14, "testObject_TeamDeleteData_team_14.json"), (Test.Wire.API.Golden.Generated.TeamDeleteData_team.testObject_TeamDeleteData_team_15, "testObject_TeamDeleteData_team_15.json"), (Test.Wire.API.Golden.Generated.TeamDeleteData_team.testObject_TeamDeleteData_team_16, "testObject_TeamDeleteData_team_16.json"), (Test.Wire.API.Golden.Generated.TeamDeleteData_team.testObject_TeamDeleteData_team_17, "testObject_TeamDeleteData_team_17.json"), (Test.Wire.API.Golden.Generated.TeamDeleteData_team.testObject_TeamDeleteData_team_18, "testObject_TeamDeleteData_team_18.json"), (Test.Wire.API.Golden.Generated.TeamDeleteData_team.testObject_TeamDeleteData_team_19, "testObject_TeamDeleteData_team_19.json"), (Test.Wire.API.Golden.Generated.TeamDeleteData_team.testObject_TeamDeleteData_team_20, "testObject_TeamDeleteData_team_20.json")], testGroup "Golden: TeamConversation_team" $ - testObjects [(Test.Wire.API.Golden.Generated.TeamConversation_team.testObject_TeamConversation_team_1, "testObject_TeamConversation_team_1.json"), (Test.Wire.API.Golden.Generated.TeamConversation_team.testObject_TeamConversation_team_2, "testObject_TeamConversation_team_2.json"), (Test.Wire.API.Golden.Generated.TeamConversation_team.testObject_TeamConversation_team_3, "testObject_TeamConversation_team_3.json"), (Test.Wire.API.Golden.Generated.TeamConversation_team.testObject_TeamConversation_team_4, "testObject_TeamConversation_team_4.json"), (Test.Wire.API.Golden.Generated.TeamConversation_team.testObject_TeamConversation_team_5, "testObject_TeamConversation_team_5.json"), (Test.Wire.API.Golden.Generated.TeamConversation_team.testObject_TeamConversation_team_6, "testObject_TeamConversation_team_6.json"), (Test.Wire.API.Golden.Generated.TeamConversation_team.testObject_TeamConversation_team_7, "testObject_TeamConversation_team_7.json"), (Test.Wire.API.Golden.Generated.TeamConversation_team.testObject_TeamConversation_team_8, "testObject_TeamConversation_team_8.json"), (Test.Wire.API.Golden.Generated.TeamConversation_team.testObject_TeamConversation_team_9, "testObject_TeamConversation_team_9.json"), (Test.Wire.API.Golden.Generated.TeamConversation_team.testObject_TeamConversation_team_10, "testObject_TeamConversation_team_10.json"), (Test.Wire.API.Golden.Generated.TeamConversation_team.testObject_TeamConversation_team_11, "testObject_TeamConversation_team_11.json"), (Test.Wire.API.Golden.Generated.TeamConversation_team.testObject_TeamConversation_team_12, "testObject_TeamConversation_team_12.json"), (Test.Wire.API.Golden.Generated.TeamConversation_team.testObject_TeamConversation_team_13, "testObject_TeamConversation_team_13.json"), (Test.Wire.API.Golden.Generated.TeamConversation_team.testObject_TeamConversation_team_14, "testObject_TeamConversation_team_14.json"), (Test.Wire.API.Golden.Generated.TeamConversation_team.testObject_TeamConversation_team_15, "testObject_TeamConversation_team_15.json"), (Test.Wire.API.Golden.Generated.TeamConversation_team.testObject_TeamConversation_team_16, "testObject_TeamConversation_team_16.json"), (Test.Wire.API.Golden.Generated.TeamConversation_team.testObject_TeamConversation_team_17, "testObject_TeamConversation_team_17.json"), (Test.Wire.API.Golden.Generated.TeamConversation_team.testObject_TeamConversation_team_18, "testObject_TeamConversation_team_18.json"), (Test.Wire.API.Golden.Generated.TeamConversation_team.testObject_TeamConversation_team_19, "testObject_TeamConversation_team_19.json"), (Test.Wire.API.Golden.Generated.TeamConversation_team.testObject_TeamConversation_team_20, "testObject_TeamConversation_team_20.json")], + testObjects + [ ( Test.Wire.API.Golden.Generated.TeamConversation_team.testObject_TeamConversation_team_1, + "testObject_TeamConversation_team_1.json" + ), + ( Test.Wire.API.Golden.Generated.TeamConversation_team.testObject_TeamConversation_team_2, + "testObject_TeamConversation_team_2.json" + ) + ], testGroup "Golden: TeamConversationList_team" $ - testObjects [(Test.Wire.API.Golden.Generated.TeamConversationList_team.testObject_TeamConversationList_team_1, "testObject_TeamConversationList_team_1.json"), (Test.Wire.API.Golden.Generated.TeamConversationList_team.testObject_TeamConversationList_team_2, "testObject_TeamConversationList_team_2.json"), (Test.Wire.API.Golden.Generated.TeamConversationList_team.testObject_TeamConversationList_team_3, "testObject_TeamConversationList_team_3.json"), (Test.Wire.API.Golden.Generated.TeamConversationList_team.testObject_TeamConversationList_team_4, "testObject_TeamConversationList_team_4.json"), (Test.Wire.API.Golden.Generated.TeamConversationList_team.testObject_TeamConversationList_team_5, "testObject_TeamConversationList_team_5.json"), (Test.Wire.API.Golden.Generated.TeamConversationList_team.testObject_TeamConversationList_team_6, "testObject_TeamConversationList_team_6.json"), (Test.Wire.API.Golden.Generated.TeamConversationList_team.testObject_TeamConversationList_team_7, "testObject_TeamConversationList_team_7.json"), (Test.Wire.API.Golden.Generated.TeamConversationList_team.testObject_TeamConversationList_team_8, "testObject_TeamConversationList_team_8.json"), (Test.Wire.API.Golden.Generated.TeamConversationList_team.testObject_TeamConversationList_team_9, "testObject_TeamConversationList_team_9.json"), (Test.Wire.API.Golden.Generated.TeamConversationList_team.testObject_TeamConversationList_team_10, "testObject_TeamConversationList_team_10.json"), (Test.Wire.API.Golden.Generated.TeamConversationList_team.testObject_TeamConversationList_team_11, "testObject_TeamConversationList_team_11.json"), (Test.Wire.API.Golden.Generated.TeamConversationList_team.testObject_TeamConversationList_team_12, "testObject_TeamConversationList_team_12.json"), (Test.Wire.API.Golden.Generated.TeamConversationList_team.testObject_TeamConversationList_team_13, "testObject_TeamConversationList_team_13.json"), (Test.Wire.API.Golden.Generated.TeamConversationList_team.testObject_TeamConversationList_team_14, "testObject_TeamConversationList_team_14.json"), (Test.Wire.API.Golden.Generated.TeamConversationList_team.testObject_TeamConversationList_team_15, "testObject_TeamConversationList_team_15.json"), (Test.Wire.API.Golden.Generated.TeamConversationList_team.testObject_TeamConversationList_team_16, "testObject_TeamConversationList_team_16.json"), (Test.Wire.API.Golden.Generated.TeamConversationList_team.testObject_TeamConversationList_team_17, "testObject_TeamConversationList_team_17.json"), (Test.Wire.API.Golden.Generated.TeamConversationList_team.testObject_TeamConversationList_team_18, "testObject_TeamConversationList_team_18.json"), (Test.Wire.API.Golden.Generated.TeamConversationList_team.testObject_TeamConversationList_team_19, "testObject_TeamConversationList_team_19.json"), (Test.Wire.API.Golden.Generated.TeamConversationList_team.testObject_TeamConversationList_team_20, "testObject_TeamConversationList_team_20.json")], + testObjects + [ ( Test.Wire.API.Golden.Generated.TeamConversationList_team.testObject_TeamConversationList_team_1, + "testObject_TeamConversationList_team_1.json" + ), + ( Test.Wire.API.Golden.Generated.TeamConversationList_team.testObject_TeamConversationList_team_2, + "testObject_TeamConversationList_team_2.json" + ) + ], testGroup "Golden: WithStatusNoLock_team 1" $ testObjects [ (Test.Wire.API.Golden.Generated.WithStatusNoLock_team.testObject_WithStatusNoLock_team_1, "testObject_WithStatusNoLock_team_1.json"), diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/TeamConversationList_team.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/TeamConversationList_team.hs index 3bdf75b2bea..ea25570d1bf 100644 --- a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/TeamConversationList_team.hs +++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/TeamConversationList_team.hs @@ -26,459 +26,14 @@ import Wire.API.Team.Conversation (TeamConversationList, newTeamConversation, ne testObject_TeamConversationList_team_1 :: TeamConversationList testObject_TeamConversationList_team_1 = - ( newTeamConversationList - [ (newTeamConversation ((Id (fromJust (UUID.fromString "00000012-0000-0018-0000-00260000002b"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000002d-0000-0063-0000-006900000013"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000002e-0000-003c-0000-00440000000e"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000067-0000-003a-0000-006100000049"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000005f-0000-0003-0000-005a00000075"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000007f-0000-0018-0000-00250000007c"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000006a-0000-0020-0000-001a00000073"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000002e-0000-006a-0000-005f00000003"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000034-0000-0021-0000-00330000005b"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000048-0000-0011-0000-002a00000004"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000031-0000-0018-0000-00060000001a"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000056-0000-000e-0000-004300000028"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000067-0000-007f-0000-003600000031"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000066-0000-0053-0000-006a00000034"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000000f-0000-0071-0000-001b00000057"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000032-0000-0035-0000-00210000003b"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000004-0000-000d-0000-002100000067"))))) - ] - ) + newTeamConversationList + [ newTeamConversation (Id (fromJust (UUID.fromString "00000012-0000-0018-0000-00260000002b"))), + newTeamConversation (Id (fromJust (UUID.fromString "0000002d-0000-0063-0000-006900000013"))) + ] testObject_TeamConversationList_team_2 :: TeamConversationList testObject_TeamConversationList_team_2 = - ( newTeamConversationList - [ (newTeamConversation ((Id (fromJust (UUID.fromString "00000064-0000-0045-0000-007d00000023"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000000d-0000-0080-0000-00550000001b"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000004e-0000-0053-0000-004600000056"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000006e-0000-003c-0000-003200000071"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000067-0000-002f-0000-007a0000007f"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000000a-0000-0027-0000-004e0000005f"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000006-0000-0026-0000-000000000054"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000006e-0000-007e-0000-001600000035"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000002c-0000-0057-0000-007e00000070"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000074-0000-0053-0000-005f00000006"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000028-0000-005c-0000-00050000006b"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000018-0000-0061-0000-004a00000024"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000005a-0000-007b-0000-000800000033"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000027-0000-0043-0000-006800000068"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000056-0000-0018-0000-003f00000001"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000014-0000-0066-0000-00440000001b"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000007f-0000-0071-0000-007f0000001b"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000018-0000-004d-0000-005000000080"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000018-0000-003e-0000-00140000006e"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000033-0000-005c-0000-001e0000000d"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000004d-0000-0021-0000-00360000000e"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000057-0000-003f-0000-003700000065"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000006f-0000-003e-0000-000300000051"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000038-0000-0025-0000-00030000003b"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000003c-0000-0069-0000-005000000035"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000005f-0000-006b-0000-00260000004e"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000001c-0000-001c-0000-00530000000c"))))) - ] - ) - -testObject_TeamConversationList_team_3 :: TeamConversationList -testObject_TeamConversationList_team_3 = - ( newTeamConversationList - [ (newTeamConversation ((Id (fromJust (UUID.fromString "00000046-0000-0026-0000-005600000014"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000006b-0000-0042-0000-002c00000074"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000006d-0000-006d-0000-006100000027"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000079-0000-0024-0000-004600000011"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000044-0000-0005-0000-003800000008"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000052-0000-005e-0000-00200000001a"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000009-0000-0038-0000-001b00000065"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000029-0000-0045-0000-004500000078"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000001e-0000-0036-0000-006400000045"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000050-0000-0066-0000-000500000075"))))) - ] - ) - -testObject_TeamConversationList_team_4 :: TeamConversationList -testObject_TeamConversationList_team_4 = - ( newTeamConversationList - [ (newTeamConversation ((Id (fromJust (UUID.fromString "00000076-0000-0038-0000-003c00000043"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000046-0000-001f-0000-005800000080"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000023-0000-0070-0000-006f00000077"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000006-0000-0031-0000-004700000053"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000057-0000-0041-0000-001600000013"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000007b-0000-003c-0000-004800000063"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000028-0000-0009-0000-004c00000009"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000001a-0000-007b-0000-00460000007f"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000052-0000-002e-0000-001000000064"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000003d-0000-002a-0000-00290000007b"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000004-0000-0033-0000-00780000005e"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000006b-0000-007f-0000-001d0000002c"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000017-0000-0079-0000-001c00000066"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000002f-0000-0024-0000-001000000074"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000010-0000-000c-0000-001700000046"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000003-0000-0049-0000-003100000022"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000011-0000-0051-0000-003300000061"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000003e-0000-0077-0000-004c00000022"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000007e-0000-0048-0000-007200000056"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000006f-0000-0007-0000-00190000004f"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000002d-0000-0048-0000-001c0000007e"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000004c-0000-0071-0000-007a00000071"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000006-0000-0002-0000-002000000068"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000002e-0000-0037-0000-005e00000027"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000056-0000-006d-0000-004d00000024"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000004a-0000-0038-0000-001e0000003b"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000033-0000-001a-0000-004a0000001a"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000001a-0000-0070-0000-007000000019"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000006b-0000-0013-0000-004a00000018"))))) - ] - ) - -testObject_TeamConversationList_team_5 :: TeamConversationList -testObject_TeamConversationList_team_5 = - ( newTeamConversationList - [ (newTeamConversation ((Id (fromJust (UUID.fromString "00000073-0000-005a-0000-00250000000d"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000033-0000-005c-0000-006e00000014"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000017-0000-005d-0000-003b00000023"))))) - ] - ) - -testObject_TeamConversationList_team_6 :: TeamConversationList -testObject_TeamConversationList_team_6 = - ( newTeamConversationList - [ (newTeamConversation ((Id (fromJust (UUID.fromString "0000007c-0000-007f-0000-00730000000d"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000028-0000-0037-0000-000b00000016"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000021-0000-0064-0000-003900000002"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000064-0000-001f-0000-00350000001b"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000002d-0000-007b-0000-00770000003e"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000064-0000-0068-0000-007700000068"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000061-0000-000b-0000-00170000005c"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000005c-0000-0001-0000-004e00000003"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000008-0000-002b-0000-002d00000022"))))) - ] - ) - -testObject_TeamConversationList_team_7 :: TeamConversationList -testObject_TeamConversationList_team_7 = - ( newTeamConversationList - [ (newTeamConversation ((Id (fromJust (UUID.fromString "00000068-0000-0010-0000-002700000004"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000006d-0000-0036-0000-000e00000080"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000003-0000-0068-0000-000000000006"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000024-0000-0018-0000-005d00000050"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000040-0000-0001-0000-00670000002e"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000002-0000-0016-0000-004300000052"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000007b-0000-0073-0000-002700000048"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000003b-0000-0048-0000-002500000015"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000055-0000-007c-0000-001500000051"))))) - ] - ) - -testObject_TeamConversationList_team_8 :: TeamConversationList -testObject_TeamConversationList_team_8 = - ( newTeamConversationList - [ (newTeamConversation ((Id (fromJust (UUID.fromString "00000026-0000-0066-0000-00170000007b"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000064-0000-0015-0000-001f00000071"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000063-0000-0049-0000-004100000018"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000050-0000-002b-0000-000300000001"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000035-0000-006e-0000-002f00000057"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000006f-0000-0064-0000-003b0000002d"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000003e-0000-0009-0000-00630000001d"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000002a-0000-004d-0000-001b00000036"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000002d-0000-0073-0000-007d00000010"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000016-0000-0007-0000-00690000002d"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000043-0000-001f-0000-007500000002"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000002-0000-0012-0000-006200000028"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000019-0000-003a-0000-002300000023"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000050-0000-006d-0000-00610000000c"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000068-0000-0048-0000-003200000004"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000003-0000-0024-0000-002000000015"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000027-0000-0003-0000-007600000028"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000074-0000-005d-0000-00100000005d"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000071-0000-0075-0000-000a0000002c"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000012-0000-0071-0000-004d00000010"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000006f-0000-003f-0000-005a00000026"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000016-0000-0069-0000-00500000000a"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000033-0000-000b-0000-003000000046"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000002d-0000-005f-0000-007f0000001b"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000057-0000-0050-0000-002100000074"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000077-0000-0063-0000-00360000000e"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000058-0000-0011-0000-001200000005"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000004a-0000-0037-0000-003000000034"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000029-0000-0043-0000-006700000030"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000039-0000-003e-0000-008000000051"))))) - ] - ) - -testObject_TeamConversationList_team_9 :: TeamConversationList -testObject_TeamConversationList_team_9 = - ( newTeamConversationList - [ (newTeamConversation ((Id (fromJust (UUID.fromString "00000058-0000-007c-0000-002a0000005f"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000080-0000-0009-0000-006500000038"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000004e-0000-000a-0000-004e00000039"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000062-0000-001e-0000-004c00000058"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000004-0000-0021-0000-00670000000a"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000004f-0000-0063-0000-004a0000004b"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000044-0000-0017-0000-006300000067"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000006a-0000-0070-0000-002e0000000a"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000049-0000-0080-0000-006000000025"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000007d-0000-0040-0000-001700000066"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000057-0000-0045-0000-00610000006c"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000001-0000-0042-0000-005b00000057"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000048-0000-0032-0000-000000000069"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000003-0000-0022-0000-00370000005b"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000007-0000-0068-0000-00150000001f"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000003a-0000-0067-0000-00060000003e"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000001e-0000-0043-0000-002800000065"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000053-0000-001f-0000-001700000006"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000068-0000-0024-0000-004900000037"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000005-0000-0019-0000-00670000005c"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000029-0000-0003-0000-00520000004c"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000080-0000-002f-0000-002b0000006f"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000021-0000-002e-0000-004f0000005e"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000006a-0000-0023-0000-00560000001b"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000066-0000-007b-0000-00160000005c"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000004e-0000-0008-0000-006b00000049"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000005b-0000-0020-0000-005000000006"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000052-0000-0038-0000-003400000074"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000067-0000-006f-0000-00370000002e"))))) - ] - ) - -testObject_TeamConversationList_team_10 :: TeamConversationList -testObject_TeamConversationList_team_10 = - ( newTeamConversationList - [ (newTeamConversation ((Id (fromJust (UUID.fromString "00000070-0000-007d-0000-001400000009"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000065-0000-0057-0000-00190000004a"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000049-0000-0030-0000-006b00000005"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000007c-0000-0065-0000-001100000066"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000057-0000-0039-0000-000400000071"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000003e-0000-0053-0000-007f0000003c"))))) - ] - ) - -testObject_TeamConversationList_team_11 :: TeamConversationList -testObject_TeamConversationList_team_11 = - ( newTeamConversationList - [ (newTeamConversation ((Id (fromJust (UUID.fromString "00000038-0000-0030-0000-006700000067"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000000-0000-006a-0000-00220000007c"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000055-0000-004f-0000-005500000047"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000064-0000-003d-0000-006500000060"))))) - ] - ) - -testObject_TeamConversationList_team_12 :: TeamConversationList -testObject_TeamConversationList_team_12 = - ( newTeamConversationList - [ (newTeamConversation ((Id (fromJust (UUID.fromString "00000056-0000-0042-0000-00120000004e"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000010-0000-002b-0000-002600000066"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000006b-0000-0054-0000-005300000004"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000000e-0000-006f-0000-000c00000038"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000038-0000-0021-0000-005500000008"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000005b-0000-007a-0000-00230000002d"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000078-0000-000e-0000-004300000065"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000036-0000-0003-0000-000500000011"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000043-0000-0032-0000-005200000069"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000000c-0000-0003-0000-001400000018"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000002a-0000-0020-0000-005200000053"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000047-0000-007b-0000-00670000000b"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000001a-0000-005b-0000-00250000000c"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000004b-0000-005b-0000-004200000001"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000057-0000-0073-0000-003d00000006"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000053-0000-0038-0000-006600000048"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000000d-0000-0022-0000-00800000006f"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000005e-0000-0023-0000-000700000012"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000046-0000-0071-0000-005f00000070"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000056-0000-0024-0000-003400000018"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000054-0000-0056-0000-007000000058"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000046-0000-0011-0000-001500000007"))))) - ] - ) - -testObject_TeamConversationList_team_13 :: TeamConversationList -testObject_TeamConversationList_team_13 = - ( newTeamConversationList - [ (newTeamConversation ((Id (fromJust (UUID.fromString "0000006a-0000-0043-0000-007f00000048"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000007d-0000-005f-0000-000a00000024"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000007a-0000-0046-0000-003800000023"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000023-0000-006b-0000-002000000068"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000041-0000-0000-0000-007000000005"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000007a-0000-0075-0000-00200000007a"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000038-0000-0023-0000-001a00000022"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000035-0000-004f-0000-000400000072"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000065-0000-001a-0000-00680000004d"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000002f-0000-0037-0000-00020000000f"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000023-0000-0040-0000-005b0000001c"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000000-0000-0074-0000-007b00000019"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000004e-0000-0025-0000-006900000014"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000063-0000-0000-0000-002100000043"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000004e-0000-0018-0000-004d0000003a"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000052-0000-004e-0000-002700000075"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000046-0000-0014-0000-000100000040"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000049-0000-0004-0000-00280000000a"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000004-0000-0012-0000-00150000006e"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000009-0000-003c-0000-006400000055"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000008-0000-003d-0000-003c00000003"))))) - ] - ) - -testObject_TeamConversationList_team_14 :: TeamConversationList -testObject_TeamConversationList_team_14 = - ( newTeamConversationList - [ (newTeamConversation ((Id (fromJust (UUID.fromString "00000039-0000-005c-0000-000e00000044"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000080-0000-0061-0000-005d00000066"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000011-0000-0009-0000-006c00000065"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000002a-0000-0026-0000-001e00000007"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000023-0000-005e-0000-007300000058"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000056-0000-006a-0000-004100000045"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000006d-0000-0027-0000-00080000000d"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000024-0000-0028-0000-007700000051"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000004-0000-001c-0000-004c00000073"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000006f-0000-002f-0000-003400000023"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000005d-0000-0057-0000-00580000006a"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000034-0000-0016-0000-002500000036"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000033-0000-006c-0000-00420000003d"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000008-0000-005d-0000-004600000002"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000006a-0000-002b-0000-005800000035"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000006e-0000-0007-0000-005800000075"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000047-0000-002b-0000-000100000080"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000013-0000-001b-0000-003200000000"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000006-0000-0013-0000-004d0000006e"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000074-0000-0041-0000-007200000079"))))) - ] - ) - -testObject_TeamConversationList_team_15 :: TeamConversationList -testObject_TeamConversationList_team_15 = - ( newTeamConversationList - [ (newTeamConversation ((Id (fromJust (UUID.fromString "0000001a-0000-0013-0000-006400000036"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000070-0000-007e-0000-002f00000057"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000002-0000-006e-0000-006800000040"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000080-0000-005a-0000-000e00000024"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000069-0000-007c-0000-00550000002f"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000068-0000-0041-0000-000e0000003e"))))) - ] - ) - -testObject_TeamConversationList_team_16 :: TeamConversationList -testObject_TeamConversationList_team_16 = - ( newTeamConversationList - [ (newTeamConversation ((Id (fromJust (UUID.fromString "00000012-0000-0066-0000-003800000061"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000049-0000-0007-0000-003f0000001d"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000045-0000-0038-0000-005f00000072"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000032-0000-0069-0000-005b00000011"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000053-0000-0073-0000-00280000005d"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000046-0000-0068-0000-004f00000042"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000003-0000-0056-0000-00780000000f"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000006b-0000-0064-0000-001b00000024"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000004e-0000-0052-0000-004000000072"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000052-0000-0080-0000-005100000029"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000079-0000-0018-0000-000600000047"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000009-0000-0029-0000-003100000043"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000048-0000-002e-0000-00220000005b"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000003b-0000-004d-0000-001700000055"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000006c-0000-0028-0000-002100000076"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000033-0000-0052-0000-003300000080"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000004c-0000-005f-0000-00390000004d"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000007a-0000-004b-0000-00440000003e"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000052-0000-007a-0000-003d00000036"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000018-0000-0058-0000-003700000019"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000034-0000-0011-0000-007c00000011"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000056-0000-0057-0000-00630000002b"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000051-0000-0018-0000-00590000007a"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000004b-0000-0011-0000-002100000014"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000060-0000-0003-0000-00490000001b"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000042-0000-006e-0000-001e0000001a"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000005d-0000-0065-0000-004b00000045"))))) - ] - ) - -testObject_TeamConversationList_team_17 :: TeamConversationList -testObject_TeamConversationList_team_17 = - ( newTeamConversationList - [ (newTeamConversation ((Id (fromJust (UUID.fromString "00000053-0000-0070-0000-007f0000001c"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000036-0000-0017-0000-002a00000076"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000065-0000-004f-0000-00710000002d"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000067-0000-0037-0000-004d0000007b"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000004-0000-0071-0000-000800000015"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000047-0000-0062-0000-002900000024"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000072-0000-0027-0000-001300000046"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000000f-0000-0034-0000-00720000000f"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000021-0000-005d-0000-003300000024"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000023-0000-000b-0000-00160000000d"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000022-0000-0042-0000-003400000043"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000020-0000-0033-0000-00780000006b"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000074-0000-0067-0000-005f00000042"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000000f-0000-0079-0000-00630000007e"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000001a-0000-0045-0000-003900000053"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000000-0000-003e-0000-003d00000000"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000039-0000-0052-0000-000500000034"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000004e-0000-002d-0000-00030000005c"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000036-0000-0067-0000-007400000054"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000047-0000-0075-0000-001200000054"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000002e-0000-003d-0000-000700000080"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000005d-0000-0006-0000-00010000001a"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000012-0000-0073-0000-002000000058"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000073-0000-0015-0000-005e0000006e"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000047-0000-0019-0000-00510000005a"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000004b-0000-0074-0000-007000000021"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000007a-0000-0040-0000-006f00000075"))))) - ] - ) - -testObject_TeamConversationList_team_18 :: TeamConversationList -testObject_TeamConversationList_team_18 = - ( newTeamConversationList - [ (newTeamConversation ((Id (fromJust (UUID.fromString "00000049-0000-000d-0000-007600000068"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000002a-0000-0033-0000-006400000019"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000080-0000-0075-0000-00400000004e"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000062-0000-0073-0000-002a00000051"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000003b-0000-004b-0000-005c00000064"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000016-0000-001a-0000-00430000003d"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000002f-0000-0005-0000-004f00000031"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000000-0000-0043-0000-001a0000000c"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000003-0000-001c-0000-003a0000002b"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000001c-0000-007b-0000-00170000000a"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000073-0000-0073-0000-000000000074"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000005b-0000-0069-0000-00490000002d"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000003c-0000-0012-0000-000400000000"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000016-0000-004e-0000-003800000057"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000008-0000-0022-0000-002000000004"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000070-0000-0011-0000-00260000004a"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000002c-0000-007a-0000-00340000006e"))))) - ] - ) - -testObject_TeamConversationList_team_19 :: TeamConversationList -testObject_TeamConversationList_team_19 = - ( newTeamConversationList - [ (newTeamConversation ((Id (fromJust (UUID.fromString "00000000-0000-0041-0000-007b00000060"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000003f-0000-0059-0000-000700000073"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000065-0000-0056-0000-007e00000066"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000002b-0000-000b-0000-007a00000065"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000071-0000-003a-0000-001b00000027"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000070-0000-004f-0000-008000000008"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000003c-0000-000d-0000-00510000005a"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000045-0000-006e-0000-004200000072"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000001b-0000-003b-0000-007900000004"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000002d-0000-0077-0000-006400000054"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000001a-0000-005e-0000-003e00000012"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000057-0000-000c-0000-00370000003b"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000031-0000-0010-0000-006500000077"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000028-0000-004b-0000-00460000007b"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000005-0000-0040-0000-006400000024"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000042-0000-005b-0000-002d00000031"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000065-0000-0067-0000-00610000006d"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000007f-0000-0036-0000-00770000000d"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000058-0000-0042-0000-003700000054"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000002a-0000-0001-0000-000700000015"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000002f-0000-003c-0000-003b00000000"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "00000065-0000-0049-0000-00720000006c"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000000f-0000-0021-0000-004c00000055"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000005b-0000-002e-0000-00140000003d"))))) - ] - ) - -testObject_TeamConversationList_team_20 :: TeamConversationList -testObject_TeamConversationList_team_20 = - ( newTeamConversationList - [ (newTeamConversation ((Id (fromJust (UUID.fromString "00000007-0000-0017-0000-007500000074"))))), - (newTeamConversation ((Id (fromJust (UUID.fromString "0000003b-0000-0055-0000-003f00000059"))))) - ] - ) + newTeamConversationList + [ newTeamConversation (Id (fromJust (UUID.fromString "00000064-0000-0045-0000-007d00000023"))), + newTeamConversation (Id (fromJust (UUID.fromString "0000000d-0000-0080-0000-00550000001b"))) + ] diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/TeamConversation_team.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/TeamConversation_team.hs index 8f519c4f5f1..cbcce2a5b7b 100644 --- a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/TeamConversation_team.hs +++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/TeamConversation_team.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE OverloadedLists #-} - -- This file is part of the Wire Server implementation. -- -- Copyright (C) 2022 Wire Swiss GmbH @@ -26,80 +24,8 @@ import Wire.API.Team.Conversation (TeamConversation, newTeamConversation) testObject_TeamConversation_team_1 :: TeamConversation testObject_TeamConversation_team_1 = - (newTeamConversation ((Id (fromJust (UUID.fromString "00000054-0000-0032-0000-001d0000003e"))))) + newTeamConversation (Id (fromJust (UUID.fromString "00000054-0000-0032-0000-001d0000003e"))) testObject_TeamConversation_team_2 :: TeamConversation testObject_TeamConversation_team_2 = - (newTeamConversation ((Id (fromJust (UUID.fromString "00000021-0000-0059-0000-00390000004c"))))) - -testObject_TeamConversation_team_3 :: TeamConversation -testObject_TeamConversation_team_3 = - (newTeamConversation ((Id (fromJust (UUID.fromString "00000020-0000-0022-0000-00550000003b"))))) - -testObject_TeamConversation_team_4 :: TeamConversation -testObject_TeamConversation_team_4 = - (newTeamConversation ((Id (fromJust (UUID.fromString "0000002d-0000-0034-0000-004600000023"))))) - -testObject_TeamConversation_team_5 :: TeamConversation -testObject_TeamConversation_team_5 = - (newTeamConversation ((Id (fromJust (UUID.fromString "0000007d-0000-005d-0000-003d00000076"))))) - -testObject_TeamConversation_team_6 :: TeamConversation -testObject_TeamConversation_team_6 = - (newTeamConversation ((Id (fromJust (UUID.fromString "0000000a-0000-0013-0000-00420000002e"))))) - -testObject_TeamConversation_team_7 :: TeamConversation -testObject_TeamConversation_team_7 = - (newTeamConversation ((Id (fromJust (UUID.fromString "0000005d-0000-0080-0000-002800000080"))))) - -testObject_TeamConversation_team_8 :: TeamConversation -testObject_TeamConversation_team_8 = - (newTeamConversation ((Id (fromJust (UUID.fromString "0000002e-0000-006d-0000-003700000042"))))) - -testObject_TeamConversation_team_9 :: TeamConversation -testObject_TeamConversation_team_9 = - (newTeamConversation ((Id (fromJust (UUID.fromString "0000000d-0000-001b-0000-006800000047"))))) - -testObject_TeamConversation_team_10 :: TeamConversation -testObject_TeamConversation_team_10 = - (newTeamConversation ((Id (fromJust (UUID.fromString "00000023-0000-0024-0000-003200000067"))))) - -testObject_TeamConversation_team_11 :: TeamConversation -testObject_TeamConversation_team_11 = - (newTeamConversation ((Id (fromJust (UUID.fromString "00000003-0000-0041-0000-002600000041"))))) - -testObject_TeamConversation_team_12 :: TeamConversation -testObject_TeamConversation_team_12 = - (newTeamConversation ((Id (fromJust (UUID.fromString "0000007d-0000-0049-0000-001f00000034"))))) - -testObject_TeamConversation_team_13 :: TeamConversation -testObject_TeamConversation_team_13 = - (newTeamConversation ((Id (fromJust (UUID.fromString "00000025-0000-003c-0000-003d00000032"))))) - -testObject_TeamConversation_team_14 :: TeamConversation -testObject_TeamConversation_team_14 = - (newTeamConversation ((Id (fromJust (UUID.fromString "0000005b-0000-0065-0000-002a00000060"))))) - -testObject_TeamConversation_team_15 :: TeamConversation -testObject_TeamConversation_team_15 = - (newTeamConversation ((Id (fromJust (UUID.fromString "0000001f-0000-0037-0000-005a0000004d"))))) - -testObject_TeamConversation_team_16 :: TeamConversation -testObject_TeamConversation_team_16 = - (newTeamConversation ((Id (fromJust (UUID.fromString "00000044-0000-000a-0000-007f0000001d"))))) - -testObject_TeamConversation_team_17 :: TeamConversation -testObject_TeamConversation_team_17 = - (newTeamConversation ((Id (fromJust (UUID.fromString "00000009-0000-0060-0000-005c00000049"))))) - -testObject_TeamConversation_team_18 :: TeamConversation -testObject_TeamConversation_team_18 = - (newTeamConversation ((Id (fromJust (UUID.fromString "0000005f-0000-0051-0000-003d00000026"))))) - -testObject_TeamConversation_team_19 :: TeamConversation -testObject_TeamConversation_team_19 = - (newTeamConversation ((Id (fromJust (UUID.fromString "0000003d-0000-0025-0000-00170000002e"))))) - -testObject_TeamConversation_team_20 :: TeamConversation -testObject_TeamConversation_team_20 = - (newTeamConversation ((Id (fromJust (UUID.fromString "00000007-0000-0053-0000-001500000035"))))) + newTeamConversation (Id (fromJust (UUID.fromString "00000021-0000-0059-0000-00390000004c"))) diff --git a/libs/wire-api/test/golden/fromJSON/testObject_NewConvManaged_user_2.json b/libs/wire-api/test/golden/fromJSON/testObject_NewConvManaged_user_2.json deleted file mode 100644 index f3820d40cc6..00000000000 --- a/libs/wire-api/test/golden/fromJSON/testObject_NewConvManaged_user_2.json +++ /dev/null @@ -1,24 +0,0 @@ -{ - "access": [ - "private", - "invite", - "link" - ], - "access_role": "non_activated", - "conversation_role": "bewzponl1a3c_l6ou", - "message_timer": 5509522199847054, - "name": "󳂣\u001a5", - "qualified_users": [ - { - "domain": "test.example.com", - "id": "00000000-0000-0000-0000-000100000001" - } - ], - "team": { - "managed": false, - "teamid": "00000002-0000-0002-0000-000200000002" - }, - "users": [ - "00000002-0000-0001-0000-000400000000" - ] -} diff --git a/libs/wire-api/test/golden/fromJSON/testObject_NewConvUnmanaged_user_1.json b/libs/wire-api/test/golden/fromJSON/testObject_NewConvUnmanaged_user_1.json deleted file mode 100644 index f58dad1b1a9..00000000000 --- a/libs/wire-api/test/golden/fromJSON/testObject_NewConvUnmanaged_user_1.json +++ /dev/null @@ -1,22 +0,0 @@ -{ - "access": [ - "private", - "invite" - ], - "access_role_v2": [ - "team_member", - "guest" - ], - "users": [ - "00000001-0000-0000-0000-000000000001", - "00000000-0000-0000-0000-000000000000" - ], - "conversation_role": "8tp2gs7b6", - "team": { - "managed": false, - "teamid": "00000000-0000-0001-0000-000000000000" - }, - "receipt_mode": 1, - "message_timer": 3320987366258987, - "qualified_users": [] -} diff --git a/libs/wire-api/test/golden/fromJSON/testObject_NewConvUnmanaged_user_2.json b/libs/wire-api/test/golden/fromJSON/testObject_NewConvUnmanaged_user_2.json deleted file mode 100644 index aae8702ff67..00000000000 --- a/libs/wire-api/test/golden/fromJSON/testObject_NewConvUnmanaged_user_2.json +++ /dev/null @@ -1,18 +0,0 @@ -{ - "access": [], - "conversation_role": "vmao7psxph3fenvbpsu1u57fns5pfo53d67k98om378rnxr0crcpak_mpspn8q_3m1b02n2n133s1d7q5w3qgmt_5e_dgtvzon8an7dtauiecd32", - "message_timer": 2406292360203739, - "name": "😏􃉷", - "qualified_users": [ - { - "domain": "testdomain.example.com", - "id": "00000000-0000-0000-0000-000100000001" - } - ], - "receipt_mode": -1, - "team": { - "managed": true, - "teamid": "00000000-0000-0001-0000-000000000001" - }, - "users": [] -} diff --git a/libs/wire-api/test/golden/testObject_TeamConversationList_team_1.json b/libs/wire-api/test/golden/testObject_TeamConversationList_team_1.json index 3248c22295b..8ff30f176f4 100644 --- a/libs/wire-api/test/golden/testObject_TeamConversationList_team_1.json +++ b/libs/wire-api/test/golden/testObject_TeamConversationList_team_1.json @@ -7,66 +7,6 @@ { "conversation": "0000002d-0000-0063-0000-006900000013", "managed": false - }, - { - "conversation": "0000002e-0000-003c-0000-00440000000e", - "managed": false - }, - { - "conversation": "00000067-0000-003a-0000-006100000049", - "managed": false - }, - { - "conversation": "0000005f-0000-0003-0000-005a00000075", - "managed": false - }, - { - "conversation": "0000007f-0000-0018-0000-00250000007c", - "managed": false - }, - { - "conversation": "0000006a-0000-0020-0000-001a00000073", - "managed": false - }, - { - "conversation": "0000002e-0000-006a-0000-005f00000003", - "managed": false - }, - { - "conversation": "00000034-0000-0021-0000-00330000005b", - "managed": false - }, - { - "conversation": "00000048-0000-0011-0000-002a00000004", - "managed": false - }, - { - "conversation": "00000031-0000-0018-0000-00060000001a", - "managed": false - }, - { - "conversation": "00000056-0000-000e-0000-004300000028", - "managed": false - }, - { - "conversation": "00000067-0000-007f-0000-003600000031", - "managed": false - }, - { - "conversation": "00000066-0000-0053-0000-006a00000034", - "managed": false - }, - { - "conversation": "0000000f-0000-0071-0000-001b00000057", - "managed": false - }, - { - "conversation": "00000032-0000-0035-0000-00210000003b", - "managed": false - }, - { - "conversation": "00000004-0000-000d-0000-002100000067", - "managed": false } ] } diff --git a/libs/wire-api/test/golden/testObject_TeamConversationList_team_10.json b/libs/wire-api/test/golden/testObject_TeamConversationList_team_10.json deleted file mode 100644 index 5a7f04fd53d..00000000000 --- a/libs/wire-api/test/golden/testObject_TeamConversationList_team_10.json +++ /dev/null @@ -1,28 +0,0 @@ -{ - "conversations": [ - { - "conversation": "00000070-0000-007d-0000-001400000009", - "managed": false - }, - { - "conversation": "00000065-0000-0057-0000-00190000004a", - "managed": false - }, - { - "conversation": "00000049-0000-0030-0000-006b00000005", - "managed": false - }, - { - "conversation": "0000007c-0000-0065-0000-001100000066", - "managed": false - }, - { - "conversation": "00000057-0000-0039-0000-000400000071", - "managed": false - }, - { - "conversation": "0000003e-0000-0053-0000-007f0000003c", - "managed": false - } - ] -} diff --git a/libs/wire-api/test/golden/testObject_TeamConversationList_team_11.json b/libs/wire-api/test/golden/testObject_TeamConversationList_team_11.json deleted file mode 100644 index cd3dde1b948..00000000000 --- a/libs/wire-api/test/golden/testObject_TeamConversationList_team_11.json +++ /dev/null @@ -1,20 +0,0 @@ -{ - "conversations": [ - { - "conversation": "00000038-0000-0030-0000-006700000067", - "managed": false - }, - { - "conversation": "00000000-0000-006a-0000-00220000007c", - "managed": false - }, - { - "conversation": "00000055-0000-004f-0000-005500000047", - "managed": false - }, - { - "conversation": "00000064-0000-003d-0000-006500000060", - "managed": false - } - ] -} diff --git a/libs/wire-api/test/golden/testObject_TeamConversationList_team_12.json b/libs/wire-api/test/golden/testObject_TeamConversationList_team_12.json deleted file mode 100644 index 1ce03386ffd..00000000000 --- a/libs/wire-api/test/golden/testObject_TeamConversationList_team_12.json +++ /dev/null @@ -1,92 +0,0 @@ -{ - "conversations": [ - { - "conversation": "00000056-0000-0042-0000-00120000004e", - "managed": false - }, - { - "conversation": "00000010-0000-002b-0000-002600000066", - "managed": false - }, - { - "conversation": "0000006b-0000-0054-0000-005300000004", - "managed": false - }, - { - "conversation": "0000000e-0000-006f-0000-000c00000038", - "managed": false - }, - { - "conversation": "00000038-0000-0021-0000-005500000008", - "managed": false - }, - { - "conversation": "0000005b-0000-007a-0000-00230000002d", - "managed": false - }, - { - "conversation": "00000078-0000-000e-0000-004300000065", - "managed": false - }, - { - "conversation": "00000036-0000-0003-0000-000500000011", - "managed": false - }, - { - "conversation": "00000043-0000-0032-0000-005200000069", - "managed": false - }, - { - "conversation": "0000000c-0000-0003-0000-001400000018", - "managed": false - }, - { - "conversation": "0000002a-0000-0020-0000-005200000053", - "managed": false - }, - { - "conversation": "00000047-0000-007b-0000-00670000000b", - "managed": false - }, - { - "conversation": "0000001a-0000-005b-0000-00250000000c", - "managed": false - }, - { - "conversation": "0000004b-0000-005b-0000-004200000001", - "managed": false - }, - { - "conversation": "00000057-0000-0073-0000-003d00000006", - "managed": false - }, - { - "conversation": "00000053-0000-0038-0000-006600000048", - "managed": false - }, - { - "conversation": "0000000d-0000-0022-0000-00800000006f", - "managed": false - }, - { - "conversation": "0000005e-0000-0023-0000-000700000012", - "managed": false - }, - { - "conversation": "00000046-0000-0071-0000-005f00000070", - "managed": false - }, - { - "conversation": "00000056-0000-0024-0000-003400000018", - "managed": false - }, - { - "conversation": "00000054-0000-0056-0000-007000000058", - "managed": false - }, - { - "conversation": "00000046-0000-0011-0000-001500000007", - "managed": false - } - ] -} diff --git a/libs/wire-api/test/golden/testObject_TeamConversationList_team_13.json b/libs/wire-api/test/golden/testObject_TeamConversationList_team_13.json deleted file mode 100644 index 76a0c7ecc99..00000000000 --- a/libs/wire-api/test/golden/testObject_TeamConversationList_team_13.json +++ /dev/null @@ -1,88 +0,0 @@ -{ - "conversations": [ - { - "conversation": "0000006a-0000-0043-0000-007f00000048", - "managed": false - }, - { - "conversation": "0000007d-0000-005f-0000-000a00000024", - "managed": false - }, - { - "conversation": "0000007a-0000-0046-0000-003800000023", - "managed": false - }, - { - "conversation": "00000023-0000-006b-0000-002000000068", - "managed": false - }, - { - "conversation": "00000041-0000-0000-0000-007000000005", - "managed": false - }, - { - "conversation": "0000007a-0000-0075-0000-00200000007a", - "managed": false - }, - { - "conversation": "00000038-0000-0023-0000-001a00000022", - "managed": false - }, - { - "conversation": "00000035-0000-004f-0000-000400000072", - "managed": false - }, - { - "conversation": "00000065-0000-001a-0000-00680000004d", - "managed": false - }, - { - "conversation": "0000002f-0000-0037-0000-00020000000f", - "managed": false - }, - { - "conversation": "00000023-0000-0040-0000-005b0000001c", - "managed": false - }, - { - "conversation": "00000000-0000-0074-0000-007b00000019", - "managed": false - }, - { - "conversation": "0000004e-0000-0025-0000-006900000014", - "managed": false - }, - { - "conversation": "00000063-0000-0000-0000-002100000043", - "managed": false - }, - { - "conversation": "0000004e-0000-0018-0000-004d0000003a", - "managed": false - }, - { - "conversation": "00000052-0000-004e-0000-002700000075", - "managed": false - }, - { - "conversation": "00000046-0000-0014-0000-000100000040", - "managed": false - }, - { - "conversation": "00000049-0000-0004-0000-00280000000a", - "managed": false - }, - { - "conversation": "00000004-0000-0012-0000-00150000006e", - "managed": false - }, - { - "conversation": "00000009-0000-003c-0000-006400000055", - "managed": false - }, - { - "conversation": "00000008-0000-003d-0000-003c00000003", - "managed": false - } - ] -} diff --git a/libs/wire-api/test/golden/testObject_TeamConversationList_team_14.json b/libs/wire-api/test/golden/testObject_TeamConversationList_team_14.json deleted file mode 100644 index 3c118b9fcef..00000000000 --- a/libs/wire-api/test/golden/testObject_TeamConversationList_team_14.json +++ /dev/null @@ -1,84 +0,0 @@ -{ - "conversations": [ - { - "conversation": "00000039-0000-005c-0000-000e00000044", - "managed": false - }, - { - "conversation": "00000080-0000-0061-0000-005d00000066", - "managed": false - }, - { - "conversation": "00000011-0000-0009-0000-006c00000065", - "managed": false - }, - { - "conversation": "0000002a-0000-0026-0000-001e00000007", - "managed": false - }, - { - "conversation": "00000023-0000-005e-0000-007300000058", - "managed": false - }, - { - "conversation": "00000056-0000-006a-0000-004100000045", - "managed": false - }, - { - "conversation": "0000006d-0000-0027-0000-00080000000d", - "managed": false - }, - { - "conversation": "00000024-0000-0028-0000-007700000051", - "managed": false - }, - { - "conversation": "00000004-0000-001c-0000-004c00000073", - "managed": false - }, - { - "conversation": "0000006f-0000-002f-0000-003400000023", - "managed": false - }, - { - "conversation": "0000005d-0000-0057-0000-00580000006a", - "managed": false - }, - { - "conversation": "00000034-0000-0016-0000-002500000036", - "managed": false - }, - { - "conversation": "00000033-0000-006c-0000-00420000003d", - "managed": false - }, - { - "conversation": "00000008-0000-005d-0000-004600000002", - "managed": false - }, - { - "conversation": "0000006a-0000-002b-0000-005800000035", - "managed": false - }, - { - "conversation": "0000006e-0000-0007-0000-005800000075", - "managed": false - }, - { - "conversation": "00000047-0000-002b-0000-000100000080", - "managed": false - }, - { - "conversation": "00000013-0000-001b-0000-003200000000", - "managed": false - }, - { - "conversation": "00000006-0000-0013-0000-004d0000006e", - "managed": false - }, - { - "conversation": "00000074-0000-0041-0000-007200000079", - "managed": false - } - ] -} diff --git a/libs/wire-api/test/golden/testObject_TeamConversationList_team_15.json b/libs/wire-api/test/golden/testObject_TeamConversationList_team_15.json deleted file mode 100644 index 05b3262d3a0..00000000000 --- a/libs/wire-api/test/golden/testObject_TeamConversationList_team_15.json +++ /dev/null @@ -1,28 +0,0 @@ -{ - "conversations": [ - { - "conversation": "0000001a-0000-0013-0000-006400000036", - "managed": false - }, - { - "conversation": "00000070-0000-007e-0000-002f00000057", - "managed": false - }, - { - "conversation": "00000002-0000-006e-0000-006800000040", - "managed": false - }, - { - "conversation": "00000080-0000-005a-0000-000e00000024", - "managed": false - }, - { - "conversation": "00000069-0000-007c-0000-00550000002f", - "managed": false - }, - { - "conversation": "00000068-0000-0041-0000-000e0000003e", - "managed": false - } - ] -} diff --git a/libs/wire-api/test/golden/testObject_TeamConversationList_team_16.json b/libs/wire-api/test/golden/testObject_TeamConversationList_team_16.json deleted file mode 100644 index 04835850c9f..00000000000 --- a/libs/wire-api/test/golden/testObject_TeamConversationList_team_16.json +++ /dev/null @@ -1,112 +0,0 @@ -{ - "conversations": [ - { - "conversation": "00000012-0000-0066-0000-003800000061", - "managed": false - }, - { - "conversation": "00000049-0000-0007-0000-003f0000001d", - "managed": false - }, - { - "conversation": "00000045-0000-0038-0000-005f00000072", - "managed": false - }, - { - "conversation": "00000032-0000-0069-0000-005b00000011", - "managed": false - }, - { - "conversation": "00000053-0000-0073-0000-00280000005d", - "managed": false - }, - { - "conversation": "00000046-0000-0068-0000-004f00000042", - "managed": false - }, - { - "conversation": "00000003-0000-0056-0000-00780000000f", - "managed": false - }, - { - "conversation": "0000006b-0000-0064-0000-001b00000024", - "managed": false - }, - { - "conversation": "0000004e-0000-0052-0000-004000000072", - "managed": false - }, - { - "conversation": "00000052-0000-0080-0000-005100000029", - "managed": false - }, - { - "conversation": "00000079-0000-0018-0000-000600000047", - "managed": false - }, - { - "conversation": "00000009-0000-0029-0000-003100000043", - "managed": false - }, - { - "conversation": "00000048-0000-002e-0000-00220000005b", - "managed": false - }, - { - "conversation": "0000003b-0000-004d-0000-001700000055", - "managed": false - }, - { - "conversation": "0000006c-0000-0028-0000-002100000076", - "managed": false - }, - { - "conversation": "00000033-0000-0052-0000-003300000080", - "managed": false - }, - { - "conversation": "0000004c-0000-005f-0000-00390000004d", - "managed": false - }, - { - "conversation": "0000007a-0000-004b-0000-00440000003e", - "managed": false - }, - { - "conversation": "00000052-0000-007a-0000-003d00000036", - "managed": false - }, - { - "conversation": "00000018-0000-0058-0000-003700000019", - "managed": false - }, - { - "conversation": "00000034-0000-0011-0000-007c00000011", - "managed": false - }, - { - "conversation": "00000056-0000-0057-0000-00630000002b", - "managed": false - }, - { - "conversation": "00000051-0000-0018-0000-00590000007a", - "managed": false - }, - { - "conversation": "0000004b-0000-0011-0000-002100000014", - "managed": false - }, - { - "conversation": "00000060-0000-0003-0000-00490000001b", - "managed": false - }, - { - "conversation": "00000042-0000-006e-0000-001e0000001a", - "managed": false - }, - { - "conversation": "0000005d-0000-0065-0000-004b00000045", - "managed": false - } - ] -} diff --git a/libs/wire-api/test/golden/testObject_TeamConversationList_team_17.json b/libs/wire-api/test/golden/testObject_TeamConversationList_team_17.json deleted file mode 100644 index 7361261cb69..00000000000 --- a/libs/wire-api/test/golden/testObject_TeamConversationList_team_17.json +++ /dev/null @@ -1,112 +0,0 @@ -{ - "conversations": [ - { - "conversation": "00000053-0000-0070-0000-007f0000001c", - "managed": false - }, - { - "conversation": "00000036-0000-0017-0000-002a00000076", - "managed": false - }, - { - "conversation": "00000065-0000-004f-0000-00710000002d", - "managed": false - }, - { - "conversation": "00000067-0000-0037-0000-004d0000007b", - "managed": false - }, - { - "conversation": "00000004-0000-0071-0000-000800000015", - "managed": false - }, - { - "conversation": "00000047-0000-0062-0000-002900000024", - "managed": false - }, - { - "conversation": "00000072-0000-0027-0000-001300000046", - "managed": false - }, - { - "conversation": "0000000f-0000-0034-0000-00720000000f", - "managed": false - }, - { - "conversation": "00000021-0000-005d-0000-003300000024", - "managed": false - }, - { - "conversation": "00000023-0000-000b-0000-00160000000d", - "managed": false - }, - { - "conversation": "00000022-0000-0042-0000-003400000043", - "managed": false - }, - { - "conversation": "00000020-0000-0033-0000-00780000006b", - "managed": false - }, - { - "conversation": "00000074-0000-0067-0000-005f00000042", - "managed": false - }, - { - "conversation": "0000000f-0000-0079-0000-00630000007e", - "managed": false - }, - { - "conversation": "0000001a-0000-0045-0000-003900000053", - "managed": false - }, - { - "conversation": "00000000-0000-003e-0000-003d00000000", - "managed": false - }, - { - "conversation": "00000039-0000-0052-0000-000500000034", - "managed": false - }, - { - "conversation": "0000004e-0000-002d-0000-00030000005c", - "managed": false - }, - { - "conversation": "00000036-0000-0067-0000-007400000054", - "managed": false - }, - { - "conversation": "00000047-0000-0075-0000-001200000054", - "managed": false - }, - { - "conversation": "0000002e-0000-003d-0000-000700000080", - "managed": false - }, - { - "conversation": "0000005d-0000-0006-0000-00010000001a", - "managed": false - }, - { - "conversation": "00000012-0000-0073-0000-002000000058", - "managed": false - }, - { - "conversation": "00000073-0000-0015-0000-005e0000006e", - "managed": false - }, - { - "conversation": "00000047-0000-0019-0000-00510000005a", - "managed": false - }, - { - "conversation": "0000004b-0000-0074-0000-007000000021", - "managed": false - }, - { - "conversation": "0000007a-0000-0040-0000-006f00000075", - "managed": false - } - ] -} diff --git a/libs/wire-api/test/golden/testObject_TeamConversationList_team_18.json b/libs/wire-api/test/golden/testObject_TeamConversationList_team_18.json deleted file mode 100644 index 2ddbcdbac5e..00000000000 --- a/libs/wire-api/test/golden/testObject_TeamConversationList_team_18.json +++ /dev/null @@ -1,72 +0,0 @@ -{ - "conversations": [ - { - "conversation": "00000049-0000-000d-0000-007600000068", - "managed": false - }, - { - "conversation": "0000002a-0000-0033-0000-006400000019", - "managed": false - }, - { - "conversation": "00000080-0000-0075-0000-00400000004e", - "managed": false - }, - { - "conversation": "00000062-0000-0073-0000-002a00000051", - "managed": false - }, - { - "conversation": "0000003b-0000-004b-0000-005c00000064", - "managed": false - }, - { - "conversation": "00000016-0000-001a-0000-00430000003d", - "managed": false - }, - { - "conversation": "0000002f-0000-0005-0000-004f00000031", - "managed": false - }, - { - "conversation": "00000000-0000-0043-0000-001a0000000c", - "managed": false - }, - { - "conversation": "00000003-0000-001c-0000-003a0000002b", - "managed": false - }, - { - "conversation": "0000001c-0000-007b-0000-00170000000a", - "managed": false - }, - { - "conversation": "00000073-0000-0073-0000-000000000074", - "managed": false - }, - { - "conversation": "0000005b-0000-0069-0000-00490000002d", - "managed": false - }, - { - "conversation": "0000003c-0000-0012-0000-000400000000", - "managed": false - }, - { - "conversation": "00000016-0000-004e-0000-003800000057", - "managed": false - }, - { - "conversation": "00000008-0000-0022-0000-002000000004", - "managed": false - }, - { - "conversation": "00000070-0000-0011-0000-00260000004a", - "managed": false - }, - { - "conversation": "0000002c-0000-007a-0000-00340000006e", - "managed": false - } - ] -} diff --git a/libs/wire-api/test/golden/testObject_TeamConversationList_team_19.json b/libs/wire-api/test/golden/testObject_TeamConversationList_team_19.json deleted file mode 100644 index f8ff6ae2764..00000000000 --- a/libs/wire-api/test/golden/testObject_TeamConversationList_team_19.json +++ /dev/null @@ -1,100 +0,0 @@ -{ - "conversations": [ - { - "conversation": "00000000-0000-0041-0000-007b00000060", - "managed": false - }, - { - "conversation": "0000003f-0000-0059-0000-000700000073", - "managed": false - }, - { - "conversation": "00000065-0000-0056-0000-007e00000066", - "managed": false - }, - { - "conversation": "0000002b-0000-000b-0000-007a00000065", - "managed": false - }, - { - "conversation": "00000071-0000-003a-0000-001b00000027", - "managed": false - }, - { - "conversation": "00000070-0000-004f-0000-008000000008", - "managed": false - }, - { - "conversation": "0000003c-0000-000d-0000-00510000005a", - "managed": false - }, - { - "conversation": "00000045-0000-006e-0000-004200000072", - "managed": false - }, - { - "conversation": "0000001b-0000-003b-0000-007900000004", - "managed": false - }, - { - "conversation": "0000002d-0000-0077-0000-006400000054", - "managed": false - }, - { - "conversation": "0000001a-0000-005e-0000-003e00000012", - "managed": false - }, - { - "conversation": "00000057-0000-000c-0000-00370000003b", - "managed": false - }, - { - "conversation": "00000031-0000-0010-0000-006500000077", - "managed": false - }, - { - "conversation": "00000028-0000-004b-0000-00460000007b", - "managed": false - }, - { - "conversation": "00000005-0000-0040-0000-006400000024", - "managed": false - }, - { - "conversation": "00000042-0000-005b-0000-002d00000031", - "managed": false - }, - { - "conversation": "00000065-0000-0067-0000-00610000006d", - "managed": false - }, - { - "conversation": "0000007f-0000-0036-0000-00770000000d", - "managed": false - }, - { - "conversation": "00000058-0000-0042-0000-003700000054", - "managed": false - }, - { - "conversation": "0000002a-0000-0001-0000-000700000015", - "managed": false - }, - { - "conversation": "0000002f-0000-003c-0000-003b00000000", - "managed": false - }, - { - "conversation": "00000065-0000-0049-0000-00720000006c", - "managed": false - }, - { - "conversation": "0000000f-0000-0021-0000-004c00000055", - "managed": false - }, - { - "conversation": "0000005b-0000-002e-0000-00140000003d", - "managed": false - } - ] -} diff --git a/libs/wire-api/test/golden/testObject_TeamConversationList_team_2.json b/libs/wire-api/test/golden/testObject_TeamConversationList_team_2.json index 19a9f17bde5..e7dfd82620a 100644 --- a/libs/wire-api/test/golden/testObject_TeamConversationList_team_2.json +++ b/libs/wire-api/test/golden/testObject_TeamConversationList_team_2.json @@ -7,106 +7,6 @@ { "conversation": "0000000d-0000-0080-0000-00550000001b", "managed": false - }, - { - "conversation": "0000004e-0000-0053-0000-004600000056", - "managed": false - }, - { - "conversation": "0000006e-0000-003c-0000-003200000071", - "managed": false - }, - { - "conversation": "00000067-0000-002f-0000-007a0000007f", - "managed": false - }, - { - "conversation": "0000000a-0000-0027-0000-004e0000005f", - "managed": false - }, - { - "conversation": "00000006-0000-0026-0000-000000000054", - "managed": false - }, - { - "conversation": "0000006e-0000-007e-0000-001600000035", - "managed": false - }, - { - "conversation": "0000002c-0000-0057-0000-007e00000070", - "managed": false - }, - { - "conversation": "00000074-0000-0053-0000-005f00000006", - "managed": false - }, - { - "conversation": "00000028-0000-005c-0000-00050000006b", - "managed": false - }, - { - "conversation": "00000018-0000-0061-0000-004a00000024", - "managed": false - }, - { - "conversation": "0000005a-0000-007b-0000-000800000033", - "managed": false - }, - { - "conversation": "00000027-0000-0043-0000-006800000068", - "managed": false - }, - { - "conversation": "00000056-0000-0018-0000-003f00000001", - "managed": false - }, - { - "conversation": "00000014-0000-0066-0000-00440000001b", - "managed": false - }, - { - "conversation": "0000007f-0000-0071-0000-007f0000001b", - "managed": false - }, - { - "conversation": "00000018-0000-004d-0000-005000000080", - "managed": false - }, - { - "conversation": "00000018-0000-003e-0000-00140000006e", - "managed": false - }, - { - "conversation": "00000033-0000-005c-0000-001e0000000d", - "managed": false - }, - { - "conversation": "0000004d-0000-0021-0000-00360000000e", - "managed": false - }, - { - "conversation": "00000057-0000-003f-0000-003700000065", - "managed": false - }, - { - "conversation": "0000006f-0000-003e-0000-000300000051", - "managed": false - }, - { - "conversation": "00000038-0000-0025-0000-00030000003b", - "managed": false - }, - { - "conversation": "0000003c-0000-0069-0000-005000000035", - "managed": false - }, - { - "conversation": "0000005f-0000-006b-0000-00260000004e", - "managed": false - }, - { - "conversation": "0000001c-0000-001c-0000-00530000000c", - "managed": false } ] } diff --git a/libs/wire-api/test/golden/testObject_TeamConversationList_team_20.json b/libs/wire-api/test/golden/testObject_TeamConversationList_team_20.json deleted file mode 100644 index ac130821ff7..00000000000 --- a/libs/wire-api/test/golden/testObject_TeamConversationList_team_20.json +++ /dev/null @@ -1,12 +0,0 @@ -{ - "conversations": [ - { - "conversation": "00000007-0000-0017-0000-007500000074", - "managed": false - }, - { - "conversation": "0000003b-0000-0055-0000-003f00000059", - "managed": false - } - ] -} diff --git a/libs/wire-api/test/golden/testObject_TeamConversationList_team_3.json b/libs/wire-api/test/golden/testObject_TeamConversationList_team_3.json deleted file mode 100644 index c492ea34289..00000000000 --- a/libs/wire-api/test/golden/testObject_TeamConversationList_team_3.json +++ /dev/null @@ -1,44 +0,0 @@ -{ - "conversations": [ - { - "conversation": "00000046-0000-0026-0000-005600000014", - "managed": false - }, - { - "conversation": "0000006b-0000-0042-0000-002c00000074", - "managed": false - }, - { - "conversation": "0000006d-0000-006d-0000-006100000027", - "managed": false - }, - { - "conversation": "00000079-0000-0024-0000-004600000011", - "managed": false - }, - { - "conversation": "00000044-0000-0005-0000-003800000008", - "managed": false - }, - { - "conversation": "00000052-0000-005e-0000-00200000001a", - "managed": false - }, - { - "conversation": "00000009-0000-0038-0000-001b00000065", - "managed": false - }, - { - "conversation": "00000029-0000-0045-0000-004500000078", - "managed": false - }, - { - "conversation": "0000001e-0000-0036-0000-006400000045", - "managed": false - }, - { - "conversation": "00000050-0000-0066-0000-000500000075", - "managed": false - } - ] -} diff --git a/libs/wire-api/test/golden/testObject_TeamConversationList_team_4.json b/libs/wire-api/test/golden/testObject_TeamConversationList_team_4.json deleted file mode 100644 index 56cca582891..00000000000 --- a/libs/wire-api/test/golden/testObject_TeamConversationList_team_4.json +++ /dev/null @@ -1,120 +0,0 @@ -{ - "conversations": [ - { - "conversation": "00000076-0000-0038-0000-003c00000043", - "managed": false - }, - { - "conversation": "00000046-0000-001f-0000-005800000080", - "managed": false - }, - { - "conversation": "00000023-0000-0070-0000-006f00000077", - "managed": false - }, - { - "conversation": "00000006-0000-0031-0000-004700000053", - "managed": false - }, - { - "conversation": "00000057-0000-0041-0000-001600000013", - "managed": false - }, - { - "conversation": "0000007b-0000-003c-0000-004800000063", - "managed": false - }, - { - "conversation": "00000028-0000-0009-0000-004c00000009", - "managed": false - }, - { - "conversation": "0000001a-0000-007b-0000-00460000007f", - "managed": false - }, - { - "conversation": "00000052-0000-002e-0000-001000000064", - "managed": false - }, - { - "conversation": "0000003d-0000-002a-0000-00290000007b", - "managed": false - }, - { - "conversation": "00000004-0000-0033-0000-00780000005e", - "managed": false - }, - { - "conversation": "0000006b-0000-007f-0000-001d0000002c", - "managed": false - }, - { - "conversation": "00000017-0000-0079-0000-001c00000066", - "managed": false - }, - { - "conversation": "0000002f-0000-0024-0000-001000000074", - "managed": false - }, - { - "conversation": "00000010-0000-000c-0000-001700000046", - "managed": false - }, - { - "conversation": "00000003-0000-0049-0000-003100000022", - "managed": false - }, - { - "conversation": "00000011-0000-0051-0000-003300000061", - "managed": false - }, - { - "conversation": "0000003e-0000-0077-0000-004c00000022", - "managed": false - }, - { - "conversation": "0000007e-0000-0048-0000-007200000056", - "managed": false - }, - { - "conversation": "0000006f-0000-0007-0000-00190000004f", - "managed": false - }, - { - "conversation": "0000002d-0000-0048-0000-001c0000007e", - "managed": false - }, - { - "conversation": "0000004c-0000-0071-0000-007a00000071", - "managed": false - }, - { - "conversation": "00000006-0000-0002-0000-002000000068", - "managed": false - }, - { - "conversation": "0000002e-0000-0037-0000-005e00000027", - "managed": false - }, - { - "conversation": "00000056-0000-006d-0000-004d00000024", - "managed": false - }, - { - "conversation": "0000004a-0000-0038-0000-001e0000003b", - "managed": false - }, - { - "conversation": "00000033-0000-001a-0000-004a0000001a", - "managed": false - }, - { - "conversation": "0000001a-0000-0070-0000-007000000019", - "managed": false - }, - { - "conversation": "0000006b-0000-0013-0000-004a00000018", - "managed": false - } - ] -} diff --git a/libs/wire-api/test/golden/testObject_TeamConversationList_team_5.json b/libs/wire-api/test/golden/testObject_TeamConversationList_team_5.json deleted file mode 100644 index 9fc01c729f4..00000000000 --- a/libs/wire-api/test/golden/testObject_TeamConversationList_team_5.json +++ /dev/null @@ -1,16 +0,0 @@ -{ - "conversations": [ - { - "conversation": "00000073-0000-005a-0000-00250000000d", - "managed": false - }, - { - "conversation": "00000033-0000-005c-0000-006e00000014", - "managed": false - }, - { - "conversation": "00000017-0000-005d-0000-003b00000023", - "managed": false - } - ] -} diff --git a/libs/wire-api/test/golden/testObject_TeamConversationList_team_6.json b/libs/wire-api/test/golden/testObject_TeamConversationList_team_6.json deleted file mode 100644 index e3e2854092a..00000000000 --- a/libs/wire-api/test/golden/testObject_TeamConversationList_team_6.json +++ /dev/null @@ -1,40 +0,0 @@ -{ - "conversations": [ - { - "conversation": "0000007c-0000-007f-0000-00730000000d", - "managed": false - }, - { - "conversation": "00000028-0000-0037-0000-000b00000016", - "managed": false - }, - { - "conversation": "00000021-0000-0064-0000-003900000002", - "managed": false - }, - { - "conversation": "00000064-0000-001f-0000-00350000001b", - "managed": false - }, - { - "conversation": "0000002d-0000-007b-0000-00770000003e", - "managed": false - }, - { - "conversation": "00000064-0000-0068-0000-007700000068", - "managed": false - }, - { - "conversation": "00000061-0000-000b-0000-00170000005c", - "managed": false - }, - { - "conversation": "0000005c-0000-0001-0000-004e00000003", - "managed": false - }, - { - "conversation": "00000008-0000-002b-0000-002d00000022", - "managed": false - } - ] -} diff --git a/libs/wire-api/test/golden/testObject_TeamConversationList_team_7.json b/libs/wire-api/test/golden/testObject_TeamConversationList_team_7.json deleted file mode 100644 index a3a49965496..00000000000 --- a/libs/wire-api/test/golden/testObject_TeamConversationList_team_7.json +++ /dev/null @@ -1,40 +0,0 @@ -{ - "conversations": [ - { - "conversation": "00000068-0000-0010-0000-002700000004", - "managed": false - }, - { - "conversation": "0000006d-0000-0036-0000-000e00000080", - "managed": false - }, - { - "conversation": "00000003-0000-0068-0000-000000000006", - "managed": false - }, - { - "conversation": "00000024-0000-0018-0000-005d00000050", - "managed": false - }, - { - "conversation": "00000040-0000-0001-0000-00670000002e", - "managed": false - }, - { - "conversation": "00000002-0000-0016-0000-004300000052", - "managed": false - }, - { - "conversation": "0000007b-0000-0073-0000-002700000048", - "managed": false - }, - { - "conversation": "0000003b-0000-0048-0000-002500000015", - "managed": false - }, - { - "conversation": "00000055-0000-007c-0000-001500000051", - "managed": false - } - ] -} diff --git a/libs/wire-api/test/golden/testObject_TeamConversationList_team_8.json b/libs/wire-api/test/golden/testObject_TeamConversationList_team_8.json deleted file mode 100644 index cf6455ca885..00000000000 --- a/libs/wire-api/test/golden/testObject_TeamConversationList_team_8.json +++ /dev/null @@ -1,124 +0,0 @@ -{ - "conversations": [ - { - "conversation": "00000026-0000-0066-0000-00170000007b", - "managed": false - }, - { - "conversation": "00000064-0000-0015-0000-001f00000071", - "managed": false - }, - { - "conversation": "00000063-0000-0049-0000-004100000018", - "managed": false - }, - { - "conversation": "00000050-0000-002b-0000-000300000001", - "managed": false - }, - { - "conversation": "00000035-0000-006e-0000-002f00000057", - "managed": false - }, - { - "conversation": "0000006f-0000-0064-0000-003b0000002d", - "managed": false - }, - { - "conversation": "0000003e-0000-0009-0000-00630000001d", - "managed": false - }, - { - "conversation": "0000002a-0000-004d-0000-001b00000036", - "managed": false - }, - { - "conversation": "0000002d-0000-0073-0000-007d00000010", - "managed": false - }, - { - "conversation": "00000016-0000-0007-0000-00690000002d", - "managed": false - }, - { - "conversation": "00000043-0000-001f-0000-007500000002", - "managed": false - }, - { - "conversation": "00000002-0000-0012-0000-006200000028", - "managed": false - }, - { - "conversation": "00000019-0000-003a-0000-002300000023", - "managed": false - }, - { - "conversation": "00000050-0000-006d-0000-00610000000c", - "managed": false - }, - { - "conversation": "00000068-0000-0048-0000-003200000004", - "managed": false - }, - { - "conversation": "00000003-0000-0024-0000-002000000015", - "managed": false - }, - { - "conversation": "00000027-0000-0003-0000-007600000028", - "managed": false - }, - { - "conversation": "00000074-0000-005d-0000-00100000005d", - "managed": false - }, - { - "conversation": "00000071-0000-0075-0000-000a0000002c", - "managed": false - }, - { - "conversation": "00000012-0000-0071-0000-004d00000010", - "managed": false - }, - { - "conversation": "0000006f-0000-003f-0000-005a00000026", - "managed": false - }, - { - "conversation": "00000016-0000-0069-0000-00500000000a", - "managed": false - }, - { - "conversation": "00000033-0000-000b-0000-003000000046", - "managed": false - }, - { - "conversation": "0000002d-0000-005f-0000-007f0000001b", - "managed": false - }, - { - "conversation": "00000057-0000-0050-0000-002100000074", - "managed": false - }, - { - "conversation": "00000077-0000-0063-0000-00360000000e", - "managed": false - }, - { - "conversation": "00000058-0000-0011-0000-001200000005", - "managed": false - }, - { - "conversation": "0000004a-0000-0037-0000-003000000034", - "managed": false - }, - { - "conversation": "00000029-0000-0043-0000-006700000030", - "managed": false - }, - { - "conversation": "00000039-0000-003e-0000-008000000051", - "managed": false - } - ] -} diff --git a/libs/wire-api/test/golden/testObject_TeamConversationList_team_9.json b/libs/wire-api/test/golden/testObject_TeamConversationList_team_9.json deleted file mode 100644 index a9c45447710..00000000000 --- a/libs/wire-api/test/golden/testObject_TeamConversationList_team_9.json +++ /dev/null @@ -1,120 +0,0 @@ -{ - "conversations": [ - { - "conversation": "00000058-0000-007c-0000-002a0000005f", - "managed": false - }, - { - "conversation": "00000080-0000-0009-0000-006500000038", - "managed": false - }, - { - "conversation": "0000004e-0000-000a-0000-004e00000039", - "managed": false - }, - { - "conversation": "00000062-0000-001e-0000-004c00000058", - "managed": false - }, - { - "conversation": "00000004-0000-0021-0000-00670000000a", - "managed": false - }, - { - "conversation": "0000004f-0000-0063-0000-004a0000004b", - "managed": false - }, - { - "conversation": "00000044-0000-0017-0000-006300000067", - "managed": false - }, - { - "conversation": "0000006a-0000-0070-0000-002e0000000a", - "managed": false - }, - { - "conversation": "00000049-0000-0080-0000-006000000025", - "managed": false - }, - { - "conversation": "0000007d-0000-0040-0000-001700000066", - "managed": false - }, - { - "conversation": "00000057-0000-0045-0000-00610000006c", - "managed": false - }, - { - "conversation": "00000001-0000-0042-0000-005b00000057", - "managed": false - }, - { - "conversation": "00000048-0000-0032-0000-000000000069", - "managed": false - }, - { - "conversation": "00000003-0000-0022-0000-00370000005b", - "managed": false - }, - { - "conversation": "00000007-0000-0068-0000-00150000001f", - "managed": false - }, - { - "conversation": "0000003a-0000-0067-0000-00060000003e", - "managed": false - }, - { - "conversation": "0000001e-0000-0043-0000-002800000065", - "managed": false - }, - { - "conversation": "00000053-0000-001f-0000-001700000006", - "managed": false - }, - { - "conversation": "00000068-0000-0024-0000-004900000037", - "managed": false - }, - { - "conversation": "00000005-0000-0019-0000-00670000005c", - "managed": false - }, - { - "conversation": "00000029-0000-0003-0000-00520000004c", - "managed": false - }, - { - "conversation": "00000080-0000-002f-0000-002b0000006f", - "managed": false - }, - { - "conversation": "00000021-0000-002e-0000-004f0000005e", - "managed": false - }, - { - "conversation": "0000006a-0000-0023-0000-00560000001b", - "managed": false - }, - { - "conversation": "00000066-0000-007b-0000-00160000005c", - "managed": false - }, - { - "conversation": "0000004e-0000-0008-0000-006b00000049", - "managed": false - }, - { - "conversation": "0000005b-0000-0020-0000-005000000006", - "managed": false - }, - { - "conversation": "00000052-0000-0038-0000-003400000074", - "managed": false - }, - { - "conversation": "00000067-0000-006f-0000-00370000002e", - "managed": false - } - ] -} diff --git a/libs/wire-api/test/golden/testObject_TeamConversation_team_10.json b/libs/wire-api/test/golden/testObject_TeamConversation_team_10.json deleted file mode 100644 index ee720e2f877..00000000000 --- a/libs/wire-api/test/golden/testObject_TeamConversation_team_10.json +++ /dev/null @@ -1,4 +0,0 @@ -{ - "conversation": "00000023-0000-0024-0000-003200000067", - "managed": false -} diff --git a/libs/wire-api/test/golden/testObject_TeamConversation_team_11.json b/libs/wire-api/test/golden/testObject_TeamConversation_team_11.json deleted file mode 100644 index 25cf779c07c..00000000000 --- a/libs/wire-api/test/golden/testObject_TeamConversation_team_11.json +++ /dev/null @@ -1,4 +0,0 @@ -{ - "conversation": "00000003-0000-0041-0000-002600000041", - "managed": false -} diff --git a/libs/wire-api/test/golden/testObject_TeamConversation_team_12.json b/libs/wire-api/test/golden/testObject_TeamConversation_team_12.json deleted file mode 100644 index 815df368e29..00000000000 --- a/libs/wire-api/test/golden/testObject_TeamConversation_team_12.json +++ /dev/null @@ -1,4 +0,0 @@ -{ - "conversation": "0000007d-0000-0049-0000-001f00000034", - "managed": false -} diff --git a/libs/wire-api/test/golden/testObject_TeamConversation_team_13.json b/libs/wire-api/test/golden/testObject_TeamConversation_team_13.json deleted file mode 100644 index 08af5f0cbc1..00000000000 --- a/libs/wire-api/test/golden/testObject_TeamConversation_team_13.json +++ /dev/null @@ -1,4 +0,0 @@ -{ - "conversation": "00000025-0000-003c-0000-003d00000032", - "managed": false -} diff --git a/libs/wire-api/test/golden/testObject_TeamConversation_team_14.json b/libs/wire-api/test/golden/testObject_TeamConversation_team_14.json deleted file mode 100644 index 70ac6497480..00000000000 --- a/libs/wire-api/test/golden/testObject_TeamConversation_team_14.json +++ /dev/null @@ -1,4 +0,0 @@ -{ - "conversation": "0000005b-0000-0065-0000-002a00000060", - "managed": false -} diff --git a/libs/wire-api/test/golden/testObject_TeamConversation_team_15.json b/libs/wire-api/test/golden/testObject_TeamConversation_team_15.json deleted file mode 100644 index bc6c7526159..00000000000 --- a/libs/wire-api/test/golden/testObject_TeamConversation_team_15.json +++ /dev/null @@ -1,4 +0,0 @@ -{ - "conversation": "0000001f-0000-0037-0000-005a0000004d", - "managed": false -} diff --git a/libs/wire-api/test/golden/testObject_TeamConversation_team_16.json b/libs/wire-api/test/golden/testObject_TeamConversation_team_16.json deleted file mode 100644 index 842886be695..00000000000 --- a/libs/wire-api/test/golden/testObject_TeamConversation_team_16.json +++ /dev/null @@ -1,4 +0,0 @@ -{ - "conversation": "00000044-0000-000a-0000-007f0000001d", - "managed": false -} diff --git a/libs/wire-api/test/golden/testObject_TeamConversation_team_17.json b/libs/wire-api/test/golden/testObject_TeamConversation_team_17.json deleted file mode 100644 index 49f37f2faec..00000000000 --- a/libs/wire-api/test/golden/testObject_TeamConversation_team_17.json +++ /dev/null @@ -1,4 +0,0 @@ -{ - "conversation": "00000009-0000-0060-0000-005c00000049", - "managed": false -} diff --git a/libs/wire-api/test/golden/testObject_TeamConversation_team_18.json b/libs/wire-api/test/golden/testObject_TeamConversation_team_18.json deleted file mode 100644 index c74e29a2206..00000000000 --- a/libs/wire-api/test/golden/testObject_TeamConversation_team_18.json +++ /dev/null @@ -1,4 +0,0 @@ -{ - "conversation": "0000005f-0000-0051-0000-003d00000026", - "managed": false -} diff --git a/libs/wire-api/test/golden/testObject_TeamConversation_team_19.json b/libs/wire-api/test/golden/testObject_TeamConversation_team_19.json deleted file mode 100644 index f4165939bdc..00000000000 --- a/libs/wire-api/test/golden/testObject_TeamConversation_team_19.json +++ /dev/null @@ -1,4 +0,0 @@ -{ - "conversation": "0000003d-0000-0025-0000-00170000002e", - "managed": false -} diff --git a/libs/wire-api/test/golden/testObject_TeamConversation_team_20.json b/libs/wire-api/test/golden/testObject_TeamConversation_team_20.json deleted file mode 100644 index 685a331cb2b..00000000000 --- a/libs/wire-api/test/golden/testObject_TeamConversation_team_20.json +++ /dev/null @@ -1,4 +0,0 @@ -{ - "conversation": "00000007-0000-0053-0000-001500000035", - "managed": false -} diff --git a/libs/wire-api/test/golden/testObject_TeamConversation_team_3.json b/libs/wire-api/test/golden/testObject_TeamConversation_team_3.json deleted file mode 100644 index 9f73a8d7200..00000000000 --- a/libs/wire-api/test/golden/testObject_TeamConversation_team_3.json +++ /dev/null @@ -1,4 +0,0 @@ -{ - "conversation": "00000020-0000-0022-0000-00550000003b", - "managed": false -} diff --git a/libs/wire-api/test/golden/testObject_TeamConversation_team_4.json b/libs/wire-api/test/golden/testObject_TeamConversation_team_4.json deleted file mode 100644 index 36244e41508..00000000000 --- a/libs/wire-api/test/golden/testObject_TeamConversation_team_4.json +++ /dev/null @@ -1,4 +0,0 @@ -{ - "conversation": "0000002d-0000-0034-0000-004600000023", - "managed": false -} diff --git a/libs/wire-api/test/golden/testObject_TeamConversation_team_5.json b/libs/wire-api/test/golden/testObject_TeamConversation_team_5.json deleted file mode 100644 index de418778915..00000000000 --- a/libs/wire-api/test/golden/testObject_TeamConversation_team_5.json +++ /dev/null @@ -1,4 +0,0 @@ -{ - "conversation": "0000007d-0000-005d-0000-003d00000076", - "managed": false -} diff --git a/libs/wire-api/test/golden/testObject_TeamConversation_team_6.json b/libs/wire-api/test/golden/testObject_TeamConversation_team_6.json deleted file mode 100644 index 16a96402ac7..00000000000 --- a/libs/wire-api/test/golden/testObject_TeamConversation_team_6.json +++ /dev/null @@ -1,4 +0,0 @@ -{ - "conversation": "0000000a-0000-0013-0000-00420000002e", - "managed": false -} diff --git a/libs/wire-api/test/golden/testObject_TeamConversation_team_7.json b/libs/wire-api/test/golden/testObject_TeamConversation_team_7.json deleted file mode 100644 index 56c320cc2cb..00000000000 --- a/libs/wire-api/test/golden/testObject_TeamConversation_team_7.json +++ /dev/null @@ -1,4 +0,0 @@ -{ - "conversation": "0000005d-0000-0080-0000-002800000080", - "managed": false -} diff --git a/libs/wire-api/test/golden/testObject_TeamConversation_team_8.json b/libs/wire-api/test/golden/testObject_TeamConversation_team_8.json deleted file mode 100644 index 32455b74b26..00000000000 --- a/libs/wire-api/test/golden/testObject_TeamConversation_team_8.json +++ /dev/null @@ -1,4 +0,0 @@ -{ - "conversation": "0000002e-0000-006d-0000-003700000042", - "managed": false -} diff --git a/libs/wire-api/test/golden/testObject_TeamConversation_team_9.json b/libs/wire-api/test/golden/testObject_TeamConversation_team_9.json deleted file mode 100644 index 4e9f0537f6c..00000000000 --- a/libs/wire-api/test/golden/testObject_TeamConversation_team_9.json +++ /dev/null @@ -1,4 +0,0 @@ -{ - "conversation": "0000000d-0000-001b-0000-006800000047", - "managed": false -} diff --git a/services/galley/galley.cabal b/services/galley/galley.cabal index f6c3689b8ff..9ed8d777152 100644 --- a/services/galley/galley.cabal +++ b/services/galley/galley.cabal @@ -661,6 +661,7 @@ executable galley-schema V69_MLSProposal V70_MLSCipherSuite V71_MemberClientKeypackage + V72_DropManagedConversations hs-source-dirs: schema/src default-extensions: diff --git a/services/galley/schema/src/Main.hs b/services/galley/schema/src/Main.hs index e77d65cfed2..13e3401d5f0 100644 --- a/services/galley/schema/src/Main.hs +++ b/services/galley/schema/src/Main.hs @@ -74,6 +74,7 @@ import qualified V68_MLSCommitLock import qualified V69_MLSProposal import qualified V70_MLSCipherSuite import qualified V71_MemberClientKeypackage +import qualified V72_DropManagedConversations main :: IO () main = do @@ -133,7 +134,8 @@ main = do V68_MLSCommitLock.migration, V69_MLSProposal.migration, V70_MLSCipherSuite.migration, - V71_MemberClientKeypackage.migration + V71_MemberClientKeypackage.migration, + V72_DropManagedConversations.migration -- When adding migrations here, don't forget to update -- 'schemaVersion' in Galley.Cassandra -- (see also docs/developer/cassandra-interaction.md) diff --git a/services/galley/schema/src/V72_DropManagedConversations.hs b/services/galley/schema/src/V72_DropManagedConversations.hs new file mode 100644 index 00000000000..acb633fe5e9 --- /dev/null +++ b/services/galley/schema/src/V72_DropManagedConversations.hs @@ -0,0 +1,30 @@ +-- 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 V72_DropManagedConversations where + +import Cassandra.Schema +import Imports +import Text.RawString.QQ + +migration :: Migration +migration = Migration 72 "Drop the managed column from team_conv" $ do + schema' + [r| ALTER TABLE team_conv DROP ( + managed + ); + |] diff --git a/services/galley/src/Galley/Cassandra.hs b/services/galley/src/Galley/Cassandra.hs index e256f18aba0..9e6c24f7fbf 100644 --- a/services/galley/src/Galley/Cassandra.hs +++ b/services/galley/src/Galley/Cassandra.hs @@ -20,4 +20,4 @@ module Galley.Cassandra (schemaVersion) where import Imports schemaVersion :: Int32 -schemaVersion = 71 +schemaVersion = 72 diff --git a/services/galley/src/Galley/Cassandra/Instances.hs b/services/galley/src/Galley/Cassandra/Instances.hs index f25ffc2a279..a0dce48efdc 100644 --- a/services/galley/src/Galley/Cassandra/Instances.hs +++ b/services/galley/src/Galley/Cassandra/Instances.hs @@ -118,9 +118,8 @@ instance Cql ConvTeamInfo where toCql t = CqlUdt [("teamid", toCql (cnvTeamId t)), ("managed", toCql False)] - fromCql (CqlUdt u) = do - t <- note "missing 'teamid' in teaminfo" ("teamid" `lookup` u) >>= fromCql - pure (ConvTeamInfo t) + fromCql (CqlUdt u) = + note "missing 'teamid' in teaminfo" ("teamid" `lookup` u) >>= fmap ConvTeamInfo . fromCql fromCql _ = Left "teaminfo: udt expected" instance Cql TeamBinding where diff --git a/services/galley/src/Galley/Cassandra/Team.hs b/services/galley/src/Galley/Cassandra/Team.hs index 3156f2fc613..7494b24b6d2 100644 --- a/services/galley/src/Galley/Cassandra/Team.hs +++ b/services/galley/src/Galley/Cassandra/Team.hs @@ -415,7 +415,11 @@ newTeamMember' lh tid (uid, perms, minvu, minvt, fromMaybe defUserLegalHoldStatu mk Nothing Nothing = pure $ mkTeamMember uid perms Nothing lhStatus mk _ _ = throwM $ ErrorCall "TeamMember with incomplete metadata." -teamConversationsForPagination :: TeamId -> Maybe ConvId -> Range 1 HardTruncationLimit Int32 -> Client (Page TeamConversation) +teamConversationsForPagination :: + TeamId -> + Maybe ConvId -> + Range 1 HardTruncationLimit Int32 -> + Client (Page TeamConversation) teamConversationsForPagination tid start (fromRange -> max) = fmap (newTeamConversation . runIdentity) <$> case start of Just c -> paginate Cql.selectTeamConvsFrom (paramsP LocalQuorum (tid, c) max) From e5ea9bd918ba371f57054670ea11395b2efa1e6f Mon Sep 17 00:00:00 2001 From: Stefan Matting Date: Fri, 9 Sep 2022 12:57:38 +0200 Subject: [PATCH 19/58] Add alias to GET /conversations/{cnv} endpoint for LH devices (#2682) --- charts/nginz/static/conf/zauth.acl | 3 ++- charts/nginz/values.yaml | 3 +++ deploy/services-demo/conf/nginz/nginx.conf | 4 ++++ deploy/services-demo/conf/nginz/zauth_acl.txt | 3 ++- libs/wire-api/src/Wire/API/Routes/Public/Galley.hs | 12 ++++++++++++ services/brig/test/integration/API/User/Auth.hs | 8 ++++++++ services/galley/src/Galley/API/Public/Servant.hs | 1 + 7 files changed, 32 insertions(+), 2 deletions(-) diff --git a/charts/nginz/static/conf/zauth.acl b/charts/nginz/static/conf/zauth.acl index 9498b8cc43f..3fe4d179e1a 100644 --- a/charts/nginz/static/conf/zauth.acl +++ b/charts/nginz/static/conf/zauth.acl @@ -14,4 +14,5 @@ p (whitelist (path "/provider") la (whitelist (path "/notifications") (path "/assets/v3/**") (path "/users") - (path "/users/**")) + (path "/users/**") + (path "/legalhold/conversations/*")) diff --git a/charts/nginz/values.yaml b/charts/nginz/values.yaml index 7c5dd2c6851..155f7e5e2bb 100644 --- a/charts/nginz/values.yaml +++ b/charts/nginz/values.yaml @@ -397,6 +397,9 @@ nginx_conf: envs: - all doc: true + - path: /legalhold/conversations/(.*) + envs: + - all - path: /teams$ envs: - all diff --git a/deploy/services-demo/conf/nginz/nginx.conf b/deploy/services-demo/conf/nginz/nginx.conf index ca1e9041ba2..3eea668311d 100644 --- a/deploy/services-demo/conf/nginz/nginx.conf +++ b/deploy/services-demo/conf/nginz/nginx.conf @@ -325,6 +325,10 @@ http { proxy_pass http://galley; } + location ~* /legalhold/conversations/(.*) { + include common_response_with_zauth.conf; + proxy_pass http://galley; + } location /conversations { include common_response_with_zauth.conf; diff --git a/deploy/services-demo/conf/nginz/zauth_acl.txt b/deploy/services-demo/conf/nginz/zauth_acl.txt index 9498b8cc43f..3fe4d179e1a 100644 --- a/deploy/services-demo/conf/nginz/zauth_acl.txt +++ b/deploy/services-demo/conf/nginz/zauth_acl.txt @@ -14,4 +14,5 @@ p (whitelist (path "/provider") la (whitelist (path "/notifications") (path "/assets/v3/**") (path "/users") - (path "/users/**")) + (path "/users/**") + (path "/legalhold/conversations/*")) diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs b/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs index 719fc9b33fc..f80ff25aa3f 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs @@ -185,6 +185,18 @@ type ConversationAPI = :> Capture "cnv" ConvId :> Get '[Servant.JSON] Conversation ) + :<|> Named + "get-unqualified-conversation-legalhold-alias" + -- This alias exists, so that it can be uniquely selected in zauth.acl + ( Summary "Get a conversation by ID (Legalhold alias)" + :> CanThrow 'ConvNotFound + :> CanThrow 'ConvAccessDenied + :> ZLocalUser + :> "legalhold" + :> "conversations" + :> Capture "cnv" ConvId + :> Get '[Servant.JSON] Conversation + ) :<|> Named "get-conversation" ( Summary "Get a conversation by ID" diff --git a/services/brig/test/integration/API/User/Auth.hs b/services/brig/test/integration/API/User/Auth.hs index 896ab54098d..bc65816a8f3 100644 --- a/services/brig/test/integration/API/User/Auth.hs +++ b/services/brig/test/integration/API/User/Auth.hs @@ -46,6 +46,7 @@ import Data.Handle (Handle (Handle)) import Data.Id import Data.Misc (PlainTextPassword (..)) import Data.Proxy +import Data.Qualified (Qualified (qUnqualified)) import Data.Range (unsafeRange) import qualified Data.Text as Text import Data.Text.Ascii (AsciiChars (validate)) @@ -62,6 +63,7 @@ import Test.Tasty.HUnit import qualified Test.Tasty.HUnit as HUnit import UnliftIO.Async hiding (wait) import Util +import Wire.API.Conversation (Conversation (..)) import qualified Wire.API.Team.Feature as Public import Wire.API.User import qualified Wire.API.User as Public @@ -226,6 +228,10 @@ testNginzLegalHold b g n = do cUsr = decodeCookie rsUsr pure (c, t) + qconv <- + fmap cnvQualifiedId . responseJsonError + =<< createConversation g (userId alice) [] toByteString' t)) !!! do const 200 === statusCode @@ -235,6 +241,8 @@ testNginzLegalHold b g n = do -- ensure legal hold tokens can fetch notifications get (n . path "/notifications" . header "Authorization" ("Bearer " <> toByteString' t)) !!! const 200 === statusCode + get (n . paths ["legalhold", "conversations", toByteString' (qUnqualified qconv)] . header "Authorization" ("Bearer " <> toByteString' t)) !!! const 200 === statusCode + -- | Corner case for 'testNginz': when upgrading a wire backend from the old behavior (setting -- cookie domain to eg. @*.wire.com@) to the new behavior (leaving cookie domain empty, -- effectively setting it to the backend host), clients may start sending two cookies for a diff --git a/services/galley/src/Galley/API/Public/Servant.hs b/services/galley/src/Galley/API/Public/Servant.hs index 21378d52784..9977aaae1ab 100644 --- a/services/galley/src/Galley/API/Public/Servant.hs +++ b/services/galley/src/Galley/API/Public/Servant.hs @@ -47,6 +47,7 @@ servantSitemap = where conversations = mkNamedAPI @"get-unqualified-conversation" getUnqualifiedConversation + <@> mkNamedAPI @"get-unqualified-conversation-legalhold-alias" getUnqualifiedConversation <@> mkNamedAPI @"get-conversation" getConversation <@> mkNamedAPI @"get-conversation-roles" getConversationRoles <@> mkNamedAPI @"list-conversation-ids-unqualified" conversationIdsPageFromUnqualified From 0715b41f228547600423d1ab6f72a556913ff7eb Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Tue, 13 Sep 2022 16:11:18 +0200 Subject: [PATCH 20/58] Update to mls-test-cli 0.5 (#2685) * Update mls-test-cli to version 0.5 --- changelog.d/5-internal/mls-test-cli-0.5 | 1 + nix/pkgs/mls_test_cli/default.nix | 6 +++--- 2 files changed, 4 insertions(+), 3 deletions(-) create mode 100644 changelog.d/5-internal/mls-test-cli-0.5 diff --git a/changelog.d/5-internal/mls-test-cli-0.5 b/changelog.d/5-internal/mls-test-cli-0.5 new file mode 100644 index 00000000000..a138a2d6ae4 --- /dev/null +++ b/changelog.d/5-internal/mls-test-cli-0.5 @@ -0,0 +1 @@ +Update mls-test-cli to version 0.5 diff --git a/nix/pkgs/mls_test_cli/default.nix b/nix/pkgs/mls_test_cli/default.nix index 4a9c64213de..69fd9b1f385 100644 --- a/nix/pkgs/mls_test_cli/default.nix +++ b/nix/pkgs/mls_test_cli/default.nix @@ -15,11 +15,11 @@ rustPlatform.buildRustPackage rec { src = fetchFromGitHub { owner = "wireapp"; repo = "mls-test-cli"; - sha256 = "sha256-6G01eONZb/61MrO/Py+ix7Psz+jl+3Cn7xUMez3osxw="; - rev = "d01258a290546a01a62dca21ba3d0e3863a288b4"; + sha256 = "sha256-nBtXkxGstSqBEhzjcRd0RG2hv0WFgTqy1z29W2sf27U="; + rev = "560186482d201fe0f6194d620dba2b623fdd7f6f"; }; doCheck = false; - cargoSha256 = "sha256-frzVXP0lxXhPhfNL4zleHj2WSMwmQfCdTqkTbHXBFEI="; + cargoSha256 = "sha256-3zUGEowQREPKsfpH2y9C7BeeTTF3zat4Qfpw74fOCHQ="; cargoDepsHook = '' mkdir -p mls-test-cli-${version}-vendor.tar.gz/ring/.git ''; From 6c24fb1623dc8e8d44733be88ea37c691ca1e3a7 Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Wed, 14 Sep 2022 10:52:40 +0200 Subject: [PATCH 21/58] change h3 to h2 (#2687) --- docs/src/how-to/install/team-feature-settings.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/docs/src/how-to/install/team-feature-settings.md b/docs/src/how-to/install/team-feature-settings.md index ff1670f3449..7db2c074293 100644 --- a/docs/src/how-to/install/team-feature-settings.md +++ b/docs/src/how-to/install/team-feature-settings.md @@ -31,7 +31,7 @@ galley: Note that the lock status is required but has no effect, as it is currently not supported for team admins to enable or disable `sndFactorPasswordChallenge`. We recommend to set the lock status to `locked`. -### Rate limiting of code generation requests +## Rate limiting of code generation requests The default delay between code generation requests is 5 minutes. This setting can be overridden in the Helm charts: @@ -68,7 +68,7 @@ galley: lockStatus: locked ``` -### TTL for nonces +## TTL for nonces Nonces that can be retrieved e.g. by calling `HEAD /nonce/clients` have a default time-to-live of 5 minutes. To change this setting add the following to your Helm overrides in `values/wire-server/values.yaml`: From 8bf716dfd8f7dcec451162dbccf0e1604a2f7a2a Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Wed, 14 Sep 2022 10:58:20 +0200 Subject: [PATCH 22/58] [FS-736] Add rusty-jwt-tools dependency to docker deps and builder (#2686) --- build/ubuntu/Dockerfile.builder | 13 +++++++++++++ build/ubuntu/Dockerfile.deps | 14 ++++++++++++++ changelog.d/5-internal/pr-2686 | 1 + 3 files changed, 28 insertions(+) create mode 100644 changelog.d/5-internal/pr-2686 diff --git a/build/ubuntu/Dockerfile.builder b/build/ubuntu/Dockerfile.builder index df52ce9bc4e..bd919ee5d14 100644 --- a/build/ubuntu/Dockerfile.builder +++ b/build/ubuntu/Dockerfile.builder @@ -10,9 +10,22 @@ RUN cd /tmp && \ RUN cd /tmp/mls-test-cli && RUSTFLAGS='-C target-feature=+crt-static' cargo build --release --target x86_64-unknown-linux-gnu +FROM rust:1.63 as rusty-jwt-tools-builder + +# compile rusty-jwt-tools +RUN cd /tmp && \ + git clone https://github.com/wireapp/rusty-jwt-tools && \ + cd rusty-jwt-tools && \ + git checkout 6370cd556f03f6834d0b8043615ffaf0044ef1fa && \ + git rev-parse HEAD + +RUN cd /tmp/rusty-jwt-tools && cargo build --release --target x86_64-unknown-linux-gnu + FROM ${prebuilder} COPY --from=mls-test-cli-builder /tmp/mls-test-cli/target/x86_64-unknown-linux-gnu/release/mls-test-cli /usr/bin/mls-test-cli +COPY --from=rusty-jwt-tools-builder /tmp/rusty-jwt-tools/target/x86_64-unknown-linux-gnu/release/librusty_jwt_tools.so /usr/lib +COPY --from=rusty-jwt-tools-builder /tmp/rusty-jwt-tools/target/x86_64-unknown-linux-gnu/release/librusty_jwt_tools_ffi.so /usr/lib WORKDIR / diff --git a/build/ubuntu/Dockerfile.deps b/build/ubuntu/Dockerfile.deps index 7b356804b42..458f71f01a7 100644 --- a/build/ubuntu/Dockerfile.deps +++ b/build/ubuntu/Dockerfile.deps @@ -20,11 +20,25 @@ RUN cd /tmp && \ RUN cd /tmp/mls-test-cli && RUSTFLAGS='-C target-feature=+crt-static' cargo build --release --target x86_64-unknown-linux-gnu +FROM rust:1.63 as rusty-jwt-tools-builder + +# compile rusty-jwt-tools +RUN cd /tmp && \ + git clone https://github.com/wireapp/rusty-jwt-tools && \ + cd rusty-jwt-tools && \ + git checkout 6370cd556f03f6834d0b8043615ffaf0044ef1fa && \ + git rev-parse HEAD + +RUN cd /tmp/rusty-jwt-tools && cargo build --release --target x86_64-unknown-linux-gnu + + # Minimal dependencies for ubuntu-compiled, dynamically linked wire-server Haskell services FROM ubuntu:20.04 COPY --from=cryptobox-builder /tmp/cryptobox-c/target/release/libcryptobox.so /usr/lib COPY --from=mls-test-cli-builder /tmp/mls-test-cli/target/x86_64-unknown-linux-gnu/release/mls-test-cli /usr/bin/mls-test-cli +COPY --from=rusty-jwt-tools-builder /tmp/rusty-jwt-tools/target/x86_64-unknown-linux-gnu/release/librusty_jwt_tools.so /usr/lib +COPY --from=rusty-jwt-tools-builder /tmp/rusty-jwt-tools/target/x86_64-unknown-linux-gnu/release/librusty_jwt_tools_ffi.so /usr/lib RUN export DEBIAN_FRONTEND=noninteractive && \ apt-get update && \ diff --git a/changelog.d/5-internal/pr-2686 b/changelog.d/5-internal/pr-2686 new file mode 100644 index 00000000000..3051a190b7d --- /dev/null +++ b/changelog.d/5-internal/pr-2686 @@ -0,0 +1 @@ +Added rusty-jwt-tools to docker images From 869a9ebe56dcb855036a8fffc9254f34302f4633 Mon Sep 17 00:00:00 2001 From: Stefan Matting Date: Wed, 14 Sep 2022 11:23:43 +0200 Subject: [PATCH 23/58] Refactor MLS test framework (#2678) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * Implement most of the new MLS test framework * Automatically keep track of clients in the group * Assert that add proposal is forwarded * Remove dead code * Keep track of clients in the test state * Port more external proposal tests to new framework * Refactor test testSenderNotInConversation - Also add a utility for creating an application message * Port welcome tests to new MLS test framework * Refactor test testSendAnotherUsersCommit * Port some commit tests to new MLS test framework * Port more commit tests * Refactor test testAppMessage * Refactor test testRemoteAppMessage * Port more commit tests * Fix bracket in testAppMessage * Finish porting commit tests * Refactor test testAppMessage2 * Port proposal tests * Refactor test testLocalToRemote * Refactor test testLocalToRemoteNonMember * Refactor test testRemoteToLocal * Refactor test testRemoteNonMemberToLocal * Refactor test testRemoteToLocalWrongConversation * Refactor test testAddUsersDirectly * Refactor test testRemoveUsersDirectly * Refactor test testProteusMessage * Refactor test testAddUsersToProteus * Generalise return type of awaitMatch and friends Fix error reporting in assertNoEvent * Port backend removal test * Port final test in API/MLS * Move MLS tests out of the Federation module * Remove old MLS test framework * Add CHANGELOG entry * Fix a test setup in runMLSTest * Update mls-test-cli Co-authored-by: Paolo Capriotti Co-authored-by: Marko Dimjašević --- changelog.d/5-internal/mls-refactor-tests | 1 + libs/tasty-cannon/src/Test/Tasty/Cannon.hs | 32 +- libs/wire-api/src/Wire/API/MLS/Credential.hs | 5 +- nix/pkgs/mls_test_cli/default.nix | 4 +- services/brig/test/integration/Util.hs | 2 +- services/galley/galley.cabal | 3 + .../galley/test/integration/API/Federation.hs | 55 +- services/galley/test/integration/API/MLS.hs | 2248 +++++++---------- .../galley/test/integration/API/MLS/Util.hs | 1163 +++++---- services/galley/test/integration/API/Util.hs | 107 +- .../galley/test/integration/TestHelpers.hs | 6 + 11 files changed, 1722 insertions(+), 1904 deletions(-) create mode 100644 changelog.d/5-internal/mls-refactor-tests diff --git a/changelog.d/5-internal/mls-refactor-tests b/changelog.d/5-internal/mls-refactor-tests new file mode 100644 index 00000000000..fbbf9416455 --- /dev/null +++ b/changelog.d/5-internal/mls-refactor-tests @@ -0,0 +1 @@ +Refactor MLS test framework diff --git a/libs/tasty-cannon/src/Test/Tasty/Cannon.hs b/libs/tasty-cannon/src/Test/Tasty/Cannon.hs index f7f556886f1..8b0b437277e 100644 --- a/libs/tasty-cannon/src/Test/Tasty/Cannon.hs +++ b/libs/tasty-cannon/src/Test/Tasty/Cannon.hs @@ -288,8 +288,8 @@ awaitMatch :: (HasCallStack, MonadIO m, MonadCatch m) => Timeout -> WebSocket -> - (Notification -> Assertion) -> - m (Either MatchTimeout Notification) + (Notification -> IO a) -> + m (Either MatchTimeout a) awaitMatch t ws match = go [] [] where go buf errs = do @@ -297,9 +297,9 @@ awaitMatch t ws match = go [] [] case mn of Just n -> do - liftIO (match n) + a <- liftIO (match n) refill buf - pure (Right n) + pure (Right a) `catchAll` \e -> case asyncExceptionFromException e of Just x -> throwM (x :: SomeAsyncException) Nothing -> @@ -322,15 +322,15 @@ assertMatch :: (HasCallStack, MonadIO m, MonadCatch m) => Timeout -> WebSocket -> - (Notification -> Assertion) -> - m Notification + (Notification -> IO a) -> + m a assertMatch t ws f = awaitMatch t ws f >>= assertSuccess assertMatch_ :: (HasCallStack, MonadIO m, MonadCatch m) => Timeout -> WebSocket -> - (Notification -> Assertion) -> + (Notification -> IO a) -> m () assertMatch_ t w = void . assertMatch t w @@ -338,40 +338,40 @@ awaitMatchN :: (HasCallStack, MonadIO m) => Timeout -> [WebSocket] -> - (Notification -> Assertion) -> - m [Either MatchTimeout Notification] + (Notification -> IO a) -> + m [Either MatchTimeout a] awaitMatchN t wss f = snd <$$> awaitMatchN' t (((),) <$> wss) f awaitMatchN' :: (HasCallStack, MonadIO m) => Timeout -> [(extra, WebSocket)] -> - (Notification -> Assertion) -> - m [(extra, Either MatchTimeout Notification)] + (Notification -> IO a) -> + m [(extra, Either MatchTimeout a)] awaitMatchN' t wss f = liftIO $ mapConcurrently (\(extra, ws) -> (extra,) <$> awaitMatch t ws f) wss assertMatchN :: (HasCallStack, MonadIO m, MonadThrow m) => Timeout -> [WebSocket] -> - (Notification -> Assertion) -> - m [Notification] + (Notification -> IO a) -> + m [a] assertMatchN t wss f = awaitMatchN t wss f >>= mapM assertSuccess assertMatchN_ :: (HasCallStack, MonadIO m, MonadThrow m) => Timeout -> [WebSocket] -> - (Notification -> Assertion) -> + (Notification -> IO a) -> m () assertMatchN_ t wss f = void $ assertMatchN t wss f -assertSuccess :: (HasCallStack, MonadIO m, MonadThrow m) => Either MatchTimeout Notification -> m Notification +assertSuccess :: (HasCallStack, MonadIO m, MonadThrow m) => Either MatchTimeout a -> m a assertSuccess = either throwM pure assertNoEvent :: (HasCallStack, MonadIO m, MonadCatch m) => Timeout -> [WebSocket] -> m () assertNoEvent t ww = do - results <- awaitMatchN' t (zip [(0 :: Int) ..] ww) (const $ pure ()) + results <- awaitMatchN' t (zip [(0 :: Int) ..] ww) pure for_ results $ \(ix, result) -> either (const $ pure ()) (liftIO . f ix) result where diff --git a/libs/wire-api/src/Wire/API/MLS/Credential.hs b/libs/wire-api/src/Wire/API/MLS/Credential.hs index c3cb28c6c5e..f24926280f2 100644 --- a/libs/wire-api/src/Wire/API/MLS/Credential.hs +++ b/libs/wire-api/src/Wire/API/MLS/Credential.hs @@ -139,12 +139,15 @@ data ClientIdentity = ClientIdentity ciUser :: UserId, ciClient :: ClientId } - deriving stock (Eq, Show, Generic) + deriving stock (Eq, Ord, Show, Generic) deriving (FromJSON, ToJSON, S.ToSchema) via Schema ClientIdentity cidQualifiedClient :: ClientIdentity -> Qualified (UserId, ClientId) cidQualifiedClient cid = Qualified (ciUser cid, ciClient cid) (ciDomain cid) +cidQualifiedUser :: ClientIdentity -> Qualified UserId +cidQualifiedUser = fmap fst . cidQualifiedClient + instance ToSchema ClientIdentity where schema = object "ClientIdentity" $ diff --git a/nix/pkgs/mls_test_cli/default.nix b/nix/pkgs/mls_test_cli/default.nix index 69fd9b1f385..5d786dc0c6a 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-nBtXkxGstSqBEhzjcRd0RG2hv0WFgTqy1z29W2sf27U="; - rev = "560186482d201fe0f6194d620dba2b623fdd7f6f"; + sha256 = "sha256-Gw1+b7kslc/KcB+pEqP1FuE6tAPqKtB6hlkLcXMuCcM="; + rev = "f44dec2705e1833b654cb6f02271e11a6c2fdeb0"; }; doCheck = false; cargoSha256 = "sha256-3zUGEowQREPKsfpH2y9C7BeeTTF3zat4Qfpw74fOCHQ="; diff --git a/services/brig/test/integration/Util.hs b/services/brig/test/integration/Util.hs index 42db733b757..080bd924a0b 100644 --- a/services/brig/test/integration/Util.hs +++ b/services/brig/test/integration/Util.hs @@ -317,7 +317,7 @@ getPhoneLoginCode brig p = do let lbs = fromMaybe "" $ responseBody r pure (LoginCode <$> (lbs ^? key "code" . _String)) -assertUpdateNotification :: WS.WebSocket -> UserId -> UserUpdate -> IO Notification +assertUpdateNotification :: WS.WebSocket -> UserId -> UserUpdate -> IO () assertUpdateNotification ws uid upd = WS.assertMatch (5 # Second) ws $ \n -> do let j = Object $ List1.head (ntfPayload n) j ^? key "type" . _String @?= Just "user.update" diff --git a/services/galley/galley.cabal b/services/galley/galley.cabal index 9ed8d777152..7beab6843ad 100644 --- a/services/galley/galley.cabal +++ b/services/galley/galley.cabal @@ -442,6 +442,7 @@ executable galley-integration , currency-codes , data-default , data-timeout + , directory , errors , exceptions , extended @@ -451,6 +452,7 @@ executable galley-integration , galley , galley-types , gundeck-types + , hex , HsOpenSSL , HsOpenSSL-x509-system , hspec @@ -500,6 +502,7 @@ executable galley-integration , transformers , types-common , types-common-journal + , unix , unliftio , unordered-containers , uri-bytestring diff --git a/services/galley/test/integration/API/Federation.hs b/services/galley/test/integration/API/Federation.hs index 9d9eda39be0..2f632a4c2ec 100644 --- a/services/galley/test/integration/API/Federation.hs +++ b/services/galley/test/integration/API/Federation.hs @@ -19,7 +19,6 @@ module API.Federation where -import API.MLS.Util import API.Util import Bilge hiding (head) import Bilge.Assert @@ -27,7 +26,6 @@ import Control.Lens hiding ((#)) import Data.Aeson (ToJSON (..)) import qualified Data.Aeson as A import Data.ByteString.Conversion (toByteString') -import Data.Default import Data.Domain import Data.Id (ConvId, Id (..), UserId, newClientId, randomId) import Data.Json.Util hiding ((#)) @@ -90,9 +88,7 @@ tests s = test s "POST /federation/on-message-sent : Receive a message from another backend" onMessageSent, test s "POST /federation/send-message : Post a message sent from another backend" sendMessage, test s "POST /federation/on-user-deleted-conversations : Remove deleted remote user from local conversations" onUserDeleted, - test s "POST /federation/update-conversation : Update local conversation by a remote admin " updateConversationByRemoteAdmin, - test s "POST /federation/mls-welcome : Post an MLS welcome message received from another backend" sendMLSWelcome, - test s "POST /federation/mls-welcome : Post an MLS welcome message (key package ref not found)" sendMLSWelcomeKeyPackageNotFound + test s "POST /federation/update-conversation : Update local conversation by a remote admin " updateConversationByRemoteAdmin ] getConversationsAllFound :: TestM () @@ -1134,55 +1130,6 @@ updateConversationByRemoteAdmin = do let convUpdate :: ConversationUpdate = fromRight (error $ "Could not parse ConversationUpdate from " <> show (frBody rpc)) $ A.eitherDecode (frBody rpc) pure (rpc, convUpdate) -sendMLSWelcome :: TestM () -sendMLSWelcome = do - let aliceDomain = Domain "a.far-away.example.com" - -- Alice is from the originating domain and Bob is local, i.e., on the receiving domain - MessagingSetup {..} <- aliceInvitesBob (1, LocalUser) def {creatorOrigin = RemoteUser aliceDomain} - let bob = head users - - fedGalleyClient <- view tsFedGalleyClient - cannon <- view tsCannon - - WS.bracketR cannon (qUnqualified (pUserId bob)) $ \wsB -> do - -- send welcome message - void $ - runFedClient @"mls-welcome" fedGalleyClient aliceDomain $ - MLSWelcomeRequest - (Base64ByteString welcome) - - -- check that the corresponding event is received - liftIO $ do - WS.assertMatch_ (5 # WS.Second) wsB $ - wsAssertMLSWelcome (pUserId bob) welcome - -sendMLSWelcomeKeyPackageNotFound :: TestM () -sendMLSWelcomeKeyPackageNotFound = do - let aliceDomain = Domain "a.far-away.example.com" - -- Alice is from the originating domain and Bob is local, i.e., on the receiving domain - MessagingSetup {..} <- - aliceInvitesBob - (1, LocalUser) - def - { creatorOrigin = RemoteUser aliceDomain, - createClients = DontCreateClients -- no key package upload will happen - } - let bob = head users - - fedGalleyClient <- view tsFedGalleyClient - cannon <- view tsCannon - - WS.bracketR cannon (qUnqualified (pUserId bob)) $ \wsB -> do - -- send welcome message - void $ - runFedClient @"mls-welcome" fedGalleyClient aliceDomain $ - MLSWelcomeRequest - (Base64ByteString welcome) - - liftIO $ do - -- check that no event is received - WS.assertNoEvent (1 # Second) [wsB] - getConvAction :: Sing tag -> SomeConversationAction -> Maybe (ConversationAction tag) getConvAction tquery (SomeConversationAction tag action) = case (tag, tquery) of diff --git a/services/galley/test/integration/API/MLS.hs b/services/galley/test/integration/API/MLS.hs index ab37b621f48..20ffd37612c 100644 --- a/services/galley/test/integration/API/MLS.hs +++ b/services/galley/test/integration/API/MLS.hs @@ -1,6 +1,5 @@ {-# LANGUAGE RecordWildCards #-} {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} - -- This file is part of the Wire Server implementation. -- -- Copyright (C) 2022 Wire Swiss GmbH @@ -17,6 +16,7 @@ -- -- You should have received a copy of the GNU Affero General Public License along -- with this program. If not, see . +{-# OPTIONS_GHC -Wwarn #-} module API.MLS (tests) where @@ -25,23 +25,17 @@ import API.Util import Bilge hiding (head) import Bilge.Assert import Cassandra -import Control.Arrow -import Control.Lens (view, (^..)) +import Control.Lens (view) +import qualified Control.Monad.State as State import Crypto.Error -import qualified Crypto.PubKey.Ed25519 as C +import qualified Crypto.PubKey.Ed25519 as Ed25519 import qualified Data.Aeson as Aeson -import Data.Aeson.Lens import Data.Binary.Put import qualified Data.ByteString as BS -import qualified Data.ByteString.Base64.URL as B64U -import Data.ByteString.Conversion import qualified Data.ByteString.Lazy as LBS -import Data.Default import Data.Domain import Data.Id import Data.Json.Util hiding ((#)) -import qualified Data.List.NonEmpty as NE -import qualified Data.List.NonEmpty as NonEmpty import Data.List1 hiding (head) import qualified Data.Map as Map import Data.Qualified @@ -54,8 +48,7 @@ import Data.Time import Federator.MockServer hiding (withTempMockFederator) import Imports import qualified Network.Wai.Utilities.Error as Wai -import System.FilePath -import System.IO.Temp +import Test.QuickCheck (Arbitrary (arbitrary), generate) import Test.Tasty import Test.Tasty.Cannon (TimeoutUnit (Second), (#)) import qualified Test.Tasty.Cannon as WS @@ -67,19 +60,12 @@ import Wire.API.Conversation.Action import Wire.API.Conversation.Protocol import Wire.API.Conversation.Role import Wire.API.Error.Galley -import Wire.API.Event.Conversation 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.Group (convToGroupId) -import Wire.API.MLS.KeyPackage import Wire.API.MLS.Keys -import Wire.API.MLS.Message -import Wire.API.MLS.Proposal import Wire.API.MLS.Serialisation import Wire.API.Message -import Wire.API.Routes.Version import Wire.API.User.Client tests :: IO TestSetup -> TestTree @@ -95,7 +81,12 @@ tests s = "Welcome" [ test s "local welcome" testLocalWelcome, test s "local welcome (client with no public key)" testWelcomeNoKey, - test s "remote welcome" testRemoteWelcome + test s "remote welcome" testRemoteWelcome, + test s "post a remote MLS welcome message" sendRemoteMLSWelcome, + test + s + "post a remote MLS welcome message (key package ref not found)" + sendRemoteMLSWelcomeKPNotFound ], testGroup "Creation" @@ -109,7 +100,6 @@ tests s = test s "add user (partial client list)" testAddUserPartial, test s "add client of existing user" testAddClientPartial, test s "add user with some non-MLS clients" testAddUserWithProteusClients, - test s "add new client of an already-present user to a conversation" testAddNewClient, test s "send a stale commit" testStaleCommit, test s "add remote user to a conversation" testAddRemoteUser, test s "return error when commit is locked" testCommitLock, @@ -118,9 +108,7 @@ tests s = test s "post commit that is not referencing all proposals" testCommitNotReferencingAllProposals, test s "admin removes user from a conversation" testAdminRemovesUserFromConv, test s "admin removes user from a conversation but doesn't list all clients" testRemoveClientsIncomplete, - test s "anyone removes a non-existing client from a group" (testRemoveDeletedClient True), - test s "anyone removes an existing client from group, but the user has other clients" (testRemoveDeletedClient False), - test s "admin removes only strict subset of clients from a user" testRemoveSubset + test s "anyone removes a non-existing client from a group" testRemoveDeletedClient ], testGroup "Application Message" @@ -207,500 +195,404 @@ postMLSConvOk = do testSenderNotInConversation :: TestM () testSenderNotInConversation = do - withSystemTempDirectory "mls" $ \tmp -> do - (alice, [bob]) <- withLastPrekeys $ setupParticipants tmp def [(1, LocalUser)] - _ <- setupGroup tmp CreateConv alice "group" + -- create users + [alice, bob] <- createAndConnectUsers (replicate 2 Nothing) - (_commit, _welcome) <- - liftIO $ - setupCommit tmp alice "group" "group" $ - toList (pClients bob) - liftIO $ mergeWelcome tmp (pClientQid bob) "group" "group" "welcome" - message <- liftIO $ createMessage tmp bob "group" "some text" + runMLSTest $ do + [alice1, bob1] <- traverse createMLSClient [alice, bob] + + -- upload key packages + void $ uploadNewKeyPackage bob1 + + -- create group with alice1 and bob1, but do not commit adding Bob + void $ setupMLSGroup alice1 + mp <- createAddCommit alice1 [bob] + + traverse_ consumeWelcome (mpWelcome mp) + + message <- createApplicationMessage bob1 "some text" -- send the message as bob, who is not in the conversation err <- responseJsonError - =<< postMessage (qUnqualified (pUserId bob)) message + =<< postMessage (qUnqualified bob) (mpMessage message) assertFailure "Expected welcome message" + Just w -> pure w + events <- mlsBracket [bob1] $ \wss -> do + es <- sendAndConsumeCommit commit + + WS.assertMatchN_ (5 # Second) wss $ + wsAssertMLSWelcome (cidQualifiedUser bob1) welcome + + pure es - cannon <- view tsCannon - - WS.bracketR cannon (qUnqualified (pUserId bob)) $ \wsB -> do - -- send welcome message - postWelcome (qUnqualified $ pUserId creator) welcome - !!! const 201 === statusCode - - -- check that the corresponding event is received - void . liftIO $ - WS.assertMatch (5 # WS.Second) wsB $ - wsAssertMLSWelcome (pUserId bob) welcome + event <- assertOne events + liftIO $ assertJoinEvent qcnv alice [bob] roleNameWireMember event testWelcomeNoKey :: TestM () testWelcomeNoKey = do - MessagingSetup {..} <- aliceInvitesBob (1, LocalUser) def {createClients = CreateWithoutKey} + users <- createAndConnectUsers [Nothing, Nothing] + runMLSTest $ do + [alice1, bob1] <- traverse createMLSClient users + void $ setupMLSGroup alice1 + + -- add bob using an "out-of-band" key package + (_, ref) <- generateKeyPackage bob1 + kp <- keyPackageFile bob1 ref + commit <- createAddCommitWithKeyPackages alice1 [(bob1, kp)] + welcome <- liftIO $ case mpWelcome commit of + Nothing -> assertFailure "Expected welcome message" + Just w -> pure w - postWelcome (qUnqualified (pUserId creator)) welcome - !!! const 404 === statusCode + err <- + responseJsonError =<< postWelcome (ciUser alice1) welcome + pure (Aeson.encode okResp) + "mls-welcome" -> pure (Aeson.encode EmptyResponse) ms -> assertFailure ("unmocked endpoint called: " <> cs ms) - (_resp, reqs) <- - withTempMockFederator' mockedResponse $ - postWelcome (qUnqualified $ pUserId alice) welcome - !!! const 201 === statusCode - - -- Assert the correct federated call is made. - fedWelcome <- assertOne (filter ((== "mls-welcome") . frRPC) reqs) - let req :: Maybe MLSWelcomeRequest = Aeson.decode (frBody fedWelcome) - liftIO $ req @?= (Just . MLSWelcomeRequest . Base64ByteString) welcome - --- | Send a commit message, and assert that all participants see an event with --- the given list of new members. -testSuccessfulCommitWithNewUsers :: HasCallStack => MessagingSetup -> [Qualified UserId] -> TestM () -testSuccessfulCommitWithNewUsers setup@MessagingSetup {..} newUsers = do - cannon <- view tsCannon - - WS.bracketRN cannon (map (qUnqualified . pUserId) users) $ \wss -> do - -- send commit message - events <- postCommit setup - - let alreadyPresent = - map snd - . filter (\(p, _) -> pUserId p `notElem` newUsers) - $ zip users wss - - liftIO $ - if null newUsers - then do - -- check that alice receives no events - events @?= [] - - -- check that no users receive join events - when (null alreadyPresent) $ - WS.assertNoEvent (1 # WS.Second) wss - else do - -- check that alice receives a join event - case events of - [e] -> assertJoinEvent conversation (pUserId creator) newUsers roleNameWireMember e - [] -> assertFailure "expected join event to be returned to alice" - es -> assertFailure $ "expected one event, found: " <> show es - - -- check that all users receive a join event, - for_ wss $ \ws -> do - WS.assertMatch_ (5 # WS.Second) ws $ - wsAssertMemberJoinWithRole conversation (pUserId creator) newUsers roleNameWireMember - - -- and that the already-present users in the conversation receive a commit - for_ alreadyPresent $ \ws -> do - WS.assertMatch_ (5 # WS.Second) ws $ - wsAssertMLSMessage conversation (pUserId creator) commit - -testSuccessfulRemoveMemberFromConvCommit :: - HasCallStack => - Participant -> - [Participant] -> - Qualified ConvId -> - ByteString -> - [Participant] -> - TestM () -testSuccessfulRemoveMemberFromConvCommit admin users conv commit participantsToRemove = do - cannon <- view tsCannon - - WS.bracketRN cannon (map (qUnqualified . pUserId) users) $ \wss -> do - events :: [Event] <- - fmap mmssEvents . responseJsonError - =<< postMessage (qUnqualified (pUserId admin)) commit - - WS.assertMatch_ (5 # WS.Second) ws $ - wsAssertMembersLeave conv (pUserId admin) (map pUserId participantsToRemove) - - -- all users (including the removed ones) receive the commit - for_ wss $ \ws -> do - WS.assertMatch_ (5 # WS.Second) ws $ - wsAssertMLSMessage conv (pUserId admin) commit - -testFailedCommit :: HasCallStack => MessagingSetup -> Int -> TestM Wai.Error -testFailedCommit MessagingSetup {..} status = do - cannon <- view tsCannon - - WS.bracketRN cannon (map (qUnqualified . pUserId) users) $ \wss -> do - galley <- viewGalley - err <- - responseJsonError - =<< post - ( galley . paths ["mls", "messages"] - . zUser (qUnqualified (pUserId creator)) - . zConn "conn" - . content "message/mls" - . bytes commit - ) - MessagingSetup -> TestM () -testSuccessfulCommit setup = testSuccessfulCommitWithNewUsers setup (map pUserId (users setup)) + runMLSTest $ do + alice1 <- createMLSClient alice + _bob1 <- createFakeMLSClient bob + + void $ setupMLSGroup alice1 + commit <- createAddCommit alice1 [bob] + welcome <- liftIO $ case mpWelcome commit of + Nothing -> assertFailure "Expected welcome message" + Just w -> pure w + (_, reqs) <- + withTempMockFederator' mockedResponse $ + postWelcome (ciUser (mpSender commit)) welcome + !!! const 201 === statusCode + consumeWelcome welcome + fedWelcome <- assertOne (filter ((== "mls-welcome") . frRPC) reqs) + let req :: Maybe MLSWelcomeRequest = Aeson.decode (frBody fedWelcome) + liftIO $ req @?= (Just . MLSWelcomeRequest . Base64ByteString) welcome testAddUser :: TestM () testAddUser = do - setup@MessagingSetup {..} <- - aliceInvitesBob - (1, LocalUser) - def - { createConv = CreateConv, - numCreatorClients = 3 - } - testSuccessfulCommit setup + [alice, bob] <- createAndConnectUsers [Nothing, Nothing] + + qcnv <- runMLSTest $ do + [alice1, bob1, bob2] <- traverse createMLSClient [alice, bob, bob] + traverse_ uploadNewKeyPackage [bob1, bob2] + (_, qcnv) <- setupMLSGroup alice1 + events <- createAddCommit alice1 [bob] >>= sendAndConsumeCommit + event <- assertOne events + liftIO $ assertJoinEvent qcnv alice [bob] roleNameWireMember event + pure qcnv -- check that bob can now see the conversation - let bob = head users convs <- - responseJsonError =<< getConvs (qUnqualified (pUserId bob)) Nothing Nothing + responseJsonError =<< getConvs (qUnqualified bob) Nothing Nothing do + err <- + responseJsonError + =<< postMessage (ciUser (mpSender commit)) (mpMessage commit) + do - (alice, users@[bob]) <- withLastPrekeys $ do - -- bob has 2 MLS clients - participants@(_, [bob]) <- setupParticipants tmp def [(2, LocalUser)] - - -- and a non-MLS client - void $ takeLastPrekey >>= lift . randomClient (qUnqualified (pUserId bob)) - - pure participants - - -- alice creates a conversation and adds Bob's MLS clients - (groupId, conversation) <- setupGroup tmp CreateConv alice "group" - (commit, welcome) <- liftIO $ setupCommit tmp alice "group" "group" (pClients bob) - - pure MessagingSetup {creator = alice, ..} - - testSuccessfulCommit setup + [alice, bob] <- createAndConnectUsers (replicate 2 Nothing) + runMLSTest $ do + alice1 <- createMLSClient alice + -- bob has 2 MLS clients + [bob1, bob2] <- replicateM 2 (createMLSClient bob) + traverse_ uploadNewKeyPackage [bob1, bob2] + -- and a non-MLS client + _bob3 <- createWireClient bob + + void $ setupMLSGroup alice1 + void $ createAddCommit alice1 [bob] >>= sendAndConsumeCommit testAddUserPartial :: TestM () testAddUserPartial = do - (creator, commit) <- withSystemTempDirectory "mls" $ \tmp -> do + [alice, bob, charlie] <- createAndConnectUsers (replicate 3 Nothing) + + runMLSTest $ do -- Bob has 3 clients, Charlie has 2 - (alice, [bob, charlie]) <- withLastPrekeys $ setupParticipants tmp def ((,LocalUser) <$> [3, 2]) + alice1 <- createMLSClient alice + bobClients@[_bob1, _bob2, bob3] <- replicateM 3 (createMLSClient bob) + charlieClients <- replicateM 2 (createMLSClient charlie) - -- upload one more key package for each of bob's clients - -- this makes sure the unused client has at least one key package, and - -- therefore will be considered MLS-capable - for_ (pClients bob) $ \(cid, c) -> do - kp <- - liftIO $ - decodeMLSError - =<< spawn (cli cid tmp ["key-package", "create"]) Nothing - addKeyPackage def {mapKeyPackage = False, setPublicKey = False} (pUserId bob) c kp + -- Only the first 2 clients of Bob's have uploaded key packages + traverse_ uploadNewKeyPackage (take 2 bobClients <> charlieClients) - void $ setupGroup tmp CreateConv alice "group" - (commit, _) <- - liftIO . setupCommit tmp alice "group" "group" $ - -- only 2 out of the 3 clients of Bob's are added to the conversation - NonEmpty.take 2 (pClients bob) <> toList (pClients charlie) - pure (alice, commit) + -- alice adds bob's first 2 clients + void $ setupMLSGroup alice1 + commit <- createAddCommit alice1 [bob, charlie] - galley <- viewGalley + -- before alice can commit, bob3 uploads a key package + void $ uploadNewKeyPackage bob3 - err <- - responseJsonError - =<< post - ( galley . paths ["mls", "messages"] - . zUser (qUnqualified (pUserId creator)) - . zConn "conn" - . content "message/mls" - . bytes commit - ) - do - withLastPrekeys $ do - (alice, [bob]) <- setupParticipants tmp def ((,LocalUser) <$> [1]) - (groupId, conversation) <- lift $ setupGroup tmp CreateConv alice "group" - (commit, welcome) <- liftIO . setupCommit tmp alice "group" "group" $ pClients bob - let setup = - MessagingSetup - { creator = alice, - users = [bob], - .. - } - lift $ testSuccessfulCommit setup - - -- create more clients for Bob, only take the first one - nc <- fmap head . replicateM 2 $ do - setupUserClient tmp CreateWithKey True (pUserId bob) - - -- add new client - (commit', welcome') <- - liftIO $ - setupCommit - tmp - alice - "group" - "group" - [(userClientQid (pUserId bob) nc, nc)] - - lift $ testSuccessfulCommitWithNewUsers setup {commit = commit', welcome = welcome'} [] - -testAddNewClient :: TestM () -testAddNewClient = do - withSystemTempDirectory "mls" $ \tmp -> withLastPrekeys $ do - -- bob starts with a single client - (creator, users@[bob]) <- setupParticipants tmp def [(1, LocalUser)] - (groupId, conversation) <- lift $ setupGroup tmp CreateConv creator "group" - - -- creator sends first commit message - do - (commit, welcome) <- liftIO $ setupCommit tmp creator "group" "group" (pClients bob) - lift $ testSuccessfulCommit MessagingSetup {..} - - do - -- then bob adds a new client - c <- setupUserClient tmp CreateWithKey True (pUserId bob) - let bobC = (userClientQid (pUserId bob) c, c) - -- which gets added to the group - (commit, welcome) <- liftIO $ setupCommit tmp creator "group" "group" [bobC] - -- and the corresponding commit is sent - lift $ testSuccessfulCommitWithNewUsers MessagingSetup {..} [] +testAddClientPartial = do + [alice, bob] <- createAndConnectUsers (replicate 2 Nothing) + runMLSTest $ do + alice1 <- createMLSClient alice + -- bob only has 1 usable client + [bob1, bob2, bob3] <- replicateM 3 (createMLSClient bob) + void $ uploadNewKeyPackage bob1 + + -- alice1 creates a group with bob1 + void $ setupMLSGroup alice1 + void $ createAddCommit alice1 [bob] >>= sendAndConsumeCommit + + -- now bob2 and bob3 upload key packages, and alice adds bob2 only + kp <- uploadNewKeyPackage bob2 >>= keyPackageFile bob2 + void $ uploadNewKeyPackage bob3 + void $ + createAddCommitWithKeyPackages alice1 [(bob2, kp)] + >>= sendAndConsumeCommit testSendAnotherUsersCommit :: TestM () testSendAnotherUsersCommit = do - withSystemTempDirectory "mls" $ \tmp -> withLastPrekeys $ do - -- bob starts with a single client - (creator, users@[bob]) <- setupParticipants tmp def [(1, LocalUser)] - (groupId, conversation) <- lift $ setupGroup tmp CreateConv creator "group" + -- create users + [alice, bob] <- createAndConnectUsers (replicate 2 Nothing) - -- creator sends first commit message - do - (commit, welcome) <- liftIO $ setupCommit tmp creator "group" "group" (pClients bob) - lift $ testSuccessfulCommit MessagingSetup {..} + runMLSTest $ do + [alice1, bob1] <- traverse createMLSClient [alice, bob] - do - -- then bob adds a new client - c <- setupUserClient tmp CreateWithKey True (pUserId bob) - let bobC = (userClientQid (pUserId bob) c, c) - -- which gets added to the group - (commit, _welcome) <- liftIO $ setupCommit tmp creator "group" "group" [bobC] - -- and the corresponding commit is sent from bob instead of the creator - err <- lift (responseJsonError =<< postMessage (qUnqualified (pUserId bob)) commit >= void . sendAndConsumeCommit + + -- Alice creates a commit that adds bob2 + bob2 <- createMLSClient bob + -- upload key packages + void $ uploadNewKeyPackage bob2 + mp <- createAddCommit alice1 [bob] + -- and the corresponding commit is sent from Bob instead of Alice + err <- + responseJsonError + =<< postMessage (qUnqualified bob) (mpMessage mp) + setupMLSGroup alice1 + createAddCommit alice1 [bob] >>= void . sendAndConsumeCommit + e <- + responseJsonError + =<< postMembers + (qUnqualified alice) + (pure charlie) + qcnv + setupMLSGroup alice1 + createAddCommit alice1 [bob] >>= void . sendAndConsumeCommit + e <- + responseJsonError + =<< deleteMemberQualified + (qUnqualified alice) + bob + qcnv + setupMLSGroup alice1 + createAddCommit alice1 [bob] >>= void . sendAndConsumeCommit + e <- + responseJsonError + =<< postProteusMessageQualified + (qUnqualified alice) + (ciClient bob1) + qcnv + [] + "data" + MismatchReportAll + do - (creator, users) <- withLastPrekeys $ setupParticipants tmp def ((,LocalUser) <$> [2, 3]) - (groupId, conversation) <- setupGroup tmp CreateConv creator "group.0" - let (users1, users2) = splitAt 1 users +testStaleCommit = do + (alice : users) <- createAndConnectUsers (replicate 5 Nothing) + let (users1, users2) = splitAt 2 users - -- add the first batch of users to the conversation, but do not overwrite group - do - (commit, welcome) <- - liftIO $ - setupCommit tmp creator "group.0" "group.1" $ - users1 >>= toList . pClients - testSuccessfulCommit MessagingSetup {users = users1, ..} + runMLSTest $ do + (alice1 : clients) <- traverse createMLSClient (alice : users) + traverse_ uploadNewKeyPackage clients + void $ setupMLSGroup alice1 - -- now add the rest of the users to the original group state - do - (commit, welcome) <- - liftIO $ - setupCommit tmp creator "group.0" "group.2" $ - users2 >>= toList . pClients - err <- testFailedCommit MessagingSetup {..} 409 + -- add the first batch of users to the conversation + void $ createAddCommit alice1 users1 >>= sendAndConsumeCommit + + -- now roll back alice1 and try to add the second batch of users + void $ rollBackClient alice1 + commit <- createAddCommit alice1 users2 + err <- + responseJsonError + =<< postMessage (ciUser (mpSender commit)) (mpMessage commit) + pure (Aeson.encode ()) - "on-new-remote-conversation" -> pure (Aeson.encode EmptyResponse) - "get-mls-clients" -> - pure - . Aeson.encode - . Set.fromList - . map (flip ClientInfo True . snd) - . toList - . pClients - $ bob - ms -> assertFailure ("unmocked endpoint called: " <> cs ms) - (events, reqs) <- withTempMockFederator' mock $ do - postCommit setup + users@[alice, bob] <- createAndConnectUsers [Nothing, Just "bob.example.com"] + (events, reqs, qcnv) <- runMLSTest $ do + [alice1, bob1] <- traverse createMLSClient users + (_, qcnv) <- setupMLSGroup alice1 + + let mock req = case frRPC req of + "on-conversation-updated" -> pure (Aeson.encode ()) + "on-new-remote-conversation" -> pure (Aeson.encode EmptyResponse) + "get-mls-clients" -> + pure + . Aeson.encode + . Set.fromList + . map (flip ClientInfo True . ciClient) + $ [bob1] + "mls-welcome" -> pure (Aeson.encode EmptyResponse) + ms -> assertFailure ("unmocked endpoint called: " <> cs ms) + + commit <- createAddCommit alice1 [bob] + (events, reqs) <- + withTempMockFederator' mock $ + sendAndConsumeCommit commit + pure (events, reqs, qcnv) liftIO $ do req <- assertOne $ filter ((== "on-conversation-updated") . frRPC) reqs - frTargetDomain req @?= qDomain (pUserId bob) + frTargetDomain req @?= qDomain bob bdy <- case Aeson.eitherDecode (frBody req) of Right b -> pure b Left e -> assertFailure $ "Could not parse on-conversation-updated request body: " <> e - cuOrigUserId bdy @?= pUserId (creator setup) - cuConvId bdy @?= qUnqualified (conversation setup) - cuAlreadyPresentUsers bdy @?= [qUnqualified (pUserId bob)] + cuOrigUserId bdy @?= alice + cuConvId bdy @?= qUnqualified qcnv + cuAlreadyPresentUsers bdy @?= [qUnqualified bob] cuAction bdy @?= SomeConversationAction SConversationJoinTag ConversationJoin - { cjUsers = pure (pUserId bob), + { cjUsers = pure bob, cjRole = roleNameWireMember } liftIO $ do event <- assertOne events - assertJoinEvent - (conversation setup) - (pUserId (creator setup)) - [pUserId bob] - roleNameWireMember - event + assertJoinEvent qcnv alice [bob] roleNameWireMember event testCommitLock :: TestM () -testCommitLock = withSystemTempDirectory "mls" $ \tmp -> do - -- create MLS conversation - (creator, users) <- withLastPrekeys $ setupParticipants tmp def ((,LocalUser) <$> [2, 2, 2]) - (groupId, conversation) <- setupGroup tmp CreateConv creator "group" - let (users1, usersX) = splitAt 1 users - let (users2, users3) = splitAt 1 usersX - void $ assertOne users1 - void $ assertOne users2 - void $ assertOne users3 - - -- initial user can be added - do - (commit, welcome) <- - liftIO $ - setupCommit tmp creator "group" "group" $ - users1 >>= toList . pClients - testSuccessfulCommit MessagingSetup {users = users1, ..} +testCommitLock = do + users <- createAndConnectUsers (replicate 4 Nothing) - -- can commit without blocking - do - (commit, welcome) <- - liftIO $ - setupCommit tmp creator "group" "group" $ - users2 >>= toList . pClients - testSuccessfulCommit MessagingSetup {users = users2, ..} + runMLSTest $ do + [alice1, bob1, charlie1, dee1] <- traverse createMLSClient users + (groupId, _) <- setupMLSGroup alice1 + traverse_ uploadNewKeyPackage [bob1, charlie1, dee1] - -- block epoch - casClient <- view tsCass - runClient casClient $ insertLock (convToGroupId (qTagUnsafe conversation)) (Epoch 2) + -- alice adds add bob + void $ createAddCommit alice1 [cidQualifiedUser bob1] >>= sendAndConsumeCommit - -- commit fails due to competing lock - do - (commit, welcome) <- - liftIO $ - setupCommit tmp creator "group" "group" $ - users3 >>= toList . pClients - -- assert HTTP 409 on next attempt to commit - err <- testFailedCommit MessagingSetup {..} 409 - liftIO $ Wai.label err @?= "mls-stale-message" + -- alice adds charlie + void $ createAddCommit alice1 [cidQualifiedUser charlie1] >>= sendAndConsumeCommit + + -- simulate concurrent commit by blocking epoch + casClient <- view tsCass + runClient casClient $ insertLock groupId (Epoch 2) - -- unblock epoch - runClient casClient $ deleteLock (convToGroupId (qTagUnsafe conversation)) (Epoch 2) + -- commit should fail due to competing lock + do + commit <- createAddCommit alice1 [cidQualifiedUser dee1] + err <- + responseJsonError + =<< postMessage (ciUser alice1) (mpMessage commit) + do LocalQuorum (groupId, epoch) ) - unlock :: PrepQuery W (GroupId, Epoch) () - unlock = "delete from mls_commit_locks where group_id = ? and epoch = ?" - deleteLock groupId epoch = - retry x5 $ - write - unlock - ( params - LocalQuorum - (groupId, epoch) - ) testAddUserBareProposalCommit :: TestM () -testAddUserBareProposalCommit = withSystemTempDirectory "mls" $ \tmp -> do - (alice, [bob]) <- withLastPrekeys $ setupParticipants tmp def [(1, LocalUser)] - - (groupId, conversation) <- setupGroup tmp CreateConv alice "group" - - prop <- liftIO $ bareAddProposal tmp alice bob "group" "group" - postMessage (qUnqualified (pUserId alice)) prop - !!! const 201 === statusCode - - (commit, mbWelcome) <- - liftIO $ - pendingProposalsCommit tmp alice "group" - - welcome <- assertJust mbWelcome - - testSuccessfulCommit MessagingSetup {creator = alice, users = [bob], ..} - - -- check that bob can now see the conversation - convs <- - responseJsonError =<< getConvs (qUnqualified (pUserId bob)) Nothing Nothing - >= traverse_ sendAndConsumeMessage + commit <- createPendingProposalCommit alice1 + void $ assertJust (mpWelcome commit) + void $ sendAndConsumeCommit commit + + -- check that bob can now see the conversation + liftTest $ do + convs <- + responseJsonError =<< getConvs (ciUser bob1) Nothing Nothing + do - (alice, [bob]) <- withLastPrekeys $ setupParticipants tmp def [(1, LocalUser)] - - (groupId, conversation) <- setupGroup tmp CreateConv alice "group" - - -- create proposal, but don't send it to group - void $ liftIO $ bareAddProposal tmp alice bob "group" "group" - - (commit, mbWelcome) <- - liftIO $ - pendingProposalsCommit tmp alice "group" - - welcome <- assertJust mbWelcome - - err <- testFailedCommit (MessagingSetup {creator = alice, users = [bob], ..}) 404 - liftIO $ Wai.label err @?= "mls-proposal-not-found" +testUnknownProposalRefCommit = do + [alice, bob] <- createAndConnectUsers (replicate 2 Nothing) + runMLSTest $ do + [alice1, bob1] <- traverse createMLSClient [alice, bob] + void $ setupMLSGroup alice1 + void $ uploadNewKeyPackage bob1 + + -- create proposal, but don't send it to group + void $ createAddProposals alice1 [bob] + commit <- createPendingProposalCommit alice1 + + -- send commit before proposal + err <- + responseJsonError =<< postMessage (ciUser alice1) (mpMessage commit) + do - (alice, [bob, dee]) <- withLastPrekeys $ setupParticipants tmp def [(1, LocalUser), (1, LocalUser)] +testCommitNotReferencingAllProposals = do + users@[_alice, bob, charlie] <- createAndConnectUsers (replicate 3 Nothing) - (groupId, conversation) <- setupGroup tmp CreateConv alice "group" + runMLSTest $ do + [alice1, bob1, charlie1] <- traverse createMLSClient users + void $ setupMLSGroup alice1 + traverse_ uploadNewKeyPackage [bob1, charlie1] - propBob <- liftIO $ bareAddProposal tmp alice bob "group" "group" - postMessage (qUnqualified (pUserId alice)) propBob - !!! const 201 === statusCode + -- create proposals for bob and charlie + createAddProposals alice1 [bob, charlie] + >>= traverse_ sendAndConsumeMessage - propDee <- liftIO $ bareAddProposal tmp alice dee "group" "group2" - postMessage (qUnqualified (pUserId alice)) propDee - !!! const 201 === statusCode + -- now create a commit referencing only the first proposal + void $ rollBackClient alice1 + commit <- createPendingProposalCommit alice1 - (commit, mbWelcome) <- - liftIO $ - pendingProposalsCommit tmp alice "group" - - welcome <- assertJust mbWelcome - - err <- testFailedCommit (MessagingSetup {creator = alice, users = [bob, dee], ..}) 409 - liftIO $ Wai.label err @?= "mls-commit-missing-references" + -- send commit and expect and error + err <- + responseJsonError =<< postMessage (ciUser alice1) (mpMessage commit) + do - MessagingSetup {..} <- aliceInvitesBobWithTmp tmp (2, LocalUser) def {createConv = CreateConv} - let [bob] = users - - testSuccessfulCommit MessagingSetup {users = [bob], ..} - - (removalCommit, _mbWelcome) <- liftIO $ setupRemoveCommit tmp creator "group" "group" (pClients bob) - - do - convs <- - responseJsonError =<< getConvs (qUnqualified (pUserId bob)) Nothing Nothing - >= sendAndConsumeCommit + events <- createRemoveCommit alice1 [bob1, bob2] >>= sendAndConsumeCommit + pure (qcnv, events) + + liftIO $ assertOne events >>= assertLeaveEvent qcnv alice [bob] do convs <- - responseJsonError =<< getConvs (qUnqualified (pUserId bob)) Nothing Nothing + responseJsonError =<< getConvs (qUnqualified bob) Nothing Nothing do - MessagingSetup {..} <- aliceInvitesBobWithTmp tmp (2, LocalUser) def {createConv = CreateConv} - let [bob] = users - - testSuccessfulCommit MessagingSetup {users = [bob], ..} - - -- remove only first client of bob - (removalCommit, _mbWelcome) <- liftIO $ setupRemoveCommit tmp creator "group" "group" [NE.head (pClients bob)] +testRemoveClientsIncomplete = do + [alice, bob] <- createAndConnectUsers [Nothing, Nothing] + runMLSTest $ do + [alice1, bob1, bob2] <- traverse createMLSClient [alice, bob, bob] + traverse_ uploadNewKeyPackage [bob1, bob2] + void $ setupMLSGroup alice1 + void $ createAddCommit alice1 [bob] >>= sendAndConsumeCommit + commit <- createRemoveCommit alice1 [bob1] - err <- - responseJsonError - =<< postMessage (qUnqualified (pUserId creator)) removalCommit - TestM () -testRemoveDeletedClient deleteClientBefore = withSystemTempDirectory "mls" $ \tmp -> do - (creator, [bob, dee]) <- withLastPrekeys $ setupParticipants tmp def [(2, LocalUser), (1, LocalUser)] - - -- create a group - (groupId, conversation) <- setupGroup tmp CreateConv creator "group" - - -- add clients to it and get welcome message - (addCommit, welcome) <- - liftIO $ - setupCommit tmp creator "group" "group" $ - NonEmpty.tail (pClients creator) <> toList (pClients bob) <> toList (pClients dee) - - testSuccessfulCommit MessagingSetup {users = [bob, dee], commit = addCommit, ..} - - let (_bobClient1, bobClient2) = assertTwo (toList (pClients bob)) - - when deleteClientBefore $ do - cannon <- view tsCannon - WS.bracketR - cannon - (qUnqualified . pUserId $ bob) - $ \ws -> do - deleteClient (qUnqualified (pUserId bob)) (snd bobClient2) (Just defPassword) - !!! statusCode - === const - 200 + err <- + responseJsonError + =<< postMessage (qUnqualified alice) (mpMessage commit) + >= sendAndConsumeCommit + + liftTest $ do + cannon <- view tsCannon + WS.bracketR cannon (qUnqualified bob) $ \ws -> do + deleteClient (qUnqualified bob) (ciClient bob2) (Just defPassword) + !!! statusCode === const 200 -- check that the corresponding event is received - liftIO $ WS.assertMatch_ (5 # WS.Second) ws $ - wsAssertClientRemoved (snd bobClient2) - - void . liftIO $ - spawn - ( cli - (pClientQid bob) - tmp - [ "group", - "from-welcome", - "--group-out", - tmp "group", - tmp "welcome" - ] - ) - Nothing - - void . liftIO $ - spawn - ( cli - (pClientQid dee) - tmp - [ "group", - "from-welcome", - "--group-out", - tmp "group", - tmp "welcome" - ] - ) - Nothing - - (removalCommit, _mbWelcome) <- liftIO $ setupRemoveCommit tmp dee "group" "group" [bobClient2] - - -- dee (which is not an admin) commits removal of bob's deleted client - let doCommitRemoval = postMessage (qUnqualified (pUserId dee)) removalCommit - - if deleteClientBefore - then do - events :: [Event] <- - fmap mmssEvents . responseJsonError - =<< doCommitRemoval - do - MessagingSetup {..} <- aliceInvitesBobWithTmp tmp (2, LocalUser) def {createConv = CreateConv} - let [bob] = users - - testSuccessfulCommit MessagingSetup {users = [bob], ..} - - -- attempt to remove only first client of bob - (removalCommit, _mbWelcome) <- liftIO $ setupRemoveCommit tmp creator "group" "group" [NonEmpty.head (pClients bob)] - - err <- - responseJsonError - =<< postMessage (qUnqualified (pUserId creator)) removalCommit - >= sendAndConsumeCommit + liftIO $ assertEqual "a non-admin received conversation events when removing a client" [] events testRemoteAppMessage :: TestM () -testRemoteAppMessage = withSystemTempDirectory "mls" $ \tmp -> do - let opts = - def - { createClients = DontCreateClients, - createConv = CreateConv - } - (alice, [bob]) <- - withLastPrekeys $ - setupParticipants tmp opts [(1, RemoteUser (Domain "faraway.example.com"))] - (groupId, conversation) <- setupGroup tmp CreateConv alice "group" - (commit, welcome) <- liftIO $ setupCommit tmp alice "group" "group" (pClients bob) - message <- - liftIO $ - spawn (cli (pClientQid alice) tmp ["message", "--group", tmp "group", "some text"]) Nothing - - let mock req = case frRPC req of - "on-conversation-updated" -> pure (Aeson.encode ()) - "on-new-remote-conversation" -> pure (Aeson.encode EmptyResponse) - "on-mls-message-sent" -> pure (Aeson.encode EmptyResponse) - "get-mls-clients" -> - pure - . Aeson.encode - . Set.fromList - . map (flip ClientInfo True . snd) - . toList - . pClients - $ bob - ms -> assertFailure ("unmocked endpoint called: " <> cs ms) - (events :: [Event], reqs) <- fmap (first mmssEvents) . withTempMockFederator' mock $ do - galley <- viewGalley - void $ postCommit MessagingSetup {creator = alice, users = [bob], ..} - let v2 = toByteString' (toLower <$> show V2) - responseJsonError - =<< post - ( galley . paths [v2, "mls", "messages"] - . zUser (qUnqualified (pUserId alice)) - . zConn "conn" - . content "message/mls" - . bytes message - ) - pure (Aeson.encode ()) + "on-new-remote-conversation" -> pure (Aeson.encode EmptyResponse) + "on-mls-message-sent" -> pure (Aeson.encode EmptyResponse) + "get-mls-clients" -> + pure + . Aeson.encode + . Set.singleton + $ ClientInfo (ciClient bob1) True + ms -> assertFailure ("unmocked endpoint called: " <> cs ms) - liftIO $ do - req <- assertOne $ filter ((== "on-mls-message-sent") . frRPC) reqs - frTargetDomain req @?= qDomain (pUserId bob) - bdy <- case Aeson.eitherDecode (frBody req) of - Right b -> pure b - Left e -> assertFailure $ "Could not parse on-mls-message-sent request body: " <> e - rmmSender bdy @?= pUserId alice - rmmConversation bdy @?= qUnqualified conversation - rmmRecipients bdy - @?= [(qUnqualified (pUserId bob), c) | (_, c) <- toList (pClients bob)] - rmmMessage bdy @?= Base64ByteString message + ((message, events), reqs) <- withTempMockFederator' mock $ do + void $ createAddCommit alice1 [bob] >>= sendAndConsumeCommit + message <- createApplicationMessage alice1 "hello" + events <- sendAndConsumeMessage message + pure (message, events) - liftIO $ assertBool "Unexpected events returned" (null events) + liftIO $ do + req <- assertOne $ filter ((== "on-mls-message-sent") . frRPC) reqs + frTargetDomain req @?= qDomain bob + bdy <- case Aeson.eitherDecode (frBody req) of + Right b -> pure b + Left e -> assertFailure $ "Could not parse on-mls-message-sent request body: " <> e + rmmSender bdy @?= alice + rmmConversation bdy @?= qUnqualified qcnv + rmmRecipients bdy @?= [(ciUser bob1, ciClient bob1)] + rmmMessage bdy @?= Base64ByteString (mpMessage message) + + liftIO $ assertBool "Unexpected events returned" (null events) -- The following test happens within backend B -- Alice@A is remote and Bob@B is local @@ -1019,243 +797,167 @@ testRemoteAppMessage = withSystemTempDirectory "mls" $ \tmp -> do -- faked: 4 -- actual test step: 12 14 testLocalToRemote :: TestM () -testLocalToRemote = withSystemTempDirectory "mls" $ \tmp -> do - let domain = Domain "faraway.example.com" - -- step 2 - MessagingSetup {creator = alice, users = [bob], ..} <- - aliceInvitesBobWithTmp - tmp - (1, LocalUser) - def - { creatorOrigin = RemoteUser domain - } - - -- step 10 - liftIO $ mergeWelcome tmp (pClientQid bob) "group" "groupB.json" "welcome" - -- step 11 - message <- - liftIO $ - spawn - ( cli - (pClientQid bob) - tmp - ["message", "--group", tmp "groupB.json", "hi"] - ) - Nothing - - fedGalleyClient <- view tsFedGalleyClient - - -- register remote conversation: step 4 - qcnv <- randomQualifiedId (qDomain (pUserId alice)) - let nrc = - NewRemoteConversation (qUnqualified qcnv) $ - ProtocolMLS (ConversationMLSData groupId (Epoch 1) MLS_128_DHKEMX25519_AES128GCM_SHA256_Ed25519) - void $ - runFedClient - @"on-new-remote-conversation" - fedGalleyClient - (qDomain (pUserId alice)) - nrc - - -- A notifies B about bob being in the conversation (Join event): step 5 - now <- liftIO getCurrentTime - let cu = - ConversationUpdate - { cuTime = now, - cuOrigUserId = pUserId alice, - cuConvId = qUnqualified qcnv, - cuAlreadyPresentUsers = [qUnqualified $ pUserId bob], - cuAction = - SomeConversationAction - SConversationJoinTag - ConversationJoin - { cjUsers = pure (pUserId bob), - cjRole = roleNameWireMember - } - } - void $ - runFedClient - @"on-conversation-updated" - fedGalleyClient - (qDomain (pUserId alice)) - cu - - let mock req = case frRPC req of - "send-mls-message" -> pure (Aeson.encode (MLSMessageResponseUpdates [])) - rpc -> assertFailure $ "unmocked RPC called: " <> T.unpack rpc - - (_, reqs) <- withTempMockFederator' mock $ do - galley <- viewGalley - - -- bob sends a message: step 12 - post - ( galley . paths ["mls", "messages"] - . zUser (qUnqualified (pUserId bob)) - . zConn "conn" - . content "message/mls" - . bytes message - ) - !!! const 201 - === statusCode - - -- check requests to mock federator: step 14 - liftIO $ do - req <- assertOne reqs - frRPC req @?= "send-mls-message" - frTargetDomain req @?= qDomain qcnv - bdy <- case Aeson.eitherDecode (frBody req) of - Right b -> pure b - Left e -> assertFailure $ "Could not parse send-mls-message request body: " <> e - msrConvId bdy @?= qUnqualified qcnv - msrSender bdy @?= qUnqualified (pUserId bob) - msrRawMessage bdy @?= Base64ByteString message +testLocalToRemote = do + -- create users + let aliceDomain = Domain "faraway.example.com" + [alice, bob] <- createAndConnectUsers [Just (domainText aliceDomain), Nothing] + + runMLSTest $ do + [alice1, bob1] <- traverse createMLSClient [alice, bob] + + -- upload key packages + void $ uploadNewKeyPackage bob1 + + -- step 2 + (groupId, qcnv) <- setupFakeMLSGroup alice1 + mp <- createAddCommit alice1 [bob] + -- step 10 + traverse_ consumeWelcome (mpWelcome mp) + -- step 11 + message <- createApplicationMessage bob1 "hi" + + -- register remote conversation: step 4 + receiveNewRemoteConv qcnv groupId + -- A notifies B about bob being in the conversation (Join event): step 5 + receiveOnConvUpdated qcnv alice bob + + let mock req = case frRPC req of + "send-mls-message" -> pure (Aeson.encode (MLSMessageResponseUpdates [])) + rpc -> assertFailure $ "unmocked RPC called: " <> T.unpack rpc + + (_, reqs) <- + withTempMockFederator' mock $ + -- bob sends a message: step 12 + sendAndConsumeMessage message + + -- check requests to mock federator: step 14 + liftIO $ do + req <- assertOne reqs + frRPC req @?= "send-mls-message" + frTargetDomain req @?= qDomain qcnv + bdy <- case Aeson.eitherDecode (frBody req) of + Right b -> pure b + Left e -> assertFailure $ "Could not parse send-mls-message request body: " <> e + msrConvId bdy @?= qUnqualified qcnv + msrSender bdy @?= qUnqualified bob + msrRawMessage bdy @?= Base64ByteString (mpMessage message) + where + receiveOnConvUpdated conv origUser joiner = do + client <- view tsFedGalleyClient + now <- liftIO getCurrentTime + let cu = + ConversationUpdate + { cuTime = now, + cuOrigUserId = origUser, + cuConvId = qUnqualified conv, + cuAlreadyPresentUsers = [qUnqualified joiner], + cuAction = + SomeConversationAction + SConversationJoinTag + ConversationJoin + { cjUsers = pure joiner, + cjRole = roleNameWireMember + } + } + void $ + runFedClient + @"on-conversation-updated" + client + (qDomain conv) + cu testLocalToRemoteNonMember :: TestM () -testLocalToRemoteNonMember = withSystemTempDirectory "mls" $ \tmp -> do +testLocalToRemoteNonMember = do + -- create users let domain = Domain "faraway.example.com" - -- step 2 - MessagingSetup {creator = alice, users = [bob], ..} <- - aliceInvitesBobWithTmp - tmp - (1, LocalUser) - def - { creatorOrigin = RemoteUser domain - } - - -- step 10 - liftIO $ mergeWelcome tmp (pClientQid bob) "group" "groupB.json" "welcome" - -- step 11 - message <- - liftIO $ - spawn - ( cli - (pClientQid bob) - tmp - ["message", "--group", tmp "groupB.json", "hi"] - ) - Nothing + [alice, bob] <- createAndConnectUsers [Just (domainText domain), Nothing] - fedGalleyClient <- view tsFedGalleyClient + runMLSTest $ do + [alice1, bob1] <- traverse createMLSClient [alice, bob] - -- register remote conversation: step 4 - qcnv <- randomQualifiedId (qDomain (pUserId alice)) - let nrc = - NewRemoteConversation (qUnqualified qcnv) $ - ProtocolMLS (ConversationMLSData groupId (Epoch 1) MLS_128_DHKEMX25519_AES128GCM_SHA256_Ed25519) - void $ - runFedClient - @"on-new-remote-conversation" - fedGalleyClient - (qDomain (pUserId alice)) - nrc - - let mock req = case frRPC req of - "send-mls-message" -> pure (Aeson.encode (MLSMessageResponseUpdates [])) - rpc -> assertFailure $ "unmocked RPC called: " <> T.unpack rpc - - void $ - withTempMockFederator' mock $ do - galley <- viewGalley - - -- bob sends a message: step 12 - post - ( galley . paths ["mls", "messages"] - . zUser (qUnqualified (pUserId bob)) - . zConn "conn" - . content "message/mls" - . bytes message - ) - !!! do - const 404 === statusCode - const (Just "no-conversation-member") === fmap Wai.label . responseJsonError + void $ uploadNewKeyPackage bob1 -testAppMessage :: TestM () -testAppMessage = withSystemTempDirectory "mls" $ \tmp -> do - (creator, users) <- withLastPrekeys $ setupParticipants tmp def ((,LocalUser) <$> [1, 2, 3]) - (groupId, conversation) <- setupGroup tmp CreateConv creator "group" + -- step 2 + (groupId, qcnv) <- setupFakeMLSGroup alice1 - (commit, welcome) <- - liftIO $ - setupCommit tmp creator "group" "group" $ - users >>= toList . pClients + mp <- createAddCommit alice1 [bob] + -- step 10 + traverse_ consumeWelcome (mpWelcome mp) + -- step 11 + message <- createApplicationMessage bob1 "hi" - void $ postCommit MessagingSetup {..} - message <- liftIO $ createMessage tmp creator "group" "some text" + -- register remote conversation: step 4 + receiveNewRemoteConv qcnv groupId - galley <- viewGalley - cannon <- view tsCannon + let mock req = case frRPC req of + "send-mls-message" -> pure (Aeson.encode (MLSMessageResponseUpdates [])) + rpc -> assertFailure $ "unmocked RPC called: " <> T.unpack rpc - WS.bracketRN - cannon - (map (qUnqualified . pUserId) (creator : users)) - $ \wss -> do - post - ( galley . paths ["mls", "messages"] - . zUser (qUnqualified (pUserId creator)) - . zConn "conn" - . content "message/mls" - . bytes message - ) - !!! const 201 - === statusCode + void $ + withTempMockFederator' mock $ do + galley <- viewGalley - -- check that the corresponding event is received + -- bob sends a message: step 12 + post + ( galley . paths ["mls", "messages"] + . zUser (qUnqualified bob) + . zConn "conn" + . content "message/mls" + . bytes (mpMessage message) + ) + !!! do + const 404 === statusCode + const (Just "no-conversation-member") + === fmap Wai.label . responseJsonError +testAppMessage :: TestM () +testAppMessage = do + users@(alice : _) <- createAndConnectUsers (replicate 4 Nothing) + + runMLSTest $ do + clients@(alice1 : _) <- traverse createMLSClient users + traverse_ uploadNewKeyPackage (tail clients) + (_, qcnv) <- setupMLSGroup alice1 + void $ createAddCommit alice1 (tail users) >>= sendAndConsumeCommit + message <- createApplicationMessage alice1 "some text" + + mlsBracket clients $ \wss -> do + events <- sendAndConsumeMessage message + liftIO $ events @?= [] liftIO $ WS.assertMatchN_ (5 # WS.Second) wss $ - wsAssertMLSMessage conversation (pUserId creator) message + wsAssertMLSMessage qcnv alice (mpMessage message) testAppMessage2 :: TestM () testAppMessage2 = do - (MessagingSetup {..}, message) <- withSystemTempDirectory "mls" $ \tmp -> do - (creator, users) <- withLastPrekeys $ setupParticipants tmp def ((,LocalUser) <$> [2, 1]) - (groupId, conversation) <- setupGroup tmp CreateConv creator "group" + -- create users + [alice, bob, charlie] <- createAndConnectUsers (replicate 3 Nothing) - (commit, welcome) <- - liftIO $ - setupCommit tmp creator "group" "group" $ - users >>= toList . pClients + runMLSTest $ do + alice1 : clients@[bob1, _bob2, _charlie1] <- + traverse createMLSClient [alice, bob, bob, charlie] - let setup = MessagingSetup {..} - void $ postCommit setup + -- upload key packages + traverse_ uploadNewKeyPackage clients - let bob = head users - liftIO $ mergeWelcome tmp (pClientQid bob) "group" "group" "welcome" - message <- - liftIO $ - createMessage tmp bob "group" "some text" - pure (setup, message) + -- create group with alice1 and other clients + conversation <- snd <$> setupMLSGroup alice1 + mp <- createAddCommit alice1 [bob, charlie] + void $ sendAndConsumeCommit mp - let (bob, charlie) = assertTwo users - galley <- viewGalley - cannon <- view tsCannon + traverse_ consumeWelcome (mpWelcome mp) - let mkClients p = do - c <- pClients p - pure (qUnqualified (pUserId p), snd c) - - WS.bracketAsClientRN - cannon - ( toList (mkClients creator) - <> NonEmpty.tail (mkClients bob) - <> toList (mkClients charlie) - ) - $ \wss -> do - post - ( galley . paths ["mls", "messages"] - . zUser (qUnqualified (pUserId bob)) - . zConn "conn" - . content "message/mls" - . bytes message - ) - !!! const 201 - === statusCode + message <- createApplicationMessage bob1 "some text" + + mlsBracket (alice1 : clients) $ \wss -> do + events <- sendAndConsumeMessage message + liftIO $ events @?= [] -- check that the corresponding event is received liftIO $ WS.assertMatchN_ (5 # WS.Second) wss $ - wsAssertMLSMessage conversation (pUserId bob) message + wsAssertMLSMessage conversation bob (mpMessage message) testRemoteToRemote :: TestM () testRemoteToRemote = do @@ -1318,20 +1020,20 @@ testRemoteToLocal = do -- bob then sends a message to the conversation let bobDomain = Domain "faraway.example.com" + -- create users + [alice, bob] <- createAndConnectUsers [Nothing, Just (domainText bobDomain)] -- Simulate the whole MLS setup for both clients first. In reality, -- backend calls would need to happen in order for bob to get ahold of a -- welcome message, but that should not affect the correctness of the test. - (MessagingSetup {..}, message) <- withSystemTempDirectory "mls" $ \tmp -> do - setup <- - aliceInvitesBobWithTmp - tmp - (1, RemoteUser bobDomain) - def - { createConv = CreateConv - } - bob <- assertOne (users setup) + runMLSTest $ do + [alice1, bob1] <- traverse createMLSClient [alice, bob] + + (_groupId, qcnv) <- setupMLSGroup alice1 + kpb <- claimKeyPackages alice1 bob + mp <- createAddCommit alice1 [bob] + let mockedResponse fedReq = case frRPC fedReq of "mls-welcome" -> pure (Aeson.encode EmptyResponse) @@ -1340,48 +1042,35 @@ testRemoteToLocal = do "get-mls-clients" -> pure . Aeson.encode - . Set.fromList - . map (flip ClientInfo True . snd) - . toList - . pClients - $ bob + . Set.singleton + $ ClientInfo (ciClient bob1) True + "claim-key-packages" -> pure . Aeson.encode $ kpb ms -> assertFailure ("unmocked endpoint called: " <> cs ms) void . withTempMockFederator' mockedResponse $ - postCommit setup - liftIO $ mergeWelcome tmp (pClientQid bob) "group" "groupB.json" "welcome" - message <- - liftIO $ - spawn - ( cli - (pClientQid bob) - tmp - ["message", "--group", tmp "groupB.json", "hello from another backend"] - ) - Nothing - pure (setup, message) + sendAndConsumeCommit mp - let bob = head users - let alice = creator + traverse_ consumeWelcome (mpWelcome mp) + message <- createApplicationMessage bob1 "hello from another backend" - fedGalleyClient <- view tsFedGalleyClient - cannon <- view tsCannon + fedGalleyClient <- view tsFedGalleyClient + cannon <- view tsCannon - -- actual test + -- actual test - let msr = - MessageSendRequest - { msrConvId = qUnqualified conversation, - msrSender = qUnqualified (pUserId bob), - msrRawMessage = Base64ByteString message - } + let msr = + MessageSendRequest + { msrConvId = qUnqualified qcnv, + msrSender = qUnqualified bob, + msrRawMessage = Base64ByteString (mpMessage message) + } - WS.bracketR cannon (qUnqualified (pUserId alice)) $ \ws -> do - resp <- runFedClient @"send-mls-message" fedGalleyClient bobDomain msr - liftIO $ do - resp @?= MLSMessageResponseUpdates [] - WS.assertMatch_ (5 # Second) ws $ - wsAssertMLSMessage conversation (pUserId bob) message + WS.bracketR cannon (qUnqualified alice) $ \ws -> do + resp <- runFedClient @"send-mls-message" fedGalleyClient bobDomain msr + liftIO $ do + resp @?= MLSMessageResponseUpdates [] + WS.assertMatch_ (5 # Second) ws $ + wsAssertMLSMessage qcnv bob (mpMessage message) testRemoteToLocalWrongConversation :: TestM () testRemoteToLocalWrongConversation = do @@ -1390,20 +1079,19 @@ testRemoteToLocalWrongConversation = do -- bob then sends a message to the conversation let bobDomain = Domain "faraway.example.com" + [alice, bob] <- createAndConnectUsers [Nothing, Just (domainText bobDomain)] -- Simulate the whole MLS setup for both clients first. In reality, -- backend calls would need to happen in order for bob to get ahold of a -- welcome message, but that should not affect the correctness of the test. - (MessagingSetup {..}, message) <- withSystemTempDirectory "mls" $ \tmp -> do - setup <- - aliceInvitesBobWithTmp - tmp - (1, RemoteUser bobDomain) - def - { createConv = CreateConv - } - bob <- assertOne (users setup) + runMLSTest $ do + [alice1, bob1] <- traverse createMLSClient [alice, bob] + + void $ claimKeyPackages alice1 bob + void $ setupMLSGroup alice1 + mp <- createAddCommit alice1 [bob] + let mockedResponse fedReq = case frRPC fedReq of "mls-welcome" -> pure (Aeson.encode EmptyResponse) @@ -1412,42 +1100,27 @@ testRemoteToLocalWrongConversation = do "get-mls-clients" -> pure . Aeson.encode - . Set.fromList - . map (flip ClientInfo True . snd) - . toList - . pClients - $ bob + . Set.singleton + $ ClientInfo (ciClient bob1) True ms -> assertFailure ("unmocked endpoint called: " <> cs ms) - void . withTempMockFederator' mockedResponse $ - postCommit setup - liftIO $ mergeWelcome tmp (pClientQid bob) "group" "groupB.json" "welcome" - message <- - liftIO $ - spawn - ( cli - (pClientQid bob) - tmp - ["message", "--group", tmp "groupB.json", "hello from another backend"] - ) - Nothing - pure (setup, message) - - let bob = head users + void . withTempMockFederator' mockedResponse $ sendAndConsumeCommit mp + traverse_ consumeWelcome (mpWelcome mp) + message <- createApplicationMessage bob1 "hello from another backend" - fedGalleyClient <- view tsFedGalleyClient + fedGalleyClient <- view tsFedGalleyClient - -- actual test - randomConfId <- randomId - let msr = - MessageSendRequest - { msrConvId = randomConfId, - msrSender = qUnqualified (pUserId bob), - msrRawMessage = Base64ByteString message - } + -- actual test + randomConfId <- randomId + let msr = + MessageSendRequest + { msrConvId = randomConfId, + msrSender = qUnqualified bob, + msrRawMessage = Base64ByteString (mpMessage message) + } - resp <- runFedClient @"send-mls-message" fedGalleyClient bobDomain msr - liftIO $ resp @?= MLSMessageResponseError MLSGroupConversationMismatch + resp <- runFedClient @"send-mls-message" fedGalleyClient bobDomain msr + liftIO $ resp @?= MLSMessageResponseError MLSGroupConversationMismatch testRemoteNonMemberToLocal :: TestM () testRemoteNonMemberToLocal = do @@ -1456,272 +1129,200 @@ testRemoteNonMemberToLocal = do -- bob then sends a message to the conversation let bobDomain = Domain "faraway.example.com" + [alice, bob] <- createAndConnectUsers [Nothing, Just (domainText bobDomain)] -- Simulate the whole MLS setup for both clients first. In reality, -- backend calls would need to happen in order for bob to get ahold of a -- welcome message, but that should not affect the correctness of the test. - (MessagingSetup {..}, message) <- withSystemTempDirectory "mls" $ \tmp -> do - setup <- - aliceInvitesBobWithTmp - tmp - (1, RemoteUser bobDomain) - def - { createConv = CreateConv - } - bob <- assertOne (users setup) - liftIO $ mergeWelcome tmp (pClientQid bob) "group" "groupB.json" "welcome" - message <- - liftIO $ - spawn - ( cli - (pClientQid bob) - tmp - ["message", "--group", tmp "groupB.json", "hello from another backend"] - ) - Nothing - pure (setup, message) + runMLSTest $ do + [alice1, bob1] <- traverse createMLSClient [alice, bob] - let bob = head users - fedGalleyClient <- view tsFedGalleyClient + qcnv <- snd <$> setupMLSGroup alice1 + void $ claimKeyPackages alice1 bob + mp <- createAddCommit alice1 [bob] + traverse_ consumeWelcome (mpWelcome mp) - -- actual test + message <- createApplicationMessage bob1 "hello from another backend" - let msr = - MessageSendRequest - { msrConvId = qUnqualified conversation, - msrSender = qUnqualified (pUserId bob), - msrRawMessage = Base64ByteString message - } + let msr = + MessageSendRequest + { msrConvId = qUnqualified qcnv, + msrSender = qUnqualified bob, + msrRawMessage = Base64ByteString (mpMessage message) + } - resp <- runFedClient @"send-mls-message" fedGalleyClient bobDomain msr - liftIO $ do - resp @?= MLSMessageResponseError ConvNotFound + fedGalleyClient <- view tsFedGalleyClient + resp <- runFedClient @"send-mls-message" fedGalleyClient bobDomain msr + liftIO $ do + resp @?= MLSMessageResponseError ConvNotFound -- | The group exists in mls-test-cli's store, but not in wire-server's database. propNonExistingConv :: TestM () -propNonExistingConv = withSystemTempDirectory "mls" $ \tmp -> do - (creator, [bob]) <- withLastPrekeys $ setupParticipants tmp def [(1, LocalUser)] - - let groupId = toBase64Text "test_group" - groupJSON <- - liftIO $ - spawn (cli (pClientQid creator) tmp ["group", "create", T.unpack groupId]) Nothing - liftIO $ BS.writeFile (tmp cs groupId) groupJSON - - prop <- - liftIO $ - spawn - ( cli - (pClientQid creator) - tmp - [ "proposal", - "--group-in", - tmp cs groupId, - "--in-place", - "add", - tmp pClientQid bob - ] - ) - Nothing - postMessage (qUnqualified (pUserId creator)) prop !!! do - const 404 === statusCode - const (Just "no-conversation") === fmap Wai.label . responseJsonError +propNonExistingConv = do + [alice, bob] <- createAndConnectUsers (replicate 2 Nothing) + runMLSTest $ do + [alice1, bob1] <- traverse createMLSClient [alice, bob] + void $ uploadNewKeyPackage bob1 + createGroup alice1 "test_group" + + [prop] <- createAddProposals alice1 [bob] + postMessage (ciUser alice1) (mpMessage prop) !!! do + const 404 === statusCode + const (Just "no-conversation") === fmap Wai.label . responseJsonError propExistingConv :: TestM () -propExistingConv = withSystemTempDirectory "mls" $ \tmp -> do - (creator, [bob]) <- withLastPrekeys $ setupParticipants tmp def [(1, LocalUser)] - -- setupGroup :: HasCallStack => FilePath -> CreateConv -> Participant -> String -> TestM (Qualified ConvId) - void $ setupGroup tmp CreateConv creator "group.json" - - prop <- liftIO $ bareAddProposal tmp creator bob "group.json" "group.json" +propExistingConv = do + [alice, bob] <- createAndConnectUsers (replicate 2 Nothing) + runMLSTest $ do + [alice1, bob1] <- traverse createMLSClient [alice, bob] + void $ uploadNewKeyPackage bob1 + void $ setupMLSGroup alice1 + events <- createAddProposals alice1 [bob] >>= traverse sendAndConsumeMessage - events <- - fmap mmssEvents . responseJsonError - =<< postMessage (qUnqualified (pUserId creator)) prop - do - (creator, users) <- withLastPrekeys $ setupParticipants tmp def [(1, LocalUser), (1, LocalUser), (1, LocalUser)] - (groupId, conversation) <- setupGroup tmp CreateConv creator "group.0.json" +propInvalidEpoch = do + users@[alice, bob, charlie, dee] <- createAndConnectUsers (replicate 4 Nothing) + runMLSTest $ do + [alice1, bob1, charlie1, dee1] <- traverse createMLSClient users + void $ setupMLSGroup alice1 - let (bob, charlie, dee) = assertThree users + -- Add bob -> epoch 1 + void $ uploadNewKeyPackage bob1 + void $ createAddCommit alice1 [bob] >>= sendAndConsumeCommit - -- Add bob -> epoch 1 - do - (commit, welcome) <- - liftIO $ - setupCommit tmp creator "group.0.json" "group.1.json" $ - toList (pClients bob) - testSuccessfulCommit MessagingSetup {users = [bob], ..} - - -- try to request a proposal that with too old epoch (0) - do - prop <- liftIO $ bareAddProposal tmp creator charlie "group.0.json" "group.0.json" - err <- - responseJsonError - =<< postMessage (qUnqualified (pUserId creator)) prop - mls {mlsNewMembers = mempty} + + -- alice send a well-formed proposal and commits it + void $ uploadNewKeyPackage dee1 + createAddProposals alice1 [dee] >>= traverse_ sendAndConsumeMessage + void $ createPendingProposalCommit alice1 >>= sendAndConsumeCommit + +-- scenario: +-- alice1 creates a group and adds bob1 +-- bob2 joins with external proposal (alice1 commits it) +-- bob2 adds charlie1 testExternalAddProposal :: TestM () -testExternalAddProposal = withSystemTempDirectory "mls" $ \tmp -> do - let opts@SetupOptions {..} = def {createConv = CreateConv} - (creator, users@[bob], bobClient2, bobClient3) <- withLastPrekeys $ do - (creator, users@[bob]) <- setupParticipants tmp opts [(1, LocalUser)] - userClient2 <- setupUserClient tmp CreateWithKey True (pUserId bob) - userClient3 <- setupUserClient tmp CreateWithKey True (pUserId bob) - pure (creator, users, userClient2, userClient3) - let bobClient2Qid = userClientQid (pUserId bob) bobClient2 - - -- create a group - (groupId, conversation) <- setupGroup tmp createConv creator "group" - - -- add clients to it and get welcome message - (commit, welcome) <- - liftIO $ - setupCommit tmp creator "group" "group" $ - NonEmpty.tail (pClients creator) <> toList (pClients bob) - - testSuccessfulCommit MessagingSetup {..} - - -- we use alice's group state "group" here, so that the mls client knows the group id - externalProposal <- liftIO $ createExternalProposal tmp bobClient2Qid "group" "bobClient2-group" - - -- extract signature key from proposal - do - msg <- liftIO $ decodeMLSError @(Message 'MLSPlainText) externalProposal - let payload = tbsMsgPayload . rmValue . msgTBS $ msg - let proposal = - case payload of - ProposalMessage rprop -> rmValue rprop - x -> error ("Expected ProposalMessage but got <> " <> show x) - let kp = case proposal of - (AddProposal kp') -> kp' - x -> error ("Expected AddProposal but got <> " <> show x) - let signerKey = bcSignatureKey . kpuCredential . rmValue . kpTBS . rmValue $ kp - liftIO $ BS.writeFile (tmp "proposal-signer.key") signerKey - - postMessage (qUnqualified (pUserId bob)) externalProposal !!! const 201 === statusCode - - void . liftIO $ - spawn - ( cli - (pClientQid creator) - tmp - [ "consume", - "--group", - tmp "group", - "--in-place", - "--signer-key", - tmp "proposal-signer.key", - "-" - ] - ) - (Just externalProposal) - - (commitExternalAdd, Just welcomeBobClient2) <- - liftIO $ - pendingProposalsCommit tmp creator "group" - - -- Create bobWithClient2 here so that the new client of bob is used - let bobWithClient2 = Participant (pUserId bob) (bobClient2 NonEmpty.<| pClientIds bob) - void $ postCommit MessagingSetup {users = [bobWithClient2], commit = commitExternalAdd, ..} - liftIO $ BS.writeFile (tmp "welcomeBobClient2") welcomeBobClient2 - -- reset bobWithClient2's group state - void . liftIO $ - spawn - ( cli - (pClientQid bobWithClient2) - tmp - [ "group", - "from-welcome", - "--group-out", - tmp "bobClient2-group", - tmp "welcomeBobClient2" - ] - ) - Nothing - - -- Bob's bobClient2 and its keypackage ref is known to backend, so this client - -- is able able to send an unencrypted message, e.g. a bare add proposal - prop <- - liftIO $ - bareAddProposal - tmp - bobWithClient2 - (Participant (pUserId bob) (pure bobClient3)) - "bobClient2-group" - "bobClient2-group" - postMessage (qUnqualified (pUserId bobWithClient2)) prop - !!! const 201 === statusCode - -testExternalAddProposalWrongUser :: TestM () -testExternalAddProposalWrongUser = withSystemTempDirectory "mls" $ \tmp -> do - (creator, [bob, charly]) <- withLastPrekeys $ setupParticipants tmp def [(1, LocalUser), (1, LocalUser)] - (groupId, conversation) <- setupGroup tmp CreateConv creator "group" - - bobClient1 <- assertOne . toList $ pClients bob - charlyClient1 <- assertOne . toList $ pClients charly - (commit, welcome) <- - liftIO $ - setupCommit tmp creator "group" "group" $ - NonEmpty.tail (pClients creator) <> [bobClient1, charlyClient1] - testSuccessfulCommit MessagingSetup {users = [bob, charly], ..} - - liftIO $ mergeWelcome tmp (fst bobClient1) "group" "group" "welcome" - - bobClient2Qid <- - userClientQid (pUserId bob) - <$> withLastPrekeys (setupUserClient tmp CreateWithKey True (pUserId bob)) - externalProposal <- liftIO $ createExternalProposal tmp bobClient2Qid "group" "group" - postMessage (qUnqualified (pUserId charly)) externalProposal !!! do - const 422 === statusCode - const (Just "mls-unsupported-proposal") === fmap Wai.label . responseJsonError - +testExternalAddProposal = do + -- create users + [alice, bob, charlie] <- + createAndConnectUsers (replicate 3 Nothing) + + void . runMLSTest $ do + -- create clients + alice1 <- createMLSClient alice + [bob1, bob2] <- replicateM 2 (createMLSClient bob) + charlie1 <- createMLSClient charlie + + -- upload key packages + void $ uploadNewKeyPackage bob1 + void $ uploadNewKeyPackage charlie1 + + -- create group with alice1 and bob1 + (_, qcnv) <- setupMLSGroup alice1 + void $ + createAddCommit alice1 [bob] + >>= sendAndConsumeCommit + + -- bob joins with an external proposal + mlsBracket [alice1, bob1] $ \wss -> do + void $ + createExternalAddProposal bob2 + >>= sendAndConsumeMessage + liftTest $ + WS.assertMatchN_ (5 # Second) wss $ + void . wsAssertAddProposal bob qcnv + void $ + createPendingProposalCommit alice1 + >>= sendAndConsumeCommit + + -- bob adds charlie + putOtherMemberQualified + (qUnqualified alice) + bob + (OtherMemberUpdate (Just roleNameWireAdmin)) + qcnv + !!! const 200 === statusCode + createAddCommit bob2 [charlie] + >>= sendAndConsumeCommit + +-- scenario: +-- alice adds bob and charlie +-- charlie sends an external proposal for bob testExternalAddProposalWrongClient :: TestM () -testExternalAddProposalWrongClient = withSystemTempDirectory "mls" $ \tmp -> do - (creator, [bob, charly]) <- withLastPrekeys $ setupParticipants tmp def [(1, LocalUser), (1, LocalUser)] - (groupId, conversation) <- setupGroup tmp CreateConv creator "group" +testExternalAddProposalWrongClient = do + [alice, bob, charlie] <- + createAndConnectUsers (replicate 3 Nothing) + + runMLSTest $ do + -- setup clients + [alice1, bob1, bob2, charlie1] <- + traverse + createMLSClient + [alice, bob, bob, charlie] + void $ uploadNewKeyPackage bob1 + void $ uploadNewKeyPackage charlie1 + + void $ setupMLSGroup alice1 + void $ + createAddCommit alice1 [bob, charlie] + >>= sendAndConsumeCommit + + prop <- createExternalAddProposal bob2 + postMessage (qUnqualified charlie) (mpMessage prop) + !!! do + const 422 === statusCode + const (Just "mls-unsupported-proposal") === fmap Wai.label . responseJsonError + +-- scenario: +-- alice adds bob +-- charlie attempts to join with an external add proposal +testExternalAddProposalWrongUser :: TestM () +testExternalAddProposalWrongUser = do + users@[_, bob, charlie] <- createAndConnectUsers (replicate 3 Nothing) - bobClient1 <- assertOne . toList $ pClients bob - charlyClient1 <- assertOne . toList $ pClients charly - (commit, welcome) <- - liftIO $ - setupCommit tmp creator "group" "group" $ - NonEmpty.tail (pClients creator) <> [bobClient1, charlyClient1] - testSuccessfulCommit MessagingSetup {users = [bob, charly], ..} + runMLSTest $ do + -- setup clients + [alice1, bob1, charlie1] <- traverse createMLSClient users + void $ uploadNewKeyPackage bob1 - liftIO $ mergeWelcome tmp (fst bobClient1) "group" "group" "welcome" + void $ setupMLSGroup alice1 + void $ + createAddCommit alice1 [bob] + >>= sendAndConsumeCommit - bobClient2Qid <- - userClientQid (pUserId bob) - <$> withLastPrekeys (setupUserClient tmp CreateWithoutKey True (pUserId bob)) - externalProposal <- liftIO $ createExternalProposal tmp bobClient2Qid "group" "group" - postMessage (qUnqualified (pUserId charly)) externalProposal !!! do - const 422 === statusCode - const (Just "mls-unsupported-proposal") === fmap Wai.label . responseJsonError + prop <- createExternalAddProposal charlie1 + postMessage (qUnqualified charlie) (mpMessage prop) + !!! do + const 404 === statusCode + const (Just "no-conversation") === fmap Wai.label . responseJsonError -- FUTUREWORK: test processing a commit containing the external proposal testPublicKeys :: TestM () @@ -1751,139 +1352,154 @@ testPublicKeys = do -- 2022 only gets forwarded by the backend, i.e., there's no action taken by the -- backend. propUnsupported :: TestM () -propUnsupported = withSystemTempDirectory "mls" $ \tmp -> do - MessagingSetup {..} <- aliceInvitesBobWithTmp tmp (1, LocalUser) def {createConv = CreateConv} - aliceKP <- liftIO $ do - d <- BS.readFile (tmp pClientQid creator) - either (\e -> assertFailure ("could not parse key package: " <> T.unpack e)) pure $ - decodeMLS' d - let alicePublicKey = bcSignatureKey $ kpCredential aliceKP - - -- "\0 " corresponds to 0020 in TLS encoding, which is the length of the - -- following public key - file <- - liftIO . BS.readFile $ - tmp pClientQid creator <> ".db" cs (B64U.encode $ "\0 " <> alicePublicKey) - let s = - file ^.. key "signature_private_key" . key "value" . _Array . traverse . _Integer - & fmap fromIntegral - & BS.pack - let (privKey, pubKey) = BS.splitAt 32 s - liftIO $ alicePublicKey @?= pubKey - let aliceRef = - kpRef - MLS_128_DHKEMX25519_AES128GCM_SHA256_Ed25519 - . KeyPackageData - . rmRaw - . kpTBS - $ aliceKP - let Just appAckMsg = +propUnsupported = do + users@[_alice, bob] <- createAndConnectUsers (replicate 2 Nothing) + runMLSTest $ do + [alice1, bob1] <- traverse createMLSClient users + void $ uploadNewKeyPackage bob1 + (gid, _) <- setupMLSGroup alice1 + void $ createAddCommit alice1 [bob] >>= sendAndConsumeCommit + + mems <- currentGroupFile alice1 >>= liftIO . readGroupState + (_, ref) <- assertJust $ find ((== alice1) . fst) mems + (priv, pub) <- clientKeyPair alice1 + msg <- + assertJust $ maybeCryptoError $ mkAppAckProposalMessage - groupId - (Epoch 0) - aliceRef + gid + (Epoch 1) + ref [] - <$> C.secretKey privKey - <*> C.publicKey pubKey - msgSerialised = - LBS.toStrict . runPut . serialiseMLS $ appAckMsg + <$> Ed25519.secretKey priv + <*> Ed25519.publicKey pub + let msgData = LBS.toStrict (runPut (serialiseMLS msg)) - postMessage (qUnqualified . pUserId $ creator) msgSerialised - !!! const 201 === statusCode + -- we cannot use sendAndConsumeMessage here, because openmls does not yet + -- support AppAck proposals + postMessage (ciUser alice1) msgData !!! const 201 === statusCode testBackendRemoveProposalLocalConvLocalUser :: TestM () -testBackendRemoveProposalLocalConvLocalUser = withSystemTempDirectory "mls" $ \tmp -> do - saveRemovalKey (tmp "removal.key") - MessagingSetup {..} <- aliceInvitesBobWithTmp tmp (2, LocalUser) def {createConv = CreateConv} - let [bobParticipant] = users - let bob = pUserId bobParticipant - let alice = pUserId creator - testSuccessfulCommit MessagingSetup {users = [bobParticipant], ..} +testBackendRemoveProposalLocalConvLocalUser = do + [alice, bob] <- createAndConnectUsers (replicate 2 Nothing) + runMLSTest $ do + [alice1, bob1, bob2] <- traverse createMLSClient [alice, bob, bob] + traverse_ uploadNewKeyPackage [bob1, bob2] + (_, qcnv) <- setupMLSGroup alice1 + + void $ createAddCommit alice1 [bob] >>= sendAndConsumeCommit + + bobClients <- + fmap (filter (\(cid, _) -> cidQualifiedUser cid == bob)) $ + currentGroupFile alice1 >>= liftIO . readGroupState + + mlsBracket [alice1] $ \wss -> void $ do + liftTest $ deleteUser (qUnqualified bob) !!! const 200 === statusCode + -- remove bob clients from the test state + State.modify $ \mls -> + mls + { mlsMembers = Set.difference (mlsMembers mls) (Set.fromList [bob1, bob2]) + } - kprefs <- (fromJust . kpRef' . snd) <$$> liftIO (readKeyPackages tmp bobParticipant) + for bobClients $ \(_, ref) -> do + [msg] <- WS.assertMatchN (5 # Second) wss $ \n -> + wsAssertBackendRemoveProposal bob qcnv ref n + consumeMessage1 alice1 msg - c <- view tsCannon - WS.bracketR c (qUnqualified alice) $ \wsA -> do - deleteUser (qUnqualified bob) !!! const 200 === statusCode - - for_ kprefs $ \kp -> - WS.assertMatch_ (5 # WS.Second) wsA $ \notification -> do - msg <- wsAssertBackendRemoveProposal bob conversation kp notification - void . liftIO $ - spawn - ( cli - (pClientQid creator) - tmp - $ [ "consume", - "--group", - tmp "group", - "--in-place", - "--signer-key", - tmp "removal.key", - "-" - ] - ) - (Just msg) - - -- alice commits the external proposals - (commit', _) <- liftIO $ pendingProposalsCommit tmp creator "group" - events <- - postCommit - MessagingSetup - { commit = commit', - .. - } - liftIO $ events @?= [] + -- alice commits the external proposals + events <- createPendingProposalCommit alice1 >>= sendAndConsumeCommit + liftIO $ events @?= [] testBackendRemoveProposalLocalConvRemoteUser :: TestM () -testBackendRemoveProposalLocalConvRemoteUser = withSystemTempDirectory "mls" $ \tmp -> do - let opts = - def - { createClients = DontCreateClients, - createConv = CreateConv - } - (alice, [bob]) <- - withLastPrekeys $ - setupParticipants tmp opts [(1, RemoteUser (Domain "faraway.example.com"))] - (groupId, conversation) <- setupGroup tmp CreateConv alice "group" - (commit, welcome) <- liftIO $ setupCommit tmp alice "group" "group" (pClients bob) - - let mock req = case frRPC req of - "on-conversation-updated" -> pure (Aeson.encode ()) - "on-new-remote-conversation" -> pure (Aeson.encode EmptyResponse) - "on-mls-message-sent" -> pure (Aeson.encode EmptyResponse) - "get-mls-clients" -> - pure - . Aeson.encode - . Set.fromList - . map (flip ClientInfo True . snd) - . toList - . pClients - $ bob - ms -> assertFailure ("unmocked endpoint called: " <> cs ms) - - void $ - withTempMockFederator' mock $ do - c <- view tsCannon - WS.bracketR c (qUnqualified (pUserId alice)) $ \wsA -> do - void $ postCommit MessagingSetup {creator = alice, users = [bob], ..} - - kprefs <- (fromJust . kpRef' . snd) <$$> liftIO (readKeyPackages tmp bob) +testBackendRemoveProposalLocalConvRemoteUser = do + [alice, bob] <- createAndConnectUsers [Nothing, Just "bob.example.com"] + runMLSTest $ do + [alice1, bob1, bob2] <- traverse createMLSClient [alice, bob, bob] + (_, qcnv) <- setupMLSGroup alice1 + commit <- createAddCommit alice1 [bob] + + let mock req = case frRPC req of + "on-conversation-updated" -> pure (Aeson.encode ()) + "on-new-remote-conversation" -> pure (Aeson.encode EmptyResponse) + "on-mls-message-sent" -> pure (Aeson.encode EmptyResponse) + "get-mls-clients" -> + pure + . Aeson.encode + . Set.fromList + . map (flip ClientInfo True . ciClient) + $ [bob1, bob2] + ms -> assertFailure ("unmocked endpoint called: " <> cs ms) + + void . withTempMockFederator' mock $ do + mlsBracket [alice1] $ \[wsA] -> do + void $ sendAndConsumeCommit commit + + bobClients <- + fmap (filter (\(cid, _) -> cidQualifiedUser cid == bob)) $ + currentGroupFile alice1 >>= liftIO . readGroupState fedGalleyClient <- view tsFedGalleyClient void $ runFedClient @"on-user-deleted-conversations" fedGalleyClient - (qDomain (pUserId bob)) + (qDomain bob) ( UserDeletedConversationsNotification - { udcvUser = qUnqualified (pUserId bob), - udcvConversations = unsafeRange [qUnqualified conversation] + { udcvUser = qUnqualified bob, + udcvConversations = unsafeRange [qUnqualified qcnv] } ) - for_ kprefs $ \kp -> - WS.assertMatch_ (5 # WS.Second) wsA $ \notification -> - void $ - wsAssertBackendRemoveProposal (pUserId bob) conversation kp notification + for_ bobClients $ \(_, ref) -> + WS.assertMatch (5 # WS.Second) wsA $ + wsAssertBackendRemoveProposal bob qcnv ref + +sendRemoteMLSWelcome :: TestM () +sendRemoteMLSWelcome = do + -- Alice is from the originating domain and Bob is local, i.e., on the receiving domain + [alice, bob] <- createAndConnectUsers [Just "alice.example.com", Nothing] + commit <- runMLSTest $ do + [alice1, bob1] <- traverse createMLSClient [alice, bob] + void $ setupFakeMLSGroup alice1 + void $ uploadNewKeyPackage bob1 + createAddCommit alice1 [bob] + + welcome <- assertJust (mpWelcome commit) + + fedGalleyClient <- view tsFedGalleyClient + cannon <- view tsCannon + + WS.bracketR cannon (qUnqualified bob) $ \wsB -> do + -- send welcome message + void $ + runFedClient @"mls-welcome" fedGalleyClient (qDomain alice) $ + MLSWelcomeRequest + (Base64ByteString welcome) + + -- check that the corresponding event is received + liftIO $ do + WS.assertMatch_ (5 # WS.Second) wsB $ + wsAssertMLSWelcome bob welcome + +sendRemoteMLSWelcomeKPNotFound :: TestM () +sendRemoteMLSWelcomeKPNotFound = do + [alice, bob] <- createAndConnectUsers [Just "alice.example.com", Nothing] + commit <- runMLSTest $ do + [alice1, bob1] <- traverse createMLSClient [alice, bob] + void $ setupFakeMLSGroup alice1 + kp <- generateKeyPackage bob1 >>= keyPackageFile bob1 . snd + createAddCommitWithKeyPackages alice1 [(bob1, kp)] + welcome <- assertJust (mpWelcome commit) + + fedGalleyClient <- view tsFedGalleyClient + cannon <- view tsCannon + WS.bracketR cannon (qUnqualified bob) $ \wsB -> do + -- send welcome message + void $ + runFedClient @"mls-welcome" fedGalleyClient (qDomain alice) $ + MLSWelcomeRequest + (Base64ByteString welcome) + + liftIO $ do + -- check that no event is received + WS.assertNoEvent (1 # Second) [wsB] diff --git a/services/galley/test/integration/API/MLS/Util.hs b/services/galley/test/integration/API/MLS/Util.hs index 5e3feaae1f7..f4425091cf1 100644 --- a/services/galley/test/integration/API/MLS/Util.hs +++ b/services/galley/test/integration/API/MLS/Util.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE RecordWildCards #-} -- This file is part of the Wire Server implementation. @@ -22,36 +23,46 @@ module API.MLS.Util where import API.Util import Bilge import Bilge.Assert -import Control.Lens (preview, to, view) +import Control.Arrow ((&&&)) +import Control.Error.Util +import Control.Lens (preview, to, view, (^..)) import Control.Monad.Catch +import Control.Monad.State (StateT, evalStateT) import qualified Control.Monad.State as State +import Control.Monad.Trans.Maybe import Crypto.PubKey.Ed25519 +import Data.Aeson.Lens import qualified Data.ByteArray as BA import qualified Data.ByteString as BS +import qualified Data.ByteString.Base64.URL as B64U import Data.ByteString.Conversion -import Data.Default import Data.Domain +import Data.Hex import Data.Id -import Data.Json.Util -import Data.List.NonEmpty (NonEmpty (..)) -import qualified Data.List.NonEmpty as NonEmpty +import Data.Json.Util hiding ((#)) import qualified Data.Map as Map import Data.Qualified import qualified Data.Set as Set import qualified Data.Text as T +import qualified Data.Text.Encoding as T import Galley.Keys import Galley.Options import Imports +import System.Directory (getSymbolicLinkTarget) import System.FilePath import System.IO.Temp +import System.Posix hiding (createDirectory) import System.Process import Test.QuickCheck (arbitrary, generate) +import qualified Test.Tasty.Cannon as WS import Test.Tasty.HUnit import TestHelpers import TestSetup import Wire.API.Conversation import Wire.API.Conversation.Protocol import Wire.API.Event.Conversation +import Wire.API.Federation.API.Galley +import Wire.API.MLS.CipherSuite import Wire.API.MLS.Credential import Wire.API.MLS.KeyPackage import Wire.API.MLS.Keys @@ -61,482 +72,19 @@ import Wire.API.MLS.Serialisation import Wire.API.User.Client import Wire.API.User.Client.Prekey -data CreateClients = CreateWithoutKey | CreateWithKey | DontCreateClients - deriving (Eq) - -data CreateConv = CreateConv | CreateProteusConv | DontCreateConv - deriving (Eq) - -data UserOrigin = LocalUser | RemoteUser Domain - -createNewConv :: ClientId -> CreateConv -> Maybe NewConv -createNewConv c CreateConv = Just (defNewMLSConv c) -createNewConv _ CreateProteusConv = Just defNewProteusConv -createNewConv _ DontCreateConv = Nothing - -data SetupOptions = SetupOptions - { createClients :: CreateClients, - creatorOrigin :: UserOrigin, - createConv :: CreateConv, - makeConnections :: Bool, - numCreatorClients :: Int - } - -instance Default SetupOptions where - def = - SetupOptions - { createClients = CreateWithKey, - creatorOrigin = LocalUser, - createConv = DontCreateConv, - makeConnections = True, - numCreatorClients = 1 - } - -data MessagingSetup = MessagingSetup - { creator :: Participant, - users :: [Participant], - conversation :: Qualified ConvId, - groupId :: GroupId, - welcome :: ByteString, - commit :: ByteString - } - deriving (Show) - -data AddKeyPackage = AddKeyPackage - { mapKeyPackage :: Bool, - setPublicKey :: Bool - } - deriving (Show) - -instance Default AddKeyPackage where - def = - AddKeyPackage - { mapKeyPackage = True, - setPublicKey = True - } - -cli :: String -> FilePath -> [String] -> CreateProcess -cli store tmp args = - proc "mls-test-cli" $ - ["--store", tmp (store <> ".db")] <> args - -data Participant = Participant - { pUserId :: Qualified UserId, - pClientIds :: NonEmpty ClientId - } - deriving (Show) - -userClientQid :: Qualified UserId -> ClientId -> String -userClientQid usr c = - show (qUnqualified usr) +cid2Str :: ClientIdentity -> String +cid2Str cid = + show (ciUser cid) <> ":" - <> T.unpack (client c) + <> T.unpack (client . ciClient $ cid) <> "@" - <> T.unpack (domainText (qDomain usr)) - -pClients :: Participant -> NonEmpty (String, ClientId) -pClients p = - pClientIds p <&> \c -> - (userClientQid (pUserId p) c, c) - -pClientQid :: Participant -> String -pClientQid p = userClientQid (pUserId p) (NonEmpty.head (pClientIds p)) - -pClientId :: Participant -> ClientId -pClientId = NonEmpty.head . pClientIds - -readKeyPackages :: FilePath -> Participant -> IO (NonEmpty (ClientId, RawMLS KeyPackage)) -readKeyPackages tmp participant = for (pClients participant) $ \(qcid, cid) -> do - b <- BS.readFile (tmp qcid) - pure (cid, fromRight (error "parsing RawMLS KeyPackage") (decodeMLS' b)) - -setupUserClient :: - HasCallStack => - FilePath -> - CreateClients -> - -- | Whether to claim/map the key package - Bool -> - Qualified UserId -> - State.StateT [LastPrekey] TestM ClientId -setupUserClient tmp doCreateClients mapKeyPackage usr = do - localDomain <- lift viewFederationDomain - lpk <- takeLastPrekey - lift $ do - -- create client if requested - c <- case doCreateClients of - DontCreateClients -> liftIO $ generate arbitrary - _ -> randomClient (qUnqualified usr) lpk - - let qcid = userClientQid usr c - - -- generate key package - void . liftIO $ spawn (cli qcid tmp ["init", qcid]) Nothing - kp <- - liftIO $ - decodeMLSError - =<< spawn (cli qcid tmp ["key-package", "create"]) Nothing - liftIO $ BS.writeFile (tmp qcid) (rmRaw kp) - - -- Set Bob's private key and upload key package if required. If a client - -- does not have to be created and it is remote, pretend to have claimed its - -- key package. - case doCreateClients of - CreateWithKey -> addKeyPackage def {mapKeyPackage = mapKeyPackage} usr c kp - DontCreateClients | localDomain /= qDomain usr -> do - brig <- view tsBrig - let bundle = - KeyPackageBundle $ - Set.singleton $ - KeyPackageBundleEntry - { kpbeUser = usr, - kpbeClient = c, - kpbeRef = fromJust $ kpRef' kp, - kpbeKeyPackage = KeyPackageData $ rmRaw kp - } - when mapKeyPackage $ mapRemoteKeyPackageRef brig bundle - DontCreateClients -> pure () - CreateWithoutKey -> pure () - - pure c - -setupParticipant :: - HasCallStack => - FilePath -> - CreateClients -> - Int -> - Qualified UserId -> - State.StateT [LastPrekey] TestM Participant -setupParticipant tmp doCreateClients numClients usr = - Participant usr . NonEmpty.fromList - <$> replicateM numClients (setupUserClient tmp doCreateClients True usr) - -setupParticipants :: - HasCallStack => - FilePath -> - SetupOptions -> - -- | A list of pairs, where each pair represents the number of clients for a - -- participant other than the group creator and whether the participant is - -- local or remote. - [(Int, UserOrigin)] -> - State.StateT [LastPrekey] TestM (Participant, [Participant]) -setupParticipants tmp SetupOptions {..} ns = do - creator <- do - u <- lift $ createUserOrId creatorOrigin - let createCreatorClients = createClientsForUR creatorOrigin createClients - c0 <- setupUserClient tmp createCreatorClients False u - cs <- replicateM (numCreatorClients - 1) (setupUserClient tmp createCreatorClients True u) - pure (Participant u (c0 :| cs)) - others <- for ns $ \(n, ur) -> do - qusr <- lift (createUserOrId ur) - participant <- setupParticipant tmp (createClientsForUR ur createClients) n qusr - pure (participant, ur) - lift . when makeConnections $ do - for_ others $ \(o, ur) -> case (creatorOrigin, ur) of - (LocalUser, LocalUser) -> - connectUsers (qUnqualified (pUserId creator)) (pure ((qUnqualified . pUserId) o)) - (LocalUser, RemoteUser _) -> - connectWithRemoteUser - (qUnqualified . pUserId $ creator) - (pUserId o) - (RemoteUser _, LocalUser) -> - connectWithRemoteUser - (qUnqualified . pUserId $ o) - (pUserId creator) - (RemoteUser _, RemoteUser _) -> - liftIO $ - assertFailure "Trying to have both the creator and a group participant remote" - pure (creator, fst <$> others) - where - createUserOrId :: UserOrigin -> TestM (Qualified UserId) - createUserOrId = \case - LocalUser -> randomQualifiedUser - RemoteUser d -> randomQualifiedId d - - createClientsForUR LocalUser cc = cc - createClientsForUR (RemoteUser _) _ = DontCreateClients - -withLastPrekeys :: Monad m => State.StateT [LastPrekey] m a -> m a -withLastPrekeys m = State.evalStateT m someLastPrekeys - -setupGroup :: - HasCallStack => - FilePath -> - CreateConv -> - Participant -> - String -> - TestM (GroupId, Qualified ConvId) -setupGroup tmp createConv creator name = do - (mGroupId, conversation) <- case createNewConv (pClientId creator) createConv of - Nothing -> pure (Nothing, error "No conversation created") - Just nc -> do - conv <- - responseJsonError =<< postConvQualified (qUnqualified (pUserId creator)) nc - pure gid - -- generate a random group id - Nothing -> liftIO $ fmap (GroupId . BS.pack) (replicateM 32 (generate arbitrary)) - - groupJSON <- - liftIO $ - spawn - ( cli - (pClientQid creator) - tmp - ["group", "create", T.unpack (toBase64Text (unGroupId groupId))] - ) - Nothing - liftIO $ BS.writeFile (tmp name) groupJSON - - pure (groupId, conversation) - -setupCommit :: - (HasCallStack, Foldable f) => - String -> - Participant -> - String -> - String -> - f (String, ClientId) -> - IO (ByteString, ByteString) -setupCommit tmp admin groupName newGroupName clients = - (,) - <$> spawn - ( cli - (pClientQid admin) - tmp - $ [ "member", - "add", - "--group", - tmp groupName, - "--welcome-out", - tmp "welcome", - "--group-out", - tmp newGroupName - ] - <> map ((tmp ) . fst) (toList clients) - ) - Nothing - <*> BS.readFile (tmp "welcome") - -setupRemoveCommit :: - (HasCallStack, Foldable f) => - String -> - Participant -> - String -> - String -> - f (String, ClientId) -> - IO (ByteString, Maybe ByteString) -setupRemoveCommit tmp admin groupName newGroupName clients = do - let welcomeFile = tmp "welcome" - commit <- - spawn - ( cli - (pClientQid admin) - tmp - $ [ "member", - "remove", - "--group", - tmp groupName, - "--group-out", - tmp newGroupName, - "--welcome-out", - welcomeFile - ] - <> map ((tmp ) . fst) (toList clients) - ) - Nothing - welcome <- - doesFileExist welcomeFile >>= \case - False -> pure Nothing - True -> Just <$> BS.readFile welcomeFile - pure (commit, welcome) - -mergeWelcome :: - (HasCallStack) => - String -> - String -> - String -> - String -> - String -> - IO () -mergeWelcome tmp clientQid groupIn groupOut welcomeIn = - void $ - spawn - ( cli - clientQid - tmp - [ groupIn, - "from-welcome", - "--group-out", - tmp groupOut, - tmp welcomeIn - ] - ) - Nothing - -bareAddProposal :: - HasCallStack => - String -> - Participant -> - Participant -> - String -> - String -> - IO ByteString -bareAddProposal tmp creator participantToAdd groupIn groupOut = - spawn - ( cli - (pClientQid creator) - tmp - $ [ "proposal", - "--group-in", - tmp groupIn, - "--group-out", - tmp groupOut, - "add", - tmp pClientQid participantToAdd - ] - ) - Nothing - -pendingProposalsCommit :: - HasCallStack => - String -> - Participant -> - String -> - IO (ByteString, Maybe ByteString) -pendingProposalsCommit tmp creator groupName = do - let welcomeFile = tmp "welcome" - commit <- - spawn - ( cli - (pClientQid creator) - tmp - $ [ "commit", - "--group", - tmp groupName, - "--welcome-out", - welcomeFile - ] - ) - Nothing - welcome <- - doesFileExist welcomeFile >>= \case - False -> pure Nothing - True -> Just <$> BS.readFile welcomeFile - pure (commit, welcome) - -createExternalProposal :: - HasCallStack => - String -> - String -> - String -> - String -> - IO ByteString -createExternalProposal tmp creatorClientQid groupIn groupOut = do - spawn - ( cli - creatorClientQid - tmp - $ [ "external-proposal", - "--group-in", - tmp groupIn, - "--group-out", - tmp groupOut, - "add" - ] - ) - Nothing - -createMessage :: - HasCallStack => - String -> - Participant -> - String -> - String -> - IO ByteString -createMessage tmp sender groupName msgText = - spawn (cli (pClientQid sender) tmp ["message", "--group", tmp groupName, msgText]) Nothing - -takeLastPrekey :: MonadFail m => State.StateT [LastPrekey] m LastPrekey -takeLastPrekey = do - (lpk : lpks) <- State.get - State.put lpks - pure lpk - --- | Setup: Alice creates a group and invites Bob that is local or remote to --- Alice depending on the passed in creator origin. Return welcome and commit --- message. -aliceInvitesBob :: HasCallStack => (Int, UserOrigin) -> SetupOptions -> TestM MessagingSetup -aliceInvitesBob bobConf opts = withSystemTempDirectory "mls" $ \tmp -> - aliceInvitesBobWithTmp tmp bobConf opts - -aliceInvitesBobWithTmp :: - HasCallStack => - FilePath -> - (Int, UserOrigin) -> - SetupOptions -> - TestM MessagingSetup -aliceInvitesBobWithTmp tmp bobConf opts@SetupOptions {..} = do - (alice, [bob]) <- withLastPrekeys $ setupParticipants tmp opts [bobConf] - -- create a group - (groupId, conversation) <- setupGroup tmp createConv alice "group" - - -- add clients to it and get welcome message - (commit, welcome) <- - liftIO $ - setupCommit tmp alice "group" "group" $ - NonEmpty.tail (pClients alice) <> toList (pClients bob) - - pure $ - MessagingSetup - { creator = alice, - users = [bob], - .. - } - -addKeyPackage :: - HasCallStack => - AddKeyPackage -> - Qualified UserId -> - ClientId -> - RawMLS KeyPackage -> - TestM () -addKeyPackage AddKeyPackage {..} u c kp = do - brig <- view tsBrig - - when setPublicKey $ do - -- set public key - let update = defUpdateClient {updateClientMLSPublicKeys = Map.singleton Ed25519 (bcSignatureKey (kpCredential (rmValue kp)))} - put - ( brig - . paths ["clients", toByteString' c] - . zUser (qUnqualified u) - . json update - ) - !!! const 200 === statusCode - - -- upload key package - post - ( brig - . paths ["mls", "key-packages", "self", toByteString' c] - . zUser (qUnqualified u) - . json (KeyPackageUpload [kp]) - ) - !!! const 201 === statusCode - - when mapKeyPackage $ - -- claim key package (technically, some other user should claim them, but it doesn't really make a difference) - post - ( brig - . paths ["mls", "key-packages", "claim", toByteString' (qDomain u), toByteString' (qUnqualified u)] - . zUser (qUnqualified u) - ) - !!! const 200 === statusCode + <> T.unpack (domainText (ciDomain cid)) -mapRemoteKeyPackageRef :: (MonadIO m, MonadHttp m, MonadCatch m) => (Request -> Request) -> KeyPackageBundle -> m () +mapRemoteKeyPackageRef :: + (MonadIO m, MonadHttp m, MonadCatch m) => + (Request -> Request) -> + KeyPackageBundle -> + m () mapRemoteKeyPackageRef brig bundle = void $ put @@ -546,20 +94,6 @@ mapRemoteKeyPackageRef brig bundle = ) !!! const 204 === statusCode -claimKeyPackage :: (MonadIO m, MonadHttp m) => (Request -> Request) -> UserId -> Qualified UserId -> m ResponseLBS -claimKeyPackage brig claimant target = - post - ( brig - . paths ["mls", "key-packages", "claim", toByteString' (qDomain target), toByteString' (qUnqualified target)] - . zUser claimant - ) - -postCommit :: HasCallStack => MessagingSetup -> TestM [Event] -postCommit MessagingSetup {..} = - fmap mmssEvents . responseJsonError - =<< postMessage (qUnqualified (pUserId creator)) commit - TestM () saveRemovalKey fp = do @@ -621,3 +155,646 @@ saveRemovalKey fp = do keysByPurpose <- liftIO $ loadAllMLSKeys keys let (_, pub) = fromJust (mlsKeyPair_ed25519 (keysByPurpose RemovalPurpose)) liftIO $ BS.writeFile fp (BA.convert pub) + +data MLSState = MLSState + { mlsBaseDir :: FilePath, + -- | for creating clients + mlsUnusedPrekeys :: [LastPrekey], + mlsMembers :: Set ClientIdentity, + -- | users expected to receive a welcome message after the next commit + mlsNewMembers :: Set ClientIdentity, + mlsGroupId :: Maybe GroupId, + mlsEpoch :: Word64 + } + +newtype MLSTest a = MLSTest {unMLSTest :: StateT MLSState TestM a} + deriving newtype + ( Functor, + Applicative, + Monad, + MonadThrow, + MonadHttp, + MonadIO, + MonadCatch, + MonadFail, + MonadMask, + State.MonadState MLSState, + MonadReader TestSetup + ) + +instance HasGalley MLSTest where + viewGalley = MLSTest $ lift viewGalley + viewGalleyOpts = MLSTest $ lift viewGalleyOpts + +instance HasSettingsOverrides MLSTest where + withSettingsOverrides f (MLSTest action) = MLSTest $ + State.StateT $ \s -> + withSettingsOverrides f (State.runStateT action s) + +liftTest :: TestM a -> MLSTest a +liftTest = MLSTest . lift + +runMLSTest :: MLSTest a -> TestM a +runMLSTest (MLSTest m) = + withSystemTempDirectory "mls" $ \tmp -> do + saveRemovalKey (tmp "removal.key") + evalStateT + m + MLSState + { mlsBaseDir = tmp, + mlsUnusedPrekeys = someLastPrekeys, + mlsMembers = mempty, + mlsNewMembers = mempty, + mlsGroupId = Nothing, + mlsEpoch = 0 + } + +data MessagePackage = MessagePackage + { mpSender :: ClientIdentity, + mpMessage :: ByteString, + mpWelcome :: Maybe ByteString + } + +takeLastPrekeyNG :: HasCallStack => MLSTest LastPrekey +takeLastPrekeyNG = do + s <- State.get + case mlsUnusedPrekeys s of + (pk : pks) -> do + State.modify (\s' -> s' {mlsUnusedPrekeys = pks}) + pure pk + [] -> error "no prekeys left" + +mlscli :: HasCallStack => ClientIdentity -> [String] -> Maybe ByteString -> MLSTest ByteString +mlscli qcid args mbstdin = do + bd <- State.gets mlsBaseDir + let cdir = bd cid2Str qcid + liftIO $ spawn (proc "mls-test-cli" (["--store", cdir "store"] <> args)) mbstdin + +createWireClient :: HasCallStack => Qualified UserId -> MLSTest ClientIdentity +createWireClient qusr = do + lpk <- takeLastPrekeyNG + clientId <- liftTest $ randomClient (qUnqualified qusr) lpk + pure $ mkClientIdentity qusr clientId + +initMLSClient :: HasCallStack => ClientIdentity -> MLSTest () +initMLSClient cid = do + bd <- State.gets mlsBaseDir + createDirectory $ bd cid2Str cid + void $ mlscli cid ["init", cid2Str cid] Nothing + +createLocalMLSClient :: Local UserId -> MLSTest ClientIdentity +createLocalMLSClient (qUntagged -> qusr) = do + qcid <- createWireClient qusr + initMLSClient qcid + + -- set public key + pkey <- mlscli qcid ["public-key"] Nothing + brig <- view tsBrig + let update = defUpdateClient {updateClientMLSPublicKeys = Map.singleton Ed25519 pkey} + put + ( brig + . paths ["clients", toByteString' . ciClient $ qcid] + . zUser (ciUser qcid) + . json update + ) + !!! const 200 === statusCode + pure qcid + +-- | Create new mls client and register with backend. If the user is remote, +-- this only creates a fake client (see 'createFakeMLSClient'). +createMLSClient :: HasCallStack => Qualified UserId -> MLSTest ClientIdentity +createMLSClient qusr = do + loc <- liftTest $ qualifyLocal () + foldQualified loc createLocalMLSClient (createFakeMLSClient . qUntagged) qusr + +-- | Like 'createMLSClient', but do not actually register client with backend. +createFakeMLSClient :: HasCallStack => Qualified UserId -> MLSTest ClientIdentity +createFakeMLSClient qusr = do + c <- liftIO $ generate arbitrary + let cid = mkClientIdentity qusr c + initMLSClient cid + pure cid + +-- | create and upload to backend +uploadNewKeyPackage :: HasCallStack => ClientIdentity -> MLSTest KeyPackageRef +uploadNewKeyPackage qcid = do + (kp, _) <- generateKeyPackage qcid + + -- upload key package + brig <- view tsBrig + post + ( brig + . paths ["mls", "key-packages", "self", toByteString' . ciClient $ qcid] + . zUser (ciUser qcid) + . json (KeyPackageUpload [kp]) + ) + !!! const 201 === statusCode + pure $ fromJust (kpRef' kp) + +generateKeyPackage :: HasCallStack => ClientIdentity -> MLSTest (RawMLS KeyPackage, KeyPackageRef) +generateKeyPackage qcid = do + kp <- liftIO . decodeMLSError =<< mlscli qcid ["key-package", "create"] Nothing + let ref = fromJust (kpRef' kp) + fp <- keyPackageFile qcid ref + liftIO $ BS.writeFile fp (rmRaw kp) + pure (kp, ref) + +groupFileLink :: HasCallStack => ClientIdentity -> MLSTest FilePath +groupFileLink qcid = State.gets $ \mls -> + mlsBaseDir mls cid2Str qcid "group.latest" + +currentGroupFile :: HasCallStack => ClientIdentity -> MLSTest FilePath +currentGroupFile = liftIO . getSymbolicLinkTarget <=< groupFileLink + +parseGroupFileName :: FilePath -> IO (FilePath, Int) +parseGroupFileName fp = do + let base = takeFileName fp + (prefix, version) <- case break (== '.') base of + (p, '.' : v) -> pure (p, v) + _ -> assertFailure "invalid group file name" + n <- case reads version of + [(v, "")] -> pure (v :: Int) + _ -> assertFailure "could not parse group file version" + pure $ (prefix, n) + +-- sets symlink and creates empty file +nextGroupFile :: HasCallStack => ClientIdentity -> MLSTest FilePath +nextGroupFile qcid = do + bd <- State.gets mlsBaseDir + link <- groupFileLink qcid + exists <- doesFileExist link + base' <- + liftIO $ + if exists + then -- group file exists, bump version and update link + do + (prefix, n) <- parseGroupFileName =<< getSymbolicLinkTarget link + removeFile link + pure $ prefix <> "." <> show (n + 1) + else -- group file does not exist yet, point link to version 0 + pure "group.0" + + let groupFile = bd cid2Str qcid base' + createFileLink groupFile link + pure groupFile + +rollBackClient :: HasCallStack => ClientIdentity -> MLSTest ByteString +rollBackClient cid = do + link <- groupFileLink cid + groupFile <- liftIO $ getSymbolicLinkTarget link + (prefix, n) <- + liftIO $ parseGroupFileName groupFile + when (n == 0) $ do + liftIO . assertFailure $ "Cannot roll back client " <> cid2Str cid + state <- liftIO $ BS.readFile groupFile + removeFile groupFile + removeFile link + bd <- State.gets mlsBaseDir + let newGroupFile = bd cid2Str cid (prefix <> "." <> show (n - 1)) + createFileLink newGroupFile link + pure state + +setGroupState :: HasCallStack => ClientIdentity -> ByteString -> MLSTest () +setGroupState cid state = do + fp <- nextGroupFile cid + liftIO $ BS.writeFile fp state + +-- | Create conversation and corresponding group. +setupMLSGroup :: HasCallStack => ClientIdentity -> MLSTest (GroupId, Qualified ConvId) +setupMLSGroup creator = do + ownDomain <- liftTest viewFederationDomain + liftIO $ assertEqual "creator is not local" (ciDomain creator) ownDomain + conv <- + responseJsonError + =<< liftTest + ( postConvQualified + (ciUser creator) + (defNewMLSConv (ciClient creator)) + ) + GroupId -> MLSTest () +createGroup cid gid = do + State.gets mlsGroupId >>= \case + Just _ -> liftIO $ assertFailure "only one group can be created" + Nothing -> pure () + + groupJSON <- mlscli cid ["group", "create", T.unpack (toBase64Text (unGroupId gid))] Nothing + g <- nextGroupFile cid + liftIO $ BS.writeFile g groupJSON + State.modify $ \s -> + s + { mlsGroupId = Just gid, + mlsMembers = Set.singleton cid + } + +-- | Create a local group only without a conversation. This simulates creating +-- an MLS conversation on a remote backend. +setupFakeMLSGroup :: ClientIdentity -> MLSTest (GroupId, Qualified ConvId) +setupFakeMLSGroup creator = do + groupId <- + liftIO $ + fmap (GroupId . BS.pack) (replicateM 32 (generate arbitrary)) + createGroup creator groupId + qcnv <- randomQualifiedId (ciDomain creator) + pure (groupId, qcnv) + +keyPackageFile :: HasCallStack => ClientIdentity -> KeyPackageRef -> MLSTest FilePath +keyPackageFile qcid ref = + State.gets $ \mls -> + mlsBaseDir mls cid2Str qcid + T.unpack (T.decodeUtf8 (hex (unKeyPackageRef ref))) + +claimLocalKeyPackages :: HasCallStack => ClientIdentity -> Local UserId -> MLSTest KeyPackageBundle +claimLocalKeyPackages qcid lusr = do + brig <- view tsBrig + responseJsonError + =<< post + ( brig + . paths ["mls", "key-packages", "claim", toByteString' (tDomain lusr), toByteString' (tUnqualified lusr)] + . zUser (ciUser qcid) + ) + Qualified UserId -> MLSTest [ClientIdentity] +getUserClients qusr = do + bd <- State.gets mlsBaseDir + files <- getDirectoryContents bd + let toClient f = do + cid <- hush . decodeMLS' . T.encodeUtf8 . T.pack $ f + guard (cidQualifiedUser cid == qusr) + pure cid + pure . catMaybes . map toClient $ files + +-- | Generate one key package for each client of a remote user +claimRemoteKeyPackages :: HasCallStack => Remote UserId -> MLSTest KeyPackageBundle +claimRemoteKeyPackages (qUntagged -> qusr) = do + brig <- view tsBrig + clients <- getUserClients qusr + bundle <- fmap (KeyPackageBundle . Set.fromList) $ + for clients $ \cid -> do + (kp, ref) <- generateKeyPackage cid + pure $ + KeyPackageBundleEntry + { kpbeUser = qusr, + kpbeClient = ciClient cid, + kpbeRef = ref, + kpbeKeyPackage = KeyPackageData (rmRaw kp) + } + mapRemoteKeyPackageRef brig bundle + pure bundle + +-- | Claim key package for a local user, or generate and map key packages for remote ones. +claimKeyPackages :: + HasCallStack => + ClientIdentity -> + Qualified UserId -> + MLSTest KeyPackageBundle +claimKeyPackages cid qusr = do + loc <- liftTest $ qualifyLocal () + foldQualified loc (claimLocalKeyPackages cid) claimRemoteKeyPackages qusr + +bundleKeyPackages :: KeyPackageBundle -> MLSTest [(ClientIdentity, FilePath)] +bundleKeyPackages bundle = do + let bundleEntries = kpbEntries bundle + entryIdentity be = mkClientIdentity (kpbeUser be) (kpbeClient be) + for (toList bundleEntries) $ \be -> do + let d = kpData . kpbeKeyPackage $ be + qcid = entryIdentity be + fn <- keyPackageFile qcid (kpbeRef be) + liftIO $ BS.writeFile fn d + pure (qcid, fn) + +-- | Claim keypackages and create a commit/welcome pair on a given client. +-- Note that this alters the state of the group immediately. If we want to test +-- a scenario where the commit is rejected by the backend, we can restore the +-- group to the previous state by using an older version of the group file. +createAddCommit :: HasCallStack => ClientIdentity -> [Qualified UserId] -> MLSTest MessagePackage +createAddCommit cid users = do + kps <- concat <$> traverse (bundleKeyPackages <=< claimKeyPackages cid) users + createAddCommitWithKeyPackages cid kps + +createAddProposals :: HasCallStack => ClientIdentity -> [Qualified UserId] -> MLSTest [MessagePackage] +createAddProposals cid users = do + kps <- concat <$> traverse (bundleKeyPackages <=< claimKeyPackages cid) users + traverse (createAddProposalWithKeyPackage cid) kps + +-- | Create an application message. +createApplicationMessage :: + HasCallStack => + ClientIdentity -> + String -> + MLSTest MessagePackage +createApplicationMessage cid messageContent = do + groupFile <- currentGroupFile cid + message <- + mlscli + cid + ["message", "--group", groupFile, messageContent] + Nothing + + pure $ + MessagePackage + { mpSender = cid, + mpMessage = message, + mpWelcome = Nothing + } + +createAddCommitWithKeyPackages :: + ClientIdentity -> + [(ClientIdentity, FilePath)] -> + MLSTest MessagePackage +createAddCommitWithKeyPackages qcid clientsAndKeyPackages = do + bd <- State.gets mlsBaseDir + g <- currentGroupFile qcid + gNew <- nextGroupFile qcid + welcomeFile <- liftIO $ emptyTempFile bd "welcome" + commit <- + mlscli + qcid + ( [ "member", + "add", + "--group", + g, + "--welcome-out", + welcomeFile, + "--group-out", + gNew + ] + <> map snd clientsAndKeyPackages + ) + Nothing + + State.modify $ \mls -> + mls + { mlsNewMembers = Set.fromList (map fst clientsAndKeyPackages) + } + + welcome <- liftIO $ BS.readFile welcomeFile + pure $ + MessagePackage + { mpSender = qcid, + mpMessage = commit, + mpWelcome = Just welcome + } + +createAddProposalWithKeyPackage :: + ClientIdentity -> + (ClientIdentity, FilePath) -> + MLSTest MessagePackage +createAddProposalWithKeyPackage cid (_, kp) = do + g <- currentGroupFile cid + gNew <- nextGroupFile cid + prop <- + mlscli + cid + ["proposal", "--group-in", g, "--group-out", gNew, "add", kp] + Nothing + pure + MessagePackage + { mpSender = cid, + mpMessage = prop, + mpWelcome = Nothing + } + +createPendingProposalCommit :: HasCallStack => ClientIdentity -> MLSTest MessagePackage +createPendingProposalCommit qcid = do + bd <- State.gets mlsBaseDir + welcomeFile <- liftIO $ emptyTempFile bd "welcome" + g <- currentGroupFile qcid + gNew <- nextGroupFile qcid + commit <- + mlscli + qcid + [ "commit", + "--group", + g, + "--group-out", + gNew, + "--welcome-out", + welcomeFile + ] + Nothing + + welcome <- liftIO $ readWelcome welcomeFile + pure + MessagePackage + { mpSender = qcid, + mpMessage = commit, + mpWelcome = welcome + } + +readWelcome :: FilePath -> IO (Maybe ByteString) +readWelcome fp = runMaybeT $ do + liftIO (doesFileExist fp) >>= guard + stat <- liftIO $ getFileStatus fp + guard $ fileSize stat > 0 + liftIO $ BS.readFile fp + +createRemoveCommit :: HasCallStack => ClientIdentity -> [ClientIdentity] -> MLSTest MessagePackage +createRemoveCommit cid targets = do + bd <- State.gets mlsBaseDir + welcomeFile <- liftIO $ emptyTempFile bd "welcome" + g <- currentGroupFile cid + gNew <- nextGroupFile cid + + kprefByClient <- liftIO $ Map.fromList <$> readGroupState g + let fetchKeyPackage c = keyPackageFile c (kprefByClient Map.! c) + kps <- traverse fetchKeyPackage targets + + commit <- + mlscli + cid + ( [ "member", + "remove", + "--group", + g, + "--group-out", + gNew, + "--welcome-out", + welcomeFile + ] + <> kps + ) + Nothing + welcome <- liftIO $ readWelcome welcomeFile + pure + MessagePackage + { mpSender = cid, + mpMessage = commit, + mpWelcome = welcome + } + +createExternalAddProposal :: HasCallStack => ClientIdentity -> MLSTest MessagePackage +createExternalAddProposal joiner = do + groupId <- + State.gets mlsGroupId >>= \case + Nothing -> liftIO $ assertFailure "Creating add proposal for non-existing group" + Just g -> pure g + epoch <- State.gets mlsEpoch + proposal <- + mlscli + joiner + [ "proposal-external", + "--group-id", + T.unpack (toBase64Text (unGroupId groupId)), + "--epoch", + show epoch, + "add" + ] + Nothing + + State.modify $ \mls -> + mls + { mlsNewMembers = mlsNewMembers mls <> Set.singleton joiner + } + pure + MessagePackage + { mpSender = joiner, + mpMessage = proposal, + mpWelcome = Nothing + } + +consumeWelcome :: HasCallStack => ByteString -> MLSTest () +consumeWelcome welcome = do + qcids <- State.gets mlsNewMembers + for_ qcids $ \qcid -> do + link <- groupFileLink qcid + liftIO $ + doesFileExist link >>= \e -> + assertBool "Existing clients in a conversation should not consume commits" (not e) + groupFile <- nextGroupFile qcid + void $ + mlscli + qcid + [ "group", + "from-welcome", + "--group-out", + groupFile, + "-" + ] + (Just welcome) + +-- | Make all member clients consume a given message. +consumeMessage :: HasCallStack => MessagePackage -> MLSTest () +consumeMessage msg = do + mems <- State.gets mlsMembers + for_ (Set.delete (mpSender msg) mems) $ \cid -> + consumeMessage1 cid (mpMessage msg) + +consumeMessage1 :: HasCallStack => ClientIdentity -> ByteString -> MLSTest () +consumeMessage1 cid msg = do + bd <- State.gets mlsBaseDir + g <- currentGroupFile cid + gNew <- nextGroupFile cid + void $ + mlscli + cid + [ "consume", + "--group", + g, + "--group-out", + gNew, + "--signer-key", + bd "removal.key", + "-" + ] + (Just msg) + +-- | Send an MLS message and simulate clients receiving it. If the message is a +-- commit, the 'sendAndConsumeCommit' function should be used instead. +sendAndConsumeMessage :: HasCallStack => MessagePackage -> MLSTest [Event] +sendAndConsumeMessage mp = do + events <- + fmap mmssEvents . responseJsonError + =<< postMessage (ciUser (mpSender mp)) (mpMessage mp) + do + postWelcome (ciUser (mpSender mp)) welcome + !!! const 201 === statusCode + consumeWelcome welcome + + pure events + +-- | Send an MLS commit message, simulate clients receiving it, and update the +-- test state accordingly. +sendAndConsumeCommit :: + HasCallStack => + MessagePackage -> + MLSTest [Event] +sendAndConsumeCommit mp = do + events <- sendAndConsumeMessage mp + + -- increment epoch and add new clients + State.modify $ \mls -> + mls + { mlsEpoch = mlsEpoch mls + 1, + mlsMembers = mlsMembers mls <> mlsNewMembers mls, + mlsNewMembers = mempty + } + + pure events + +mlsBracket :: + HasCallStack => + [ClientIdentity] -> + ([WS.WebSocket] -> MLSTest a) -> + MLSTest a +mlsBracket clients k = do + c <- view tsCannon + WS.bracketAsClientRN c (map (ciUser &&& ciClient) clients) k + +readGroupState :: FilePath -> IO [(ClientIdentity, KeyPackageRef)] +readGroupState fp = do + j <- BS.readFile fp + pure $ do + node <- j ^.. key "group" . key "tree" . key "tree" . key "nodes" . _Array . traverse + leafNode <- node ^.. key "node" . key "LeafNode" + identity <- + either (const []) pure . decodeMLS' . BS.pack . map fromIntegral $ + leafNode ^.. key "key_package" . key "payload" . key "credential" . key "credential" . key "Basic" . key "identity" . key "vec" . _Array . traverse . _Integer + kpr <- (unhexM . T.encodeUtf8 =<<) $ leafNode ^.. key "key_package_ref" . _String + pure (identity, KeyPackageRef kpr) + +clientKeyPair :: ClientIdentity -> MLSTest (ByteString, ByteString) +clientKeyPair cid = do + bd <- State.gets mlsBaseDir + credential <- + liftIO . BS.readFile $ + bd cid2Str cid "store" T.unpack (T.decodeUtf8 (B64U.encode "self")) + let s = + credential ^.. key "signature_private_key" . key "value" . _Array . traverse . _Integer + & fmap fromIntegral + & BS.pack + pure $ BS.splitAt 32 s + +receiveNewRemoteConv :: + (MonadReader TestSetup m, MonadIO m) => + Qualified ConvId -> + GroupId -> + m () +receiveNewRemoteConv conv gid = do + client <- view tsFedGalleyClient + let nrc = + NewRemoteConversation (qUnqualified conv) $ + ProtocolMLS + ( ConversationMLSData + gid + (Epoch 1) + MLS_128_DHKEMX25519_AES128GCM_SHA256_Ed25519 + ) + void $ + runFedClient + @"on-new-remote-conversation" + client + (qDomain conv) + nrc diff --git a/services/galley/test/integration/API/Util.hs b/services/galley/test/integration/API/Util.hs index 53472850b07..bd42d1b55a2 100644 --- a/services/galley/test/integration/API/Util.hs +++ b/services/galley/test/integration/API/Util.hs @@ -26,7 +26,7 @@ import Brig.Types.Connection import Brig.Types.Intra (UserAccount (..)) import Control.Concurrent.Async import Control.Exception (throw) -import Control.Lens hiding (from, to, (#), (.=)) +import Control.Lens hiding (from, to, uncons, (#), (.=)) import Control.Monad.Catch (MonadCatch, MonadMask) import Control.Monad.Codensity (lowerCodensity) import Control.Monad.Except (ExceptT, runExceptT) @@ -1013,10 +1013,21 @@ postQualifiedMembers zusr invitees conv = do . zType "access" . json invite -postMembers :: UserId -> NonEmpty (Qualified UserId) -> Qualified ConvId -> TestM ResponseLBS +postMembers :: + (MonadIO m, MonadHttp m, MonadReader TestSetup m) => + UserId -> + NonEmpty (Qualified UserId) -> + Qualified ConvId -> + m ResponseLBS postMembers u us c = postMembersWithRole u us c roleNameWireAdmin -postMembersWithRole :: UserId -> NonEmpty (Qualified UserId) -> Qualified ConvId -> RoleName -> TestM ResponseLBS +postMembersWithRole :: + (MonadIO m, MonadHttp m, MonadReader TestSetup m) => + UserId -> + NonEmpty (Qualified UserId) -> + Qualified ConvId -> + RoleName -> + m ResponseLBS postMembersWithRole u us c r = do g <- view tsGalley let i = InviteQualified us r @@ -2312,20 +2323,23 @@ postSSOUser name hasEmail ssoid teamid = do defCookieLabel :: CookieLabel defCookieLabel = CookieLabel "auth" -withSettingsOverrides :: (Opts.Opts -> Opts.Opts) -> TestM a -> TestM a -withSettingsOverrides f action = do - ts :: TestSetup <- ask - let opts = f (ts ^. tsGConf) - liftIO . lowerCodensity $ do - (galleyApp, _env) <- Run.mkApp opts - port' <- withMockServer galleyApp - liftIO $ - runReaderT - (runTestM action) - ( ts - & tsGalley .~ Bilge.host "127.0.0.1" . Bilge.port port' - & tsFedGalleyClient .~ FedClient (ts ^. tsManager) (Endpoint "127.0.0.1" port') - ) +class HasSettingsOverrides m where + withSettingsOverrides :: (Opts.Opts -> Opts.Opts) -> m a -> m a + +instance HasSettingsOverrides TestM where + withSettingsOverrides f action = do + ts :: TestSetup <- ask + let opts = f (ts ^. tsGConf) + liftIO . lowerCodensity $ do + (galleyApp, _env) <- Run.mkApp opts + port' <- withMockServer galleyApp + liftIO $ + runReaderT + (runTestM action) + ( ts + & tsGalley .~ Bilge.host "127.0.0.1" . Bilge.port port' + & tsFedGalleyClient .~ FedClient (ts ^. tsManager) (Endpoint "127.0.0.1" port') + ) waitForMemberDeletion :: UserId -> TeamId -> UserId -> TestM () waitForMemberDeletion zusr tid uid = do @@ -2470,9 +2484,10 @@ withTempMockFederator :: withTempMockFederator resp = withTempMockFederator' $ pure . encode . resp withTempMockFederator' :: + (MonadIO m, MonadMask m, HasSettingsOverrides m) => (FederatedRequest -> IO LByteString) -> - TestM b -> - TestM (b, [FederatedRequest]) + m b -> + m (b, [FederatedRequest]) withTempMockFederator' resp action = do Mock.withTempMockFederator [("Content-Type", "application/json")] @@ -2792,10 +2807,60 @@ wsAssertBackendRemoveProposal fromUser convId kpref n = do case rmValue rp of RemoveProposal kpRefRemove -> kpRefRemove @?= kpref - otherProp -> error ("Exepected RemoveProposal but got " <> show otherProp) - otherPayload -> error ("Exepected ProposalMessage but got " <> show otherPayload) + otherProp -> assertFailure $ "Expected RemoveProposal but got " <> show otherProp + otherPayload -> assertFailure $ "Expected ProposalMessage but got " <> show otherPayload + pure bs + where + getMLSMessageData :: Conv.EventData -> ByteString + getMLSMessageData (EdMLSMessage bs) = bs + getMLSMessageData d = error ("Excepected EdMLSMessage, but got " <> show d) + +wsAssertAddProposal :: + HasCallStack => + Qualified UserId -> + Qualified ConvId -> + Notification -> + IO ByteString +wsAssertAddProposal fromUser convId n = do + let e = List1.head (WS.unpackPayload n) + ntfTransient n @?= False + evtConv e @?= convId + evtType e @?= MLSMessageAdd + evtFrom e @?= fromUser + let bs = getMLSMessageData (evtData e) + let msg = fromRight (error "Failed to parse Message 'MLSPlaintext") $ decodeMLS' bs + let tbs = rmValue . msgTBS $ msg + tbsMsgSender tbs @?= NewMemberSender + case tbsMsgPayload tbs of + ProposalMessage rp -> + case rmValue rp of + AddProposal _ -> pure () + otherProp -> + assertFailure $ + "Expected AddProposal but got " <> show otherProp + otherPayload -> + assertFailure $ + "Expected ProposalMessage but got " <> show otherPayload pure bs where getMLSMessageData :: Conv.EventData -> ByteString getMLSMessageData (EdMLSMessage bs) = bs getMLSMessageData d = error ("Excepected EdMLSMessage, but got " <> show d) + +createAndConnectUsers :: [Maybe Text] -> TestM [Qualified UserId] +createAndConnectUsers domains = do + localDomain <- viewFederationDomain + users <- for domains $ maybe randomQualifiedUser (randomQualifiedId . Domain) + let userPairs = do + t <- tails users + (a, others) <- maybeToList (uncons t) + b <- others + pure (a, b) + for_ userPairs $ \(a, b) -> + case (qDomain a == localDomain, qDomain b == localDomain) of + (True, True) -> + connectUsers (qUnqualified a) (pure (qUnqualified b)) + (True, False) -> connectWithRemoteUser (qUnqualified a) b + (False, True) -> connectWithRemoteUser (qUnqualified b) a + (False, False) -> pure () + pure users diff --git a/services/galley/test/integration/TestHelpers.hs b/services/galley/test/integration/TestHelpers.hs index 37c039d6379..e7932f789d9 100644 --- a/services/galley/test/integration/TestHelpers.hs +++ b/services/galley/test/integration/TestHelpers.hs @@ -22,6 +22,7 @@ module TestHelpers where import API.SQS import Control.Lens (view) import Data.Domain (Domain) +import Data.Qualified import qualified Galley.Aws as Aws import Galley.Options (optSettings, setFederationDomain) import Imports @@ -54,3 +55,8 @@ test s n h = testCase n runTest viewFederationDomain :: TestM Domain viewFederationDomain = view (tsGConf . optSettings . setFederationDomain) + +qualifyLocal :: a -> TestM (Local a) +qualifyLocal x = do + domain <- viewFederationDomain + pure $ toLocalUnsafe domain x From abe85c6ac52d76e5290a945579c40fb3f98437f1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marko=20Dimja=C5=A1evi=C4=87?= Date: Wed, 14 Sep 2022 14:11:01 +0200 Subject: [PATCH 24/58] [FS-873] Leaving MLS Conversations and Backend-side Removals (#2667) * Allow leaving an MLS conversation via Wire API * Add failing test for user leaving * Move MLS clients to their own table * Refactor leave action: remove list of leavers * Update conversation object after removal * Fix integration tests * Implement a remote leaver test * Update federation golden tests * Split leave test into two * Make removing already-removed users a no-op * Add CHANGELOG entries Co-authored-by: Paolo Capriotti --- cassandra-schema.cql | 37 ++- changelog.d/1-api-changes/leave-mls-conv | 1 + changelog.d/5-internal/mls-clients-in-conv | 1 + .../src/Galley/Types/Conversations/Members.hs | 11 +- libs/types-common/src/Data/Qualified.hs | 4 + .../Federation/Golden/ConversationUpdate.hs | 2 +- .../testObject_ConversationUpdate2.json | 9 +- .../testObject_MessageSendReponse1.json | 32 +-- .../testObject_MessageSendReponse3.json | 36 +-- .../testObject_NewConnectionRequest1.json | 4 +- .../testObject_NewConnectionRequest2.json | 4 +- .../testObject_NewConnectionResponse1.json | 4 +- .../testObject_NewConnectionResponse2.json | 4 +- .../testObject_NewConnectionResponse3.json | 4 +- .../src/Wire/API/Conversation/Action.hs | 6 +- .../src/Wire/API/Conversation/Protocol.hs | 2 +- services/brig/test/integration/Util.hs | 2 +- services/galley/galley.cabal | 4 + services/galley/schema/src/Main.hs | 4 +- .../schema/src/V73_MemberClientTable.hs | 49 ++++ services/galley/src/Galley/API/Action.hs | 97 ++++++-- services/galley/src/Galley/API/Federation.hs | 30 ++- services/galley/src/Galley/API/Internal.hs | 6 +- services/galley/src/Galley/API/LegalHold.hs | 101 ++++---- services/galley/src/Galley/API/MLS/Message.hs | 224 ++++++------------ .../galley/src/Galley/API/MLS/Propagate.hs | 116 +++++++++ services/galley/src/Galley/API/MLS/Removal.hs | 103 ++++++++ services/galley/src/Galley/API/MLS/Types.hs | 43 ++++ services/galley/src/Galley/API/Mapping.hs | 4 +- services/galley/src/Galley/API/Teams.hs | 1 + .../galley/src/Galley/API/Teams/Features.hs | 4 + services/galley/src/Galley/API/Update.hs | 91 +++++-- services/galley/src/Galley/API/Util.hs | 1 + services/galley/src/Galley/Cassandra.hs | 2 +- .../Galley/Cassandra/Conversation/Members.hs | 92 +++---- .../galley/src/Galley/Cassandra/Queries.hs | 35 ++- .../src/Galley/Data/Conversation/Types.hs | 10 - .../galley/src/Galley/Effects/MemberStore.hs | 6 +- services/galley/test/integration/API.hs | 66 ++++-- .../galley/test/integration/API/Federation.hs | 12 +- services/galley/test/integration/API/MLS.hs | 147 +++++++++++- .../galley/test/integration/API/MLS/Util.hs | 9 + services/galley/test/integration/API/Util.hs | 8 +- .../galley/test/unit/Test/Galley/Mapping.hs | 3 +- 44 files changed, 961 insertions(+), 470 deletions(-) create mode 100644 changelog.d/1-api-changes/leave-mls-conv create mode 100644 changelog.d/5-internal/mls-clients-in-conv create mode 100644 services/galley/schema/src/V73_MemberClientTable.hs create mode 100644 services/galley/src/Galley/API/MLS/Propagate.hs create mode 100644 services/galley/src/Galley/API/MLS/Removal.hs create mode 100644 services/galley/src/Galley/API/MLS/Types.hs diff --git a/cassandra-schema.cql b/cassandra-schema.cql index 0474d89325c..5eb68efc442 100644 --- a/cassandra-schema.cql +++ b/cassandra-schema.cql @@ -168,7 +168,6 @@ CREATE TABLE galley_test.member ( conversation_role text, hidden boolean, hidden_ref text, - mls_clients_keypackages set>>, otr_archived boolean, otr_archived_ref text, otr_muted boolean, @@ -262,7 +261,6 @@ CREATE TABLE galley_test.member_remote_user ( user_remote_domain text, user_remote_id uuid, conversation_role text, - mls_clients_keypackages set>>, PRIMARY KEY (conv, user_remote_domain, user_remote_id) ) WITH CLUSTERING ORDER BY (user_remote_domain ASC, user_remote_id ASC) AND bloom_filter_fp_chance = 0.1 @@ -365,15 +363,18 @@ CREATE TABLE galley_test.group_id_conv_id ( AND read_repair_chance = 0.0 AND speculative_retry = '99PERCENTILE'; -CREATE TABLE galley_test.user ( - user uuid, +CREATE TABLE galley_test.member_client ( conv uuid, - PRIMARY KEY (user, conv) -) WITH CLUSTERING ORDER BY (conv ASC) - AND bloom_filter_fp_chance = 0.1 + user_domain text, + user uuid, + client text, + key_package_ref blob, + PRIMARY KEY (conv, user_domain, user, client) +) WITH CLUSTERING ORDER BY (user_domain ASC, user ASC, client ASC) + AND bloom_filter_fp_chance = 0.01 AND caching = {'keys': 'ALL', 'rows_per_partition': 'NONE'} AND comment = '' - AND compaction = {'class': 'org.apache.cassandra.db.compaction.LeveledCompactionStrategy'} + AND compaction = {'class': 'org.apache.cassandra.db.compaction.SizeTieredCompactionStrategy', 'max_threshold': '32', 'min_threshold': '4'} AND compression = {'chunk_length_in_kb': '64', 'class': 'org.apache.cassandra.io.compress.LZ4Compressor'} AND crc_check_chance = 1.0 AND dclocal_read_repair_chance = 0.1 @@ -565,6 +566,26 @@ CREATE TABLE galley_test.mls_proposal_refs ( AND read_repair_chance = 0.0 AND speculative_retry = '99PERCENTILE'; +CREATE TABLE galley_test.user ( + user uuid, + conv uuid, + PRIMARY KEY (user, conv) +) WITH CLUSTERING ORDER BY (conv ASC) + AND bloom_filter_fp_chance = 0.1 + AND caching = {'keys': 'ALL', 'rows_per_partition': 'NONE'} + AND comment = '' + AND compaction = {'class': 'org.apache.cassandra.db.compaction.LeveledCompactionStrategy'} + AND compression = {'chunk_length_in_kb': '64', 'class': 'org.apache.cassandra.io.compress.LZ4Compressor'} + AND crc_check_chance = 1.0 + AND dclocal_read_repair_chance = 0.1 + AND default_time_to_live = 0 + AND gc_grace_seconds = 864000 + AND max_index_interval = 2048 + AND memtable_flush_period_in_ms = 0 + AND min_index_interval = 128 + AND read_repair_chance = 0.0 + AND speculative_retry = '99PERCENTILE'; + CREATE KEYSPACE gundeck_test WITH replication = {'class': 'SimpleStrategy', 'replication_factor': '1'} AND durable_writes = true; CREATE TABLE gundeck_test.push ( diff --git a/changelog.d/1-api-changes/leave-mls-conv b/changelog.d/1-api-changes/leave-mls-conv new file mode 100644 index 00000000000..0c9e0474ca1 --- /dev/null +++ b/changelog.d/1-api-changes/leave-mls-conv @@ -0,0 +1 @@ +Leaving an MLS conversation is now possible using the regular endpoint `DELETE /conversations/{cnv_domain}/{cnv}/members/{usr_domain}/{usr}`. When a user leaves, the backend sends external remove proposals for all their clients in the corresponding MLS group. diff --git a/changelog.d/5-internal/mls-clients-in-conv b/changelog.d/5-internal/mls-clients-in-conv new file mode 100644 index 00000000000..55d01f9304f --- /dev/null +++ b/changelog.d/5-internal/mls-clients-in-conv @@ -0,0 +1 @@ +Clients and key package refs in an MLS conversation are now stored in their own table. diff --git a/libs/galley-types/src/Galley/Types/Conversations/Members.hs b/libs/galley-types/src/Galley/Types/Conversations/Members.hs index 9c6b9b5eb0a..eb602cfe10e 100644 --- a/libs/galley-types/src/Galley/Types/Conversations/Members.hs +++ b/libs/galley-types/src/Galley/Types/Conversations/Members.hs @@ -33,18 +33,15 @@ where import Data.Domain import Data.Id as Id import Data.Qualified -import qualified Data.Set as Set import Imports import Wire.API.Conversation import Wire.API.Conversation.Role (RoleName, roleNameWireAdmin) -import Wire.API.MLS.KeyPackage import Wire.API.Provider.Service (ServiceRef) -- | Internal (cassandra) representation of a remote conversation member. data RemoteMember = RemoteMember { rmId :: Remote UserId, - rmConvRoleName :: RoleName, - rmMLSClients :: Set (ClientId, KeyPackageRef) + rmConvRoleName :: RoleName } deriving stock (Show) @@ -64,8 +61,7 @@ data LocalMember = LocalMember { lmId :: UserId, lmStatus :: MemberStatus, lmService :: Maybe ServiceRef, - lmConvRoleName :: RoleName, - lmMLSClients :: Set (ClientId, KeyPackageRef) + lmConvRoleName :: RoleName } deriving stock (Show) @@ -78,8 +74,7 @@ newMemberWithRole (u, r) = { lmId = u, lmService = Nothing, lmStatus = defMemberStatus, - lmConvRoleName = r, - lmMLSClients = Set.empty + lmConvRoleName = r } localMemberToOther :: Domain -> LocalMember -> OtherMember diff --git a/libs/types-common/src/Data/Qualified.hs b/libs/types-common/src/Data/Qualified.hs index 12180988f61..0eb22eb4d5e 100644 --- a/libs/types-common/src/Data/Qualified.hs +++ b/libs/types-common/src/Data/Qualified.hs @@ -41,6 +41,7 @@ module Data.Qualified indexQualified, bucketQualified, bucketRemote, + isLocal, deprecatedSchema, qualifiedSchema, qualifiedObjectSchema, @@ -157,6 +158,9 @@ bucketRemote = . indexQualified . fmap qUntagged +isLocal :: Local x -> Qualified a -> Bool +isLocal loc = foldQualified loc (const True) (const False) + ---------------------------------------------------------------------- deprecatedSchema :: S.HasDescription doc (Maybe Text) => Text -> ValueSchema doc a -> ValueSchema doc a diff --git a/libs/wire-api-federation/test/Test/Wire/API/Federation/Golden/ConversationUpdate.hs b/libs/wire-api-federation/test/Test/Wire/API/Federation/Golden/ConversationUpdate.hs index e19c3b6732c..a9eebfde1fb 100644 --- a/libs/wire-api-federation/test/Test/Wire/API/Federation/Golden/ConversationUpdate.hs +++ b/libs/wire-api-federation/test/Test/Wire/API/Federation/Golden/ConversationUpdate.hs @@ -72,5 +72,5 @@ testObject_ConversationUpdate2 = cuConvId = Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000100000006")), cuAlreadyPresentUsers = [chad, dee], - cuAction = SomeConversationAction (sing @'ConversationLeaveTag) (pure qAlice) + cuAction = SomeConversationAction (sing @'ConversationLeaveTag) () } diff --git a/libs/wire-api-federation/test/golden/testObject_ConversationUpdate2.json b/libs/wire-api-federation/test/golden/testObject_ConversationUpdate2.json index 21f5d72822b..8b443934beb 100644 --- a/libs/wire-api-federation/test/golden/testObject_ConversationUpdate2.json +++ b/libs/wire-api-federation/test/golden/testObject_ConversationUpdate2.json @@ -1,13 +1,6 @@ { "cuAction": { - "action": { - "users": [ - { - "domain": "golden.example.com", - "id": "00000000-0000-0000-0000-000100004007" - } - ] - }, + "action": {}, "tag": "ConversationLeaveTag" }, "cuAlreadyPresentUsers": [ diff --git a/libs/wire-api-federation/test/golden/testObject_MessageSendReponse1.json b/libs/wire-api-federation/test/golden/testObject_MessageSendReponse1.json index d35a577690e..e95ce811b45 100644 --- a/libs/wire-api-federation/test/golden/testObject_MessageSendReponse1.json +++ b/libs/wire-api-federation/test/golden/testObject_MessageSendReponse1.json @@ -1,49 +1,49 @@ { "Right": { - "failed_to_send": { + "deleted": { "golden.example.com": { - "00000000-0000-0000-0000-000200000008": [ - "0" - ], - "00000000-0000-0000-0000-000100000007": [ + "00000000-0000-0000-0000-000100000005": [ "0", "1" + ], + "00000000-0000-0000-0000-000200000006": [ + "0" ] } }, - "redundant": { + "failed_to_send": { "golden.example.com": { - "00000000-0000-0000-0000-000100000003": [ + "00000000-0000-0000-0000-000100000007": [ "0", "1" ], - "00000000-0000-0000-0000-000200000004": [ + "00000000-0000-0000-0000-000200000008": [ "0" ] } }, - "time": "1864-04-12T12:22:43.673Z", "missing": { "golden.example.com": { - "00000000-0000-0000-0000-000200000000": [ - "0" - ], "00000000-0000-0000-0000-000100000002": [ "0", "1" + ], + "00000000-0000-0000-0000-000200000000": [ + "0" ] } }, - "deleted": { + "redundant": { "golden.example.com": { - "00000000-0000-0000-0000-000100000005": [ + "00000000-0000-0000-0000-000100000003": [ "0", "1" ], - "00000000-0000-0000-0000-000200000006": [ + "00000000-0000-0000-0000-000200000004": [ "0" ] } - } + }, + "time": "1864-04-12T12:22:43.673Z" } } \ No newline at end of file diff --git a/libs/wire-api-federation/test/golden/testObject_MessageSendReponse3.json b/libs/wire-api-federation/test/golden/testObject_MessageSendReponse3.json index 21fb6f1f902..7080dfa8c3a 100644 --- a/libs/wire-api-federation/test/golden/testObject_MessageSendReponse3.json +++ b/libs/wire-api-federation/test/golden/testObject_MessageSendReponse3.json @@ -1,52 +1,52 @@ { "Left": { - "tag": "MessageNotSentClientMissing", "contents": { - "failed_to_send": { + "deleted": { "golden.example.com": { - "00000000-0000-0000-0000-000200000008": [ - "0" - ], - "00000000-0000-0000-0000-000100000007": [ + "00000000-0000-0000-0000-000100000005": [ "0", "1" + ], + "00000000-0000-0000-0000-000200000006": [ + "0" ] } }, - "redundant": { + "failed_to_send": { "golden.example.com": { - "00000000-0000-0000-0000-000100000003": [ + "00000000-0000-0000-0000-000100000007": [ "0", "1" ], - "00000000-0000-0000-0000-000200000004": [ + "00000000-0000-0000-0000-000200000008": [ "0" ] } }, - "time": "1864-04-12T12:22:43.673Z", "missing": { "golden.example.com": { - "00000000-0000-0000-0000-000200000000": [ - "0" - ], "00000000-0000-0000-0000-000100000002": [ "0", "1" + ], + "00000000-0000-0000-0000-000200000000": [ + "0" ] } }, - "deleted": { + "redundant": { "golden.example.com": { - "00000000-0000-0000-0000-000100000005": [ + "00000000-0000-0000-0000-000100000003": [ "0", "1" ], - "00000000-0000-0000-0000-000200000006": [ + "00000000-0000-0000-0000-000200000004": [ "0" ] } - } - } + }, + "time": "1864-04-12T12:22:43.673Z" + }, + "tag": "MessageNotSentClientMissing" } } \ No newline at end of file diff --git a/libs/wire-api-federation/test/golden/testObject_NewConnectionRequest1.json b/libs/wire-api-federation/test/golden/testObject_NewConnectionRequest1.json index cebe1dfa478..0657122cdbb 100644 --- a/libs/wire-api-federation/test/golden/testObject_NewConnectionRequest1.json +++ b/libs/wire-api-federation/test/golden/testObject_NewConnectionRequest1.json @@ -1,5 +1,5 @@ { - "to": "1669240c-c510-43e0-bf1a-33378fa4ba55", + "action": "RemoteConnect", "from": "69f66843-6cf1-48fb-8c05-1cf58c23566a", - "action": "RemoteConnect" + "to": "1669240c-c510-43e0-bf1a-33378fa4ba55" } \ No newline at end of file diff --git a/libs/wire-api-federation/test/golden/testObject_NewConnectionRequest2.json b/libs/wire-api-federation/test/golden/testObject_NewConnectionRequest2.json index 46109706108..32f52b7f307 100644 --- a/libs/wire-api-federation/test/golden/testObject_NewConnectionRequest2.json +++ b/libs/wire-api-federation/test/golden/testObject_NewConnectionRequest2.json @@ -1,5 +1,5 @@ { - "to": "1669240c-c510-43e0-bf1a-33378fa4ba55", + "action": "RemoteRescind", "from": "69f66843-6cf1-48fb-8c05-1cf58c23566a", - "action": "RemoteRescind" + "to": "1669240c-c510-43e0-bf1a-33378fa4ba55" } \ No newline at end of file diff --git a/libs/wire-api-federation/test/golden/testObject_NewConnectionResponse1.json b/libs/wire-api-federation/test/golden/testObject_NewConnectionResponse1.json index 61c94bf0db3..8742918c4b3 100644 --- a/libs/wire-api-federation/test/golden/testObject_NewConnectionResponse1.json +++ b/libs/wire-api-federation/test/golden/testObject_NewConnectionResponse1.json @@ -1,4 +1,4 @@ { - "tag": "NewConnectionResponseOk", - "contents": null + "contents": null, + "tag": "NewConnectionResponseOk" } \ No newline at end of file diff --git a/libs/wire-api-federation/test/golden/testObject_NewConnectionResponse2.json b/libs/wire-api-federation/test/golden/testObject_NewConnectionResponse2.json index 84fa71d7368..d9f4636ea37 100644 --- a/libs/wire-api-federation/test/golden/testObject_NewConnectionResponse2.json +++ b/libs/wire-api-federation/test/golden/testObject_NewConnectionResponse2.json @@ -1,4 +1,4 @@ { - "tag": "NewConnectionResponseOk", - "contents": "RemoteConnect" + "contents": "RemoteConnect", + "tag": "NewConnectionResponseOk" } \ No newline at end of file diff --git a/libs/wire-api-federation/test/golden/testObject_NewConnectionResponse3.json b/libs/wire-api-federation/test/golden/testObject_NewConnectionResponse3.json index aeee3a6db92..d520e8340ea 100644 --- a/libs/wire-api-federation/test/golden/testObject_NewConnectionResponse3.json +++ b/libs/wire-api-federation/test/golden/testObject_NewConnectionResponse3.json @@ -1,4 +1,4 @@ { - "tag": "NewConnectionResponseOk", - "contents": "RemoteRescind" + "contents": "RemoteRescind", + "tag": "NewConnectionResponseOk" } \ No newline at end of file diff --git a/libs/wire-api/src/Wire/API/Conversation/Action.hs b/libs/wire-api/src/Wire/API/Conversation/Action.hs index bd0700a521a..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,7 @@ import Wire.Arbitrary (Arbitrary (..)) -- individual effects per conversation action. See 'HasConversationActionEffects'. type family ConversationAction (tag :: ConversationActionTag) :: * where ConversationAction 'ConversationJoinTag = ConversationJoin - ConversationAction 'ConversationLeaveTag = NonEmptyList.NonEmpty (Qualified UserId) + ConversationAction 'ConversationLeaveTag = () ConversationAction 'ConversationMemberUpdateTag = ConversationMemberUpdate ConversationAction 'ConversationDeleteTag = () ConversationAction 'ConversationRenameTag = ConversationRename @@ -87,7 +87,7 @@ conversationActionSchema SConversationLeaveTag = objectWithDocModifier "ConversationLeave" (S.description ?~ "The action of some users leaving a conversation on their own") - $ field "users" (nonEmptyArray schema) + $ pure () conversationActionSchema SConversationRemoveMembersTag = objectWithDocModifier "ConversationRemoveMembers" @@ -151,7 +151,7 @@ conversationActionToEvent tag now quid qcnv action = let ConversationJoin newMembers role = action in EdMembersJoin $ SimpleMembers (map (`SimpleMember` role) (toList newMembers)) SConversationLeaveTag -> - EdMembersLeave (QualifiedUserIdList (toList action)) + EdMembersLeave (QualifiedUserIdList [quid]) SConversationRemoveMembersTag -> EdMembersLeave (QualifiedUserIdList (toList action)) SConversationMemberUpdateTag -> diff --git a/libs/wire-api/src/Wire/API/Conversation/Protocol.hs b/libs/wire-api/src/Wire/API/Conversation/Protocol.hs index 718caa3071d..492a2ef68bc 100644 --- a/libs/wire-api/src/Wire/API/Conversation/Protocol.hs +++ b/libs/wire-api/src/Wire/API/Conversation/Protocol.hs @@ -78,7 +78,7 @@ protocolTag (ProtocolMLS _) = ProtocolMLSTag protocolValidAction :: Protocol -> ConversationActionTag -> Bool protocolValidAction ProtocolProteus _ = True protocolValidAction (ProtocolMLS _) ConversationJoinTag = False -protocolValidAction (ProtocolMLS _) ConversationLeaveTag = False +protocolValidAction (ProtocolMLS _) ConversationLeaveTag = True protocolValidAction (ProtocolMLS _) ConversationRemoveMembersTag = False protocolValidAction (ProtocolMLS _) ConversationDeleteTag = False protocolValidAction (ProtocolMLS _) _ = True diff --git a/services/brig/test/integration/Util.hs b/services/brig/test/integration/Util.hs index 080bd924a0b..75960516505 100644 --- a/services/brig/test/integration/Util.hs +++ b/services/brig/test/integration/Util.hs @@ -59,7 +59,7 @@ import Data.List1 (List1) import qualified Data.List1 as List1 import Data.Misc (PlainTextPassword (..)) import Data.Proxy -import Data.Qualified +import Data.Qualified hiding (isLocal) import Data.Range import qualified Data.Sequence as Seq import Data.String.Conversions (cs) diff --git a/services/galley/galley.cabal b/services/galley/galley.cabal index 7beab6843ad..be5ca7e8437 100644 --- a/services/galley/galley.cabal +++ b/services/galley/galley.cabal @@ -34,6 +34,9 @@ library Galley.API.MLS.KeyPackage Galley.API.MLS.Keys Galley.API.MLS.Message + Galley.API.MLS.Propagate + Galley.API.MLS.Removal + Galley.API.MLS.Types Galley.API.MLS.Welcome Galley.API.One2One Galley.API.Public @@ -665,6 +668,7 @@ executable galley-schema V70_MLSCipherSuite V71_MemberClientKeypackage V72_DropManagedConversations + V73_MemberClientTable hs-source-dirs: schema/src default-extensions: diff --git a/services/galley/schema/src/Main.hs b/services/galley/schema/src/Main.hs index 13e3401d5f0..ce3af1f4ce5 100644 --- a/services/galley/schema/src/Main.hs +++ b/services/galley/schema/src/Main.hs @@ -75,6 +75,7 @@ import qualified V69_MLSProposal import qualified V70_MLSCipherSuite import qualified V71_MemberClientKeypackage import qualified V72_DropManagedConversations +import qualified V73_MemberClientTable main :: IO () main = do @@ -135,7 +136,8 @@ main = do V69_MLSProposal.migration, V70_MLSCipherSuite.migration, V71_MemberClientKeypackage.migration, - V72_DropManagedConversations.migration + V72_DropManagedConversations.migration, + V73_MemberClientTable.migration -- When adding migrations here, don't forget to update -- 'schemaVersion' in Galley.Cassandra -- (see also docs/developer/cassandra-interaction.md) diff --git a/services/galley/schema/src/V73_MemberClientTable.hs b/services/galley/schema/src/V73_MemberClientTable.hs new file mode 100644 index 00000000000..15f642018b9 --- /dev/null +++ b/services/galley/schema/src/V73_MemberClientTable.hs @@ -0,0 +1,49 @@ +-- 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 V73_MemberClientTable where + +import Cassandra.Schema +import Imports +import Text.RawString.QQ + +migration :: Migration +migration = + Migration 73 "Move mls_clients_keypackages to its own table" $ do + schema' + [r| + CREATE TABLE member_client ( + conv uuid, + user_domain text, + user uuid, + client text, + key_package_ref blob, + PRIMARY KEY (conv, user_domain, user, client) + ); + |] + schema' + [r| + ALTER TABLE member DROP ( + mls_clients_keypackages + ); + |] + schema' + [r| + ALTER TABLE member_remote_user DROP ( + mls_clients_keypackages + ); + |] diff --git a/services/galley/src/Galley/API/Action.hs b/services/galley/src/Galley/API/Action.hs index d3201e1c5ee..d7e3ad707eb 100644 --- a/services/galley/src/Galley/API/Action.hs +++ b/services/galley/src/Galley/API/Action.hs @@ -51,7 +51,9 @@ import qualified Data.Set as Set import Data.Singletons import Data.Time.Clock import Galley.API.Error +import Galley.API.MLS.Removal import Galley.API.Util +import Galley.App import Galley.Data.Conversation import qualified Galley.Data.Conversation as Data import Galley.Data.Services @@ -64,6 +66,7 @@ import qualified Galley.Effects.ConversationStore as E import qualified Galley.Effects.FederatorAccess as E import qualified Galley.Effects.FireAndForget as E import qualified Galley.Effects.MemberStore as E +import Galley.Effects.ProposalStore import qualified Galley.Effects.TeamStore as E import Galley.Options import Galley.Types.Conversations.Members @@ -73,6 +76,7 @@ import Imports import Polysemy import Polysemy.Error import Polysemy.Input +import Polysemy.TinyLog import qualified Polysemy.TinyLog as P import qualified System.Logger as Log import Wire.API.Conversation hiding (Conversation, Member) @@ -96,6 +100,7 @@ type family HasConversationActionEffects (tag :: ConversationActionTag) r :: Con Members '[ BrigAccess, Error FederationError, + Error InternalError, ErrorS 'NotATeamMember, ErrorS 'NotConnected, ErrorS ('ActionDenied 'LeaveConversation), @@ -108,17 +113,33 @@ type family HasConversationActionEffects (tag :: ConversationActionTag) r :: Con ExternalAccess, FederatorAccess, GundeckAccess, + Input Env, Input Opts, Input UTCTime, LegalHoldStore, MemberStore, + ProposalStore, TeamStore, + TinyLog, ConversationStore, Error NoChanges ] r HasConversationActionEffects 'ConversationLeaveTag r = - (Members '[MemberStore, Error NoChanges] r) + ( Members + '[ MemberStore, + Error InternalError, + Error NoChanges, + ExternalAccess, + FederatorAccess, + GundeckAccess, + Input UTCTime, + Input Env, + ProposalStore, + TinyLog + ] + r + ) HasConversationActionEffects 'ConversationRemoveMembersTag r = (Members '[MemberStore, Error NoChanges] r) HasConversationActionEffects 'ConversationMemberUpdateTag r = @@ -132,6 +153,7 @@ type family HasConversationActionEffects (tag :: ConversationActionTag) r :: Con '[ BotAccess, BrigAccess, CodeStore, + Error InternalError, Error InvalidInput, Error NoChanges, ErrorS 'InvalidTargetAccess, @@ -140,8 +162,11 @@ type family HasConversationActionEffects (tag :: ConversationActionTag) r :: Con FederatorAccess, FireAndForget, GundeckAccess, + Input Env, MemberStore, + ProposalStore, TeamStore, + TinyLog, Input UTCTime, ConversationStore ] @@ -264,10 +289,28 @@ performAction tag origUser lconv action = do SConversationJoinTag -> do performConversationJoin origUser lconv action SConversationLeaveTag -> do - let presentVictims = filter (isConvMemberL lconv) (toList action) - when (null presentVictims) noChanges - E.deleteMembers (tUnqualified lcnv) (toUserList lconv presentVictims) - pure (mempty, action) -- FUTUREWORK: should we return the filtered action here? + let victims = [origUser] + E.deleteMembers (tUnqualified lcnv) (toUserList lconv victims) + -- update in-memory view of the conversation + let lconv' = + lconv <&> \c -> + foldQualified + lconv + ( \lu -> + c + { convLocalMembers = + filter (\lm -> lmId lm /= tUnqualified lu) (convLocalMembers c) + } + ) + ( \ru -> + c + { convRemoteMembers = + filter (\rm -> rmId rm /= ru) (convRemoteMembers c) + } + ) + origUser + traverse_ (removeUser lconv') victims + pure (mempty, action) SConversationRemoveMembersTag -> do let presentVictims = filter (isConvMemberL lconv) (toList action) when (null presentVictims) noChanges @@ -297,7 +340,7 @@ performAction tag origUser lconv action = do E.setConversationReceiptMode (tUnqualified lcnv) (cruReceiptMode action) pure (mempty, action) SConversationAccessDataTag -> do - (bm, act) <- performConversationAccessData origUser lconv action + (bm, act) <- performConversationAccessData lconv action pure (bm, act) performConversationJoin :: @@ -368,6 +411,7 @@ performConversationJoin qusr lconv (ConversationJoin invited role) = do checkLHPolicyConflictsLocal :: Members '[ ConversationStore, + Error InternalError, ErrorS ('ActionDenied 'LeaveConversation), ErrorS 'InvalidOperation, ErrorS 'ConvNotFound, @@ -375,11 +419,14 @@ performConversationJoin qusr lconv (ConversationJoin invited role) = do ExternalAccess, FederatorAccess, GundeckAccess, + Input Env, Input Opts, Input UTCTime, LegalHoldStore, MemberStore, - TeamStore + ProposalStore, + TeamStore, + TinyLog ] r => [UserId] -> @@ -417,7 +464,7 @@ performConversationJoin qusr lconv (ConversationJoin invited role) = do (fmap convId lconv) (qUntagged lvictim) Nothing - $ pure (qUntagged lvictim) + () else throwS @'MissingLegalholdConsent checkLHPolicyConflictsRemote :: @@ -427,11 +474,10 @@ performConversationJoin qusr lconv (ConversationJoin invited role) = do performConversationAccessData :: (HasConversationActionEffects 'ConversationAccessDataTag r) => - Qualified UserId -> Local Conversation -> ConversationAccessData -> Sem r (BotsAndMembers, ConversationAccessData) -performConversationAccessData qusr lconv action = do +performConversationAccessData lconv action = do when (convAccessData conv == action) noChanges -- Remove conversation codes if CodeAccess is revoked when @@ -460,9 +506,17 @@ performConversationAccessData qusr lconv action = do let bmToNotify = current {bmBots = bmBots desired} -- Remove users and notify everyone - void . for_ (nonEmpty (bmQualifiedMembers lcnv toRemove)) $ \usersToRemove -> do - void . runError @NoChanges $ performAction SConversationLeaveTag qusr lconv usersToRemove - notifyConversationAction (sing @'ConversationLeaveTag) qusr Nothing lconv bmToNotify usersToRemove + for_ (bmQualifiedMembers lcnv toRemove) $ \userToRemove -> do + (extraTargets, action') <- performAction SConversationLeaveTag userToRemove lconv () + notifyConversationAction + (sing @'ConversationLeaveTag) + userToRemove + True + Nothing + lconv + (bmToNotify <> extraTargets) + action' + pure (mempty, action) where lcnv = fmap convId lconv @@ -519,6 +573,7 @@ updateLocalConversation :: ExternalAccess, FederatorAccess, GundeckAccess, + Input Env, Input UTCTime ] r, @@ -584,6 +639,7 @@ updateLocalConversationUnchecked lconv qusr con action = do notifyConversationAction (sing @tag) qusr + False con lconv (convBotsAndMembers conv <> extraTargets) @@ -638,12 +694,13 @@ notifyConversationAction :: Members '[FederatorAccess, ExternalAccess, GundeckAccess, Input UTCTime] r => Sing tag -> Qualified UserId -> + Bool -> Maybe ConnId -> Local Conversation -> BotsAndMembers -> ConversationAction (tag :: ConversationActionTag) -> Sem r LocalConversationUpdate -notifyConversationAction tag quid con lconv targets action = do +notifyConversationAction tag quid notifyOrigDomain con lconv targets action = do now <- input let lcnv = fmap convId lconv conv = tUnqualified lconv @@ -675,12 +732,12 @@ notifyConversationAction tag quid con lconv targets action = do . E.runFederatedConcurrently (toList (bmRemotes targets)) $ \ruids -> do let update = mkUpdate (tUnqualified ruids) - -- filter out user from quid's domain, because quid's backend will update - -- local state and notify its users itself using the ConversationUpdate - -- returned by this function - if tDomain ruids == qDomain quid - then pure (Just update) - else fedClient @'Galley @"on-conversation-updated" update $> Nothing + -- if notifyOrigDomain is false, filter out user from quid's domain, + -- because quid's backend will update local state and notify its users + -- itself using the ConversationUpdate returned by this function + if notifyOrigDomain || tDomain ruids /= qDomain quid + then fedClient @'Galley @"on-conversation-updated" update $> Nothing + else pure (Just update) -- notify local participants and bots pushConversationEvent con e (qualifyAs lcnv (bmLocals targets)) (bmBots targets) diff --git a/services/galley/src/Galley/API/Federation.hs b/services/galley/src/Galley/API/Federation.hs index 2aa7f3a092b..fc70eafd359 100644 --- a/services/galley/src/Galley/API/Federation.hs +++ b/services/galley/src/Galley/API/Federation.hs @@ -40,6 +40,7 @@ import Galley.API.Action import Galley.API.Error import Galley.API.MLS.KeyPackage import Galley.API.MLS.Message +import Galley.API.MLS.Removal import Galley.API.MLS.Welcome import qualified Galley.API.Mapping as Mapping import Galley.API.Message @@ -227,8 +228,8 @@ onConversationUpdated requestingDomain cu = do [] -> pure (Nothing, []) -- If no users get added, its like no action was performed. (u : us) -> pure (Just (SomeConversationAction (sing @'ConversationJoinTag) (ConversationJoin (u :| us) role)), addedLocalUsers) SConversationLeaveTag -> do - let localUsers = getLocalUsers (tDomain loc) action - E.deleteMembersInRemoteConversation rconvId localUsers + let users = foldQualified loc (pure . tUnqualified) (const []) (F.cuOrigUserId cu) + E.deleteMembersInRemoteConversation rconvId users pure (Just sca, []) SConversationRemoveMembersTag -> do let localUsers = getLocalUsers (tDomain loc) action @@ -291,13 +292,17 @@ addLocalUsersToRemoteConv remoteConvId qAdder localUsers = do leaveConversation :: Members '[ ConversationStore, + Error InternalError, Error InvalidInput, ExternalAccess, FederatorAccess, GundeckAccess, + Input Env, Input (Local ()), Input UTCTime, - MemberStore + MemberStore, + ProposalStore, + TinyLog ] r => Domain -> @@ -322,24 +327,23 @@ leaveConversation requestingDomain lc = do lcnv (qUntagged leaver) Nothing - (pure (qUntagged leaver)) + () pure (update, conv) case res of Left e -> pure $ F.LeaveConversationResponse (Left e) Right (_update, conv) -> do - let action = pure (qUntagged leaver) - let remotes = filter ((== tDomain leaver) . tDomain) (rmId <$> Data.convRemoteMembers conv) let botsAndMembers = BotsAndMembers mempty (Set.fromList remotes) mempty _ <- notifyConversationAction SConversationLeaveTag (qUntagged leaver) + False Nothing (qualifyAs lcnv conv) botsAndMembers - action + () pure $ F.LeaveConversationResponse (Right ()) @@ -457,17 +461,17 @@ onUserDeleted origDomain udcn = do -- The self conv cannot be on a remote backend. Public.SelfConv -> pure () Public.RegularConv -> do - let action = pure untaggedDeletedUser - botsAndMembers = convBotsAndMembers conv - mlsRemoveUser conv (qUntagged deletedUser) + let botsAndMembers = convBotsAndMembers conv + removeUser (qualifyAs lc conv) (qUntagged deletedUser) void $ notifyConversationAction (sing @'ConversationLeaveTag) untaggedDeletedUser + False Nothing (qualifyAs lc conv) botsAndMembers - action + () pure EmptyResponse updateConversation :: @@ -483,11 +487,14 @@ updateConversation :: FederatorAccess, Error InternalError, GundeckAccess, + Input Env, Input Opts, Input UTCTime, LegalHoldStore, MemberStore, + ProposalStore, TeamStore, + TinyLog, ConversationStore, Input (Local ()) ] @@ -563,6 +570,7 @@ sendMLSMessage :: FederatorAccess, GundeckAccess, Input (Local ()), + Input Env, Input Opts, Input UTCTime, LegalHoldStore, diff --git a/services/galley/src/Galley/API/Internal.hs b/services/galley/src/Galley/API/Internal.hs index 120845565a8..28c19f80d37 100644 --- a/services/galley/src/Galley/API/Internal.hs +++ b/services/galley/src/Galley/API/Internal.hs @@ -40,7 +40,7 @@ import qualified Galley.API.CustomBackend as CustomBackend import Galley.API.Error import Galley.API.LegalHold (unsetTeamLegalholdWhitelistedH) import Galley.API.LegalHold.Conflicts -import Galley.API.MLS.Message (mlsRemoveUser) +import Galley.API.MLS.Removal import Galley.API.One2One import Galley.API.Public import Galley.API.Public.Servant @@ -684,7 +684,7 @@ rmUser lusr conn = do ConnectConv -> deleteMembers (Data.convId c) (UserList [tUnqualified lusr] []) $> Nothing RegularConv | tUnqualified lusr `isMember` Data.convLocalMembers c -> do - runError (mlsRemoveUser c (qUntagged lusr)) >>= \case + 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] []) @@ -717,7 +717,7 @@ rmUser lusr conn = do cuOrigUserId = qUser, cuConvId = cid, cuAlreadyPresentUsers = tUnqualified remotes, - cuAction = SomeConversationAction (sing @'ConversationLeaveTag) (pure qUser) + cuAction = SomeConversationAction (sing @'ConversationLeaveTag) () } let rpc = fedClient @'Galley @"on-conversation-updated" convUpdate runFederatedEither remotes rpc diff --git a/services/galley/src/Galley/API/LegalHold.hs b/services/galley/src/Galley/API/LegalHold.hs index 302ef62ad57..71288e7af5c 100644 --- a/services/galley/src/Galley/API/LegalHold.hs +++ b/services/galley/src/Galley/API/LegalHold.hs @@ -48,11 +48,13 @@ import Galley.API.Error import Galley.API.Query (iterateConversations) import Galley.API.Update (removeMemberFromLocalConv) import Galley.API.Util +import Galley.App import qualified Galley.Data.Conversation as Data import Galley.Effects import Galley.Effects.BrigAccess import Galley.Effects.FireAndForget import qualified Galley.Effects.LegalHoldStore as LegalHoldData +import Galley.Effects.ProposalStore import qualified Galley.Effects.TeamFeatureStore as TeamFeatures import Galley.Effects.TeamMemberStore import Galley.Effects.TeamStore @@ -187,30 +189,32 @@ removeSettingsInternalPaging :: BrigAccess, CodeStore, ConversationStore, - Error InternalError, Error AuthenticationError, - ErrorS OperationDenied, - ErrorS 'NotATeamMember, + Error InternalError, ErrorS ('ActionDenied 'RemoveConversationMember), ErrorS 'InvalidOperation, - ErrorS 'LegalHoldNotEnabled, + ErrorS 'LegalHoldCouldNotBlockConnections, ErrorS 'LegalHoldDisableUnimplemented, + ErrorS 'LegalHoldNotEnabled, ErrorS 'LegalHoldServiceNotRegistered, + ErrorS 'NotATeamMember, + ErrorS OperationDenied, ErrorS 'UserLegalHoldIllegalOperation, - ErrorS 'LegalHoldCouldNotBlockConnections, ExternalAccess, FederatorAccess, FireAndForget, GundeckAccess, - Input UTCTime, + Input Env, Input (Local ()), + Input UTCTime, LegalHoldStore, ListItems LegacyPaging ConvId, MemberStore, + ProposalStore, + P.TinyLog, TeamFeatureStore db, TeamMemberStore InternalPaging, TeamStore, - P.TinyLog, WaiRoutes ] r => @@ -230,30 +234,32 @@ removeSettings :: BrigAccess, CodeStore, ConversationStore, - Error InternalError, Error AuthenticationError, - ErrorS 'NotATeamMember, - ErrorS OperationDenied, + Error InternalError, ErrorS ('ActionDenied 'RemoveConversationMember), ErrorS 'InvalidOperation, - ErrorS 'LegalHoldNotEnabled, + ErrorS 'LegalHoldCouldNotBlockConnections, ErrorS 'LegalHoldDisableUnimplemented, + ErrorS 'LegalHoldNotEnabled, ErrorS 'LegalHoldServiceNotRegistered, + ErrorS 'NotATeamMember, + ErrorS OperationDenied, ErrorS 'UserLegalHoldIllegalOperation, - ErrorS 'LegalHoldCouldNotBlockConnections, ExternalAccess, FederatorAccess, FireAndForget, GundeckAccess, - Input UTCTime, + Input Env, Input (Local ()), + Input UTCTime, LegalHoldStore, ListItems LegacyPaging ConvId, MemberStore, + ProposalStore, + P.TinyLog, TeamFeatureStore db, TeamMemberStore p, - TeamStore, - P.TinyLog + TeamStore ] r ) => @@ -305,11 +311,13 @@ removeSettings' :: GundeckAccess, Input UTCTime, Input (Local ()), + Input Env, LegalHoldStore, ListItems LegacyPaging ConvId, MemberStore, TeamMemberStore p, TeamStore, + ProposalStore, P.TinyLog ] r @@ -386,18 +394,20 @@ grantConsent :: Error InternalError, ErrorS ('ActionDenied 'RemoveConversationMember), ErrorS 'InvalidOperation, + ErrorS 'LegalHoldCouldNotBlockConnections, ErrorS 'TeamMemberNotFound, ErrorS 'UserLegalHoldIllegalOperation, - ErrorS 'LegalHoldCouldNotBlockConnections, ExternalAccess, FederatorAccess, GundeckAccess, + Input Env, Input UTCTime, LegalHoldStore, ListItems LegacyPaging ConvId, MemberStore, - TeamStore, - P.TinyLog + ProposalStore, + P.TinyLog, + TeamStore ] r => Local UserId -> @@ -422,27 +432,29 @@ requestDevice :: ConversationStore, Error InternalError, ErrorS ('ActionDenied 'RemoveConversationMember), + ErrorS 'LegalHoldCouldNotBlockConnections, + ErrorS 'LegalHoldNotEnabled, + ErrorS 'LegalHoldServiceBadResponse, + ErrorS 'LegalHoldServiceNotRegistered, ErrorS 'NotATeamMember, + ErrorS 'NoUserLegalHoldConsent, ErrorS OperationDenied, ErrorS 'TeamMemberNotFound, - ErrorS 'LegalHoldNotEnabled, ErrorS 'UserLegalHoldAlreadyEnabled, - ErrorS 'NoUserLegalHoldConsent, - ErrorS 'LegalHoldServiceBadResponse, - ErrorS 'LegalHoldServiceNotRegistered, - ErrorS 'LegalHoldCouldNotBlockConnections, ErrorS 'UserLegalHoldIllegalOperation, - Input (Local ()), ExternalAccess, FederatorAccess, GundeckAccess, + Input (Local ()), + Input Env, Input UTCTime, LegalHoldStore, ListItems LegacyPaging ConvId, MemberStore, + ProposalStore, + P.TinyLog, TeamFeatureStore db, - TeamStore, - P.TinyLog + TeamStore ] r => TeamFeatures.FeaturePersistentConstraint db Public.LegalholdConfig => @@ -498,29 +510,31 @@ approveDevice :: Members '[ BrigAccess, ConversationStore, - Error InternalError, Error AuthenticationError, + Error InternalError, ErrorS 'AccessDenied, ErrorS ('ActionDenied 'RemoveConversationMember), - ErrorS 'NotATeamMember, + ErrorS 'LegalHoldCouldNotBlockConnections, ErrorS 'LegalHoldNotEnabled, - ErrorS 'UserLegalHoldNotPending, - ErrorS 'NoLegalHoldDeviceAllocated, ErrorS 'LegalHoldServiceNotRegistered, + ErrorS 'NoLegalHoldDeviceAllocated, + ErrorS 'NotATeamMember, ErrorS 'UserLegalHoldAlreadyEnabled, ErrorS 'UserLegalHoldIllegalOperation, - ErrorS 'LegalHoldCouldNotBlockConnections, - Input (Local ()), + ErrorS 'UserLegalHoldNotPending, ExternalAccess, FederatorAccess, GundeckAccess, + Input (Local ()), + Input Env, Input UTCTime, LegalHoldStore, ListItems LegacyPaging ConvId, MemberStore, + ProposalStore, + P.TinyLog, TeamFeatureStore db, - TeamStore, - P.TinyLog + TeamStore ] r => TeamFeatures.FeaturePersistentConstraint db Public.LegalholdConfig => @@ -577,24 +591,26 @@ disableForUser :: Members '[ BrigAccess, ConversationStore, - Error InternalError, Error AuthenticationError, + Error InternalError, ErrorS ('ActionDenied 'RemoveConversationMember), + ErrorS 'LegalHoldCouldNotBlockConnections, + ErrorS 'LegalHoldServiceNotRegistered, ErrorS 'NotATeamMember, ErrorS OperationDenied, - ErrorS 'LegalHoldServiceNotRegistered, ErrorS 'UserLegalHoldIllegalOperation, - ErrorS 'LegalHoldCouldNotBlockConnections, - Input (Local ()), ExternalAccess, FederatorAccess, GundeckAccess, + Input Env, + Input (Local ()), Input UTCTime, LegalHoldStore, ListItems LegacyPaging ConvId, MemberStore, - TeamStore, - P.TinyLog + ProposalStore, + P.TinyLog, + TeamStore ] r => Local UserId -> @@ -640,11 +656,13 @@ changeLegalholdStatus :: ExternalAccess, FederatorAccess, GundeckAccess, + Input Env, Input UTCTime, LegalHoldStore, ListItems LegacyPaging ConvId, MemberStore, TeamStore, + ProposalStore, P.TinyLog ] r => @@ -755,9 +773,12 @@ handleGroupConvPolicyConflicts :: ExternalAccess, FederatorAccess, GundeckAccess, + Input Env, Input UTCTime, ListItems LegacyPaging ConvId, MemberStore, + ProposalStore, + P.TinyLog, TeamStore ] r => diff --git a/services/galley/src/Galley/API/MLS/Message.hs b/services/galley/src/Galley/API/MLS/Message.hs index 2ace16c5d34..555dff1a118 100644 --- a/services/galley/src/Galley/API/MLS/Message.hs +++ b/services/galley/src/Galley/API/MLS/Message.hs @@ -20,15 +20,12 @@ module Galley.API.MLS.Message ( postMLSMessageFromLocalUser, postMLSMessageFromLocalUserV1, postMLSMessage, - mlsRemoveUser, MLSMessageStaticErrors, ) where import Control.Comonad -import Control.Lens (preview, to, view) -import Data.Bifunctor -import Data.Domain +import Control.Lens (preview, to) import Data.Id import Data.Json.Util import Data.List.NonEmpty (NonEmpty, nonEmpty) @@ -40,11 +37,11 @@ import Data.Time import Galley.API.Action import Galley.API.Error import Galley.API.MLS.KeyPackage -import Galley.API.Push +import Galley.API.MLS.Propagate +import Galley.API.MLS.Types import Galley.API.Util import Galley.Data.Conversation.Types hiding (Conversation) import qualified Galley.Data.Conversation.Types as Data -import Galley.Data.Services import Galley.Data.Types import Galley.Effects import Galley.Effects.BrigAccess @@ -56,14 +53,12 @@ import Galley.Env import Galley.Options import Galley.Types.Conversations.Members import Imports -import Network.Wai.Utilities.Server import Polysemy import Polysemy.Error import Polysemy.Input import Polysemy.Internal import Polysemy.Resource (Resource, bracket) import Polysemy.TinyLog -import qualified System.Logger.Class as Logger import Wire.API.Conversation hiding (Member) import Wire.API.Conversation.Protocol import Wire.API.Conversation.Role @@ -78,7 +73,6 @@ import Wire.API.MLS.CipherSuite import Wire.API.MLS.Commit import Wire.API.MLS.Credential import Wire.API.MLS.KeyPackage -import Wire.API.MLS.Keys import Wire.API.MLS.Message import Wire.API.MLS.Proposal import qualified Wire.API.MLS.Proposal as Proposal @@ -279,11 +273,15 @@ postMLSMessageToLocalConv qusr senderClient con smsg lcnv = case rmValue smsg of isMember' <- foldQualified loc (fmap isJust . getLocalMember (convId conv) . tUnqualified) (fmap isJust . getRemoteMember (convId conv)) qusr unless isMember' $ throwS @'ConvNotFound + -- construct client map + cm <- lookupMLSClients lcnv + let lconv = qualifyAs lcnv conv + -- validate message events <- case tag of SMLSPlainText -> case msgPayload msg of CommitMessage c -> - processCommit qusr senderClient con (qualifyAs lcnv conv) (msgEpoch msg) (msgSender msg) c + processCommit qusr senderClient con lconv cm (msgEpoch msg) (msgSender msg) c ApplicationMessage _ -> throwS @'MLSUnsupportedMessage ProposalMessage prop -> processProposal qusr conv msg prop $> mempty @@ -294,7 +292,7 @@ postMLSMessageToLocalConv qusr senderClient con smsg lcnv = case rmValue smsg of Left _ -> throwS @'MLSUnsupportedMessage -- forward message - propagateMessage lcnv qusr conv con (rmRaw smsg) + propagateMessage qusr lconv cm con (rmRaw smsg) pure events @@ -337,24 +335,27 @@ postMLSMessageToRemoteConv loc qusr _senderClient con smsg rcnv = do type HasProposalEffects r = ( Member BrigAccess r, Member ConversationStore r, + Member (Error InternalError) r, Member (Error MLSProposalFailure) r, Member (Error MLSProtocolError) r, - Member (ErrorS 'MLSKeyPackageRefNotFound) 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 (Input (Local ())) r + Member TinyLog r ) -type ClientMap = Map (Qualified UserId) (Set (ClientId, KeyPackageRef)) - data ProposalAction = ProposalAction { paAdd :: ClientMap, paRemove :: ClientMap @@ -394,11 +395,12 @@ processCommit :: Maybe ClientId -> Maybe ConnId -> Local Data.Conversation -> + ClientMap -> Epoch -> Sender 'MLSPlainText -> Commit -> Sem r [LocalConversationUpdate] -processCommit qusr senderClient con lconv epoch sender commit = do +processCommit qusr senderClient con lconv cm epoch sender commit = do self <- noteS @'ConvNotFound $ getConvMember lconv (tUnqualified lconv) qusr -- check epoch number @@ -419,23 +421,24 @@ processCommit qusr senderClient con lconv epoch sender commit = do then do -- this is a newly created conversation, and it should contain exactly one -- client (the creator) - case (sender, first (fmap fst . toList . lmMLSClients) self) of - (MemberSender currentRef, Left [creatorClient]) -> do - -- use update path as sender reference and if not existing fall back to sender - senderRef <- - maybe - (pure currentRef) - ( note (mlsProtocolError "Could not compute key package ref") - . kpRef' - . upLeaf - ) - $ cPath commit - -- register the creator client - updateKeyPackageMapping lconv qusr creatorClient Nothing senderRef + case (sender, self, cmAssocs cm) of + (MemberSender currentRef, 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 + senderRef <- + maybe + (pure currentRef) + ( note (mlsProtocolError "Could not compute key package ref") + . kpRef' + . upLeaf + ) + $ cPath commit + -- register the creator client + updateKeyPackageMapping lconv qusr creatorClient Nothing senderRef -- remote clients cannot send the first commit - (_, Right _) -> throwS @'MLSStaleMessage + (_, Right _, _) -> throwS @'MLSStaleMessage -- uninitialised conversations should contain exactly one client - (MemberSender _, _) -> + (MemberSender _, _, _) -> throw (InternalErrorWithDescription "Unexpected creator client set") -- the sender of the first commit must be a member _ -> throw (mlsProtocolError "Unexpected sender") @@ -458,7 +461,7 @@ processCommit qusr senderClient con lconv epoch sender commit = do -- process and execute proposals action <- foldMap (applyProposalRef (tUnqualified lconv) groupId epoch) (cProposals commit) - updates <- executeProposalAction qusr con lconv action + updates <- executeProposalAction qusr con lconv cm action -- update key package ref if necessary postponedKeyPackageRefUpdate @@ -490,8 +493,7 @@ updateKeyPackageMapping lconv qusr cid mOld new = do } -- remove old (client, key package) pair - let old = fromMaybe nullKeyPackageRef mOld - removeMLSClients lcnv qusr (Set.singleton (cid, old)) + removeMLSClients lcnv qusr (Set.singleton cid) -- add new (client, key package) pair addMLSClients lcnv qusr (Set.singleton (cid, new)) @@ -692,6 +694,7 @@ executeProposalAction :: forall r. ( Member BrigAccess r, Member ConversationStore r, + Member (Error InternalError) r, Member (ErrorS 'ConvNotFound) r, Member (Error FederationError) r, Member (ErrorS 'MLSClientMismatch) r, @@ -703,21 +706,24 @@ executeProposalAction :: Member ExternalAccess r, Member FederatorAccess r, Member GundeckAccess r, + Member (Input Env) r, Member (Input Opts) r, Member (Input UTCTime) r, Member LegalHoldStore r, Member MemberStore r, - Member TeamStore r + Member ProposalStore r, + Member TeamStore r, + Member TinyLog r ) => Qualified UserId -> Maybe ConnId -> Local Data.Conversation -> + ClientMap -> ProposalAction -> Sem r [LocalConversationUpdate] -executeProposalAction qusr con lconv action = do +executeProposalAction qusr con lconv cm action = do cs <- preview (to convProtocol . _ProtocolMLS . to cnvmlsCipherSuite) (tUnqualified lconv) & noteS @'ConvNotFound let ss = csSignatureScheme cs - cm = convClientMap lconv newUserClients = Map.assocs (paAdd action) removeUserClients = Map.assocs (paRemove action) @@ -768,7 +774,7 @@ executeProposalAction qusr con lconv action = do -- remove clients in the conversation state for_ removeUserClients $ \(qtarget, clients) -> do - removeMLSClients (fmap convId lconv) qtarget clients + removeMLSClients (fmap convId lconv) qtarget (Set.map fst clients) pure (addEvents <> removeEvents) where @@ -808,96 +814,34 @@ executeProposalAction qusr con lconv action = do con $ ConversationJoin users roleNameWireMember + existingLocalMembers :: Set (Qualified UserId) + existingLocalMembers = + Set.fromList . map (fmap lmId . qUntagged) . sequenceA $ + fmap convLocalMembers lconv + + existingRemoteMembers :: Set (Qualified UserId) + existingRemoteMembers = + Set.fromList . map (qUntagged . rmId) . convRemoteMembers . tUnqualified $ + lconv + + existingMembers :: Set (Qualified UserId) + existingMembers = existingLocalMembers <> existingRemoteMembers + removeMembers :: NonEmpty (Qualified UserId) -> Sem r [LocalConversationUpdate] removeMembers = - handleNoChanges - . handleMLSProposalFailures @ProposalErrors - . fmap pure - . updateLocalConversationUnchecked - @'ConversationRemoveMembersTag - lconv - qusr - con + foldMap + ( handleNoChanges + . handleMLSProposalFailures @ProposalErrors + . fmap pure + . updateLocalConversationUnchecked @'ConversationRemoveMembersTag lconv qusr con + ) + . nonEmpty + . filter (flip Set.member existingMembers) + . toList handleNoChanges :: Monoid a => Sem (Error NoChanges ': r) a -> Sem r a handleNoChanges = fmap fold . runError -convClientMap :: Local Data.Conversation -> ClientMap -convClientMap lconv = - mconcat - [ foldMap localMember . convLocalMembers, - foldMap remoteMember . convRemoteMembers - ] - (tUnqualified lconv) - where - localMember lm = Map.singleton (qUntagged (qualifyAs lconv (lmId lm))) (lmMLSClients lm) - remoteMember rm = Map.singleton (qUntagged (rmId rm)) (rmMLSClients rm) - --- | Propagate a message. -propagateMessage :: - ( Member ExternalAccess r, - Member FederatorAccess r, - Member GundeckAccess r, - Member (Input UTCTime) r, - Member TinyLog r - ) => - Local x -> - Qualified UserId -> - Data.Conversation -> - Maybe ConnId -> - ByteString -> - Sem r () -propagateMessage loc qusr conv con raw = do - -- FUTUREWORK: check the epoch - let lmems = Data.convLocalMembers conv - botMap = Map.fromList $ do - m <- lmems - b <- maybeToList $ newBotMember m - pure (lmId m, b) - mm = defMessageMetadata - now <- input @UTCTime - let lcnv = qualifyAs loc (Data.convId conv) - qcnv = qUntagged lcnv - e = Event qcnv qusr now $ EdMLSMessage raw - lclients = tUnqualified . clients <$> lmems - mkPush :: UserId -> ClientId -> MessagePush 'NormalMessage - mkPush u c = newMessagePush lcnv botMap con mm (u, c) e - runMessagePush loc (Just qcnv) $ - foldMap (uncurry mkPush) (cToList =<< lclients) - - -- send to remotes - traverse_ handleError <=< runFederatedConcurrentlyEither (map remoteMemberQualify (Data.convRemoteMembers conv)) $ - \(tUnqualified -> rs) -> - fedClient @'Galley @"on-mls-message-sent" $ - RemoteMLSMessage - { rmmTime = now, - rmmSender = qusr, - rmmMetadata = mm, - rmmConversation = tUnqualified lcnv, - rmmRecipients = rs >>= remoteMemberMLSClients, - rmmMessage = Base64ByteString raw - } - where - cToList :: (UserId, Set ClientId) -> [(UserId, ClientId)] - cToList (u, s) = (u,) <$> Set.toList s - - clients :: LocalMember -> Local (UserId, Set ClientId) - clients LocalMember {..} = qualifyAs loc (lmId, Set.map fst lmMLSClients) - - remoteMemberMLSClients :: RemoteMember -> [(UserId, ClientId)] - remoteMemberMLSClients rm = - map - (tUnqualified (rmId rm),) - (toList (Set.map fst (rmMLSClients rm))) - - handleError :: Member TinyLog r => Either (Remote [a], FederationError) x -> Sem r () - handleError (Right _) = pure () - handleError (Left (r, e)) = - warn $ - Logger.msg ("A message could not be delivered to a remote backend" :: ByteString) - . Logger.field "remote_domain" (domainText (tDomain r)) - . logErrorMsg (toWai e) - getMLSClients :: Members '[BrigAccess, FederatorAccess] r => Local x -> @@ -1011,39 +955,3 @@ withCommitLock gid epoch ttl action = ) (const $ releaseCommitLock gid epoch) (const action) - -mlsRemoveUser :: - ( Members - '[ Input UTCTime, - TinyLog, - ExternalAccess, - FederatorAccess, - GundeckAccess, - Error InternalError, - ProposalStore, - Input Env, - Input (Local ()) - ] - r - ) => - Data.Conversation -> - Qualified UserId -> - Sem r () -mlsRemoveUser c qusr = do - loc <- qualifyLocal () - case Data.convProtocol c of - ProtocolProteus -> pure () - ProtocolMLS meta -> do - keyPair <- mlsKeyPair_ed25519 <$> (inputs (view mlsKeys) <*> pure RemovalPurpose) - (secKey, pubKey) <- note (InternalErrorWithDescription "backend removal key missing") $ keyPair - for_ (getConvMemberMLSClients loc c qusr) $ \cpks -> - for_ cpks $ \(_client, kpref) -> do - let proposal = mkRemoveProposal kpref - msg = mkSignedMessage secKey pubKey (cnvmlsGroupId meta) (cnvmlsEpoch meta) (ProposalMessage proposal) - msgEncoded = encodeMLS' msg - storeProposal - (cnvmlsGroupId meta) - (cnvmlsEpoch meta) - (proposalRef (cnvmlsCipherSuite meta) proposal) - proposal - propagateMessage loc qusr c Nothing msgEncoded diff --git a/services/galley/src/Galley/API/MLS/Propagate.hs b/services/galley/src/Galley/API/MLS/Propagate.hs new file mode 100644 index 00000000000..6af4e1d61b9 --- /dev/null +++ b/services/galley/src/Galley/API/MLS/Propagate.hs @@ -0,0 +1,116 @@ +{-# LANGUAGE RecordWildCards #-} + +-- 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 Galley.API.MLS.Propagate where + +import Control.Comonad +import Data.Domain +import Data.Id +import Data.Json.Util +import qualified Data.Map as Map +import Data.Qualified +import Data.Time +import Galley.API.MLS.Types +import Galley.API.Push +import qualified Galley.Data.Conversation.Types as Data +import Galley.Data.Services +import Galley.Effects +import Galley.Effects.FederatorAccess +import Galley.Types.Conversations.Members +import Imports +import Network.Wai.Utilities.Server +import Polysemy +import Polysemy.Input +import Polysemy.TinyLog +import qualified System.Logger.Class as Logger +import Wire.API.Error +import Wire.API.Event.Conversation +import Wire.API.Federation.API +import Wire.API.Federation.API.Galley +import Wire.API.Federation.Error +import Wire.API.Message + +-- | Propagate a message. +propagateMessage :: + ( Member ExternalAccess r, + Member FederatorAccess r, + Member GundeckAccess r, + Member (Input UTCTime) r, + Member TinyLog r + ) => + Qualified UserId -> + Local Data.Conversation -> + ClientMap -> + Maybe ConnId -> + ByteString -> + Sem r () +propagateMessage qusr lconv cm con raw = do + -- FUTUREWORK: check the epoch + let lmems = Data.convLocalMembers . tUnqualified $ lconv + botMap = Map.fromList $ do + m <- lmems + b <- maybeToList $ newBotMember m + pure (lmId m, b) + mm = defMessageMetadata + now <- input @UTCTime + let lcnv = fmap Data.convId lconv + qcnv = qUntagged lcnv + e = Event qcnv qusr now $ EdMLSMessage raw + mkPush :: UserId -> ClientId -> MessagePush 'NormalMessage + mkPush u c = newMessagePush lcnv botMap con mm (u, c) e + runMessagePush lconv (Just qcnv) $ + foldMap (uncurry mkPush) (lmems >>= localMemberMLSClients lcnv) + + -- send to remotes + traverse_ handleError + <=< runFederatedConcurrentlyEither (map remoteMemberQualify (Data.convRemoteMembers . tUnqualified $ lconv)) + $ \(tUnqualified -> rs) -> + fedClient @'Galley @"on-mls-message-sent" $ + RemoteMLSMessage + { rmmTime = now, + rmmSender = qusr, + rmmMetadata = mm, + rmmConversation = tUnqualified lcnv, + rmmRecipients = rs >>= remoteMemberMLSClients, + rmmMessage = Base64ByteString raw + } + where + localMemberMLSClients :: Local x -> LocalMember -> [(UserId, ClientId)] + localMemberMLSClients loc lm = + let localUserQId = qUntagged (qualifyAs loc localUserId) + localUserId = lmId lm + in map + (\(c, _) -> (localUserId, c)) + (toList (Map.findWithDefault mempty localUserQId cm)) + + remoteMemberMLSClients :: RemoteMember -> [(UserId, ClientId)] + remoteMemberMLSClients rm = + let remoteUserQId = qUntagged (rmId rm) + remoteUserId = qUnqualified remoteUserQId + in map + (\(c, _) -> (remoteUserId, c)) + (toList (Map.findWithDefault mempty remoteUserQId cm)) + + handleError :: Member TinyLog r => Either (Remote [a], FederationError) x -> Sem r () + handleError (Right _) = pure () + handleError (Left (r, e)) = + warn $ + Logger.msg ("A message could not be delivered to a remote backend" :: ByteString) + . Logger.field "remote_domain" (domainText (tDomain r)) + . logErrorMsg (toWai e) diff --git a/services/galley/src/Galley/API/MLS/Removal.hs b/services/galley/src/Galley/API/MLS/Removal.hs new file mode 100644 index 00000000000..04b3c6f28f0 --- /dev/null +++ b/services/galley/src/Galley/API/MLS/Removal.hs @@ -0,0 +1,103 @@ +-- 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 Galley.API.MLS.Removal + ( removeUserWithClientMap, + removeUser, + ) +where + +import Control.Comonad +import Control.Lens (view) +import Data.Id +import qualified Data.Map as Map +import Data.Qualified +import Data.Time +import Galley.API.Error +import Galley.API.MLS.Propagate +import Galley.API.MLS.Types +import qualified Galley.Data.Conversation.Types as Data +import Galley.Effects +import Galley.Effects.MemberStore +import Galley.Effects.ProposalStore +import Galley.Env +import Imports +import Polysemy +import Polysemy.Error +import Polysemy.Input +import Polysemy.TinyLog +import Wire.API.Conversation.Protocol +import Wire.API.MLS.Credential +import Wire.API.MLS.Keys +import Wire.API.MLS.Message +import Wire.API.MLS.Proposal +import Wire.API.MLS.Serialisation + +removeUserWithClientMap :: + ( Members + '[ Input UTCTime, + TinyLog, + ExternalAccess, + FederatorAccess, + GundeckAccess, + Error InternalError, + ProposalStore, + Input Env + ] + r + ) => + Local Data.Conversation -> + ClientMap -> + Qualified UserId -> + Sem r () +removeUserWithClientMap lc cm qusr = do + case Data.convProtocol (tUnqualified lc) of + ProtocolProteus -> pure () + ProtocolMLS meta -> do + keyPair <- mlsKeyPair_ed25519 <$> (inputs (view mlsKeys) <*> pure RemovalPurpose) + (secKey, pubKey) <- note (InternalErrorWithDescription "backend removal key missing") $ keyPair + for_ (Map.findWithDefault mempty qusr cm) $ \(_client, kpref) -> do + let proposal = mkRemoveProposal kpref + msg = mkSignedMessage secKey pubKey (cnvmlsGroupId meta) (cnvmlsEpoch meta) (ProposalMessage proposal) + msgEncoded = encodeMLS' msg + storeProposal + (cnvmlsGroupId meta) + (cnvmlsEpoch meta) + (proposalRef (cnvmlsCipherSuite meta) proposal) + proposal + propagateMessage qusr lc cm Nothing msgEncoded + +removeUser :: + ( Members + '[ Error InternalError, + ExternalAccess, + FederatorAccess, + GundeckAccess, + Input Env, + Input UTCTime, + MemberStore, + ProposalStore, + TinyLog + ] + r + ) => + Local Data.Conversation -> + Qualified UserId -> + Sem r () +removeUser lc qusr = do + cm <- lookupMLSClients (fmap Data.convId lc) + removeUserWithClientMap lc cm qusr diff --git a/services/galley/src/Galley/API/MLS/Types.hs b/services/galley/src/Galley/API/MLS/Types.hs new file mode 100644 index 00000000000..f9b6cefb8e4 --- /dev/null +++ b/services/galley/src/Galley/API/MLS/Types.hs @@ -0,0 +1,43 @@ +-- 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 Galley.API.MLS.Types + ( ClientMap, + mkClientMap, + cmAssocs, + ) +where + +import Data.Domain +import Data.Id +import qualified Data.Map as Map +import Data.Qualified +import qualified Data.Set as Set +import Imports +import Wire.API.MLS.KeyPackage + +type ClientMap = Map (Qualified UserId) (Set (ClientId, KeyPackageRef)) + +mkClientMap :: [(Domain, UserId, ClientId, KeyPackageRef)] -> ClientMap +mkClientMap = foldr addEntry mempty + where + addEntry :: (Domain, UserId, ClientId, KeyPackageRef) -> ClientMap -> ClientMap + addEntry (dom, usr, c, kpr) = + Map.insertWith (<>) (Qualified usr dom) (Set.singleton (c, kpr)) + +cmAssocs :: ClientMap -> [(Qualified UserId, (ClientId, KeyPackageRef))] +cmAssocs cm = Map.assocs cm >>= traverse toList diff --git a/services/galley/src/Galley/API/Mapping.hs b/services/galley/src/Galley/API/Mapping.hs index 3481feb6f67..6e97ab8adc9 100644 --- a/services/galley/src/Galley/API/Mapping.hs +++ b/services/galley/src/Galley/API/Mapping.hs @@ -27,7 +27,6 @@ where import Data.Domain (Domain) import Data.Id (UserId, idToText) import Data.Qualified -import qualified Data.Set as Set import Galley.API.Error import qualified Galley.Data.Conversation as Data import Galley.Data.Types (convId) @@ -95,8 +94,7 @@ remoteConversationView uid status (qUntagged -> Qualified rconv rDomain) = { lmId = tUnqualified uid, lmService = Nothing, lmStatus = status, - lmConvRoleName = rcmSelfRole mems, - lmMLSClients = Set.empty + lmConvRoleName = rcmSelfRole mems } in Conversation (Qualified (rcnvId rconv) rDomain) diff --git a/services/galley/src/Galley/API/Teams.hs b/services/galley/src/Galley/API/Teams.hs index 73ff6660d31..bff05ef9102 100644 --- a/services/galley/src/Galley/API/Teams.hs +++ b/services/galley/src/Galley/API/Teams.hs @@ -1061,6 +1061,7 @@ deleteTeamConversation :: ExternalAccess, FederatorAccess, GundeckAccess, + Input Env, Input UTCTime, TeamStore ] diff --git a/services/galley/src/Galley/API/Teams/Features.hs b/services/galley/src/Galley/API/Teams/Features.hs index 260781cec44..57c93ebcaa9 100644 --- a/services/galley/src/Galley/API/Teams/Features.hs +++ b/services/galley/src/Galley/API/Teams/Features.hs @@ -52,10 +52,12 @@ import Galley.API.LegalHold (isLegalHoldEnabledForTeam) import qualified Galley.API.LegalHold as LegalHold import Galley.API.Teams (ensureNotTooLargeToActivateLegalHold) import Galley.API.Util (assertTeamExists, getTeamMembersForFanout, membersToRecipients, permissionCheck) +import Galley.App import Galley.Effects import Galley.Effects.BrigAccess (getAccountConferenceCallingConfigClient, updateSearchVisibilityInbound) import Galley.Effects.ConversationStore as ConversationStore import Galley.Effects.GundeckAccess +import Galley.Effects.ProposalStore import qualified Galley.Effects.SearchVisibilityStore as SearchVisibilityData import Galley.Effects.TeamFeatureStore import qualified Galley.Effects.TeamFeatureStore as TeamFeatures @@ -726,10 +728,12 @@ instance SetFeatureConfig db LegalholdConfig where FireAndForget, GundeckAccess, Input (Local ()), + Input Env, Input UTCTime, LegalHoldStore, ListItems LegacyPaging ConvId, MemberStore, + ProposalStore, TeamFeatureStore db, TeamStore, TeamMemberStore InternalPaging, diff --git a/services/galley/src/Galley/API/Update.hs b/services/galley/src/Galley/API/Update.hs index 4257c7b863a..27b2d6c8068 100644 --- a/services/galley/src/Galley/API/Update.hs +++ b/services/galley/src/Galley/API/Update.hs @@ -85,6 +85,7 @@ import Galley.API.Mapping import Galley.API.Message import qualified Galley.API.Query as Query import Galley.API.Util +import Galley.App import qualified Galley.Data.Conversation as Data import Galley.Data.Services as Data import Galley.Data.Types hiding (Conversation) @@ -96,6 +97,7 @@ import qualified Galley.Effects.ExternalAccess as E import qualified Galley.Effects.FederatorAccess as E import qualified Galley.Effects.GundeckAccess as E import qualified Galley.Effects.MemberStore as E +import Galley.Effects.ProposalStore import qualified Galley.Effects.ServiceStore as E import Galley.Effects.TeamFeatureStore (FeaturePersistentConstraint) import Galley.Effects.WaiRoutes @@ -265,20 +267,24 @@ type UpdateConversationAccessEffects = BrigAccess, CodeStore, ConversationStore, - ExternalAccess, - FederatorAccess, - FireAndForget, - GundeckAccess, - MemberStore, - TeamStore, - Error InvalidInput, Error FederationError, + Error InternalError, + Error InvalidInput, ErrorS ('ActionDenied 'ModifyConversationAccess), ErrorS ('ActionDenied 'RemoveConversationMember), ErrorS 'ConvNotFound, ErrorS 'InvalidOperation, ErrorS 'InvalidTargetAccess, - Input UTCTime + ExternalAccess, + FederatorAccess, + FireAndForget, + GundeckAccess, + Input Env, + Input UTCTime, + MemberStore, + ProposalStore, + TeamStore, + TinyLog ] updateConversationAccess :: @@ -310,18 +316,19 @@ updateConversationAccessUnqualified lusr con cnv update = updateConversationReceiptMode :: Members - '[ Error FederationError, + '[ BrigAccess, + ConversationStore, + Error FederationError, ErrorS ('ActionDenied 'ModifyConversationReceiptMode), ErrorS 'ConvNotFound, ErrorS 'InvalidOperation, ExternalAccess, FederatorAccess, GundeckAccess, - BrigAccess, - ConversationStore, - MemberStore, - Input UTCTime, Input (Local ()), + Input Env, + Input UTCTime, + MemberStore, TinyLog ] r => @@ -385,7 +392,8 @@ updateRemoteConversation rcnv lusr conn action = getUpdateResult $ do updateConversationReceiptModeUnqualified :: Members - '[ ConversationStore, + '[ BrigAccess, + ConversationStore, Error FederationError, ErrorS ('ActionDenied 'ModifyConversationReceiptMode), ErrorS 'ConvNotFound, @@ -393,10 +401,10 @@ updateConversationReceiptModeUnqualified :: ExternalAccess, FederatorAccess, GundeckAccess, - BrigAccess, - MemberStore, - Input UTCTime, Input (Local ()), + Input Env, + Input UTCTime, + MemberStore, TinyLog ] r => @@ -417,6 +425,7 @@ updateConversationMessageTimer :: ExternalAccess, FederatorAccess, GundeckAccess, + Input Env, Input UTCTime ] r => @@ -451,6 +460,7 @@ updateConversationMessageTimerUnqualified :: ExternalAccess, FederatorAccess, GundeckAccess, + Input Env, Input UTCTime ] r => @@ -473,6 +483,7 @@ deleteLocalConversation :: ExternalAccess, FederatorAccess, GundeckAccess, + Input Env, Input UTCTime, TeamStore ] @@ -765,6 +776,7 @@ joinConversation lusr zcon conv access = do <$> notifyConversationAction (sing @'ConversationJoinTag) (qUntagged lusr) + False (Just zcon) (qualifyAs lusr conv) (convBotsAndMembers conv <> extraTargets) @@ -775,6 +787,7 @@ addMembers :: '[ BrigAccess, ConversationStore, Error FederationError, + Error InternalError, ErrorS ('ActionDenied 'AddConversationMember), ErrorS ('ActionDenied 'LeaveConversation), ErrorS 'ConvAccessDenied, @@ -787,11 +800,14 @@ addMembers :: ExternalAccess, FederatorAccess, GundeckAccess, + Input Env, Input Opts, Input UTCTime, LegalHoldStore, MemberStore, - TeamStore + ProposalStore, + TeamStore, + TinyLog ] r => Local UserId -> @@ -810,6 +826,7 @@ addMembersUnqualifiedV2 :: '[ BrigAccess, ConversationStore, Error FederationError, + Error InternalError, ErrorS ('ActionDenied 'AddConversationMember), ErrorS ('ActionDenied 'LeaveConversation), ErrorS 'ConvAccessDenied, @@ -822,11 +839,14 @@ addMembersUnqualifiedV2 :: ExternalAccess, FederatorAccess, GundeckAccess, + Input Env, Input Opts, Input UTCTime, LegalHoldStore, MemberStore, - TeamStore + ProposalStore, + TeamStore, + TinyLog ] r => Local UserId -> @@ -845,6 +865,7 @@ addMembersUnqualified :: '[ BrigAccess, ConversationStore, Error FederationError, + Error InternalError, ErrorS ('ActionDenied 'AddConversationMember), ErrorS ('ActionDenied 'LeaveConversation), ErrorS 'ConvAccessDenied, @@ -857,11 +878,14 @@ addMembersUnqualified :: ExternalAccess, FederatorAccess, GundeckAccess, + Input Env, Input Opts, Input UTCTime, LegalHoldStore, MemberStore, - TeamStore + ProposalStore, + TeamStore, + TinyLog ] r => Local UserId -> @@ -952,6 +976,7 @@ updateOtherMemberLocalConv :: ExternalAccess, FederatorAccess, GundeckAccess, + Input Env, Input UTCTime, MemberStore ] @@ -979,6 +1004,7 @@ updateOtherMemberUnqualified :: ExternalAccess, FederatorAccess, GundeckAccess, + Input Env, Input UTCTime, MemberStore ] @@ -1006,6 +1032,7 @@ updateOtherMember :: ExternalAccess, FederatorAccess, GundeckAccess, + Input Env, Input UTCTime, MemberStore ] @@ -1033,14 +1060,18 @@ updateOtherMemberRemoteConv _ _ _ _ _ = throw FederationNotImplemented removeMemberUnqualified :: Members '[ ConversationStore, + Error InternalError, ErrorS ('ActionDenied 'RemoveConversationMember), ErrorS 'ConvNotFound, ErrorS 'InvalidOperation, ExternalAccess, FederatorAccess, GundeckAccess, + Input Env, Input UTCTime, - MemberStore + MemberStore, + ProposalStore, + TinyLog ] r => Local UserId -> @@ -1056,14 +1087,18 @@ removeMemberUnqualified lusr con cnv victim = do removeMemberQualified :: Members '[ ConversationStore, + Error InternalError, ErrorS ('ActionDenied 'RemoveConversationMember), ErrorS 'ConvNotFound, ErrorS 'InvalidOperation, ExternalAccess, FederatorAccess, GundeckAccess, + Input Env, Input UTCTime, - MemberStore + MemberStore, + ProposalStore, + TinyLog ] r => Local UserId -> @@ -1120,6 +1155,7 @@ removeMemberFromRemoteConv cnv lusr victim removeMemberFromLocalConv :: Members '[ ConversationStore, + Error InternalError, ErrorS ('ActionDenied 'LeaveConversation), ErrorS ('ActionDenied 'RemoveConversationMember), ErrorS 'ConvNotFound, @@ -1127,8 +1163,11 @@ removeMemberFromLocalConv :: ExternalAccess, FederatorAccess, GundeckAccess, + Input Env, Input UTCTime, - MemberStore + MemberStore, + ProposalStore, + TinyLog ] r => Local ConvId -> @@ -1141,8 +1180,7 @@ removeMemberFromLocalConv lcnv lusr con victim fmap (fmap lcuEvent . hush) . runError @NoChanges . updateLocalConversation @'ConversationLeaveTag lcnv (qUntagged lusr) con - . pure - $ victim + $ () | otherwise = fmap (fmap lcuEvent . hush) . runError @NoChanges @@ -1335,6 +1373,7 @@ updateConversationName :: ExternalAccess, FederatorAccess, GundeckAccess, + Input Env, Input UTCTime ] r => @@ -1361,6 +1400,7 @@ updateUnqualifiedConversationName :: ExternalAccess, FederatorAccess, GundeckAccess, + Input Env, Input UTCTime ] r => @@ -1383,6 +1423,7 @@ updateLocalConversationName :: ExternalAccess, FederatorAccess, GundeckAccess, + Input Env, Input UTCTime ] r => diff --git a/services/galley/src/Galley/API/Util.hs b/services/galley/src/Galley/API/Util.hs index 62908700dd1..34d890bb557 100644 --- a/services/galley/src/Galley/API/Util.hs +++ b/services/galley/src/Galley/API/Util.hs @@ -391,6 +391,7 @@ data BotsAndMembers = BotsAndMembers bmRemotes :: Set (Remote UserId), bmBots :: Set BotMember } + deriving (Show) bmQualifiedMembers :: Local x -> BotsAndMembers -> [Qualified UserId] bmQualifiedMembers loc bm = diff --git a/services/galley/src/Galley/Cassandra.hs b/services/galley/src/Galley/Cassandra.hs index 9e6c24f7fbf..6bc6719a2b2 100644 --- a/services/galley/src/Galley/Cassandra.hs +++ b/services/galley/src/Galley/Cassandra.hs @@ -20,4 +20,4 @@ module Galley.Cassandra (schemaVersion) where import Imports schemaVersion :: Int32 -schemaVersion = 72 +schemaVersion = 73 diff --git a/services/galley/src/Galley/Cassandra/Conversation/Members.hs b/services/galley/src/Galley/Cassandra/Conversation/Members.hs index 25e2a3cb3db..4d2c03fc9de 100644 --- a/services/galley/src/Galley/Cassandra/Conversation/Members.hs +++ b/services/galley/src/Galley/Cassandra/Conversation/Members.hs @@ -32,6 +32,7 @@ import qualified Data.List.Extra as List import Data.Monoid import Data.Qualified import qualified Data.Set as Set +import Galley.API.MLS.Types import Galley.Cassandra.Instances () import qualified Galley.Cassandra.Queries as Cql import Galley.Cassandra.Services @@ -74,7 +75,7 @@ addMembers conv (fmap toUserRole -> UserList lusers rusers) = do setConsistency LocalQuorum for_ chunk $ \(u, r) -> do -- User is local, too, so we add it to both the member and the user table - addPrepQuery Cql.insertMember (conv, u, Nothing, Nothing, r, Nothing) + addPrepQuery Cql.insertMember (conv, u, Nothing, Nothing, r) addPrepQuery Cql.insertUserConv (u, conv) for_ (List.chunksOf 32 rusers) $ \chunk -> do @@ -157,18 +158,16 @@ toMember :: Maybe Bool, Maybe Text, -- conversation role name - Maybe RoleName, - Maybe (Cassandra.Set (ClientId, KeyPackageRef)) + Maybe RoleName ) -> Maybe LocalMember -toMember (usr, srv, prv, Just 0, omus, omur, oar, oarr, hid, hidr, crn, cs) = +toMember (usr, srv, prv, Just 0, omus, omur, oar, oarr, hid, hidr, crn) = Just $ LocalMember { lmId = usr, lmService = newServiceRef <$> srv <*> prv, lmStatus = toMemberStatus (omus, omur, oar, oarr, hid, hidr), - lmConvRoleName = fromMaybe roleNameWireAdmin crn, - lmMLSClients = maybe Set.empty (Set.fromList . fromSet) cs + lmConvRoleName = fromMaybe roleNameWireAdmin crn } toMember _ = Nothing @@ -176,30 +175,27 @@ newRemoteMemberWithRole :: Remote (UserId, RoleName) -> RemoteMember newRemoteMemberWithRole ur@(qUntagged -> (Qualified (u, r) _)) = RemoteMember { rmId = qualifyAs ur u, - rmConvRoleName = r, - rmMLSClients = mempty + rmConvRoleName = r } lookupRemoteMember :: ConvId -> Domain -> UserId -> Client (Maybe RemoteMember) lookupRemoteMember conv domain usr = do mkMem <$$> retry x1 (query1 Cql.selectRemoteMember (params LocalQuorum (conv, domain, usr))) where - mkMem (role, clients) = + mkMem (Identity role) = RemoteMember { rmId = toRemoteUnsafe domain usr, - rmConvRoleName = role, - rmMLSClients = Set.fromList (fromSet clients) + rmConvRoleName = role } lookupRemoteMembers :: ConvId -> Client [RemoteMember] lookupRemoteMembers conv = do fmap (map mkMem) . retry x1 $ query Cql.selectRemoteMembers (params LocalQuorum (Identity conv)) where - mkMem (domain, usr, role, clients) = + mkMem (domain, usr, role) = RemoteMember { rmId = toRemoteUnsafe domain usr, - rmConvRoleName = role, - rmMLSClients = Set.fromList (fromSet clients) + rmConvRoleName = role } member :: @@ -346,58 +342,25 @@ removeLocalMembersFromRemoteConv (qUntagged -> Qualified conv convDomain) victim for_ victims $ \u -> addPrepQuery Cql.deleteUserRemoteConv (u, convDomain, conv) addMLSClients :: Local ConvId -> Qualified UserId -> Set.Set (ClientId, KeyPackageRef) -> Client () -addMLSClients lcnv = - foldQualified - lcnv - (addLocalMLSClients (tUnqualified lcnv)) - (addRemoteMLSClients (tUnqualified lcnv)) - -addRemoteMLSClients :: ConvId -> Remote UserId -> Set.Set (ClientId, KeyPackageRef) -> Client () -addRemoteMLSClients cid ruid cs = - retry x5 $ - write - Cql.addRemoteMLSClients - ( params - LocalQuorum - (Cassandra.Set (toList cs), cid, tDomain ruid, tUnqualified ruid) - ) - -addLocalMLSClients :: ConvId -> Local UserId -> Set.Set (ClientId, KeyPackageRef) -> Client () -addLocalMLSClients cid lusr cs = - retry x5 $ - write - Cql.addLocalMLSClients - ( params - LocalQuorum - (Cassandra.Set (toList cs), cid, tUnqualified lusr) - ) +addMLSClients lcnv (Qualified usr domain) cs = retry x5 . batch $ do + setType BatchLogged + setConsistency LocalQuorum + for_ cs $ \(c, kpr) -> + addPrepQuery Cql.addMLSClient (tUnqualified lcnv, domain, usr, c, kpr) -removeMLSClients :: Local ConvId -> Qualified UserId -> Set.Set (ClientId, KeyPackageRef) -> Client () -removeMLSClients lcnv = - foldQualified - lcnv - (removeLocalMLSClients (tUnqualified lcnv)) - (removeRemoteMLSClients (tUnqualified lcnv)) - -removeLocalMLSClients :: ConvId -> Local UserId -> Set.Set (ClientId, KeyPackageRef) -> Client () -removeLocalMLSClients cid lusr cs = - retry x5 $ - write - Cql.removeLocalMLSClients - ( params - LocalQuorum - (Cassandra.Set (toList cs), cid, tUnqualified lusr) - ) +removeMLSClients :: Local ConvId -> Qualified UserId -> Set.Set ClientId -> Client () +removeMLSClients lcnv (Qualified usr domain) cs = retry x5 . batch $ do + setType BatchLogged + setConsistency LocalQuorum + for_ cs $ \c -> + addPrepQuery Cql.removeMLSClient (tUnqualified lcnv, domain, usr, c) -removeRemoteMLSClients :: ConvId -> Remote UserId -> Set.Set (ClientId, KeyPackageRef) -> Client () -removeRemoteMLSClients cid rusr cs = - retry x5 $ - write - Cql.removeRemoteMLSClients - ( params - LocalQuorum - (Cassandra.Set (toList cs), cid, tDomain rusr, tUnqualified rusr) - ) +lookupMLSClients :: Local ConvId -> Client ClientMap +lookupMLSClients lcnv = + mkClientMap + <$> retry + x5 + (query Cql.lookupMLSClients (params LocalQuorum (Identity (tUnqualified lcnv)))) interpretMemberStoreToCassandra :: Members '[Embed IO, Input ClientState] r => @@ -423,3 +386,4 @@ interpretMemberStoreToCassandra = interpret $ \case removeLocalMembersFromRemoteConv rcnv uids AddMLSClients lcnv quid cs -> embedClient $ addMLSClients lcnv quid cs RemoveMLSClients lcnv quid cs -> embedClient $ removeMLSClients lcnv quid cs + LookupMLSClients lcnv -> embedClient $ lookupMLSClients lcnv diff --git a/services/galley/src/Galley/Cassandra/Queries.hs b/services/galley/src/Galley/Cassandra/Queries.hs index c46fb5afdb3..07b45150fc7 100644 --- a/services/galley/src/Galley/Cassandra/Queries.hs +++ b/services/galley/src/Galley/Cassandra/Queries.hs @@ -272,14 +272,14 @@ lookupGroupId = "SELECT conv_id, domain from group_id_conv_id where group_id = ? type MemberStatus = Int32 -selectMember :: PrepQuery R (ConvId, UserId) (UserId, Maybe ServiceId, Maybe ProviderId, Maybe MemberStatus, Maybe MutedStatus, Maybe Text, Maybe Bool, Maybe Text, Maybe Bool, Maybe Text, Maybe RoleName, Maybe (C.Set (ClientId, KeyPackageRef))) -selectMember = "select user, service, provider, status, otr_muted_status, otr_muted_ref, otr_archived, otr_archived_ref, hidden, hidden_ref, conversation_role, mls_clients_keypackages from member where conv = ? and user = ?" +selectMember :: PrepQuery R (ConvId, UserId) (UserId, Maybe ServiceId, Maybe ProviderId, Maybe MemberStatus, Maybe MutedStatus, Maybe Text, Maybe Bool, Maybe Text, Maybe Bool, Maybe Text, Maybe RoleName) +selectMember = "select user, service, provider, status, otr_muted_status, otr_muted_ref, otr_archived, otr_archived_ref, hidden, hidden_ref, conversation_role from member where conv = ? and user = ?" -selectMembers :: PrepQuery R (Identity ConvId) (UserId, Maybe ServiceId, Maybe ProviderId, Maybe MemberStatus, Maybe MutedStatus, Maybe Text, Maybe Bool, Maybe Text, Maybe Bool, Maybe Text, Maybe RoleName, Maybe (C.Set (ClientId, KeyPackageRef))) -selectMembers = "select user, service, provider, status, otr_muted_status, otr_muted_ref, otr_archived, otr_archived_ref, hidden, hidden_ref, conversation_role, mls_clients_keypackages from member where conv = ?" +selectMembers :: PrepQuery R (Identity ConvId) (UserId, Maybe ServiceId, Maybe ProviderId, Maybe MemberStatus, Maybe MutedStatus, Maybe Text, Maybe Bool, Maybe Text, Maybe Bool, Maybe Text, Maybe RoleName) +selectMembers = "select user, service, provider, status, otr_muted_status, otr_muted_ref, otr_archived, otr_archived_ref, hidden, hidden_ref, conversation_role from member where conv = ?" -insertMember :: PrepQuery W (ConvId, UserId, Maybe ServiceId, Maybe ProviderId, RoleName, Maybe (C.Set (ClientId, KeyPackageRef))) () -insertMember = "insert into member (conv, user, service, provider, status, conversation_role, mls_clients_keypackages) values (?, ?, ?, ?, 0, ?, ?)" +insertMember :: PrepQuery W (ConvId, UserId, Maybe ServiceId, Maybe ProviderId, RoleName) () +insertMember = "insert into member (conv, user, service, provider, status, conversation_role) values (?, ?, ?, ?, 0, ?)" removeMember :: PrepQuery W (ConvId, UserId) () removeMember = "delete from member where conv = ? and user = ?" @@ -308,11 +308,11 @@ insertRemoteMember = "insert into member_remote_user (conv, user_remote_domain, removeRemoteMember :: PrepQuery W (ConvId, Domain, UserId) () removeRemoteMember = "delete from member_remote_user where conv = ? and user_remote_domain = ? and user_remote_id = ?" -selectRemoteMember :: PrepQuery R (ConvId, Domain, UserId) (RoleName, C.Set (ClientId, KeyPackageRef)) -selectRemoteMember = "select conversation_role, mls_clients_keypackages from member_remote_user where conv = ? and user_remote_domain = ? and user_remote_id = ?" +selectRemoteMember :: PrepQuery R (ConvId, Domain, UserId) (Identity RoleName) +selectRemoteMember = "select conversation_role from member_remote_user where conv = ? and user_remote_domain = ? and user_remote_id = ?" -selectRemoteMembers :: PrepQuery R (Identity ConvId) (Domain, UserId, RoleName, C.Set (ClientId, KeyPackageRef)) -selectRemoteMembers = "select user_remote_domain, user_remote_id, conversation_role, mls_clients_keypackages from member_remote_user where conv = ?" +selectRemoteMembers :: PrepQuery R (Identity ConvId) (Domain, UserId, RoleName) +selectRemoteMembers = "select user_remote_domain, user_remote_id, conversation_role from member_remote_user where conv = ?" updateRemoteMemberConvRoleName :: PrepQuery W (RoleName, ConvId, Domain, UserId) () updateRemoteMemberConvRoleName = "update member_remote_user set conversation_role = ? where conv = ? and user_remote_domain = ? and user_remote_id = ?" @@ -368,17 +368,14 @@ rmMemberClient c = -- MLS Clients -------------------------------------------------------------- -addLocalMLSClients :: PrepQuery W (C.Set (ClientId, KeyPackageRef), ConvId, UserId) () -addLocalMLSClients = "update member set mls_clients_keypackages = mls_clients_keypackages + ? where conv = ? and user = ?" +addMLSClient :: PrepQuery W (ConvId, Domain, UserId, ClientId, KeyPackageRef) () +addMLSClient = "insert into member_client (conv, user_domain, user, client, key_package_ref) values (?, ?, ?, ?, ?)" -addRemoteMLSClients :: PrepQuery W (C.Set (ClientId, KeyPackageRef), ConvId, Domain, UserId) () -addRemoteMLSClients = "update member_remote_user set mls_clients_keypackages = mls_clients_keypackages + ? where conv = ? and user_remote_domain = ? and user_remote_id = ?" +removeMLSClient :: PrepQuery W (ConvId, Domain, UserId, ClientId) () +removeMLSClient = "delete from member_client where conv = ? and user_domain = ? and user = ? and client = ?" -removeLocalMLSClients :: PrepQuery W (C.Set (ClientId, KeyPackageRef), ConvId, UserId) () -removeLocalMLSClients = "update member set mls_clients_keypackages = mls_clients_keypackages - ? where conv = ? and user = ?" - -removeRemoteMLSClients :: PrepQuery W (C.Set (ClientId, KeyPackageRef), ConvId, Domain, UserId) () -removeRemoteMLSClients = "update member_remote_user set mls_clients_keypackages = mls_clients_keypackages - ? where conv = ? and user_remote_domain = ? and user_remote_id = ?" +lookupMLSClients :: PrepQuery R (Identity ConvId) (Domain, UserId, ClientId, KeyPackageRef) +lookupMLSClients = "select user_domain, user, client, key_package_ref from member_client where conv = ?" acquireCommitLock :: PrepQuery W (GroupId, Epoch, Int32) Row acquireCommitLock = "insert into mls_commit_locks (group_id, epoch) values (?, ?) if not exists using ttl ?" diff --git a/services/galley/src/Galley/Data/Conversation/Types.hs b/services/galley/src/Galley/Data/Conversation/Types.hs index 5f7add65558..b93bd616c57 100644 --- a/services/galley/src/Galley/Data/Conversation/Types.hs +++ b/services/galley/src/Galley/Data/Conversation/Types.hs @@ -18,14 +18,12 @@ module Galley.Data.Conversation.Types where import Data.Id -import Data.Qualified import Galley.Types.Conversations.Members import Galley.Types.UserList import Imports import Wire.API.Conversation hiding (Conversation) import Wire.API.Conversation.Protocol import Wire.API.Conversation.Role -import Wire.API.MLS.KeyPackage -- | Internal conversation type, corresponding directly to database schema. -- Should never be sent to users (and therefore doesn't have 'FromJSON' or @@ -45,11 +43,3 @@ data NewConversation = NewConversation ncUsers :: UserList (UserId, RoleName), ncProtocol :: ProtocolTag } - -getConvMemberMLSClients :: Local () -> Conversation -> Qualified UserId -> Maybe (Set (ClientId, KeyPackageRef)) -getConvMemberMLSClients loc conv qusr = - foldQualified - loc - (\lusr -> lmMLSClients <$> find ((==) (tUnqualified lusr) . lmId) (convLocalMembers conv)) - (\rusr -> rmMLSClients <$> find ((==) rusr . rmId) (convRemoteMembers conv)) - qusr diff --git a/services/galley/src/Galley/Effects/MemberStore.hs b/services/galley/src/Galley/Effects/MemberStore.hs index d9d8c779f87..1bd42b55338 100644 --- a/services/galley/src/Galley/Effects/MemberStore.hs +++ b/services/galley/src/Galley/Effects/MemberStore.hs @@ -40,6 +40,7 @@ module Galley.Effects.MemberStore setOtherMember, addMLSClients, removeMLSClients, + lookupMLSClients, -- * Delete members deleteMembers, @@ -74,7 +75,10 @@ data MemberStore m a where DeleteMembers :: ConvId -> UserList UserId -> MemberStore m () DeleteMembersInRemoteConversation :: Remote ConvId -> [UserId] -> MemberStore m () AddMLSClients :: Local ConvId -> Qualified UserId -> Set (ClientId, KeyPackageRef) -> MemberStore m () - RemoveMLSClients :: Local ConvId -> Qualified UserId -> Set (ClientId, KeyPackageRef) -> MemberStore m () + RemoveMLSClients :: Local ConvId -> Qualified UserId -> Set ClientId -> MemberStore m () + LookupMLSClients :: + Local ConvId -> + MemberStore m (Map (Qualified UserId) (Set (ClientId, KeyPackageRef))) makeSem ''MemberStore diff --git a/services/galley/test/integration/API.hs b/services/galley/test/integration/API.hs index 7bccfdaefa3..7ecd707a9f0 100644 --- a/services/galley/test/integration/API.hs +++ b/services/galley/test/integration/API.hs @@ -1452,7 +1452,7 @@ postConvertTeamConv = do dave <- view Teams.userId <$> addUserToTeam alice tid assertQueue "team member (dave) join" $ tUpdate 3 [alice] refreshIndex - eve <- randomUser + (eve, qeve) <- randomUserTuple connectUsers alice (singleton eve) let acc = Just $ Set.fromList [InviteAccess, CodeAccess] -- creating a team-only conversation containing eve should fail @@ -1481,9 +1481,11 @@ postConvertTeamConv = do WS.assertMatchN (5 # Second) [wsA, wsB, wsE, wsM] $ wsAssertConvAccessUpdate qconv qalice teamAccess -- non-team members get kicked out - void . liftIO $ - WS.assertMatchN (5 # Second) [wsA, wsB, wsE, wsM] $ - wsAssertMemberLeave qconv qalice $ (`Qualified` localDomain) <$> [eve, mallory] + liftIO $ do + WS.assertMatchN_ (5 # Second) [wsA, wsB, wsE, wsM] $ + wsAssertMemberLeave qconv qeve (pure qeve) + WS.assertMatchN_ (5 # Second) [wsA, wsB, wsE, wsM] $ + wsAssertMemberLeave qconv qmallory (pure qmallory) -- joining (for mallory) is no longer possible postJoinCodeConv mallory j !!! const 403 === statusCode -- team members (dave) can still join @@ -1535,16 +1537,41 @@ testAccessUpdateGuestRemoved = do -- note that removing users happens asynchronously, so this check should -- happen while the mock federator is still available WS.assertMatchN_ (5 # Second) [wsA, wsB, wsC] $ - wsAssertMembersLeave (cnvQualifiedId conv) alice [charlie, dee] + wsAssertMembersLeave (cnvQualifiedId conv) charlie [charlie] + WS.assertMatchN_ (5 # Second) [wsA, wsB, wsC] $ + wsAssertMembersLeave (cnvQualifiedId conv) dee [dee] -- dee's remote receives a notification - liftIO . assertBool "remote users are not notified" . isJust . flip find reqs $ \freq -> - (frComponent freq == Galley) - && ( frRPC freq == "on-conversation-updated" - ) - && ( fmap F.cuAction (eitherDecode (frBody freq)) - == Right (SomeConversationAction (sing @'ConversationLeaveTag) (charlie :| [dee])) - ) + liftIO $ + sortOn + (fmap fst) + ( map + ( \fr -> do + cu <- eitherDecode (frBody fr) + pure (F.cuOrigUserId cu, F.cuAction cu) + ) + ( filter + ( \fr -> + frComponent fr == Galley + && frRPC fr == "on-conversation-updated" + ) + reqs + ) + ) + @?= sortOn + (fmap fst) + [ Right (charlie, SomeConversationAction (sing @'ConversationLeaveTag) ()), + Right (dee, SomeConversationAction (sing @'ConversationLeaveTag) ()), + Right + ( alice, + SomeConversationAction + (sing @'ConversationAccessDataTag) + ConversationAccessData + { cupAccess = mempty, + cupAccessRoles = Set.fromList [TeamMemberAccessRole] + } + ) + ] -- only alice and bob remain conv2 <- @@ -2412,7 +2439,7 @@ testGetQualifiedRemoteConv = do remoteConvId = Qualified convId remoteDomain bobAsOtherMember = OtherMember bobQ Nothing roleNameWireAdmin aliceAsLocal = - LocalMember aliceId defMemberStatus Nothing roleNameWireAdmin Set.empty + LocalMember aliceId defMemberStatus Nothing roleNameWireAdmin aliceAsOtherMember = localMemberToOther (qDomain aliceQ) aliceAsLocal aliceAsSelfMember = localMemberToSelf loc aliceAsLocal @@ -3375,7 +3402,6 @@ putRemoteConvMemberOk update = do defMemberStatus Nothing roleNameWireAdmin - Set.empty let mockConversation = mkProteusConv (qUnqualified qconv) @@ -3743,25 +3769,29 @@ removeUser = do bConvUpdates <- mapM (assertRight . eitherDecode . frBody) bConvUpdateRPCs bConvUpdatesA2 <- assertOne $ filter (\cu -> cuConvId cu == convA2) bConvUpdates - cuAction bConvUpdatesA2 @?= SomeConversationAction (sing @'ConversationLeaveTag) (pure alexDel) + cuOrigUserId bConvUpdatesA2 @?= alexDel + cuAction bConvUpdatesA2 @?= SomeConversationAction (sing @'ConversationLeaveTag) () cuAlreadyPresentUsers bConvUpdatesA2 @?= [qUnqualified berta] bConvUpdatesA4 <- assertOne $ filter (\cu -> cuConvId cu == convA4) bConvUpdates - cuAction bConvUpdatesA4 @?= SomeConversationAction (sing @'ConversationLeaveTag) (pure alexDel) + cuOrigUserId bConvUpdatesA4 @?= alexDel + cuAction bConvUpdatesA4 @?= SomeConversationAction (sing @'ConversationLeaveTag) () cuAlreadyPresentUsers bConvUpdatesA4 @?= [qUnqualified bart] liftIO $ do cConvUpdateRPC <- assertOne $ filter (matchFedRequest cDomain "on-conversation-updated") fedRequests Right convUpdate <- pure . eitherDecode . frBody $ cConvUpdateRPC cuConvId convUpdate @?= convA4 - cuAction convUpdate @?= SomeConversationAction (sing @'ConversationLeaveTag) (pure alexDel) + cuOrigUserId convUpdate @?= alexDel + cuAction convUpdate @?= SomeConversationAction (sing @'ConversationLeaveTag) () cuAlreadyPresentUsers convUpdate @?= [qUnqualified carl] liftIO $ do dConvUpdateRPC <- assertOne $ filter (matchFedRequest dDomain "on-conversation-updated") fedRequests Right convUpdate <- pure . eitherDecode . frBody $ dConvUpdateRPC cuConvId convUpdate @?= convA2 - cuAction convUpdate @?= SomeConversationAction (sing @'ConversationLeaveTag) (pure alexDel) + cuOrigUserId convUpdate @?= alexDel + cuAction convUpdate @?= SomeConversationAction (sing @'ConversationLeaveTag) () cuAlreadyPresentUsers convUpdate @?= [qUnqualified dwight] -- Check memberships diff --git a/services/galley/test/integration/API/Federation.hs b/services/galley/test/integration/API/Federation.hs index 2f632a4c2ec..436a283970c 100644 --- a/services/galley/test/integration/API/Federation.hs +++ b/services/galley/test/integration/API/Federation.hs @@ -331,11 +331,11 @@ removeLocalUser = do cuRemove = FedGalley.ConversationUpdate { FedGalley.cuTime = addUTCTime (secondsToNominalDiffTime 5) now, - FedGalley.cuOrigUserId = qBob, + FedGalley.cuOrigUserId = qAlice, FedGalley.cuConvId = conv, FedGalley.cuAlreadyPresentUsers = [alice], FedGalley.cuAction = - SomeConversationAction (sing @'ConversationLeaveTag) (pure qAlice) + SomeConversationAction (sing @'ConversationLeaveTag) () } connectWithRemoteUser alice qBob @@ -347,7 +347,7 @@ removeLocalUser = do void . WS.assertMatch (3 # Second) ws $ wsAssertMemberJoinWithRole qconv qBob [qAlice] roleNameWireMember void . WS.assertMatch (3 # Second) ws $ - wsAssertMembersLeave qconv qBob [qAlice] + wsAssertMembersLeave qconv qAlice [qAlice] afterRemoval <- listRemoteConvs remoteDomain alice liftIO $ do afterAddition @?= [qconv] @@ -399,7 +399,7 @@ removeRemoteUser = do FedGalley.cuConvId = conv, FedGalley.cuAlreadyPresentUsers = [alice, charlie, dee], FedGalley.cuAction = - SomeConversationAction (sing @'ConversationLeaveTag) (pure user) + SomeConversationAction (sing @'ConversationRemoveMembersTag) (pure user) } WS.bracketRN c [alice, charlie, dee, flo] $ \[wsA, wsC, wsD, wsF] -> do @@ -682,7 +682,7 @@ leaveConversationSuccess = do liftIO $ fedRequestsForDomain remoteDomain1 Galley federatedRequests @?= [] let [remote2GalleyFederatedRequest] = fedRequestsForDomain remoteDomain2 Galley federatedRequests - assertLeaveUpdate remote2GalleyFederatedRequest qconvId qChad [qUnqualified qEve] qChad + assertLeaveUpdate remote2GalleyFederatedRequest qconvId qChad [qUnqualified qEve] leaveConversationNonExistent :: TestM () leaveConversationNonExistent = do @@ -1031,7 +1031,7 @@ onUserDeleted = do FedGalley.cuOrigUserId cDomainRPCReq @?= qUntagged bob FedGalley.cuConvId cDomainRPCReq @?= qUnqualified groupConvId FedGalley.cuAlreadyPresentUsers cDomainRPCReq @?= [qUnqualified carl] - FedGalley.cuAction cDomainRPCReq @?= SomeConversationAction (sing @'ConversationLeaveTag) (pure $ qUntagged bob) + FedGalley.cuAction cDomainRPCReq @?= SomeConversationAction (sing @'ConversationLeaveTag) () -- | We test only ReceiptMode update here -- diff --git a/services/galley/test/integration/API/MLS.hs b/services/galley/test/integration/API/MLS.hs index 20ffd37612c..9e89c583158 100644 --- a/services/galley/test/integration/API/MLS.hs +++ b/services/galley/test/integration/API/MLS.hs @@ -150,7 +150,16 @@ tests s = testGroup "Backend-side External Remove Proposals" [ test s "local conversation, local user deleted" testBackendRemoveProposalLocalConvLocalUser, - test s "local conversation, remote user deleted" testBackendRemoveProposalLocalConvRemoteUser + test s "local conversation, remote user deleted" testBackendRemoveProposalLocalConvRemoteUser, + test + s + "local conversation, creator leaving" + testBackendRemoveProposalLocalConvLocalLeaverCreator, + test + s + "local conversation, local committer leaving" + testBackendRemoveProposalLocalConvLocalLeaverCommitter, + test s "local conversation, remote user leaving" testBackendRemoveProposalLocalConvRemoteLeaver ], testGroup "Protocol mismatch" @@ -1386,13 +1395,9 @@ testBackendRemoveProposalLocalConvLocalUser = do [alice1, bob1, bob2] <- traverse createMLSClient [alice, bob, bob] traverse_ uploadNewKeyPackage [bob1, bob2] (_, qcnv) <- setupMLSGroup alice1 - void $ createAddCommit alice1 [bob] >>= sendAndConsumeCommit - bobClients <- - fmap (filter (\(cid, _) -> cidQualifiedUser cid == bob)) $ - currentGroupFile alice1 >>= liftIO . readGroupState - + bobClients <- getClientsFromGroupState alice1 bob mlsBracket [alice1] $ \wss -> void $ do liftTest $ deleteUser (qUnqualified bob) !!! const 200 === statusCode -- remove bob clients from the test state @@ -1434,10 +1439,7 @@ testBackendRemoveProposalLocalConvRemoteUser = do mlsBracket [alice1] $ \[wsA] -> do void $ sendAndConsumeCommit commit - bobClients <- - fmap (filter (\(cid, _) -> cidQualifiedUser cid == bob)) $ - currentGroupFile alice1 >>= liftIO . readGroupState - + bobClients <- getClientsFromGroupState alice1 bob fedGalleyClient <- view tsFedGalleyClient void $ runFedClient @@ -1503,3 +1505,128 @@ sendRemoteMLSWelcomeKPNotFound = do liftIO $ do -- check that no event is received WS.assertNoEvent (1 # Second) [wsB] + +testBackendRemoveProposalLocalConvLocalLeaverCreator :: TestM () +testBackendRemoveProposalLocalConvLocalLeaverCreator = do + [alice, bob] <- createAndConnectUsers (replicate 2 Nothing) + + runMLSTest $ do + [alice1, bob1, bob2] <- traverse createMLSClient [alice, bob, bob] + traverse_ uploadNewKeyPackage [bob1, bob2] + (_, qcnv) <- setupMLSGroup alice1 + void $ createAddCommit alice1 [bob] >>= sendAndConsumeCommit + + aliceClients <- getClientsFromGroupState alice1 alice + mlsBracket [alice1, bob1, bob2] $ \wss -> void $ do + liftTest $ + deleteMemberQualified (qUnqualified alice) alice qcnv + !!! const 200 === statusCode + -- remove alice's client from the test state + State.modify $ \mls -> + mls + { mlsMembers = Set.difference (mlsMembers mls) (Set.fromList [alice1]) + } + + for_ aliceClients $ \(_, ref) -> do + -- only bob's clients should receive the external proposals + msgs <- WS.assertMatchN (5 # Second) (drop 1 wss) $ \n -> + wsAssertBackendRemoveProposal alice qcnv ref n + traverse_ (uncurry consumeMessage1) (zip [bob1, bob2] msgs) + + -- but everyone should receive leave events + WS.assertMatchN_ (5 # WS.Second) wss $ + wsAssertMembersLeave qcnv alice [alice] + + -- check that no more events are sent, so in particular alice does not + -- receive any MLS messages + WS.assertNoEvent (1 # WS.Second) wss + + -- bob commits the external proposals + events <- createPendingProposalCommit bob1 >>= sendAndConsumeCommit + liftIO $ events @?= [] + +testBackendRemoveProposalLocalConvLocalLeaverCommitter :: TestM () +testBackendRemoveProposalLocalConvLocalLeaverCommitter = do + [alice, bob, charlie] <- createAndConnectUsers (replicate 3 Nothing) + + runMLSTest $ do + [alice1, bob1, bob2, charlie1] <- traverse createMLSClient [alice, bob, bob, charlie] + traverse_ uploadNewKeyPackage [bob1, bob2, charlie1] + (_, qcnv) <- setupMLSGroup alice1 + void $ createAddCommit alice1 [bob] >>= sendAndConsumeCommit + + -- promote bob + putOtherMemberQualified (ciUser alice1) bob (OtherMemberUpdate (Just roleNameWireAdmin)) qcnv + !!! const 200 === statusCode + + void $ createAddCommit bob1 [charlie] >>= sendAndConsumeCommit + + bobClients <- getClientsFromGroupState alice1 bob + mlsBracket [alice1, charlie1, bob1, bob2] $ \wss -> void $ do + liftTest $ + deleteMemberQualified (qUnqualified bob) bob qcnv + !!! const 200 === statusCode + -- remove bob clients from the test state + State.modify $ \mls -> + mls + { mlsMembers = Set.difference (mlsMembers mls) (Set.fromList [bob1, bob2]) + } + + for_ bobClients $ \(_, ref) -> do + -- only alice and charlie should receive the external proposals + msgs <- WS.assertMatchN (5 # Second) (take 2 wss) $ \n -> + wsAssertBackendRemoveProposal bob qcnv ref n + traverse_ (uncurry consumeMessage1) (zip [alice1, charlie1] msgs) + + -- but everyone should receive leave events + WS.assertMatchN_ (5 # WS.Second) wss $ + wsAssertMembersLeave qcnv bob [bob] + + -- check that no more events are sent, so in particular bob does not + -- receive any MLS messages + WS.assertNoEvent (1 # WS.Second) wss + + -- alice commits the external proposals + events <- createPendingProposalCommit alice1 >>= sendAndConsumeCommit + liftIO $ events @?= [] + +testBackendRemoveProposalLocalConvRemoteLeaver :: TestM () +testBackendRemoveProposalLocalConvRemoteLeaver = do + [alice, bob] <- createAndConnectUsers [Nothing, Just "bob.example.com"] + + runMLSTest $ do + [alice1, bob1, bob2] <- traverse createMLSClient [alice, bob, bob] + (_, qcnv) <- setupMLSGroup alice1 + commit <- createAddCommit alice1 [bob] + + let mock req = case frRPC req of + "on-conversation-updated" -> pure (Aeson.encode ()) + "on-new-remote-conversation" -> pure (Aeson.encode EmptyResponse) + "on-mls-message-sent" -> pure (Aeson.encode EmptyResponse) + "get-mls-clients" -> + pure + . Aeson.encode + . Set.fromList + . map (flip ClientInfo True . ciClient) + $ [bob1, bob2] + ms -> assertFailure ("unmocked endpoint called: " <> cs ms) + + bobClients <- getClientsFromGroupState alice1 bob + void . withTempMockFederator' mock $ do + mlsBracket [alice1] $ \[wsA] -> void $ do + void $ sendAndConsumeCommit commit + fedGalleyClient <- view tsFedGalleyClient + void $ + runFedClient + @"update-conversation" + fedGalleyClient + (qDomain bob) + ConversationUpdateRequest + { curUser = qUnqualified bob, + curConvId = qUnqualified qcnv, + curAction = SomeConversationAction SConversationLeaveTag () + } + + for_ bobClients $ \(_, ref) -> + WS.assertMatch_ (5 # WS.Second) wsA $ + wsAssertBackendRemoveProposal bob qcnv ref diff --git a/services/galley/test/integration/API/MLS/Util.hs b/services/galley/test/integration/API/MLS/Util.hs index f4425091cf1..731ff774f55 100644 --- a/services/galley/test/integration/API/MLS/Util.hs +++ b/services/galley/test/integration/API/MLS/Util.hs @@ -765,6 +765,15 @@ readGroupState fp = do kpr <- (unhexM . T.encodeUtf8 =<<) $ leafNode ^.. key "key_package_ref" . _String pure (identity, KeyPackageRef kpr) +getClientsFromGroupState :: + ClientIdentity -> + Qualified UserId -> + MLSTest [(ClientIdentity, KeyPackageRef)] +getClientsFromGroupState cid u = do + groupFile <- currentGroupFile cid + groupState <- liftIO $ readGroupState groupFile + pure $ filter (\(cid', _) -> cidQualifiedUser cid' == u) groupState + clientKeyPair :: ClientIdentity -> MLSTest (ByteString, ByteString) clientKeyPair cid = do bd <- State.gets mlsBaseDir diff --git a/services/galley/test/integration/API/Util.hs b/services/galley/test/integration/API/Util.hs index bd42d1b55a2..d486dee0f72 100644 --- a/services/galley/test/integration/API/Util.hs +++ b/services/galley/test/integration/API/Util.hs @@ -54,7 +54,7 @@ import qualified Data.Map.Strict as Map import Data.Misc import qualified Data.ProtoLens as Protolens import Data.ProtocolBuffers (encodeMessage) -import Data.Qualified +import Data.Qualified hiding (isLocal) import Data.Range import Data.Serialize (runPut) import qualified Data.Set as Set @@ -1716,15 +1716,15 @@ assertRemoveUpdate req qconvId remover alreadyPresentUsers victim = liftIO $ do sort (cuAlreadyPresentUsers cu) @?= sort alreadyPresentUsers cuAction cu @?= SomeConversationAction (sing @'ConversationRemoveMembersTag) (pure victim) -assertLeaveUpdate :: (MonadIO m, HasCallStack) => FederatedRequest -> Qualified ConvId -> Qualified UserId -> [UserId] -> Qualified UserId -> m () -assertLeaveUpdate req qconvId remover alreadyPresentUsers victim = liftIO $ do +assertLeaveUpdate :: (MonadIO m, HasCallStack) => FederatedRequest -> Qualified ConvId -> Qualified UserId -> [UserId] -> m () +assertLeaveUpdate req qconvId remover alreadyPresentUsers = liftIO $ do frRPC req @?= "on-conversation-updated" frOriginDomain req @?= qDomain qconvId let Just cu = decode (frBody req) cuOrigUserId cu @?= remover cuConvId cu @?= qUnqualified qconvId sort (cuAlreadyPresentUsers cu) @?= sort alreadyPresentUsers - cuAction cu @?= SomeConversationAction (sing @'ConversationLeaveTag) (pure victim) + cuAction cu @?= SomeConversationAction (sing @'ConversationLeaveTag) () ------------------------------------------------------------------------------- -- Helpers diff --git a/services/galley/test/unit/Test/Galley/Mapping.hs b/services/galley/test/unit/Test/Galley/Mapping.hs index da4ca972fc9..7ad96398c13 100644 --- a/services/galley/test/unit/Test/Galley/Mapping.hs +++ b/services/galley/test/unit/Test/Galley/Mapping.hs @@ -107,10 +107,9 @@ genLocalMember = <*> pure defMemberStatus <*> pure Nothing <*> arbitrary - <*> arbitrary genRemoteMember :: Gen RemoteMember -genRemoteMember = RemoteMember <$> arbitrary <*> pure roleNameWireMember <*> arbitrary +genRemoteMember = RemoteMember <$> arbitrary <*> pure roleNameWireMember genConversation :: Gen Data.Conversation genConversation = From b46398ff286a9b1358af79638822dbc9c8f7f562 Mon Sep 17 00:00:00 2001 From: Igor Ranieri Elland <54423+elland@users.noreply.github.com> Date: Thu, 15 Sep 2022 11:42:48 +0200 Subject: [PATCH 25/58] Added hlint pr check makefile cmd. (#2690) --- Makefile | 9 +++++++++ tools/hlint.sh | 3 +++ 2 files changed, 12 insertions(+) diff --git a/Makefile b/Makefile index 2121a2332d8..a60238394fe 100644 --- a/Makefile +++ b/Makefile @@ -121,6 +121,15 @@ ghcid: hlint-check-all: ./tools/hlint.sh -f all -m check +.PHONY: hlint-check-pr +hlint-check-pr: + ./tools/hlint.sh -f pr -m check + +.PHONY: hlint-inplace-pr +hlint-inplace-pr: + ./tools/hlint.sh -f pr -m inplace + + .PHONY: hlint-inplace-all hlint-inplace-all: ./tools/hlint.sh -f all -m inplace diff --git a/tools/hlint.sh b/tools/hlint.sh index 84e30d837a9..e8e31d88c1f 100755 --- a/tools/hlint.sh +++ b/tools/hlint.sh @@ -12,6 +12,9 @@ while getopts ':f:m:' opt if [ "$f" = "all" ]; then files=$(find libs/ services/ -not -path "*/test/*" -name "*.hs") echo "WARNING: not linting tests." + elif [ "$f" = "pr" ]; then + files=$(git diff --name-only origin/develop... | grep \.hs\$) + echo "WARNING: linting test files with changes. This may lead to some hard to fix warnings/errors, it is safe to ignore those!" elif [ "$f" = "changeset" ]; then files=$(git diff --name-only HEAD | grep \.hs\$) echo "WARNING: linting test files with changes. This may lead to some hard to fix warnings/errors, it is safe to ignore those!" From 8493c5cf4379e06ac2e5ac2f9e973cc47ad7eb83 Mon Sep 17 00:00:00 2001 From: Stefan Matting Date: Thu, 15 Sep 2022 15:42:15 +0200 Subject: [PATCH 26/58] Deleting clients creates MLS remove proposals (#2674) Co-authored by stefanwire --- .../mls-remote-proposals-on-client-deletion | 1 + .../src/Wire/API/Federation/API/Galley.hs | 10 ++ services/galley/galley.cabal | 1 + services/galley/src/Galley/API/Clients.hs | 94 +++++++++++++- services/galley/src/Galley/API/Federation.hs | 32 ++++- services/galley/src/Galley/API/MLS/Removal.hs | 62 ++++++++- services/galley/test/integration/API/MLS.hs | 122 ++++++++++++------ 7 files changed, 274 insertions(+), 48 deletions(-) create mode 100644 changelog.d/2-features/mls-remote-proposals-on-client-deletion diff --git a/changelog.d/2-features/mls-remote-proposals-on-client-deletion b/changelog.d/2-features/mls-remote-proposals-on-client-deletion new file mode 100644 index 00000000000..0b0df17eae3 --- /dev/null +++ b/changelog.d/2-features/mls-remote-proposals-on-client-deletion @@ -0,0 +1 @@ +Deleting clients creates MLS remove proposals diff --git a/libs/wire-api-federation/src/Wire/API/Federation/API/Galley.hs b/libs/wire-api-federation/src/Wire/API/Federation/API/Galley.hs index b654911291b..121f182f68b 100644 --- a/libs/wire-api-federation/src/Wire/API/Federation/API/Galley.hs +++ b/libs/wire-api-federation/src/Wire/API/Federation/API/Galley.hs @@ -69,6 +69,16 @@ type GalleyApi = :<|> FedEndpoint "mls-welcome" MLSWelcomeRequest EmptyResponse :<|> FedEndpoint "on-mls-message-sent" RemoteMLSMessage EmptyResponse :<|> FedEndpoint "send-mls-message" MessageSendRequest MLSMessageResponse + :<|> FedEndpoint "on-client-removed" ClientRemovedRequest EmptyResponse + +data ClientRemovedRequest = ClientRemovedRequest + { crrUser :: UserId, + crrClient :: ClientId, + crrConvs :: [ConvId] + } + deriving stock (Eq, Show, Generic) + deriving (Arbitrary) via (GenericUniform ClientRemovedRequest) + deriving (FromJSON, ToJSON) via (CustomEncoded ClientRemovedRequest) data GetConversationsRequest = GetConversationsRequest { gcrUserId :: UserId, diff --git a/services/galley/galley.cabal b/services/galley/galley.cabal index be5ca7e8437..4c18ff8a8e4 100644 --- a/services/galley/galley.cabal +++ b/services/galley/galley.cabal @@ -206,6 +206,7 @@ library , extra >=1.3 , galley-types >=0.65.0 , gundeck-types >=1.35.2 + , hex , HsOpenSSL >=0.11 , HsOpenSSL-x509-system >=0.1 , http-client >=0.4 diff --git a/services/galley/src/Galley/API/Clients.hs b/services/galley/src/Galley/API/Clients.hs index c4d4859a38d..95bf989479f 100644 --- a/services/galley/src/Galley/API/Clients.hs +++ b/services/galley/src/Galley/API/Clients.hs @@ -22,16 +22,41 @@ module Galley.API.Clients ) where +import Data.Either.Combinators (whenLeft) +import Data.Hex import Data.Id +import Data.Proxy +import Data.Qualified +import Data.Range +import Data.String.Conversions +import qualified Data.Text as T +import Data.Time +import Galley.API.Error +import Galley.API.MLS.Removal +import qualified Galley.API.Query as Query +import Galley.API.Util import Galley.Effects import qualified Galley.Effects.BrigAccess as E import qualified Galley.Effects.ClientStore as E +import Galley.Effects.ConversationStore (getConversation) +import Galley.Effects.FederatorAccess +import Galley.Effects.ProposalStore (ProposalStore) +import Galley.Env import Galley.Types.Clients (clientIds, fromUserClients) import Imports import Network.Wai -import Network.Wai.Predicate hiding (setStatus) -import Network.Wai.Utilities +import Network.Wai.Predicate hiding (Error, setStatus) +import Network.Wai.Utilities hiding (Error) import Polysemy +import Polysemy.Error +import Polysemy.Input +import qualified Polysemy.TinyLog as P +import qualified System.Logger as Log +import Wire.API.Conversation hiding (Member) +import Wire.API.Federation.API +import Wire.API.Federation.API.Galley (ClientRemovedRequest (ClientRemovedRequest)) +import Wire.API.Routes.MultiTablePaging +import Wire.Sem.Paging.Cassandra (CassandraPaging) getClientsH :: Members '[BrigAccess, ClientStore] r => @@ -61,9 +86,68 @@ addClientH (usr ::: clt) = do pure empty rmClientH :: - Member ClientStore r => + forall p1 r. + ( p1 ~ CassandraPaging, + Members + '[ ClientStore, + ConversationStore, + ExternalAccess, + FederatorAccess, + GundeckAccess, + Input Env, + Input (Local ()), + Input UTCTime, + ListItems p1 ConvId, + ListItems p1 (Remote ConvId), + MemberStore, + Error InternalError, + ProposalStore, + P.TinyLog + ] + r + ) => UserId ::: ClientId -> Sem r Response -rmClientH (usr ::: clt) = do - E.deleteClient usr clt +rmClientH (usr ::: cid) = do + lusr <- qualifyLocal usr + let nRange1000 = toRange (Proxy @1000) :: Range 1 1000 Int32 + firstConvIds <- Query.conversationIdsPageFrom lusr (GetPaginatedConversationIds Nothing nRange1000) + goConvs nRange1000 firstConvIds lusr + + E.deleteClient usr cid pure empty + where + rpc = fedClient @'Galley @"on-client-removed" + goConvs :: Range 1 1000 Int32 -> ConvIdsPage -> Local UserId -> Sem r () + goConvs range page lusr = do + let (localConvs, remoteConvs) = partitionQualified lusr (mtpResults page) + for_ localConvs $ \convId -> do + mConv <- getConversation convId + for_ mConv $ \conv -> do + lconv <- qualifyLocal conv + removeClient lconv (qUntagged lusr) cid + traverse_ removeRemoteMLSClients (rangedChunks remoteConvs) + when (mtpHasMore page) $ do + let nextState = mtpPagingState page + nextQuery = GetPaginatedConversationIds (Just nextState) range + newCids <- Query.conversationIdsPageFrom lusr nextQuery + goConvs range newCids lusr + + removeRemoteMLSClients :: Range 1 1000 [Remote ConvId] -> Sem r () + removeRemoteMLSClients convIds = do + for_ (bucketRemote (fromRange convIds)) $ \remoteConvs -> do + runFederatedEither remoteConvs (rpc (ClientRemovedRequest usr cid (tUnqualified remoteConvs))) + >>= logAndIgnoreError "Error in onConversationUpdated call" usr + + logAndIgnoreError message usr' res = + whenLeft res $ \federationError -> + P.err + ( Log.msg + ( "Federation error while notifying remote backends of a client deletion (Galley). " + <> message + <> " " + <> show federationError + ) + . Log.field "user" (show usr') + . Log.field "client" (hex . T.unpack . client $ cid) + ) diff --git a/services/galley/src/Galley/API/Federation.hs b/services/galley/src/Galley/API/Federation.hs index fc70eafd359..acb3cb4a4c1 100644 --- a/services/galley/src/Galley/API/Federation.hs +++ b/services/galley/src/Galley/API/Federation.hs @@ -50,6 +50,7 @@ import Galley.App import qualified Galley.Data.Conversation as Data import Galley.Effects import qualified Galley.Effects.BrigAccess as E +import Galley.Effects.ConversationStore (getConversation) import qualified Galley.Effects.ConversationStore as E import qualified Galley.Effects.FireAndForget as E import qualified Galley.Effects.MemberStore as E @@ -79,7 +80,7 @@ import Wire.API.Error.Galley import Wire.API.Event.Conversation import Wire.API.Federation.API import Wire.API.Federation.API.Common (EmptyResponse (..)) -import Wire.API.Federation.API.Galley (ConversationUpdateResponse) +import Wire.API.Federation.API.Galley (ClientRemovedRequest, ConversationUpdateResponse) import qualified Wire.API.Federation.API.Galley as F import Wire.API.Federation.Error import Wire.API.MLS.Credential @@ -108,6 +109,35 @@ federationSitemap = :<|> Named @"mls-welcome" mlsSendWelcome :<|> Named @"on-mls-message-sent" onMLSMessageSent :<|> Named @"send-mls-message" sendMLSMessage + :<|> Named @"on-client-removed" onClientRemoved + +onClientRemoved :: + ( Members + '[ ConversationStore, + Error InternalError, + ExternalAccess, + FederatorAccess, + GundeckAccess, + Input Env, + Input (Local ()), + Input UTCTime, + MemberStore, + ProposalStore, + TinyLog + ] + r + ) => + Domain -> + ClientRemovedRequest -> + Sem r EmptyResponse +onClientRemoved domain req = do + let qusr = Qualified (F.crrUser req) domain + for_ (F.crrConvs req) $ \convId -> do + mConv <- getConversation convId + for mConv $ \conv -> do + lconv <- qualifyLocal conv + removeClient lconv qusr (F.crrClient req) + pure EmptyResponse onConversationCreated :: Members diff --git a/services/galley/src/Galley/API/MLS/Removal.hs b/services/galley/src/Galley/API/MLS/Removal.hs index 04b3c6f28f0..43c6375a1ca 100644 --- a/services/galley/src/Galley/API/MLS/Removal.hs +++ b/services/galley/src/Galley/API/MLS/Removal.hs @@ -16,7 +16,9 @@ -- with this program. If not, see . module Galley.API.MLS.Removal - ( removeUserWithClientMap, + ( removeClientsWithClientMap, + removeClient, + removeUserWithClientMap, removeUser, ) where @@ -26,6 +28,7 @@ import Control.Lens (view) import Data.Id import qualified Data.Map as Map import Data.Qualified +import qualified Data.Set as Set import Data.Time import Galley.API.Error import Galley.API.MLS.Propagate @@ -42,12 +45,14 @@ import Polysemy.Input import Polysemy.TinyLog import Wire.API.Conversation.Protocol import Wire.API.MLS.Credential +import Wire.API.MLS.KeyPackage import Wire.API.MLS.Keys import Wire.API.MLS.Message import Wire.API.MLS.Proposal import Wire.API.MLS.Serialisation -removeUserWithClientMap :: +-- | Send remove proposals for a set of clients to clients in the ClientMap. +removeClientsWithClientMap :: ( Members '[ Input UTCTime, TinyLog, @@ -61,16 +66,17 @@ removeUserWithClientMap :: r ) => Local Data.Conversation -> + Set (ClientId, KeyPackageRef) -> ClientMap -> Qualified UserId -> Sem r () -removeUserWithClientMap lc cm qusr = do +removeClientsWithClientMap lc cs cm qusr = do case Data.convProtocol (tUnqualified lc) of ProtocolProteus -> pure () ProtocolMLS meta -> do keyPair <- mlsKeyPair_ed25519 <$> (inputs (view mlsKeys) <*> pure RemovalPurpose) (secKey, pubKey) <- note (InternalErrorWithDescription "backend removal key missing") $ keyPair - for_ (Map.findWithDefault mempty qusr cm) $ \(_client, kpref) -> do + for_ cs $ \(_client, kpref) -> do let proposal = mkRemoveProposal kpref msg = mkSignedMessage secKey pubKey (cnvmlsGroupId meta) (cnvmlsEpoch meta) (ProposalMessage proposal) msgEncoded = encodeMLS' msg @@ -81,6 +87,54 @@ removeUserWithClientMap lc cm qusr = do proposal propagateMessage qusr lc cm Nothing msgEncoded +-- | Send remove proposals for a single client of a user to the local conversation. +removeClient :: + ( Members + '[ Error InternalError, + ExternalAccess, + FederatorAccess, + GundeckAccess, + Input Env, + Input UTCTime, + MemberStore, + ProposalStore, + TinyLog + ] + r + ) => + Local Data.Conversation -> + Qualified UserId -> + ClientId -> + Sem r () +removeClient lc qusr cid = do + cm <- lookupMLSClients (fmap Data.convId lc) + let cidAndKP = Set.filter ((==) cid . fst) $ Map.findWithDefault mempty qusr cm + removeClientsWithClientMap lc cidAndKP cm qusr + +-- | Send remove proposals for all clients of the user to clients in the ClientMap. +-- +-- All clients of the user have to be contained in the ClientMap. +removeUserWithClientMap :: + ( Members + '[ Input UTCTime, + TinyLog, + ExternalAccess, + FederatorAccess, + GundeckAccess, + Error InternalError, + ProposalStore, + Input Env + ] + r + ) => + Local Data.Conversation -> + ClientMap -> + Qualified UserId -> + Sem r () +removeUserWithClientMap lc cm qusr = + removeClientsWithClientMap lc (Map.findWithDefault mempty qusr cm) cm qusr + +-- | Send remove proposals for all clients of the user to the local conversation. removeUser :: ( Members '[ Error InternalError, diff --git a/services/galley/test/integration/API/MLS.hs b/services/galley/test/integration/API/MLS.hs index 9e89c583158..df76b0691f6 100644 --- a/services/galley/test/integration/API/MLS.hs +++ b/services/galley/test/integration/API/MLS.hs @@ -83,10 +83,7 @@ tests s = test s "local welcome (client with no public key)" testWelcomeNoKey, test s "remote welcome" testRemoteWelcome, test s "post a remote MLS welcome message" sendRemoteMLSWelcome, - test - s - "post a remote MLS welcome message (key package ref not found)" - sendRemoteMLSWelcomeKPNotFound + test s "post a remote MLS welcome message (key package ref not found)" sendRemoteMLSWelcomeKPNotFound ], testGroup "Creation" @@ -107,8 +104,7 @@ tests s = test s "post commit that references a unknown proposal" testUnknownProposalRefCommit, test s "post commit that is not referencing all proposals" testCommitNotReferencingAllProposals, test s "admin removes user from a conversation" testAdminRemovesUserFromConv, - test s "admin removes user from a conversation but doesn't list all clients" testRemoveClientsIncomplete, - test s "anyone removes a non-existing client from a group" testRemoveDeletedClient + test s "admin removes user from a conversation but doesn't list all clients" testRemoveClientsIncomplete ], testGroup "Application Message" @@ -151,15 +147,11 @@ tests s = "Backend-side External Remove Proposals" [ test s "local conversation, local user deleted" testBackendRemoveProposalLocalConvLocalUser, test s "local conversation, remote user deleted" testBackendRemoveProposalLocalConvRemoteUser, - test - s - "local conversation, creator leaving" - testBackendRemoveProposalLocalConvLocalLeaverCreator, - test - s - "local conversation, local committer leaving" - testBackendRemoveProposalLocalConvLocalLeaverCommitter, - test s "local conversation, remote user leaving" testBackendRemoveProposalLocalConvRemoteLeaver + test s "local conversation, creator leaving" testBackendRemoveProposalLocalConvLocalLeaverCreator, + test s "local conversation, local committer leaving" testBackendRemoveProposalLocalConvLocalLeaverCommitter, + test s "local conversation, remote user leaving" testBackendRemoveProposalLocalConvRemoteLeaver, + test s "local conversation, local client deleted" testBackendRemoveProposalLocalConvLocalClient, + test s "local conversation, remote client deleted" testBackendRemoveProposalLocalConvRemoteClient ], testGroup "Protocol mismatch" @@ -714,29 +706,6 @@ testRemoveClientsIncomplete = do >= sendAndConsumeCommit - - liftTest $ do - cannon <- view tsCannon - WS.bracketR cannon (qUnqualified bob) $ \ws -> do - deleteClient (qUnqualified bob) (ciClient bob2) (Just defPassword) - !!! statusCode === const 200 - -- check that the corresponding event is received - liftIO $ - WS.assertMatch_ (5 # WS.Second) ws $ - wsAssertClientRemoved (ciClient bob2) - - events <- createRemoveCommit charlie1 [bob2] >>= sendAndConsumeCommit - liftIO $ assertEqual "a non-admin received conversation events when removing a client" [] events - testRemoteAppMessage :: TestM () testRemoteAppMessage = do users@[alice, bob] <- createAndConnectUsers [Nothing, Just "bob.example.com"] @@ -750,6 +719,7 @@ testRemoteAppMessage = do "on-conversation-updated" -> pure (Aeson.encode ()) "on-new-remote-conversation" -> pure (Aeson.encode EmptyResponse) "on-mls-message-sent" -> pure (Aeson.encode EmptyResponse) + "mls-welcome" -> pure (Aeson.encode EmptyResponse) "get-mls-clients" -> pure . Aeson.encode @@ -1427,6 +1397,7 @@ testBackendRemoveProposalLocalConvRemoteUser = do "on-conversation-updated" -> pure (Aeson.encode ()) "on-new-remote-conversation" -> pure (Aeson.encode EmptyResponse) "on-mls-message-sent" -> pure (Aeson.encode EmptyResponse) + "mls-welcome" -> pure (Aeson.encode EmptyResponse) "get-mls-clients" -> pure . Aeson.encode @@ -1603,6 +1574,7 @@ testBackendRemoveProposalLocalConvRemoteLeaver = do "on-conversation-updated" -> pure (Aeson.encode ()) "on-new-remote-conversation" -> pure (Aeson.encode EmptyResponse) "on-mls-message-sent" -> pure (Aeson.encode EmptyResponse) + "mls-welcome" -> pure (Aeson.encode EmptyResponse) "get-mls-clients" -> pure . Aeson.encode @@ -1630,3 +1602,77 @@ testBackendRemoveProposalLocalConvRemoteLeaver = do for_ bobClients $ \(_, ref) -> WS.assertMatch_ (5 # WS.Second) wsA $ wsAssertBackendRemoveProposal bob qcnv ref + +testBackendRemoveProposalLocalConvLocalClient :: TestM () +testBackendRemoveProposalLocalConvLocalClient = do + [alice, bob] <- createAndConnectUsers [Nothing, Nothing] + + runMLSTest $ do + [alice1, bob1, bob2] <- traverse createMLSClient [alice, bob, bob] + traverse_ uploadNewKeyPackage [bob1, bob2] + (_, qcnv) <- setupMLSGroup alice1 + void $ createAddCommit alice1 [bob] >>= sendAndConsumeCommit + Just (_, kpBob1) <- find (\(ci, _) -> ci == bob1) <$> getClientsFromGroupState alice1 bob + + mlsBracket [alice1, bob1] $ \[wsA, wsB] -> do + liftTest $ + deleteClient (ciUser bob1) (ciClient bob1) (Just defPassword) + !!! statusCode === const 200 + + State.modify $ \mls -> + mls + { mlsMembers = Set.difference (mlsMembers mls) (Set.fromList [bob1]) + } + + WS.assertMatch_ (5 # WS.Second) wsB $ + wsAssertClientRemoved (ciClient bob1) + + msg <- WS.assertMatch (5 # WS.Second) wsA $ \notification -> do + wsAssertBackendRemoveProposal bob qcnv kpBob1 notification + + for_ [alice1, bob2] $ + flip consumeMessage1 msg + + mp <- createPendingProposalCommit alice1 + events <- sendAndConsumeCommit mp + liftIO $ events @?= [] + +testBackendRemoveProposalLocalConvRemoteClient :: TestM () +testBackendRemoveProposalLocalConvRemoteClient = do + [alice, bob] <- createAndConnectUsers [Nothing, Just "faraway.example.com"] + + runMLSTest $ do + [alice1, bob1] <- traverse createMLSClient [alice, bob] + (_, qcnv) <- setupMLSGroup alice1 + commit <- createAddCommit alice1 [bob] + + let mock req = case frRPC req of + "on-conversation-updated" -> pure (Aeson.encode ()) + "on-new-remote-conversation" -> pure (Aeson.encode EmptyResponse) + "mls-welcome" -> pure (Aeson.encode EmptyResponse) + "on-mls-message-sent" -> pure (Aeson.encode EmptyResponse) + "get-mls-clients" -> + pure + . Aeson.encode + . Set.fromList + . map (flip ClientInfo True) + $ [ciClient bob1] + ms -> assertFailure ("unmocked endpoint called: " <> cs ms) + + [(_, bob1KP)] <- getClientsFromGroupState alice1 bob + + void . withTempMockFederator' mock $ do + mlsBracket [alice1] $ \[wsA] -> void $ do + void $ sendAndConsumeCommit commit + + fedGalleyClient <- view tsFedGalleyClient + void $ + runFedClient + @"on-client-removed" + fedGalleyClient + (ciDomain bob1) + (ClientRemovedRequest (ciUser bob1) (ciClient bob1) [qUnqualified qcnv]) + + WS.assertMatch_ (5 # WS.Second) wsA $ + \notification -> + void $ wsAssertBackendRemoveProposal bob qcnv bob1KP notification From 3e848c37c539f58d9d1953561c1a5b23929704fa Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Fri, 16 Sep 2022 10:51:56 +0200 Subject: [PATCH 27/58] [SQSERVICE- 1509] 2FA in the context of sso (#2693) --- changelog.d/3-bug-fixes/pr-2693 | 1 + .../how-to/install/team-feature-settings.md | 2 ++ services/brig/src/Brig/User/Auth.hs | 3 ++- services/brig/test/integration/API/Team.hs | 21 ++++++++++++++++++- 4 files changed, 25 insertions(+), 2 deletions(-) create mode 100644 changelog.d/3-bug-fixes/pr-2693 diff --git a/changelog.d/3-bug-fixes/pr-2693 b/changelog.d/3-bug-fixes/pr-2693 new file mode 100644 index 00000000000..ccba02e2888 --- /dev/null +++ b/changelog.d/3-bug-fixes/pr-2693 @@ -0,0 +1 @@ +The 2nd factor password challenge team feature is disabled for SSO users diff --git a/docs/src/how-to/install/team-feature-settings.md b/docs/src/how-to/install/team-feature-settings.md index 7db2c074293..21733829f91 100644 --- a/docs/src/how-to/install/team-feature-settings.md +++ b/docs/src/how-to/install/team-feature-settings.md @@ -31,6 +31,8 @@ galley: Note that the lock status is required but has no effect, as it is currently not supported for team admins to enable or disable `sndFactorPasswordChallenge`. We recommend to set the lock status to `locked`. +Currently the 2nd factor password challenge if enabled has no effect for SSO users. + ## Rate limiting of code generation requests The default delay between code generation requests is 5 minutes. This setting can be overridden in the Helm charts: diff --git a/services/brig/src/Brig/User/Auth.hs b/services/brig/src/Brig/User/Auth.hs index d85d7786706..712da1d6b0e 100644 --- a/services/brig/src/Brig/User/Auth.hs +++ b/services/brig/src/Brig/User/Auth.hs @@ -194,7 +194,8 @@ verifyCode mbCode action uid = do featureEnabled <- lift $ do mbFeatureEnabled <- Intra.getVerificationCodeEnabled `traverse` mbTeamId pure $ fromMaybe (Public.wsStatus (Public.defFeatureStatus @Public.SndFactorPasswordChallengeConfig) == Public.FeatureStatusEnabled) mbFeatureEnabled - when featureEnabled $ do + isSsoUser <- Data.isSamlUser uid + when (featureEnabled && not isSsoUser) $ do case (mbCode, mbEmail) of (Just code, Just email) -> do key <- Code.mkKey $ Code.ForEmail email diff --git a/services/brig/test/integration/API/Team.hs b/services/brig/test/integration/API/Team.hs index 1462a421a48..45b2ce69d2c 100644 --- a/services/brig/test/integration/API/Team.hs +++ b/services/brig/test/integration/API/Team.hs @@ -24,6 +24,7 @@ where import qualified API.Search.Util as SearchUtil import API.Team.Util +import API.User.Util as Util hiding (listConnections) import Bilge hiding (accept, head, timeout) import qualified Bilge import Bilge.Assert @@ -57,6 +58,7 @@ import Web.Cookie (parseSetCookie, setCookieName) import Wire.API.Asset import Wire.API.Connection import Wire.API.Team hiding (newTeam) +import qualified Wire.API.Team.Feature as Public import Wire.API.Team.Invitation import Wire.API.Team.Member hiding (invitation, userId) import qualified Wire.API.Team.Member as Member @@ -65,6 +67,7 @@ import Wire.API.Team.Role import Wire.API.Team.Size import Wire.API.User import Wire.API.User.Auth +import Wire.API.User.Client (ClientType (PermanentClientType)) newtype TeamSizeLimit = TeamSizeLimit Word32 @@ -108,7 +111,8 @@ tests conf m n b c g aws = do testGroup "sso" $ [ test m "post /i/users - 201 internal-SSO" $ testCreateUserInternalSSO b g, test m "delete /i/users/:uid - 202 internal-SSO (ensure no orphan teams)" $ testDeleteUserSSO b g, - test m "get /i/teams/:tid/is-team-owner/:uid" $ testSSOIsTeamOwner b g + test m "get /i/teams/:tid/is-team-owner/:uid" $ testSSOIsTeamOwner b g, + test m "2FA disabled for SSO user" $ test2FaDisabledForSsoUser b g ], testGroup "size" $ [test m "get /i/teams/:tid/size" $ testTeamSize b] ] @@ -820,6 +824,21 @@ testDeleteUserSSO brig galley = do updatePermissions user3 tid (creator', Team.rolePermissions RoleMember) galley deleteUser creator' (Just defPassword) brig !!! const 200 === statusCode +test2FaDisabledForSsoUser :: Brig -> Galley -> Http () +test2FaDisabledForSsoUser brig galley = do + teamid <- snd <$> createUserWithTeam brig + setTeamFeatureLockStatus @Public.SndFactorPasswordChallengeConfig galley teamid Public.LockStatusUnlocked + setTeamSndFactorPasswordChallenge galley teamid Public.FeatureStatusEnabled + let ssoid = UserSSOId mkSimpleSampleUref + createUserResp <- + postUser "dummy" True False (Just ssoid) (Just teamid) brig responseJsonMaybe createUserResp + let verificationCode = Nothing + addClient brig uid (defNewClientWithVerificationCode verificationCode PermanentClientType [head somePrekeys] (head someLastPrekeys)) + !!! const 201 === statusCode + -- TODO: -- add sso service. (we'll need a name for that now.) -- brig needs to notify the sso service about deletions! From c7584f2295a3504c0e04b0e2326c64efbcab8824 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Fri, 16 Sep 2022 13:58:49 +0200 Subject: [PATCH 28/58] Allow add proposal commits by non-admins (#2691) --- changelog.d/2-features/non-admin-commits | 1 + services/galley/src/Galley/API/MLS/Message.hs | 27 ++++---- services/galley/test/integration/API/MLS.hs | 65 ++++++++++++++++--- 3 files changed, 72 insertions(+), 21 deletions(-) create mode 100644 changelog.d/2-features/non-admin-commits diff --git a/changelog.d/2-features/non-admin-commits b/changelog.d/2-features/non-admin-commits new file mode 100644 index 00000000000..0d1b286836e --- /dev/null +++ b/changelog.d/2-features/non-admin-commits @@ -0,0 +1 @@ +Allow non-admins to commit add proposals in MLS conversations diff --git a/services/galley/src/Galley/API/MLS/Message.hs b/services/galley/src/Galley/API/MLS/Message.hs index 555dff1a118..15f08d45a64 100644 --- a/services/galley/src/Galley/API/MLS/Message.hs +++ b/services/galley/src/Galley/API/MLS/Message.hs @@ -801,19 +801,6 @@ executeProposalAction qusr con lconv cm action = do throwS @'MLSSelfRemovalNotAllowed pure (Just qtarget) - addMembers :: NonEmpty (Qualified UserId) -> Sem r [LocalConversationUpdate] - addMembers users = - -- FUTUREWORK: update key package ref mapping to reflect conversation membership - handleNoChanges - . handleMLSProposalFailures @ProposalErrors - . fmap pure - . updateLocalConversationUnchecked - @'ConversationJoinTag - lconv - qusr - con - $ ConversationJoin users roleNameWireMember - existingLocalMembers :: Set (Qualified UserId) existingLocalMembers = Set.fromList . map (fmap lmId . qUntagged) . sequenceA $ @@ -827,6 +814,20 @@ executeProposalAction qusr con lconv cm action = do existingMembers :: Set (Qualified UserId) existingMembers = existingLocalMembers <> existingRemoteMembers + addMembers :: NonEmpty (Qualified UserId) -> Sem r [LocalConversationUpdate] + addMembers = + -- FUTUREWORK: update key package ref mapping to reflect conversation membership + foldMap + ( handleNoChanges + . handleMLSProposalFailures @ProposalErrors + . fmap pure + . updateLocalConversationUnchecked @'ConversationJoinTag lconv qusr con + . flip ConversationJoin roleNameWireMember + ) + . nonEmpty + . filter (flip Set.notMember existingMembers) + . toList + removeMembers :: NonEmpty (Qualified UserId) -> Sem r [LocalConversationUpdate] removeMembers = foldMap diff --git a/services/galley/test/integration/API/MLS.hs b/services/galley/test/integration/API/MLS.hs index df76b0691f6..80ff3dd766d 100644 --- a/services/galley/test/integration/API/MLS.hs +++ b/services/galley/test/integration/API/MLS.hs @@ -1,5 +1,6 @@ {-# LANGUAGE RecordWildCards #-} {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} + -- This file is part of the Wire Server implementation. -- -- Copyright (C) 2022 Wire Swiss GmbH @@ -16,7 +17,6 @@ -- -- You should have received a copy of the GNU Affero General Public License along -- with this program. If not, see . -{-# OPTIONS_GHC -Wwarn #-} module API.MLS (tests) where @@ -140,6 +140,7 @@ tests s = testGroup "External Add Proposal" [ test s "member adds new client" testExternalAddProposal, + test s "non-admin commits external add proposal" testExternalAddProposalNonAdminCommit, test s "non-member adds new client" testExternalAddProposalWrongUser, test s "member adds unknown new client" testExternalAddProposalWrongClient ], @@ -1208,6 +1209,7 @@ propInvalidEpoch = do -- alice1 creates a group and adds bob1 -- bob2 joins with external proposal (alice1 commits it) -- bob2 adds charlie1 +-- alice1 sends a message testExternalAddProposal :: TestM () testExternalAddProposal = do -- create users @@ -1217,7 +1219,7 @@ testExternalAddProposal = do void . runMLSTest $ do -- create clients alice1 <- createMLSClient alice - [bob1, bob2] <- replicateM 2 (createMLSClient bob) + bob1 <- createMLSClient bob charlie1 <- createMLSClient charlie -- upload key packages @@ -1231,6 +1233,7 @@ testExternalAddProposal = do >>= sendAndConsumeCommit -- bob joins with an external proposal + bob2 <- createMLSClient bob mlsBracket [alice1, bob1] $ \wss -> do void $ createExternalAddProposal bob2 @@ -1238,10 +1241,20 @@ testExternalAddProposal = do liftTest $ WS.assertMatchN_ (5 # Second) wss $ void . wsAssertAddProposal bob qcnv + void $ createPendingProposalCommit alice1 >>= sendAndConsumeCommit + -- alice sends a message + do + msg <- createApplicationMessage alice1 "hi bob" + mlsBracket [bob1, bob2] $ \wss -> do + void $ sendAndConsumeMessage msg + liftTest $ + WS.assertMatchN_ (5 # Second) wss $ + wsAssertMLSMessage qcnv alice (mpMessage msg) + -- bob adds charlie putOtherMemberQualified (qUnqualified alice) @@ -1252,6 +1265,42 @@ testExternalAddProposal = do createAddCommit bob2 [charlie] >>= sendAndConsumeCommit +testExternalAddProposalNonAdminCommit :: TestM () +testExternalAddProposalNonAdminCommit = do + -- create users + [alice, bob, charlie] <- + createAndConnectUsers (replicate 3 Nothing) + + void . runMLSTest $ do + -- create clients + alice1 <- createMLSClient alice + [bob1, bob2] <- replicateM 2 (createMLSClient bob) + charlie1 <- createMLSClient charlie + + -- upload key packages + void $ uploadNewKeyPackage bob1 + void $ uploadNewKeyPackage charlie1 + + -- create group with alice1 and bob1 + (_, qcnv) <- setupMLSGroup alice1 + void $ + createAddCommit alice1 [bob] + >>= sendAndConsumeCommit + + -- bob joins with an external proposal + mlsBracket [alice1, bob1] $ \wss -> do + void $ + createExternalAddProposal bob2 + >>= sendAndConsumeMessage + liftTest $ + WS.assertMatchN_ (5 # Second) wss $ + void . wsAssertAddProposal bob qcnv + + -- bob1 commits + void $ + createPendingProposalCommit bob1 + >>= sendAndConsumeCommit + -- scenario: -- alice adds bob and charlie -- charlie sends an external proposal for bob @@ -1605,13 +1654,13 @@ testBackendRemoveProposalLocalConvRemoteLeaver = do testBackendRemoveProposalLocalConvLocalClient :: TestM () testBackendRemoveProposalLocalConvLocalClient = do - [alice, bob] <- createAndConnectUsers [Nothing, Nothing] + [alice, bob, charlie] <- createAndConnectUsers (replicate 3 Nothing) runMLSTest $ do - [alice1, bob1, bob2] <- traverse createMLSClient [alice, bob, bob] - traverse_ uploadNewKeyPackage [bob1, bob2] + [alice1, bob1, bob2, charlie1] <- traverse createMLSClient [alice, bob, bob, charlie] + traverse_ uploadNewKeyPackage [bob1, bob2, charlie1] (_, qcnv) <- setupMLSGroup alice1 - void $ createAddCommit alice1 [bob] >>= sendAndConsumeCommit + void $ createAddCommit alice1 [bob, charlie] >>= sendAndConsumeCommit Just (_, kpBob1) <- find (\(ci, _) -> ci == bob1) <$> getClientsFromGroupState alice1 bob mlsBracket [alice1, bob1] $ \[wsA, wsB] -> do @@ -1630,10 +1679,10 @@ testBackendRemoveProposalLocalConvLocalClient = do msg <- WS.assertMatch (5 # WS.Second) wsA $ \notification -> do wsAssertBackendRemoveProposal bob qcnv kpBob1 notification - for_ [alice1, bob2] $ + for_ [alice1, bob2, charlie1] $ flip consumeMessage1 msg - mp <- createPendingProposalCommit alice1 + mp <- createPendingProposalCommit charlie1 events <- sendAndConsumeCommit mp liftIO $ events @?= [] From fe819ae0075bf03f654692a54de052f16d6ad35e Mon Sep 17 00:00:00 2001 From: Stefan Matting Date: Fri, 16 Sep 2022 18:37:55 +0200 Subject: [PATCH 29/58] Improve Tasty Hunit errors (#2697) --- cabal.project | 6 ++++++ cabal.project.freeze | 2 +- services/brig/test/integration/API/Provider.hs | 2 +- 3 files changed, 8 insertions(+), 2 deletions(-) diff --git a/cabal.project b/cabal.project index c0c9d989abb..71ab22593fa 100644 --- a/cabal.project +++ b/cabal.project @@ -157,6 +157,12 @@ source-repository-package location: https://gitlab.com/twittner/wai-routing tag: 7e996a93fec5901767f845a50316b3c18e51a61d +source-repository-package + type: git + location: https://github.com/wireapp/tasty.git + tag: 3934275585a084fd263c9564090e36c5319e5fde + subdir: hunit + allow-older: * allow-newer: * diff --git a/cabal.project.freeze b/cabal.project.freeze index da0e31f39ce..f25dfb49757 100644 --- a/cabal.project.freeze +++ b/cabal.project.freeze @@ -2358,7 +2358,7 @@ constraints: any.AC-Angle ==1.0, any.tasty-golden ==2.3.4, any.tasty-hedgehog ==1.1.0.0, any.tasty-hspec ==1.1.6, - any.tasty-hunit ==0.10.0.3, + any.tasty-hunit ==0.10.0.2, any.tasty-hunit-compat ==0.2.0.1, any.tasty-inspection-testing ==0.1, any.tasty-kat ==0.0.3, diff --git a/services/brig/test/integration/API/Provider.hs b/services/brig/test/integration/API/Provider.hs index 3d3e81803af..e2caccbb30f 100644 --- a/services/brig/test/integration/API/Provider.hs +++ b/services/brig/test/integration/API/Provider.hs @@ -1849,7 +1849,7 @@ svcAssertBotCreated buf bid cid = liftIO $ do -- TODO: Verify the conversation name -- TODO: Verify the list of members pure b - _ -> throwM $ HUnitFailure Nothing "Event timeout (TestBotCreated)" + _ -> assertFailure "Event timeout (TestBotCreated)" svcAssertMessage :: MonadIO m => Chan TestBotEvent -> Qualified UserId -> OtrMessage -> Qualified ConvId -> m () svcAssertMessage buf from msg cnv = liftIO $ do From 9830a3e00c78fcd7268a9c35b736ca2933ffac4e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marko=20Dimja=C5=A1evi=C4=87?= Date: Fri, 16 Sep 2022 20:34:49 +0200 Subject: [PATCH 30/58] [FS-937] Validate Remotely Claimed Key Packages (#2692) * Provide a custom Show instance for ClientIdentity * Align function types in KeyPackages and Validation * Validate remotely claimed key packages * Restrict validation of MLS public keys to locals * Update Brig integration test utils * Update the remote key package claim test --- .../validate-remotely-claimed-key-packages | 1 + libs/wire-api/src/Wire/API/Error/Brig.hs | 6 ++ libs/wire-api/src/Wire/API/MLS/Credential.hs | 10 ++- services/brig/src/Brig/API/Error.hs | 2 + services/brig/src/Brig/API/MLS/KeyPackages.hs | 39 ++++++++---- .../Brig/API/MLS/KeyPackages/Validation.hs | 42 +++++++++---- services/brig/src/Brig/Data/Client.hs | 2 + services/brig/test/integration/API/MLS.hs | 22 ++++--- .../brig/test/integration/API/MLS/Util.hs | 63 ++++++++++++++----- 9 files changed, 135 insertions(+), 52 deletions(-) create mode 100644 changelog.d/1-api-changes/validate-remotely-claimed-key-packages diff --git a/changelog.d/1-api-changes/validate-remotely-claimed-key-packages b/changelog.d/1-api-changes/validate-remotely-claimed-key-packages new file mode 100644 index 00000000000..dadf82918a0 --- /dev/null +++ b/changelog.d/1-api-changes/validate-remotely-claimed-key-packages @@ -0,0 +1 @@ +Validate remotely claimed key packages diff --git a/libs/wire-api/src/Wire/API/Error/Brig.hs b/libs/wire-api/src/Wire/API/Error/Brig.hs index 544a3755cde..6e5e8a03ebb 100644 --- a/libs/wire-api/src/Wire/API/Error/Brig.hs +++ b/libs/wire-api/src/Wire/API/Error/Brig.hs @@ -64,6 +64,8 @@ data BrigError | PasswordAuthenticationFailed | TooManyTeamInvitations | InsufficientTeamPermissions + | KeyPackageDecodingError + | InvalidKeyPackageRef instance KnownError (MapError e) => IsSwaggerError (e :: BrigError) where addToSwagger = addStaticErrorToSwagger @(MapError e) @@ -172,3 +174,7 @@ type instance MapError 'PasswordAuthenticationFailed = 'StaticError 403 "passwor type instance MapError 'TooManyTeamInvitations = 'StaticError 403 "too-many-team-invitations" "Too many team invitations for this team" type instance MapError 'InsufficientTeamPermissions = 'StaticError 403 "insufficient-permissions" "Insufficient team permissions" + +type instance MapError 'KeyPackageDecodingError = 'StaticError 409 "decoding-error" "Key package could not be TLS-decoded" + +type instance MapError 'InvalidKeyPackageRef = 'StaticError 409 "invalid-reference" "Key package's reference does not match its data" diff --git a/libs/wire-api/src/Wire/API/MLS/Credential.hs b/libs/wire-api/src/Wire/API/MLS/Credential.hs index f24926280f2..4b7d62f99ee 100644 --- a/libs/wire-api/src/Wire/API/MLS/Credential.hs +++ b/libs/wire-api/src/Wire/API/MLS/Credential.hs @@ -139,9 +139,17 @@ data ClientIdentity = ClientIdentity ciUser :: UserId, ciClient :: ClientId } - deriving stock (Eq, Ord, Show, Generic) + deriving stock (Eq, Ord, Generic) deriving (FromJSON, ToJSON, S.ToSchema) via Schema ClientIdentity +instance Show ClientIdentity where + show (ClientIdentity dom u c) = + show u + <> ":" + <> T.unpack (client c) + <> "@" + <> T.unpack (domainText dom) + cidQualifiedClient :: ClientIdentity -> Qualified (UserId, ClientId) cidQualifiedClient cid = Qualified (ciUser cid, ciClient cid) (ciDomain cid) diff --git a/services/brig/src/Brig/API/Error.hs b/services/brig/src/Brig/API/Error.hs index c3e8341498f..6c5f09a4beb 100644 --- a/services/brig/src/Brig/API/Error.hs +++ b/services/brig/src/Brig/API/Error.hs @@ -182,6 +182,8 @@ clientDataError (ClientReAuthError e) = reauthError e clientDataError ClientMissingAuth = StdError (errorToWai @'E.MissingAuth) clientDataError MalformedPrekeys = StdError (errorToWai @'E.MalformedPrekeys) clientDataError MLSPublicKeyDuplicate = StdError (errorToWai @'E.MLSDuplicatePublicKey) +clientDataError KeyPackageDecodingError = StdError (errorToWai @'E.KeyPackageDecodingError) +clientDataError InvalidKeyPackageRef = StdError (errorToWai @'E.InvalidKeyPackageRef) deleteUserError :: DeleteUserError -> Error deleteUserError DeleteUserInvalid = StdError (errorToWai @'E.InvalidUser) diff --git a/services/brig/src/Brig/API/MLS/KeyPackages.hs b/services/brig/src/Brig/API/MLS/KeyPackages.hs index 342eafd9537..49cd60de864 100644 --- a/services/brig/src/Brig/API/MLS/KeyPackages.hs +++ b/services/brig/src/Brig/API/MLS/KeyPackages.hs @@ -42,6 +42,7 @@ import Wire.API.Federation.API import Wire.API.Federation.API.Brig import Wire.API.MLS.Credential import Wire.API.MLS.KeyPackage +import Wire.API.MLS.Serialisation import Wire.API.Team.LegalHold import Wire.API.User.Client @@ -57,12 +58,11 @@ claimKeyPackages :: Maybe ClientId -> Handler r KeyPackageBundle claimKeyPackages lusr target skipOwn = - withExceptT clientError $ - foldQualified - lusr - (claimLocalKeyPackages (qUntagged lusr) skipOwn) - (claimRemoteKeyPackages lusr) - target + foldQualified + lusr + (withExceptT clientError . claimLocalKeyPackages (qUntagged lusr) skipOwn) + (claimRemoteKeyPackages lusr) + target claimLocalKeyPackages :: Qualified UserId -> @@ -96,11 +96,12 @@ claimLocalKeyPackages qusr skipOwn target = do claimRemoteKeyPackages :: Local UserId -> Remote UserId -> - ExceptT ClientError (AppT r) KeyPackageBundle + Handler r KeyPackageBundle claimRemoteKeyPackages lusr target = do bundle <- - (handleFailure =<<) $ - withExceptT ClientFederationError $ + withExceptT clientError + . (handleFailure =<<) + $ withExceptT ClientFederationError $ runBrigFederatorClient (tDomain target) $ fedClient @'Brig @"claim-key-packages" $ ClaimKeyPackageRequest @@ -108,10 +109,22 @@ claimRemoteKeyPackages lusr target = do ckprTarget = tUnqualified target } - -- set up mappings for all claimed key packages - wrapClientE $ - for_ (kpbEntries bundle) $ \e -> - Data.mapKeyPackageRef (kpbeRef e) (kpbeUser e) (kpbeClient e) + -- validate and set up mappings for all claimed key packages + for_ (kpbEntries bundle) $ \e -> do + let cid = mkClientIdentity (kpbeUser e) (kpbeClient e) + kpRaw <- + withExceptT (const . clientDataError $ KeyPackageDecodingError) + . except + . decodeMLS' + . kpData + . kpbeKeyPackage + $ e + (refVal, _) <- validateKeyPackage cid kpRaw + unless (refVal == kpbeRef e) + . throwE + . clientDataError + $ InvalidKeyPackageRef + wrapClientE $ Data.mapKeyPackageRef (kpbeRef e) (kpbeUser e) (kpbeClient e) pure bundle where diff --git a/services/brig/src/Brig/API/MLS/KeyPackages/Validation.hs b/services/brig/src/Brig/API/MLS/KeyPackages/Validation.hs index 8b64dc030bb..186328a7f18 100644 --- a/services/brig/src/Brig/API/MLS/KeyPackages/Validation.hs +++ b/services/brig/src/Brig/API/MLS/KeyPackages/Validation.hs @@ -35,6 +35,7 @@ import Brig.Options import Control.Applicative import Control.Lens (view) import qualified Data.ByteString.Lazy as LBS +import Data.Qualified import Data.Time.Clock import Data.Time.Clock.POSIX import Imports @@ -46,8 +47,12 @@ import Wire.API.MLS.Extension import Wire.API.MLS.KeyPackage import Wire.API.MLS.Serialisation -validateKeyPackage :: ClientIdentity -> RawMLS KeyPackage -> Handler r (KeyPackageRef, KeyPackageData) +validateKeyPackage :: + ClientIdentity -> + RawMLS KeyPackage -> + Handler r (KeyPackageRef, KeyPackageData) validateKeyPackage identity (RawMLS (KeyPackageData -> kpd) kp) = do + loc <- qualifyLocal () -- get ciphersuite cs <- maybe @@ -60,19 +65,32 @@ validateKeyPackage identity (RawMLS (KeyPackageData -> kpd) kp) = do when (signatureScheme ss /= bcSignatureScheme (kpCredential kp)) $ mlsProtocolError "Signature scheme incompatible with ciphersuite" - -- authenticate signature key - key <- - fmap LBS.toStrict $ - maybe - (mlsProtocolError "No key associated to the given identity and signature scheme") - pure - =<< lift (wrapClient (Data.lookupMLSPublicKey (ciUser identity) (ciClient identity) ss)) - when (key /= bcSignatureKey (kpCredential kp)) $ - mlsProtocolError "Unrecognised signature key" + -- Authenticate signature key. This is performed only upon uploading a key + -- package for a local client. + foldQualified + loc + ( \_ -> do + key <- + fmap LBS.toStrict $ + maybe + (mlsProtocolError "No key associated to the given identity and signature scheme") + pure + =<< lift (wrapClient (Data.lookupMLSPublicKey (ciUser identity) (ciClient identity) ss)) + when (key /= bcSignatureKey (kpCredential kp)) $ + mlsProtocolError "Unrecognised signature key" + ) + (pure . const ()) + (cidQualifiedClient identity) -- validate signature - unless (csVerifySignature cs key (rmRaw (kpTBS kp)) (kpSignature kp)) $ - mlsProtocolError "Invalid signature" + unless + ( csVerifySignature + cs + (bcSignatureKey (kpCredential kp)) + (rmRaw (kpTBS kp)) + (kpSignature kp) + ) + $ mlsProtocolError "Invalid signature" -- validate protocol version maybe (mlsProtocolError "Unsupported protocol version") diff --git a/services/brig/src/Brig/Data/Client.hs b/services/brig/src/Brig/Data/Client.hs index 9453071a5fd..480f8bebf7d 100644 --- a/services/brig/src/Brig/Data/Client.hs +++ b/services/brig/src/Brig/Data/Client.hs @@ -97,6 +97,8 @@ data ClientDataError | ClientMissingAuth | MalformedPrekeys | MLSPublicKeyDuplicate + | KeyPackageDecodingError + | InvalidKeyPackageRef -- | Re-authentication policy. -- diff --git a/services/brig/test/integration/API/MLS.hs b/services/brig/test/integration/API/MLS.hs index b71cca2873d..cbd5fa5697b 100644 --- a/services/brig/test/integration/API/MLS.hs +++ b/services/brig/test/integration/API/MLS.hs @@ -23,7 +23,6 @@ import Bilge.Assert import Brig.Options import Control.Timeout import qualified Data.Aeson as Aeson -import qualified Data.ByteString as BS import Data.ByteString.Conversion import Data.Default import Data.Id @@ -32,7 +31,6 @@ import qualified Data.Set as Set import Data.Timeout import Federation.Util import Imports -import Test.QuickCheck hiding ((===)) import Test.Tasty import Test.Tasty.HUnit import UnliftIO.Temporary @@ -40,6 +38,7 @@ import Util import Web.HttpApiData import Wire.API.MLS.Credential import Wire.API.MLS.KeyPackage +import Wire.API.MLS.Serialisation import Wire.API.User import Wire.API.User.Client @@ -186,13 +185,18 @@ testKeyPackageRemoteClaim opts brig = do u' <- userQualifiedId <$> randomUser brig - entries <- - liftIO . replicateM 2 . generate $ - -- claimed key packages are not validated by the backend, so it is fine to - -- make up some random data here - KeyPackageBundleEntry u <$> arbitrary - <*> (KeyPackageRef . BS.pack <$> vector 32) - <*> (KeyPackageData . BS.pack <$> vector 64) + qcid <- mkClientIdentity u <$> randomClient + entries <- withSystemTempDirectory "mls" $ \tmp -> do + initStore tmp qcid + replicateM 2 $ do + (r, kp) <- generateKeyPackage tmp qcid Nothing + pure $ + KeyPackageBundleEntry + { kpbeUser = u, + kpbeClient = ciClient qcid, + kpbeRef = kp, + kpbeKeyPackage = KeyPackageData . rmRaw $ r + } let mockBundle = KeyPackageBundle (Set.fromList entries) (bundle :: KeyPackageBundle, _reqs) <- liftIO . withTempMockFederator opts (Aeson.encode mockBundle) $ diff --git a/services/brig/test/integration/API/MLS/Util.hs b/services/brig/test/integration/API/MLS/Util.hs index 65dae9bdec1..0671af1c658 100644 --- a/services/brig/test/integration/API/MLS/Util.hs +++ b/services/brig/test/integration/API/MLS/Util.hs @@ -23,19 +23,20 @@ import Bilge.Assert import Data.Aeson (object, toJSON, (.=)) import Data.ByteString.Conversion import Data.Default -import Data.Domain import Data.Id import Data.Json.Util import qualified Data.Map as Map import Data.Qualified -import qualified Data.Text as T +import qualified Data.Text as Text import Data.Timeout import Imports import System.FilePath import System.Process +import Test.Tasty.HUnit import Util import Wire.API.MLS.Credential import Wire.API.MLS.KeyPackage +import Wire.API.MLS.Serialisation import Wire.API.User.Client data SetKey = SetKey | DontSetKey @@ -49,6 +50,39 @@ data KeyingInfo = KeyingInfo instance Default KeyingInfo where def = KeyingInfo SetKey Nothing +cliCmd :: FilePath -> ClientIdentity -> [String] +cliCmd tmp qcid = + ["mls-test-cli", "--store", tmp (show qcid <> ".db")] + +initStore :: + HasCallStack => + MonadIO m => + FilePath -> + ClientIdentity -> + m () +initStore tmp qcid = do + let cmd0 = cliCmd tmp qcid + void . liftIO . flip spawn Nothing . shell . unwords $ + cmd0 <> ["init", show qcid] + +generateKeyPackage :: + HasCallStack => + MonadIO m => + FilePath -> + ClientIdentity -> + Maybe Timeout -> + m (RawMLS KeyPackage, KeyPackageRef) +generateKeyPackage tmp qcid lifetime = do + let cmd0 = cliCmd tmp qcid + kp <- + liftIO $ + decodeMLSError <=< (flip spawn Nothing . shell . unwords) $ + cmd0 + <> ["key-package", "create"] + <> (("--lifetime " <>) . show . (#> Second) <$> maybeToList lifetime) + let ref = fromJust (kpRef' kp) + pure (kp, ref) + uploadKeyPackages :: HasCallStack => Brig -> @@ -59,20 +93,10 @@ uploadKeyPackages :: Int -> Http () uploadKeyPackages brig tmp KeyingInfo {..} u c n = do - let cmd0 = ["mls-test-cli", "--store", tmp (clientId <> ".db")] - clientId = - show (qUnqualified u) - <> ":" - <> T.unpack (client c) - <> "@" - <> T.unpack (domainText (qDomain u)) - void . liftIO . flip spawn Nothing . shell . unwords $ - cmd0 <> ["init", clientId] - kps <- - replicateM n . liftIO . flip spawn Nothing . shell . unwords $ - cmd0 - <> ["key-package", "create"] - <> (("--lifetime " <>) . show . (#> Second) <$> maybeToList kiLifetime) + let cmd0 = cliCmd tmp cid + cid = mkClientIdentity u c + initStore tmp cid + kps <- replicateM n (fst <$> generateKeyPackage tmp cid kiLifetime) when (kiSetKey == SetKey) $ do pk <- @@ -85,7 +109,7 @@ uploadKeyPackages brig tmp KeyingInfo {..} u c n = do . json defUpdateClient {updateClientMLSPublicKeys = Map.fromList [(Ed25519, pk)]} ) !!! const 200 === statusCode - let upload = object ["key_packages" .= toJSON (map Base64ByteString kps)] + let upload = object ["key_packages" .= toJSON (map (Base64ByteString . rmRaw) kps)] post ( brig . paths ["mls", "key-packages", "self", toByteString' c] @@ -102,3 +126,8 @@ getKeyPackageCount brig u c = . zUser (qUnqualified u) ) ByteString -> IO a +decodeMLSError s = case decodeMLS' s of + Left e -> assertFailure ("Could not parse MLS object: " <> Text.unpack e) + Right x -> pure x From cb6e9c23459dab34fe15d0f9427603ca672fc682 Mon Sep 17 00:00:00 2001 From: Molly Miller <33266253+sysvinit@users.noreply.github.com> Date: Mon, 19 Sep 2022 10:32:31 +0200 Subject: [PATCH 31/58] Feature flag for exposing invite URLs to team admins [SQPIT-1368] (#2684) This flag is generally locked and disabled. To be able to unlock/enable it, the team id must be added to the list of eligible teams. The invitation URLs are meant to be used in automatized onboarding processes; e.g. rendering them as QR codes. N.B. getting hold of the invitation URLs makes it possible to impersonate as someone else. That's why there's this two-configs solution: To make sure it's only activated when absolutely needed (and not accidentally.) Co-authored-by: Sven Tennie Co-authored-by: Molly Miller Co-authored-by: Matthias Fischmann --- cassandra-schema.cql | 1 + .../2-features/registration-url-in-invitation | 1 + charts/galley/templates/configmap.yaml | 9 +- charts/galley/values.yaml | 3 +- .../src/developer/reference/config-options.md | 47 ++ .../src/Wire/API/Routes/Public/Galley.hs | 2 + libs/wire-api/src/Wire/API/Team/Feature.hs | 31 +- libs/wire-api/src/Wire/API/Team/Invitation.hs | 11 +- .../Golden/Generated/InvitationList_team.hs | 453 ++++++++++-------- .../API/Golden/Generated/Invitation_team.hs | 182 +++---- .../testObject_InvitationList_team_10.json | 3 +- .../testObject_InvitationList_team_11.json | 3 +- .../testObject_InvitationList_team_13.json | 21 +- .../testObject_InvitationList_team_15.json | 15 +- .../testObject_InvitationList_team_16.json | 3 +- .../testObject_InvitationList_team_17.json | 3 +- .../testObject_InvitationList_team_2.json | 3 +- .../testObject_InvitationList_team_20.json | 6 +- .../testObject_InvitationList_team_4.json | 24 +- .../testObject_InvitationList_team_6.json | 45 +- .../testObject_InvitationList_team_7.json | 9 +- .../testObject_InvitationList_team_8.json | 6 +- .../testObject_InvitationList_team_9.json | 9 +- .../golden/testObject_Invitation_team_1.json | 3 +- .../golden/testObject_Invitation_team_10.json | 3 +- .../golden/testObject_Invitation_team_11.json | 3 +- .../golden/testObject_Invitation_team_12.json | 3 +- .../golden/testObject_Invitation_team_13.json | 3 +- .../golden/testObject_Invitation_team_14.json | 3 +- .../golden/testObject_Invitation_team_15.json | 3 +- .../golden/testObject_Invitation_team_16.json | 3 +- .../golden/testObject_Invitation_team_17.json | 3 +- .../golden/testObject_Invitation_team_18.json | 3 +- .../golden/testObject_Invitation_team_19.json | 3 +- .../golden/testObject_Invitation_team_2.json | 3 +- .../golden/testObject_Invitation_team_20.json | 3 +- .../golden/testObject_Invitation_team_3.json | 3 +- .../golden/testObject_Invitation_team_4.json | 3 +- .../golden/testObject_Invitation_team_5.json | 3 +- .../golden/testObject_Invitation_team_6.json | 3 +- .../golden/testObject_Invitation_team_7.json | 3 +- .../golden/testObject_Invitation_team_8.json | 3 +- .../golden/testObject_Invitation_team_9.json | 3 +- libs/wire-api/wire-api.cabal | 1 + services/brig/brig.cabal | 1 + services/brig/src/Brig/API/Internal.hs | 3 +- services/brig/src/Brig/API/User.hs | 3 +- services/brig/src/Brig/IO/Intra.hs | 24 + services/brig/src/Brig/Team/API.hs | 13 +- services/brig/src/Brig/Team/DB.hs | 136 ++++-- services/brig/src/Brig/Team/Types.hs | 23 + .../brig/test/integration/API/User/Account.hs | 32 +- services/galley/galley.cabal | 1 + services/galley/galley.integration.yaml | 1 + services/galley/schema/src/Main.hs | 4 +- .../src/V74_ExposeInvitationsToTeamAdmin.hs | 33 ++ services/galley/src/Galley/API/Internal.hs | 7 + .../galley/src/Galley/API/Public/Servant.hs | 3 + .../galley/src/Galley/API/Teams/Features.hs | 44 +- services/galley/src/Galley/Cassandra.hs | 2 +- .../src/Galley/Cassandra/TeamFeatures.hs | 4 + services/galley/src/Galley/Options.hs | 6 + .../test/integration/API/Teams/Feature.hs | 88 +++- 63 files changed, 965 insertions(+), 414 deletions(-) create mode 100644 changelog.d/2-features/registration-url-in-invitation create mode 100644 services/brig/src/Brig/Team/Types.hs create mode 100644 services/galley/schema/src/V74_ExposeInvitationsToTeamAdmin.hs diff --git a/cassandra-schema.cql b/cassandra-schema.cql index 5eb68efc442..81316299b98 100644 --- a/cassandra-schema.cql +++ b/cassandra-schema.cql @@ -128,6 +128,7 @@ CREATE TABLE galley_test.team_features ( app_lock_status int, conference_calling int, digital_signatures int, + expose_invitation_urls_to_team_admin int, file_sharing int, file_sharing_lock_status int, guest_links_lock_status int, diff --git a/changelog.d/2-features/registration-url-in-invitation b/changelog.d/2-features/registration-url-in-invitation new file mode 100644 index 00000000000..eb9669b1fc2 --- /dev/null +++ b/changelog.d/2-features/registration-url-in-invitation @@ -0,0 +1 @@ +Optionally add invitation urls to the body of `/teams/{tid}/invitations`. This allows further processing; e.g. to send those links with custom emails or distribute them as QR codes. See [docs](https://docs.wire.com/developer/reference/config-options.html#expose-invitation-urls-to-team-admin) for details and privacy implications. diff --git a/charts/galley/templates/configmap.yaml b/charts/galley/templates/configmap.yaml index 9a877ab26ff..c5ce757acee 100644 --- a/charts/galley/templates/configmap.yaml +++ b/charts/galley/templates/configmap.yaml @@ -54,6 +54,9 @@ data: {{- if .settings.maxFanoutSize }} maxFanoutSize: {{ .settings.maxFanoutSize }} {{- end }} + {{- if .settings.exposeInvitationURLsTeamAllowlist }} + exposeInvitationURLsTeamAllowlist: {{ .settings.exposeInvitationURLsTeamAllowlist }} + {{- end }} conversationCodeURI: {{ .settings.conversationCodeURI | quote }} {{- if .settings.enableIndexedBillingTeamMembers }} enableIndexedBillingTeamMembers: {{ .settings.enableIndexedBillingTeamMembers }} @@ -92,15 +95,15 @@ data: {{- if .settings.featureFlags.appLock }} appLock: {{- toYaml .settings.featureFlags.appLock | nindent 10 }} - {{- end }} + {{- end }} {{- if .settings.featureFlags.conferenceCalling }} conferenceCalling: {{- toYaml .settings.featureFlags.conferenceCalling | nindent 10 }} - {{- end }} + {{- end }} {{- if .settings.featureFlags.selfDeletingMessages }} selfDeletingMessages: {{- toYaml .settings.featureFlags.selfDeletingMessages | nindent 10 }} - {{- end }} + {{- end }} {{- if .settings.featureFlags.conversationGuestLinks }} conversationGuestLinks: {{- toYaml .settings.featureFlags.conversationGuestLinks | nindent 10 }} diff --git a/charts/galley/values.yaml b/charts/galley/values.yaml index 2c6fa9a6c4e..4ee17754e5f 100644 --- a/charts/galley/values.yaml +++ b/charts/galley/values.yaml @@ -26,6 +26,7 @@ config: settings: httpPoolSize: 128 maxTeamSize: 10000 + exposeInvitationURLsTeamAllowlist: [] maxConvSize: 500 # Before making indexedBillingTeamMember true while upgrading, please # refer to notes here: https://github.com/wireapp/wire-server-deploy/releases/tag/v2020-05-15 @@ -79,7 +80,7 @@ config: validateSAMLemails: defaults: status: enabled - + aws: region: "eu-west-1" proxy: {} diff --git a/docs/src/developer/reference/config-options.md b/docs/src/developer/reference/config-options.md index 8a74338aa70..07ce0ec7cae 100644 --- a/docs/src/developer/reference/config-options.md +++ b/docs/src/developer/reference/config-options.md @@ -99,6 +99,53 @@ IMPORTANT: If you switch this back to `disabled-permanently` from that have created them while it was allowed. This may change in the future. +### Expose invitation URLs to team admin + +For further processing (e.g. sending custom emails or rendering the URLs as QR +codes), team invitation URLs can be made part of the result of +`GET /teams/{tid}/invitations`. + +```json +{ + "has_more": false, + "invitations": [ + { + "created_at": "2022-09-15T15:47:28.577Z", + "created_by": "375f56fe-7f12-4c0c-aed8-d48c0326d1fb", + "email": "foo@example.com", + "id": "4decf7f8-bdd4-43b3-aaf2-e912e2c0c46f", + "name": null, + "phone": null, + "role": "member", + "team": "51612209-3b61-49b0-8c55-d21ae65efc1a", + "url": "http://127.0.0.1:8080/register?team=51612209-3b61-49b0-8c55-d21ae65efc1a&team_code=RpxGkK_yjw8ZBegJuFQO0hha-2Tneajp" + } + ] +} +``` + +This can be a privacy issue as it allows the team admin to impersonate as +another team member. The feature is disabled by default. + +To activate this feature two steps are needed. First, the team id (tid) has to +be added to the list of teams for which this feature *can* be enabled +(`exposeInvitationURLsTeamAllowlist`). This is done in `galley`'s `values.yaml`: + +```yaml +settings: + exposeInvitationURLsTeamAllowlist: ["51612209-3b61-49b0-8c55-d21ae65efc1a", ...] +``` + +Then, the feature can be set for the team by enabling the +`exposeInvitationURLsToTeamAdmin` flag. This is done by making a `PUT` request +to `/teams/{tid}/features/exposeInvitationURLsToTeamAdmin` with the body: + +```json +{ + "status": "enabled" +} +``` + ### Team searchVisibility The team flag `searchVisibility` affects the outbound search of user diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs b/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs index f80ff25aa3f..de1bd25b34a 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs @@ -1136,6 +1136,8 @@ type FeatureAPI = :<|> FeatureStatusPut '() SndFactorPasswordChallengeConfig :<|> FeatureStatusGet MLSConfig :<|> FeatureStatusPut '() MLSConfig + :<|> FeatureStatusGet ExposeInvitationURLsToTeamAdminConfig + :<|> FeatureStatusPut '() ExposeInvitationURLsToTeamAdminConfig :<|> FeatureStatusGet SearchVisibilityInboundConfig :<|> FeatureStatusPut '() SearchVisibilityInboundConfig :<|> AllFeatureConfigsUserGet diff --git a/libs/wire-api/src/Wire/API/Team/Feature.hs b/libs/wire-api/src/Wire/API/Team/Feature.hs index 1e2a33f803d..41eb91997aa 100644 --- a/libs/wire-api/src/Wire/API/Team/Feature.hs +++ b/libs/wire-api/src/Wire/API/Team/Feature.hs @@ -67,6 +67,7 @@ module Wire.API.Team.Feature DigitalSignaturesConfig (..), ConferenceCallingConfig (..), GuestLinksConfig (..), + ExposeInvitationURLsToTeamAdminConfig (..), SndFactorPasswordChallengeConfig (..), SearchVisibilityInboundConfig (..), ClassifiedDomainsConfig (..), @@ -579,6 +580,7 @@ allFeatureModels = withStatusNoLockModel @SndFactorPasswordChallengeConfig, withStatusNoLockModel @SearchVisibilityInboundConfig, withStatusNoLockModel @MLSConfig, + withStatusNoLockModel @ExposeInvitationURLsToTeamAdminConfig, withStatusModel @LegalholdConfig, withStatusModel @SSOConfig, withStatusModel @SearchVisibilityAvailableConfig, @@ -592,7 +594,8 @@ allFeatureModels = withStatusModel @GuestLinksConfig, withStatusModel @SndFactorPasswordChallengeConfig, withStatusModel @SearchVisibilityInboundConfig, - withStatusModel @MLSConfig + withStatusModel @MLSConfig, + withStatusModel @ExposeInvitationURLsToTeamAdminConfig ] <> catMaybes [ configModel @LegalholdConfig, @@ -608,7 +611,8 @@ allFeatureModels = configModel @GuestLinksConfig, configModel @SndFactorPasswordChallengeConfig, configModel @SearchVisibilityInboundConfig, - configModel @MLSConfig + configModel @MLSConfig, + configModel @ExposeInvitationURLsToTeamAdminConfig ] -------------------------------------------------------------------------------- @@ -939,6 +943,24 @@ instance IsFeatureConfig MLSConfig where Doc.property "allowedCipherSuites" (Doc.array Doc.int32') $ Doc.description "cipher suite numbers, See https://messaginglayersecurity.rocks/mls-protocol/draft-ietf-mls-protocol.html#table-5" Doc.property "defaultCipherSuite" Doc.int32' $ Doc.description "cipher suite number. See https://messaginglayersecurity.rocks/mls-protocol/draft-ietf-mls-protocol.html#table-5" +---------------------------------------------------------------------- +-- ExposeInvitationURLsToTeamAdminConfig + +data ExposeInvitationURLsToTeamAdminConfig = ExposeInvitationURLsToTeamAdminConfig + deriving stock (Show, Eq, Generic) + deriving (Arbitrary) via (GenericUniform ExposeInvitationURLsToTeamAdminConfig) + +instance IsFeatureConfig ExposeInvitationURLsToTeamAdminConfig where + type FeatureSymbol ExposeInvitationURLsToTeamAdminConfig = "exposeInvitationURLsToTeamAdmin" + defFeatureStatus = withStatus FeatureStatusDisabled LockStatusLocked ExposeInvitationURLsToTeamAdminConfig FeatureTTLUnlimited + objectSchema = pure ExposeInvitationURLsToTeamAdminConfig + +instance ToSchema ExposeInvitationURLsToTeamAdminConfig where + schema = object "ExposeInvitationURLsToTeamAdminConfig" objectSchema + +instance FeatureTrivialConfig ExposeInvitationURLsToTeamAdminConfig where + trivialConfig = ExposeInvitationURLsToTeamAdminConfig + ---------------------------------------------------------------------- -- FeatureStatus @@ -1007,7 +1029,8 @@ data AllFeatureConfigs = AllFeatureConfigs afcSelfDeletingMessages :: WithStatus SelfDeletingMessagesConfig, afcGuestLink :: WithStatus GuestLinksConfig, afcSndFactorPasswordChallenge :: WithStatus SndFactorPasswordChallengeConfig, - afcMLS :: WithStatus MLSConfig + afcMLS :: WithStatus MLSConfig, + afcExposeInvitationURLsToTeamAdmin :: WithStatus ExposeInvitationURLsToTeamAdminConfig } deriving stock (Eq, Show) deriving (FromJSON, ToJSON, S.ToSchema) via (Schema AllFeatureConfigs) @@ -1030,6 +1053,7 @@ instance ToSchema AllFeatureConfigs where <*> afcGuestLink .= featureField <*> afcSndFactorPasswordChallenge .= featureField <*> afcMLS .= featureField + <*> afcExposeInvitationURLsToTeamAdmin .= featureField where featureField :: forall cfg. @@ -1054,5 +1078,6 @@ instance Arbitrary AllFeatureConfigs where <*> arbitrary <*> arbitrary <*> arbitrary + <*> arbitrary makeLenses ''ImplicitLockStatus diff --git a/libs/wire-api/src/Wire/API/Team/Invitation.hs b/libs/wire-api/src/Wire/API/Team/Invitation.hs index 4476698097f..efcc60de35c 100644 --- a/libs/wire-api/src/Wire/API/Team/Invitation.hs +++ b/libs/wire-api/src/Wire/API/Team/Invitation.hs @@ -34,6 +34,7 @@ import Data.Id import Data.Json.Util import qualified Data.Swagger.Build.Api as Doc import Imports +import URI.ByteString import Wire.API.Team.Role (Role, defaultRole, typeRole) import Wire.API.User.Identity (Email, Phone) import Wire.API.User.Profile (Locale, Name) @@ -104,7 +105,8 @@ data Invitation = Invitation inCreatedBy :: Maybe UserId, inInviteeEmail :: Email, inInviteeName :: Maybe Name, - inInviteePhone :: Maybe Phone + inInviteePhone :: Maybe Phone, + inInviteeUrl :: Maybe (URIRef Absolute) } deriving stock (Eq, Show, Generic) deriving (Arbitrary) via (GenericUniform Invitation) @@ -134,6 +136,9 @@ modelTeamInvitation = Doc.defineModel "TeamInvitation" $ do Doc.property "phone" Doc.string' $ do Doc.description "Phone number of the invitee, in the E.164 format" Doc.optional + Doc.property "url" Doc.string' $ do + Doc.description "URL of the invitation link to be sent to the invitee" + Doc.optional instance ToJSON Invitation where toJSON i = @@ -145,7 +150,8 @@ instance ToJSON Invitation where "created_by" .= inCreatedBy i, "email" .= inInviteeEmail i, "name" .= inInviteeName i, - "phone" .= inInviteePhone i + "phone" .= inInviteePhone i, + "url" .= inInviteeUrl i ] instance FromJSON Invitation where @@ -160,6 +166,7 @@ instance FromJSON Invitation where <*> o .: "email" <*> o .:? "name" <*> o .:? "phone" + <*> o .:? "url" -------------------------------------------------------------------------------- -- InvitationList diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/InvitationList_team.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/InvitationList_team.hs index 5a3d0eee55d..2b94790051b 100644 --- a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/InvitationList_team.hs +++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/InvitationList_team.hs @@ -19,10 +19,12 @@ module Test.Wire.API.Golden.Generated.InvitationList_team where +import Data.Either.Combinators import Data.Id (Id (Id)) import Data.Json.Util (readUTCTimeMillis) import qualified Data.UUID as UUID (fromString) import Imports (Bool (False, True), Maybe (Just, Nothing), fromJust) +import URI.ByteString (parseURI, strictURIParserOptions) import Wire.API.Team.Invitation ( Invitation ( Invitation, @@ -32,6 +34,7 @@ import Wire.API.Team.Invitation inInviteeEmail, inInviteeName, inInviteePhone, + inInviteeUrl, inRole, inTeam ), @@ -49,10 +52,10 @@ testObject_InvitationList_team_2 = InvitationList { ilInvitations = [ Invitation - { inTeam = (Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000000000001"))), + { inTeam = Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000000000001")), inRole = RoleOwner, - inInvitation = (Id (fromJust (UUID.fromString "00000001-0000-0001-0000-000000000000"))), - inCreatedAt = (fromJust (readUTCTimeMillis "1864-05-08T09:28:36.729Z")), + inInvitation = Id (fromJust (UUID.fromString "00000001-0000-0001-0000-000000000000")), + inCreatedAt = fromJust (readUTCTimeMillis "1864-05-08T09:28:36.729Z"), inCreatedBy = Just (Id (fromJust (UUID.fromString "00000001-0000-0001-0000-000000000000"))), inInviteeEmail = Email {emailLocal = "\153442", emailDomain = "w"}, inInviteeName = @@ -62,7 +65,8 @@ testObject_InvitationList_team_2 = "fuC9p\1098501A\163554\f\ENQ\SO\21027N\47326_?oCX.U\r\163744W\33096\58996\1038685\DC3\t[\37667\SYN/\8408A\145025\173325\DC4H\135001\STX\166880\EOT\165028o\DC3" } ), - inInviteePhone = Just (Phone {fromPhone = "+851333011"}) + inInviteePhone = Just (Phone {fromPhone = "+851333011"}), + inInviteeUrl = Just (fromRight' (parseURI strictURIParserOptions "https://example.com/inv14")) } ], ilHasMore = True @@ -76,10 +80,10 @@ testObject_InvitationList_team_4 = InvitationList { ilInvitations = [ Invitation - { inTeam = (Id (fromJust (UUID.fromString "00000000-0000-0001-0000-000000000000"))), + { inTeam = Id (fromJust (UUID.fromString "00000000-0000-0001-0000-000000000000")), inRole = RoleAdmin, - inInvitation = (Id (fromJust (UUID.fromString "00000001-0000-0001-0000-000100000000"))), - inCreatedAt = (fromJust (readUTCTimeMillis "1864-05-09T19:46:50.121Z")), + inInvitation = Id (fromJust (UUID.fromString "00000001-0000-0001-0000-000100000000")), + inCreatedAt = fromJust (readUTCTimeMillis "1864-05-09T19:46:50.121Z"), inCreatedBy = Just (Id (fromJust (UUID.fromString "00000001-0000-0001-0000-000000000000"))), inInviteeEmail = Email {emailLocal = "", emailDomain = ""}, inInviteeName = @@ -89,13 +93,14 @@ testObject_InvitationList_team_4 = "R6\133444\134053VQ\187682\SUB\SOH\180538\&0C\1088909\ESCR\185800\125002@\38857Z?\STX\169387\1067878e}\SOH\ETB\EOTm\184898\US]\986782\189015\1059374\986508\b\DC1zfw-5\120662\CAN\1064450 \EMe\DC4|\14426Vo{\1076439\DC3#\USS\45051&zz\160719\&9\142411,\SI\f\SOHp\1025840\DLE\163178\1060369.&\997544kZ\50431u\b\50764\1109279n:\1103691D$.Q" } ), - inInviteePhone = Just (Phone {fromPhone = "+60506387292"}) + inInviteePhone = Just (Phone {fromPhone = "+60506387292"}), + inInviteeUrl = Nothing }, Invitation - { inTeam = (Id (fromJust (UUID.fromString "00000000-0000-0001-0000-000100000000"))), + { inTeam = Id (fromJust (UUID.fromString "00000000-0000-0001-0000-000100000000")), inRole = RoleAdmin, - inInvitation = (Id (fromJust (UUID.fromString "00000001-0000-0000-0000-000100000000"))), - inCreatedAt = (fromJust (readUTCTimeMillis "1864-05-09T09:00:02.901Z")), + inInvitation = Id (fromJust (UUID.fromString "00000001-0000-0000-0000-000100000000")), + inCreatedAt = fromJust (readUTCTimeMillis "1864-05-09T09:00:02.901Z"), inCreatedBy = Just (Id (fromJust (UUID.fromString "00000000-0000-0001-0000-000000000000"))), inInviteeEmail = Email {emailLocal = "", emailDomain = ""}, inInviteeName = @@ -105,13 +110,14 @@ testObject_InvitationList_team_4 = "\DC2}q\CAN=SA\ETXx\t\ETX\\\v[\b)(\ESC]\135875Y\v@p\41515l\45065\157388\NUL\t\1100066\SOH1\DC1\ENQ\1021763\"i\29460\EM\b\ACK\SI\DC2v\ACK" } ), - inInviteePhone = Just (Phone {fromPhone = "+913945015"}) + inInviteePhone = Just (Phone {fromPhone = "+913945015"}), + inInviteeUrl = Nothing }, Invitation - { inTeam = (Id (fromJust (UUID.fromString "00000001-0000-0000-0000-000000000001"))), + { inTeam = Id (fromJust (UUID.fromString "00000001-0000-0000-0000-000000000001")), inRole = RoleMember, - inInvitation = (Id (fromJust (UUID.fromString "00000001-0000-0001-0000-000100000001"))), - inCreatedAt = (fromJust (readUTCTimeMillis "1864-05-09T11:10:31.203Z")), + inInvitation = Id (fromJust (UUID.fromString "00000001-0000-0001-0000-000100000001")), + inCreatedAt = fromJust (readUTCTimeMillis "1864-05-09T11:10:31.203Z"), inCreatedBy = Just (Id (fromJust (UUID.fromString "00000001-0000-0001-0000-000000000000"))), inInviteeEmail = Email {emailLocal = "", emailDomain = ""}, inInviteeName = @@ -121,13 +127,14 @@ testObject_InvitationList_team_4 = "\58076&\1059325Ec\NUL\16147}k\1036184l\172911\USJ\EM0^.+F\DEL\NUL\f$'`!\ETB[p\1041609}>E0y\96440#4I\a\66593jc\ESCgt\22473\1093208P\DC4!\1095909E93'Y$YL\46886b\r:,\181790\SO\153247y\ETX;\1064633\1099478z4z-D\1096755a\139100\&6\164829r\1033640\987906J\DLE\48134" } ), - inInviteePhone = Just (Phone {fromPhone = "+17046334"}) + inInviteePhone = Just (Phone {fromPhone = "+17046334"}), + inInviteeUrl = Nothing }, Invitation - { inTeam = (Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000000000000"))), + { inTeam = Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000000000000")), inRole = RoleOwner, - inInvitation = (Id (fromJust (UUID.fromString "00000001-0000-0000-0000-000000000000"))), - inCreatedAt = (fromJust (readUTCTimeMillis "1864-05-09T23:41:34.529Z")), + inInvitation = Id (fromJust (UUID.fromString "00000001-0000-0000-0000-000000000000")), + inCreatedAt = fromJust (readUTCTimeMillis "1864-05-09T23:41:34.529Z"), inCreatedBy = Just (Id (fromJust (UUID.fromString "00000001-0000-0001-0000-000100000000"))), inInviteeEmail = Email {emailLocal = "", emailDomain = ""}, inInviteeName = @@ -137,23 +144,25 @@ testObject_InvitationList_team_4 = "Ft*O1\b&\SO\CAN<\72219\1092619m\n\DC4\DC2; \ETX\988837\DC1\1059627\"k.T\1023249[[\FS\EOT{j`\GS\997342c\1066411{\SUB\GSQY\182805\t\NAKy\t\132339j\1036225W " } ), - inInviteePhone = Nothing + inInviteePhone = Nothing, + inInviteeUrl = Nothing }, Invitation - { inTeam = (Id (fromJust (UUID.fromString "00000001-0000-0000-0000-000100000000"))), + { inTeam = Id (fromJust (UUID.fromString "00000001-0000-0000-0000-000100000000")), inRole = RoleAdmin, - inInvitation = (Id (fromJust (UUID.fromString "00000001-0000-0000-0000-000000000000"))), - inCreatedAt = (fromJust (readUTCTimeMillis "1864-05-09T00:29:17.658Z")), + inInvitation = Id (fromJust (UUID.fromString "00000001-0000-0000-0000-000000000000")), + inCreatedAt = fromJust (readUTCTimeMillis "1864-05-09T00:29:17.658Z"), inCreatedBy = Just (Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000000000001"))), inInviteeEmail = Email {emailLocal = "", emailDomain = ""}, inInviteeName = Nothing, - inInviteePhone = Just (Phone {fromPhone = "+918848647685283"}) + inInviteePhone = Just (Phone {fromPhone = "+918848647685283"}), + inInviteeUrl = Nothing }, Invitation - { inTeam = (Id (fromJust (UUID.fromString "00000001-0000-0000-0000-000100000001"))), + { inTeam = Id (fromJust (UUID.fromString "00000001-0000-0000-0000-000100000001")), inRole = RoleOwner, - inInvitation = (Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000100000001"))), - inCreatedAt = (fromJust (readUTCTimeMillis "1864-05-09T13:34:37.117Z")), + inInvitation = Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000100000001")), + inCreatedAt = fromJust (readUTCTimeMillis "1864-05-09T13:34:37.117Z"), inCreatedBy = Just (Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000100000001"))), inInviteeEmail = Email {emailLocal = "", emailDomain = ""}, inInviteeName = @@ -163,13 +172,14 @@ testObject_InvitationList_team_4 = "Lo\r\1107113 @@ -31,62 +29,66 @@ import Wire.API.User.Profile (Name (Name, fromName)) testObject_Invitation_team_1 :: Invitation testObject_Invitation_team_1 = Invitation - { inTeam = (Id (fromJust (UUID.fromString "00000002-0000-0001-0000-000200000002"))), + { inTeam = Id (fromJust (UUID.fromString "00000002-0000-0001-0000-000200000002")), inRole = RoleAdmin, - inInvitation = (Id (fromJust (UUID.fromString "00000002-0000-0001-0000-000200000000"))), - inCreatedAt = (fromJust (readUTCTimeMillis "1864-05-11T20:13:15.856Z")), + inInvitation = Id (fromJust (UUID.fromString "00000002-0000-0001-0000-000200000000")), + inCreatedAt = fromJust (readUTCTimeMillis "1864-05-11T20:13:15.856Z"), inCreatedBy = Just (Id (fromJust (UUID.fromString "00000002-0000-0000-0000-000100000001"))), inInviteeEmail = Email {emailLocal = "\FS\58114Y", emailDomain = "7"}, inInviteeName = Nothing, - inInviteePhone = Just (Phone {fromPhone = "+54687000371"}) + inInviteePhone = Just (Phone {fromPhone = "+54687000371"}), + inInviteeUrl = Nothing } testObject_Invitation_team_2 :: Invitation testObject_Invitation_team_2 = Invitation - { inTeam = (Id (fromJust (UUID.fromString "00000000-0000-0001-0000-000000000000"))), + { inTeam = Id (fromJust (UUID.fromString "00000000-0000-0001-0000-000000000000")), inRole = RoleExternalPartner, - inInvitation = (Id (fromJust (UUID.fromString "00000002-0000-0001-0000-000100000002"))), - inCreatedAt = (fromJust (readUTCTimeMillis "1864-05-12T14:47:35.551Z")), + inInvitation = Id (fromJust (UUID.fromString "00000002-0000-0001-0000-000100000002")), + inCreatedAt = fromJust (readUTCTimeMillis "1864-05-12T14:47:35.551Z"), inCreatedBy = Just (Id (fromJust (UUID.fromString "00000002-0000-0001-0000-000200000001"))), inInviteeEmail = Email {emailLocal = "i", emailDomain = "m_:"}, inInviteeName = Just (Name {fromName = "\1067847} 2pGEW+\rT\171609p\174643\157218&\146145v0\b"}), - inInviteePhone = Nothing + inInviteePhone = Nothing, + inInviteeUrl = Nothing } testObject_Invitation_team_3 :: Invitation testObject_Invitation_team_3 = Invitation - { inTeam = (Id (fromJust (UUID.fromString "00000002-0000-0001-0000-000100000001"))), + { inTeam = Id (fromJust (UUID.fromString "00000002-0000-0001-0000-000100000001")), inRole = RoleExternalPartner, - inInvitation = (Id (fromJust (UUID.fromString "00000002-0000-0001-0000-000100000002"))), - inCreatedAt = (fromJust (readUTCTimeMillis "1864-05-08T22:07:35.846Z")), + inInvitation = Id (fromJust (UUID.fromString "00000002-0000-0001-0000-000100000002")), + inCreatedAt = fromJust (readUTCTimeMillis "1864-05-08T22:07:35.846Z"), inCreatedBy = Just (Id (fromJust (UUID.fromString "00000001-0000-0002-0000-000200000001"))), inInviteeEmail = Email {emailLocal = "", emailDomain = "\31189L"}, inInviteeName = Nothing, - inInviteePhone = Nothing + inInviteePhone = Nothing, + inInviteeUrl = Nothing } testObject_Invitation_team_4 :: Invitation testObject_Invitation_team_4 = Invitation - { inTeam = (Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000100000000"))), + { inTeam = Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000100000000")), inRole = RoleAdmin, - inInvitation = (Id (fromJust (UUID.fromString "00000001-0000-0001-0000-000000000001"))), - inCreatedAt = (fromJust (readUTCTimeMillis "1864-05-09T09:23:58.270Z")), + inInvitation = Id (fromJust (UUID.fromString "00000001-0000-0001-0000-000000000001")), + inCreatedAt = fromJust (readUTCTimeMillis "1864-05-09T09:23:58.270Z"), inCreatedBy = Just (Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000200000001"))), inInviteeEmail = Email {emailLocal = "^", emailDomain = "e"}, inInviteeName = Nothing, - inInviteePhone = Nothing + inInviteePhone = Nothing, + inInviteeUrl = Nothing } testObject_Invitation_team_5 :: Invitation testObject_Invitation_team_5 = Invitation - { inTeam = (Id (fromJust (UUID.fromString "00000002-0000-0000-0000-000000000001"))), + { inTeam = Id (fromJust (UUID.fromString "00000002-0000-0000-0000-000000000001")), inRole = RoleOwner, - inInvitation = (Id (fromJust (UUID.fromString "00000000-0000-0002-0000-000000000002"))), - inCreatedAt = (fromJust (readUTCTimeMillis "1864-05-09T03:42:15.266Z")), + inInvitation = Id (fromJust (UUID.fromString "00000000-0000-0002-0000-000000000002")), + inCreatedAt = fromJust (readUTCTimeMillis "1864-05-09T03:42:15.266Z"), inCreatedBy = Nothing, inInviteeEmail = Email {emailLocal = "\SOHV", emailDomain = "f\1086249\43462"}, inInviteeName = @@ -96,16 +98,17 @@ testObject_Invitation_team_5 = "}G_\147658`X\1028823\131485\1014942L\"\1047959e6:E\DEL\51733\993223f-$\133906Z!s2p?#\tF 8\188400\165247\1023303\EOT\1087640*\1017476\SYN\DLE%Y\167940>\1111565\1042998\1027480g\"\1055088\SUB\SUB\180703\43419\EOTv\188258,\171408(\GSQT\150160;\1063450\ENQ\ETBB\1106414H\170195\\\1040638,Y" } ), - inInviteePhone = Just (Phone {fromPhone = "+45207005641274"}) + inInviteePhone = Just (Phone {fromPhone = "+45207005641274"}), + inInviteeUrl = Nothing } testObject_Invitation_team_6 :: Invitation testObject_Invitation_team_6 = Invitation - { inTeam = (Id (fromJust (UUID.fromString "00000001-0000-0000-0000-000000000001"))), + { inTeam = Id (fromJust (UUID.fromString "00000001-0000-0000-0000-000000000001")), inRole = RoleAdmin, - inInvitation = (Id (fromJust (UUID.fromString "00000001-0000-0002-0000-000100000000"))), - inCreatedAt = (fromJust (readUTCTimeMillis "1864-05-09T08:56:40.919Z")), + inInvitation = Id (fromJust (UUID.fromString "00000001-0000-0002-0000-000100000000")), + inCreatedAt = fromJust (readUTCTimeMillis "1864-05-09T08:56:40.919Z"), inCreatedBy = Just (Id (fromJust (UUID.fromString "00000001-0000-0001-0000-000200000000"))), inInviteeEmail = Email {emailLocal = "", emailDomain = "OC"}, inInviteeName = @@ -115,16 +118,17 @@ testObject_Invitation_team_6 = "O~\DC4U\RS?V3_\191280Slh\1072236Q1\1011443j|~M7\1092762\1097596\94632\DC1K\1078140Afs\178951lGV\1113159]`o\EMf\34020InvfDDy\\DI\163761\1091945\ETBB\159212F*X\SOH\SUB\50580\ETX\DLE<\ETX\SYNc\DEL\DLE,p\v*\1005720Vn\fI\70201xS\STXV\ESC$\EMu\1002390xl>\aZ\DC44e\DC4aZ" } ), - inInviteePhone = Just (Phone {fromPhone = "+75547625285"}) + inInviteePhone = Just (Phone {fromPhone = "+75547625285"}), + inInviteeUrl = Nothing } testObject_Invitation_team_7 :: Invitation testObject_Invitation_team_7 = Invitation - { inTeam = (Id (fromJust (UUID.fromString "00000000-0000-0001-0000-000200000001"))), + { inTeam = Id (fromJust (UUID.fromString "00000000-0000-0001-0000-000200000001")), inRole = RoleExternalPartner, - inInvitation = (Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000000000002"))), - inCreatedAt = (fromJust (readUTCTimeMillis "1864-05-07T18:46:22.786Z")), + inInvitation = Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000000000002")), + inCreatedAt = fromJust (readUTCTimeMillis "1864-05-07T18:46:22.786Z"), inCreatedBy = Just (Id (fromJust (UUID.fromString "00000000-0000-0002-0000-000100000000"))), inInviteeEmail = Email {emailLocal = "oj", emailDomain = ""}, inInviteeName = @@ -134,55 +138,59 @@ testObject_Invitation_team_7 = "\CAN.\110967\1085214\DLE\f\DLE\CAN\150564o;Yay:yY $\ETX<\879%@\USre>5L'R\DC3\178035oy#]c4!\99741U\54858\26279\1042232\1062242p_>f\SO\DEL\175240\1077738\995735_Vm\US}\STXPz\r\ENQK\SO+>\991648\NUL\153467?pu?r\ESC\SUB!?\168405;\6533S\18757\a\1071148\b\1023581\996567\17385\120022\b\SUB\FS\SIF%<\125113\SIh\ESC\ETX\SI\994739\USO\NULg_\151272\47274\1026399\EOT\1058084\1089771z~%IA'R\b\1011572Hv^\1043633wrjb\t\166747\ETX" } ), - inInviteePhone = Just (Phone {fromPhone = "+518729615781"}) + inInviteePhone = Just (Phone {fromPhone = "+518729615781"}), + inInviteeUrl = Nothing } testObject_Invitation_team_12 :: Invitation testObject_Invitation_team_12 = Invitation - { inTeam = (Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000000000002"))), + { inTeam = Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000000000002")), inRole = RoleAdmin, - inInvitation = (Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000100000002"))), - inCreatedAt = (fromJust (readUTCTimeMillis "1864-05-12T22:47:35.829Z")), + inInvitation = Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000100000002")), + inCreatedAt = fromJust (readUTCTimeMillis "1864-05-12T22:47:35.829Z"), inCreatedBy = Just (Id (fromJust (UUID.fromString "00000002-0000-0002-0000-000000000000"))), inInviteeEmail = Email {emailLocal = "\1016862\141073\RS", emailDomain = ""}, inInviteeName = @@ -211,42 +220,45 @@ testObject_Invitation_team_12 = "\DLEZ+wd^\67082\1073384\&1\STXYdXt>\1081020LSB7F9\\\135148\ENQ\n\987295\"\127009|\a\61724\157754\DEL'\ESCTygU\1106772R\52822\1071584O4\1035713E9\"\1016016\DC2Re\ENQD}\1051112\161959\1104733\bV\176894%98'\RS9\ACK4yP\83405\14400\345\aw\t\1098022\v\1078003xv/Yl\1005740\158703" } ), - inInviteePhone = Just (Phone {fromPhone = "+68945103783764"}) + inInviteePhone = Just (Phone {fromPhone = "+68945103783764"}), + inInviteeUrl = Nothing } testObject_Invitation_team_13 :: Invitation testObject_Invitation_team_13 = Invitation - { inTeam = (Id (fromJust (UUID.fromString "00000002-0000-0001-0000-000000000001"))), + { inTeam = Id (fromJust (UUID.fromString "00000002-0000-0001-0000-000000000001")), inRole = RoleMember, - inInvitation = (Id (fromJust (UUID.fromString "00000002-0000-0000-0000-000200000002"))), - inCreatedAt = (fromJust (readUTCTimeMillis "1864-05-08T01:18:31.982Z")), + inInvitation = Id (fromJust (UUID.fromString "00000002-0000-0000-0000-000200000002")), + inCreatedAt = fromJust (readUTCTimeMillis "1864-05-08T01:18:31.982Z"), inCreatedBy = Just (Id (fromJust (UUID.fromString "00000001-0000-0002-0000-000100000002"))), inInviteeEmail = Email {emailLocal = "", emailDomain = "\DELr"}, inInviteeName = Just (Name {fromName = "U"}), - inInviteePhone = Just (Phone {fromPhone = "+549940856897515"}) + inInviteePhone = Just (Phone {fromPhone = "+549940856897515"}), + inInviteeUrl = Nothing } testObject_Invitation_team_14 :: Invitation testObject_Invitation_team_14 = Invitation - { inTeam = (Id (fromJust (UUID.fromString "00000002-0000-0002-0000-000100000000"))), + { inTeam = Id (fromJust (UUID.fromString "00000002-0000-0002-0000-000100000000")), inRole = RoleOwner, - inInvitation = (Id (fromJust (UUID.fromString "00000001-0000-0000-0000-000200000002"))), - inCreatedAt = (fromJust (readUTCTimeMillis "1864-05-12T23:54:25.090Z")), + inInvitation = Id (fromJust (UUID.fromString "00000001-0000-0000-0000-000200000002")), + inCreatedAt = fromJust (readUTCTimeMillis "1864-05-12T23:54:25.090Z"), inCreatedBy = Just (Id (fromJust (UUID.fromString "00000002-0000-0002-0000-000200000000"))), inInviteeEmail = Email {emailLocal = "EI", emailDomain = "{"}, inInviteeName = Nothing, - inInviteePhone = Just (Phone {fromPhone = "+89058877371"}) + inInviteePhone = Just (Phone {fromPhone = "+89058877371"}), + inInviteeUrl = Nothing } testObject_Invitation_team_15 :: Invitation testObject_Invitation_team_15 = Invitation - { inTeam = (Id (fromJust (UUID.fromString "00000000-0000-0002-0000-000100000001"))), + { inTeam = Id (fromJust (UUID.fromString "00000000-0000-0002-0000-000100000001")), inRole = RoleOwner, - inInvitation = (Id (fromJust (UUID.fromString "00000001-0000-0001-0000-000200000001"))), - inCreatedAt = (fromJust (readUTCTimeMillis "1864-05-08T22:22:28.568Z")), + inInvitation = Id (fromJust (UUID.fromString "00000001-0000-0001-0000-000200000001")), + inCreatedAt = fromJust (readUTCTimeMillis "1864-05-08T22:22:28.568Z"), inCreatedBy = Nothing, inInviteeEmail = Email {emailLocal = ".", emailDomain = "\DEL"}, inInviteeName = @@ -256,29 +268,31 @@ testObject_Invitation_team_15 = "\71448\US&KIL\DC3\1086159![\n6\1111661HEj4E\12136UL\US>2\1070931_\nJ\53410Pv\SO\SIR\30897\&8\bmS\45510mE\ag\SYN\ENQ%\14545\f!\v\US\119306\ENQ\184817\1044744\SO83!j\73854\GS\1071331,\RS\CANF\1062795\1110535U\EMJb\DC1j\EMY\92304O\1007855" } ), - inInviteePhone = Just (Phone {fromPhone = "+57741900390998"}) + inInviteePhone = Just (Phone {fromPhone = "+57741900390998"}), + inInviteeUrl = Nothing } testObject_Invitation_team_16 :: Invitation testObject_Invitation_team_16 = Invitation - { inTeam = (Id (fromJust (UUID.fromString "00000001-0000-0001-0000-000100000002"))), + { inTeam = Id (fromJust (UUID.fromString "00000001-0000-0001-0000-000100000002")), inRole = RoleExternalPartner, - inInvitation = (Id (fromJust (UUID.fromString "00000001-0000-0002-0000-000200000001"))), - inCreatedAt = (fromJust (readUTCTimeMillis "1864-05-09T09:56:33.113Z")), + inInvitation = Id (fromJust (UUID.fromString "00000001-0000-0002-0000-000200000001")), + inCreatedAt = fromJust (readUTCTimeMillis "1864-05-09T09:56:33.113Z"), inCreatedBy = Just (Id (fromJust (UUID.fromString "00000001-0000-0000-0000-000100000001"))), inInviteeEmail = Email {emailLocal = "\\", emailDomain = "\"\DEL{"}, inInviteeName = Just (Name {fromName = "\GS\DC4Q;6/_f*7\1093966\SI+\1092810\41698\&9"}), - inInviteePhone = Nothing + inInviteePhone = Nothing, + inInviteeUrl = Nothing } testObject_Invitation_team_17 :: Invitation testObject_Invitation_team_17 = Invitation - { inTeam = (Id (fromJust (UUID.fromString "00000002-0000-0001-0000-000000000002"))), + { inTeam = Id (fromJust (UUID.fromString "00000002-0000-0001-0000-000000000002")), inRole = RoleAdmin, - inInvitation = (Id (fromJust (UUID.fromString "00000001-0000-0001-0000-000100000001"))), - inCreatedAt = (fromJust (readUTCTimeMillis "1864-05-08T06:30:23.239Z")), + inInvitation = Id (fromJust (UUID.fromString "00000001-0000-0001-0000-000100000001")), + inCreatedAt = fromJust (readUTCTimeMillis "1864-05-08T06:30:23.239Z"), inCreatedBy = Just (Id (fromJust (UUID.fromString "00000000-0000-0001-0000-000000000001"))), inInviteeEmail = Email {emailLocal = "", emailDomain = "\SOH[\97119"}, inInviteeName = @@ -288,16 +302,17 @@ testObject_Invitation_team_17 = "Z\ESC9E\DEL\NAK\37708\83413}(3m\97177\97764'\1072786.WY;\RS8?v-\1100720\DC2\1015859" } ), - inInviteePhone = Nothing + inInviteePhone = Nothing, + inInviteeUrl = Nothing } testObject_Invitation_team_19 :: Invitation testObject_Invitation_team_19 = Invitation - { inTeam = (Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000200000000"))), + { inTeam = Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000200000000")), inRole = RoleMember, - inInvitation = (Id (fromJust (UUID.fromString "00000001-0000-0002-0000-000000000001"))), - inCreatedAt = (fromJust (readUTCTimeMillis "1864-05-07T15:08:06.796Z")), + inInvitation = Id (fromJust (UUID.fromString "00000001-0000-0002-0000-000000000001")), + inCreatedAt = fromJust (readUTCTimeMillis "1864-05-07T15:08:06.796Z"), inCreatedBy = Nothing, inInviteeEmail = Email {emailLocal = "\1019726\96050\DEL", emailDomain = "(S\ETB"}, inInviteeName = @@ -326,18 +342,20 @@ testObject_Invitation_team_19 = "\38776r\111317\ETXQi\1000087\1097943\EM\170747\74323+\1067948Q?H=G-\RS;\1103719\SOq^K;a\1052250W\EM X\83384\1073320>M\980\26387jjbU-&\1040136v\NULy\181884\a|\SYNUfJCHjP\SO\1111555\27981DNA:~s" } ), - inInviteePhone = Just (Phone {fromPhone = "+05787228893"}) + inInviteePhone = Just (Phone {fromPhone = "+05787228893"}), + inInviteeUrl = Nothing } testObject_Invitation_team_20 :: Invitation testObject_Invitation_team_20 = Invitation - { inTeam = (Id (fromJust (UUID.fromString "00000001-0000-0000-0000-000000000000"))), + { inTeam = Id (fromJust (UUID.fromString "00000001-0000-0000-0000-000000000000")), inRole = RoleExternalPartner, - inInvitation = (Id (fromJust (UUID.fromString "00000002-0000-0001-0000-000000000001"))), - inCreatedAt = (fromJust (readUTCTimeMillis "1864-05-12T08:07:17.747Z")), + inInvitation = Id (fromJust (UUID.fromString "00000002-0000-0001-0000-000000000001")), + inCreatedAt = fromJust (readUTCTimeMillis "1864-05-12T08:07:17.747Z"), inCreatedBy = Just (Id (fromJust (UUID.fromString "00000000-0000-0001-0000-000100000001"))), inInviteeEmail = Email {emailLocal = "b", emailDomain = "u9T"}, inInviteeName = Nothing, - inInviteePhone = Just (Phone {fromPhone = "+27259486019"}) + inInviteePhone = Just (Phone {fromPhone = "+27259486019"}), + inInviteeUrl = Nothing } diff --git a/libs/wire-api/test/golden/testObject_InvitationList_team_10.json b/libs/wire-api/test/golden/testObject_InvitationList_team_10.json index f5a607418e0..c06f56c3cf3 100644 --- a/libs/wire-api/test/golden/testObject_InvitationList_team_10.json +++ b/libs/wire-api/test/golden/testObject_InvitationList_team_10.json @@ -9,7 +9,8 @@ "name": "P𥖧\u0006'e\u0010\u001d\"\u0011K󽗨Fcvm[\"Sc}U𑊒􂌨󿔟~!E􀖇\u000bV", "phone": null, "role": "member", - "team": "00000000-0000-0001-0000-000100000000" + "team": "00000000-0000-0001-0000-000100000000", + "url": null } ] } diff --git a/libs/wire-api/test/golden/testObject_InvitationList_team_11.json b/libs/wire-api/test/golden/testObject_InvitationList_team_11.json index 621efe7906c..3b5e6bce7fb 100644 --- a/libs/wire-api/test/golden/testObject_InvitationList_team_11.json +++ b/libs/wire-api/test/golden/testObject_InvitationList_team_11.json @@ -9,7 +9,8 @@ "name": "G\\,\u0000=ෝI-w󠀹}𠉭抳-92\u0013@\u0006\u001f\\F\u001a\"-r꒫6\u000fඬ\u001f*}c󼘹\u001f\u0007T8m@旅M\u0012#MIq\r4nW􍦐y\u0005Ud룫#𫶒5\n\u0002V]𨡀\"󶂃𩫘0:ﲼ𮭩+\u0001\u000bP󹎷X镟􅔧.\u0019N\"𬋻", "phone": "+872574694", "role": "admin", - "team": "00000000-0000-0001-0000-000100000000" + "team": "00000000-0000-0001-0000-000100000000", + "url" :null }, { "created_at": "1864-05-09T23:06:13.648Z", @@ -19,7 +20,8 @@ "name": "叕5q}B\u0001𦌜`ｲw\\X@󼶝𢼈7Mw,*z{𠚷&~", "phone": "+143031479742", "role": "partner", - "team": "00000000-0000-0001-0000-000000000001" + "team": "00000000-0000-0001-0000-000000000001", + "url" :null }, { "created_at": "1864-05-09T10:37:03.809Z", @@ -29,7 +31,8 @@ "name": "V􈫮\u0010qYﾋCU\u000e􄕀fQJ\u0005ਓq+\u0007\u0016󱊸\u0011@𤠼`坟qh+𬾬A7𦄡Y \u0011Tㅎ1_􈩇#B<􂡁;a6o=", "phone": "+236346166386230", "role": "partner", - "team": "00000001-0000-0000-0000-000000000000" + "team": "00000001-0000-0000-0000-000000000000", + "url" :null }, { "created_at": "1864-05-09T04:46:03.504Z", @@ -39,7 +42,8 @@ "name": ",􃠾{ս\u000c𬕻Uh죙\t\u001b\u0004\u0001O@\u001a_\u0002D􎰥𦀛\u0016g}", "phone": "+80162248", "role": "admin", - "team": "00000001-0000-0001-0000-000100000001" + "team": "00000001-0000-0001-0000-000100000001", + "url" :null }, { "created_at": "1864-05-09T12:53:52.047Z", @@ -49,7 +53,8 @@ "name": null, "phone": null, "role": "owner", - "team": "00000000-0000-0001-0000-000100000001" + "team": "00000000-0000-0001-0000-000100000001", + "url" :null } ] } diff --git a/libs/wire-api/test/golden/testObject_InvitationList_team_16.json b/libs/wire-api/test/golden/testObject_InvitationList_team_16.json index fc14ac96bf2..535fe0678e2 100644 --- a/libs/wire-api/test/golden/testObject_InvitationList_team_16.json +++ b/libs/wire-api/test/golden/testObject_InvitationList_team_16.json @@ -9,7 +9,8 @@ "name": "E𝘆YM<󾪤j􆢆\r􇳗O󴟴MCU\u001eI󳊃m𔒷hG\u0012|:P􅛽Vj\u001c\u0000ffgG)K{􁇏7x5󱟰𪔘\n\u000clT􆊞", "phone": "+36515555", "role": "owner", - "team": "00000001-0000-0001-0000-000100000001" + "team": "00000001-0000-0001-0000-000100000001", + "url": null } ] } diff --git a/libs/wire-api/test/golden/testObject_InvitationList_team_17.json b/libs/wire-api/test/golden/testObject_InvitationList_team_17.json index c2c9ba044af..eba7991502c 100644 --- a/libs/wire-api/test/golden/testObject_InvitationList_team_17.json +++ b/libs/wire-api/test/golden/testObject_InvitationList_team_17.json @@ -9,7 +9,8 @@ "name": null, "phone": null, "role": "partner", - "team": "00000001-0000-0000-0000-000100000000" + "team": "00000001-0000-0000-0000-000100000000", + "url": null } ] } diff --git a/libs/wire-api/test/golden/testObject_InvitationList_team_2.json b/libs/wire-api/test/golden/testObject_InvitationList_team_2.json index e2f2601fb1f..076b78a0d43 100644 --- a/libs/wire-api/test/golden/testObject_InvitationList_team_2.json +++ b/libs/wire-api/test/golden/testObject_InvitationList_team_2.json @@ -9,7 +9,8 @@ "name": "fuC9p􌌅A𧻢\u000c\u0005\u000e刣N룞_?oCX.U\r𧾠W腈󽥝\u0013\t[錣\u0016/⃘A𣚁𪔍\u0014H𠽙\u0002𨯠\u0004𨒤o\u0013", "phone": "+851333011", "role": "owner", - "team": "00000000-0000-0000-0000-000000000001" + "team": "00000000-0000-0000-0000-000000000001", + "url": "https://example.com/inv14" } ] } diff --git a/libs/wire-api/test/golden/testObject_InvitationList_team_20.json b/libs/wire-api/test/golden/testObject_InvitationList_team_20.json index 1b50ca8071e..26a5ab01344 100644 --- a/libs/wire-api/test/golden/testObject_InvitationList_team_20.json +++ b/libs/wire-api/test/golden/testObject_InvitationList_team_20.json @@ -9,7 +9,8 @@ "name": null, "phone": "+745177056001783", "role": "partner", - "team": "00000001-0000-0001-0000-000000000000" + "team": "00000001-0000-0001-0000-000000000000", + "url": null }, { "created_at": "1864-05-09T18:56:29.712Z", @@ -19,7 +20,8 @@ "name": "YPf╞:\u0005Ỉ&\u0018\u0011󽧛%ꦡk𪯋􅥏:Q\u0005F+\u0008b8Jh􌎓K\u0007\u001dY\u0004􃏡\u000f󽝰\u0016 􁗠6>I󾉩B$z?𤢾wECB\u001e𥼬덄\"W𗤞󲴂@\u001eg)\u0001m!-U􇧦󵜰o\u0006a\u0004𭂢;R􂪧kgT􍆈f\u0004\u001e\rp𓎎󿉊X/􄂲)\u00025.Ym󵳬n싟N\u0013𫅄]?'𠴺a4\"󳟾!i5\u001e\u001dC14", "phone": null, "role": "owner", - "team": "00000001-0000-0000-0000-000100000000" + "team": "00000001-0000-0000-0000-000100000000", + "url": null } ] } diff --git a/libs/wire-api/test/golden/testObject_InvitationList_team_4.json b/libs/wire-api/test/golden/testObject_InvitationList_team_4.json index e41e76da520..3063b4fdeb3 100644 --- a/libs/wire-api/test/golden/testObject_InvitationList_team_4.json +++ b/libs/wire-api/test/golden/testObject_InvitationList_team_4.json @@ -9,7 +9,8 @@ "name": "R6𠥄𠮥VQ𭴢\u001a\u0001𬄺0C􉶍\u001bR𭗈𞡊@韉Z?\u0002𩖫􄭦e}\u0001\u0017\u0004m𭉂\u001f]󰺞𮉗􂨮󰶌\u0008\u0011zfw-5𝝖\u0018􃸂 \u0019e\u0014|㡚Vo{􆳗\u0013#\u001fS꿻&zz𧏏9𢱋,\u000f\u000c\u0001p󺜰\u0010𧵪􂸑.&󳢨kZ쓿u\u0008왌􎴟n:􍝋D$.Q", "phone": "+60506387292", "role": "admin", - "team": "00000000-0000-0001-0000-000000000000" + "team": "00000000-0000-0001-0000-000000000000", + "url": null }, { "created_at": "1864-05-09T09:00:02.901Z", @@ -19,7 +20,8 @@ "name": "\u0012}q\u0018=SA\u0003x\t\u0003\\\u000b[\u0008)(\u001b]𡋃Y\u000b@pꈫl뀉𦛌\u0000\t􌤢\u00011\u0011\u0005󹝃\"i猔\u0019\u0008\u0006\u000f\u0012v\u0006", "phone": "+913945015", "role": "admin", - "team": "00000000-0000-0001-0000-000100000000" + "team": "00000000-0000-0001-0000-000100000000", + "url": null }, { "created_at": "1864-05-09T11:10:31.203Z", @@ -29,7 +31,8 @@ "name": "&􂧽Ec\u0000㼓}k󼾘l𪍯\u001fJ\u00190^.+F\u0000\u000c$'`!\u0017[p󾓉}>E0y𗢸#4I\u0007𐐡jc\u001bgt埉􊹘P\u0014!􋣥E93'Y$YL뜦b\r:,𬘞\u000e𥚟y\u0003;􃺹􌛖z4z-D􋰳a𡽜6𨏝r󼖨󱌂J\u0010밆", "phone": "+17046334", "role": "member", - "team": "00000001-0000-0000-0000-000000000001" + "team": "00000001-0000-0000-0000-000000000001", + "url": null }, { "created_at": "1864-05-09T23:41:34.529Z", @@ -39,7 +42,8 @@ "name": "Ft*O1\u0008&\u000e\u0018<𑨛􊰋m\n\u0014\u0012; \u0003󱚥\u0011􂬫\"k.T󹴑[[\u001c\u0004{j`\u001d󳟞c􄖫{\u001a\u001dQY𬨕\t\u0015y\t𠓳j󼿁W ", "phone": null, "role": "owner", - "team": "00000000-0000-0000-0000-000000000000" + "team": "00000000-0000-0000-0000-000000000000", + "url": null }, { "created_at": "1864-05-09T00:29:17.658Z", @@ -49,7 +53,8 @@ "name": null, "phone": "+918848647685283", "role": "admin", - "team": "00000001-0000-0000-0000-000100000000" + "team": "00000001-0000-0000-0000-000100000000", + "url": null }, { "created_at": "1864-05-09T13:34:37.117Z", @@ -59,7 +64,8 @@ "name": "Lo\r􎒩B𗚰_v󰔢􆍶󻀬􊽦9\u0002vyQ🖰&W󻟑𠸘􇹬'􁔫:𤟗𡶘􏹠}-o󿜊le8Zp󺩐􋾙)nK\u00140⛟0DE\u0015K$io\u001e|Ip2ClnU𬖍", "phone": "+2239859474784", "role": "owner", - "team": "00000001-0000-0001-0000-000100000000" + "team": "00000001-0000-0001-0000-000100000000", + "url": null } ] } diff --git a/libs/wire-api/test/golden/testObject_InvitationList_team_6.json b/libs/wire-api/test/golden/testObject_InvitationList_team_6.json index 2285c8dc7ab..03aa3d04857 100644 --- a/libs/wire-api/test/golden/testObject_InvitationList_team_6.json +++ b/libs/wire-api/test/golden/testObject_InvitationList_team_6.json @@ -9,7 +9,8 @@ "name": null, "phone": null, "role": "admin", - "team": "00000001-0000-0001-0000-000100000000" + "team": "00000001-0000-0001-0000-000100000000", + "url": null }, { "created_at": "1864-05-09T11:26:36.672Z", @@ -19,7 +20,8 @@ "name": null, "phone": "+85999765", "role": "admin", - "team": "00000000-0000-0000-0000-000100000000" + "team": "00000000-0000-0000-0000-000100000000", + "url": null }, { "created_at": "1864-05-09T00:31:56.241Z", @@ -29,7 +31,8 @@ "name": null, "phone": "+150835819626453", "role": "owner", - "team": "00000001-0000-0000-0000-000100000000" + "team": "00000001-0000-0000-0000-000100000000", + "url": null }, { "created_at": "1864-05-09T21:10:47.237Z", @@ -39,7 +42,8 @@ "name": "YBc\r웶8{\\\n􋸓+\u0008\u0016'<\u0004􈄿Z\u0007nOb􋨴􌸖𩮤}2o@v/", "phone": "+787465997389", "role": "member", - "team": "00000000-0000-0001-0000-000100000000" + "team": "00000000-0000-0001-0000-000100000000", + "url": null } ] } diff --git a/libs/wire-api/test/golden/testObject_Invitation_team_1.json b/libs/wire-api/test/golden/testObject_Invitation_team_1.json index 9d611aa22e5..ee4489e209d 100644 --- a/libs/wire-api/test/golden/testObject_Invitation_team_1.json +++ b/libs/wire-api/test/golden/testObject_Invitation_team_1.json @@ -6,5 +6,6 @@ "name": null, "phone": "+54687000371", "role": "admin", - "team": "00000002-0000-0001-0000-000200000002" + "team": "00000002-0000-0001-0000-000200000002", + "url": null } diff --git a/libs/wire-api/test/golden/testObject_Invitation_team_10.json b/libs/wire-api/test/golden/testObject_Invitation_team_10.json index 447daf009cc..9c189f7c134 100644 --- a/libs/wire-api/test/golden/testObject_Invitation_team_10.json +++ b/libs/wire-api/test/golden/testObject_Invitation_team_10.json @@ -6,5 +6,6 @@ "name": null, "phone": "+957591063736", "role": "partner", - "team": "00000002-0000-0001-0000-000100000001" + "team": "00000002-0000-0001-0000-000100000001", + "url": null } diff --git a/libs/wire-api/test/golden/testObject_Invitation_team_11.json b/libs/wire-api/test/golden/testObject_Invitation_team_11.json index 09e6c67ff7c..a1d4b2e572f 100644 --- a/libs/wire-api/test/golden/testObject_Invitation_team_11.json +++ b/libs/wire-api/test/golden/testObject_Invitation_team_11.json @@ -6,5 +6,6 @@ "name": "􄘬,􍁨緌sC\nD\u001e󱫂*\u0011𧲍\u0011󲾁a󽌳𗿸{.熿𭒪빝𡨶9/ಇ<;$𭣘𠪹Z\u0005'󺠞!F􎉼󼪟n\"\n8\u001dH󼯢9𐪜z:d\u0010F𧕰y_w\ri轭!>󳓗䏩𝓖\u0008\u001a\u001c\u000fF%<𞢹\u000fh\u001b\u0003\u000f󲶳\u001fO\u0000g_𤻨뢪󺥟\u0004􂔤􊃫z~%IA'R\u0008󶽴Hv^󾲱wrjb\t𨭛\u0003", "phone": "+518729615781", "role": "admin", - "team": "00000001-0000-0001-0000-000100000000" + "team": "00000001-0000-0001-0000-000100000000", + "url": null } diff --git a/libs/wire-api/test/golden/testObject_Invitation_team_12.json b/libs/wire-api/test/golden/testObject_Invitation_team_12.json index 866b59a7897..ece82b4d173 100644 --- a/libs/wire-api/test/golden/testObject_Invitation_team_12.json +++ b/libs/wire-api/test/golden/testObject_Invitation_team_12.json @@ -6,5 +6,6 @@ "name": "\u0010Z+wd^𐘊􆃨1\u0002YdXt>􇺼LSB7F9\\𠿬\u0005\n󱂟\"🀡|\u0007𦠺'\u001bTygU􎍔R칖􅧠O4󼷁E9\"󸃐\u0012Re\u0005D}􀧨𧢧􍭝\u0008V𫋾%98'\u001e9\u00064yP𔗍㡀ř\u0007w\t􌄦\u000b􇋳xv/Yl󵢬𦯯", "phone": "+68945103783764", "role": "admin", - "team": "00000000-0000-0000-0000-000000000002" + "team": "00000000-0000-0000-0000-000000000002", + "url": null } diff --git a/libs/wire-api/test/golden/testObject_Invitation_team_13.json b/libs/wire-api/test/golden/testObject_Invitation_team_13.json index 789b4a32975..f12163f667d 100644 --- a/libs/wire-api/test/golden/testObject_Invitation_team_13.json +++ b/libs/wire-api/test/golden/testObject_Invitation_team_13.json @@ -6,5 +6,6 @@ "name": "U", "phone": "+549940856897515", "role": "member", - "team": "00000002-0000-0001-0000-000000000001" + "team": "00000002-0000-0001-0000-000000000001", + "url": null } diff --git a/libs/wire-api/test/golden/testObject_Invitation_team_14.json b/libs/wire-api/test/golden/testObject_Invitation_team_14.json index 1f1ac31cc4d..7b5764a6871 100644 --- a/libs/wire-api/test/golden/testObject_Invitation_team_14.json +++ b/libs/wire-api/test/golden/testObject_Invitation_team_14.json @@ -6,5 +6,6 @@ "name": null, "phone": "+89058877371", "role": "owner", - "team": "00000002-0000-0002-0000-000100000000" + "team": "00000002-0000-0002-0000-000100000000", + "url": null } diff --git a/libs/wire-api/test/golden/testObject_Invitation_team_15.json b/libs/wire-api/test/golden/testObject_Invitation_team_15.json index 8ec11e965f6..7d5215c7822 100644 --- a/libs/wire-api/test/golden/testObject_Invitation_team_15.json +++ b/libs/wire-api/test/golden/testObject_Invitation_team_15.json @@ -6,5 +6,6 @@ "name": "𑜘\u001f&KIL\u0013􉋏![\n6􏙭HEj4E⽨UL\u001f>2􅝓_\nJ킢Pv\u000e\u000fR碱8\u0008mS뇆mE\u0007g\u0016\u0005%㣑\u000c!\u000b\u001f𝈊\u0005𭇱󿄈\u000e83!j𒁾\u001d􅣣,\u001e\u0018F􃞋􏈇U\u0019Jb\u0011j\u0019Y𖢐O󶃯", "phone": "+57741900390998", "role": "owner", - "team": "00000000-0000-0002-0000-000100000001" + "team": "00000000-0000-0002-0000-000100000001", + "url": null } diff --git a/libs/wire-api/test/golden/testObject_Invitation_team_16.json b/libs/wire-api/test/golden/testObject_Invitation_team_16.json index 1ade470dd6b..853aab3be71 100644 --- a/libs/wire-api/test/golden/testObject_Invitation_team_16.json +++ b/libs/wire-api/test/golden/testObject_Invitation_team_16.json @@ -6,5 +6,6 @@ "name": "\u001d\u0014Q;6/_f*7􋅎\u000f+􊳊ꋢ9", "phone": null, "role": "partner", - "team": "00000001-0000-0001-0000-000100000002" + "team": "00000001-0000-0001-0000-000100000002", + "url": null } diff --git a/libs/wire-api/test/golden/testObject_Invitation_team_17.json b/libs/wire-api/test/golden/testObject_Invitation_team_17.json index ffaa39fdfc5..d7ae310a544 100644 --- a/libs/wire-api/test/golden/testObject_Invitation_team_17.json +++ b/libs/wire-api/test/golden/testObject_Invitation_team_17.json @@ -6,5 +6,6 @@ "name": "Z\u001b9E\u0015鍌𔗕}(3m𗮙𗷤'􅺒.WY;\u001e8?v-􌮰\u0012󸀳", "phone": null, "role": "admin", - "team": "00000000-0000-0001-0000-000100000000" + "team": "00000000-0000-0001-0000-000100000000", + "url": null } diff --git a/libs/wire-api/test/golden/testObject_Invitation_team_19.json b/libs/wire-api/test/golden/testObject_Invitation_team_19.json index 4f087c6be4e..aaa9b35ce06 100644 --- a/libs/wire-api/test/golden/testObject_Invitation_team_19.json +++ b/libs/wire-api/test/golden/testObject_Invitation_team_19.json @@ -6,5 +6,6 @@ "name": "靸r𛋕\u0003Qi󴊗􌃗\u0019𩫻𒉓+􄮬Q?H=G-\u001e;􍝧\u000eq^K;a􀹚W\u0019 X𔖸􆂨>Mϔ朓jjbU-&󽼈v\u0000y𬙼\u0007|\u0016UfJCHjP\u000e􏘃浍DNA:~s", "phone": "+05787228893", "role": "member", - "team": "00000000-0000-0000-0000-000200000000" + "team": "00000000-0000-0000-0000-000200000000", + "url": null } diff --git a/libs/wire-api/test/golden/testObject_Invitation_team_2.json b/libs/wire-api/test/golden/testObject_Invitation_team_2.json index c5227405c9f..393eaccd4f2 100644 --- a/libs/wire-api/test/golden/testObject_Invitation_team_2.json +++ b/libs/wire-api/test/golden/testObject_Invitation_team_2.json @@ -6,5 +6,6 @@ "name": "􄭇} 2pGEW+\rT𩹙p𪨳𦘢&𣫡v0\u0008", "phone": null, "role": "partner", - "team": "00000000-0000-0001-0000-000000000000" + "team": "00000000-0000-0001-0000-000000000000", + "url": null } diff --git a/libs/wire-api/test/golden/testObject_Invitation_team_20.json b/libs/wire-api/test/golden/testObject_Invitation_team_20.json index 8a036b8aff6..653fafc89ea 100644 --- a/libs/wire-api/test/golden/testObject_Invitation_team_20.json +++ b/libs/wire-api/test/golden/testObject_Invitation_team_20.json @@ -6,5 +6,6 @@ "name": null, "phone": "+27259486019", "role": "partner", - "team": "00000001-0000-0000-0000-000000000000" + "team": "00000001-0000-0000-0000-000000000000", + "url": null } diff --git a/libs/wire-api/test/golden/testObject_Invitation_team_3.json b/libs/wire-api/test/golden/testObject_Invitation_team_3.json index 81115420498..6222659d12a 100644 --- a/libs/wire-api/test/golden/testObject_Invitation_team_3.json +++ b/libs/wire-api/test/golden/testObject_Invitation_team_3.json @@ -6,5 +6,6 @@ "name": null, "phone": null, "role": "partner", - "team": "00000002-0000-0001-0000-000100000001" + "team": "00000002-0000-0001-0000-000100000001", + "url": null } diff --git a/libs/wire-api/test/golden/testObject_Invitation_team_4.json b/libs/wire-api/test/golden/testObject_Invitation_team_4.json index 76282c46540..8e8dedc4a4d 100644 --- a/libs/wire-api/test/golden/testObject_Invitation_team_4.json +++ b/libs/wire-api/test/golden/testObject_Invitation_team_4.json @@ -6,5 +6,6 @@ "name": null, "phone": null, "role": "admin", - "team": "00000000-0000-0000-0000-000100000000" + "team": "00000000-0000-0000-0000-000100000000", + "url": null } diff --git a/libs/wire-api/test/golden/testObject_Invitation_team_5.json b/libs/wire-api/test/golden/testObject_Invitation_team_5.json index 44a5cd464dc..ce4196efbb0 100644 --- a/libs/wire-api/test/golden/testObject_Invitation_team_5.json +++ b/libs/wire-api/test/golden/testObject_Invitation_team_5.json @@ -6,5 +6,6 @@ "name": "}G_𤃊`X󻋗𠆝󷲞L\"󿶗e6:E쨕󲟇f-$𠬒Z!s2p?#\tF 8𭿰𨕿󹵇\u0004􉢘*󸚄\u0016\u0010%Y𩀄>􏘍󾨶󺶘g\"􁥰\u001a\u001a𬇟ꦛ\u0004v𭽢,𩶐(\u001dQT𤪐;􃨚\u0005\u0017B􎇮H𩣓\\󾃾,Y", "phone": "+45207005641274", "role": "owner", - "team": "00000002-0000-0000-0000-000000000001" + "team": "00000002-0000-0000-0000-000000000001", + "url": null } diff --git a/libs/wire-api/test/golden/testObject_Invitation_team_6.json b/libs/wire-api/test/golden/testObject_Invitation_team_6.json index c847dcf4a2e..37e3f45bdcd 100644 --- a/libs/wire-api/test/golden/testObject_Invitation_team_6.json +++ b/libs/wire-api/test/golden/testObject_Invitation_team_6.json @@ -6,5 +6,6 @@ "name": "O~\u0014U\u001e?V3_𮬰Slh􅱬Q1󶻳j|~M7􊲚􋽼𗆨\u0011K􇍼Afs𫬇lGV􏱇]`o\u0019f蓤InvfDDy\\DI𧾱􊥩\u0017B𦷬F*X\u0001\u001a얔\u0003\u0010<\u0003\u0016c\u0010,p\u000b*󵢘Vn\u000cI𑈹xS\u0002V\u001b$\u0019u󴮖xl>\u0007Z\u00144e\u0014aZ", "phone": "+75547625285", "role": "admin", - "team": "00000001-0000-0000-0000-000000000001" + "team": "00000001-0000-0000-0000-000000000001", + "url": null } diff --git a/libs/wire-api/test/golden/testObject_Invitation_team_7.json b/libs/wire-api/test/golden/testObject_Invitation_team_7.json index d4699fe74de..844522e7165 100644 --- a/libs/wire-api/test/golden/testObject_Invitation_team_7.json +++ b/libs/wire-api/test/golden/testObject_Invitation_team_7.json @@ -6,5 +6,6 @@ "name": "\u0018.𛅷􈼞\u0010\u000c\u0010\u0018𤰤o;Yay:yY $\u0003<ͯ%@\u001fre>5L'R\u0013𫝳oy#]c4!𘖝U홊暧󾜸􃕢p_>f\u000e𪲈􇇪󳆗_Vm\u001f}\u0002Pz\r\u0005K\u000e+>󲆠\u0000𥝻?pu?r\u001b\u001a!?𩇕;ᦅS䥅\u0007􅠬\u0008󹹝=0.5 , currency-codes , directory + , either , filepath , hscim , imports diff --git a/services/brig/brig.cabal b/services/brig/brig.cabal index 392f90d30ee..95f744d763a 100644 --- a/services/brig/brig.cabal +++ b/services/brig/brig.cabal @@ -96,6 +96,7 @@ library Brig.Team.DB Brig.Team.Email Brig.Team.Template + Brig.Team.Types Brig.Team.Util Brig.Template Brig.Unique diff --git a/services/brig/src/Brig/API/Internal.hs b/services/brig/src/Brig/API/Internal.hs index 4a548f766d4..d4d567f4ba8 100644 --- a/services/brig/src/Brig/API/Internal.hs +++ b/services/brig/src/Brig/API/Internal.hs @@ -50,6 +50,7 @@ import Brig.Options hiding (internalEvents, sesQueue) import qualified Brig.Provider.API as Provider import qualified Brig.Team.API as Team import Brig.Team.DB (lookupInvitationByEmail) +import Brig.Team.Types (ShowOrHideInvitationUrl (..)) import Brig.Types.Connection import Brig.Types.Intra import Brig.Types.Team.LegalHold (LegalHoldClientRequest (..)) @@ -556,7 +557,7 @@ listActivatedAccounts elh includePendingInvitations = do case (accountStatus account, includePendingInvitations, emailIdentity ident) of (PendingInvitation, False, _) -> pure False (PendingInvitation, True, Just email) -> do - hasInvitation <- isJust <$> wrapClient (lookupInvitationByEmail email) + hasInvitation <- isJust <$> wrapClient (lookupInvitationByEmail HideInvitationUrl email) unless hasInvitation $ do -- user invited via scim should expire together with its invitation API.deleteUserNoVerify (userId . accountUser $ account) diff --git a/services/brig/src/Brig/API/User.hs b/services/brig/src/Brig/API/User.hs index ce19c9bdde1..ea3932461fb 100644 --- a/services/brig/src/Brig/API/User.hs +++ b/services/brig/src/Brig/API/User.hs @@ -125,6 +125,7 @@ import Brig.Options hiding (Timeout, internalEvents) import Brig.Password import qualified Brig.Queue as Queue import qualified Brig.Team.DB as Team +import Brig.Team.Types (ShowOrHideInvitationUrl (..)) import Brig.Types.Activation (ActivationPair) import Brig.Types.Connection import Brig.Types.Intra @@ -413,7 +414,7 @@ createUser new = do findTeamInvitation (Just e) c = lift (wrapClient $ Team.lookupInvitationInfo c) >>= \case Just ii -> do - inv <- lift . wrapClient $ Team.lookupInvitation (Team.iiTeam ii) (Team.iiInvId ii) + inv <- lift . wrapClient $ Team.lookupInvitation HideInvitationUrl (Team.iiTeam ii) (Team.iiInvId ii) case (inv, Team.inInviteeEmail <$> inv) of (Just invite, Just em) | e == userEmailKey em -> do diff --git a/services/brig/src/Brig/IO/Intra.hs b/services/brig/src/Brig/IO/Intra.hs index 51695d0a0fc..c5c4b65042f 100644 --- a/services/brig/src/Brig/IO/Intra.hs +++ b/services/brig/src/Brig/IO/Intra.hs @@ -59,6 +59,7 @@ module Brig.IO.Intra getTeamSearchVisibility, getAllFeatureConfigsForUser, getVerificationCodeEnabled, + getTeamExposeInvitationURLsToTeamAdmin, -- * Legalhold guardLegalhold, @@ -80,6 +81,7 @@ import qualified Brig.Data.Connection as Data import Brig.Federation.Client (notifyUserDeleted) import qualified Brig.IO.Journal as Journal import Brig.RPC +import Brig.Team.Types (ShowOrHideInvitationUrl (..)) import Brig.Types.User.Event import Brig.User.Search.Index (MonadIndexIO) import qualified Brig.User.Search.Index as Search @@ -1367,6 +1369,28 @@ getTeamSearchVisibility tid = paths ["i", "teams", toByteString' tid, "search-visibility"] . expect2xx +getTeamExposeInvitationURLsToTeamAdmin :: + ( MonadLogger m, + MonadReader Env m, + MonadIO m, + MonadMask m, + MonadHttp m, + HasRequestId m + ) => + TeamId -> + m ShowOrHideInvitationUrl +getTeamExposeInvitationURLsToTeamAdmin tid = do + debug $ remote "galley" . msg (val "Get expose invitation URLs to team admin settings") + response <- galleyRequest GET req + status <- wsStatus <$> decodeBody @(WithStatus ExposeInvitationURLsToTeamAdminConfig) "galley" response + case status of + FeatureStatusEnabled -> pure ShowInvitationUrl + FeatureStatusDisabled -> pure HideInvitationUrl + where + req = + paths ["i", "teams", toByteString' tid, "features", featureNameBS @ExposeInvitationURLsToTeamAdminConfig] + . expect2xx + getVerificationCodeEnabled :: ( MonadReader Env m, MonadIO m, diff --git a/services/brig/src/Brig/Team/API.hs b/services/brig/src/Brig/Team/API.hs index 74bda2dead8..f00cd9ae1b1 100644 --- a/services/brig/src/Brig/Team/API.hs +++ b/services/brig/src/Brig/Team/API.hs @@ -38,6 +38,7 @@ import Brig.Options (setMaxTeamSize, setTeamInvitationTimeout) import qualified Brig.Phone as Phone import qualified Brig.Team.DB as DB import Brig.Team.Email +import Brig.Team.Types (ShowOrHideInvitationUrl (..)) import Brig.Team.Util (ensurePermissionToAddUser, ensurePermissions) import Brig.Types.Intra (AccountStatus (..), NewUserScimInvitation (..), UserAccount (..)) import Brig.Types.Team (TeamSize) @@ -377,6 +378,7 @@ createInvitation' tid inviteeRole mbInviterUid fromEmail body = do let locale = irLocale body let inviteeName = irInviteeName body + showInvitationUrl <- lift $ wrapHttp $ Intra.getTeamExposeInvitationURLsToTeamAdmin tid lift $ do iid <- liftIO DB.mkInvitationId @@ -385,6 +387,7 @@ createInvitation' tid inviteeRole mbInviterUid fromEmail body = do (newInv, code) <- wrapClient $ DB.insertInvitation + showInvitationUrl iid tid inviteeRole @@ -412,7 +415,8 @@ listInvitationsH (_ ::: uid ::: tid ::: start ::: size) = do listInvitations :: UserId -> TeamId -> Maybe InvitationId -> Range 1 500 Int32 -> (Handler r) Public.InvitationList listInvitations uid tid start size = do ensurePermissions uid tid [AddTeamMember] - rs <- lift $ wrapClient $ DB.lookupInvitations tid start size + showInvitationUrl <- lift $ wrapHttp $ Intra.getTeamExposeInvitationURLsToTeamAdmin tid + rs <- lift $ wrapClient $ DB.lookupInvitations showInvitationUrl tid start size pure $! Public.InvitationList (DB.resultList rs) (DB.resultHasMore rs) getInvitationH :: JSON ::: UserId ::: TeamId ::: InvitationId -> (Handler r) Response @@ -425,7 +429,8 @@ getInvitationH (_ ::: uid ::: tid ::: iid) = do getInvitation :: UserId -> TeamId -> InvitationId -> (Handler r) (Maybe Public.Invitation) getInvitation uid tid iid = do ensurePermissions uid tid [AddTeamMember] - lift $ wrapClient $ DB.lookupInvitation tid iid + showInvitationUrl <- lift $ wrapHttp $ Intra.getTeamExposeInvitationURLsToTeamAdmin tid + lift $ wrapClient $ DB.lookupInvitation showInvitationUrl tid iid getInvitationByCodeH :: JSON ::: Public.InvitationCode -> (Handler r) Response getInvitationByCodeH (_ ::: c) = do @@ -433,7 +438,7 @@ getInvitationByCodeH (_ ::: c) = do getInvitationByCode :: Public.InvitationCode -> (Handler r) Public.Invitation getInvitationByCode c = do - inv <- lift . wrapClient $ DB.lookupInvitationByCode c + inv <- lift . wrapClient $ DB.lookupInvitationByCode HideInvitationUrl c maybe (throwStd $ errorToWai @'E.InvalidInvitationCode) pure inv headInvitationByEmailH :: JSON ::: Email -> (Handler r) Response @@ -453,7 +458,7 @@ getInvitationByEmailH (_ ::: email) = getInvitationByEmail :: Email -> (Handler r) Public.Invitation getInvitationByEmail email = do - inv <- lift $ wrapClient $ DB.lookupInvitationByEmail email + inv <- lift $ wrapClient $ DB.lookupInvitationByEmail HideInvitationUrl email maybe (throwStd (notFound "Invitation not found")) pure inv suspendTeamH :: JSON ::: TeamId -> (Handler r) Response diff --git a/services/brig/src/Brig/Team/DB.hs b/services/brig/src/Brig/Team/DB.hs index 0f6063c4d6d..e52a5113728 100644 --- a/services/brig/src/Brig/Team/DB.hs +++ b/services/brig/src/Brig/Team/DB.hs @@ -37,21 +37,29 @@ module Brig.Team.DB ) where +import Brig.App as App import Brig.Data.Instances () import Brig.Data.Types as T import Brig.Options +import Brig.Team.Template +import Brig.Team.Types (ShowOrHideInvitationUrl (..)) +import Brig.Template (renderTextWithBranding) import Cassandra as C +import Control.Lens (view) import Data.Conduit (runConduit, (.|)) import qualified Data.Conduit.List as C import Data.Id import Data.Json.Util (UTCTimeMillis, toUTCTimeMillis) import Data.Range -import Data.Text.Ascii (encodeBase64Url) +import Data.Text.Ascii (encodeBase64Url, toText) +import Data.Text.Encoding +import Data.Text.Lazy (toStrict) import Data.Time.Clock import Data.UUID.V4 import Imports import OpenSSL.Random (randBytes) import qualified System.Logger.Class as Log +import URI.ByteString import UnliftIO.Async (pooledMapConcurrentlyN_) import Wire.API.Team.Invitation import Wire.API.Team.Role @@ -76,7 +84,11 @@ data InvitationByEmail | InvitationByEmailMoreThanOne insertInvitation :: - MonadClient m => + ( Log.MonadLogger m, + MonadReader Env m, + MonadClient m + ) => + ShowOrHideInvitationUrl -> InvitationId -> TeamId -> Role -> @@ -88,9 +100,10 @@ insertInvitation :: -- | The timeout for the invitation code. Timeout -> m (Invitation, InvitationCode) -insertInvitation iid t role (toUTCTimeMillis -> now) minviter email inviteeName phone timeout = do +insertInvitation showUrl iid t role (toUTCTimeMillis -> now) minviter email inviteeName phone timeout = do code <- liftIO mkInvitationCode - let inv = Invitation t role iid now minviter email inviteeName phone + url <- mkInviteUrl showUrl t code + let inv = Invitation t role iid now minviter email inviteeName phone url retry x5 . batch $ do setType BatchLogged setConsistency LocalQuorum @@ -107,18 +120,33 @@ insertInvitation iid t role (toUTCTimeMillis -> now) minviter email inviteeName cqlInvitationByEmail :: PrepQuery W (Email, TeamId, InvitationId, InvitationCode, Int32) () cqlInvitationByEmail = "INSERT INTO team_invitation_email (email, team, invitation, code) VALUES (?, ?, ?, ?) USING TTL ?" -lookupInvitation :: MonadClient m => TeamId -> InvitationId -> m (Maybe Invitation) -lookupInvitation t r = - fmap toInvitation - <$> retry x1 (query1 cqlInvitation (params LocalQuorum (t, r))) +lookupInvitation :: + ( MonadClient m, + MonadReader Env m, + Log.MonadLogger m + ) => + ShowOrHideInvitationUrl -> + TeamId -> + InvitationId -> + m (Maybe Invitation) +lookupInvitation showUrl t r = do + inv <- retry x1 (query1 cqlInvitation (params LocalQuorum (t, r))) + traverse (toInvitation showUrl) inv where - cqlInvitation :: PrepQuery R (TeamId, InvitationId) (TeamId, Maybe Role, InvitationId, UTCTimeMillis, Maybe UserId, Email, Maybe Name, Maybe Phone) - cqlInvitation = "SELECT team, role, id, created_at, created_by, email, name, phone FROM team_invitation WHERE team = ? AND id = ?" + cqlInvitation :: PrepQuery R (TeamId, InvitationId) (TeamId, Maybe Role, InvitationId, UTCTimeMillis, Maybe UserId, Email, Maybe Name, Maybe Phone, InvitationCode) + cqlInvitation = "SELECT team, role, id, created_at, created_by, email, name, phone, code FROM team_invitation WHERE team = ? AND id = ?" -lookupInvitationByCode :: MonadClient m => InvitationCode -> m (Maybe Invitation) -lookupInvitationByCode i = +lookupInvitationByCode :: + ( Log.MonadLogger m, + MonadReader Env m, + MonadClient m + ) => + ShowOrHideInvitationUrl -> + InvitationCode -> + m (Maybe Invitation) +lookupInvitationByCode showUrl i = lookupInvitationInfo i >>= \case - Just InvitationInfo {..} -> lookupInvitation iiTeam iiInvId + Just InvitationInfo {..} -> lookupInvitation showUrl iiTeam iiInvId _ -> pure Nothing lookupInvitationCode :: MonadClient m => TeamId -> InvitationId -> m (Maybe InvitationCode) @@ -135,12 +163,21 @@ lookupInvitationCodeEmail t r = retry x1 (query1 cqlInvitationCodeEmail (params cqlInvitationCodeEmail :: PrepQuery R (TeamId, InvitationId) (InvitationCode, Email) cqlInvitationCodeEmail = "SELECT code, email FROM team_invitation WHERE team = ? AND id = ?" -lookupInvitations :: MonadClient m => TeamId -> Maybe InvitationId -> Range 1 500 Int32 -> m (ResultPage Invitation) -lookupInvitations team start (fromRange -> size) = do +lookupInvitations :: + ( Log.MonadLogger m, + MonadReader Env m, + MonadClient m + ) => + ShowOrHideInvitationUrl -> + TeamId -> + Maybe InvitationId -> + Range 1 500 Int32 -> + m (ResultPage Invitation) +lookupInvitations showUrl team start (fromRange -> size) = do page <- case start of Just ref -> retry x1 $ paginate cqlSelectFrom (paramsP LocalQuorum (team, ref) (size + 1)) Nothing -> retry x1 $ paginate cqlSelect (paramsP LocalQuorum (Identity team) (size + 1)) - pure $ toResult (hasMore page) $ map toInvitation (trim page) + toResult (hasMore page) <$> traverse (toInvitation showUrl) (trim page) where trim p = take (fromIntegral size) (result p) toResult more invs = @@ -149,10 +186,10 @@ lookupInvitations team start (fromRange -> size) = do { result = invs, hasMore = more } - cqlSelect :: PrepQuery R (Identity TeamId) (TeamId, Maybe Role, InvitationId, UTCTimeMillis, Maybe UserId, Email, Maybe Name, Maybe Phone) - cqlSelect = "SELECT team, role, id, created_at, created_by, email, name, phone FROM team_invitation WHERE team = ? ORDER BY id ASC" - cqlSelectFrom :: PrepQuery R (TeamId, InvitationId) (TeamId, Maybe Role, InvitationId, UTCTimeMillis, Maybe UserId, Email, Maybe Name, Maybe Phone) - cqlSelectFrom = "SELECT team, role, id, created_at, created_by, email, name, phone FROM team_invitation WHERE team = ? AND id > ? ORDER BY id ASC" + cqlSelect :: PrepQuery R (Identity TeamId) (TeamId, Maybe Role, InvitationId, UTCTimeMillis, Maybe UserId, Email, Maybe Name, Maybe Phone, InvitationCode) + cqlSelect = "SELECT team, role, id, created_at, created_by, email, name, phone, code FROM team_invitation WHERE team = ? ORDER BY id ASC" + cqlSelectFrom :: PrepQuery R (TeamId, InvitationId) (TeamId, Maybe Role, InvitationId, UTCTimeMillis, Maybe UserId, Email, Maybe Name, Maybe Phone, InvitationCode) + cqlSelectFrom = "SELECT team, role, id, created_at, created_by, email, name, phone, code FROM team_invitation WHERE team = ? AND id > ? ORDER BY id ASC" deleteInvitation :: MonadClient m => TeamId -> InvitationId -> m () deleteInvitation t i = do @@ -195,10 +232,17 @@ lookupInvitationInfo ic@(InvitationCode c) cqlInvitationInfo :: PrepQuery R (Identity InvitationCode) (TeamId, InvitationId) cqlInvitationInfo = "SELECT team, id FROM team_invitation_info WHERE code = ?" -lookupInvitationByEmail :: (Log.MonadLogger m, MonadClient m) => Email -> m (Maybe Invitation) -lookupInvitationByEmail e = +lookupInvitationByEmail :: + ( Log.MonadLogger m, + MonadReader Env m, + MonadClient m + ) => + ShowOrHideInvitationUrl -> + Email -> + m (Maybe Invitation) +lookupInvitationByEmail showUrl e = lookupInvitationInfoByEmail e >>= \case - InvitationByEmail InvitationInfo {..} -> lookupInvitation iiTeam iiInvId + InvitationByEmail InvitationInfo {..} -> lookupInvitation showUrl iiTeam iiInvId _ -> pure Nothing lookupInvitationInfoByEmail :: (Log.MonadLogger m, MonadClient m) => Email -> m InvitationByEmail @@ -230,6 +274,10 @@ countInvitations t = -- | brig used to not store the role, so for migration we allow this to be empty and fill in the -- default here. toInvitation :: + ( MonadReader Env m, + Log.MonadLogger m + ) => + ShowOrHideInvitationUrl -> ( TeamId, Maybe Role, InvitationId, @@ -237,8 +285,42 @@ toInvitation :: Maybe UserId, Email, Maybe Name, - Maybe Phone + Maybe Phone, + InvitationCode ) -> - Invitation -toInvitation (t, r, i, tm, minviter, e, inviteeName, p) = - Invitation t (fromMaybe defaultRole r) i tm minviter e inviteeName p + m Invitation +toInvitation showUrl (t, r, i, tm, minviter, e, inviteeName, p, code) = do + url <- mkInviteUrl showUrl t code + pure $ Invitation t (fromMaybe defaultRole r) i tm minviter e inviteeName p url + +mkInviteUrl :: + ( MonadReader Env m, + Log.MonadLogger m + ) => + ShowOrHideInvitationUrl -> + TeamId -> + InvitationCode -> + m (Maybe (URIRef Absolute)) +mkInviteUrl HideInvitationUrl _ _ = pure Nothing +mkInviteUrl ShowInvitationUrl team (InvitationCode c) = do + template <- invitationEmailUrl . invitationEmail . snd <$> teamTemplates Nothing + branding <- view App.templateBranding + let url = toStrict $ renderTextWithBranding template replace branding + parseHttpsUrl url + where + replace "team" = idToText team + replace "code" = toText c + replace x = x + + parseHttpsUrl :: Log.MonadLogger m => Text -> m (Maybe (URIRef Absolute)) + parseHttpsUrl url = + either (\e -> logError url e >> pure Nothing) (pure . Just) $ + parseURI laxURIParserOptions (encodeUtf8 url) + + logError :: (Log.MonadLogger m, Show e) => Text -> e -> m () + logError url e = + Log.err $ + Log.msg + (Log.val "Unable to create invitation url. Please check configuration.") + . Log.field "url" url + . Log.field "error" (show e) diff --git a/services/brig/src/Brig/Team/Types.hs b/services/brig/src/Brig/Team/Types.hs new file mode 100644 index 00000000000..e85bc4eb5b8 --- /dev/null +++ b/services/brig/src/Brig/Team/Types.hs @@ -0,0 +1,23 @@ +-- 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 Brig.Team.Types where + +import Imports + +data ShowOrHideInvitationUrl = ShowInvitationUrl | HideInvitationUrl + deriving (Eq, Show) diff --git a/services/brig/test/integration/API/User/Account.hs b/services/brig/test/integration/API/User/Account.hs index 07a4ef632c7..eb579b44388 100644 --- a/services/brig/test/integration/API/User/Account.hs +++ b/services/brig/test/integration/API/User/Account.hs @@ -89,6 +89,7 @@ import Wire.API.Federation.API.Brig (UserDeletedConnectionsNotification (..)) import qualified Wire.API.Federation.API.Brig as FedBrig import Wire.API.Federation.API.Common (EmptyResponse (EmptyResponse)) import Wire.API.Internal.Notification +import Wire.API.Team.Feature (ExposeInvitationURLsToTeamAdminConfig (..), FeatureStatus (..), FeatureTTL' (..), LockStatus (LockStatusLocked), withStatus) import Wire.API.Team.Invitation (Invitation (inInvitation)) import Wire.API.Team.Permission hiding (self) import Wire.API.User @@ -1610,17 +1611,26 @@ testTooManyMembersForLegalhold opts brig = do responseJsonError =<< postInvitation brig tid owner invite +-- +-- 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 V74_ExposeInvitationsToTeamAdmin + ( migration, + ) +where + +import Cassandra.Schema +import Imports +import Text.RawString.QQ + +migration :: Migration +migration = Migration 74 "Add feature config for team feature exposing invitation URLs to team admins" $ do + schema' + [r| ALTER TABLE team_features ADD ( + expose_invitation_urls_to_team_admin int + ) + |] diff --git a/services/galley/src/Galley/API/Internal.hs b/services/galley/src/Galley/API/Internal.hs index 28c19f80d37..e7d9876ba43 100644 --- a/services/galley/src/Galley/API/Internal.hs +++ b/services/galley/src/Galley/API/Internal.hs @@ -192,6 +192,10 @@ type IFeatureAPI = :<|> IFeatureStatusGet MLSConfig :<|> IFeatureStatusPut '() MLSConfig :<|> IFeatureStatusPatch '() MLSConfig + -- ExposeInvitationURLsToTeamAdminConfig + :<|> IFeatureStatusGet ExposeInvitationURLsToTeamAdminConfig + :<|> IFeatureStatusPut '() ExposeInvitationURLsToTeamAdminConfig + :<|> IFeatureStatusPatch '() ExposeInvitationURLsToTeamAdminConfig -- SearchVisibilityInboundConfig :<|> IFeatureStatusGet SearchVisibilityInboundConfig :<|> IFeatureStatusPut '() SearchVisibilityInboundConfig @@ -530,6 +534,9 @@ featureAPI = <@> mkNamedAPI @'("iget", MLSConfig) (getFeatureStatus @Cassandra DontDoAuth) <@> mkNamedAPI @'("iput", MLSConfig) (setFeatureStatusInternal @Cassandra) <@> mkNamedAPI @'("ipatch", MLSConfig) (patchFeatureStatusInternal @Cassandra) + <@> mkNamedAPI @'("iget", ExposeInvitationURLsToTeamAdminConfig) (getFeatureStatus @Cassandra DontDoAuth) + <@> mkNamedAPI @'("iput", ExposeInvitationURLsToTeamAdminConfig) (setFeatureStatusInternal @Cassandra) + <@> mkNamedAPI @'("ipatch", ExposeInvitationURLsToTeamAdminConfig) (patchFeatureStatusInternal @Cassandra) <@> mkNamedAPI @'("iget", SearchVisibilityInboundConfig) (getFeatureStatus @Cassandra DontDoAuth) <@> mkNamedAPI @'("iput", SearchVisibilityInboundConfig) (setFeatureStatusInternal @Cassandra) <@> mkNamedAPI @'("ipatch", SearchVisibilityInboundConfig) (patchFeatureStatusInternal @Cassandra) diff --git a/services/galley/src/Galley/API/Public/Servant.hs b/services/galley/src/Galley/API/Public/Servant.hs index 9977aaae1ab..baaa9cc414b 100644 --- a/services/galley/src/Galley/API/Public/Servant.hs +++ b/services/galley/src/Galley/API/Public/Servant.hs @@ -111,6 +111,7 @@ servantSitemap = <@> mkNamedAPI @"get-team" getTeamH <@> mkNamedAPI @"delete-team" deleteTeam + features :: API FeatureAPI GalleyEffects features = mkNamedAPI @'("get", SSOConfig) (getFeatureStatus @Cassandra . DoAuth) <@> mkNamedAPI @'("get", LegalholdConfig) (getFeatureStatus @Cassandra . DoAuth) @@ -139,6 +140,8 @@ servantSitemap = <@> mkNamedAPI @'("put", SndFactorPasswordChallengeConfig) (setFeatureStatus @Cassandra . DoAuth) <@> mkNamedAPI @'("get", MLSConfig) (getFeatureStatus @Cassandra . DoAuth) <@> mkNamedAPI @'("put", MLSConfig) (setFeatureStatus @Cassandra . DoAuth) + <@> mkNamedAPI @'("get", ExposeInvitationURLsToTeamAdminConfig) (getFeatureStatus @Cassandra . DoAuth) + <@> mkNamedAPI @'("put", ExposeInvitationURLsToTeamAdminConfig) (setFeatureStatus @Cassandra . DoAuth) <@> mkNamedAPI @'("get", SearchVisibilityInboundConfig) (getFeatureStatus @Cassandra . DoAuth) <@> mkNamedAPI @'("put", SearchVisibilityInboundConfig) (setFeatureStatus @Cassandra . DoAuth) <@> mkNamedAPI @"get-all-feature-configs-for-user" (getAllFeatureConfigsForUser @Cassandra) diff --git a/services/galley/src/Galley/API/Teams/Features.hs b/services/galley/src/Galley/API/Teams/Features.hs index 57c93ebcaa9..4556f935d7a 100644 --- a/services/galley/src/Galley/API/Teams/Features.hs +++ b/services/galley/src/Galley/API/Teams/Features.hs @@ -179,7 +179,8 @@ type FeaturePersistentAllFeatures db = FeaturePersistentConstraint db GuestLinksConfig, FeaturePersistentConstraint db SndFactorPasswordChallengeConfig, FeaturePersistentConstraint db MLSConfig, - FeaturePersistentConstraint db SearchVisibilityInboundConfig + FeaturePersistentConstraint db SearchVisibilityInboundConfig, + FeaturePersistentConstraint db ExposeInvitationURLsToTeamAdminConfig ) getFeatureStatus :: @@ -440,6 +441,7 @@ getAllFeatureConfigsForServer = <*> getConfigForServer @db @GuestLinksConfig <*> getConfigForServer @db @SndFactorPasswordChallengeConfig <*> getConfigForServer @db @MLSConfig + <*> getConfigForServer @db @ExposeInvitationURLsToTeamAdminConfig getAllFeatureConfigsUser :: forall db r. @@ -473,6 +475,7 @@ getAllFeatureConfigsUser uid = <*> getConfigForUser @db @GuestLinksConfig uid <*> getConfigForUser @db @SndFactorPasswordChallengeConfig uid <*> getConfigForUser @db @MLSConfig uid + <*> getConfigForUser @db @ExposeInvitationURLsToTeamAdminConfig uid getAllFeatureConfigsTeam :: forall db r. @@ -505,6 +508,7 @@ getAllFeatureConfigsTeam tid = <*> getConfigForTeam @db @GuestLinksConfig tid <*> getConfigForTeam @db @SndFactorPasswordChallengeConfig tid <*> getConfigForTeam @db @MLSConfig tid + <*> getConfigForTeam @db @ExposeInvitationURLsToTeamAdminConfig tid -- | Note: this is an internal function which doesn't cover all features, e.g. LegalholdConfig genericGetConfigForTeam :: @@ -850,6 +854,44 @@ instance SetFeatureConfig db MLSConfig where setConfigForTeam tid wsnl = do persistAndPushEvent @db tid wsnl +instance GetFeatureConfig db ExposeInvitationURLsToTeamAdminConfig where + getConfigForServer = + -- we could look at the galley settings, but we don't have a team here, so there is not much else we can say. + pure $ + withStatus + FeatureStatusDisabled + LockStatusLocked + ExposeInvitationURLsToTeamAdminConfig + FeatureTTLUnlimited + + getConfigForTeam tid = do + allowList <- input <&> view (optSettings . setExposeInvitationURLsTeamAllowlist . to (fromMaybe [])) + mbOldStatus <- TeamFeatures.getFeatureConfig @db (Proxy @ExposeInvitationURLsToTeamAdminConfig) tid <&> fmap wssStatus + let teamAllowed = tid `elem` allowList + pure $ computeConfigForTeam teamAllowed (fromMaybe FeatureStatusDisabled mbOldStatus) + where + computeConfigForTeam :: Bool -> FeatureStatus -> WithStatus ExposeInvitationURLsToTeamAdminConfig + computeConfigForTeam teamAllowed teamDbStatus = + if teamAllowed + then makeConfig LockStatusUnlocked teamDbStatus + else makeConfig LockStatusLocked FeatureStatusDisabled + + makeConfig :: LockStatus -> FeatureStatus -> WithStatus ExposeInvitationURLsToTeamAdminConfig + makeConfig lockStatus status = + withStatus + status + lockStatus + ExposeInvitationURLsToTeamAdminConfig + FeatureTTLUnlimited + +instance SetFeatureConfig db ExposeInvitationURLsToTeamAdminConfig where + type SetConfigForTeamConstraints db ExposeInvitationURLsToTeamAdminConfig (r :: EffectRow) = (Member (ErrorS OperationDenied) r) + setConfigForTeam tid wsnl = do + lockStatus <- getConfigForTeam @db @ExposeInvitationURLsToTeamAdminConfig tid <&> wsLockStatus + case lockStatus of + LockStatusLocked -> throwS @OperationDenied + LockStatusUnlocked -> persistAndPushEvent @db tid wsnl + -- -- | If second factor auth is enabled, make sure that end-points that don't support it, but should, are blocked completely. (This is a workaround until we have 2FA for those end-points as well.) -- -- -- This function exists to resolve a cyclic dependency. diff --git a/services/galley/src/Galley/Cassandra.hs b/services/galley/src/Galley/Cassandra.hs index 6bc6719a2b2..275255cd59c 100644 --- a/services/galley/src/Galley/Cassandra.hs +++ b/services/galley/src/Galley/Cassandra.hs @@ -20,4 +20,4 @@ module Galley.Cassandra (schemaVersion) where import Imports schemaVersion :: Int32 -schemaVersion = 73 +schemaVersion = 74 diff --git a/services/galley/src/Galley/Cassandra/TeamFeatures.hs b/services/galley/src/Galley/Cassandra/TeamFeatures.hs index eacdde56533..169280c51d7 100644 --- a/services/galley/src/Galley/Cassandra/TeamFeatures.hs +++ b/services/galley/src/Galley/Cassandra/TeamFeatures.hs @@ -313,3 +313,7 @@ instance FeatureStatusCassandra MLSConfig where insert = "insert into team_features (team_id, mls_status, mls_default_protocol, \ \mls_protocol_toggle_users, mls_allowed_ciphersuites, mls_default_ciphersuite) values (?, ?, ?, ?, ?, ?)" + +instance FeatureStatusCassandra ExposeInvitationURLsToTeamAdminConfig where + getFeatureConfig _ = getTrivialConfigC "expose_invitation_urls_to_team_admin" + setFeatureConfig _ tid statusNoLock = setFeatureStatusC "expose_invitation_urls_to_team_admin" tid (wssStatus statusNoLock) diff --git a/services/galley/src/Galley/Options.hs b/services/galley/src/Galley/Options.hs index 2d822419134..edb3850d29b 100644 --- a/services/galley/src/Galley/Options.hs +++ b/services/galley/src/Galley/Options.hs @@ -22,6 +22,7 @@ module Galley.Options setHttpPoolSize, setMaxTeamSize, setMaxFanoutSize, + setExposeInvitationURLsTeamAllowlist, setMaxConvSize, setIntraListing, setConversationCodeURI, @@ -56,6 +57,7 @@ where import Control.Lens hiding (Level, (.=)) import Data.Aeson.TH (deriveFromJSON) import Data.Domain (Domain) +import Data.Id (TeamId) import Data.Misc import Data.Range import Galley.Keys @@ -76,6 +78,10 @@ data Settings = Settings -- This defaults to setMaxTeamSize and cannot be > HardTruncationLimit. Useful -- to tune mainly for testing purposes. _setMaxFanoutSize :: !(Maybe (Range 1 HardTruncationLimit Int32)), + -- | List of teams for which the invitation URL can be added to the list of all + -- invitations retrievable by team admins. See also: + -- 'ExposeInvitationURLsToTeamAdminConfig'. + _setExposeInvitationURLsTeamAllowlist :: !(Maybe [TeamId]), -- | Max number of members in a conversation. NOTE: This must be in sync with Brig _setMaxConvSize :: !Word16, -- | Whether to call Brig for device listing diff --git a/services/galley/test/integration/API/Teams/Feature.hs b/services/galley/test/integration/API/Teams/Feature.hs index 0660b3f8369..365584c46f5 100644 --- a/services/galley/test/integration/API/Teams/Feature.hs +++ b/services/galley/test/integration/API/Teams/Feature.hs @@ -18,15 +18,17 @@ module API.Teams.Feature (tests) where +import API.SQS (assertQueue, tActivate) import API.Util (HasGalley, getFeatureStatusMulti, withSettingsOverrides) import qualified API.Util as Util -import API.Util.TeamFeature (patchFeatureStatusInternal) +import API.Util.TeamFeature (patchFeatureStatusInternal, putTeamFeatureFlagWithGalley) import qualified API.Util.TeamFeature as Util import Bilge import Bilge.Assert import Brig.Types.Test.Arbitrary (Arbitrary (arbitrary)) import Cassandra as Cql -import Control.Lens (over, to, view) +import Control.Lens (over, to, view, (.~), (?~)) +import Control.Lens.Operators () import Control.Monad.Catch (MonadCatch) import Data.Aeson (FromJSON, ToJSON) import qualified Data.Aeson as Aeson @@ -40,7 +42,7 @@ import Data.Schema (ToSchema) import qualified Data.Set as Set import Data.Timeout (TimeoutUnit (Second), (#)) import GHC.TypeLits (KnownSymbol) -import Galley.Options (optSettings, setFeatureFlags) +import Galley.Options (optSettings, setExposeInvitationURLsTeamAllowlist, setFeatureFlags) import Galley.Types.Teams import Imports import Network.Wai.Utilities (label) @@ -56,7 +58,7 @@ import qualified Wire.API.Event.FeatureConfig as FeatureConfig import Wire.API.Internal.Notification (Notification) import Wire.API.MLS.CipherSuite import Wire.API.Routes.Internal.Galley.TeamFeatureNoConfigMulti as Multi -import Wire.API.Team.Feature (FeatureStatus (..), FeatureTTL, FeatureTTL' (..), LockStatus (LockStatusUnlocked), MLSConfig (MLSConfig)) +import Wire.API.Team.Feature (ExposeInvitationURLsToTeamAdminConfig (..), FeatureStatus (..), FeatureTTL, FeatureTTL' (..), LockStatus (LockStatusUnlocked), MLSConfig (MLSConfig)) import qualified Wire.API.Team.Feature as Public tests :: IO TestSetup -> TestTree @@ -135,6 +137,12 @@ tests s = testPatch AssertLockStatusChange Public.FeatureStatusDisabled Public.SndFactorPasswordChallengeConfig, test s (unpack $ Public.featureNameBS @Public.SelfDeletingMessagesConfig) $ testPatch AssertLockStatusChange Public.FeatureStatusEnabled (Public.SelfDeletingMessagesConfig 0) + ], + testGroup + "ExposeInvitationURLsToTeamAdmin" + [ test s "can be set when TeamId is in allow list" testExposeInvitationURLsToTeamAdminTeamIdInAllowList, + test s "can not be set when allow list is empty" testExposeInvitationURLsToTeamAdminEmptyAllowList, + test s "server config takes precendece over team feature config" testExposeInvitationURLsToTeamAdminServerConfigTakesPrecedence ] ] @@ -442,7 +450,7 @@ testClassifiedDomainsDisabled = do liftIO $ Public.wsStatus result @?= Public.wssStatus expected' liftIO $ Public.wsConfig result @?= Public.wssConfig expected' - let classifiedDomainsDisabled = \opts -> + let classifiedDomainsDisabled opts = opts & over (optSettings . setFeatureFlags . flagClassifiedDomains) @@ -991,7 +999,8 @@ testAllFeatures = do Public.afcGuestLink = Public.withStatus FeatureStatusEnabled Public.LockStatusUnlocked Public.GuestLinksConfig Public.FeatureTTLUnlimited, Public.afcSndFactorPasswordChallenge = Public.withStatus FeatureStatusDisabled Public.LockStatusLocked Public.SndFactorPasswordChallengeConfig Public.FeatureTTLUnlimited, Public.afcMLS = Public.withStatus FeatureStatusDisabled Public.LockStatusUnlocked (Public.MLSConfig [] ProtocolProteusTag [MLS_128_DHKEMX25519_AES128GCM_SHA256_Ed25519] MLS_128_DHKEMX25519_AES128GCM_SHA256_Ed25519) Public.FeatureTTLUnlimited, - Public.afcSearchVisibilityInboundConfig = Public.withStatus FeatureStatusDisabled Public.LockStatusUnlocked Public.SearchVisibilityInboundConfig Public.FeatureTTLUnlimited + Public.afcSearchVisibilityInboundConfig = Public.withStatus FeatureStatusDisabled Public.LockStatusUnlocked Public.SearchVisibilityInboundConfig Public.FeatureTTLUnlimited, + Public.afcExposeInvitationURLsToTeamAdmin = Public.withStatus FeatureStatusDisabled Public.LockStatusLocked Public.ExposeInvitationURLsToTeamAdminConfig Public.FeatureTTLUnlimited } testFeatureConfigConsistency :: TestM () @@ -1131,6 +1140,73 @@ testMLS = do wsAssertFeatureConfigUpdate @MLSConfig config3 LockStatusUnlocked getViaEndpoints config3 +testExposeInvitationURLsToTeamAdminTeamIdInAllowList :: TestM () +testExposeInvitationURLsToTeamAdminTeamIdInAllowList = do + owner <- Util.randomUser + tid <- Util.createBindingTeamInternal "foo" owner + assertQueue "create team" tActivate + void $ + withSettingsOverrides (\opts -> opts & optSettings . setExposeInvitationURLsTeamAllowlist ?~ [tid]) $ do + g <- view tsGalley + assertExposeInvitationURLsToTeamAdminConfigStatus owner tid FeatureStatusDisabled Public.LockStatusUnlocked + let enabled = Public.WithStatusNoLock Public.FeatureStatusEnabled ExposeInvitationURLsToTeamAdminConfig Public.FeatureTTLUnlimited + void $ + putTeamFeatureFlagWithGalley @ExposeInvitationURLsToTeamAdminConfig g owner tid enabled !!! do + const 200 === statusCode + assertExposeInvitationURLsToTeamAdminConfigStatus owner tid FeatureStatusEnabled Public.LockStatusUnlocked + +testExposeInvitationURLsToTeamAdminEmptyAllowList :: TestM () +testExposeInvitationURLsToTeamAdminEmptyAllowList = do + owner <- Util.randomUser + tid <- Util.createBindingTeamInternal "foo" owner + assertQueue "create team" tActivate + void $ + withSettingsOverrides (\opts -> opts & optSettings . setExposeInvitationURLsTeamAllowlist .~ Nothing) $ do + g <- view tsGalley + assertExposeInvitationURLsToTeamAdminConfigStatus owner tid FeatureStatusDisabled Public.LockStatusLocked + let enabled = Public.WithStatusNoLock Public.FeatureStatusEnabled ExposeInvitationURLsToTeamAdminConfig Public.FeatureTTLUnlimited + void $ + putTeamFeatureFlagWithGalley @ExposeInvitationURLsToTeamAdminConfig g owner tid enabled !!! do + const 409 === statusCode + assertExposeInvitationURLsToTeamAdminConfigStatus owner tid FeatureStatusDisabled Public.LockStatusLocked + +-- | Ensure that the server config takes precedence over a saved team config. +-- +-- In other words: When a team id is no longer in the +-- `setExposeInvitationURLsTeamAllowlist` the +-- `ExposeInvitationURLsToTeamAdminConfig` is always disabled (even tough it +-- might have been enabled before). +testExposeInvitationURLsToTeamAdminServerConfigTakesPrecedence :: TestM () +testExposeInvitationURLsToTeamAdminServerConfigTakesPrecedence = do + owner <- Util.randomUser + tid <- Util.createBindingTeamInternal "foo" owner + assertQueue "create team" tActivate + void $ + withSettingsOverrides (\opts -> opts & optSettings . setExposeInvitationURLsTeamAllowlist ?~ [tid]) $ do + g <- view tsGalley + assertExposeInvitationURLsToTeamAdminConfigStatus owner tid FeatureStatusDisabled Public.LockStatusUnlocked + let enabled = Public.WithStatusNoLock Public.FeatureStatusEnabled ExposeInvitationURLsToTeamAdminConfig Public.FeatureTTLUnlimited + void $ + putTeamFeatureFlagWithGalley @ExposeInvitationURLsToTeamAdminConfig g owner tid enabled !!! do + const 200 === statusCode + assertExposeInvitationURLsToTeamAdminConfigStatus owner tid FeatureStatusEnabled Public.LockStatusUnlocked + void $ + withSettingsOverrides (\opts -> opts & optSettings . setExposeInvitationURLsTeamAllowlist .~ Nothing) $ do + g <- view tsGalley + assertExposeInvitationURLsToTeamAdminConfigStatus owner tid FeatureStatusDisabled Public.LockStatusLocked + let enabled = Public.WithStatusNoLock Public.FeatureStatusEnabled ExposeInvitationURLsToTeamAdminConfig Public.FeatureTTLUnlimited + void $ + putTeamFeatureFlagWithGalley @ExposeInvitationURLsToTeamAdminConfig g owner tid enabled !!! do + const 409 === statusCode + assertExposeInvitationURLsToTeamAdminConfigStatus owner tid FeatureStatusDisabled Public.LockStatusLocked + +assertExposeInvitationURLsToTeamAdminConfigStatus :: UserId -> TeamId -> FeatureStatus -> LockStatus -> TestM () +assertExposeInvitationURLsToTeamAdminConfigStatus owner tid fStatus lStatus = do + g <- view tsGalley + Util.getTeamFeatureFlagWithGalley @ExposeInvitationURLsToTeamAdminConfig g owner tid !!! do + const 200 === statusCode + const (Right (Public.withStatus fStatus lStatus Public.ExposeInvitationURLsToTeamAdminConfig Public.FeatureTTLUnlimited)) === responseJsonEither + assertFlagForbidden :: HasCallStack => TestM ResponseLBS -> TestM () assertFlagForbidden res = do res !!! do From 3db4338590aae304879be5bffc0fd4b79a46ea02 Mon Sep 17 00:00:00 2001 From: Stefan Matting Date: Mon, 19 Sep 2022 15:45:51 +0200 Subject: [PATCH 32/58] Add commit bundle support (#2688) * wire-api: Add types and test (wip) * Add endpoint in galley * Implement naive PublicGroupState (broken) * Split into PublicGroupStateTBS and PGS * Refactor: use deriving via newtype * Add roundtrip tests * bump cli * Add integration test for commit bundles * Implement federated commit bundle requests * Test remote commit bundles * Fix build * Add CHANGELOG entry * Extract action from commit for welcome verification * Change status code from 409 to 400 for some errors The conflict status code 409 should be used for errors that are caused by race conditions, such as in cases where the client has an out-of-date view on the state of the backend. * Remove redundant error handling * Implement welcome check for commit bundles * Test welcome mismatch * Add new endpoint to charts and demo Co-authored-by: Paolo Capriotti --- .../1-api-changes/FS-922-post-commit-bundle | 1 + charts/nginz/values.yaml | 3 + deploy/services-demo/conf/nginz/nginx.conf | 5 + .../src/Wire/API/Federation/API/Galley.hs | 1 + libs/wire-api/src/Wire/API/Error/Galley.hs | 11 +- libs/wire-api/src/Wire/API/MLS/CipherSuite.hs | 2 +- libs/wire-api/src/Wire/API/MLS/Commit.hs | 9 +- .../wire-api/src/Wire/API/MLS/CommitBundle.hs | 45 +++ libs/wire-api/src/Wire/API/MLS/Extension.hs | 3 +- .../src/Wire/API/MLS/GroupInfoBundle.hs | 53 +++ .../src/Wire/API/MLS/PublicGroupState.hs | 98 +++++ .../src/Wire/API/MLS/Serialisation.hs | 9 +- libs/wire-api/src/Wire/API/MLS/Welcome.hs | 25 +- .../src/Wire/API/Routes/Public/Galley.hs | 28 ++ libs/wire-api/test/unit/Test/Wire/API/MLS.hs | 47 ++- .../test/unit/Test/Wire/API/Roundtrip/MLS.hs | 7 +- libs/wire-api/wire-api.cabal | 3 + nix/pkgs/mls_test_cli/default.nix | 8 +- services/galley/src/Galley/API/Federation.hs | 47 ++- services/galley/src/Galley/API/MLS.hs | 3 +- services/galley/src/Galley/API/MLS/Message.hs | 336 +++++++++++++++--- services/galley/src/Galley/API/MLS/Welcome.hs | 27 +- .../galley/src/Galley/API/Public/Servant.hs | 3 +- .../galley/src/Galley/Cassandra/Queries.hs | 4 + services/galley/test/integration/API/MLS.hs | 112 +++++- .../galley/test/integration/API/MLS/Util.hs | 101 +++++- 26 files changed, 891 insertions(+), 100 deletions(-) create mode 100644 changelog.d/1-api-changes/FS-922-post-commit-bundle create mode 100644 libs/wire-api/src/Wire/API/MLS/CommitBundle.hs create mode 100644 libs/wire-api/src/Wire/API/MLS/GroupInfoBundle.hs create mode 100644 libs/wire-api/src/Wire/API/MLS/PublicGroupState.hs diff --git a/changelog.d/1-api-changes/FS-922-post-commit-bundle b/changelog.d/1-api-changes/FS-922-post-commit-bundle new file mode 100644 index 00000000000..a56fd4595ee --- /dev/null +++ b/changelog.d/1-api-changes/FS-922-post-commit-bundle @@ -0,0 +1 @@ +Add new endpoint `/mls/commit-bundles` for submitting MLS `CommitBundle`s. A `CommitBundle` is a triple consisting of a commit message, an optional welcome message and a public group state. diff --git a/charts/nginz/values.yaml b/charts/nginz/values.yaml index 155f7e5e2bb..bb6790f8e06 100644 --- a/charts/nginz/values.yaml +++ b/charts/nginz/values.yaml @@ -478,6 +478,9 @@ nginx_conf: - path: /mls/messages envs: - all + - path: /mls/commit-bundles + envs: + - all - path: /mls/public-keys envs: - all diff --git a/deploy/services-demo/conf/nginz/nginx.conf b/deploy/services-demo/conf/nginz/nginx.conf index 3eea668311d..f969a7e61c1 100644 --- a/deploy/services-demo/conf/nginz/nginx.conf +++ b/deploy/services-demo/conf/nginz/nginx.conf @@ -425,6 +425,11 @@ http { proxy_pass http://galley; } + location /mls/commit-bundles { + include common_response_with_zauth.conf; + proxy_pass http://galley; + } + location /mls/public-keys { include common_response_with_zauth.conf; proxy_pass http://galley; diff --git a/libs/wire-api-federation/src/Wire/API/Federation/API/Galley.hs b/libs/wire-api-federation/src/Wire/API/Federation/API/Galley.hs index 121f182f68b..8aa6f52d9e7 100644 --- a/libs/wire-api-federation/src/Wire/API/Federation/API/Galley.hs +++ b/libs/wire-api-federation/src/Wire/API/Federation/API/Galley.hs @@ -69,6 +69,7 @@ type GalleyApi = :<|> FedEndpoint "mls-welcome" MLSWelcomeRequest EmptyResponse :<|> FedEndpoint "on-mls-message-sent" RemoteMLSMessage EmptyResponse :<|> FedEndpoint "send-mls-message" MessageSendRequest MLSMessageResponse + :<|> FedEndpoint "send-mls-commit-bundle" MessageSendRequest MLSMessageResponse :<|> FedEndpoint "on-client-removed" ClientRemovedRequest EmptyResponse data ClientRemovedRequest = ClientRemovedRequest diff --git a/libs/wire-api/src/Wire/API/Error/Galley.hs b/libs/wire-api/src/Wire/API/Error/Galley.hs index f6344289905..11bad2e5707 100644 --- a/libs/wire-api/src/Wire/API/Error/Galley.hs +++ b/libs/wire-api/src/Wire/API/Error/Galley.hs @@ -81,6 +81,7 @@ data GalleyError | MLSSelfRemovalNotAllowed | MLSGroupConversationMismatch | MLSClientSenderUserMismatch + | MLSWelcomeMismatch | -- NoBindingTeamMembers | NoBindingTeam @@ -192,13 +193,15 @@ type instance MapError 'MLSClientMismatch = 'StaticError 409 "mls-client-mismatc type instance MapError 'MLSStaleMessage = 'StaticError 409 "mls-stale-message" "The conversation epoch in a message is too old" -type instance MapError 'MLSCommitMissingReferences = 'StaticError 409 "mls-commit-missing-references" "The commit is not referencing all pending proposals" +type instance MapError 'MLSCommitMissingReferences = 'StaticError 400 "mls-commit-missing-references" "The commit is not referencing all pending proposals" -type instance MapError 'MLSSelfRemovalNotAllowed = 'StaticError 409 "mls-self-removal-not-allowed" "Self removal from group is not allowed" +type instance MapError 'MLSSelfRemovalNotAllowed = 'StaticError 400 "mls-self-removal-not-allowed" "Self removal from group is not allowed" -type instance MapError 'MLSGroupConversationMismatch = 'StaticError 409 "mls-group-conversation-mismatch" "Conversation ID resolved from Group ID does not match submitted Conversation ID" +type instance MapError 'MLSGroupConversationMismatch = 'StaticError 400 "mls-group-conversation-mismatch" "Conversation ID resolved from Group ID does not match submitted Conversation ID" -type instance MapError 'MLSClientSenderUserMismatch = 'StaticError 409 "mls-client-sender-user-mismatch" "User ID resolved from Client ID does not match message's sender user ID" +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 '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 'NoBindingTeamMembers = 'StaticError 403 "non-binding-team-members" "Both users must be members of the same binding team" diff --git a/libs/wire-api/src/Wire/API/MLS/CipherSuite.hs b/libs/wire-api/src/Wire/API/MLS/CipherSuite.hs index 9308a1b1e29..aaf42cd5af6 100644 --- a/libs/wire-api/src/Wire/API/MLS/CipherSuite.hs +++ b/libs/wire-api/src/Wire/API/MLS/CipherSuite.hs @@ -37,7 +37,7 @@ import Wire.Arbitrary newtype CipherSuite = CipherSuite {cipherSuiteNumber :: Word16} deriving stock (Eq, Show) - deriving newtype (ParseMLS, Arbitrary) + deriving newtype (ParseMLS, SerialiseMLS, Arbitrary) instance ToSchema CipherSuite where schema = diff --git a/libs/wire-api/src/Wire/API/MLS/Commit.hs b/libs/wire-api/src/Wire/API/MLS/Commit.hs index 7b4729cf6d1..8f1a17c8ce6 100644 --- a/libs/wire-api/src/Wire/API/MLS/Commit.hs +++ b/libs/wire-api/src/Wire/API/MLS/Commit.hs @@ -21,6 +21,7 @@ import Imports import Wire.API.MLS.KeyPackage import Wire.API.MLS.Proposal import Wire.API.MLS.Serialisation +import Wire.Arbitrary data Commit = Commit { cProposals :: [ProposalOrRef], @@ -53,7 +54,13 @@ data HPKECiphertext = HPKECiphertext { hcOutput :: ByteString, hcCiphertext :: ByteString } - deriving (Eq, Show) + deriving (Eq, Show, Generic) + deriving (Arbitrary) via (GenericUniform HPKECiphertext) instance ParseMLS HPKECiphertext where parseMLS = HPKECiphertext <$> parseMLSBytes @Word16 <*> parseMLSBytes @Word16 + +instance SerialiseMLS HPKECiphertext where + serialiseMLS (HPKECiphertext out ct) = do + serialiseMLSBytes @Word16 out + serialiseMLSBytes @Word16 ct diff --git a/libs/wire-api/src/Wire/API/MLS/CommitBundle.hs b/libs/wire-api/src/Wire/API/MLS/CommitBundle.hs new file mode 100644 index 00000000000..dfe09f0b88f --- /dev/null +++ b/libs/wire-api/src/Wire/API/MLS/CommitBundle.hs @@ -0,0 +1,45 @@ +-- 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 . +{-# LANGUAGE RecordWildCards #-} + +module Wire.API.MLS.CommitBundle where + +import qualified Data.Swagger as S +import Imports +import Wire.API.MLS.GroupInfoBundle +import Wire.API.MLS.Message +import Wire.API.MLS.Serialisation +import Wire.API.MLS.Welcome + +data CommitBundle = CommitBundle + { cbCommitMsg :: RawMLS (Message 'MLSPlainText), + cbWelcome :: Maybe (RawMLS Welcome), + cbGroupInfoBundle :: GroupInfoBundle + } + deriving (Eq, Show) + +instance ParseMLS CommitBundle where + parseMLS = CommitBundle <$> parseMLS <*> parseMLSOptional parseMLS <*> parseMLS + +instance S.ToSchema CommitBundle where + declareNamedSchema _ = pure (mlsSwagger "CommitBundle") + +instance SerialiseMLS CommitBundle where + serialiseMLS (CommitBundle commit welcome gi) = do + serialiseMLS commit + serialiseMLSOptional serialiseMLS welcome + serialiseMLS gi diff --git a/libs/wire-api/src/Wire/API/MLS/Extension.hs b/libs/wire-api/src/Wire/API/MLS/Extension.hs index 18b1d551d2d..406adfa7e8a 100644 --- a/libs/wire-api/src/Wire/API/MLS/Extension.hs +++ b/libs/wire-api/src/Wire/API/MLS/Extension.hs @@ -52,8 +52,7 @@ import Wire.API.MLS.Serialisation import Wire.Arbitrary newtype ProtocolVersion = ProtocolVersion {pvNumber :: Word8} - deriving newtype (Eq, Ord, Show, Binary, Arbitrary) - deriving (ParseMLS) via (BinaryMLS ProtocolVersion) + deriving newtype (Eq, Ord, Show, Binary, Arbitrary, ParseMLS, SerialiseMLS) data ProtocolVersionTag = ProtocolMLS10 | ProtocolMLSDraft11 deriving stock (Bounded, Enum, Eq, Show, Generic) diff --git a/libs/wire-api/src/Wire/API/MLS/GroupInfoBundle.hs b/libs/wire-api/src/Wire/API/MLS/GroupInfoBundle.hs new file mode 100644 index 00000000000..5f1da34b87b --- /dev/null +++ b/libs/wire-api/src/Wire/API/MLS/GroupInfoBundle.hs @@ -0,0 +1,53 @@ +-- 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.GroupInfoBundle where + +import Imports +import Test.QuickCheck +import Wire.API.MLS.PublicGroupState +import Wire.API.MLS.Serialisation +import Wire.Arbitrary + +data GroupInfoEncryption = UnencryptedGroupInfo | JweEncryptedGroupInfo + deriving stock (Eq, Show, Generic, Bounded, Enum) + deriving (Arbitrary) via (GenericUniform GroupInfoEncryption) + +data GroupInfoTreeType = TreeFull | TreeDelta | TreeByRef + deriving stock (Eq, Show, Generic, Bounded, Enum) + deriving (Arbitrary) via (GenericUniform GroupInfoTreeType) + +data GroupInfoBundle = GroupInfoBundle + { gipEncryptionType :: GroupInfoEncryption, + gipTreeType :: GroupInfoTreeType, + gipGroupState :: PublicGroupState + } + deriving stock (Eq, Show, Generic) + deriving (Arbitrary) via GenericUniform GroupInfoBundle + +instance ParseMLS GroupInfoBundle where + parseMLS = + GroupInfoBundle + <$> parseMLSEnum @Word8 "GroupInfoEncryptionEnum" + <*> parseMLSEnum @Word8 "RatchetTreeEnum" + <*> parseMLS + +instance SerialiseMLS GroupInfoBundle where + serialiseMLS (GroupInfoBundle e t pgs) = do + serialiseMLSEnum @Word8 e + serialiseMLSEnum @Word8 t + serialiseMLS pgs diff --git a/libs/wire-api/src/Wire/API/MLS/PublicGroupState.hs b/libs/wire-api/src/Wire/API/MLS/PublicGroupState.hs new file mode 100644 index 00000000000..ae3c4ba5e0f --- /dev/null +++ b/libs/wire-api/src/Wire/API/MLS/PublicGroupState.hs @@ -0,0 +1,98 @@ +-- 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 . +{-# LANGUAGE RecordWildCards #-} + +module Wire.API.MLS.PublicGroupState where + +import Data.Binary.Get (label) +import Imports +import Test.QuickCheck hiding (label) +import Wire.API.MLS.CipherSuite +import Wire.API.MLS.Epoch +import Wire.API.MLS.Extension +import Wire.API.MLS.Group +import Wire.API.MLS.KeyPackage +import Wire.API.MLS.Serialisation +import Wire.Arbitrary + +data PublicGroupStateTBS = PublicGroupStateTBS + { pgsVersion :: ProtocolVersion, + pgsCipherSuite :: CipherSuite, + pgsGroupId :: GroupId, + pgsEpoch :: Epoch, + pgsTreeHash :: ByteString, + pgsInterimTranscriptHash :: ByteString, + pgsConfirmedInterimTranscriptHash :: ByteString, + pgsGroupContextExtensions :: ByteString, + pgsOtherExtensions :: ByteString, + pgsExternalPub :: ByteString, + pgsSigner :: KeyPackageRef + } + deriving stock (Eq, Show, Generic) + deriving (Arbitrary) via (GenericUniform PublicGroupStateTBS) + +instance ParseMLS PublicGroupStateTBS where + parseMLS = + PublicGroupStateTBS + <$> label "pgsVersion" parseMLS + <*> label "pgsCipherSuite" parseMLS + <*> label "pgsGroupId" parseMLS + <*> label "pgsEpoch" parseMLS + <*> label "pgsTreeHash" (parseMLSBytes @Word8) + <*> label "pgsInterimTranscriptHash" (parseMLSBytes @Word8) + <*> label "pgsConfirmedInterimTranscriptHash" (parseMLSBytes @Word8) + <*> label "pgsGroupContextExtensions" (parseMLSBytes @Word32) + <*> label "pgsOtherExtensions" (parseMLSBytes @Word32) + <*> label "pgsExternalPub" (parseMLSBytes @Word16) + <*> label "pgsSigner" parseMLS + +instance SerialiseMLS PublicGroupStateTBS where + serialiseMLS (PublicGroupStateTBS {..}) = do + serialiseMLS pgsVersion + serialiseMLS pgsCipherSuite + serialiseMLS pgsGroupId + serialiseMLS pgsEpoch + serialiseMLSBytes @Word8 pgsTreeHash + serialiseMLSBytes @Word8 pgsInterimTranscriptHash + serialiseMLSBytes @Word8 pgsConfirmedInterimTranscriptHash + serialiseMLSBytes @Word32 pgsGroupContextExtensions + serialiseMLSBytes @Word32 pgsOtherExtensions + serialiseMLSBytes @Word16 pgsExternalPub + serialiseMLS pgsSigner + +data PublicGroupState = PublicGroupState + { pgTBS :: RawMLS PublicGroupStateTBS, + pgSignature :: ByteString + } + deriving stock (Eq, Show, Generic) + +instance Arbitrary PublicGroupState where + arbitrary = + PublicGroupState + <$> (mkRawMLS <$> arbitrary) + <*> arbitrary + +instance ParseMLS PublicGroupState where + parseMLS = + PublicGroupState + <$> label "pgTBS" parseMLS + <*> label "pgSignature" (parseMLSBytes @Word16) + +instance SerialiseMLS PublicGroupState where + serialiseMLS PublicGroupState {..} = do + serialiseMLS pgTBS + serialiseMLSBytes @Word16 pgSignature diff --git a/libs/wire-api/src/Wire/API/MLS/Serialisation.hs b/libs/wire-api/src/Wire/API/MLS/Serialisation.hs index a55d9e3fa24..3e99b33cfb0 100644 --- a/libs/wire-api/src/Wire/API/MLS/Serialisation.hs +++ b/libs/wire-api/src/Wire/API/MLS/Serialisation.hs @@ -27,7 +27,6 @@ module Wire.API.MLS.Serialisation serialiseMLSOptional, parseMLSEnum, serialiseMLSEnum, - BinaryMLS (..), MLSEnumError (..), fromMLSEnum, toMLSEnum', @@ -165,15 +164,13 @@ instance ParseMLS Word32 where parseMLS = get instance ParseMLS Word64 where parseMLS = get +instance SerialiseMLS Word8 where serialiseMLS = put + instance SerialiseMLS Word16 where serialiseMLS = put instance SerialiseMLS Word32 where serialiseMLS = put --- | A wrapper to generate a 'ParseMLS' instance given a 'Binary' instance. -newtype BinaryMLS a = BinaryMLS a - -instance Binary a => ParseMLS (BinaryMLS a) where - parseMLS = BinaryMLS <$> get +instance SerialiseMLS Word64 where serialiseMLS = put -- | Encode an MLS value to a lazy bytestring. encodeMLS :: SerialiseMLS a => a -> LByteString diff --git a/libs/wire-api/src/Wire/API/MLS/Welcome.hs b/libs/wire-api/src/Wire/API/MLS/Welcome.hs index 4231b08abae..929dc78af52 100644 --- a/libs/wire-api/src/Wire/API/MLS/Welcome.hs +++ b/libs/wire-api/src/Wire/API/MLS/Welcome.hs @@ -24,12 +24,16 @@ import Wire.API.MLS.Commit import Wire.API.MLS.Extension import Wire.API.MLS.KeyPackage import Wire.API.MLS.Serialisation +import Wire.Arbitrary data Welcome = Welcome - { welCipherSuite :: CipherSuite, + { welProtocolVersion :: ProtocolVersion, + welCipherSuite :: CipherSuite, welSecrets :: [GroupSecrets], welGroupInfo :: ByteString } + deriving (Show, Eq, Generic) + deriving (Arbitrary) via (GenericUniform Welcome) instance S.ToSchema Welcome where declareNamedSchema _ = pure (mlsSwagger "Welcome") @@ -37,16 +41,29 @@ instance S.ToSchema Welcome where instance ParseMLS Welcome where parseMLS = Welcome - -- Note: the extra protocol version at the beginning of the welcome - -- message is present in openmls-0.4.0-pre, but is not part of the spec - <$> (parseMLS @ProtocolVersion *> parseMLS) + <$> parseMLS @ProtocolVersion + <*> parseMLS <*> parseMLSVector @Word32 parseMLS <*> parseMLSBytes @Word32 +instance SerialiseMLS Welcome where + serialiseMLS (Welcome pv cs ss gi) = do + serialiseMLS pv + serialiseMLS cs + serialiseMLSVector @Word32 serialiseMLS ss + serialiseMLSBytes @Word32 gi + data GroupSecrets = GroupSecrets { gsNewMember :: KeyPackageRef, gsSecrets :: HPKECiphertext } + deriving (Show, Eq, Generic) + deriving (Arbitrary) via (GenericUniform GroupSecrets) instance ParseMLS GroupSecrets where parseMLS = GroupSecrets <$> parseMLS <*> parseMLS + +instance SerialiseMLS GroupSecrets where + serialiseMLS (GroupSecrets kp sec) = do + serialiseMLS kp + serialiseMLS sec diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs b/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs index de1bd25b34a..ffb364daf9a 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs @@ -41,6 +41,7 @@ import Wire.API.Error import qualified Wire.API.Error.Brig as BrigError import Wire.API.Error.Galley import Wire.API.Event.Conversation +import Wire.API.MLS.CommitBundle import Wire.API.MLS.Keys import Wire.API.MLS.Message import Wire.API.MLS.Serialisation @@ -1382,6 +1383,33 @@ type MLSMessagingAPI = :> ReqBody '[MLS] (RawMLS SomeMessage) :> MultiVerb1 'POST '[JSON] (Respond 201 "Message sent" MLSMessageSendingStatus) ) + :<|> Named + "mls-commit-bundle" + ( Summary "Post a MLS CommitBundle" + :> From 'V2 + :> CanThrow 'ConvAccessDenied + :> CanThrow 'ConvMemberNotFound + :> CanThrow 'ConvNotFound + :> CanThrow 'LegalHoldNotEnabled + :> CanThrow 'MLSClientMismatch + :> CanThrow 'MLSCommitMissingReferences + :> CanThrow 'MLSKeyPackageRefNotFound + :> CanThrow 'MLSProposalNotFound + :> CanThrow 'MLSProtocolErrorTag + :> CanThrow 'MLSSelfRemovalNotAllowed + :> CanThrow 'MLSStaleMessage + :> CanThrow 'MLSUnsupportedMessage + :> CanThrow 'MLSUnsupportedProposal + :> CanThrow 'MLSClientSenderUserMismatch + :> CanThrow 'MLSGroupConversationMismatch + :> CanThrow 'MLSWelcomeMismatch + :> CanThrow 'MissingLegalholdConsent + :> CanThrow MLSProposalFailure + :> "commit-bundles" + :> ZConn + :> ReqBody '[MLS] (RawMLS CommitBundle) + :> MultiVerb1 'POST '[JSON] (Respond 201 "Commit accepted and forwarded" MLSMessageSendingStatus) + ) :<|> Named "mls-public-keys" ( Summary "Get public keys used by the backend to sign external proposals" diff --git a/libs/wire-api/test/unit/Test/Wire/API/MLS.hs b/libs/wire-api/test/unit/Test/Wire/API/MLS.hs index 9040f432d49..7be804c918f 100644 --- a/libs/wire-api/test/unit/Test/Wire/API/MLS.hs +++ b/libs/wire-api/test/unit/Test/Wire/API/MLS.hs @@ -48,6 +48,7 @@ import Wire.API.MLS.Group import Wire.API.MLS.KeyPackage import Wire.API.MLS.Message import Wire.API.MLS.Proposal +import Wire.API.MLS.PublicGroupState import Wire.API.MLS.Serialisation import Wire.API.MLS.Welcome @@ -60,7 +61,8 @@ tests = testCase "parse welcome message" testParseWelcome, testCase "key package ref" testKeyPackageRef, testCase "validate message signature" testVerifyMLSPlainTextWithKey, - testCase "create signed remove proposal" testRemoveProposalMessageSignature + testCase "create signed remove proposal" testRemoveProposalMessageSignature, + testCase "parse GroupInfoBundle" testParseGroupInfoBundle ] testParseKeyPackage :: IO () @@ -214,6 +216,49 @@ testRemoveProposalMessageSignature = withSystemTempDirectory "mls" $ \tmp -> do ) Nothing +testParseGroupInfoBundle :: IO () +testParseGroupInfoBundle = withSystemTempDirectory "mls" $ \tmp -> do + qcid <- do + let c = newClientId 0x3ae58155 + usr <- flip Qualified (Domain "example.com") <$> (Id <$> UUID.nextRandom) + pure (userClientQid usr c) + void . liftIO $ spawn (cli qcid tmp ["init", qcid]) Nothing + + qcid2 <- do + let c = newClientId 0x4ae58157 + usr <- flip Qualified (Domain "example.com") <$> (Id <$> UUID.nextRandom) + pure (userClientQid usr c) + void . liftIO $ spawn (cli qcid2 tmp ["init", qcid2]) Nothing + kp :: RawMLS KeyPackage <- liftIO $ decodeMLSError <$> spawn (cli qcid2 tmp ["key-package", "create"]) Nothing + liftIO $ BS.writeFile (tmp qcid2) (rmRaw kp) + + let groupFilename = "group" + let gid = GroupId "abcd" + createGroup tmp qcid groupFilename gid + + void $ + liftIO $ + spawn + ( cli + qcid + tmp + [ "member", + "add", + "--group", + tmp groupFilename, + "--in-place", + tmp qcid2, + "--group-state-out", + tmp "group-info-bundle" + ] + ) + Nothing + + bundleBS <- BS.readFile (tmp "group-info-bundle") + case decodeMLS' @PublicGroupState bundleBS of + Left err -> assertFailure ("Failed parsing PublicGroupState: " <> T.unpack err) + Right _ -> pure () + createGroup :: FilePath -> String -> String -> GroupId -> IO () createGroup tmp store groupName gid = do groupJSON <- diff --git a/libs/wire-api/test/unit/Test/Wire/API/Roundtrip/MLS.hs b/libs/wire-api/test/unit/Test/Wire/API/Roundtrip/MLS.hs index 34aaeeb9ffe..e1a4e9820da 100644 --- a/libs/wire-api/test/unit/Test/Wire/API/Roundtrip/MLS.hs +++ b/libs/wire-api/test/unit/Test/Wire/API/Roundtrip/MLS.hs @@ -28,7 +28,9 @@ import Wire.API.MLS.Extension import Wire.API.MLS.KeyPackage import Wire.API.MLS.Message import Wire.API.MLS.Proposal +import Wire.API.MLS.PublicGroupState import Wire.API.MLS.Serialisation +import Wire.API.MLS.Welcome tests :: T.TestTree tests = @@ -38,7 +40,10 @@ tests = testRoundTrip @RemoveProposalMessage, testRoundTrip @RemoveProposalPayload, testRoundTrip @AppAckProposalTest, - testRoundTrip @ExtensionVector + testRoundTrip @ExtensionVector, + testRoundTrip @PublicGroupStateTBS, + testRoundTrip @PublicGroupState, + testRoundTrip @Welcome ] testRoundTrip :: diff --git a/libs/wire-api/wire-api.cabal b/libs/wire-api/wire-api.cabal index b7dab8ae13c..ac49c0a5a4d 100644 --- a/libs/wire-api/wire-api.cabal +++ b/libs/wire-api/wire-api.cabal @@ -41,15 +41,18 @@ library Wire.API.Message.Proto Wire.API.MLS.CipherSuite Wire.API.MLS.Commit + Wire.API.MLS.CommitBundle Wire.API.MLS.Context Wire.API.MLS.Credential Wire.API.MLS.Epoch Wire.API.MLS.Extension Wire.API.MLS.Group + Wire.API.MLS.GroupInfoBundle Wire.API.MLS.KeyPackage Wire.API.MLS.Keys Wire.API.MLS.Message Wire.API.MLS.Proposal + Wire.API.MLS.PublicGroupState Wire.API.MLS.Serialisation Wire.API.MLS.Servant Wire.API.MLS.Welcome diff --git a/nix/pkgs/mls_test_cli/default.nix b/nix/pkgs/mls_test_cli/default.nix index 5d786dc0c6a..a9a9657d731 100644 --- a/nix/pkgs/mls_test_cli/default.nix +++ b/nix/pkgs/mls_test_cli/default.nix @@ -9,17 +9,17 @@ rustPlatform.buildRustPackage rec { name = "mls-test-cli-${version}"; - version = "0.4.0"; + version = "0.6.0"; nativeBuildInputs = [ pkg-config perl ]; buildInputs = [ libsodium ]; src = fetchFromGitHub { owner = "wireapp"; repo = "mls-test-cli"; - sha256 = "sha256-Gw1+b7kslc/KcB+pEqP1FuE6tAPqKtB6hlkLcXMuCcM="; - rev = "f44dec2705e1833b654cb6f02271e11a6c2fdeb0"; + sha256 = "sha256-xYL9KNcirCARb1Rp41einOpq0ut5adlqMIAEiwYXkzg="; + rev = "d46624fb49c900facc8853fa86e3ecf51fd0dcdb"; }; doCheck = false; - cargoSha256 = "sha256-3zUGEowQREPKsfpH2y9C7BeeTTF3zat4Qfpw74fOCHQ="; + cargoSha256 = "sha256-FGFyS/tLlD+3JQX7vkKq4nW+WQI1FFnpugzfFBi/eQE="; cargoDepsHook = '' mkdir -p mls-test-cli-${version}-vendor.tar.gz/ring/.git ''; diff --git a/services/galley/src/Galley/API/Federation.hs b/services/galley/src/Galley/API/Federation.hs index acb3cb4a4c1..e1c5a22c172 100644 --- a/services/galley/src/Galley/API/Federation.hs +++ b/services/galley/src/Galley/API/Federation.hs @@ -83,6 +83,7 @@ import Wire.API.Federation.API.Common (EmptyResponse (..)) import Wire.API.Federation.API.Galley (ClientRemovedRequest, ConversationUpdateResponse) import qualified Wire.API.Federation.API.Galley as F import Wire.API.Federation.Error +import Wire.API.MLS.CommitBundle import Wire.API.MLS.Credential import Wire.API.MLS.Message import Wire.API.MLS.Serialisation @@ -109,6 +110,7 @@ federationSitemap = :<|> Named @"mls-welcome" mlsSendWelcome :<|> Named @"on-mls-message-sent" onMLSMessageSent :<|> Named @"send-mls-message" sendMLSMessage + :<|> Named @"send-mls-commit-bundle" sendMLSCommitBundle :<|> Named @"on-client-removed" onClientRemoved onClientRemoved :: @@ -590,7 +592,7 @@ updateConversation origDomain updateRequest = do toResponse (Right (Left NoChanges)) = F.ConversationUpdateResponseNoChanges toResponse (Right (Right update)) = F.ConversationUpdateResponseUpdate update -sendMLSMessage :: +sendMLSCommitBundle :: ( Members [ BrigAccess, ConversationStore, @@ -615,13 +617,54 @@ sendMLSMessage :: Domain -> F.MessageSendRequest -> Sem r F.MLSMessageResponse -sendMLSMessage remoteDomain msr = +sendMLSCommitBundle remoteDomain msr = fmap (either (F.MLSMessageResponseProtocolError . unTagged) id) . runError @MLSProtocolError . fmap (either F.MLSMessageResponseError id) . runError . fmap (either (F.MLSMessageResponseProposalFailure . pfInner) id) . runError + $ do + loc <- qualifyLocal () + let sender = toRemoteUnsafe remoteDomain (F.msrSender msr) + bundle <- either (throw . mlsProtocolError) pure $ decodeMLS' (fromBase64ByteString (F.msrRawMessage msr)) + mapToGalleyError @MLSBundleStaticErrors $ do + let msg = rmValue (cbCommitMsg (rmValue bundle)) + qcnv <- E.getConversationIdByGroupId (msgGroupId msg) >>= noteS @'ConvNotFound + when (qUnqualified qcnv /= F.msrConvId msr) $ throwS @'MLSGroupConversationMismatch + F.MLSMessageResponseUpdates . map lcuUpdate + <$> postMLSCommitBundle loc (qUntagged sender) qcnv Nothing bundle + +sendMLSMessage :: + ( Members + [ BrigAccess, + ConversationStore, + ExternalAccess, + Error FederationError, + Error InternalError, + FederatorAccess, + GundeckAccess, + Input (Local ()), + Input Env, + Input Opts, + Input UTCTime, + LegalHoldStore, + MemberStore, + Resource, + TeamStore, + P.TinyLog, + ProposalStore + ] + r + ) => + Domain -> + F.MessageSendRequest -> + Sem r F.MLSMessageResponse +sendMLSMessage remoteDomain msr = + fmap (either (F.MLSMessageResponseProtocolError . unTagged) id) + . runError @MLSProtocolError + . fmap (either F.MLSMessageResponseError id) + . runError . fmap (either (F.MLSMessageResponseProposalFailure . pfInner) id) . runError $ do diff --git a/services/galley/src/Galley/API/MLS.hs b/services/galley/src/Galley/API/MLS.hs index fc85496141b..242414a4420 100644 --- a/services/galley/src/Galley/API/MLS.hs +++ b/services/galley/src/Galley/API/MLS.hs @@ -16,8 +16,9 @@ -- with this program. If not, see . module Galley.API.MLS - ( postMLSWelcome, + ( postMLSWelcomeFromLocalUser, postMLSMessage, + postMLSCommitBundleFromLocalUser, postMLSMessageFromLocalUser, postMLSMessageFromLocalUserV1, getMLSPublicKeys, diff --git a/services/galley/src/Galley/API/MLS/Message.hs b/services/galley/src/Galley/API/MLS/Message.hs index 15f08d45a64..e2283ef4c64 100644 --- a/services/galley/src/Galley/API/MLS/Message.hs +++ b/services/galley/src/Galley/API/MLS/Message.hs @@ -17,10 +17,13 @@ {-# LANGUAGE RecordWildCards #-} module Galley.API.MLS.Message - ( postMLSMessageFromLocalUser, + ( postMLSCommitBundle, + postMLSCommitBundleFromLocalUser, + postMLSMessageFromLocalUser, postMLSMessageFromLocalUserV1, postMLSMessage, MLSMessageStaticErrors, + MLSBundleStaticErrors, ) where @@ -39,6 +42,7 @@ import Galley.API.Error import Galley.API.MLS.KeyPackage import Galley.API.MLS.Propagate import Galley.API.MLS.Types +import Galley.API.MLS.Welcome (postMLSWelcome) import Galley.API.Util import Galley.Data.Conversation.Types hiding (Conversation) import qualified Galley.Data.Conversation.Types as Data @@ -71,12 +75,14 @@ import Wire.API.Federation.API.Galley import Wire.API.Federation.Error import Wire.API.MLS.CipherSuite import Wire.API.MLS.Commit +import Wire.API.MLS.CommitBundle import Wire.API.MLS.Credential import Wire.API.MLS.KeyPackage import Wire.API.MLS.Message import Wire.API.MLS.Proposal import qualified Wire.API.MLS.Proposal as Proposal import Wire.API.MLS.Serialisation +import Wire.API.MLS.Welcome import Wire.API.Message import Wire.API.Routes.Internal.Brig import Wire.API.User.Client @@ -98,6 +104,11 @@ type MLSMessageStaticErrors = ErrorS 'MLSGroupConversationMismatch ] +type MLSBundleStaticErrors = + Append + MLSMessageStaticErrors + '[ErrorS 'MLSWelcomeMismatch] + postMLSMessageFromLocalUserV1 :: ( HasProposalEffects r, Members @@ -165,22 +176,201 @@ postMLSMessageFromLocalUser lusr conn msg = do t <- toUTCTimeMillis <$> input pure $ MLSMessageSendingStatus events t +postMLSCommitBundle :: + ( HasProposalEffects r, + Members MLSBundleStaticErrors r, + Members + '[ BrigAccess, + Error FederationError, + Error InternalError, + Error MLSProtocolError, + Input (Local ()), + Input Opts, + Input UTCTime, + MemberStore, + ProposalStore, + Resource, + TinyLog + ] + r + ) => + Local x -> + Qualified UserId -> + Qualified ConvId -> + Maybe ConnId -> + RawMLS CommitBundle -> + Sem r [LocalConversationUpdate] +postMLSCommitBundle loc qusr qcnv conn rawBundle = + foldQualified + loc + (postMLSCommitBundleToLocalConv qusr conn (rmValue rawBundle)) + (postMLSCommitBundleToRemoteConv loc qusr conn rawBundle) + qcnv + +postMLSCommitBundleFromLocalUser :: + ( HasProposalEffects r, + Members MLSBundleStaticErrors r, + Members + '[ BrigAccess, + Error FederationError, + Error InternalError, + Input (Local ()), + Input Opts, + Input UTCTime, + MemberStore, + ProposalStore, + Resource, + TinyLog + ] + r + ) => + Local UserId -> + ConnId -> + RawMLS CommitBundle -> + Sem r MLSMessageSendingStatus +postMLSCommitBundleFromLocalUser lusr conn bundle = do + let msg = rmValue (cbCommitMsg (rmValue bundle)) + qcnv <- getConversationIdByGroupId (msgGroupId msg) >>= noteS @'ConvNotFound + events <- + map lcuEvent + <$> postMLSCommitBundle lusr (qUntagged lusr) qcnv (Just conn) bundle + t <- toUTCTimeMillis <$> input + pure $ MLSMessageSendingStatus events t + +postMLSCommitBundleToLocalConv :: + ( HasProposalEffects r, + Members MLSBundleStaticErrors r, + Members + '[ BrigAccess, + Error FederationError, + Error InternalError, + Error MLSProtocolError, + Input (Local ()), + Input UTCTime, + Input Opts, + ProposalStore, + BrigAccess, + Resource, + TinyLog + ] + r + ) => + Qualified UserId -> + Maybe ConnId -> + CommitBundle -> + Local ConvId -> + Sem r [LocalConversationUpdate] +postMLSCommitBundleToLocalConv qusr conn bundle lcnv = do + let msg = rmValue (cbCommitMsg bundle) + conv <- getLocalConvForUser qusr lcnv + let lconv = qualifyAs lcnv conv + cm <- lookupMLSClients lcnv + + senderClient <- fmap ciClient <$> getSenderClient qusr SMLSPlainText msg + + events <- case msgPayload msg of + CommitMessage commit -> + do + (groupId, action) <- getCommitData lconv (msgEpoch msg) commit + -- check that the welcome message matches the action + for_ (cbWelcome bundle) $ \welcome -> + when + ( Set.fromList (map gsNewMember (welSecrets (rmValue welcome))) + /= Set.fromList (map (snd . snd) (cmAssocs (paAdd action))) + ) + $ throwS @'MLSWelcomeMismatch + processCommitWithAction qusr senderClient conn lconv cm (msgEpoch msg) groupId action (msgSender msg) commit + ApplicationMessage _ -> throwS @'MLSUnsupportedMessage + ProposalMessage _ -> throwS @'MLSUnsupportedMessage + + propagateMessage qusr (qualifyAs lcnv conv) cm conn (rmRaw (cbCommitMsg bundle)) + + for_ (cbWelcome bundle) $ + postMLSWelcome lcnv conn + + pure events + +postMLSCommitBundleToRemoteConv :: + ( Members MLSBundleStaticErrors r, + Members + '[ Error FederationError, + Error MLSProtocolError, + Error MLSProposalFailure, + ExternalAccess, + FederatorAccess, + GundeckAccess, + MemberStore, + TinyLog + ] + r + ) => + Local x -> + Qualified UserId -> + Maybe ConnId -> + RawMLS CommitBundle -> + Remote ConvId -> + Sem r [LocalConversationUpdate] +postMLSCommitBundleToRemoteConv loc qusr con bundle rcnv = do + -- only local users can send messages to remote conversations + lusr <- foldQualified loc pure (\_ -> throwS @'ConvAccessDenied) qusr + -- only members may send commit bundles to a remote conversation + flip unless (throwS @'ConvMemberNotFound) =<< checkLocalMemberRemoteConv (tUnqualified lusr) rcnv + + resp <- + runFederated rcnv $ + fedClient @'Galley @"send-mls-commit-bundle" $ + MessageSendRequest + { msrConvId = tUnqualified rcnv, + msrSender = tUnqualified lusr, + msrRawMessage = Base64ByteString (rmRaw bundle) + } + updates <- case resp of + MLSMessageResponseError e -> rethrowErrors @MLSBundleStaticErrors e + MLSMessageResponseProtocolError e -> throw (mlsProtocolError e) + MLSMessageResponseProposalFailure e -> throw (MLSProposalFailure e) + MLSMessageResponseUpdates updates -> pure updates + + for updates $ \update -> do + e <- notifyRemoteConversationAction loc (qualifyAs rcnv update) con + pure (LocalConversationUpdate e update) + +getLocalConvForUser :: + Members + '[ ErrorS 'ConvNotFound, + ConversationStore, + Input (Local ()), + MemberStore + ] + r => + Qualified UserId -> + Local ConvId -> + Sem r Data.Conversation +getLocalConvForUser qusr lcnv = do + conv <- getConversation (tUnqualified lcnv) >>= noteS @'ConvNotFound + + -- check that sender is part of conversation + loc <- qualifyLocal () + isMember' <- foldQualified loc (fmap isJust . getLocalMember (convId conv) . tUnqualified) (fmap isJust . getRemoteMember (convId conv)) qusr + unless isMember' $ throwS @'ConvNotFound + + pure conv + postMLSMessage :: ( HasProposalEffects r, Members '[ Error FederationError, Error InternalError, ErrorS 'ConvAccessDenied, - ErrorS 'ConvNotFound, ErrorS 'ConvMemberNotFound, - ErrorS 'MLSUnsupportedMessage, - ErrorS 'MLSStaleMessage, - ErrorS 'MLSProposalNotFound, - ErrorS 'MissingLegalholdConsent, - ErrorS 'MLSCommitMissingReferences, - ErrorS 'MLSSelfRemovalNotAllowed, + ErrorS 'ConvNotFound, ErrorS 'MLSClientSenderUserMismatch, + ErrorS 'MLSCommitMissingReferences, ErrorS 'MLSGroupConversationMismatch, + ErrorS 'MLSProposalNotFound, + ErrorS 'MLSSelfRemovalNotAllowed, + ErrorS 'MLSStaleMessage, + ErrorS 'MLSUnsupportedMessage, + ErrorS 'MissingLegalholdConsent, Resource, TinyLog, ProposalStore, @@ -195,49 +385,40 @@ postMLSMessage :: RawMLS SomeMessage -> Sem r [LocalConversationUpdate] postMLSMessage loc qusr qcnv con smsg = case rmValue smsg of - SomeMessage _ msg -> do - mcid <- if msgEpoch msg == Epoch 0 then pure Nothing else getSenderClient smsg - -- Check that the MLS client who created the message belongs to the user who - -- is the sender of the REST request, identified by HTTP header. - -- - -- This is only relevant in an ongoing conversation. The check should be skipped - -- in case of - -- encrypted messages in which we don't have access to the sending client's - -- key package, - -- messages sent by the backend, and - -- external add proposals which propose fresh key packages for new clients and - -- thus the validity of the key package cannot be known at the time of this - -- check. - -- For these cases the function will return True. - for_ mcid $ \cid -> - when (fmap fst (cidQualifiedClient cid) /= qusr) $ - throwS @'MLSClientSenderUserMismatch - + SomeMessage tag msg -> do + mcid <- fmap ciClient <$> getSenderClient qusr tag msg foldQualified loc - (postMLSMessageToLocalConv qusr (fmap ciClient mcid) con smsg) - (postMLSMessageToRemoteConv loc qusr (fmap ciClient mcid) con smsg) + (postMLSMessageToLocalConv qusr mcid con smsg) + (postMLSMessageToRemoteConv loc qusr mcid con smsg) qcnv +-- Check that the MLS client who created the message belongs to the user who +-- is the sender of the REST request, identified by HTTP header. +-- +-- The check is skipped in case of conversation creation and encrypted messages. getSenderClient :: ( Members '[ ErrorS 'MLSKeyPackageRefNotFound, + ErrorS 'MLSClientSenderUserMismatch, BrigAccess ] r ) => - RawMLS SomeMessage -> + Qualified UserId -> + SWireFormatTag tag -> + Message tag -> Sem r (Maybe ClientIdentity) -getSenderClient smsg = case rmValue smsg of - SomeMessage tag msg -> case tag of - -- skip encrypted message - SMLSCipherText -> pure Nothing - SMLSPlainText -> case msgSender msg of - -- skip message sent by backend - PreconfiguredSender _ -> pure Nothing - -- skip external add proposal - NewMemberSender -> pure Nothing - MemberSender ref -> Just <$> derefKeyPackage ref +getSenderClient _ SMLSCipherText _ = pure Nothing +getSenderClient _ _ msg | msgEpoch msg == Epoch 0 = pure Nothing +getSenderClient qusr SMLSPlainText msg = case msgSender msg of + PreconfiguredSender _ -> pure Nothing + NewMemberSender -> pure Nothing + MemberSender ref -> do + cid <- derefKeyPackage ref + when (fmap fst (cidQualifiedClient cid) /= qusr) $ + throwS @'MLSClientSenderUserMismatch + pure (Just cid) postMLSMessageToLocalConv :: ( HasProposalEffects r, @@ -266,12 +447,7 @@ postMLSMessageToLocalConv :: Sem r [LocalConversationUpdate] postMLSMessageToLocalConv qusr senderClient con smsg lcnv = case rmValue smsg of SomeMessage tag msg -> do - conv <- getConversation (tUnqualified lcnv) >>= noteS @'ConvNotFound - - -- check that sender is part of conversation - loc <- qualifyLocal () - isMember' <- foldQualified loc (fmap isJust . getLocalMember (convId conv) . tUnqualified) (fmap isJust . getRemoteMember (convId conv)) qusr - unless isMember' $ throwS @'ConvNotFound + conv <- getLocalConvForUser qusr lcnv -- construct client map cm <- lookupMLSClients lcnv @@ -376,6 +552,35 @@ paAddClient quc = mempty {paAdd = Map.singleton (fmap fst quc) (Set.singleton (s paRemoveClient :: Qualified (UserId, (ClientId, KeyPackageRef)) -> ProposalAction paRemoveClient quc = mempty {paRemove = Map.singleton (fmap fst quc) (Set.singleton (snd (qUnqualified quc)))} +getCommitData :: + ( HasProposalEffects r, + Member (ErrorS 'ConvNotFound) r, + Member (Error MLSProtocolError) r, + Member (ErrorS 'MLSProposalNotFound) r, + Member (ErrorS 'MLSStaleMessage) r, + Member (Input (Local ())) r, + Member (Input Env) r, + Member (Input Opts) r, + Member (Input UTCTime) r, + Member TinyLog r + ) => + Local Data.Conversation -> + Epoch -> + Commit -> + Sem r (GroupId, ProposalAction) +getCommitData lconv epoch commit = do + convMeta <- + preview (to convProtocol . _ProtocolMLS) (tUnqualified lconv) + & noteS @'ConvNotFound + + let curEpoch = cnvmlsEpoch convMeta + groupId = cnvmlsGroupId convMeta + + -- check epoch number + when (epoch /= curEpoch) $ throwS @'MLSStaleMessage + action <- foldMap (applyProposalRef (tUnqualified lconv) groupId epoch) (cProposals commit) + pure (groupId, action) + processCommit :: ( HasProposalEffects r, Member (Error FederationError) r, @@ -401,17 +606,37 @@ processCommit :: Commit -> Sem r [LocalConversationUpdate] processCommit qusr senderClient con lconv cm epoch sender commit = do - self <- noteS @'ConvNotFound $ getConvMember lconv (tUnqualified lconv) qusr - - -- check epoch number - convMeta <- - preview (to convProtocol . _ProtocolMLS) (tUnqualified lconv) - & noteS @'ConvNotFound - - let curEpoch = cnvmlsEpoch convMeta - groupId = cnvmlsGroupId convMeta + (groupId, action) <- getCommitData lconv epoch commit + processCommitWithAction qusr senderClient con lconv cm epoch groupId action sender commit - when (epoch /= curEpoch) $ throwS @'MLSStaleMessage +processCommitWithAction :: + ( HasProposalEffects r, + Member (Error FederationError) r, + Member (Error InternalError) r, + Member (ErrorS 'ConvNotFound) r, + Member (ErrorS 'MLSCommitMissingReferences) 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 -> + Maybe ConnId -> + Local Data.Conversation -> + ClientMap -> + Epoch -> + GroupId -> + ProposalAction -> + Sender 'MLSPlainText -> + Commit -> + Sem r [LocalConversationUpdate] +processCommitWithAction qusr senderClient con lconv cm epoch groupId action sender commit = do + self <- noteS @'ConvNotFound $ getConvMember lconv (tUnqualified lconv) qusr let ttlSeconds :: Int = 600 -- 10 minutes withCommitLock groupId epoch (fromIntegral ttlSeconds) $ do @@ -460,7 +685,6 @@ processCommit qusr senderClient con lconv cm epoch sender commit = do throwS @'MLSCommitMissingReferences -- process and execute proposals - action <- foldMap (applyProposalRef (tUnqualified lconv) groupId epoch) (cProposals commit) updates <- executeProposalAction qusr con lconv cm action -- update key package ref if necessary diff --git a/services/galley/src/Galley/API/MLS/Welcome.hs b/services/galley/src/Galley/API/MLS/Welcome.hs index c249e3d03d7..2e52592d9c5 100644 --- a/services/galley/src/Galley/API/MLS/Welcome.hs +++ b/services/galley/src/Galley/API/MLS/Welcome.hs @@ -17,6 +17,7 @@ module Galley.API.MLS.Welcome ( postMLSWelcome, + postMLSWelcomeFromLocalUser, sendLocalWelcomes, ) where @@ -60,17 +61,33 @@ postMLSWelcome :: P.TinyLog ] r => - Local UserId -> - ConnId -> + Local x -> + Maybe ConnId -> RawMLS Welcome -> Sem r () -postMLSWelcome lusr con wel = do +postMLSWelcome loc con wel = do now <- input rcpts <- welcomeRecipients (rmValue wel) - let (locals, remotes) = partitionQualified lusr rcpts - sendLocalWelcomes (Just con) now (rmRaw wel) (qualifyAs lusr locals) + let (locals, remotes) = partitionQualified loc rcpts + sendLocalWelcomes con now (rmRaw wel) (qualifyAs loc locals) sendRemoteWelcomes (rmRaw wel) remotes +postMLSWelcomeFromLocalUser :: + Members + '[ BrigAccess, + FederatorAccess, + GundeckAccess, + ErrorS 'MLSKeyPackageRefNotFound, + Input UTCTime, + P.TinyLog + ] + r => + Local x -> + ConnId -> + RawMLS Welcome -> + Sem r () +postMLSWelcomeFromLocalUser loc con wel = postMLSWelcome loc (Just con) wel + welcomeRecipients :: Members '[ BrigAccess, diff --git a/services/galley/src/Galley/API/Public/Servant.hs b/services/galley/src/Galley/API/Public/Servant.hs index baaa9cc414b..7686b15ef3b 100644 --- a/services/galley/src/Galley/API/Public/Servant.hs +++ b/services/galley/src/Galley/API/Public/Servant.hs @@ -162,9 +162,10 @@ servantSitemap = mls :: API MLSAPI GalleyEffects mls = - mkNamedAPI @"mls-welcome-message" postMLSWelcome + mkNamedAPI @"mls-welcome-message" postMLSWelcomeFromLocalUser <@> mkNamedAPI @"mls-message-v1" postMLSMessageFromLocalUserV1 <@> mkNamedAPI @"mls-message" postMLSMessageFromLocalUser + <@> mkNamedAPI @"mls-commit-bundle" postMLSCommitBundleFromLocalUser <@> mkNamedAPI @"mls-public-keys" getMLSPublicKeys customBackend :: API CustomBackendAPI GalleyEffects diff --git a/services/galley/src/Galley/Cassandra/Queries.hs b/services/galley/src/Galley/Cassandra/Queries.hs index 07b45150fc7..0436b16a924 100644 --- a/services/galley/src/Galley/Cassandra/Queries.hs +++ b/services/galley/src/Galley/Cassandra/Queries.hs @@ -34,6 +34,7 @@ import Wire.API.Conversation.Code import Wire.API.Conversation.Protocol import Wire.API.Conversation.Role import Wire.API.MLS.CipherSuite +import Wire.API.MLS.GroupInfoBundle import Wire.API.MLS.KeyPackage import Wire.API.Provider import Wire.API.Provider.Service @@ -232,6 +233,9 @@ deleteConv = "delete from conversation using timestamp 32503680000000000 where c markConvDeleted :: PrepQuery W (Identity ConvId) () markConvDeleted = "update conversation set deleted = true where conv = ?" +updateGroupInfoBundle :: PrepQuery W (GroupInfoBundle, ConvId) () +updateGroupInfoBundle = "update conversation set group_info_bundle = ? where conv = ?" + -- Conversations accessible by code ----------------------------------------- insertCode :: PrepQuery W (Key, Value, ConvId, Scope, Int32) () diff --git a/services/galley/test/integration/API/MLS.hs b/services/galley/test/integration/API/MLS.hs index 80ff3dd766d..811939d4ffe 100644 --- a/services/galley/test/integration/API/MLS.hs +++ b/services/galley/test/integration/API/MLS.hs @@ -65,6 +65,7 @@ import Wire.API.Federation.API.Galley import Wire.API.MLS.Credential import Wire.API.MLS.Keys import Wire.API.MLS.Serialisation +import Wire.API.MLS.Welcome import Wire.API.Message import Wire.API.User.Client @@ -93,12 +94,15 @@ tests s = testGroup "Commit" [ test s "add user to a conversation" testAddUser, + test s "add user with a commit bundle" testAddUserWithBundle, + test s "add user with an incomplete welcome" testAddUserWithBundleIncompleteWelcome, test s "add user (not connected)" testAddUserNotConnected, test s "add user (partial client list)" testAddUserPartial, test s "add client of existing user" testAddClientPartial, test s "add user with some non-MLS clients" testAddUserWithProteusClients, test s "send a stale commit" testStaleCommit, test s "add remote user to a conversation" testAddRemoteUser, + test s "add remote user with a commit bundle" testAddRemoteUserWithBundle, test s "return error when commit is locked" testCommitLock, test s "add user to a conversation with proposal + commit" testAddUserBareProposalCommit, test s "post commit that references a unknown proposal" testUnknownProposalRefCommit, @@ -292,6 +296,64 @@ testRemoteWelcome = do let req :: Maybe MLSWelcomeRequest = Aeson.decode (frBody fedWelcome) liftIO $ req @?= (Just . MLSWelcomeRequest . Base64ByteString) welcome +testAddUserWithBundle :: TestM () +testAddUserWithBundle = do + [alice, bob] <- createAndConnectUsers [Nothing, Nothing] + + qcnv <- runMLSTest $ do + (alice1 : bobClients) <- traverse createMLSClient [alice, bob, bob] + traverse_ uploadNewKeyPackage bobClients + (_, qcnv) <- setupMLSGroup 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 + + -- check that bob can now see the conversation + convs <- + responseJsonError =<< getConvs (qUnqualified bob) Nothing Nothing + pure (Aeson.encode ()) + "on-new-remote-conversation" -> pure (Aeson.encode EmptyResponse) + "get-mls-clients" -> + pure + . Aeson.encode + . Set.fromList + . map (flip ClientInfo True . ciClient) + $ [bob1] + "mls-welcome" -> pure (Aeson.encode EmptyResponse) + ms -> assertFailure ("unmocked endpoint called: " <> cs ms) + + commit <- createAddCommit alice1 [bob] + (events, reqs) <- + withTempMockFederator' mock $ + sendAndConsumeCommitBundle commit + pure (events, reqs, qcnv) + + liftIO $ do + req <- assertOne $ filter ((== "on-conversation-updated") . frRPC) reqs + frTargetDomain req @?= qDomain bob + bdy <- case Aeson.eitherDecode (frBody req) of + Right b -> pure b + Left e -> assertFailure $ "Could not parse on-conversation-updated request body: " <> e + cuOrigUserId bdy @?= alice + cuConvId bdy @?= qUnqualified qcnv + cuAlreadyPresentUsers bdy @?= [qUnqualified bob] + cuAction bdy + @?= SomeConversationAction + SConversationJoinTag + ConversationJoin + { cjUsers = pure bob, + cjRole = roleNameWireMember + } + + liftIO $ do + event <- assertOne events + assertJoinEvent qcnv alice [bob] roleNameWireMember event + testCommitLock :: TestM () testCommitLock = do users <- createAndConnectUsers (replicate 4 Nothing) @@ -666,7 +774,7 @@ testCommitNotReferencingAllProposals = do -- send commit and expect and error err <- responseJsonError =<< postMessage (ciUser alice1) (mpMessage commit) - + UserId -> + ByteString -> + m ResponseLBS +postCommitBundle sender bundle = do + galley <- viewGalley + post + ( galley . paths ["v2", "mls", "commit-bundles"] + . zUser sender + . zConn "conn" + . content "message/mls" + . bytes bundle + ) + postWelcome :: (MonadIO m, MonadHttp m, HasGalley m, HasCallStack) => UserId -> ByteString -> m ResponseLBS postWelcome uid welcome = do galley <- viewGalley @@ -212,7 +235,8 @@ runMLSTest (MLSTest m) = data MessagePackage = MessagePackage { mpSender :: ClientIdentity, mpMessage :: ByteString, - mpWelcome :: Maybe ByteString + mpWelcome :: Maybe ByteString, + mpPublicGroupState :: Maybe ByteString } takeLastPrekeyNG :: HasCallStack => MLSTest LastPrekey @@ -504,7 +528,8 @@ createApplicationMessage cid messageContent = do MessagePackage { mpSender = cid, mpMessage = message, - mpWelcome = Nothing + mpWelcome = Nothing, + mpPublicGroupState = Nothing } createAddCommitWithKeyPackages :: @@ -516,6 +541,7 @@ createAddCommitWithKeyPackages qcid clientsAndKeyPackages = do g <- currentGroupFile qcid gNew <- nextGroupFile qcid welcomeFile <- liftIO $ emptyTempFile bd "welcome" + pgsFile <- liftIO $ emptyTempFile bd "pgs" commit <- mlscli qcid @@ -525,6 +551,8 @@ createAddCommitWithKeyPackages qcid clientsAndKeyPackages = do g, "--welcome-out", welcomeFile, + "--group-state-out", + pgsFile, "--group-out", gNew ] @@ -538,11 +566,13 @@ createAddCommitWithKeyPackages qcid clientsAndKeyPackages = do } welcome <- liftIO $ BS.readFile welcomeFile + pgs <- liftIO $ BS.readFile pgsFile pure $ MessagePackage { mpSender = qcid, mpMessage = commit, - mpWelcome = Just welcome + mpWelcome = Just welcome, + mpPublicGroupState = Just pgs } createAddProposalWithKeyPackage :: @@ -561,13 +591,15 @@ createAddProposalWithKeyPackage cid (_, kp) = do MessagePackage { mpSender = cid, mpMessage = prop, - mpWelcome = Nothing + mpWelcome = Nothing, + mpPublicGroupState = Nothing } createPendingProposalCommit :: HasCallStack => ClientIdentity -> MLSTest MessagePackage createPendingProposalCommit qcid = do bd <- State.gets mlsBaseDir welcomeFile <- liftIO $ emptyTempFile bd "welcome" + pgsFile <- liftIO $ emptyTempFile bd "pgs" g <- currentGroupFile qcid gNew <- nextGroupFile qcid commit <- @@ -579,16 +611,20 @@ createPendingProposalCommit qcid = do "--group-out", gNew, "--welcome-out", - welcomeFile + welcomeFile, + "--group-state-out", + pgsFile ] Nothing welcome <- liftIO $ readWelcome welcomeFile + pgs <- liftIO $ BS.readFile pgsFile pure MessagePackage { mpSender = qcid, mpMessage = commit, - mpWelcome = welcome + mpWelcome = welcome, + mpPublicGroupState = Just pgs } readWelcome :: FilePath -> IO (Maybe ByteString) @@ -602,6 +638,7 @@ createRemoveCommit :: HasCallStack => ClientIdentity -> [ClientIdentity] -> MLST createRemoveCommit cid targets = do bd <- State.gets mlsBaseDir welcomeFile <- liftIO $ emptyTempFile bd "welcome" + pgsFile <- liftIO $ emptyTempFile bd "pgs" g <- currentGroupFile cid gNew <- nextGroupFile cid @@ -619,17 +656,21 @@ createRemoveCommit cid targets = do "--group-out", gNew, "--welcome-out", - welcomeFile + welcomeFile, + "--group-state-out", + pgsFile ] <> kps ) Nothing welcome <- liftIO $ readWelcome welcomeFile + pgs <- liftIO $ BS.readFile pgsFile pure MessagePackage { mpSender = cid, mpMessage = commit, - mpWelcome = welcome + mpWelcome = welcome, + mpPublicGroupState = Just pgs } createExternalAddProposal :: HasCallStack => ClientIdentity -> MLSTest MessagePackage @@ -659,7 +700,8 @@ createExternalAddProposal joiner = do MessagePackage { mpSender = joiner, mpMessage = proposal, - mpWelcome = Nothing + mpWelcome = Nothing, + mpPublicGroupState = Nothing } consumeWelcome :: HasCallStack => ByteString -> MLSTest () @@ -744,6 +786,47 @@ sendAndConsumeCommit mp = do pure events +mkBundle :: MessagePackage -> Either Text CommitBundle +mkBundle mp = do + commitB <- decodeMLS' (mpMessage mp) + welcomeB <- traverse decodeMLS' (mpWelcome mp) + pgs <- note "public group state unavailable" (mpPublicGroupState mp) + pgsB <- decodeMLS' pgs + pure $ + CommitBundle commitB welcomeB $ + GroupInfoBundle UnencryptedGroupInfo TreeFull pgsB + +createBundle :: MonadIO m => MessagePackage -> m ByteString +createBundle mp = do + bundle <- + either (liftIO . assertFailure . T.unpack) pure $ + mkBundle mp + pure (encodeMLS' bundle) + +sendAndConsumeCommitBundle :: + HasCallStack => + MessagePackage -> + MLSTest [Event] +sendAndConsumeCommitBundle mp = do + bundle <- createBundle mp + events <- + fmap mmssEvents + . responseJsonError + =<< postCommitBundle (ciUser (mpSender mp)) bundle + + mls + { mlsEpoch = mlsEpoch mls + 1, + mlsMembers = mlsMembers mls <> mlsNewMembers mls, + mlsNewMembers = mempty + } + + pure events + mlsBracket :: HasCallStack => [ClientIdentity] -> From 6bf0e77447640cfeb2014a8d8d444495b393a723 Mon Sep 17 00:00:00 2001 From: Igor Ranieri Elland <54423+elland@users.noreply.github.com> Date: Tue, 20 Sep 2022 11:42:15 +0200 Subject: [PATCH 33/58] Use hlint with no summary instead of grep. (#2712) * Use hlint no summary instead of grep. Turns out hlint already provided a way to silence the annoying no hints output. On top of that, I added a quick early break with a better error message in case of grep failures b/c no files were found. * Update hlint.sh * Update hlint.sh I've over deleted. --- tools/hlint.sh | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/tools/hlint.sh b/tools/hlint.sh index e8e31d88c1f..1ae13906cb9 100755 --- a/tools/hlint.sh +++ b/tools/hlint.sh @@ -1,5 +1,7 @@ #!/usr/bin/env bash +set -euo pipefail + usage() { echo "Usage: $0 -f [all, changeset] -m [check, inplace]" 1>&2; exit 1; } files='' @@ -47,7 +49,7 @@ for f in $files do echo "$f" if [ $check = true ]; then - hlint "$f" | grep -v 'No hints' + hlint --no-summary "$f" else hlint --refactor --refactor-options="--inplace" "$f" fi From f55267d970b9d0161aed00dbd6882353176c972a Mon Sep 17 00:00:00 2001 From: fisx Date: Tue, 20 Sep 2022 11:45:53 +0200 Subject: [PATCH 34/58] Nit pick (#2709) --- .../src/Gundeck/Push/Native/Serialise.hs | 29 +++++++------------ 1 file changed, 11 insertions(+), 18 deletions(-) diff --git a/services/gundeck/src/Gundeck/Push/Native/Serialise.hs b/services/gundeck/src/Gundeck/Push/Native/Serialise.hs index 0077594710f..8e070222f5b 100644 --- a/services/gundeck/src/Gundeck/Push/Native/Serialise.hs +++ b/services/gundeck/src/Gundeck/Push/Native/Serialise.hs @@ -33,24 +33,17 @@ import Gundeck.Types import Imports serialise :: HasCallStack => NativePush -> UserId -> Transport -> IO (Either Failure LT.Text) -serialise m uid transport = do - let rs = prepare m uid - case rs of - Left failure -> pure $! Left $! failure - Right (v, prio) -> case renderText transport prio v of - Nothing -> pure $ Left PayloadTooLarge - Just txt -> pure $ Right txt - -prepare :: NativePush -> UserId -> Either Failure (Value, Priority) -prepare m uid = case m of - NativePush nid prio _aps -> - let o = - object - [ "type" .= ("notice" :: Text), - "data" .= object ["id" .= nid], - "user" .= uid - ] - in Right (o, prio) +serialise (NativePush nid prio _aps) uid transport = do + case renderText transport prio o of + Nothing -> pure $ Left PayloadTooLarge + Just txt -> pure $ Right txt + where + o = + object + [ "type" .= ("notice" :: Text), + "data" .= object ["id" .= nid], + "user" .= uid + ] -- | Assemble a final SNS JSON string for transmission. renderText :: Transport -> Priority -> Value -> Maybe LT.Text From b973e26613ecd12aef797c10d529f85517829f6e Mon Sep 17 00:00:00 2001 From: zebot Date: Tue, 20 Sep 2022 14:47:36 +0200 Subject: [PATCH 35/58] chore: [charts] Update team-settings version (#2710) Co-authored-by: Zebot --- changelog.d/0-release-notes/team-settings-upgrade | 1 + charts/team-settings/values.yaml | 2 +- 2 files changed, 2 insertions(+), 1 deletion(-) create mode 100644 changelog.d/0-release-notes/team-settings-upgrade diff --git a/changelog.d/0-release-notes/team-settings-upgrade b/changelog.d/0-release-notes/team-settings-upgrade new file mode 100644 index 00000000000..17ee61cb95e --- /dev/null +++ b/changelog.d/0-release-notes/team-settings-upgrade @@ -0,0 +1 @@ +Upgrade team-settings version to 4.12.1-v0.31.5-0-0167ea4 diff --git a/charts/team-settings/values.yaml b/charts/team-settings/values.yaml index 65cd0bc57fd..03da568f124 100644 --- a/charts/team-settings/values.yaml +++ b/charts/team-settings/values.yaml @@ -9,7 +9,7 @@ resources: cpu: "1" image: repository: quay.io/wire/team-settings - tag: "4.11.0-v0.31.1-0-9e64150" + tag: "4.12.1-v0.31.5-0-0167ea4" service: https: externalPort: 443 From 30bf53861cb9c378cd3d1aa48a216a7d5cf5598a Mon Sep 17 00:00:00 2001 From: zebot Date: Tue, 20 Sep 2022 14:48:04 +0200 Subject: [PATCH 36/58] chore: [charts] Update webapp version (#2711) Co-authored-by: Zebot --- changelog.d/0-release-notes/webapp-upgrade | 1 + charts/webapp/values.yaml | 2 +- 2 files changed, 2 insertions(+), 1 deletion(-) create mode 100644 changelog.d/0-release-notes/webapp-upgrade diff --git a/changelog.d/0-release-notes/webapp-upgrade b/changelog.d/0-release-notes/webapp-upgrade new file mode 100644 index 00000000000..9481d3e313d --- /dev/null +++ b/changelog.d/0-release-notes/webapp-upgrade @@ -0,0 +1 @@ +Upgrade webapp version to 2022-09-20-production.0-v0.31.2-0-7f74074 diff --git a/charts/webapp/values.yaml b/charts/webapp/values.yaml index 78f3b51a12f..7cffabca9a6 100644 --- a/charts/webapp/values.yaml +++ b/charts/webapp/values.yaml @@ -9,7 +9,7 @@ resources: cpu: "1" image: repository: quay.io/wire/webapp - tag: "2022-06-30-production.0-v0.30.5-0-3e2aaf6" + tag: "2022-09-20-production.0-v0.31.2-0-7f74074" service: https: externalPort: 443 From 753a87594d43d87cbe4ea8dfac64ae9511f31619 Mon Sep 17 00:00:00 2001 From: Marko Nimac Date: Tue, 20 Sep 2022 14:54:44 +0200 Subject: [PATCH 37/58] SER-162: updated monitoring (#2708) * SER-162: updated monitoring * added a new entry in changelog.d --- changelog.d/4-docs/update-of-monitoring-wire-server-page | 1 + docs/src/how-to/install/monitoring.rst | 4 ++-- 2 files changed, 3 insertions(+), 2 deletions(-) create mode 100644 changelog.d/4-docs/update-of-monitoring-wire-server-page diff --git a/changelog.d/4-docs/update-of-monitoring-wire-server-page b/changelog.d/4-docs/update-of-monitoring-wire-server-page new file mode 100644 index 00000000000..fdb9658cb36 --- /dev/null +++ b/changelog.d/4-docs/update-of-monitoring-wire-server-page @@ -0,0 +1 @@ +Monitoring page showed wrong wrong configuration charts. Updated prometheus-operator to kube-prometheus-stack chart in the documentation. \ No newline at end of file diff --git a/docs/src/how-to/install/monitoring.rst b/docs/src/how-to/install/monitoring.rst index d886b888bde..eb49b1a404c 100644 --- a/docs/src/how-to/install/monitoring.rst +++ b/docs/src/how-to/install/monitoring.rst @@ -133,7 +133,7 @@ file. # This configuration switches to use memory instead of disk for metrics services # NOTE: If the pods are killed you WILL lose all your metrics history - prometheus-operator: + kube-prometheus-stack: grafana: persistence: enabled: false @@ -160,7 +160,7 @@ file. .. code:: yaml - prometheus-operator: + kube-prometheus-stack: grafana: persistence: storageClassName: "" From b2e497d7201c6603c80c5169a44787058b53bd7d Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Tue, 20 Sep 2022 15:17:07 +0200 Subject: [PATCH 38/58] [SQSERVICES-1643] Servantify brig account API 1 - `POST /delete` (#2699) --- changelog.d/5-internal/pr-2699 | 1 + .../src/Wire/API/Routes/Public/Brig.hs | 11 ++++++++ libs/wire-api/src/Wire/API/Swagger.hs | 1 - libs/wire-api/src/Wire/API/User.hs | 28 +++++-------------- services/brig/src/Brig/API/Public.hs | 25 ++++------------- 5 files changed, 24 insertions(+), 42 deletions(-) create mode 100644 changelog.d/5-internal/pr-2699 diff --git a/changelog.d/5-internal/pr-2699 b/changelog.d/5-internal/pr-2699 new file mode 100644 index 00000000000..69a92c3128e --- /dev/null +++ b/changelog.d/5-internal/pr-2699 @@ -0,0 +1 @@ +The `POST /delete` endpoint of the account API is now migrated to servant diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs index 0bc1a9ca28b..11265ec5dd2 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs @@ -384,6 +384,17 @@ type AccountAPI = :> ReqBody '[JSON] NewUserPublic :> MultiVerb 'POST '[JSON] RegisterResponses (Either RegisterError RegisterSuccess) ) + -- This endpoint can lead to the following events being sent: + -- UserDeleted event to contacts of deleted user + -- MemberLeave event to members for all conversations the user was in (via galley) + :<|> Named + "verify-delete" + ( Summary "Verify account deletion with a code." + :> CanThrow 'InvalidCode + :> "delete" + :> ReqBody '[JSON] VerifyDeleteUser + :> MultiVerb 'POST '[JSON] '[RespondEmpty 200 "Deletion is initiated."] () + ) type PrekeyAPI = Named diff --git a/libs/wire-api/src/Wire/API/Swagger.hs b/libs/wire-api/src/Wire/API/Swagger.hs index a9915a6b35e..bf1e06e94d2 100644 --- a/libs/wire-api/src/Wire/API/Swagger.hs +++ b/libs/wire-api/src/Wire/API/Swagger.hs @@ -102,7 +102,6 @@ models = User.modelUser, User.modelEmailUpdate, User.modelDelete, - User.modelVerifyDelete, User.Activation.modelActivate, User.Activation.modelSendActivationCode, User.Activation.modelActivationResponse, diff --git a/libs/wire-api/src/Wire/API/User.hs b/libs/wire-api/src/Wire/API/User.hs index e61446113f8..5dae1dfd9a1 100644 --- a/libs/wire-api/src/Wire/API/User.hs +++ b/libs/wire-api/src/Wire/API/User.hs @@ -109,7 +109,6 @@ module Wire.API.User modelEmailUpdate, modelUser, modelUserIdList, - modelVerifyDelete, -- * 2nd factor auth VerificationAction (..), @@ -1312,30 +1311,17 @@ data VerifyDeleteUser = VerifyDeleteUser } deriving stock (Eq, Show, Generic) deriving (Arbitrary) via (GenericUniform VerifyDeleteUser) - -modelVerifyDelete :: Doc.Model -modelVerifyDelete = Doc.defineModel "VerifyDelete" $ do - Doc.description "Data for verifying an account deletion." - Doc.property "key" Doc.string' $ - Doc.description "The identifying key of the account (i.e. user ID)." - Doc.property "code" Doc.string' $ - Doc.description "The verification code." + deriving (ToJSON, FromJSON, S.ToSchema) via (Schema VerifyDeleteUser) mkVerifyDeleteUser :: Code.Key -> Code.Value -> VerifyDeleteUser mkVerifyDeleteUser = VerifyDeleteUser -instance ToJSON VerifyDeleteUser where - toJSON d = - A.object - [ "key" A..= verifyDeleteUserKey d, - "code" A..= verifyDeleteUserCode d - ] - -instance FromJSON VerifyDeleteUser where - parseJSON = A.withObject "VerifyDeleteUser" $ \o -> - VerifyDeleteUser - <$> o A..: "key" - <*> o A..: "code" +instance ToSchema VerifyDeleteUser where + schema = + objectWithDocModifier "VerifyDeleteUser" (description ?~ "Data for verifying an account deletion.") $ + VerifyDeleteUser + <$> verifyDeleteUserKey .= fieldWithDocModifier "key" (description ?~ "The identifying key of the account (i.e. user ID).") schema + <*> verifyDeleteUserCode .= fieldWithDocModifier "code" (description ?~ "The verification code.") schema -- | A response for a pending deletion code. newtype DeletionCodeTimeout = DeletionCodeTimeout diff --git a/services/brig/src/Brig/API/Public.hs b/services/brig/src/Brig/API/Public.hs index e6159d34687..3daaed2ec7f 100644 --- a/services/brig/src/Brig/API/Public.hs +++ b/services/brig/src/Brig/API/Public.hs @@ -222,7 +222,9 @@ servantSitemap = userAPI :<|> selfAPI :<|> accountAPI :<|> clientAPI :<|> prekey :<|> Named @"change-handle" changeHandle accountAPI :: ServerT AccountAPI (Handler r) - accountAPI = Named @"register" createUser + accountAPI = + Named @"register" createUser + :<|> Named @"verify-delete" verifyDeleteUser clientAPI :: ServerT ClientAPI (Handler r) clientAPI = @@ -309,20 +311,6 @@ sitemap :: r => Routes Doc.ApiBuilder (Handler r) () sitemap = do - -- This endpoint can lead to the following events being sent: - -- UserDeleted event to contacts of deleted user - -- MemberLeave event to members for all conversations the user was in (via galley) - post "/delete" (continue verifyDeleteUserH) $ - jsonRequest @Public.VerifyDeleteUser - .&. accept "application" "json" - document "POST" "verifyDeleteUser" $ do - Doc.summary "Verify account deletion with a code." - Doc.body (Doc.ref Public.modelVerifyDelete) $ - Doc.description "JSON body" - Doc.response 200 "Deletion is initiated." Doc.end - Doc.errorResponse (errorToWai @'E.InvalidCode) - - -- TODO: put delete here, too? -- /activate, /password-reset ---------------------------------- -- This endpoint can lead to the following events being sent: @@ -989,11 +977,8 @@ deleteSelfUser :: deleteSelfUser u body = API.deleteSelfUser u (Public.deleteUserPassword body) !>> deleteUserError -verifyDeleteUserH :: JsonRequest Public.VerifyDeleteUser ::: JSON -> (Handler r) Response -verifyDeleteUserH (r ::: _) = do - body <- parseJsonBody r - API.verifyDeleteUser body !>> deleteUserError - pure (setStatus status200 empty) +verifyDeleteUser :: Public.VerifyDeleteUser -> Handler r () +verifyDeleteUser body = API.verifyDeleteUser body !>> deleteUserError updateUserEmail :: Member BlacklistStore r => UserId -> UserId -> Public.EmailUpdate -> (Handler r) () updateUserEmail zuserId emailOwnerId (Public.EmailUpdate email) = do From 813165443431ca3e6f2d5cf65d3b0b5f2812f77f Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Tue, 20 Sep 2022 16:34:30 +0200 Subject: [PATCH 39/58] [SQSERVICES-1643] Servantify brig account API 2 - `GET /activate` (#2700) --- changelog.d/5-internal/pr-2700 | 1 + .../src/Wire/API/Routes/Public/Brig.hs | 40 +++++++++++++++++ libs/wire-api/src/Wire/API/User/Activation.hs | 43 +++++++++++-------- services/brig/src/Brig/API/Public.hs | 37 +++------------- 4 files changed, 74 insertions(+), 47 deletions(-) create mode 100644 changelog.d/5-internal/pr-2700 diff --git a/changelog.d/5-internal/pr-2700 b/changelog.d/5-internal/pr-2700 new file mode 100644 index 00000000000..1280aee9c59 --- /dev/null +++ b/changelog.d/5-internal/pr-2700 @@ -0,0 +1 @@ +The `GET /activate` endpoint of the account API is now migrated to servant diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs index 11265ec5dd2..c4ebba27223 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs @@ -31,6 +31,7 @@ import Data.Qualified (Qualified (..)) import Data.Range import Data.SOP import Data.Swagger hiding (Contact, Header) +import qualified Generics.SOP as GSOP import Imports hiding (head) import Servant (JSON) import Servant hiding (Handler, JSON, addHeader, respond) @@ -50,6 +51,7 @@ import Wire.API.Routes.Public.Util import Wire.API.Routes.QualifiedCapture import Wire.API.Routes.Version import Wire.API.User hiding (NoIdentity) +import Wire.API.User.Activation import Wire.API.User.Client import Wire.API.User.Client.Prekey import Wire.API.User.Handle @@ -395,6 +397,44 @@ type AccountAPI = :> ReqBody '[JSON] VerifyDeleteUser :> MultiVerb 'POST '[JSON] '[RespondEmpty 200 "Deletion is initiated."] () ) + -- This endpoint can lead to the following events being sent: + -- - UserActivated event to the user, if account gets activated + -- - UserIdentityUpdated event to the user, if email or phone get activated + :<|> Named + "get-activate" + ( Summary "Activate (i.e. confirm) an email address or phone number." + :> Description "See also 'POST /activate' which has a larger feature set." + :> CanThrow 'UserKeyExists + :> CanThrow 'InvalidActivationCodeWrongUser + :> CanThrow 'InvalidActivationCodeWrongCode + :> CanThrow 'InvalidEmail + :> CanThrow 'InvalidPhone + :> "activate" + :> QueryParam' '[Required, Strict, Description "Activation key"] "key" ActivationKey + :> QueryParam' '[Required, Strict, Description "Activation code"] "code" ActivationCode + :> MultiVerb + 'GET + '[JSON] + GetActivateResponse + ActivationRespWithStatus + ) + +data ActivationRespWithStatus + = ActivationResp ActivationResponse + | ActivationRespDryRun + | ActivationRespPass + | ActivationRespSuccessNoIdent + deriving (Generic) + deriving (AsUnion GetActivateResponse) via GenericAsUnion GetActivateResponse ActivationRespWithStatus + +instance GSOP.Generic ActivationRespWithStatus + +type GetActivateResponse = + '[ Respond 200 "Activation successful." ActivationResponse, + RespondEmpty 200 "Activation successful. (Dry run)", + RespondEmpty 204 "A recent activation was already successful.", + RespondEmpty 200 "Activation successful." + ] type PrekeyAPI = Named diff --git a/libs/wire-api/src/Wire/API/User/Activation.hs b/libs/wire-api/src/Wire/API/User/Activation.hs index 385ceaa59cf..14b6ae6dffa 100644 --- a/libs/wire-api/src/Wire/API/User/Activation.hs +++ b/libs/wire-api/src/Wire/API/User/Activation.hs @@ -40,14 +40,19 @@ module Wire.API.User.Activation ) where +import Control.Lens ((?~)) import Data.Aeson import Data.ByteString.Conversion +import Data.Data (Proxy (Proxy)) import Data.Json.Util ((#)) -import Data.Schema (Schema (..), ToSchema, schemaIn) +import Data.Schema as Schema (Schema (..), ToSchema (..), description) +import qualified Data.Schema as Schema +import Data.Swagger (ToParamSchema) import qualified Data.Swagger as S import qualified Data.Swagger.Build.Api as Doc import Data.Text.Ascii import Imports +import Servant (FromHttpApiData (..)) import Wire.API.User.Identity import Wire.API.User.Profile import Wire.Arbitrary (Arbitrary, GenericUniform (..)) @@ -77,6 +82,12 @@ newtype ActivationKey = ActivationKey deriving stock (Eq, Show, Generic) deriving newtype (ToByteString, FromByteString, ToJSON, FromJSON, Arbitrary) +instance ToParamSchema ActivationKey where + toParamSchema _ = S.toParamSchema (Proxy @Text) + +instance FromHttpApiData ActivationKey where + parseUrlPiece = fmap ActivationKey . parseUrlPiece + -------------------------------------------------------------------------------- -- ActivationCode @@ -89,6 +100,12 @@ newtype ActivationCode = ActivationCode deriving newtype (ToByteString, FromByteString, ToSchema, Arbitrary) deriving (ToJSON, FromJSON, S.ToSchema) via Schema ActivationCode +instance ToParamSchema ActivationCode where + toParamSchema _ = S.toParamSchema (Proxy @Text) + +instance FromHttpApiData ActivationCode where + parseQueryParam = fmap ActivationCode . parseUrlPiece + -------------------------------------------------------------------------------- -- Activate @@ -158,6 +175,14 @@ data ActivationResponse = ActivationResponse } deriving stock (Eq, Show, Generic) deriving (Arbitrary) via (GenericUniform ActivationResponse) + deriving (ToJSON, FromJSON, S.ToSchema) via Schema ActivationResponse + +instance ToSchema ActivationResponse where + schema = + Schema.objectWithDocModifier "ActivationResponse" (description ?~ "Response body of a successful activation request") $ + ActivationResponse + <$> activatedIdentity Schema..= userIdentityObjectSchema + <*> activatedFirst Schema..= (fromMaybe False <$> Schema.optFieldWithDocModifier "first" (description ?~ "Whether this is the first successful activation (i.e. account activation).") Schema.schema) modelActivationResponse :: Doc.Model modelActivationResponse = Doc.defineModel "ActivationResponse" $ do @@ -171,22 +196,6 @@ modelActivationResponse = Doc.defineModel "ActivationResponse" $ do Doc.property "first" Doc.bool' $ Doc.description "Whether this is the first successful activation (i.e. account activation)." --- FUTUREWORK: de-deduplicate work with JSON instance for 'UserIdentity'? -instance ToJSON ActivationResponse where - toJSON (ActivationResponse ident first) = - object $ - "email" .= emailIdentity ident - # "phone" .= phoneIdentity ident - # "sso_id" .= ssoIdentity ident - # "first" .= first - # [] - -instance FromJSON ActivationResponse where - parseJSON = withObject "ActivationResponse" $ \o -> - ActivationResponse - <$> schemaIn userIdentityObjectSchema o - <*> o .:? "first" .!= False - -------------------------------------------------------------------------------- -- SendActivationCode diff --git a/services/brig/src/Brig/API/Public.hs b/services/brig/src/Brig/API/Public.hs index 3daaed2ec7f..10a67e427cd 100644 --- a/services/brig/src/Brig/API/Public.hs +++ b/services/brig/src/Brig/API/Public.hs @@ -225,6 +225,7 @@ servantSitemap = userAPI :<|> selfAPI :<|> accountAPI :<|> clientAPI :<|> prekey accountAPI = Named @"register" createUser :<|> Named @"verify-delete" verifyDeleteUser + :<|> Named @"get-activate" activate clientAPI :: ServerT ClientAPI (Handler r) clientAPI = @@ -313,24 +314,6 @@ sitemap :: sitemap = do -- /activate, /password-reset ---------------------------------- - -- This endpoint can lead to the following events being sent: - -- - UserActivated event to the user, if account gets activated - -- - UserIdentityUpdated event to the user, if email or phone get activated - get "/activate" (continue activateH) $ - query "key" - .&. query "code" - document "GET" "activate" $ do - Doc.summary "Activate (i.e. confirm) an email address or phone number." - Doc.notes "See also 'POST /activate' which has a larger feature set." - Doc.parameter Doc.Query "key" Doc.bytes' $ - Doc.description "Activation key" - Doc.parameter Doc.Query "code" Doc.bytes' $ - Doc.description "Activation code" - Doc.returns (Doc.ref Public.modelActivationResponse) - Doc.response 200 "Activation successful." Doc.end - Doc.response 204 "A recent activation was already successful." Doc.end - Doc.errorResponse activationCodeNotFound - -- docs/reference/user/activation.md {#RefActivationSubmit} -- -- This endpoint can lead to the following events being sent: @@ -1003,12 +986,6 @@ updateUserEmail zuserId emailOwnerId (Public.EmailUpdate email) = do -- activation -data ActivationRespWithStatus - = ActivationResp Public.ActivationResponse - | ActivationRespDryRun - | ActivationRespPass - | ActivationRespSuccessNoIdent - respFromActivationRespWithStatus :: ActivationRespWithStatus -> Response respFromActivationRespWithStatus = \case ActivationResp aresp -> json aresp @@ -1020,15 +997,15 @@ respFromActivationRespWithStatus = \case activateKeyH :: JSON ::: JsonRequest Public.Activate -> (Handler r) Response activateKeyH (_ ::: req) = do activationRequest <- parseJsonBody req - respFromActivationRespWithStatus <$> activate activationRequest + respFromActivationRespWithStatus <$> activate' activationRequest -activateH :: Public.ActivationKey ::: Public.ActivationCode -> (Handler r) Response -activateH (k ::: c) = do +activate :: Public.ActivationKey -> Public.ActivationCode -> (Handler r) ActivationRespWithStatus +activate k c = do let activationRequest = Public.Activate (Public.ActivateKey k) c False - respFromActivationRespWithStatus <$> activate activationRequest + activate' activationRequest -activate :: Public.Activate -> (Handler r) ActivationRespWithStatus -activate (Public.Activate tgt code dryrun) +activate' :: Public.Activate -> (Handler r) ActivationRespWithStatus +activate' (Public.Activate tgt code dryrun) | dryrun = do wrapClientE (API.preverify tgt code) !>> actError pure ActivationRespDryRun From e9f07a1b015fd515064eb5111aba11e8dbc70c17 Mon Sep 17 00:00:00 2001 From: Stefan Matting Date: Tue, 20 Sep 2022 18:52:41 +0200 Subject: [PATCH 40/58] Improve Tasty Hunit errors - followup (#2716) --- cabal.project | 2 +- cabal.project.freeze | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/cabal.project b/cabal.project index 71ab22593fa..b6beec6f68a 100644 --- a/cabal.project +++ b/cabal.project @@ -160,7 +160,7 @@ source-repository-package source-repository-package type: git location: https://github.com/wireapp/tasty.git - tag: 3934275585a084fd263c9564090e36c5319e5fde + tag: 394943c7672e5ad269e5587528b7678caf3b0720 subdir: hunit allow-older: * diff --git a/cabal.project.freeze b/cabal.project.freeze index f25dfb49757..da0e31f39ce 100644 --- a/cabal.project.freeze +++ b/cabal.project.freeze @@ -2358,7 +2358,7 @@ constraints: any.AC-Angle ==1.0, any.tasty-golden ==2.3.4, any.tasty-hedgehog ==1.1.0.0, any.tasty-hspec ==1.1.6, - any.tasty-hunit ==0.10.0.2, + any.tasty-hunit ==0.10.0.3, any.tasty-hunit-compat ==0.2.0.1, any.tasty-inspection-testing ==0.1, any.tasty-kat ==0.0.3, From 7dd6ed95177cadcb74491b12dc5633bdef2e078a Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Wed, 21 Sep 2022 09:57:30 +0200 Subject: [PATCH 41/58] [SQSERVICES-1643] Servantify brig account API 3 - `POST /activate` (#2701) --- changelog.d/5-internal/pr-2701 | 1 + .../src/Wire/API/Routes/Public/Brig.hs | 24 +++++ libs/wire-api/src/Wire/API/Swagger.hs | 1 - libs/wire-api/src/Wire/API/User/Activation.hs | 97 ++++++++++--------- services/brig/src/Brig/API/Public.hs | 41 +------- 5 files changed, 79 insertions(+), 85 deletions(-) create mode 100644 changelog.d/5-internal/pr-2701 diff --git a/changelog.d/5-internal/pr-2701 b/changelog.d/5-internal/pr-2701 new file mode 100644 index 00000000000..11cb76339c4 --- /dev/null +++ b/changelog.d/5-internal/pr-2701 @@ -0,0 +1 @@ +The `POST /activate` endpoint of the account API is now migrated to servant diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs index c4ebba27223..0b39efda323 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs @@ -418,6 +418,30 @@ type AccountAPI = GetActivateResponse ActivationRespWithStatus ) + -- docs/reference/user/activation.md {#RefActivationSubmit} + -- + -- This endpoint can lead to the following events being sent: + -- - UserActivated event to the user, if account gets activated + -- - UserIdentityUpdated event to the user, if email or phone get activated + :<|> Named + "post-activate" + ( Summary "Activate (i.e. confirm) an email address or phone number." + :> Description + "Activation only succeeds once and the number of \ + \failed attempts for a valid key is limited." + :> CanThrow 'UserKeyExists + :> CanThrow 'InvalidActivationCodeWrongUser + :> CanThrow 'InvalidActivationCodeWrongCode + :> CanThrow 'InvalidEmail + :> CanThrow 'InvalidPhone + :> "activate" + :> ReqBody '[JSON] Activate + :> MultiVerb + 'POST + '[JSON] + GetActivateResponse + ActivationRespWithStatus + ) data ActivationRespWithStatus = ActivationResp ActivationResponse diff --git a/libs/wire-api/src/Wire/API/Swagger.hs b/libs/wire-api/src/Wire/API/Swagger.hs index bf1e06e94d2..53796f33058 100644 --- a/libs/wire-api/src/Wire/API/Swagger.hs +++ b/libs/wire-api/src/Wire/API/Swagger.hs @@ -102,7 +102,6 @@ models = User.modelUser, User.modelEmailUpdate, User.modelDelete, - User.Activation.modelActivate, User.Activation.modelSendActivationCode, User.Activation.modelActivationResponse, User.Auth.modelSendLoginCode, diff --git a/libs/wire-api/src/Wire/API/User/Activation.hs b/libs/wire-api/src/Wire/API/User/Activation.hs index 14b6ae6dffa..c42c16e7b2c 100644 --- a/libs/wire-api/src/Wire/API/User/Activation.hs +++ b/libs/wire-api/src/Wire/API/User/Activation.hs @@ -34,7 +34,6 @@ module Wire.API.User.Activation SendActivationCode (..), -- * Swagger - modelActivate, modelSendActivationCode, modelActivationResponse, ) @@ -42,6 +41,7 @@ where import Control.Lens ((?~)) import Data.Aeson +import Data.Aeson.Types (Parser) import Data.ByteString.Conversion import Data.Data (Proxy (Proxy)) import Data.Json.Util ((#)) @@ -51,6 +51,7 @@ import Data.Swagger (ToParamSchema) import qualified Data.Swagger as S import qualified Data.Swagger.Build.Api as Doc import Data.Text.Ascii +import Data.Tuple.Extra (fst3, snd3, thd3) import Imports import Servant (FromHttpApiData (..)) import Wire.API.User.Identity @@ -80,7 +81,7 @@ instance ToByteString ActivationTarget where newtype ActivationKey = ActivationKey {fromActivationKey :: AsciiBase64Url} deriving stock (Eq, Show, Generic) - deriving newtype (ToByteString, FromByteString, ToJSON, FromJSON, Arbitrary) + deriving newtype (ToSchema, ToByteString, FromByteString, ToJSON, FromJSON, Arbitrary) instance ToParamSchema ActivationKey where toParamSchema _ = S.toParamSchema (Proxy @Text) @@ -88,6 +89,34 @@ instance ToParamSchema ActivationKey where instance FromHttpApiData ActivationKey where parseUrlPiece = fmap ActivationKey . parseUrlPiece +maybeActivationKeyObjectSchema :: Schema.ObjectSchemaP Schema.SwaggerDoc (Maybe ActivationKey, Maybe Phone, Maybe Email) ActivationTarget +maybeActivationKeyObjectSchema = + Schema.withParser activationKeyTupleObjectSchema maybeActivationKeyTargetFromTuple + where + activationKeyTupleObjectSchema :: Schema.ObjectSchema Schema.SwaggerDoc (Maybe ActivationKey, Maybe Phone, Maybe Email) + activationKeyTupleObjectSchema = + (,,) + <$> fst3 Schema..= Schema.maybe_ (Schema.optFieldWithDocModifier "key" keyDocs Schema.schema) + <*> snd3 Schema..= Schema.maybe_ (Schema.optFieldWithDocModifier "phone" phoneDocs Schema.schema) + <*> thd3 Schema..= Schema.maybe_ (Schema.optFieldWithDocModifier "email" emailDocs Schema.schema) + where + keyDocs = description ?~ "An opaque key to activate, as it was sent by the API." + phoneDocs = description ?~ "A known phone number to activate." + emailDocs = description ?~ "A known email address to activate." + + maybeActivationKeyTargetFromTuple :: (Maybe ActivationKey, Maybe Phone, Maybe Email) -> Parser ActivationTarget + maybeActivationKeyTargetFromTuple = \case + (Just key, _, _) -> pure $ ActivateKey key + (_, _, Just email) -> pure $ ActivateEmail email + (_, Just phone, _) -> pure $ ActivatePhone phone + _ -> fail "key, email or phone must be present" + +maybeActivationTargetToTuple :: ActivationTarget -> (Maybe ActivationKey, Maybe Phone, Maybe Email) +maybeActivationTargetToTuple = \case + ActivateKey key -> (Just key, Nothing, Nothing) + ActivatePhone phone -> (Nothing, Just phone, Nothing) + ActivateEmail email -> (Nothing, Nothing, Just email) + -------------------------------------------------------------------------------- -- ActivationCode @@ -117,54 +146,26 @@ data Activate = Activate } deriving stock (Eq, Show, Generic) deriving (Arbitrary) via (GenericUniform Activate) + deriving (ToJSON, FromJSON, S.ToSchema) via Schema Activate -modelActivate :: Doc.Model -modelActivate = Doc.defineModel "Activate" $ do - Doc.description "Data for an activation request." - Doc.property "key" Doc.string' $ do - Doc.description "An opaque key to activate, as it was sent by the API." - Doc.optional - Doc.property "email" Doc.string' $ do - Doc.description "A known email address to activate." - Doc.optional - Doc.property "phone" Doc.string' $ do - Doc.description "A known phone number to activate." - Doc.optional - Doc.property "code" Doc.string' $ - Doc.description "The activation code." - Doc.property "label" Doc.string' $ do - Doc.description - "An optional label to associate with the access cookie, \ - \if one is granted during account activation." - Doc.optional - Doc.property "dryrun" Doc.bool' $ do - Doc.description - "Whether to perform a dryrun, i.e. to only check whether \ - \activation would succeed. Dry-runs never issue access \ - \cookies or tokens on success but failures still count \ - \towards the maximum failure count." - Doc.optional - -instance ToJSON Activate where - toJSON (Activate k c d) = - object - [key k, "code" .= c, "dryrun" .= d] - where - key (ActivateKey ak) = "key" .= ak - key (ActivateEmail e) = "email" .= e - key (ActivatePhone p) = "phone" .= p - -instance FromJSON Activate where - parseJSON = withObject "Activation" $ \o -> - Activate - <$> key o - <*> o .: "code" - <*> o .:? "dryrun" .!= False +instance ToSchema Activate where + schema = + Schema.objectWithDocModifier "Activate" objectDocs $ + Activate + <$> (maybeActivationTargetToTuple . activateTarget) Schema..= maybeActivationKeyObjectSchema + <*> activateCode Schema..= Schema.fieldWithDocModifier "code" codeDocs schema + <*> activateDryrun Schema..= Schema.fieldWithDocModifier "dryrun" dryrunDocs schema where - key o = - (ActivateKey <$> o .: "key") - <|> (ActivateEmail <$> o .: "email") - <|> (ActivatePhone <$> o .: "phone") + objectDocs = description ?~ "Data for an activation request." + codeDocs = description ?~ "The activation code." + dryrunDocs = + description + ?~ "At least one of key, email, or phone has to be present \ + \while key takes precedence over email, and email takes precedence over phone. \ + \Whether to perform a dryrun, i.e. to only check whether \ + \activation would succeed. Dry-runs never issue access \ + \cookies or tokens on success but failures still count \ + \towards the maximum failure count." -- | Information returned as part of a successful activation. data ActivationResponse = ActivationResponse diff --git a/services/brig/src/Brig/API/Public.hs b/services/brig/src/Brig/API/Public.hs index 10a67e427cd..d563434c0e4 100644 --- a/services/brig/src/Brig/API/Public.hs +++ b/services/brig/src/Brig/API/Public.hs @@ -226,6 +226,7 @@ servantSitemap = userAPI :<|> selfAPI :<|> accountAPI :<|> clientAPI :<|> prekey Named @"register" createUser :<|> Named @"verify-delete" verifyDeleteUser :<|> Named @"get-activate" activate + :<|> Named @"post-activate" activateKey clientAPI :: ServerT ClientAPI (Handler r) clientAPI = @@ -314,26 +315,6 @@ sitemap :: sitemap = do -- /activate, /password-reset ---------------------------------- - -- docs/reference/user/activation.md {#RefActivationSubmit} - -- - -- This endpoint can lead to the following events being sent: - -- - UserActivated event to the user, if account gets activated - -- - UserIdentityUpdated event to the user, if email or phone get activated - post "/activate" (continue activateKeyH) $ - accept "application" "json" - .&. jsonRequest @Public.Activate - document "POST" "activate" $ do - Doc.summary "Activate (i.e. confirm) an email address or phone number." - Doc.notes - "Activation only succeeds once and the number of \ - \failed attempts for a valid key is limited." - Doc.body (Doc.ref Public.modelActivate) $ - Doc.description "JSON body" - Doc.returns (Doc.ref Public.modelActivationResponse) - Doc.response 200 "Activation successful." Doc.end - Doc.response 204 "A recent activation was already successful." Doc.end - Doc.errorResponse activationCodeNotFound - -- docs/reference/user/activation.md {#RefActivationRequest} post "/activate/send" (continue sendActivationCodeH) $ jsonRequest @Public.SendActivationCode @@ -986,26 +967,14 @@ updateUserEmail zuserId emailOwnerId (Public.EmailUpdate email) = do -- activation -respFromActivationRespWithStatus :: ActivationRespWithStatus -> Response -respFromActivationRespWithStatus = \case - ActivationResp aresp -> json aresp - ActivationRespDryRun -> empty - ActivationRespPass -> setStatus status204 empty - ActivationRespSuccessNoIdent -> empty - --- docs/reference/user/activation.md {#RefActivationSubmit} -activateKeyH :: JSON ::: JsonRequest Public.Activate -> (Handler r) Response -activateKeyH (_ ::: req) = do - activationRequest <- parseJsonBody req - respFromActivationRespWithStatus <$> activate' activationRequest - activate :: Public.ActivationKey -> Public.ActivationCode -> (Handler r) ActivationRespWithStatus activate k c = do let activationRequest = Public.Activate (Public.ActivateKey k) c False - activate' activationRequest + activateKey activationRequest -activate' :: Public.Activate -> (Handler r) ActivationRespWithStatus -activate' (Public.Activate tgt code dryrun) +-- docs/reference/user/activation.md {#RefActivationSubmit} +activateKey :: Public.Activate -> (Handler r) ActivationRespWithStatus +activateKey (Public.Activate tgt code dryrun) | dryrun = do wrapClientE (API.preverify tgt code) !>> actError pure ActivationRespDryRun From 9e4bb966224f55bfc7b4612c043e1b5fcf475c47 Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Thu, 22 Sep 2022 09:17:22 +0200 Subject: [PATCH 42/58] [SQSERVICES-1643] Servantify brig account API 4 - `POST /activate/send` (#2702) --- changelog.d/5-internal/pr-2702 | 1 + libs/wire-api/src/Wire/API/Error/Brig.hs | 10 + .../src/Wire/API/Routes/Public/Brig.hs | 15 ++ libs/wire-api/src/Wire/API/Swagger.hs | 3 - libs/wire-api/src/Wire/API/User/Activation.hs | 184 ++++++++---------- services/brig/src/Brig/API/Public.hs | 27 +-- 6 files changed, 112 insertions(+), 128 deletions(-) create mode 100644 changelog.d/5-internal/pr-2702 diff --git a/changelog.d/5-internal/pr-2702 b/changelog.d/5-internal/pr-2702 new file mode 100644 index 00000000000..110b73f20fe --- /dev/null +++ b/changelog.d/5-internal/pr-2702 @@ -0,0 +1 @@ +The `POST /activate/send` endpoint of the account API is now migrated to servant diff --git a/libs/wire-api/src/Wire/API/Error/Brig.hs b/libs/wire-api/src/Wire/API/Error/Brig.hs index 6e5e8a03ebb..ab251a2bc08 100644 --- a/libs/wire-api/src/Wire/API/Error/Brig.hs +++ b/libs/wire-api/src/Wire/API/Error/Brig.hs @@ -66,6 +66,7 @@ data BrigError | InsufficientTeamPermissions | KeyPackageDecodingError | InvalidKeyPackageRef + | CustomerExtensionBlockedDomain instance KnownError (MapError e) => IsSwaggerError (e :: BrigError) where addToSwagger = addStaticErrorToSwagger @(MapError e) @@ -178,3 +179,12 @@ type instance MapError 'InsufficientTeamPermissions = 'StaticError 403 "insuffic type instance MapError 'KeyPackageDecodingError = 'StaticError 409 "decoding-error" "Key package could not be TLS-decoded" type instance MapError 'InvalidKeyPackageRef = 'StaticError 409 "invalid-reference" "Key package's reference does not match its data" + +type instance + MapError 'CustomerExtensionBlockedDomain = + 'StaticError + 451 + "domain-blocked-for-registration" + "[Customer extension] the email domain example.com \ + \that you are attempting to register a user with has been \ + \blocked for creating wire users. Please contact your IT department." diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs index 0b39efda323..ea553494153 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs @@ -442,6 +442,21 @@ type AccountAPI = GetActivateResponse ActivationRespWithStatus ) + -- docs/reference/user/activation.md {#RefActivationRequest} + :<|> Named + "post-activate-send" + ( Summary "Send (or resend) an email or phone activation code." + :> CanThrow 'UserKeyExists + :> CanThrow 'InvalidEmail + :> CanThrow 'InvalidPhone + :> CanThrow 'BlacklistedEmail + :> CanThrow 'BlacklistedPhone + :> CanThrow 'CustomerExtensionBlockedDomain + :> "activate" + :> "send" + :> ReqBody '[JSON] SendActivationCode + :> MultiVerb 'POST '[JSON] '[RespondEmpty 200 "Activation code sent."] () + ) data ActivationRespWithStatus = ActivationResp ActivationResponse diff --git a/libs/wire-api/src/Wire/API/Swagger.hs b/libs/wire-api/src/Wire/API/Swagger.hs index 53796f33058..79992799efc 100644 --- a/libs/wire-api/src/Wire/API/Swagger.hs +++ b/libs/wire-api/src/Wire/API/Swagger.hs @@ -36,7 +36,6 @@ import qualified Wire.API.Team.Conversation as Team.Conversation import qualified Wire.API.Team.Invitation as Team.Invitation import qualified Wire.API.Team.Permission as Team.Permission import qualified Wire.API.User as User -import qualified Wire.API.User.Activation as User.Activation import qualified Wire.API.User.Auth as User.Auth import qualified Wire.API.User.Client as User.Client import qualified Wire.API.User.Client.Prekey as User.Client.Prekey @@ -102,8 +101,6 @@ models = User.modelUser, User.modelEmailUpdate, User.modelDelete, - User.Activation.modelSendActivationCode, - User.Activation.modelActivationResponse, User.Auth.modelSendLoginCode, User.Auth.modelLoginCodeResponse, User.Auth.modelLogin, diff --git a/libs/wire-api/src/Wire/API/User/Activation.hs b/libs/wire-api/src/Wire/API/User/Activation.hs index c42c16e7b2c..4ec40cb6d3f 100644 --- a/libs/wire-api/src/Wire/API/User/Activation.hs +++ b/libs/wire-api/src/Wire/API/User/Activation.hs @@ -32,24 +32,17 @@ module Wire.API.User.Activation -- * SendActivationCode SendActivationCode (..), - - -- * Swagger - modelSendActivationCode, - modelActivationResponse, ) where import Control.Lens ((?~)) -import Data.Aeson +import qualified Data.Aeson as A import Data.Aeson.Types (Parser) import Data.ByteString.Conversion import Data.Data (Proxy (Proxy)) -import Data.Json.Util ((#)) -import Data.Schema as Schema (Schema (..), ToSchema (..), description) -import qualified Data.Schema as Schema +import Data.Schema import Data.Swagger (ToParamSchema) import qualified Data.Swagger as S -import qualified Data.Swagger.Build.Api as Doc import Data.Text.Ascii import Data.Tuple.Extra (fst3, snd3, thd3) import Imports @@ -81,7 +74,7 @@ instance ToByteString ActivationTarget where newtype ActivationKey = ActivationKey {fromActivationKey :: AsciiBase64Url} deriving stock (Eq, Show, Generic) - deriving newtype (ToSchema, ToByteString, FromByteString, ToJSON, FromJSON, Arbitrary) + deriving newtype (ToSchema, ToByteString, FromByteString, A.ToJSON, A.FromJSON, Arbitrary) instance ToParamSchema ActivationKey where toParamSchema _ = S.toParamSchema (Proxy @Text) @@ -89,34 +82,6 @@ instance ToParamSchema ActivationKey where instance FromHttpApiData ActivationKey where parseUrlPiece = fmap ActivationKey . parseUrlPiece -maybeActivationKeyObjectSchema :: Schema.ObjectSchemaP Schema.SwaggerDoc (Maybe ActivationKey, Maybe Phone, Maybe Email) ActivationTarget -maybeActivationKeyObjectSchema = - Schema.withParser activationKeyTupleObjectSchema maybeActivationKeyTargetFromTuple - where - activationKeyTupleObjectSchema :: Schema.ObjectSchema Schema.SwaggerDoc (Maybe ActivationKey, Maybe Phone, Maybe Email) - activationKeyTupleObjectSchema = - (,,) - <$> fst3 Schema..= Schema.maybe_ (Schema.optFieldWithDocModifier "key" keyDocs Schema.schema) - <*> snd3 Schema..= Schema.maybe_ (Schema.optFieldWithDocModifier "phone" phoneDocs Schema.schema) - <*> thd3 Schema..= Schema.maybe_ (Schema.optFieldWithDocModifier "email" emailDocs Schema.schema) - where - keyDocs = description ?~ "An opaque key to activate, as it was sent by the API." - phoneDocs = description ?~ "A known phone number to activate." - emailDocs = description ?~ "A known email address to activate." - - maybeActivationKeyTargetFromTuple :: (Maybe ActivationKey, Maybe Phone, Maybe Email) -> Parser ActivationTarget - maybeActivationKeyTargetFromTuple = \case - (Just key, _, _) -> pure $ ActivateKey key - (_, _, Just email) -> pure $ ActivateEmail email - (_, Just phone, _) -> pure $ ActivatePhone phone - _ -> fail "key, email or phone must be present" - -maybeActivationTargetToTuple :: ActivationTarget -> (Maybe ActivationKey, Maybe Phone, Maybe Email) -maybeActivationTargetToTuple = \case - ActivateKey key -> (Just key, Nothing, Nothing) - ActivatePhone phone -> (Nothing, Just phone, Nothing) - ActivateEmail email -> (Nothing, Nothing, Just email) - -------------------------------------------------------------------------------- -- ActivationCode @@ -127,7 +92,7 @@ newtype ActivationCode = ActivationCode {fromActivationCode :: AsciiBase64Url} deriving stock (Eq, Show, Generic) deriving newtype (ToByteString, FromByteString, ToSchema, Arbitrary) - deriving (ToJSON, FromJSON, S.ToSchema) via Schema ActivationCode + deriving (A.ToJSON, A.FromJSON, S.ToSchema) via Schema ActivationCode instance ToParamSchema ActivationCode where toParamSchema _ = S.toParamSchema (Proxy @Text) @@ -146,19 +111,24 @@ data Activate = Activate } deriving stock (Eq, Show, Generic) deriving (Arbitrary) via (GenericUniform Activate) - deriving (ToJSON, FromJSON, S.ToSchema) via Schema Activate + deriving (A.ToJSON, A.FromJSON, S.ToSchema) via Schema Activate instance ToSchema Activate where schema = - Schema.objectWithDocModifier "Activate" objectDocs $ + objectWithDocModifier "Activate" objectDocs $ Activate - <$> (maybeActivationTargetToTuple . activateTarget) Schema..= maybeActivationKeyObjectSchema - <*> activateCode Schema..= Schema.fieldWithDocModifier "code" codeDocs schema - <*> activateDryrun Schema..= Schema.fieldWithDocModifier "dryrun" dryrunDocs schema + <$> (maybeActivationTargetToTuple . activateTarget) .= maybeActivationTargetObjectSchema + <*> activateCode .= fieldWithDocModifier "code" codeDocs schema + <*> activateDryrun .= fieldWithDocModifier "dryrun" dryRunDocs schema where + objectDocs :: NamedSwaggerDoc -> NamedSwaggerDoc objectDocs = description ?~ "Data for an activation request." + + codeDocs :: NamedSwaggerDoc -> NamedSwaggerDoc codeDocs = description ?~ "The activation code." - dryrunDocs = + + dryRunDocs :: NamedSwaggerDoc -> NamedSwaggerDoc + dryRunDocs = description ?~ "At least one of key, email, or phone has to be present \ \while key takes precedence over email, and email takes precedence over phone. \ @@ -167,6 +137,34 @@ instance ToSchema Activate where \cookies or tokens on success but failures still count \ \towards the maximum failure count." + maybeActivationTargetObjectSchema :: ObjectSchemaP SwaggerDoc (Maybe ActivationKey, Maybe Phone, Maybe Email) ActivationTarget + maybeActivationTargetObjectSchema = + withParser activationTargetTupleObjectSchema maybeActivationTargetTargetFromTuple + where + activationTargetTupleObjectSchema :: ObjectSchema SwaggerDoc (Maybe ActivationKey, Maybe Phone, Maybe Email) + activationTargetTupleObjectSchema = + (,,) + <$> fst3 .= maybe_ (optFieldWithDocModifier "key" keyDocs schema) + <*> snd3 .= maybe_ (optFieldWithDocModifier "phone" phoneDocs schema) + <*> thd3 .= maybe_ (optFieldWithDocModifier "email" emailDocs schema) + where + keyDocs = description ?~ "An opaque key to activate, as it was sent by the API." + phoneDocs = description ?~ "A known phone number to activate." + emailDocs = description ?~ "A known email address to activate." + + maybeActivationTargetTargetFromTuple :: (Maybe ActivationKey, Maybe Phone, Maybe Email) -> Parser ActivationTarget + maybeActivationTargetTargetFromTuple = \case + (Just key, _, _) -> pure $ ActivateKey key + (_, _, Just email) -> pure $ ActivateEmail email + (_, Just phone, _) -> pure $ ActivatePhone phone + _ -> fail "key, email or phone must be present" + + maybeActivationTargetToTuple :: ActivationTarget -> (Maybe ActivationKey, Maybe Phone, Maybe Email) + maybeActivationTargetToTuple = \case + ActivateKey key -> (Just key, Nothing, Nothing) + ActivatePhone phone -> (Nothing, Just phone, Nothing) + ActivateEmail email -> (Nothing, Nothing, Just email) + -- | Information returned as part of a successful activation. data ActivationResponse = ActivationResponse { -- | The activated / verified user identity. @@ -176,26 +174,14 @@ data ActivationResponse = ActivationResponse } deriving stock (Eq, Show, Generic) deriving (Arbitrary) via (GenericUniform ActivationResponse) - deriving (ToJSON, FromJSON, S.ToSchema) via Schema ActivationResponse + deriving (A.ToJSON, A.FromJSON, S.ToSchema) via Schema ActivationResponse instance ToSchema ActivationResponse where schema = - Schema.objectWithDocModifier "ActivationResponse" (description ?~ "Response body of a successful activation request") $ + objectWithDocModifier "ActivationResponse" (description ?~ "Response body of a successful activation request") $ ActivationResponse - <$> activatedIdentity Schema..= userIdentityObjectSchema - <*> activatedFirst Schema..= (fromMaybe False <$> Schema.optFieldWithDocModifier "first" (description ?~ "Whether this is the first successful activation (i.e. account activation).") Schema.schema) - -modelActivationResponse :: Doc.Model -modelActivationResponse = Doc.defineModel "ActivationResponse" $ do - Doc.description "Response body of a successful activation request" - Doc.property "email" Doc.string' $ do - Doc.description "The email address that was activated." - Doc.optional - Doc.property "phone" Doc.string' $ do - Doc.description "The phone number that was activated." - Doc.optional - Doc.property "first" Doc.bool' $ - Doc.description "Whether this is the first successful activation (i.e. account activation)." + <$> activatedIdentity .= userIdentityObjectSchema + <*> activatedFirst .= (fromMaybe False <$> optFieldWithDocModifier "first" (description ?~ "Whether this is the first successful activation (i.e. account activation).") schema) -------------------------------------------------------------------------------- -- SendActivationCode @@ -210,43 +196,43 @@ data SendActivationCode = SendActivationCode } deriving stock (Eq, Show, Generic) deriving (Arbitrary) via (GenericUniform SendActivationCode) + deriving (A.ToJSON, A.FromJSON, S.ToSchema) via Schema SendActivationCode -modelSendActivationCode :: Doc.Model -modelSendActivationCode = Doc.defineModel "SendActivationCode" $ do - Doc.description - "Data for requesting an email or phone activation code to be sent. \ - \One of 'email' or 'phone' must be present." - Doc.property "email" Doc.string' $ do - Doc.description "Email address to send the code to." - Doc.optional - Doc.property "phone" Doc.string' $ do - Doc.description "E.164 phone number to send the code to." - Doc.optional - Doc.property "locale" Doc.string' $ do - Doc.description "Locale to use for the activation code template." - Doc.optional - Doc.property "voice_call" Doc.bool' $ do - Doc.description "Request the code with a call instead (default is SMS)." - Doc.optional - -instance ToJSON SendActivationCode where - toJSON (SendActivationCode userKey locale call) = - object $ - either ("email" .=) ("phone" .=) userKey - # "locale" .= locale - # "voice_call" .= call - # [] - -instance FromJSON SendActivationCode where - parseJSON = withObject "SendActivationCode" $ \o -> do - e <- o .:? "email" - p <- o .:? "phone" - SendActivationCode - <$> key e p - <*> o .:? "locale" - <*> o .:? "voice_call" .!= False +instance ToSchema SendActivationCode where + schema = + objectWithDocModifier "SendActivationCode" objectDesc $ + SendActivationCode + <$> (maybeUserKeyToTuple . saUserKey) .= userKeyObjectSchema + <*> saLocale .= maybe_ (optFieldWithDocModifier "locale" (description ?~ "Locale to use for the activation code template.") schema) + <*> saCall .= (fromMaybe False <$> optFieldWithDocModifier "voice_call" (description ?~ "Request the code with a call instead (default is SMS).") schema) where - key (Just _) (Just _) = fail "Only one of 'email' or 'phone' allowed." - key Nothing Nothing = fail "One of 'email' or 'phone' required." - key (Just e) Nothing = pure $ Left e - key Nothing (Just p) = pure $ Right p + maybeUserKeyToTuple :: Either Email Phone -> (Maybe Email, Maybe Phone) + maybeUserKeyToTuple = \case + Left email -> (Just email, Nothing) + Right phone -> (Nothing, Just phone) + + objectDesc :: NamedSwaggerDoc -> NamedSwaggerDoc + objectDesc = + description + ?~ "Data for requesting an email or phone activation code to be sent. \ + \One of 'email' or 'phone' must be present." + + userKeyObjectSchema :: ObjectSchemaP SwaggerDoc (Maybe Email, Maybe Phone) (Either Email Phone) + userKeyObjectSchema = + withParser userKeyTupleObjectSchema maybeUserKeyFromTuple + where + userKeyTupleObjectSchema :: ObjectSchema SwaggerDoc (Maybe Email, Maybe Phone) + userKeyTupleObjectSchema = + (,) + <$> fst .= maybe_ (optFieldWithDocModifier "email" phoneDocs schema) + <*> snd .= maybe_ (optFieldWithDocModifier "phone" emailDocs schema) + where + emailDocs = description ?~ "Email address to send the code to." + phoneDocs = description ?~ "E.164 phone number to send the code to." + + maybeUserKeyFromTuple :: (Maybe Email, Maybe Phone) -> Parser (Either Email Phone) + maybeUserKeyFromTuple = \case + (Just _, Just _) -> fail "Only one of 'email' or 'phone' allowed." + (Just email, Nothing) -> pure $ Left email + (Nothing, Just phone) -> pure $ Right phone + (Nothing, Nothing) -> fail "One of 'email' or 'phone' required." diff --git a/services/brig/src/Brig/API/Public.hs b/services/brig/src/Brig/API/Public.hs index d563434c0e4..5db6b5516e5 100644 --- a/services/brig/src/Brig/API/Public.hs +++ b/services/brig/src/Brig/API/Public.hs @@ -227,6 +227,7 @@ servantSitemap = userAPI :<|> selfAPI :<|> accountAPI :<|> clientAPI :<|> prekey :<|> Named @"verify-delete" verifyDeleteUser :<|> Named @"get-activate" activate :<|> Named @"post-activate" activateKey + :<|> Named @"post-activate-send" sendActivationCode clientAPI :: ServerT ClientAPI (Handler r) clientAPI = @@ -315,21 +316,6 @@ sitemap :: sitemap = do -- /activate, /password-reset ---------------------------------- - -- docs/reference/user/activation.md {#RefActivationRequest} - post "/activate/send" (continue sendActivationCodeH) $ - jsonRequest @Public.SendActivationCode - document "POST" "sendActivationCode" $ do - Doc.summary "Send (or resend) an email or phone activation code." - Doc.body (Doc.ref Public.modelSendActivationCode) $ - Doc.description "JSON body" - Doc.response 200 "Activation code sent." Doc.end - Doc.errorResponse (errorToWai @'E.InvalidEmail) - Doc.errorResponse (errorToWai @'E.InvalidPhone) - Doc.errorResponse (errorToWai @'E.UserKeyExists) - Doc.errorResponse blacklistedEmail - Doc.errorResponse (errorToWai @'E.BlacklistedPhone) - Doc.errorResponse (customerExtensionBlockedDomain (either undefined id $ mkDomain "example.com")) - post "/password-reset" (continue beginPasswordResetH) $ accept "application" "json" .&. jsonRequest @Public.NewPasswordReset @@ -812,17 +798,6 @@ completePasswordResetH (_ ::: req) = do API.completePasswordReset cpwrIdent cpwrCode cpwrPassword !>> pwResetError pure empty -sendActivationCodeH :: - Members - '[ BlacklistStore, - BlacklistPhonePrefixStore - ] - r => - JsonRequest Public.SendActivationCode -> - (Handler r) Response -sendActivationCodeH req = - empty <$ (sendActivationCode =<< parseJsonBody req) - -- docs/reference/user/activation.md {#RefActivationRequest} -- docs/reference/user/registration.md {#RefRegistration} sendActivationCode :: From 0102d7eb2aedf7354a9f1e3adde861ff70b08fc9 Mon Sep 17 00:00:00 2001 From: Igor Ranieri Elland <54423+elland@users.noreply.github.com> Date: Thu, 22 Sep 2022 16:14:50 +0200 Subject: [PATCH 43/58] Add new custom hlint rule for runSetting. (#2718) * Add new custom hlint rule for runSetting. Also applies hlint again to the whole codebase (excluding tests), as we had some drift between finalising hlint and new PRs being merged without being linted / having CI catch those cases. I also disalbed the pipefail from the script, as that would short-circuit the linter on first issue found. Hopefully that doesn't mess with CI. PS: This will fail CI linters phase until #2715 has been merged. * Removed Federator.Response from runSettings rule. --- .hlint.yaml | 3 +++ libs/wire-api/src/Wire/API/MLS/CommitBundle.hs | 1 - services/galley/src/Galley/API/MLS/Message.hs | 4 +--- services/galley/src/Galley/API/MLS/Propagate.hs | 2 -- tools/hlint.sh | 2 -- 5 files changed, 4 insertions(+), 8 deletions(-) diff --git a/.hlint.yaml b/.hlint.yaml index d919816d412..805c9272095 100644 --- a/.hlint.yaml +++ b/.hlint.yaml @@ -15,3 +15,6 @@ # custom rules: - hint: { lhs: (() <$), rhs: void } - hint: { lhs: return, rhs: pure } +## We want the latter to properly handle signals. +- error: { name: Use shutdown, lhs: runSettings, rhs: runSettingsWithShutdown } +- ignore: { name: Use shutdown, within: [Network.Wai.Utilities.Server, Federator.Response] } diff --git a/libs/wire-api/src/Wire/API/MLS/CommitBundle.hs b/libs/wire-api/src/Wire/API/MLS/CommitBundle.hs index dfe09f0b88f..67ebd6fd5d2 100644 --- a/libs/wire-api/src/Wire/API/MLS/CommitBundle.hs +++ b/libs/wire-api/src/Wire/API/MLS/CommitBundle.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 RecordWildCards #-} module Wire.API.MLS.CommitBundle where diff --git a/services/galley/src/Galley/API/MLS/Message.hs b/services/galley/src/Galley/API/MLS/Message.hs index e2283ef4c64..e5c6334977b 100644 --- a/services/galley/src/Galley/API/MLS/Message.hs +++ b/services/galley/src/Galley/API/MLS/Message.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 RecordWildCards #-} module Galley.API.MLS.Message ( postMLSCommitBundle, @@ -1027,8 +1026,7 @@ executeProposalAction qusr con lconv cm action = do existingLocalMembers :: Set (Qualified UserId) existingLocalMembers = - Set.fromList . map (fmap lmId . qUntagged) . sequenceA $ - fmap convLocalMembers lconv + (Set.fromList . map (fmap lmId . qUntagged)) (traverse convLocalMembers lconv) existingRemoteMembers :: Set (Qualified UserId) existingRemoteMembers = diff --git a/services/galley/src/Galley/API/MLS/Propagate.hs b/services/galley/src/Galley/API/MLS/Propagate.hs index 6af4e1d61b9..8356619baa3 100644 --- a/services/galley/src/Galley/API/MLS/Propagate.hs +++ b/services/galley/src/Galley/API/MLS/Propagate.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE RecordWildCards #-} - -- This file is part of the Wire Server implementation. -- -- Copyright (C) 2022 Wire Swiss GmbH diff --git a/tools/hlint.sh b/tools/hlint.sh index 1ae13906cb9..35a7cc7dccb 100755 --- a/tools/hlint.sh +++ b/tools/hlint.sh @@ -1,7 +1,5 @@ #!/usr/bin/env bash -set -euo pipefail - usage() { echo "Usage: $0 -f [all, changeset] -m [check, inplace]" 1>&2; exit 1; } files='' From e6041f4f41915481022834b31b115374d31ebb99 Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Thu, 22 Sep 2022 16:51:15 +0200 Subject: [PATCH 44/58] [SQSERVICES-1643] Servantify brig account API 5 - `POST /password-reset` (#2703) --- changelog.d/5-internal/pr-2703 | 1 + libs/wire-api/src/Wire/API/Error/Brig.hs | 12 ++++ .../src/Wire/API/Routes/Public/Brig.hs | 10 +++ libs/wire-api/src/Wire/API/Swagger.hs | 1 - libs/wire-api/src/Wire/API/User/Password.hs | 65 ++++++++++++------- services/brig/src/Brig/API/Error.hs | 20 ++---- services/brig/src/Brig/API/Internal.hs | 2 +- services/brig/src/Brig/API/Public.hs | 23 +------ services/brig/src/Brig/Provider/API.hs | 36 +++++----- 9 files changed, 94 insertions(+), 76 deletions(-) create mode 100644 changelog.d/5-internal/pr-2703 diff --git a/changelog.d/5-internal/pr-2703 b/changelog.d/5-internal/pr-2703 new file mode 100644 index 00000000000..95c71d8d482 --- /dev/null +++ b/changelog.d/5-internal/pr-2703 @@ -0,0 +1 @@ +The `POST /password-reset` endpoint of the account API is now migrated to servant diff --git a/libs/wire-api/src/Wire/API/Error/Brig.hs b/libs/wire-api/src/Wire/API/Error/Brig.hs index ab251a2bc08..2ce133f35f3 100644 --- a/libs/wire-api/src/Wire/API/Error/Brig.hs +++ b/libs/wire-api/src/Wire/API/Error/Brig.hs @@ -67,6 +67,10 @@ data BrigError | KeyPackageDecodingError | InvalidKeyPackageRef | CustomerExtensionBlockedDomain + | PasswordResetInProgress + | InvalidPasswordResetKey + | InvalidPasswordResetCode + | ResetPasswordMustDiffer instance KnownError (MapError e) => IsSwaggerError (e :: BrigError) where addToSwagger = addStaticErrorToSwagger @(MapError e) @@ -188,3 +192,11 @@ type instance "[Customer extension] the email domain example.com \ \that you are attempting to register a user with has been \ \blocked for creating wire users. Please contact your IT department." + +type instance MapError 'PasswordResetInProgress = 'StaticError 409 "code-exists" "A password reset is already in progress." + +type instance MapError 'InvalidPasswordResetKey = 'StaticError 400 "invalid-key" "Invalid email or mobile number for password reset." + +type instance MapError 'InvalidPasswordResetCode = 'StaticError 400 "invalid-code" "Invalid password reset code." + +type instance MapError 'ResetPasswordMustDiffer = 'StaticError 409 "password-must-differ" "For password reset, new and old password must be different." diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs index ea553494153..e0f7f5e78a0 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs @@ -55,6 +55,7 @@ import Wire.API.User.Activation import Wire.API.User.Client import Wire.API.User.Client.Prekey import Wire.API.User.Handle +import Wire.API.User.Password (NewPasswordReset) import Wire.API.User.RichInfo (RichInfoAssocList) import Wire.API.User.Search (Contact, RoleFilter, SearchResult, TeamContact, TeamUserSearchSortBy, TeamUserSearchSortOrder) import Wire.API.UserMap @@ -457,6 +458,15 @@ type AccountAPI = :> ReqBody '[JSON] SendActivationCode :> MultiVerb 'POST '[JSON] '[RespondEmpty 200 "Activation code sent."] () ) + :<|> Named + "post-password-reset" + ( Summary "Initiate a password reset." + :> CanThrow 'PasswordResetInProgress + :> CanThrow 'InvalidPasswordResetKey + :> "password-reset" + :> ReqBody '[JSON] NewPasswordReset + :> MultiVerb 'POST '[JSON] '[RespondEmpty 201 "Password reset code created and sent by email."] () + ) data ActivationRespWithStatus = ActivationResp ActivationResponse diff --git a/libs/wire-api/src/Wire/API/Swagger.hs b/libs/wire-api/src/Wire/API/Swagger.hs index 79992799efc..a76bcd70c25 100644 --- a/libs/wire-api/src/Wire/API/Swagger.hs +++ b/libs/wire-api/src/Wire/API/Swagger.hs @@ -118,7 +118,6 @@ models = User.Client.Prekey.modelPrekey, User.Handle.modelUserHandleInfo, User.Handle.modelCheckHandles, - User.Password.modelNewPasswordReset, User.Password.modelCompletePasswordReset, User.Profile.modelAsset, User.RichInfo.modelRichInfo, diff --git a/libs/wire-api/src/Wire/API/User/Password.hs b/libs/wire-api/src/Wire/API/User/Password.hs index 986ef301a6f..cb4e6400f44 100644 --- a/libs/wire-api/src/Wire/API/User/Password.hs +++ b/libs/wire-api/src/Wire/API/User/Password.hs @@ -30,15 +30,18 @@ module Wire.API.User.Password PasswordReset (..), -- * Swagger - modelNewPasswordReset, modelCompletePasswordReset, ) where +import Control.Lens ((?~)) import Data.Aeson +import Data.Aeson.Types (Parser) import Data.ByteString.Conversion import Data.Misc (PlainTextPassword (..)) import Data.Range (Ranged (..)) +import qualified Data.Schema as Schema +import qualified Data.Swagger as S import qualified Data.Swagger.Build.Api as Doc import Data.Text.Ascii import Imports @@ -52,28 +55,46 @@ import Wire.Arbitrary (Arbitrary, GenericUniform (..)) newtype NewPasswordReset = NewPasswordReset (Either Email Phone) deriving stock (Eq, Show, Generic) deriving newtype (Arbitrary) + deriving (ToJSON, FromJSON, S.ToSchema) via Schema.Schema NewPasswordReset -modelNewPasswordReset :: Doc.Model -modelNewPasswordReset = Doc.defineModel "NewPasswordReset" $ do - Doc.description "Data to initiate a password reset" - Doc.property "email" Doc.string' $ do - Doc.description "Email" - Doc.optional - Doc.property "phone" Doc.string' $ do - Doc.description "Phone" - Doc.optional - -instance ToJSON NewPasswordReset where - toJSON (NewPasswordReset ident) = - object - [either ("email" .=) ("phone" .=) ident] - -instance FromJSON NewPasswordReset where - parseJSON = withObject "NewPasswordReset" $ \o -> - NewPasswordReset - <$> ( (Left <$> o .: "email") - <|> (Right <$> o .: "phone") - ) +instance Schema.ToSchema NewPasswordReset where + schema = + Schema.objectWithDocModifier "NewPasswordReset" objectDesc $ + NewPasswordReset + <$> (toTuple . unNewPasswordReset) Schema..= newPasswordResetObjectSchema + where + unNewPasswordReset :: NewPasswordReset -> Either Email Phone + unNewPasswordReset (NewPasswordReset v) = v + + objectDesc :: Schema.NamedSwaggerDoc -> Schema.NamedSwaggerDoc + objectDesc = Schema.description ?~ "Data to initiate a password reset" + + newPasswordResetObjectSchema :: Schema.ObjectSchemaP Schema.SwaggerDoc (Maybe Email, Maybe Phone) (Either Email Phone) + newPasswordResetObjectSchema = Schema.withParser newPasswordResetTupleObjectSchema fromTuple + where + newPasswordResetTupleObjectSchema :: Schema.ObjectSchema Schema.SwaggerDoc (Maybe Email, Maybe Phone) + newPasswordResetTupleObjectSchema = + (,) + <$> fst Schema..= Schema.maybe_ (Schema.optFieldWithDocModifier "email" phoneDocs Schema.schema) + <*> snd Schema..= Schema.maybe_ (Schema.optFieldWithDocModifier "phone" emailDocs Schema.schema) + where + emailDocs :: Schema.NamedSwaggerDoc -> Schema.NamedSwaggerDoc + emailDocs = Schema.description ?~ "Email" + + phoneDocs :: Schema.NamedSwaggerDoc -> Schema.NamedSwaggerDoc + phoneDocs = Schema.description ?~ "Phone" + + fromTuple :: (Maybe Email, Maybe Phone) -> Parser (Either Email Phone) + fromTuple = \case + (Just _, Just _) -> fail "Only one of 'email' or 'phone' allowed." + (Just email, Nothing) -> pure $ Left email + (Nothing, Just phone) -> pure $ Right phone + (Nothing, Nothing) -> fail "One of 'email' or 'phone' required." + + toTuple :: Either Email Phone -> (Maybe Email, Maybe Phone) + toTuple = \case + Left e -> (Just e, Nothing) + Right p -> (Nothing, Just p) -------------------------------------------------------------------------------- -- CompletePasswordReset diff --git a/services/brig/src/Brig/API/Error.hs b/services/brig/src/Brig/API/Error.hs index 6c5f09a4beb..408f7c217f6 100644 --- a/services/brig/src/Brig/API/Error.hs +++ b/services/brig/src/Brig/API/Error.hs @@ -83,15 +83,15 @@ actError (InvalidActivationEmail _ _) = StdError (errorToWai @'E.InvalidEmail) actError (InvalidActivationPhone _) = StdError (errorToWai @'E.InvalidPhone) pwResetError :: PasswordResetError -> Error -pwResetError InvalidPasswordResetKey = StdError invalidPwResetKey -pwResetError InvalidPasswordResetCode = StdError invalidPwResetCode -pwResetError (PasswordResetInProgress Nothing) = StdError duplicatePwResetCode +pwResetError InvalidPasswordResetKey = StdError (errorToWai @'E.InvalidPasswordResetKey) +pwResetError InvalidPasswordResetCode = StdError (errorToWai @'E.InvalidPasswordResetCode) +pwResetError (PasswordResetInProgress Nothing) = StdError (errorToWai @'E.PasswordResetInProgress) pwResetError (PasswordResetInProgress (Just t)) = RichError - duplicatePwResetCode + (errorToWai @'E.PasswordResetInProgress) () [("Retry-After", toByteString' t)] -pwResetError ResetPasswordMustDiffer = StdError resetPasswordMustDiffer +pwResetError ResetPasswordMustDiffer = StdError (errorToWai @'E.ResetPasswordMustDiffer) sendLoginCodeError :: SendLoginCodeError -> Error sendLoginCodeError (SendLoginInvalidPhone _) = StdError (errorToWai @'E.InvalidPhone) @@ -235,18 +235,10 @@ clientCapabilitiesCannotBeRemoved = Wai.mkError status409 "client-capabilities-c noEmail :: Wai.Error noEmail = Wai.mkError status403 "no-email" "This operation requires the user to have a verified email address." -invalidPwResetKey :: Wai.Error -invalidPwResetKey = Wai.mkError status400 "invalid-key" "Invalid email or mobile number for password reset." - -resetPasswordMustDiffer :: Wai.Error -resetPasswordMustDiffer = Wai.mkError status409 "password-must-differ" "For password reset, new and old password must be different." - +-- todo(leif): remove later invalidPwResetCode :: Wai.Error invalidPwResetCode = Wai.mkError status400 "invalid-code" "Invalid password reset code." -duplicatePwResetCode :: Wai.Error -duplicatePwResetCode = Wai.mkError status409 "code-exists" "A password reset is already in progress." - emailExists :: Wai.Error emailExists = Wai.mkError status409 "email-exists" "The given e-mail address is in use." diff --git a/services/brig/src/Brig/API/Internal.hs b/services/brig/src/Brig/API/Internal.hs index d4d567f4ba8..a69ebeac665 100644 --- a/services/brig/src/Brig/API/Internal.hs +++ b/services/brig/src/Brig/API/Internal.hs @@ -594,7 +594,7 @@ getPasswordResetCodeH :: JSON ::: Either Email Phone -> (Handler r) Response getPasswordResetCodeH (_ ::: emailOrPhone) = do - maybe (throwStd invalidPwResetKey) (pure . json) =<< lift (getPasswordResetCode emailOrPhone) + maybe (throwStd (errorToWai @'E.InvalidPasswordResetKey)) (pure . json) =<< lift (getPasswordResetCode emailOrPhone) getPasswordResetCode :: Members '[CodeStore, PasswordResetStore] r => diff --git a/services/brig/src/Brig/API/Public.hs b/services/brig/src/Brig/API/Public.hs index 5db6b5516e5..25ab490c74d 100644 --- a/services/brig/src/Brig/API/Public.hs +++ b/services/brig/src/Brig/API/Public.hs @@ -95,7 +95,6 @@ import qualified Data.ZAuth.Token as ZAuth import FileEmbedLzma import Galley.Types.Teams (HiddenPerm (..), hasPermission) import Imports hiding (head) -import Network.HTTP.Types.Status import Network.Wai import Network.Wai.Predicate hiding (result, setStatus) import Network.Wai.Routing @@ -190,7 +189,8 @@ servantSitemap :: Members '[ BlacklistStore, BlacklistPhonePrefixStore, - UserPendingActivationStore p + UserPendingActivationStore p, + PasswordResetStore ] r => ServerT BrigAPI (Handler r) @@ -228,6 +228,7 @@ servantSitemap = userAPI :<|> selfAPI :<|> accountAPI :<|> clientAPI :<|> prekey :<|> Named @"get-activate" activate :<|> Named @"post-activate" activateKey :<|> Named @"post-activate-send" sendActivationCode + :<|> Named @"post-password-reset" beginPasswordReset clientAPI :: ServerT ClientAPI (Handler r) clientAPI = @@ -316,17 +317,6 @@ sitemap :: sitemap = do -- /activate, /password-reset ---------------------------------- - post "/password-reset" (continue beginPasswordResetH) $ - accept "application" "json" - .&. jsonRequest @Public.NewPasswordReset - document "POST" "beginPasswordReset" $ do - Doc.summary "Initiate a password reset." - Doc.body (Doc.ref Public.modelNewPasswordReset) $ - Doc.description "JSON body" - Doc.response 201 "Password reset code created and sent by email." Doc.end - Doc.errorResponse invalidPwResetKey - Doc.errorResponse duplicatePwResetCode - post "/password-reset/complete" (continue completePasswordResetH) $ accept "application" "json" .&. jsonRequest @Public.CompletePasswordReset @@ -770,13 +760,6 @@ changeHandle u conn (Public.HandleUpdate h) = lift . exceptTToMaybe $ do handle <- maybe (throwError Public.ChangeHandleInvalid) pure $ parseHandle h API.changeHandle u (Just conn) handle API.ForbidSCIMUpdates -beginPasswordResetH :: - Members '[PasswordResetStore] r => - JSON ::: JsonRequest Public.NewPasswordReset -> - (Handler r) Response -beginPasswordResetH (_ ::: req) = - setStatus status201 empty <$ (beginPasswordReset =<< parseJsonBody req) - beginPasswordReset :: Members '[PasswordResetStore] r => Public.NewPasswordReset -> diff --git a/services/brig/src/Brig/Provider/API.hs b/services/brig/src/Brig/Provider/API.hs index 061cdf4011d..f02a1d5bb2d 100644 --- a/services/brig/src/Brig/Provider/API.hs +++ b/services/brig/src/Brig/Provider/API.hs @@ -100,7 +100,7 @@ import Wire.API.Conversation.Bot import qualified Wire.API.Conversation.Bot as Public import Wire.API.Conversation.Role import Wire.API.Error -import Wire.API.Error.Brig +import qualified Wire.API.Error.Brig as E import qualified Wire.API.Event.Conversation as Public (Event) import Wire.API.Provider import qualified Wire.API.Provider as Public @@ -338,7 +338,7 @@ newAccount :: Public.NewProvider -> (Handler r) Public.NewProviderResponse newAccount new = do email <- case validateEmail (Public.newProviderEmail new) of Right em -> pure em - Left _ -> throwStd (errorToWai @'InvalidEmail) + Left _ -> throwStd (errorToWai @'E.InvalidEmail) let name = Public.newProviderName new let pass = Public.newProviderPassword new let descr = fromRange (Public.newProviderDescr new) @@ -376,7 +376,7 @@ activateAccountKey key val = do c <- wrapClientE (Code.verify key Code.IdentityVerification val) >>= maybeInvalidCode (pid, email) <- case (Code.codeAccount c, Code.codeForEmail c) of (Just p, Just e) -> pure (Id p, e) - _ -> throwStd (errorToWai @'InvalidCode) + _ -> throwStd (errorToWai @'E.InvalidCode) (name, memail, _url, _descr) <- wrapClientE (DB.lookupAccountData pid) >>= maybeInvalidCode case memail of Just email' | email == email' -> pure Nothing @@ -402,7 +402,7 @@ getActivationCode :: Public.Email -> (Handler r) FoundActivationCode getActivationCode e = do email <- case validateEmail e of Right em -> pure em - Left _ -> throwStd (errorToWai @'InvalidEmail) + Left _ -> throwStd (errorToWai @'E.InvalidEmail) gen <- Code.mkGen (Code.ForEmail email) code <- wrapClientE $ Code.lookup (Code.genKey gen) Code.IdentityVerification maybe (throwStd activationKeyNotFound) (pure . FoundActivationCode) code @@ -427,7 +427,7 @@ approveAccountKey key val = do (name, _, _, _) <- wrapClientE (DB.lookupAccountData (Id pid)) >>= maybeInvalidCode activate (Id pid) Nothing email lift $ sendApprovalConfirmMail name email - _ -> throwStd (errorToWai @'InvalidCode) + _ -> throwStd (errorToWai @'E.InvalidCode) loginH :: JsonRequest Public.ProviderLogin -> (Handler r) Response loginH req = do @@ -440,7 +440,7 @@ login l = do pid <- wrapClientE (DB.lookupKey (mkEmailKey (providerLoginEmail l))) >>= maybeBadCredentials pass <- wrapClientE (DB.lookupPassword pid) >>= maybeBadCredentials unless (verifyPassword (providerLoginPassword l) pass) $ - throwStd (errorToWai @'BadCredentials) + throwStd (errorToWai @'E.BadCredentials) ZAuth.newProviderToken pid beginPasswordResetH :: JsonRequest Public.PasswordReset -> (Handler r) Response @@ -520,7 +520,7 @@ updateAccountEmail :: ProviderId -> Public.EmailUpdate -> (Handler r) () updateAccountEmail pid (Public.EmailUpdate new) = do email <- case validateEmail new of Right em -> pure em - Left _ -> throwStd (errorToWai @'InvalidEmail) + Left _ -> throwStd (errorToWai @'E.InvalidEmail) let emailKey = mkEmailKey email wrapClientE (DB.lookupKey emailKey) >>= mapM_ (const $ throwStd emailExists) gen <- Code.mkGen (Code.ForEmail email) @@ -543,7 +543,7 @@ updateAccountPassword :: ProviderId -> Public.PasswordChange -> (Handler r) () updateAccountPassword pid upd = do pass <- wrapClientE (DB.lookupPassword pid) >>= maybeBadCredentials unless (verifyPassword (cpOldPassword upd) pass) $ - throwStd (errorToWai @'BadCredentials) + throwStd (errorToWai @'E.BadCredentials) when (verifyPassword (cpNewPassword upd) pass) $ throwStd newPasswordMustDiffer wrapClientE $ DB.updateAccountPassword pid (cpNewPassword upd) @@ -628,7 +628,7 @@ updateServiceConn :: ProviderId -> ServiceId -> Public.UpdateServiceConn -> (Han updateServiceConn pid sid upd = do pass <- wrapClientE (DB.lookupPassword pid) >>= maybeBadCredentials unless (verifyPassword (updateServiceConnPassword upd) pass) $ - throwStd (errorToWai @'BadCredentials) + throwStd (errorToWai @'E.BadCredentials) scon <- wrapClientE (DB.lookupServiceConn pid sid) >>= maybeServiceNotFound svc <- wrapClientE (DB.lookupServiceProfile pid sid) >>= maybeServiceNotFound let newBaseUrl = updateServiceConnUrl upd @@ -679,7 +679,7 @@ deleteService :: ProviderId -> ServiceId -> Public.DeleteService -> (Handler r) deleteService pid sid del = do pass <- wrapClientE (DB.lookupPassword pid) >>= maybeBadCredentials unless (verifyPassword (deleteServicePassword del) pass) $ - throwStd (errorToWai @'BadCredentials) + throwStd (errorToWai @'E.BadCredentials) _ <- wrapClientE (DB.lookupService pid sid) >>= maybeServiceNotFound -- Disable the service wrapClientE $ DB.updateServiceConn pid sid Nothing Nothing Nothing (Just False) @@ -741,7 +741,7 @@ deleteAccount pid del = do prov <- DB.lookupAccount pid >>= maybeInvalidProvider pass <- DB.lookupPassword pid >>= maybeBadCredentials unless (verifyPassword (deleteProviderPassword del) pass) $ - throwStd (errorToWai @'BadCredentials) + throwStd (errorToWai @'E.BadCredentials) svcs <- DB.listServices pid forM_ svcs $ \svc -> do let sid = serviceId svc @@ -990,12 +990,12 @@ botGetSelfH bot = do botGetSelf :: BotId -> (Handler r) Public.UserProfile botGetSelf bot = do p <- lift $ wrapClient $ User.lookupUser NoPendingInvitations (botUserId bot) - maybe (throwStd (errorToWai @'UserNotFound)) (pure . (`Public.publicProfile` UserLegalHoldNoConsent)) p + maybe (throwStd (errorToWai @'E.UserNotFound)) (pure . (`Public.publicProfile` UserLegalHoldNoConsent)) p botGetClientH :: BotId -> (Handler r) Response botGetClientH bot = do mapExceptT wrapHttp $ guardSecondFactorDisabled (Just (botUserId bot)) - maybe (throwStd (errorToWai @'ClientNotFound)) (pure . json) =<< lift (botGetClient bot) + maybe (throwStd (errorToWai @'E.ClientNotFound)) (pure . json) =<< lift (botGetClient bot) botGetClient :: BotId -> (AppT r) (Maybe Public.Client) botGetClient bot = @@ -1022,7 +1022,7 @@ botUpdatePrekeys :: BotId -> Public.UpdateBotPrekeys -> (Handler r) () botUpdatePrekeys bot upd = do clt <- lift $ listToMaybe <$> wrapClient (User.lookupClients (botUserId bot)) case clt of - Nothing -> throwStd (errorToWai @'ClientNotFound) + Nothing -> throwStd (errorToWai @'E.ClientNotFound) Just c -> do let pks = updateBotPrekeyList upd wrapClientE (User.updatePrekeys (botUserId bot) (clientId c) pks) !>> clientDataError @@ -1036,7 +1036,7 @@ botClaimUsersPrekeys :: Public.UserClients -> (Handler r) Public.UserClientPreke botClaimUsersPrekeys body = do maxSize <- fromIntegral . setMaxConvSize <$> view settings when (Map.size (Public.userClients body) > maxSize) $ - throwStd (errorToWai @'TooManyClients) + throwStd (errorToWai @'E.TooManyClients) Client.claimLocalMultiPrekeyBundles UnprotectedBot body !>> clientError botListUserProfilesH :: List UserId -> (Handler r) Response @@ -1184,7 +1184,7 @@ maybeInvalidProvider :: Monad m => Maybe a -> (ExceptT Error m) a maybeInvalidProvider = maybe (throwStd invalidProvider) pure maybeInvalidCode :: Monad m => Maybe a -> (ExceptT Error m) a -maybeInvalidCode = maybe (throwStd (errorToWai @'InvalidCode)) pure +maybeInvalidCode = maybe (throwStd (errorToWai @'E.InvalidCode)) pure maybeServiceNotFound :: Monad m => Maybe a -> (ExceptT Error m) a maybeServiceNotFound = maybe (throwStd (notFound "Service not found")) pure @@ -1196,7 +1196,7 @@ maybeConvNotFound :: Monad m => Maybe a -> (ExceptT Error m) a maybeConvNotFound = maybe (throwStd (notFound "Conversation not found")) pure maybeBadCredentials :: Monad m => Maybe a -> (ExceptT Error m) a -maybeBadCredentials = maybe (throwStd (errorToWai @'BadCredentials)) pure +maybeBadCredentials = maybe (throwStd (errorToWai @'E.BadCredentials)) pure maybeInvalidServiceKey :: Monad m => Maybe a -> (ExceptT Error m) a maybeInvalidServiceKey = maybe (throwStd invalidServiceKey) pure @@ -1205,7 +1205,7 @@ maybeInvalidBot :: Monad m => Maybe a -> (ExceptT Error m) a maybeInvalidBot = maybe (throwStd invalidBot) pure maybeInvalidUser :: Monad m => Maybe a -> (ExceptT Error m) a -maybeInvalidUser = maybe (throwStd (errorToWai @'InvalidUser)) pure +maybeInvalidUser = maybe (throwStd (errorToWai @'E.InvalidUser)) pure rangeChecked :: (Within a n m, Monad monad) => a -> (ExceptT Error monad) (Range n m a) rangeChecked = either (throwStd . invalidRange . fromString) pure . checkedEither From 95136593e8d08e6ea788d700f723dd8b2c54b8f1 Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Fri, 23 Sep 2022 09:06:20 +0200 Subject: [PATCH 45/58] [SQSERVICES-1643] Servantify brig account API 6- `POST password-reset/complete` (#2704) --- changelog.d/5-internal/pr-2704 | 1 + .../src/Wire/API/Routes/Public/Brig.hs | 11 ++- libs/wire-api/src/Wire/API/Swagger.hs | 2 - libs/wire-api/src/Wire/API/User/Password.hs | 84 ++++++++++--------- services/brig/src/Brig/API/Error.hs | 4 - services/brig/src/Brig/API/Public.hs | 27 ++---- 6 files changed, 65 insertions(+), 64 deletions(-) create mode 100644 changelog.d/5-internal/pr-2704 diff --git a/changelog.d/5-internal/pr-2704 b/changelog.d/5-internal/pr-2704 new file mode 100644 index 00000000000..8e186d7d972 --- /dev/null +++ b/changelog.d/5-internal/pr-2704 @@ -0,0 +1 @@ +The `POST /password-reset/complete` endpoint of the account API is now migrated to servant diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs index e0f7f5e78a0..c83a031d89b 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs @@ -55,7 +55,7 @@ import Wire.API.User.Activation import Wire.API.User.Client import Wire.API.User.Client.Prekey import Wire.API.User.Handle -import Wire.API.User.Password (NewPasswordReset) +import Wire.API.User.Password (CompletePasswordReset, NewPasswordReset) import Wire.API.User.RichInfo (RichInfoAssocList) import Wire.API.User.Search (Contact, RoleFilter, SearchResult, TeamContact, TeamUserSearchSortBy, TeamUserSearchSortOrder) import Wire.API.UserMap @@ -467,6 +467,15 @@ type AccountAPI = :> ReqBody '[JSON] NewPasswordReset :> MultiVerb 'POST '[JSON] '[RespondEmpty 201 "Password reset code created and sent by email."] () ) + :<|> Named + "post-password-reset-complete" + ( Summary "Complete a password reset." + :> CanThrow 'InvalidPasswordResetCode + :> "password-reset" + :> "complete" + :> ReqBody '[JSON] CompletePasswordReset + :> MultiVerb 'POST '[JSON] '[RespondEmpty 200 "Password reset successful."] () + ) data ActivationRespWithStatus = ActivationResp ActivationResponse diff --git a/libs/wire-api/src/Wire/API/Swagger.hs b/libs/wire-api/src/Wire/API/Swagger.hs index a76bcd70c25..20aaddca84b 100644 --- a/libs/wire-api/src/Wire/API/Swagger.hs +++ b/libs/wire-api/src/Wire/API/Swagger.hs @@ -40,7 +40,6 @@ import qualified Wire.API.User.Auth as User.Auth import qualified Wire.API.User.Client as User.Client import qualified Wire.API.User.Client.Prekey as User.Client.Prekey import qualified Wire.API.User.Handle as User.Handle -import qualified Wire.API.User.Password as User.Password import qualified Wire.API.User.Profile as User.Profile import qualified Wire.API.User.RichInfo as User.RichInfo import qualified Wire.API.User.Search as User.Search @@ -118,7 +117,6 @@ models = User.Client.Prekey.modelPrekey, User.Handle.modelUserHandleInfo, User.Handle.modelCheckHandles, - User.Password.modelCompletePasswordReset, User.Profile.modelAsset, User.RichInfo.modelRichInfo, User.RichInfo.modelRichField, diff --git a/libs/wire-api/src/Wire/API/User/Password.hs b/libs/wire-api/src/Wire/API/User/Password.hs index cb4e6400f44..5bda2ab6028 100644 --- a/libs/wire-api/src/Wire/API/User/Password.hs +++ b/libs/wire-api/src/Wire/API/User/Password.hs @@ -28,9 +28,6 @@ module Wire.API.User.Password -- * deprecated PasswordReset (..), - - -- * Swagger - modelCompletePasswordReset, ) where @@ -42,8 +39,8 @@ import Data.Misc (PlainTextPassword (..)) import Data.Range (Ranged (..)) import qualified Data.Schema as Schema import qualified Data.Swagger as S -import qualified Data.Swagger.Build.Api as Doc import Data.Text.Ascii +import Data.Tuple.Extra (fst3, snd3, thd3) import Imports import Wire.API.User.Identity import Wire.Arbitrary (Arbitrary, GenericUniform (..)) @@ -107,41 +104,52 @@ data CompletePasswordReset = CompletePasswordReset } deriving stock (Eq, Show, Generic) deriving (Arbitrary) via (GenericUniform CompletePasswordReset) + deriving (ToJSON, FromJSON, S.ToSchema) via Schema.Schema CompletePasswordReset -modelCompletePasswordReset :: Doc.Model -modelCompletePasswordReset = Doc.defineModel "CompletePasswordReset" $ do - Doc.description "Data to complete a password reset." - Doc.property "key" Doc.string' $ do - Doc.description "An opaque key for a pending password reset." - Doc.optional - Doc.property "email" Doc.string' $ do - Doc.description "A known email with a pending password reset." - Doc.optional - Doc.property "phone" Doc.string' $ do - Doc.description "A known phone number with a pending password reset." - Doc.optional - Doc.property "code" Doc.string' $ - Doc.description "Password reset code" - Doc.property "password" Doc.string' $ - Doc.description "New password (6 - 1024 characters)" - -instance ToJSON CompletePasswordReset where - toJSON (CompletePasswordReset i c pw) = - object - [ident i, "code" .= c, "password" .= pw] +instance Schema.ToSchema CompletePasswordReset where + schema = + Schema.objectWithDocModifier "CompletePasswordReset" objectDocs $ + CompletePasswordReset + <$> (maybePasswordResetIdentityToTuple . cpwrIdent) Schema..= maybePasswordResetIdentityObjectSchema + <*> cpwrCode Schema..= Schema.fieldWithDocModifier "code" codeDocs Schema.schema + <*> cpwrPassword Schema..= Schema.fieldWithDocModifier "password" pwDocs Schema.schema where - ident (PasswordResetIdentityKey k) = "key" .= k - ident (PasswordResetEmailIdentity e) = "email" .= e - ident (PasswordResetPhoneIdentity p) = "phone" .= p + objectDocs :: Schema.NamedSwaggerDoc -> Schema.NamedSwaggerDoc + objectDocs = Schema.description ?~ "Data to complete a password reset" -instance FromJSON CompletePasswordReset where - parseJSON = withObject "CompletePasswordReset" $ \o -> - CompletePasswordReset <$> ident o <*> o .: "code" <*> o .: "password" - where - ident o = - (PasswordResetIdentityKey <$> o .: "key") - <|> (PasswordResetEmailIdentity <$> o .: "email") - <|> (PasswordResetPhoneIdentity <$> o .: "phone") + codeDocs :: Schema.NamedSwaggerDoc -> Schema.NamedSwaggerDoc + codeDocs = Schema.description ?~ "Password reset code" + + pwDocs :: Schema.NamedSwaggerDoc -> Schema.NamedSwaggerDoc + pwDocs = Schema.description ?~ "New password (6 - 1024 characters)" + + maybePasswordResetIdentityObjectSchema :: Schema.ObjectSchemaP Schema.SwaggerDoc (Maybe PasswordResetKey, Maybe Email, Maybe Phone) PasswordResetIdentity + maybePasswordResetIdentityObjectSchema = + Schema.withParser passwordResetIdentityTupleObjectSchema maybePasswordResetIdentityTargetFromTuple + where + passwordResetIdentityTupleObjectSchema :: Schema.ObjectSchema Schema.SwaggerDoc (Maybe PasswordResetKey, Maybe Email, Maybe Phone) + passwordResetIdentityTupleObjectSchema = + (,,) + <$> fst3 Schema..= Schema.maybe_ (Schema.optFieldWithDocModifier "key" keyDocs Schema.schema) + <*> snd3 Schema..= Schema.maybe_ (Schema.optFieldWithDocModifier "email" emailDocs Schema.schema) + <*> thd3 Schema..= Schema.maybe_ (Schema.optFieldWithDocModifier "phone" phoneDocs Schema.schema) + where + keyDocs = Schema.description ?~ "An opaque key for a pending password reset." + emailDocs = Schema.description ?~ "A known email with a pending password reset." + phoneDocs = Schema.description ?~ "A known phone number with a pending password reset." + + maybePasswordResetIdentityTargetFromTuple :: (Maybe PasswordResetKey, Maybe Email, Maybe Phone) -> Parser PasswordResetIdentity + maybePasswordResetIdentityTargetFromTuple = \case + (Just key, _, _) -> pure $ PasswordResetIdentityKey key + (_, Just email, _) -> pure $ PasswordResetEmailIdentity email + (_, _, Just phone) -> pure $ PasswordResetPhoneIdentity phone + _ -> fail "key, email or phone must be present" + + maybePasswordResetIdentityToTuple :: PasswordResetIdentity -> (Maybe PasswordResetKey, Maybe Email, Maybe Phone) + maybePasswordResetIdentityToTuple = \case + PasswordResetIdentityKey key -> (Just key, Nothing, Nothing) + PasswordResetEmailIdentity email -> (Nothing, Just email, Nothing) + PasswordResetPhoneIdentity phone -> (Nothing, Nothing, Just phone) -------------------------------------------------------------------------------- -- PasswordResetIdentity @@ -161,7 +169,7 @@ data PasswordResetIdentity newtype PasswordResetKey = PasswordResetKey {fromPasswordResetKey :: AsciiBase64Url} deriving stock (Eq, Show) - deriving newtype (FromByteString, ToByteString, FromJSON, ToJSON, Arbitrary) + deriving newtype (Schema.ToSchema, FromByteString, ToByteString, FromJSON, ToJSON, Arbitrary) -------------------------------------------------------------------------------- -- PasswordResetCode @@ -170,7 +178,7 @@ newtype PasswordResetKey = PasswordResetKey newtype PasswordResetCode = PasswordResetCode {fromPasswordResetCode :: AsciiBase64Url} deriving stock (Eq, Show, Generic) - deriving newtype (FromByteString, ToByteString, FromJSON, ToJSON) + deriving newtype (Schema.ToSchema, FromByteString, ToByteString, FromJSON, ToJSON) deriving (Arbitrary) via (Ranged 6 1024 AsciiBase64Url) -------------------------------------------------------------------------------- diff --git a/services/brig/src/Brig/API/Error.hs b/services/brig/src/Brig/API/Error.hs index 408f7c217f6..acab9f94a71 100644 --- a/services/brig/src/Brig/API/Error.hs +++ b/services/brig/src/Brig/API/Error.hs @@ -235,10 +235,6 @@ clientCapabilitiesCannotBeRemoved = Wai.mkError status409 "client-capabilities-c noEmail :: Wai.Error noEmail = Wai.mkError status403 "no-email" "This operation requires the user to have a verified email address." --- todo(leif): remove later -invalidPwResetCode :: Wai.Error -invalidPwResetCode = Wai.mkError status400 "invalid-code" "Invalid password reset code." - emailExists :: Wai.Error emailExists = Wai.mkError status409 "email-exists" "The given e-mail address is in use." diff --git a/services/brig/src/Brig/API/Public.hs b/services/brig/src/Brig/API/Public.hs index 25ab490c74d..89bee1dffa1 100644 --- a/services/brig/src/Brig/API/Public.hs +++ b/services/brig/src/Brig/API/Public.hs @@ -100,7 +100,6 @@ import Network.Wai.Predicate hiding (result, setStatus) import Network.Wai.Routing import Network.Wai.Utilities as Utilities import Network.Wai.Utilities.Swagger (document, mkSwaggerApi) -import qualified Network.Wai.Utilities.Swagger as Doc import Network.Wai.Utilities.ZAuth (zauthUserId) import Polysemy import Servant hiding (Handler, JSON, addHeader, respond) @@ -190,7 +189,8 @@ servantSitemap :: '[ BlacklistStore, BlacklistPhonePrefixStore, UserPendingActivationStore p, - PasswordResetStore + PasswordResetStore, + CodeStore ] r => ServerT BrigAPI (Handler r) @@ -229,6 +229,7 @@ servantSitemap = userAPI :<|> selfAPI :<|> accountAPI :<|> clientAPI :<|> prekey :<|> Named @"post-activate" activateKey :<|> Named @"post-activate-send" sendActivationCode :<|> Named @"post-password-reset" beginPasswordReset + :<|> Named @"post-password-reset-complete" completePasswordReset clientAPI :: ServerT ClientAPI (Handler r) clientAPI = @@ -317,16 +318,6 @@ sitemap :: sitemap = do -- /activate, /password-reset ---------------------------------- - post "/password-reset/complete" (continue completePasswordResetH) $ - accept "application" "json" - .&. jsonRequest @Public.CompletePasswordReset - document "POST" "completePasswordReset" $ do - Doc.summary "Complete a password reset." - Doc.body (Doc.ref Public.modelCompletePasswordReset) $ - Doc.description "JSON body" - Doc.response 200 "Password reset successful." Doc.end - Doc.errorResponse invalidPwResetCode - post "/password-reset/:key" (continue deprecatedCompletePasswordResetH) $ accept "application" "json" .&. capture "key" @@ -772,14 +763,12 @@ beginPasswordReset (Public.NewPasswordReset target) = do Left email -> sendPasswordResetMail email pair loc Right phone -> wrapClient $ sendPasswordResetSms phone pair loc -completePasswordResetH :: +completePasswordReset :: Members '[CodeStore, PasswordResetStore] r => - JSON ::: JsonRequest Public.CompletePasswordReset -> - (Handler r) Response -completePasswordResetH (_ ::: req) = do - Public.CompletePasswordReset {..} <- parseJsonBody req - API.completePasswordReset cpwrIdent cpwrCode cpwrPassword !>> pwResetError - pure empty + Public.CompletePasswordReset -> + (Handler r) () +completePasswordReset req = do + API.completePasswordReset (Public.cpwrIdent req) (Public.cpwrCode req) (Public.cpwrPassword req) !>> pwResetError -- docs/reference/user/activation.md {#RefActivationRequest} -- docs/reference/user/registration.md {#RefRegistration} From b83b6719836f541f62a63271dc7b173ecd7b854a Mon Sep 17 00:00:00 2001 From: fisx Date: Fri, 23 Sep 2022 09:48:42 +0200 Subject: [PATCH 46/58] Better signal handling for proxy, stern; extend grace period for all (#2715) Co-authored-by: Akshay Mankar --- changelog.d/3-bug-fixes/sqpit-1431 | 1 + libs/wai-utilities/src/Network/Wai/Utilities/Server.hs | 9 +++++++-- services/brig/src/Brig/Run.hs | 2 +- services/cannon/src/Cannon/Run.hs | 4 ++++ services/cargohold/src/CargoHold/Run.hs | 2 +- services/galley/src/Galley/Run.hs | 2 +- services/gundeck/src/Gundeck/Run.hs | 2 +- services/proxy/src/Proxy/Run.hs | 3 +-- services/spar/src/Spar/Run.hs | 2 +- tools/stern/src/Stern/API.hs | 3 +-- 10 files changed, 19 insertions(+), 11 deletions(-) create mode 100644 changelog.d/3-bug-fixes/sqpit-1431 diff --git a/changelog.d/3-bug-fixes/sqpit-1431 b/changelog.d/3-bug-fixes/sqpit-1431 new file mode 100644 index 00000000000..27e4489509a --- /dev/null +++ b/changelog.d/3-bug-fixes/sqpit-1431 @@ -0,0 +1 @@ +Less surprising handling of SIGINT, SIGTERM for proxy, stern. Increase grace period for shutdown from 5s to 30s for all services. \ No newline at end of file diff --git a/libs/wai-utilities/src/Network/Wai/Utilities/Server.hs b/libs/wai-utilities/src/Network/Wai/Utilities/Server.hs index 8bbf5286490..ea4708a3253 100644 --- a/libs/wai-utilities/src/Network/Wai/Utilities/Server.hs +++ b/libs/wai-utilities/src/Network/Wai/Utilities/Server.hs @@ -122,8 +122,10 @@ newSettings (Server h p l m t) = do -- on receiving either the INT or TERM signals. After closing -- the listen socket, Warp will be allowed to drain existing -- connections up to the given number of seconds. -runSettingsWithShutdown :: Settings -> Application -> Word16 -> IO () -runSettingsWithShutdown s app secs = do +-- +-- See also: https://gitlab.haskell.org/ghc/ghc/-/merge_requests/7681 +runSettingsWithShutdown :: Settings -> Application -> Maybe Word16 -> IO () +runSettingsWithShutdown s app (fromMaybe defaultShutdownTime -> secs) = do initialization latch <- newEmptyMVar let s' = setInstallShutdownHandler (catchSignals latch) s @@ -145,6 +147,9 @@ runSettingsWithShutdown s app secs = do Just (Left ex) -> throwIO ex _ -> cancel srv +defaultShutdownTime :: Word16 +defaultShutdownTime = 30 + compile :: Monad m => Routes a m b -> Tree (App m) compile routes = Route.prepare (Route.renderer predicateError >> routes) where diff --git a/services/brig/src/Brig/Run.hs b/services/brig/src/Brig/Run.hs index d4813c5dc43..d435284e4ab 100644 --- a/services/brig/src/Brig/Run.hs +++ b/services/brig/src/Brig/Run.hs @@ -102,7 +102,7 @@ run o = do authMetrics <- Async.async (runBrigToIO e collectAuthMetrics) pendingActivationCleanupAsync <- Async.async (runBrigToIO e pendingActivationCleanup) - runSettingsWithShutdown s app 5 `finally` do + runSettingsWithShutdown s app Nothing `finally` do mapM_ Async.cancel emailListener Async.cancel internalEventListener mapM_ Async.cancel sftDiscovery diff --git a/services/cannon/src/Cannon/Run.hs b/services/cannon/src/Cannon/Run.hs index 635e414a9fe..c5a30103aba 100644 --- a/services/cannon/src/Cannon/Run.hs +++ b/services/cannon/src/Cannon/Run.hs @@ -91,6 +91,10 @@ run o = do void $ installHandler sigTERM (signalHandler (env e) tid) Nothing void $ installHandler sigINT (signalHandler (env e) tid) Nothing runSettings s app `finally` do + -- FUTUREWORK(@akshaymankar, @fisx): we may want to call `runSettingsWithShutdown` here, + -- but it's a sensitive change, and it looks like this is closing all the websockets at + -- the same time and then calling the drain script. I suspect this might be due to some + -- cleanup in wai. this needs to be tested very carefully when touched. Async.cancel refreshMetricsThread L.close (applog e) where diff --git a/services/cargohold/src/CargoHold/Run.hs b/services/cargohold/src/CargoHold/Run.hs index 7f0b3d73d15..09677b898ea 100644 --- a/services/cargohold/src/CargoHold/Run.hs +++ b/services/cargohold/src/CargoHold/Run.hs @@ -69,7 +69,7 @@ run o = lowerCodensity $ do (o ^. optCargohold . epPort) (e ^. appLogger) (e ^. metrics) - runSettingsWithShutdown s app 5 + runSettingsWithShutdown s app Nothing mkApp :: Opts -> Codensity IO (Application, Env) mkApp o = Codensity $ \k -> diff --git a/services/galley/src/Galley/Run.hs b/services/galley/src/Galley/Run.hs index a82a7f3a721..81dfa216da9 100644 --- a/services/galley/src/Galley/Run.hs +++ b/services/galley/src/Galley/Run.hs @@ -81,7 +81,7 @@ run opts = lowerCodensity $ do void $ Codensity $ Async.withAsync $ collectAuthMetrics (env ^. monitor) (aws ^. awsEnv) void $ Codensity $ Async.withAsync $ runApp env deleteLoop void $ Codensity $ Async.withAsync $ runApp env refreshMetrics - lift $ finally (runSettingsWithShutdown settings app 5) (shutdown (env ^. cstate)) + lift $ finally (runSettingsWithShutdown settings app Nothing) (shutdown (env ^. cstate)) mkApp :: Opts -> Codensity IO (Application, Env) mkApp opts = diff --git a/services/gundeck/src/Gundeck/Run.hs b/services/gundeck/src/Gundeck/Run.hs index f25fcc47c4c..3a5819ba6bf 100644 --- a/services/gundeck/src/Gundeck/Run.hs +++ b/services/gundeck/src/Gundeck/Run.hs @@ -62,7 +62,7 @@ run o = do lst <- Async.async $ Aws.execute (e ^. awsEnv) (Aws.listen throttleMillis (runDirect e . onEvent)) wtbs <- forM (e ^. threadBudgetState) $ \tbs -> Async.async $ runDirect e $ watchThreadBudgetState m tbs 10 wCollectAuth <- Async.async (collectAuthMetrics m (Aws._awsEnv (Env._awsEnv e))) - runSettingsWithShutdown s (middleware e $ mkApp e) 5 `finally` do + runSettingsWithShutdown s (middleware e $ mkApp e) Nothing `finally` do Log.info l $ Log.msg (Log.val "Shutting down ...") shutdown (e ^. cstate) Async.cancel lst diff --git a/services/proxy/src/Proxy/Run.hs b/services/proxy/src/Proxy/Run.hs index b58d93c61e3..69b209b0bb2 100644 --- a/services/proxy/src/Proxy/Run.hs +++ b/services/proxy/src/Proxy/Run.hs @@ -25,7 +25,6 @@ import Control.Monad.Catch import Data.Metrics.Middleware hiding (path) import Data.Metrics.Middleware.Prometheus (waiPrometheusMiddleware) import Imports hiding (head) -import Network.Wai.Handler.Warp (runSettings) import Network.Wai.Utilities.Server hiding (serverPort) import Proxy.API (sitemap) import Proxy.Env @@ -44,4 +43,4 @@ run o = do versionMiddleware . waiPrometheusMiddleware (sitemap e) . catchErrors (e ^. applog) [Right m] - runSettings s (middleware app) `finally` destroyEnv e + runSettingsWithShutdown s (middleware app) Nothing `finally` destroyEnv e diff --git a/services/spar/src/Spar/Run.hs b/services/spar/src/Spar/Run.hs index 8cb2339da30..80e7013291f 100644 --- a/services/spar/src/Spar/Run.hs +++ b/services/spar/src/Spar/Run.hs @@ -98,7 +98,7 @@ runServer sparCtxOpts = do (wrappedApp, ctxOpts) <- mkApp sparCtxOpts let logger = sparCtxLogger ctxOpts Log.info logger . Log.msg $ "Listening on " <> shost <> ":" <> show sport - WU.runSettingsWithShutdown settings wrappedApp 5 + WU.runSettingsWithShutdown settings wrappedApp Nothing mkApp :: Opts -> IO (Application, Env) mkApp sparCtxOpts = do diff --git a/tools/stern/src/Stern/API.hs b/tools/stern/src/Stern/API.hs index 0912ec75125..af93fae30ee 100644 --- a/tools/stern/src/Stern/API.hs +++ b/tools/stern/src/Stern/API.hs @@ -49,7 +49,6 @@ import qualified Galley.Types.Teams.Intra as Team import Imports hiding (head) import Network.HTTP.Types import Network.Wai -import Network.Wai.Handler.Warp import qualified Network.Wai.Middleware.Gzip as GZip import Network.Wai.Predicate hiding (Error, reason, setStatus) import Network.Wai.Routing hiding (trace) @@ -78,7 +77,7 @@ start :: Opts -> IO () start o = do e <- newEnv o s <- Server.newSettings (server e) - runSettings s (pipeline e) + Server.runSettingsWithShutdown s (pipeline e) Nothing where server e = Server.defaultServer (unpack $ stern o ^. epHost) (stern o ^. epPort) (e ^. applog) (e ^. metrics) pipeline e = GZip.gzip GZip.def $ serve e From 987c6485e8e8ad8bb36a7a55a5d6f139f2bf1ebf Mon Sep 17 00:00:00 2001 From: fisx Date: Fri, 23 Sep 2022 11:25:18 +0200 Subject: [PATCH 47/58] Note on race condition in integration test. (#2719) --- services/brig/test/integration/API/Provider.hs | 3 ++- services/brig/test/integration/Util.hs | 4 ++++ services/galley/test/integration/API/Teams.hs | 5 +---- services/galley/test/integration/API/Teams/Feature.hs | 8 ++++---- services/galley/test/integration/TestHelpers.hs | 5 +++++ 5 files changed, 16 insertions(+), 9 deletions(-) diff --git a/services/brig/test/integration/API/Provider.hs b/services/brig/test/integration/API/Provider.hs index e2caccbb30f..6b6674f748c 100644 --- a/services/brig/test/integration/API/Provider.hs +++ b/services/brig/test/integration/API/Provider.hs @@ -733,7 +733,8 @@ testDeleteTeamBotTeam config db brig galley cannon = withTestService config db b forM_ [uid1, uid2] $ \uid -> do void $ retryWhileN 20 (/= Intra.Deleted) (getStatus brig uid) chkStatus brig uid Intra.Deleted - getConversation galley uid cid !!! const 404 === statusCode + eventually $ do + getConversation galley uid cid !!! const 404 === statusCode -- Check the bot cannot see the conversation either getBotConv galley bid cid !!! const 404 === statusCode diff --git a/services/brig/test/integration/Util.hs b/services/brig/test/integration/Util.hs index 75960516505..e832bb08b12 100644 --- a/services/brig/test/integration/Util.hs +++ b/services/brig/test/integration/Util.hs @@ -1048,6 +1048,10 @@ aFewTimes (\_ -> pure . not . good) (const action) +-- see also: `aFewTimes`. we should really clean this up. +eventually :: (MonadIO m, MonadMask m) => m a -> m a +eventually = recovering (limitRetries 3 <> exponentialBackoff 100000) [] . const + assertOne :: (HasCallStack, MonadIO m, Show a) => [a] -> m a assertOne [a] = pure a assertOne xs = liftIO . assertFailure $ "Expected exactly one element, found " <> show xs diff --git a/services/galley/test/integration/API/Teams.hs b/services/galley/test/integration/API/Teams.hs index 0d25f0b8cb1..df7d9fe6f31 100644 --- a/services/galley/test/integration/API/Teams.hs +++ b/services/galley/test/integration/API/Teams.hs @@ -33,7 +33,6 @@ import qualified Brig.Types.Intra as Brig import Control.Arrow ((>>>)) import Control.Lens hiding ((#), (.=)) import Control.Monad.Catch -import Control.Retry import Data.Aeson hiding (json) import Data.ByteString.Conversion import Data.ByteString.Lazy (fromStrict) @@ -75,7 +74,7 @@ import Test.Tasty import Test.Tasty.Cannon (TimeoutUnit (..), (#)) import qualified Test.Tasty.Cannon as WS import Test.Tasty.HUnit -import TestHelpers (test, viewFederationDomain) +import TestHelpers (eventually, test, viewFederationDomain) import TestSetup (TestM, TestSetup, tsBrig, tsCannon, tsGConf, tsGalley) import UnliftIO (mapConcurrently) import Wire.API.Conversation @@ -491,8 +490,6 @@ testCreateOne2OneWithMembers (rolePermissions -> perms) = do -- | At the time of writing this test, the only event sent to this queue is 'MemberJoin'. testTeamQueue :: TestM () testTeamQueue = do - let eventually = recovering (limitRetries 3 <> exponentialBackoff 100000) [] . const - (owner, tid) <- createBindingTeam eventually $ do queue <- getTeamQueue owner Nothing Nothing False diff --git a/services/galley/test/integration/API/Teams/Feature.hs b/services/galley/test/integration/API/Teams/Feature.hs index 365584c46f5..701aad80902 100644 --- a/services/galley/test/integration/API/Teams/Feature.hs +++ b/services/galley/test/integration/API/Teams/Feature.hs @@ -51,7 +51,7 @@ import Test.QuickCheck (Gen, generate, suchThat) import Test.Tasty import qualified Test.Tasty.Cannon as WS import Test.Tasty.HUnit (assertFailure, (@?=)) -import TestHelpers (test) +import TestHelpers (eventually, test) import TestSetup import Wire.API.Conversation.Protocol (ProtocolTag (ProtocolMLSTag, ProtocolProteusTag)) import qualified Wire.API.Event.FeatureConfig as FeatureConfig @@ -495,17 +495,17 @@ testSimpleFlagTTLOverride defaultValue ttl ttlAfter = do nonMember <- Util.randomUser let getFlag :: HasCallStack => Public.FeatureStatus -> TestM () - getFlag expected = + getFlag expected = eventually $ do flip (assertFlagNoConfig @cfg) expected $ Util.getTeamFeatureFlag @cfg member tid getFeatureConfig :: HasCallStack => Public.FeatureStatus -> FeatureTTL -> TestM () - getFeatureConfig expectedStatus expectedTtl = do + getFeatureConfig expectedStatus expectedTtl = eventually $ do actual <- Util.getFeatureConfig @cfg member liftIO $ Public.wsStatus actual @?= expectedStatus liftIO $ Public.wsTTL actual @?= expectedTtl getFlagInternal :: HasCallStack => Public.FeatureStatus -> TestM () - getFlagInternal expected = + getFlagInternal expected = eventually $ do flip (assertFlagNoConfig @cfg) expected $ Util.getTeamFeatureFlagInternal @cfg tid setFlagInternal :: Public.FeatureStatus -> FeatureTTL -> TestM () diff --git a/services/galley/test/integration/TestHelpers.hs b/services/galley/test/integration/TestHelpers.hs index e7932f789d9..88b35c4e773 100644 --- a/services/galley/test/integration/TestHelpers.hs +++ b/services/galley/test/integration/TestHelpers.hs @@ -21,6 +21,8 @@ module TestHelpers where import API.SQS import Control.Lens (view) +import Control.Monad.Catch (MonadMask) +import Control.Retry import Data.Domain (Domain) import Data.Qualified import qualified Galley.Aws as Aws @@ -60,3 +62,6 @@ qualifyLocal :: a -> TestM (Local a) qualifyLocal x = do domain <- viewFederationDomain pure $ toLocalUnsafe domain x + +eventually :: (MonadIO m, MonadMask m) => m a -> m a +eventually = recovering (limitRetries 3 <> exponentialBackoff 100000) [] . const From d23f76711017f53aff91e8673ece83cca7e6df4e Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Fri, 23 Sep 2022 11:31:44 +0200 Subject: [PATCH 48/58] [SQSERVICES-1643] Servantify brig account API 7 - `POST /password-reset/:key` (#2705) --- changelog.d/5-internal/pr-2705 | 1 + .../src/Wire/API/Routes/Public/Brig.hs | 15 ++- libs/wire-api/src/Wire/API/User/Password.hs | 108 +++++++++++------- services/brig/src/Brig/API/Public.hs | 21 +--- 4 files changed, 85 insertions(+), 60 deletions(-) create mode 100644 changelog.d/5-internal/pr-2705 diff --git a/changelog.d/5-internal/pr-2705 b/changelog.d/5-internal/pr-2705 new file mode 100644 index 00000000000..25a250df03f --- /dev/null +++ b/changelog.d/5-internal/pr-2705 @@ -0,0 +1 @@ +The `POST /password-reset/:key` endpoint of the account API is now migrated to servant diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs index c83a031d89b..ccde347eec4 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs @@ -55,7 +55,7 @@ import Wire.API.User.Activation import Wire.API.User.Client import Wire.API.User.Client.Prekey import Wire.API.User.Handle -import Wire.API.User.Password (CompletePasswordReset, NewPasswordReset) +import Wire.API.User.Password (CompletePasswordReset, NewPasswordReset, PasswordReset, PasswordResetKey) import Wire.API.User.RichInfo (RichInfoAssocList) import Wire.API.User.Search (Contact, RoleFilter, SearchResult, TeamContact, TeamUserSearchSortBy, TeamUserSearchSortOrder) import Wire.API.UserMap @@ -476,6 +476,19 @@ type AccountAPI = :> ReqBody '[JSON] CompletePasswordReset :> MultiVerb 'POST '[JSON] '[RespondEmpty 200 "Password reset successful."] () ) + :<|> Named + "post-password-reset-key-deprecated" + ( Summary "Complete a password reset." + :> CanThrow 'PasswordResetInProgress + :> CanThrow 'InvalidPasswordResetKey + :> CanThrow 'InvalidPasswordResetCode + :> CanThrow 'ResetPasswordMustDiffer + :> Description "DEPRECATED: Use 'POST /password-reset/complete'." + :> "password-reset" + :> Capture' '[Description "An opaque key for a pending password reset."] "key" PasswordResetKey + :> ReqBody '[JSON] PasswordReset + :> MultiVerb 'POST '[JSON] '[RespondEmpty 200 "Password reset successful."] () + ) data ActivationRespWithStatus = ActivationResp ActivationResponse diff --git a/libs/wire-api/src/Wire/API/User/Password.hs b/libs/wire-api/src/Wire/API/User/Password.hs index 5bda2ab6028..555082c573e 100644 --- a/libs/wire-api/src/Wire/API/User/Password.hs +++ b/libs/wire-api/src/Wire/API/User/Password.hs @@ -32,16 +32,19 @@ module Wire.API.User.Password where import Control.Lens ((?~)) -import Data.Aeson +import qualified Data.Aeson as A import Data.Aeson.Types (Parser) import Data.ByteString.Conversion import Data.Misc (PlainTextPassword (..)) +import Data.Proxy (Proxy (Proxy)) import Data.Range (Ranged (..)) -import qualified Data.Schema as Schema +import Data.Schema as Schema import qualified Data.Swagger as S +import Data.Swagger.ParamSchema import Data.Text.Ascii import Data.Tuple.Extra (fst3, snd3, thd3) import Imports +import Servant (FromHttpApiData (..)) import Wire.API.User.Identity import Wire.Arbitrary (Arbitrary, GenericUniform (..)) @@ -52,34 +55,34 @@ import Wire.Arbitrary (Arbitrary, GenericUniform (..)) newtype NewPasswordReset = NewPasswordReset (Either Email Phone) deriving stock (Eq, Show, Generic) deriving newtype (Arbitrary) - deriving (ToJSON, FromJSON, S.ToSchema) via Schema.Schema NewPasswordReset + deriving (A.ToJSON, A.FromJSON, S.ToSchema) via Schema NewPasswordReset -instance Schema.ToSchema NewPasswordReset where +instance ToSchema NewPasswordReset where schema = - Schema.objectWithDocModifier "NewPasswordReset" objectDesc $ + objectWithDocModifier "NewPasswordReset" objectDesc $ NewPasswordReset <$> (toTuple . unNewPasswordReset) Schema..= newPasswordResetObjectSchema where unNewPasswordReset :: NewPasswordReset -> Either Email Phone unNewPasswordReset (NewPasswordReset v) = v - objectDesc :: Schema.NamedSwaggerDoc -> Schema.NamedSwaggerDoc - objectDesc = Schema.description ?~ "Data to initiate a password reset" + objectDesc :: NamedSwaggerDoc -> NamedSwaggerDoc + objectDesc = description ?~ "Data to initiate a password reset" - newPasswordResetObjectSchema :: Schema.ObjectSchemaP Schema.SwaggerDoc (Maybe Email, Maybe Phone) (Either Email Phone) - newPasswordResetObjectSchema = Schema.withParser newPasswordResetTupleObjectSchema fromTuple + newPasswordResetObjectSchema :: ObjectSchemaP SwaggerDoc (Maybe Email, Maybe Phone) (Either Email Phone) + newPasswordResetObjectSchema = withParser newPasswordResetTupleObjectSchema fromTuple where - newPasswordResetTupleObjectSchema :: Schema.ObjectSchema Schema.SwaggerDoc (Maybe Email, Maybe Phone) + newPasswordResetTupleObjectSchema :: ObjectSchema SwaggerDoc (Maybe Email, Maybe Phone) newPasswordResetTupleObjectSchema = (,) - <$> fst Schema..= Schema.maybe_ (Schema.optFieldWithDocModifier "email" phoneDocs Schema.schema) - <*> snd Schema..= Schema.maybe_ (Schema.optFieldWithDocModifier "phone" emailDocs Schema.schema) + <$> fst .= maybe_ (optFieldWithDocModifier "email" phoneDocs schema) + <*> snd .= maybe_ (optFieldWithDocModifier "phone" emailDocs schema) where - emailDocs :: Schema.NamedSwaggerDoc -> Schema.NamedSwaggerDoc - emailDocs = Schema.description ?~ "Email" + emailDocs :: NamedSwaggerDoc -> NamedSwaggerDoc + emailDocs = description ?~ "Email" - phoneDocs :: Schema.NamedSwaggerDoc -> Schema.NamedSwaggerDoc - phoneDocs = Schema.description ?~ "Phone" + phoneDocs :: NamedSwaggerDoc -> NamedSwaggerDoc + phoneDocs = description ?~ "Phone" fromTuple :: (Maybe Email, Maybe Phone) -> Parser (Either Email Phone) fromTuple = \case @@ -104,39 +107,39 @@ data CompletePasswordReset = CompletePasswordReset } deriving stock (Eq, Show, Generic) deriving (Arbitrary) via (GenericUniform CompletePasswordReset) - deriving (ToJSON, FromJSON, S.ToSchema) via Schema.Schema CompletePasswordReset + deriving (A.ToJSON, A.FromJSON, S.ToSchema) via Schema CompletePasswordReset -instance Schema.ToSchema CompletePasswordReset where +instance ToSchema CompletePasswordReset where schema = - Schema.objectWithDocModifier "CompletePasswordReset" objectDocs $ + objectWithDocModifier "CompletePasswordReset" objectDocs $ CompletePasswordReset - <$> (maybePasswordResetIdentityToTuple . cpwrIdent) Schema..= maybePasswordResetIdentityObjectSchema - <*> cpwrCode Schema..= Schema.fieldWithDocModifier "code" codeDocs Schema.schema - <*> cpwrPassword Schema..= Schema.fieldWithDocModifier "password" pwDocs Schema.schema + <$> (maybePasswordResetIdentityToTuple . cpwrIdent) .= maybePasswordResetIdentityObjectSchema + <*> cpwrCode .= fieldWithDocModifier "code" codeDocs schema + <*> cpwrPassword .= fieldWithDocModifier "password" pwDocs schema where - objectDocs :: Schema.NamedSwaggerDoc -> Schema.NamedSwaggerDoc - objectDocs = Schema.description ?~ "Data to complete a password reset" + objectDocs :: NamedSwaggerDoc -> NamedSwaggerDoc + objectDocs = description ?~ "Data to complete a password reset" - codeDocs :: Schema.NamedSwaggerDoc -> Schema.NamedSwaggerDoc - codeDocs = Schema.description ?~ "Password reset code" + codeDocs :: NamedSwaggerDoc -> NamedSwaggerDoc + codeDocs = description ?~ "Password reset code" - pwDocs :: Schema.NamedSwaggerDoc -> Schema.NamedSwaggerDoc - pwDocs = Schema.description ?~ "New password (6 - 1024 characters)" + pwDocs :: NamedSwaggerDoc -> NamedSwaggerDoc + pwDocs = description ?~ "New password (6 - 1024 characters)" - maybePasswordResetIdentityObjectSchema :: Schema.ObjectSchemaP Schema.SwaggerDoc (Maybe PasswordResetKey, Maybe Email, Maybe Phone) PasswordResetIdentity + maybePasswordResetIdentityObjectSchema :: ObjectSchemaP SwaggerDoc (Maybe PasswordResetKey, Maybe Email, Maybe Phone) PasswordResetIdentity maybePasswordResetIdentityObjectSchema = - Schema.withParser passwordResetIdentityTupleObjectSchema maybePasswordResetIdentityTargetFromTuple + withParser passwordResetIdentityTupleObjectSchema maybePasswordResetIdentityTargetFromTuple where - passwordResetIdentityTupleObjectSchema :: Schema.ObjectSchema Schema.SwaggerDoc (Maybe PasswordResetKey, Maybe Email, Maybe Phone) + passwordResetIdentityTupleObjectSchema :: ObjectSchema SwaggerDoc (Maybe PasswordResetKey, Maybe Email, Maybe Phone) passwordResetIdentityTupleObjectSchema = (,,) - <$> fst3 Schema..= Schema.maybe_ (Schema.optFieldWithDocModifier "key" keyDocs Schema.schema) - <*> snd3 Schema..= Schema.maybe_ (Schema.optFieldWithDocModifier "email" emailDocs Schema.schema) - <*> thd3 Schema..= Schema.maybe_ (Schema.optFieldWithDocModifier "phone" phoneDocs Schema.schema) + <$> fst3 .= maybe_ (optFieldWithDocModifier "key" keyDocs schema) + <*> snd3 .= maybe_ (optFieldWithDocModifier "email" emailDocs schema) + <*> thd3 .= maybe_ (optFieldWithDocModifier "phone" phoneDocs schema) where - keyDocs = Schema.description ?~ "An opaque key for a pending password reset." - emailDocs = Schema.description ?~ "A known email with a pending password reset." - phoneDocs = Schema.description ?~ "A known phone number with a pending password reset." + keyDocs = description ?~ "An opaque key for a pending password reset." + emailDocs = description ?~ "A known email with a pending password reset." + phoneDocs = description ?~ "A known phone number with a pending password reset." maybePasswordResetIdentityTargetFromTuple :: (Maybe PasswordResetKey, Maybe Email, Maybe Phone) -> Parser PasswordResetIdentity maybePasswordResetIdentityTargetFromTuple = \case @@ -169,7 +172,13 @@ data PasswordResetIdentity newtype PasswordResetKey = PasswordResetKey {fromPasswordResetKey :: AsciiBase64Url} deriving stock (Eq, Show) - deriving newtype (Schema.ToSchema, FromByteString, ToByteString, FromJSON, ToJSON, Arbitrary) + deriving newtype (ToSchema, FromByteString, ToByteString, A.FromJSON, A.ToJSON, Arbitrary) + +instance ToParamSchema PasswordResetKey where + toParamSchema _ = toParamSchema (Proxy @Text) + +instance FromHttpApiData PasswordResetKey where + parseQueryParam = fmap PasswordResetKey . parseQueryParam -------------------------------------------------------------------------------- -- PasswordResetCode @@ -178,7 +187,7 @@ newtype PasswordResetKey = PasswordResetKey newtype PasswordResetCode = PasswordResetCode {fromPasswordResetCode :: AsciiBase64Url} deriving stock (Eq, Show, Generic) - deriving newtype (Schema.ToSchema, FromByteString, ToByteString, FromJSON, ToJSON) + deriving newtype (ToSchema, FromByteString, ToByteString, A.FromJSON, A.ToJSON) deriving (Arbitrary) via (Ranged 6 1024 AsciiBase64Url) -------------------------------------------------------------------------------- @@ -190,9 +199,20 @@ data PasswordReset = PasswordReset } deriving stock (Eq, Show, Generic) deriving (Arbitrary) via (GenericUniform PasswordReset) + deriving (A.ToJSON, A.FromJSON, S.ToSchema) via Schema PasswordReset + +instance ToSchema PasswordReset where + schema = + objectWithDocModifier "PasswordReset" objectDocs $ + PasswordReset + <$> pwrCode .= fieldWithDocModifier "code" codeDocs schema + <*> pwrPassword .= fieldWithDocModifier "password" pwDocs schema + where + objectDocs :: NamedSwaggerDoc -> NamedSwaggerDoc + objectDocs = description ?~ "Data to complete a password reset" + + codeDocs :: NamedSwaggerDoc -> NamedSwaggerDoc + codeDocs = description ?~ "Password reset code" -instance FromJSON PasswordReset where - parseJSON = withObject "PasswordReset" $ \o -> - PasswordReset - <$> o .: "code" - <*> o .: "password" + pwDocs :: NamedSwaggerDoc -> NamedSwaggerDoc + pwDocs = description ?~ "New password (6 - 1024 characters)" diff --git a/services/brig/src/Brig/API/Public.hs b/services/brig/src/Brig/API/Public.hs index 89bee1dffa1..288366defae 100644 --- a/services/brig/src/Brig/API/Public.hs +++ b/services/brig/src/Brig/API/Public.hs @@ -230,6 +230,7 @@ servantSitemap = userAPI :<|> selfAPI :<|> accountAPI :<|> clientAPI :<|> prekey :<|> Named @"post-activate-send" sendActivationCode :<|> Named @"post-password-reset" beginPasswordReset :<|> Named @"post-password-reset-complete" completePasswordReset + :<|> Named @"post-password-reset-key-deprecated" deprecatedCompletePasswordReset clientAPI :: ServerT ClientAPI (Handler r) clientAPI = @@ -318,15 +319,6 @@ sitemap :: sitemap = do -- /activate, /password-reset ---------------------------------- - post "/password-reset/:key" (continue deprecatedCompletePasswordResetH) $ - accept "application" "json" - .&. capture "key" - .&. jsonRequest @Public.PasswordReset - document "POST" "deprecatedCompletePasswordReset" $ do - Doc.deprecated - Doc.summary "Complete a password reset." - Doc.notes "DEPRECATED: Use 'POST /password-reset/complete'." - -- This endpoint is used to test /i/metrics, when this is servantified, please -- make sure some other endpoint is used to test that routes defined in this -- function are recorded and reported correctly in /i/metrics. @@ -986,18 +978,17 @@ instance ToJSON DeprecatedMatchingResult where "auto-connects" .= ([] :: [()]) ] -deprecatedCompletePasswordResetH :: +deprecatedCompletePasswordReset :: Members '[CodeStore, PasswordResetStore] r => - JSON ::: Public.PasswordResetKey ::: JsonRequest Public.PasswordReset -> - (Handler r) Response -deprecatedCompletePasswordResetH (_ ::: k ::: req) = do - pwr <- parseJsonBody req + Public.PasswordResetKey -> + Public.PasswordReset -> + (Handler r) () +deprecatedCompletePasswordReset k pwr = do API.completePasswordReset (Public.PasswordResetIdentityKey k) (Public.pwrCode pwr) (Public.pwrPassword pwr) !>> pwResetError - pure empty -- Utilities From 74632d706bc9d81519f7dc3380a6625f0a6fec70 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Fri, 23 Sep 2022 11:35:06 +0200 Subject: [PATCH 49/58] Improve libzauth ACL syntax (#2714) This PR replaces the prefix-tree matcher used in libzauth for matching ACL paths with a simple regex-based matcher, which constructs a single regular expression containing all possible paths. This makes it trivial to accept user-provided regular expressions in the ACL language itself. --- changelog.d/5-internal/improve-acl | 1 + libs/libzauth/libzauth-c/Cargo.lock | 42 ++++++++- libs/libzauth/libzauth/Cargo.toml | 4 +- libs/libzauth/libzauth/src/acl.rs | 99 ++++++++++----------- libs/libzauth/libzauth/src/lib.rs | 4 +- libs/libzauth/libzauth/src/matcher.rs | 118 ++++++++++++++++++++++++++ libs/libzauth/libzauth/src/tree.rs | 97 --------------------- nix/pkgs/zauth/default.nix | 2 +- 8 files changed, 214 insertions(+), 153 deletions(-) create mode 100644 changelog.d/5-internal/improve-acl create mode 100644 libs/libzauth/libzauth/src/matcher.rs delete mode 100644 libs/libzauth/libzauth/src/tree.rs diff --git a/changelog.d/5-internal/improve-acl b/changelog.d/5-internal/improve-acl new file mode 100644 index 00000000000..15f0545ef7a --- /dev/null +++ b/changelog.d/5-internal/improve-acl @@ -0,0 +1 @@ +Add regular expression support to libzauth ACL language diff --git a/libs/libzauth/libzauth-c/Cargo.lock b/libs/libzauth/libzauth-c/Cargo.lock index 71636e381b0..7acceb85ae5 100644 --- a/libs/libzauth/libzauth-c/Cargo.lock +++ b/libs/libzauth/libzauth-c/Cargo.lock @@ -2,6 +2,15 @@ # It is not intended for manual editing. version = 3 +[[package]] +name = "aho-corasick" +version = "0.7.19" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "b4f55bd91a0978cbfd91c457a164bab8b4001c833b7f323132c0a4e1922dd44e" +dependencies = [ + "memchr", +] + [[package]] name = "asexp" version = "0.3.2" @@ -23,6 +32,12 @@ dependencies = [ "signature", ] +[[package]] +name = "lazy_static" +version = "1.4.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "e2abad23fbc42b3700f2f279844dc832adb2b2eb069b2df918f455c4e18cc646" + [[package]] name = "libc" version = "0.2.125" @@ -41,12 +56,35 @@ dependencies = [ "walkdir", ] +[[package]] +name = "memchr" +version = "2.5.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "2dffe52ecf27772e601905b7522cb4ef790d2cc203488bbd0e2fe85fcb74566d" + [[package]] name = "pkg-config" version = "0.3.25" source = "registry+https://github.com/rust-lang/crates.io-index" checksum = "1df8c4ec4b0627e53bdf214615ad287367e482558cf84b109250b37464dc03ae" +[[package]] +name = "regex" +version = "1.6.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "4c4eb3267174b8c6c2f654116623910a0fef09c4753f8dd83db29c48a0df988b" +dependencies = [ + "aho-corasick", + "memchr", + "regex-syntax", +] + +[[package]] +name = "regex-syntax" +version = "0.6.27" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "a3f87b73ce11b1619a3c6332f45341e0047173771e8b8b73f87bfeefb7b56244" + [[package]] name = "rustc-serialize" version = "0.3.24" @@ -130,9 +168,11 @@ checksum = "712e227841d057c1ee1cd2fb22fa7e5a5461ae8e48fa2ca79ec42cfc1931183f" [[package]] name = "zauth" -version = "3.0.0" +version = "3.1.0" dependencies = [ "asexp", + "lazy_static", + "regex", "rustc-serialize", "sodiumoxide", ] diff --git a/libs/libzauth/libzauth/Cargo.toml b/libs/libzauth/libzauth/Cargo.toml index bcff7126d8c..34920bd6f2d 100644 --- a/libs/libzauth/libzauth/Cargo.toml +++ b/libs/libzauth/libzauth/Cargo.toml @@ -1,6 +1,6 @@ [package] name = "zauth" -version = "3.0.0" +version = "3.1.0" authors = ["Wire Swiss GmbH "] license = "AGPL-3.0" @@ -11,6 +11,8 @@ name = "zauth" asexp = ">= 0.3" rustc-serialize = ">= 0.3" sodiumoxide = "^0.2.7" +regex = "1.6" +lazy_static = "1.4" [dev-dependencies] clap = ">= 2.0" diff --git a/libs/libzauth/libzauth/src/acl.rs b/libs/libzauth/libzauth/src/acl.rs index a14ab697f52..0920d06602e 100644 --- a/libs/libzauth/libzauth/src/acl.rs +++ b/libs/libzauth/libzauth/src/acl.rs @@ -15,31 +15,34 @@ // You should have received a copy of the GNU Affero General Public License along // with this program. If not, see . -use std::collections::HashMap; use asexp::Sexp; -use tree::Tree; +use matcher::{Item, Matcher}; +use std::collections::HashMap; #[derive(Debug, Clone)] pub enum Error { - Parse(&'static str) + Parse(&'static str), } pub type AclResult = Result; #[derive(Debug, Clone)] pub struct Acl { - acl: HashMap + acl: HashMap, } impl Acl { pub fn new() -> Acl { - Acl { acl: HashMap::new() } + Acl { + acl: HashMap::new(), + } } pub fn from_str(s: &str) -> AclResult { - match Sexp::parse_toplevel(s) { - Err(()) => Err(Error::Parse("invalid s-expressions")), - Ok(sexp) => Acl::from_sexp(&sexp) + let sexp = Sexp::parse_toplevel(s); + match sexp { + Err(()) => Err(Error::Parse("invalid s-expressions")), + Ok(sexp) => Acl::from_sexp(&sexp), } } @@ -51,31 +54,30 @@ impl Acl { if let Some(k) = key.get_str().map(String::from) { acl.insert(k, List::from_sexp(&list)?); } else { - return Err(Error::Parse("not a string")) + return Err(Error::Parse("not a string")); } } Ok(Acl { acl }) } - _ => Err(Error::Parse("expected key and values")) + _ => Err(Error::Parse("expected key and values")), } } pub fn allowed(&self, key: &str, path: &str) -> bool { - self.acl.get(key).map(|list| { - match *list { - List::Black(Some(ref t)) => !t.contains(path), - List::Black(None) => true, - List::White(Some(ref t)) => t.contains(path), - List::White(None) => false - } - }).unwrap_or(false) + self.acl + .get(key) + .map(|list| match *list { + List::Black(ref t) => !t.contains(path), + List::White(ref t) => t.contains(path), + }) + .unwrap_or(false) } } #[derive(Debug, Clone)] enum List { - Black(Option), - White(Option) + Black(Matcher), + White(Matcher), } impl List { @@ -83,50 +85,38 @@ impl List { let items = match *s { Sexp::Tuple(ref a) => a.as_slice(), Sexp::Array(ref a) => a.as_slice(), - _ => return Err(Error::Parse("s-expr not a list")) + _ => return Err(Error::Parse("s-expr not a list")), }; if items.is_empty() { - return Err(Error::Parse("list is empty")) + return Err(Error::Parse("list is empty")); } match items[0].get_str() { - Some("blacklist") => List::items(&items[1 ..]).map(List::Black), - Some("whitelist") => List::items(&items[1 ..]).map(List::White), - _ => Err(Error::Parse("'blacklist' or 'whitelist' expected")) + Some("blacklist") => List::items(&items[1..]).map(List::Black), + Some("whitelist") => List::items(&items[1..]).map(List::White), + _ => Err(Error::Parse("'blacklist' or 'whitelist' expected")), } } - fn items(xs: &[Sexp]) -> AclResult> { - match xs.len() { - 0 => Ok(None), - 1 if List::is_unit(&xs[0]) => Ok(None), - _ => { - let mut t = Tree::new(); - for x in xs { - t.add(&List::read_path(x)?) - } - Ok(Some(t)) - } - } + fn items(xs: &[Sexp]) -> AclResult { + let items: AclResult> = xs.iter().map(List::read_path).collect(); + let m = Matcher::new(&items?); + Ok(m) } - fn is_unit(s: &Sexp) -> bool { - match *s { - Sexp::Tuple(ref a) if a.is_empty() => true, - _ => false - } - } - - fn read_path(s: &Sexp) -> AclResult { + fn read_path(s: &Sexp) -> AclResult { match *s { Sexp::Tuple(ref a) | Sexp::Array(ref a) if a.len() == 2 => { match (a[0].get_str(), a[1].get_str()) { - (Some("path"), Some(x)) => Ok(String::from(x)), - _ => Err(Error::Parse("'path' not found")) + (Some("path"), Some(x)) => Ok(Item::Str(String::from(x))), + (Some("regex"), Some(x)) => { + Ok(Item::Regex(String::from(x))) + } + _ => Err(Error::Parse("'path' not found")), } } - _ => return Err(Error::Parse("s-expr not a list")) + _ => return Err(Error::Parse("s-expr not a list")), } } } @@ -144,14 +134,15 @@ mod tests { (path "/a/**")) b (whitelist (path "/conversation/message") - (path "/foo/bar/*")) + (path "/foo/bar/*") + (regex "(/v[0-9]+)?/foo/baz/[^/]+")) # this is a comment that should not lead to a parse failure. la (whitelist (path "/legalhold/**")) - x (blacklist ()) + x (blacklist) - y (whitelist ()) + y (whitelist) "#; #[test] @@ -165,8 +156,12 @@ mod tests { assert!(!acl.allowed("u", "/x/here/z")); assert!(acl.allowed("u", "/x/here/z/x")); assert!(acl.allowed("b", "/conversation/message")); - assert!(acl.allowed("b", "/foo/bar/baz")); + assert!(acl.allowed("b", "/foo/bar/quux")); + assert!(!acl.allowed("b", "/foo/bar/")); + assert!(acl.allowed("b", "/foo/baz/quux")); assert!(!acl.allowed("b", "/foo/bar/")); + assert!(acl.allowed("b", "/v97/foo/baz/quux")); + assert!(!acl.allowed("b", "/voo/foo/baz/quux")); assert!(!acl.allowed("b", "/anywhere/else/")); assert!(acl.allowed("x", "/everywhere")); assert!(acl.allowed("x", "/")); diff --git a/libs/libzauth/libzauth/src/lib.rs b/libs/libzauth/libzauth/src/lib.rs index 192fa31b6f9..7aed0ff3713 100644 --- a/libs/libzauth/libzauth/src/lib.rs +++ b/libs/libzauth/libzauth/src/lib.rs @@ -16,6 +16,8 @@ // with this program. If not, see . extern crate asexp; +extern crate lazy_static; +extern crate regex; extern crate rustc_serialize; extern crate sodiumoxide; @@ -23,7 +25,7 @@ pub mod acl; pub mod error; pub mod zauth; -mod tree; +mod matcher; pub use acl::Acl; pub use error::Error; diff --git a/libs/libzauth/libzauth/src/matcher.rs b/libs/libzauth/libzauth/src/matcher.rs new file mode 100644 index 00000000000..622ba8be989 --- /dev/null +++ b/libs/libzauth/libzauth/src/matcher.rs @@ -0,0 +1,118 @@ +// 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 . + +use lazy_static::lazy_static; +use regex::Regex; + +pub enum Item { + Str(String), + Regex(String), +} + +#[derive(Debug, Clone)] +pub struct Matcher { + regex: Option, +} + +lazy_static! { + static ref SLASHES: Regex = Regex::new("/+").unwrap(); + static ref DOUBLE_STAR_PATTERN: Regex = Regex::new(r#"\\\*\\\*"#).unwrap(); + static ref STAR_PATTERN: Regex = Regex::new(r#"\\\*"#).unwrap(); +} + +impl Matcher { + pub fn new(items: &Vec) -> Self { + if items.len() == 0 { + return Self { regex: None }; + } + + let items = items + .iter() + .map(|item| match item { + Item::Str(item) => { + let item = SLASHES.replace_all(item, "/"); + let item = item.trim_end_matches("/"); + let pattern = regex::escape(item); + let pattern = + DOUBLE_STAR_PATTERN.replace_all(&pattern, ".*"); + let pattern = STAR_PATTERN.replace_all(&pattern, "[^/]+"); + + let mut text = String::new(); + text.push_str("("); + text.push_str(&pattern); + text.push_str(")"); + text + } + Item::Regex(r) => r.clone(), + }) + .collect::>(); + + let mut pattern = String::new(); + pattern.push_str("^("); + pattern.push_str(&items.join("|")); + pattern.push_str(")$"); + Self { + regex: Some(Regex::new(&pattern).unwrap()), + } + } + + pub fn contains(&self, s: &str) -> bool { + match &self.regex { + None => false, + Some(r) => { + let s = SLASHES.replace_all(s, "/"); + let s = s.trim_end_matches("/"); + r.is_match(&s) + } + } + } +} + +// Tests //////////////////////////////////////////////////////////////////// + +#[cfg(test)] +mod tests { + use super::*; + + #[test] + fn test() { + let mut items = Vec::new(); + items.push(Item::Str("/foo".to_string())); + items.push(Item::Str("/foo/bar/baz".to_string())); + items.push(Item::Str("/x/y/".to_string())); + items.push(Item::Str("/i/**".to_string())); + items.push(Item::Str("/j/*".to_string())); + items.push(Item::Str("/k/v*".to_string())); + items.push(Item::Str("/a//c".to_string())); + items.push(Item::Regex("(/v[0-9]+)?/notifications".to_string())); + let t = Matcher::new(&items); + + assert!(t.contains("/foo")); + assert!(t.contains("/foo/bar/baz")); + assert!(t.contains("/x/y")); + assert!(!t.contains("/foo/bar")); + assert!(t.contains("/a/c")); + assert!(!t.contains("/a")); + assert!(t.contains("/i/foo")); + assert!(t.contains("/i/foo/zoo")); + assert!(t.contains("/j/foo")); + assert!(!t.contains("/j/foo/zoo")); + assert!(t.contains("/notifications")); + assert!(t.contains("/v33/notifications")); + assert!(!t.contains("/versions/notifications")); + } +} diff --git a/libs/libzauth/libzauth/src/tree.rs b/libs/libzauth/libzauth/src/tree.rs deleted file mode 100644 index 2a55075e0fa..00000000000 --- a/libs/libzauth/libzauth/src/tree.rs +++ /dev/null @@ -1,97 +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 . - -//! Internal module to provide efficient lookup trees for paths. -//! Actually a port of wai-zauth's Network.Wai.Zauth.Tree with -//! the addtional support for "deep wildcards" (specified with "**"). - -use std::collections::HashMap; -use std::collections::hash_map::Entry; - -#[derive(Debug, Clone)] -pub struct Tree { - end_marker: bool, - subtree: HashMap -} - -impl Tree { - pub fn new() -> Tree { - Tree { - end_marker: false, - subtree: HashMap::new() - } - } - - pub fn add(&mut self, s: &str) { - add_parts(self, s.split('/').filter(|s| !s.is_empty())) - } - - pub fn contains(&self, s: &str) -> bool { - let mut tree = self; - for p in s.split('/').filter(|s| !s.is_empty()) { - match tree.subtree.get(p).or_else(|| tree.subtree.get("*")) { - None => return tree.subtree.get("**").is_some(), - Some(t) => tree = t - } - } - tree.end_marker - } -} - -fn add_parts<'a, I>(tree: &mut Tree, mut s: I) - where I: Iterator { - match s.next() { - None => tree.end_marker = true, - Some(p) => { - let next = - match tree.subtree.entry(String::from(p)) { - Entry::Vacant(e) => e.insert(Tree::new()), - Entry::Occupied(e) => e.into_mut() - }; - add_parts(next, s) - } - } -} - -// Tests //////////////////////////////////////////////////////////////////// - -#[cfg(test)] -mod tests { - use super::*; - - #[test] - fn test() { - let mut t = Tree::new(); - t.add("/foo"); - t.add("/foo/bar/baz"); - t.add("/x/y/"); - t.add("/i/**"); - t.add("/j/*"); - t.add("/a//c"); - - assert!(t.contains("/foo")); - assert!(t.contains("/foo/bar/baz")); - assert!(t.contains("/x/y")); - assert!(!t.contains("/foo/bar")); - assert!(t.contains("/a/c")); - assert!(!t.contains("/a")); - assert!(t.contains("/i/foo")); - assert!(t.contains("/i/foo/zoo")); - assert!(t.contains("/j/foo")); - assert!(!t.contains("/j/foo/zoo")); - } -} diff --git a/nix/pkgs/zauth/default.nix b/nix/pkgs/zauth/default.nix index 1f256b7c9ea..5ae2d991a6d 100644 --- a/nix/pkgs/zauth/default.nix +++ b/nix/pkgs/zauth/default.nix @@ -15,7 +15,7 @@ rustPlatform.buildRustPackage rec { src = nix-gitignore.gitignoreSourcePure [ ../../../.gitignore ] ../../../libs/libzauth; sourceRoot = "libzauth/libzauth-c"; - cargoSha256 = "0p81bjbwchq8v0ybvx8r1xcxsah7fjdq2fc2dy4l4k2v18hi9z91"; + cargoSha256 = "sha256-od+O5dhAVC1KhDUz8U2fhjyqjXkqHjeEEhvVE0N9orI="; patchLibs = lib.optionalString stdenv.isDarwin '' install_name_tool -id $out/lib/libzauth.dylib $out/lib/libzauth.dylib From 363ffa45d4b926cf6de041ac4c66c08290e61b91 Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Fri, 23 Sep 2022 12:57:13 +0200 Subject: [PATCH 50/58] [SQSERVICES-1643] Servantify brig account API 8 - `POST /onboading/v3` (#2707) --- changelog.d/5-internal/pr-2699 | 1 - changelog.d/5-internal/pr-2700 | 1 - changelog.d/5-internal/pr-2701 | 1 - changelog.d/5-internal/pr-2702 | 1 - changelog.d/5-internal/pr-2703 | 1 - changelog.d/5-internal/pr-2704 | 1 - changelog.d/5-internal/pr-2705 | 1 - changelog.d/5-internal/pr-2707 | 1 + .../src/Wire/API/Routes/Public/Brig.hs | 34 +++++++++++++++++- services/brig/src/Brig/API/Public.hs | 35 +++---------------- services/brig/src/Brig/User/API/Auth.hs | 4 +++ services/brig/test/integration/API/Metrics.hs | 14 ++++---- 12 files changed, 49 insertions(+), 46 deletions(-) delete mode 100644 changelog.d/5-internal/pr-2699 delete mode 100644 changelog.d/5-internal/pr-2700 delete mode 100644 changelog.d/5-internal/pr-2701 delete mode 100644 changelog.d/5-internal/pr-2702 delete mode 100644 changelog.d/5-internal/pr-2703 delete mode 100644 changelog.d/5-internal/pr-2704 delete mode 100644 changelog.d/5-internal/pr-2705 create mode 100644 changelog.d/5-internal/pr-2707 diff --git a/changelog.d/5-internal/pr-2699 b/changelog.d/5-internal/pr-2699 deleted file mode 100644 index 69a92c3128e..00000000000 --- a/changelog.d/5-internal/pr-2699 +++ /dev/null @@ -1 +0,0 @@ -The `POST /delete` endpoint of the account API is now migrated to servant diff --git a/changelog.d/5-internal/pr-2700 b/changelog.d/5-internal/pr-2700 deleted file mode 100644 index 1280aee9c59..00000000000 --- a/changelog.d/5-internal/pr-2700 +++ /dev/null @@ -1 +0,0 @@ -The `GET /activate` endpoint of the account API is now migrated to servant diff --git a/changelog.d/5-internal/pr-2701 b/changelog.d/5-internal/pr-2701 deleted file mode 100644 index 11cb76339c4..00000000000 --- a/changelog.d/5-internal/pr-2701 +++ /dev/null @@ -1 +0,0 @@ -The `POST /activate` endpoint of the account API is now migrated to servant diff --git a/changelog.d/5-internal/pr-2702 b/changelog.d/5-internal/pr-2702 deleted file mode 100644 index 110b73f20fe..00000000000 --- a/changelog.d/5-internal/pr-2702 +++ /dev/null @@ -1 +0,0 @@ -The `POST /activate/send` endpoint of the account API is now migrated to servant diff --git a/changelog.d/5-internal/pr-2703 b/changelog.d/5-internal/pr-2703 deleted file mode 100644 index 95c71d8d482..00000000000 --- a/changelog.d/5-internal/pr-2703 +++ /dev/null @@ -1 +0,0 @@ -The `POST /password-reset` endpoint of the account API is now migrated to servant diff --git a/changelog.d/5-internal/pr-2704 b/changelog.d/5-internal/pr-2704 deleted file mode 100644 index 8e186d7d972..00000000000 --- a/changelog.d/5-internal/pr-2704 +++ /dev/null @@ -1 +0,0 @@ -The `POST /password-reset/complete` endpoint of the account API is now migrated to servant diff --git a/changelog.d/5-internal/pr-2705 b/changelog.d/5-internal/pr-2705 deleted file mode 100644 index 25a250df03f..00000000000 --- a/changelog.d/5-internal/pr-2705 +++ /dev/null @@ -1 +0,0 @@ -The `POST /password-reset/:key` endpoint of the account API is now migrated to servant diff --git a/changelog.d/5-internal/pr-2707 b/changelog.d/5-internal/pr-2707 new file mode 100644 index 00000000000..c6c26155174 --- /dev/null +++ b/changelog.d/5-internal/pr-2707 @@ -0,0 +1 @@ +The account API is now migrated to servant. (#2699, #2700, #2701, #2702, #2703, #2704, #2705, #2707) diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs index ccde347eec4..e75deb517a9 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs @@ -19,6 +19,7 @@ module Wire.API.Routes.Public.Brig where +import qualified Data.Aeson as A (FromJSON, ToJSON, Value) import Data.ByteString.Conversion import Data.Code (Timeout) import Data.CommaSeparatedList (CommaSeparatedList) @@ -30,7 +31,9 @@ import Data.Nonce (Nonce) import Data.Qualified (Qualified (..)) import Data.Range import Data.SOP -import Data.Swagger hiding (Contact, Header) +import Data.Schema as Schema +import Data.Swagger hiding (Contact, Header, Schema, ToSchema) +import qualified Data.Swagger as S import qualified Generics.SOP as GSOP import Imports hiding (head) import Servant (JSON) @@ -489,6 +492,35 @@ type AccountAPI = :> ReqBody '[JSON] PasswordReset :> MultiVerb 'POST '[JSON] '[RespondEmpty 200 "Password reset successful."] () ) + :<|> Named + "onboarding" + ( Summary "Upload contacts and invoke matching." + :> Description + "DEPRECATED: the feature has been turned off, the end-point does \ + \nothing and always returns '{\"results\":[],\"auto-connects\":[]}'." + :> ZUser + :> "onboarding" + :> "v3" + :> ReqBody '[JSON] JsonValue + :> Post '[JSON] DeprecatedMatchingResult + ) + +newtype JsonValue = JsonValue {fromJsonValue :: A.Value} + deriving (A.ToJSON, A.FromJSON, S.ToSchema) via (Schema JsonValue) + +instance ToSchema JsonValue where + schema = fromJsonValue .= (JsonValue <$> named "Body" jsonValue) + +data DeprecatedMatchingResult = DeprecatedMatchingResult + deriving (A.ToJSON, A.FromJSON, S.ToSchema) via (Schema DeprecatedMatchingResult) + +instance ToSchema DeprecatedMatchingResult where + schema = + object + "DeprecatedMatchingResult" + $ DeprecatedMatchingResult + <$ const [] .= field "results" (array (null_ @SwaggerDoc)) + <* const [] .= field "auto-connects" (array (null_ @SwaggerDoc)) data ActivationRespWithStatus = ActivationResp ActivationResponse diff --git a/services/brig/src/Brig/API/Public.hs b/services/brig/src/Brig/API/Public.hs index 288366defae..b6eb96598c8 100644 --- a/services/brig/src/Brig/API/Public.hs +++ b/services/brig/src/Brig/API/Public.hs @@ -95,12 +95,10 @@ import qualified Data.ZAuth.Token as ZAuth import FileEmbedLzma import Galley.Types.Teams (HiddenPerm (..), hasPermission) import Imports hiding (head) -import Network.Wai import Network.Wai.Predicate hiding (result, setStatus) import Network.Wai.Routing import Network.Wai.Utilities as Utilities -import Network.Wai.Utilities.Swagger (document, mkSwaggerApi) -import Network.Wai.Utilities.ZAuth (zauthUserId) +import Network.Wai.Utilities.Swagger (mkSwaggerApi) import Polysemy import Servant hiding (Handler, JSON, addHeader, respond) import qualified Servant @@ -231,6 +229,7 @@ servantSitemap = userAPI :<|> selfAPI :<|> accountAPI :<|> clientAPI :<|> prekey :<|> Named @"post-password-reset" beginPasswordReset :<|> Named @"post-password-reset-complete" completePasswordReset :<|> Named @"post-password-reset-key-deprecated" deprecatedCompletePasswordReset + :<|> Named @"onboarding" deprecatedOnboarding clientAPI :: ServerT ClientAPI (Handler r) clientAPI = @@ -317,23 +316,6 @@ sitemap :: r => Routes Doc.ApiBuilder (Handler r) () sitemap = do - -- /activate, /password-reset ---------------------------------- - - -- This endpoint is used to test /i/metrics, when this is servantified, please - -- make sure some other endpoint is used to test that routes defined in this - -- function are recorded and reported correctly in /i/metrics. - -- see test/integration/API/Metrics.hs - post "/onboarding/v3" (continue deprecatedOnboardingH) $ - accept "application" "json" - .&. zauthUserId - .&. jsonRequest @Value - document "POST" "onboardingV3" $ do - Doc.deprecated - Doc.summary "Upload contacts and invoke matching." - Doc.notes - "DEPRECATED: the feature has been turned off, the end-point does \ - \nothing and always returns '{\"results\":[],\"auto-connects\":[]}'." - Provider.routesPublic Auth.routesPublic Team.routesPublic @@ -966,17 +948,8 @@ sendVerificationCode req = do -- Deprecated -deprecatedOnboardingH :: JSON ::: UserId ::: JsonRequest Value -> (Handler r) Response -deprecatedOnboardingH (_ ::: _ ::: _) = pure $ json DeprecatedMatchingResult - -data DeprecatedMatchingResult = DeprecatedMatchingResult - -instance ToJSON DeprecatedMatchingResult where - toJSON DeprecatedMatchingResult = - object - [ "results" .= ([] :: [()]), - "auto-connects" .= ([] :: [()]) - ] +deprecatedOnboarding :: UserId -> JsonValue -> (Handler r) DeprecatedMatchingResult +deprecatedOnboarding _ _ = pure DeprecatedMatchingResult deprecatedCompletePasswordReset :: Members '[CodeStore, PasswordResetStore] r => diff --git a/services/brig/src/Brig/User/API/Auth.hs b/services/brig/src/Brig/User/API/Auth.hs index a528297b1b2..2ea7a8d86ff 100644 --- a/services/brig/src/Brig/User/API/Auth.hs +++ b/services/brig/src/Brig/User/API/Auth.hs @@ -110,6 +110,10 @@ routesPublic = do Doc.errorResponse passwordExists Doc.errorResponse' loginCodePending Doc.pendingLoginError + -- This endpoint is used to test /i/metrics, when this is servantified, please + -- make sure some other wai-route endpoint is used to test that routes defined in + -- this function ('Brig.API.Public.sitemap') are recorded and reported correctly in /i/metrics. + -- see test/integration/API/Metrics.hs post "/login" (continue loginH) $ jsonRequest @Public.Login .&. def False (query "persist") diff --git a/services/brig/test/integration/API/Metrics.hs b/services/brig/test/integration/API/Metrics.hs index b705d2e522f..a1679dc12af 100644 --- a/services/brig/test/integration/API/Metrics.hs +++ b/services/brig/test/integration/API/Metrics.hs @@ -54,23 +54,23 @@ testMetricsEndpoint :: Brig -> Http () testMetricsEndpoint brig = do let p1 = "/self" p2 uid = "/users/" <> uid <> "/clients" - p3 = "/onboarding/v3" + p3 = "/login" beforeSelf <- getCount "/self" "GET" beforeClients <- getCount "/users/:uid/clients" "GET" - beforeProperties <- getCount "/onboarding/v3" "POST" - uid <- userId <$> randomUser brig + beforeProperties <- getCount "/login" "POST" + (uid, Just email) <- (\u -> (userId u, userEmail u)) <$> randomUser brig uid' <- userId <$> randomUser brig _ <- get (brig . path p1 . zAuthAccess uid "conn" . expect2xx) _ <- get (brig . path (p2 $ toByteString' uid) . zAuthAccess uid "conn" . expect2xx) _ <- get (brig . path (p2 $ toByteString' uid') . zAuthAccess uid "conn" . expect2xx) - _ <- post (brig . path p3 . zAuthAccess uid "conn" . json 'x' . expect2xx) - _ <- post (brig . path p3 . zAuthAccess uid "conn" . json 'x' . expect2xx) + _ <- post (brig . path p3 . contentJson . queryItem "persist" "true" . json (defEmailLogin email) . expect2xx) + _ <- post (brig . path p3 . contentJson . queryItem "persist" "true" . json (defEmailLogin email) . expect2xx) countSelf <- getCount "/self" "GET" liftIO $ assertEqual "/self was called once" (beforeSelf + 1) countSelf countClients <- getCount "/users/:uid/clients" "GET" liftIO $ assertEqual "/users/:uid/clients was called twice" (beforeClients + 2) countClients - countProperties <- getCount "/onboarding/v3" "POST" - liftIO $ assertEqual "/onboarding/v3 was called twice" (beforeProperties + 2) countProperties + countProperties <- getCount "/login" "POST" + liftIO $ assertEqual "/login was called twice" (beforeProperties + 2) countProperties where getCount endpoint m = do rsp <- responseBody <$> get (brig . path "i/metrics") From e6ed1e673800cf19f1f61cce7eacb3692f061398 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Mon, 26 Sep 2022 09:35:43 +0200 Subject: [PATCH 51/58] Update nginz and cannon ACLs to match api-versioned paths (#2725) * Update nginz whitelists and blacklists * Update cannon zauth.acl * Add changelog entry Co-authored-by: Stefan Matting --- changelog.d/5-internal/pr-2725 | 1 + charts/cannon/conf/static/zauth.acl | 18 +----------------- charts/nginz/static/conf/zauth.acl | 23 +++++++++-------------- 3 files changed, 11 insertions(+), 31 deletions(-) create mode 100644 changelog.d/5-internal/pr-2725 diff --git a/changelog.d/5-internal/pr-2725 b/changelog.d/5-internal/pr-2725 new file mode 100644 index 00000000000..8945a4600fd --- /dev/null +++ b/changelog.d/5-internal/pr-2725 @@ -0,0 +1 @@ +Update nginz and cannon ACLs to match api-versioned paths diff --git a/charts/cannon/conf/static/zauth.acl b/charts/cannon/conf/static/zauth.acl index 9498b8cc43f..8e6d629346e 100644 --- a/charts/cannon/conf/static/zauth.acl +++ b/charts/cannon/conf/static/zauth.acl @@ -1,17 +1 @@ -a (blacklist (path "/provider") - (path "/provider/**") - (path "/bot") - (path "/bot/**") - (path "/i/**")) - -b (whitelist (path "/bot") - (path "/bot/**")) - -p (whitelist (path "/provider") - (path "/provider/**")) - -# LegalHold Access Tokens -la (whitelist (path "/notifications") - (path "/assets/v3/**") - (path "/users") - (path "/users/**")) +a (whitelist (regex "/await")) diff --git a/charts/nginz/static/conf/zauth.acl b/charts/nginz/static/conf/zauth.acl index 3fe4d179e1a..5de1ce5aa19 100644 --- a/charts/nginz/static/conf/zauth.acl +++ b/charts/nginz/static/conf/zauth.acl @@ -1,18 +1,13 @@ -a (blacklist (path "/provider") - (path "/provider/**") - (path "/bot") - (path "/bot/**") - (path "/i/**")) +a (blacklist (regex "(/v[0-9]+)?/provider(/.*)?") + (regex "(/v[0-9]+)?/bot(/.*)?") + (regex "(/v[0-9]+)?/i/.*")) -b (whitelist (path "/bot") - (path "/bot/**")) +b (whitelist (regex "(/v[0-9]+)?/bot(/.*)?")) -p (whitelist (path "/provider") - (path "/provider/**")) +p (whitelist (regex "(/v[0-9]+)?/provider(/.*)?")) # LegalHold Access Tokens -la (whitelist (path "/notifications") - (path "/assets/v3/**") - (path "/users") - (path "/users/**") - (path "/legalhold/conversations/*")) +la (whitelist (regex "(/v[0-9]+)?/notifications") + (regex "(/v[0-9]+)?/assets/v3/.*") + (regex "(/v[0-9]+)?/users(/.*)?") + (regex "(/v[0-9]+)?/legalhold/conversations/[^/]+")) From 3bea3bb0b8636cf963e1b7c1cb647583eeb1a56c Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Mon, 26 Sep 2022 09:36:06 +0200 Subject: [PATCH 52/58] Restore previous behaviour of kicking (#2724) After #2667, when users are kicked out of a conversation, the events being sent out would look like normal leave events. This commit restores the previous behaviour: the events reflect the fact that the user was kicked out, with the originating user set to the user who caused the change that required users to be removed. --- changelog.d/1-api-changes/backend-removal-fix | 1 + services/galley/src/Galley/API/Action.hs | 67 +++++++++++++------ services/galley/test/integration/API.hs | 41 ++++++------ 3 files changed, 69 insertions(+), 40 deletions(-) create mode 100644 changelog.d/1-api-changes/backend-removal-fix diff --git a/changelog.d/1-api-changes/backend-removal-fix b/changelog.d/1-api-changes/backend-removal-fix new file mode 100644 index 00000000000..e855500394a --- /dev/null +++ b/changelog.d/1-api-changes/backend-removal-fix @@ -0,0 +1 @@ +Users being kicked out results in member-leave events originating from the user who caused the change in the conversation diff --git a/services/galley/src/Galley/API/Action.hs b/services/galley/src/Galley/API/Action.hs index d7e3ad707eb..dcae8353e87 100644 --- a/services/galley/src/Galley/API/Action.hs +++ b/services/galley/src/Galley/API/Action.hs @@ -340,7 +340,7 @@ performAction tag origUser lconv action = do E.setConversationReceiptMode (tUnqualified lcnv) (cruReceiptMode action) pure (mempty, action) SConversationAccessDataTag -> do - (bm, act) <- performConversationAccessData lconv action + (bm, act) <- performConversationAccessData origUser lconv action pure (bm, act) performConversationJoin :: @@ -457,14 +457,11 @@ performConversationJoin qusr lconv (ConversationJoin invited role) = do then do for_ convUsersLHStatus $ \(mem, status) -> when (consentGiven status == ConsentNotGiven) $ do - let lvictim = qualifyAs lconv (lmId mem) - void . runError @NoChanges $ - updateLocalConversation - @'ConversationLeaveTag - (fmap convId lconv) - (qUntagged lvictim) - Nothing - () + kickMember + qusr + lconv + (convBotsAndMembers (tUnqualified lconv)) + (qUntagged (qualifyAs lconv (lmId mem))) else throwS @'MissingLegalholdConsent checkLHPolicyConflictsRemote :: @@ -474,10 +471,11 @@ performConversationJoin qusr lconv (ConversationJoin invited role) = do performConversationAccessData :: (HasConversationActionEffects 'ConversationAccessDataTag r) => + Qualified UserId -> Local Conversation -> ConversationAccessData -> Sem r (BotsAndMembers, ConversationAccessData) -performConversationAccessData lconv action = do +performConversationAccessData qusr lconv action = do when (convAccessData conv == action) noChanges -- Remove conversation codes if CodeAccess is revoked when @@ -506,16 +504,8 @@ performConversationAccessData lconv action = do let bmToNotify = current {bmBots = bmBots desired} -- Remove users and notify everyone - for_ (bmQualifiedMembers lcnv toRemove) $ \userToRemove -> do - (extraTargets, action') <- performAction SConversationLeaveTag userToRemove lconv () - notifyConversationAction - (sing @'ConversationLeaveTag) - userToRemove - True - Nothing - lconv - (bmToNotify <> extraTargets) - action' + for_ (bmQualifiedMembers lcnv toRemove) $ + kickMember qusr lconv bmToNotify pure (mempty, action) where @@ -792,3 +782,40 @@ notifyRemoteConversationAction loc rconvUpdate con = do let bots = [] pushConversationEvent con event localPresentUsers bots $> event + +-- | Kick a user from a conversation and send notifications. +-- +-- This function removes the given victim from the conversation by making them +-- 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 + ) => + Qualified UserId -> + Local Conversation -> + BotsAndMembers -> + Qualified UserId -> + Sem r () +kickMember qusr lconv targets victim = void . runError @NoChanges $ do + (extraTargets, _) <- + performAction + SConversationLeaveTag + victim + lconv + () + notifyConversationAction + (sing @'ConversationRemoveMembersTag) + qusr + True + Nothing + lconv + (targets <> extraTargets) + (pure victim) diff --git a/services/galley/test/integration/API.hs b/services/galley/test/integration/API.hs index 7ecd707a9f0..19c775fc400 100644 --- a/services/galley/test/integration/API.hs +++ b/services/galley/test/integration/API.hs @@ -1483,9 +1483,9 @@ postConvertTeamConv = do -- non-team members get kicked out liftIO $ do WS.assertMatchN_ (5 # Second) [wsA, wsB, wsE, wsM] $ - wsAssertMemberLeave qconv qeve (pure qeve) + wsAssertMemberLeave qconv qalice (pure qeve) WS.assertMatchN_ (5 # Second) [wsA, wsB, wsE, wsM] $ - wsAssertMemberLeave qconv qmallory (pure qmallory) + wsAssertMemberLeave qconv qalice (pure qmallory) -- joining (for mallory) is no longer possible postJoinCodeConv mallory j !!! const 403 === statusCode -- team members (dave) can still join @@ -1537,14 +1537,17 @@ testAccessUpdateGuestRemoved = do -- note that removing users happens asynchronously, so this check should -- happen while the mock federator is still available WS.assertMatchN_ (5 # Second) [wsA, wsB, wsC] $ - wsAssertMembersLeave (cnvQualifiedId conv) charlie [charlie] + wsAssertMembersLeave (cnvQualifiedId conv) alice [charlie] WS.assertMatchN_ (5 # Second) [wsA, wsB, wsC] $ - wsAssertMembersLeave (cnvQualifiedId conv) dee [dee] + wsAssertMembersLeave (cnvQualifiedId conv) alice [dee] -- dee's remote receives a notification + let compareLists [] ys = [] @?= ys + compareLists (x : xs) ys = case break (== x) ys of + (ys1, _ : ys2) -> compareLists xs (ys1 <> ys2) + _ -> assertFailure $ "Could not find " <> show x <> " in " <> show ys liftIO $ - sortOn - (fmap fst) + compareLists ( map ( \fr -> do cu <- eitherDecode (frBody fr) @@ -1558,20 +1561,18 @@ testAccessUpdateGuestRemoved = do reqs ) ) - @?= sortOn - (fmap fst) - [ Right (charlie, SomeConversationAction (sing @'ConversationLeaveTag) ()), - Right (dee, SomeConversationAction (sing @'ConversationLeaveTag) ()), - Right - ( alice, - SomeConversationAction - (sing @'ConversationAccessDataTag) - ConversationAccessData - { cupAccess = mempty, - cupAccessRoles = Set.fromList [TeamMemberAccessRole] - } - ) - ] + [ Right (alice, SomeConversationAction (sing @'ConversationRemoveMembersTag) (pure charlie)), + Right (alice, SomeConversationAction (sing @'ConversationRemoveMembersTag) (pure dee)), + Right + ( alice, + SomeConversationAction + (sing @'ConversationAccessDataTag) + ConversationAccessData + { cupAccess = mempty, + cupAccessRoles = Set.fromList [TeamMemberAccessRole] + } + ) + ] -- only alice and bob remain conv2 <- From 4d039230c5841795ad5688f0b00b148c1be40568 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Vedran=20Ivankovi=C4=87?= <33936733+Veki301@users.noreply.github.com> Date: Mon, 26 Sep 2022 11:41:37 +0200 Subject: [PATCH 53/58] JCT-147: update SCIM documentation how to deactivate user (#2720) Co-authored-by: fisx --- changelog.d/4-docs/pr-2720 | 1 + docs/src/understand/single-sign-on/main.rst | 4 ++++ 2 files changed, 5 insertions(+) create mode 100644 changelog.d/4-docs/pr-2720 diff --git a/changelog.d/4-docs/pr-2720 b/changelog.d/4-docs/pr-2720 new file mode 100644 index 00000000000..c84bb55c031 --- /dev/null +++ b/changelog.d/4-docs/pr-2720 @@ -0,0 +1 @@ +Document user deactivation (aka suspension) with SCIM. \ No newline at end of file diff --git a/docs/src/understand/single-sign-on/main.rst b/docs/src/understand/single-sign-on/main.rst index acfe8ff3135..e12c4c69a00 100644 --- a/docs/src/understand/single-sign-on/main.rst +++ b/docs/src/understand/single-sign-on/main.rst @@ -546,6 +546,10 @@ For each put request, you need to provide the full json object. All omitted fie -d "$SCIM_USER" \ $WIRE_BACKEND/scim/v2/Users/$STORED_USER_ID +**Deactivate user** + +It is possible to temporarily deactivate an user (and reactivate him later) by setting his ``active`` property to ``true/false`` without affecting his device history. (`active=false` changes the wire user status to `suspended`.) + **Delete user** .. code-block:: bash From 1414c0720140943bfb85801a65363b10c9d41243 Mon Sep 17 00:00:00 2001 From: Stefan Matting Date: Mon, 26 Sep 2022 13:57:32 +0200 Subject: [PATCH 54/58] Allow /conversations/ paths for legalhold tokens (#2726) --- changelog.d/5-internal/acl-legalhold-tokens | 1 + charts/nginz/static/conf/zauth.acl | 4 ++- deploy/services-demo/conf/nginz/zauth_acl.txt | 25 ++++++++----------- .../brig/test/integration/API/User/Auth.hs | 2 ++ 4 files changed, 17 insertions(+), 15 deletions(-) create mode 100644 changelog.d/5-internal/acl-legalhold-tokens diff --git a/changelog.d/5-internal/acl-legalhold-tokens b/changelog.d/5-internal/acl-legalhold-tokens new file mode 100644 index 00000000000..ce4c2fe5d54 --- /dev/null +++ b/changelog.d/5-internal/acl-legalhold-tokens @@ -0,0 +1 @@ +Allow legalhold tokens access to `/converations/` endpoint (#2682, #2726) diff --git a/charts/nginz/static/conf/zauth.acl b/charts/nginz/static/conf/zauth.acl index 5de1ce5aa19..3b644bf3d98 100644 --- a/charts/nginz/static/conf/zauth.acl +++ b/charts/nginz/static/conf/zauth.acl @@ -7,7 +7,9 @@ b (whitelist (regex "(/v[0-9]+)?/bot(/.*)?")) p (whitelist (regex "(/v[0-9]+)?/provider(/.*)?")) # LegalHold Access Tokens +# FUTUREWORK: remove /legalhold/conversations/ when support for v1 dropped la (whitelist (regex "(/v[0-9]+)?/notifications") (regex "(/v[0-9]+)?/assets/v3/.*") (regex "(/v[0-9]+)?/users(/.*)?") - (regex "(/v[0-9]+)?/legalhold/conversations/[^/]+")) + (regex "(/v[0-9]+)?/legalhold/conversations/[^/]+") + (regex "(/v[0-9]+)?/conversations/[0-9a-fA-F]{8}-[0-9a-fA-F]{4}-[0-9a-fA-F]{4}-[0-9a-fA-F]{4}-[0-9a-fA-F]{12}$")) diff --git a/deploy/services-demo/conf/nginz/zauth_acl.txt b/deploy/services-demo/conf/nginz/zauth_acl.txt index 3fe4d179e1a..3b644bf3d98 100644 --- a/deploy/services-demo/conf/nginz/zauth_acl.txt +++ b/deploy/services-demo/conf/nginz/zauth_acl.txt @@ -1,18 +1,15 @@ -a (blacklist (path "/provider") - (path "/provider/**") - (path "/bot") - (path "/bot/**") - (path "/i/**")) +a (blacklist (regex "(/v[0-9]+)?/provider(/.*)?") + (regex "(/v[0-9]+)?/bot(/.*)?") + (regex "(/v[0-9]+)?/i/.*")) -b (whitelist (path "/bot") - (path "/bot/**")) +b (whitelist (regex "(/v[0-9]+)?/bot(/.*)?")) -p (whitelist (path "/provider") - (path "/provider/**")) +p (whitelist (regex "(/v[0-9]+)?/provider(/.*)?")) # LegalHold Access Tokens -la (whitelist (path "/notifications") - (path "/assets/v3/**") - (path "/users") - (path "/users/**") - (path "/legalhold/conversations/*")) +# FUTUREWORK: remove /legalhold/conversations/ when support for v1 dropped +la (whitelist (regex "(/v[0-9]+)?/notifications") + (regex "(/v[0-9]+)?/assets/v3/.*") + (regex "(/v[0-9]+)?/users(/.*)?") + (regex "(/v[0-9]+)?/legalhold/conversations/[^/]+") + (regex "(/v[0-9]+)?/conversations/[0-9a-fA-F]{8}-[0-9a-fA-F]{4}-[0-9a-fA-F]{4}-[0-9a-fA-F]{4}-[0-9a-fA-F]{12}$")) diff --git a/services/brig/test/integration/API/User/Auth.hs b/services/brig/test/integration/API/User/Auth.hs index bc65816a8f3..3bcdca313b5 100644 --- a/services/brig/test/integration/API/User/Auth.hs +++ b/services/brig/test/integration/API/User/Auth.hs @@ -243,6 +243,8 @@ testNginzLegalHold b g n = do get (n . paths ["legalhold", "conversations", toByteString' (qUnqualified qconv)] . header "Authorization" ("Bearer " <> toByteString' t)) !!! const 200 === statusCode + get (n . paths ["conversations", toByteString' (qUnqualified qconv)] . header "Authorization" ("Bearer " <> toByteString' t)) !!! const 200 === statusCode + -- | Corner case for 'testNginz': when upgrading a wire backend from the old behavior (setting -- cookie domain to eg. @*.wire.com@) to the new behavior (leaving cookie domain empty, -- effectively setting it to the backend host), clients may start sending two cookies for a From 563d8e9b911d524aaf068f289840bd5bdf855a5e Mon Sep 17 00:00:00 2001 From: jschaul Date: Mon, 26 Sep 2022 14:20:04 +0200 Subject: [PATCH 55/58] charts/wire-server: enable topology-aware hints. (#2723) For wire-server cloud, on kubernetes 1.21+, favour topology-aware routing, which reduces unnecessary inter-availability-zone traffic, reducing latency and cloud provider costs. Documentation: https://kubernetes.io/docs/concepts/services-networking/topology-aware-hints/ See SQPIT-1439 --- changelog.d/5-internal/topology-aware-hints | 1 + charts/backoffice/templates/service.yaml | 2 ++ charts/brig/templates/service.yaml | 2 ++ charts/cannon/templates/headless-service.yaml | 4 +++- charts/cannon/templates/nginz-service.yaml | 1 + charts/cargohold/templates/service.yaml | 2 ++ charts/federator/templates/service.yaml | 2 ++ charts/galley/templates/service.yaml | 2 ++ charts/gundeck/templates/service.yaml | 2 ++ charts/legalhold/templates/service.yaml | 2 ++ charts/nginz/templates/service.yaml | 2 ++ charts/proxy/templates/service.yaml | 2 ++ charts/spar/templates/service.yaml | 2 ++ 13 files changed, 25 insertions(+), 1 deletion(-) create mode 100644 changelog.d/5-internal/topology-aware-hints diff --git a/changelog.d/5-internal/topology-aware-hints b/changelog.d/5-internal/topology-aware-hints new file mode 100644 index 00000000000..3ad2093d2f7 --- /dev/null +++ b/changelog.d/5-internal/topology-aware-hints @@ -0,0 +1 @@ +For wire-server cloud, on kubernetes 1.21+, favour topology-aware routing, which reduces unnecessary inter-availability-zone traffic, reducing latency and cloud provider cross-AZ traffic costs. diff --git a/charts/backoffice/templates/service.yaml b/charts/backoffice/templates/service.yaml index 3422d81a77f..a3ae8a9d9b0 100644 --- a/charts/backoffice/templates/service.yaml +++ b/charts/backoffice/templates/service.yaml @@ -7,6 +7,8 @@ metadata: chart: {{ .Chart.Name }}-{{ .Chart.Version | replace "+" "_" }} release: {{ .Release.Name }} heritage: {{ .Release.Service }} + annotations: + service.kubernetes.io/topology-aware-hints: auto spec: type: ClusterIP ports: diff --git a/charts/brig/templates/service.yaml b/charts/brig/templates/service.yaml index 432be27dd18..63d52526e2f 100644 --- a/charts/brig/templates/service.yaml +++ b/charts/brig/templates/service.yaml @@ -7,6 +7,8 @@ metadata: chart: {{ .Chart.Name }}-{{ .Chart.Version | replace "+" "_" }} release: {{ .Release.Name }} heritage: {{ .Release.Service }} + annotations: + service.kubernetes.io/topology-aware-hints: auto spec: type: ClusterIP ports: diff --git a/charts/cannon/templates/headless-service.yaml b/charts/cannon/templates/headless-service.yaml index 5c107d0bc23..2788f00c0d9 100644 --- a/charts/cannon/templates/headless-service.yaml +++ b/charts/cannon/templates/headless-service.yaml @@ -2,7 +2,7 @@ # We use it this way so we can handle routing requests to specific cannons directly rather than distributing requests # between pods. # -# Read more about this technique in the StatefulSet guide: +# Read more about this technique in the StatefulSet guide: # https://kubernetes.io/docs/tutorials/stateful-application/basic-stateful-set/ apiVersion: v1 kind: Service @@ -13,6 +13,8 @@ metadata: chart: {{ .Chart.Name }}-{{ .Chart.Version | replace "+" "_" }} release: {{ .Release.Name }} heritage: {{ .Release.Service }} + annotations: + service.kubernetes.io/topology-aware-hints: auto spec: type: ClusterIP # This is what makes it a Headless Service diff --git a/charts/cannon/templates/nginz-service.yaml b/charts/cannon/templates/nginz-service.yaml index 704e2e2a250..901c35abaaf 100644 --- a/charts/cannon/templates/nginz-service.yaml +++ b/charts/cannon/templates/nginz-service.yaml @@ -18,6 +18,7 @@ metadata: release: {{ .Release.Name }} heritage: {{ .Release.Service }} annotations: + service.kubernetes.io/topology-aware-hints: auto {{- if .Values.service.nginz.externalDNS.enabled }} external-dns.alpha.kubernetes.io/ttl: {{ .Values.service.nginz.externalDNS.ttl | quote }} external-dns.alpha.kubernetes.io/hostname: {{ required "Please provide .service.nginz.hostname when .service.nginz.enabled and .service.nginz.externalDNS.enabled are True" .Values.service.nginz.hostname | quote }} diff --git a/charts/cargohold/templates/service.yaml b/charts/cargohold/templates/service.yaml index af4957e907c..c6d7422a791 100644 --- a/charts/cargohold/templates/service.yaml +++ b/charts/cargohold/templates/service.yaml @@ -7,6 +7,8 @@ metadata: chart: {{ .Chart.Name }}-{{ .Chart.Version | replace "+" "_" }} release: {{ .Release.Name }} heritage: {{ .Release.Service }} + annotations: + service.kubernetes.io/topology-aware-hints: auto spec: type: ClusterIP ports: diff --git a/charts/federator/templates/service.yaml b/charts/federator/templates/service.yaml index 5394e54b1a3..22d018b9135 100644 --- a/charts/federator/templates/service.yaml +++ b/charts/federator/templates/service.yaml @@ -7,6 +7,8 @@ metadata: chart: {{ .Chart.Name }}-{{ .Chart.Version | replace "+" "_" }} release: {{ .Release.Name }} heritage: {{ .Release.Service }} + annotations: + service.kubernetes.io/topology-aware-hints: auto spec: type: ClusterIP ports: diff --git a/charts/galley/templates/service.yaml b/charts/galley/templates/service.yaml index f79d3a70e93..d7cdd38ce45 100644 --- a/charts/galley/templates/service.yaml +++ b/charts/galley/templates/service.yaml @@ -7,6 +7,8 @@ metadata: chart: {{ .Chart.Name }}-{{ .Chart.Version | replace "+" "_" }} release: {{ .Release.Name }} heritage: {{ .Release.Service }} + annotations: + service.kubernetes.io/topology-aware-hints: auto spec: type: ClusterIP ports: diff --git a/charts/gundeck/templates/service.yaml b/charts/gundeck/templates/service.yaml index 0d27085f1a0..c685bd4504e 100644 --- a/charts/gundeck/templates/service.yaml +++ b/charts/gundeck/templates/service.yaml @@ -7,6 +7,8 @@ metadata: chart: {{ .Chart.Name }}-{{ .Chart.Version | replace "+" "_" }} release: {{ .Release.Name }} heritage: {{ .Release.Service }} + annotations: + service.kubernetes.io/topology-aware-hints: auto spec: type: ClusterIP ports: diff --git a/charts/legalhold/templates/service.yaml b/charts/legalhold/templates/service.yaml index 74b8d980285..4a178e268eb 100644 --- a/charts/legalhold/templates/service.yaml +++ b/charts/legalhold/templates/service.yaml @@ -2,6 +2,8 @@ apiVersion: v1 kind: Service metadata: name: "{{ .Release.Name }}-hold" + annotations: + service.kubernetes.io/topology-aware-hints: auto spec: type: ClusterIP selector: diff --git a/charts/nginz/templates/service.yaml b/charts/nginz/templates/service.yaml index 8ed76cdaaae..6a5c2420f7f 100644 --- a/charts/nginz/templates/service.yaml +++ b/charts/nginz/templates/service.yaml @@ -7,6 +7,8 @@ metadata: chart: {{ .Chart.Name }}-{{ .Chart.Version | replace "+" "_" }} release: {{ .Release.Name }} heritage: {{ .Release.Service }} + annotations: + service.kubernetes.io/topology-aware-hints: auto spec: type: ClusterIP ports: diff --git a/charts/proxy/templates/service.yaml b/charts/proxy/templates/service.yaml index 2bda5053b26..f3640fa434a 100644 --- a/charts/proxy/templates/service.yaml +++ b/charts/proxy/templates/service.yaml @@ -7,6 +7,8 @@ metadata: chart: {{ .Chart.Name }}-{{ .Chart.Version | replace "+" "_" }} release: {{ .Release.Name }} heritage: {{ .Release.Service }} + annotations: + service.kubernetes.io/topology-aware-hints: auto spec: type: ClusterIP ports: diff --git a/charts/spar/templates/service.yaml b/charts/spar/templates/service.yaml index 711967459f0..201b604a82b 100644 --- a/charts/spar/templates/service.yaml +++ b/charts/spar/templates/service.yaml @@ -7,6 +7,8 @@ metadata: chart: {{ .Chart.Name }}-{{ .Chart.Version | replace "+" "_" }} release: {{ .Release.Name }} heritage: {{ .Release.Service }} + annotations: + service.kubernetes.io/topology-aware-hints: auto spec: type: ClusterIP ports: From b130ec60884d82c83013a015bddaa548583c0878 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Tue, 27 Sep 2022 11:39:15 +0200 Subject: [PATCH 56/58] Make sure integration tests use most recent API version (#2695) * Avoid qualified Util import * Use viewGalley everywhere * Add v2 prefix to all galley requests * Add v2 prefix to all brig requests * client tests * account tests * auth tests wip * Fix one more client test * Add versioned paths to legalhold ACL * Refactor: factor out test cases * fix bug: regex routes match too much * Fix the remaining brig tests * Use versioned API in cargohold tests * Always use most recent version in galley tests * Use latest API version in brig * Use latest API version in cargohold * Use v1 API in End2End tests * Add CHANGELOG entry Co-authored-by: Stefan Matting --- .../5-internal/integration-test-version | 1 + deploy/services-demo/conf/nginz/nginx.conf | 10 +- libs/wire-api/src/Wire/API/Routes/Version.hs | 4 + .../brig/test/integration/API/Internal.hs | 2 +- services/brig/test/integration/API/Metrics.hs | 7 +- .../brig/test/integration/API/Settings.hs | 4 +- services/brig/test/integration/API/Team.hs | 12 +- .../brig/test/integration/API/Team/Util.hs | 10 - .../brig/test/integration/API/User/Account.hs | 27 +- .../brig/test/integration/API/User/Auth.hs | 191 +++++++------- .../brig/test/integration/API/User/Client.hs | 29 ++- .../test/integration/API/User/Connection.hs | 2 +- .../brig/test/integration/API/User/Handles.hs | 25 +- .../brig/test/integration/API/User/Util.hs | 17 +- services/brig/test/integration/API/Version.hs | 4 +- .../test/integration/Federation/End2end.hs | 2 +- services/brig/test/integration/Main.hs | 37 ++- services/brig/test/integration/Util.hs | 65 ++++- services/cargohold/cargohold.cabal | 1 + .../cargohold/test/integration/API/Util.hs | 25 +- .../cargohold/test/integration/TestSetup.hs | 50 +++- services/galley/test/integration/API.hs | 36 +-- .../test/integration/API/CustomBackend.hs | 12 +- .../galley/test/integration/API/MLS/Util.hs | 15 +- services/galley/test/integration/API/Roles.hs | 2 +- services/galley/test/integration/API/Teams.hs | 70 +++--- .../test/integration/API/Teams/Feature.hs | 209 ++++++++-------- .../test/integration/API/Teams/LegalHold.hs | 44 ++-- .../API/Teams/LegalHold/DisabledByDefault.hs | 26 +- services/galley/test/integration/API/Util.hs | 236 ++++++++++-------- .../test/integration/API/Util/TeamFeature.hs | 16 +- services/galley/test/integration/TestSetup.hs | 8 +- 32 files changed, 673 insertions(+), 526 deletions(-) create mode 100644 changelog.d/5-internal/integration-test-version diff --git a/changelog.d/5-internal/integration-test-version b/changelog.d/5-internal/integration-test-version new file mode 100644 index 00000000000..3f769d8deea --- /dev/null +++ b/changelog.d/5-internal/integration-test-version @@ -0,0 +1 @@ +Make test API calls point to the most recent version by default diff --git a/deploy/services-demo/conf/nginz/nginx.conf b/deploy/services-demo/conf/nginz/nginx.conf index f969a7e61c1..9074229501c 100644 --- a/deploy/services-demo/conf/nginz/nginx.conf +++ b/deploy/services-demo/conf/nginz/nginx.conf @@ -214,7 +214,7 @@ http { proxy_pass http://brig; } - location ~* ^/teams/invitations/([^/]*)$ { + location ~* ^(/v[0-9]+)?/teams/invitations/([^/]*)$ { include common_response_no_zauth.conf; proxy_pass http://brig; } @@ -226,7 +226,7 @@ http { ## brig authenticated endpoints - location /self { + location ~* ^(/v[0-9]+)?/self$ { include common_response_with_zauth.conf; proxy_pass http://brig; } @@ -261,7 +261,7 @@ http { proxy_pass http://brig; } - location /clients { + location ~* ^(/v[0-9]+)?/clients$ { include common_response_with_zauth.conf; proxy_pass http://brig; } @@ -325,7 +325,7 @@ http { proxy_pass http://galley; } - location ~* /legalhold/conversations/(.*) { + location ~* ^(/v[0-9]+)?/legalhold/conversations/(.*)$ { include common_response_with_zauth.conf; proxy_pass http://galley; } @@ -454,7 +454,7 @@ http { proxy_pass http://gundeck; } - location /notifications { + location ~* ^(/v[0-9]+)?/notifications$ { include common_response_with_zauth.conf; proxy_pass http://gundeck; } diff --git a/libs/wire-api/src/Wire/API/Routes/Version.hs b/libs/wire-api/src/Wire/API/Routes/Version.hs index 959c6abd3c1..a269f644426 100644 --- a/libs/wire-api/src/Wire/API/Routes/Version.hs +++ b/libs/wire-api/src/Wire/API/Routes/Version.hs @@ -73,6 +73,10 @@ instance FromHttpApiData Version where parseHeader = first Text.pack . Aeson.eitherDecode . LBS.fromStrict parseUrlPiece = parseHeader . Text.encodeUtf8 +instance ToHttpApiData Version where + toHeader = LBS.toStrict . Aeson.encode + toUrlPiece = Text.decodeUtf8 . toHeader + supportedVersions :: [Version] supportedVersions = [minBound .. maxBound] diff --git a/services/brig/test/integration/API/Internal.hs b/services/brig/test/integration/API/Internal.hs index 93d0eebb759..f6b7f3f4d42 100644 --- a/services/brig/test/integration/API/Internal.hs +++ b/services/brig/test/integration/API/Internal.hs @@ -363,7 +363,7 @@ testAddKeyPackageRef brig = do getFeatureConfig :: forall cfg m. (MonadIO m, MonadHttp m, HasCallStack, ApiFt.IsFeatureConfig cfg, KnownSymbol (ApiFt.FeatureSymbol cfg)) => (Request -> Request) -> UserId -> m ResponseLBS getFeatureConfig galley uid = do - get $ galley . paths ["feature-configs", featureNameBS @cfg] . zUser uid + get $ apiVersion "v1" . galley . paths ["feature-configs", featureNameBS @cfg] . zUser uid getAllFeatureConfigs :: (MonadIO m, MonadHttp m, HasCallStack) => (Request -> Request) -> UserId -> m ResponseLBS getAllFeatureConfigs galley uid = do diff --git a/services/brig/test/integration/API/Metrics.hs b/services/brig/test/integration/API/Metrics.hs index a1679dc12af..807942b60d0 100644 --- a/services/brig/test/integration/API/Metrics.hs +++ b/services/brig/test/integration/API/Metrics.hs @@ -51,8 +51,9 @@ testPrometheusMetrics brig = do const (Just "TYPE http_request_duration_seconds histogram") =~= responseBody testMetricsEndpoint :: Brig -> Http () -testMetricsEndpoint brig = do - let p1 = "/self" +testMetricsEndpoint brig0 = do + let brig = apiVersion "v1" . brig0 + p1 = "/self" p2 uid = "/users/" <> uid <> "/clients" p3 = "/login" beforeSelf <- getCount "/self" "GET" @@ -73,7 +74,7 @@ testMetricsEndpoint brig = do liftIO $ assertEqual "/login was called twice" (beforeProperties + 2) countProperties where getCount endpoint m = do - rsp <- responseBody <$> get (brig . path "i/metrics") + rsp <- responseBody <$> get (brig0 . path "i/metrics") -- is there some responseBodyAsText function used elsewhere? let asText = fromMaybe "" (fromByteString' (fromMaybe "" rsp)) pure $ fromRight 0 (parseOnly (parseCount endpoint m) asText) diff --git a/services/brig/test/integration/API/Settings.hs b/services/brig/test/integration/API/Settings.hs index ff2059d1ee0..0efdb338d8e 100644 --- a/services/brig/test/integration/API/Settings.hs +++ b/services/brig/test/integration/API/Settings.hs @@ -125,7 +125,7 @@ testUsersEmailVisibleIffExpected opts brig galley viewingUserIs visibilitySettin ] let newOpts = opts & Opt.optionSettings . Opt.emailVisibility .~ visibilitySetting withSettingsOverrides newOpts $ do - get (brig . zUser viewerId . path "users" . queryItem "ids" uids) !!! do + get (apiVersion "v1" . brig . zUser viewerId . path "users" . queryItem "ids" uids) !!! do const 200 === statusCode const (Just expected) === result where @@ -155,7 +155,7 @@ testGetUserEmailShowsEmailsIffExpected opts brig galley viewingUserIs visibility let newOpts = opts & Opt.optionSettings . Opt.emailVisibility .~ visibilitySetting withSettingsOverrides newOpts $ do forM_ expectations $ \(uid, expectedEmail) -> - get (brig . zUser viewerId . paths ["users", toByteString' uid]) !!! do + get (apiVersion "v1" . brig . zUser viewerId . paths ["users", toByteString' uid]) !!! do const 200 === statusCode const expectedEmail === emailResult where diff --git a/services/brig/test/integration/API/Team.hs b/services/brig/test/integration/API/Team.hs index 45b2ce69d2c..9cff893a447 100644 --- a/services/brig/test/integration/API/Team.hs +++ b/services/brig/test/integration/API/Team.hs @@ -24,7 +24,7 @@ where import qualified API.Search.Util as SearchUtil import API.Team.Util -import API.User.Util as Util hiding (listConnections) +import API.User.Util as Util import Bilge hiding (accept, head, timeout) import qualified Bilge import Bilge.Assert @@ -218,9 +218,9 @@ testInvitationEmailLookupNginz brig nginz = do -- expect an invitation to be found querying with email after invite headInvitationByEmail nginz email 200 -headInvitationByEmail :: Brig -> Email -> Int -> Http () -headInvitationByEmail brig email expectedCode = - Bilge.head (brig . path "/teams/invitations/by-email" . contentJson . queryItem "email" (toByteString' email)) +headInvitationByEmail :: (Request -> Request) -> Email -> Int -> Http () +headInvitationByEmail service email expectedCode = + Bilge.head (service . path "/teams/invitations/by-email" . contentJson . queryItem "email" (toByteString' email)) !!! const expectedCode === statusCode testInvitationTooManyPending :: Brig -> TeamSizeLimit -> Http () @@ -383,7 +383,9 @@ createAndVerifyInvitation' replacementBrigApp acceptFn invite brig galley = do mem <- getTeamMember invitee tid galley liftIO $ assertEqual "Member not part of the team" invitee (mem ^. Member.userId) liftIO $ assertEqual "Member has no/wrong invitation metadata" invmeta (mem ^. Member.invitation) - conns <- listConnections invitee brig + conns <- + responseJsonError =<< listConnections brig invitee + UserId -> Brig -> (MonadIO m, MonadHttp m, MonadThrow m) => m UserConnectionList -listConnections u brig = do - responseJsonError - =<< get - ( brig - . path "connections" - . zUser u - ) - getInvitation :: Brig -> InvitationCode -> (MonadIO m, MonadHttp m) => m (Maybe Invitation) getInvitation brig c = do r <- diff --git a/services/brig/test/integration/API/User/Account.hs b/services/brig/test/integration/API/User/Account.hs index eb579b44388..24cbcf0968e 100644 --- a/services/brig/test/integration/API/User/Account.hs +++ b/services/brig/test/integration/API/User/Account.hs @@ -24,7 +24,7 @@ module API.User.Account where import qualified API.Search.Util as Search -import API.Team.Util hiding (listConnections) +import API.Team.Util import API.User.Util import Bilge hiding (accept, timeout) import Bilge.Assert @@ -589,11 +589,11 @@ testNonExistingUserUnqualified :: Brig -> Http () testNonExistingUserUnqualified brig = do findingOne <- liftIO $ Id <$> UUID.nextRandom foundOne <- liftIO $ Id <$> UUID.nextRandom - get (brig . paths ["users", pack $ show foundOne] . zUser findingOne) + get (apiVersion "v1" . brig . paths ["users", pack $ show foundOne] . zUser findingOne) !!! do const 404 === statusCode const (Just "not-found") === fmap Error.label . responseJsonMaybe - get (brig . paths ["users", pack $ show foundOne] . zUser foundOne) + get (apiVersion "v1" . brig . paths ["users", pack $ show foundOne] . zUser foundOne) !!! do const 404 === statusCode const (Just "not-found") === fmap Error.label . responseJsonMaybe @@ -605,11 +605,11 @@ testNonExistingUser brig = do uid2 <- liftIO $ Id <$> UUID.nextRandom let uid = qUnqualified qself domain = qDomain qself - get (brig . paths ["users", toByteString' domain, toByteString' uid1] . zUser uid) + get (apiVersion "v1" . brig . paths ["users", toByteString' domain, toByteString' uid1] . zUser uid) !!! do const 404 === statusCode const (Just "not-found") === fmap Error.label . responseJsonMaybe - get (brig . paths ["users", toByteString' domain, toByteString' uid2] . zUser uid) + get (apiVersion "v1" . brig . paths ["users", toByteString' domain, toByteString' uid2] . zUser uid) !!! do const 404 === statusCode const (Just "not-found") === fmap Error.label . responseJsonMaybe @@ -629,7 +629,7 @@ testUserInvalidDomain brig = do testExistingUserUnqualified :: Brig -> Http () testExistingUserUnqualified brig = do uid <- userId <$> randomUser brig - get (brig . paths ["users", pack $ show uid] . zUser uid) !!! do + get (apiVersion "v1" . brig . paths ["users", pack $ show uid] . zUser uid) !!! do const 200 === statusCode const (Just uid) === ( \r -> do @@ -643,7 +643,8 @@ testExistingUser brig = do let uid = qUnqualified quser domain = qDomain quser get - ( brig + ( apiVersion "v1" + . brig . zUser uid . paths [ "users", @@ -664,7 +665,8 @@ testUserExistsUnqualified brig = do qself <- userQualifiedId <$> randomUser brig quser <- userQualifiedId <$> randomUser brig head - ( brig + ( apiVersion "v1" + . brig . paths ["users", toByteString' (qUnqualified quser)] . zUser (qUnqualified qself) ) @@ -726,7 +728,8 @@ testMultipleUsersUnqualified brig = do (Just $ userDisplayName u3, Nothing) ] get - ( brig + ( apiVersion "v1" + . brig . zUser (userId u1) . contentJson . path "users" @@ -794,7 +797,7 @@ testCreateUserAnonExpiry b = do liftIO $ assertBool "Bob must be in deleted state" (fromMaybe False $ deleted resBob') where getProfile :: UserId -> UserId -> Http ResponseLBS - getProfile zusr uid = get (b . zUser zusr . paths ["users", toByteString' uid]) UserId -> UserId -> Http () awaitExpiry n zusr uid = do -- after expiration, a profile lookup should trigger garbage collection of ephemeral users @@ -818,7 +821,7 @@ testCreateUserAnonExpiry b = do field :: FromJSON a => Text -> Value -> Maybe a field f u = u ^? key f >>= maybeFromJSON -testUserUpdate :: Brig -> Cannon -> AWS.Env -> Http () +testUserUpdate :: HasCallStack => Brig -> Cannon -> AWS.Env -> Http () testUserUpdate brig cannon aws = do aliceUser <- randomUser brig liftIO $ Util.assertUserJournalQueue "user create alice" aws (userActivateJournaled aliceUser) @@ -1749,7 +1752,7 @@ execAndAssertUserDeletion brig cannon u hdl others aws execDelete = do Search.refreshIndex brig -- Does not appear in search; public profile shows the user as deleted forM_ others $ \usr -> do - get (brig . paths ["users", toByteString' uid] . zUser usr) !!! assertDeletedProfilePublic + get (apiVersion "v1" . brig . paths ["users", toByteString' uid] . zUser usr) !!! assertDeletedProfilePublic Search.assertCan'tFind brig usr quid (fromName (userDisplayName u)) Search.assertCan'tFind brig usr quid (fromHandle hdl) -- Email address is available again diff --git a/services/brig/test/integration/API/User/Auth.hs b/services/brig/test/integration/API/User/Auth.hs index 3bcdca313b5..4e2ccc67cbe 100644 --- a/services/brig/test/integration/API/User/Auth.hs +++ b/services/brig/test/integration/API/User/Auth.hs @@ -150,8 +150,10 @@ tests conf m z db b g n = ], testGroup "update /access/self/email" - [ test m "valid token (idempotency case)" (testAccessSelfEmailAllowed n b), - test m "invalid or missing token" (testAccessSelfEmailDenied z n b) + [ test m "valid token (idempotency case) (with cookie)" (testAccessSelfEmailAllowed n b True), + test m "valid token (idempotency case) (without cookie)" (testAccessSelfEmailAllowed n b False), + test m "invalid or missing token (with cookie)" (testAccessSelfEmailDenied z n b True), + test m "invalid or missing token (without cookie)" (testAccessSelfEmailDenied z n b False) ], testGroup "cookies" @@ -199,7 +201,7 @@ testNginz b n = do liftIO $ assertEqual "Ensure nginz is started. Ensure nginz and brig share the same private/public zauth keys. Ensure ACL file is correct." 200 (statusCode _rs) -- ensure nginz allows refresh at /access _rs <- - post (n . path "/access" . cookie c . header "Authorization" ("Bearer " <> toByteString' t)) toByteString' t)) toByteString' t)) !!! const 200 === statusCode @@ -233,7 +235,7 @@ testNginzLegalHold b g n = do =<< createConversation g (userId alice) [] toByteString' t)) !!! do + post (unversioned . n . path "/access" . cookie c . header "Authorization" ("Bearer " <> toByteString' t)) !!! do const 200 === statusCode -- ensure legalhold tokens CANNOT fetch /clients get (n . path "/clients" . header "Authorization" ("Bearer " <> toByteString' t)) !!! const 403 === statusCode @@ -274,16 +276,16 @@ testNginzMultipleCookies o b n = do badCookie2 <- (\c -> c {cookie_value = "SKsjKQbiqxuEugGMWVbq02fNEA7QFdNmTiSa1Y0YMgaEP5tWl3nYHWlIrM5F8Tt7Cfn2Of738C7oeiY8xzPHAC==.v=1.k=1.d=1.t=u.l=.u=13da31b4-c6bb-4561-8fed-07e728fa6cc5.r=f844b420"}) . decodeCookie <$> dologin -- Basic sanity checks - post (n . path "/access" . cookie goodCookie) !!! const 200 === statusCode - post (n . path "/access" . cookie badCookie1) !!! const 403 === statusCode - post (n . path "/access" . cookie badCookie2) !!! const 403 === statusCode + post (unversioned . n . path "/access" . cookie goodCookie) !!! const 200 === statusCode + post (unversioned . n . path "/access" . cookie badCookie1) !!! const 403 === statusCode + post (unversioned . n . path "/access" . cookie badCookie2) !!! const 403 === statusCode -- Sending both cookies should always work, regardless of the order (they are ordered by time) - post (n . path "/access" . cookie badCookie1 . cookie goodCookie . cookie badCookie2) !!! const 200 === statusCode - post (n . path "/access" . cookie goodCookie . cookie badCookie1 . cookie badCookie2) !!! const 200 === statusCode - post (n . path "/access" . cookie badCookie1 . cookie badCookie2 . cookie goodCookie) !!! const 200 === statusCode -- -- Sending a bad cookie and an unparseble one should work too - post (n . path "/access" . cookie unparseableCookie . cookie goodCookie) !!! const 200 === statusCode - post (n . path "/access" . cookie goodCookie . cookie unparseableCookie) !!! const 200 === statusCode + post (unversioned . n . path "/access" . cookie badCookie1 . cookie goodCookie . cookie badCookie2) !!! const 200 === statusCode + post (unversioned . n . path "/access" . cookie goodCookie . cookie badCookie1 . cookie badCookie2) !!! const 200 === statusCode + post (unversioned . n . path "/access" . cookie badCookie1 . cookie badCookie2 . cookie goodCookie) !!! const 200 === statusCode -- -- Sending a bad cookie and an unparseble one should work too + post (unversioned . n . path "/access" . cookie unparseableCookie . cookie goodCookie) !!! const 200 === statusCode + post (unversioned . n . path "/access" . cookie goodCookie . cookie unparseableCookie) !!! const 200 === statusCode -- We want to make sure we are using a cookie that was deleted from the DB but not expired - this way the client -- will still have it in the cookie jar because it did not get overriden @@ -291,10 +293,10 @@ testNginzMultipleCookies o b n = do now <- liftIO getCurrentTime liftIO $ assertBool "cookie should not be expired" (cookie_expiry_time deleted > now) liftIO $ assertBool "cookie should not be expired" (cookie_expiry_time valid > now) - post (n . path "/access" . cookie deleted) !!! const 403 === statusCode - post (n . path "/access" . cookie valid) !!! const 200 === statusCode - post (n . path "/access" . cookie deleted . cookie valid) !!! const 200 === statusCode - post (n . path "/access" . cookie valid . cookie deleted) !!! const 200 === statusCode + post (unversioned . n . path "/access" . cookie deleted) !!! const 403 === statusCode + post (unversioned . n . path "/access" . cookie valid) !!! const 200 === statusCode + post (unversioned . n . path "/access" . cookie deleted . cookie valid) !!! const 200 === statusCode + post (unversioned . n . path "/access" . cookie valid . cookie deleted) !!! const 200 === statusCode ------------------------------------------------------------------------------- -- Login @@ -663,11 +665,11 @@ testLegalHoldLogout brig galley = do uid <- prepareLegalHoldUser brig galley _rs <- legalHoldLogin brig (LegalHoldLogin uid (Just defPassword) Nothing) PersistentCookie ZAuth.Env -> Brig -> Http () testInvalidCookie z b = do -- Syntactically invalid - post (b . path "/access" . cookieRaw "zuid" "xxx") !!! do + post (unversioned . b . path "/access" . cookieRaw "zuid" "xxx") !!! do const 403 === statusCode const (Just "Invalid user token") =~= responseBody -- Expired @@ -727,7 +729,7 @@ testInvalidCookie z b = do let f = set (ZAuth.userTTL (Proxy @u)) 0 t <- toByteString' <$> runZAuth z (ZAuth.localSettings f (ZAuth.newUserToken @u user)) liftIO $ threadDelay 1000000 - post (b . path "/access" . cookieRaw "zuid" t) !!! do + post (unversioned . b . path "/access" . cookieRaw "zuid" t) !!! do const 403 === statusCode const (Just "expired") =~= responseBody @@ -736,9 +738,9 @@ testInvalidCookie z b = do testInvalidToken :: Brig -> Http () testInvalidToken b = do -- Syntactically invalid - post (b . path "/access" . queryItem "access_token" "xxx") + post (unversioned . b . path "/access" . queryItem "access_token" "xxx") !!! errResponse - post (b . path "/access" . header "Authorization" "Bearer xxx") + post (unversioned . b . path "/access" . header "Authorization" "Bearer xxx") !!! errResponse where errResponse = do @@ -748,12 +750,12 @@ testInvalidToken b = do testMissingCookie :: forall u a. ZAuth.TokenPair u a => ZAuth.Env -> Brig -> Http () testMissingCookie z b = do -- Missing cookie, i.e. token refresh mandates a cookie. - post (b . path "/access") + post (unversioned . b . path "/access") !!! errResponse t <- toByteString' <$> runZAuth z (randomAccessToken @u @a) - post (b . path "/access" . header "Authorization" ("Bearer " <> t)) + post (unversioned . b . path "/access" . header "Authorization" ("Bearer " <> t)) !!! errResponse - post (b . path "/access" . queryItem "access_token" t) + post (unversioned . b . path "/access" . queryItem "access_token" t) !!! errResponse where errResponse = do @@ -765,7 +767,7 @@ testUnknownCookie :: forall u. ZAuth.UserTokenLike u => ZAuth.Env -> Brig -> Htt testUnknownCookie z b = do -- Valid cookie but unknown to the server. t <- toByteString' <$> runZAuth z (randomUserToken @u) - post (b . path "/access" . cookieRaw "zuid" t) !!! do + post (unversioned . b . path "/access" . cookieRaw "zuid" t) !!! do const 403 === statusCode const (Just "invalid-credentials") =~= responseBody @@ -779,7 +781,7 @@ testTokenMismatchLegalhold z brig galley = do -- try refresh with a regular UserCookie but a LegalHoldAccessToken let c = decodeCookie _rs t <- toByteString' <$> runZAuth z (randomAccessToken @ZAuth.LegalHoldUser @ZAuth.LegalHoldAccess) - post (brig . path "/access" . cookie c . header "Authorization" ("Bearer " <> t)) !!! do + post (unversioned . brig . path "/access" . cookie c . header "Authorization" ("Bearer " <> t)) !!! do const 403 === statusCode const (Just "Token mismatch") =~= responseBody -- try refresh with a regular AccessToken but a LegalHoldUserCookie @@ -788,69 +790,70 @@ testTokenMismatchLegalhold z brig galley = do _rs <- legalHoldLogin brig (LegalHoldLogin alice (Just defPassword) Nothing) PersistentCookie let c' = decodeCookie _rs t' <- toByteString' <$> runZAuth z (randomAccessToken @ZAuth.User @ZAuth.Access) - post (brig . path "/access" . cookie c' . header "Authorization" ("Bearer " <> t')) !!! do + post (unversioned . brig . path "/access" . cookie c' . header "Authorization" ("Bearer " <> t')) !!! do const 403 === statusCode const (Just "Token mismatch") =~= responseBody -- | This only tests access; the logic is tested in 'testEmailUpdate' in `Account.hs`. -testAccessSelfEmailAllowed :: Nginz -> Brig -> Http () -testAccessSelfEmailAllowed nginz brig = do - -- this test duplicates some of 'initiateEmailUpdateLogin' intentionally. - forM_ [True, False] $ \withCookie -> do - usr <- randomUser brig - let Just email = userEmail usr - (mbCky, tok) <- do - rsp <- - login nginz (emailLogin email defPassword (Just "nexus1")) PersistentCookie - toByteString' tok) - - put (req . Bilge.json ()) - !!! const (if withCookie then 400 else 403) === statusCode - put (req . Bilge.json (EmailUpdate email)) - !!! const (if withCookie then 204 else 403) === statusCode - -testAccessSelfEmailDenied :: ZAuth.Env -> Nginz -> Brig -> Http () -testAccessSelfEmailDenied zenv nginz brig = do - -- this test duplicates some of 'initiateEmailUpdateLogin' intentionally. - forM_ [True, False] $ \withCookie -> do - mbCky <- - if withCookie - then do - usr <- randomUser brig - let Just email = userEmail usr - rsp <- - login nginz (emailLogin email defPassword (Just "nexus1")) PersistentCookie - toByteString' tok)) - !!! errResponse withCookie "invalid-credentials" "Invalid token" +-- this test duplicates some of 'initiateEmailUpdateLogin' intentionally. +testAccessSelfEmailAllowed :: Nginz -> Brig -> Bool -> Http () +testAccessSelfEmailAllowed nginz brig withCookie = do + usr <- randomUser brig + let Just email = userEmail usr + (mbCky, tok) <- do + rsp <- + login nginz (emailLogin email defPassword (Just "nexus1")) PersistentCookie + toByteString' tok) + + put (req . Bilge.json ()) + !!! const (if withCookie then 400 else 403) === statusCode + + put (req . Bilge.json (EmailUpdate email)) + !!! const (if withCookie then 204 else 403) === statusCode + +-- this test duplicates some of 'initiateEmailUpdateLogin' intentionally. +testAccessSelfEmailDenied :: ZAuth.Env -> Nginz -> Brig -> Bool -> Http () +testAccessSelfEmailDenied zenv nginz brig withCookie = do + mbCky <- + if withCookie + then do + usr <- randomUser brig + let Just email = userEmail usr + rsp <- + login nginz (emailLogin email defPassword (Just "nexus1")) PersistentCookie + toByteString' tok)) + !!! errResponse "invalid-credentials" "Invalid token" where - errResponse withCookie label msg = do + errResponse label msg = do const 403 === statusCode when withCookie $ do const (Just label) =~= responseBody @@ -877,7 +880,7 @@ getAndTestDBSupersededCookieAndItsValidSuccessor config b n = do liftIO $ threadDelay minAge -- Refresh tokens _rs <- - post (n . path "/access" . cookie c) do - post (brig . path "/access" . cookie cky) !!! do + post (unversioned . brig . path "/access" . cookie cky) !!! do const 403 === statusCode const Nothing === getHeader "Set-Cookie" "/login" -> do @@ -1108,11 +1111,11 @@ testLogout b = do Just email <- userEmail <$> randomUser b _rs <- login b (defEmailLogin email) SessionCookie let (t, c) = (decodeToken _rs, decodeCookie _rs) - post (b . path "/access" . cookie c) + post (unversioned . b . path "/access" . cookie c) !!! const 200 === statusCode - post (b . path "/access/logout" . cookie c . queryItem "access_token" (toByteString' t)) + post (unversioned . b . path "/access/logout" . cookie c . queryItem "access_token" (toByteString' t)) !!! const 200 === statusCode - post (b . path "/access" . cookie c) + post (unversioned . b . path "/access" . cookie c) !!! const 403 === statusCode testReauthentication :: Brig -> Http () diff --git a/services/brig/test/integration/API/User/Client.hs b/services/brig/test/integration/API/User/Client.hs index ef2abc5109b..50bf88810ee 100644 --- a/services/brig/test/integration/API/User/Client.hs +++ b/services/brig/test/integration/API/User/Client.hs @@ -378,7 +378,8 @@ testListClientsBulk opts brig = do ] ) post - ( brig + ( apiVersion "v1" + . brig . paths ["users", "list-clients"] . zUser uid3 . contentJson @@ -418,7 +419,8 @@ testListClientsBulkV2 opts brig = do ] ) post - ( brig + ( apiVersion "v1" + . brig . paths ["users", "list-clients", "v2"] . zUser uid3 . contentJson @@ -456,12 +458,12 @@ generateClients n brig = do testGetUserPrekeys :: Brig -> Http () testGetUserPrekeys brig = do [(uid, _c, lpk, cpk)] <- generateClients 1 brig - get (brig . paths ["users", toByteString' uid, "prekeys"] . zUser uid) !!! do + get (apiVersion "v1" . brig . paths ["users", toByteString' uid, "prekeys"] . zUser uid) !!! do const 200 === statusCode const (Just $ PrekeyBundle uid [cpk]) === responseJsonMaybe -- prekeys are deleted when retrieved, except the last one replicateM_ 2 $ - get (brig . paths ["users", toByteString' uid, "prekeys"] . zUser uid) !!! do + get (apiVersion "v1" . brig . paths ["users", toByteString' uid, "prekeys"] . zUser uid) !!! do const 200 === statusCode const (Just $ PrekeyBundle uid [lpk]) === responseJsonMaybe @@ -482,7 +484,7 @@ testGetUserPrekeysInvalidDomain brig = do testGetClientPrekey :: Brig -> Http () testGetClientPrekey brig = do [(uid, c, _lpk, cpk)] <- generateClients 1 brig - get (brig . paths ["users", toByteString' uid, "prekeys", toByteString' (clientId c)] . zUser uid) !!! do + get (apiVersion "v1" . brig . paths ["users", toByteString' uid, "prekeys", toByteString' (clientId c)] . zUser uid) !!! do const 200 === statusCode const (Just $ cpk) === responseJsonMaybe @@ -512,7 +514,8 @@ testMultiUserGetPrekeys brig = do uid <- userId <$> randomUser brig post - ( brig + ( apiVersion "v1" + . brig . paths ["users", "prekeys"] . contentJson . body (RequestBodyLBS $ encode userClients) @@ -708,7 +711,7 @@ testUpdateClient opts brig = do newClientModel = Just "featurephone" } c <- responseJsonError =<< addClient brig uid clt - get (brig . paths ["users", toByteString' uid, "prekeys", toByteString' (clientId c)] . zUser uid) !!! do + get (apiVersion "v1" . brig . paths ["users", toByteString' uid, "prekeys", toByteString' (clientId c)] . zUser uid) !!! do const 200 === statusCode const (Just $ ClientPrekey (clientId c) (somePrekeys !! 0)) === responseJsonMaybe getClient brig uid (clientId c) !!! do @@ -731,7 +734,7 @@ testUpdateClient opts brig = do ) !!! const 200 === statusCode - get (brig . paths ["users", toByteString' uid, "prekeys", toByteString' (clientId c)] . zUser uid) !!! do + get (apiVersion "v1" . brig . paths ["users", toByteString' uid, "prekeys", toByteString' (clientId c)] . zUser uid) !!! do const 200 === statusCode const (Just $ ClientPrekey (clientId c) newPrekey) === responseJsonMaybe @@ -741,7 +744,7 @@ testUpdateClient opts brig = do const (Just "label") === (clientLabel <=< responseJsonMaybe) -- via `/users/:uid/clients/:client`, only `id` and `class` are visible: - get (brig . paths ["users", toByteString' uid, "clients", toByteString' (clientId c)]) !!! do + get (apiVersion "v1" . brig . paths ["users", toByteString' uid, "clients", toByteString' (clientId c)]) !!! do const 200 === statusCode const (Just $ clientId c) === (fmap pubClientId . responseJsonMaybe) const (Just PhoneClient) === (pubClientClass <=< responseJsonMaybe) @@ -761,7 +764,8 @@ testUpdateClient opts brig = do -- empty update should be a no-op put - ( brig + ( apiVersion "v1" + . brig . paths ["clients", toByteString' (clientId c)] . zUser uid . contentJson @@ -780,7 +784,8 @@ testUpdateClient opts brig = do checkUpdate capsIn respStatusOk capsOut = do let update'' = defUpdateClient {updateClientCapabilities = Set.fromList <$> capsIn} put - ( brig + ( apiVersion "v1" + . brig . paths ["clients", toByteString' (clientId c)] . zUser uid . contentJson @@ -813,7 +818,7 @@ testUpdateClient opts brig = do flushClientPrekey = do responseJsonMaybe <$> ( get - (brig . paths ["users", toByteString' uid, "prekeys", toByteString' (clientId c)] . zUser uid) + (apiVersion "v1" . brig . paths ["users", toByteString' uid, "prekeys", toByteString' (clientId c)] . zUser uid) start) (Just step) r <- - get (b . path "/connections" . zUser u . range) + get (apiVersion "v1" . b . path "/connections" . zUser u . range) conns) diff --git a/services/brig/test/integration/API/User/Handles.hs b/services/brig/test/integration/API/User/Handles.hs index 5eb3a44c293..f15c65bb0cc 100644 --- a/services/brig/test/integration/API/User/Handles.hs +++ b/services/brig/test/integration/API/User/Handles.hs @@ -176,7 +176,7 @@ testHandleQuery opts brig = do Bilge.head (brig . paths ["users", "handles", toByteString' hdl] . zUser uid) !!! const 200 === statusCode -- Query user profiles by handles - get (brig . path "/users" . queryItem "handles" (toByteString' hdl) . zUser uid) !!! do + get (apiVersion "v1" . brig . path "/users" . queryItem "handles" (toByteString' hdl) . zUser uid) !!! do const 200 === statusCode const (Just (Handle hdl)) === (profileHandle <=< listToMaybe <=< responseJsonMaybe) -- Bulk availability check @@ -241,7 +241,8 @@ testGetUserByUnqualifiedHandle brig = do _ <- putHandle brig (userId user) handle requestingUser <- randomId get - ( brig + ( apiVersion "v1" + . brig . paths ["users", "handles", toByteString' handle] . zUser requestingUser ) @@ -254,7 +255,8 @@ testGetUserByUnqualifiedHandleFailure brig = do handle <- randomHandle requestingUser <- randomId get - ( brig + ( apiVersion "v1" + . brig . paths ["users", "handles", toByteString' handle] . zUser requestingUser ) @@ -272,7 +274,8 @@ testGetUserByQualifiedHandle brig = do profileForUnconnectedUser <- responseJsonError =<< get - ( brig + ( apiVersion "v1" + . brig . paths ["users", "by-handle", toByteString' domain, toByteString' handle] . zUser (userId unconnectedUser) . expect2xx @@ -296,7 +299,8 @@ testGetUserByQualifiedHandleFailure brig = do handle <- randomHandle qself <- userQualifiedId <$> randomUser brig get - ( brig + ( apiVersion "v1" + . brig . paths [ "users", "by-handle", @@ -315,7 +319,8 @@ testGetUserByQualifiedHandleNoFederation opt brig = do someUser <- randomUser brig withSettingsOverrides newOpts $ get - ( brig + ( apiVersion "v1" + . brig . paths ["users", "by-handle", "non-existant.example.com", "oh-a-handle"] . zUser (userId someUser) ) @@ -328,10 +333,10 @@ assertCanFind :: (Monad m, MonadCatch m, MonadIO m, MonadHttp m, HasCallStack) = assertCanFind brig from target = do liftIO $ assertBool "assertCanFind: Target must have a handle set" (isJust $ userHandle target) let targetHandle = fromMaybe (error "Impossible") (userHandle target) - get (brig . path "/users" . queryItem "handles" (toByteString' targetHandle) . zUser (userId from)) !!! do + get (apiVersion "v1" . brig . path "/users" . queryItem "handles" (toByteString' targetHandle) . zUser (userId from)) !!! do const 200 === statusCode const (userHandle target) === (>>= (listToMaybe >=> profileHandle)) . responseJsonMaybe - get (brig . paths ["users", "handles", toByteString' targetHandle] . zUser (userId from)) !!! do + get (apiVersion "v1" . brig . paths ["users", "handles", toByteString' targetHandle] . zUser (userId from)) !!! do const 200 === statusCode const (Just (UserHandleInfo $ userQualifiedId target)) === responseJsonMaybe @@ -339,7 +344,7 @@ assertCannotFind :: (Monad m, MonadCatch m, MonadIO m, MonadHttp m, HasCallStack assertCannotFind brig from target = do liftIO $ assertBool "assertCannotFind: Target must have a handle set" (isJust $ userHandle target) let targetHandle = fromMaybe (error "Impossible") (userHandle target) - get (brig . path "/users" . queryItem "handles" (toByteString' targetHandle) . zUser (userId from)) !!! do + get (apiVersion "v1" . brig . path "/users" . queryItem "handles" (toByteString' targetHandle) . zUser (userId from)) !!! do const 404 === statusCode - get (brig . paths ["users", "handles", toByteString' targetHandle] . zUser (userId from)) !!! do + get (apiVersion "v1" . brig . paths ["users", "handles", toByteString' targetHandle] . zUser (userId from)) !!! do const 404 === statusCode diff --git a/services/brig/test/integration/API/User/Util.hs b/services/brig/test/integration/API/User/Util.hs index b54f1c30252..7551ef25c32 100644 --- a/services/brig/test/integration/API/User/Util.hs +++ b/services/brig/test/integration/API/User/Util.hs @@ -186,7 +186,8 @@ initiateEmailUpdateLogin brig email loginCreds uid = do initiateEmailUpdateCreds :: Brig -> Email -> (Bilge.Cookie, Brig.ZAuth.AccessToken) -> UserId -> (MonadIO m, MonadCatch m, MonadHttp m) => m ResponseLBS initiateEmailUpdateCreds brig email (cky, tok) uid = do put $ - brig + unversioned + . brig . path "/access/self/email" . cookie cky . header "Authorization" ("Bearer " <> toByteString' tok) @@ -261,7 +262,8 @@ getClientCapabilities brig u c = getUserClientsUnqualified :: Brig -> UserId -> (MonadIO m, MonadHttp m) => m ResponseLBS getUserClientsUnqualified brig uid = get $ - brig + apiVersion "v1" + . brig . paths ["users", toByteString' uid, "clients"] . zUser uid @@ -286,10 +288,11 @@ deleteClient brig u c pw = RequestBodyLBS . encode . object . maybeToList $ fmap ("password" .=) pw -listConnections :: Brig -> UserId -> (MonadIO m, MonadHttp m) => m ResponseLBS +listConnections :: HasCallStack => Brig -> UserId -> (MonadIO m, MonadHttp m) => m ResponseLBS listConnections brig u = get $ - brig + apiVersion "v1" + . brig . path "connections" . zUser u @@ -434,7 +437,7 @@ sendConnectionUpdateAction brig opts uid1 quid2 reaction expectedRel = do assertEmailVisibility :: (MonadCatch m, MonadIO m, MonadHttp m, HasCallStack) => Brig -> User -> User -> Bool -> m () assertEmailVisibility brig a b visible = - get (brig . paths ["users", pack . show $ userId b] . zUser (userId a)) !!! do + get (apiVersion "v1" . brig . paths ["users", pack . show $ userId b] . zUser (userId a)) !!! do const 200 === statusCode if visible then const (Just (userEmail b)) === fmap userEmail . responseJsonMaybe @@ -452,7 +455,7 @@ uploadAsset c usr sts dat = do mpb = buildMultipartBody sts ct (LB.fromStrict dat) post ( c - . path "/assets/v3" + . path "/assets" . zUser usr . zConn "conn" . content "multipart/mixed" @@ -470,7 +473,7 @@ downloadAsset :: downloadAsset c usr ast = get ( c - . paths ["/assets/v4", toByteString' (qDomain ast), toByteString' (qUnqualified ast)] + . paths ["/assets", toByteString' (qDomain ast), toByteString' (qUnqualified ast)] . zUser usr . zConn "conn" ) diff --git a/services/brig/test/integration/API/Version.hs b/services/brig/test/integration/API/Version.hs index 0a0702509cf..455925be8c0 100644 --- a/services/brig/test/integration/API/Version.hs +++ b/services/brig/test/integration/API/Version.hs @@ -50,7 +50,7 @@ testVersion brig = do testVersionV1 :: Brig -> Http () testVersionV1 brig = do vinfo <- - responseJsonError =<< get (brig . path "/v1/api-version") + responseJsonError =<< get (apiVersion "v1" . brig . path "api-version") Http () testUnsupportedVersion brig = do e <- - responseJsonError =<< get (brig . path "/v500/api-version") + responseJsonError =<< get (apiVersion "v500" . brig . path "api-version") Opts.Opts -> [String] -> IO () runTests iConf brigOpts otherArgs = do - let b = mkRequest $ brig iConf - c = mkRequest $ cannon iConf - gd = mkRequest $ gundeck iConf - ch = mkRequest $ cargohold iConf - g = mkRequest $ galley iConf - n = mkRequest $ nginz iConf - s = mkRequest $ spar iConf + let b = mkVersionedRequest $ brig iConf + c = mkVersionedRequest $ cannon iConf + gd = mkVersionedRequest $ gundeck iConf + ch = mkVersionedRequest $ cargohold iConf + g = mkVersionedRequest $ galley iConf + n = mkVersionedRequest $ nginz iConf + s = mkVersionedRequest $ spar iConf f = federatorInternal iConf - brigTwo = mkRequest $ remoteBrig (backendTwo iConf) - cannonTwo = mkRequest $ remoteCannon (backendTwo iConf) - galleyTwo = mkRequest $ remoteGalley (backendTwo iConf) - ch2 = mkRequest $ remoteCargohold (backendTwo iConf) + brigTwo = mkVersionedRequest $ remoteBrig (backendTwo iConf) + cannonTwo = mkVersionedRequest $ remoteCannon (backendTwo iConf) + galleyTwo = mkVersionedRequest $ remoteGalley (backendTwo iConf) + ch2 = mkVersionedRequest $ remoteCargohold (backendTwo iConf) let Opts.TurnServersFiles turnFile turnFileV2 = case Opts.serversSource $ Opts.turn brigOpts of Opts.TurnSourceFiles files -> files @@ -178,6 +182,17 @@ runTests iConf brigOpts otherArgs = do where mkRequest (Endpoint h p) = host (encodeUtf8 h) . port p + mkVersionedRequest endpoint = addPrefix . mkRequest endpoint + + addPrefix :: Request -> Request + addPrefix r = r {HTTP.path = "v" <> toHeader latestVersion <> "/" <> removeSlash (HTTP.path r)} + where + removeSlash s = case B8.uncons s of + Just ('/', s') -> s' + _ -> s + latestVersion :: Version + latestVersion = maxBound + parseEmailAWSOpts :: IO (Maybe Opts.EmailAWSOpts) parseEmailAWSOpts = case Opts.email . Opts.emailSMS $ brigOpts of (Opts.EmailAWS aws) -> pure (Just aws) diff --git a/services/brig/test/integration/Util.hs b/services/brig/test/integration/Util.hs index e832bb08b12..bcb0e9031aa 100644 --- a/services/brig/test/integration/Util.hs +++ b/services/brig/test/integration/Util.hs @@ -40,6 +40,7 @@ import Control.Exception (throw) import Control.Lens ((^.), (^?), (^?!)) import Control.Monad.Catch (MonadCatch, MonadMask) import qualified Control.Monad.Catch as Catch +import qualified Control.Monad.State as State import Control.Monad.State.Class (MonadState) import qualified Control.Monad.State.Class as MonadState import Control.Monad.Trans.Except (ExceptT (ExceptT), runExceptT) @@ -50,7 +51,7 @@ import qualified Data.Aeson.Types as Aeson import qualified Data.ByteString as BS import Data.ByteString.Builder (toLazyByteString) import Data.ByteString.Char8 (pack) -import qualified Data.ByteString.Char8 as C8 +import qualified Data.ByteString.Char8 as B8 import Data.ByteString.Conversion import Data.Domain (Domain (..), domainText, mkDomain) import Data.Handle (Handle (..)) @@ -135,6 +136,38 @@ type Spar = Request -> Request data FedClient (comp :: Component) = FedClient HTTP.Manager Endpoint +-- | Note: Apply this function last when composing (Request -> Request) functions +apiVersion :: ByteString -> Request -> Request +apiVersion newVersion r = r {HTTP.path = setVersion newVersion (HTTP.path r)} + where + setVersion :: ByteString -> ByteString -> ByteString + setVersion v p = + let p' = removeSlash' p + in v <> "/" <> fromMaybe p' (removeVersionPrefix p') + +removeSlash' :: ByteString -> ByteString +removeSlash' s = case B8.uncons s of + Just ('/', s') -> s' + _ -> s + +removeVersionPrefix :: ByteString -> Maybe ByteString +removeVersionPrefix bs = do + let (x, s) = B8.splitAt 1 bs + guard (x == B8.pack "v") + (_, s') <- B8.readInteger s + pure (B8.tail s') + +-- | Note: Apply this function last when composing (Request -> Request) functions +unversioned :: Request -> Request +unversioned r = + r + { HTTP.path = + maybe + (HTTP.path r) + (B8.pack "/" <>) + (removeVersionPrefix . removeSlash' $ HTTP.path r) + } + runFedClient :: forall (name :: Symbol) comp api. ( HasFedEndpoint comp api name, @@ -333,7 +366,8 @@ assertUpdateNotification ws uid upd = WS.assertMatch (5 # Second) ws $ \n -> do getConnection :: Brig -> UserId -> UserId -> Http ResponseLBS getConnection brig from to = get $ - brig + apiVersion "v1" + . brig . paths ["/connections", toByteString' to] . zUser from . zConn "conn" @@ -439,7 +473,8 @@ getSelfProfile brig usr = do getUser :: Brig -> UserId -> UserId -> Http ResponseLBS getUser brig zusr usr = get $ - brig + apiVersion "v1" + . brig . paths ["users", toByteString' usr] . zUser zusr @@ -450,7 +485,8 @@ login :: Brig -> Login -> CookieType -> (MonadIO m, MonadHttp m) => m ResponseLB login b l t = let js = RequestBodyLBS (encode l) in post $ - b + unversioned + . b . path "/login" . contentJson . (if t == PersistentCookie then queryItem "persist" "true" else id) @@ -510,7 +546,8 @@ sendLoginCode b p typ force = postConnection :: Brig -> UserId -> UserId -> (MonadIO m, MonadHttp m) => m ResponseLBS postConnection brig from to = post $ - brig + apiVersion "v1" + . brig . path "/connections" . contentJson . body payload @@ -533,7 +570,8 @@ postConnectionQualified brig from (Qualified toUser toDomain) = putConnection :: Brig -> UserId -> UserId -> Relation -> (MonadIO m, MonadHttp m) => m ResponseLBS putConnection brig from to r = put $ - brig + apiVersion "v1" + . brig . paths ["/connections", toByteString' to] . contentJson . body payload @@ -602,7 +640,8 @@ getUserInfoFromHandle brig domain handle = do u <- randomId responseJsonError =<< get - ( brig + ( apiVersion "v1" + . brig . paths ["users", "by-handle", toByteString' (domainText domain), toByteString' handle] . zUser u . expect2xx @@ -649,7 +688,8 @@ defNewClientWithVerificationCode mbCode ty pks lpk = getPreKey :: Brig -> UserId -> UserId -> ClientId -> Http ResponseLBS getPreKey brig zusr u c = get $ - brig + apiVersion "v1" + . brig . paths ["users", toByteString' u, "prekeys", toByteString' c] . zUser zusr @@ -744,7 +784,8 @@ listConvs :: m ResponseLBS listConvs galley zusr convs = do post $ - galley + apiVersion "v1" + . galley . path "/conversations/list/v2" . zUser zusr . zConn "conn" @@ -803,7 +844,7 @@ zAuthAccess :: UserId -> ByteString -> Request -> Request zAuthAccess u c = header "Z-Type" "access" . zUser u . zConn c zUser :: UserId -> Request -> Request -zUser = header "Z-User" . C8.pack . show +zUser = header "Z-User" . B8.pack . show zConn :: ByteString -> Request -> Request zConn = header "Z-Connection" @@ -893,7 +934,7 @@ somePrekeys = Prekey (PrekeyId 23) "pQABARcCoQBYIASE94LjK6Raipk/lN/YewouqO+kcQGpxIqP+iW2hyHiA6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=", Prekey (PrekeyId 24) "pQABARgYAqEAWCBZ222LpS6/99Btlw+83PihrA655skwsNevt//8oz5axQOhAKEAWCCy39UyMEgetquvTo7P19bcyfnWBzQMOEG1v+0wub0magT2", Prekey (PrekeyId 25) "pQABARgZAqEAWCDGEwo61w4O8T8lyw0HdoOjGWBKQUNqo6+jSfrPR9alrAOhAKEAWCCy39UyMEgetquvTo7P19bcyfnWBzQMOEG1v+0wub0magT2", - Prekey (PrekeyId 26) "pQABARgaAqEAWCBMSQoQ6B35plC80i1O3AWlJSftCEbCbju97Iykg5+NWQOhAKEAWCCy39UyMEgetquvTo7P19bcyfnWBzQMOEG1v+0wub0magT2" + Prekey (PrekeyId 26) "pQABARgaAqEAWCBMSQoQ6B35plB80i1O3AWlJSftCEbCbju97Iykg5+NWQOhAKEAWCCy39UyMEgetquvTo7P19bcyfnWBzQMOEG1v+0wub0magT2" ] -- | The client ID of the first of 'someLastPrekeys' @@ -1238,7 +1279,7 @@ fromServantRequest domain r = <> headers <> [(originDomainHeaderName, T.encodeUtf8 (domainText domain))], Wai.isSecure = True, - Wai.pathInfo = filter (not . T.null) (map Data.String.Conversions.cs (C8.split '/' pathBS)), + Wai.pathInfo = filter (not . T.null) (map Data.String.Conversions.cs (B8.split '/' pathBS)), Wai.queryString = toList (Servant.requestQueryString r) } in WaiTest.SRequest req (cs bodyBS) diff --git a/services/cargohold/cargohold.cabal b/services/cargohold/cargohold.cabal index f82b665ae31..74ebc915c50 100644 --- a/services/cargohold/cargohold.cabal +++ b/services/cargohold/cargohold.cabal @@ -290,6 +290,7 @@ executable cargohold-integration , extended , federator , HsOpenSSL >=0.11 + , http-api-data , http-client >=0.4 , http-client-tls >=0.2 , http-media diff --git a/services/cargohold/test/integration/API/Util.hs b/services/cargohold/test/integration/API/Util.hs index c0609d86609..c98851fdd41 100644 --- a/services/cargohold/test/integration/API/Util.hs +++ b/services/cargohold/test/integration/API/Util.hs @@ -64,9 +64,11 @@ uploadRaw :: Lazy.ByteString -> TestM (Response (Maybe Lazy.ByteString)) uploadRaw c usr bs = do - cargohold <- viewCargohold + cargohold <- viewUnversionedCargohold post $ - c . cargohold + apiVersion "v1" + . c + . cargohold . method POST . zUser usr . zConn "conn" @@ -90,8 +92,8 @@ zConn = header "Z-Connection" deleteAssetV3 :: UserId -> Qualified AssetKey -> TestM (Response (Maybe Lazy.ByteString)) deleteAssetV3 u k = do - c <- viewCargohold - delete $ c . zUser u . paths ["assets", "v3", toByteString' (qUnqualified k)] + c <- viewUnversionedCargohold + delete $ apiVersion "v1" . c . zUser u . paths ["assets", "v3", toByteString' (qUnqualified k)] deleteAsset :: UserId -> Qualified AssetKey -> TestM (Response (Maybe Lazy.ByteString)) deleteAsset u k = do @@ -100,7 +102,6 @@ deleteAsset u k = do c . zUser u . paths [ "assets", - "v4", toByteString' (qDomain k), toByteString' (qUnqualified k) ] @@ -109,10 +110,14 @@ class IsAssetLocation key where locationPath :: key -> Request -> Request instance IsAssetLocation AssetKey where - locationPath k = paths ["assets", "v3", toByteString' k] + locationPath k = + apiVersion "v1" + . paths ["assets", "v3", toByteString' k] instance IsAssetLocation (Qualified AssetKey) where - locationPath k = paths ["assets", "v4", toByteString' (qDomain k), toByteString' (qUnqualified k)] + locationPath k = + apiVersion "v2" + . paths ["assets", toByteString' (qDomain k), toByteString' (qUnqualified k)] instance IsAssetLocation ByteString where locationPath = path @@ -137,7 +142,7 @@ downloadAssetWith :: tok -> TestM (Response (Maybe LByteString)) downloadAssetWith r uid loc tok = do - c <- viewCargohold + c <- viewUnversionedCargohold get $ c . r . zUser uid @@ -158,14 +163,14 @@ postToken uid key = do c <- viewCargohold post $ c . zUser uid - . paths ["assets", "v3", toByteString' key, "token"] + . paths ["assets", toByteString' key, "token"] deleteToken :: UserId -> AssetKey -> TestM (Response (Maybe LByteString)) deleteToken uid key = do c <- viewCargohold delete $ c . zUser uid - . paths ["assets", "v3", toByteString' key, "token"] + . paths ["assets", toByteString' key, "token"] viewFederationDomain :: TestM Domain viewFederationDomain = view (tsOpts . optSettings . setFederationDomain) diff --git a/services/cargohold/test/integration/TestSetup.hs b/services/cargohold/test/integration/TestSetup.hs index cd92d677f98..af4eb7d6677 100644 --- a/services/cargohold/test/integration/TestSetup.hs +++ b/services/cargohold/test/integration/TestSetup.hs @@ -26,11 +26,14 @@ module TestSetup Cargohold, TestM, runTestM, + viewUnversionedCargohold, viewCargohold, createTestSetup, runFederationClient, withFederationClient, withFederationError, + apiVersion, + unversioned, ) where @@ -42,12 +45,14 @@ import Control.Monad.Codensity import Control.Monad.Except import Control.Monad.Morph import qualified Data.Aeson as Aeson +import qualified Data.ByteString.Char8 as B8 import Data.ByteString.Conversion import qualified Data.Text as T import Data.Text.Encoding import Data.Yaml import Imports import Network.HTTP.Client hiding (responseBody) +import qualified Network.HTTP.Client as HTTP import Network.HTTP.Client.TLS import qualified Network.Wai.Utilities.Error as Wai import Servant.Client.Streaming @@ -56,7 +61,9 @@ import Test.Tasty.HUnit import Util.Options import Util.Options.Common import Util.Test +import Web.HttpApiData import Wire.API.Federation.Domain +import Wire.API.Routes.Version type Cargohold = Request -> Request @@ -73,8 +80,49 @@ data TestSetup = TestSetup makeLenses ''TestSetup +-- | Note: Apply this function last when composing (Request -> Request) functions +apiVersion :: ByteString -> Request -> Request +apiVersion newVersion r = r {HTTP.path = setVersion newVersion (HTTP.path r)} + where + setVersion :: ByteString -> ByteString -> ByteString + setVersion v p = + let p' = removeSlash' p + in v <> "/" <> fromMaybe p' (removeVersionPrefix p') + +removeSlash' :: ByteString -> ByteString +removeSlash' s = case B8.uncons s of + Just ('/', s') -> s' + _ -> s + +removeVersionPrefix :: ByteString -> Maybe ByteString +removeVersionPrefix bs = do + let (x, s) = B8.splitAt 1 bs + guard (x == B8.pack "v") + (_, s') <- B8.readInteger s + pure (B8.tail s') + +-- | Note: Apply this function last when composing (Request -> Request) functions +unversioned :: Request -> Request +unversioned r = + r + { HTTP.path = + maybe + (HTTP.path r) + (B8.pack "/" <>) + (removeVersionPrefix . removeSlash' $ HTTP.path r) + } + viewCargohold :: TestM Cargohold -viewCargohold = mkRequest <$> view tsEndpoint +viewCargohold = + fmap + (apiVersion ("v" <> toHeader latestVersion) .) + viewUnversionedCargohold + where + latestVersion :: Version + latestVersion = maxBound + +viewUnversionedCargohold :: TestM Cargohold +viewUnversionedCargohold = mkRequest <$> view tsEndpoint runTestM :: TestSetup -> TestM a -> IO a runTestM ts action = runHttpT (view tsManager ts) (runReaderT action ts) diff --git a/services/galley/test/integration/API.hs b/services/galley/test/integration/API.hs index 19c775fc400..f8d9b3092f9 100644 --- a/services/galley/test/integration/API.hs +++ b/services/galley/test/integration/API.hs @@ -247,7 +247,7 @@ tests s = status :: TestM () status = do - g <- view tsGalley + g <- viewGalley get (g . path "/i/status") !!! const 200 === statusCode Bilge.head (g . path "/i/status") @@ -255,7 +255,7 @@ status = do metrics :: TestM () metrics = do - g <- view tsGalley + g <- viewGalley get (g . path "/i/metrics") !!! do const 200 === statusCode -- Should contain the request duration metric in its output @@ -441,7 +441,6 @@ postCryptoMessageVerifyMsgSentAndRejectIfMissingClient = do -- This test verifies basic mismatch behavior of the the JSON endpoint. postCryptoMessageVerifyRejectMissingClientAndRepondMissingPrekeysJson :: TestM () postCryptoMessageVerifyRejectMissingClientAndRepondMissingPrekeysJson = do - b <- view tsBrig (alice, ac) <- randomUserWithClient (head someLastPrekeys) (bob, bc) <- randomUserWithClient (someLastPrekeys !! 1) (eve, ec) <- randomUserWithClient (someLastPrekeys !! 2) @@ -455,8 +454,9 @@ postCryptoMessageVerifyRejectMissingClientAndRepondMissingPrekeysJson = do assertMismatchWithMessage (Just "client mismatch") [(eve, Set.singleton ec)] [] [] let x = responseJsonUnsafeWithMsg "ClientMismatch" r1 -- Fetch all missing clients prekeys + b <- view tsUnversionedBrig r2 <- - post (b . zUser alice . path "/users/prekeys" . json (missingClients x)) + post (b . zUser alice . path "v1/users/prekeys" . json (missingClients x)) postTeamConv teamId owner [] (Just "testConversation") [CodeAccess] (Just noGuestsAccess) Nothing @@ -1256,7 +1256,7 @@ testPostCodeRejectedIfGuestLinksDisabled = do -- Check if guests cannot join anymore if guest invite feature was disabled on team level testJoinTeamConvGuestLinksDisabled :: TestM () testJoinTeamConvGuestLinksDisabled = do - galley <- view tsGalley + galley <- viewGalley let convName = "testConversation" (owner, teamId, [alice]) <- Util.createBindingTeamWithNMembers 1 eve <- ephemeralUser @@ -1315,7 +1315,7 @@ testJoinTeamConvGuestLinksDisabled = do testJoinNonTeamConvGuestLinksDisabled :: TestM () testJoinNonTeamConvGuestLinksDisabled = do - galley <- view tsGalley + galley <- viewGalley let convName = "testConversation" (owner, teamId, []) <- Util.createBindingTeamWithNMembers 0 userNotInTeam <- randomUser @@ -1606,7 +1606,7 @@ testTeamMemberCantJoinViaGuestLinkIfAccessRoleRemoved = do getGuestLinksStatusFromForeignTeamConv :: TestM () getGuestLinksStatusFromForeignTeamConv = do localDomain <- viewFederationDomain - galley <- view tsGalley + galley <- viewGalley let setTeamStatus u tid tfStatus = TeamFeatures.putTeamFeatureFlagWithGalley @Public.GuestLinksConfig galley u tid (Public.WithStatusNoLock tfStatus Public.GuestLinksConfig Public.FeatureTTLUnlimited) !!! do const 200 === statusCode @@ -2064,7 +2064,7 @@ postConvQualifiedFederationNotEnabled = do connectWithRemoteUser alice bob let federatorNotConfigured = optFederator .~ Nothing withSettingsOverrides federatorNotConfigured $ do - g <- view tsGalley + g <- viewGalley postConvHelper g alice [bob] !!! do const 400 === statusCode const (Just "federation-not-enabled") === fmap label . responseJsonUnsafe @@ -2100,7 +2100,7 @@ postO2OConvOk = do postConvO2OFailWithSelf :: TestM () postConvO2OFailWithSelf = do - g <- view tsGalley + g <- viewGalley alice <- randomUser 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 @@ -2221,7 +2221,7 @@ postRepeatConnectConvCancel = do privateAccess @=? cnvAccess cnv4 where cancel u c = do - g <- view tsGalley + g <- viewGalley let cnvId = qUnqualified . cnvQualifiedId put (g . paths ["/i/conversations", toByteString' (cnvId c), "block"] . zUser u) !!! const 200 === statusCode @@ -2229,7 +2229,7 @@ postRepeatConnectConvCancel = do putBlockConvOk :: TestM () putBlockConvOk = do - g <- view tsGalley + g <- viewGalley alice <- randomUser bob <- randomUser conv <- responseJsonUnsafeWithMsg "conversation" <$> postConnectConv alice bob "Alice" "connect with me!" (Just "me@me.com") @@ -2289,7 +2289,7 @@ getConvQualifiedOk = do accessConvMeta :: TestM () accessConvMeta = do - g <- view tsGalley + g <- viewGalley alice <- randomUser bob <- randomUser chuck <- randomUser @@ -3114,7 +3114,7 @@ putQualifiedConvRenameWithRemotesOk = do putConvDeprecatedRenameOk :: TestM () putConvDeprecatedRenameOk = do c <- view tsCannon - g <- view tsGalley + g <- viewGalley alice <- randomUser qbob <- randomQualifiedUser let bob = qUnqualified qbob @@ -3600,7 +3600,7 @@ putReceiptModeWithRemotesOk = do postTypingIndicators :: TestM () postTypingIndicators = do - g <- view tsGalley + g <- viewGalley alice <- randomUser bob <- randomUser connectUsers alice (singleton bob) diff --git a/services/galley/test/integration/API/CustomBackend.hs b/services/galley/test/integration/API/CustomBackend.hs index 4f427c2f7d3..3da26252beb 100644 --- a/services/galley/test/integration/API/CustomBackend.hs +++ b/services/galley/test/integration/API/CustomBackend.hs @@ -20,9 +20,9 @@ module API.CustomBackend ) where +import API.Util import Bilge hiding (timeout) import Bilge.Assert -import Control.Lens (view) import Data.Aeson hiding (json) import Data.Aeson.QQ (aesonQQ) import Imports @@ -43,13 +43,13 @@ tests s = getByDomainNotFound :: TestM () getByDomainNotFound = do - galley <- view tsGalley + galley <- viewGalley get (galley . path "/custom-backend/by-domain/domain.no1") !!! do const 404 === statusCode getByDomainInvalidDomain :: TestM () getByDomainInvalidDomain = do - galley <- view tsGalley + galley <- viewGalley -- contains invalid character '+' -- this used to respond with '400 bad request' -- but after servantification it returns '404 not found' @@ -59,7 +59,7 @@ getByDomainInvalidDomain = do getByDomainFound :: TestM () getByDomainFound = do - galley <- view tsGalley + galley <- viewGalley let jsonBody :: Value jsonBody = [aesonQQ|{ @@ -74,7 +74,7 @@ getByDomainFound = do getByDomainDeleted :: TestM () getByDomainDeleted = do - galley <- view tsGalley + galley <- viewGalley let jsonBody :: Value jsonBody = [aesonQQ|{ @@ -90,7 +90,7 @@ getByDomainDeleted = do getByDomainIsCaseInsensitive :: TestM () getByDomainIsCaseInsensitive = do - galley <- view tsGalley + galley <- viewGalley let jsonBody :: Value jsonBody = [aesonQQ|{ diff --git a/services/galley/test/integration/API/MLS/Util.hs b/services/galley/test/integration/API/MLS/Util.hs index 436b7673f1b..3e7f6c8eb91 100644 --- a/services/galley/test/integration/API/MLS/Util.hs +++ b/services/galley/test/integration/API/MLS/Util.hs @@ -110,7 +110,7 @@ postMessage :: postMessage sender msg = do galley <- viewGalley post - ( galley . paths ["v2", "mls", "messages"] + ( galley . paths ["mls", "messages"] . zUser sender . zConn "conn" . content "message/mls" @@ -131,7 +131,7 @@ postCommitBundle :: postCommitBundle sender bundle = do galley <- viewGalley post - ( galley . paths ["v2", "mls", "commit-bundles"] + ( galley . paths ["mls", "commit-bundles"] . zUser sender . zConn "conn" . content "message/mls" @@ -209,6 +209,9 @@ instance HasGalley MLSTest where viewGalley = MLSTest $ lift viewGalley viewGalleyOpts = MLSTest $ lift viewGalleyOpts +instance HasBrig MLSTest where + viewBrig = MLSTest $ lift viewBrig + instance HasSettingsOverrides MLSTest where withSettingsOverrides f (MLSTest action) = MLSTest $ State.StateT $ \s -> @@ -273,7 +276,7 @@ createLocalMLSClient (qUntagged -> qusr) = do -- set public key pkey <- mlscli qcid ["public-key"] Nothing - brig <- view tsBrig + brig <- viewBrig let update = defUpdateClient {updateClientMLSPublicKeys = Map.singleton Ed25519 pkey} put ( brig @@ -305,7 +308,7 @@ uploadNewKeyPackage qcid = do (kp, _) <- generateKeyPackage qcid -- upload key package - brig <- view tsBrig + brig <- viewBrig post ( brig . paths ["mls", "key-packages", "self", toByteString' . ciClient $ qcid] @@ -437,7 +440,7 @@ keyPackageFile qcid ref = claimLocalKeyPackages :: HasCallStack => ClientIdentity -> Local UserId -> MLSTest KeyPackageBundle claimLocalKeyPackages qcid lusr = do - brig <- view tsBrig + brig <- viewBrig responseJsonError =<< post ( brig @@ -460,7 +463,7 @@ getUserClients qusr = do -- | Generate one key package for each client of a remote user claimRemoteKeyPackages :: HasCallStack => Remote UserId -> MLSTest KeyPackageBundle claimRemoteKeyPackages (qUntagged -> qusr) = do - brig <- view tsBrig + brig <- viewBrig clients <- getUserClients qusr bundle <- fmap (KeyPackageBundle . Set.fromList) $ for clients $ \cid -> do diff --git a/services/galley/test/integration/API/Roles.hs b/services/galley/test/integration/API/Roles.hs index 1f55cfe02a3..ec4a5dc80da 100644 --- a/services/galley/test/integration/API/Roles.hs +++ b/services/galley/test/integration/API/Roles.hs @@ -67,7 +67,7 @@ testAllConversationRoles = do connectUsers alice (list1 bob [chuck]) let role = roleNameWireAdmin c <- decodeConvId <$> postConvWithRole alice [bob] (Just "gossip") [] Nothing Nothing role - g <- view tsGalley + g <- viewGalley get ( g . paths ["conversations", toByteString' c, "roles"] diff --git a/services/galley/test/integration/API/Teams.hs b/services/galley/test/integration/API/Teams.hs index df7d9fe6f31..353280ac05d 100644 --- a/services/galley/test/integration/API/Teams.hs +++ b/services/galley/test/integration/API/Teams.hs @@ -74,8 +74,8 @@ import Test.Tasty import Test.Tasty.Cannon (TimeoutUnit (..), (#)) import qualified Test.Tasty.Cannon as WS import Test.Tasty.HUnit -import TestHelpers (eventually, test, viewFederationDomain) -import TestSetup (TestM, TestSetup, tsBrig, tsCannon, tsGConf, tsGalley) +import TestHelpers +import TestSetup import UnliftIO (mapConcurrently) import Wire.API.Conversation import Wire.API.Conversation.Protocol @@ -302,7 +302,7 @@ testListTeamMembersCsv numMembers = do addClient :: UserId -> Int -> TestM () addClient uid i = do - brig <- view tsBrig + brig <- viewBrig post (brig . paths ["i", "clients", toByteString' uid] . contentJson . json (newClient (someLastPrekeys !! i)) . queryItem "skip_reauth" "true") !!! const 201 === statusCode newClient :: PC.LastPrekey -> C.NewClient @@ -381,7 +381,7 @@ testEnableSSOPerTeam = do liftIO $ assertEqual msg enabledness statusValue let putSSOEnabledInternalCheckNotImplemented :: HasCallStack => TestM () putSSOEnabledInternalCheckNotImplemented = do - g <- view tsGalley + g <- viewGalley Wai.Error status label _ _ <- responseJsonUnsafe <$> put @@ -405,27 +405,27 @@ testEnableTeamSearchVisibilityPerTeam = do (tid, owner, member : _) <- Util.createBindingTeamWithMembers 2 let check :: String -> Public.FeatureStatus -> TestM () check msg enabledness = do - g <- view tsGalley + g <- viewGalley status :: Public.WithStatusNoLock Public.SearchVisibilityAvailableConfig <- responseJsonUnsafe <$> (Util.getTeamSearchVisibilityAvailableInternal g tid putSearchVisibility g owner tid SearchVisibilityNoNameOutsideTeam liftIO $ do assertEqual "bad status" status403 status assertEqual "bad label" "team-search-visibility-not-enabled" label let getSearchVisibilityCheck :: TeamSearchVisibility -> TestM () getSearchVisibilityCheck vis = do - g <- view tsGalley + g <- viewGalley getSearchVisibility g owner tid !!! do const 200 === statusCode const (Just (TeamSearchVisibilityView vis)) === responseJsonUnsafe Util.withCustomSearchFeature FeatureTeamSearchVisibilityAvailableByDefault $ do - g <- view tsGalley + g <- viewGalley check "Teams should start with Custom Search Visibility enabled" Public.FeatureStatusEnabled putSearchVisibility g owner tid SearchVisibilityNoNameOutsideTeam !!! const 204 === statusCode putSearchVisibility g owner tid SearchVisibilityStandard !!! const 204 === statusCode @@ -433,7 +433,7 @@ testEnableTeamSearchVisibilityPerTeam = do check "Teams should start with Custom Search Visibility disabled" Public.FeatureStatusDisabled putSearchVisibilityCheckNotAllowed - g <- view tsGalley + g <- viewGalley Util.putTeamSearchVisibilityAvailableInternal g tid Public.FeatureStatusEnabled -- Nothing was set, default value getSearchVisibilityCheck SearchVisibilityStandard @@ -563,7 +563,7 @@ testAddTeamMemberInternal = do testRemoveBindingTeamMember :: Bool -> TestM () testRemoveBindingTeamMember ownerHasPassword = do localDomain <- viewFederationDomain - g <- view tsGalley + g <- viewGalley c <- view tsCannon -- Owner who creates the team must have an email, This is why we run all tests with a second -- owner @@ -686,7 +686,7 @@ testRemoveBindingTeamOwner = do where check :: HasCallStack => TeamId -> UserId -> UserId -> Maybe PlainTextPassword -> Maybe LText -> TestM () check tid deleter deletee pass maybeError = do - g <- view tsGalley + g <- viewGalley delete ( g . paths ["teams", toByteString' tid, "members", toByteString' deletee] @@ -910,7 +910,7 @@ testUpdateTeamConv _ convRole = do testDeleteBindingTeamSingleMember :: TestM () testDeleteBindingTeamSingleMember = do - g <- view tsGalley + g <- viewGalley c <- view tsCannon (owner, tid) <- Util.createBindingTeam other <- Util.addUserToTeam owner tid @@ -971,7 +971,7 @@ testDeleteBindingTeamSingleMember = do testDeleteBindingTeamNoMembers :: TestM () testDeleteBindingTeamNoMembers = do - g <- view tsGalley + g <- viewGalley (owner, tid) <- Util.createBindingTeam deleteUser owner !!! const 200 === statusCode ensureQueueEmpty @@ -982,8 +982,8 @@ testDeleteBindingTeamNoMembers = do testDeleteBindingTeamMoreThanOneMember :: TestM () testDeleteBindingTeamMoreThanOneMember = do - g <- view tsGalley - b <- view tsBrig + g <- viewGalley + b <- viewBrig c <- view tsCannon (alice, tid, members) <- Util.createBindingTeamWithNMembers 10 ensureQueueEmpty @@ -1011,7 +1011,7 @@ testDeleteBindingTeamMoreThanOneMember = do testDeleteTeamVerificationCodeSuccess :: TestM () testDeleteTeamVerificationCodeSuccess = do - g <- view tsGalley + g <- viewGalley (owner, tid) <- Util.createBindingTeam' let Just email = U.userEmail owner setFeatureLockStatus @Public.SndFactorPasswordChallengeConfig tid Public.LockStatusUnlocked @@ -1035,7 +1035,7 @@ testDeleteTeamVerificationCodeSuccess = do -- Test that team cannot be deleted with missing second factor email verification code when this feature is enabled testDeleteTeamVerificationCodeMissingCode :: TestM () testDeleteTeamVerificationCodeMissingCode = do - g <- view tsGalley + g <- viewGalley (owner, tid) <- Util.createBindingTeam' setFeatureLockStatus @Public.SndFactorPasswordChallengeConfig tid Public.LockStatusUnlocked setTeamSndFactorPasswordChallenge tid Public.FeatureStatusEnabled @@ -1060,7 +1060,7 @@ testDeleteTeamVerificationCodeMissingCode = do -- Test that team cannot be deleted with expired second factor email verification code when this feature is enabled testDeleteTeamVerificationCodeExpiredCode :: TestM () testDeleteTeamVerificationCodeExpiredCode = do - g <- view tsGalley + g <- viewGalley (owner, tid) <- Util.createBindingTeam' setFeatureLockStatus @Public.SndFactorPasswordChallengeConfig tid Public.LockStatusUnlocked setTeamSndFactorPasswordChallenge tid Public.FeatureStatusEnabled @@ -1088,7 +1088,7 @@ testDeleteTeamVerificationCodeExpiredCode = do -- Test that team cannot be deleted with wrong second factor email verification code when this feature is enabled testDeleteTeamVerificationCodeWrongCode :: TestM () testDeleteTeamVerificationCodeWrongCode = do - g <- view tsGalley + g <- viewGalley (owner, tid) <- Util.createBindingTeam' setFeatureLockStatus @Public.SndFactorPasswordChallengeConfig tid Public.LockStatusUnlocked setTeamSndFactorPasswordChallenge tid Public.FeatureStatusEnabled @@ -1111,24 +1111,24 @@ testDeleteTeamVerificationCodeWrongCode = do setFeatureLockStatus :: forall cfg. (Public.IsFeatureConfig cfg, KnownSymbol (Public.FeatureSymbol cfg)) => TeamId -> Public.LockStatus -> TestM () setFeatureLockStatus tid status = do - g <- view tsGalley + g <- viewGalley put (g . paths ["i", "teams", toByteString' tid, "features", Public.featureNameBS @cfg, toByteString' status]) !!! const 200 === statusCode generateVerificationCode :: Public.SendVerificationCode -> TestM () generateVerificationCode req = do - brig <- view tsBrig + brig <- viewBrig let js = RequestBodyLBS $ encode req post (brig . paths ["verification-code", "send"] . contentJson . body js) !!! const 200 === statusCode setTeamSndFactorPasswordChallenge :: TeamId -> Public.FeatureStatus -> TestM () setTeamSndFactorPasswordChallenge tid status = do - g <- view tsGalley + g <- viewGalley let js = RequestBodyLBS $ encode $ Public.WithStatusNoLock status Public.SndFactorPasswordChallengeConfig Public.FeatureTTLUnlimited put (g . paths ["i", "teams", toByteString' tid, "features", Public.featureNameBS @Public.SndFactorPasswordChallengeConfig] . contentJson . body js) !!! const 200 === statusCode getVerificationCode :: UserId -> Public.VerificationAction -> TestM Code.Value getVerificationCode uid action = do - brig <- view tsBrig + brig <- viewBrig resp <- get (brig . paths ["i", "users", toByteString' uid, "verification-code", toByteString' action]) TestM () testDeleteBindingTeam ownerHasPassword = do - g <- view tsGalley + g <- viewGalley c <- view tsCannon (ownerWithPassword, tid) <- Util.createBindingTeam ownerMem <- @@ -1272,7 +1272,7 @@ testDeleteTeamConv = do testUpdateTeamIconValidation :: TestM () testUpdateTeamIconValidation = do - g <- view tsGalley + g <- viewGalley (tid, owner, _) <- Util.createBindingTeamWithMembers 2 let update payload expectedStatusCode = put @@ -1297,7 +1297,7 @@ testUpdateTeamIconValidation = do testUpdateTeam :: TestM () testUpdateTeam = do - g <- view tsGalley + g <- viewGalley c <- view tsCannon (tid, owner, [member]) <- Util.createBindingTeamWithMembers 2 @@ -1402,7 +1402,7 @@ testTeamAddRemoveMemberAboveThresholdNoEvents = do modifyUserProfileAndExpectEvent :: HasCallStack => Bool -> UserId -> [UserId] -> TestM () modifyUserProfileAndExpectEvent expect target listeners = do c <- view tsCannon - b <- view tsBrig + b <- viewBrig WS.bracketRN c listeners $ \wsListeners -> do -- Do something let u = U.UserUpdate (Just $ U.Name "name") Nothing Nothing Nothing @@ -1421,7 +1421,7 @@ testTeamAddRemoveMemberAboveThresholdNoEvents = do modifyTeamDataAndExpectEvent :: HasCallStack => Bool -> TeamId -> UserId -> TestM () modifyTeamDataAndExpectEvent expect tid origin = do c <- view tsCannon - g <- view tsGalley + g <- viewGalley let u = newTeamUpdateData & nameUpdate .~ (Just $ unsafeRange "bar") WS.bracketR c origin $ \wsOrigin -> do put @@ -1450,7 +1450,7 @@ testTeamAddRemoveMemberAboveThresholdNoEvents = do removeTeamMemberAndExpectEvent :: HasCallStack => Bool -> UserId -> TeamId -> UserId -> [UserId] -> TestM () removeTeamMemberAndExpectEvent expect owner tid victim others = do c <- view tsCannon - g <- view tsGalley + g <- viewGalley WS.bracketRN c (owner : victim : others) $ \(wsOwner : _wsVictim : wsOthers) -> do delete ( g @@ -1470,7 +1470,7 @@ testTeamAddRemoveMemberAboveThresholdNoEvents = do deleteTeam :: HasCallStack => TeamId -> UserId -> [UserId] -> [Qualified ConvId] -> UserId -> TestM () deleteTeam tid owner otherRealUsersInTeam teamCidsThatExternBelongsTo extern = do c <- view tsCannon - g <- view tsGalley + g <- viewGalley void . WS.bracketRN c (owner : extern : otherRealUsersInTeam) $ \(_wsOwner : wsExtern : _wsotherRealUsersInTeam) -> do delete ( g @@ -1497,7 +1497,7 @@ testBillingInLargeTeam = do (firstOwner, team) <- Util.createBindingTeam refreshIndex opts <- view tsGConf - galley <- view tsGalley + galley <- viewGalley let fanoutLimit = fromRange $ Galley.currentFanoutLimit opts allOwnersBeforeFanoutLimit <- foldM @@ -1534,7 +1534,7 @@ testBillingInLargeTeamWithoutIndexedBillingTeamMembers = do (firstOwner, team) <- Util.createBindingTeam refreshIndex opts <- view tsGConf - galley <- view tsGalley + galley <- viewGalley let withoutIndexedBillingTeamMembers = withSettingsOverrides (\o -> o & optSettings . setEnableIndexedBillingTeamMembers ?~ False) let fanoutLimit = fromRange $ Galley.currentFanoutLimit opts @@ -1566,7 +1566,7 @@ testBillingInLargeTeamWithoutIndexedBillingTeamMembers = do -- We cannot properly add the new owner with an invite as we don't have a way to -- override galley settings while making a call to brig withoutIndexedBillingTeamMembers $ do - g <- view tsGalley + g <- viewGalley post (g . paths ["i", "teams", toByteString' team, "members"] . memFanoutPlusTwo) !!! const 200 === statusCode assertQueue ("add " <> show (fanoutLimit + 2) <> "th billing member: " <> show ownerFanoutPlusTwo) $ @@ -1632,7 +1632,7 @@ testBillingInLargeTeamWithoutIndexedBillingTeamMembers = do -- Demotion by inferior roles is NOT allowed. testUpdateTeamMember :: TestM () testUpdateTeamMember = do - g <- view tsGalley + g <- viewGalley c <- view tsCannon (owner, tid) <- Util.createBindingTeam member <- Util.addUserToTeamWithRole (Just RoleAdmin) owner tid @@ -1698,7 +1698,7 @@ testUpdateTeamMember = do testUpdateTeamStatus :: TestM () testUpdateTeamStatus = do - g <- view tsGalley + g <- viewGalley (_, tid) <- Util.createBindingTeam -- Check for idempotency Util.changeTeamStatus tid TeamsIntra.Active diff --git a/services/galley/test/integration/API/Teams/Feature.hs b/services/galley/test/integration/API/Teams/Feature.hs index 701aad80902..cf56f46ddd0 100644 --- a/services/galley/test/integration/API/Teams/Feature.hs +++ b/services/galley/test/integration/API/Teams/Feature.hs @@ -19,9 +19,8 @@ module API.Teams.Feature (tests) where import API.SQS (assertQueue, tActivate) -import API.Util (HasGalley, getFeatureStatusMulti, withSettingsOverrides) -import qualified API.Util as Util -import API.Util.TeamFeature (patchFeatureStatusInternal, putTeamFeatureFlagWithGalley) +import API.Util +import API.Util.TeamFeature hiding (getFeatureConfig, setLockStatusInternal) import qualified API.Util.TeamFeature as Util import Bilge import Bilge.Assert @@ -225,10 +224,10 @@ testPatch' :: cfg -> TestM () testPatch' testLockStatusChange rndFeatureConfig defStatus defConfig = do - (_, tid) <- Util.createBindingTeam - Just original <- responseJsonMaybe <$> Util.getFeatureStatusInternal @cfg tid + (_, tid) <- createBindingTeam + Just original <- responseJsonMaybe <$> getFeatureStatusInternal @cfg tid patchFeatureStatusInternal tid rndFeatureConfig !!! statusCode === const 200 - Just actual <- responseJsonMaybe <$> Util.getFeatureStatusInternal @cfg tid + Just actual <- responseJsonMaybe <$> getFeatureStatusInternal @cfg tid liftIO $ if Public.wsLockStatus actual == Public.LockStatusLocked then do @@ -242,19 +241,19 @@ testPatch' testLockStatusChange rndFeatureConfig defStatus defConfig = do testSSO :: (TeamId -> Public.FeatureStatus -> TestM ()) -> TestM () testSSO setSSOFeature = do - (_owner, tid, member : _) <- Util.createBindingTeamWithNMembers 1 - nonMember <- Util.randomUser + (_owner, tid, member : _) <- createBindingTeamWithNMembers 1 + nonMember <- randomUser let getSSO :: HasCallStack => Public.FeatureStatus -> TestM () - getSSO = assertFlagNoConfig @Public.SSOConfig $ Util.getTeamFeatureFlag @Public.SSOConfig member tid + getSSO = assertFlagNoConfig @Public.SSOConfig $ getTeamFeatureFlag @Public.SSOConfig member tid getSSOFeatureConfig :: HasCallStack => Public.FeatureStatus -> TestM () getSSOFeatureConfig expectedStatus = do actual <- Util.getFeatureConfig @Public.SSOConfig member liftIO $ Public.wsStatus actual @?= expectedStatus getSSOInternal :: HasCallStack => Public.FeatureStatus -> TestM () - getSSOInternal = assertFlagNoConfig @Public.SSOConfig $ Util.getTeamFeatureFlagInternal @Public.SSOConfig tid + getSSOInternal = assertFlagNoConfig @Public.SSOConfig $ getTeamFeatureFlagInternal @Public.SSOConfig tid - assertFlagForbidden $ Util.getTeamFeatureFlag @Public.SSOConfig nonMember tid + assertFlagForbidden $ getTeamFeatureFlag @Public.SSOConfig nonMember tid featureSSO <- view (tsGConf . optSettings . setFeatureFlags . flagSSO) case featureSSO of @@ -278,20 +277,20 @@ testSSO setSSOFeature = do putSSOInternal :: HasCallStack => TeamId -> Public.FeatureStatus -> TestM () putSSOInternal tid = - void . Util.putTeamFeatureFlagInternal @Public.SSOConfig expect2xx tid + void . putTeamFeatureFlagInternal @Public.SSOConfig expect2xx tid . (\st -> Public.WithStatusNoLock st Public.SSOConfig Public.FeatureTTLUnlimited) patchSSOInternal :: HasCallStack => TeamId -> Public.FeatureStatus -> TestM () -patchSSOInternal tid status = void $ Util.patchFeatureStatusInternalWithMod @Public.SSOConfig expect2xx tid (Public.withStatus' (Just status) Nothing Nothing (Just Public.FeatureTTLUnlimited)) +patchSSOInternal tid status = void $ patchFeatureStatusInternalWithMod @Public.SSOConfig expect2xx tid (Public.withStatus' (Just status) Nothing Nothing (Just Public.FeatureTTLUnlimited)) testLegalHold :: ((Request -> Request) -> TeamId -> Public.FeatureStatus -> TestM ()) -> TestM () testLegalHold setLegalHoldInternal = do - (_owner, tid, member : _) <- Util.createBindingTeamWithNMembers 1 - nonMember <- Util.randomUser + (_owner, tid, member : _) <- createBindingTeamWithNMembers 1 + nonMember <- randomUser let getLegalHold :: HasCallStack => Public.FeatureStatus -> TestM () - getLegalHold = assertFlagNoConfig @Public.LegalholdConfig $ Util.getTeamFeatureFlag @Public.LegalholdConfig member tid + getLegalHold = assertFlagNoConfig @Public.LegalholdConfig $ getTeamFeatureFlag @Public.LegalholdConfig member tid getLegalHoldInternal :: HasCallStack => Public.FeatureStatus -> TestM () - getLegalHoldInternal = assertFlagNoConfig @Public.LegalholdConfig $ Util.getTeamFeatureFlagInternal @Public.LegalholdConfig tid + getLegalHoldInternal = assertFlagNoConfig @Public.LegalholdConfig $ getTeamFeatureFlagInternal @Public.LegalholdConfig tid getLegalHoldFeatureConfig expectedStatus = do actual <- Util.getFeatureConfig @Public.LegalholdConfig member liftIO $ Public.wsStatus actual @?= expectedStatus @@ -299,7 +298,7 @@ testLegalHold setLegalHoldInternal = do getLegalHold Public.FeatureStatusDisabled getLegalHoldInternal Public.FeatureStatusDisabled - assertFlagForbidden $ Util.getTeamFeatureFlag @Public.LegalholdConfig nonMember tid + assertFlagForbidden $ getTeamFeatureFlag @Public.LegalholdConfig nonMember tid -- FUTUREWORK: run two galleys, like below for custom search visibility. featureLegalHold <- view (tsGConf . optSettings . setFeatureFlags . flagLegalHold) @@ -326,25 +325,25 @@ testLegalHold setLegalHoldInternal = do putLegalHoldInternal :: HasCallStack => (Request -> Request) -> TeamId -> Public.FeatureStatus -> TestM () putLegalHoldInternal expectation tid = - void . Util.putTeamFeatureFlagInternal @Public.LegalholdConfig expectation tid + void . putTeamFeatureFlagInternal @Public.LegalholdConfig expectation tid . (\st -> Public.WithStatusNoLock st Public.LegalholdConfig Public.FeatureTTLUnlimited) patchLegalHoldInternal :: HasCallStack => (Request -> Request) -> TeamId -> Public.FeatureStatus -> TestM () -patchLegalHoldInternal expectation tid status = void $ Util.patchFeatureStatusInternalWithMod @Public.LegalholdConfig expectation tid (Public.withStatus' (Just status) Nothing Nothing (Just Public.FeatureTTLUnlimited)) +patchLegalHoldInternal expectation tid status = void $ patchFeatureStatusInternalWithMod @Public.LegalholdConfig expectation tid (Public.withStatus' (Just status) Nothing Nothing (Just Public.FeatureTTLUnlimited)) testSearchVisibility :: TestM () testSearchVisibility = do let getTeamSearchVisibility :: TeamId -> UserId -> Public.FeatureStatus -> TestM () getTeamSearchVisibility teamid uid expected = do - g <- view tsGalley - Util.getTeamSearchVisibilityAvailable g uid teamid !!! do + g <- viewGalley + getTeamSearchVisibilityAvailable g uid teamid !!! do statusCode === const 200 responseJsonEither === const (Right (Public.WithStatusNoLock expected Public.SearchVisibilityAvailableConfig Public.FeatureTTLUnlimited)) let getTeamSearchVisibilityInternal :: TeamId -> Public.FeatureStatus -> TestM () getTeamSearchVisibilityInternal teamid expected = do - g <- view tsGalley - Util.getTeamSearchVisibilityAvailableInternal g teamid !!! do + g <- viewGalley + getTeamSearchVisibilityAvailableInternal g teamid !!! do statusCode === const 200 responseJsonEither === const (Right (Public.WithStatusNoLock expected Public.SearchVisibilityAvailableConfig Public.FeatureTTLUnlimited)) @@ -355,15 +354,15 @@ testSearchVisibility = do let setTeamSearchVisibilityInternal :: TeamId -> Public.FeatureStatus -> TestM () setTeamSearchVisibilityInternal teamid val = do - g <- view tsGalley - Util.putTeamSearchVisibilityAvailableInternal g teamid val + g <- viewGalley + putTeamSearchVisibilityAvailableInternal g teamid val - (owner, tid, [member]) <- Util.createBindingTeamWithNMembers 1 - nonMember <- Util.randomUser + (owner, tid, [member]) <- createBindingTeamWithNMembers 1 + nonMember <- randomUser - assertFlagForbidden $ Util.getTeamFeatureFlag @Public.SearchVisibilityAvailableConfig nonMember tid + assertFlagForbidden $ getTeamFeatureFlag @Public.SearchVisibilityAvailableConfig nonMember tid - Util.withCustomSearchFeature FeatureTeamSearchVisibilityUnavailableByDefault $ do + withCustomSearchFeature FeatureTeamSearchVisibilityUnavailableByDefault $ do getTeamSearchVisibility tid owner Public.FeatureStatusDisabled getTeamSearchVisibilityInternal tid Public.FeatureStatusDisabled getTeamSearchVisibilityFeatureConfig member Public.FeatureStatusDisabled @@ -378,9 +377,9 @@ testSearchVisibility = do getTeamSearchVisibilityInternal tid Public.FeatureStatusDisabled getTeamSearchVisibilityFeatureConfig member Public.FeatureStatusDisabled - (owner2, tid2, team2member : _) <- Util.createBindingTeamWithNMembers 1 + (owner2, tid2, team2member : _) <- createBindingTeamWithNMembers 1 - Util.withCustomSearchFeature FeatureTeamSearchVisibilityAvailableByDefault $ do + withCustomSearchFeature FeatureTeamSearchVisibilityAvailableByDefault $ do getTeamSearchVisibility tid2 owner2 Public.FeatureStatusEnabled getTeamSearchVisibilityInternal tid2 Public.FeatureStatusEnabled getTeamSearchVisibilityFeatureConfig team2member Public.FeatureStatusEnabled @@ -403,7 +402,7 @@ getClassifiedDomains :: m () getClassifiedDomains member tid = assertFlagWithConfig @Public.ClassifiedDomainsConfig $ - Util.getTeamFeatureFlag @Public.ClassifiedDomainsConfig member tid + getTeamFeatureFlag @Public.ClassifiedDomainsConfig member tid getClassifiedDomainsInternal :: (HasCallStack, HasGalley m, MonadIO m, MonadHttp m, MonadCatch m) => @@ -412,11 +411,11 @@ getClassifiedDomainsInternal :: m () getClassifiedDomainsInternal tid = assertFlagWithConfig @Public.ClassifiedDomainsConfig $ - Util.getTeamFeatureFlagInternal @Public.ClassifiedDomainsConfig tid + getTeamFeatureFlagInternal @Public.ClassifiedDomainsConfig tid testClassifiedDomainsEnabled :: TestM () testClassifiedDomainsEnabled = do - (_owner, tid, member : _) <- Util.createBindingTeamWithNMembers 1 + (_owner, tid, member : _) <- createBindingTeamWithNMembers 1 let expected = Public.WithStatusNoLock Public.FeatureStatusEnabled (Public.ClassifiedDomainsConfig [Domain "example.com"]) Public.FeatureTTLUnlimited @@ -436,7 +435,7 @@ testClassifiedDomainsEnabled = do testClassifiedDomainsDisabled :: TestM () testClassifiedDomainsDisabled = do - (_owner, tid, member : _) <- Util.createBindingTeamWithNMembers 1 + (_owner, tid, member : _) <- createBindingTeamWithNMembers 1 let expected = Public.WithStatusNoLock Public.FeatureStatusDisabled (Public.ClassifiedDomainsConfig []) Public.FeatureTTLUnlimited @@ -491,12 +490,12 @@ testSimpleFlagTTLOverride :: FeatureTTL -> TestM () testSimpleFlagTTLOverride defaultValue ttl ttlAfter = do - (_owner, tid, member : _) <- Util.createBindingTeamWithNMembers 1 - nonMember <- Util.randomUser + (_owner, tid, member : _) <- createBindingTeamWithNMembers 1 + nonMember <- randomUser let getFlag :: HasCallStack => Public.FeatureStatus -> TestM () getFlag expected = eventually $ do - flip (assertFlagNoConfig @cfg) expected $ Util.getTeamFeatureFlag @cfg member tid + flip (assertFlagNoConfig @cfg) expected $ getTeamFeatureFlag @cfg member tid getFeatureConfig :: HasCallStack => Public.FeatureStatus -> FeatureTTL -> TestM () getFeatureConfig expectedStatus expectedTtl = eventually $ do @@ -506,11 +505,11 @@ testSimpleFlagTTLOverride defaultValue ttl ttlAfter = do getFlagInternal :: HasCallStack => Public.FeatureStatus -> TestM () getFlagInternal expected = eventually $ do - flip (assertFlagNoConfig @cfg) expected $ Util.getTeamFeatureFlagInternal @cfg tid + flip (assertFlagNoConfig @cfg) expected $ getTeamFeatureFlagInternal @cfg tid setFlagInternal :: Public.FeatureStatus -> FeatureTTL -> TestM () setFlagInternal statusValue ttl' = - void $ Util.putTeamFeatureFlagInternalTTL @cfg expect2xx tid (Public.WithStatusNoLock statusValue (Public.trivialConfig @cfg) ttl') + void $ putTeamFeatureFlagInternalTTL @cfg expect2xx tid (Public.WithStatusNoLock statusValue (Public.trivialConfig @cfg) ttl') select :: PrepQuery R (Identity TeamId) (Identity (Maybe FeatureTTL)) select = fromString "select ttl(conference_calling) from team_features where team_id = ?" @@ -537,7 +536,7 @@ testSimpleFlagTTLOverride defaultValue ttl ttlAfter = do toMicros secs = fromIntegral secs * 1000000 - assertFlagForbidden $ Util.getTeamFeatureFlag @cfg nonMember tid + assertFlagForbidden $ getTeamFeatureFlag @cfg nonMember tid let otherValue = case defaultValue of Public.FeatureStatusDisabled -> Public.FeatureStatusEnabled @@ -618,12 +617,12 @@ testSimpleFlagTTL :: FeatureTTL -> TestM () testSimpleFlagTTL defaultValue ttl = do - (_owner, tid, member : _) <- Util.createBindingTeamWithNMembers 1 - nonMember <- Util.randomUser + (_owner, tid, member : _) <- createBindingTeamWithNMembers 1 + nonMember <- randomUser let getFlag :: HasCallStack => Public.FeatureStatus -> TestM () getFlag expected = - flip (assertFlagNoConfig @cfg) expected $ Util.getTeamFeatureFlag @cfg member tid + flip (assertFlagNoConfig @cfg) expected $ getTeamFeatureFlag @cfg member tid getFeatureConfig :: HasCallStack => Public.FeatureStatus -> TestM () getFeatureConfig expected = do @@ -632,11 +631,11 @@ testSimpleFlagTTL defaultValue ttl = do getFlagInternal :: HasCallStack => Public.FeatureStatus -> TestM () getFlagInternal expected = - flip (assertFlagNoConfig @cfg) expected $ Util.getTeamFeatureFlagInternal @cfg tid + flip (assertFlagNoConfig @cfg) expected $ getTeamFeatureFlagInternal @cfg tid setFlagInternal :: Public.FeatureStatus -> FeatureTTL -> TestM () setFlagInternal statusValue ttl' = - void $ Util.putTeamFeatureFlagInternalTTL @cfg expect2xx tid (Public.WithStatusNoLock statusValue (Public.trivialConfig @cfg) ttl') + void $ putTeamFeatureFlagInternalTTL @cfg expect2xx tid (Public.WithStatusNoLock statusValue (Public.trivialConfig @cfg) ttl') select :: PrepQuery R (Identity TeamId) (Identity (Maybe FeatureTTL)) select = fromString "select ttl(conference_calling) from team_features where team_id = ?" @@ -661,7 +660,7 @@ testSimpleFlagTTL defaultValue ttl = do Just (FeatureTTLSeconds i) -> i <= upper unless check $ error ("expected ttl <= " <> show upper <> ", got " <> show storedTTL) - assertFlagForbidden $ Util.getTeamFeatureFlag @cfg nonMember tid + assertFlagForbidden $ getTeamFeatureFlag @cfg nonMember tid let otherValue = case defaultValue of Public.FeatureStatusDisabled -> Public.FeatureStatusEnabled @@ -716,13 +715,13 @@ testSimpleFlagWithLockStatus :: Public.LockStatus -> TestM () testSimpleFlagWithLockStatus defaultStatus defaultLockStatus = do - galley <- view tsGalley - (owner, tid, member : _) <- Util.createBindingTeamWithNMembers 1 - nonMember <- Util.randomUser + galley <- viewGalley + (owner, tid, member : _) <- createBindingTeamWithNMembers 1 + nonMember <- randomUser let getFlag :: HasCallStack => Public.FeatureStatus -> Public.LockStatus -> TestM () getFlag expectedStatus expectedLockStatus = do - let flag = Util.getTeamFeatureFlag @cfg member tid + let flag = getTeamFeatureFlag @cfg member tid assertFlagNoConfigWithLockStatus @cfg flag expectedStatus expectedLockStatus getFeatureConfig :: HasCallStack => Public.FeatureStatus -> Public.LockStatus -> TestM () @@ -733,7 +732,7 @@ testSimpleFlagWithLockStatus defaultStatus defaultLockStatus = do getFlagInternal :: HasCallStack => Public.FeatureStatus -> Public.LockStatus -> TestM () getFlagInternal expectedStatus expectedLockStatus = do - let flag = Util.getTeamFeatureFlagInternal @cfg tid + let flag = getTeamFeatureFlagInternal @cfg tid assertFlagNoConfigWithLockStatus @cfg flag expectedStatus expectedLockStatus getFlags expectedStatus expectedLockStatus = do @@ -743,12 +742,12 @@ testSimpleFlagWithLockStatus defaultStatus defaultLockStatus = do setFlagWithGalley :: Public.FeatureStatus -> TestM () setFlagWithGalley statusValue = - Util.putTeamFeatureFlagWithGalley @cfg galley owner tid (Public.WithStatusNoLock statusValue (Public.trivialConfig @cfg) Public.FeatureTTLUnlimited) + putTeamFeatureFlagWithGalley @cfg galley owner tid (Public.WithStatusNoLock statusValue (Public.trivialConfig @cfg) Public.FeatureTTLUnlimited) !!! statusCode === const 200 assertSetStatusForbidden :: Public.FeatureStatus -> TestM () assertSetStatusForbidden statusValue = - Util.putTeamFeatureFlagWithGalley @cfg galley owner tid (Public.WithStatusNoLock statusValue (Public.trivialConfig @cfg) Public.FeatureTTLUnlimited) + putTeamFeatureFlagWithGalley @cfg galley owner tid (Public.WithStatusNoLock statusValue (Public.trivialConfig @cfg) Public.FeatureTTLUnlimited) !!! statusCode === const 409 setLockStatus :: Public.LockStatus -> TestM () @@ -756,7 +755,7 @@ testSimpleFlagWithLockStatus defaultStatus defaultLockStatus = do Util.setLockStatusInternal @cfg galley tid lockStatus !!! statusCode === const 200 - assertFlagForbidden $ Util.getTeamFeatureFlag @cfg nonMember tid + assertFlagForbidden $ getTeamFeatureFlag @cfg nonMember tid let otherStatus = case defaultStatus of Public.FeatureStatusDisabled -> Public.FeatureStatusEnabled @@ -821,19 +820,19 @@ testSelfDeletingMessages = do (Public.SelfDeletingMessagesConfig tout) Public.FeatureTTLUnlimited - personalUser <- Util.randomUser + personalUser <- randomUser do result <- Util.getFeatureConfig @Public.SelfDeletingMessagesConfig personalUser liftIO $ result @?= settingWithLockStatus FeatureStatusEnabled 0 defLockStatus -- team users - galley <- view tsGalley - (owner, tid, []) <- Util.createBindingTeamWithNMembers 0 + galley <- viewGalley + (owner, tid, []) <- createBindingTeamWithNMembers 0 let checkSet :: FeatureStatus -> Int32 -> Int -> TestM () checkSet stat tout expectedStatusCode = do - Util.putTeamFeatureFlagInternal @Public.SelfDeletingMessagesConfig + putTeamFeatureFlagInternal @Public.SelfDeletingMessagesConfig galley tid (settingWithoutLockStatus stat tout) @@ -844,8 +843,8 @@ testSelfDeletingMessages = do checkGet stat tout lockStatus = do let expected = settingWithLockStatus stat tout lockStatus forM_ - [ Util.getTeamFeatureFlagInternal @Public.SelfDeletingMessagesConfig tid, - Util.getTeamFeatureFlagWithGalley @Public.SelfDeletingMessagesConfig galley owner tid + [ getTeamFeatureFlagInternal @Public.SelfDeletingMessagesConfig tid, + getTeamFeatureFlagWithGalley @Public.SelfDeletingMessagesConfig galley owner tid ] (!!! responseJsonEither === const (Right expected)) result <- Util.getFeatureConfig @Public.SelfDeletingMessagesConfig owner @@ -894,18 +893,18 @@ testSelfDeletingMessages = do testGuestLinksInternal :: TestM () testGuestLinksInternal = do - galley <- view tsGalley + galley <- viewGalley testGuestLinks - (const $ Util.getTeamFeatureFlagInternal @Public.GuestLinksConfig) - (const $ Util.putTeamFeatureFlagInternal @Public.GuestLinksConfig galley) + (const $ getTeamFeatureFlagInternal @Public.GuestLinksConfig) + (const $ putTeamFeatureFlagInternal @Public.GuestLinksConfig galley) (Util.setLockStatusInternal @Public.GuestLinksConfig galley) testGuestLinksPublic :: TestM () testGuestLinksPublic = do - galley <- view tsGalley + galley <- viewGalley testGuestLinks - (Util.getTeamFeatureFlagWithGalley @Public.GuestLinksConfig galley) - (Util.putTeamFeatureFlagWithGalley @Public.GuestLinksConfig galley) + (getTeamFeatureFlagWithGalley @Public.GuestLinksConfig galley) + (putTeamFeatureFlagWithGalley @Public.GuestLinksConfig galley) (Util.setLockStatusInternal @Public.GuestLinksConfig galley) testGuestLinks :: @@ -914,7 +913,7 @@ testGuestLinks :: (TeamId -> Public.LockStatus -> TestM ResponseLBS) -> TestM () testGuestLinks getStatus putStatus setLockStatusInternal = do - (owner, tid, []) <- Util.createBindingTeamWithNMembers 0 + (owner, tid, []) <- createBindingTeamWithNMembers 0 let checkGet :: HasCallStack => Public.FeatureStatus -> Public.LockStatus -> TestM () checkGet status lock = getStatus owner tid !!! do @@ -959,28 +958,28 @@ testAllFeatures = do . to Public.wsLockStatus ) - (_owner, tid, member : _) <- Util.createBindingTeamWithNMembers 1 - Util.getAllTeamFeatures member tid !!! do + (_owner, tid, member : _) <- createBindingTeamWithNMembers 1 + getAllTeamFeatures member tid !!! do statusCode === const 200 responseJsonMaybe === const (Just (expected FeatureStatusEnabled defLockStatus {- determined by default in galley -})) -- This block catches potential errors in the logic that reverts to default if there is a disinction made between -- 1. there is no row for a team_id in galley.team_features -- 2. there is a row for team_id in galley.team_features but the feature has a no entry (null value) - galley <- view tsGalley + galley <- viewGalley -- this sets the guest links config to its default value thereby creating a row for the team in galley.team_features - Util.putTeamFeatureFlagInternal @Public.GuestLinksConfig galley tid (Public.WithStatusNoLock FeatureStatusEnabled Public.GuestLinksConfig Public.FeatureTTLUnlimited) + putTeamFeatureFlagInternal @Public.GuestLinksConfig galley tid (Public.WithStatusNoLock FeatureStatusEnabled Public.GuestLinksConfig Public.FeatureTTLUnlimited) !!! statusCode === const 200 - Util.getAllTeamFeatures member tid !!! do + getAllTeamFeatures member tid !!! do statusCode === const 200 responseJsonMaybe === const (Just (expected FeatureStatusEnabled defLockStatus {- determined by default in galley -})) - Util.getAllTeamFeaturesPersonal member !!! do + getAllTeamFeaturesPersonal member !!! do statusCode === const 200 responseJsonMaybe === const (Just (expected FeatureStatusEnabled defLockStatus {- determined by default in galley -})) - randomPersonalUser <- Util.randomUser - Util.getAllTeamFeaturesPersonal randomPersonalUser !!! do + randomPersonalUser <- randomUser + getAllTeamFeaturesPersonal randomPersonalUser !!! do statusCode === const 200 responseJsonMaybe === const (Just (expected FeatureStatusEnabled defLockStatus {- determined by 'getAfcConferenceCallingDefNew' in brig -})) where @@ -1005,11 +1004,11 @@ testAllFeatures = do testFeatureConfigConsistency :: TestM () testFeatureConfigConsistency = do - (_owner, tid, member : _) <- Util.createBindingTeamWithNMembers 1 + (_owner, tid, member : _) <- createBindingTeamWithNMembers 1 - allFeaturesRes <- Util.getAllFeatureConfigs member >>= parseObjectKeys + allFeaturesRes <- getAllFeatureConfigs member >>= parseObjectKeys - allTeamFeaturesRes <- Util.getAllTeamFeatures member tid >>= parseObjectKeys + allTeamFeaturesRes <- getAllTeamFeatures member tid >>= parseObjectKeys unless (allTeamFeaturesRes `Set.isSubsetOf` allFeaturesRes) $ liftIO $ expectationFailure (show allTeamFeaturesRes <> " is not a subset of " <> show allFeaturesRes) @@ -1026,15 +1025,15 @@ testFeatureConfigConsistency = do testSearchVisibilityInbound :: TestM () testSearchVisibilityInbound = do let defaultValue = FeatureStatusDisabled - (_owner, tid, _) <- Util.createBindingTeamWithNMembers 1 + (_owner, tid, _) <- createBindingTeamWithNMembers 1 let getFlagInternal :: HasCallStack => Public.FeatureStatus -> TestM () getFlagInternal expected = - flip (assertFlagNoConfig @Public.SearchVisibilityInboundConfig) expected $ Util.getTeamFeatureFlagInternal @Public.SearchVisibilityInboundConfig tid + flip (assertFlagNoConfig @Public.SearchVisibilityInboundConfig) expected $ getTeamFeatureFlagInternal @Public.SearchVisibilityInboundConfig tid setFlagInternal :: Public.FeatureStatus -> TestM () setFlagInternal statusValue = - void $ Util.putTeamFeatureFlagInternal @Public.SearchVisibilityInboundConfig expect2xx tid (Public.WithStatusNoLock statusValue Public.SearchVisibilityInboundConfig Public.FeatureTTLUnlimited) + void $ putTeamFeatureFlagInternal @Public.SearchVisibilityInboundConfig expect2xx tid (Public.WithStatusNoLock statusValue Public.SearchVisibilityInboundConfig Public.FeatureTTLUnlimited) let otherValue = case defaultValue of Public.FeatureStatusDisabled -> Public.FeatureStatusEnabled @@ -1047,12 +1046,12 @@ testSearchVisibilityInbound = do testFeatureNoConfigMultiSearchVisibilityInbound :: TestM () testFeatureNoConfigMultiSearchVisibilityInbound = do - (_owner1, team1, _) <- Util.createBindingTeamWithNMembers 0 - (_owner2, team2, _) <- Util.createBindingTeamWithNMembers 0 + (_owner1, team1, _) <- createBindingTeamWithNMembers 0 + (_owner2, team2, _) <- createBindingTeamWithNMembers 0 let setFlagInternal :: TeamId -> Public.FeatureStatus -> TestM () setFlagInternal tid statusValue = - void $ Util.putTeamFeatureFlagInternal @Public.SearchVisibilityInboundConfig expect2xx tid (Public.WithStatusNoLock statusValue Public.SearchVisibilityInboundConfig Public.FeatureTTLUnlimited) + void $ putTeamFeatureFlagInternal @Public.SearchVisibilityInboundConfig expect2xx tid (Public.WithStatusNoLock statusValue Public.SearchVisibilityInboundConfig Public.FeatureTTLUnlimited) setFlagInternal team2 Public.FeatureStatusEnabled @@ -1065,26 +1064,26 @@ testFeatureNoConfigMultiSearchVisibilityInbound = do liftIO $ do length teamsStatuses @?= 2 - Multi.TeamStatus _ team1Status <- Util.assertOne (filter ((== team1) . Multi.team) teamsStatuses) + Multi.TeamStatus _ team1Status <- assertOne (filter ((== team1) . Multi.team) teamsStatuses) team1Status @?= Public.FeatureStatusDisabled - Multi.TeamStatus _ team2Status <- Util.assertOne (filter ((== team2) . Multi.team) teamsStatuses) + Multi.TeamStatus _ team2Status <- assertOne (filter ((== team2) . Multi.team) teamsStatuses) team2Status @?= Public.FeatureStatusEnabled testMLS :: TestM () testMLS = do - (owner, tid, member : _) <- Util.createBindingTeamWithNMembers 1 + (owner, tid, member : _) <- createBindingTeamWithNMembers 1 - galley <- view tsGalley + galley <- viewGalley cannon <- view tsCannon let getForTeam :: HasCallStack => Public.WithStatusNoLock MLSConfig -> TestM () getForTeam expected = - flip assertFlagWithConfig expected $ Util.getTeamFeatureFlag @MLSConfig member tid + flip assertFlagWithConfig expected $ getTeamFeatureFlag @MLSConfig member tid getForTeamInternal :: HasCallStack => Public.WithStatusNoLock MLSConfig -> TestM () getForTeamInternal expected = - flip assertFlagWithConfig expected $ Util.getTeamFeatureFlagInternal @Public.MLSConfig tid + flip assertFlagWithConfig expected $ getTeamFeatureFlagInternal @Public.MLSConfig tid getForUser :: HasCallStack => Public.WithStatusNoLock MLSConfig -> TestM () getForUser expected = do @@ -1100,12 +1099,12 @@ testMLS = do setForTeam :: HasCallStack => Public.WithStatusNoLock MLSConfig -> TestM () setForTeam wsnl = - Util.putTeamFeatureFlagWithGalley @MLSConfig galley owner tid wsnl + putTeamFeatureFlagWithGalley @MLSConfig galley owner tid wsnl !!! statusCode === const 200 setForTeamInternal :: HasCallStack => Public.WithStatusNoLock MLSConfig -> TestM () setForTeamInternal wsnl = - void $ Util.putTeamFeatureFlagInternal @Public.MLSConfig expect2xx tid wsnl + void $ putTeamFeatureFlagInternal @Public.MLSConfig expect2xx tid wsnl let cipherSuite = MLS_128_DHKEMX25519_AES128GCM_SHA256_Ed25519 let defaultConfig = @@ -1142,12 +1141,12 @@ testMLS = do testExposeInvitationURLsToTeamAdminTeamIdInAllowList :: TestM () testExposeInvitationURLsToTeamAdminTeamIdInAllowList = do - owner <- Util.randomUser - tid <- Util.createBindingTeamInternal "foo" owner + owner <- randomUser + tid <- createBindingTeamInternal "foo" owner assertQueue "create team" tActivate void $ withSettingsOverrides (\opts -> opts & optSettings . setExposeInvitationURLsTeamAllowlist ?~ [tid]) $ do - g <- view tsGalley + g <- viewGalley assertExposeInvitationURLsToTeamAdminConfigStatus owner tid FeatureStatusDisabled Public.LockStatusUnlocked let enabled = Public.WithStatusNoLock Public.FeatureStatusEnabled ExposeInvitationURLsToTeamAdminConfig Public.FeatureTTLUnlimited void $ @@ -1157,12 +1156,12 @@ testExposeInvitationURLsToTeamAdminTeamIdInAllowList = do testExposeInvitationURLsToTeamAdminEmptyAllowList :: TestM () testExposeInvitationURLsToTeamAdminEmptyAllowList = do - owner <- Util.randomUser - tid <- Util.createBindingTeamInternal "foo" owner + owner <- randomUser + tid <- createBindingTeamInternal "foo" owner assertQueue "create team" tActivate void $ withSettingsOverrides (\opts -> opts & optSettings . setExposeInvitationURLsTeamAllowlist .~ Nothing) $ do - g <- view tsGalley + g <- viewGalley assertExposeInvitationURLsToTeamAdminConfigStatus owner tid FeatureStatusDisabled Public.LockStatusLocked let enabled = Public.WithStatusNoLock Public.FeatureStatusEnabled ExposeInvitationURLsToTeamAdminConfig Public.FeatureTTLUnlimited void $ @@ -1178,12 +1177,12 @@ testExposeInvitationURLsToTeamAdminEmptyAllowList = do -- might have been enabled before). testExposeInvitationURLsToTeamAdminServerConfigTakesPrecedence :: TestM () testExposeInvitationURLsToTeamAdminServerConfigTakesPrecedence = do - owner <- Util.randomUser - tid <- Util.createBindingTeamInternal "foo" owner + owner <- randomUser + tid <- createBindingTeamInternal "foo" owner assertQueue "create team" tActivate void $ withSettingsOverrides (\opts -> opts & optSettings . setExposeInvitationURLsTeamAllowlist ?~ [tid]) $ do - g <- view tsGalley + g <- viewGalley assertExposeInvitationURLsToTeamAdminConfigStatus owner tid FeatureStatusDisabled Public.LockStatusUnlocked let enabled = Public.WithStatusNoLock Public.FeatureStatusEnabled ExposeInvitationURLsToTeamAdminConfig Public.FeatureTTLUnlimited void $ @@ -1192,7 +1191,7 @@ testExposeInvitationURLsToTeamAdminServerConfigTakesPrecedence = do assertExposeInvitationURLsToTeamAdminConfigStatus owner tid FeatureStatusEnabled Public.LockStatusUnlocked void $ withSettingsOverrides (\opts -> opts & optSettings . setExposeInvitationURLsTeamAllowlist .~ Nothing) $ do - g <- view tsGalley + g <- viewGalley assertExposeInvitationURLsToTeamAdminConfigStatus owner tid FeatureStatusDisabled Public.LockStatusLocked let enabled = Public.WithStatusNoLock Public.FeatureStatusEnabled ExposeInvitationURLsToTeamAdminConfig Public.FeatureTTLUnlimited void $ @@ -1202,7 +1201,7 @@ testExposeInvitationURLsToTeamAdminServerConfigTakesPrecedence = do assertExposeInvitationURLsToTeamAdminConfigStatus :: UserId -> TeamId -> FeatureStatus -> LockStatus -> TestM () assertExposeInvitationURLsToTeamAdminConfigStatus owner tid fStatus lStatus = do - g <- view tsGalley + g <- viewGalley Util.getTeamFeatureFlagWithGalley @ExposeInvitationURLsToTeamAdminConfig g owner tid !!! do const 200 === statusCode const (Right (Public.withStatus fStatus lStatus Public.ExposeInvitationURLsToTeamAdminConfig Public.FeatureTTLUnlimited)) === responseJsonEither diff --git a/services/galley/test/integration/API/Teams/LegalHold.hs b/services/galley/test/integration/API/Teams/LegalHold.hs index 115b547161d..d4dde55c62e 100644 --- a/services/galley/test/integration/API/Teams/LegalHold.hs +++ b/services/galley/test/integration/API/Teams/LegalHold.hs @@ -621,7 +621,7 @@ testCannotCreateLegalHoldDeviceOldAPI = do where tryout :: UserId -> TestM () tryout uid = do - brg <- view tsBrig + brg <- viewBrig let newClientBody = (newClient LegalHoldClientType (head someLastPrekeys)) { newClientPassword = Just defPassword @@ -671,7 +671,7 @@ testGetTeamMembersIncludesLHStatus = do testInWhitelist :: TestM () testInWhitelist = do - g <- view tsGalley + g <- viewGalley (owner, tid) <- createBindingTeam member <- randomUser addTeamMemberInternal tid member (rolePermissions RoleMember) Nothing @@ -826,7 +826,7 @@ testNoConsentBlockOne2OneConv connectFirst teamPeer approveLH testPendingConnect regularClient <- randomClient legalholder (head someLastPrekeys) peer :: UserId <- if teamPeer then fst <$> createBindingTeam else randomUser - galley <- view tsGalley + galley <- viewGalley putLHWhitelistTeam tid !!! const 200 === statusCode @@ -966,7 +966,7 @@ testNoConsentRemoveFromGroupConv whoIsAdmin = do qLegalHolder <- Qualified legalholder <$> viewFederationDomain (peer :: UserId, teamPeer) <- createBindingTeam qPeer <- Qualified peer <$> viewFederationDomain - galley <- view tsGalley + galley <- viewGalley let enableLHForLegalholder :: HasCallStack => TestM () enableLHForLegalholder = do @@ -1058,7 +1058,7 @@ testGroupConvInvitationHandlesLHConflicts inviteCase = do -- activate legalhold for legalholder do - galley <- view tsGalley + galley <- viewGalley requestLegalHoldDevice legalholder legalholder tid !!! testResponse 201 Nothing approveLegalHoldDevice (Just defPassword) legalholder legalholder tid !!! testResponse 200 Nothing UserLegalHoldStatusResponse userStatus _ _ <- getUserStatusTyped' galley legalholder tid @@ -1108,7 +1108,7 @@ testNoConsentCannotBeInvited = do -- activate legalhold for legalholder do - galley <- view tsGalley + galley <- viewGalley requestLegalHoldDevice legalholder legalholder tid !!! testResponse 201 Nothing approveLegalHoldDevice (Just defPassword) legalholder legalholder tid !!! testResponse 200 Nothing UserLegalHoldStatusResponse userStatus _ _ <- getUserStatusTyped' galley legalholder tid @@ -1147,7 +1147,7 @@ testCannotCreateGroupWithUsersInConflict = do -- activate legalhold for legalholder do - galley <- view tsGalley + galley <- viewGalley requestLegalHoldDevice legalholder legalholder tid !!! testResponse 201 Nothing approveLegalHoldDevice (Just defPassword) legalholder legalholder tid !!! testResponse 200 Nothing UserLegalHoldStatusResponse userStatus _ _ <- getUserStatusTyped' galley legalholder tid @@ -1267,7 +1267,7 @@ testBenchHack' :: HasCallStack => Int -> TestM (Int, Time.NominalDiffTime) testBenchHack' numPeers = do (legalholder :: UserId, tid) <- createBindingTeam peers :: [UserId] <- replicateM numPeers randomUser - galley <- view tsGalley + galley <- viewGalley let doEnableLH :: HasCallStack => TestM () doEnableLH = do @@ -1305,14 +1305,14 @@ testBenchHack' numPeers = do getEnabled :: HasCallStack => TeamId -> TestM ResponseLBS getEnabled tid = do - g <- view tsGalley + g <- viewGalley get $ g . paths ["i", "teams", toByteString' tid, "features", "legalhold"] renewToken :: HasCallStack => Text -> TestM () renewToken tok = do - b <- view tsBrig + b <- viewBrig void . post $ b . paths ["access"] @@ -1321,7 +1321,7 @@ renewToken tok = do _putEnabled :: HasCallStack => TeamId -> Public.FeatureStatus -> TestM () _putEnabled tid enabled = do - g <- view tsGalley + g <- viewGalley putEnabledM g tid enabled putEnabledM :: (HasCallStack, MonadHttp m, MonadIO m) => GalleyR -> TeamId -> Public.FeatureStatus -> m () @@ -1329,7 +1329,7 @@ putEnabledM g tid enabled = void $ putEnabledM' g expect2xx tid enabled putEnabled' :: HasCallStack => (Bilge.Request -> Bilge.Request) -> TeamId -> Public.FeatureStatus -> TestM ResponseLBS putEnabled' extra tid enabled = do - g <- view tsGalley + g <- viewGalley putEnabledM' g extra tid enabled putEnabledM' :: (HasCallStack, MonadHttp m, MonadIO m) => GalleyR -> (Bilge.Request -> Bilge.Request) -> TeamId -> Public.FeatureStatus -> m ResponseLBS @@ -1345,7 +1345,7 @@ postSettings uid tid new = -- Retry calls to this endpoint, on k8s it sometimes takes a while to establish a working -- connection. retrying policy only412 $ \_ -> do - g <- view tsGalley + g <- viewGalley post $ g . paths ["teams", toByteString' tid, "legalhold", "settings"] @@ -1364,7 +1364,7 @@ getSettingsTyped uid tid = responseJsonUnsafe <$> (getSettings uid tid UserId -> TeamId -> TestM ResponseLBS getSettings uid tid = do - g <- view tsGalley + g <- viewGalley get $ g . paths ["teams", toByteString' tid, "legalhold", "settings"] @@ -1374,7 +1374,7 @@ getSettings uid tid = do deleteSettings :: HasCallStack => Maybe PlainTextPassword -> UserId -> TeamId -> TestM ResponseLBS deleteSettings mPassword uid tid = do - g <- view tsGalley + g <- viewGalley delete $ g . paths ["teams", toByteString' tid, "legalhold", "settings"] @@ -1385,7 +1385,7 @@ deleteSettings mPassword uid tid = do getUserStatusTyped :: HasCallStack => UserId -> TeamId -> TestM UserLegalHoldStatusResponse getUserStatusTyped uid tid = do - g <- view tsGalley + g <- viewGalley getUserStatusTyped' g uid tid getUserStatusTyped' :: (HasCallStack, MonadHttp m, MonadIO m, MonadCatch m) => GalleyR -> UserId -> TeamId -> m UserLegalHoldStatusResponse @@ -1404,7 +1404,7 @@ getUserStatus' g uid tid = do approveLegalHoldDevice :: HasCallStack => Maybe PlainTextPassword -> UserId -> UserId -> TeamId -> TestM ResponseLBS approveLegalHoldDevice mPassword zusr uid tid = do - g <- view tsGalley + g <- viewGalley approveLegalHoldDevice' g mPassword zusr uid tid approveLegalHoldDevice' :: @@ -1432,7 +1432,7 @@ disableLegalHoldForUser :: UserId -> TestM ResponseLBS disableLegalHoldForUser mPassword tid zusr uid = do - g <- view tsGalley + g <- viewGalley disableLegalHoldForUser' g mPassword tid zusr uid disableLegalHoldForUser' :: @@ -1476,7 +1476,7 @@ assertZeroLegalHoldDevices uid = do requestLegalHoldDevice :: HasCallStack => UserId -> UserId -> TeamId -> TestM ResponseLBS requestLegalHoldDevice zusr uid tid = do - g <- view tsGalley + g <- viewGalley requestLegalHoldDevice' g zusr uid tid requestLegalHoldDevice' :: (HasCallStack, MonadHttp m, MonadIO m) => GalleyR -> UserId -> UserId -> TeamId -> m ResponseLBS @@ -1814,7 +1814,7 @@ assertMatchChan c match = go [] getLHWhitelistedTeam :: HasCallStack => TeamId -> TestM ResponseLBS getLHWhitelistedTeam tid = do - galley <- view tsGalley + galley <- viewGalley getLHWhitelistedTeam' galley tid getLHWhitelistedTeam' :: (HasCallStack, MonadHttp m, MonadIO m) => GalleyR -> TeamId -> m ResponseLBS @@ -1826,7 +1826,7 @@ getLHWhitelistedTeam' g tid = do putLHWhitelistTeam :: HasCallStack => TeamId -> TestM ResponseLBS putLHWhitelistTeam tid = do - galley <- view tsGalley + galley <- viewGalley putLHWhitelistTeam' galley tid putLHWhitelistTeam' :: (HasCallStack, MonadHttp m, MonadIO m) => GalleyR -> TeamId -> m ResponseLBS @@ -1838,7 +1838,7 @@ putLHWhitelistTeam' g tid = do _deleteLHWhitelistTeam :: HasCallStack => TeamId -> TestM ResponseLBS _deleteLHWhitelistTeam tid = do - galley <- view tsGalley + galley <- viewGalley deleteLHWhitelistTeam' galley tid deleteLHWhitelistTeam' :: (HasCallStack, MonadHttp m, MonadIO m) => GalleyR -> TeamId -> m ResponseLBS diff --git a/services/galley/test/integration/API/Teams/LegalHold/DisabledByDefault.hs b/services/galley/test/integration/API/Teams/LegalHold/DisabledByDefault.hs index f8e390259c1..677895ad58d 100644 --- a/services/galley/test/integration/API/Teams/LegalHold/DisabledByDefault.hs +++ b/services/galley/test/integration/API/Teams/LegalHold/DisabledByDefault.hs @@ -633,7 +633,7 @@ testCannotCreateLegalHoldDeviceOldAPI = do where tryout :: UserId -> TestM () tryout uid = do - brg <- view tsBrig + brg <- viewBrig let newClientBody = (newClient LegalHoldClientType (head someLastPrekeys)) { newClientPassword = Just defPassword @@ -841,14 +841,14 @@ testClaimKeys testcase = do getEnabled :: HasCallStack => TeamId -> TestM ResponseLBS getEnabled tid = do - g <- view tsGalley + g <- viewGalley get $ g . paths ["i", "teams", toByteString' tid, "features", "legalhold"] renewToken :: HasCallStack => Text -> TestM () renewToken tok = do - b <- view tsBrig + b <- viewBrig void . post $ b . paths ["access"] @@ -857,7 +857,7 @@ renewToken tok = do putEnabled :: HasCallStack => TeamId -> Public.FeatureStatus -> TestM () putEnabled tid enabled = do - g <- view tsGalley + g <- viewGalley putEnabledM g tid enabled putEnabledM :: (HasCallStack, MonadHttp m, MonadIO m) => GalleyR -> TeamId -> Public.FeatureStatus -> m () @@ -865,7 +865,7 @@ putEnabledM g tid enabled = void $ putEnabledM' g expect2xx tid enabled putEnabled' :: HasCallStack => (Bilge.Request -> Bilge.Request) -> TeamId -> Public.FeatureStatus -> TestM ResponseLBS putEnabled' extra tid enabled = do - g <- view tsGalley + g <- viewGalley putEnabledM' g extra tid enabled putEnabledM' :: (HasCallStack, MonadHttp m, MonadIO m) => GalleyR -> (Bilge.Request -> Bilge.Request) -> TeamId -> Public.FeatureStatus -> m ResponseLBS @@ -881,7 +881,7 @@ postSettings uid tid new = -- Retry calls to this endpoint, on k8s it sometimes takes a while to establish a working -- connection. retrying policy only412 $ \_ -> do - g <- view tsGalley + g <- viewGalley post $ g . paths ["teams", toByteString' tid, "legalhold", "settings"] @@ -900,7 +900,7 @@ getSettingsTyped uid tid = responseJsonUnsafe <$> (getSettings uid tid UserId -> TeamId -> TestM ResponseLBS getSettings uid tid = do - g <- view tsGalley + g <- viewGalley get $ g . paths ["teams", toByteString' tid, "legalhold", "settings"] @@ -910,7 +910,7 @@ getSettings uid tid = do deleteSettings :: HasCallStack => Maybe PlainTextPassword -> UserId -> TeamId -> TestM ResponseLBS deleteSettings mPassword uid tid = do - g <- view tsGalley + g <- viewGalley delete $ g . paths ["teams", toByteString' tid, "legalhold", "settings"] @@ -921,7 +921,7 @@ deleteSettings mPassword uid tid = do getUserStatusTyped :: HasCallStack => UserId -> TeamId -> TestM UserLegalHoldStatusResponse getUserStatusTyped uid tid = do - g <- view tsGalley + g <- viewGalley getUserStatusTyped' g uid tid getUserStatusTyped' :: (HasCallStack, MonadHttp m, MonadIO m, MonadCatch m) => GalleyR -> UserId -> TeamId -> m UserLegalHoldStatusResponse @@ -940,7 +940,7 @@ getUserStatus' g uid tid = do approveLegalHoldDevice :: HasCallStack => Maybe PlainTextPassword -> UserId -> UserId -> TeamId -> TestM ResponseLBS approveLegalHoldDevice mPassword zusr uid tid = do - g <- view tsGalley + g <- viewGalley approveLegalHoldDevice' g mPassword zusr uid tid approveLegalHoldDevice' :: @@ -968,7 +968,7 @@ disableLegalHoldForUser :: UserId -> TestM ResponseLBS disableLegalHoldForUser mPassword tid zusr uid = do - g <- view tsGalley + g <- viewGalley disableLegalHoldForUser' g mPassword tid zusr uid disableLegalHoldForUser' :: @@ -1012,7 +1012,7 @@ assertZeroLegalHoldDevices uid = do grantConsent :: HasCallStack => TeamId -> UserId -> TestM () grantConsent tid zusr = do - g <- view tsGalley + g <- viewGalley grantConsent' g tid zusr grantConsent' :: (HasCallStack, MonadHttp m, MonadIO m) => GalleyR -> TeamId -> UserId -> m () @@ -1030,7 +1030,7 @@ grantConsent'' expectation g tid zusr = do requestLegalHoldDevice :: HasCallStack => UserId -> UserId -> TeamId -> TestM ResponseLBS requestLegalHoldDevice zusr uid tid = do - g <- view tsGalley + g <- viewGalley requestLegalHoldDevice' g zusr uid tid requestLegalHoldDevice' :: (HasCallStack, MonadHttp m, MonadIO m) => GalleyR -> UserId -> UserId -> TeamId -> m ResponseLBS diff --git a/services/galley/test/integration/API/Util.hs b/services/galley/test/integration/API/Util.hs index d486dee0f72..5664206d251 100644 --- a/services/galley/test/integration/API/Util.hs +++ b/services/galley/test/integration/API/Util.hs @@ -34,6 +34,7 @@ import Control.Retry (constantDelay, exponentialBackoff, limitRetries, retrying) import Data.Aeson hiding (json) import Data.Aeson.Lens (key, _String) import qualified Data.ByteString as BS +import qualified Data.ByteString.Char8 as B8 import qualified Data.ByteString.Char8 as C import Data.ByteString.Conversion import qualified Data.ByteString.Lazy as Lazy @@ -79,13 +80,14 @@ import qualified Galley.Types.Teams as Team import Galley.Types.Teams.Intra import Galley.Types.UserList import Imports +import qualified Network.HTTP.Client as HTTP import Network.HTTP.Media.MediaType import qualified Network.HTTP.Types as HTTP -import Network.Wai (Application, defaultRequest) +import Network.Wai (defaultRequest) import qualified Network.Wai as Wai import qualified Network.Wai.Test as Wai import Network.Wai.Utilities.MockServer (withMockServer) -import Servant (Handler, HasServer, Server, ServerT, serve, (:<|>) (..)) +import Servant import System.Exit import System.Process import System.Random @@ -137,19 +139,34 @@ import Wire.API.User.Client.Prekey ------------------------------------------------------------------------------- -- API Operations +addPrefix :: Request -> Request +addPrefix r = r {HTTP.path = "v" <> toHeader latestVersion <> "/" <> removeSlash (HTTP.path r)} + where + removeSlash s = case B8.uncons s of + Just ('/', s') -> s' + _ -> s + latestVersion :: Version + latestVersion = maxBound + -- | A class for monads with access to a Sem r instance class HasGalley m where viewGalley :: m GalleyR viewGalleyOpts :: m Opts.Opts instance HasGalley TestM where - viewGalley = view tsGalley + viewGalley = fmap (addPrefix .) (view tsUnversionedGalley) viewGalleyOpts = view tsGConf instance (HasGalley m, Monad m) => HasGalley (SessionT m) where viewGalley = lift viewGalley viewGalleyOpts = lift viewGalleyOpts +class HasBrig m where + viewBrig :: m BrigR + +instance HasBrig TestM where + viewBrig = fmap (addPrefix .) (view tsUnversionedBrig) + symmPermissions :: [Perm] -> Permissions symmPermissions p = let s = Set.fromList p in fromJust (newPermissions s s) @@ -189,7 +206,7 @@ createBindingTeamWithQualifiedMembers num = do getTeams :: UserId -> [(ByteString, Maybe ByteString)] -> TestM TeamList getTeams u queryItems = do - g <- view tsGalley + g <- viewGalley r <- get ( g @@ -224,7 +241,7 @@ createBindingTeamWithNMembersWithHandles withHandles n = do setHandle :: UserId -> TestM () setHandle uid = when withHandles $ do - b <- view tsBrig + b <- viewBrig randomHandle <- mkRandomHandle put ( b @@ -236,7 +253,7 @@ createBindingTeamWithNMembersWithHandles withHandles n = do changeTeamStatus :: HasCallStack => TeamId -> TeamStatus -> TestM () changeTeamStatus tid s = do - g <- view tsGalley + g <- viewGalley put ( g . paths ["i", "teams", toByteString' tid, "status"] . json (TeamStatusUpdate s Nothing) @@ -252,7 +269,7 @@ createBindingTeamInternal name owner = do createBindingTeamInternalNoActivate :: HasCallStack => Text -> UserId -> TestM TeamId createBindingTeamInternalNoActivate name owner = do - g <- view tsGalley + g <- viewGalley tid <- randomId let nt = BindingNewTeam $ newNewTeam (unsafeRange name) DefaultIcon _ <- @@ -263,7 +280,7 @@ createBindingTeamInternalNoActivate name owner = do createBindingTeamInternalWithCurrency :: HasCallStack => Text -> UserId -> Currency.Alpha -> TestM TeamId createBindingTeamInternalWithCurrency name owner cur = do - g <- view tsGalley + g <- viewGalley tid <- createBindingTeamInternalNoActivate name owner _ <- put (g . paths ["i", "teams", toByteString' tid, "status"] . json (TeamStatusUpdate Active $ Just cur)) @@ -272,39 +289,39 @@ createBindingTeamInternalWithCurrency name owner cur = do getTeamInternal :: HasCallStack => TeamId -> TestM TeamData getTeamInternal tid = do - g <- view tsGalley + g <- viewGalley r <- get (g . paths ["i/teams", toByteString' tid]) UserId -> TeamId -> TestM Team getTeam usr tid = do - g <- view tsGalley + g <- viewGalley r <- get (g . paths ["teams", toByteString' tid] . zUser usr) UserId -> TeamId -> TestM TeamMemberList getTeamMembers usr tid = do - g <- view tsGalley + g <- viewGalley r <- get (g . paths ["teams", toByteString' tid, "members"] . zUser usr) UserId -> TeamId -> TestM ResponseLBS getTeamMembersCsv usr tid = do - g <- view tsGalley + g <- viewGalley get (g . accept "text/csv" . paths ["teams", toByteString' tid, "members/csv"] . zUser usr) UserId -> TeamId -> Int -> TestM TeamMemberList getTeamMembersTruncated usr tid n = do - g <- view tsGalley + g <- viewGalley r <- get (g . paths ["teams", toByteString' tid, "members"] . zUser usr . queryItem "maxResults" (C.pack $ show n)) TeamId -> Int -> TestM TeamMemberList getTeamMembersInternalTruncated tid n = do - g <- view tsGalley + g <- viewGalley r <- get ( g @@ -317,7 +334,7 @@ getTeamMembersInternalTruncated tid n = do bulkGetTeamMembers :: HasCallStack => UserId -> TeamId -> [UserId] -> TestM TeamMemberList bulkGetTeamMembers usr tid uids = do - g <- view tsGalley + g <- viewGalley r <- post ( g @@ -331,7 +348,7 @@ bulkGetTeamMembers usr tid uids = do bulkGetTeamMembersTruncated :: HasCallStack => UserId -> TeamId -> [UserId] -> Int -> TestM ResponseLBS bulkGetTeamMembersTruncated usr tid uids trnc = do - g <- view tsGalley + g <- viewGalley post ( g . paths ["teams", toByteString' tid, "get-members-by-ids-using-post"] @@ -342,7 +359,7 @@ bulkGetTeamMembersTruncated usr tid uids trnc = do getTeamMember :: HasCallStack => UserId -> TeamId -> UserId -> TestM TeamMember getTeamMember getter tid gettee = do - g <- view tsGalley + g <- viewGalley getTeamMember' g getter tid gettee getTeamMember' :: (HasCallStack, MonadHttp m, MonadIO m, MonadCatch m) => GalleyR -> UserId -> TeamId -> UserId -> m TeamMember @@ -352,13 +369,13 @@ getTeamMember' g getter tid gettee = do getTeamMemberInternal :: HasCallStack => TeamId -> UserId -> TestM TeamMember getTeamMemberInternal tid mid = do - g <- view tsGalley + g <- viewGalley r <- get (g . paths ["i", "teams", toByteString' tid, "members", toByteString' mid]) UserId -> TeamId -> UserId -> Permissions -> Maybe (UserId, UTCTimeMillis) -> TestM () addTeamMember usr tid muid mperms mmbinv = do - g <- view tsGalley + g <- viewGalley let payload = json (mkNewTeamMember muid mperms mmbinv) post (g . paths ["teams", toByteString' tid, "members"] . zUser usr . zConn "conn" . payload) !!! const 200 === statusCode @@ -370,7 +387,7 @@ addTeamMemberInternal tid muid mperms mmbinv = addTeamMemberInternal' tid muid m -- | FUTUREWORK: do not use this, it's broken!! use 'addUserToTeam' instead! https://wearezeta.atlassian.net/browse/SQSERVICES-471 addTeamMemberInternal' :: HasCallStack => TeamId -> UserId -> Permissions -> Maybe (UserId, UTCTimeMillis) -> TestM ResponseLBS addTeamMemberInternal' tid muid mperms mmbinv = do - g <- view tsGalley + g <- viewGalley let payload = json (mkNewTeamMember muid mperms mmbinv) post (g . paths ["i", "teams", toByteString' tid, "members"] . payload) @@ -394,7 +411,7 @@ addUserToTeamWithRole role inviter tid = do addUserToTeamWithRole' :: HasCallStack => Maybe Role -> UserId -> TeamId -> TestM (Invitation, ResponseLBS) addUserToTeamWithRole' role inviter tid = do - brig <- view tsBrig + brig <- viewBrig inviteeEmail <- randomEmail let invite = InvitationRequest Nothing role Nothing inviteeEmail Nothing invResponse <- postInvitation tid inviter invite @@ -417,7 +434,7 @@ addUserToTeamWithSSO hasEmail tid = do makeOwner :: HasCallStack => UserId -> TeamMember -> TeamId -> TestM () makeOwner owner mem tid = do - galley <- view tsGalley + galley <- viewGalley let changeMember = mkNewTeamMember (mem ^. Team.userId) fullPermissions (mem ^. Team.invitation) put ( galley @@ -441,7 +458,7 @@ acceptInviteBody email code = postInvitation :: TeamId -> UserId -> InvitationRequest -> TestM ResponseLBS postInvitation t u i = do - brig <- view tsBrig + brig <- viewBrig post $ brig . paths ["teams", toByteString' t, "invitations"] @@ -457,7 +474,7 @@ zAuthAccess u conn = getInvitationCode :: HasCallStack => TeamId -> InvitationId -> TestM InvitationCode getInvitationCode t ref = do - brig <- view tsBrig + brig <- viewBrig let getm :: TestM (Maybe InvitationCode) getm = do @@ -483,7 +500,7 @@ getInvitationCode t ref = do -- it clearly shows the API that old(er) clients use. createTeamConvLegacy :: HasCallStack => UserId -> TeamId -> [UserId] -> Maybe Text -> TestM ConvId createTeamConvLegacy u tid us name = do - g <- view tsGalley + g <- viewGalley let tinfo = ConvTeamInfo tid let convPayload = object @@ -550,7 +567,7 @@ createTeamConvAccessRaw :: Maybe RoleName -> TestM ResponseLBS createTeamConvAccessRaw u tid us name acc role mtimer convRole = do - g <- view tsGalley + 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 @@ -606,7 +623,7 @@ createMLSTeamConv lusr c tid users name access role timer convRole = do updateTeamConv :: UserId -> ConvId -> ConversationRename -> TestM ResponseLBS updateTeamConv zusr convid upd = do - g <- view tsGalley + g <- viewGalley put ( g . paths ["/conversations", toByteString' convid] @@ -618,7 +635,7 @@ updateTeamConv zusr convid upd = do createOne2OneTeamConv :: UserId -> UserId -> Maybe Text -> TeamId -> TestM ResponseLBS createOne2OneTeamConv u1 u2 n tid = do - g <- view tsGalley + g <- viewGalley let conv = 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 @@ -674,7 +691,7 @@ 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 <- view tsGalley + g <- viewGalley 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 @@ -711,25 +728,25 @@ 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 <- view tsGalley + g <- viewGalley 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 postSelfConv u = do - g <- view tsGalley + g <- viewGalley post $ g . path "/conversations/self" . zUser u . zConn "conn" . zType "access" postO2OConv :: UserId -> UserId -> Maybe Text -> TestM ResponseLBS postO2OConv u1 u2 n = do - g <- view tsGalley + g <- viewGalley 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 postConnectConv a b name msg email = do qb <- Qualified b <$> viewFederationDomain - g <- view tsGalley + g <- viewGalley post $ g . path "/i/conversations/connect" @@ -740,7 +757,7 @@ postConnectConv a b name msg email = do putConvAccept :: UserId -> ConvId -> TestM ResponseLBS putConvAccept invited cid = do - g <- view tsGalley + g <- viewGalley put $ g . paths ["/i/conversations", C.pack $ show cid, "accept", "v2"] @@ -766,7 +783,7 @@ postOtrMessage' :: [(UserId, ClientId, Text)] -> TestM ResponseLBS postOtrMessage' reportMissing f u d c rec = do - g <- view tsGalley + g <- viewGalley post $ g . f @@ -906,7 +923,7 @@ postProtoOtrMessage = postProtoOtrMessage' Nothing id postProtoOtrMessage' :: Maybe [UserId] -> (Request -> Request) -> UserId -> ClientId -> ConvId -> OtrRecipients -> TestM ResponseLBS postProtoOtrMessage' reportMissing modif u d c rec = do - g <- view tsGalley + g <- viewGalley let m = runPut (encodeMessage $ mkOtrProtoMessage d rec reportMissing "ZXhhbXBsZQ==") in post $ g @@ -929,7 +946,7 @@ mkOtrProtoMessage sender rec reportMissing ad = getConvs :: UserId -> Maybe (Either [ConvId] ConvId) -> Maybe Int32 -> TestM ResponseLBS getConvs u r s = do - g <- view tsGalley + g <- viewGalley get $ g . path "/conversations" @@ -938,12 +955,16 @@ getConvs u r s = do . zType "access" . convRange r s -listConvs :: (MonadIO m, MonadHttp m, HasGalley m) => UserId -> ListConversations -> m ResponseLBS +listConvs :: + (MonadIO m, MonadHttp m, MonadReader TestSetup m) => + UserId -> + ListConversations -> + m ResponseLBS listConvs u req = do - g <- viewGalley + g <- view tsUnversionedGalley post $ g - . path "/conversations/list/v2" + . path "/v1/conversations/list/v2" . zUser u . zConn "conn" . zType "access" @@ -971,7 +992,7 @@ getConvQualified u (Qualified conv domain) = do getConvIds :: UserId -> Maybe (Either [ConvId] ConvId) -> Maybe Int32 -> TestM ResponseLBS getConvIds u r s = do - g <- view tsGalley + g <- viewGalley get $ g . path "/conversations/ids" @@ -982,7 +1003,7 @@ getConvIds u r s = do listConvIds :: UserId -> GetPaginatedConversationIds -> TestM ResponseLBS listConvIds u paginationOpts = do - g <- view tsGalley + g <- viewGalley post $ g . path "/conversations/list-ids" @@ -997,24 +1018,24 @@ listRemoteConvs remoteDomain uid = do pure $ filter (\qcnv -> qDomain qcnv == remoteDomain) allConvs postQualifiedMembers :: - (HasGalley m, MonadIO m, MonadHttp m) => + (MonadReader TestSetup m, MonadIO m, MonadHttp m) => UserId -> NonEmpty (Qualified UserId) -> ConvId -> m ResponseLBS postQualifiedMembers zusr invitees conv = do - g <- viewGalley + g <- view tsUnversionedGalley let invite = InviteQualified invitees roleNameWireAdmin post $ g - . paths ["conversations", toByteString' conv, "members", "v2"] + . paths ["v1", "conversations", toByteString' conv, "members", "v2"] . zUser zusr . zConn "conn" . zType "access" . json invite postMembers :: - (MonadIO m, MonadHttp m, MonadReader TestSetup m) => + (MonadIO m, MonadHttp m, HasGalley m) => UserId -> NonEmpty (Qualified UserId) -> Qualified ConvId -> @@ -1022,20 +1043,19 @@ postMembers :: postMembers u us c = postMembersWithRole u us c roleNameWireAdmin postMembersWithRole :: - (MonadIO m, MonadHttp m, MonadReader TestSetup m) => + (MonadIO m, MonadHttp m, HasGalley m) => UserId -> NonEmpty (Qualified UserId) -> Qualified ConvId -> RoleName -> m ResponseLBS postMembersWithRole u us c r = do - g <- view tsGalley + g <- viewGalley let i = InviteQualified us r post $ g . paths - [ v2, - "conversations", + [ "conversations", toByteString' (qDomain c), toByteString' (qUnqualified c), "members" @@ -1044,8 +1064,6 @@ postMembersWithRole u us c r = do . zConn "conn" . zType "access" . json i - where - v2 = toByteString' (toLower <$> show V2) deleteMemberQualified :: (HasCallStack, MonadIO m, MonadHttp m, HasGalley m) => @@ -1071,7 +1089,7 @@ deleteMemberQualified u1 (Qualified u2 u2Domain) (Qualified conv convDomain) = d getSelfMember :: UserId -> ConvId -> TestM ResponseLBS getSelfMember u c = do - g <- view tsGalley + g <- viewGalley get $ g . paths ["conversations", toByteString' c, "self"] @@ -1081,7 +1099,7 @@ getSelfMember u c = do putMember :: UserId -> MemberUpdate -> Qualified ConvId -> TestM ResponseLBS putMember u m (Qualified c dom) = do - g <- view tsGalley + g <- viewGalley put $ g . paths ["conversations", toByteString' dom, toByteString' c, "self"] @@ -1116,7 +1134,7 @@ putOtherMemberQualified from to m c = do putOtherMember :: UserId -> UserId -> OtherMemberUpdate -> ConvId -> TestM ResponseLBS putOtherMember from to m c = do - g <- view tsGalley + g <- viewGalley put $ g . paths ["conversations", toByteString' c, "members", toByteString' to] @@ -1150,7 +1168,7 @@ putQualifiedConversationName u c n = do putConversationName :: UserId -> ConvId -> Text -> TestM ResponseLBS putConversationName u c n = do - g <- view tsGalley + g <- viewGalley let update = ConversationRename n put ( g @@ -1181,7 +1199,7 @@ putQualifiedReceiptMode u (Qualified c dom) r = do putReceiptMode :: UserId -> ConvId -> ReceiptMode -> TestM ResponseLBS putReceiptMode u c r = do - g <- view tsGalley + g <- viewGalley let update = ConversationReceiptModeUpdate r put ( g @@ -1194,7 +1212,7 @@ putReceiptMode u c r = do getJoinCodeConv :: UserId -> Code.Key -> Code.Value -> TestM ResponseLBS getJoinCodeConv u k v = do - g <- view tsGalley + g <- viewGalley get $ g . paths ["/conversations", "join"] @@ -1204,7 +1222,7 @@ getJoinCodeConv u k v = do postJoinConv :: UserId -> ConvId -> TestM ResponseLBS postJoinConv u c = do - g <- view tsGalley + g <- viewGalley post $ g . paths ["/conversations", toByteString' c, "join"] @@ -1214,7 +1232,7 @@ postJoinConv u c = do postJoinCodeConv :: UserId -> ConversationCode -> TestM ResponseLBS postJoinCodeConv u j = do - g <- view tsGalley + g <- viewGalley post $ g . paths ["/conversations", "join"] @@ -1225,7 +1243,7 @@ postJoinCodeConv u j = do putAccessUpdate :: UserId -> ConvId -> ConversationAccessData -> TestM ResponseLBS putAccessUpdate u c acc = do - g <- view tsGalley + g <- viewGalley put $ g . paths ["/conversations", toByteString' c, "access"] @@ -1274,7 +1292,7 @@ putMessageTimerUpdateQualified u c acc = do putMessageTimerUpdate :: UserId -> ConvId -> ConversationMessageTimerUpdate -> TestM ResponseLBS putMessageTimerUpdate u c acc = do - g <- view tsGalley + g <- viewGalley put $ g . paths ["/conversations", toByteString' c, "message-timer"] @@ -1285,7 +1303,7 @@ putMessageTimerUpdate u c acc = do postConvCode :: UserId -> ConvId -> TestM ResponseLBS postConvCode u c = do - g <- view tsGalley + g <- viewGalley post $ g . paths ["/conversations", toByteString' c, "code"] @@ -1295,7 +1313,7 @@ postConvCode u c = do postConvCodeCheck :: ConversationCode -> TestM ResponseLBS postConvCodeCheck code = do - g <- view tsGalley + g <- viewGalley post $ g . path "/conversations/code-check" @@ -1303,7 +1321,7 @@ postConvCodeCheck code = do getConvCode :: UserId -> ConvId -> TestM ResponseLBS getConvCode u c = do - g <- view tsGalley + g <- viewGalley get $ g . paths ["/conversations", toByteString' c, "code"] @@ -1313,7 +1331,7 @@ getConvCode u c = do deleteConvCode :: UserId -> ConvId -> TestM ResponseLBS deleteConvCode u c = do - g <- view tsGalley + g <- viewGalley delete $ g . paths ["/conversations", toByteString' c, "code"] @@ -1355,7 +1373,7 @@ getTeamQueue zusr msince msize onlyLast = getTeamQueue' :: HasCallStack => UserId -> Maybe NotificationId -> Maybe Int -> Bool -> TestM ResponseLBS getTeamQueue' zusr msince msize onlyLast = do - g <- view tsGalley + g <- viewGalley get ( g . path "/teams/notifications" . zUser zusr @@ -1392,7 +1410,7 @@ registerRemoteConv convId originUser name othMembers = do getFeatureStatusMulti :: forall cfg. (IsFeatureConfig cfg, KnownSymbol (FeatureSymbol cfg)) => Multi.TeamFeatureNoConfigMultiRequest -> TestM ResponseLBS getFeatureStatusMulti req = do - g <- view tsGalley + g <- viewGalley post ( g . paths ["i", "features-multi-teams", featureNameBS @cfg] . json req @@ -1819,13 +1837,13 @@ connectUsersWith :: connectUsersWith fn u = mapM connectTo where connectTo v = do - b <- view tsBrig + b <- view tsUnversionedBrig r1 <- post ( b . zUser u . zConn "conn" - . path "/connections" + . paths ["v1", "connections"] . json (ConnectionRequest v (unsafeRange "chat")) . fn ) @@ -1834,20 +1852,20 @@ connectUsersWith fn u = mapM connectTo ( b . zUser v . zConn "conn" - . paths ["connections", toByteString' u] + . paths ["v1", "connections", toByteString' u] . json (ConnectionUpdate Accepted) . fn ) pure (r1, r2) connectWithRemoteUser :: - (MonadReader TestSetup m, MonadIO m, MonadHttp m, MonadCatch m, HasCallStack) => + (HasBrig m, MonadIO m, MonadHttp m, MonadCatch m, HasCallStack) => UserId -> Qualified UserId -> m () connectWithRemoteUser self other = do let req = CreateConnectionForTest self other - b <- view tsBrig + b <- viewBrig put ( b . zUser self @@ -1862,10 +1880,10 @@ connectWithRemoteUser self other = do -- | A copy of 'postConnection' from Brig integration tests. postConnection :: UserId -> UserId -> TestM ResponseLBS postConnection from to = do - brig <- view tsBrig + brig <- view tsUnversionedBrig post $ brig - . path "/connections" + . paths ["v1", "connections"] . contentJson . body payload . zUser from @@ -1877,10 +1895,10 @@ postConnection from to = do postConnectionQualified :: UserId -> Qualified UserId -> TestM ResponseLBS postConnectionQualified from (Qualified toUser toDomain) = do - brig <- view tsBrig + brig <- viewBrig post $ brig - . paths ["/connections", toByteString' toDomain, toByteString' toUser] + . paths ["connections", toByteString' toDomain, toByteString' toUser] . contentJson . zUser from . zConn "conn" @@ -1888,10 +1906,10 @@ postConnectionQualified from (Qualified toUser toDomain) = do -- | A copy of 'putConnection' from Brig integration tests. putConnection :: UserId -> UserId -> Relation -> TestM ResponseLBS putConnection from to r = do - brig <- view tsBrig + brig <- view tsUnversionedBrig put $ brig - . paths ["/connections", toByteString' to] + . paths ["v1", "connections", toByteString' to] . contentJson . body payload . zUser from @@ -1909,10 +1927,10 @@ putConnectionQualified fromQualified to r = do "The qualified user's domain is not local" localDomain qualifiedDomain - brig <- view tsBrig + brig <- view tsUnversionedBrig put $ brig - . paths ["/connections", toByteString' to] + . paths ["v1", "connections", toByteString' to] . contentJson . body payload . zUser from @@ -1923,7 +1941,7 @@ putConnectionQualified fromQualified to r = do -- | A copy of `assertConnections from Brig integration tests. assertConnections :: HasCallStack => UserId -> [ConnectionStatus] -> TestM () assertConnections u cstat = do - brig <- view tsBrig + brig <- view tsUnversionedBrig resp <- listConnections brig u show cstat <> " is not a subset of " <> show cstat' where status c = ConnectionStatus (ucFrom c) (qUnqualified $ ucTo c) (ucStatus c) - listConnections brig usr = get $ brig . path "connections" . zUser usr + listConnections brig usr = get $ brig . paths ["v1", "connections"] . zUser usr randomUsers :: Int -> TestM [UserId] randomUsers n = replicateM n randomUser @@ -1964,7 +1982,7 @@ randomUser'' isCreator hasPassword hasEmail = selfUser <$> randomUserProfile' is randomUserProfile' :: HasCallStack => Bool -> Bool -> Bool -> TestM SelfProfile randomUserProfile' isCreator hasPassword hasEmail = do - b <- view tsBrig + b <- viewBrig e <- liftIO randomEmail let p = object $ @@ -1976,7 +1994,7 @@ randomUserProfile' isCreator hasPassword hasEmail = do ephemeralUser :: HasCallStack => TestM UserId ephemeralUser = do - b <- view tsBrig + b <- viewBrig name <- UUID.toText <$> liftIO nextRandom let p = object ["name" .= name] r <- post (b . path "/register" . json p) UserId -> LastPrekey -> Maybe (Set Client.ClientCapability) -> TestM ClientId randomClientWithCaps uid lk caps = do - b <- view tsBrig + b <- viewBrig resp <- post ( b @@ -2015,18 +2033,18 @@ ensureDeletedState check from u = do getDeletedState :: HasCallStack => UserId -> UserId -> TestM (Maybe Bool) getDeletedState from u = do - b <- view tsBrig + b <- view tsUnversionedBrig fmap profileDeleted . responseJsonMaybe <$> get ( b - . paths ["users", toByteString' u] + . paths ["v1", "users", toByteString' u] . zUser from . zConn "conn" ) getClients :: UserId -> TestM ResponseLBS getClients u = do - b <- view tsBrig + b <- viewBrig get $ b . paths ["clients"] @@ -2035,7 +2053,7 @@ getClients u = do getInternalClientsFull :: UserSet -> TestM UserClientsFull getInternalClientsFull userSet = do - b <- view tsBrig + b <- viewBrig res <- post $ b @@ -2053,7 +2071,7 @@ ensureClientCaps uid cid caps = do -- TODO: Refactor, as used also in brig deleteClient :: UserId -> ClientId -> Maybe PlainTextPassword -> TestM ResponseLBS deleteClient u c pw = do - b <- view tsBrig + b <- viewBrig delete $ b . paths ["clients", toByteString' c] @@ -2071,7 +2089,7 @@ deleteClient u c pw = do -- TODO: Refactor, as used also in brig isUserDeleted :: HasCallStack => UserId -> TestM Bool isUserDeleted u = do - b <- view tsBrig + b <- viewBrig r <- get (b . paths ["i", "users", toByteString' u, "status"]) ConvId -> TestM Bool isMember usr cnv = do - g <- view tsGalley + g <- viewGalley res <- get $ g @@ -2302,12 +2320,12 @@ mkProteusConv cnvId creator selfRole otherMembers = -- | ES is only refreshed occasionally; we don't want to wait for that in tests. refreshIndex :: TestM () refreshIndex = do - brig <- view tsBrig + brig <- viewBrig post (brig . path "/i/index/refresh") !!! const 200 === statusCode postSSOUser :: Text -> Bool -> UserSSOId -> TeamId -> TestM ResponseLBS postSSOUser name hasEmail ssoid teamid = do - brig <- view tsBrig + brig <- viewBrig email <- randomEmail let o = object $ @@ -2337,7 +2355,7 @@ instance HasSettingsOverrides TestM where runReaderT (runTestM action) ( ts - & tsGalley .~ Bilge.host "127.0.0.1" . Bilge.port port' + & tsUnversionedGalley .~ Bilge.host "127.0.0.1" . Bilge.port port' & tsFedGalleyClient .~ FedClient (ts ^. tsManager) (Endpoint "127.0.0.1" port') ) @@ -2349,7 +2367,7 @@ waitForMemberDeletion zusr tid uid = do assertFailure "Timed out waiting for member deletion" where loop = do - galley <- view tsGalley + galley <- viewGalley res <- get (galley . paths ["teams", toByteString' tid, "members", toByteString' uid] . zUser zusr) case statusCode res of 404 -> pure () @@ -2369,7 +2387,7 @@ deleteTeamMember g tid owner deletee = deleteTeam :: UserId -> TeamId -> TestM () deleteTeam owner tid = do - g <- view tsGalley + g <- viewGalley delete ( g . paths ["teams", toByteString' tid] @@ -2389,7 +2407,7 @@ getUsersByHandle = getUsersBy "handles" getUsersBy :: forall uidsOrHandles. (ToByteString uidsOrHandles) => ByteString -> [uidsOrHandles] -> TestM [User] getUsersBy keyName = chunkify $ \keys -> do - brig <- view tsBrig + brig <- viewBrig let users = BS.intercalate "," $ toByteString' <$> keys res <- get @@ -2403,8 +2421,8 @@ getUsersBy keyName = chunkify $ \keys -> do getUserProfile :: UserId -> UserId -> TestM UserProfile getUserProfile zusr uid = do - brig <- view tsBrig - res <- get (brig . zUser zusr . paths ["users", toByteString' uid]) + brig <- view tsUnversionedBrig + res <- get (brig . zUser zusr . paths ["v1", "users", toByteString' uid]) responseJsonError res upgradeClientToLH :: HasCallStack => UserId -> ClientId -> TestM () @@ -2413,7 +2431,7 @@ upgradeClientToLH zusr cid = putCapabilities :: HasCallStack => UserId -> ClientId -> [ClientCapability] -> TestM () putCapabilities zusr cid caps = do - brig <- view tsBrig + brig <- viewBrig void $ put ( brig @@ -2425,29 +2443,29 @@ putCapabilities zusr cid caps = do getUsersPrekeysClientUnqualified :: HasCallStack => UserId -> UserId -> ClientId -> TestM ResponseLBS getUsersPrekeysClientUnqualified zusr uid cid = do - brig <- view tsBrig + brig <- view tsUnversionedBrig get ( brig . zUser zusr - . paths ["users", toByteString' uid, "prekeys", toByteString' cid] + . paths ["v1", "users", toByteString' uid, "prekeys", toByteString' cid] ) getUsersPrekeyBundleUnqualified :: HasCallStack => UserId -> UserId -> TestM ResponseLBS getUsersPrekeyBundleUnqualified zusr uid = do - brig <- view tsBrig + brig <- view tsUnversionedBrig get ( brig . zUser zusr - . paths ["users", toByteString' uid, "prekeys"] + . paths ["v1", "users", toByteString' uid, "prekeys"] ) getMultiUserPrekeyBundleUnqualified :: HasCallStack => UserId -> UserClients -> TestM ResponseLBS getMultiUserPrekeyBundleUnqualified zusr userClients = do - brig <- view tsBrig + brig <- view tsUnversionedBrig post ( brig . zUser zusr - . paths ["users", "prekeys"] + . paths ["v1", "users", "prekeys"] . json userClients ) @@ -2724,7 +2742,7 @@ assertJust Nothing = liftIO $ error "Expected Just, got Nothing" iUpsertOne2OneConversation :: UpsertOne2OneConversationRequest -> TestM ResponseLBS iUpsertOne2OneConversation req = do - galley <- view tsGalley + galley <- viewGalley post (galley . path "/i/conversations/one2one/upsert" . Bilge.json req) createOne2OneConvWithRemote :: HasCallStack => Local UserId -> Remote UserId -> TestM () diff --git a/services/galley/test/integration/API/Util/TeamFeature.hs b/services/galley/test/integration/API/Util/TeamFeature.hs index 5e62e7b77f9..b56ee21c1b4 100644 --- a/services/galley/test/integration/API/Util/TeamFeature.hs +++ b/services/galley/test/integration/API/Util/TeamFeature.hs @@ -20,7 +20,7 @@ module API.Util.TeamFeature where import API.Util (HasGalley (viewGalley), zUser) import qualified API.Util as Util import Bilge -import Control.Lens (view, (.~), (^?)) +import Control.Lens ((.~), (^?)) import Control.Monad.Catch (MonadThrow) import Data.Aeson (FromJSON, Result (Success), ToJSON, Value, fromJSON) import Data.Aeson.Lens @@ -129,7 +129,7 @@ getFeatureConfig uid = do getAllFeatureConfigs :: HasCallStack => UserId -> TestM ResponseLBS getAllFeatureConfigs uid = do - g <- view tsGalley + g <- viewGalley getAllFeatureConfigsWithGalley g uid getAllFeatureConfigsWithGalley :: (MonadIO m, MonadHttp m, HasCallStack) => (Request -> Request) -> UserId -> m ResponseLBS @@ -171,7 +171,7 @@ putTeamFeatureFlagInternalTTL :: Public.WithStatusNoLock cfg -> TestM ResponseLBS putTeamFeatureFlagInternalTTL reqmod tid status = do - g <- view tsGalley + g <- viewGalley putTeamFeatureFlagInternalWithGalleyAndMod @cfg g reqmod tid status putTeamFeatureFlagInternal :: @@ -186,7 +186,7 @@ putTeamFeatureFlagInternal :: Public.WithStatusNoLock cfg -> TestM ResponseLBS putTeamFeatureFlagInternal reqmod tid status = do - g <- view tsGalley + g <- viewGalley putTeamFeatureFlagInternalWithGalleyAndMod @cfg g reqmod tid status putTeamFeatureFlagInternalWithGalleyAndMod :: @@ -222,7 +222,7 @@ setLockStatusInternal :: Public.LockStatus -> TestM ResponseLBS setLockStatusInternal reqmod tid lockStatus = do - galley <- view tsGalley + galley <- viewGalley put $ galley . paths ["i", "teams", toByteString' tid, "features", Public.featureNameBS @cfg, toByteString' lockStatus] @@ -238,7 +238,7 @@ getFeatureStatusInternal :: TeamId -> TestM ResponseLBS getFeatureStatusInternal tid = do - galley <- view tsGalley + galley <- viewGalley get $ galley . paths ["i", "teams", toByteString' tid, "features", Public.featureNameBS @cfg] @@ -255,7 +255,7 @@ patchFeatureStatusInternal :: Public.WithStatusPatch cfg -> TestM ResponseLBS patchFeatureStatusInternal tid reqBody = do - galley <- view tsGalley + galley <- viewGalley patch $ galley . paths ["i", "teams", toByteString' tid, "features", Public.featureNameBS @cfg] @@ -274,7 +274,7 @@ patchFeatureStatusInternalWithMod :: Public.WithStatusPatch cfg -> TestM ResponseLBS patchFeatureStatusInternalWithMod reqmod tid reqBody = do - galley <- view tsGalley + galley <- viewGalley patch $ galley . paths ["i", "teams", toByteString' tid, "features", Public.featureNameBS @cfg] diff --git a/services/galley/test/integration/TestSetup.hs b/services/galley/test/integration/TestSetup.hs index 9dcae5c3143..e01fc52b14c 100644 --- a/services/galley/test/integration/TestSetup.hs +++ b/services/galley/test/integration/TestSetup.hs @@ -25,8 +25,8 @@ module TestSetup tsGConf, tsIConf, tsManager, - tsGalley, - tsBrig, + tsUnversionedGalley, + tsUnversionedBrig, tsCannon, tsAwsEnv, tsMaxConvSize, @@ -112,8 +112,8 @@ data TestSetup = TestSetup { _tsGConf :: Opts, _tsIConf :: IntegrationConfig, _tsManager :: Manager, - _tsGalley :: GalleyR, - _tsBrig :: BrigR, + _tsUnversionedGalley :: GalleyR, + _tsUnversionedBrig :: BrigR, _tsCannon :: CannonR, _tsAwsEnv :: Maybe Aws.Env, _tsMaxConvSize :: Word16, From 4da26f5fbab8eac5b125f2e1723b17b2061ccd0e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marko=20Dimja=C5=A1evi=C4=87?= Date: Tue, 27 Sep 2022 13:40:10 +0200 Subject: [PATCH 57/58] [FS-923] Store Per-conversation GroupInfo Structure and Expose It (#2721) * Add the DB column for PublicGroupState * Processing a commit bundle: store PublicGroupState * Implement group-info endpoint (local conversation) * Implement group-info endpoint (remote conversation) Co-authored-by: Stefan Matting --- cassandra-schema.cql | 1 + changelog.d/1-api-changes/FS-923-group-info | 1 + .../src/Wire/API/Federation/API/Galley.hs | 19 +++ libs/wire-api/src/Wire/API/Error/Galley.hs | 3 + .../src/Wire/API/MLS/GroupInfoBundle.hs | 10 +- .../src/Wire/API/MLS/PublicGroupState.hs | 30 +++- .../src/Wire/API/Routes/Public/Galley.hs | 19 +++ .../test/unit/Test/Wire/API/Roundtrip/MLS.hs | 3 +- services/galley/galley.cabal | 3 + services/galley/schema/src/Main.hs | 4 +- .../galley/schema/src/V75_MLSGroupInfo.hs | 34 ++++ services/galley/src/Galley/API/Federation.hs | 29 +++- .../galley/src/Galley/API/MLS/GroupInfo.hs | 98 ++++++++++++ services/galley/src/Galley/API/MLS/Message.hs | 47 +++--- services/galley/src/Galley/API/MLS/Util.hs | 54 +++++++ .../galley/src/Galley/API/Public/Servant.hs | 2 + services/galley/src/Galley/Cassandra.hs | 2 +- .../src/Galley/Cassandra/Conversation.hs | 18 +++ .../galley/src/Galley/Cassandra/Instances.hs | 8 + .../galley/src/Galley/Cassandra/Queries.hs | 9 +- .../src/Galley/Effects/ConversationStore.hs | 10 ++ services/galley/test/integration/API/MLS.hs | 149 +++++++++++++++--- .../galley/test/integration/API/MLS/Util.hs | 58 +++++++ 23 files changed, 552 insertions(+), 59 deletions(-) create mode 100644 changelog.d/1-api-changes/FS-923-group-info create mode 100644 services/galley/schema/src/V75_MLSGroupInfo.hs create mode 100644 services/galley/src/Galley/API/MLS/GroupInfo.hs create mode 100644 services/galley/src/Galley/API/MLS/Util.hs diff --git a/cassandra-schema.cql b/cassandra-schema.cql index 81316299b98..c2ba0cbe065 100644 --- a/cassandra-schema.cql +++ b/cassandra-schema.cql @@ -461,6 +461,7 @@ CREATE TABLE galley_test.conversation ( message_timer bigint, name text, protocol int, + public_group_state blob, receipt_mode int, team uuid, type int diff --git a/changelog.d/1-api-changes/FS-923-group-info b/changelog.d/1-api-changes/FS-923-group-info new file mode 100644 index 00000000000..9eacbbd05ad --- /dev/null +++ b/changelog.d/1-api-changes/FS-923-group-info @@ -0,0 +1 @@ +MLS: Store and expose group info via `GET /conversations/:domain/:id/groupinfo` diff --git a/libs/wire-api-federation/src/Wire/API/Federation/API/Galley.hs b/libs/wire-api-federation/src/Wire/API/Federation/API/Galley.hs index 8aa6f52d9e7..ee690d531d6 100644 --- a/libs/wire-api-federation/src/Wire/API/Federation/API/Galley.hs +++ b/libs/wire-api-federation/src/Wire/API/Federation/API/Galley.hs @@ -70,6 +70,7 @@ type GalleyApi = :<|> FedEndpoint "on-mls-message-sent" RemoteMLSMessage EmptyResponse :<|> FedEndpoint "send-mls-message" MessageSendRequest MLSMessageResponse :<|> FedEndpoint "send-mls-commit-bundle" MessageSendRequest MLSMessageResponse + :<|> FedEndpoint "query-group-info" GetGroupInfoRequest GetGroupInfoResponse :<|> FedEndpoint "on-client-removed" ClientRemovedRequest EmptyResponse data ClientRemovedRequest = ClientRemovedRequest @@ -312,3 +313,21 @@ data MLSMessageResponse | MLSMessageResponseUpdates [ConversationUpdate] deriving stock (Eq, Show, Generic) deriving (ToJSON, FromJSON) via (CustomEncoded MLSMessageResponse) + +data GetGroupInfoRequest = GetGroupInfoRequest + { -- | Conversation is assumed to be owned by the target domain, this allows + -- us to protect against relay attacks + ggireqConv :: ConvId, + -- | Sender is assumed to be owned by the origin domain, this allows us to + -- protect against spoofing attacks + ggireqSender :: UserId + } + deriving stock (Eq, Show, Generic) + deriving (Arbitrary) via (GenericUniform GetGroupInfoRequest) + deriving (ToJSON, FromJSON) via (CustomEncoded GetGroupInfoRequest) + +data GetGroupInfoResponse + = GetGroupInfoResponseError GalleyError + | GetGroupInfoResponseState Base64ByteString + deriving stock (Eq, Show, Generic) + deriving (ToJSON, FromJSON) via (CustomEncoded GetGroupInfoResponse) diff --git a/libs/wire-api/src/Wire/API/Error/Galley.hs b/libs/wire-api/src/Wire/API/Error/Galley.hs index 11bad2e5707..171f894b3d5 100644 --- a/libs/wire-api/src/Wire/API/Error/Galley.hs +++ b/libs/wire-api/src/Wire/API/Error/Galley.hs @@ -82,6 +82,7 @@ data GalleyError | MLSGroupConversationMismatch | MLSClientSenderUserMismatch | MLSWelcomeMismatch + | MLSMissingGroupInfo | -- NoBindingTeamMembers | NoBindingTeam @@ -203,6 +204,8 @@ type instance MapError 'MLSClientSenderUserMismatch = 'StaticError 400 "mls-clie 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" + type instance MapError 'NoBindingTeamMembers = 'StaticError 403 "non-binding-team-members" "Both users must be members of the same binding team" type instance MapError 'NoBindingTeam = 'StaticError 403 "no-binding-team" "Operation allowed only on binding teams" diff --git a/libs/wire-api/src/Wire/API/MLS/GroupInfoBundle.hs b/libs/wire-api/src/Wire/API/MLS/GroupInfoBundle.hs index 5f1da34b87b..57acb31499f 100644 --- a/libs/wire-api/src/Wire/API/MLS/GroupInfoBundle.hs +++ b/libs/wire-api/src/Wire/API/MLS/GroupInfoBundle.hs @@ -34,10 +34,16 @@ data GroupInfoTreeType = TreeFull | TreeDelta | TreeByRef data GroupInfoBundle = GroupInfoBundle { gipEncryptionType :: GroupInfoEncryption, gipTreeType :: GroupInfoTreeType, - gipGroupState :: PublicGroupState + gipGroupState :: RawMLS PublicGroupState } deriving stock (Eq, Show, Generic) - deriving (Arbitrary) via GenericUniform GroupInfoBundle + +instance Arbitrary GroupInfoBundle where + arbitrary = + GroupInfoBundle + <$> arbitrary + <*> arbitrary + <*> (mkRawMLS <$> arbitrary) instance ParseMLS GroupInfoBundle where parseMLS = diff --git a/libs/wire-api/src/Wire/API/MLS/PublicGroupState.hs b/libs/wire-api/src/Wire/API/MLS/PublicGroupState.hs index ae3c4ba5e0f..d590260157d 100644 --- a/libs/wire-api/src/Wire/API/MLS/PublicGroupState.hs +++ b/libs/wire-api/src/Wire/API/MLS/PublicGroupState.hs @@ -18,8 +18,13 @@ module Wire.API.MLS.PublicGroupState where -import Data.Binary.Get (label) +import Data.Binary +import Data.Binary.Get +import Data.Binary.Put +import qualified Data.ByteString.Lazy as LBS +import qualified Data.Swagger as S import Imports +import Servant.API.ContentTypes import Test.QuickCheck hiding (label) import Wire.API.MLS.CipherSuite import Wire.API.MLS.Epoch @@ -27,6 +32,7 @@ import Wire.API.MLS.Extension import Wire.API.MLS.Group import Wire.API.MLS.KeyPackage import Wire.API.MLS.Serialisation +import Wire.API.MLS.Servant import Wire.Arbitrary data PublicGroupStateTBS = PublicGroupStateTBS @@ -80,6 +86,28 @@ data PublicGroupState = PublicGroupState } deriving stock (Eq, Show, Generic) +-- | A type that holds an MLS-encoded 'PublicGroupState' value via +-- 'serialiseMLS'. +newtype OpaquePublicGroupState = OpaquePublicGroupState + {unOpaquePublicGroupState :: ByteString} + deriving (Generic, Eq, Show) + deriving (Arbitrary) via (GenericUniform OpaquePublicGroupState) + +instance ParseMLS OpaquePublicGroupState where + parseMLS = OpaquePublicGroupState . LBS.toStrict <$> getRemainingLazyByteString + +instance SerialiseMLS OpaquePublicGroupState where + serialiseMLS (OpaquePublicGroupState bs) = putByteString bs + +instance S.ToSchema OpaquePublicGroupState where + declareNamedSchema _ = pure (mlsSwagger "OpaquePublicGroupState") + +instance MimeRender MLS OpaquePublicGroupState where + mimeRender _ = LBS.fromStrict . unOpaquePublicGroupState + +toOpaquePublicGroupState :: RawMLS PublicGroupState -> OpaquePublicGroupState +toOpaquePublicGroupState = OpaquePublicGroupState . rmRaw + instance Arbitrary PublicGroupState where arbitrary = PublicGroupState diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs b/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs index ffb364daf9a..eb56a4639c9 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs @@ -44,6 +44,7 @@ import Wire.API.Event.Conversation import Wire.API.MLS.CommitBundle import Wire.API.MLS.Keys import Wire.API.MLS.Message +import Wire.API.MLS.PublicGroupState import Wire.API.MLS.Serialisation import Wire.API.MLS.Servant import Wire.API.MLS.Welcome @@ -219,6 +220,24 @@ type ConversationAPI = :> "roles" :> Get '[Servant.JSON] ConversationRolesList ) + :<|> Named + "get-group-info" + ( Summary "Get MLS group information" + :> CanThrow 'ConvNotFound + :> CanThrow 'MLSMissingGroupInfo + :> ZLocalUser + :> "conversations" + :> QualifiedCapture "cnv" ConvId + :> "groupinfo" + :> MultiVerb1 + 'GET + '[MLS] + ( Respond + 200 + "The group information" + OpaquePublicGroupState + ) + ) :<|> Named "list-conversation-ids-unqualified" ( Summary "[deprecated] Get all local conversation IDs." diff --git a/libs/wire-api/test/unit/Test/Wire/API/Roundtrip/MLS.hs b/libs/wire-api/test/unit/Test/Wire/API/Roundtrip/MLS.hs index e1a4e9820da..c64845a252c 100644 --- a/libs/wire-api/test/unit/Test/Wire/API/Roundtrip/MLS.hs +++ b/libs/wire-api/test/unit/Test/Wire/API/Roundtrip/MLS.hs @@ -43,7 +43,8 @@ tests = testRoundTrip @ExtensionVector, testRoundTrip @PublicGroupStateTBS, testRoundTrip @PublicGroupState, - testRoundTrip @Welcome + testRoundTrip @Welcome, + testRoundTrip @OpaquePublicGroupState ] testRoundTrip :: diff --git a/services/galley/galley.cabal b/services/galley/galley.cabal index 7042d2839f0..6e3529e4974 100644 --- a/services/galley/galley.cabal +++ b/services/galley/galley.cabal @@ -31,12 +31,14 @@ library Galley.API.Mapping Galley.API.Message Galley.API.MLS + Galley.API.MLS.GroupInfo Galley.API.MLS.KeyPackage Galley.API.MLS.Keys Galley.API.MLS.Message Galley.API.MLS.Propagate Galley.API.MLS.Removal Galley.API.MLS.Types + Galley.API.MLS.Util Galley.API.MLS.Welcome Galley.API.One2One Galley.API.Public @@ -671,6 +673,7 @@ executable galley-schema V72_DropManagedConversations V73_MemberClientTable V74_ExposeInvitationsToTeamAdmin + V75_MLSGroupInfo hs-source-dirs: schema/src default-extensions: diff --git a/services/galley/schema/src/Main.hs b/services/galley/schema/src/Main.hs index 58878911439..1c987650ccb 100644 --- a/services/galley/schema/src/Main.hs +++ b/services/galley/schema/src/Main.hs @@ -77,6 +77,7 @@ import qualified V71_MemberClientKeypackage import qualified V72_DropManagedConversations import qualified V73_MemberClientTable import qualified V74_ExposeInvitationsToTeamAdmin +import qualified V75_MLSGroupInfo main :: IO () main = do @@ -139,7 +140,8 @@ main = do V71_MemberClientKeypackage.migration, V72_DropManagedConversations.migration, V73_MemberClientTable.migration, - V74_ExposeInvitationsToTeamAdmin.migration + V74_ExposeInvitationsToTeamAdmin.migration, + V75_MLSGroupInfo.migration -- When adding migrations here, don't forget to update -- 'schemaVersion' in Galley.Cassandra -- (see also docs/developer/cassandra-interaction.md) diff --git a/services/galley/schema/src/V75_MLSGroupInfo.hs b/services/galley/schema/src/V75_MLSGroupInfo.hs new file mode 100644 index 00000000000..4615c73954e --- /dev/null +++ b/services/galley/schema/src/V75_MLSGroupInfo.hs @@ -0,0 +1,34 @@ +-- 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 V75_MLSGroupInfo + ( migration, + ) +where + +import Cassandra.Schema +import Imports +import Text.RawString.QQ + +migration :: Migration +migration = + Migration 75 "Add the MLS public group state column to the conversation table" $ + schema' + [r| ALTER TABLE conversation ADD ( + public_group_state blob + ) + |] diff --git a/services/galley/src/Galley/API/Federation.hs b/services/galley/src/Galley/API/Federation.hs index e1c5a22c172..46e56f2fe6d 100644 --- a/services/galley/src/Galley/API/Federation.hs +++ b/services/galley/src/Galley/API/Federation.hs @@ -38,6 +38,7 @@ import qualified Data.Text.Lazy as LT import Data.Time.Clock import Galley.API.Action import Galley.API.Error +import Galley.API.MLS.GroupInfo import Galley.API.MLS.KeyPackage import Galley.API.MLS.Message import Galley.API.MLS.Removal @@ -80,12 +81,13 @@ import Wire.API.Error.Galley import Wire.API.Event.Conversation import Wire.API.Federation.API import Wire.API.Federation.API.Common (EmptyResponse (..)) -import Wire.API.Federation.API.Galley (ClientRemovedRequest, ConversationUpdateResponse) +import Wire.API.Federation.API.Galley import qualified Wire.API.Federation.API.Galley as F import Wire.API.Federation.Error import Wire.API.MLS.CommitBundle import Wire.API.MLS.Credential import Wire.API.MLS.Message +import Wire.API.MLS.PublicGroupState import Wire.API.MLS.Serialisation import Wire.API.MLS.Welcome import Wire.API.Message @@ -111,6 +113,7 @@ federationSitemap = :<|> Named @"on-mls-message-sent" onMLSMessageSent :<|> Named @"send-mls-message" sendMLSMessage :<|> Named @"send-mls-commit-bundle" sendMLSCommitBundle + :<|> Named @"query-group-info" queryGroupInfo :<|> Named @"on-client-removed" onClientRemoved onClientRemoved :: @@ -771,3 +774,27 @@ onMLSMessageSent domain rmm = do runMessagePush loc (Just (qUntagged rcnv)) $ foldMap mkPush recipients pure EmptyResponse + +queryGroupInfo :: + ( Members + '[ ConversationStore, + Input (Local ()) + ] + r, + Member MemberStore r + ) => + Domain -> + F.GetGroupInfoRequest -> + Sem r F.GetGroupInfoResponse +queryGroupInfo origDomain req = + fmap (either F.GetGroupInfoResponseError F.GetGroupInfoResponseState) + . runError @GalleyError + . mapToGalleyError @MLSGroupInfoStaticErrors + $ do + lconvId <- qualifyLocal . ggireqConv $ req + let sender = toRemoteUnsafe origDomain . ggireqSender $ req + state <- getGroupInfoFromLocalConv (qUntagged sender) lconvId + pure + . Base64ByteString + . unOpaquePublicGroupState + $ state diff --git a/services/galley/src/Galley/API/MLS/GroupInfo.hs b/services/galley/src/Galley/API/MLS/GroupInfo.hs new file mode 100644 index 00000000000..40637193b6d --- /dev/null +++ b/services/galley/src/Galley/API/MLS/GroupInfo.hs @@ -0,0 +1,98 @@ +-- 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 Galley.API.MLS.GroupInfo where + +import Data.Id as Id +import Data.Json.Util +import Data.Qualified +import Galley.API.MLS.Util +import Galley.API.Util +import Galley.Effects +import qualified Galley.Effects.ConversationStore as E +import qualified Galley.Effects.FederatorAccess as E +import Imports +import Polysemy +import Polysemy.Error +import Polysemy.Input +import Wire.API.Error +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.PublicGroupState + +type MLSGroupInfoStaticErrors = + '[ ErrorS 'ConvNotFound, + ErrorS 'MLSMissingGroupInfo + ] + +getGroupInfo :: + Members + '[ ConversationStore, + Error FederationError, + FederatorAccess, + Input (Local ()), + MemberStore + ] + r => + Members MLSGroupInfoStaticErrors r => + Local UserId -> + Qualified ConvId -> + Sem r OpaquePublicGroupState +getGroupInfo lusr qcnvId = + foldQualified + lusr + (getGroupInfoFromLocalConv . qUntagged $ lusr) + (getGroupInfoFromRemoteConv lusr) + qcnvId + +getGroupInfoFromLocalConv :: + Members + '[ ConversationStore, + MemberStore, + Input (Local ()) + ] + r => + Members MLSGroupInfoStaticErrors r => + Qualified UserId -> + Local ConvId -> + Sem r OpaquePublicGroupState +getGroupInfoFromLocalConv qusr lcnvId = do + void $ getLocalConvForUser qusr lcnvId + E.getPublicGroupState (tUnqualified lcnvId) + >>= noteS @'MLSMissingGroupInfo + +getGroupInfoFromRemoteConv :: + Members '[Error FederationError, FederatorAccess] r => + Members MLSGroupInfoStaticErrors r => + Local UserId -> + Remote ConvId -> + Sem r OpaquePublicGroupState +getGroupInfoFromRemoteConv lusr rcnv = do + let getRequest = + GetGroupInfoRequest + { ggireqSender = tUnqualified lusr, + ggireqConv = tUnqualified rcnv + } + response <- E.runFederated rcnv (fedClient @'Galley @"query-group-info" getRequest) + case response of + GetGroupInfoResponseError e -> rethrowErrors @MLSGroupInfoStaticErrors e + GetGroupInfoResponseState s -> + pure . OpaquePublicGroupState + . fromBase64ByteString + $ s diff --git a/services/galley/src/Galley/API/MLS/Message.hs b/services/galley/src/Galley/API/MLS/Message.hs index e5c6334977b..f90829e7664 100644 --- a/services/galley/src/Galley/API/MLS/Message.hs +++ b/services/galley/src/Galley/API/MLS/Message.hs @@ -41,6 +41,7 @@ import Galley.API.Error import Galley.API.MLS.KeyPackage import Galley.API.MLS.Propagate import Galley.API.MLS.Types +import Galley.API.MLS.Util import Galley.API.MLS.Welcome (postMLSWelcome) import Galley.API.Util import Galley.Data.Conversation.Types hiding (Conversation) @@ -76,10 +77,12 @@ import Wire.API.MLS.CipherSuite import Wire.API.MLS.Commit import Wire.API.MLS.CommitBundle import Wire.API.MLS.Credential +import Wire.API.MLS.GroupInfoBundle import Wire.API.MLS.KeyPackage import Wire.API.MLS.Message import Wire.API.MLS.Proposal import qualified Wire.API.MLS.Proposal as Proposal +import Wire.API.MLS.PublicGroupState import Wire.API.MLS.Serialisation import Wire.API.MLS.Welcome import Wire.API.Message @@ -278,7 +281,18 @@ postMLSCommitBundleToLocalConv qusr conn bundle lcnv = do /= Set.fromList (map (snd . snd) (cmAssocs (paAdd action))) ) $ throwS @'MLSWelcomeMismatch - processCommitWithAction qusr senderClient conn lconv cm (msgEpoch msg) groupId action (msgSender msg) commit + processCommitWithAction + qusr + senderClient + conn + lconv + cm + (msgEpoch msg) + groupId + action + (msgSender msg) + (Just . cbGroupInfoBundle $ bundle) + commit ApplicationMessage _ -> throwS @'MLSUnsupportedMessage ProposalMessage _ -> throwS @'MLSUnsupportedMessage @@ -333,27 +347,6 @@ postMLSCommitBundleToRemoteConv loc qusr con bundle rcnv = do e <- notifyRemoteConversationAction loc (qualifyAs rcnv update) con pure (LocalConversationUpdate e update) -getLocalConvForUser :: - Members - '[ ErrorS 'ConvNotFound, - ConversationStore, - Input (Local ()), - MemberStore - ] - r => - Qualified UserId -> - Local ConvId -> - Sem r Data.Conversation -getLocalConvForUser qusr lcnv = do - conv <- getConversation (tUnqualified lcnv) >>= noteS @'ConvNotFound - - -- check that sender is part of conversation - loc <- qualifyLocal () - isMember' <- foldQualified loc (fmap isJust . getLocalMember (convId conv) . tUnqualified) (fmap isJust . getRemoteMember (convId conv)) qusr - unless isMember' $ throwS @'ConvNotFound - - pure conv - postMLSMessage :: ( HasProposalEffects r, Members @@ -606,7 +599,7 @@ processCommit :: Sem r [LocalConversationUpdate] processCommit qusr senderClient con lconv cm epoch sender commit = do (groupId, action) <- getCommitData lconv epoch commit - processCommitWithAction qusr senderClient con lconv cm epoch groupId action sender commit + processCommitWithAction qusr senderClient con lconv cm epoch groupId action sender Nothing commit processCommitWithAction :: ( HasProposalEffects r, @@ -632,9 +625,10 @@ processCommitWithAction :: GroupId -> ProposalAction -> Sender 'MLSPlainText -> + Maybe GroupInfoBundle -> Commit -> Sem r [LocalConversationUpdate] -processCommitWithAction qusr senderClient con lconv cm epoch groupId action sender commit = do +processCommitWithAction qusr senderClient con lconv cm epoch groupId action sender mGIBundle commit = do self <- noteS @'ConvNotFound $ getConvMember lconv (tUnqualified lconv) qusr let ttlSeconds :: Int = 600 -- 10 minutes @@ -690,6 +684,11 @@ processCommitWithAction qusr senderClient con lconv cm epoch groupId action send postponedKeyPackageRefUpdate -- increment epoch number setConversationEpoch (Data.convId (tUnqualified lconv)) (succ epoch) + -- set the group info + for_ mGIBundle $ + setPublicGroupState (Data.convId (tUnqualified lconv)) + . toOpaquePublicGroupState + . gipGroupState pure updates diff --git a/services/galley/src/Galley/API/MLS/Util.hs b/services/galley/src/Galley/API/MLS/Util.hs new file mode 100644 index 00000000000..304926137ca --- /dev/null +++ b/services/galley/src/Galley/API/MLS/Util.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 Galley.API.MLS.Util where + +import Control.Comonad +import Data.Id +import Data.Qualified +import Galley.API.Util +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 Imports +import Polysemy +import Polysemy.Input +import Wire.API.Error +import Wire.API.Error.Galley + +getLocalConvForUser :: + Members + '[ ErrorS 'ConvNotFound, + ConversationStore, + Input (Local ()), + MemberStore + ] + r => + Qualified UserId -> + Local ConvId -> + Sem r Data.Conversation +getLocalConvForUser qusr lcnv = do + conv <- getConversation (tUnqualified lcnv) >>= noteS @'ConvNotFound + + -- check that sender is part of conversation + loc <- qualifyLocal () + isMember' <- foldQualified loc (fmap isJust . getLocalMember (convId conv) . tUnqualified) (fmap isJust . getRemoteMember (convId conv)) qusr + unless isMember' $ throwS @'ConvNotFound + + pure conv diff --git a/services/galley/src/Galley/API/Public/Servant.hs b/services/galley/src/Galley/API/Public/Servant.hs index 7686b15ef3b..9e32a4aa939 100644 --- a/services/galley/src/Galley/API/Public/Servant.hs +++ b/services/galley/src/Galley/API/Public/Servant.hs @@ -21,6 +21,7 @@ import Galley.API.Create import Galley.API.CustomBackend import Galley.API.LegalHold import Galley.API.MLS +import Galley.API.MLS.GroupInfo import Galley.API.Query import Galley.API.Teams import Galley.API.Teams.Features @@ -50,6 +51,7 @@ servantSitemap = <@> mkNamedAPI @"get-unqualified-conversation-legalhold-alias" getUnqualifiedConversation <@> mkNamedAPI @"get-conversation" getConversation <@> mkNamedAPI @"get-conversation-roles" getConversationRoles + <@> mkNamedAPI @"get-group-info" getGroupInfo <@> mkNamedAPI @"list-conversation-ids-unqualified" conversationIdsPageFromUnqualified <@> mkNamedAPI @"list-conversation-ids" conversationIdsPageFrom <@> mkNamedAPI @"get-conversations" getConversations diff --git a/services/galley/src/Galley/Cassandra.hs b/services/galley/src/Galley/Cassandra.hs index 275255cd59c..f01b95a4f37 100644 --- a/services/galley/src/Galley/Cassandra.hs +++ b/services/galley/src/Galley/Cassandra.hs @@ -20,4 +20,4 @@ module Galley.Cassandra (schemaVersion) where import Imports schemaVersion :: Int32 -schemaVersion = 74 +schemaVersion = 75 diff --git a/services/galley/src/Galley/Cassandra/Conversation.hs b/services/galley/src/Galley/Cassandra/Conversation.hs index 9956105bb6d..a245c29269a 100644 --- a/services/galley/src/Galley/Cassandra/Conversation.hs +++ b/services/galley/src/Galley/Cassandra/Conversation.hs @@ -54,6 +54,7 @@ import Wire.API.Conversation hiding (Conversation, Member) import Wire.API.Conversation.Protocol import Wire.API.MLS.CipherSuite import Wire.API.MLS.Group +import Wire.API.MLS.PublicGroupState createConversation :: Local ConvId -> NewConversation -> Client Conversation createConversation lcnv nc = do @@ -133,6 +134,17 @@ conversationMeta conv = accessRoles = maybeRole t $ parseAccessRoles r mbAccessRolesV2 pure $ ConversationMetadata t c (defAccess t a) accessRoles n i mt rm +getPublicGroupState :: ConvId -> Client (Maybe OpaquePublicGroupState) +getPublicGroupState cid = do + fmap join $ + runIdentity + <$$> retry + x1 + ( query1 + Cql.selectPublicGroupState + (params LocalQuorum (Identity cid)) + ) + isConvAlive :: ConvId -> Client Bool isConvAlive cid = do result <- retry x1 (query1 Cql.isConvDeleted (params LocalQuorum (Identity cid))) @@ -164,6 +176,10 @@ updateConvMessageTimer cid mtimer = retry x5 $ write Cql.updateConvMessageTimer updateConvEpoch :: ConvId -> Epoch -> Client () updateConvEpoch cid epoch = retry x5 $ write Cql.updateConvEpoch (params LocalQuorum (epoch, cid)) +setPublicGroupState :: ConvId -> OpaquePublicGroupState -> Client () +setPublicGroupState conv gib = + write Cql.updatePublicGroupState (params LocalQuorum (gib, conv)) + getConversation :: ConvId -> Client (Maybe Conversation) getConversation conv = do cdata <- UnliftIO.async $ retry x1 (query1 Cql.selectConv (params LocalQuorum (Identity conv))) @@ -302,6 +318,7 @@ interpretConversationStoreToCassandra = interpret $ \case GetConversationIdByGroupId gId -> embedClient $ lookupGroupId gId GetConversations cids -> localConversations cids GetConversationMetadata cid -> embedClient $ conversationMeta cid + GetPublicGroupState cid -> embedClient $ getPublicGroupState cid IsConversationAlive cid -> embedClient $ isConvAlive cid SelectConversations uid cids -> embedClient $ localConversationIdsOf uid cids GetRemoteConversationStatus uid cids -> embedClient $ remoteConversationStatus uid cids @@ -313,5 +330,6 @@ interpretConversationStoreToCassandra = interpret $ \case SetConversationEpoch cid epoch -> embedClient $ updateConvEpoch cid epoch DeleteConversation cid -> embedClient $ deleteConversation cid SetGroupId gId cid -> embedClient $ mapGroupId gId cid + SetPublicGroupState cid gib -> embedClient $ setPublicGroupState cid gib AcquireCommitLock gId epoch ttl -> embedClient $ acquireCommitLock gId epoch ttl ReleaseCommitLock gId epoch -> embedClient $ releaseCommitLock gId epoch diff --git a/services/galley/src/Galley/Cassandra/Instances.hs b/services/galley/src/Galley/Cassandra/Instances.hs index a0dce48efdc..4860fdd3e12 100644 --- a/services/galley/src/Galley/Cassandra/Instances.hs +++ b/services/galley/src/Galley/Cassandra/Instances.hs @@ -39,6 +39,7 @@ import Wire.API.Conversation import Wire.API.Conversation.Protocol import Wire.API.MLS.CipherSuite import Wire.API.MLS.Proposal +import Wire.API.MLS.PublicGroupState import Wire.API.MLS.Serialisation import Wire.API.Team import qualified Wire.API.Team.Feature as Public @@ -198,6 +199,13 @@ instance Cql GroupId where fromCql (CqlBlob b) = Right . GroupId . LBS.toStrict $ b fromCql _ = Left "group_id: blob expected" +instance Cql OpaquePublicGroupState where + ctype = Tagged BlobColumn + + toCql = CqlBlob . LBS.fromStrict . unOpaquePublicGroupState + fromCql (CqlBlob b) = Right $ OpaquePublicGroupState (LBS.toStrict b) + fromCql _ = Left "OpaquePublicGroupState: blob expected" + instance Cql Icon where ctype = Tagged TextColumn toCql = CqlText . T.decodeUtf8 . toByteString' diff --git a/services/galley/src/Galley/Cassandra/Queries.hs b/services/galley/src/Galley/Cassandra/Queries.hs index 0436b16a924..9e50d5808ea 100644 --- a/services/galley/src/Galley/Cassandra/Queries.hs +++ b/services/galley/src/Galley/Cassandra/Queries.hs @@ -34,8 +34,8 @@ import Wire.API.Conversation.Code import Wire.API.Conversation.Protocol import Wire.API.Conversation.Role import Wire.API.MLS.CipherSuite -import Wire.API.MLS.GroupInfoBundle import Wire.API.MLS.KeyPackage +import Wire.API.MLS.PublicGroupState import Wire.API.Provider import Wire.API.Provider.Service import Wire.API.Team @@ -233,8 +233,11 @@ deleteConv = "delete from conversation using timestamp 32503680000000000 where c markConvDeleted :: PrepQuery W (Identity ConvId) () markConvDeleted = "update conversation set deleted = true where conv = ?" -updateGroupInfoBundle :: PrepQuery W (GroupInfoBundle, ConvId) () -updateGroupInfoBundle = "update conversation set group_info_bundle = ? where conv = ?" +selectPublicGroupState :: PrepQuery R (Identity ConvId) (Identity (Maybe OpaquePublicGroupState)) +selectPublicGroupState = "select public_group_state from conversation where conv = ?" + +updatePublicGroupState :: PrepQuery W (OpaquePublicGroupState, ConvId) () +updatePublicGroupState = "update conversation set public_group_state = ? where conv = ?" -- Conversations accessible by code ----------------------------------------- diff --git a/services/galley/src/Galley/Effects/ConversationStore.hs b/services/galley/src/Galley/Effects/ConversationStore.hs index 442d2cfe8c1..8a4b699a72d 100644 --- a/services/galley/src/Galley/Effects/ConversationStore.hs +++ b/services/galley/src/Galley/Effects/ConversationStore.hs @@ -30,6 +30,7 @@ module Galley.Effects.ConversationStore getConversationIdByGroupId, getConversations, getConversationMetadata, + getPublicGroupState, isConversationAlive, getRemoteConversationStatus, selectConversations, @@ -43,6 +44,7 @@ module Galley.Effects.ConversationStore setConversationEpoch, acceptConnectConversation, setGroupId, + setPublicGroupState, -- * Delete conversation deleteConversation, @@ -65,6 +67,7 @@ import Imports import Polysemy import Wire.API.Conversation hiding (Conversation, Member) import Wire.API.MLS.Epoch +import Wire.API.MLS.PublicGroupState data ConversationStore m a where CreateConversationId :: ConversationStore m ConvId @@ -74,6 +77,9 @@ data ConversationStore m a where GetConversationIdByGroupId :: GroupId -> ConversationStore m (Maybe (Qualified ConvId)) GetConversations :: [ConvId] -> ConversationStore m [Conversation] GetConversationMetadata :: ConvId -> ConversationStore m (Maybe ConversationMetadata) + GetPublicGroupState :: + ConvId -> + ConversationStore m (Maybe OpaquePublicGroupState) IsConversationAlive :: ConvId -> ConversationStore m Bool GetRemoteConversationStatus :: UserId -> @@ -87,6 +93,10 @@ data ConversationStore m a where SetConversationMessageTimer :: ConvId -> Maybe Milliseconds -> ConversationStore m () SetConversationEpoch :: ConvId -> Epoch -> ConversationStore m () SetGroupId :: GroupId -> Qualified ConvId -> ConversationStore m () + SetPublicGroupState :: + ConvId -> + OpaquePublicGroupState -> + ConversationStore m () AcquireCommitLock :: GroupId -> Epoch -> NominalDiffTime -> ConversationStore m LockAcquired ReleaseCommitLock :: GroupId -> Epoch -> ConversationStore m () diff --git a/services/galley/test/integration/API/MLS.hs b/services/galley/test/integration/API/MLS.hs index 811939d4ffe..352c3b356f3 100644 --- a/services/galley/test/integration/API/MLS.hs +++ b/services/galley/test/integration/API/MLS.hs @@ -165,7 +165,13 @@ tests s = test s "remove users bypassing MLS" testRemoveUsersDirectly, test s "send proteus message to an MLS conversation" testProteusMessage ], - test s "public keys" testPublicKeys + test s "public keys" testPublicKeys, + testGroup + "GroupInfo" + [ test s "get group info for a local conversation" testGetGroupInfoOfLocalConv, + test s "get group info for a remote conversation" testGetGroupInfoOfRemoteConv, + test s "get group info for a remote user" testFederatedGetGroupInfo + ] ] postMLSConvFail :: TestM () @@ -929,30 +935,6 @@ testLocalToRemote = do msrConvId bdy @?= qUnqualified qcnv msrSender bdy @?= qUnqualified bob msrRawMessage bdy @?= Base64ByteString (mpMessage message) - where - receiveOnConvUpdated conv origUser joiner = do - client <- view tsFedGalleyClient - now <- liftIO getCurrentTime - let cu = - ConversationUpdate - { cuTime = now, - cuOrigUserId = origUser, - cuConvId = qUnqualified conv, - cuAlreadyPresentUsers = [qUnqualified joiner], - cuAction = - SomeConversationAction - SConversationJoinTag - ConversationJoin - { cjUsers = pure joiner, - cjRole = roleNameWireMember - } - } - void $ - runFedClient - @"on-conversation-updated" - client - (qDomain conv) - cu testLocalToRemoteNonMember :: TestM () testLocalToRemoteNonMember = do @@ -1833,3 +1815,120 @@ testBackendRemoveProposalLocalConvRemoteClient = do WS.assertMatch_ (5 # WS.Second) wsA $ \notification -> void $ wsAssertBackendRemoveProposal bob qcnv bob1KP notification + +testGetGroupInfoOfLocalConv :: TestM () +testGetGroupInfoOfLocalConv = do + [alice, bob] <- createAndConnectUsers [Nothing, Nothing] + + runMLSTest $ do + [alice1, bob1] <- traverse createMLSClient [alice, bob] + traverse_ uploadNewKeyPackage [bob1] + (_, qcnv) <- setupMLSGroup alice1 + commit <- createAddCommit alice1 [bob] + + void $ sendAndConsumeCommitBundle commit + + -- check the group info matches + gs <- assertJust (mpPublicGroupState commit) + returnedGS <- + fmap responseBody $ + getGroupInfo (qUnqualified alice) qcnv + returnedGS + +testGetGroupInfoOfRemoteConv :: TestM () +testGetGroupInfoOfRemoteConv = do + let aliceDomain = Domain "faraway.example.com" + [alice, bob, charlie] <- createAndConnectUsers [Just (domainText aliceDomain), Nothing, Nothing] + + runMLSTest $ do + [alice1, bob1] <- traverse createMLSClient [alice, bob] + + void $ uploadNewKeyPackage bob1 + (groupId, qcnv) <- setupFakeMLSGroup alice1 + mp <- createAddCommit alice1 [bob] + traverse_ consumeWelcome (mpWelcome mp) + + receiveNewRemoteConv qcnv groupId + receiveOnConvUpdated qcnv alice bob + + let fakeGroupState = "\xde\xad\xbe\xef" + let mock req = case frRPC req of + "query-group-info" -> do + request <- either (assertFailure . ("Parse failure in query-group-info " <>)) pure (Aeson.eitherDecode (frBody req)) + let uid = ggireqSender request + pure . Aeson.encode $ + if uid == qUnqualified bob + then GetGroupInfoResponseState (Base64ByteString fakeGroupState) + else GetGroupInfoResponseError ConvNotFound + s -> error ("unmocked: " <> T.unpack s) + + (_, reqs) <- withTempMockFederator' mock $ do + res <- + fmap responseBody $ + getGroupInfo (qUnqualified bob) qcnv + pure (Aeson.encode EmptyResponse) + "on-conversation-updated" -> pure (Aeson.encode ()) + "mls-welcome" -> pure (Aeson.encode EmptyResponse) + "get-mls-clients" -> + pure + . Aeson.encode + . Set.fromList + . map (flip ClientInfo True) + $ [ciClient bob1] + ms -> assertFailure ("unmocked endpoint called: " <> cs ms) + + void . withTempMockFederator' mock $ do + void $ sendAndConsumeCommitBundle commit + + fedGalleyClient <- view tsFedGalleyClient + do + resp <- + runFedClient + @"query-group-info" + fedGalleyClient + (ciDomain bob1) + (GetGroupInfoRequest (qUnqualified qcnv) (qUnqualified bob)) + + liftIO $ case resp of + GetGroupInfoResponseError err -> assertFailure ("Unexpected error: " <> show err) + GetGroupInfoResponseState gs -> + fromBase64ByteString gs @=? groupState + + do + resp <- + runFedClient + @"query-group-info" + fedGalleyClient + (ciDomain bob1) + (GetGroupInfoRequest (qUnqualified qcnv) (qUnqualified charlie)) + + liftIO $ case resp of + GetGroupInfoResponseError err -> + err @?= ConvNotFound + GetGroupInfoResponseState _ -> + assertFailure "Unexpected success" diff --git a/services/galley/test/integration/API/MLS/Util.hs b/services/galley/test/integration/API/MLS/Util.hs index 3e7f6c8eb91..e71e592a6ad 100644 --- a/services/galley/test/integration/API/MLS/Util.hs +++ b/services/galley/test/integration/API/MLS/Util.hs @@ -45,6 +45,7 @@ import Data.Qualified import qualified Data.Set as Set import qualified Data.Text as T import qualified Data.Text.Encoding as T +import Data.Time.Clock (getCurrentTime) import Galley.Keys import Galley.Options import Imports @@ -59,7 +60,9 @@ import Test.Tasty.HUnit import TestHelpers import TestSetup import Wire.API.Conversation +import Wire.API.Conversation.Action import Wire.API.Conversation.Protocol +import Wire.API.Conversation.Role (roleNameWireMember) import Wire.API.Event.Conversation import Wire.API.Federation.API.Galley import Wire.API.MLS.CipherSuite @@ -893,3 +896,58 @@ receiveNewRemoteConv conv gid = do client (qDomain conv) nrc + +receiveOnConvUpdated :: + (MonadReader TestSetup m, MonadIO m) => + Qualified ConvId -> + Qualified UserId -> + Qualified UserId -> + m () +receiveOnConvUpdated conv origUser joiner = do + client <- view tsFedGalleyClient + now <- liftIO getCurrentTime + let cu = + ConversationUpdate + { cuTime = now, + cuOrigUserId = origUser, + cuConvId = qUnqualified conv, + cuAlreadyPresentUsers = [qUnqualified joiner], + cuAction = + SomeConversationAction + SConversationJoinTag + ConversationJoin + { cjUsers = pure joiner, + cjRole = roleNameWireMember + } + } + void $ + runFedClient + @"on-conversation-updated" + client + (qDomain conv) + cu + +getGroupInfo :: + ( HasCallStack, + MonadIO m, + MonadCatch m, + MonadThrow m, + MonadHttp m, + HasGalley m + ) => + UserId -> + Qualified ConvId -> + m ResponseLBS +getGroupInfo sender qcnv = do + galley <- viewGalley + get + ( galley + . paths + [ "conversations", + toByteString' (qDomain qcnv), + toByteString' (qUnqualified qcnv), + "groupinfo" + ] + . zUser sender + . zConn "conn" + ) From d31ab5267fd69ed57daabb7571ab15c31f875f19 Mon Sep 17 00:00:00 2001 From: Zebot Date: Tue, 27 Sep 2022 13:14:29 +0000 Subject: [PATCH 58/58] Add changelog for Release 2022-09-27 --- CHANGELOG.md | 113 ++++++++++++++++++ changelog.d/0-release-notes/coturn-labels | 6 - .../helm-chart-default-resources | 1 - .../0-release-notes/team-settings-upgrade | 1 - changelog.d/0-release-notes/webapp-upgrade | 1 - .../1-api-changes/FS-922-post-commit-bundle | 1 - changelog.d/1-api-changes/FS-923-group-info | 1 - .../add-mls-public-keys-to-nginz | 1 - changelog.d/1-api-changes/backend-removal-fix | 1 - changelog.d/1-api-changes/leave-mls-conv | 1 - .../validate-remotely-claimed-key-packages | 1 - changelog.d/2-features/coturn-metrics | 2 - .../mls-remote-proposals-on-client-deletion | 1 - .../mls-remove-proposals-on-user-deletion | 1 - changelog.d/2-features/non-admin-commits | 1 - .../2-features/registration-url-in-invitation | 1 - .../more-stable-user-deletion-via-scim | 1 - changelog.d/3-bug-fixes/pr-2693 | 1 - changelog.d/3-bug-fixes/sqpit-1431 | 1 - changelog.d/4-docs/FS-672 | 2 - changelog.d/4-docs/pr-2720 | 1 - .../update-of-monitoring-wire-server-page | 1 - changelog.d/5-internal/FS-905-async | 1 - changelog.d/5-internal/FS-921 | 1 - changelog.d/5-internal/acl-legalhold-tokens | 1 - .../5-internal/cleanup-module-structure | 1 - changelog.d/5-internal/coturn-labels | 2 - changelog.d/5-internal/drop-managed-db-schema | 1 - changelog.d/5-internal/fix-pr-template | 1 - ...otifications-cassandra-compaction-strategy | 4 - changelog.d/5-internal/improve-acl | 1 - .../5-internal/integration-test-version | 1 - changelog.d/5-internal/mls-clients-in-conv | 1 - changelog.d/5-internal/mls-refactor-tests | 1 - changelog.d/5-internal/mls-test-cli-0.5 | 1 - changelog.d/5-internal/pr-2686 | 1 - changelog.d/5-internal/pr-2707 | 1 - changelog.d/5-internal/pr-2725 | 1 - changelog.d/5-internal/topology-aware-hints | 1 - 39 files changed, 113 insertions(+), 49 deletions(-) delete mode 100644 changelog.d/0-release-notes/coturn-labels delete mode 100644 changelog.d/0-release-notes/helm-chart-default-resources delete mode 100644 changelog.d/0-release-notes/team-settings-upgrade delete mode 100644 changelog.d/0-release-notes/webapp-upgrade delete mode 100644 changelog.d/1-api-changes/FS-922-post-commit-bundle delete mode 100644 changelog.d/1-api-changes/FS-923-group-info delete mode 100644 changelog.d/1-api-changes/add-mls-public-keys-to-nginz delete mode 100644 changelog.d/1-api-changes/backend-removal-fix delete mode 100644 changelog.d/1-api-changes/leave-mls-conv delete mode 100644 changelog.d/1-api-changes/validate-remotely-claimed-key-packages delete mode 100644 changelog.d/2-features/coturn-metrics delete mode 100644 changelog.d/2-features/mls-remote-proposals-on-client-deletion delete mode 100644 changelog.d/2-features/mls-remove-proposals-on-user-deletion delete mode 100644 changelog.d/2-features/non-admin-commits delete mode 100644 changelog.d/2-features/registration-url-in-invitation delete mode 100644 changelog.d/3-bug-fixes/more-stable-user-deletion-via-scim delete mode 100644 changelog.d/3-bug-fixes/pr-2693 delete mode 100644 changelog.d/3-bug-fixes/sqpit-1431 delete mode 100644 changelog.d/4-docs/FS-672 delete mode 100644 changelog.d/4-docs/pr-2720 delete mode 100644 changelog.d/4-docs/update-of-monitoring-wire-server-page delete mode 100644 changelog.d/5-internal/FS-905-async delete mode 100644 changelog.d/5-internal/FS-921 delete mode 100644 changelog.d/5-internal/acl-legalhold-tokens delete mode 100644 changelog.d/5-internal/cleanup-module-structure delete mode 100644 changelog.d/5-internal/coturn-labels delete mode 100644 changelog.d/5-internal/drop-managed-db-schema delete mode 100644 changelog.d/5-internal/fix-pr-template delete mode 100644 changelog.d/5-internal/gundeck-notifications-cassandra-compaction-strategy delete mode 100644 changelog.d/5-internal/improve-acl delete mode 100644 changelog.d/5-internal/integration-test-version delete mode 100644 changelog.d/5-internal/mls-clients-in-conv delete mode 100644 changelog.d/5-internal/mls-refactor-tests delete mode 100644 changelog.d/5-internal/mls-test-cli-0.5 delete mode 100644 changelog.d/5-internal/pr-2686 delete mode 100644 changelog.d/5-internal/pr-2707 delete mode 100644 changelog.d/5-internal/pr-2725 delete mode 100644 changelog.d/5-internal/topology-aware-hints diff --git a/CHANGELOG.md b/CHANGELOG.md index ed7e44be1dc..be8dd8cbdfb 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,116 @@ +# [2022-09-27] (Chart Release 4.24.0) + +## Release notes + + +* For users of the (currently alpha) coturn Helm chart, **manual action is + required** when upgrading to this version. The labels applied to the Kubernetes + manifests in this chart have changed, in order to match the conventions used + in the wire-server charts. However, this may mean that upgrading with Helm can + fail, due to changes to the `StatefulSet` included in this chart -- in this + case, the `StatefulSet` must be deleted before the chart is upgraded. (#2677) + +* wire-server helm charts: Adjust default CPU/Memory resources: Remove CPU limits to avoid CPU throttling; adjust request CPU and memory based on observed values. Overall this decreases the amount of CPU/memory that the wire-server chart needs to install/schedule pods. (#2675) + +* Upgrade team-settings version to 4.12.1-v0.31.5-0-0167ea4 (#2180) + +* Upgrade webapp version to 2022-09-20-production.0-v0.31.2-0-7f74074 (#2302) + + +## API changes + + +* Add new endpoint `/mls/commit-bundles` for submitting MLS `CommitBundle`s. A `CommitBundle` is a triple consisting of a commit message, an optional welcome message and a public group state. (#2688) + +* MLS: Store and expose group info via `GET /conversations/:domain/:id/groupinfo` (#2721) + +* Add /mls/public-keys to nginz chart (#2676) + +* Users being kicked out results in member-leave events originating from the user who caused the change in the conversation (#2724) + +* Leaving an MLS conversation is now possible using the regular endpoint `DELETE /conversations/{cnv_domain}/{cnv}/members/{usr_domain}/{usr}`. When a user leaves, the backend sends external remove proposals for all their clients in the corresponding MLS group. (#2667) + +* Validate remotely claimed key packages (#2692) + + +## Features + + +* The coturn chart now has support for exposing its metric endpoint with a + ServiceMonitor, which can be ingested by third-party metrics collection tools. (#2677) + +* Deleting clients creates MLS remove proposals (#2674) + +* External remove proposals are now sent to a group when a user is deleted (#2650) + +* Allow non-admins to commit add proposals in MLS conversations (#2691) + +* Optionally add invitation urls to the body of `/teams/{tid}/invitations`. This allows further processing; e.g. to send those links with custom emails or distribute them as QR codes. See [docs](https://docs.wire.com/developer/reference/config-options.html#expose-invitation-urls-to-team-admin) for details and privacy implications. (#2684) + + +## Bug fixes and other updates + + +* SCIM user deletion suffered from a couple of race conditions. The user in now first deleted in spar, because this process depends on data from brig. Then, the user is deleted in brig. If any error occurs, the SCIM deletion request can be made again. This change depends on brig being completely deployed before using the SCIM deletion endpoint in brig. In the unlikely event of using SCIM deletion during the deployment, these requests can be retried (in case of error). (#2637) + +* The 2nd factor password challenge team feature is disabled for SSO users (#2693) + +* Less surprising handling of SIGINT, SIGTERM for proxy, stern. Increase grace period for shutdown from 5s to 30s for all services. (#2715) + + +## Documentation + + +* Drop Client model (unused) from old swagger. + Add a description and example data for mls_public_keys field in new swagger. (#2657) + +* Document user deactivation (aka suspension) with SCIM. (#2720) + +* Monitoring page showed wrong wrong configuration charts. Updated prometheus-operator to kube-prometheus-stack chart in the documentation. (#2708) + + +## Internal changes + + +* Make client deletion asynchronous (#2669) + +* Allow external add proposals without previously uploading key packages. (#2661) + +* Allow legalhold tokens access to `/converations/` endpoint (#2682, #2726) + +* Move Brig.Sem.* modules to Brig.Effects (consistency) (#2672) + +* The labels applied to resources in the coturn chart have been changed to + reflect the conventions in the wire-server charts. (#2677) + +* Drop the `managed` column from `team_conv` table in Galley (#2127) + +* Fix link in PR template (#2673) + +* In Gundeck's 'notifications' cassandra table, switch to [TWCS](https://cassandra.apache.org/doc/latest/cassandra/operating/compaction/twcs.html) compaction strategy, which should be more efficient for this workload, and possibly bring performance benefits to latencies. + It may be beneficial to run a manual compaction before rolling out this + change (but things should also work without this manual operation). + In case you have time, run the following from a cassandra machine before deploying this update: `nodetool compact gundeck notifications`. (#2615) + +* Add regular expression support to libzauth ACL language (#2714) + +* Make test API calls point to the most recent version by default (#2695) + +* Clients and key package refs in an MLS conversation are now stored in their own table. (#2667) + +* Refactor MLS test framework (#2678) + +* Update mls-test-cli to version 0.5 (#2685) + +* Added rusty-jwt-tools to docker images (#2686) + +* The account API is now migrated to servant. (#2699, #2700, #2701, #2702, #2703, #2704, #2705, #2707) + +* Update nginz and cannon ACLs to match api-versioned paths (#2725) + +* For wire-server cloud, on kubernetes 1.21+, favour topology-aware routing, which reduces unnecessary inter-availability-zone traffic, reducing latency and cloud provider cross-AZ traffic costs. (#2723) + + # [2022-09-01] (Chart Release 4.23.0) ## Release notes diff --git a/changelog.d/0-release-notes/coturn-labels b/changelog.d/0-release-notes/coturn-labels deleted file mode 100644 index 043dfd539f6..00000000000 --- a/changelog.d/0-release-notes/coturn-labels +++ /dev/null @@ -1,6 +0,0 @@ -For users of the (currently alpha) coturn Helm chart, **manual action is -required** when upgrading to this version. The labels applied to the Kubernetes -manifests in this chart have changed, in order to match the conventions used -in the wire-server charts. However, this may mean that upgrading with Helm can -fail, due to changes to the `StatefulSet` included in this chart -- in this -case, the `StatefulSet` must be deleted before the chart is upgraded. diff --git a/changelog.d/0-release-notes/helm-chart-default-resources b/changelog.d/0-release-notes/helm-chart-default-resources deleted file mode 100644 index 19d3f0516b6..00000000000 --- a/changelog.d/0-release-notes/helm-chart-default-resources +++ /dev/null @@ -1 +0,0 @@ -wire-server helm charts: Adjust default CPU/Memory resources: Remove CPU limits to avoid CPU throttling; adjust request CPU and memory based on observed values. Overall this decreases the amount of CPU/memory that the wire-server chart needs to install/schedule pods. diff --git a/changelog.d/0-release-notes/team-settings-upgrade b/changelog.d/0-release-notes/team-settings-upgrade deleted file mode 100644 index 17ee61cb95e..00000000000 --- a/changelog.d/0-release-notes/team-settings-upgrade +++ /dev/null @@ -1 +0,0 @@ -Upgrade team-settings version to 4.12.1-v0.31.5-0-0167ea4 diff --git a/changelog.d/0-release-notes/webapp-upgrade b/changelog.d/0-release-notes/webapp-upgrade deleted file mode 100644 index 9481d3e313d..00000000000 --- a/changelog.d/0-release-notes/webapp-upgrade +++ /dev/null @@ -1 +0,0 @@ -Upgrade webapp version to 2022-09-20-production.0-v0.31.2-0-7f74074 diff --git a/changelog.d/1-api-changes/FS-922-post-commit-bundle b/changelog.d/1-api-changes/FS-922-post-commit-bundle deleted file mode 100644 index a56fd4595ee..00000000000 --- a/changelog.d/1-api-changes/FS-922-post-commit-bundle +++ /dev/null @@ -1 +0,0 @@ -Add new endpoint `/mls/commit-bundles` for submitting MLS `CommitBundle`s. A `CommitBundle` is a triple consisting of a commit message, an optional welcome message and a public group state. diff --git a/changelog.d/1-api-changes/FS-923-group-info b/changelog.d/1-api-changes/FS-923-group-info deleted file mode 100644 index 9eacbbd05ad..00000000000 --- a/changelog.d/1-api-changes/FS-923-group-info +++ /dev/null @@ -1 +0,0 @@ -MLS: Store and expose group info via `GET /conversations/:domain/:id/groupinfo` diff --git a/changelog.d/1-api-changes/add-mls-public-keys-to-nginz b/changelog.d/1-api-changes/add-mls-public-keys-to-nginz deleted file mode 100644 index 67c245c7d7d..00000000000 --- a/changelog.d/1-api-changes/add-mls-public-keys-to-nginz +++ /dev/null @@ -1 +0,0 @@ -Add /mls/public-keys to nginz chart diff --git a/changelog.d/1-api-changes/backend-removal-fix b/changelog.d/1-api-changes/backend-removal-fix deleted file mode 100644 index e855500394a..00000000000 --- a/changelog.d/1-api-changes/backend-removal-fix +++ /dev/null @@ -1 +0,0 @@ -Users being kicked out results in member-leave events originating from the user who caused the change in the conversation diff --git a/changelog.d/1-api-changes/leave-mls-conv b/changelog.d/1-api-changes/leave-mls-conv deleted file mode 100644 index 0c9e0474ca1..00000000000 --- a/changelog.d/1-api-changes/leave-mls-conv +++ /dev/null @@ -1 +0,0 @@ -Leaving an MLS conversation is now possible using the regular endpoint `DELETE /conversations/{cnv_domain}/{cnv}/members/{usr_domain}/{usr}`. When a user leaves, the backend sends external remove proposals for all their clients in the corresponding MLS group. diff --git a/changelog.d/1-api-changes/validate-remotely-claimed-key-packages b/changelog.d/1-api-changes/validate-remotely-claimed-key-packages deleted file mode 100644 index dadf82918a0..00000000000 --- a/changelog.d/1-api-changes/validate-remotely-claimed-key-packages +++ /dev/null @@ -1 +0,0 @@ -Validate remotely claimed key packages diff --git a/changelog.d/2-features/coturn-metrics b/changelog.d/2-features/coturn-metrics deleted file mode 100644 index 717a9c795a0..00000000000 --- a/changelog.d/2-features/coturn-metrics +++ /dev/null @@ -1,2 +0,0 @@ -The coturn chart now has support for exposing its metric endpoint with a -ServiceMonitor, which can be ingested by third-party metrics collection tools. diff --git a/changelog.d/2-features/mls-remote-proposals-on-client-deletion b/changelog.d/2-features/mls-remote-proposals-on-client-deletion deleted file mode 100644 index 0b0df17eae3..00000000000 --- a/changelog.d/2-features/mls-remote-proposals-on-client-deletion +++ /dev/null @@ -1 +0,0 @@ -Deleting clients creates MLS remove proposals diff --git a/changelog.d/2-features/mls-remove-proposals-on-user-deletion b/changelog.d/2-features/mls-remove-proposals-on-user-deletion deleted file mode 100644 index cacb36e122a..00000000000 --- a/changelog.d/2-features/mls-remove-proposals-on-user-deletion +++ /dev/null @@ -1 +0,0 @@ -External remove proposals are now sent to a group when a user is deleted diff --git a/changelog.d/2-features/non-admin-commits b/changelog.d/2-features/non-admin-commits deleted file mode 100644 index 0d1b286836e..00000000000 --- a/changelog.d/2-features/non-admin-commits +++ /dev/null @@ -1 +0,0 @@ -Allow non-admins to commit add proposals in MLS conversations diff --git a/changelog.d/2-features/registration-url-in-invitation b/changelog.d/2-features/registration-url-in-invitation deleted file mode 100644 index eb9669b1fc2..00000000000 --- a/changelog.d/2-features/registration-url-in-invitation +++ /dev/null @@ -1 +0,0 @@ -Optionally add invitation urls to the body of `/teams/{tid}/invitations`. This allows further processing; e.g. to send those links with custom emails or distribute them as QR codes. See [docs](https://docs.wire.com/developer/reference/config-options.html#expose-invitation-urls-to-team-admin) for details and privacy implications. diff --git a/changelog.d/3-bug-fixes/more-stable-user-deletion-via-scim b/changelog.d/3-bug-fixes/more-stable-user-deletion-via-scim deleted file mode 100644 index bbbca33cabb..00000000000 --- a/changelog.d/3-bug-fixes/more-stable-user-deletion-via-scim +++ /dev/null @@ -1 +0,0 @@ -SCIM user deletion suffered from a couple of race conditions. The user in now first deleted in spar, because this process depends on data from brig. Then, the user is deleted in brig. If any error occurs, the SCIM deletion request can be made again. This change depends on brig being completely deployed before using the SCIM deletion endpoint in brig. In the unlikely event of using SCIM deletion during the deployment, these requests can be retried (in case of error). diff --git a/changelog.d/3-bug-fixes/pr-2693 b/changelog.d/3-bug-fixes/pr-2693 deleted file mode 100644 index ccba02e2888..00000000000 --- a/changelog.d/3-bug-fixes/pr-2693 +++ /dev/null @@ -1 +0,0 @@ -The 2nd factor password challenge team feature is disabled for SSO users diff --git a/changelog.d/3-bug-fixes/sqpit-1431 b/changelog.d/3-bug-fixes/sqpit-1431 deleted file mode 100644 index 27e4489509a..00000000000 --- a/changelog.d/3-bug-fixes/sqpit-1431 +++ /dev/null @@ -1 +0,0 @@ -Less surprising handling of SIGINT, SIGTERM for proxy, stern. Increase grace period for shutdown from 5s to 30s for all services. \ No newline at end of file diff --git a/changelog.d/4-docs/FS-672 b/changelog.d/4-docs/FS-672 deleted file mode 100644 index be428706747..00000000000 --- a/changelog.d/4-docs/FS-672 +++ /dev/null @@ -1,2 +0,0 @@ -Drop Client model (unused) from old swagger. -Add a description and example data for mls_public_keys field in new swagger. diff --git a/changelog.d/4-docs/pr-2720 b/changelog.d/4-docs/pr-2720 deleted file mode 100644 index c84bb55c031..00000000000 --- a/changelog.d/4-docs/pr-2720 +++ /dev/null @@ -1 +0,0 @@ -Document user deactivation (aka suspension) with SCIM. \ No newline at end of file diff --git a/changelog.d/4-docs/update-of-monitoring-wire-server-page b/changelog.d/4-docs/update-of-monitoring-wire-server-page deleted file mode 100644 index fdb9658cb36..00000000000 --- a/changelog.d/4-docs/update-of-monitoring-wire-server-page +++ /dev/null @@ -1 +0,0 @@ -Monitoring page showed wrong wrong configuration charts. Updated prometheus-operator to kube-prometheus-stack chart in the documentation. \ No newline at end of file diff --git a/changelog.d/5-internal/FS-905-async b/changelog.d/5-internal/FS-905-async deleted file mode 100644 index 6abf8850d64..00000000000 --- a/changelog.d/5-internal/FS-905-async +++ /dev/null @@ -1 +0,0 @@ -Make client deletion asynchronous diff --git a/changelog.d/5-internal/FS-921 b/changelog.d/5-internal/FS-921 deleted file mode 100644 index b2901852cdb..00000000000 --- a/changelog.d/5-internal/FS-921 +++ /dev/null @@ -1 +0,0 @@ -Allow external add proposals without previously uploading key packages. \ No newline at end of file diff --git a/changelog.d/5-internal/acl-legalhold-tokens b/changelog.d/5-internal/acl-legalhold-tokens deleted file mode 100644 index ce4c2fe5d54..00000000000 --- a/changelog.d/5-internal/acl-legalhold-tokens +++ /dev/null @@ -1 +0,0 @@ -Allow legalhold tokens access to `/converations/` endpoint (#2682, #2726) diff --git a/changelog.d/5-internal/cleanup-module-structure b/changelog.d/5-internal/cleanup-module-structure deleted file mode 100644 index c89b9673391..00000000000 --- a/changelog.d/5-internal/cleanup-module-structure +++ /dev/null @@ -1 +0,0 @@ -Move Brig.Sem.* modules to Brig.Effects (consistency) \ No newline at end of file diff --git a/changelog.d/5-internal/coturn-labels b/changelog.d/5-internal/coturn-labels deleted file mode 100644 index 33c3a3f5b06..00000000000 --- a/changelog.d/5-internal/coturn-labels +++ /dev/null @@ -1,2 +0,0 @@ -The labels applied to resources in the coturn chart have been changed to -reflect the conventions in the wire-server charts. diff --git a/changelog.d/5-internal/drop-managed-db-schema b/changelog.d/5-internal/drop-managed-db-schema deleted file mode 100644 index 265b0595cd9..00000000000 --- a/changelog.d/5-internal/drop-managed-db-schema +++ /dev/null @@ -1 +0,0 @@ -Drop the `managed` column from `team_conv` table in Galley diff --git a/changelog.d/5-internal/fix-pr-template b/changelog.d/5-internal/fix-pr-template deleted file mode 100644 index 2fb12fbc358..00000000000 --- a/changelog.d/5-internal/fix-pr-template +++ /dev/null @@ -1 +0,0 @@ -Fix link in PR template diff --git a/changelog.d/5-internal/gundeck-notifications-cassandra-compaction-strategy b/changelog.d/5-internal/gundeck-notifications-cassandra-compaction-strategy deleted file mode 100644 index 6eff7f41c73..00000000000 --- a/changelog.d/5-internal/gundeck-notifications-cassandra-compaction-strategy +++ /dev/null @@ -1,4 +0,0 @@ -In Gundeck's 'notifications' cassandra table, switch to [TWCS](https://cassandra.apache.org/doc/latest/cassandra/operating/compaction/twcs.html) compaction strategy, which should be more efficient for this workload, and possibly bring performance benefits to latencies. -It may be beneficial to run a manual compaction before rolling out this -change (but things should also work without this manual operation). -In case you have time, run the following from a cassandra machine before deploying this update: `nodetool compact gundeck notifications`. diff --git a/changelog.d/5-internal/improve-acl b/changelog.d/5-internal/improve-acl deleted file mode 100644 index 15f0545ef7a..00000000000 --- a/changelog.d/5-internal/improve-acl +++ /dev/null @@ -1 +0,0 @@ -Add regular expression support to libzauth ACL language diff --git a/changelog.d/5-internal/integration-test-version b/changelog.d/5-internal/integration-test-version deleted file mode 100644 index 3f769d8deea..00000000000 --- a/changelog.d/5-internal/integration-test-version +++ /dev/null @@ -1 +0,0 @@ -Make test API calls point to the most recent version by default diff --git a/changelog.d/5-internal/mls-clients-in-conv b/changelog.d/5-internal/mls-clients-in-conv deleted file mode 100644 index 55d01f9304f..00000000000 --- a/changelog.d/5-internal/mls-clients-in-conv +++ /dev/null @@ -1 +0,0 @@ -Clients and key package refs in an MLS conversation are now stored in their own table. diff --git a/changelog.d/5-internal/mls-refactor-tests b/changelog.d/5-internal/mls-refactor-tests deleted file mode 100644 index fbbf9416455..00000000000 --- a/changelog.d/5-internal/mls-refactor-tests +++ /dev/null @@ -1 +0,0 @@ -Refactor MLS test framework diff --git a/changelog.d/5-internal/mls-test-cli-0.5 b/changelog.d/5-internal/mls-test-cli-0.5 deleted file mode 100644 index a138a2d6ae4..00000000000 --- a/changelog.d/5-internal/mls-test-cli-0.5 +++ /dev/null @@ -1 +0,0 @@ -Update mls-test-cli to version 0.5 diff --git a/changelog.d/5-internal/pr-2686 b/changelog.d/5-internal/pr-2686 deleted file mode 100644 index 3051a190b7d..00000000000 --- a/changelog.d/5-internal/pr-2686 +++ /dev/null @@ -1 +0,0 @@ -Added rusty-jwt-tools to docker images diff --git a/changelog.d/5-internal/pr-2707 b/changelog.d/5-internal/pr-2707 deleted file mode 100644 index c6c26155174..00000000000 --- a/changelog.d/5-internal/pr-2707 +++ /dev/null @@ -1 +0,0 @@ -The account API is now migrated to servant. (#2699, #2700, #2701, #2702, #2703, #2704, #2705, #2707) diff --git a/changelog.d/5-internal/pr-2725 b/changelog.d/5-internal/pr-2725 deleted file mode 100644 index 8945a4600fd..00000000000 --- a/changelog.d/5-internal/pr-2725 +++ /dev/null @@ -1 +0,0 @@ -Update nginz and cannon ACLs to match api-versioned paths diff --git a/changelog.d/5-internal/topology-aware-hints b/changelog.d/5-internal/topology-aware-hints deleted file mode 100644 index 3ad2093d2f7..00000000000 --- a/changelog.d/5-internal/topology-aware-hints +++ /dev/null @@ -1 +0,0 @@ -For wire-server cloud, on kubernetes 1.21+, favour topology-aware routing, which reduces unnecessary inter-availability-zone traffic, reducing latency and cloud provider cross-AZ traffic costs.