diff --git a/changelog.d/0-release-notes/WPB-20728 b/changelog.d/0-release-notes/WPB-20728 new file mode 100644 index 0000000000..24d528fbf8 --- /dev/null +++ b/changelog.d/0-release-notes/WPB-20728 @@ -0,0 +1,15 @@ +Background-worker configuration: required values when supplying your own Helm values + +Add the following fields under `background-worker`: + +- `config.domain` +- `config.postgresql` +- `config.cassandraBrig` +- `config.cassandraGalley` +- `secrets.pgPassword` + +Notes +- `config.cassandra` (for gundeck) already exists; no change needed. +- `config.backgroundJobs` and `config.postgresqlPool` have defaults; override only if needed. +- `config.postgresMigration.conversation` defaults to `postgresql`; change only if migrating conversations to PostgreSQL. +- `config.brig` and `config.gundeck` endpoints have in-cluster defaults; override only if your service DNS/ports differ. diff --git a/changelog.d/2-features/WPB-20728 b/changelog.d/2-features/WPB-20728 new file mode 100644 index 0000000000..24cbff570d --- /dev/null +++ b/changelog.d/2-features/WPB-20728 @@ -0,0 +1 @@ +Add users of user groups to a channel in asynchronous background worker job diff --git a/charts/background-worker/README.md b/charts/background-worker/README.md index 55e379a4ed..b3ef345c5f 100644 --- a/charts/background-worker/README.md +++ b/charts/background-worker/README.md @@ -1,5 +1,21 @@ -Note that background-worker depends on some provisioned storage, namely: +Note that background-worker depends on some provisioned storage/services, namely: - rabbitmq +- postgresql +- cassandra (three clusters) + +PostgreSQL configuration +- Set connection parameters under `config.postgresql` (libpq keywords: `host`, `port`, `user`, `dbname`, etc.). +- Provide the password via `secrets.pgPassword`; it is mounted at `/etc/wire/background-worker/secrets/pgPassword` and referenced from the configmap. + +Cassandra configuration +- Background-worker connects to three Cassandra clusters: + - `config.cassandra` (keyspace: `gundeck`) for the dead user notification watcher. + - `config.cassandraBrig` (keyspace: `brig`) for the user store. + - `config.cassandraGalley` (keyspace: `galley`) for conversation-related data access. +- TLS may be configured via either a reference (`tlsCaSecretRef`) or inline CA (`tlsCa`) for each cluster. Secrets mount under: + - `/etc/wire/background-worker/cassandra-gundeck` + - `/etc/wire/background-worker/cassandra-brig` + - `/etc/wire/background-worker/cassandra-galley` These are dealt with independently from this chart. diff --git a/charts/background-worker/templates/_helpers.tpl b/charts/background-worker/templates/_helpers.tpl index 96bf8dd1b8..ec6e25f5f4 100644 --- a/charts/background-worker/templates/_helpers.tpl +++ b/charts/background-worker/templates/_helpers.tpl @@ -8,18 +8,38 @@ {{- (semverCompare ">= 1.24-0" (include "kubeVersion" .)) -}} {{- end -}} -{{- define "useCassandraTLS" -}} +{{- define "useGundeckCassandraTLS" -}} {{ or (hasKey .cassandra "tlsCa") (hasKey .cassandra "tlsCaSecretRef") }} {{- end -}} -{{/* Return a Dict of TLS CA secret name and key -This is used to switch between provided secret (e.g. by cert-manager) and -created one (in case the CA is provided as PEM string.) -*/}} -{{- define "tlsSecretRef" -}} +{{- define "useBrigCassandraTLS" -}} +{{ or (hasKey .cassandraBrig "tlsCa") (hasKey .cassandraBrig "tlsCaSecretRef") }} +{{- end -}} + +{{- define "useGalleyCassandraTLS" -}} +{{ or (hasKey .cassandraGalley "tlsCa") (hasKey .cassandraGalley "tlsCaSecretRef") }} +{{- end -}} + +{{- define "gundeckTlsSecretRef" -}} {{- if .cassandra.tlsCaSecretRef -}} {{ .cassandra.tlsCaSecretRef | toYaml }} {{- else }} -{{- dict "name" "background-worker-cassandra" "key" "ca.pem" | toYaml -}} +{{- dict "name" "background-worker-cassandra-gundeck" "key" "ca.pem" | toYaml -}} +{{- end -}} +{{- end -}} + +{{- define "brigTlsSecretRef" -}} +{{- if .cassandraBrig.tlsCaSecretRef -}} +{{ .cassandraBrig.tlsCaSecretRef | toYaml }} +{{- else }} +{{- dict "name" "background-worker-cassandra-brig" "key" "ca.pem" | toYaml -}} +{{- end -}} +{{- end -}} + +{{- define "galleyTlsSecretRef" -}} +{{- if and .cassandraGalley .cassandraGalley.tlsCaSecretRef -}} +{{ .cassandraGalley.tlsCaSecretRef | toYaml }} +{{- else }} +{{- dict "name" "background-worker-cassandra-galley" "key" "ca.pem" | toYaml -}} {{- end -}} {{- end -}} diff --git a/charts/background-worker/templates/cassandra-secret.yaml b/charts/background-worker/templates/cassandra-secret.yaml index d5d9c61dfc..158d75ea54 100644 --- a/charts/background-worker/templates/cassandra-secret.yaml +++ b/charts/background-worker/templates/cassandra-secret.yaml @@ -1,9 +1,9 @@ -{{/* Secret for the provided Cassandra TLS CA. */}} +{{/* Secrets for provided Cassandra TLS CAs */}} {{- if not (empty .Values.config.cassandra.tlsCa) }} apiVersion: v1 kind: Secret metadata: - name: background-worker-cassandra + name: background-worker-cassandra-gundeck labels: app: background-worker chart: {{ .Chart.Name }}-{{ .Chart.Version | replace "+" "_" }} @@ -13,3 +13,33 @@ type: Opaque data: ca.pem: {{ .Values.config.cassandra.tlsCa | b64enc | quote }} {{- end }} +{{- if not (empty .Values.config.cassandraBrig.tlsCa) }} +--- +apiVersion: v1 +kind: Secret +metadata: + name: background-worker-cassandra-brig + labels: + app: background-worker + chart: {{ .Chart.Name }}-{{ .Chart.Version | replace "+" "_" }} + release: "{{ .Release.Name }}" + heritage: "{{ .Release.Service }}" +type: Opaque +data: + ca.pem: {{ .Values.config.cassandraBrig.tlsCa | b64enc | quote }} +{{- end }} +{{- if and .Values.config.cassandraGalley (not (empty .Values.config.cassandraGalley.tlsCa)) }} +--- +apiVersion: v1 +kind: Secret +metadata: + name: background-worker-cassandra-galley + labels: + app: background-worker + chart: {{ .Chart.Name }}-{{ .Chart.Version | replace "+" "_" }} + release: "{{ .Release.Name }}" + heritage: "{{ .Release.Service }}" +type: Opaque +data: + ca.pem: {{ .Values.config.cassandraGalley.tlsCa | b64enc | quote }} +{{- end }} diff --git a/charts/background-worker/templates/configmap.yaml b/charts/background-worker/templates/configmap.yaml index 1a0e37e609..b2521c72f0 100644 --- a/charts/background-worker/templates/configmap.yaml +++ b/charts/background-worker/templates/configmap.yaml @@ -21,15 +21,43 @@ data: host: federator port: 8080 + brig: + host: brig + port: 8080 + + gundeck: + host: gundeck + port: 8080 + cassandra: endpoint: host: {{ .cassandra.host }} port: 9042 keyspace: gundeck - {{- if eq (include "useCassandraTLS" .) "true" }} - tlsCa: /etc/wire/background-worker/cassandra/{{- (include "tlsSecretRef" . | fromYaml).key }} + {{- if eq (include "useGundeckCassandraTLS" .) "true" }} + tlsCa: /etc/wire/background-worker/cassandra-gundeck/{{- (include "gundeckTlsSecretRef" . | fromYaml).key }} + {{- end }} + + cassandraBrig: + endpoint: + host: {{ .cassandraBrig.host }} + port: 9042 + keyspace: brig + {{- if eq (include "useBrigCassandraTLS" .) "true" }} + tlsCa: /etc/wire/background-worker/cassandra-brig/{{- (include "brigTlsSecretRef" . | fromYaml).key }} {{- end }} + cassandraGalley: + endpoint: + host: {{ .cassandraGalley.host }} + port: 9042 + keyspace: galley + {{- if eq (include "useGalleyCassandraTLS" .) "true" }} + tlsCa: /etc/wire/background-worker/cassandra-galley/{{- (include "galleyTlsSecretRef" . | fromYaml).key }} + {{- end }} + + domain: {{ .Values.domain }} + {{- with .rabbitmq }} rabbitmq: host: {{ .host }} @@ -48,4 +76,18 @@ data: backendNotificationPusher: {{toYaml .backendNotificationPusher | indent 6 }} + {{- with .backgroundJobs }} + backgroundJobs: +{{ toYaml . | indent 6 }} + {{- end }} + postgresql: +{{ toYaml .postgresql | indent 6 }} + {{- if hasKey $.Values.secrets "pgPassword" }} + postgresqlPassword: /etc/wire/background-worker/secrets/pgPassword + {{- end }} + postgresqlPool: +{{ toYaml .postgresqlPool | nindent 6 }} + {{- if .postgresMigration }} + postgresMigration: {{- toYaml .postgresMigration | nindent 6 }} + {{- end }} {{- end }} diff --git a/charts/background-worker/templates/deployment.yaml b/charts/background-worker/templates/deployment.yaml index aeeab1ecc5..c159ee7335 100644 --- a/charts/background-worker/templates/deployment.yaml +++ b/charts/background-worker/templates/deployment.yaml @@ -39,10 +39,20 @@ spec: - name: "background-worker-secrets" secret: secretName: "background-worker" - {{- if eq (include "useCassandraTLS" .Values.config) "true" }} - - name: "background-worker-cassandra" + {{- if eq (include "useGundeckCassandraTLS" .Values.config) "true" }} + - name: "background-worker-cassandra-gundeck" secret: - secretName: {{ (include "tlsSecretRef" .Values.config | fromYaml).name }} + secretName: {{ (include "gundeckTlsSecretRef" .Values.config | fromYaml).name }} + {{- end }} + {{- if eq (include "useBrigCassandraTLS" .Values.config) "true" }} + - name: "background-worker-cassandra-brig" + secret: + secretName: {{ (include "brigTlsSecretRef" .Values.config | fromYaml).name }} + {{- end }} + {{- if eq (include "useGalleyCassandraTLS" .Values.config) "true" }} + - name: "background-worker-cassandra-galley" + secret: + secretName: {{ (include "galleyTlsSecretRef" .Values.config | fromYaml).name }} {{- end }} {{- if .Values.config.rabbitmq.tlsCaSecretRef }} - name: "rabbitmq-ca" @@ -58,11 +68,21 @@ spec: {{- toYaml .Values.podSecurityContext | nindent 12 }} {{- end }} volumeMounts: + - name: "background-worker-secrets" + mountPath: "/etc/wire/background-worker/secrets" - name: "background-worker-config" mountPath: "/etc/wire/background-worker/conf" - {{- if eq (include "useCassandraTLS" .Values.config) "true" }} - - name: "background-worker-cassandra" - mountPath: "/etc/wire/background-worker/cassandra" + {{- if eq (include "useGundeckCassandraTLS" .Values.config) "true" }} + - name: "background-worker-cassandra-gundeck" + mountPath: "/etc/wire/background-worker/cassandra-gundeck" + {{- end }} + {{- if eq (include "useBrigCassandraTLS" .Values.config) "true" }} + - name: "background-worker-cassandra-brig" + mountPath: "/etc/wire/background-worker/cassandra-brig" + {{- end }} + {{- if eq (include "useGalleyCassandraTLS" .Values.config) "true" }} + - name: "background-worker-cassandra-galley" + mountPath: "/etc/wire/background-worker/cassandra-galley" {{- end }} {{- if .Values.config.rabbitmq.tlsCaSecretRef }} - name: "rabbitmq-ca" diff --git a/charts/background-worker/templates/secret.yaml b/charts/background-worker/templates/secret.yaml index 25a22ce67e..dfde355db9 100644 --- a/charts/background-worker/templates/secret.yaml +++ b/charts/background-worker/templates/secret.yaml @@ -15,4 +15,7 @@ data: {{- with .Values.secrets }} rabbitmqUsername: {{ .rabbitmq.username | b64enc | quote }} rabbitmqPassword: {{ .rabbitmq.password | b64enc | quote }} + {{- if .pgPassword }} + pgPassword: {{ .pgPassword | b64enc | quote }} + {{- end }} {{- end }} diff --git a/charts/background-worker/values.yaml b/charts/background-worker/values.yaml index a0117c9363..2eb0058944 100644 --- a/charts/background-worker/values.yaml +++ b/charts/background-worker/values.yaml @@ -19,6 +19,22 @@ 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 + # Postgres connection settings + # + # Values are described in https://www.postgresql.org/docs/17/libpq-connect.html#LIBPQ-PARAMKEYWORDS + # To set the password via a background-worker secret see `secrets.pgPassword`. + # + # Below is an example configuration used in CI tests. + postgresql: + host: postgresql # DNS name without protocol + port: "5432" + user: wire-server + dbname: wire-server + postgresqlPool: + size: 100 + acquisitionTimeout: 10s + agingTimeout: 1d + idlenessTimeout: 10m rabbitmq: host: rabbitmq port: 5672 @@ -29,15 +45,37 @@ config: # tlsCaSecretRef: # name: # key: + # Cassandra clusters used by background-worker cassandra: host: aws-cassandra + cassandraBrig: + host: aws-cassandra + cassandraGalley: + host: aws-cassandra backendNotificationPusher: pushBackoffMinWait: 10000 # in microseconds, so 10ms pushBackoffMaxWait: 300000000 # microseconds, so 300s remotesRefreshInterval: 300000000 # microseconds, so 300s -secrets: {} + # Background jobs consumer configuration + backgroundJobs: + # Maximum number of in-flight jobs per process + concurrency: 8 + # Per-attempt timeout in seconds + jobTimeout: 60 + # Total attempts, including the first try + maxAttempts: 3 + + domain: example.org + + # Controls where conversation data is stored/accessed + postgresMigration: + conversation: postgresql + +secrets: + {} + # pgPassword: podSecurityContext: allowPrivilegeEscalation: false diff --git a/charts/integration/templates/configmap.yaml b/charts/integration/templates/configmap.yaml index 84aa623acb..5402a048f2 100644 --- a/charts/integration/templates/configmap.yaml +++ b/charts/integration/templates/configmap.yaml @@ -56,6 +56,11 @@ data: backgroundWorker: host: backgroundWorker.{{ .Release.Namespace }}.svc.cluster.local port: 8080 + # Background jobs defaults for integration tests + backgroundJobs: + concurrency: 4 + jobTimeout: 5 + maxAttempts: 3 stern: host: stern.{{ .Release.Namespace }}.svc.cluster.local diff --git a/docs/src/developer/reference/config-options.md b/docs/src/developer/reference/config-options.md index 5ca0820dca..5812d9dd5f 100644 --- a/docs/src/developer/reference/config-options.md +++ b/docs/src/developer/reference/config-options.md @@ -1707,3 +1707,43 @@ gundeck: settings: cellsEventQueue: "cells_events" ``` +## Background worker: Background jobs + +The background worker consumes jobs from RabbitMQ to process tasks asynchronously. The following configuration controls the consumer’s behavior: + +Internal YAML file and Helm values (under `background-worker.config`): + +```yaml +backgroundJobs: + # Maximum number of in-flight jobs per process + concurrency: 8 + # Per-attempt timeout in seconds + jobTimeout: 60 + # Total attempts including the first run + maxAttempts: 3 +``` + +Notes: + +- `concurrency` controls the AMQP prefetch and caps parallel handler execution per process. +- `jobTimeout` bounds each attempt; timed‑out attempts are retried until `maxAttempts` is reached. +- `maxAttempts` is total tries (first run plus retries). On final failure, the job is dropped (NACK requeue=false) and counted in metrics. + +Additional background-worker configuration: + +```yaml +# Cassandra clusters +cassandra: + host: aws-cassandra +cassandraBrig: + host: aws-cassandra +cassandraGalley: + host: aws-cassandra + +# Conversation storage backend selection +postgresMigration: + conversation: cassandra # or postgresql +``` + +- `cassandraGalley` configures the third Cassandra cluster used for conversation-related data; TLS may be configured via `tlsCa` or `tlsCaSecretRef` similarly to the other clusters. +- `postgresMigration.conversation` selects the storage location for conversation data; aligns with galley’s option and defaults to `cassandra`. diff --git a/hack/helm_vars/wire-server/values.yaml.gotmpl b/hack/helm_vars/wire-server/values.yaml.gotmpl index f675fc761f..07016b143e 100644 --- a/hack/helm_vars/wire-server/values.yaml.gotmpl +++ b/hack/helm_vars/wire-server/values.yaml.gotmpl @@ -58,6 +58,7 @@ brig: teamCreatorWelcome: https://teams.wire.com/login teamMemberWelcome: https://wire.com/download accountPages: https://account.wire.com + # Background-worker uses Brig's Cassandra keyspace. cassandra: host: {{ .Values.cassandraHost }} replicaCount: 1 @@ -604,6 +605,11 @@ background-worker: pushBackoffMinWait: 1000 # 1ms pushBackoffMaxWait: 500000 # 0.5s remotesRefreshInterval: 1000000 # 1s + backgroundJobs: + concurrency: 8 + jobTimeout: 60 + maxAttempts: 3 + # Cassandra clusters used by background-worker cassandra: host: {{ .Values.cassandraHost }} replicaCount: 1 @@ -612,6 +618,23 @@ background-worker: name: "cassandra-jks-keystore" key: "ca.crt" {{- end }} + cassandraBrig: + host: {{ .Values.cassandraHost }} + replicaCount: 1 + {{- if .Values.useK8ssandraSSL.enabled }} + tlsCaSecretRef: + name: "cassandra-jks-keystore" + key: "ca.crt" + {{- end }} + cassandraGalley: + host: {{ .Values.cassandraHost }} + replicaCount: 1 + {{- if .Values.useK8ssandraSSL.enabled }} + tlsCaSecretRef: + name: "cassandra-jks-keystore" + key: "ca.crt" + {{- end }} + domain: {{ .Values.domain }} rabbitmq: port: 5671 adminPort: 15671 @@ -620,10 +643,16 @@ background-worker: tlsCaSecretRef: name: "rabbitmq-certificate" key: "ca.crt" + postgresql: + host: "postgresql" + port: "5432" + user: wire-server + dbname: wire-server secrets: rabbitmq: username: {{ .Values.rabbitmqUsername }} password: {{ .Values.rabbitmqPassword }} + pgPassword: "posty-the-gres" integration: ingress: diff --git a/hack/helmfile.yaml.gotmpl b/hack/helmfile.yaml.gotmpl index 2fe0dc9791..f3aba0bcb0 100644 --- a/hack/helmfile.yaml.gotmpl +++ b/hack/helmfile.yaml.gotmpl @@ -18,6 +18,7 @@ environments: - imagePullPolicy: Always - storageClass: hcloud-volumes - cassandraHost: cassandra-ephemeral + - domain: example.org - useK8ssandraSSL: enabled: false - elasticsearch: @@ -30,6 +31,7 @@ environments: - imagePullPolicy: Always - storageClass: hcloud-volumes - cassandraHost: k8ssandra-cluster-datacenter-1-service + - domain: example.org - useK8ssandraSSL: enabled: true - elasticsearch: @@ -42,6 +44,7 @@ environments: - imagePullPolicy: Never - storageClass: standard - cassandraHost: cassandra-ephemeral + - domain: example.org - useK8ssandraSSL: enabled: false - elasticsearch: @@ -54,6 +57,7 @@ environments: - imagePullPolicy: Never - storageClass: standard - cassandraHost: k8ssandra-cluster-datacenter-1-service + - domain: example.org - useK8ssandraSSL: enabled: true - elasticsearch: diff --git a/integration/test/Test/Events.hs b/integration/test/Test/Events.hs index 52021e5edf..fac210a115 100644 --- a/integration/test/Test/Events.hs +++ b/integration/test/Test/Events.hs @@ -157,11 +157,12 @@ testTemporaryQueuesAreDeletedAfterUse = do aliceClientQueue = Queue {name = fromString aliceClientQueueName, vhost = fromString beResource.berVHost} deadNotifsQueue = Queue {name = fromString "dead-user-notifications", vhost = fromString beResource.berVHost} cellsEventsQueue = Queue {name = fromString "cells_events", vhost = fromString beResource.berVHost} + backgroundJobsQueue = Queue {name = fromString "background-jobs", vhost = fromString beResource.berVHost} -- Wait for queue for the new client to be created eventually $ do queuesBeforeWS <- rabbitmqAdmin.listQueuesByVHost (fromString beResource.berVHost) (fromString "") True 100 1 - queuesBeforeWS.items `shouldMatchSet` [deadNotifsQueue, cellsEventsQueue, aliceClientQueue] + queuesBeforeWS.items `shouldMatchSet` [deadNotifsQueue, cellsEventsQueue, aliceClientQueue, backgroundJobsQueue] runCodensity (createEventsWebSocket alice Nothing) $ \ws -> do handle <- randomHandle @@ -169,7 +170,7 @@ testTemporaryQueuesAreDeletedAfterUse = do queuesDuringWS <- rabbitmqAdmin.listQueuesByVHost (fromString beResource.berVHost) (fromString "") True 100 1 addJSONToFailureContext "queuesDuringWS" queuesDuringWS $ do - length queuesDuringWS.items `shouldMatchInt` 4 + length queuesDuringWS.items `shouldMatchInt` 5 -- We cannot use 'assertEvent' here because there is a race between the temp -- queue being created and rabbitmq fanning out the previous events. @@ -183,7 +184,7 @@ testTemporaryQueuesAreDeletedAfterUse = do eventually $ do queuesAfterWS <- rabbitmqAdmin.listQueuesByVHost (fromString beResource.berVHost) (fromString "") True 100 1 - queuesAfterWS.items `shouldMatchSet` [deadNotifsQueue, cellsEventsQueue, aliceClientQueue] + queuesAfterWS.items `shouldMatchSet` [deadNotifsQueue, cellsEventsQueue, aliceClientQueue, backgroundJobsQueue] testSendMessageNoReturnToSenderWithConsumableNotificationsProteus :: (HasCallStack) => App () testSendMessageNoReturnToSenderWithConsumableNotificationsProteus = do diff --git a/integration/test/Test/UserGroup.hs b/integration/test/Test/UserGroup.hs index 4e34207c1c..9bee467b69 100644 --- a/integration/test/Test/UserGroup.hs +++ b/integration/test/Test/UserGroup.hs @@ -6,7 +6,7 @@ import API.Brig import API.Galley import API.GalleyInternal (setTeamFeatureLockStatus) import Control.Error (lastMay) -import Notifications (isUserGroupCreatedNotif, isUserGroupUpdatedNotif) +import Notifications (isMemberJoinNotif, isUserGroupCreatedNotif, isUserGroupUpdatedNotif) import SetupHelpers import Testlib.Prelude @@ -396,22 +396,11 @@ testUserGroupRemovalOnDelete = do testUserGroupUpdateChannelsSucceeds :: (HasCallStack) => App () testUserGroupUpdateChannelsSucceeds = do - (alice, tid, [_bob]) <- createTeam OwnDomain 2 + (alice, tid, _) <- createTeam OwnDomain 1 setTeamFeatureLockStatus alice tid "channels" "unlocked" - let config = - object - [ "status" .= "enabled", - "config" - .= object - [ "allowed_to_create_channels" .= "team-members", - "allowed_to_open_channels" .= "team-members" - ] - ] - setTeamFeatureConfig alice tid "channels" config >>= assertSuccess + setTeamFeatureConfig alice tid "channels" channelsConfig >>= assertSuccess - ug <- - createUserGroup alice (object ["name" .= "none", "members" .= (mempty :: [String])]) - >>= getJSON 200 + ug <- createUserGroup alice (object ["name" .= "none", "members" .= (mempty :: [String])]) >>= getJSON 200 gid <- ug %. "id" & asString convs <- replicateM 5 $ postConversation alice (defMLS {team = Just tid, groupConvType = Just "channel"}) >>= getJSON 201 >>= objConvId @@ -424,7 +413,8 @@ testUserGroupUpdateChannelsSucceeds = do bindResponse (getUserGroupWithChannels alice gid) $ \resp -> do resp.status `shouldMatchInt` 200 - (resp.json %. "channels" >>= asList >>= traverse objQid) `shouldMatchSet` for (take 2 convs) objQid + actual <- resp.json %. "channels" >>= asList >>= traverse objQid + actual `shouldMatchSet` for (take 2 convs) objQid bindResponse (getUserGroups alice (def {includeChannels = True})) $ \resp -> do resp.status `shouldMatchInt` 200 @@ -446,10 +436,6 @@ testUserGroupUpdateChannelsSucceeds = do resp.status `shouldMatchInt` 200 (resp.json %. "channels" >>= fmap length . asList) `shouldMatchInt` 0 - bindResponse (getUserGroups alice (def {includeChannels = True})) $ \resp -> do - resp.status `shouldMatchInt` 200 - (resp.json %. "page.0.channels" >>= fmap length . asList) `shouldMatchInt` 0 - testUserGroupUpdateChannelsNonAdmin :: (HasCallStack) => App () testUserGroupUpdateChannelsNonAdmin = do (alice, tid, [bob]) <- createTeam OwnDomain 2 @@ -495,3 +481,81 @@ testUserGroupUpdateChannelsNonChannel = do >>= getJSON 201 >>= objConvId updateUserGroupChannels alice gid [convId.id_] >>= assertLabel 404 "user-group-channel-not-found" + +testUserGroupAddUsersToGroupWithChannels :: (HasCallStack) => App () +testUserGroupAddUsersToGroupWithChannels = do + (alice, tid, mems@[bob, charlie, dave, eve, franzi]) <- createTeam OwnDomain 6 + setTeamFeatureLockStatus alice tid "channels" "unlocked" + setTeamFeatureConfig alice tid "channels" channelsConfig >>= assertSuccess + + [bobId, charlieId, daveId, eveId, franziId] <- for mems $ asString . (%. "id") + + -- Create user group with bob as initial member + ug <- createUserGroup alice (object ["name" .= "test group", "members" .= [bobId]]) >>= getJSON 200 + gid <- ug %. "id" & asString + + -- Create two conversations (channels) for the team + [convId1, convId2] <- replicateM 2 $ postConversation alice (defMLS {team = Just tid, groupConvType = Just "channel"}) >>= getJSON 201 >>= objConvId + + -- Associate both channels with the user group + withWebSocket bob $ \bobWs -> do + updateUserGroupChannels alice gid [convId1.id_, convId2.id_] >>= assertSuccess + replicateM_ 2 $ awaitMatch isMemberJoinNotif bobWs + + for_ [convId1, convId2] $ \convId -> do + bindResponse (getConversation alice convId) $ \resp -> do + resp.status `shouldMatchInt` 200 + members <- resp.json %. "members" %. "others" >>= asList + memberIds <- mapM ((%. "qualified_id") >=> (%. "id") >=> asString) members + memberIds `shouldMatchSet` [bobId] + + -- Add charlie, dave, and eve to the group using addUsersToGroup + withWebSockets [charlie, dave, eve] $ \wss -> do + addUsersToGroup alice gid [charlieId, daveId, eveId] >>= assertSuccess + for_ wss $ replicateM_ 2 . awaitMatch isMemberJoinNotif + + -- Verify all three users are now in the first channel + for_ [convId1, convId2] $ \convId -> do + bindResponse (getConversation alice convId) $ \resp -> do + resp.status `shouldMatchInt` 200 + members <- resp.json %. "members" %. "others" >>= asList + memberIds <- mapM ((%. "qualified_id") >=> (%. "id") >=> asString) members + memberIds `shouldMatchSet` [bobId, charlieId, daveId, eveId] + + -- now we make charlie and dave admins in the conversation + updateConversationMember alice convId charlie "wire_admin" >>= assertSuccess + updateConversationMember alice convId dave "wire_admin" >>= assertSuccess + + bindResponse (getConversation alice convId) $ \resp -> do + resp.status `shouldMatchInt` 200 + members <- resp.json %. "members" %. "others" >>= asList + actual <- for members toIdRolePair + let expected = [(bobId, "wire_member"), (charlieId, "wire_admin"), (daveId, "wire_admin"), (eveId, "wire_member")] + actual `shouldMatchSet` expected + + -- when we now add another user, we expect roles not be overwritten + withWebSockets [franzi] $ \wss -> do + addUsersToGroup alice gid [franziId] >>= assertSuccess + for_ wss $ replicateM_ 2 . awaitMatch isMemberJoinNotif + + for_ [convId1] $ \convId -> do + bindResponse (getConversation alice convId) $ \resp -> do + resp.status `shouldMatchInt` 200 + members <- resp.json %. "members" %. "others" >>= asList + actual <- for members toIdRolePair + let expected = [(bobId, "wire_member"), (charlieId, "wire_admin"), (daveId, "wire_admin"), (eveId, "wire_member"), (franziId, "wire_member")] + actual `shouldMatchSet` expected + where + toIdRolePair :: Value -> App (String, String) + toIdRolePair mem = (,) <$> (mem %. "qualified_id.id" & asString) <*> (mem %. "conversation_role" & asString) + +channelsConfig :: Value +channelsConfig = + object + [ "status" .= "enabled", + "config" + .= object + [ "allowed_to_create_channels" .= "team-members", + "allowed_to_open_channels" .= "team-members" + ] + ] diff --git a/libs/polysemy-wire-zoo/polysemy-wire-zoo.cabal b/libs/polysemy-wire-zoo/polysemy-wire-zoo.cabal index 42d0ef800a..87dc102d65 100644 --- a/libs/polysemy-wire-zoo/polysemy-wire-zoo.cabal +++ b/libs/polysemy-wire-zoo/polysemy-wire-zoo.cabal @@ -33,6 +33,7 @@ library Wire.Sem.Paging.Cassandra Wire.Sem.Random Wire.Sem.Random.IO + Wire.Sem.Random.Null other-modules: Paths_polysemy_wire_zoo hs-source-dirs: src diff --git a/libs/polysemy-wire-zoo/src/Wire/Sem/Random.hs b/libs/polysemy-wire-zoo/src/Wire/Sem/Random.hs index 8cc1ef3386..20e6d02466 100644 --- a/libs/polysemy-wire-zoo/src/Wire/Sem/Random.hs +++ b/libs/polysemy-wire-zoo/src/Wire/Sem/Random.hs @@ -21,6 +21,7 @@ module Wire.Sem.Random ( Random (..), bytes, uuid, + newId, scimTokenId, liftRandom, nDigitNumber, @@ -28,7 +29,7 @@ module Wire.Sem.Random where import Crypto.Random.Types -import Data.Id (ScimTokenId) +import Data.Id (Id, ScimTokenId) import Data.UUID (UUID) import Imports import Polysemy @@ -36,6 +37,7 @@ import Polysemy data Random m a where Bytes :: Int -> Random m ByteString Uuid :: Random m UUID + NewId :: Random m (Id a) ScimTokenId :: Random m ScimTokenId LiftRandom :: (forall mr. (MonadRandom mr) => mr a) -> Random m a NDigitNumber :: Int -> Random m Integer diff --git a/libs/polysemy-wire-zoo/src/Wire/Sem/Random/IO.hs b/libs/polysemy-wire-zoo/src/Wire/Sem/Random/IO.hs index d073d267e8..53d75a904e 100644 --- a/libs/polysemy-wire-zoo/src/Wire/Sem/Random/IO.hs +++ b/libs/polysemy-wire-zoo/src/Wire/Sem/Random/IO.hs @@ -35,6 +35,7 @@ randomToIO :: randomToIO = interpret $ \case Bytes i -> embed $ randBytes i Uuid -> embed $ UUID.nextRandom + NewId -> embed $ randomId @IO ScimTokenId -> embed $ randomId @IO LiftRandom m -> embed @IO $ m NDigitNumber n -> embed $ randIntegerZeroToNMinusOne (10 ^ n) diff --git a/libs/polysemy-wire-zoo/src/Wire/Sem/Random/Null.hs b/libs/polysemy-wire-zoo/src/Wire/Sem/Random/Null.hs new file mode 100644 index 0000000000..7d19eff66c --- /dev/null +++ b/libs/polysemy-wire-zoo/src/Wire/Sem/Random/Null.hs @@ -0,0 +1,39 @@ +-- 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.Sem.Random.Null + ( randomToNull, + ) +where + +import Crypto.Random +import Data.Id (Id (..)) +import qualified Data.UUID as UUID +import Imports +import Polysemy +import Wire.Sem.Random (Random (..)) + +randomToNull :: + Sem (Random ': r) a -> + Sem r a +randomToNull = interpret $ \case + Bytes i -> pure $ mconcat $ replicate i "0" + Uuid -> pure UUID.nil + NewId -> pure $ Id UUID.nil + ScimTokenId -> pure $ Id UUID.nil + LiftRandom m -> pure $ fst $ withDRG (drgNewSeed $ seedFromInteger 0) m + NDigitNumber n -> pure $ 10 ^ n diff --git a/libs/types-common/src/Data/Id.hs b/libs/types-common/src/Data/Id.hs index ebd24fc53b..ad7f4526ff 100644 --- a/libs/types-common/src/Data/Id.hs +++ b/libs/types-common/src/Data/Id.hs @@ -37,6 +37,7 @@ module Data.Id ServiceId, TeamId, ScimTokenId, + JobId, parseIdFromText, idToText, idObjectSchema, @@ -111,6 +112,7 @@ data IdTag | OAuthClient | OAuthRefreshToken | Challenge + | Job idTagName :: IdTag -> Text idTagName Asset = "Asset" @@ -125,6 +127,7 @@ idTagName ScimToken = "ScimToken" idTagName OAuthClient = "OAuthClient" idTagName OAuthRefreshToken = "OAuthRefreshToken" idTagName Challenge = "Challenge" +idTagName Job = "Job" class KnownIdTag (t :: IdTag) where idTagValue :: IdTag @@ -151,6 +154,8 @@ instance KnownIdTag 'OAuthClient where idTagValue = OAuthClient instance KnownIdTag 'OAuthRefreshToken where idTagValue = OAuthRefreshToken +instance KnownIdTag 'Job where idTagValue = Job + type AssetId = Id 'Asset type InvitationId = Id 'Invitation @@ -177,6 +182,8 @@ type OAuthRefreshTokenId = Id 'OAuthRefreshToken type ChallengeId = Id 'Challenge +type JobId = Id 'Job + -- Id ------------------------------------------------------------------------- data NoId = NoId deriving (Eq, Show, Generic) @@ -434,6 +441,9 @@ newtype RequestId = RequestId ToBytes ) +instance Arbitrary RequestId where + arbitrary = RequestId . UUID.toASCIIBytes <$> arbitrary @UUID + defRequestId :: (IsString s) => s defRequestId = "N/A" diff --git a/libs/wire-api/src/Wire/API/BackgroundJobs.hs b/libs/wire-api/src/Wire/API/BackgroundJobs.hs new file mode 100644 index 0000000000..c5a638cb1a --- /dev/null +++ b/libs/wire-api/src/Wire/API/BackgroundJobs.hs @@ -0,0 +1,169 @@ +{-# LANGUAGE StrictData #-} +{-# LANGUAGE TemplateHaskell #-} + +-- 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.API.BackgroundJobs where + +import Control.Arrow ((&&&)) +import Control.Lens (makePrisms) +import Data.Aeson qualified as Aeson +import Data.Id +import Data.Map.Strict qualified as Map +import Data.OpenApi qualified as S +import Data.Schema +import Imports +import Network.AMQP qualified as Q +import Network.AMQP.Types qualified as QT +import Wire.Arbitrary (Arbitrary (..), GenericUniform (..)) + +data JobPayload + = JobSyncUserGroupAndChannel SyncUserGroupAndChannel + | JobSyncUserGroup SyncUserGroup + deriving stock (Eq, Show, Generic) + deriving (Arbitrary) via GenericUniform JobPayload + +jobPayloadLabel :: JobPayload -> Text +jobPayloadLabel p = case jobPayloadTag p of + JobSyncUserGroupAndChannelTag -> "sync-user-group-and-channel" + JobSyncUserGroupTag -> "sync-user-group" + +data JobPayloadTag + = JobSyncUserGroupAndChannelTag + | JobSyncUserGroupTag + deriving stock (Eq, Ord, Bounded, Enum, Show, Generic) + deriving (Arbitrary) via GenericUniform JobPayloadTag + +instance ToSchema JobPayloadTag where + schema = + enum @Text "JobPayloadTag" $ + mconcat + [ element "sync-user-group-and-channel" JobSyncUserGroupAndChannelTag, + element "sync-user-group" JobSyncUserGroupTag + ] + +jobPayloadTag :: JobPayload -> JobPayloadTag +jobPayloadTag = + \case + JobSyncUserGroupAndChannel {} -> JobSyncUserGroupAndChannelTag + JobSyncUserGroup {} -> JobSyncUserGroupTag + +jobPayloadTagSchema :: ObjectSchema SwaggerDoc JobPayloadTag +jobPayloadTagSchema = field "type" schema + +data SyncUserGroupAndChannel = SyncUserGroupAndChannel + { teamId :: TeamId, + userGroupId :: UserGroupId, + convId :: ConvId, + actor :: UserId + } + deriving (Show, Eq, Generic) + deriving (Aeson.ToJSON, Aeson.FromJSON) via (Schema SyncUserGroupAndChannel) + deriving (Arbitrary) via GenericUniform SyncUserGroupAndChannel + +instance ToSchema SyncUserGroupAndChannel where + schema = + object "SyncUserGroupAndChannel" $ + SyncUserGroupAndChannel + <$> (.teamId) .= field "team_id" schema + <*> (.userGroupId) .= field "user_group_id" schema + <*> (.convId) .= field "conv_id" schema + <*> (.actor) .= field "actor" schema + +data SyncUserGroup = SyncUserGroup + { teamId :: TeamId, + userGroupId :: UserGroupId, + actor :: UserId + } + deriving (Show, Eq, Generic) + deriving (Aeson.ToJSON, Aeson.FromJSON) via (Schema SyncUserGroup) + deriving (Arbitrary) via GenericUniform SyncUserGroup + +instance ToSchema SyncUserGroup where + schema = + object "SyncUserGroup" $ + SyncUserGroup + <$> (.teamId) .= field "team_id" schema + <*> (.userGroupId) .= field "user_group_id" schema + <*> (.actor) .= field "actor" schema + +makePrisms ''JobPayload + +jobPayloadObjectSchema :: ObjectSchema SwaggerDoc JobPayload +jobPayloadObjectSchema = + snd + <$> (jobPayloadTag &&& id) + .= bind + (fst .= jobPayloadTagSchema) + (snd .= dispatch jobPayloadDataSchema) + where + jobPayloadDataSchema :: JobPayloadTag -> ObjectSchema SwaggerDoc JobPayload + jobPayloadDataSchema = \case + JobSyncUserGroupAndChannelTag -> tag _JobSyncUserGroupAndChannel (field "payload" schema) + JobSyncUserGroupTag -> tag _JobSyncUserGroup (field "payload" schema) + +instance ToSchema JobPayload where + schema = object "JobPayload" jobPayloadObjectSchema + +deriving via (Schema JobPayload) instance Aeson.FromJSON JobPayload + +deriving via (Schema JobPayload) instance Aeson.ToJSON JobPayload + +deriving via (Schema JobPayload) instance S.ToSchema JobPayload + +-- | Background job envelope. Payload is a free-form JSON object. +data Job = Job + { jobId :: JobId, + requestId :: RequestId, + payload :: JobPayload + } + deriving stock (Eq, Show, Generic) + deriving (Arbitrary) via GenericUniform Job + deriving (Aeson.ToJSON, Aeson.FromJSON, S.ToSchema) via Schema Job + +instance ToSchema Job where + schema = + object "Job" $ + Job + <$> jobId .= field "id" schema + <*> requestId .= field "requestId" schema + <*> payload .= field "payload" schema + +backgroundJobsRoutingKey :: Text +backgroundJobsRoutingKey = backgroundJobsQueueName + +backgroundJobsQueueName :: Text +backgroundJobsQueueName = "background-jobs" + +ensureBackgroundJobsQueue :: Q.Channel -> IO () +ensureBackgroundJobsQueue chan = do + let headers = + QT.FieldTable + ( Map.fromList + [ ("x-queue-type", QT.FVString "quorum") + ] + ) + q = + Q.newQueue + { Q.queueName = backgroundJobsQueueName, + Q.queueDurable = True, + Q.queueAutoDelete = False, + Q.queueExclusive = False, + Q.queueHeaders = headers + } + void $ Q.declareQueue chan q diff --git a/libs/wire-api/src/Wire/API/Conversation.hs b/libs/wire-api/src/Wire/API/Conversation.hs index 7e326d8daf..c9442d728c 100644 --- a/libs/wire-api/src/Wire/API/Conversation.hs +++ b/libs/wire-api/src/Wire/API/Conversation.hs @@ -74,6 +74,7 @@ module Wire.API.Conversation -- * invite Invite (..), InviteQualified (..), + InviteQualifiedInternal (..), -- * update ConversationRename (..), @@ -249,6 +250,9 @@ instance ToSchema (Versioned 'V2 ConversationMetadata) where "ConversationMetadata" (conversationMetadataObjectSchema accessRolesSchemaV2) +instance HasCellsState ConversationMetadata where + getCellsState = cnvmCellsState + -- | Public-facing conversation type. Represents information that a -- particular user is allowed to see. -- @@ -268,6 +272,9 @@ data OwnConversation = OwnConversation deriving (Arbitrary) via (GenericUniform OwnConversation) deriving (FromJSON, ToJSON, S.ToSchema) via Schema OwnConversation +instance HasCellsState OwnConversation where + getCellsState = getCellsState . cnvMetadata + cnvType :: OwnConversation -> ConvType cnvType = cnvmType . cnvMetadata @@ -1095,6 +1102,21 @@ instance ToSchema InviteQualified where <$> (.users) .= field "qualified_users" (nonEmptyArray schema) <*> roleName .= (fromMaybe roleNameWireAdmin <$> optField "conversation_role" schema) +data InviteQualifiedInternal = InviteQualifiedInternal + { actor :: UserId, + invite :: InviteQualified + } + deriving stock (Eq, Show, Generic) + deriving (Arbitrary) via (GenericUniform InviteQualifiedInternal) + deriving (ToJSON, FromJSON, S.ToSchema) via (Schema InviteQualifiedInternal) + +instance ToSchema InviteQualifiedInternal where + schema = + object "InviteQualifiedInternal" $ + InviteQualifiedInternal + <$> (.actor) .= field "actor" schema + <*> (.invite) .= field "invite" schema + -------------------------------------------------------------------------------- -- update diff --git a/libs/wire-api/src/Wire/API/Conversation/CellsState.hs b/libs/wire-api/src/Wire/API/Conversation/CellsState.hs index 10b6d12ec3..5ecee42ae8 100644 --- a/libs/wire-api/src/Wire/API/Conversation/CellsState.hs +++ b/libs/wire-api/src/Wire/API/Conversation/CellsState.hs @@ -76,3 +76,12 @@ cellsStateToInt32 = \case CellsDisabled -> 0 CellsPending -> 1 CellsReady -> 2 + +class HasCellsState a where + getCellsState :: a -> CellsState + +instance HasCellsState CellsState where + getCellsState = id + +instance HasCellsState () where + getCellsState = def diff --git a/libs/wire-api/src/Wire/API/Event/Conversation.hs b/libs/wire-api/src/Wire/API/Event/Conversation.hs index 13fc23ce5b..1c620be050 100644 --- a/libs/wire-api/src/Wire/API/Event/Conversation.hs +++ b/libs/wire-api/src/Wire/API/Event/Conversation.hs @@ -33,6 +33,7 @@ module Wire.API.Event.Conversation CellsEventType (..), CellsEventData (..), cellsEventType, + shouldPushToCells, -- * Event lenses _EdMembersJoin, @@ -92,6 +93,7 @@ import Test.QuickCheck qualified as QC import URI.ByteString () import Wire.API.Conversation hiding (AddPermissionUpdate) import Wire.API.Conversation qualified as Conv +import Wire.API.Conversation.CellsState import Wire.API.Conversation.Code (ConversationCode (..), ConversationCodeInfo) import Wire.API.Conversation.Protocol (ProtocolUpdate (unProtocolUpdate)) import Wire.API.Conversation.Protocol qualified as P @@ -581,6 +583,13 @@ instance ToJSONObject CellsEvent where A.Object o -> KeyMap.delete "data" o _ -> KeyMap.fromList [] +shouldPushToCells :: (HasCellsState a) => a -> Event -> Bool +shouldPushToCells st e = + isCellsConversationEvent (evtType e) && case getCellsState st of + CellsDisabled -> False + CellsPending -> True + CellsReady -> True + -------------------------------------------------------------------------------- -- MultiVerb instances diff --git a/libs/wire-api/test/unit/Test/Wire/API/Roundtrip/Aeson.hs b/libs/wire-api/test/unit/Test/Wire/API/Roundtrip/Aeson.hs index 57cf9e9fda..91f136c22b 100644 --- a/libs/wire-api/test/unit/Test/Wire/API/Roundtrip/Aeson.hs +++ b/libs/wire-api/test/unit/Test/Wire/API/Roundtrip/Aeson.hs @@ -27,6 +27,7 @@ import Test.Tasty qualified as T import Test.Tasty.QuickCheck (Arbitrary, counterexample, testProperty, (.&&.), (===)) import Type.Reflection (typeRep) import Wire.API.Asset qualified as Asset +import Wire.API.BackgroundJobs qualified as BackgroundJobs import Wire.API.Call.Config qualified as Call.Config import Wire.API.Connection qualified as Connection import Wire.API.Conversation qualified as Conversation @@ -356,7 +357,8 @@ tests = testRoundTrip @TeamsIntra.TeamStatus, testRoundTrip @TeamsIntra.TeamStatusUpdate, testRoundTrip @TeamsIntra.TeamData, - testRoundTrip @TeamsIntra.TeamName + testRoundTrip @TeamsIntra.TeamName, + testRoundTrip @BackgroundJobs.Job ] testRoundTrip :: @@ -365,7 +367,7 @@ testRoundTrip :: T.TestTree testRoundTrip = testProperty msg trip where - msg = show (typeRep @a) + msg = show (typeRep @a) <> " JSON roundtrip" trip (v :: a) = counterexample (show $ toJSON v) $ Right v === (parseEither parseJSON . toJSON) v diff --git a/libs/wire-api/wire-api.cabal b/libs/wire-api/wire-api.cabal index c7e39ed4ca..690725bb16 100644 --- a/libs/wire-api/wire-api.cabal +++ b/libs/wire-api/wire-api.cabal @@ -72,6 +72,7 @@ library Wire.API.App Wire.API.ApplyMods Wire.API.Asset + Wire.API.BackgroundJobs Wire.API.Bot Wire.API.Bot.Service Wire.API.Call.Config diff --git a/libs/wire-subsystems/default.nix b/libs/wire-subsystems/default.nix index 498d21aa2f..5a6c8b98e0 100644 --- a/libs/wire-subsystems/default.nix +++ b/libs/wire-subsystems/default.nix @@ -84,7 +84,9 @@ , servant , servant-client-core , servant-server +, singletons , sodium-crypto-sign +, ssl-util , statistics , stomp-queue , string-conversions @@ -191,7 +193,9 @@ mkDerivation { servant servant-client-core servant-server + singletons sodium-crypto-sign + ssl-util statistics stomp-queue template @@ -292,7 +296,9 @@ mkDerivation { servant servant-client-core servant-server + singletons sodium-crypto-sign + ssl-util statistics stomp-queue string-conversions diff --git a/services/galley/src/Galley/Effects/BackendNotificationQueueAccess.hs b/libs/wire-subsystems/src/Wire/BackendNotificationQueueAccess.hs similarity index 97% rename from services/galley/src/Galley/Effects/BackendNotificationQueueAccess.hs rename to libs/wire-subsystems/src/Wire/BackendNotificationQueueAccess.hs index fee78987c2..bbf37bbd29 100644 --- a/services/galley/src/Galley/Effects/BackendNotificationQueueAccess.hs +++ b/libs/wire-subsystems/src/Wire/BackendNotificationQueueAccess.hs @@ -1,4 +1,4 @@ -module Galley.Effects.BackendNotificationQueueAccess where +module Wire.BackendNotificationQueueAccess where import Data.Qualified import Imports diff --git a/libs/wire-subsystems/src/Wire/BackendNotificationQueueAccess/RabbitMq.hs b/libs/wire-subsystems/src/Wire/BackendNotificationQueueAccess/RabbitMq.hs new file mode 100644 index 0000000000..41ed987515 --- /dev/null +++ b/libs/wire-subsystems/src/Wire/BackendNotificationQueueAccess/RabbitMq.hs @@ -0,0 +1,99 @@ +{-# LANGUAGE NumericUnderscores #-} + +module Wire.BackendNotificationQueueAccess.RabbitMq + ( interpretBackendNotificationQueueAccess, + Env (..), + ) +where + +import Control.Monad.Catch +import Control.Retry +import Data.Domain +import Data.Id +import Data.Qualified +import Imports +import Network.AMQP qualified as Q +import Polysemy +import Polysemy.Error +import System.Logger qualified as Log +import UnliftIO +import Wire.API.Federation.BackendNotifications +import Wire.API.Federation.Error +import Wire.BackendNotificationQueueAccess (BackendNotificationQueueAccess (..)) + +data Env = Env + { channelMVar :: (MVar (Q.Channel)), + logger :: Log.Logger, + local :: Local (), + requestId :: RequestId + } + +interpretBackendNotificationQueueAccess :: + (Member (Embed IO) r) => + Maybe Env -> + Sem (BackendNotificationQueueAccess ': r) a -> + Sem r a +interpretBackendNotificationQueueAccess mEnv = interpret $ \case + EnqueueNotification deliveryMode remote action -> runError do + env <- note FederationNotConfigured mEnv + embed $ enqueueSingleNotification env (tDomain remote) deliveryMode action + EnqueueNotificationsConcurrently m xs rpc -> runError do + env <- note FederationNotConfigured mEnv + embed $ enqueueNotificationsConcurrently env m xs rpc + EnqueueNotificationsConcurrentlyBuckets m xs rpc -> runError do + env <- note FederationNotConfigured mEnv + embed $ enqueueNotificationsConcurrentlyBuckets env m xs rpc + +enqueueSingleNotification :: Env -> Domain -> Q.DeliveryMode -> FedQueueClient c a -> IO a +enqueueSingleNotification env remoteDomain deliveryMode action = do + let ownDomain = tDomain env.local + let policy = limitRetries 3 <> constantDelay 1_000_000 + handlers = + skipAsyncExceptions + <> [logRetries (const $ pure True) logError] + recovering policy handlers (const $ go ownDomain) + where + logError willRetry (SomeException e) status = do + Log.err env.logger $ + Log.msg @Text "failed to enqueue notification in RabbitMQ" + . Log.field "error" (displayException e) + . Log.field "willRetry" willRetry + . Log.field "retryCount" status.rsIterNumber + . Log.field "request" env.requestId + go ownDomain = do + mChan <- timeout 1_000_000 (readMVar env.channelMVar) + case mChan of + Nothing -> throwM NoRabbitMqChannel + Just chan -> do + liftIO $ enqueue chan env.requestId ownDomain remoteDomain deliveryMode action + +enqueueNotificationsConcurrently :: + (Foldable f, Functor f) => + Env -> + Q.DeliveryMode -> + f (Remote x) -> + (Remote [x] -> FedQueueClient c a) -> + IO [Remote a] +enqueueNotificationsConcurrently env m xs f = + enqueueNotificationsConcurrentlyBuckets env m (bucketRemote xs) f + +enqueueNotificationsConcurrentlyBuckets :: + (Foldable f) => + Env -> + Q.DeliveryMode -> + f (Remote x) -> + (Remote x -> FedQueueClient c a) -> + IO [Remote a] +enqueueNotificationsConcurrentlyBuckets env m xs f = do + case toList xs of + -- only attempt to get a channel if there is at least one notification to send + [] -> pure [] + _ -> do + pooledForConcurrentlyN 8 (toList xs) $ \r -> + qualifyAs r + <$> enqueueSingleNotification env (tDomain r) m (f r) + +data NoRabbitMqChannel = NoRabbitMqChannel + deriving (Show) + +instance Exception NoRabbitMqChannel diff --git a/libs/wire-subsystems/src/Wire/BackgroundJobsPublisher.hs b/libs/wire-subsystems/src/Wire/BackgroundJobsPublisher.hs new file mode 100644 index 0000000000..9c65214dfc --- /dev/null +++ b/libs/wire-subsystems/src/Wire/BackgroundJobsPublisher.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE TemplateHaskell #-} + +module Wire.BackgroundJobsPublisher where + +import Data.Id +import Polysemy +import Wire.API.BackgroundJobs (JobPayload) + +data BackgroundJobsPublisher m a where + PublishJob :: JobId -> JobPayload -> BackgroundJobsPublisher m () + +makeSem ''BackgroundJobsPublisher diff --git a/libs/wire-subsystems/src/Wire/BackgroundJobsPublisher/Null.hs b/libs/wire-subsystems/src/Wire/BackgroundJobsPublisher/Null.hs new file mode 100644 index 0000000000..87cc32e530 --- /dev/null +++ b/libs/wire-subsystems/src/Wire/BackgroundJobsPublisher/Null.hs @@ -0,0 +1,9 @@ +module Wire.BackgroundJobsPublisher.Null where + +import Imports +import Polysemy +import Wire.BackgroundJobsPublisher (BackgroundJobsPublisher (..)) + +interpretBackgroundJobsPublisherNoConfig :: InterpreterFor BackgroundJobsPublisher r +interpretBackgroundJobsPublisherNoConfig = interpret $ \case + PublishJob {} -> pure () diff --git a/libs/wire-subsystems/src/Wire/BackgroundJobsPublisher/RabbitMQ.hs b/libs/wire-subsystems/src/Wire/BackgroundJobsPublisher/RabbitMQ.hs new file mode 100644 index 0000000000..4475bf03c0 --- /dev/null +++ b/libs/wire-subsystems/src/Wire/BackgroundJobsPublisher/RabbitMQ.hs @@ -0,0 +1,67 @@ +module Wire.BackgroundJobsPublisher.RabbitMQ where + +import Data.Aeson qualified as Aeson +import Data.Id (JobId, RequestId (..), idToText) +import Data.Text.Encoding qualified as T +import Imports +import Network.AMQP qualified as Q +import Polysemy +import Polysemy.Input +import Wire.API.BackgroundJobs +import Wire.BackgroundJobsPublisher (BackgroundJobsPublisher (..)) +import Wire.BackgroundJobsPublisher.Null (interpretBackgroundJobsPublisherNoConfig) + +interpretBackgroundJobsPublisherRabbitMQOptional :: + ( Member (Embed IO) r + ) => + RequestId -> + Maybe (MVar Q.Channel) -> + InterpreterFor BackgroundJobsPublisher r +interpretBackgroundJobsPublisherRabbitMQOptional requestId = + \case + Nothing -> interpretBackgroundJobsPublisherNoConfig + Just channelRef -> + runInputSem (readMVar channelRef) + . interpretBackgroundJobsPublisherRabbitMQ requestId + . raiseUnder + +interpretBackgroundJobsPublisherRabbitMQ :: + ( Member (Embed IO) r, + Member (Input Q.Channel) r + ) => + RequestId -> + InterpreterFor BackgroundJobsPublisher r +interpretBackgroundJobsPublisherRabbitMQ requestId = + interpret $ \case + PublishJob jobId jobPayload -> do + channel <- input + publishJob requestId channel jobId jobPayload + +publishJob :: + ( Member (Embed IO) r + ) => + RequestId -> + Q.Channel -> + JobId -> + JobPayload -> + Sem r () +publishJob requestId channel jobId jobPayload = do + let job = + Job + { payload = jobPayload, + jobId = jobId, + requestId = requestId + } + msg = + Q.newMsg + { Q.msgBody = Aeson.encode job, + Q.msgContentType = Just "application/json", + Q.msgID = Just (idToText job.jobId), + Q.msgCorrelationID = Just $ T.decodeUtf8 job.requestId.unRequestId + } + + liftIO $ do + ensureBackgroundJobsQueue channel + -- Passing "" for `exchangeName` publishes to the default exchange in RabbitMQ. + -- The default exchange routes directly to the queue whose name equals the `routingKey`. + void $ Q.publishMsg channel "" backgroundJobsRoutingKey msg diff --git a/libs/wire-subsystems/src/Wire/BackgroundJobsRunner.hs b/libs/wire-subsystems/src/Wire/BackgroundJobsRunner.hs new file mode 100644 index 0000000000..4515563ef1 --- /dev/null +++ b/libs/wire-subsystems/src/Wire/BackgroundJobsRunner.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE TemplateHaskell #-} + +module Wire.BackgroundJobsRunner where + +import Polysemy +import Wire.API.BackgroundJobs (Job) + +data BackgroundJobsRunner m a where + RunJob :: Job -> BackgroundJobsRunner m () + +makeSem ''BackgroundJobsRunner diff --git a/libs/wire-subsystems/src/Wire/BackgroundJobsRunner/Interpreter.hs b/libs/wire-subsystems/src/Wire/BackgroundJobsRunner/Interpreter.hs new file mode 100644 index 0000000000..f521ffcaf4 --- /dev/null +++ b/libs/wire-subsystems/src/Wire/BackgroundJobsRunner/Interpreter.hs @@ -0,0 +1,143 @@ +{-# LANGUAGE RecordWildCards #-} + +module Wire.BackgroundJobsRunner.Interpreter where + +import Data.ByteString.Conversion (toByteString) +import Data.Default +import Data.Id +import Data.List.NonEmpty (nonEmpty) +import Data.Qualified +import Data.Set qualified as Set +import Data.Singletons +import Data.Vector qualified as V +import Imports +import Polysemy +import Polysemy.Input +import Polysemy.TinyLog (TinyLog) +import Polysemy.TinyLog qualified as Log +import System.Logger.Message (field, msg, val) +import Wire.API.BackgroundJobs +import Wire.API.Conversation (ConversationJoin (..), JoinType (ExternalAdd)) +import Wire.API.Conversation.Action.Tag +import Wire.API.Conversation.Role (roleNameWireMember) +import Wire.API.UserGroup +import Wire.BackgroundJobsPublisher +import Wire.BackgroundJobsRunner (BackgroundJobsRunner (..)) +import Wire.ConversationStore (ConversationStore, getConversation, upsertMembers) +import Wire.ConversationSubsystem +import Wire.Sem.Random +import Wire.StoredConversation +import Wire.UserGroupStore (UserGroupStore, getUserGroup, getUserGroupChannels) +import Wire.UserList (toUserList) + +interpretBackgroundJobsRunner :: + ( Member UserGroupStore r, + Member BackgroundJobsPublisher r, + Member (Input (Local ())) r, + Member ConversationStore r, + Member ConversationSubsystem r, + Member Random r, + Member TinyLog r + ) => + InterpreterFor BackgroundJobsRunner r +interpretBackgroundJobsRunner = interpret $ \case + RunJob job -> runJob job + +runJob :: + ( Member UserGroupStore r, + Member BackgroundJobsPublisher r, + Member (Input (Local ())) r, + Member ConversationStore r, + Member ConversationSubsystem r, + Member Random r, + Member TinyLog r + ) => + Job -> + Sem r () +runJob job = case job.payload of + JobSyncUserGroupAndChannel payload -> runSyncUserGroupAndChannel job.jobId job.requestId payload + JobSyncUserGroup payload -> runSyncUserGroup job.jobId job.requestId payload + +runSyncUserGroupAndChannel :: + ( Member UserGroupStore r, + Member (Input (Local ())) r, + Member ConversationStore r, + Member ConversationSubsystem r, + Member TinyLog r + ) => + JobId -> + RequestId -> + SyncUserGroupAndChannel -> + Sem r () +runSyncUserGroupAndChannel _ _ (SyncUserGroupAndChannel {..}) = do + loc <- input + mUserGroup <- getUserGroup teamId userGroupId False + when (isNothing mUserGroup) $ + Log.warn $ + field "team" (toByteString teamId) + . field "user_group" (toByteString userGroupId) + . field "conv" (toByteString convId) + . msg (val "User group not found for sync") + mConv <- getConversation convId + when (isNothing mConv) $ + Log.warn $ + field "conv" (toByteString convId) + . field "team" (toByteString teamId) + . field "user_group" (toByteString userGroupId) + . msg (val "Conversation not found for sync") + for_ mConv $ \conv -> do + let usersFromGroup = foldMap (runIdentity . (.members)) mUserGroup + (botMembers, localMembers) = localBotsAndUsers conv.localMembers + usersNotInConv = V.filter (\u -> u `notElem` fmap (.id_) localMembers) usersFromGroup + + for_ (nonEmpty . V.toList $ usersNotInConv) $ \usersUnqualified -> do + let role = roleNameWireMember + users = fmap (flip Qualified (tDomain loc)) usersUnqualified + userList = toUserList loc users + action = ConversationJoin {joinType = ExternalAdd, ..} + + -- TODO: how are we going to deal with conversation member limit, which affects the fan out of notifications here? + (extraLocals, extraRemotes) <- upsertMembers convId (fmap (,role) userList) + void $ + notifyConversationAction + (sing @'ConversationJoinTag) + (Qualified actor (tDomain loc)) + False + Nothing + (loc $> conv) + (Set.fromList $ fmap (.id_) (localMembers <> extraLocals)) + (Set.fromList $ fmap (.id_) (conv.remoteMembers <> extraRemotes)) + (Set.fromList botMembers) + action + def + +localBotsAndUsers :: (Foldable f) => f LocalMember -> ([BotMember], [LocalMember]) +localBotsAndUsers = foldMap botOrUser + where + botOrUser m = case m.service of + -- we drop invalid bots here, which shouldn't happen + Just _ -> (toList (newBotMember m), []) + Nothing -> ([], [m]) + +runSyncUserGroup :: + ( Member UserGroupStore r, + Member BackgroundJobsPublisher r, + Member Random r, + Member TinyLog r + ) => + JobId -> + RequestId -> + SyncUserGroup -> + Sem r () +runSyncUserGroup _ _ SyncUserGroup {..} = do + mChannels <- getUserGroupChannels teamId userGroupId + when (isNothing mChannels) $ + Log.warn $ + field "team" (toByteString teamId) + . field "user_group" (toByteString userGroupId) + . msg (val "No channels found for user group") + let channels = fromMaybe mempty mChannels + for_ channels $ \convId -> do + let syncUserGroupAndChannel = SyncUserGroupAndChannel {..} + jobId <- newId + publishJob jobId (JobSyncUserGroupAndChannel syncUserGroupAndChannel) diff --git a/libs/wire-subsystems/src/Wire/ConversationStore.hs b/libs/wire-subsystems/src/Wire/ConversationStore.hs index 0bd1191278..65ca5e1e7c 100644 --- a/libs/wire-subsystems/src/Wire/ConversationStore.hs +++ b/libs/wire-subsystems/src/Wire/ConversationStore.hs @@ -19,10 +19,12 @@ module Wire.ConversationStore where +import Data.Aeson import Data.Id import Data.Misc import Data.Qualified import Data.Range +import Data.Text qualified as Text import Data.Time.Clock import Imports import Polysemy @@ -143,3 +145,21 @@ acceptConnectConversation cid = setConversationType cid One2OneConv -- | Add a member to a local conversation, as an admin. upsertMember :: (Member ConversationStore r) => Local ConvId -> Local UserId -> Sem r [LocalMember] upsertMember c u = fst <$> upsertMembers (tUnqualified c) (UserList [(tUnqualified u, roleNameWireAdmin)] []) + +data StorageLocation = CassandraStorage | PostgresqlStorage + deriving (Show, Eq) + +instance FromJSON StorageLocation where + parseJSON = withText "StorageLocation" $ \case + "cassandra" -> pure CassandraStorage + "postgresql" -> pure PostgresqlStorage + x -> fail $ "Invalid storage location: " <> Text.unpack x <> ". Valid options: cassandra, postgresql" + +data PostgresMigrationOpts = PostgresMigrationOpts + { conversation :: StorageLocation + } + deriving (Show, Eq) + +instance FromJSON PostgresMigrationOpts where + parseJSON = withObject "PostgresMigrationOpts" $ \o -> + PostgresMigrationOpts <$> o .: "conversation" diff --git a/libs/wire-subsystems/src/Wire/ConversationSubsystem.hs b/libs/wire-subsystems/src/Wire/ConversationSubsystem.hs new file mode 100644 index 0000000000..cc7995ea0d --- /dev/null +++ b/libs/wire-subsystems/src/Wire/ConversationSubsystem.hs @@ -0,0 +1,29 @@ +{-# LANGUAGE TemplateHaskell #-} + +module Wire.ConversationSubsystem where + +import Data.Id +import Data.Qualified +import Data.Singletons (Sing) +import Imports +import Polysemy +import Wire.API.Conversation (ExtraConversationData) +import Wire.API.Conversation.Action +import Wire.NotificationSubsystem (LocalConversationUpdate) +import Wire.StoredConversation + +data ConversationSubsystem m a where + NotifyConversationAction :: + Sing tag -> + Qualified UserId -> + Bool -> + Maybe ConnId -> + Local StoredConversation -> + Set UserId -> + Set (Remote UserId) -> + Set BotMember -> + ConversationAction (tag :: ConversationActionTag) -> + ExtraConversationData -> + ConversationSubsystem r LocalConversationUpdate + +makeSem ''ConversationSubsystem diff --git a/libs/wire-subsystems/src/Wire/ConversationSubsystem/Interpreter.hs b/libs/wire-subsystems/src/Wire/ConversationSubsystem/Interpreter.hs new file mode 100644 index 0000000000..b46a27f650 --- /dev/null +++ b/libs/wire-subsystems/src/Wire/ConversationSubsystem/Interpreter.hs @@ -0,0 +1,116 @@ +module Wire.ConversationSubsystem.Interpreter where + +import Data.Default +import Data.Id +import Data.Json.Util (ToJSONObject (toJSONObject)) +import Data.Qualified +import Data.Singletons (Sing) +import Imports +import Network.AMQP qualified as Q +import Polysemy +import Polysemy.Error +import Wire.API.Conversation hiding (Member) +import Wire.API.Conversation.Action +import Wire.API.Conversation.CellsState (CellsState (..)) +import Wire.API.Event.Conversation +import Wire.API.Federation.API (makeConversationUpdateBundle, sendBundle) +import Wire.API.Federation.API.Galley.Notifications (ConversationUpdate (..)) +import Wire.API.Federation.Error (FederationError) +import Wire.API.Push.V2 qualified as PushV2 +import Wire.BackendNotificationQueueAccess (BackendNotificationQueueAccess, enqueueNotificationsConcurrently) +import Wire.ConversationSubsystem +import Wire.ExternalAccess (ExternalAccess, deliverAsync) +import Wire.NotificationSubsystem as NS +import Wire.Sem.Now (Now) +import Wire.Sem.Now qualified as Now +import Wire.StoredConversation + +interpretConversationSubsystem :: + ( Member (Error FederationError) r, + Member BackendNotificationQueueAccess r, + Member NotificationSubsystem r, + Member ExternalAccess r, + Member Now 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 + +notifyConversationActionImpl :: + forall tag r. + ( Member BackendNotificationQueueAccess r, + Member ExternalAccess r, + Member (Error FederationError) r, + Member Now r, + Member NotificationSubsystem r + ) => + Sing tag -> + Qualified UserId -> + Bool -> + Maybe ConnId -> + Local StoredConversation -> + Set UserId -> + Set (Remote UserId) -> + Set BotMember -> + ConversationAction (tag :: ConversationActionTag) -> + ExtraConversationData -> + Sem r LocalConversationUpdate +notifyConversationActionImpl tag quid notifyOrigDomain con lconv targetsLocal targetsRemote targetsBots action extraData = do + now <- Now.get + let lcnv = fmap (.id_) lconv + conv = tUnqualified lconv + tid = conv.metadata.cnvmTeam + e = conversationActionToEvent tag now quid (tUntagged lcnv) extraData Nothing tid action + mkUpdate uids = + ConversationUpdate + { time = now, + origUserId = quid, + convId = tUnqualified lcnv, + alreadyPresentUsers = uids, + action = SomeConversationAction tag action, + extraConversationData = Just extraData + } + update <- + fmap (fromMaybe (mkUpdate []) . asum . map tUnqualified) $ + enqueueNotificationsConcurrently Q.Persistent (toList targetsRemote) $ + \ruids -> do + let update = mkUpdate (tUnqualified ruids) + if notifyOrigDomain || tDomain ruids /= qDomain quid + then do + makeConversationUpdateBundle update >>= sendBundle + pure Nothing + else pure (Just update) + + pushConversationEvent con conv.metadata.cnvmCellsState e (qualifyAs lcnv targetsLocal) targetsBots + + pure $ LocalConversationUpdate {lcuEvent = e, lcuUpdate = update} + +pushConversationEvent :: + ( Member ExternalAccess r, + Member NotificationSubsystem r, + Foldable f + ) => + Maybe ConnId -> + CellsState -> + Event -> + Local (f UserId) -> + f BotMember -> + Sem r () +pushConversationEvent conn st e lusers bots = do + pushNotifications [(newConversationEventPush (fmap toList lusers)) {conn}] + deliverAsync (map (,e) (toList bots)) + where + newConversationEventPush :: Local [UserId] -> Push + newConversationEventPush users = + let musr = guard (tDomain users == qDomain e.evtFrom) $> qUnqualified e.evtFrom + in def + { origin = musr, + json = toJSONObject e, + recipients = map userRecipient (tUnqualified users), + isCellsEvent = shouldPushToCells st e + } + + userRecipient :: UserId -> Recipient + userRecipient u = Recipient {recipientUserId = u, recipientClients = PushV2.RecipientClientsAll} diff --git a/services/galley/src/Galley/Effects/ExternalAccess.hs b/libs/wire-subsystems/src/Wire/ExternalAccess.hs similarity index 93% rename from services/galley/src/Galley/Effects/ExternalAccess.hs rename to libs/wire-subsystems/src/Wire/ExternalAccess.hs index d54509d304..81d25fad4e 100644 --- a/services/galley/src/Galley/Effects/ExternalAccess.hs +++ b/libs/wire-subsystems/src/Wire/ExternalAccess.hs @@ -2,7 +2,7 @@ -- This file is part of the Wire Server implementation. -- --- Copyright (C) 2022 Wire Swiss GmbH +-- 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 @@ -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.ExternalAccess +module Wire.ExternalAccess ( -- * External access effect ExternalAccess (..), deliver, diff --git a/services/galley/src/Galley/External.hs b/libs/wire-subsystems/src/Wire/ExternalAccess/External.hs similarity index 61% rename from services/galley/src/Galley/External.hs rename to libs/wire-subsystems/src/Wire/ExternalAccess/External.hs index f4c0b04267..11b8a27874 100644 --- a/services/galley/src/Galley/External.hs +++ b/libs/wire-subsystems/src/Wire/ExternalAccess/External.hs @@ -1,6 +1,6 @@ -- This file is part of the Wire Server implementation. -- --- Copyright (C) 2022 Wire Swiss GmbH +-- 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 @@ -15,123 +15,162 @@ -- You should have received a copy of the GNU Affero General Public License along -- with this program. If not, see . -module Galley.External (interpretExternalAccess) where +module Wire.ExternalAccess.External (interpretExternalAccess, ExtEnv (..)) where import Bilge.Request import Bilge.Retry (httpHandlers) +import Control.Concurrent.Async (Async) +import Control.Exception (try) import Control.Lens import Control.Retry import Data.ByteString.Conversion.To import Data.Id import Data.Misc -import Galley.Cassandra.Services -import Galley.Cassandra.Util -import Galley.Effects -import Galley.Effects.ExternalAccess (ExternalAccess (..)) -import Galley.Effects.FireAndForget -import Galley.Env -import Galley.Monad import Imports import Network.HTTP.Client qualified as Http import Network.HTTP.Types.Method import Network.HTTP.Types.Status (status410) +import OpenSSL.Session qualified as Ssl import Polysemy -import Polysemy.Input +import Polysemy.Async qualified as Async import Polysemy.TinyLog import Ssl.Util (withVerifiedSslConnection) -import System.Logger.Class qualified as Log import System.Logger.Message (field, msg, val, (~~)) import URI.ByteString -import UnliftIO (Async, async, waitCatch) import Wire.API.Bot.Service import Wire.API.Event.Conversation (Event) import Wire.API.Provider.Service (serviceRefId, serviceRefProvider) import Wire.BrigAPIAccess +import Wire.ExternalAccess (ExternalAccess (..)) +import Wire.FireAndForget +import Wire.ServiceStore import Wire.StoredConversation (BotMember, botMemId, botMemService) +import Wire.Util + +data ExtEnv = ExtEnv + { extGetManager :: (Http.Manager, [Fingerprint Rsa] -> Ssl.SSL -> IO ()) + } interpretExternalAccess :: - ( Member (Embed IO) r, - Member (Input Env) r, - Member TinyLog r, + ( Member TinyLog r, Member BrigAPIAccess r, - Member FireAndForget r + Member FireAndForget r, + Member ServiceStore r, + Member (Final IO) r, + Member Async.Async r ) => + ExtEnv -> Sem (ExternalAccess ': r) a -> Sem r a -interpretExternalAccess = interpret $ \case +interpretExternalAccess env = interpret $ \case Deliver pp -> do logEffect "ExternalAccess.Deliver" - embedApp $ deliver (toList pp) + deliver env (toList pp) DeliverAsync pp -> do logEffect "ExternalAccess.DeliverAsync" - embedApp $ deliverAsync (toList pp) + deliverAsync env (toList pp) DeliverAndDeleteAsync cid pp -> do logEffect "ExternalAccess.DeliverAndDeleteAsync" - deliverAndDeleteAsync cid (toList pp) + deliverAndDeleteAsync env cid (toList pp) -- | Like deliver, but ignore orphaned bots and return immediately. -- -- FUTUREWORK: Check if this can be removed. -deliverAsync :: [(BotMember, Event)] -> App () -deliverAsync = void . forkIO . void . deliver +deliverAsync :: + ( Member FireAndForget r, + Member TinyLog r, + Member ServiceStore r, + Member (Final IO) r, + Member Async.Async r + ) => + ExtEnv -> + [(BotMember, Event)] -> + Sem r () +deliverAsync env = fireAndForget . void . deliver env -- | Like deliver, but remove orphaned bots and return immediately. -deliverAndDeleteAsync :: (Member (Input Env) r, Member (Embed IO) r, Member BrigAPIAccess r, Member FireAndForget r) => ConvId -> [(BotMember, Event)] -> Sem r () -deliverAndDeleteAsync cnv pushes = fireAndForget $ do - gone <- embedApp $ deliver pushes +deliverAndDeleteAsync :: + ( Member BrigAPIAccess r, + Member FireAndForget r, + Member TinyLog r, + Member ServiceStore r, + Member (Final IO) r, + Member Async.Async r + ) => + ExtEnv -> + ConvId -> + [(BotMember, Event)] -> + Sem r () +deliverAndDeleteAsync env cnv pushes = fireAndForget $ do + gone <- deliver env pushes mapM_ (deleteBot cnv . botMemId) gone -deliver :: [(BotMember, Event)] -> App [BotMember] -deliver pp = mapM (async . exec) pp >>= foldM eval [] . zip (map fst pp) +deliver :: + forall r. + ( Member ServiceStore r, + Member TinyLog r, + Member Async.Async r, + Member (Final IO) r + ) => + ExtEnv -> + [(BotMember, Event)] -> + Sem r [BotMember] +deliver env pp = mapM (Async.async . exec) pp >>= foldM eval [] . zip (map fst pp) where - exec :: (BotMember, Event) -> App Bool + exec :: (BotMember, Event) -> Sem r (Either SomeException Bool) exec (b, e) = - lookupService (botMemService b) >>= \case - Nothing -> pure False - Just s -> do - deliver1 s b e - pure True - eval :: [BotMember] -> (BotMember, Async Bool) -> App [BotMember] + getService (botMemService b) >>= \case + Nothing -> pure $ Right False + Just s -> + embedFinal $ try $ (deliver1 env s b e $> True) + eval :: [BotMember] -> (BotMember, Async (Maybe (Either SomeException Bool))) -> Sem r [BotMember] eval gone (b, a) = do let s = botMemService b - r <- waitCatch a + r <- Async.await a case r of - Right True -> do - Log.debug $ + Just (Right True) -> do + debug $ field "provider" (toByteString (s ^. serviceRefProvider)) ~~ field "service" (toByteString (s ^. serviceRefId)) ~~ field "bot" (toByteString (botMemId b)) ~~ msg (val "External delivery success") pure gone - Right False -> do - Log.debug $ + Just (Right False) -> do + debug $ field "provider" (toByteString (s ^. serviceRefProvider)) ~~ field "service" (toByteString (s ^. serviceRefId)) ~~ field "bot" (toByteString (botMemId b)) ~~ msg (val "External service gone") pure (b : gone) - Left ex + Just (Left ex) | Just (Http.HttpExceptionRequest _ (Http.StatusCodeException rs _)) <- fromException ex, Http.responseStatus rs == status410 -> do - Log.debug $ + debug $ field "provider" (toByteString (s ^. serviceRefProvider)) ~~ field "service" (toByteString (s ^. serviceRefId)) ~~ field "bot" (toByteString (botMemId b)) ~~ msg (val "External bot gone") pure (b : gone) - Left ex -> do - Log.info $ + Just (Left ex) -> do + info $ field "provider" (toByteString (s ^. serviceRefProvider)) ~~ field "service" (toByteString (s ^. serviceRefId)) ~~ field "bot" (toByteString (botMemId b)) ~~ field "error" (show ex) ~~ msg (val "External delivery failure") pure gone + Nothing -> do + info $ + field "provider" (toByteString (s ^. serviceRefProvider)) + ~~ field "service" (toByteString (s ^. serviceRefId)) + ~~ field "bot" (toByteString (botMemId b)) + ~~ msg (val "External delivery failure due to local error in Async") + pure gone -- Internal ------------------------------------------------------------------- -deliver1 :: Service -> BotMember -> Event -> App () -deliver1 s bm e +deliver1 :: ExtEnv -> Service -> BotMember -> Event -> IO () +deliver1 env s bm e | s ^. serviceEnabled = do let t = toByteString' (s ^. serviceToken) let u = s ^. serviceUrl @@ -139,7 +178,7 @@ deliver1 s bm e let HttpsUrl url = u recovering x3 httpHandlers $ const $ - sendMessage (s ^. serviceFingerprints) $ + sendMessage env (s ^. serviceFingerprints) $ method POST . maybe id host (urlHost u) . maybe (port 443) port (urlPort u) @@ -160,9 +199,9 @@ urlPort (HttpsUrl u) = do p <- a ^. authorityPortL pure (fromIntegral (p ^. portNumberL)) -sendMessage :: [Fingerprint Rsa] -> (Request -> Request) -> App () -sendMessage fprs reqBuilder = do - (man, verifyFingerprints) <- view (extEnv . extGetManager) +sendMessage :: ExtEnv -> [Fingerprint Rsa] -> (Request -> Request) -> IO () +sendMessage env fprs reqBuilder = do + let (man, verifyFingerprints) = env.extGetManager liftIO . withVerifiedSslConnection (verifyFingerprints fprs) man reqBuilder $ \req -> Http.withResponse req man (const $ pure ()) diff --git a/services/galley/src/Galley/Effects/FireAndForget.hs b/libs/wire-subsystems/src/Wire/FireAndForget.hs similarity index 94% rename from services/galley/src/Galley/Effects/FireAndForget.hs rename to libs/wire-subsystems/src/Wire/FireAndForget.hs index b78264acaf..bcc2ebdfa0 100644 --- a/services/galley/src/Galley/Effects/FireAndForget.hs +++ b/libs/wire-subsystems/src/Wire/FireAndForget.hs @@ -2,7 +2,7 @@ -- This file is part of the Wire Server implementation. -- --- Copyright (C) 2022 Wire Swiss GmbH +-- 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 @@ -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.FireAndForget +module Wire.FireAndForget ( FireAndForget, fireAndForget, spawnMany, diff --git a/libs/wire-subsystems/src/Wire/NotificationSubsystem.hs b/libs/wire-subsystems/src/Wire/NotificationSubsystem.hs index c2d7d8118c..735dd5c300 100644 --- a/libs/wire-subsystems/src/Wire/NotificationSubsystem.hs +++ b/libs/wire-subsystems/src/Wire/NotificationSubsystem.hs @@ -8,6 +8,8 @@ import Data.Default import Data.Id import Imports import Polysemy +import Wire.API.Event.Conversation +import Wire.API.Federation.API.Galley.Notifications (ConversationUpdate) import Wire.API.Push.V2 hiding (Push (..), Recipient, newPush) import Wire.Arbitrary @@ -32,6 +34,12 @@ data Push = Push deriving stock (Eq, Generic, Show) deriving (Arbitrary) via GenericUniform Push +data LocalConversationUpdate = LocalConversationUpdate + { lcuEvent :: Event, + lcuUpdate :: ConversationUpdate + } + deriving (Show) + -- | This subsystem governs mechanisms to send notifications to users. data NotificationSubsystem m a where -- | Bulk push notifications diff --git a/libs/wire-subsystems/src/Wire/NotificationSubsystem/Interpreter.hs b/libs/wire-subsystems/src/Wire/NotificationSubsystem/Interpreter.hs index e3dbcec587..63d1a05969 100644 --- a/libs/wire-subsystems/src/Wire/NotificationSubsystem/Interpreter.hs +++ b/libs/wire-subsystems/src/Wire/NotificationSubsystem/Interpreter.hs @@ -1,9 +1,9 @@ module Wire.NotificationSubsystem.Interpreter where -import Bilge (RequestId) import Control.Concurrent.Async (Async) import Control.Lens (set, (.~)) import Data.Aeson +import Data.Id import Data.List1 (List1) import Data.List1 qualified as List1 import Data.Proxy @@ -21,10 +21,10 @@ import Polysemy.TinyLog qualified as P import System.Logger.Class as Log import Wire.API.Push.V2 hiding (Push (..), Recipient, newPush) import Wire.API.Push.V2 qualified as V2 -import Wire.API.Team.Member +import Wire.API.Team.HardTruncationLimit (HardTruncationLimit) import Wire.GundeckAPIAccess (GundeckAPIAccess) import Wire.GundeckAPIAccess qualified as GundeckAPIAccess -import Wire.NotificationSubsystem +import Wire.NotificationSubsystem as NS import Wire.Sem.Delay -- | We interpret this using 'GundeckAPIAccess' so we can mock it out for testing. @@ -155,7 +155,7 @@ chunkPushes maxRecipients splitPush :: Natural -> Push -> (Push, Push) splitPush n p = let (r1, r2) = splitAt (fromIntegral n) (toList p.recipients) - in (p {recipients = r1}, p {recipients = r2}) + in (p {NS.recipients = r1}, p {NS.recipients = r2}) pushSlowlyImpl :: ( Member Delay r, diff --git a/services/galley/src/Galley/Effects/ServiceStore.hs b/libs/wire-subsystems/src/Wire/ServiceStore.hs similarity index 97% rename from services/galley/src/Galley/Effects/ServiceStore.hs rename to libs/wire-subsystems/src/Wire/ServiceStore.hs index 18949b7a47..80d9cc5bdb 100644 --- a/services/galley/src/Galley/Effects/ServiceStore.hs +++ b/libs/wire-subsystems/src/Wire/ServiceStore.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.ServiceStore +module Wire.ServiceStore ( -- * Service effect ServiceStore (..), diff --git a/services/galley/src/Galley/Cassandra/Services.hs b/libs/wire-subsystems/src/Wire/ServiceStore/Cassandra.hs similarity index 52% rename from services/galley/src/Galley/Cassandra/Services.hs rename to libs/wire-subsystems/src/Wire/ServiceStore/Cassandra.hs index 45ab448883..780df8f804 100644 --- a/services/galley/src/Galley/Cassandra/Services.hs +++ b/libs/wire-subsystems/src/Wire/ServiceStore/Cassandra.hs @@ -1,54 +1,36 @@ --- 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.Cassandra.Services where +module Wire.ServiceStore.Cassandra where import Cassandra +import Cassandra qualified as C import Control.Lens -import Galley.Cassandra.Queries -import Galley.Cassandra.Store -import Galley.Cassandra.Util -import Galley.Effects.ServiceStore hiding (deleteService) +import Data.Id +import Data.Misc import Imports import Polysemy -import Polysemy.Input import Polysemy.TinyLog import Wire.API.Bot.Service qualified as Bot +import Wire.API.Provider import Wire.API.Provider.Service hiding (DeleteService) - --- Service -------------------------------------------------------------------- +import Wire.ServiceStore (ServiceStore (..)) +import Wire.Util interpretServiceStoreToCassandra :: ( Member (Embed IO) r, - Member (Input ClientState) r, Member TinyLog r ) => + ClientState -> Sem (ServiceStore ': r) a -> Sem r a -interpretServiceStoreToCassandra = interpret $ \case +interpretServiceStoreToCassandra cassClient = interpret $ \case CreateService s -> do logEffect "ServiceStore.CreateService" - embedClient $ insertService s + embedClient cassClient $ insertService s GetService sr -> do logEffect "ServiceStore.GetService" - embedClient $ lookupService sr + embedClient cassClient $ lookupService sr DeleteService sr -> do logEffect "ServiceStore.DeleteService" - embedClient $ deleteService sr + embedClient cassClient $ deleteService sr insertService :: (MonadClient m) => Bot.Service -> m () insertService s = do @@ -70,3 +52,12 @@ lookupService s = deleteService :: (MonadClient m) => ServiceRef -> m () deleteService s = retry x5 (write rmSrv (params LocalQuorum (s ^. serviceRefProvider, s ^. serviceRefId))) + +rmSrv :: PrepQuery W (ProviderId, ServiceId) () +rmSrv = "delete from service where provider = ? AND id = ?" + +insertSrv :: PrepQuery W (ProviderId, ServiceId, HttpsUrl, ServiceToken, C.Set (Fingerprint Rsa), Bool) () +insertSrv = "insert into service (provider, id, base_url, auth_token, fingerprints, enabled) values (?, ?, ?, ?, ?, ?)" + +selectSrv :: PrepQuery R (ProviderId, ServiceId) (HttpsUrl, ServiceToken, C.Set (Fingerprint Rsa), Bool) +selectSrv = "select base_url, auth_token, fingerprints, enabled from service where provider = ? AND id = ?" diff --git a/libs/wire-subsystems/src/Wire/StoredConversation.hs b/libs/wire-subsystems/src/Wire/StoredConversation.hs index 71a5f7b024..d69dc4757e 100644 --- a/libs/wire-subsystems/src/Wire/StoredConversation.hs +++ b/libs/wire-subsystems/src/Wire/StoredConversation.hs @@ -35,6 +35,9 @@ data StoredConversation = StoredConversation } deriving (Show) +instance HasCellsState StoredConversation where + getCellsState = getCellsState . (.metadata) + type ConvRowWithId = ( ConvId, ConvType, diff --git a/libs/wire-subsystems/src/Wire/UserGroupStore.hs b/libs/wire-subsystems/src/Wire/UserGroupStore.hs index 98a1fd7d8f..ea49cd2943 100644 --- a/libs/wire-subsystems/src/Wire/UserGroupStore.hs +++ b/libs/wire-subsystems/src/Wire/UserGroupStore.hs @@ -44,5 +44,6 @@ data UserGroupStore m a where AddUserGroupChannels :: UserGroupId -> Vector ConvId -> UserGroupStore m () UpdateUserGroupChannels :: UserGroupId -> Vector ConvId -> UserGroupStore m () GetUserGroupIdsForUsers :: [UserId] -> UserGroupStore m (Map UserId [UserGroupId]) + GetUserGroupChannels :: TeamId -> UserGroupId -> UserGroupStore m (Maybe (Vector ConvId)) makeSem ''UserGroupStore diff --git a/libs/wire-subsystems/src/Wire/UserGroupStore/Postgres.hs b/libs/wire-subsystems/src/Wire/UserGroupStore/Postgres.hs index 2deb4b5db7..53c74e0c36 100644 --- a/libs/wire-subsystems/src/Wire/UserGroupStore/Postgres.hs +++ b/libs/wire-subsystems/src/Wire/UserGroupStore/Postgres.hs @@ -56,6 +56,7 @@ interpretUserGroupStoreToPostgres = AddUserGroupChannels gid convIds -> updateUserGroupChannels True gid convIds UpdateUserGroupChannels gid convIds -> updateUserGroupChannels False gid convIds GetUserGroupIdsForUsers uids -> getUserGroupIdsForUsers uids + GetUserGroupChannels tid gid -> getUserGroupChannels tid gid getUserGroupIdsForUsers :: (UserGroupStorePostgresEffectConstraints r) => [UserId] -> Sem r (Map UserId [UserGroupId]) getUserGroupIdsForUsers uidsList = do @@ -433,6 +434,35 @@ updateUserGroupChannels appendOnly gid convIds = do on conflict (user_group_id, conv_id) do nothing |] +getUserGroupChannels :: + forall r. + (UserGroupStorePostgresEffectConstraints r) => + TeamId -> + UserGroupId -> + Sem r (Maybe (Vector ConvId)) +getUserGroupChannels tid gid = do + pool <- input + result <- liftIO $ use pool session + either throw pure result + where + session :: Session (Maybe (Vector ConvId)) + session = do + mbUuids <- statement (gid, tid) getChannelsStatement + pure (fmap (fmap Id) mbUuids) + + getChannelsStatement :: Statement (UserGroupId, TeamId) (Maybe (Vector UUID)) + getChannelsStatement = + lmap (\(g, t) -> (g.toUUID, t.toUUID)) $ + [maybeStatement| + select + coalesce( + (select array_agg(ugc.conv_id) from user_group_channel ugc where ugc.user_group_id = ug.id), + array[]::uuid[] + ) :: uuid[] + from user_group ug + where ug.id = ($1 :: uuid) and ug.team_id = ($2 :: uuid) + |] + crudUser :: forall r. (UserGroupStorePostgresEffectConstraints r) => diff --git a/libs/wire-subsystems/src/Wire/UserGroupSubsystem/Interpreter.hs b/libs/wire-subsystems/src/Wire/UserGroupSubsystem/Interpreter.hs index 151152b12b..1af84cff5b 100644 --- a/libs/wire-subsystems/src/Wire/UserGroupSubsystem/Interpreter.hs +++ b/libs/wire-subsystems/src/Wire/UserGroupSubsystem/Interpreter.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE RecordWildCards #-} + module Wire.UserGroupSubsystem.Interpreter where import Control.Error (MaybeT (..)) @@ -12,6 +14,7 @@ import Imports import Polysemy import Polysemy.Error import Polysemy.Input (Input, input) +import Wire.API.BackgroundJobs import Wire.API.Conversation qualified as Conversation import Wire.API.Error import Wire.API.Error.Brig qualified as E @@ -23,10 +26,12 @@ import Wire.API.User import Wire.API.UserEvent import Wire.API.UserGroup import Wire.API.UserGroup.Pagination +import Wire.BackgroundJobsPublisher import Wire.Error import Wire.GalleyAPIAccess (GalleyAPIAccess, internalGetConversation) import Wire.NotificationSubsystem import Wire.PaginationState +import Wire.Sem.Random qualified as Random import Wire.TeamSubsystem import Wire.UserGroupStore (UserGroupPageRequest (..)) import Wire.UserGroupStore qualified as Store @@ -34,13 +39,15 @@ import Wire.UserGroupSubsystem (GroupSearch (..), UserGroupSubsystem (..)) import Wire.UserSubsystem (UserSubsystem, getLocalUserProfiles, getUserTeam) interpretUserGroupSubsystem :: - ( Member UserSubsystem r, + ( Member Random.Random r, + Member UserSubsystem r, Member (Error UserGroupSubsystemError) r, Member Store.UserGroupStore r, Member (Input (Local ())) r, Member NotificationSubsystem r, Member TeamSubsystem r, - Member GalleyAPIAccess r + Member GalleyAPIAccess r, + Member BackgroundJobsPublisher r ) => InterpreterFor UserGroupSubsystem r interpretUserGroupSubsystem = interpret $ \case @@ -73,12 +80,14 @@ userGroupSubsystemErrorToHttpError = UserGroupChannelNotFound -> errorToWai @E.UserGroupChannelNotFound createUserGroup :: - ( Member UserSubsystem r, + ( Member Random.Random r, + Member UserSubsystem r, Member (Error UserGroupSubsystemError) r, Member Store.UserGroupStore r, Member (Input (Local ())) r, Member NotificationSubsystem r, - Member TeamSubsystem r + Member TeamSubsystem r, + Member BackgroundJobsPublisher r ) => UserId -> NewUserGroup -> @@ -99,6 +108,7 @@ createUserGroup creator newGroup = do pushNotifications [ mkEvent creator (UserGroupCreated ug.id_) admins ] + triggerSyncUserGroup team creator ug.id_ pure ug getTeamAsAdmin :: @@ -245,11 +255,13 @@ deleteGroup deleter groupId = throw UserGroupNotATeamAdmin addUser :: - ( Member UserSubsystem r, + ( Member Random.Random r, + Member UserSubsystem r, Member Store.UserGroupStore r, Member (Error UserGroupSubsystemError) r, Member NotificationSubsystem r, - Member TeamSubsystem r + Member TeamSubsystem r, + Member BackgroundJobsPublisher r ) => UserId -> UserGroupId -> @@ -265,13 +277,16 @@ addUser adder groupId addeeId = do pushNotifications [ mkEvent adder (UserGroupUpdated groupId) admins ] + triggerSyncUserGroup team adder groupId addUsers :: - ( Member UserSubsystem r, + ( Member Random.Random r, + Member UserSubsystem r, Member Store.UserGroupStore r, Member (Error UserGroupSubsystemError) r, Member NotificationSubsystem r, - Member TeamSubsystem r + Member TeamSubsystem r, + Member BackgroundJobsPublisher r ) => UserId -> UserGroupId -> @@ -291,12 +306,16 @@ addUsers adder groupId addeeIds = do [ mkEvent adder (UserGroupUpdated groupId) admins ] + triggerSyncUserGroup team adder groupId + updateUsers :: - ( Member UserSubsystem r, + ( Member Random.Random r, + Member UserSubsystem r, Member Store.UserGroupStore r, Member (Error UserGroupSubsystemError) r, Member NotificationSubsystem r, - Member TeamSubsystem r + Member TeamSubsystem r, + Member BackgroundJobsPublisher r ) => UserId -> UserGroupId -> @@ -312,13 +331,16 @@ updateUsers updater groupId uids = do pushNotifications [ mkEvent updater (UserGroupUpdated groupId) admins ] + triggerSyncUserGroup team updater groupId removeUser :: - ( Member UserSubsystem r, + ( Member Random.Random r, + Member UserSubsystem r, Member Store.UserGroupStore r, Member (Error UserGroupSubsystemError) r, Member NotificationSubsystem r, - Member TeamSubsystem r + Member TeamSubsystem r, + Member BackgroundJobsPublisher r ) => UserId -> UserGroupId -> @@ -334,6 +356,7 @@ removeUser remover groupId removeeId = do pushNotifications [ mkEvent remover (UserGroupUpdated groupId) admins ] + triggerSyncUserGroup team remover groupId removeUserFromAllGroups :: ( Member Store.UserGroupStore r, @@ -372,12 +395,14 @@ removeUserFromAllGroups uid tid = do } updateChannels :: - ( Member UserSubsystem r, + ( Member Random.Random r, + Member UserSubsystem r, Member Store.UserGroupStore r, Member (Error UserGroupSubsystemError) r, Member TeamSubsystem r, Member NotificationSubsystem r, - Member GalleyAPIAccess r + Member GalleyAPIAccess r, + Member BackgroundJobsPublisher r ) => Bool -> UserId -> @@ -392,11 +417,26 @@ updateChannels appendOnly performer groupId channelIds = do let meta = conv.metadata unless (meta.cnvmTeam == Just teamId && meta.cnvmGroupConvType == Just Conversation.Channel) $ throw UserGroupChannelNotFound + if appendOnly then Store.addUserGroupChannels groupId channelIds else Store.updateUserGroupChannels groupId channelIds + triggerSyncUserGroup teamId performer groupId + admins <- fmap (^. TM.userId) . (^. teamMembers) <$> internalGetTeamAdmins teamId pushNotifications [ mkEvent performer (UserGroupUpdated groupId) admins ] + +triggerSyncUserGroup :: + ( Member Random.Random r, + Member BackgroundJobsPublisher r + ) => + TeamId -> + UserId -> + UserGroupId -> + Sem r () +triggerSyncUserGroup teamId actor userGroupId = do + jobId <- Random.newId + publishJob jobId $ JobSyncUserGroup SyncUserGroup {..} diff --git a/libs/wire-subsystems/test/unit/Wire/MockInterpreters/Random.hs b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/Random.hs index 6352edfe9d..870d813b0e 100644 --- a/libs/wire-subsystems/test/unit/Wire/MockInterpreters/Random.hs +++ b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/Random.hs @@ -14,6 +14,7 @@ randomToStatefulStdGen = interpret $ \case Bytes n -> do fromShort <$> withStatefulGen (genShortByteString n) Uuid -> withStatefulGen random + NewId -> Id <$> withStatefulGen random ScimTokenId -> Id <$> withStatefulGen random LiftRandom m -> do seedInt <- withStatefulGen (random @Int) diff --git a/libs/wire-subsystems/test/unit/Wire/MockInterpreters/UserGroupStore.hs b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/UserGroupStore.hs index 3a0746384b..c58f40bb9b 100644 --- a/libs/wire-subsystems/test/unit/Wire/MockInterpreters/UserGroupStore.hs +++ b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/UserGroupStore.hs @@ -70,6 +70,7 @@ userGroupStoreTestInterpreter = RemoveUser gid uid -> removeUserImpl gid uid AddUserGroupChannels gid convIds -> updateUserGroupChannelsImpl True gid convIds UpdateUserGroupChannels gid convIds -> updateUserGroupChannelsImpl False gid convIds + GetUserGroupChannels tid gid -> getUserGroupChannelsImpl tid gid GetUserGroupIdsForUsers uids -> getUserGroupIdsForUsersImpl uids getUserGroupIdsForUsersImpl :: (UserGroupStoreInMemEffectConstraints r) => [UserId] -> Sem r (Map UserId [UserGroupId]) @@ -233,6 +234,17 @@ listUserGroupChannelsImpl gid = foldMap (fmap qUnqualified) . ((.channels) . snd <=< find ((== gid) . snd . fst) . Map.toList) <$> get @(Map (TeamId, UserGroupId) UserGroup) +getUserGroupChannelsImpl :: + (UserGroupStoreInMemEffectConstraints r) => + TeamId -> + UserGroupId -> + Sem r (Maybe (Vector ConvId)) +getUserGroupChannelsImpl tid gid = do + st <- get @UserGroupInMemState + pure $ case st Map.!? (tid, gid) of + Nothing -> Nothing + Just ug -> fmap (fmap qUnqualified) ug.channels + ---------------------------------------------------------------------- modifyUserGroupsGidOnly :: diff --git a/libs/wire-subsystems/test/unit/Wire/UserGroupSubsystem/InterpreterSpec.hs b/libs/wire-subsystems/test/unit/Wire/UserGroupSubsystem/InterpreterSpec.hs index aa35062d5c..c57863e262 100644 --- a/libs/wire-subsystems/test/unit/Wire/UserGroupSubsystem/InterpreterSpec.hs +++ b/libs/wire-subsystems/test/unit/Wire/UserGroupSubsystem/InterpreterSpec.hs @@ -39,9 +39,13 @@ import Wire.API.UserEvent import Wire.API.UserGroup import Wire.API.UserGroup.Pagination import Wire.Arbitrary +import Wire.BackgroundJobsPublisher qualified as BackgroundJobsPublisher +import Wire.BackgroundJobsPublisher.Null qualified as BackgroundJobsPublisher import Wire.GalleyAPIAccess import Wire.MockInterpreters as Mock import Wire.NotificationSubsystem +import Wire.Sem.Random qualified as Random +import Wire.Sem.Random.Null qualified as Random import Wire.TeamSubsystem import Wire.TeamSubsystem.GalleyAPI import Wire.UserGroupSubsystem @@ -57,8 +61,10 @@ type AllDependencies = `Append` '[ Input (Local ()), MockNow, NotificationSubsystem, + BackgroundJobsPublisher.BackgroundJobsPublisher, State [Push], - Error UserGroupSubsystemError + Error UserGroupSubsystemError, + Random.Random ] runDependenciesFailOnError :: (HasCallStack) => [User] -> Map TeamId [TeamMember] -> Sem AllDependencies (IO ()) -> IO () @@ -71,8 +77,10 @@ runDependencies :: Either UserGroupSubsystemError a runDependencies initialUsers initialTeams = run + . Random.randomToNull . runError . evalState mempty + . BackgroundJobsPublisher.interpretBackgroundJobsPublisherNoConfig . inMemoryNotificationSubsystemInterpreter . evalState defaultTime . runInputConst (toLocalUnsafe (Domain "example.com") ()) @@ -88,8 +96,10 @@ runDependenciesWithReturnState :: Either UserGroupSubsystemError ([Push], a) runDependenciesWithReturnState initialUsers initialTeams = run + . Random.randomToNull . runError . runState mempty + . BackgroundJobsPublisher.interpretBackgroundJobsPublisherNoConfig . inMemoryNotificationSubsystemInterpreter . evalState defaultTime . runInputConst (toLocalUnsafe (Domain "example.com") ()) diff --git a/libs/wire-subsystems/wire-subsystems.cabal b/libs/wire-subsystems/wire-subsystems.cabal index a22d24a034..82604ed090 100644 --- a/libs/wire-subsystems/wire-subsystems.cabal +++ b/libs/wire-subsystems/wire-subsystems.cabal @@ -137,7 +137,9 @@ common common-all , servant , servant-client-core , servant-server + , singletons , sodium-crypto-sign + , ssl-util , statistics , stomp-queue , template @@ -182,6 +184,13 @@ library Wire.AuthenticationSubsystem.Interpreter Wire.AuthenticationSubsystem.ZAuth Wire.AWS + Wire.BackendNotificationQueueAccess + Wire.BackendNotificationQueueAccess.RabbitMq + Wire.BackgroundJobsPublisher + Wire.BackgroundJobsPublisher.Null + Wire.BackgroundJobsPublisher.RabbitMQ + Wire.BackgroundJobsRunner + Wire.BackgroundJobsRunner.Interpreter Wire.BlockListStore Wire.BlockListStore.Cassandra Wire.BrigAPIAccess @@ -192,6 +201,8 @@ library Wire.ConversationStore.Cassandra.Queries Wire.ConversationStore.MLS.Types Wire.ConversationStore.Postgres + Wire.ConversationSubsystem + Wire.ConversationSubsystem.Interpreter Wire.DeleteQueue Wire.DeleteQueue.InMemory Wire.DomainRegistrationStore @@ -210,10 +221,13 @@ library Wire.EnterpriseLoginSubsystem.Null Wire.Error Wire.Events + Wire.ExternalAccess + Wire.ExternalAccess.External Wire.FederationAPIAccess Wire.FederationAPIAccess.Interpreter Wire.FederationConfigStore Wire.FederationConfigStore.Cassandra + Wire.FireAndForget Wire.GalleyAPIAccess Wire.GalleyAPIAccess.Rpc Wire.GundeckAPIAccess @@ -248,6 +262,8 @@ library Wire.RateLimit Wire.RateLimit.Interpreter Wire.Rpc + Wire.ServiceStore + Wire.ServiceStore.Cassandra Wire.SessionStore Wire.SessionStore.Cassandra Wire.SparAPIAccess diff --git a/services/background-worker/background-worker.cabal b/services/background-worker/background-worker.cabal index 25079919e4..e3f7fde82e 100644 --- a/services/background-worker/background-worker.cabal +++ b/services/background-worker/background-worker.cabal @@ -16,6 +16,8 @@ library Wire.BackgroundWorker Wire.BackgroundWorker.Env Wire.BackgroundWorker.Health + Wire.BackgroundWorker.Jobs.Consumer + Wire.BackgroundWorker.Jobs.Registry Wire.BackgroundWorker.Options Wire.BackgroundWorker.Util Wire.DeadUserNotificationWatcher @@ -35,18 +37,25 @@ library , bytestring-conversion , cassandra-util , containers + , data-timeout , exceptions , extended + , extra + , hasql-pool , HsOpenSSL , http-client + , http-client-openssl , http2-manager , imports , metrics-wai , monad-control + , polysemy + , polysemy-wire-zoo , prometheus-client , retry , servant-client , servant-server + , ssl-util , text , tinylog , transformers @@ -56,6 +65,7 @@ library , wai-utilities , wire-api , wire-api-federation + , wire-subsystems default-extensions: AllowAmbiguousTypes @@ -205,6 +215,7 @@ test-suite background-worker-test , wai-utilities , wire-api , wire-api-federation + , wire-subsystems default-extensions: AllowAmbiguousTypes diff --git a/services/background-worker/background-worker.integration.yaml b/services/background-worker/background-worker.integration.yaml index 60dc23a926..e1a470d3bc 100644 --- a/services/background-worker/background-worker.integration.yaml +++ b/services/background-worker/background-worker.integration.yaml @@ -8,12 +8,34 @@ federatorInternal: host: 127.0.0.1 port: 8097 +brig: + host: 0.0.0.0 + port: 8082 + +gundeck: + host: 127.0.0.1 + port: 8086 + cassandra: endpoint: host: 127.0.0.1 port: 9042 keyspace: gundeck_test +cassandraBrig: + endpoint: + host: 127.0.0.1 + port: 9042 + keyspace: brig_test + +cassandraGalley: + endpoint: + host: 127.0.0.1 + port: 9042 + keyspace: galley_test + +domain: example.org + rabbitmq: host: 127.0.0.1 port: 5671 @@ -28,3 +50,25 @@ backendNotificationPusher: pushBackoffMinWait: 1000 # 1ms pushBackoffMaxWait: 1000000 # 1s remotesRefreshInterval: 10000 # 10ms + +# Background jobs consumer configuration for integration +backgroundJobs: + concurrency: 4 + jobTimeout: 5 + maxAttempts: 3 + +postgresql: + host: 127.0.0.1 + port: "5432" + user: wire-server + dbname: backendA + password: posty-the-gres + +postgresqlPool: + size: 20 + acquisitionTimeout: 10s + agingTimeout: 1d + idlenessTimeout: 10m + +postgresMigration: + conversation: postgresql diff --git a/services/background-worker/default.nix b/services/background-worker/default.nix index 7ef4b6ab45..9c4f5614c2 100644 --- a/services/background-worker/default.nix +++ b/services/background-worker/default.nix @@ -11,13 +11,17 @@ , cassandra-util , containers , data-default +, data-timeout , exceptions , extended +, extra , federator , gitignoreSource +, hasql-pool , HsOpenSSL , hspec , http-client +, http-client-openssl , http-media , http-types , http2-manager @@ -25,6 +29,8 @@ , lib , metrics-wai , monad-control +, polysemy +, polysemy-wire-zoo , prometheus-client , QuickCheck , retry @@ -32,6 +38,7 @@ , servant-client , servant-client-core , servant-server +, ssl-util , text , tinylog , transformers @@ -42,6 +49,7 @@ , wai-utilities , wire-api , wire-api-federation +, wire-subsystems }: mkDerivation { pname = "background-worker"; @@ -57,18 +65,25 @@ mkDerivation { bytestring-conversion cassandra-util containers + data-timeout exceptions extended + extra + hasql-pool HsOpenSSL http-client + http-client-openssl http2-manager imports metrics-wai monad-control + polysemy + polysemy-wire-zoo prometheus-client retry servant-client servant-server + ssl-util text tinylog transformers @@ -78,6 +93,7 @@ mkDerivation { wai-utilities wire-api wire-api-federation + wire-subsystems ]; executableHaskellDepends = [ HsOpenSSL imports types-common ]; testHaskellDepends = [ @@ -109,6 +125,7 @@ mkDerivation { wai-utilities wire-api wire-api-federation + wire-subsystems ]; description = "Runs background work"; license = lib.licenses.agpl3Only; diff --git a/services/background-worker/src/Wire/BackgroundWorker.hs b/services/background-worker/src/Wire/BackgroundWorker.hs index e6110fb438..b1aeb9789f 100644 --- a/services/background-worker/src/Wire/BackgroundWorker.hs +++ b/services/background-worker/src/Wire/BackgroundWorker.hs @@ -14,6 +14,7 @@ import Util.Options import Wire.BackendNotificationPusher qualified as BackendNotificationPusher import Wire.BackgroundWorker.Env import Wire.BackgroundWorker.Health qualified as Health +import Wire.BackgroundWorker.Jobs.Consumer qualified as Jobs import Wire.BackgroundWorker.Options import Wire.DeadUserNotificationWatcher qualified as DeadUserNotificationWatcher @@ -23,16 +24,20 @@ run opts = do let amqpEP = either id demoteOpts opts.rabbitmq.unRabbitMqOpts cleanupBackendNotifPusher <- runAppT env $ - withNamedLogger "backend-notifcation-pusher" $ + withNamedLogger "backend-notification-pusher" $ BackendNotificationPusher.startWorker amqpEP cleanupDeadUserNotifWatcher <- runAppT env $ withNamedLogger "dead-user-notification-watcher" $ DeadUserNotificationWatcher.startWorker amqpEP + cleanupJobs <- + runAppT env $ + withNamedLogger "background-job-consumer" $ + Jobs.startWorker amqpEP let -- cleanup will run in a new thread when the signal is caught, so we need to use IORefs and -- specific exception types to message threads to clean up cleanup = do - concurrently_ cleanupDeadUserNotifWatcher cleanupBackendNotifPusher + concurrently_ cleanupDeadUserNotifWatcher (concurrently_ cleanupBackendNotifPusher cleanupJobs) let server = defaultServer (T.unpack $ opts.backgroundWorker.host) opts.backgroundWorker.port env.logger let settings = newSettings server -- Additional cleanup when shutting down via signals. diff --git a/services/background-worker/src/Wire/BackgroundWorker/Env.hs b/services/background-worker/src/Wire/BackgroundWorker/Env.hs index 93711e9d9b..d843b5e737 100644 --- a/services/background-worker/src/Wire/BackgroundWorker/Env.hs +++ b/services/background-worker/src/Wire/BackgroundWorker/Env.hs @@ -8,9 +8,13 @@ import Cassandra.Util (defInitCassandra) import Control.Monad.Base import Control.Monad.Catch import Control.Monad.Trans.Control +import Data.Domain (Domain) import Data.Map.Strict qualified as Map import HTTP2.Client.Manager +import Hasql.Pool qualified as HasqlPool +import Hasql.Pool.Extended (initPostgresPool) import Imports +import Network.AMQP qualified as Q import Network.AMQP.Extended import Network.HTTP.Client import Network.RabbitMqAdmin qualified as RabbitMqAdmin @@ -23,6 +27,7 @@ import System.Logger.Class (Logger, MonadLogger (..)) import System.Logger.Extended qualified as Log import Util.Options import Wire.BackgroundWorker.Options +import Wire.ConversationStore (PostgresMigrationOpts) type IsWorking = Bool @@ -30,12 +35,14 @@ type IsWorking = Bool data Worker = BackendNotificationPusher | DeadUserNotificationWatcher + | BackgroundJobConsumer deriving (Eq, Ord) workerName :: Worker -> Text workerName = \case BackendNotificationPusher -> "backend-notification-pusher" DeadUserNotificationWatcher -> "dead-user-notification-watcher" + BackgroundJobConsumer -> "background-job-consumer" data Env = Env { http2Manager :: Http2Manager, @@ -47,9 +54,20 @@ data Env = Env defederationTimeout :: ResponseTimeout, backendNotificationMetrics :: BackendNotificationMetrics, backendNotificationsConfig :: BackendNotificationsConfig, + backgroundJobsConfig :: BackgroundJobsConfig, workerRunningGauge :: Vector Text Gauge, statuses :: IORef (Map Worker IsWorking), - cassandra :: ClientState + gundeckCassandra :: ClientState, + brigCassandra :: ClientState, + galleyCassandra :: ClientState, + hasqlPool :: HasqlPool.Pool, + -- Dedicated AMQP channels per concern + amqpJobsPublisherChannel :: MVar Q.Channel, + amqpBackendNotificationsChannel :: MVar Q.Channel, + domain :: Domain, + postgresMigration :: PostgresMigrationOpts, + gundeckEndpoint :: Endpoint, + brigEndpoint :: Endpoint } data BackendNotificationMetrics = BackendNotificationMetrics @@ -72,7 +90,9 @@ mkWorkerRunningGauge = mkEnv :: Opts -> IO Env mkEnv opts = do logger <- Log.mkLogger opts.logLevel Nothing opts.logFormat - cassandra <- defInitCassandra opts.cassandra logger + gundeckCassandra <- defInitCassandra opts.cassandra logger + brigCassandra <- defInitCassandra opts.cassandraBrig logger + galleyCassandra <- defInitCassandra opts.cassandraGalley logger http2Manager <- initHttp2Manager httpManager <- newManager defaultManagerSettings let federatorInternal = opts.federatorInternal @@ -86,11 +106,24 @@ mkEnv opts = do statuses <- newIORef $ Map.fromList - [ (BackendNotificationPusher, False) + [ (BackendNotificationPusher, False), + (BackgroundJobConsumer, False) ] backendNotificationMetrics <- mkBackendNotificationMetrics let backendNotificationsConfig = opts.backendNotificationPusher + backgroundJobsConfig = opts.backgroundJobs + domain = opts.domain + postgresMigration = opts.postgresMigration + brigEndpoint = opts.brig + gundeckEndpoint = opts.gundeck workerRunningGauge <- mkWorkerRunningGauge + hasqlPool <- initPostgresPool opts.postgresqlPool opts.postgresql opts.postgresqlPassword + amqpJobsPublisherChannel <- + mkRabbitMqChannelMVar logger (Just "background-worker-jobs-publisher") $ + either id demoteOpts opts.rabbitmq.unRabbitMqOpts + amqpBackendNotificationsChannel <- + mkRabbitMqChannelMVar logger (Just "background-worker-backend-notifications") $ + either id demoteOpts opts.rabbitmq.unRabbitMqOpts pure Env {..} initHttp2Manager :: IO Http2Manager diff --git a/services/background-worker/src/Wire/BackgroundWorker/Jobs/Consumer.hs b/services/background-worker/src/Wire/BackgroundWorker/Jobs/Consumer.hs new file mode 100644 index 0000000000..4ab007cca8 --- /dev/null +++ b/services/background-worker/src/Wire/BackgroundWorker/Jobs/Consumer.hs @@ -0,0 +1,121 @@ +{-# LANGUAGE RecordWildCards #-} + +module Wire.BackgroundWorker.Jobs.Consumer (startWorker, BackgroundJobsMetrics (..)) where + +import Control.Concurrent.Timeout qualified as Timeout +import Control.Retry +import Data.Aeson qualified as Aeson +import Data.Range (Range (fromRange)) +import Data.Timeout +import Imports +import Network.AMQP qualified as Q +import Network.AMQP.Extended +import Network.AMQP.Lifted qualified as QL +import Prometheus +import System.Logger.Class qualified as Log +import System.Time.Extra (duration) +import UnliftIO +import Wire.API.BackgroundJobs +import Wire.BackgroundWorker.Env +import Wire.BackgroundWorker.Jobs.Registry +import Wire.BackgroundWorker.Options +import Wire.BackgroundWorker.Util (CleanupAction) + +data BackgroundJobsMetrics = BackgroundJobsMetrics + { workersBusy :: Gauge, + concurrencyConfigured :: Gauge, + jobsReceived :: Vector Text Counter, + jobsStarted :: Vector Text Counter, + jobsSucceeded :: Vector Text Counter, + jobsFailed :: Vector Text Counter, + jobsInvalid :: Vector Text Counter, + jobsRedelivered :: Vector Text Counter, + jobDuration :: Vector Text Histogram + } + +mkMetrics :: IO BackgroundJobsMetrics +mkMetrics = do + workersBusy <- register (gauge $ Info {metricName = "wire_background_jobs_workers_busy", metricHelp = "In-flight background jobs"}) + concurrencyConfigured <- register (gauge $ Info {metricName = "wire_background_jobs_concurrency_configured", metricHelp = "Configured concurrency for this process"}) + jobsReceived <- register (vector "job_type" $ counter $ Info "wire_background_jobs_received_total" "Jobs received") + jobsStarted <- register (vector "job_type" $ counter $ Info "wire_background_jobs_started_total" "Jobs started") + jobsSucceeded <- register (vector "job_type" $ counter $ Info "wire_background_jobs_succeeded_total" "Jobs succeeded") + jobsFailed <- register (vector "job_type" $ counter $ Info "wire_background_jobs_failed_total" "Jobs failed") + jobsInvalid <- register (vector "job_type" $ counter $ Info "wire_background_jobs_invalid_total" "Invalid jobs received") + jobsRedelivered <- register (vector "job_type" $ counter $ Info "wire_background_jobs_redelivered_total" "Jobs marked redelivered by broker") + jobDuration <- register (vector "job_type" $ histogram (Info "wire_background_jobs_duration_seconds" "Job duration seconds") defaultBuckets) + pure BackgroundJobsMetrics {..} + +startWorker :: AmqpEndpoint -> AppT IO CleanupAction +startWorker rabbitmqOpts = do + env <- ask + let cfg = env.backgroundJobsConfig + metrics <- liftIO mkMetrics + markAsNotWorking BackgroundJobConsumer + void . async . liftIO $ + openConnectionWithRetries env.logger rabbitmqOpts (Just "background-job-consumer") $ + RabbitMqHooks + { onNewChannel = \chan -> do + -- declare queue and set prefetch to concurrency + ensureBackgroundJobsQueue chan + Q.qos chan 0 (fromIntegral $ fromRange cfg.concurrency) False + -- set gauges + setGauge metrics.concurrencyConfigured (fromIntegral $ fromRange cfg.concurrency) + -- start consuming with manual ack and keep the channel alive + void $ QL.consumeMsgs chan backgroundJobsQueueName Q.Ack (void . runAppT env . handleDelivery metrics cfg) + runAppT env $ markAsWorking BackgroundJobConsumer + forever $ threadDelay maxBound, + onChannelException = \_ -> do + -- mark not working; TODO: only log unexpected exceptions + runAppT env $ markAsNotWorking BackgroundJobConsumer, + onConnectionClose = + runAppT env $ do + markAsNotWorking BackgroundJobConsumer + Log.info $ Log.msg (Log.val "RabbitMQ connection closed for background job consumer") + } + pure $ runAppT env $ cleanup + where + cleanup :: AppT IO () + cleanup = do + -- nothing to close explicitly; the AMQP helper closes channel/connection on shutdown + Log.info $ Log.msg (Log.val "Background job consumer cleanup") + markAsNotWorking BackgroundJobConsumer + +handleDelivery :: BackgroundJobsMetrics -> BackgroundJobsConfig -> (Q.Message, Q.Envelope) -> AppT IO () +handleDelivery metrics cfg (msg, env) = do + case Aeson.eitherDecode @Job (Q.msgBody msg) of + Left err -> do + withLabel metrics.jobsInvalid "invalid" incCounter + Log.err $ Log.msg (Log.val "Invalid background job JSON") . Log.field "error" err + Timeout.threadDelay (200 # MilliSecond) -- avoid tight redelivery loop + liftIO $ Q.rejectEnv env True + Right job -> do + let lbl = jobPayloadLabel job.payload + when (Q.envRedelivered env) $ withLabel metrics.jobsRedelivered lbl incCounter + withLabel metrics.jobsReceived lbl incCounter + UnliftIO.bracket_ (incGauge metrics.workersBusy) (decGauge metrics.workersBusy) $ do + outcome <- runAttempts lbl job + case outcome of + Right () -> do + withLabel metrics.jobsSucceeded lbl incCounter + liftIO $ Q.ackEnv env + Left e -> do + withLabel metrics.jobsFailed lbl incCounter + Log.err $ Log.msg (Log.val "Background job failed after retries") . Log.field "error" e + liftIO $ Q.rejectEnv env False + where + runAttempts :: Text -> Job -> AppT IO (Either Text ()) + runAttempts lbl job = do + let retries = max 0 (fromRange cfg.maxAttempts - 1) + policy = limitRetries retries <> fullJitterBackoff 100000 -- 100ms base + retrying policy shouldRetry $ \_rs -> do + withLabel metrics.jobsStarted lbl incCounter + (dur, r) <- + duration $ + fromMaybe (Left "job timeout") + <$> timeout (fromRange cfg.jobTimeout * 1000000) (dispatchJob job) + withLabel metrics.jobDuration lbl (`observe` dur) + pure r + where + shouldRetry _ (Right _) = pure False + shouldRetry _ (Left _) = pure True diff --git a/services/background-worker/src/Wire/BackgroundWorker/Jobs/Registry.hs b/services/background-worker/src/Wire/BackgroundWorker/Jobs/Registry.hs new file mode 100644 index 0000000000..2e52e12570 --- /dev/null +++ b/services/background-worker/src/Wire/BackgroundWorker/Jobs/Registry.hs @@ -0,0 +1,128 @@ +module Wire.BackgroundWorker.Jobs.Registry + ( dispatchJob, + ) +where + +import Data.ByteString.Conversion (toByteString') +import Data.Id +import Data.Qualified +import Data.Text qualified as T +import Hasql.Pool (UsageError) +import Imports +import Network.HTTP.Client +import Network.HTTP.Client.OpenSSL +import OpenSSL.EVP.Digest +import OpenSSL.Session as Ssl +import Polysemy +import Polysemy.Async (asyncToIOFinal) +import Polysemy.Error +import Polysemy.Input +import Polysemy.TinyLog qualified as P +import Ssl.Util +import System.Logger as Logger +import Wire.API.BackgroundJobs (Job (..)) +import Wire.API.Federation.Error (FederationError) +import Wire.BackendNotificationQueueAccess.RabbitMq qualified as BackendNotificationQueueAccess +import Wire.BackgroundJobsPublisher.RabbitMQ (interpretBackgroundJobsPublisherRabbitMQ) +import Wire.BackgroundJobsRunner (runJob) +import Wire.BackgroundJobsRunner.Interpreter hiding (runJob) +import Wire.BackgroundWorker.Env (AppT, Env (..)) +import Wire.BrigAPIAccess.Rpc +import Wire.ConversationStore +import Wire.ConversationStore.Cassandra (interpretConversationStoreToCassandra) +import Wire.ConversationStore.Postgres (interpretConversationStoreToPostgres) +import Wire.ConversationSubsystem.Interpreter (interpretConversationSubsystem) +import Wire.ExternalAccess.External +import Wire.FireAndForget (interpretFireAndForget) +import Wire.GundeckAPIAccess +import Wire.NotificationSubsystem.Interpreter +import Wire.ParseException +import Wire.Rpc +import Wire.Sem.Delay (runDelay) +import Wire.Sem.Now.IO (nowToIO) +import Wire.Sem.Random.IO (randomToIO) +import Wire.ServiceStore.Cassandra (interpretServiceStoreToCassandra) +import Wire.UserGroupStore.Postgres (interpretUserGroupStoreToPostgres) +import Wire.UserStore.Cassandra (interpretUserStoreCassandra) + +dispatchJob :: Job -> AppT IO (Either Text ()) +dispatchJob job = do + env <- ask @Env + extEnv <- liftIO initExtEnv + liftIO $ runInterpreters env extEnv $ runJob job + where + convStoreInterpreter env = + case env.postgresMigration.conversation of + CassandraStorage -> interpretConversationStoreToCassandra env.galleyCassandra + PostgresqlStorage -> interpretConversationStoreToPostgres + runInterpreters env extEnv = do + runFinal @IO + . embedToFinal @IO + . asyncToIOFinal + . runDelay + . runError + . mapError @FederationError (T.pack . show) + . mapError @UsageError (T.pack . show) + . mapError @ParseException (T.pack . show) + . interpretTinyLog env job.requestId + . runInputConst env.hasqlPool + . runInputConst (toLocalUnsafe env.domain ()) + . interpretServiceStoreToCassandra env.brigCassandra + . interpretUserStoreCassandra env.brigCassandra + . interpretUserGroupStoreToPostgres + . runInputSem (readMVar env.amqpJobsPublisherChannel) + . interpretBackgroundJobsPublisherRabbitMQ job.requestId + . nowToIO + . randomToIO + . interpretFireAndForget + . BackendNotificationQueueAccess.interpretBackendNotificationQueueAccess (Just $ backendQueueEnv env) + . convStoreInterpreter env + . runRpcWithHttp env.httpManager job.requestId + . runGundeckAPIAccess env.gundeckEndpoint + -- FUTUREWORK: Currently the brig access effect is needed for the interpreter of ExternalAccess. + -- At the time of implementation the only function used from ExternalAccess is deliverAsync, which will not call brig access. + -- However, to prevent the background worker to require HTTP access to brig, we should consider refactoring this at some point. + . interpretBrigAccess env.brigEndpoint + . interpretExternalAccess extEnv + . runNotificationSubsystemGundeck (defaultNotificationSubsystemConfig job.requestId) + . interpretConversationSubsystem + . interpretBackgroundJobsRunner + + backendQueueEnv env = + BackendNotificationQueueAccess.Env + { channelMVar = env.amqpBackendNotificationsChannel, + logger = env.logger, + local = toLocalUnsafe env.domain (), + requestId = job.requestId + } + +interpretTinyLog :: + (Member (Embed IO) r) => + Env -> + RequestId -> + Sem (P.TinyLog ': r) a -> + Sem r a +interpretTinyLog e reqId = interpret $ \case + P.Log l m -> Logger.log e.logger l ((("request" .=) . unRequestId) reqId . m) + +initExtEnv :: IO ExtEnv +initExtEnv = do + ctx <- Ssl.context + Ssl.contextSetVerificationMode ctx Ssl.VerifyNone + Ssl.contextAddOption ctx SSL_OP_NO_SSLv2 + Ssl.contextAddOption ctx SSL_OP_NO_SSLv3 + Ssl.contextAddOption ctx SSL_OP_NO_TLSv1 + Ssl.contextSetCiphers ctx rsaCiphers + Ssl.contextSetDefaultVerifyPaths ctx + mgr <- + newManager + (opensslManagerSettings (pure ctx)) + { managerResponseTimeout = responseTimeoutMicro 10000000, + managerConnCount = 100 + } + Just sha <- getDigestByName "SHA256" + pure $ ExtEnv (mgr, mkVerify sha) + where + mkVerify sha fprs = + let pinset = map toByteString' fprs + in verifyRsaFingerprint sha pinset diff --git a/services/background-worker/src/Wire/BackgroundWorker/Options.hs b/services/background-worker/src/Wire/BackgroundWorker/Options.hs index f9055d89e0..a27bb50bdd 100644 --- a/services/background-worker/src/Wire/BackgroundWorker/Options.hs +++ b/services/background-worker/src/Wire/BackgroundWorker/Options.hs @@ -1,25 +1,41 @@ module Wire.BackgroundWorker.Options where import Data.Aeson +import Data.Domain (Domain) +import Data.Range (Range) +import GHC.Generics +import Hasql.Pool.Extended (PoolConfig) import Imports import Network.AMQP.Extended import System.Logger.Extended import Util.Options +import Wire.ConversationStore (PostgresMigrationOpts) data Opts = Opts { logLevel :: !Level, logFormat :: !(Maybe (Last LogFormat)), backgroundWorker :: !Endpoint, federatorInternal :: !Endpoint, + brig :: Endpoint, + gundeck :: Endpoint, rabbitmq :: !RabbitMqOpts, -- | Seconds, Nothing for no timeout defederationTimeout :: Maybe Int, backendNotificationPusher :: BackendNotificationsConfig, - cassandra :: CassandraOpts + cassandra :: CassandraOpts, + cassandraBrig :: CassandraOpts, + cassandraGalley :: CassandraOpts, + backgroundJobs :: BackgroundJobsConfig, + -- | Postgresql settings, the key values must be in libpq format. + -- https://www.postgresql.org/docs/17/libpq-connect.html#LIBPQ-PARAMKEYWORDS + postgresql :: !(Map Text Text), + postgresqlPassword :: !(Maybe FilePathSecrets), + postgresqlPool :: !PoolConfig, + postgresMigration :: !PostgresMigrationOpts, + domain :: Domain } deriving (Show, Generic) - -instance FromJSON Opts + deriving (FromJSON) via Generically Opts data BackendNotificationsConfig = BackendNotificationsConfig { -- | Minimum amount of time (in microseconds) to wait before doing the first @@ -36,8 +52,7 @@ data BackendNotificationsConfig = BackendNotificationsConfig remotesRefreshInterval :: Int } deriving (Show, Generic) - -instance FromJSON BackendNotificationsConfig + deriving (FromJSON) via Generically BackendNotificationsConfig newtype RabbitMqOpts = RabbitMqOpts {unRabbitMqOpts :: Either AmqpEndpoint RabbitMqAdminOpts} deriving (Show) @@ -48,3 +63,14 @@ instance FromJSON RabbitMqOpts where <$> ( (Right <$> parseJSON v) <|> (Left <$> parseJSON v) ) + +data BackgroundJobsConfig = BackgroundJobsConfig + { -- | Maximum parallel jobs processed by this process + concurrency :: Range 1 1000 Int, + -- | Per-attempt timeout (seconds) + jobTimeout :: Range 1 1000 Int, + -- | Total attempts including first run + maxAttempts :: Range 1 1000 Int + } + deriving (Show, Generic) + deriving (FromJSON) via Generically BackgroundJobsConfig diff --git a/services/background-worker/src/Wire/DeadUserNotificationWatcher.hs b/services/background-worker/src/Wire/DeadUserNotificationWatcher.hs index 802f89eda6..d4bb3c1d0a 100644 --- a/services/background-worker/src/Wire/DeadUserNotificationWatcher.hs +++ b/services/background-worker/src/Wire/DeadUserNotificationWatcher.hs @@ -34,7 +34,7 @@ startConsumer chan = do env <- ask markAsWorking DeadUserNotificationWatcher - cassandra <- asks (.cassandra) + cassandra <- asks (.gundeckCassandra) void . lift $ Q.declareQueue diff --git a/services/background-worker/test/Test/Wire/BackendNotificationPusherSpec.hs b/services/background-worker/test/Test/Wire/BackendNotificationPusherSpec.hs index 9e88cbe9f0..6d9f12be8d 100644 --- a/services/background-worker/test/Test/Wire/BackendNotificationPusherSpec.hs +++ b/services/background-worker/test/Test/Wire/BackendNotificationPusherSpec.hs @@ -51,6 +51,7 @@ import Wire.BackendNotificationPusher import Wire.BackgroundWorker.Env import Wire.BackgroundWorker.Options import Wire.BackgroundWorker.Util +import Wire.ConversationStore spec :: Spec spec = do @@ -322,14 +323,29 @@ spec = do ] logger <- Logger.new Logger.defSettings httpManager <- newManager defaultManagerSettings - let cassandra = undefined - let federatorInternal = Endpoint "localhost" 8097 + let gundeckCassandra = undefined + brigCassandra = undefined + galleyCassandra = undefined + federatorInternal = Endpoint "localhost" 8097 http2Manager = undefined statuses = undefined rabbitmqAdminClient = Just $ mockRabbitMqAdminClient mockAdmin rabbitmqVHost = "test-vhost" defederationTimeout = responseTimeoutNone backendNotificationsConfig = BackendNotificationsConfig 1000 500000 1000 + backgroundJobsConfig = + BackgroundJobsConfig + { concurrency = toRange (Proxy @1), + jobTimeout = toRange (Proxy @100), + maxAttempts = toRange (Proxy @3) + } + hasqlPool = undefined + amqpJobsPublisherChannel = undefined + amqpBackendNotificationsChannel = undefined + domain = Domain "local" + postgresMigration = PostgresMigrationOpts CassandraStorage + gundeckEndpoint = undefined + brigEndpoint = undefined backendNotificationMetrics <- mkBackendNotificationMetrics workerRunningGauge <- mkWorkerRunningGauge @@ -340,15 +356,30 @@ spec = do it "should retry fetching domains if a request fails" $ do mockAdmin <- newMockRabbitMqAdmin True ["backend-notifications.foo.example"] logger <- Logger.new Logger.defSettings - let cassandra = undefined httpManager <- newManager defaultManagerSettings let federatorInternal = Endpoint "localhost" 8097 + gundeckCassandra = undefined + brigCassandra = undefined + galleyCassandra = undefined http2Manager = undefined statuses = undefined rabbitmqAdminClient = Just $ mockRabbitMqAdminClient mockAdmin rabbitmqVHost = "test-vhost" defederationTimeout = responseTimeoutNone backendNotificationsConfig = BackendNotificationsConfig 1000 500000 1000 + backgroundJobsConfig = + BackgroundJobsConfig + { concurrency = toRange (Proxy @1), + jobTimeout = toRange (Proxy @100), + maxAttempts = toRange (Proxy @3) + } + hasqlPool = undefined + amqpJobsPublisherChannel = undefined + amqpBackendNotificationsChannel = undefined + domain = Domain "local" + postgresMigration = PostgresMigrationOpts CassandraStorage + gundeckEndpoint = undefined + brigEndpoint = undefined 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 cb4eeef5f9..dc2dfac958 100644 --- a/services/background-worker/test/Test/Wire/Util.hs +++ b/services/background-worker/test/Test/Wire/Util.hs @@ -2,19 +2,26 @@ module Test.Wire.Util where +import Data.Domain (Domain (Domain)) +import Data.Proxy +import Data.Range import Imports -import Network.HTTP.Client +import Network.HTTP.Client hiding (Proxy) import System.Logger.Class qualified as Logger import Util.Options (Endpoint (..)) import Wire.BackgroundWorker.Env hiding (federatorInternal) import Wire.BackgroundWorker.Env qualified as E import Wire.BackgroundWorker.Options +import Wire.ConversationStore testEnv :: IO Env testEnv = do http2Manager <- initHttp2Manager logger <- Logger.new Logger.defSettings - let cassandra = undefined + let gundeckCassandra = undefined + brigCassandra = undefined + galleyCassandra = undefined + postgresMigration = PostgresMigrationOpts CassandraStorage statuses <- newIORef mempty backendNotificationMetrics <- mkBackendNotificationMetrics workerRunningGauge <- mkWorkerRunningGauge @@ -24,6 +31,18 @@ testEnv = do rabbitmqVHost = undefined defederationTimeout = responseTimeoutNone backendNotificationsConfig = BackendNotificationsConfig 1000 500000 1000 + backgroundJobsConfig = + BackgroundJobsConfig + { concurrency = toRange (Proxy @1), + jobTimeout = toRange (Proxy @100), + maxAttempts = toRange (Proxy @3) + } + hasqlPool = undefined + amqpJobsPublisherChannel = undefined + amqpBackendNotificationsChannel = undefined + domain = Domain "local" + gundeckEndpoint = undefined + brigEndpoint = undefined pure Env {..} runTestAppT :: AppT IO a -> Int -> IO a diff --git a/services/brig/src/Brig/App.hs b/services/brig/src/Brig/App.hs index 811e6930e2..3ce647b469 100644 --- a/services/brig/src/Brig/App.hs +++ b/services/brig/src/Brig/App.hs @@ -71,6 +71,7 @@ module Brig.App disabledVersionsLens, enableSFTFederationLens, rateLimitEnvLens, + amqpJobsPublisherChannelLens, initZAuth, initLogger, initPostgresPool, @@ -218,7 +219,8 @@ data Env = Env rabbitmqChannel :: Maybe (MVar Q.Channel), disabledVersions :: Set Version, enableSFTFederation :: Maybe Bool, - rateLimitEnv :: RateLimitEnv + rateLimitEnv :: RateLimitEnv, + amqpJobsPublisherChannel :: Maybe (MVar Q.Channel) } makeLensesWith (lensRules & lensField .~ suffixNamer) ''Env @@ -280,6 +282,7 @@ newEnv opts = do idxEnv <- mkIndexEnv opts.elasticsearch lgr (Opt.galley opts) mgr rateLimitEnv <- newRateLimitEnv opts.settings.passwordHashingRateLimit hasqlPool <- initPostgresPool opts.postgresqlPool opts.postgresql opts.postgresqlPassword + amqpJobsPublisherChannel <- traverse (Q.mkRabbitMqChannelMVar lgr (Just "brig")) opts.rabbitmq pure $! Env { cargohold = mkEndpoint $ opts.cargohold, @@ -319,7 +322,8 @@ newEnv opts = do rabbitmqChannel = rabbitChan, disabledVersions = allDisabledVersions, enableSFTFederation = opts.multiSFT, - rateLimitEnv + rateLimitEnv, + amqpJobsPublisherChannel } where emailConn _ (Opt.EmailAWS aws) = pure (Just aws, Nothing) diff --git a/services/brig/src/Brig/CanonicalInterpreter.hs b/services/brig/src/Brig/CanonicalInterpreter.hs index 6e968f75ae..948b5c7f62 100644 --- a/services/brig/src/Brig/CanonicalInterpreter.hs +++ b/services/brig/src/Brig/CanonicalInterpreter.hs @@ -45,6 +45,8 @@ import Wire.AppSubsystem.Interpreter import Wire.AuthenticationSubsystem import Wire.AuthenticationSubsystem.Config import Wire.AuthenticationSubsystem.Interpreter +import Wire.BackgroundJobsPublisher (BackgroundJobsPublisher) +import Wire.BackgroundJobsPublisher.RabbitMQ (interpretBackgroundJobsPublisherRabbitMQOptional) import Wire.BlockListStore import Wire.BlockListStore.Cassandra import Wire.DeleteQueue @@ -153,6 +155,7 @@ type BrigLowerLevelEffects = DeleteQueue, Wire.Events.Events, NotificationSubsystem, + BackgroundJobsPublisher, RateLimit, UserGroupStore, Error AppSubsystemError, @@ -363,6 +366,7 @@ runBrigToIO e (AppT ma) = do . mapError appSubsystemErrorToHttpError . interpretUserGroupStoreToPostgres . interpretRateLimit e.rateLimitEnv + . interpretBackgroundJobsPublisherRabbitMQOptional e.requestId e.amqpJobsPublisherChannel . runNotificationSubsystemGundeck (defaultNotificationSubsystemConfig e.requestId) . runEvents . runDeleteQueue e.internalEvents diff --git a/services/galley/galley.cabal b/services/galley/galley.cabal index 727c8b4d7c..38356fc134 100644 --- a/services/galley/galley.cabal +++ b/services/galley/galley.cabal @@ -78,7 +78,6 @@ library Galley.API.Action.Leave Galley.API.Action.Notify Galley.API.Action.Reset - Galley.API.Cells Galley.API.Clients Galley.API.Create Galley.API.CustomBackend @@ -144,7 +143,6 @@ library Galley.Cassandra.Proposal Galley.Cassandra.Queries Galley.Cassandra.SearchVisibility - Galley.Cassandra.Services Galley.Cassandra.Store Galley.Cassandra.Team Galley.Cassandra.TeamFeatures @@ -154,28 +152,22 @@ library Galley.Data.TeamNotifications Galley.Data.Types Galley.Effects - Galley.Effects.BackendNotificationQueueAccess Galley.Effects.ClientStore Galley.Effects.CodeStore Galley.Effects.CustomBackendStore - Galley.Effects.ExternalAccess Galley.Effects.FederatorAccess - Galley.Effects.FireAndForget Galley.Effects.LegalHoldStore Galley.Effects.ProposalStore Galley.Effects.Queue Galley.Effects.SearchVisibilityStore - Galley.Effects.ServiceStore Galley.Effects.SparAccess Galley.Effects.TeamFeatureStore Galley.Effects.TeamMemberStore Galley.Effects.TeamNotificationStore Galley.Effects.TeamStore Galley.Env - Galley.External Galley.External.LegalHoldService Galley.External.LegalHoldService.Internal - Galley.Intra.BackendNotificationQueue Galley.Intra.Effects Galley.Intra.Federator Galley.Intra.Journal diff --git a/services/galley/src/Galley/API/Action.hs b/services/galley/src/Galley/API/Action.hs index 83d543d5d1..3581a5262e 100644 --- a/services/galley/src/Galley/API/Action.hs +++ b/services/galley/src/Galley/API/Action.hs @@ -33,7 +33,7 @@ module Galley.API.Action -- * Utilities addMembersToLocalConversation, - notifyConversationAction, + sendConversationActionNotifications, updateLocalStateOfRemoteConv, addLocalUsersToRemoteConv, ConversationUpdate, @@ -45,6 +45,8 @@ module Galley.API.Action ) where +-- + import Control.Arrow ((&&&)) import Control.Error (headMay) import Control.Lens @@ -79,7 +81,6 @@ import Galley.Data.Scope (Scope (ReusableCode)) import Galley.Effects import Galley.Effects.CodeStore qualified as E import Galley.Effects.FederatorAccess qualified as E -import Galley.Effects.FireAndForget qualified as E import Galley.Effects.ProposalStore qualified as E import Galley.Effects.TeamStore qualified as E import Galley.Env (Env) @@ -120,6 +121,8 @@ import Wire.API.Team.Permission (Perm (AddRemoveConvMember, ModifyConvName)) import Wire.API.User as User import Wire.BrigAPIAccess qualified as E import Wire.ConversationStore qualified as E +import Wire.ConversationSubsystem +import Wire.FireAndForget qualified as E import Wire.NotificationSubsystem import Wire.Sem.Now (Now) import Wire.Sem.Now qualified as Now @@ -496,6 +499,7 @@ performAction :: Member BackendNotificationQueueAccess r, Member TeamCollaboratorsSubsystem r, Member (Error FederationError) r, + Member ConversationSubsystem r, Member E.MLSCommitLockStore r ) => Sing tag -> @@ -612,6 +616,7 @@ performConversationJoin :: forall r. ( HasConversationActionEffects 'ConversationJoinTag r, Member BackendNotificationQueueAccess r, + Member ConversationSubsystem r, Member TeamCollaboratorsSubsystem r ) => Qualified UserId -> @@ -756,7 +761,8 @@ performConversationJoin qusr lconv (ConversationJoin invited role joinType) = do performConversationAccessData :: ( HasConversationActionEffects 'ConversationAccessDataTag r, Member (Error FederationError) r, - Member BackendNotificationQueueAccess r + Member BackendNotificationQueueAccess r, + Member ConversationSubsystem r ) => Qualified UserId -> Local StoredConversation -> @@ -842,9 +848,7 @@ updateLocalConversation :: Member (ErrorS ('ActionDenied (ConversationActionPermission tag))) r, Member (ErrorS 'InvalidOperation) r, Member (ErrorS 'ConvNotFound) r, - Member ExternalAccess r, - Member NotificationSubsystem r, - Member Now r, + Member ConversationSubsystem r, HasConversationActionEffects tag r, SingI tag, Member TeamStore r, @@ -880,9 +884,7 @@ updateLocalConversationUnchecked :: Member (ErrorS ('ActionDenied (ConversationActionPermission tag))) r, Member (ErrorS 'ConvNotFound) r, Member (ErrorS 'InvalidOperation) r, - Member ExternalAccess r, - Member NotificationSubsystem r, - Member Now r, + Member ConversationSubsystem r, HasConversationActionEffects tag r, Member TeamStore r, Member TeamCollaboratorsSubsystem r, @@ -899,7 +901,7 @@ updateLocalConversationUnchecked lconv qusr con action = do mTeamMember <- foldQualified lconv (getTeamMembership conv) (const $ pure Nothing) qusr ensureConversationActionAllowed (sing @tag) lcnv conv mTeamMember par <- performAction (sing @tag) qusr lconv action - notifyConversationAction + sendConversationActionNotifications (sing @tag) qusr False diff --git a/services/galley/src/Galley/API/Action/Kick.hs b/services/galley/src/Galley/API/Action/Kick.hs index b6d22c6dda..af1820dd67 100644 --- a/services/galley/src/Galley/API/Action/Kick.hs +++ b/services/galley/src/Galley/API/Action/Kick.hs @@ -18,6 +18,7 @@ import Wire.API.Conversation hiding (Conversation, Member) import Wire.API.Conversation.Action import Wire.API.Event.LeaveReason import Wire.API.Federation.Error +import Wire.ConversationSubsystem import Wire.NotificationSubsystem import Wire.Sem.Now (Now) import Wire.StoredConversation @@ -31,6 +32,7 @@ kickMember :: ( Member BackendNotificationQueueAccess r, Member (Error FederationError) r, Member ExternalAccess r, + Member ConversationSubsystem r, Member NotificationSubsystem r, Member ProposalStore r, Member Now r, @@ -46,7 +48,7 @@ kickMember :: Sem r () kickMember qusr lconv targets victim = void . runError @NoChanges $ do leaveConversation victim lconv - notifyConversationAction + sendConversationActionNotifications (sing @'ConversationRemoveMembersTag) qusr True diff --git a/services/galley/src/Galley/API/Action/Notify.hs b/services/galley/src/Galley/API/Action/Notify.hs index 2c01c1c6b2..5bfaff6376 100644 --- a/services/galley/src/Galley/API/Action/Notify.hs +++ b/services/galley/src/Galley/API/Action/Notify.hs @@ -5,35 +5,17 @@ import Data.Qualified import Data.Singletons import Galley.API.Util import Galley.Effects -import Galley.Effects.BackendNotificationQueueAccess import Imports hiding ((\\)) -import Network.AMQP qualified as Q import Polysemy -import Polysemy.Error import Wire.API.Conversation hiding (Conversation, Member) import Wire.API.Conversation.Action -import Wire.API.Event.Conversation -import Wire.API.Federation.API -import Wire.API.Federation.API.Galley -import Wire.API.Federation.Error +import Wire.ConversationSubsystem import Wire.NotificationSubsystem -import Wire.Sem.Now (Now) -import Wire.Sem.Now qualified as Now import Wire.StoredConversation -data LocalConversationUpdate = LocalConversationUpdate - { lcuEvent :: Event, - lcuUpdate :: ConversationUpdate - } - deriving (Show) - -notifyConversationAction :: +sendConversationActionNotifications :: forall tag r. - ( Member BackendNotificationQueueAccess r, - Member ExternalAccess r, - Member (Error FederationError) r, - Member NotificationSubsystem r, - Member Now r + ( Member ConversationSubsystem r ) => Sing tag -> Qualified UserId -> @@ -44,38 +26,15 @@ notifyConversationAction :: ConversationAction (tag :: ConversationActionTag) -> ExtraConversationData -> Sem r LocalConversationUpdate -notifyConversationAction tag quid notifyOrigDomain con lconv targets action extraData = do - now <- Now.get - let lcnv = fmap (.id_) lconv - conv = tUnqualified lconv - tid = conv.metadata.cnvmTeam - e = conversationActionToEvent tag now quid (tUntagged lcnv) extraData Nothing tid action - mkUpdate uids = - ConversationUpdate - { time = now, - origUserId = quid, - convId = tUnqualified lcnv, - alreadyPresentUsers = uids, - action = SomeConversationAction tag action, - extraConversationData = Just extraData - } - update <- - fmap (fromMaybe (mkUpdate []) . asum . map tUnqualified) $ - enqueueNotificationsConcurrently Q.Persistent (toList (bmRemotes targets)) $ - \ruids -> do - let update = mkUpdate (tUnqualified ruids) - -- if notifyOrigDomain is false, filter out user from quid's domain, - -- because quid's backend will update local state and notify its users - -- itself using the ConversationUpdate returned by this function - if notifyOrigDomain || tDomain ruids /= qDomain quid - then do - makeConversationUpdateBundle update >>= sendBundle - pure Nothing - else pure (Just update) - - -- notify local participants and bots - pushConversationEvent con conv e (qualifyAs lcnv (bmLocals targets)) (bmBots targets) - - -- return both the event and the 'ConversationUpdate' structure corresponding - -- to the originating domain (if it is remote) - pure $ LocalConversationUpdate e update +sendConversationActionNotifications tag quid notifyOrigDomain con lconv targets action extraData = do + notifyConversationAction + tag + quid + notifyOrigDomain + con + lconv + (bmLocals targets) + (bmRemotes targets) + (bmBots targets) + action + extraData diff --git a/services/galley/src/Galley/API/Action/Reset.hs b/services/galley/src/Galley/API/Action/Reset.hs index 4823ad27d0..b7c14126d1 100644 --- a/services/galley/src/Galley/API/Action/Reset.hs +++ b/services/galley/src/Galley/API/Action/Reset.hs @@ -31,6 +31,7 @@ import Wire.API.MLS.SubConversation import Wire.API.Routes.Public.Galley.MLS import Wire.API.VersionInfo import Wire.ConversationStore +import Wire.ConversationSubsystem import Wire.NotificationSubsystem import Wire.Sem.Now (Now) import Wire.StoredConversation as Data @@ -44,6 +45,7 @@ resetLocalMLSMainConversation :: Member BackendNotificationQueueAccess r, Member FederatorAccess r, Member ExternalAccess r, + Member ConversationSubsystem r, Member NotificationSubsystem r, Member ProposalStore r, Member Random r, diff --git a/services/galley/src/Galley/API/Cells.hs b/services/galley/src/Galley/API/Cells.hs deleted file mode 100644 index 38c16811b8..0000000000 --- a/services/galley/src/Galley/API/Cells.hs +++ /dev/null @@ -1,55 +0,0 @@ --- 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 Galley.API.Cells - ( HasCellsState (..), - shouldPushToCells, - ) -where - -import Data.Default -import Imports -import Wire.API.Conversation -import Wire.API.Conversation qualified as Public -import Wire.API.Conversation.CellsState -import Wire.API.Event.Conversation -import Wire.StoredConversation - -class HasCellsState a where - getCellsState :: a -> CellsState - -instance HasCellsState CellsState where - getCellsState = id - -instance HasCellsState StoredConversation where - getCellsState = getCellsState . (.metadata) - -instance HasCellsState Public.OwnConversation where - getCellsState = getCellsState . Public.cnvMetadata - -instance HasCellsState ConversationMetadata where - getCellsState = cnvmCellsState - -instance HasCellsState () where - getCellsState = def - -shouldPushToCells :: (HasCellsState a) => a -> Event -> Bool -shouldPushToCells st e = - isCellsConversationEvent (evtType e) && case getCellsState st of - CellsDisabled -> False - CellsPending -> True - CellsReady -> True diff --git a/services/galley/src/Galley/API/Clients.hs b/services/galley/src/Galley/API/Clients.hs index b409b9049b..1fda288d62 100644 --- a/services/galley/src/Galley/API/Clients.hs +++ b/services/galley/src/Galley/API/Clients.hs @@ -30,7 +30,6 @@ import Galley.API.MLS.Removal import Galley.API.Query qualified as Query import Galley.API.Util import Galley.Effects -import Galley.Effects.BackendNotificationQueueAccess import Galley.Effects.ClientStore qualified as E import Galley.Env import Galley.Types.Clients (clientIds) @@ -46,6 +45,7 @@ import Wire.API.Federation.API import Wire.API.Federation.API.Galley import Wire.API.Federation.Error import Wire.API.Routes.MultiTablePaging +import Wire.BackendNotificationQueueAccess import Wire.ConversationStore (getConversation) import Wire.NotificationSubsystem import Wire.Sem.Now (Now) diff --git a/services/galley/src/Galley/API/Create.hs b/services/galley/src/Galley/API/Create.hs index ba40896ba8..3336979830 100644 --- a/services/galley/src/Galley/API/Create.hs +++ b/services/galley/src/Galley/API/Create.hs @@ -43,7 +43,6 @@ import Data.Range import Data.Set qualified as Set import Data.UUID.Tagged qualified as U import Galley.API.Action -import Galley.API.Cells import Galley.API.Error import Galley.API.MLS import Galley.API.Mapping diff --git a/services/galley/src/Galley/API/Federation.hs b/services/galley/src/Galley/API/Federation.hs index 2cbb40b6f7..0c98f4a751 100644 --- a/services/galley/src/Galley/API/Federation.hs +++ b/services/galley/src/Galley/API/Federation.hs @@ -55,7 +55,6 @@ import Galley.API.Push import Galley.API.Util import Galley.App import Galley.Effects -import Galley.Effects.FireAndForget qualified as E import Galley.Options import Galley.Types.Conversations.One2One import Imports @@ -94,6 +93,8 @@ import Wire.API.Routes.Public.Galley.MLS import Wire.API.ServantProto import Wire.API.User (BaseProtocolTag (..)) import Wire.ConversationStore qualified as E +import Wire.ConversationSubsystem +import Wire.FireAndForget qualified as E import Wire.NotificationSubsystem import Wire.Sem.Now (Now) import Wire.Sem.Now qualified as Now @@ -267,6 +268,7 @@ leaveConversation :: Member (Error InternalError) r, Member ExternalAccess r, Member FederatorAccess r, + Member ConversationSubsystem r, Member NotificationSubsystem r, Member (Input Env) r, Member (Input (Local ())) r, @@ -316,7 +318,7 @@ leaveConversation requestingDomain lc = do do outcome <- runError @FederationError $ - notifyConversationAction + sendConversationActionNotifications SConversationLeaveTag leaver False @@ -418,6 +420,7 @@ onUserDeleted :: Member FireAndForget r, Member (Error FederationError) r, Member ExternalAccess r, + Member ConversationSubsystem r, Member NotificationSubsystem r, Member (Input (Local ())) r, Member Now r, @@ -455,7 +458,7 @@ onUserDeleted origDomain udcn = do removeUser (qualifyAs lc conv) RemoveUserIncludeMain (tUntagged deletedUser) outcome <- runError @FederationError $ - notifyConversationAction + sendConversationActionNotifications (sing @'ConversationLeaveTag) untaggedDeletedUser False @@ -480,6 +483,7 @@ updateConversation :: Member ExternalAccess r, Member FederatorAccess r, Member (Error InternalError) r, + Member ConversationSubsystem r, Member NotificationSubsystem r, Member (Input Env) r, Member (Input Opts) r, @@ -614,6 +618,7 @@ sendMLSCommitBundle :: Member (Error FederationError) r, Member (Error InternalError) r, Member FederatorAccess r, + Member ConversationSubsystem r, Member NotificationSubsystem r, Member (Input (Local ())) r, Member (Input Env) r, diff --git a/services/galley/src/Galley/API/Internal.hs b/services/galley/src/Galley/API/Internal.hs index 95320a676f..ce4aa597d4 100644 --- a/services/galley/src/Galley/API/Internal.hs +++ b/services/galley/src/Galley/API/Internal.hs @@ -37,7 +37,6 @@ import Data.Range import Data.Singletons import Data.Time import Galley.API.Action -import Galley.API.Cells import Galley.API.Clients qualified as Clients import Galley.API.Create qualified as Create import Galley.API.Error @@ -55,11 +54,9 @@ import Galley.API.Update qualified as Update import Galley.API.Util import Galley.App import Galley.Effects -import Galley.Effects.BackendNotificationQueueAccess import Galley.Effects.ClientStore import Galley.Effects.CustomBackendStore import Galley.Effects.LegalHoldStore as LegalHoldStore -import Galley.Effects.ServiceStore import Galley.Effects.TeamStore import Galley.Effects.TeamStore qualified as E import Galley.Monad @@ -93,13 +90,16 @@ import Wire.API.Routes.MultiTablePaging qualified as MTP import Wire.API.Team.Feature import Wire.API.User (UserIds (cUsers)) import Wire.API.User.Client +import Wire.BackendNotificationQueueAccess import Wire.ConversationStore import Wire.ConversationStore qualified as E +import Wire.ConversationSubsystem import Wire.NotificationSubsystem import Wire.Sem.Now (Now) import Wire.Sem.Now qualified as Now import Wire.Sem.Paging import Wire.Sem.Paging.Cassandra +import Wire.ServiceStore import Wire.StoredConversation import Wire.StoredConversation qualified as Data import Wire.TeamSubsystem qualified as TeamSubsystem @@ -325,6 +325,7 @@ rmUser :: Member (Error InternalError) r, Member ExternalAccess r, Member NotificationSubsystem r, + Member ConversationSubsystem r, Member (Input Env) r, Member (Input Opts) r, Member Now r, diff --git a/services/galley/src/Galley/API/LegalHold.hs b/services/galley/src/Galley/API/LegalHold.hs index 8de1a0c435..600784f802 100644 --- a/services/galley/src/Galley/API/LegalHold.hs +++ b/services/galley/src/Galley/API/LegalHold.hs @@ -50,7 +50,6 @@ import Galley.API.Update (removeMemberFromLocalConv) import Galley.API.Util import Galley.App import Galley.Effects -import Galley.Effects.FireAndForget import Galley.Effects.LegalHoldStore qualified as LegalHoldData import Galley.Effects.TeamMemberStore import Galley.Effects.TeamStore @@ -79,6 +78,8 @@ import Wire.API.Team.Member import Wire.API.User.Client.Prekey import Wire.BrigAPIAccess import Wire.ConversationStore +import Wire.ConversationSubsystem +import Wire.FireAndForget import Wire.NotificationSubsystem import Wire.Sem.Now (Now) import Wire.Sem.Paging @@ -161,6 +162,7 @@ removeSettingsInternalPaging :: Member FederatorAccess r, Member FireAndForget r, Member NotificationSubsystem r, + Member ConversationSubsystem r, Member (Input Env) r, Member (Input (Local ())) r, Member Now r, @@ -206,6 +208,7 @@ removeSettings :: Member FederatorAccess r, Member FireAndForget r, Member NotificationSubsystem r, + Member ConversationSubsystem r, Member (Input Env) r, Member (Input (Local ())) r, Member Now r, @@ -259,6 +262,7 @@ removeSettings' :: Member FederatorAccess r, Member FireAndForget r, Member NotificationSubsystem r, + Member ConversationSubsystem r, Member Now r, Member (Input (Local ())) r, Member (Input Env) r, @@ -310,6 +314,7 @@ grantConsent :: Member ExternalAccess r, Member FederatorAccess r, Member NotificationSubsystem r, + Member ConversationSubsystem r, Member (Input Env) r, Member Now r, Member LegalHoldStore r, @@ -357,6 +362,7 @@ requestDevice :: Member ExternalAccess r, Member FederatorAccess r, Member NotificationSubsystem r, + Member ConversationSubsystem r, Member (Input (Local ())) r, Member (Input Env) r, Member Now r, @@ -450,6 +456,7 @@ approveDevice :: Member ExternalAccess r, Member FederatorAccess r, Member NotificationSubsystem r, + Member ConversationSubsystem r, Member (Input (Local ())) r, Member (Input Env) r, Member Now r, @@ -527,6 +534,7 @@ disableForUser :: Member ExternalAccess r, Member FederatorAccess r, Member NotificationSubsystem r, + Member ConversationSubsystem r, Member (Input Env) r, Member (Input (Local ())) r, Member Now r, @@ -592,6 +600,7 @@ changeLegalholdStatusAndHandlePolicyConflicts :: Member ExternalAccess r, Member FederatorAccess r, Member NotificationSubsystem r, + Member ConversationSubsystem r, Member (Input Env) r, Member Now r, Member LegalHoldStore r, @@ -708,6 +717,7 @@ handleGroupConvPolicyConflicts :: Member ExternalAccess r, Member FederatorAccess r, Member NotificationSubsystem r, + Member ConversationSubsystem r, Member (Input Env) r, Member Now r, Member ProposalStore r, diff --git a/services/galley/src/Galley/API/MLS/Commit/InternalCommit.hs b/services/galley/src/Galley/API/MLS/Commit/InternalCommit.hs index 602f3766a5..9965e3c5c9 100644 --- a/services/galley/src/Galley/API/MLS/Commit/InternalCommit.hs +++ b/services/galley/src/Galley/API/MLS/Commit/InternalCommit.hs @@ -61,6 +61,7 @@ import Wire.API.Unreachable import Wire.API.User.Client import Wire.ConversationStore import Wire.ConversationStore.MLS.Types +import Wire.ConversationSubsystem import Wire.StoredConversation processInternalCommit :: @@ -73,6 +74,7 @@ processInternalCommit :: Member (ErrorS 'MLSIdentityMismatch) r, Member (ErrorS 'MissingLegalholdConsent) r, Member (ErrorS 'GroupIdVersionNotSupported) r, + Member ConversationSubsystem r, Member Resource r, Member Random r, Member (ErrorS MLSInvalidLeafNodeSignature) r, @@ -255,7 +257,7 @@ processInternalCommit senderIdentity con lConvOrSub ciphersuite ciphersuiteUpdat ) $ nonEmpty (bmQualifiedMembers lconv bm) update <- - notifyConversationAction + sendConversationActionNotifications SConversationJoinTag senderUser False @@ -329,7 +331,7 @@ mkClientData clientInfo = } addMembers :: - (HasProposalActionEffects r, Member MLSCommitLockStore r) => + (HasProposalActionEffects r, Member ConversationSubsystem r, Member MLSCommitLockStore r) => Qualified UserId -> Maybe ConnId -> Local ConvOrSubConv -> @@ -353,7 +355,7 @@ addMembers qusr con lConvOrSub users = case tUnqualified lConvOrSub of SubConv _ _ -> pure [] removeMembers :: - (HasProposalActionEffects r, Member MLSCommitLockStore r) => + (HasProposalActionEffects r, Member ConversationSubsystem r, Member MLSCommitLockStore r) => Qualified UserId -> Maybe ConnId -> Local ConvOrSubConv -> diff --git a/services/galley/src/Galley/API/MLS/Message.hs b/services/galley/src/Galley/API/MLS/Message.hs index 2ee59d49b3..c317a4f8c2 100644 --- a/services/galley/src/Galley/API/MLS/Message.hs +++ b/services/galley/src/Galley/API/MLS/Message.hs @@ -84,6 +84,7 @@ import Wire.API.MLS.SubConversation import Wire.API.Team.LegalHold import Wire.ConversationStore import Wire.ConversationStore.MLS.Types +import Wire.ConversationSubsystem import Wire.NotificationSubsystem import Wire.Sem.Now qualified as Now import Wire.StoredConversation @@ -165,6 +166,7 @@ postMLSCommitBundle :: Member Resource r, Members MLSBundleStaticErrors r, HasProposalEffects r, + Member ConversationSubsystem r, Member MLSCommitLockStore r ) => Local x -> @@ -192,6 +194,7 @@ postMLSCommitBundleFromLocalUser :: Member Resource r, Members MLSBundleStaticErrors r, HasProposalEffects r, + Member ConversationSubsystem r, Member MLSCommitLockStore r ) => Local UserId -> @@ -219,6 +222,7 @@ postMLSCommitBundleToLocalConv :: Member Resource r, Members MLSBundleStaticErrors r, HasProposalEffects r, + Member ConversationSubsystem r, Member MLSCommitLockStore r ) => Qualified UserId -> diff --git a/services/galley/src/Galley/API/MLS/Propagate.hs b/services/galley/src/Galley/API/MLS/Propagate.hs index 4300af2de3..40242f6566 100644 --- a/services/galley/src/Galley/API/MLS/Propagate.hs +++ b/services/galley/src/Galley/API/MLS/Propagate.hs @@ -26,7 +26,6 @@ import Data.Map qualified as Map import Data.Qualified import Galley.API.Push import Galley.Effects -import Galley.Effects.BackendNotificationQueueAccess import Imports import Network.AMQP qualified as Q import Polysemy @@ -43,6 +42,7 @@ import Wire.API.MLS.Serialisation import Wire.API.MLS.SubConversation import Wire.API.Message import Wire.API.Push.V2 (RecipientClients (..)) +import Wire.BackendNotificationQueueAccess import Wire.ConversationStore.MLS.Types import Wire.NotificationSubsystem 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 f5cfe82934..a1b2addba7 100644 --- a/services/galley/src/Galley/API/MLS/Reset.hs +++ b/services/galley/src/Galley/API/MLS/Reset.hs @@ -39,6 +39,7 @@ import Wire.API.Federation.Error import Wire.API.MLS.SubConversation import Wire.API.Routes.Public.Galley.MLS import Wire.ConversationStore +import Wire.ConversationSubsystem import Wire.NotificationSubsystem import Wire.Sem.Now (Now) import Wire.TeamCollaboratorsSubsystem @@ -63,6 +64,7 @@ resetMLSConversation :: Member (Error FederationError) r, Member BrigAPIAccess r, Member NotificationSubsystem r, + Member ConversationSubsystem r, Member ProposalStore r, Member Random r, Member Resource r, diff --git a/services/galley/src/Galley/API/MLS/Welcome.hs b/services/galley/src/Galley/API/MLS/Welcome.hs index 06dac306d3..b6c9f4b5fa 100644 --- a/services/galley/src/Galley/API/MLS/Welcome.hs +++ b/services/galley/src/Galley/API/MLS/Welcome.hs @@ -31,7 +31,6 @@ import Data.Map qualified as Map import Data.Qualified import Data.Time import Galley.API.Push -import Galley.Effects.ExternalAccess import Galley.Effects.FederatorAccess import Imports import Network.Wai.Utilities.JSONResponse @@ -51,6 +50,7 @@ import Wire.API.MLS.SubConversation import Wire.API.MLS.Welcome import Wire.API.Message import Wire.API.Push.V2 (RecipientClients (..)) +import Wire.ExternalAccess import Wire.NotificationSubsystem import Wire.Sem.Now (Now) import Wire.Sem.Now qualified as Now diff --git a/services/galley/src/Galley/API/Message.hs b/services/galley/src/Galley/API/Message.hs index 35ea6ecb97..87093c07d6 100644 --- a/services/galley/src/Galley/API/Message.hs +++ b/services/galley/src/Galley/API/Message.hs @@ -53,7 +53,6 @@ import Galley.API.LegalHold.Conflicts import Galley.API.Push import Galley.API.Util import Galley.Effects -import Galley.Effects.BackendNotificationQueueAccess import Galley.Effects.ClientStore import Galley.Effects.FederatorAccess import Galley.Effects.TeamStore @@ -81,6 +80,7 @@ import Wire.API.Team.LegalHold import Wire.API.Team.Member import Wire.API.User.Client import Wire.API.UserMap (UserMap (..)) +import Wire.BackendNotificationQueueAccess import Wire.BrigAPIAccess import Wire.ConversationStore import Wire.NotificationSubsystem (NotificationSubsystem) diff --git a/services/galley/src/Galley/API/Push.hs b/services/galley/src/Galley/API/Push.hs index d9d5da6522..2fe2abc6d5 100644 --- a/services/galley/src/Galley/API/Push.hs +++ b/services/galley/src/Galley/API/Push.hs @@ -35,7 +35,6 @@ import Data.Json.Util import Data.List1 qualified as List1 import Data.Map qualified as Map import Data.Qualified -import Galley.Effects.ExternalAccess import Imports import Polysemy import Polysemy.TinyLog @@ -43,6 +42,7 @@ import System.Logger.Class qualified as Log import Wire.API.Event.Conversation import Wire.API.Message import Wire.API.Push.V2 (RecipientClients (RecipientClientsSome), Route (..)) +import Wire.ExternalAccess import Wire.NotificationSubsystem import Wire.StoredConversation diff --git a/services/galley/src/Galley/API/Teams.hs b/services/galley/src/Galley/API/Teams.hs index ff1513aab1..589f9fc837 100644 --- a/services/galley/src/Galley/API/Teams.hs +++ b/services/galley/src/Galley/API/Teams.hs @@ -86,7 +86,6 @@ import Galley.API.Update qualified as API import Galley.API.Util import Galley.App import Galley.Effects -import Galley.Effects.ExternalAccess qualified as E import Galley.Effects.LegalHoldStore qualified as Data import Galley.Effects.Queue qualified as E import Galley.Effects.SearchVisibilityStore qualified as SearchVisibilityData @@ -132,6 +131,8 @@ import Wire.API.User qualified as U import Wire.BrigAPIAccess qualified as Brig import Wire.BrigAPIAccess qualified as E import Wire.ConversationStore qualified as E +import Wire.ConversationSubsystem +import Wire.ExternalAccess qualified as E import Wire.ListItems qualified as E import Wire.NotificationSubsystem import Wire.Sem.Now @@ -755,21 +756,19 @@ updateTeamMember lzusr zcon tid newMem = do && permissionsRole targetPermissions /= Just RoleOwner deleteTeamMember :: - ( Member BackendNotificationQueueAccess r, - Member BrigAPIAccess r, + ( Member BrigAPIAccess r, Member ConversationStore r, Member (Error AuthenticationError) r, - Member (Error FederationError) r, Member (Error InvalidInput) r, Member (ErrorS 'AccessDenied) r, Member (ErrorS 'TeamMemberNotFound) r, Member (ErrorS 'TeamNotFound) r, Member (ErrorS 'NotATeamMember) r, Member (ErrorS OperationDenied) r, - Member ExternalAccess r, Member (Input Opts) r, Member Now r, Member NotificationSubsystem r, + Member ConversationSubsystem r, Member TeamFeatureStore r, Member TeamStore r, Member P.TinyLog r @@ -783,21 +782,19 @@ deleteTeamMember :: deleteTeamMember lusr zcon tid remove body = deleteTeamMember' lusr zcon tid remove (Just body) deleteNonBindingTeamMember :: - ( Member BackendNotificationQueueAccess r, - Member BrigAPIAccess r, + ( Member BrigAPIAccess r, Member ConversationStore r, Member (Error AuthenticationError) r, - Member (Error FederationError) r, Member (Error InvalidInput) r, Member (ErrorS 'AccessDenied) r, Member (ErrorS 'TeamMemberNotFound) r, Member (ErrorS 'TeamNotFound) r, Member (ErrorS 'NotATeamMember) r, Member (ErrorS OperationDenied) r, - Member ExternalAccess r, Member (Input Opts) r, Member Now r, Member NotificationSubsystem r, + Member ConversationSubsystem r, Member TeamFeatureStore r, Member TeamStore r, Member P.TinyLog r @@ -811,21 +808,19 @@ deleteNonBindingTeamMember lusr zcon tid remove = deleteTeamMember' lusr zcon ti -- | 'TeamMemberDeleteData' is only required for binding teams deleteTeamMember' :: - ( Member BackendNotificationQueueAccess r, - Member BrigAPIAccess r, + ( Member BrigAPIAccess r, Member ConversationStore r, Member (Error AuthenticationError) r, Member (Error InvalidInput) r, - Member (Error FederationError) r, Member (ErrorS 'AccessDenied) r, Member (ErrorS 'TeamMemberNotFound) r, Member (ErrorS 'TeamNotFound) r, Member (ErrorS 'NotATeamMember) r, Member (ErrorS OperationDenied) r, - Member ExternalAccess r, Member (Input Opts) r, Member Now r, Member NotificationSubsystem r, + Member ConversationSubsystem r, Member TeamFeatureStore r, Member TeamStore r, Member P.TinyLog r @@ -880,11 +875,9 @@ deleteTeamMember' lusr zcon tid remove mBody = do -- This function is "unchecked" because it does not validate that the user has the `RemoveTeamMember` permission. uncheckedDeleteTeamMember :: forall r. - ( Member BackendNotificationQueueAccess r, - Member ConversationStore r, + ( Member ConversationStore r, Member NotificationSubsystem r, - Member (Error FederationError) r, - Member ExternalAccess r, + Member ConversationSubsystem r, Member Now r, Member TeamStore r ) => @@ -943,12 +936,8 @@ uncheckedDeleteTeamMember lusr zcon tid remove (Right mems) = do removeFromConvsAndPushConvLeaveEvent :: forall r. - ( Member BackendNotificationQueueAccess r, - Member ConversationStore r, - Member (Error FederationError) r, - Member ExternalAccess r, - Member NotificationSubsystem r, - Member Now r + ( Member ConversationStore r, + Member ConversationSubsystem r ) => Local UserId -> Maybe ConnId -> @@ -973,7 +962,7 @@ removeFromConvsAndPushConvLeaveEvent lusr zcon tid remove = do (Set.fromList $ (.id_) <$> dc.remoteMembers) (Set.fromList bots) void $ - notifyConversationAction + sendConversationActionNotifications (sing @'ConversationRemoveMembersTag) (tUntagged lusr) True @@ -1035,9 +1024,7 @@ deleteTeamConversation :: Member (ErrorS ('ActionDenied 'Public.DeleteConversation)) r, Member FederatorAccess r, Member ProposalStore r, - Member ExternalAccess r, - Member NotificationSubsystem r, - Member Now r, + Member ConversationSubsystem r, Member TeamStore r, Member TeamCollaboratorsSubsystem r, Member E.MLSCommitLockStore r @@ -1335,13 +1322,11 @@ checkAdminLimit adminCount = -- | Removing a team collaborator and clean their conversations removeTeamCollaborator :: forall r. - ( Member BackendNotificationQueueAccess r, - Member ConversationStore r, - Member (Error FederationError) r, + ( Member ConversationStore r, Member (ErrorS OperationDenied) r, Member (ErrorS NotATeamMember) r, - Member ExternalAccess r, Member NotificationSubsystem r, + Member ConversationSubsystem r, Member (Input Opts) r, Member Now r, Member P.TinyLog r, diff --git a/services/galley/src/Galley/API/Teams/Features.hs b/services/galley/src/Galley/API/Teams/Features.hs index e6a7fd9fab..d5f4ff10fd 100644 --- a/services/galley/src/Galley/API/Teams/Features.hs +++ b/services/galley/src/Galley/API/Teams/Features.hs @@ -67,6 +67,7 @@ import Wire.API.Team.Feature import Wire.API.Team.Member import Wire.BrigAPIAccess (updateSearchVisibilityInbound) import Wire.ConversationStore (MLSCommitLockStore) +import Wire.ConversationSubsystem import Wire.NotificationSubsystem import Wire.Sem.Now (Now) import Wire.Sem.Paging @@ -326,6 +327,7 @@ instance SetFeatureConfig LegalholdConfig where Member FederatorAccess r, Member FireAndForget r, Member NotificationSubsystem r, + Member ConversationSubsystem r, Member (Input (Local ())) r, Member (Input Env) r, Member Now r, diff --git a/services/galley/src/Galley/API/Update.hs b/services/galley/src/Galley/API/Update.hs index 72830a9ada..b9d8cd7ff0 100644 --- a/services/galley/src/Galley/API/Update.hs +++ b/services/galley/src/Galley/API/Update.hs @@ -88,7 +88,6 @@ import Data.Set qualified as Set import Data.Singletons import Galley.API.Action import Galley.API.Action.Kick (kickMember) -import Galley.API.Cells import Galley.API.Error import Galley.API.Mapping import Galley.API.Message @@ -100,7 +99,6 @@ import Galley.Data.Types import Galley.Effects import Galley.Effects.ClientStore qualified as E import Galley.Effects.CodeStore qualified as E -import Galley.Effects.ExternalAccess qualified as E import Galley.Effects.FederatorAccess qualified as E import Galley.Effects.TeamStore qualified as E import Galley.Options @@ -133,6 +131,8 @@ import Wire.API.Team.Feature import Wire.API.Team.Member import Wire.API.User.Client import Wire.ConversationStore qualified as E +import Wire.ConversationSubsystem +import Wire.ExternalAccess qualified as E import Wire.HashPassword as HashPassword import Wire.NotificationSubsystem import Wire.RateLimit @@ -270,6 +270,7 @@ type UpdateConversationAccessEffects = FederatorAccess, FireAndForget, NotificationSubsystem, + ConversationSubsystem, Input Env, ProposalStore, Random, @@ -325,8 +326,8 @@ updateConversationReceiptMode :: Member ExternalAccess r, Member FederatorAccess r, Member NotificationSubsystem r, + Member ConversationSubsystem r, Member (Input (Local ())) r, - Member Now r, Member TinyLog r, Member TeamStore r, Member TeamCollaboratorsSubsystem r, @@ -406,8 +407,8 @@ updateConversationReceiptModeUnqualified :: Member ExternalAccess r, Member FederatorAccess r, Member NotificationSubsystem r, + Member ConversationSubsystem r, Member (Input (Local ())) r, - Member Now r, Member TinyLog r, Member TeamStore r, Member TeamCollaboratorsSubsystem r, @@ -427,9 +428,7 @@ updateConversationMessageTimer :: Member (ErrorS 'ConvNotFound) r, Member (ErrorS 'InvalidOperation) r, Member (Error FederationError) r, - Member ExternalAccess r, - Member NotificationSubsystem r, - Member Now r, + Member ConversationSubsystem r, Member TeamStore r, Member TeamCollaboratorsSubsystem r, Member E.MLSCommitLockStore r @@ -462,9 +461,7 @@ updateConversationMessageTimerUnqualified :: Member (ErrorS 'ConvNotFound) r, Member (ErrorS 'InvalidOperation) r, Member (Error FederationError) r, - Member ExternalAccess r, - Member NotificationSubsystem r, - Member Now r, + Member ConversationSubsystem r, Member TeamStore r, Member TeamCollaboratorsSubsystem r, Member E.MLSCommitLockStore r @@ -486,11 +483,9 @@ deleteLocalConversation :: Member (ErrorS ('ActionDenied 'DeleteConversation)) r, Member (ErrorS 'ConvNotFound) r, Member (ErrorS 'InvalidOperation) r, - Member ExternalAccess r, Member FederatorAccess r, - Member NotificationSubsystem r, + Member ConversationSubsystem r, Member ProposalStore r, - Member Now r, Member TeamStore r, Member TeamCollaboratorsSubsystem r, Member E.MLSCommitLockStore r @@ -729,6 +724,7 @@ updateConversationProtocolWithLocalUser :: Member ConversationStore r, Member TinyLog r, Member NotificationSubsystem r, + Member ConversationSubsystem r, Member ExternalAccess r, Member FederatorAccess r, Member Random r, @@ -769,7 +765,7 @@ updateChannelAddPermission :: Member (Error FederationError) r, Member ExternalAccess r, Member NotificationSubsystem r, - Member Now r, + Member ConversationSubsystem r, Member TeamStore r, Member (Input (Local ())) r, Member TinyLog r, @@ -807,11 +803,9 @@ updateChannelAddPermission lusr zcon qcnv update = joinConversationByReusableCode :: forall r. - ( Member BackendNotificationQueueAccess r, - Member BrigAPIAccess r, + ( Member BrigAPIAccess r, Member CodeStore r, Member ConversationStore r, - Member (Error FederationError) r, Member (ErrorS 'CodeNotFound) r, Member (ErrorS 'InvalidConversationPassword) r, Member (ErrorS 'ConvAccessDenied) r, @@ -820,10 +814,8 @@ joinConversationByReusableCode :: Member (ErrorS 'InvalidOperation) r, Member (ErrorS 'NotATeamMember) r, Member (ErrorS 'TooManyMembers) r, - Member ExternalAccess r, - Member NotificationSubsystem r, + Member ConversationSubsystem r, Member (Input Opts) r, - Member Now r, Member TeamStore r, Member TeamFeatureStore r, Member HashPassword r, @@ -841,19 +833,15 @@ joinConversationByReusableCode lusr zcon req = do joinConversationById :: forall r. - ( Member BackendNotificationQueueAccess r, - Member BrigAPIAccess r, + ( Member BrigAPIAccess r, Member ConversationStore r, - Member (Error FederationError) r, Member (ErrorS 'ConvAccessDenied) r, Member (ErrorS 'ConvNotFound) r, Member (ErrorS 'InvalidOperation) r, Member (ErrorS 'NotATeamMember) r, Member (ErrorS 'TooManyMembers) r, - Member ExternalAccess r, - Member NotificationSubsystem r, + Member ConversationSubsystem r, Member (Input Opts) r, - Member Now r, Member TeamStore r ) => Local UserId -> @@ -866,17 +854,13 @@ joinConversationById lusr zcon cnv = do joinConversation :: forall r. - ( Member BackendNotificationQueueAccess r, - Member BrigAPIAccess r, - Member (Error FederationError) r, + ( Member BrigAPIAccess r, Member (ErrorS 'ConvAccessDenied) r, Member (ErrorS 'InvalidOperation) r, Member (ErrorS 'NotATeamMember) r, Member (ErrorS 'TooManyMembers) r, - Member ExternalAccess r, - Member NotificationSubsystem r, + Member ConversationSubsystem r, Member (Input Opts) r, - Member Now r, Member ConversationStore r, Member TeamStore r ) => @@ -899,7 +883,7 @@ joinConversation lusr zcon conv access = do (extraTargets, action) <- addMembersToLocalConversation lcnv (UserList users []) roleNameWireMember InternalAdd lcuEvent - <$> notifyConversationAction + <$> sendConversationActionNotifications (sing @'ConversationJoinTag) (tUntagged lusr) False @@ -930,6 +914,7 @@ addMembers :: Member (Error UnreachableBackends) r, Member ExternalAccess r, Member FederatorAccess r, + Member ConversationSubsystem r, Member NotificationSubsystem r, Member (Input Env) r, Member (Input Opts) r, @@ -984,6 +969,7 @@ addMembersUnqualifiedV2 :: Member (Error UnreachableBackends) r, Member ExternalAccess r, Member FederatorAccess r, + Member ConversationSubsystem r, Member NotificationSubsystem r, Member (Input Env) r, Member (Input Opts) r, @@ -1027,6 +1013,7 @@ addMembersUnqualified :: Member (Error UnreachableBackends) r, Member ExternalAccess r, Member FederatorAccess r, + Member ConversationSubsystem r, Member NotificationSubsystem r, Member (Input Env) r, Member (Input Opts) r, @@ -1119,9 +1106,7 @@ updateOtherMemberLocalConv :: Member (ErrorS 'InvalidOperation) r, Member (ErrorS 'ConvNotFound) r, Member (ErrorS 'ConvMemberNotFound) r, - Member ExternalAccess r, - Member NotificationSubsystem r, - Member Now r, + Member ConversationSubsystem r, Member TeamStore r, Member TeamCollaboratorsSubsystem r, Member E.MLSCommitLockStore r @@ -1147,9 +1132,7 @@ updateOtherMemberUnqualified :: Member (ErrorS 'InvalidOperation) r, Member (ErrorS 'ConvNotFound) r, Member (ErrorS 'ConvMemberNotFound) r, - Member ExternalAccess r, - Member NotificationSubsystem r, - Member Now r, + Member ConversationSubsystem r, Member TeamStore r, Member TeamCollaboratorsSubsystem r, Member E.MLSCommitLockStore r @@ -1174,9 +1157,7 @@ updateOtherMember :: Member (ErrorS 'InvalidOperation) r, Member (ErrorS 'ConvNotFound) r, Member (ErrorS 'ConvMemberNotFound) r, - Member ExternalAccess r, - Member NotificationSubsystem r, - Member Now r, + Member ConversationSubsystem r, Member TeamStore r, Member TeamCollaboratorsSubsystem r, Member E.MLSCommitLockStore r @@ -1212,6 +1193,7 @@ removeMemberUnqualified :: Member ExternalAccess r, Member FederatorAccess r, Member NotificationSubsystem r, + Member ConversationSubsystem r, Member (Input Env) r, Member Now r, Member ProposalStore r, @@ -1242,6 +1224,7 @@ removeMemberQualified :: Member ExternalAccess r, Member FederatorAccess r, Member NotificationSubsystem r, + Member ConversationSubsystem r, Member (Input Env) r, Member Now r, Member ProposalStore r, @@ -1319,6 +1302,7 @@ removeMemberFromLocalConv :: Member ExternalAccess r, Member FederatorAccess r, Member NotificationSubsystem r, + Member ConversationSubsystem r, Member (Input Env) r, Member Now r, Member ProposalStore r, @@ -1365,6 +1349,7 @@ removeMemberFromChannel :: Member ExternalAccess r, Member FederatorAccess r, Member NotificationSubsystem r, + Member ConversationSubsystem r, Member (Error InternalError) r, Member Random r, Member TinyLog r, @@ -1553,9 +1538,7 @@ updateConversationName :: Member (ErrorS ('ActionDenied 'ModifyConversationName)) r, Member (ErrorS 'ConvNotFound) r, Member (ErrorS 'InvalidOperation) r, - Member ExternalAccess r, - Member NotificationSubsystem r, - Member Now r, + Member ConversationSubsystem r, Member TeamStore r, Member TeamCollaboratorsSubsystem r, Member E.MLSCommitLockStore r @@ -1581,9 +1564,7 @@ updateUnqualifiedConversationName :: Member (ErrorS ('ActionDenied 'ModifyConversationName)) r, Member (ErrorS 'ConvNotFound) r, Member (ErrorS 'InvalidOperation) r, - Member ExternalAccess r, - Member NotificationSubsystem r, - Member Now r, + Member ConversationSubsystem r, Member TeamStore r, Member TeamCollaboratorsSubsystem r, Member E.MLSCommitLockStore r @@ -1605,9 +1586,7 @@ updateLocalConversationName :: Member (ErrorS ('ActionDenied 'ModifyConversationName)) r, Member (ErrorS 'ConvNotFound) r, Member (ErrorS 'InvalidOperation) r, - Member ExternalAccess r, - Member NotificationSubsystem r, - Member Now r, + Member ConversationSubsystem r, Member TeamStore r, Member TeamCollaboratorsSubsystem r, Member E.MLSCommitLockStore r diff --git a/services/galley/src/Galley/API/Util.hs b/services/galley/src/Galley/API/Util.hs index 545ac8a6a6..9529100c3b 100644 --- a/services/galley/src/Galley/API/Util.hs +++ b/services/galley/src/Galley/API/Util.hs @@ -40,15 +40,12 @@ import Data.Set qualified as Set import Data.Singletons import Data.Text qualified as T import Data.Time -import Galley.API.Cells import Galley.API.Error import Galley.API.Mapping import Galley.Data.Types qualified as DataTypes import Galley.Effects -import Galley.Effects.BackendNotificationQueueAccess import Galley.Effects.ClientStore import Galley.Effects.CodeStore -import Galley.Effects.ExternalAccess import Galley.Effects.FederatorAccess import Galley.Effects.LegalHoldStore import Galley.Effects.TeamStore @@ -67,6 +64,7 @@ import Wire.API.Connection 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.CellsState (HasCellsState) import Wire.API.Conversation.Protocol import Wire.API.Conversation.Role import Wire.API.Error @@ -90,8 +88,10 @@ import Wire.API.Team.Role import Wire.API.User hiding (userId) import Wire.API.User.Auth.ReAuth import Wire.API.VersionInfo +import Wire.BackendNotificationQueueAccess import Wire.BrigAPIAccess import Wire.ConversationStore +import Wire.ExternalAccess import Wire.HashPassword (HashPassword) import Wire.HashPassword qualified as HashPassword import Wire.NotificationSubsystem diff --git a/services/galley/src/Galley/App.hs b/services/galley/src/Galley/App.hs index 09a5cfbf76..d6c4ee7007 100644 --- a/services/galley/src/Galley/App.hs +++ b/services/galley/src/Galley/App.hs @@ -32,7 +32,6 @@ module Galley.App extEnv, aEnv, ExtEnv (..), - extGetManager, -- * Running Galley effects GalleyEffects, @@ -61,15 +60,11 @@ import Galley.Cassandra.CustomBackend import Galley.Cassandra.LegalHold import Galley.Cassandra.Proposal import Galley.Cassandra.SearchVisibility -import Galley.Cassandra.Services import Galley.Cassandra.Team import Galley.Cassandra.TeamFeatures import Galley.Cassandra.TeamNotifications import Galley.Effects -import Galley.Effects.FireAndForget import Galley.Env -import Galley.External -import Galley.Intra.BackendNotificationQueue import Galley.Intra.Effects import Galley.Intra.Federator import Galley.Keys @@ -108,10 +103,14 @@ import Wire.API.Error import Wire.API.Federation.Error import Wire.API.Team.Collaborator import Wire.API.Team.Feature +import Wire.BackendNotificationQueueAccess.RabbitMq qualified as BackendNotificationQueueAccess import Wire.BrigAPIAccess.Rpc import Wire.ConversationStore.Cassandra import Wire.ConversationStore.Postgres +import Wire.ConversationSubsystem.Interpreter (interpretConversationSubsystem) import Wire.Error +import Wire.ExternalAccess.External +import Wire.FireAndForget import Wire.GundeckAPIAccess (runGundeckAPIAccess) import Wire.HashPassword.Interpreter import Wire.NotificationSubsystem.Interpreter (runNotificationSubsystemGundeck) @@ -122,6 +121,7 @@ import Wire.Rpc import Wire.Sem.Delay import Wire.Sem.Now.IO (nowToIO) import Wire.Sem.Random.IO +import Wire.ServiceStore.Cassandra (interpretServiceStoreToCassandra) import Wire.TeamCollaboratorsStore.Postgres (interpretTeamCollaboratorsStoreToPostgres) import Wire.TeamCollaboratorsSubsystem.Interpreter @@ -267,6 +267,18 @@ evalGalley e = case (e ^. options . postgresMigration).conversation of CassandraStorage -> interpretConversationStoreToCassandra (e ^. cstate) PostgresqlStorage -> interpretConversationStoreToPostgres + localUnit = (toLocalUnsafe (e ^. options . settings . federationDomain) ()) + backendNotificationQueueAccessEnv = + case e._rabbitmqChannel of + Nothing -> Nothing + Just chanMVar -> + Just + BackendNotificationQueueAccess.Env + { BackendNotificationQueueAccess.channelMVar = chanMVar, + BackendNotificationQueueAccess.logger = e ^. applog, + BackendNotificationQueueAccess.local = localUnit, + BackendNotificationQueueAccess.requestId = e ^. reqId + } in ExceptT . runFinal @IO . resourceToIOFinal @@ -293,7 +305,7 @@ evalGalley e = . interpretQueue (e ^. deleteQueue) . nowToIO . runInputConst (e ^. options) - . runInputConst (toLocalUnsafe (e ^. options . settings . federationDomain) ()) + . runInputConst localUnit . interpretTeamFeatureSpecialContext e . runInputSem getAllTeamFeaturesForServer . interpretInternalTeamListToCassandra @@ -305,7 +317,7 @@ evalGalley e = . convStoreInterpreter . interpretTeamStoreToCassandra lh . interpretTeamNotificationStoreToCassandra - . interpretServiceStoreToCassandra + . interpretServiceStoreToCassandra (e ^. cstate) . interpretSearchVisibilityStoreToCassandra . interpretLegalHoldStoreToCassandra lh . interpretCustomBackendStoreToCassandra @@ -317,16 +329,17 @@ evalGalley e = . interpretClientStoreToCassandra . interpretTeamCollaboratorsStoreToPostgres . interpretFireAndForget - . interpretBackendNotificationQueueAccess + . BackendNotificationQueueAccess.interpretBackendNotificationQueueAccess backendNotificationQueueAccessEnv . interpretFederatorAccess . runRpcWithHttp (e ^. manager) (e ^. reqId) . runGundeckAPIAccess (e ^. options . gundeck) . interpretTeamSubsystem + . interpretBrigAccess (e ^. brig) + . interpretExternalAccess (e ^. extEnv) . runNotificationSubsystemGundeck (notificationSubsystemConfig e) + . interpretConversationSubsystem . interpretTeamCollaboratorsSubsystem . interpretSparAccess - . interpretBrigAccess (e ^. brig) - . interpretExternalAccess where lh = view (options . settings . featureFlags . to npProject) e diff --git a/services/galley/src/Galley/Cassandra/Queries.hs b/services/galley/src/Galley/Cassandra/Queries.hs index b143103b55..9b078d222b 100644 --- a/services/galley/src/Galley/Cassandra/Queries.hs +++ b/services/galley/src/Galley/Cassandra/Queries.hs @@ -23,7 +23,6 @@ -- - legalhold_pending_prekeys -- - legalhold_service -- - legalhold_whitelisted --- - service -- - team -- - team_admin -- - team_member @@ -42,9 +41,6 @@ module Galley.Cassandra.Queries rmClients, selectSearchVisibility, updateSearchVisibility, - insertSrv, - selectSrv, - rmSrv, insertLegalHoldSettings, selectLegalHoldSettings, removeLegalHoldSettings, @@ -286,17 +282,6 @@ upsertMemberRmClient c = let t = LT.fromStrict (clientToText c) in QueryString $ "update clients set clients = clients - {'" <> t <> "'} where user = ?" --- Services ----------------------------------------------------------------- - -rmSrv :: PrepQuery W (ProviderId, ServiceId) () -rmSrv = "delete from service where provider = ? AND id = ?" - -insertSrv :: PrepQuery W (ProviderId, ServiceId, HttpsUrl, ServiceToken, C.Set (Fingerprint Rsa), Bool) () -insertSrv = "insert into service (provider, id, base_url, auth_token, fingerprints, enabled) values (?, ?, ?, ?, ?, ?)" - -selectSrv :: PrepQuery R (ProviderId, ServiceId) (HttpsUrl, ServiceToken, C.Set (Fingerprint Rsa), Bool) -selectSrv = "select base_url, auth_token, fingerprints, enabled from service where provider = ? AND id = ?" - -- LegalHold ---------------------------------------------------------------- insertLegalHoldSettings :: PrepQuery W (HttpsUrl, Fingerprint Rsa, ServiceToken, ServiceKey, TeamId) () diff --git a/services/galley/src/Galley/Effects.hs b/services/galley/src/Galley/Effects.hs index 1d2811cbe5..4032d26edc 100644 --- a/services/galley/src/Galley/Effects.hs +++ b/services/galley/src/Galley/Effects.hs @@ -62,18 +62,14 @@ where import Data.Id import Data.Qualified -import Galley.Effects.BackendNotificationQueueAccess import Galley.Effects.ClientStore import Galley.Effects.CodeStore import Galley.Effects.CustomBackendStore -import Galley.Effects.ExternalAccess import Galley.Effects.FederatorAccess -import Galley.Effects.FireAndForget import Galley.Effects.LegalHoldStore import Galley.Effects.ProposalStore import Galley.Effects.Queue import Galley.Effects.SearchVisibilityStore -import Galley.Effects.ServiceStore import Galley.Effects.SparAccess import Galley.Effects.TeamFeatureStore import Galley.Effects.TeamMemberStore @@ -89,8 +85,12 @@ import Polysemy.Input import Wire.API.Error import Wire.API.Error.Galley import Wire.API.Team.Feature +import Wire.BackendNotificationQueueAccess import Wire.BrigAPIAccess import Wire.ConversationStore (ConversationStore, MLSCommitLockStore) +import Wire.ConversationSubsystem +import Wire.ExternalAccess +import Wire.FireAndForget import Wire.GundeckAPIAccess import Wire.HashPassword import Wire.ListItems @@ -100,17 +100,19 @@ import Wire.Rpc import Wire.Sem.Now import Wire.Sem.Paging.Cassandra import Wire.Sem.Random +import Wire.ServiceStore import Wire.TeamCollaboratorsStore (TeamCollaboratorsStore) import Wire.TeamCollaboratorsSubsystem (TeamCollaboratorsSubsystem) import Wire.TeamSubsystem (TeamSubsystem) -- All the possible high-level effects. type GalleyEffects1 = - '[ ExternalAccess, - BrigAPIAccess, - SparAccess, + '[ SparAccess, TeamCollaboratorsSubsystem, + ConversationSubsystem, NotificationSubsystem, + ExternalAccess, + BrigAPIAccess, TeamSubsystem, GundeckAPIAccess, Rpc, diff --git a/services/galley/src/Galley/Env.hs b/services/galley/src/Galley/Env.hs index 51ea6f59fc..c4f0d3b34b 100644 --- a/services/galley/src/Galley/Env.hs +++ b/services/galley/src/Galley/Env.hs @@ -24,7 +24,7 @@ import Cassandra import Control.Lens hiding ((.=)) import Data.ByteString.Conversion (toByteString') import Data.Id -import Data.Misc (Fingerprint, HttpsUrl, Rsa) +import Data.Misc (HttpsUrl) import Data.Range import Data.Time.Clock.DiffTime (millisecondsToDiffTime) import Galley.Aws qualified as Aws @@ -44,6 +44,7 @@ import System.Logger import Util.Options import Wire.API.MLS.Keys import Wire.API.Team.Member +import Wire.ExternalAccess.External import Wire.NotificationSubsystem.Interpreter import Wire.RateLimit.Interpreter (RateLimitEnv) @@ -70,16 +71,8 @@ data Env = Env _passwordHashingRateLimitEnv :: RateLimitEnv } --- | Environment specific to the communication with external --- service providers. -data ExtEnv = ExtEnv - { _extGetManager :: (Manager, [Fingerprint Rsa] -> Ssl.SSL -> IO ()) - } - makeLenses ''Env -makeLenses ''ExtEnv - -- TODO: somewhat duplicates Brig.App.initExtGetManager initExtEnv :: IO ExtEnv initExtEnv = do diff --git a/services/galley/src/Galley/External/LegalHoldService/Internal.hs b/services/galley/src/Galley/External/LegalHoldService/Internal.hs index 6cf5cabe5b..7fb6ecaa71 100644 --- a/services/galley/src/Galley/External/LegalHoldService/Internal.hs +++ b/services/galley/src/Galley/External/LegalHoldService/Internal.hs @@ -23,7 +23,7 @@ where import Bilge qualified import Bilge.Retry -import Control.Lens (view) +import Control.Lens ((^.)) import Control.Monad.Catch import Control.Retry import Data.ByteString qualified as BS @@ -38,6 +38,7 @@ import OpenSSL.Session qualified as SSL import Ssl.Util import System.Logger.Class qualified as Log import URI.ByteString (uriPath) +import Wire.ExternalAccess.External (ExtEnv (..)) -- | Check that the given fingerprint is valid and make the request over ssl. -- If the team has a device registered use 'makeLegalHoldServiceRequest' instead. @@ -81,7 +82,8 @@ makeVerifiedRequest :: (Http.Request -> Http.Request) -> App (Http.Response LC8.ByteString) makeVerifiedRequest fpr url reqBuilder = do - (mgr, verifyFingerprints) <- view (extEnv . extGetManager) + env <- ask + let (mgr, verifyFingerprints) = extGetManager (env ^. extEnv) makeVerifiedRequestWithManager mgr verifyFingerprints fpr url reqBuilder -- | NOTE: Use this function wisely - this creates a new manager _every_ time it is called. diff --git a/services/galley/src/Galley/Intra/BackendNotificationQueue.hs b/services/galley/src/Galley/Intra/BackendNotificationQueue.hs deleted file mode 100644 index 756ce2379a..0000000000 --- a/services/galley/src/Galley/Intra/BackendNotificationQueue.hs +++ /dev/null @@ -1,105 +0,0 @@ -{-# LANGUAGE NumericUnderscores #-} - -module Galley.Intra.BackendNotificationQueue (interpretBackendNotificationQueueAccess) where - -import Control.Lens (view) -import Control.Monad.Catch -import Control.Monad.Trans.Except -import Control.Retry -import Data.Domain -import Data.Qualified -import Galley.Cassandra.Util -import Galley.Effects.BackendNotificationQueueAccess (BackendNotificationQueueAccess (..)) -import Galley.Env -import Galley.Monad -import Galley.Options -import Imports -import Network.AMQP qualified as Q -import Polysemy -import Polysemy.Input -import Polysemy.TinyLog -import System.Logger.Class qualified as Log -import UnliftIO -import Wire.API.Federation.BackendNotifications -import Wire.API.Federation.Error - -interpretBackendNotificationQueueAccess :: - ( Member (Embed IO) r, - Member (Input Env) r, - Member TinyLog r - ) => - Sem (BackendNotificationQueueAccess ': r) a -> - Sem r a -interpretBackendNotificationQueueAccess = interpret $ \case - EnqueueNotification deliveryMode remote action -> do - logEffect "BackendNotificationQueueAccess.EnqueueNotification" - embedApp . runExceptT $ enqueueNotification deliveryMode (tDomain remote) action - EnqueueNotificationsConcurrently m xs rpc -> do - logEffect "BackendNotificationQueueAccess.EnqueueNotificationsConcurrently" - embedApp . runExceptT $ enqueueNotificationsConcurrently m xs rpc - EnqueueNotificationsConcurrentlyBuckets m xs rpc -> do - logEffect "BackendNotificationQueueAccess.EnqueueNotificationsConcurrentlyBuckets" - embedApp . runExceptT $ enqueueNotificationsConcurrentlyBuckets m xs rpc - -getChannel :: ExceptT FederationError App (MVar Q.Channel) -getChannel = view rabbitmqChannel >>= maybe (throwE FederationNotConfigured) pure - -enqueueSingleNotification :: Domain -> Q.DeliveryMode -> MVar Q.Channel -> FedQueueClient c a -> App a -enqueueSingleNotification remoteDomain deliveryMode chanVar action = do - ownDomain <- view (options . settings . federationDomain) - let policy = limitRetries 3 <> constantDelay 1_000_000 - handlers = - skipAsyncExceptions - <> [logRetries (const $ pure True) logError] - recovering policy handlers (const $ go ownDomain) - where - logError willRetry (SomeException e) status = do - rid <- view reqId - Log.err $ - Log.msg @Text "failed to enqueue notification in RabbitMQ" - . Log.field "error" (displayException e) - . Log.field "willRetry" willRetry - . Log.field "retryCount" status.rsIterNumber - . Log.field "request" rid - go ownDomain = do - rid <- view reqId - mChan <- timeout 1_000_000 (readMVar chanVar) - case mChan of - Nothing -> throwM NoRabbitMqChannel - Just chan -> do - liftIO $ enqueue chan rid ownDomain remoteDomain deliveryMode action - -enqueueNotification :: Q.DeliveryMode -> Domain -> FedQueueClient c a -> ExceptT FederationError App a -enqueueNotification deliveryMode remoteDomain action = do - chanVar <- getChannel - lift $ enqueueSingleNotification remoteDomain deliveryMode chanVar action - -enqueueNotificationsConcurrently :: - (Foldable f, Functor f) => - Q.DeliveryMode -> - f (Remote x) -> - (Remote [x] -> FedQueueClient c a) -> - ExceptT FederationError App [Remote a] -enqueueNotificationsConcurrently m xs f = - enqueueNotificationsConcurrentlyBuckets m (bucketRemote xs) f - -enqueueNotificationsConcurrentlyBuckets :: - (Foldable f) => - Q.DeliveryMode -> - f (Remote x) -> - (Remote x -> FedQueueClient c a) -> - ExceptT FederationError App [Remote a] -enqueueNotificationsConcurrentlyBuckets m xs f = do - case toList xs of - -- only attempt to get a channel if there is at least one notification to send - [] -> pure [] - _ -> do - chanVar <- getChannel - lift $ pooledForConcurrentlyN 8 (toList xs) $ \r -> - qualifyAs r - <$> enqueueSingleNotification (tDomain r) m chanVar (f r) - -data NoRabbitMqChannel = NoRabbitMqChannel - deriving (Show) - -instance Exception NoRabbitMqChannel diff --git a/services/galley/src/Galley/Options.hs b/services/galley/src/Galley/Options.hs index bd5173f967..a435707a7e 100644 --- a/services/galley/src/Galley/Options.hs +++ b/services/galley/src/Galley/Options.hs @@ -74,7 +74,6 @@ import Data.Domain (Domain) import Data.Id (TeamId) import Data.Misc import Data.Range -import Data.Text qualified as Text import Galley.Keys import Galley.Types.Teams import Hasql.Pool.Extended @@ -86,6 +85,7 @@ import Util.Options.Common import Wire.API.Conversation.Protocol import Wire.API.Routes.Version import Wire.API.Team.Member +import Wire.ConversationStore import Wire.RateLimit.Interpreter (RateLimitConfig) newtype GuestLinkTTLSeconds = GuestLinkTTLSeconds @@ -188,22 +188,6 @@ deriveFromJSON toOptionFieldName ''JournalOpts makeLenses ''JournalOpts -data StorageLocation = CassandraStorage | PostgresqlStorage - -instance FromJSON StorageLocation where - parseJSON = withText "StorageLocation" $ \case - "cassandra" -> pure CassandraStorage - "postgresql" -> pure PostgresqlStorage - x -> fail $ "Invalid storage location: " <> Text.unpack x <> ". Valid options: cassandra, postgresql" - -data PostgresMigrationOpts = PostgresMigrationOpts - { conversation :: StorageLocation - } - -instance FromJSON PostgresMigrationOpts where - parseJSON = withObject "PostgresMigrationOpts" $ \o -> - PostgresMigrationOpts <$> o .: "conversation" - data Opts = Opts { -- | Host and port to bind to _galley :: !Endpoint,