diff --git a/charts/background-worker/templates/configmap.yaml b/charts/background-worker/templates/configmap.yaml index 6c84d808767..fbcdd9dd702 100644 --- a/charts/background-worker/templates/configmap.yaml +++ b/charts/background-worker/templates/configmap.yaml @@ -25,6 +25,12 @@ data: host: brig port: 8080 + {{- if .enableFederation }} + federator: + host: {{ .federator.host }} + port: {{ .federator.port }} + {{- end }} + gundeck: host: gundeck port: 8080 @@ -103,4 +109,4 @@ data: {{- if .postgresMigration }} postgresMigration: {{- toYaml .postgresMigration | nindent 6 }} {{- end }} - {{- end }} + {{- end }} \ No newline at end of file diff --git a/charts/background-worker/values.yaml b/charts/background-worker/values.yaml index 2896d749e89..37f6c30d9dc 100644 --- a/charts/background-worker/values.yaml +++ b/charts/background-worker/values.yaml @@ -19,6 +19,9 @@ config: logLevel: Info logFormat: StructuredJSON enableFederation: false # keep in sync with brig, cargohold and galley charts' config.enableFederation as well as wire-server chart's tags.federation + federator: + host: federator + port: 8080 rabbitmq: host: rabbitmq port: 5672 diff --git a/libs/galley-types/default.nix b/libs/galley-types/default.nix index 4edd7e398d8..ff5a59d4968 100644 --- a/libs/galley-types/default.nix +++ b/libs/galley-types/default.nix @@ -12,6 +12,7 @@ , data-default , errors , gitignoreSource +, http-types , imports , lens , lib @@ -21,6 +22,7 @@ , types-common , utf8-string , uuid +, wai-utilities , wire-api }: mkDerivation { @@ -36,6 +38,7 @@ mkDerivation { crypton data-default errors + http-types imports lens memory @@ -44,6 +47,7 @@ mkDerivation { types-common utf8-string uuid + wai-utilities wire-api ]; license = lib.licenses.agpl3Only; diff --git a/libs/galley-types/galley-types.cabal b/libs/galley-types/galley-types.cabal index 3405710cad3..f17b6cc285f 100644 --- a/libs/galley-types/galley-types.cabal +++ b/libs/galley-types/galley-types.cabal @@ -14,8 +14,10 @@ library -- cabal-fmt: expand src exposed-modules: Galley.Types + Galley.Types.Clients Galley.Types.Conversations.One2One Galley.Types.Conversations.Roles + Galley.Types.Error Galley.Types.Teams other-modules: Paths_galley_types @@ -76,6 +78,7 @@ library , crypton , data-default , errors + , http-types , imports , lens >=4.12 , memory @@ -84,6 +87,7 @@ library , types-common >=0.16 , utf8-string , uuid + , wai-utilities , wire-api default-language: GHC2021 diff --git a/services/galley/src/Galley/Types/Clients.hs b/libs/galley-types/src/Galley/Types/Clients.hs similarity index 100% rename from services/galley/src/Galley/Types/Clients.hs rename to libs/galley-types/src/Galley/Types/Clients.hs diff --git a/services/galley/src/Galley/API/Error.hs b/libs/galley-types/src/Galley/Types/Error.hs similarity index 99% rename from services/galley/src/Galley/API/Error.hs rename to libs/galley-types/src/Galley/Types/Error.hs index a8241afa1c4..51a7223c868 100644 --- a/services/galley/src/Galley/API/Error.hs +++ b/libs/galley-types/src/Galley/Types/Error.hs @@ -18,7 +18,7 @@ -- | Most of the errors thrown by galley are defined as static errors in -- 'Wire.API.Error.Galley' and declared as part of the API. Errors defined here -- are dynamic, and mostly internal. -module Galley.API.Error +module Galley.Types.Error ( -- * Internal errors InvalidInput (..), InternalError (..), diff --git a/libs/galley-types/src/Galley/Types/Teams.hs b/libs/galley-types/src/Galley/Types/Teams.hs index 6177db2ef4e..65e91eeaf37 100644 --- a/libs/galley-types/src/Galley/Types/Teams.hs +++ b/libs/galley-types/src/Galley/Types/Teams.hs @@ -23,6 +23,7 @@ module Galley.Types.Teams ( GetFeatureDefaults (..), FeatureDefaults (..), FeatureFlags, + FanoutLimit, featureDefaults, notTeamMember, findTeamMember, @@ -40,6 +41,7 @@ import Data.ByteString (toStrict) import Data.ByteString.UTF8 qualified as UTF8 import Data.Default import Data.Id (UserId) +import Data.Range (Range) import Data.SOP import Data.Set qualified as Set import Imports @@ -47,6 +49,8 @@ import Wire.API.Team.Feature import Wire.API.Team.Member import Wire.API.Team.Permission +type FanoutLimit = Range 1 HardTruncationLimit Int32 + -- | Used to extract the feature config type out of 'FeatureDefaults' or -- related types. type family ConfigOf a 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 80ae80db1b4..65ee2f97a61 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs @@ -1289,7 +1289,7 @@ type ClientAPI = -- - MemberJoin event to self and other, if joining an existing connect conversation (via galley) -- - ConvCreate event to self, if creating a connect conversation (via galley) -- - ConvConnect event to self, in some cases (via galley), --- for details see 'Galley.API.Create.createConnectConversation' +-- for details see 'Wire.ConversationSubsystem.Create.createConnectConversation' type ConnectionAPI = Named "create-connection-unqualified" diff --git a/libs/wire-subsystems/src/Wire/ConversationSubsystem.hs b/libs/wire-subsystems/src/Wire/ConversationSubsystem.hs index ca068239bde..a84b8a2a98a 100644 --- a/libs/wire-subsystems/src/Wire/ConversationSubsystem.hs +++ b/libs/wire-subsystems/src/Wire/ConversationSubsystem.hs @@ -43,5 +43,10 @@ data ConversationSubsystem m a where ConversationAction (tag :: ConversationActionTag) -> ExtraConversationData -> ConversationSubsystem r LocalConversationUpdate + CreateConversation :: + Local ConvId -> + Local UserId -> + NewConversation -> + ConversationSubsystem m StoredConversation makeSem ''ConversationSubsystem diff --git a/services/galley/src/Galley/API/Create.hs b/libs/wire-subsystems/src/Wire/ConversationSubsystem/Create.hs similarity index 77% rename from services/galley/src/Galley/API/Create.hs rename to libs/wire-subsystems/src/Wire/ConversationSubsystem/Create.hs index d22b336ea75..c49dba47a9d 100644 --- a/services/galley/src/Galley/API/Create.hs +++ b/libs/wire-subsystems/src/Wire/ConversationSubsystem/Create.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 . - -- 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 @@ -22,7 +21,9 @@ -- -- You should have received a copy of the GNU Affero General Public License along -- with this program. If not, see . -module Galley.API.Create +{-# LANGUAGE DataKinds #-} + +module Wire.ConversationSubsystem.Create ( createGroupConversationUpToV3, createGroupOwnConversation, createProteusSelfConversation, @@ -35,24 +36,15 @@ where import Control.Error (headMay) import Control.Lens hiding ((??)) import Data.Default -import Data.Id -import Data.Json.Util +import Data.Id (ConnId, ConvId, Id (toUUID), TeamId, UserId) import Data.Misc (FutureWork (FutureWork)) import Data.Qualified import Data.Range import Data.Set qualified as Set import Data.UUID.Tagged qualified as U -import Galley.API.Action -import Galley.API.Error -import Galley.API.MLS -import Galley.API.Mapping -import Galley.API.One2One -import Galley.API.Util -import Galley.App (Env) -import Galley.Effects -import Galley.Options (Opts) +import GHC.TypeNats +import Galley.Types.Error import Galley.Types.Teams (notTeamMember) -import Galley.Validation import Imports hiding ((\\)) import Polysemy import Polysemy.Error @@ -68,7 +60,6 @@ import Wire.API.Event.Conversation import Wire.API.Federation.Client (FederatorClient) import Wire.API.Federation.Error import Wire.API.FederationStatus -import Wire.API.Push.V2 qualified as PushV2 import Wire.API.Routes.Public.Galley.Conversation import Wire.API.Routes.Public.Util import Wire.API.Team @@ -80,21 +71,29 @@ import Wire.API.Team.Member import Wire.API.Team.Permission hiding (self) import Wire.API.User import Wire.BrigAPIAccess +import Wire.ConversationStore (ConversationStore) import Wire.ConversationStore qualified as E -import Wire.ConversationSubsystem.Interpreter (ConversationSubsystemConfig) +import Wire.ConversationSubsystem qualified as ConversationSubsystem +import Wire.ConversationSubsystem.Federation +import Wire.ConversationSubsystem.One2One +import Wire.ConversationSubsystem.Types +import Wire.ConversationSubsystem.Util +import Wire.ConversationSubsystem.View import Wire.FeaturesConfigSubsystem -import Wire.FederationAPIAccess qualified as E +import Wire.FederationAPIAccess (FederationAPIAccess) +import Wire.LegalHoldStore (LegalHoldStore) import Wire.NotificationSubsystem import Wire.Sem.Now (Now) -import Wire.Sem.Now qualified as Now +import Wire.Sem.Random (Random) import Wire.Sem.Random qualified as Random import Wire.StoredConversation hiding (convTeam, localOne2OneConvId) import Wire.StoredConversation qualified as Data import Wire.TeamCollaboratorsSubsystem +import Wire.TeamStore (TeamStore) import Wire.TeamStore qualified as TeamStore import Wire.TeamSubsystem (TeamSubsystem) import Wire.TeamSubsystem qualified as TeamSubsystem -import Wire.UserList +import Wire.UserList (UserList (UserList), toUserList, ulAddLocal, ulAll, ulFromLocals, ulLocals, ulRemotes) ---------------------------------------------------------------------------- -- Group conversations @@ -102,11 +101,10 @@ import Wire.UserList -- | The public-facing endpoint for creating group conversations in the client -- API up to and including version 3. createGroupConversationUpToV3 :: - ( Member BackendNotificationQueueAccess r, - Member BrigAPIAccess r, + ( Member BrigAPIAccess r, Member ConversationStore r, + Member ConversationSubsystem.ConversationSubsystem r, Member (ErrorS 'ConvAccessDenied) r, - Member (Error FederationError) r, Member (Error InternalError) r, Member (Error InvalidInput) r, Member (ErrorS 'NotATeamMember) r, @@ -118,11 +116,6 @@ createGroupConversationUpToV3 :: Member (ErrorS ChannelsNotEnabled) r, Member (ErrorS NotAnMlsConversation) r, Member (Error UnreachableBackendsLegacy) r, - Member (FederationAPIAccess FederatorClient) r, - Member NotificationSubsystem r, - Member (Input Env) r, - Member (Input Opts) r, - Member Now r, Member LegalHoldStore r, Member TeamStore r, Member P.TinyLog r, @@ -136,22 +129,17 @@ createGroupConversationUpToV3 :: Maybe ConnId -> NewConv -> Sem r (ConversationResponse Public.OwnConversation) -createGroupConversationUpToV3 lusr conn newConv = mapError UnreachableBackendsLegacy $ - do - conv <- - createGroupConversationGeneric - lusr - conn - newConv - def - conversationCreated lusr conv +createGroupConversationUpToV3 lusr conn newConv = + mapError UnreachableBackendsLegacy $ + createGroupConversationGeneric lusr conn newConv + >>= conversationCreated lusr -- | The public-facing endpoint for creating group conversations in the client -- API in from version 4 to 8 createGroupOwnConversation :: - ( Member BackendNotificationQueueAccess r, - Member BrigAPIAccess r, + ( Member BrigAPIAccess r, Member ConversationStore r, + Member ConversationSubsystem.ConversationSubsystem r, Member (ErrorS 'ConvAccessDenied) r, Member (Error FederationError) r, Member (Error InternalError) r, @@ -167,11 +155,7 @@ createGroupOwnConversation :: Member (ErrorS NotAnMlsConversation) r, Member (Error UnreachableBackends) r, Member (FederationAPIAccess FederatorClient) r, - Member NotificationSubsystem r, - Member (Input Env) r, - Member (Input Opts) r, Member (Input ConversationSubsystemConfig) r, - Member Now r, Member LegalHoldStore r, Member TeamStore r, Member P.TinyLog r, @@ -197,9 +181,9 @@ createGroupOwnConversation lusr conn newConv = do -- | The public-facing endpoint for creating group conversations in the client -- API in version 9 and above. createGroupConversation :: - ( Member BackendNotificationQueueAccess r, - Member BrigAPIAccess r, + ( Member BrigAPIAccess r, Member ConversationStore r, + Member ConversationSubsystem.ConversationSubsystem r, Member (ErrorS 'ConvAccessDenied) r, Member (Error FederationError) r, Member (Error InternalError) r, @@ -215,14 +199,9 @@ createGroupConversation :: Member (ErrorS NotAnMlsConversation) r, Member (Error UnreachableBackends) r, Member (FederationAPIAccess FederatorClient) r, - Member NotificationSubsystem r, - Member (Input Env) r, - Member (Input Opts) r, Member (Input ConversationSubsystemConfig) r, - Member Now r, Member LegalHoldStore r, Member TeamStore r, - Member P.TinyLog r, Member FeaturesConfigSubsystem r, Member TeamCollaboratorsSubsystem r, Member Random r, @@ -246,10 +225,7 @@ createGroupConversation lusr conn newConv = do ) createGroupConvAndMkResponse :: - ( Member (Input Opts) r, - Member (Input Env) r, - Member Now r, - Member (ErrorS OperationDenied) r, + ( Member (ErrorS OperationDenied) r, Member (ErrorS ConvAccessDenied) r, Member (ErrorS NotATeamMember) r, Member (ErrorS NotConnected) r, @@ -263,12 +239,10 @@ createGroupConvAndMkResponse :: Member (Error NonFederatingBackends) r, Member (Error InternalError) r, Member (Error InvalidInput) r, - Member P.TinyLog r, Member (FederationAPIAccess FederatorClient) r, - Member BackendNotificationQueueAccess r, Member BrigAPIAccess r, Member ConversationStore r, - Member NotificationSubsystem r, + Member ConversationSubsystem.ConversationSubsystem r, Member LegalHoldStore r, Member TeamStore r, Member FeaturesConfigSubsystem r, @@ -286,16 +260,15 @@ createGroupConvAndMkResponse lusr conn newConv mkResponse = do let remoteDomains = void <$> snd (partitionQualified lusr $ newConv.newConvQualifiedUsers) enforceFederationProtocol (baseProtocolToProtocol newConv.newConvProtocol) remoteDomains checkFederationStatus (RemoteDomains $ Set.fromList remoteDomains) - dbConv <- createGroupConversationGeneric lusr conn newConv def + dbConv <- createGroupConversationGeneric lusr conn newConv mkResponse dbConv createGroupConversationGeneric :: forall r. - ( Member BackendNotificationQueueAccess r, - Member BrigAPIAccess r, + ( Member BrigAPIAccess r, Member ConversationStore r, + Member ConversationSubsystem.ConversationSubsystem r, Member (ErrorS 'ConvAccessDenied) r, - Member (Error FederationError) r, Member (Error InternalError) r, Member (Error InvalidInput) r, Member (ErrorS 'NotATeamMember) r, @@ -306,16 +279,9 @@ createGroupConversationGeneric :: Member (ErrorS 'MissingLegalholdConsent) r, Member (ErrorS ChannelsNotEnabled) r, Member (ErrorS NotAnMlsConversation) r, - Member (Error UnreachableBackends) r, - Member (FederationAPIAccess FederatorClient) r, - Member NotificationSubsystem r, - Member (Input Env) r, - Member (Input Opts) r, Member (Input ConversationSubsystemConfig) r, - Member Now r, Member LegalHoldStore r, Member TeamStore r, - Member P.TinyLog r, Member FeaturesConfigSubsystem r, Member TeamCollaboratorsSubsystem r, Member Random r, @@ -324,9 +290,8 @@ createGroupConversationGeneric :: Local UserId -> Maybe ConnId -> NewConv -> - JoinType -> Sem r StoredConversation -createGroupConversationGeneric lusr conn newConv joinType = do +createGroupConversationGeneric lusr _conn newConv = do (nc, fromConvSize -> allUsers) <- newRegularConversation lusr newConv checkCreateConvPermissions lusr newConv newConv.newConvTeam allUsers ensureNoLegalholdConflicts allUsers @@ -335,29 +300,10 @@ createGroupConversationGeneric lusr conn newConv joinType = do -- Here we fail early in order to notify users of this misconfiguration assertMLSEnabled - lcnv <- traverse (const $ Id <$> Random.uuid) lusr - conv <- E.upsertConversation lcnv nc - -- NOTE: We only send (conversation) events to members of the conversation - notifyCreatedConversation lusr conn conv joinType - sendCellsNotification conv - E.getConversation (tUnqualified lcnv) - >>= note (BadConvState (tUnqualified lcnv)) - where - sendCellsNotification :: StoredConversation -> Sem r () - sendCellsNotification conv = do - now <- Now.get - let lconv = qualifyAs lusr conv.id_ - event = CellsEvent (tUntagged lconv) (tUntagged lusr) now CellsConvCreateNoData - when (conv.metadata.cnvmCellsState /= CellsDisabled) $ do - let push = - def - { origin = Just (tUnqualified lusr), - json = toJSONObject event, - isCellsEvent = True, - route = PushV2.RouteAny, - conn - } - pushNotifications [push] + lcnv <- traverse (const Random.newId) lusr + conv <- ConversationSubsystem.createConversation lcnv lusr nc + E.getConversation conv.id_ + >>= note (BadConvState conv.id_) ensureNoLegalholdConflicts :: ( Member (ErrorS 'MissingLegalholdConsent) r, @@ -468,6 +414,7 @@ getTeamMember uid Nothing = TeamStore.getUserTeams uid >>= maybe (pure Nothing) createProteusSelfConversation :: forall r. ( Member ConversationStore r, + Member ConversationSubsystem.ConversationSubsystem r, Member (Error InternalError) r, Member P.TinyLog r ) => @@ -487,13 +434,13 @@ createProteusSelfConversation lusr = do protocol = BaseProtocolProteusTag, groupId = Nothing } - c <- E.upsertConversation lcnv nc - conversationCreated lusr c + ConversationSubsystem.createConversation lcnv lusr nc + >>= conversationCreated lusr createOne2OneConversation :: - ( Member BackendNotificationQueueAccess r, - Member BrigAPIAccess r, + ( Member BrigAPIAccess r, Member ConversationStore r, + Member ConversationSubsystem.ConversationSubsystem r, Member (Error FederationError) r, Member (Error InternalError) r, Member (Error InvalidInput) r, @@ -505,9 +452,6 @@ createOne2OneConversation :: Member (ErrorS 'InvalidOperation) r, Member (ErrorS 'NotConnected) r, Member (Error UnreachableBackendsLegacy) r, - Member (FederationAPIAccess FederatorClient) r, - Member NotificationSubsystem r, - Member Now r, Member TeamStore r, Member P.TinyLog r, Member TeamCollaboratorsSubsystem r, @@ -587,14 +531,10 @@ createOne2OneConversation lusr zcon j = else throwS @OperationDenied createLegacyOne2OneConversationUnchecked :: - ( Member BackendNotificationQueueAccess r, - Member ConversationStore r, - Member (Error FederationError) r, + ( Member ConversationStore r, + Member ConversationSubsystem.ConversationSubsystem r, Member (Error InternalError) r, Member (Error InvalidInput) r, - Member (FederationAPIAccess FederatorClient) r, - Member NotificationSubsystem r, - Member Now r, Member P.TinyLog r ) => Local UserId -> @@ -603,7 +543,7 @@ createLegacyOne2OneConversationUnchecked :: Maybe TeamId -> Local UserId -> Sem r (ConversationResponse Public.OwnConversation) -createLegacyOne2OneConversationUnchecked self zcon name mtid other = do +createLegacyOne2OneConversationUnchecked self _zcon name mtid other = do lcnv <- localOne2OneConvId self other let meta = (defConversationMetadata (Just (tUnqualified self))) @@ -622,23 +562,14 @@ createLegacyOne2OneConversationUnchecked self zcon name mtid other = do case mc of Just c -> conversationExisted self c Nothing -> do - c <- E.upsertConversation lcnv nc - runError @UnreachableBackends (notifyCreatedConversation self (Just zcon) c def) - >>= \case - Left _ -> do - throw . InternalErrorWithDescription $ - "A one-to-one conversation on one backend cannot involve unreachable backends" - Right () -> conversationCreated self c + ConversationSubsystem.createConversation lcnv self nc + >>= conversationCreated self createOne2OneConversationUnchecked :: - ( Member BackendNotificationQueueAccess r, - Member ConversationStore r, + ( Member ConversationStore r, + Member ConversationSubsystem.ConversationSubsystem r, Member (Error FederationError) r, Member (Error InternalError) r, - Member (Error UnreachableBackends) r, - Member (FederationAPIAccess FederatorClient) r, - Member NotificationSubsystem r, - Member Now r, Member P.TinyLog r ) => Local UserId -> @@ -656,14 +587,9 @@ createOne2OneConversationUnchecked self zcon name mtid other = do create (one2OneConvId BaseProtocolProteusTag (tUntagged self) other) self zcon name mtid other createOne2OneConversationLocally :: - ( Member BackendNotificationQueueAccess r, - Member ConversationStore r, - Member (Error FederationError) r, + ( Member ConversationStore r, + Member ConversationSubsystem.ConversationSubsystem r, Member (Error InternalError) r, - Member (Error UnreachableBackends) r, - Member (FederationAPIAccess FederatorClient) r, - Member NotificationSubsystem r, - Member Now r, Member P.TinyLog r ) => Local ConvId -> @@ -673,7 +599,7 @@ createOne2OneConversationLocally :: Maybe TeamId -> Qualified UserId -> Sem r (ConversationResponse Public.OwnConversation) -createOne2OneConversationLocally lcnv self zcon name mtid other = do +createOne2OneConversationLocally lcnv self _zcon name mtid other = do mc <- E.getConversation (tUnqualified lcnv) case mc of Just c -> conversationExisted self c @@ -691,9 +617,8 @@ createOne2OneConversationLocally lcnv self zcon name mtid other = do protocol = BaseProtocolProteusTag, groupId = Nothing } - c <- E.upsertConversation lcnv nc - notifyCreatedConversation self (Just zcon) c def - conversationCreated self c + ConversationSubsystem.createConversation lcnv self nc + >>= conversationCreated self createOne2OneConversationRemotely :: (Member (Error FederationError) r) => @@ -704,19 +629,17 @@ createOne2OneConversationRemotely :: Maybe TeamId -> Qualified UserId -> Sem r (ConversationResponse Public.OwnConversation) -createOne2OneConversationRemotely _ _ _ _ _ _ = +createOne2OneConversationRemotely _ _ _ _name _mtid _ = throw FederationNotImplemented createConnectConversation :: - ( Member BackendNotificationQueueAccess r, - Member ConversationStore r, + ( Member ConversationStore r, + Member ConversationSubsystem.ConversationSubsystem r, Member (ErrorS 'ConvNotFound) r, Member (Error FederationError) r, Member (Error InternalError) r, Member (Error InvalidInput) r, Member (ErrorS 'InvalidOperation) r, - Member (Error UnreachableBackends) r, - Member (FederationAPIAccess FederatorClient) r, Member NotificationSubsystem r, Member Now r, Member P.TinyLog r @@ -747,20 +670,7 @@ createConnectConversation lusr conn j = do >>= maybe (create lcnv nc) (update n) where create lcnv nc = do - c <- E.upsertConversation lcnv nc - now <- Now.get - let e = Event (tUntagged lcnv) Nothing (EventFromUser (tUntagged lusr)) now Nothing (EdConnect j) - notifyCreatedConversation lusr conn c def - pushNotifications - [ def - { origin = Just (tUnqualified lusr), - json = toJSONObject e, - recipients = map localMemberToRecipient c.localMembers, - isCellsEvent = shouldPushToCells c.metadata e, - route = PushV2.RouteDirect, - conn - } - ] + c <- ConversationSubsystem.createConversation lcnv lusr nc conversationCreated lusr c update n conv = do let mems = conv.localMembers @@ -787,24 +697,12 @@ createConnectConversation lusr conn j = do else pure conv'' connect n conv | Data.convType conv == ConnectConv = do - let lcnv = qualifyAs lusr conv.id_ n' <- case n of Just x -> do E.setConversationName conv.id_ x pure . Just $ fromRange x Nothing -> pure $ Data.convName conv - t <- Now.get - let e = Event (tUntagged lcnv) Nothing (EventFromUser (tUntagged lusr)) t Nothing (EdConnect j) - pushNotifications - [ def - { origin = Just (tUnqualified lusr), - json = toJSONObject e, - recipients = map localMemberToRecipient conv.localMembers, - isCellsEvent = shouldPushToCells conv.metadata e, - route = PushV2.RouteDirect, - conn - } - ] + notifyConversationUpdated lusr conn j conv pure $ Data.convSetName n' conv | otherwise = pure conv @@ -816,21 +714,21 @@ newRegularConversation :: ( Member (ErrorS 'MLSNonEmptyMemberList) r, Member (ErrorS OperationDenied) r, Member (Error InvalidInput) r, - Member (Input Opts) r, + Member (Input ConversationSubsystemConfig) r, Member ConversationStore r ) => Local UserId -> NewConv -> Sem r (NewConversation, ConvSizeChecked UserList UserId) newRegularConversation lusr newConv = do - o <- input + cfg <- input let uncheckedUsers = newConvMembers lusr newConv forM_ newConv.newConvParent $ \parent -> do mMembership <- E.getLocalMember parent (tUnqualified lusr) when (isNothing mMembership) $ throwS @OperationDenied users <- case newConvProtocol newConv of - BaseProtocolProteusTag -> checkedConvSize o uncheckedUsers + BaseProtocolProteusTag -> checkedConvSize cfg uncheckedUsers BaseProtocolMLSTag -> do unless (null uncheckedUsers) $ throwS @'MLSNonEmptyMemberList pure mempty @@ -879,58 +777,6 @@ conversationCreated :: Sem r (ConversationResponse Public.OwnConversation) conversationCreated lusr cnv = Created <$> conversationViewV9 lusr cnv --- | The return set contains all the remote users that could not be contacted. --- Consequently, the unreachable users are not added to the member list. This --- behavior might be changed later on when a message/event queue per remote --- backend is implemented. -notifyCreatedConversation :: - ( Member ConversationStore r, - Member (Error FederationError) r, - Member (Error InternalError) r, - Member (Error UnreachableBackends) r, - Member (FederationAPIAccess FederatorClient) r, - Member NotificationSubsystem r, - Member BackendNotificationQueueAccess r, - Member Now r, - Member P.TinyLog r - ) => - Local UserId -> - Maybe ConnId -> - StoredConversation -> - JoinType -> - Sem r () -notifyCreatedConversation lusr conn c joinType = do - now <- Now.get - -- Ask remote servers to store conversation membership and notify remote users - -- of being added to a conversation - registerRemoteConversationMemberships now lusr (qualifyAs lusr c) joinType - unless (null c.remoteMembers) $ - unlessM E.isFederationConfigured $ - throw FederationNotConfigured - - -- Notify local users - pushNotifications =<< mapM (toPush now) c.localMembers - where - route - | Data.convType c == RegularConv = PushV2.RouteAny - | otherwise = PushV2.RouteDirect - toPush t m = do - let remoteOthers = remoteMemberToOther <$> c.remoteMembers - localOthers = map (localMemberToOther (tDomain lusr)) $ c.localMembers - lconv = qualifyAs lusr c.id_ - c' <- conversationViewWithCachedOthers remoteOthers localOthers c (qualifyAs lusr m.id_) - let e = Event (tUntagged lconv) Nothing (EventFromUser (tUntagged lusr)) t Nothing (EdConversation c') - pure $ - def - { origin = Just (tUnqualified lusr), - json = toJSONObject e, - recipients = [localMemberToRecipient m], - -- on conversation creation we send the cells event separately to make sure it is sent exactly once - isCellsEvent = False, - route, - conn - } - localOne2OneConvId :: (Member (Error InvalidInput) r) => Local UserId -> @@ -971,3 +817,46 @@ newOne2OneConvMembers loc body = ensureOne :: (Member (Error InvalidInput) r) => [a] -> Sem r a ensureOne [x] = pure x ensureOne _ = throw (InvalidRange "One-to-one conversations can only have a single invited member") + +-------------------------------------------------------------------------------- +-- Validation and MLS Helpers + +assertMLSEnabled :: (Member (Input ConversationSubsystemConfig) r, Member (ErrorS 'MLSNotEnabled) r) => Sem r () +assertMLSEnabled = do + cfg <- input + when (null cfg.mlsKeys) $ throwS @'MLSNotEnabled + +-- Between 0 and (setMaxConvSize - 1) +newtype ConvSizeChecked f a = ConvSizeChecked {fromConvSize :: f a} + deriving (Functor, Foldable, Traversable) + +deriving newtype instance (Semigroup (f a)) => Semigroup (ConvSizeChecked f a) + +deriving newtype instance (Monoid (f a)) => Monoid (ConvSizeChecked f a) + +checkedConvSize :: + (Member (Error InvalidInput) r, Foldable f) => + ConversationSubsystemConfig -> + f a -> + Sem r (ConvSizeChecked f a) +checkedConvSize cfg x = do + let minV :: Integer = 0 + limit = cfg.maxConvSize - 1 + if length x <= fromIntegral limit + then pure (ConvSizeChecked x) + else throwErr (errorMsg minV limit "") + +rangeChecked :: (KnownNat n, KnownNat m, Member (Error InvalidInput) r, Within a n m) => a -> Sem r (Range n m a) +rangeChecked = either throwErr pure . checkedEither +{-# INLINE rangeChecked #-} + +rangeCheckedMaybe :: + (Member (Error InvalidInput) r, KnownNat n, KnownNat m, Within a n m) => + Maybe a -> + Sem r (Maybe (Range n m a)) +rangeCheckedMaybe Nothing = pure Nothing +rangeCheckedMaybe (Just a) = Just <$> rangeChecked a +{-# INLINE rangeCheckedMaybe #-} + +throwErr :: (Member (Error InvalidInput) r) => String -> Sem r a +throwErr = throw . InvalidRange . fromString diff --git a/libs/wire-subsystems/src/Wire/ConversationSubsystem/Federation.hs b/libs/wire-subsystems/src/Wire/ConversationSubsystem/Federation.hs new file mode 100644 index 00000000000..ec073a3c62f --- /dev/null +++ b/libs/wire-subsystems/src/Wire/ConversationSubsystem/Federation.hs @@ -0,0 +1,112 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE OverloadedRecordDot #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} + +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2025 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.ConversationSubsystem.Federation where + +import Control.Error (headMay) +import Data.Domain (Domain) +import Data.Qualified +import Data.Set qualified as Set +import Imports +import Polysemy +import Polysemy.Error +import Polysemy.Input +import Wire.API.Component (Component (..)) +import Wire.API.Conversation.Protocol (ProtocolTag) +import Wire.API.Error.Galley (NonFederatingBackends (..), UnreachableBackends (..)) +import Wire.API.Federation.API (fedClient) +import Wire.API.Federation.API.Brig (DomainSet (..), NonConnectedBackends (..)) +import Wire.API.Federation.Client (FederatorClient) +import Wire.API.Federation.Error +import Wire.API.FederationStatus +import Wire.ConversationSubsystem.Types +import Wire.FederationAPIAccess (FederationAPIAccess) +import Wire.FederationAPIAccess qualified as E + +enforceFederationProtocol :: + ( Member (Error FederationError) r, + Member (Input ConversationSubsystemConfig) r + ) => + ProtocolTag -> + [Remote ()] -> + Sem r () +enforceFederationProtocol proto domains = do + unless (null domains) $ do + mAllowedProtos <- federationProtocols <$> input + unless (maybe True (elem proto) mAllowedProtos) $ + throw FederationDisabledForProtocol + +checkFederationStatus :: + ( Member (Error UnreachableBackends) r, + Member (Error NonFederatingBackends) r, + Member (FederationAPIAccess FederatorClient) r + ) => + RemoteDomains -> + Sem r () +checkFederationStatus req = do + status <- getFederationStatus req + case status of + FullyConnected -> pure () + NotConnectedDomains dom1 dom2 -> throw (NonFederatingBackends dom1 dom2) + +getFederationStatus :: + ( Member (Error UnreachableBackends) r, + Member (FederationAPIAccess FederatorClient) r + ) => + RemoteDomains -> + Sem r FederationStatus +getFederationStatus req = do + fmap firstConflictOrFullyConnected + . (ensureNoUnreachableBackends =<<) + $ E.runFederatedConcurrentlyEither + (Set.toList req.rdDomains) + ( \qds -> + fedClient @'Brig @"get-not-fully-connected-backends" + (DomainSet . Set.map tDomain $ void qds `Set.delete` req.rdDomains) + ) + +-- | "conflict" here means two remote domains that we are connected to +-- but are not connected to each other. +firstConflictOrFullyConnected :: [Remote NonConnectedBackends] -> FederationStatus +firstConflictOrFullyConnected = + maybe + FullyConnected + (uncurry NotConnectedDomains) + . headMay + . mapMaybe toMaybeConflict + where + toMaybeConflict :: Remote NonConnectedBackends -> Maybe (Domain, Domain) + toMaybeConflict r = + headMay (Set.toList (nonConnectedBackends (tUnqualified r))) <&> (tDomain r,) + +ensureNoUnreachableBackends :: + (Member (Error UnreachableBackends) r) => + [Either (Remote e, b) a] -> + Sem r [a] +ensureNoUnreachableBackends results = do + let (errors, values) = partitionEithers results + unless (null errors) $ + throw (UnreachableBackends (map (tDomain . fst) errors)) + pure values diff --git a/libs/wire-subsystems/src/Wire/ConversationSubsystem/Interpreter.hs b/libs/wire-subsystems/src/Wire/ConversationSubsystem/Interpreter.hs index 089e6d14c76..c0dce6fc8b4 100644 --- a/libs/wire-subsystems/src/Wire/ConversationSubsystem/Interpreter.hs +++ b/libs/wire-subsystems/src/Wire/ConversationSubsystem/Interpreter.hs @@ -1,3 +1,17 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedRecordDot #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeOperators #-} +{-# OPTIONS_GHC -Wno-redundant-constraints #-} + -- This file is part of the Wire Server implementation. -- -- Copyright (C) 2025 Wire Swiss GmbH @@ -15,55 +29,142 @@ -- You should have received a copy of the GNU Affero General Public License along -- with this program. If not, see . -module Wire.ConversationSubsystem.Interpreter where +module Wire.ConversationSubsystem.Interpreter + ( module X, + interpretConversationSubsystem, + createConversationImpl, + sendCellsNotification, + notifyConversationActionImpl, + pushConversationEvent, + toConversationCreated, + fromConversationCreated, + registerRemoteConversationMemberships, + notifyCreatedConversation, + ) +where +import Data.Bifunctor (second) import Data.Default import Data.Id -import Data.Json.Util (ToJSONObject (toJSONObject)) +import Data.Json.Util +import Data.List.Extra (nubOrd) +import Data.List.NonEmpty (NonEmpty) +import Data.List.NonEmpty qualified as NE import Data.Qualified -import Data.Singletons (Sing) -import Galley.Types.Teams (FeatureDefaults) +import Data.Set qualified as Set +import Data.Singletons (Sing, sing) +import Data.Text qualified as T +import Data.Text.Lazy qualified as LT +import Data.Time (UTCTime) +import Galley.Types.Error (InternalError) +import Galley.Types.Error qualified as GalleyError import Imports import Network.AMQP qualified as Q import Polysemy import Polysemy.Error -import Wire.API.Conversation hiding (Member) +import Polysemy.TinyLog (TinyLog) +import Polysemy.TinyLog qualified as P +import System.Logger.Message (msg, val, (+++)) +import Wire.API.Component (Component (Brig, Galley)) +import Wire.API.Conversation qualified as Public import Wire.API.Conversation.Action -import Wire.API.Conversation.CellsState (CellsState (..)) -import Wire.API.Conversation.Protocol (ProtocolTag) +import Wire.API.Conversation.CellsState +import Wire.API.Conversation.Protocol (Protocol (ProtocolProteus)) +import Wire.API.Conversation.Role +import Wire.API.Error.Galley import Wire.API.Event.Conversation -import Wire.API.Federation.API (makeConversationUpdateBundle, sendBundle) +import Wire.API.Federation.API (fedClient, makeConversationUpdateBundle, sendBundle) +import Wire.API.Federation.API.Galley (ConversationCreated (..), ccRemoteOrigUserId) import Wire.API.Federation.API.Galley.Notifications (ConversationUpdate (..)) -import Wire.API.Federation.Error (FederationError) -import Wire.API.MLS.Keys (MLSKeysByPurpose, MLSPrivateKeys) -import Wire.API.Team.Feature (LegalholdConfig) -import Wire.BackendNotificationQueueAccess (BackendNotificationQueueAccess, enqueueNotificationsConcurrently) +import Wire.API.Federation.Client (FederatorClient) +import Wire.API.Federation.Error +import Wire.API.Push.V2 qualified as PushV2 +import Wire.BackendNotificationQueueAccess (BackendNotificationQueueAccess, enqueueNotificationsConcurrently, enqueueNotificationsConcurrentlyBuckets) +import Wire.ConversationStore (ConversationStore) +import Wire.ConversationStore qualified as ConvStore import Wire.ConversationSubsystem +import Wire.ConversationSubsystem.Federation (ensureNoUnreachableBackends) +import Wire.ConversationSubsystem.Types as X +import Wire.ConversationSubsystem.View (conversationViewWithCachedOthers) import Wire.ExternalAccess (ExternalAccess, deliverAsync) +import Wire.FederationAPIAccess (FederationAPIAccess, runFederatedConcurrentlyEither) +import Wire.FederationAPIAccess qualified as E import Wire.NotificationSubsystem as NS import Wire.Sem.Now (Now) import Wire.Sem.Now qualified as Now -import Wire.StoredConversation - -data ConversationSubsystemConfig = ConversationSubsystemConfig - { mlsKeys :: Maybe (MLSKeysByPurpose MLSPrivateKeys), - federationProtocols :: Maybe [ProtocolTag], - legalholdDefaults :: FeatureDefaults LegalholdConfig, - maxConvSize :: Word16 - } +import Wire.StoredConversation hiding (convTeam, id_, localOne2OneConvId) +import Wire.StoredConversation as Data (LocalMember (..), NewConversation (..), RemoteMember (..), convType) +import Wire.StoredConversation qualified as Data interpretConversationSubsystem :: ( Member (Error FederationError) r, + Member (Error GalleyError.InternalError) r, Member BackendNotificationQueueAccess r, Member NotificationSubsystem r, Member ExternalAccess r, - Member Now r + Member Now r, + Member (Embed IO) r, + Member ConversationStore r, + Member (FederationAPIAccess FederatorClient) r, + Member TinyLog r ) => Sem (ConversationSubsystem : r) a -> Sem r a interpretConversationSubsystem = interpret $ \case NotifyConversationAction tag quid notifyOrigDomain con lconv targetsLocal targetsRemote targetsBots action extraData -> notifyConversationActionImpl tag quid notifyOrigDomain con lconv targetsLocal targetsRemote targetsBots action extraData + CreateConversation lconv lusr newConv -> do + res <- runError @UnreachableBackends $ runError @InternalError $ createConversationImpl lconv lusr newConv + case res of + Left (unreachable :: UnreachableBackends) -> throw $ FederationUnexpectedError (T.pack $ show unreachable) + Right (Left (err :: InternalError)) -> throw err + Right (Right val') -> pure val' + +createConversationImpl :: + ( Member (Error FederationError) r, + Member (Error UnreachableBackends) r, + Member (Error InternalError) r, + Member BackendNotificationQueueAccess r, + Member NotificationSubsystem r, + Member Now r, + Member (Embed IO) r, + Member ConversationStore r, + Member (FederationAPIAccess FederatorClient) r, + Member TinyLog r + ) => + Local ConvId -> + Local UserId -> + Data.NewConversation -> + Sem r StoredConversation +createConversationImpl lconv lusr newConv = do + storedConv <- ConvStore.upsertConversation lconv newConv + unless (Data.convType storedConv == Public.SelfConv) $ do + notifyCreatedConversation lusr Nothing storedConv def + sendCellsNotification lusr Nothing storedConv + pure storedConv + +sendCellsNotification :: + ( Member NotificationSubsystem r, + Member Now r + ) => + Local UserId -> + Maybe ConnId -> + StoredConversation -> + Sem r () +sendCellsNotification lusr conn conv = do + now <- Now.get + let lconv = qualifyAs lusr conv.id_ + event = CellsEvent (tUntagged lconv) (tUntagged lusr) now CellsConvCreateNoData + when (conv.metadata.cnvmCellsState /= CellsDisabled) $ do + let push = + def + { origin = Just (tUnqualified lusr), + json = toJSONObject event, + isCellsEvent = True, + route = PushV2.RouteAny, + conn + } + NS.pushNotifications [push] notifyConversationActionImpl :: forall tag r. @@ -82,7 +183,7 @@ notifyConversationActionImpl :: Set (Remote UserId) -> Set BotMember -> ConversationAction (tag :: ConversationActionTag) -> - ExtraConversationData -> + Public.ExtraConversationData -> Sem r LocalConversationUpdate notifyConversationActionImpl tag eventFrom notifyOrigDomain con lconv targetsLocal targetsRemote targetsBots action extraData = do now <- Now.get @@ -127,7 +228,7 @@ pushConversationEvent :: f BotMember -> Sem r () pushConversationEvent conn st e lusers bots = do - pushNotifications [(newConversationEventPush (fmap toList lusers)) {conn}] + NS.pushNotifications [(newConversationEventPush (fmap toList lusers)) {conn}] deliverAsync (map (,e) (toList bots)) where newConversationEventPush :: Local [UserId] -> Push @@ -137,6 +238,221 @@ pushConversationEvent conn st e lusers bots = do in def { origin = musr, json = toJSONObject e, - recipients = map userRecipient (tUnqualified users), + recipients = map NS.userRecipient (tUnqualified users), isCellsEvent = shouldPushToCells st e } + +toConversationCreated :: + UTCTime -> + Local UserId -> + StoredConversation -> + ConversationCreated ConvId +toConversationCreated now lusr StoredConversation {metadata = Public.ConversationMetadata {..}, ..} = + ConversationCreated + { time = now, + origUserId = tUnqualified lusr, + cnvId = id_, + cnvType = cnvmType, + cnvAccess = cnvmAccess, + cnvAccessRoles = cnvmAccessRoles, + cnvName = cnvmName, + nonCreatorMembers = Set.empty, + messageTimer = cnvmMessageTimer, + receiptMode = cnvmReceiptMode, + protocol = protocol, + groupConvType = cnvmGroupConvType, + channelAddPermission = cnvmChannelAddPermission + } + +fromConversationCreated :: + Local x -> + ConversationCreated (Remote ConvId) -> + [(Public.Member, Public.OwnConversation)] +fromConversationCreated loc rc@ConversationCreated {..} = + let membersView = fmap (second Set.toList) . setHoles $ nonCreatorMembers + creatorOther = + Public.OtherMember + (tUntagged (ccRemoteOrigUserId rc)) + Nothing + roleNameWireAdmin + in foldMap + ( \(me, others) -> + guard (inDomain me) $> let mem = toMember me in (mem, conv mem (creatorOther : others)) + ) + membersView + where + inDomain :: Public.OtherMember -> Bool + inDomain = (== tDomain loc) . qDomain . Public.omQualifiedId + setHoles :: (Ord a) => Set a -> [(a, Set a)] + setHoles s = foldMap (\x -> [(x, Set.delete x s)]) s + toMember :: Public.OtherMember -> Public.Member + toMember m = + Public.Member + { memId = Public.omQualifiedId m, + memService = Public.omService m, + memOtrMutedStatus = Nothing, + memOtrMutedRef = Nothing, + memOtrArchived = False, + memOtrArchivedRef = Nothing, + memHidden = False, + memHiddenRef = Nothing, + memConvRoleName = Public.omConvRoleName m + } + conv :: Public.Member -> [Public.OtherMember] -> Public.OwnConversation + conv this others = + Public.OwnConversation + (tUntagged cnvId) + Public.ConversationMetadata + { cnvmType = cnvType, + cnvmCreator = Just origUserId, + cnvmAccess = cnvAccess, + cnvmAccessRoles = cnvAccessRoles, + cnvmName = cnvName, + cnvmTeam = Nothing, + cnvmMessageTimer = messageTimer, + cnvmReceiptMode = receiptMode, + cnvmGroupConvType = groupConvType, + cnvmChannelAddPermission = channelAddPermission, + cnvmCellsState = def, + cnvmParent = Nothing + } + (Public.OwnConvMembers this others) + ProtocolProteus + +registerRemoteConversationMemberships :: + ( Member ConvStore.ConversationStore r, + Member (Error UnreachableBackends) r, + Member (Error FederationError) r, + Member BackendNotificationQueueAccess r, + Member (FederationAPIAccess FederatorClient) r, + Member TinyLog r + ) => + UTCTime -> + Local UserId -> + Local StoredConversation -> + JoinType -> + Sem r () +registerRemoteConversationMemberships now lusr lc joinType = deleteOnUnreachable $ do + let c = tUnqualified lc + rc = toConversationCreated now lusr c + allRemoteMembers = nubOrd c.remoteMembers + allRemoteMembersQualified = remoteMemberQualify <$> allRemoteMembers + allRemoteBuckets :: [Remote [RemoteMember]] = bucketRemote allRemoteMembersQualified + + void . (ensureNoUnreachableBackends =<<) $ + runFederatedConcurrentlyEither allRemoteMembersQualified $ \_ -> + void $ fedClient @'Brig @"api-version" () + + void . (ensureNoUnreachableBackends =<<) $ + runFederatedConcurrentlyEither allRemoteMembersQualified $ + \rrms -> + fedClient @'Galley @"on-conversation-created" + ( rc + { nonCreatorMembers = + toMembers (tUnqualified rrms) + } + ) + + let joined :: [Remote [RemoteMember]] = allRemoteBuckets + joinedCoupled :: [Remote ([RemoteMember], NonEmpty (Remote UserId))] + joinedCoupled = + foldMap + ( \ruids -> + let nj = + foldMap (fmap (.id_) . tUnqualified) $ + filter (\r -> tDomain r /= tDomain ruids) joined + in case NE.nonEmpty nj of + Nothing -> [] + Just v -> [fmap (,v) ruids] + ) + joined + + void $ enqueueNotificationsConcurrentlyBuckets Q.Persistent joinedCoupled $ \z -> + makeConversationUpdateBundle (convUpdateJoin z) >>= sendBundle + where + creator :: Maybe UserId + creator = Public.cnvmCreator . (.metadata) . tUnqualified $ lc + + localNonCreators :: [Public.OtherMember] + localNonCreators = + fmap (localMemberToOther . tDomain $ lc) + . filter (\lm -> lm.id_ `notElem` creator) + . (.localMembers) + . tUnqualified + $ lc + + toMembers :: [RemoteMember] -> Set Public.OtherMember + toMembers rs = Set.fromList $ localNonCreators <> fmap remoteMemberToOther rs + + convUpdateJoin :: Remote ([RemoteMember], NonEmpty (Remote UserId)) -> ConversationUpdate + convUpdateJoin (tUnqualified -> (toNotify, newMembers)) = + ConversationUpdate + { time = now, + origUserId = tUntagged lusr, + convId = (tUnqualified lc).id_, + alreadyPresentUsers = fmap (\m -> tUnqualified $ m.id_) toNotify, + action = + SomeConversationAction + (sing @'ConversationJoinTag) + (Public.ConversationJoin (tUntagged <$> newMembers) roleNameWireMember joinType), + extraConversationData = def + } + + deleteOnUnreachable :: + ( Member ConvStore.ConversationStore r, + Member (Error UnreachableBackends) r, + Member TinyLog r + ) => + Sem r a -> + Sem r a + deleteOnUnreachable m = catch @UnreachableBackends m $ \e -> do + P.err . msg $ + val "Unreachable backend when notifying" + +++ val "error" + +++ (LT.pack . show $ e) + ConvStore.deleteConversation (tUnqualified lc).id_ + throw e + +notifyCreatedConversation :: + ( Member ConvStore.ConversationStore r, + Member (Error FederationError) r, + Member (Error InternalError) r, + Member (Error UnreachableBackends) r, + Member (FederationAPIAccess FederatorClient) r, + Member NotificationSubsystem r, + Member BackendNotificationQueueAccess r, + Member Now r, + Member TinyLog r + ) => + Local UserId -> + Maybe ConnId -> + StoredConversation -> + JoinType -> + Sem r () +notifyCreatedConversation lusr conn c joinType = do + now <- Now.get + registerRemoteConversationMemberships now lusr (qualifyAs lusr c) joinType + unless (null c.remoteMembers) $ + unlessM E.isFederationConfigured $ + throw FederationNotConfigured + + NS.pushNotifications =<< mapM (toPush now) c.localMembers + where + route + | Data.convType c == Public.RegularConv = PushV2.RouteAny + | otherwise = PushV2.RouteDirect + toPush t m = do + let remoteOthers = remoteMemberToOther <$> c.remoteMembers + localOthers = map (localMemberToOther (tDomain lusr)) $ c.localMembers + lconv = qualifyAs lusr c.id_ + c' <- conversationViewWithCachedOthers remoteOthers localOthers c (qualifyAs lusr m.id_) + let e = Event (tUntagged lconv) Nothing (EventFromUser (tUntagged lusr)) t Nothing (EdConversation c') + pure $ + def + { origin = Just (tUnqualified lusr), + json = toJSONObject e, + recipients = [localMemberToRecipient m], + isCellsEvent = False, + route, + conn + } diff --git a/libs/wire-subsystems/src/Wire/ConversationSubsystem/Notification.hs b/libs/wire-subsystems/src/Wire/ConversationSubsystem/Notification.hs new file mode 100644 index 00000000000..cf4837fb6b8 --- /dev/null +++ b/libs/wire-subsystems/src/Wire/ConversationSubsystem/Notification.hs @@ -0,0 +1,256 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TypeApplications #-} +{-# OPTIONS_GHC -Wno-ambiguous-fields #-} + +module Wire.ConversationSubsystem.Notification where + +import Data.Bifunctor +import Data.Default +import Data.Id +import Data.Json.Util +import Data.List.Extra (nubOrd) +import Data.List.NonEmpty (NonEmpty) +import Data.List.NonEmpty qualified as NE +import Data.Qualified +import Data.Set qualified as Set +import Data.Singletons +import Data.Time +import Galley.Types.Error (InternalError) +import Imports +import Network.AMQP qualified as Q +import Polysemy +import Polysemy.Error +import Polysemy.TinyLog qualified as P +import Wire.API.Component (Component (..)) +import Wire.API.Conversation hiding (Member, cnvAccess, cnvAccessRoles, cnvName, cnvType) +import Wire.API.Conversation qualified as Public +import Wire.API.Conversation.Action +import Wire.API.Conversation.Protocol +import Wire.API.Conversation.Role +import Wire.API.Error.Galley (UnreachableBackends (..)) +import Wire.API.Event.Conversation +import Wire.API.Federation.API (fedClient, makeConversationUpdateBundle, sendBundle) +import Wire.API.Federation.API.Galley +import Wire.API.Federation.Client (FederatorClient) +import Wire.API.Federation.Error +import Wire.API.Push.V2 qualified as PushV2 +import Wire.BackendNotificationQueueAccess +import Wire.ConversationStore +import Wire.ConversationSubsystem.Federation (ensureNoUnreachableBackends) +import Wire.ConversationSubsystem.View +import Wire.FederationAPIAccess +import Wire.FederationAPIAccess qualified as E +import Wire.NotificationSubsystem +import Wire.Sem.Now (Now) +import Wire.Sem.Now qualified as Now +import Wire.StoredConversation as Data + +toConversationCreated :: + UTCTime -> + Local UserId -> + StoredConversation -> + ConversationCreated ConvId +toConversationCreated now lusr StoredConversation {metadata = ConversationMetadata {..}, ..} = + ConversationCreated + { time = now, + origUserId = tUnqualified lusr, + cnvId = id_, + cnvType = cnvmType, + cnvAccess = cnvmAccess, + cnvAccessRoles = cnvmAccessRoles, + cnvName = cnvmName, + nonCreatorMembers = Set.empty, + messageTimer = cnvmMessageTimer, + receiptMode = cnvmReceiptMode, + protocol = protocol, + groupConvType = cnvmGroupConvType, + channelAddPermission = cnvmChannelAddPermission + } + +fromConversationCreated :: + Local x -> + ConversationCreated (Remote ConvId) -> + [(Public.Member, Public.OwnConversation)] +fromConversationCreated loc rc@ConversationCreated {..} = + let membersView = fmap (second Set.toList) . setHoles $ nonCreatorMembers + creatorOther = + OtherMember + (tUntagged (ccRemoteOrigUserId rc)) + Nothing + roleNameWireAdmin + in foldMap + ( \(me, others) -> + guard (inDomain me) $> let mem = toMember me in (mem, conv mem (creatorOther : others)) + ) + membersView + where + inDomain :: OtherMember -> Bool + inDomain = (== tDomain loc) . qDomain . Public.omQualifiedId + setHoles :: (Ord a) => Set a -> [(a, Set a)] + setHoles s = foldMap (\x -> [(x, Set.delete x s)]) s + toMember :: OtherMember -> Public.Member + toMember m = + Public.Member + { memId = Public.omQualifiedId m, + memService = Public.omService m, + memOtrMutedStatus = Nothing, + memOtrMutedRef = Nothing, + memOtrArchived = False, + memOtrArchivedRef = Nothing, + memHidden = False, + memHiddenRef = Nothing, + memConvRoleName = Public.omConvRoleName m + } + conv :: Public.Member -> [OtherMember] -> Public.OwnConversation + conv this others = + Public.OwnConversation + (tUntagged cnvId) + ConversationMetadata + { cnvmType = cnvType, + cnvmCreator = Just origUserId, + cnvmAccess = cnvAccess, + cnvmAccessRoles = cnvAccessRoles, + cnvmName = cnvName, + cnvmTeam = Nothing, + cnvmMessageTimer = messageTimer, + cnvmReceiptMode = receiptMode, + cnvmGroupConvType = groupConvType, + cnvmChannelAddPermission = channelAddPermission, + cnvmCellsState = def, + cnvmParent = Nothing + } + (OwnConvMembers this others) + ProtocolProteus + +registerRemoteConversationMemberships :: + ( Member ConversationStore r, + Member (Error UnreachableBackends) r, + Member (Error FederationError) r, + Member BackendNotificationQueueAccess r, + Member (FederationAPIAccess FederatorClient) r + ) => + UTCTime -> + Local UserId -> + Local StoredConversation -> + JoinType -> + Sem r () +registerRemoteConversationMemberships now lusr lc joinType = deleteOnUnreachable $ do + let c = tUnqualified lc + rc = toConversationCreated now lusr c + allRemoteMembers = nubOrd c.remoteMembers + allRemoteMembersQualified = remoteMemberQualify <$> allRemoteMembers + allRemoteBuckets :: [Remote [RemoteMember]] = bucketRemote allRemoteMembersQualified + + void . (ensureNoUnreachableBackends =<<) $ + runFederatedConcurrentlyEither allRemoteMembersQualified $ \_ -> + void $ fedClient @'Brig @"api-version" () + + void . (ensureNoUnreachableBackends =<<) $ + runFederatedConcurrentlyEither allRemoteMembersQualified $ + \rrms -> + fedClient @'Galley @"on-conversation-created" + ( rc + { nonCreatorMembers = + toMembers (tUnqualified rrms) + } + ) + + let joined :: [Remote [RemoteMember]] = allRemoteBuckets + joinedCoupled :: [Remote ([RemoteMember], NonEmpty (Remote UserId))] + joinedCoupled = + foldMap + ( \ruids -> + let nj = + foldMap (fmap (.id_) . tUnqualified) $ + filter (\r -> tDomain r /= tDomain ruids) joined + in case NE.nonEmpty nj of + Nothing -> [] + Just v -> [fmap (,v) ruids] + ) + joined + + void $ enqueueNotificationsConcurrentlyBuckets Q.Persistent joinedCoupled $ \z -> + makeConversationUpdateBundle (convUpdateJoin z) >>= sendBundle + where + creator :: Maybe UserId + creator = cnvmCreator . (.metadata) . tUnqualified $ lc + + localNonCreators :: [OtherMember] + localNonCreators = + fmap (localMemberToOther . tDomain $ lc) + . filter (\lm -> lm.id_ `notElem` creator) + . (.localMembers) + . tUnqualified + $ lc + + toMembers :: [RemoteMember] -> Set OtherMember + toMembers rs = Set.fromList $ localNonCreators <> fmap remoteMemberToOther rs + + convUpdateJoin :: Remote ([RemoteMember], NonEmpty (Remote UserId)) -> ConversationUpdate + convUpdateJoin (tUnqualified -> (toNotify, newMembers)) = + ConversationUpdate + { time = now, + origUserId = tUntagged lusr, + convId = (tUnqualified lc).id_, + alreadyPresentUsers = fmap (\m -> tUnqualified $ m.id_) toNotify, + action = + SomeConversationAction + (sing @'ConversationJoinTag) + (ConversationJoin (tUntagged <$> newMembers) roleNameWireMember joinType), + extraConversationData = def + } + + deleteOnUnreachable :: + ( Member ConversationStore r, + Member (Error UnreachableBackends) r + ) => + Sem r a -> + Sem r a + deleteOnUnreachable m = catch @UnreachableBackends m $ \e -> do + deleteConversation (tUnqualified lc).id_ + throw e + +notifyCreatedConversation :: + ( Member ConversationStore r, + Member (Error FederationError) r, + Member (Error InternalError) r, + Member (Error UnreachableBackends) r, + Member (FederationAPIAccess FederatorClient) r, + Member NotificationSubsystem r, + Member BackendNotificationQueueAccess r, + Member Now r, + Member P.TinyLog r + ) => + Local UserId -> + Maybe ConnId -> + StoredConversation -> + JoinType -> + Sem r () +notifyCreatedConversation lusr conn c joinType = do + now <- Now.get + registerRemoteConversationMemberships now lusr (qualifyAs lusr c) joinType + unless (null c.remoteMembers) $ + unlessM E.isFederationConfigured $ + throw FederationNotConfigured + + pushNotifications =<< mapM (toPush now) c.localMembers + where + route + | Data.convType c == RegularConv = PushV2.RouteAny + | otherwise = PushV2.RouteDirect + toPush t m = do + let remoteOthers = remoteMemberToOther <$> c.remoteMembers + localOthers = map (localMemberToOther (tDomain lusr)) $ c.localMembers + lconv = qualifyAs lusr c.id_ + c' <- conversationViewWithCachedOthers remoteOthers localOthers c (qualifyAs lusr m.id_) + let e = Event (tUntagged lconv) Nothing (EventFromUser (tUntagged lusr)) t Nothing (EdConversation c') + pure $ + def + { origin = Just (tUnqualified lusr), + json = toJSONObject e, + recipients = [localMemberToRecipient m], + isCellsEvent = False, + route, + conn + } diff --git a/services/galley/src/Galley/API/One2One.hs b/libs/wire-subsystems/src/Wire/ConversationSubsystem/One2One.hs similarity index 98% rename from services/galley/src/Galley/API/One2One.hs rename to libs/wire-subsystems/src/Wire/ConversationSubsystem/One2One.hs index acbd3c17f2e..afe039381b8 100644 --- a/services/galley/src/Galley/API/One2One.hs +++ b/libs/wire-subsystems/src/Wire/ConversationSubsystem/One2One.hs @@ -17,7 +17,7 @@ -- You should have received a copy of the GNU Affero General Public License along -- with this program. If not, see . -module Galley.API.One2One +module Wire.ConversationSubsystem.One2One ( one2OneConvId, iUpsertOne2OneConversation, ) diff --git a/libs/wire-subsystems/src/Wire/ConversationSubsystem/Types.hs b/libs/wire-subsystems/src/Wire/ConversationSubsystem/Types.hs new file mode 100644 index 00000000000..b37ba673093 --- /dev/null +++ b/libs/wire-subsystems/src/Wire/ConversationSubsystem/Types.hs @@ -0,0 +1,31 @@ +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2025 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.ConversationSubsystem.Types where + +import Galley.Types.Teams (FeatureDefaults) +import Imports +import Wire.API.Conversation.Protocol (ProtocolTag) +import Wire.API.MLS.Keys (MLSKeysByPurpose, MLSPrivateKeys) +import Wire.API.Team.Feature (LegalholdConfig) + +data ConversationSubsystemConfig = ConversationSubsystemConfig + { mlsKeys :: Maybe (MLSKeysByPurpose MLSPrivateKeys), + federationProtocols :: Maybe [ProtocolTag], + legalholdDefaults :: FeatureDefaults LegalholdConfig, + maxConvSize :: Word16 + } diff --git a/services/galley/src/Galley/API/Util.hs b/libs/wire-subsystems/src/Wire/ConversationSubsystem/Util.hs similarity index 97% rename from services/galley/src/Galley/API/Util.hs rename to libs/wire-subsystems/src/Wire/ConversationSubsystem/Util.hs index d8a1143b9ef..63370a7223e 100644 --- a/services/galley/src/Galley/API/Util.hs +++ b/libs/wire-subsystems/src/Wire/ConversationSubsystem/Util.hs @@ -18,7 +18,7 @@ -- You should have received a copy of the GNU Affero General Public License along -- with this program. If not, see . -module Galley.API.Util where +module Wire.ConversationSubsystem.Util where import Control.Lens (view, (^.)) import Control.Monad.Extra (allM, anyM) @@ -40,13 +40,9 @@ import Data.Set qualified as Set import Data.Singletons import Data.Text qualified as T import Data.Time -import Galley.API.Error -import Galley.API.Mapping -import Galley.Effects -import Galley.Effects.ClientStore -import Galley.Env import Galley.Types.Clients (Clients, fromUserClients) import Galley.Types.Conversations.Roles +import Galley.Types.Error import Galley.Types.Teams import Imports hiding (forkIO) import Network.AMQP qualified as Q @@ -87,7 +83,10 @@ import Wire.BrigAPIAccess import Wire.CodeStore import Wire.CodeStore.Code as DataTypes import Wire.ConversationStore -import Wire.ConversationSubsystem.Interpreter (ConversationSubsystemConfig (..)) +import Wire.ConversationSubsystem.Federation +import Wire.ConversationSubsystem.Types +import Wire.ConversationSubsystem.View +import Wire.Effects.ClientStore import Wire.ExternalAccess import Wire.FederationAPIAccess import Wire.HashPassword (HashPassword) @@ -902,16 +901,6 @@ fromConversationCreated loc rc@ConversationCreated {..} = (OwnConvMembers this others) ProtocolProteus -ensureNoUnreachableBackends :: - (Member (Error UnreachableBackends) r) => - [Either (Remote e, b) a] -> - Sem r [a] -ensureNoUnreachableBackends results = do - let (errors, values) = partitionEithers results - unless (null errors) $ - throw (UnreachableBackends (map (tDomain . fst) errors)) - pure values - -- | Notify remote users of being added to a new conversation. registerRemoteConversationMemberships :: ( Member ConversationStore r, @@ -1187,3 +1176,29 @@ instance if err' == demote @e then throwS @e else rethrowErrors @effs @r err' + +---------------------------------------------------------------------------- +-- Notifications +notifyConversationUpdated :: + ( Member NotificationSubsystem r, + Member Now r + ) => + Local UserId -> + Maybe ConnId -> + Connect -> + StoredConversation -> + Sem r () +notifyConversationUpdated lusr conn j conv = do + let lcnv = qualifyAs lusr conv.id_ + t <- Now.get + let e = Event (tUntagged lcnv) Nothing (EventFromUser (tUntagged lusr)) t Nothing (EdConnect j) + pushNotifications + [ def + { origin = Just (tUnqualified lusr), + json = toJSONObject e, + recipients = map localMemberToRecipient conv.localMembers, + isCellsEvent = shouldPushToCells conv.metadata e, + route = PushV2.RouteDirect, + conn + } + ] diff --git a/services/galley/src/Galley/API/Mapping.hs b/libs/wire-subsystems/src/Wire/ConversationSubsystem/View.hs similarity index 71% rename from services/galley/src/Galley/API/Mapping.hs rename to libs/wire-subsystems/src/Wire/ConversationSubsystem/View.hs index 91d2c338c7b..e6a71cf0d95 100644 --- a/services/galley/src/Galley/API/Mapping.hs +++ b/libs/wire-subsystems/src/Wire/ConversationSubsystem/View.hs @@ -1,34 +1,9 @@ --- 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.Mapping - ( conversationViewV9, - conversationView, - conversationViewWithCachedOthers, - remoteConversationView, - conversationToRemote, - localMemberToSelf, - ) -where +module Wire.ConversationSubsystem.View where import Data.Domain (Domain) import Data.Id (UserId, idToText) import Data.Qualified -import Galley.API.Error +import Galley.Types.Error (InternalError (BadMemberState)) import Imports import Polysemy import Polysemy.Error @@ -39,9 +14,6 @@ import Wire.API.Conversation qualified as Conversation import Wire.API.Federation.API.Galley import Wire.StoredConversation --- | View for a given user of a stored conversation. --- --- Throws @BadMemberState@ when the user is not part of the conversation. conversationViewV9 :: ( Member (Error InternalError) r, Member P.TinyLog r @@ -72,9 +44,6 @@ conversationView l luid conv = protocol = conv.protocol } --- | Like 'conversationView' but optimized for situations which could benefit --- from pre-computing the list of @OtherMember@s in the conversation. For --- instance, creating @ConversationView@ for more than 1 member of the same conversation. conversationViewWithCachedOthers :: ( Member (Error InternalError) r, Member P.TinyLog r @@ -96,9 +65,6 @@ conversationViewWithCachedOthers remoteOthers localOthers conv luid = do +++ idToText conv.id_ throw BadMemberState --- | View for a given user of a stored conversation. --- --- Returns 'Nothing' if the user is not part of the conversation. conversationViewMaybe :: Local UserId -> [OtherMember] -> [OtherMember] -> StoredConversation -> Maybe OwnConversation conversationViewMaybe luid remoteOthers localOthers conv = do let selfs = filter (\m -> tUnqualified luid == m.id_) conv.localMembers @@ -111,7 +77,6 @@ conversationViewMaybe luid remoteOthers localOthers conv = do (OwnConvMembers self others) conv.protocol --- | View for a local user of a remote conversation. remoteConversationView :: Local UserId -> MemberStatus -> @@ -135,10 +100,6 @@ remoteConversationView uid status (tUntagged -> Qualified rconv rDomain) = (OwnConvMembers self others) rconv.protocol --- | Convert a local conversation to a structure to be returned to a remote --- backend. --- --- This returns 'Nothing' if the given remote user is not part of the conversation. conversationToRemote :: Domain -> Remote UserId -> @@ -163,8 +124,6 @@ conversationToRemote localDomain ruid conv = do protocol = conv.protocol } --- | Convert a local conversation member (as stored in the DB) to a publicly --- facing 'Member' structure. localMemberToSelf :: Local x -> LocalMember -> Conversation.Member localMemberToSelf loc lm = Conversation.Member diff --git a/services/galley/src/Galley/Effects/ClientStore.hs b/libs/wire-subsystems/src/Wire/Effects/ClientStore.hs similarity index 97% rename from services/galley/src/Galley/Effects/ClientStore.hs rename to libs/wire-subsystems/src/Wire/Effects/ClientStore.hs index 4697dc12b12..d38a67b9c04 100644 --- a/services/galley/src/Galley/Effects/ClientStore.hs +++ b/libs/wire-subsystems/src/Wire/Effects/ClientStore.hs @@ -17,7 +17,7 @@ -- You should have received a copy of the GNU Affero General Public License along -- with this program. If not, see . -module Galley.Effects.ClientStore +module Wire.Effects.ClientStore ( -- * ClientStore Effect ClientStore (..), diff --git a/libs/wire-subsystems/wire-subsystems.cabal b/libs/wire-subsystems/wire-subsystems.cabal index 5dc5e19c770..80cfd1d87e9 100644 --- a/libs/wire-subsystems/wire-subsystems.cabal +++ b/libs/wire-subsystems/wire-subsystems.cabal @@ -243,13 +243,21 @@ library Wire.ConversationStore.MLS.Types Wire.ConversationStore.Postgres Wire.ConversationSubsystem + Wire.ConversationSubsystem.Create + Wire.ConversationSubsystem.Federation Wire.ConversationSubsystem.Interpreter + Wire.ConversationSubsystem.Notification + Wire.ConversationSubsystem.One2One + Wire.ConversationSubsystem.Types + Wire.ConversationSubsystem.Util + Wire.ConversationSubsystem.View Wire.DeleteQueue Wire.DeleteQueue.InMemory Wire.DomainRegistrationStore Wire.DomainRegistrationStore.Cassandra Wire.DomainVerificationChallengeStore Wire.DomainVerificationChallengeStore.Cassandra + Wire.Effects.ClientStore Wire.EmailSending Wire.EmailSending.SES Wire.EmailSending.SMTP diff --git a/services/background-worker/background-worker.cabal b/services/background-worker/background-worker.cabal index 595e3d01eac..2b73310cbc5 100644 --- a/services/background-worker/background-worker.cabal +++ b/services/background-worker/background-worker.cabal @@ -42,6 +42,7 @@ library , exceptions , extended , extra + , galley-types , hasql-pool , HsOpenSSL , http-client diff --git a/services/background-worker/default.nix b/services/background-worker/default.nix index 011bc91bea0..58beb333294 100644 --- a/services/background-worker/default.nix +++ b/services/background-worker/default.nix @@ -16,6 +16,7 @@ , extended , extra , federator +, galley-types , gitignoreSource , hasql-pool , HsOpenSSL @@ -68,6 +69,7 @@ mkDerivation { exceptions extended extra + galley-types hasql-pool HsOpenSSL http-client diff --git a/services/background-worker/src/Wire/BackgroundWorker/Env.hs b/services/background-worker/src/Wire/BackgroundWorker/Env.hs index 11787f105c6..5e2774106d5 100644 --- a/services/background-worker/src/Wire/BackgroundWorker/Env.hs +++ b/services/background-worker/src/Wire/BackgroundWorker/Env.hs @@ -84,7 +84,8 @@ data Env = Env federationDomain :: Domain, postgresMigration :: PostgresMigrationOpts, gundeckEndpoint :: Endpoint, - brigEndpoint :: Endpoint + brigEndpoint :: Endpoint, + federator :: Maybe Endpoint } data BackendNotificationMetrics = BackendNotificationMetrics @@ -133,6 +134,7 @@ mkEnv opts = do postgresMigration = opts.postgresMigration brigEndpoint = opts.brig gundeckEndpoint = opts.gundeck + federator = opts.federator workerRunningGauge <- mkWorkerRunningGauge hasqlPool <- initPostgresPool opts.postgresqlPool opts.postgresql opts.postgresqlPassword amqpJobsPublisherChannel <- diff --git a/services/background-worker/src/Wire/BackgroundWorker/Jobs/Registry.hs b/services/background-worker/src/Wire/BackgroundWorker/Jobs/Registry.hs index 1c9b3416bd5..324e5d8f9ce 100644 --- a/services/background-worker/src/Wire/BackgroundWorker/Jobs/Registry.hs +++ b/services/background-worker/src/Wire/BackgroundWorker/Jobs/Registry.hs @@ -23,6 +23,8 @@ where import Data.Id import Data.Qualified import Data.Text qualified as T +import Data.Text.Lazy qualified as TL +import Galley.Types.Error (InternalError, internalErrorDescription) import Hasql.Pool (UsageError) import Imports import Polysemy @@ -45,11 +47,14 @@ import Wire.ConversationStore.Cassandra import Wire.ConversationStore.Postgres (interpretConversationStoreToPostgres) import Wire.ConversationSubsystem.Interpreter (interpretConversationSubsystem) import Wire.ExternalAccess.External +import Wire.FederationAPIAccess.Interpreter (FederationAPIAccessConfig (..), interpretFederationAPIAccess) import Wire.FireAndForget (interpretFireAndForget) import Wire.GundeckAPIAccess import Wire.NotificationSubsystem.Interpreter import Wire.ParseException import Wire.Rpc +import Wire.Sem.Concurrency (ConcurrencySafety (Unsafe)) +import Wire.Sem.Concurrency.IO (unsafelyPerformConcurrency) import Wire.Sem.Delay (runDelay) import Wire.Sem.Logger (mapLogger) import Wire.Sem.Logger.TinyLog (loggerToTinyLog) @@ -72,7 +77,15 @@ dispatchJob job = do MigrationToPostgresql -> interpretConversationStoreToCassandraAndPostgres env.cassandraGalley PostgresqlStorage -> interpretConversationStoreToPostgres runInterpreters env extEnv = do + let federationAPIAccessConfig = + FederationAPIAccessConfig + { ownDomain = env.federationDomain, + federatorEndpoint = env.federator, + http2Manager = env.http2Manager, + requestId = job.requestId + } runFinal @IO + . unsafelyPerformConcurrency @_ @'Unsafe . embedToFinal @IO . asyncToIOFinal . interpretRace @@ -82,6 +95,7 @@ dispatchJob job = do . mapError @UsageError (T.pack . show) . mapError @ParseException (T.pack . displayException) . mapError @MigrationError (T.pack . show) + . mapError @InternalError (TL.toStrict . internalErrorDescription) . interpretTinyLog env job.requestId job.jobId . runInputConst env.hasqlPool . runInputConst (toLocalUnsafe env.federationDomain ()) @@ -102,6 +116,7 @@ dispatchJob job = do . interpretBrigAccess env.brigEndpoint . interpretExternalAccess extEnv . runNotificationSubsystemGundeck (defaultNotificationSubsystemConfig job.requestId) + . interpretFederationAPIAccess federationAPIAccessConfig . interpretConversationSubsystem . interpretBackgroundJobsRunner diff --git a/services/background-worker/src/Wire/BackgroundWorker/Options.hs b/services/background-worker/src/Wire/BackgroundWorker/Options.hs index 6dc18f03a2b..35ee518c306 100644 --- a/services/background-worker/src/Wire/BackgroundWorker/Options.hs +++ b/services/background-worker/src/Wire/BackgroundWorker/Options.hs @@ -37,6 +37,7 @@ data Opts = Opts federatorInternal :: !Endpoint, brig :: Endpoint, gundeck :: Endpoint, + federator :: Maybe Endpoint, rabbitmq :: !RabbitMqOpts, -- | Seconds, Nothing for no timeout defederationTimeout :: Maybe Int, diff --git a/services/background-worker/test/Test/Wire/BackendNotificationPusherSpec.hs b/services/background-worker/test/Test/Wire/BackendNotificationPusherSpec.hs index e10ab43123d..0b6196284be 100644 --- a/services/background-worker/test/Test/Wire/BackendNotificationPusherSpec.hs +++ b/services/background-worker/test/Test/Wire/BackendNotificationPusherSpec.hs @@ -368,6 +368,7 @@ spec = do } gundeckEndpoint = undefined brigEndpoint = undefined + federator = Nothing backendNotificationMetrics <- mkBackendNotificationMetrics workerRunningGauge <- mkWorkerRunningGauge @@ -406,6 +407,7 @@ spec = do } gundeckEndpoint = undefined brigEndpoint = undefined + federator = Nothing backendNotificationMetrics <- mkBackendNotificationMetrics workerRunningGauge <- mkWorkerRunningGauge domainsThread <- async $ runAppT Env {..} $ getRemoteDomains (fromJust rabbitmqAdminClient) diff --git a/services/background-worker/test/Test/Wire/Util.hs b/services/background-worker/test/Test/Wire/Util.hs index cdb020a2223..014c3b50383 100644 --- a/services/background-worker/test/Test/Wire/Util.hs +++ b/services/background-worker/test/Test/Wire/Util.hs @@ -65,6 +65,7 @@ testEnv = do federationDomain = Domain "local" gundeckEndpoint = undefined brigEndpoint = undefined + federator = Nothing pure Env {..} runTestAppT :: AppT IO a -> Int -> IO a diff --git a/services/brig/src/Brig/IO/Intra.hs b/services/brig/src/Brig/IO/Intra.hs index d0368962072..2cc16a9bac6 100644 --- a/services/brig/src/Brig/IO/Intra.hs +++ b/services/brig/src/Brig/IO/Intra.hs @@ -439,7 +439,7 @@ toApsData _ = Nothing ------------------------------------------------------------------------------- -- Conversation Management --- | Calls 'Galley.API.Create.createConnectConversation'. +-- | Calls 'Wire.ConversationSubsystem.Create.createConnectConversation'. createLocalConnectConv :: ( Member (Embed HttpClientIO) r, Member TinyLog r diff --git a/services/galley/default.nix b/services/galley/default.nix index 988d5378dc7..dde0afe0b97 100644 --- a/services/galley/default.nix +++ b/services/galley/default.nix @@ -190,7 +190,6 @@ mkDerivation { text time tinylog - transformers types-common types-common-aws unliftio @@ -296,6 +295,7 @@ mkDerivation { base containers extra + galley-types imports lens polysemy diff --git a/services/galley/galley.cabal b/services/galley/galley.cabal index f1d6b4f299c..eefbd7301cb 100644 --- a/services/galley/galley.cabal +++ b/services/galley/galley.cabal @@ -79,16 +79,13 @@ library Galley.API.Action.Notify Galley.API.Action.Reset Galley.API.Clients - Galley.API.Create Galley.API.CustomBackend - Galley.API.Error Galley.API.Federation Galley.API.Internal Galley.API.LegalHold Galley.API.LegalHold.Conflicts Galley.API.LegalHold.Get Galley.API.LegalHold.Team - Galley.API.Mapping Galley.API.Message Galley.API.MLS Galley.API.MLS.CheckClients @@ -113,7 +110,6 @@ library Galley.API.MLS.SubConversation Galley.API.MLS.Util Galley.API.MLS.Welcome - Galley.API.One2One Galley.API.Public.Bot Galley.API.Public.Conversation Galley.API.Public.CustomBackend @@ -134,7 +130,6 @@ library Galley.API.Teams.Features.Get Galley.API.Teams.Notifications Galley.API.Update - Galley.API.Util Galley.App Galley.Cassandra Galley.Cassandra.Client @@ -147,7 +142,6 @@ library Galley.Cassandra.Util Galley.Data.TeamNotifications Galley.Effects - Galley.Effects.ClientStore Galley.Effects.CustomBackendStore Galley.Effects.Queue Galley.Effects.SearchVisibilityStore @@ -245,8 +239,6 @@ library Galley.Schema.V97_CellsConversation Galley.Schema.V98_ChannelAddPermission Galley.Schema.V99_ConversationAddParent - Galley.Types.Clients - Galley.Validation ghc-options: -fplugin=Polysemy.Plugin other-modules: Paths_galley @@ -313,7 +305,6 @@ library , text >=0.11 , time >=1.4 , tinylog >=0.10 - , transformers , types-common >=0.16 , types-common-aws , unliftio >=0.2 @@ -571,6 +562,7 @@ test-suite galley-tests , containers , extra >=1.3 , galley + , galley-types , imports , lens , polysemy diff --git a/services/galley/src/Galley/API/Action.hs b/services/galley/src/Galley/API/Action.hs index 10474662d9a..4df091a4583 100644 --- a/services/galley/src/Galley/API/Action.hs +++ b/services/galley/src/Galley/API/Action.hs @@ -46,11 +46,9 @@ module Galley.API.Action where import Control.Arrow ((&&&)) -import Control.Error (headMay) import Control.Lens import Data.ByteString.Conversion (toByteString') import Data.Default -import Data.Domain (Domain (..)) import Data.Id import Data.Json.Util import Data.Kind @@ -61,6 +59,7 @@ import Data.List.NonEmpty qualified as NE import Data.Map qualified as Map import Data.Misc import Data.Qualified +import Data.Range (checkedEither) import Data.Set ((\\)) import Data.Set qualified as Set import Data.Singletons @@ -69,16 +68,14 @@ import Galley.API.Action.Kick import Galley.API.Action.Leave import Galley.API.Action.Notify import Galley.API.Action.Reset -import Galley.API.Error import Galley.API.MLS.Conversation import Galley.API.MLS.Migration import Galley.API.MLS.Removal import Galley.API.Teams.Features.Get -import Galley.API.Util import Galley.Effects import Galley.Env (Env) import Galley.Options (Opts) -import Galley.Validation +import Galley.Types.Error import Imports hiding ((\\)) import Polysemy import Polysemy.Error @@ -98,7 +95,6 @@ import Wire.API.Error import Wire.API.Error.Galley import Wire.API.Event.Conversation import Wire.API.Federation.API -import Wire.API.Federation.API.Brig import Wire.API.Federation.API.Galley import Wire.API.Federation.API.Galley qualified as F import Wire.API.Federation.Client (FederatorClient) @@ -117,7 +113,9 @@ import Wire.CodeStore import Wire.CodeStore qualified as E import Wire.ConversationStore qualified as E import Wire.ConversationSubsystem +import Wire.ConversationSubsystem.Federation import Wire.ConversationSubsystem.Interpreter (ConversationSubsystemConfig (..)) +import Wire.ConversationSubsystem.Util import Wire.FeaturesConfigSubsystem import Wire.FederationAPIAccess qualified as E import Wire.FireAndForget qualified as E @@ -367,62 +365,6 @@ type family HasConversationActionGalleyErrors (tag :: ConversationActionTag) :: ErrorS ConvNotFound ] -enforceFederationProtocol :: - ( Member (Error FederationError) r, - Member (Input ConversationSubsystemConfig) r - ) => - ProtocolTag -> - [Remote ()] -> - Sem r () -enforceFederationProtocol proto domains = do - unless (null domains) $ do - mAllowedProtos <- federationProtocols <$> input - unless (maybe True (elem proto) mAllowedProtos) $ - throw FederationDisabledForProtocol - -checkFederationStatus :: - ( Member (Error UnreachableBackends) r, - Member (Error NonFederatingBackends) r, - Member (FederationAPIAccess FederatorClient) r - ) => - RemoteDomains -> - Sem r () -checkFederationStatus req = do - status <- getFederationStatus req - case status of - FullyConnected -> pure () - NotConnectedDomains dom1 dom2 -> throw (NonFederatingBackends dom1 dom2) - -getFederationStatus :: - ( Member (Error UnreachableBackends) r, - Member (FederationAPIAccess FederatorClient) r - ) => - RemoteDomains -> - Sem r FederationStatus -getFederationStatus req = do - fmap firstConflictOrFullyConnected - . (ensureNoUnreachableBackends =<<) - $ E.runFederatedConcurrentlyEither - (Set.toList req.rdDomains) - ( \qds -> - fedClient @'Brig @"get-not-fully-connected-backends" - (DomainSet . Set.map tDomain $ void qds `Set.delete` req.rdDomains) - ) - --- | "conflict" here means two remote domains that we are connected to --- but are not connected to each other. -firstConflictOrFullyConnected :: [Remote NonConnectedBackends] -> FederationStatus -firstConflictOrFullyConnected = - maybe - FullyConnected - (uncurry NotConnectedDomains) - . headMay - . mapMaybe toMaybeConflict - where - toMaybeConflict :: Remote NonConnectedBackends -> Maybe (Domain, Domain) - toMaybeConflict r = - headMay (Set.toList (nonConnectedBackends (tUnqualified r))) <&> (tDomain r,) - noChanges :: (Member (Error NoChanges) r) => Sem r a noChanges = throw NoChanges @@ -568,7 +510,7 @@ performAction tag origUser lconv action = do SConversationRenameTag -> do zusrMembership <- join <$> forM storedConv.metadata.cnvmTeam (TeamSubsystem.internalGetTeamMember (qUnqualified origUser)) for_ zusrMembership $ \tm -> unless (tm `hasPermission` ModifyConvName) $ throwS @'InvalidOperation - cn <- rangeChecked (cupName action) + cn <- either (throw . InvalidRange . fromString) pure $ checkedEither (cupName action) E.setConversationName (tUnqualified lcnv) cn pure $ mkPerformActionResult action SConversationMessageTimerUpdateTag -> do diff --git a/services/galley/src/Galley/API/Action/Kick.hs b/services/galley/src/Galley/API/Action/Kick.hs index 4224dfe4a02..520a6dfb493 100644 --- a/services/galley/src/Galley/API/Action/Kick.hs +++ b/services/galley/src/Galley/API/Action/Kick.hs @@ -23,7 +23,6 @@ import Data.Qualified import Data.Singletons import Galley.API.Action.Leave import Galley.API.Action.Notify -import Galley.API.Util import Galley.Effects import Imports hiding ((\\)) import Polysemy @@ -36,6 +35,7 @@ import Wire.API.Event.LeaveReason import Wire.API.Federation.Error import Wire.ConversationSubsystem import Wire.ConversationSubsystem.Interpreter (ConversationSubsystemConfig) +import Wire.ConversationSubsystem.Util import Wire.NotificationSubsystem import Wire.Sem.Now (Now) import Wire.StoredConversation diff --git a/services/galley/src/Galley/API/Action/Leave.hs b/services/galley/src/Galley/API/Action/Leave.hs index 8d717b9cccf..7d8f83cf2a0 100644 --- a/services/galley/src/Galley/API/Action/Leave.hs +++ b/services/galley/src/Galley/API/Action/Leave.hs @@ -21,7 +21,6 @@ import Control.Lens import Data.Id import Data.Qualified import Galley.API.MLS.Removal -import Galley.API.Util import Galley.Effects import Imports hiding ((\\)) import Polysemy @@ -30,6 +29,7 @@ import Polysemy.Input import Polysemy.TinyLog import Wire.API.Federation.Error import Wire.ConversationSubsystem.Interpreter (ConversationSubsystemConfig) +import Wire.ConversationSubsystem.Util import Wire.NotificationSubsystem import Wire.Sem.Now (Now) import Wire.StoredConversation diff --git a/services/galley/src/Galley/API/Action/Notify.hs b/services/galley/src/Galley/API/Action/Notify.hs index 2e65778f8bf..6ede2e2cc22 100644 --- a/services/galley/src/Galley/API/Action/Notify.hs +++ b/services/galley/src/Galley/API/Action/Notify.hs @@ -20,7 +20,6 @@ module Galley.API.Action.Notify where import Data.Id import Data.Qualified import Data.Singletons -import Galley.API.Util import Galley.Effects import Imports hiding ((\\)) import Polysemy @@ -28,6 +27,7 @@ import Wire.API.Conversation hiding (Conversation, Member) import Wire.API.Conversation.Action import Wire.API.Event.Conversation import Wire.ConversationSubsystem +import Wire.ConversationSubsystem.Util import Wire.NotificationSubsystem import Wire.StoredConversation diff --git a/services/galley/src/Galley/API/Action/Reset.hs b/services/galley/src/Galley/API/Action/Reset.hs index b483f293044..fd95b0cc16a 100644 --- a/services/galley/src/Galley/API/Action/Reset.hs +++ b/services/galley/src/Galley/API/Action/Reset.hs @@ -24,7 +24,6 @@ import Data.Id import Data.Qualified import Galley.API.Action.Kick import Galley.API.MLS.Util -import Galley.API.Util import Galley.Effects import Imports import Polysemy @@ -49,6 +48,7 @@ import Wire.API.VersionInfo import Wire.ConversationStore import Wire.ConversationSubsystem import Wire.ConversationSubsystem.Interpreter (ConversationSubsystemConfig) +import Wire.ConversationSubsystem.Util import Wire.FederationAPIAccess import Wire.NotificationSubsystem import Wire.Sem.Now (Now) diff --git a/services/galley/src/Galley/API/Clients.hs b/services/galley/src/Galley/API/Clients.hs index 60dae17eaaf..2a402c0f40b 100644 --- a/services/galley/src/Galley/API/Clients.hs +++ b/services/galley/src/Galley/API/Clients.hs @@ -25,14 +25,12 @@ import Data.Id import Data.Proxy import Data.Qualified import Data.Range -import Galley.API.Error import Galley.API.MLS.Removal import Galley.API.Query qualified as Query -import Galley.API.Util import Galley.Effects -import Galley.Effects.ClientStore qualified as E import Galley.Env import Galley.Types.Clients (clientIds) +import Galley.Types.Error import Imports import Network.AMQP qualified as Q import Polysemy @@ -48,6 +46,8 @@ import Wire.API.Routes.MultiTablePaging import Wire.BackendNotificationQueueAccess import Wire.ConversationStore (getConversation) import Wire.ConversationSubsystem.Interpreter (ConversationSubsystemConfig) +import Wire.ConversationSubsystem.Util +import Wire.Effects.ClientStore qualified as E import Wire.NotificationSubsystem import Wire.Sem.Now (Now) diff --git a/services/galley/src/Galley/API/Federation.hs b/services/galley/src/Galley/API/Federation.hs index 725117fe7f6..b47da28fcb6 100644 --- a/services/galley/src/Galley/API/Federation.hs +++ b/services/galley/src/Galley/API/Federation.hs @@ -37,7 +37,6 @@ import Data.Singletons (SingI (..), demote, sing) import Data.Tagged import Data.Text.Lazy qualified as LT import Galley.API.Action -import Galley.API.Error import Galley.API.MLS import Galley.API.MLS.Enabled import Galley.API.MLS.GroupInfo @@ -47,15 +46,13 @@ import Galley.API.MLS.Removal import Galley.API.MLS.SubConversation hiding (leaveSubConversation) import Galley.API.MLS.Util import Galley.API.MLS.Welcome -import Galley.API.Mapping -import Galley.API.Mapping qualified as Mapping import Galley.API.Message import Galley.API.Push -import Galley.API.Util import Galley.App import Galley.Effects import Galley.Options import Galley.Types.Conversations.One2One +import Galley.Types.Error import Imports import Network.Wai.Utilities.Exception import Polysemy @@ -97,6 +94,9 @@ import Wire.CodeStore import Wire.ConversationStore qualified as E import Wire.ConversationSubsystem import Wire.ConversationSubsystem.Interpreter (ConversationSubsystemConfig) +import Wire.ConversationSubsystem.Util +import Wire.ConversationSubsystem.View +import Wire.ConversationSubsystem.View qualified as Mapping import Wire.FeaturesConfigSubsystem import Wire.FireAndForget qualified as E import Wire.NotificationSubsystem diff --git a/services/galley/src/Galley/API/Internal.hs b/services/galley/src/Galley/API/Internal.hs index 7c50cd9d5ee..9e090d3e5e2 100644 --- a/services/galley/src/Galley/API/Internal.hs +++ b/services/galley/src/Galley/API/Internal.hs @@ -38,12 +38,9 @@ import Data.Singletons import Data.Time import Galley.API.Action import Galley.API.Clients qualified as Clients -import Galley.API.Create qualified as Create -import Galley.API.Error import Galley.API.LegalHold (unsetTeamLegalholdWhitelistedH) import Galley.API.LegalHold.Conflicts import Galley.API.MLS.Removal -import Galley.API.One2One import Galley.API.Public.Servant import Galley.API.Query qualified as Query import Galley.API.Teams @@ -51,15 +48,14 @@ import Galley.API.Teams qualified as Teams import Galley.API.Teams.Features import Galley.API.Teams.Features.Get import Galley.API.Update qualified as Update -import Galley.API.Util import Galley.App import Galley.Effects -import Galley.Effects.ClientStore import Galley.Effects.CustomBackendStore -import Galley.Env (FanoutLimit) import Galley.Monad import Galley.Options hiding (brig) import Galley.Queue qualified as Q +import Galley.Types.Error +import Galley.Types.Teams (FanoutLimit) import Imports hiding (head) import Network.AMQP qualified as Q import Polysemy @@ -93,7 +89,11 @@ import Wire.ConversationStore import Wire.ConversationStore qualified as E import Wire.ConversationStore.MLS.Types import Wire.ConversationSubsystem +import Wire.ConversationSubsystem.Create qualified as Create import Wire.ConversationSubsystem.Interpreter (ConversationSubsystemConfig) +import Wire.ConversationSubsystem.One2One +import Wire.ConversationSubsystem.Util +import Wire.Effects.ClientStore import Wire.FeaturesConfigSubsystem (FeaturesConfigSubsystem) import Wire.LegalHoldStore as LegalHoldStore import Wire.NotificationSubsystem diff --git a/services/galley/src/Galley/API/LegalHold.hs b/services/galley/src/Galley/API/LegalHold.hs index 2aa4a480886..60ffdfb2041 100644 --- a/services/galley/src/Galley/API/LegalHold.hs +++ b/services/galley/src/Galley/API/LegalHold.hs @@ -41,16 +41,15 @@ import Data.Misc import Data.Proxy (Proxy (Proxy)) import Data.Qualified import Data.Range (toRange) -import Galley.API.Error import Galley.API.LegalHold.Get import Galley.API.LegalHold.Team import Galley.API.Query (iterateConversations) import Galley.API.Update (removeMemberFromLocalConv) -import Galley.API.Util import Galley.App import Galley.Effects import Galley.Effects.TeamMemberStore import Galley.External.LegalHoldService qualified as LHService +import Galley.Types.Error import Galley.Types.Teams as Team import Imports import Network.HTTP.Types.Status (status200) @@ -80,6 +79,7 @@ import Wire.BrigAPIAccess import Wire.ConversationStore import Wire.ConversationSubsystem import Wire.ConversationSubsystem.Interpreter (ConversationSubsystemConfig) +import Wire.ConversationSubsystem.Util import Wire.FireAndForget import Wire.LegalHoldStore qualified as LegalHoldData import Wire.NotificationSubsystem diff --git a/services/galley/src/Galley/API/LegalHold/Conflicts.hs b/services/galley/src/Galley/API/LegalHold/Conflicts.hs index 705d3b2f28a..59eea597008 100644 --- a/services/galley/src/Galley/API/LegalHold/Conflicts.hs +++ b/services/galley/src/Galley/API/LegalHold/Conflicts.hs @@ -33,7 +33,6 @@ import Data.Map qualified as Map import Data.Misc import Data.Qualified import Data.Set qualified as Set -import Galley.API.Util import Galley.Effects import Galley.Options import Galley.Types.Teams @@ -49,6 +48,7 @@ import Wire.API.Team.Member import Wire.API.User import Wire.API.User.Client as Client import Wire.BrigAPIAccess +import Wire.ConversationSubsystem.Util import Wire.TeamSubsystem (TeamSubsystem) import Wire.TeamSubsystem qualified as TeamSubsystem diff --git a/services/galley/src/Galley/API/LegalHold/Get.hs b/services/galley/src/Galley/API/LegalHold/Get.hs index e6ac3379fac..37c90544250 100644 --- a/services/galley/src/Galley/API/LegalHold/Get.hs +++ b/services/galley/src/Galley/API/LegalHold/Get.hs @@ -22,8 +22,8 @@ import Data.ByteString.Conversion (toByteString') import Data.Id import Data.LegalHold (UserLegalHoldStatus (..)) import Data.Qualified -import Galley.API.Error import Galley.Effects +import Galley.Types.Error import Imports import Polysemy import Polysemy.Error diff --git a/services/galley/src/Galley/API/LegalHold/Team.hs b/services/galley/src/Galley/API/LegalHold/Team.hs index 977fcfb2918..aaaacd6296e 100644 --- a/services/galley/src/Galley/API/LegalHold/Team.hs +++ b/services/galley/src/Galley/API/LegalHold/Team.hs @@ -27,8 +27,7 @@ where import Data.Id import Data.Range import Galley.Effects -import Galley.Env -import Galley.Types.Teams as Team +import Galley.Types.Teams as Team (FanoutLimit, FeatureDefaults (..)) import Imports import Polysemy import Polysemy.Input (Input, input) diff --git a/services/galley/src/Galley/API/MLS.hs b/services/galley/src/Galley/API/MLS.hs index 7a83ac92146..0d0d5abe601 100644 --- a/services/galley/src/Galley/API/MLS.hs +++ b/services/galley/src/Galley/API/MLS.hs @@ -27,10 +27,10 @@ module Galley.API.MLS where import Data.Default -import Galley.API.Error import Galley.API.MLS.Enabled import Galley.API.MLS.Message import Galley.Env +import Galley.Types.Error import Imports import Polysemy import Polysemy.Error diff --git a/services/galley/src/Galley/API/MLS/Commit/Core.hs b/services/galley/src/Galley/API/MLS/Commit/Core.hs index 966693c5940..6b3a49b4779 100644 --- a/services/galley/src/Galley/API/MLS/Commit/Core.hs +++ b/services/galley/src/Galley/API/MLS/Commit/Core.hs @@ -31,13 +31,13 @@ where import Control.Comonad import Data.Id import Data.Qualified -import Galley.API.Error import Galley.API.MLS.Conversation import Galley.API.MLS.IncomingMessage import Galley.API.MLS.Proposal import Galley.Effects import Galley.Env import Galley.Options +import Galley.Types.Error import Imports import Polysemy import Polysemy.Error diff --git a/services/galley/src/Galley/API/MLS/Commit/InternalCommit.hs b/services/galley/src/Galley/API/MLS/Commit/InternalCommit.hs index ac15b43399f..06d8270ac78 100644 --- a/services/galley/src/Galley/API/MLS/Commit/InternalCommit.hs +++ b/services/galley/src/Galley/API/MLS/Commit/InternalCommit.hs @@ -30,7 +30,6 @@ import Data.Qualified import Data.Set qualified as Set import Data.Tuple.Extra import Galley.API.Action -import Galley.API.Error import Galley.API.MLS.CheckClients import Galley.API.MLS.Commit.Core import Galley.API.MLS.Conversation @@ -38,8 +37,8 @@ import Galley.API.MLS.IncomingMessage import Galley.API.MLS.One2One import Galley.API.MLS.Proposal import Galley.API.MLS.Util -import Galley.API.Util import Galley.Effects +import Galley.Types.Error import Imports import Polysemy import Polysemy.Error @@ -62,6 +61,7 @@ import Wire.ConversationStore import Wire.ConversationStore.MLS.Types import Wire.ConversationSubsystem import Wire.ConversationSubsystem.Interpreter (ConversationSubsystemConfig) +import Wire.ConversationSubsystem.Util import Wire.ProposalStore import Wire.StoredConversation import Wire.TeamSubsystem (TeamSubsystem) diff --git a/services/galley/src/Galley/API/MLS/GroupInfo.hs b/services/galley/src/Galley/API/MLS/GroupInfo.hs index a10870a306e..f09a21db861 100644 --- a/services/galley/src/Galley/API/MLS/GroupInfo.hs +++ b/services/galley/src/Galley/API/MLS/GroupInfo.hs @@ -22,7 +22,6 @@ import Data.Json.Util import Data.Qualified import Galley.API.MLS.Enabled import Galley.API.MLS.Util -import Galley.API.Util import Galley.Effects import Galley.Env import Imports @@ -38,6 +37,7 @@ import Wire.API.Federation.Error import Wire.API.MLS.GroupInfo import Wire.API.MLS.SubConversation import Wire.ConversationStore qualified as E +import Wire.ConversationSubsystem.Util import Wire.FederationAPIAccess qualified as E type MLSGroupInfoStaticErrors = diff --git a/services/galley/src/Galley/API/MLS/Message.hs b/services/galley/src/Galley/API/MLS/Message.hs index 8ca29cac361..074e6d4d9c3 100644 --- a/services/galley/src/Galley/API/MLS/Message.hs +++ b/services/galley/src/Galley/API/MLS/Message.hs @@ -41,7 +41,6 @@ import Data.Tagged import Data.Text.Lazy qualified as LT import Data.Tuple.Extra import Galley.API.Action -import Galley.API.Error import Galley.API.LegalHold.Get (getUserStatus) import Galley.API.MLS.Commit.Core (getCommitData) import Galley.API.MLS.Commit.ExternalCommit @@ -56,8 +55,8 @@ import Galley.API.MLS.Propagate import Galley.API.MLS.Proposal import Galley.API.MLS.Util import Galley.API.MLS.Welcome (sendWelcomes) -import Galley.API.Util import Galley.Effects +import Galley.Types.Error import Imports import Polysemy import Polysemy.Error @@ -89,6 +88,7 @@ import Wire.ConversationStore import Wire.ConversationStore.MLS.Types import Wire.ConversationSubsystem import Wire.ConversationSubsystem.Interpreter (ConversationSubsystemConfig) +import Wire.ConversationSubsystem.Util import Wire.FeaturesConfigSubsystem import Wire.FederationAPIAccess import Wire.NotificationSubsystem diff --git a/services/galley/src/Galley/API/MLS/Proposal.hs b/services/galley/src/Galley/API/MLS/Proposal.hs index 68dc6a0a7a4..302a962338d 100644 --- a/services/galley/src/Galley/API/MLS/Proposal.hs +++ b/services/galley/src/Galley/API/MLS/Proposal.hs @@ -38,12 +38,11 @@ import Data.Id import Data.Map qualified as Map import Data.Qualified import Data.Set qualified as Set -import Galley.API.Error import Galley.API.MLS.IncomingMessage -import Galley.API.Util import Galley.Effects import Galley.Env import Galley.Options +import Galley.Types.Error import Imports import Polysemy import Polysemy.Error @@ -69,6 +68,7 @@ import Wire.API.MLS.Validation.Error (toText) import Wire.API.Message import Wire.BrigAPIAccess import Wire.ConversationStore.MLS.Types +import Wire.ConversationSubsystem.Util import Wire.NotificationSubsystem import Wire.ProposalStore import Wire.Sem.Now (Now) diff --git a/services/galley/src/Galley/API/MLS/Reset.hs b/services/galley/src/Galley/API/MLS/Reset.hs index 5d9515c9722..d9b6abc0674 100644 --- a/services/galley/src/Galley/API/MLS/Reset.hs +++ b/services/galley/src/Galley/API/MLS/Reset.hs @@ -20,12 +20,12 @@ module Galley.API.MLS.Reset (resetMLSConversation) where import Data.Id import Data.Qualified import Galley.API.Action -import Galley.API.Error import Galley.API.MLS.Enabled import Galley.API.MLS.Util import Galley.API.Update import Galley.Effects import Galley.Env +import Galley.Types.Error import Imports import Polysemy import Polysemy.Error diff --git a/services/galley/src/Galley/API/MLS/SubConversation.hs b/services/galley/src/Galley/API/MLS/SubConversation.hs index 8d45dfc410c..c066a009af2 100644 --- a/services/galley/src/Galley/API/MLS/SubConversation.hs +++ b/services/galley/src/Galley/API/MLS/SubConversation.hs @@ -40,7 +40,6 @@ import Galley.API.MLS.Conversation import Galley.API.MLS.GroupInfo import Galley.API.MLS.Removal import Galley.API.MLS.Util -import Galley.API.Util import Galley.App (Env) import Galley.Effects import Imports @@ -66,6 +65,7 @@ import Wire.API.Routes.Public.Galley.MLS import Wire.ConversationStore qualified as Eff import Wire.ConversationStore.MLS.Types as Eff import Wire.ConversationSubsystem.Interpreter (ConversationSubsystemConfig) +import Wire.ConversationSubsystem.Util import Wire.FederationAPIAccess import Wire.NotificationSubsystem import Wire.Sem.Now (Now) diff --git a/services/galley/src/Galley/API/Message.hs b/services/galley/src/Galley/API/Message.hs index 6ca08e514d0..4fd9135e4ca 100644 --- a/services/galley/src/Galley/API/Message.hs +++ b/services/galley/src/Galley/API/Message.hs @@ -51,12 +51,10 @@ import Data.Set.Lens import Data.Time.Clock (UTCTime) import Galley.API.LegalHold.Conflicts import Galley.API.Push -import Galley.API.Util import Galley.Effects -import Galley.Effects.ClientStore -import Galley.Env import Galley.Options import Galley.Types.Clients qualified as Clients +import Galley.Types.Teams (FanoutLimit) import Imports hiding (forkIO) import Network.AMQP qualified as Q import Polysemy hiding (send) @@ -82,6 +80,8 @@ import Wire.API.UserMap (UserMap (..)) import Wire.BackendNotificationQueueAccess import Wire.BrigAPIAccess import Wire.ConversationStore +import Wire.ConversationSubsystem.Util +import Wire.Effects.ClientStore import Wire.FederationAPIAccess import Wire.NotificationSubsystem (NotificationSubsystem) import Wire.Sem.Now (Now) diff --git a/services/galley/src/Galley/API/Public/Conversation.hs b/services/galley/src/Galley/API/Public/Conversation.hs index 724dd81c240..aa05d3bc25a 100644 --- a/services/galley/src/Galley/API/Public/Conversation.hs +++ b/services/galley/src/Galley/API/Public/Conversation.hs @@ -17,7 +17,6 @@ module Galley.API.Public.Conversation where -import Galley.API.Create import Galley.API.MLS.GroupInfo import Galley.API.MLS.SubConversation import Galley.API.Query @@ -27,6 +26,7 @@ import Imports import Wire.API.Routes.API import Wire.API.Routes.Public.Galley.Conversation import Wire.ConversationStore.MLS.Types +import Wire.ConversationSubsystem.Create conversationAPI :: API ConversationAPI GalleyEffects conversationAPI = diff --git a/services/galley/src/Galley/API/Query.hs b/services/galley/src/Galley/API/Query.hs index ee61bf748a4..94ecae59804 100644 --- a/services/galley/src/Galley/API/Query.hs +++ b/services/galley/src/Galley/API/Query.hs @@ -66,17 +66,13 @@ import Data.Qualified import Data.Range import Data.Set qualified as Set import Data.Tagged -import Galley.API.Error import Galley.API.MLS import Galley.API.MLS.Enabled import Galley.API.MLS.One2One -import Galley.API.Mapping -import Galley.API.Mapping qualified as Mapping -import Galley.API.One2One import Galley.API.Teams.Features.Get -import Galley.API.Util import Galley.Effects import Galley.Env +import Galley.Types.Error import Imports import Polysemy import Polysemy.Error @@ -110,6 +106,10 @@ import Wire.CodeStore.Code (Code (codeConversation)) import Wire.CodeStore.Code qualified as Data import Wire.ConversationStore qualified as E import Wire.ConversationStore.MLS.Types +import Wire.ConversationSubsystem.One2One +import Wire.ConversationSubsystem.Util +import Wire.ConversationSubsystem.View +import Wire.ConversationSubsystem.View qualified as Mapping import Wire.FeaturesConfigSubsystem import Wire.FederationAPIAccess qualified as E import Wire.HashPassword (HashPassword) @@ -788,6 +788,7 @@ getMLSOne2OneConversationV5 lself qother = do else throwS @MLSFederatedOne2OneNotSupported getMLSOne2OneConversationInternal :: + forall r. ( Member BrigAPIAccess r, Member ConversationStore r, Member (Input Env) r, @@ -808,6 +809,7 @@ getMLSOne2OneConversationInternal lself qother = (.conversation) <$> getMLSOne2OneConversation lself qother Nothing getMLSOne2OneConversationV6 :: + forall r. ( Member BrigAPIAccess r, Member ConversationStore r, Member (Input Env) r, diff --git a/services/galley/src/Galley/API/Teams.hs b/services/galley/src/Galley/API/Teams.hs index 2ac49386349..35a1ea18cf8 100644 --- a/services/galley/src/Galley/API/Teams.hs +++ b/services/galley/src/Galley/API/Teams.hs @@ -77,19 +77,17 @@ import Data.Set qualified as Set import Data.Singletons import Data.Time.Clock (UTCTime) import Galley.API.Action -import Galley.API.Error as Galley import Galley.API.LegalHold.Team import Galley.API.Teams.Features.Get import Galley.API.Teams.Notifications qualified as APITeamQueue import Galley.API.Update qualified as API -import Galley.API.Util import Galley.App import Galley.Effects import Galley.Effects.Queue qualified as E import Galley.Effects.SearchVisibilityStore qualified as SearchVisibilityData import Galley.Effects.TeamMemberStore qualified as E -import Galley.Env import Galley.Options +import Galley.Types.Error as Galley import Galley.Types.Teams import Imports hiding (forkIO) import Polysemy @@ -132,6 +130,7 @@ import Wire.CodeStore import Wire.ConversationStore qualified as E import Wire.ConversationSubsystem import Wire.ConversationSubsystem.Interpreter (ConversationSubsystemConfig) +import Wire.ConversationSubsystem.Util import Wire.FeaturesConfigSubsystem import Wire.ListItems qualified as E import Wire.NotificationSubsystem diff --git a/services/galley/src/Galley/API/Teams/Features.hs b/services/galley/src/Galley/API/Teams/Features.hs index 4c9bf4b9797..23e9c3016e7 100644 --- a/services/galley/src/Galley/API/Teams/Features.hs +++ b/services/galley/src/Galley/API/Teams/Features.hs @@ -41,16 +41,14 @@ import Data.Id import Data.Json.Util import Data.Kind import Data.Qualified (Local) -import Galley.API.Error (InternalError) import Galley.API.LegalHold qualified as LegalHold import Galley.API.LegalHold.Team qualified as LegalHold import Galley.API.Teams.Features.Get -import Galley.API.Util (assertTeamExists, getTeamMembersForFanout, permissionCheck) import Galley.App import Galley.Effects import Galley.Effects.SearchVisibilityStore qualified as SearchVisibilityData -import Galley.Env (FanoutLimit) import Galley.Options +import Galley.Types.Error (InternalError) import Galley.Types.Teams import Imports import Polysemy @@ -71,6 +69,7 @@ import Wire.CodeStore import Wire.ConversationStore (MLSCommitLockStore) import Wire.ConversationSubsystem import Wire.ConversationSubsystem.Interpreter (ConversationSubsystemConfig) +import Wire.ConversationSubsystem.Util (assertTeamExists, getTeamMembersForFanout, permissionCheck) import Wire.FeaturesConfigSubsystem (FeaturesConfigSubsystem) import Wire.FeaturesConfigSubsystem.Types (GetFeatureConfigEffects) import Wire.FeaturesConfigSubsystem.Utils (resolveServerFeature) diff --git a/services/galley/src/Galley/API/Teams/Features/Get.hs b/services/galley/src/Galley/API/Teams/Features/Get.hs index ece1922543c..88892545f81 100644 --- a/services/galley/src/Galley/API/Teams/Features/Get.hs +++ b/services/galley/src/Galley/API/Teams/Features/Get.hs @@ -37,7 +37,6 @@ import Control.Error (hush) import Data.Id import Data.SOP import Data.Tagged -import Galley.API.Util import Galley.Effects import Imports import Polysemy @@ -48,6 +47,7 @@ import Wire.API.Error.Galley import Wire.API.Routes.Internal.Galley.TeamFeatureNoConfigMulti qualified as Multi import Wire.API.Team.Feature import Wire.ConversationStore as ConversationStore +import Wire.ConversationSubsystem.Util import Wire.FeaturesConfigSubsystem import Wire.FeaturesConfigSubsystem.Types import Wire.TeamFeatureStore diff --git a/services/galley/src/Galley/API/Update.hs b/services/galley/src/Galley/API/Update.hs index fd4e4606b8a..f0d8bb0826d 100644 --- a/services/galley/src/Galley/API/Update.hs +++ b/services/galley/src/Galley/API/Update.hs @@ -91,17 +91,14 @@ import Data.Singletons import Data.Vector qualified as V import Galley.API.Action import Galley.API.Action.Kick (kickMember) -import Galley.API.Error -import Galley.API.Mapping import Galley.API.Message import Galley.API.Query qualified as Query import Galley.API.Teams.Features.Get -import Galley.API.Util import Galley.App import Galley.Effects -import Galley.Effects.ClientStore qualified as E -import Galley.Env import Galley.Options +import Galley.Types.Error +import Galley.Types.Teams (FanoutLimit) import Imports hiding (forkIO) import Polysemy import Polysemy.Error @@ -138,6 +135,9 @@ import Wire.CodeStore.Code import Wire.ConversationStore qualified as E import Wire.ConversationSubsystem import Wire.ConversationSubsystem.Interpreter (ConversationSubsystemConfig) +import Wire.ConversationSubsystem.Util +import Wire.ConversationSubsystem.View +import Wire.Effects.ClientStore qualified as E import Wire.ExternalAccess qualified as E import Wire.FeaturesConfigSubsystem import Wire.FederationAPIAccess qualified as E diff --git a/services/galley/src/Galley/App.hs b/services/galley/src/Galley/App.hs index 2035a64c1cf..611814c3563 100644 --- a/services/galley/src/Galley/App.hs +++ b/services/galley/src/Galley/App.hs @@ -52,7 +52,6 @@ import Data.Misc import Data.Qualified import Data.Range import Data.Text qualified as Text -import Galley.API.Error import Galley.Cassandra.Client import Galley.Cassandra.CustomBackend import Galley.Cassandra.SearchVisibility @@ -72,6 +71,7 @@ import Galley.Options hiding (brig, endpoint, federator) import Galley.Options qualified as O import Galley.Queue import Galley.Queue qualified as Q +import Galley.Types.Error import Galley.Types.Teams import HTTP2.Client.Manager (Http2Manager, http2ManagerWithSSLCtx) import Hasql.Pool qualified as Hasql diff --git a/services/galley/src/Galley/Cassandra/Client.hs b/services/galley/src/Galley/Cassandra/Client.hs index bc37fece531..57f8f8f9025 100644 --- a/services/galley/src/Galley/Cassandra/Client.hs +++ b/services/galley/src/Galley/Cassandra/Client.hs @@ -29,7 +29,6 @@ import Data.List.Split (chunksOf) import Galley.Cassandra.Queries qualified as Cql import Galley.Cassandra.Store import Galley.Cassandra.Util -import Galley.Effects.ClientStore (ClientStore (..)) import Galley.Env import Galley.Monad import Galley.Options @@ -40,6 +39,7 @@ import Polysemy import Polysemy.Input import Polysemy.TinyLog import UnliftIO qualified +import Wire.Effects.ClientStore (ClientStore (..)) updateClient :: Bool -> UserId -> ClientId -> Client () updateClient add usr cls = do diff --git a/services/galley/src/Galley/Effects.hs b/services/galley/src/Galley/Effects.hs index af09983856f..a401fffb157 100644 --- a/services/galley/src/Galley/Effects.hs +++ b/services/galley/src/Galley/Effects.hs @@ -64,7 +64,6 @@ import Data.Map (Map) import Data.Misc (HttpsUrl) import Data.Qualified import Data.Text (Text) -import Galley.Effects.ClientStore import Galley.Effects.CustomBackendStore import Galley.Effects.Queue import Galley.Effects.SearchVisibilityStore @@ -86,6 +85,7 @@ import Wire.BrigAPIAccess import Wire.CodeStore import Wire.ConversationStore (ConversationStore, MLSCommitLockStore) import Wire.ConversationSubsystem +import Wire.Effects.ClientStore import Wire.ExternalAccess import Wire.FeaturesConfigSubsystem (FeaturesConfigSubsystem) import Wire.FeaturesConfigSubsystem.Types (ExposeInvitationURLsAllowlist) diff --git a/services/galley/src/Galley/Env.hs b/services/galley/src/Galley/Env.hs index f9b8400d930..1bc0c4e778d 100644 --- a/services/galley/src/Galley/Env.hs +++ b/services/galley/src/Galley/Env.hs @@ -29,6 +29,7 @@ import Data.Time.Clock.DiffTime (millisecondsToDiffTime) import Galley.Options import Galley.Options qualified as O import Galley.Queue qualified as Q +import Galley.Types.Teams (FanoutLimit) import HTTP2.Client.Manager (Http2Manager) import Hasql.Pool import Imports @@ -37,7 +38,6 @@ import Network.HTTP.Client import System.Logger import Util.Options import Wire.API.MLS.Keys -import Wire.API.Team.Member import Wire.AWS qualified as Aws import Wire.ExternalAccess.External import Wire.NotificationSubsystem.Interpreter @@ -46,8 +46,6 @@ import Wire.RateLimit.Interpreter (RateLimitEnv) data DeleteItem = TeamItem TeamId UserId (Maybe ConnId) deriving (Eq, Ord, Show) -type FanoutLimit = Range 1 HardTruncationLimit Int32 - -- | Main application environment. data Env = Env { _reqId :: RequestId, diff --git a/services/galley/src/Galley/External/LegalHoldService/Internal.hs b/services/galley/src/Galley/External/LegalHoldService/Internal.hs index eac3a0d0100..6834a6426ab 100644 --- a/services/galley/src/Galley/External/LegalHoldService/Internal.hs +++ b/services/galley/src/Galley/External/LegalHoldService/Internal.hs @@ -29,9 +29,9 @@ import Control.Retry import Data.ByteString qualified as BS import Data.ByteString.Lazy.Char8 qualified as LC8 import Data.Misc -import Galley.API.Error import Galley.Env import Galley.Monad +import Galley.Types.Error import Imports import Network.HTTP.Client qualified as Http import OpenSSL.Session qualified as SSL diff --git a/services/galley/src/Galley/Validation.hs b/services/galley/src/Galley/Validation.hs deleted file mode 100644 index 7d045d21026..00000000000 --- a/services/galley/src/Galley/Validation.hs +++ /dev/null @@ -1,71 +0,0 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving #-} - --- 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.Validation - ( rangeChecked, - rangeCheckedMaybe, - fromConvSize, - ConvSizeChecked, - checkedConvSize, - ) -where - -import Control.Lens -import Data.Range -import GHC.TypeNats -import Galley.API.Error -import Galley.Options -import Imports -import Polysemy -import Polysemy.Error - -rangeChecked :: (KnownNat n, KnownNat m, Member (Error InvalidInput) r, Within a n m) => a -> Sem r (Range n m a) -rangeChecked = either throwErr pure . checkedEither -{-# INLINE rangeChecked #-} - -rangeCheckedMaybe :: - (Member (Error InvalidInput) r, KnownNat n, KnownNat m, Within a n m) => - Maybe a -> - Sem r (Maybe (Range n m a)) -rangeCheckedMaybe Nothing = pure Nothing -rangeCheckedMaybe (Just a) = Just <$> rangeChecked a -{-# INLINE rangeCheckedMaybe #-} - --- Between 0 and (setMaxConvSize - 1) -newtype ConvSizeChecked f a = ConvSizeChecked {fromConvSize :: f a} - deriving (Functor, Foldable, Traversable) - -deriving newtype instance (Semigroup (f a)) => Semigroup (ConvSizeChecked f a) - -deriving newtype instance (Monoid (f a)) => Monoid (ConvSizeChecked f a) - -checkedConvSize :: - (Member (Error InvalidInput) r, Foldable f) => - Opts -> - f a -> - Sem r (ConvSizeChecked f a) -checkedConvSize o x = do - let minV :: Integer = 0 - limit = o ^. settings . maxConvSize - 1 - if length x <= fromIntegral limit - then pure (ConvSizeChecked x) - else throwErr (errorMsg minV limit "") - -throwErr :: (Member (Error InvalidInput) r) => String -> Sem r a -throwErr = throw . InvalidRange . fromString diff --git a/services/galley/test/integration/API.hs b/services/galley/test/integration/API.hs index 313f11f0f55..f527d520caf 100644 --- a/services/galley/test/integration/API.hs +++ b/services/galley/test/integration/API.hs @@ -66,7 +66,6 @@ import Data.Text.Ascii qualified as Ascii import Data.Time.Clock (getCurrentTime) import Federator.Discovery (DiscoveryFailure (..)) import Federator.MockServer hiding (status) -import Galley.API.Mapping import Galley.Options (federator, rabbitmq) import Imports hiding (id) import Imports qualified as I @@ -105,6 +104,7 @@ import Wire.API.Team.Member qualified as Teams import Wire.API.User import Wire.API.User.Client import Wire.API.UserMap (UserMap (..)) +import Wire.ConversationSubsystem.View import Wire.StoredConversation hiding (convName) tests :: IO TestSetup -> TestTree diff --git a/services/galley/test/integration/Federation.hs b/services/galley/test/integration/Federation.hs index 5b5a2cd69fe..281a8fca9cb 100644 --- a/services/galley/test/integration/Federation.hs +++ b/services/galley/test/integration/Federation.hs @@ -22,7 +22,6 @@ import Data.Domain import Data.Id import Data.Qualified import Data.UUID qualified as UUID -import Galley.API.Util import Galley.App import Galley.Options import Imports @@ -31,6 +30,7 @@ import TestSetup import Wire.API.Conversation import Wire.API.Conversation.Protocol (Protocol (..)) import Wire.API.Conversation.Role (roleNameWireMember) +import Wire.ConversationSubsystem.Util import Wire.StoredConversation isConvMemberLTests :: TestM () diff --git a/services/galley/test/unit/Test/Galley/API/One2One.hs b/services/galley/test/unit/Test/Galley/API/One2One.hs index 9a93da22743..88a0df0ff57 100644 --- a/services/galley/test/unit/Test/Galley/API/One2One.hs +++ b/services/galley/test/unit/Test/Galley/API/One2One.hs @@ -21,12 +21,12 @@ module Test.Galley.API.One2One where import Data.Id import Data.List.Extra import Data.Qualified -import Galley.API.One2One (one2OneConvId) import Imports import Test.Tasty import Test.Tasty.HUnit (Assertion, testCase, (@?=)) import Test.Tasty.QuickCheck import Wire.API.User +import Wire.ConversationSubsystem.One2One (one2OneConvId) tests :: TestTree tests = diff --git a/services/galley/test/unit/Test/Galley/Mapping.hs b/services/galley/test/unit/Test/Galley/Mapping.hs index d8e36e1ad91..722f6525582 100644 --- a/services/galley/test/unit/Test/Galley/Mapping.hs +++ b/services/galley/test/unit/Test/Galley/Mapping.hs @@ -25,8 +25,7 @@ import Data.Domain import Data.Id import Data.Qualified import Data.Set qualified as Set -import Galley.API.Error (InternalError) -import Galley.API.Mapping +import Galley.Types.Error (InternalError) import Imports import Polysemy (Sem) import Polysemy qualified as P @@ -41,6 +40,7 @@ import Wire.API.Federation.API.Galley ( RemoteConvMembers (..), RemoteConversationV2 (..), ) +import Wire.ConversationSubsystem.View import Wire.Sem.Logger qualified as P import Wire.StoredConversation