diff --git a/changelog.d/0-release-notes/wpb-27255-email-background-worker.md b/changelog.d/0-release-notes/wpb-27255-email-background-worker.md new file mode 100644 index 00000000000..c05d31b4ddc --- /dev/null +++ b/changelog.d/0-release-notes/wpb-27255-email-background-worker.md @@ -0,0 +1,48 @@ +Outbound email delivery has moved from **brig** to the **background-worker**, +and the queue now carries the *composing payload* instead of a finished mail: +brig no longer renders templates or builds MIME mail. It enqueues every +outbound email (verification, activation, password-reset, invitation, +new-client, account-deletion, SAML IdP-change, provider and enterprise-audit +mail) as a `send_email` job on the `emails` Arbiter queue (a PostgreSQL table +in the default Arbiter schema), carrying only the email type, locale and +structured inputs (recipient, keys/codes, team names, certificate summaries, +...). The background-worker composes the email — locale template selection, +placeholder rendering, MIME building — from the localized templates bundled in +its image (`/usr/share/wire/templates`) right before performing the actual +SMTP/SES send. The queue is not routed through RabbitMQ. + +Operators must configure two blocks on the background-worker: + +- `background-worker.config.email` — the transport (SES **or** SMTP, the same + shape as brig's former `emailSMS.email`); for SES also the worker's AWS + region and credentials (`AWS_REGION` and + `AWS_ACCESS_KEY_ID`/`AWS_SECRET_ACCESS_KEY`). +- `background-worker.config.emailTemplates` — the template directory, default + locale, sender address, branding and the user/team/provider URL templates. + These were previously brig's `emailSMS` template/URL/branding settings + (`emailSMS.general.templateDir`, `emailSMS.general.templateBranding`, + `emailSMS.user.{activation,passwordReset,deletion}Url` and + `emailSMS.provider`); those brig keys are gone, and the worker values must + match what brig used to configure so emails render with the same URLs and + branding as before. The templates directory now ships in the + background-worker image. + +Failed sends are retried by Arbiter with bounded exponential backoff and +eventually land in the queue's dead-letter table, so transient +background-worker downtime does not lose mail: jobs stay in the `emails` table +until a worker picks them up. + +When rolling out, deploy the updated background-worker before (or alongside) +the updated brig so that the new `send_email` jobs are consumed as soon as they +appear; both services run the Arbiter migrations that create the `emails` +table at startup. This ordering assumes no intermediate build that queued email +on RabbitMQ is still running: `send-email` messages on the `background-jobs` +queue are requeued forever by an updated worker (which no longer understands +them). If such a build ran anywhere, drain or delete residual `send-email` +messages from the `background-jobs` queue before upgrading the worker. + +Note: the `emails` queue and its dead-letter table live in the shared +PostgreSQL database and contain the queued request data (including one-time +codes, recipient addresses and reset URLs, for jobs that were never delivered). +Access to the database should therefore be least-privileged, and DLQ growth +should be monitored. diff --git a/charts/wire-server/templates/background-worker/configmap.yaml b/charts/wire-server/templates/background-worker/configmap.yaml index d4fe2a63202..d7f893fcdb5 100644 --- a/charts/wire-server/templates/background-worker/configmap.yaml +++ b/charts/wire-server/templates/background-worker/configmap.yaml @@ -80,6 +80,29 @@ data: {{- end }} {{- end }} + email: + {{- if .useSES }} + sesQueue: {{ required "Missing value: background-worker.config.aws.sesQueue" .aws.sesQueue }} + sesEndpoint: {{ .aws.sesEndpoint | quote }} + {{- else }} + smtpEndpoint: + host: {{ .smtp.host }} + port: {{ .smtp.port }} + smtpConnType: {{ .smtp.connType }} + {{- if .smtp.username }} + smtpCredentials: + smtpUsername: {{ .smtp.username }} + smtpPassword: {{ .smtp.passwordFile }} + {{- end }} + {{- end }} + + # Email templates used to compose the emails queued by brig. + # These values must match what brig used to configure. + {{- with .emailTemplates }} + emailTemplates: +{{ toYaml . | indent 6 }} + {{- end }} + migrateConversations: {{ .migrateConversations }} migrateConversationCodes: {{ .migrateConversationCodes }} migrateTeamFeatures: {{ .migrateTeamFeatures }} diff --git a/charts/wire-server/templates/background-worker/deployment.yaml b/charts/wire-server/templates/background-worker/deployment.yaml index f91ccb5ee17..344c1a97bdd 100644 --- a/charts/wire-server/templates/background-worker/deployment.yaml +++ b/charts/wire-server/templates/background-worker/deployment.yaml @@ -109,6 +109,20 @@ spec: {{ toYaml .Values.additionalVolumeMounts | nindent 10 }} {{- end }} env: + {{- if hasKey $backgroundWorker.secrets "awsKeyId" }} + - name: AWS_ACCESS_KEY_ID + valueFrom: + secretKeyRef: + name: background-worker + key: awsKeyId + - name: AWS_SECRET_ACCESS_KEY + valueFrom: + secretKeyRef: + name: background-worker + key: awsSecretKey + {{- end }} + - name: AWS_REGION + value: "{{ $backgroundWorker.config.aws.region }}" - name: RABBITMQ_USERNAME valueFrom: secretKeyRef: diff --git a/charts/wire-server/templates/background-worker/secret.yaml b/charts/wire-server/templates/background-worker/secret.yaml index 1efb48f2cfa..fc7e61e316e 100644 --- a/charts/wire-server/templates/background-worker/secret.yaml +++ b/charts/wire-server/templates/background-worker/secret.yaml @@ -14,6 +14,13 @@ data: for_helm_linting: {{ required "No .secrets found in configuration. Did you forget to helm -f path/to/secrets.yaml ?" $backgroundWorker.secrets | quote | b64enc | quote }} {{- with $backgroundWorker.secrets }} + {{- if .awsKeyId }} + awsKeyId: {{ .awsKeyId | b64enc | quote }} + awsSecretKey: {{ .awsSecretKey | b64enc | quote }} + {{- end }} + {{- if (not $backgroundWorker.config.useSES) }} + smtp-password.txt: {{ .smtpPassword | b64enc | quote }} + {{- end }} rabbitmqUsername: {{ .rabbitmq.username | b64enc | quote }} rabbitmqPassword: {{ .rabbitmq.password | b64enc | quote }} {{- end }} diff --git a/charts/wire-server/templates/brig/configmap.yaml b/charts/wire-server/templates/brig/configmap.yaml index ad9ee08bf8f..f9688c7fdab 100644 --- a/charts/wire-server/templates/brig/configmap.yaml +++ b/charts/wire-server/templates/brig/configmap.yaml @@ -144,53 +144,14 @@ data: {{- end }} {{- end }} general: - templateDir: /usr/share/wire/templates emailSender: {{ .emailSMS.general.emailSender }} smsSender: {{ .emailSMS.general.smsSender | quote }} - templateBranding: - {{- with .emailSMS.general.templateBranding }} - brand: {{ .brand }} - brandUrl: {{ .brandUrl }} - brandLabelUrl: {{ .brandLabelUrl }} - brandLogoUrl: {{ .brandLogoUrl }} - brandService: {{ .brandService }} - copyright: {{ .copyright }} - misuse: {{ .misuse }} - legal: {{ .legal }} - forgot: {{ .forgot }} - support: {{ .support }} - {{- end }} user: {{- if .emailSMS.user }} - activationUrl: {{ .emailSMS.user.activationUrl }} smsActivationUrl: {{ .emailSMS.user.smsActivationUrl }} - passwordResetUrl: {{ .emailSMS.user.passwordResetUrl }} - {{- if .emailSMS.user.invitationUrl }} - invitationUrl: {{ .emailSMS.user.invitationUrl }} - {{- end }} - deletionUrl: {{ .emailSMS.user.deletionUrl }} {{- else }} - activationUrl: {{ .externalUrls.nginz }}/activate?key=${key}&code=${code} smsActivationUrl: {{ .externalUrls.nginz }}/v/${code} - passwordResetUrl: {{ .externalUrls.nginz }}/password-reset/${key}?code=${code} - invitationUrl: {{ .externalUrls.nginz }}/register?invitation_code=${code} - deletionUrl: {{ .externalUrls.nginz }}/users/delete?key=${key}&code=${code} - {{- end }} - - provider: - {{- if .emailSMS.provider }} - homeUrl: {{ .emailSMS.provider.homeUrl }} - providerActivationUrl: {{ .emailSMS.provider.providerActivationUrl }} - approvalUrl: {{ .emailSMS.provider.approvalUrl }} - approvalTo: {{ .emailSMS.provider.approvalTo }} - providerPwResetUrl: {{ .emailSMS.provider.providerPwResetUrl }} - {{- else }} - homeUrl: https://provider.localhost/ - providerActivationUrl: {{ .externalUrls.nginz }}/provider/activate?key=${key}&code=${code} - approvalUrl: {{ .externalUrls.nginz }}/provider/approve?key=${key}&code=${code} - approvalTo: success@simulator.amazonses.com - providerPwResetUrl: {{ .externalUrls.nginz }}/provider/password-reset?key=\${key}\&code=\${code} {{- end }} team: diff --git a/charts/wire-server/values.yaml b/charts/wire-server/values.yaml index 5bb0b276eb6..b1d75c82c72 100644 --- a/charts/wire-server/values.yaml +++ b/charts/wire-server/values.yaml @@ -372,8 +372,7 @@ galley: seccompProfile: type: RuntimeDefault tests: - config: - {} + config: {} # uploadXml: # baseUrl: s3://bucket/path/ @@ -1075,6 +1074,66 @@ background-worker: # Cron schedule for the cleanup job (0 * * * * = every hour) schedule: "0 * * * *" + # Email transport for the background-worker (delivers the email jobs + # enqueued by brig). Same SES/SMTP shape as brig's emailSMS.email. + # `useSES` selects the transport: when true, the worker sends via AWS SES + # using `aws.sesQueue`/`aws.sesEndpoint` together with the AWS_ACCESS_KEY_ID + # / AWS_SECRET_ACCESS_KEY secrets and the AWS_REGION below. When false, it + # sends via SMTP using the `smtp.*` settings. + useSES: true + aws: + region: "eu-west-1" + sesEndpoint: https://email.eu-west-1.amazonaws.com + # sesQueue is required when useSES is true (deployment-specific), e.g.: + # sesQueue: wire-brig-events + + # SMTP transport (used when useSES is false). The ConfigMap renders these + # into the `email` block; mirrors brig's `smtp` settings. + smtp: + passwordFile: /etc/wire/background-worker/secrets/smtp-password.txt + + # Email templates used to compose the emails queued by brig. + # The background-worker composes all outbound email from these localized + # templates (bundled in the image at templateDir); brig no longer has any + # template/URL/branding settings, so these values must match what brig + # used to configure. + emailTemplates: + templateDir: /usr/share/wire/templates + emailSender: backend@wire.com + templateBranding: + brand: Wire + brandUrl: https://wire.com + brandLabelUrl: wire.com + brandLogoUrl: https://wire.com/p/img/email/logo-email-black.png + brandService: Wire Service Provider + copyright: © WIRE SWISS GmbH + misuse: misuse@wire.com + legal: https://wire.com/legal/ + forgot: https://wire.com/forgot/ + support: https://support.wire.com/ + user: + activationUrl: https:///activate?key=${key}&code=${code} + teamActivationUrl: https:///register?team=${team}&team_code=${code} + passwordResetUrl: https:///password-reset/${key}?code=${code} + deletionUrl: https:///users/delete?key=${key}&code=${code} + team: + tInvitationUrl: https:///register?team=${team}&team_code=${code} + tExistingUserInvitationUrl: https:///register?invitation_code=${code} + tActivationUrl: https:///register?team=${team}&team_code=${code} + tCreatorWelcomeUrl: https://example.com/login + tMemberWelcomeUrl: https://example.com/download + provider: + homeUrl: https://provider.localhost/ + providerActivationUrl: https:///provider/activate?key=${key}&code=${code} + approvalUrl: https:///provider/approve?key=${key}&code=${code} + approvalTo: success@simulator.amazonses.com + providerPwResetUrl: https:///provider/password-reset?key=${key}&code=${code} + + # Optional secret keys (see templates/background-worker/secret.yaml): + # awsKeyId: # required for SES; rendered as AWS_ACCESS_KEY_ID + # awsSecretKey: # required for SES; rendered as AWS_SECRET_ACCESS_KEY + # smtpPassword: # mounted at /etc/wire/background-worker/secrets/smtp-password.txt; + # # consumed via config.smtp.passwordFile (mirrors brig/galley) secrets: {} podSecurityContext: @@ -1192,19 +1251,6 @@ brig: acquisitionTimeout: 10s idlenessTimeout: 10m - emailSMS: - general: - templateBranding: - brand: Wire - brandUrl: https://wire.com - brandLabelUrl: wire.com - brandLogoUrl: https://wire.com/p/img/email/logo-email-black.png - brandService: Wire Service Provider - copyright: © WIRE SWISS GmbH - misuse: misuse@wire.com - legal: https://wire.com/legal/ - forgot: https://wire.com/forgot/ - support: https://support.wire.com/ authSettings: keyIndex: 1 userTokenTimeout: 4838400 @@ -1324,8 +1370,7 @@ brig: seccompProfile: type: RuntimeDefault tests: - config: - {} + config: {} # uploadXml: # baseUrl: s3://bucket/path/ diff --git a/docs/src/developer/reference/config-options.md b/docs/src/developer/reference/config-options.md index cf86ee7681c..2fe1586d466 100644 --- a/docs/src/developer/reference/config-options.md +++ b/docs/src/developer/reference/config-options.md @@ -2448,3 +2448,118 @@ Notes - `jobs.workerThreads` controls the number of worker threads in each job queue. The default is `1`; increasing it allows jobs in that queue to run in parallel when their group keys permit it. - Both job queues share the same PostgreSQL pool. Increasing `jobs.workerThreads` can increase the number of connections needed when more jobs run concurrently, but it does not create a permanently dedicated connection per thread or queue. - The job runner is poll-only and does not require an additional PostgreSQL listener connection. + +## Background worker: Email sending + + +The background-worker delivers the email jobs enqueued by brig on the `emails` +Arbiter queue (PostgreSQL). It requires an `email` transport (AWS SES or SMTP), +the same shape brig uses for `emailSMS.email`. Configuration is supplied via +Helm under `background-worker.config` and rendered into the `email` block of +`background-worker.yaml`. + +The transport is selected by `background-worker.config.useSES`: + +- `useSES: true` (default) renders an SES block. `aws.sesQueue` is required and + `aws.sesEndpoint` selects the SES endpoint. The worker also needs the + `AWS_REGION`, `AWS_ACCESS_KEY_ID`, and `AWS_SECRET_ACCESS_KEY` environment + variables, injected from `background-worker.config.aws.region` and the + `awsKeyId`/`awsSecretKey` secrets (the same pattern brig uses). +- `useSES: false` renders an SMTP block using the `smtp.*` settings. The SMTP + password is read from the file named by `smtp.passwordFile` (mounted from the + `smtpPassword` secret). + +Rendered config (`background-worker.yaml`): + +```yaml +# SES: +email: + sesQueue: wire-brig-events + sesEndpoint: https://email.eu-west-1.amazonaws.com +# SMTP (xor SES): +# email: +# smtpEndpoint: { host: smtp.example.com, port: 587 } +# smtpConnType: tls +# smtpCredentials: +# smtpUsername: wire +# smtpPassword: /etc/wire/background-worker/secrets/smtp-password.txt +``` + +Helm values (under `background-worker`): + +```yaml +config: + useSES: true + aws: + region: "eu-west-1" + sesEndpoint: https://email.eu-west-1.amazonaws.com + sesQueue: wire-brig-events # required when useSES is true + smtp: + passwordFile: /etc/wire/background-worker/secrets/smtp-password.txt +secrets: + awsKeyId: # SES only + awsSecretKey: # SES only + smtpPassword: # SMTP only +``` + +Notes + +- `email` is required: the worker fails to start without a transport. +- For SES, the worker reads `AWS_REGION` from `config.aws.region` and the AWS + credentials from the `awsKeyId`/`awsSecretKey` secrets, mirroring brig. +- For SMTP, the password is mounted at + `/etc/wire/background-worker/secrets/smtp-password.txt` (from the + `smtpPassword` secret); `config.smtp.passwordFile` must point at it. +- Email jobs are inserted by brig into the `emails` table of the default + Arbiter schema (created at startup by the Arbiter migrations). Failed sends + are retried with bounded exponential backoff and eventually moved to the + queue's dead-letter queue, so transient worker downtime does not lose email + jobs. +- The `emails` queue and its dead-letter table live in the shared PostgreSQL + database and contain the queued request data (including one-time codes, + recipient addresses and reset URLs for jobs that were never delivered). Keep + database access least-privileged and monitor DLQ growth. + +## Background worker: Email templates + +The background-worker does not only deliver email, it **composes** it: brig +enqueues the composing payload (email type, locale and inputs such as +recipient, keys/codes, team names) as `send_email` jobs, and the worker +selects the localized template, renders the placeholders and builds the MIME +mail right before sending. The templates directory ships in the +background-worker image at `/usr/share/wire/templates`. + +Configure it via Helm under `background-worker.config.emailTemplates` +(rendered into the `emailTemplates` block of `background-worker.yaml`). These +settings were previously brig's `emailSMS` template/URL/branding settings; +brig no longer has them, so deployments must carry them on the worker instead +(they must match what brig used to configure, or emails will render with +different URLs/branding than before): + +```yaml +config: + emailTemplates: + templateDir: /usr/share/wire/templates + # defaultLocale: en # optional; falls back to en + emailSender: backend@wire.com + templateBranding: # the 10 branding placeholders + brand: Wire + brandUrl: https://wire.com + # ... + user: # user email URL templates + activationUrl: https:///activate?key=${key}&code=${code} + teamActivationUrl: https:///register?team=${team}&team_code=${code} + passwordResetUrl: https:///password-reset/${key}?code=${code} + deletionUrl: https:///users/delete?key=${key}&code=${code} + team: # team email URL templates + tInvitationUrl: https:///register?team=${team}&team_code=${code} + # ... + provider: # provider email URL templates + homeUrl: https://provider.example.com/ + # ... +``` + +brig still configures `emailSMS.general.emailSender` (used for SCIM +invitations and the enterprise audit email configuration) and the team +invitation URL templates (`emailSMS.team`, rendered into API responses); +everything else email-related lives on the worker. diff --git a/hack/bin/headroom-treefmt.sh b/hack/bin/headroom-treefmt.sh index 6f31cf343f5..1c5521e8f18 100755 --- a/hack/bin/headroom-treefmt.sh +++ b/hack/bin/headroom-treefmt.sh @@ -18,4 +18,14 @@ done # '-a' matches 'run-mode: add' from the config; we pass it explicitly so that # this stays add-only even if someone changes the config's default run-mode. -headroom run -a "${args[@]}" + +# headroom touches a per-user SQLite KV store (~/.headroom/cache.sqlite) on +# every startup (update check; no --no-cache flag in v0.4.3.0). Concurrent CI +# jobs on the same worker share $HOME and race on that file, and the embedded +# persistent-sqlite has no busy timeout, so the loser dies with +# "SQLite3 returned ErrorBusy ... database is locked". Point HOME at a +# throwaway dir with the update check disabled so no shared state is touched. +hr_home="$(mktemp -d)" +mkdir -p "$hr_home/.headroom" +printf 'updates:\n check-for-updates: false\n update-interval-days: 7\n' > "$hr_home/.headroom/global-config.yaml" +HOME="$hr_home" headroom run -a "${args[@]}" diff --git a/hack/helm_vars/wire-server/values.yaml.gotmpl b/hack/helm_vars/wire-server/values.yaml.gotmpl index b0309380b56..69c7dcbc2df 100644 --- a/hack/helm_vars/wire-server/values.yaml.gotmpl +++ b/hack/helm_vars/wire-server/values.yaml.gotmpl @@ -161,10 +161,7 @@ brig: emailSender: backend-integrationk8s@wire.com smsSender: dummy user: - activationUrl: https://example.com/verify/?key=${key}&code=${code} smsActivationUrl: https://example.com/v/${code} - passwordResetUrl: https://example.com/reset/?key=${key}&code=${code} - deletionUrl: https://example.com/d/?key=${key}&code=${code} team: tInvitationUrl: https://example.com/join/?team-code=${code} tExistingUserInvitationUrl: https://example.com/accept-invitation/?team-code=${code} @@ -685,6 +682,28 @@ background-worker: cleanOlderThanHours: 0.0014 batchSize: 100 schedule: "* * * * *" + # Email templates for composing the emails queued by brig; + # mirrors the values brig used to configure. + emailTemplates: + templateDir: /usr/share/wire/templates + emailSender: backend-integrationk8s@wire.com + user: + activationUrl: https://example.com/verify/?key=${key}&code=${code} + teamActivationUrl: https://example.com/verify/?key=${key}&code=${code} + passwordResetUrl: https://example.com/reset/?key=${key}&code=${code} + deletionUrl: https://example.com/d/?key=${key}&code=${code} + team: + tInvitationUrl: https://example.com/join/?team-code=${code} + tExistingUserInvitationUrl: https://example.com/accept-invitation/?team-code=${code} + tActivationUrl: https://example.com/verify/?key=${key}&code=${code} + tCreatorWelcomeUrl: https://example.com/login + tMemberWelcomeUrl: https://example.com/download + provider: + homeUrl: https://example.com/ + providerActivationUrl: https://example.com/provider-activate/?key=${key}&code=${code} + approvalUrl: https://example.com/provider-approve/?key=${key}&code=${code} + approvalTo: backend-integrationk8s@wire.com + providerPwResetUrl: https://example.com/provider-reset/?key=${key}&code=${code} # Cassandra clusters used by background-worker cassandra: host: {{ .Values.cassandraHost }} @@ -710,7 +729,15 @@ background-worker: tlsCaSecretRef: name: "rabbitmq-certificate" key: "ca.crt" + # Email transport: the worker sends email via SES in CI (mirrors brig). + useSES: true + aws: + region: "eu-west-1" + sesEndpoint: http://fake-aws-ses:4569 + sesQueue: integration-brig-events secrets: + awsKeyId: dummykey + awsSecretKey: dummysecret rabbitmq: username: {{ .Values.rabbitmqUsername }} password: {{ .Values.rabbitmqPassword }} diff --git a/integration/test/Testlib/ModService.hs b/integration/test/Testlib/ModService.hs index a02f921639a..a6729cfdb15 100644 --- a/integration/test/Testlib/ModService.hs +++ b/integration/test/Testlib/ModService.hs @@ -227,7 +227,8 @@ defaultOverrides resource = setField "federatorInternal.port" resource.berFederatorInternal >=> setField "federatorInternal.host" ("127.0.0.1" :: String) >=> setField "federationDomain" resource.berDomain - >=> setField "rabbitmq.vHost" resource.berVHost, + >=> setField "rabbitmq.vHost" resource.berVHost + >=> setField "emailTemplates.emailSender" resource.berEmailSMSEmailSender, federatorInternalCfg = setField "federatorInternal.port" resource.berFederatorInternal >=> setField "federatorExternal.port" resource.berFederatorExternal diff --git a/libs/wire-api/src/Wire/API/BackgroundJobs/Email.hs b/libs/wire-api/src/Wire/API/BackgroundJobs/Email.hs new file mode 100644 index 00000000000..a899295d18a --- /dev/null +++ b/libs/wire-api/src/Wire/API/BackgroundJobs/Email.hs @@ -0,0 +1,559 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE StrictData #-} +{-# LANGUAGE TemplateHaskell #-} + +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2026 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 . + +-- | Composing payload for outbound email. +-- +-- Outbound email is queued to the background-worker as a 'SendEmail' job on +-- the Arbiter @emails@ queue (see "Wire.API.Jobs"). Producers (brig) enqueue +-- the /composing payload/ only: the email type, locale and structured inputs +-- (recipient, keys\/codes, team names, cert summaries, ...). The +-- background-worker composes the actual email (locale template selection, +-- placeholder rendering, MIME building) right before sending. No rendered +-- email content ever crosses the queue. +module Wire.API.BackgroundJobs.Email where + +import Control.Arrow ((&&&)) +import Control.Lens (makePrisms) +import Data.Aeson qualified as Aeson +import Data.Code qualified as Code +import Data.Id +import Data.Schema +import Imports +import Test.QuickCheck (oneof) +import Wire.API.EnterpriseLogin (DomainRegistrationResponse, mkDomainRegistrationResponse) +import Wire.API.Locale +import Wire.API.Routes.Version (Version (V10)) +import Wire.API.User +import Wire.API.User.Activation (ActivationCode, ActivationKey) +import Wire.API.User.Client (Client) +import Wire.API.User.Password (PasswordResetCode, PasswordResetKey) +import Wire.Arbitrary (Arbitrary (..), GenericUniform (..)) + +-- | Fingerprint summary of an IdP certificate, as needed for the +-- IdP-configuration-change notification email. +data CertSummary = CertSummary + { algorithm :: !Text, + fingerprint :: !Text, + subject :: !Text, + issuer :: !Text + } + deriving stock (Eq, Show, Generic) + deriving (Aeson.ToJSON, Aeson.FromJSON) via (Schema CertSummary) + deriving (Arbitrary) via GenericUniform CertSummary + +instance ToSchema CertSummary where + schema = + object $ + CertSummary + <$> (.algorithm) .= field "algorithm" schema + <*> (.fingerprint) .= field "fingerprint" schema + <*> (.subject) .= field "subject" schema + <*> (.issuer) .= field "issuer" schema + +data VerificationEmail = MkVerificationEmail + { to :: !EmailAddress, + key :: !ActivationKey, + code :: !ActivationCode, + locale :: !(Maybe Locale) + } + deriving stock (Eq, Show, Generic) + deriving (Aeson.ToJSON, Aeson.FromJSON) via (Schema VerificationEmail) + deriving (Arbitrary) via GenericUniform VerificationEmail + +instance ToSchema VerificationEmail where + schema = + object $ + MkVerificationEmail + <$> (.to) .= field "to" schema + <*> (.key) .= field "key" schema + <*> (.code) .= field "code" schema + <*> (.locale) .= maybe_ (optField "locale" schema) + +data ActivationEmail = MkActivationEmail + { to :: !EmailAddress, + name :: !Name, + key :: !ActivationKey, + code :: !ActivationCode, + locale :: !(Maybe Locale) + } + deriving stock (Eq, Show, Generic) + deriving (Aeson.ToJSON, Aeson.FromJSON) via (Schema ActivationEmail) + deriving (Arbitrary) via GenericUniform ActivationEmail + +instance ToSchema ActivationEmail where + schema = + object $ + MkActivationEmail + <$> (.to) .= field "to" schema + <*> (.name) .= field "name" schema + <*> (.key) .= field "key" schema + <*> (.code) .= field "code" schema + <*> (.locale) .= maybe_ (optField "locale" schema) + +data TeamActivationEmail = MkTeamActivationEmail + { to :: !EmailAddress, + name :: !Name, + key :: !ActivationKey, + code :: !ActivationCode, + teamName :: !Text, + locale :: !(Maybe Locale) + } + deriving stock (Eq, Show, Generic) + deriving (Aeson.ToJSON, Aeson.FromJSON) via (Schema TeamActivationEmail) + deriving (Arbitrary) via GenericUniform TeamActivationEmail + +instance ToSchema TeamActivationEmail where + schema = + object $ + MkTeamActivationEmail + <$> (.to) .= field "to" schema + <*> (.name) .= field "name" schema + <*> (.key) .= field "key" schema + <*> (.code) .= field "code" schema + <*> (.teamName) .= field "team_name" schema + <*> (.locale) .= maybe_ (optField "locale" schema) + +data PasswordResetEmail = MkPasswordResetEmail + { to :: !EmailAddress, + key :: !PasswordResetKey, + code :: !PasswordResetCode, + locale :: !(Maybe Locale) + } + deriving stock (Eq, Show, Generic) + deriving (Aeson.ToJSON, Aeson.FromJSON) via (Schema PasswordResetEmail) + deriving (Arbitrary) via GenericUniform PasswordResetEmail + +instance ToSchema PasswordResetEmail where + schema = + object $ + MkPasswordResetEmail + <$> (.to) .= field "to" schema + <*> (.key) .= field "key" schema + <*> (.code) .= field "code" schema + <*> (.locale) .= maybe_ (optField "locale" schema) + +data NewClientEmail = MkNewClientEmail + { to :: !EmailAddress, + name :: !Name, + client :: !Client, + locale :: !Locale + } + deriving stock (Eq, Show, Generic) + deriving (Aeson.ToJSON, Aeson.FromJSON) via (Schema NewClientEmail) + deriving (Arbitrary) via GenericUniform NewClientEmail + +instance ToSchema NewClientEmail where + schema = + object $ + MkNewClientEmail + <$> (.to) .= field "to" schema + <*> (.name) .= field "name" schema + <*> (.client) .= field "client" schema + <*> (.locale) .= field "locale" schema + +data AccountDeletionEmail = MkAccountDeletionEmail + { to :: !EmailAddress, + name :: !Name, + key :: !Code.Key, + code :: !Code.Value, + locale :: !Locale + } + deriving stock (Eq, Show, Generic) + deriving (Aeson.ToJSON, Aeson.FromJSON) via (Schema AccountDeletionEmail) + deriving (Arbitrary) via GenericUniform AccountDeletionEmail + +instance ToSchema AccountDeletionEmail where + schema = + object $ + MkAccountDeletionEmail + <$> (.to) .= field "to" schema + <*> (.name) .= field "name" schema + <*> (.key) .= field "key" schema + <*> (.code) .= field "code" schema + <*> (.locale) .= field "locale" schema + +data SecondFactorVerificationEmail = MkSecondFactorVerificationEmail + { to :: !EmailAddress, + code :: !Code.Value, + locale :: !(Maybe Locale) + } + deriving stock (Eq, Show, Generic) + deriving (Aeson.ToJSON, Aeson.FromJSON) via (Schema SecondFactorVerificationEmail) + deriving (Arbitrary) via GenericUniform SecondFactorVerificationEmail + +instance ToSchema SecondFactorVerificationEmail where + schema = + object $ + MkSecondFactorVerificationEmail + <$> (.to) .= field "to" schema + <*> (.code) .= field "code" schema + <*> (.locale) .= maybe_ (optField "locale" schema) + +data TeamInvitationEmail = MkTeamInvitationEmail + { to :: !EmailAddress, + teamId :: !TeamId, + -- | the inviting user's email address (renders the template's + -- @${inviter}@ placeholder) + inviter :: !EmailAddress, + code :: !InvitationCode, + locale :: !(Maybe Locale) + } + deriving stock (Eq, Show, Generic) + deriving (Aeson.ToJSON, Aeson.FromJSON) via (Schema TeamInvitationEmail) + deriving (Arbitrary) via GenericUniform TeamInvitationEmail + +instance ToSchema TeamInvitationEmail where + schema = + object $ + MkTeamInvitationEmail + <$> (.to) .= field "to" schema + <*> (.teamId) .= field "team_id" schema + <*> (.inviter) .= field "inviter" schema + <*> (.code) .= field "code" schema + <*> (.locale) .= maybe_ (optField "locale" schema) + +data MemberWelcomeEmail = MkMemberWelcomeEmail + { to :: !EmailAddress, + teamId :: !TeamId, + teamName :: !Text, + locale :: !(Maybe Locale) + } + deriving stock (Eq, Show, Generic) + deriving (Aeson.ToJSON, Aeson.FromJSON) via (Schema MemberWelcomeEmail) + deriving (Arbitrary) via GenericUniform MemberWelcomeEmail + +instance ToSchema MemberWelcomeEmail where + schema = + object $ + MkMemberWelcomeEmail + <$> (.to) .= field "to" schema + <*> (.teamId) .= field "team_id" schema + <*> (.teamName) .= field "team_name" schema + <*> (.locale) .= maybe_ (optField "locale" schema) + +data NewTeamOwnerWelcomeEmail = MkNewTeamOwnerWelcomeEmail + { to :: !EmailAddress, + teamId :: !TeamId, + teamName :: !Text, + profileName :: !Name, + locale :: !(Maybe Locale) + } + deriving stock (Eq, Show, Generic) + deriving (Aeson.ToJSON, Aeson.FromJSON) via (Schema NewTeamOwnerWelcomeEmail) + deriving (Arbitrary) via GenericUniform NewTeamOwnerWelcomeEmail + +instance ToSchema NewTeamOwnerWelcomeEmail where + schema = + object $ + MkNewTeamOwnerWelcomeEmail + <$> (.to) .= field "to" schema + <*> (.teamId) .= field "team_id" schema + <*> (.teamName) .= field "team_name" schema + <*> (.profileName) .= field "profile_name" schema + <*> (.locale) .= maybe_ (optField "locale" schema) + +data IdpChangedEmail = MkIdpChangedEmail + { to :: !EmailAddress, + teamId :: !TeamId, + userId :: !(Maybe UserId), + addedCerts :: ![CertSummary], + removedCerts :: ![CertSummary], + idpId :: !Text, + oldIssuer :: !(Maybe Text), + oldEndpoint :: !(Maybe Text), + newIssuer :: !(Maybe Text), + newEndpoint :: !(Maybe Text), + locale :: !(Maybe Locale) + } + deriving stock (Eq, Show, Generic) + deriving (Aeson.ToJSON, Aeson.FromJSON) via (Schema IdpChangedEmail) + deriving (Arbitrary) via GenericUniform IdpChangedEmail + +instance ToSchema IdpChangedEmail where + schema = + object $ + MkIdpChangedEmail + <$> (.to) .= field "to" schema + <*> (.teamId) .= field "team_id" schema + <*> (.userId) .= maybe_ (optField "user_id" schema) + <*> (.addedCerts) .= field "added_certs" (array schema) + <*> (.removedCerts) .= field "removed_certs" (array schema) + <*> (.idpId) .= field "idp_id" schema + <*> (.oldIssuer) .= maybe_ (optField "old_issuer" schema) + <*> (.oldEndpoint) .= maybe_ (optField "old_endpoint" schema) + <*> (.newIssuer) .= maybe_ (optField "new_issuer" schema) + <*> (.newEndpoint) .= maybe_ (optField "new_endpoint" schema) + <*> (.locale) .= maybe_ (optField "locale" schema) + +data ProviderActivationEmail = MkProviderActivationEmail + { to :: !EmailAddress, + name :: !Name, + key :: !Code.Key, + code :: !Code.Value, + update :: !Bool + } + deriving stock (Eq, Show, Generic) + deriving (Aeson.ToJSON, Aeson.FromJSON) via (Schema ProviderActivationEmail) + deriving (Arbitrary) via GenericUniform ProviderActivationEmail + +instance ToSchema ProviderActivationEmail where + schema = + object $ + MkProviderActivationEmail + <$> (.to) .= field "to" schema + <*> (.name) .= field "name" schema + <*> (.key) .= field "key" schema + <*> (.code) .= field "code" schema + <*> (.update) .= field "update" schema + +data ProviderApprovalConfirmEmail = MkProviderApprovalConfirmEmail + { to :: !EmailAddress, + name :: !Name + } + deriving stock (Eq, Show, Generic) + deriving (Aeson.ToJSON, Aeson.FromJSON) via (Schema ProviderApprovalConfirmEmail) + deriving (Arbitrary) via GenericUniform ProviderApprovalConfirmEmail + +instance ToSchema ProviderApprovalConfirmEmail where + schema = + object $ + MkProviderApprovalConfirmEmail + <$> (.to) .= field "to" schema + <*> (.name) .= field "name" schema + +data ProviderPasswordResetEmail = MkProviderPasswordResetEmail + { to :: !EmailAddress, + key :: !Code.Key, + code :: !Code.Value + } + deriving stock (Eq, Show, Generic) + deriving (Aeson.ToJSON, Aeson.FromJSON) via (Schema ProviderPasswordResetEmail) + deriving (Arbitrary) via GenericUniform ProviderPasswordResetEmail + +instance ToSchema ProviderPasswordResetEmail where + schema = + object $ + MkProviderPasswordResetEmail + <$> (.to) .= field "to" schema + <*> (.key) .= field "key" schema + <*> (.code) .= field "code" schema + +data EnterpriseAuditEmail = MkEnterpriseAuditEmail + { from :: !EmailAddress, + to :: !EmailAddress, + subject :: !Text, + url :: !Text, + before :: !(Maybe (DomainRegistrationResponse V10)), + after :: !(Maybe (DomainRegistrationResponse V10)) + } + deriving stock (Eq, Show, Generic) + deriving (Aeson.ToJSON, Aeson.FromJSON) via (Schema EnterpriseAuditEmail) + +instance ToSchema EnterpriseAuditEmail where + schema = + object $ + MkEnterpriseAuditEmail + <$> (.from) .= field "from" schema + <*> (.to) .= field "to" schema + <*> (.subject) .= field "subject" schema + <*> (.url) .= field "url" schema + <*> (.before) .= maybe_ (optField "before" schema) + <*> (.after) .= maybe_ (optField "after" schema) + +instance Arbitrary EnterpriseAuditEmail where + arbitrary = + MkEnterpriseAuditEmail + <$> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> (fmap mkDomainRegistrationResponse <$> arbitrary) + <*> (fmap mkDomainRegistrationResponse <$> arbitrary) + +-- | The composing payload enqueued on the @emails@ queue: the email variant +-- plus its structured inputs. Keep the type tags and nested data shapes stable +-- when changing job payloads; workers decode them later, so changes require a +-- coordinated rollout. +data SendEmailRequest + = VerificationEmail !VerificationEmail + | ActivationEmail !ActivationEmail + | EmailAddressUpdateEmail !ActivationEmail + | TeamActivationEmail !TeamActivationEmail + | PasswordResetEmail !PasswordResetEmail + | NewClientEmail !NewClientEmail + | AccountDeletionEmail !AccountDeletionEmail + | LoginVerificationEmail !SecondFactorVerificationEmail + | ScimTokenVerificationEmail !SecondFactorVerificationEmail + | TeamDeletionVerificationEmail !SecondFactorVerificationEmail + | TeamInvitationEmail !TeamInvitationEmail + | TeamInvitationPersonalUserEmail !TeamInvitationEmail + | MemberWelcomeEmail !MemberWelcomeEmail + | NewTeamOwnerWelcomeEmail !NewTeamOwnerWelcomeEmail + | IdpChangedEmail !IdpChangedEmail + | ProviderActivationEmail !ProviderActivationEmail + | ProviderApprovalConfirmEmail !ProviderApprovalConfirmEmail + | ProviderPasswordResetEmail !ProviderPasswordResetEmail + | EnterpriseAuditEmail !EnterpriseAuditEmail + deriving stock (Eq, Show, Generic) + +data SendEmailRequestTag + = VerificationEmailTag + | ActivationEmailTag + | EmailAddressUpdateEmailTag + | TeamActivationEmailTag + | PasswordResetEmailTag + | NewClientEmailTag + | AccountDeletionEmailTag + | LoginVerificationEmailTag + | ScimTokenVerificationEmailTag + | TeamDeletionVerificationEmailTag + | TeamInvitationEmailTag + | TeamInvitationPersonalUserEmailTag + | MemberWelcomeEmailTag + | NewTeamOwnerWelcomeEmailTag + | IdpChangedEmailTag + | ProviderActivationEmailTag + | ProviderApprovalConfirmEmailTag + | ProviderPasswordResetEmailTag + | EnterpriseAuditEmailTag + deriving stock (Eq, Ord, Bounded, Enum, Show, Generic) + deriving (Arbitrary) via GenericUniform SendEmailRequestTag + +instance ToSchema SendEmailRequestTag where + schema = + enum @Text $ + mconcat + [ element "verification" VerificationEmailTag, + element "activation" ActivationEmailTag, + element "email_update" EmailAddressUpdateEmailTag, + element "team_activation" TeamActivationEmailTag, + element "password_reset" PasswordResetEmailTag, + element "new_client" NewClientEmailTag, + element "account_deletion" AccountDeletionEmailTag, + element "login_verification" LoginVerificationEmailTag, + element "scim_token_verification" ScimTokenVerificationEmailTag, + element "team_deletion_verification" TeamDeletionVerificationEmailTag, + element "team_invitation" TeamInvitationEmailTag, + element "team_invitation_personal_user" TeamInvitationPersonalUserEmailTag, + element "member_welcome" MemberWelcomeEmailTag, + element "new_team_owner_welcome" NewTeamOwnerWelcomeEmailTag, + element "idp_changed" IdpChangedEmailTag, + element "provider_activation" ProviderActivationEmailTag, + element "provider_approval_confirm" ProviderApprovalConfirmEmailTag, + element "provider_password_reset" ProviderPasswordResetEmailTag, + element "enterprise_audit" EnterpriseAuditEmailTag + ] + +makePrisms ''SendEmailRequest + +sendEmailRequestTag :: SendEmailRequest -> SendEmailRequestTag +sendEmailRequestTag = \case + VerificationEmail {} -> VerificationEmailTag + ActivationEmail {} -> ActivationEmailTag + EmailAddressUpdateEmail {} -> EmailAddressUpdateEmailTag + TeamActivationEmail {} -> TeamActivationEmailTag + PasswordResetEmail {} -> PasswordResetEmailTag + NewClientEmail {} -> NewClientEmailTag + AccountDeletionEmail {} -> AccountDeletionEmailTag + LoginVerificationEmail {} -> LoginVerificationEmailTag + ScimTokenVerificationEmail {} -> ScimTokenVerificationEmailTag + TeamDeletionVerificationEmail {} -> TeamDeletionVerificationEmailTag + TeamInvitationEmail {} -> TeamInvitationEmailTag + TeamInvitationPersonalUserEmail {} -> TeamInvitationPersonalUserEmailTag + MemberWelcomeEmail {} -> MemberWelcomeEmailTag + NewTeamOwnerWelcomeEmail {} -> NewTeamOwnerWelcomeEmailTag + IdpChangedEmail {} -> IdpChangedEmailTag + ProviderActivationEmail {} -> ProviderActivationEmailTag + ProviderApprovalConfirmEmail {} -> ProviderApprovalConfirmEmailTag + ProviderPasswordResetEmail {} -> ProviderPasswordResetEmailTag + EnterpriseAuditEmail {} -> EnterpriseAuditEmailTag + +instance ToSchema SendEmailRequest where + schema = object sendEmailRequestObjectSchema + +-- | Common representation for all tagged job payload envelopes: the stable +-- @{\"type\": ..., \"data\": ...}@ shape. Defined here (not in +-- "Wire.API.Jobs") because Jobs imports this module; Jobs re-uses it for its +-- own payloads. +taggedJobPayloadObjectSchema :: + forall tag payload. + (Bounded tag, Enum tag, ToSchema tag) => + (payload -> tag) -> + (tag -> ObjectSchema SwaggerDoc payload) -> + ObjectSchema SwaggerDoc payload +taggedJobPayloadObjectSchema toTag toSchema = + snd <$> (toTag &&& id) .= bind (fst .= tagObjectSchema) (snd .= dispatch toSchema) + where + tagObjectSchema :: ObjectSchema SwaggerDoc tag + tagObjectSchema = field "type" schema + +deriving via (Schema SendEmailRequest) instance Aeson.ToJSON SendEmailRequest + +deriving via (Schema SendEmailRequest) instance Aeson.FromJSON SendEmailRequest + +sendEmailRequestObjectSchema :: ObjectSchema SwaggerDoc SendEmailRequest +sendEmailRequestObjectSchema = taggedJobPayloadObjectSchema sendEmailRequestTag dataSchema + where + dataSchema :: SendEmailRequestTag -> ObjectSchema SwaggerDoc SendEmailRequest + dataSchema = \case + VerificationEmailTag -> tag _VerificationEmail (field "data" schema) + ActivationEmailTag -> tag _ActivationEmail (field "data" schema) + EmailAddressUpdateEmailTag -> tag _EmailAddressUpdateEmail (field "data" schema) + TeamActivationEmailTag -> tag _TeamActivationEmail (field "data" schema) + PasswordResetEmailTag -> tag _PasswordResetEmail (field "data" schema) + NewClientEmailTag -> tag _NewClientEmail (field "data" schema) + AccountDeletionEmailTag -> tag _AccountDeletionEmail (field "data" schema) + LoginVerificationEmailTag -> tag _LoginVerificationEmail (field "data" schema) + ScimTokenVerificationEmailTag -> tag _ScimTokenVerificationEmail (field "data" schema) + TeamDeletionVerificationEmailTag -> tag _TeamDeletionVerificationEmail (field "data" schema) + TeamInvitationEmailTag -> tag _TeamInvitationEmail (field "data" schema) + TeamInvitationPersonalUserEmailTag -> tag _TeamInvitationPersonalUserEmail (field "data" schema) + MemberWelcomeEmailTag -> tag _MemberWelcomeEmail (field "data" schema) + NewTeamOwnerWelcomeEmailTag -> tag _NewTeamOwnerWelcomeEmail (field "data" schema) + IdpChangedEmailTag -> tag _IdpChangedEmail (field "data" schema) + ProviderActivationEmailTag -> tag _ProviderActivationEmail (field "data" schema) + ProviderApprovalConfirmEmailTag -> tag _ProviderApprovalConfirmEmail (field "data" schema) + ProviderPasswordResetEmailTag -> tag _ProviderPasswordResetEmail (field "data" schema) + EnterpriseAuditEmailTag -> tag _EnterpriseAuditEmail (field "data" schema) + +instance Arbitrary SendEmailRequest where + arbitrary = + oneof + [ VerificationEmail <$> arbitrary, + ActivationEmail <$> arbitrary, + EmailAddressUpdateEmail <$> arbitrary, + TeamActivationEmail <$> arbitrary, + PasswordResetEmail <$> arbitrary, + NewClientEmail <$> arbitrary, + AccountDeletionEmail <$> arbitrary, + LoginVerificationEmail <$> arbitrary, + ScimTokenVerificationEmail <$> arbitrary, + TeamDeletionVerificationEmail <$> arbitrary, + TeamInvitationEmail <$> arbitrary, + TeamInvitationPersonalUserEmail <$> arbitrary, + MemberWelcomeEmail <$> arbitrary, + NewTeamOwnerWelcomeEmail <$> arbitrary, + IdpChangedEmail <$> arbitrary, + ProviderActivationEmail <$> arbitrary, + ProviderApprovalConfirmEmail <$> arbitrary, + ProviderPasswordResetEmail <$> arbitrary, + EnterpriseAuditEmail <$> arbitrary + ] diff --git a/libs/wire-api/src/Wire/API/Jobs.hs b/libs/wire-api/src/Wire/API/Jobs.hs index f60d60ca74f..41d32883526 100644 --- a/libs/wire-api/src/Wire/API/Jobs.hs +++ b/libs/wire-api/src/Wire/API/Jobs.hs @@ -24,7 +24,6 @@ module Wire.API.Jobs where import Arbiter.Core.QueueRegistry (Queue) -import Control.Arrow ((&&&)) import Control.Lens (makePrisms) import Data.Aeson (FromJSON, ToJSON) import Data.Id @@ -36,6 +35,7 @@ import Data.Text as Text import GHC.TypeLits import Imports import Test.QuickCheck (oneof) +import Wire.API.BackgroundJobs.Email (SendEmailRequest, taggedJobPayloadObjectSchema) import Wire.Arbitrary (Arbitrary (..), GenericUniform (..)) -- | The queue/table for jobs that operate on meetings. @@ -50,6 +50,12 @@ type ConversationsQueueName = "conversations" conversationsQueueName :: Text conversationsQueueName = Text.pack $ symbolVal (Proxy @ConversationsQueueName) +-- | The queue/table for jobs that send outbound email. +type EmailsQueueName = "emails" + +emailsQueueName :: Text +emailsQueueName = Text.pack $ symbolVal (Proxy @EmailsQueueName) + -- | Empty payload because the schedule itself carries all execution context. data MeetingsCleanupJob = MeetingsCleanupJob deriving stock (Eq, Generic, Show) @@ -135,20 +141,8 @@ instance ToSchema AdminlessSetupJob where <*> (.adminlessSetupJobOrigUserId) .= maybe_ (optField "orig_user_id" schema) <*> (.adminlessSetupJobRequestId) .= field "request_id" schema --- | Common representation for all queue payload envelopes. -- The queue-specific sum supplies the type tag and its associated data schema, -- while this helper guarantees the stable {"type": ..., "data": ...} shape. -taggedJobPayloadObjectSchema :: - forall tag payload. - (Bounded tag, Enum tag, ToSchema tag) => - (payload -> tag) -> - (tag -> ObjectSchema SwaggerDoc payload) -> - ObjectSchema SwaggerDoc payload -taggedJobPayloadObjectSchema toTag toSchema = - snd <$> (toTag &&& id) .= bind (fst .= tagObjectSchema) (snd .= dispatch toSchema) - where - tagObjectSchema :: ObjectSchema SwaggerDoc tag - tagObjectSchema = field "type" schema -- | Payload persisted in the meetings queue. Keep the type tag and nested data -- shape stable when changing job payloads. The sum makes the queue @@ -247,8 +241,74 @@ deriving via (Schema ConversationsJobPayload) instance S.ToSchema ConversationsJ instance Arbitrary ConversationsJobPayload where arbitrary = oneof [AdminlessDeletion <$> arbitrary, AdminlessReminder <$> arbitrary] +-- | Payload persisted in the emails queue. Keep the type tag and nested data +-- shape stable when changing job payloads. The payload carries the composing +-- request (email type, locale and structured inputs) from +-- "Wire.API.BackgroundJobs.Email"; the background-worker composes the actual +-- email right before sending. The request id of the brig request that queued +-- the mail is captured for logging/tracing in the worker. +data SendEmailJobPayload = SendEmailJobPayload + { sendEmailJobRequestId :: !RequestId, + sendEmailJobRequest :: !SendEmailRequest + } + deriving stock (Eq, Generic, Show) + deriving (ToJSON, FromJSON, S.ToSchema) via (Schema SendEmailJobPayload) + +instance ToSchema SendEmailJobPayload where + schema = + object $ + SendEmailJobPayload + <$> (.sendEmailJobRequestId) .= field "request_id" schema + <*> (.sendEmailJobRequest) .= field "request" schema + +instance Arbitrary SendEmailJobPayload where + arbitrary = SendEmailJobPayload <$> arbitrary <*> arbitrary + +data EmailsJobPayload + = SendEmail !SendEmailJobPayload + deriving stock (Eq, Generic, Show) + +data EmailsJobPayloadTag + = SendEmailTag + deriving stock (Eq, Ord, Bounded, Enum, Show, Generic) + deriving (Arbitrary) via GenericUniform EmailsJobPayloadTag + +instance ToSchema EmailsJobPayloadTag where + schema = + enum @Text $ + mconcat + [ element "send_email" SendEmailTag + ] + +makePrisms ''EmailsJobPayload + +emailsJobPayloadObjectSchema :: ObjectSchema SwaggerDoc EmailsJobPayload +emailsJobPayloadObjectSchema = taggedJobPayloadObjectSchema toTag toSchema + where + toTag :: EmailsJobPayload -> EmailsJobPayloadTag + toTag = + \case + SendEmail {} -> SendEmailTag + + toSchema :: EmailsJobPayloadTag -> ObjectSchema SwaggerDoc EmailsJobPayload + toSchema = \case + SendEmailTag -> tag _SendEmail (field "data" schema) + +instance ToSchema EmailsJobPayload where + schema = object emailsJobPayloadObjectSchema + +deriving via (Schema EmailsJobPayload) instance FromJSON EmailsJobPayload + +deriving via (Schema EmailsJobPayload) instance ToJSON EmailsJobPayload + +deriving via (Schema EmailsJobPayload) instance S.ToSchema EmailsJobPayload + +instance Arbitrary EmailsJobPayload where + arbitrary = SendEmail <$> arbitrary + -- | Registry for the jobs we expose via Arbiter. type JobRegistry = '[ Queue MeetingsQueueName MeetingsJobPayload, - Queue ConversationsQueueName ConversationsJobPayload + Queue ConversationsQueueName ConversationsJobPayload, + Queue EmailsQueueName EmailsJobPayload ] diff --git a/libs/wire-api/wire-api.cabal b/libs/wire-api/wire-api.cabal index e7f4e0886e0..6129e0ec934 100644 --- a/libs/wire-api/wire-api.cabal +++ b/libs/wire-api/wire-api.cabal @@ -72,6 +72,7 @@ library Wire.API.ApplyMods Wire.API.Asset Wire.API.BackgroundJobs + Wire.API.BackgroundJobs.Email Wire.API.Bot Wire.API.Bot.Service Wire.API.Call.Config diff --git a/libs/wire-subsystems/src/Wire/EmailSending/Composer.hs b/libs/wire-subsystems/src/Wire/EmailSending/Composer.hs new file mode 100644 index 00000000000..08a753bf3b8 --- /dev/null +++ b/libs/wire-subsystems/src/Wire/EmailSending/Composer.hs @@ -0,0 +1,283 @@ +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2026 Wire Swiss GmbH +-- +-- This program is free software: you can redistribute it and/or modify it under +-- the terms of the GNU Affero General Public License as published by the Free +-- Software Foundation, either version 3 of the License, or (at your option) any +-- later version. +-- +-- This program is distributed in the hope that it will be useful, but WITHOUT +-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more +-- details. +-- +-- You should have received a copy of the GNU Affero General Public License along +-- with this program. If not, see . +{-# LANGUAGE RecordWildCards #-} + +-- | Worker-side email composition. +-- +-- Producers enqueue the composing payload ('SendEmailRequest'); this module +-- turns a payload into a MIME 'Mail' right before sending: locale template +-- selection, placeholder rendering and MIME building all happen here. +module Wire.EmailSending.Composer + ( EmailTemplates (..), + loadEmailTemplates, + composeEmail, + ) +where + +import Data.Aeson.Encode.Pretty qualified as Aeson +import Data.Code qualified as Code +import Data.Default (def) +import Data.Range (fromRange) +import Data.Text (pack) +import Data.Text.Ascii qualified as Ascii +import Data.Text.Lazy qualified as Lazy +import Data.Text.Lazy.Encoding qualified as LT +import Data.Text.Template (Template) +import Imports +import Network.Mail.Mime +import Polysemy +import Polysemy.Output (Output) +import Wire.API.BackgroundJobs.Email +import Wire.API.EnterpriseLogin (DomainRegistrationResponse) +import Wire.API.Routes.Version (Version (V10)) +import Wire.API.User +import Wire.EmailSubsystem.Interpreter + ( InvitationEmail (..), + mkMimeAddress, + renderActivationMail, + renderDeletionEmail, + renderIdPConfigChangeEmail, + renderInvitationEmail, + renderMemberWelcomeMail, + renderNewClientEmail, + renderNewTeamOwnerWelcomeEmail, + renderPwResetMail, + renderSecondFactorVerificationEmail, + renderTeamActivationMail, + renderVerificationMail, + ) +import Wire.EmailSubsystem.Template +import Wire.EmailSubsystem.Templates.Provider qualified as P +import Wire.EmailSubsystem.Templates.Team +import Wire.EmailSubsystem.Templates.User qualified as U + +-- | The full set of localised templates the composer needs, plus the branding +-- in both forms used by the render functions (user\/team renders take a map, +-- provider renders take a function). +data EmailTemplates = EmailTemplates + { userTemplates :: Localised U.UserTemplates, + teamTemplates :: Localised TeamTemplates, + providerTemplates :: Localised P.ProviderTemplates, + brandingFn :: TemplateBranding, + brandingMap :: Map Text Text + } + +-- | Load all templates from the bundled templates directory. Fails fast at +-- startup if files are missing (same behaviour brig used to have). +loadEmailTemplates :: EmailTemplatesOpts -> IO EmailTemplates +loadEmailTemplates opts = do + user <- loadUserTemplates opts.user dir locale sender + team <- loadTeamTemplates opts.team dir locale sender + provider <- P.loadProviderTemplates opts.provider dir locale sender + pure + EmailTemplates + { userTemplates = user, + teamTemplates = team, + providerTemplates = provider, + brandingFn = genTemplateBranding opts.templateBranding, + brandingMap = genTemplateBrandingMap opts.templateBranding + } + where + dir = opts.templateDir + locale = fromMaybe def opts.defaultLocale + sender = opts.emailSender + +-- | Compose the email for a queued composing payload. +composeEmail :: (Member (Output Text) r) => EmailTemplates -> SendEmailRequest -> Sem r Mail +composeEmail tpls = \case + VerificationEmail (MkVerificationEmail to key code locale) -> + renderVerificationMail to key code (U.verificationEmail . snd $ forLocale locale tpls.userTemplates) tpls.brandingMap + ActivationEmail (MkActivationEmail to name key code locale) -> + renderActivationMail to name key code (U.activationEmail . snd $ forLocale locale tpls.userTemplates) tpls.brandingMap + EmailAddressUpdateEmail (MkActivationEmail to name key code locale) -> + renderActivationMail to name key code (U.activationEmailUpdate . snd $ forLocale locale tpls.userTemplates) tpls.brandingMap + TeamActivationEmail (MkTeamActivationEmail to name key code teamName locale) -> + renderTeamActivationMail to name teamName key code (U.teamActivationEmail . snd $ forLocale locale tpls.userTemplates) tpls.brandingMap + PasswordResetEmail (MkPasswordResetEmail to key code locale) -> + renderPwResetMail to key code (U.passwordResetEmail . snd $ forLocale locale tpls.userTemplates) tpls.brandingMap + NewClientEmail (MkNewClientEmail to name client locale) -> + renderNewClientEmail to name locale client (U.newClientEmail . snd $ forLocale (Just locale) tpls.userTemplates) tpls.brandingMap + AccountDeletionEmail (MkAccountDeletionEmail to name key code locale) -> + renderDeletionEmail to name key code (U.deletionEmail . snd $ forLocale (Just locale) tpls.userTemplates) tpls.brandingMap + LoginVerificationEmail (MkSecondFactorVerificationEmail to code locale) -> + renderSecondFactorVerificationEmail to code (U.verificationLoginEmail . snd $ forLocale locale tpls.userTemplates) tpls.brandingMap + ScimTokenVerificationEmail (MkSecondFactorVerificationEmail to code locale) -> + renderSecondFactorVerificationEmail to code (U.verificationScimTokenEmail . snd $ forLocale locale tpls.userTemplates) tpls.brandingMap + TeamDeletionVerificationEmail (MkSecondFactorVerificationEmail to code locale) -> + renderSecondFactorVerificationEmail to code (U.verificationTeamDeletionEmail . snd $ forLocale locale tpls.userTemplates) tpls.brandingMap + TeamInvitationEmail (MkTeamInvitationEmail {to, teamId, inviter, code, locale}) -> do + (mail, _) <- + renderInvitationEmail + (InvitationEmail to teamId code inviter) + (invitationEmail . snd $ forLocale locale tpls.teamTemplates) + tpls.brandingMap + pure mail + TeamInvitationPersonalUserEmail (MkTeamInvitationEmail {to, teamId, inviter, code, locale}) -> do + (mail, _) <- + renderInvitationEmail + (InvitationEmail to teamId code inviter) + (existingUserInvitationEmail . snd $ forLocale locale tpls.teamTemplates) + tpls.brandingMap + pure mail + MemberWelcomeEmail (MkMemberWelcomeEmail to teamId teamName locale) -> + renderMemberWelcomeMail to teamId teamName (memberWelcomeEmail . snd $ forLocale locale tpls.teamTemplates) tpls.brandingMap + NewTeamOwnerWelcomeEmail (MkNewTeamOwnerWelcomeEmail to teamId teamName profileName locale) -> + renderNewTeamOwnerWelcomeEmail to teamId teamName profileName (newTeamOwnerWelcomeEmail . snd $ forLocale locale tpls.teamTemplates) tpls.brandingMap + IdpChangedEmail payload@MkIdpChangedEmail {userId = _userId, ..} -> + renderIdPConfigChangeEmail + (idpConfigChangeEmail . snd $ forLocale locale tpls.teamTemplates) + tpls.brandingMap + payload + -- Provider emails always used the default locale, so no locale selection here. + ProviderActivationEmail (MkProviderActivationEmail to name key code update) -> do + let P.ProviderTemplates {..} = snd $ forLocale Nothing tpls.providerTemplates + tpl = if update then activationEmailUpdate else activationEmail + pure $ renderProviderActivationMail to name key code tpl tpls.brandingFn + ProviderApprovalConfirmEmail (MkProviderApprovalConfirmEmail to name) -> + pure $ + renderProviderApprovalConfirmMail + to + name + (P.approvalConfirmEmail . snd $ forLocale Nothing tpls.providerTemplates) + tpls.brandingFn + ProviderPasswordResetEmail (MkProviderPasswordResetEmail to key code) -> + pure $ + renderProviderPwResetMail + to + key + code + (P.passwordResetEmail . snd $ forLocale Nothing tpls.providerTemplates) + tpls.brandingFn + EnterpriseAuditEmail (MkEnterpriseAuditEmail {..}) -> + pure $ mkAuditMail from to subject (mkAuditBody url before after) + +-------------------------------------------------------------------------------- +-- Provider renders +-------------------------------------------------------------------------------- + +renderProviderActivationMail :: EmailAddress -> Name -> Code.Key -> Code.Value -> P.ActivationEmailTemplate -> TemplateBranding -> Mail +renderProviderActivationMail acmTo acmName acmKey acmCode P.ActivationEmailTemplate {..} branding = + (emptyMail from) + { mailTo = [to], + mailHeaders = + [ ("Subject", Lazy.toStrict subj), + ("X-Zeta-Purpose", "ProviderActivation"), + ("X-Zeta-Key", Ascii.toText (fromRange key)), + ("X-Zeta-Code", Ascii.toText (fromRange code)) + ], + mailParts = [[plainPart txt, htmlPart html]] + } + where + (Code.Key key, Code.Value code) = (acmKey, acmCode) + from = Address (Just activationEmailSenderName) (fromEmail activationEmailSender) + to = mkMimeAddress acmName acmTo + txt = renderTextWithBranding activationEmailBodyText replace branding + html = renderHtmlWithBranding activationEmailBodyHtml replace branding + subj = renderTextWithBranding activationEmailSubject replace branding + replace "url" = renderProviderActivationUrl activationEmailUrl acmKey acmCode branding + replace "email" = fromEmail acmTo + replace "name" = fromName acmName + replace x = x + +renderProviderActivationUrl :: Template -> Code.Key -> Code.Value -> TemplateBranding -> Text +renderProviderActivationUrl t (Code.Key k) (Code.Value v) branding = + Lazy.toStrict $ renderTextWithBranding t replace branding + where + replace "key" = Ascii.toText (fromRange k) + replace "code" = Ascii.toText (fromRange v) + replace x = x + +renderProviderApprovalConfirmMail :: EmailAddress -> Name -> P.ApprovalConfirmEmailTemplate -> TemplateBranding -> Mail +renderProviderApprovalConfirmMail apcTo apcName P.ApprovalConfirmEmailTemplate {..} branding = + (emptyMail from) + { mailTo = [to], + mailHeaders = + [ ("Subject", Lazy.toStrict subj), + ("X-Zeta-Purpose", "ProviderApprovalConfirm") + ], + mailParts = [[plainPart txt, htmlPart html]] + } + where + from = Address (Just approvalConfirmEmailSenderName) (fromEmail approvalConfirmEmailSender) + to = mkMimeAddress apcName apcTo + txt = renderTextWithBranding approvalConfirmEmailBodyText replace branding + html = renderHtmlWithBranding approvalConfirmEmailBodyHtml replace branding + subj = renderTextWithBranding approvalConfirmEmailSubject replace branding + replace "homeUrl" = pack $ show approvalConfirmEmailHomeUrl + replace "email" = fromEmail apcTo + replace "name" = fromName apcName + replace x = x + +renderProviderPwResetMail :: EmailAddress -> Code.Key -> Code.Value -> P.PasswordResetEmailTemplate -> TemplateBranding -> Mail +renderProviderPwResetMail pwrTo pwrKey pwrCode P.PasswordResetEmailTemplate {..} branding = + (emptyMail from) + { mailTo = [to], + mailHeaders = + [ ("Subject", Lazy.toStrict subj), + ("X-Zeta-Purpose", "ProviderPasswordReset"), + ("X-Zeta-Key", Ascii.toText (fromRange key)), + ("X-Zeta-Code", Ascii.toText (fromRange code)) + ], + mailParts = [[plainPart txt, htmlPart html]] + } + where + (Code.Key key, Code.Value code) = (pwrKey, pwrCode) + from = Address (Just passwordResetEmailSenderName) (fromEmail passwordResetEmailSender) + to = Address Nothing (fromEmail pwrTo) + txt = renderTextWithBranding passwordResetEmailBodyText replace branding + html = renderHtmlWithBranding passwordResetEmailBodyHtml replace branding + subj = renderTextWithBranding passwordResetEmailSubject replace branding + replace "url" = renderProviderPwResetUrl passwordResetEmailUrl pwrKey pwrCode branding + replace x = x + +renderProviderPwResetUrl :: Template -> Code.Key -> Code.Value -> TemplateBranding -> Text +renderProviderPwResetUrl t (Code.Key k) (Code.Value v) branding = + Lazy.toStrict $ renderTextWithBranding t replace branding + where + replace "key" = Ascii.toText (fromRange k) + replace "code" = Ascii.toText (fromRange v) + replace x = x + +-------------------------------------------------------------------------------- +-- Enterprise audit email +-------------------------------------------------------------------------------- + +-- | Audit email body: the called URL plus pretty-printed old\/new values. +mkAuditBody :: + Text -> + Maybe (DomainRegistrationResponse V10) -> + Maybe (DomainRegistrationResponse V10) -> + Lazy.Text +mkAuditBody url before after = + Lazy.fromStrict url + <> " called;\nOld value:\n" + <> pretty before + <> "\nNew value:\n" + <> pretty after + where + pretty = maybe "null" (LT.decodeUtf8 . Aeson.encodePretty) + +mkAuditMail :: EmailAddress -> EmailAddress -> Text -> Lazy.Text -> Mail +mkAuditMail from to subject bdy = + (emptyMail (Address Nothing (fromEmail from))) + { mailTo = [Address Nothing (fromEmail to)], + mailHeaders = + [ ("Subject", subject), + ("X-Zeta-Purpose", "audit") + ], + mailParts = [[plainPart bdy]] + } diff --git a/libs/wire-subsystems/src/Wire/EmailSending/Queueing.hs b/libs/wire-subsystems/src/Wire/EmailSending/Queueing.hs new file mode 100644 index 00000000000..03309a42297 --- /dev/null +++ b/libs/wire-subsystems/src/Wire/EmailSending/Queueing.hs @@ -0,0 +1,82 @@ +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2026 Wire Swiss GmbH +-- +-- This program is free software: you can redistribute it and/or modify it under +-- the terms of the GNU Affero General Public License as published by the Free +-- Software Foundation, either version 3 of the License, or (at your option) any +-- later version. +-- +-- This program is distributed in the hope that it will be useful, but WITHOUT +-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more +-- details. +-- +-- You should have received a copy of the GNU Affero General Public License along +-- with this program. If not, see . +{-# LANGUAGE TemplateHaskell #-} + +-- | Queueing effect for outbound email. +-- +-- Producers (brig) enqueue the composing payload ('SendEmailRequest': email +-- type, locale and structured inputs) as a 'SendEmail' job into the Arbiter +-- @emails@ queue (a PostgreSQL table managed by Arbiter). The +-- background-worker composes the actual email (template selection, rendering, +-- MIME building) and performs the send; see "Wire.EmailSending.Composer" and +-- "Wire.EmailJobsWorker". +module Wire.EmailSending.Queueing + ( EmailQueueing (..), + queueEmail, + emailViaQueueInterpreter, + ) +where + +import Arbiter.Core qualified as ArbiterCore +import Data.Id (RequestId) +import Hasql.Pool.Extended qualified as HasqlPoolExt +import Imports +import Polysemy (Embed, InterpreterFor, Member, embed, interpret, makeSem) +import Wire.API.BackgroundJobs.Email (SendEmailRequest) +import Wire.API.Jobs (EmailsJobPayload (SendEmail), JobRegistry, SendEmailJobPayload (..)) +import Wire.JobSubsystem.ArbiterAdapter (WireArbiter, mkNewWireArbiterEnv, runWireArbiter) + +-- | Effect for enqueueing outbound email as a composing payload. Producers use +-- this instead of 'Wire.EmailSending.SendMail': no rendered mail exists on the +-- producer side. +data EmailQueueing m a where + QueueEmail :: SendEmailRequest -> EmailQueueing m () + +makeSem ''EmailQueueing + +-- | Interpret 'EmailQueueing' by inserting a 'SendEmail' job into the Arbiter +-- @emails@ queue. +-- +-- The interpreter is self-contained: it runs Arbiter against the producer's +-- shared PostgreSQL pool, so its only effect requirement is 'Embed' 'IO' and it +-- drops into the producer's effect stack exactly where the old direct-send +-- interpreter sat. The table is created by 'runJobMigrations' (run at startup +-- by every service that schedules or executes jobs). +emailViaQueueInterpreter :: + (Member (Embed IO) r) => + RequestId -> + HasqlPoolExt.Pool -> + InterpreterFor EmailQueueing r +emailViaQueueInterpreter requestId pool = interpret \case + QueueEmail request -> do + let payload = + SendEmailJobPayload + { sendEmailJobRequestId = requestId, + sendEmailJobRequest = request + } + -- Bounded attempts: the send is retried by Arbiter with exponential + -- backoff, and after these attempts the job is moved to the queue's + -- dead-letter table. + job = + (ArbiterCore.defaultJob (SendEmail payload)) + { ArbiterCore.maxAttempts = Just 3 + } + embed @IO . void $ + runWireArbiter arbiterEnv $ + ArbiterCore.insertJob @EmailsJobPayload @(WireArbiter JobRegistry) job + where + arbiterEnv = mkNewWireArbiterEnv ArbiterCore.defaultSchemaName pool diff --git a/libs/wire-subsystems/src/Wire/EmailSubsystem.hs b/libs/wire-subsystems/src/Wire/EmailSubsystem.hs index 0ab910e724c..3eba7f4bc73 100644 --- a/libs/wire-subsystems/src/Wire/EmailSubsystem.hs +++ b/libs/wire-subsystems/src/Wire/EmailSubsystem.hs @@ -43,9 +43,9 @@ data EmailSubsystem m a where SendTeamActivationMail :: EmailAddress -> Name -> ActivationKey -> ActivationCode -> Maybe Locale -> Text -> EmailSubsystem m () SendTeamDeletionVerificationMail :: EmailAddress -> Code.Value -> Maybe Locale -> EmailSubsystem m () -- | send invitation to an unknown email address. - SendTeamInvitationMail :: EmailAddress -> TeamId -> EmailAddress -> InvitationCode -> Maybe Locale -> EmailSubsystem m Text + SendTeamInvitationMail :: EmailAddress -> TeamId -> EmailAddress -> InvitationCode -> Maybe Locale -> EmailSubsystem m () -- | send invitation to an email address associated with a personal user account. - SendTeamInvitationMailPersonalUser :: EmailAddress -> TeamId -> EmailAddress -> InvitationCode -> Maybe Locale -> EmailSubsystem m Text + SendTeamInvitationMailPersonalUser :: EmailAddress -> TeamId -> EmailAddress -> InvitationCode -> Maybe Locale -> EmailSubsystem m () SendMemberWelcomeEmail :: EmailAddress -> TeamId -> Text -> Maybe Locale -> EmailSubsystem m () SendNewTeamOwnerWelcomeEmail :: EmailAddress -> TeamId -> Text -> Maybe Locale -> Name -> EmailSubsystem m () SendSAMLIdPChanged :: diff --git a/libs/wire-subsystems/src/Wire/EmailSubsystem/Interpreter.hs b/libs/wire-subsystems/src/Wire/EmailSubsystem/Interpreter.hs index 5a9b54fa14d..617c97312fd 100644 --- a/libs/wire-subsystems/src/Wire/EmailSubsystem/Interpreter.hs +++ b/libs/wire-subsystems/src/Wire/EmailSubsystem/Interpreter.hs @@ -31,51 +31,87 @@ import Data.Text.Encoding qualified as T import Data.Text.Lazy (toStrict) import Data.Text.Lazy qualified as TL import Data.Text.Template -import Data.UUID (toText) +import Data.UUID qualified as UUID import Data.X509.Extended import Imports import Network.Mail.Mime import Polysemy import Polysemy.Output (Output) -import Polysemy.TinyLog (TinyLog) import SAML2.WebSSO -import URI.ByteString (URI, serializeURIRef') +import URI.ByteString (serializeURIRef') +import Wire.API.BackgroundJobs.Email import Wire.API.Locale import Wire.API.User import Wire.API.User.Activation import Wire.API.User.Client (Client (..)) import Wire.API.User.Password -import Wire.EmailSending (EmailSending, sendMail) +import Wire.EmailSending.Queueing (EmailQueueing, queueEmail) import Wire.EmailSubsystem import Wire.EmailSubsystem.Template import Wire.EmailSubsystem.Templates.Team import Wire.EmailSubsystem.Templates.User -emailSubsystemInterpreter :: - (Member EmailSending r, Member TinyLog r) => - Localised UserTemplates -> - Localised TeamTemplates -> - Map Text Text -> - InterpreterFor EmailSubsystem r -emailSubsystemInterpreter userTpls teamTpls branding = interpret \case +-- | Interpret 'EmailSubsystem' by enqueueing the composing payload for each +-- email on the Arbiter @emails@ queue (via 'EmailQueueing'). No templates or +-- branding are touched here; the background-worker composes the actual email +-- right before sending (see "Wire.EmailSending.Composer"). +emailSubsystemInterpreter :: (Member EmailQueueing r) => InterpreterFor EmailSubsystem r +emailSubsystemInterpreter = interpret \case -- USER EMAILS - SendPasswordResetMail email (key, code) mLocale -> sendPasswordResetMailImpl userTpls branding email key code mLocale - SendVerificationMail email key code mLocale -> sendVerificationMailImpl userTpls branding email key code mLocale - SendTeamDeletionVerificationMail email code mLocale -> sendTeamDeletionVerificationMailImpl userTpls branding email code mLocale - SendCreateScimTokenVerificationMail email code mLocale -> sendCreateScimTokenVerificationMailImpl userTpls branding email code mLocale - SendLoginVerificationMail email code mLocale -> sendLoginVerificationMailImpl userTpls branding email code mLocale - SendActivationMail email name key code mLocale -> sendActivationMailImpl userTpls branding email name key code mLocale - SendEmailAddressUpdateMail email name key code mLocale -> sendEmailAddressUpdateMailImpl userTpls branding email name key code mLocale - SendTeamActivationMail email name key code mLocale teamName -> sendTeamActivationMailImpl userTpls branding email name key code mLocale teamName - SendNewClientEmail email name client locale -> sendNewClientEmailImpl userTpls branding email name client locale - SendAccountDeletionEmail email name key code locale -> sendAccountDeletionEmailImpl userTpls branding email name key code locale + SendPasswordResetMail email (key, code) mLocale -> + queueEmail $ PasswordResetEmail (MkPasswordResetEmail email key code mLocale) + SendVerificationMail email key code mLocale -> + queueEmail $ VerificationEmail (MkVerificationEmail email key code mLocale) + SendTeamDeletionVerificationMail email code mLocale -> + queueEmail $ TeamDeletionVerificationEmail (MkSecondFactorVerificationEmail email code mLocale) + SendCreateScimTokenVerificationMail email code mLocale -> + queueEmail $ ScimTokenVerificationEmail (MkSecondFactorVerificationEmail email code mLocale) + SendLoginVerificationMail email code mLocale -> + queueEmail $ LoginVerificationEmail (MkSecondFactorVerificationEmail email code mLocale) + SendActivationMail email name key code mLocale -> + queueEmail $ ActivationEmail (MkActivationEmail email name key code mLocale) + SendEmailAddressUpdateMail email name key code mLocale -> + queueEmail $ EmailAddressUpdateEmail (MkActivationEmail email name key code mLocale) + SendTeamActivationMail email name key code mLocale teamName -> + queueEmail $ TeamActivationEmail (MkTeamActivationEmail email name key code teamName mLocale) + SendNewClientEmail email name client locale -> + queueEmail $ NewClientEmail (MkNewClientEmail email name client locale) + SendAccountDeletionEmail email name key code locale -> + queueEmail $ AccountDeletionEmail (MkAccountDeletionEmail email name key code locale) -- TEAM EMAILS - SendTeamInvitationMail email tid from code loc -> sendTeamInvitationMailImpl teamTpls branding email tid from code loc - SendTeamInvitationMailPersonalUser email tid from code loc -> sendTeamInvitationMailPersonalUserImpl teamTpls branding email tid from code loc - SendMemberWelcomeEmail email tid teamName loc -> sendMemberWelcomeEmailImpl teamTpls branding email tid teamName loc - SendNewTeamOwnerWelcomeEmail email tid teamName loc name -> sendNewTeamOwnerWelcomeEmailImpl teamTpls branding email tid teamName loc name + SendTeamInvitationMail email tid from code loc -> + queueEmail $ TeamInvitationEmail (MkTeamInvitationEmail {to = email, teamId = tid, inviter = from, code = code, locale = loc}) + SendTeamInvitationMailPersonalUser email tid from code loc -> + queueEmail $ TeamInvitationPersonalUserEmail (MkTeamInvitationEmail {to = email, teamId = tid, inviter = from, code = code, locale = loc}) + SendMemberWelcomeEmail email tid teamName loc -> + queueEmail $ MemberWelcomeEmail (MkMemberWelcomeEmail email tid teamName loc) + SendNewTeamOwnerWelcomeEmail email tid teamName loc name -> + queueEmail $ NewTeamOwnerWelcomeEmail (MkNewTeamOwnerWelcomeEmail email tid teamName name loc) SendSAMLIdPChanged email tid mbUid addedCerts removedCerts idPId oldIssuer oldEndpoint newIssuer newEndpoint mLocale -> - sendSAMLIdPChangedImpl teamTpls branding email tid mbUid addedCerts removedCerts idPId oldIssuer oldEndpoint newIssuer newEndpoint mLocale + queueEmail . IdpChangedEmail $ + MkIdpChangedEmail + { to = email, + teamId = tid, + userId = mbUid, + addedCerts = toCertSummary <$> addedCerts, + removedCerts = toCertSummary <$> removedCerts, + idpId = UUID.toText (fromIdPId idPId), + oldIssuer = renderIssuer <$> oldIssuer, + oldEndpoint = renderUri <$> oldEndpoint, + newIssuer = renderIssuer <$> newIssuer, + newEndpoint = renderUri <$> newEndpoint, + locale = mLocale + } + where + toCertSummary d = + CertSummary + { algorithm = T.pack d.fingerprintAlgorithm, + fingerprint = T.pack d.fingerprint, + subject = T.pack d.subject, + issuer = T.pack d.issuer + } + renderIssuer = T.decodeUtf8 . serializeURIRef' . _fromIssuer + renderUri = T.decodeUtf8 . serializeURIRef' ------------------------------------------------------------------------------- -- Verification Email for @@ -83,45 +119,6 @@ emailSubsystemInterpreter userTpls teamTpls branding = interpret \case -- - Creation of ScimToken -- - Team Deletion -sendTeamDeletionVerificationMailImpl :: - (Member EmailSending r, Member TinyLog r) => - Localised UserTemplates -> - Map Text Text -> - EmailAddress -> - Code.Value -> - Maybe Locale -> - Sem r () -sendTeamDeletionVerificationMailImpl userTemplates branding email code mLocale = do - let tpl = verificationTeamDeletionEmail . snd $ forLocale mLocale userTemplates - mail <- logEmailRenderErrors "team deletion verification email" $ renderSecondFactorVerificationEmail email code tpl branding - sendMail mail - -sendCreateScimTokenVerificationMailImpl :: - (Member EmailSending r, Member TinyLog r) => - Localised UserTemplates -> - Map Text Text -> - EmailAddress -> - Code.Value -> - Maybe Locale -> - Sem r () -sendCreateScimTokenVerificationMailImpl userTemplates branding email code mLocale = do - let tpl = verificationScimTokenEmail . snd $ forLocale mLocale userTemplates - mail <- logEmailRenderErrors "scim token verification email" $ renderSecondFactorVerificationEmail email code tpl branding - sendMail mail - -sendLoginVerificationMailImpl :: - (Member EmailSending r, Member TinyLog r) => - Localised UserTemplates -> - Map Text Text -> - EmailAddress -> - Code.Value -> - Maybe Locale -> - Sem r () -sendLoginVerificationMailImpl userTemplates branding email code mLocale = do - let tpl = verificationLoginEmail . snd $ forLocale mLocale userTemplates - mail <- logEmailRenderErrors "login verification email" $ renderSecondFactorVerificationEmail email code tpl branding - sendMail mail - renderSecondFactorVerificationEmail :: (Member (Output Text) r) => EmailAddress -> @@ -155,36 +152,6 @@ renderSecondFactorVerificationEmail email codeValue SecondFactorVerificationEmai ------------------------------------------------------------------------------- -- Activation Email -sendActivationMailImpl :: - (Member EmailSending r, Member TinyLog r) => - Localised UserTemplates -> - Map Text Text -> - EmailAddress -> - Name -> - ActivationKey -> - ActivationCode -> - Maybe Locale -> - Sem r () -sendActivationMailImpl userTemplates branding email name akey acode mLocale = do - let tpl = activationEmail . snd $ forLocale mLocale userTemplates - mail <- logEmailRenderErrors "activation email" $ renderActivationMail email name akey acode tpl branding - sendMail mail - -sendEmailAddressUpdateMailImpl :: - (Member EmailSending r, Member TinyLog r) => - Localised UserTemplates -> - Map Text Text -> - EmailAddress -> - Name -> - ActivationKey -> - ActivationCode -> - Maybe Locale -> - Sem r () -sendEmailAddressUpdateMailImpl userTemplates branding email name akey acode mLocale = do - let tpl = activationEmailUpdate . snd $ forLocale mLocale userTemplates - mail <- logEmailRenderErrors "email address update email" $ renderActivationMail email name akey acode tpl branding - sendMail mail - renderActivationMail :: (Member (Output Text) r) => EmailAddress -> Name -> ActivationKey -> ActivationCode -> ActivationEmailTemplate -> Map Text Text -> Sem r Mail renderActivationMail email name akey@(ActivationKey key) acode@(ActivationCode code) ActivationEmailTemplate {..} branding = do url <- renderActivationUrl activationEmailUrl akey acode branding @@ -224,22 +191,6 @@ renderActivationUrl t (ActivationKey k) (ActivationCode c) branding = do ------------------------------------------------------------------------------- -- Team Activation Email -sendTeamActivationMailImpl :: - (Member EmailSending r, Member TinyLog r) => - Localised UserTemplates -> - Map Text Text -> - EmailAddress -> - Name -> - ActivationKey -> - ActivationCode -> - Maybe Locale -> - Text -> - Sem r () -sendTeamActivationMailImpl userTemplates branding email name akey acode mLocale teamName = do - let tpl = teamActivationEmail . snd $ forLocale mLocale userTemplates - mail <- logEmailRenderErrors "team activation email" $ renderTeamActivationMail email name teamName akey acode tpl branding - sendMail mail - renderTeamActivationMail :: (Member (Output Text) r) => EmailAddress -> Name -> Text -> ActivationKey -> ActivationCode -> TeamActivationEmailTemplate -> Map Text Text -> Sem r Mail renderTeamActivationMail email name teamName akey@(ActivationKey key) acode@(ActivationCode code) TeamActivationEmailTemplate {..} branding = do url <- renderActivationUrl teamActivationEmailUrl akey acode branding @@ -270,20 +221,6 @@ renderTeamActivationMail email name teamName akey@(ActivationKey key) acode@(Act ------------------------------------------------------------------------------- -- Verification Email -sendVerificationMailImpl :: - (Member EmailSending r, Member TinyLog r) => - Localised UserTemplates -> - Map Text Text -> - EmailAddress -> - ActivationKey -> - ActivationCode -> - Maybe Locale -> - Sem r () -sendVerificationMailImpl userTemplates branding email akey acode mLocale = do - let tpl = verificationEmail . snd $ forLocale mLocale userTemplates - mail <- logEmailRenderErrors "verification email" $ renderVerificationMail email akey acode tpl branding - sendMail mail - renderVerificationMail :: (Member (Output Text) r) => EmailAddress -> ActivationKey -> ActivationCode -> VerificationEmailTemplate -> Map Text Text -> Sem r Mail renderVerificationMail email akey acode VerificationEmailTemplate {..} branding = do let replace = @@ -313,20 +250,6 @@ renderVerificationMail email akey acode VerificationEmailTemplate {..} branding ------------------------------------------------------------------------------- -- Password Reset Email -sendPasswordResetMailImpl :: - (Member EmailSending r, Member TinyLog r) => - Localised UserTemplates -> - Map Text Text -> - EmailAddress -> - PasswordResetKey -> - PasswordResetCode -> - Maybe Locale -> - Sem r () -sendPasswordResetMailImpl userTemplates branding email pkey pcode mLocale = do - let tpl = passwordResetEmail . snd $ forLocale mLocale userTemplates - mail <- logEmailRenderErrors "password reset email" $ renderPwResetMail email pkey pcode tpl branding - sendMail mail - renderPwResetMail :: (Member (Output Text) r) => EmailAddress -> PasswordResetKey -> PasswordResetCode -> PasswordResetEmailTemplate -> Map Text Text -> Sem r Mail renderPwResetMail email pkey pcode PasswordResetEmailTemplate {..} branding = do url <- renderPwResetUrl passwordResetEmailUrl pkey pcode @@ -360,20 +283,6 @@ renderPwResetMail email pkey pcode PasswordResetEmailTemplate {..} branding = do ------------------------------------------------------------------------------- -- New Client Email -sendNewClientEmailImpl :: - (Member EmailSending r, Member TinyLog r) => - Localised UserTemplates -> - Map Text Text -> - EmailAddress -> - Name -> - Client -> - Locale -> - Sem r () -sendNewClientEmailImpl userTemplates branding email name client locale = do - let tpl = newClientEmail . snd $ forLocale (Just locale) userTemplates - mail <- logEmailRenderErrors "new client email" $ renderNewClientEmail email name locale client tpl branding - sendMail mail - renderNewClientEmail :: (Member (Output Text) r) => EmailAddress -> Name -> Locale -> Client -> NewClientEmailTemplate -> Map Text Text -> Sem r Mail renderNewClientEmail email name locale Client {..} NewClientEmailTemplate {..} branding = do let replace = @@ -406,21 +315,6 @@ renderNewClientEmail email name locale Client {..} NewClientEmailTemplate {..} b ------------------------------------------------------------------------------- -- Deletion Email -sendAccountDeletionEmailImpl :: - (Member EmailSending r, Member TinyLog r) => - Localised UserTemplates -> - Map Text Text -> - EmailAddress -> - Name -> - Code.Key -> - Code.Value -> - Locale -> - Sem r () -sendAccountDeletionEmailImpl userTemplates branding email name key code locale = do - let tpl = deletionEmail . snd $ forLocale (Just locale) userTemplates - mail <- logEmailRenderErrors "account deletion email" $ renderDeletionEmail email name key code tpl branding - sendMail mail - renderDeletionEmail :: (Member (Output Text) r) => EmailAddress -> Name -> Code.Key -> Code.Value -> DeletionEmailTemplate -> Map Text Text -> Sem r Mail renderDeletionEmail email name cKey cValue DeletionEmailTemplate {..} branding = do url <- renderDeletionUrl deletionEmailUrl cKey cValue branding @@ -460,40 +354,6 @@ renderDeletionUrl t cKey cValue branding = do ------------------------------------------------------------------------------- -- Invitation Email -sendTeamInvitationMailImpl :: - (Member EmailSending r, Member TinyLog r) => - Localised TeamTemplates -> - Map Text Text -> - EmailAddress -> - TeamId -> - EmailAddress -> - InvitationCode -> - Maybe Locale -> - Sem r Text -sendTeamInvitationMailImpl teamTemplates branding to tid from code loc = do - let tpl = invitationEmail . snd $ forLocale loc teamTemplates - mail = InvitationEmail to tid code from - (renderedMail, renderedInvitationUrl) <- logEmailRenderErrors "invitation" $ renderInvitationEmail mail tpl branding - sendMail renderedMail - pure renderedInvitationUrl - -sendTeamInvitationMailPersonalUserImpl :: - (Member EmailSending r, Member TinyLog r) => - Localised TeamTemplates -> - Map Text Text -> - EmailAddress -> - TeamId -> - EmailAddress -> - InvitationCode -> - Maybe Locale -> - Sem r Text -sendTeamInvitationMailPersonalUserImpl teamTemplates branding to tid from code loc = do - let tpl = existingUserInvitationEmail . snd $ forLocale loc teamTemplates - mail = InvitationEmail to tid code from - (renderedMail, renderedInvitationUrl) <- logEmailRenderErrors "personal user invitation" $ renderInvitationEmail mail tpl branding - sendMail renderedMail - pure renderedInvitationUrl - data InvitationEmail = InvitationEmail { invTo :: !EmailAddress, invTeamId :: !TeamId, @@ -532,12 +392,6 @@ renderInvitationUrl t tid (InvitationCode c) = ------------------------------------------------------------------------------- -- Member Welcome Email -sendMemberWelcomeEmailImpl :: (Member EmailSending r, Member TinyLog r) => Localised TeamTemplates -> Map Text Text -> EmailAddress -> TeamId -> Text -> Maybe Locale -> Sem r () -sendMemberWelcomeEmailImpl teamTemplates branding to tid teamName loc = do - let tpl = memberWelcomeEmail . snd $ forLocale loc teamTemplates - mail <- logEmailRenderErrors "member welcome email" $ renderMemberWelcomeMail to tid teamName tpl branding - sendMail mail - renderMemberWelcomeMail :: (Member (Output Text) r) => EmailAddress -> TeamId -> Text -> MemberWelcomeEmailTemplate -> Map Text Text -> Sem r Mail renderMemberWelcomeMail emailTo tid teamName MemberWelcomeEmailTemplate {..} branding = do let replace = @@ -565,12 +419,6 @@ renderMemberWelcomeMail emailTo tid teamName MemberWelcomeEmailTemplate {..} bra ------------------------------------------------------------------------------- -- New Team Owner Welcome Email -sendNewTeamOwnerWelcomeEmailImpl :: (Member EmailSending r, Member TinyLog r) => Localised TeamTemplates -> Map Text Text -> EmailAddress -> TeamId -> Text -> Maybe Locale -> Name -> Sem r () -sendNewTeamOwnerWelcomeEmailImpl teamTemplates branding to tid teamName loc profileName = do - let tpl = newTeamOwnerWelcomeEmail . snd $ forLocale loc teamTemplates - mail <- logEmailRenderErrors "new team owner welcome email" $ renderNewTeamOwnerWelcomeEmail to tid teamName profileName tpl branding - sendMail mail - renderNewTeamOwnerWelcomeEmail :: (Member (Output Text) r) => EmailAddress -> TeamId -> Text -> Name -> NewTeamOwnerWelcomeEmailTemplate -> Map Text Text -> Sem r Mail renderNewTeamOwnerWelcomeEmail emailTo tid teamName profileName NewTeamOwnerWelcomeEmailTemplate {..} branding = do let replace = @@ -599,45 +447,13 @@ renderNewTeamOwnerWelcomeEmail emailTo tid teamName profileName NewTeamOwnerWelc ------------------------------------------------------------------------------- -- IdP change email for team admins and owners -sendSAMLIdPChangedImpl :: - (Member EmailSending r, Member TinyLog r) => - Localised TeamTemplates -> - Map Text Text -> - EmailAddress -> - TeamId -> - Maybe UserId -> - [CertDescription] -> - [CertDescription] -> - IdPId -> - Maybe Issuer -> - Maybe URI -> - Maybe Issuer -> - Maybe URI -> - Maybe Locale -> - Sem r () -sendSAMLIdPChangedImpl teamTemplates branding to tid mbUid addedCerts removedCerts idPId oldIssuer oldEndpoint newIssuer newEndpoint mLocale = do - let tpl = idpConfigChangeEmail . snd $ forLocale mLocale teamTemplates - mail <- - logEmailRenderErrors "idp config change email" $ - renderIdPConfigChangeEmail to tpl branding addedCerts removedCerts tid mbUid idPId oldIssuer oldEndpoint newIssuer newEndpoint - sendMail mail - renderIdPConfigChangeEmail :: (Member (Output Text) r) => - EmailAddress -> IdPConfigChangeEmailTemplate -> Map Text Text -> - [CertDescription] -> - [CertDescription] -> - TeamId -> - Maybe UserId -> - IdPId -> - Maybe Issuer -> - Maybe URI -> - Maybe Issuer -> - Maybe URI -> + IdpChangedEmail -> Sem r Mail -renderIdPConfigChangeEmail email IdPConfigChangeEmailTemplate {..} branding addedCerts removedCerts tid uid idPId oldIssuer oldEndpoint newIssuer newEndpoint = do +renderIdPConfigChangeEmail IdPConfigChangeEmailTemplate {..} branding MkIdpChangedEmail {to = email, teamId = tid, userId = uid, idpId = idpIdText, oldIssuer, oldEndpoint, newIssuer, newEndpoint, ..} = do idpDetailsAddedTextRendered :: Text <- (TL.toStrict . TL.unlines) <$> mapM (renderTextWithBrandingSem idpDetailsAddedText . idpDetailsToMap) addedCerts @@ -653,13 +469,13 @@ renderIdPConfigChangeEmail email IdPConfigChangeEmailTemplate {..} branding adde let replace = branding - & Map.insert "team_id" ((toText . toUUID) tid) - & Map.insert "user_id" (maybe "None" (toText . toUUID) uid) - & Map.insert "old_idp_issuer" (maybe "None" (T.decodeUtf8 . serializeURIRef' . _fromIssuer) oldIssuer) - & Map.insert "old_idp_endpoint" (maybe "None" (T.decodeUtf8 . serializeURIRef') oldEndpoint) - & Map.insert "new_idp_issuer" (maybe "None" (T.decodeUtf8 . serializeURIRef' . _fromIssuer) newIssuer) - & Map.insert "new_idp_endpoint" (maybe "None" (T.decodeUtf8 . serializeURIRef') newEndpoint) - & Map.insert "idp_id" ((toText . fromIdPId) idPId) + & Map.insert "team_id" (UUID.toText (toUUID tid)) + & Map.insert "user_id" (maybe "None" (UUID.toText . toUUID) uid) + & Map.insert "old_idp_issuer" (fromMaybe "None" oldIssuer) + & Map.insert "old_idp_endpoint" (fromMaybe "None" oldEndpoint) + & Map.insert "new_idp_issuer" (fromMaybe "None" newIssuer) + & Map.insert "new_idp_endpoint" (fromMaybe "None" newEndpoint) + & Map.insert "idp_id" idpIdText certificateDetailsHtml = (T.unlines . Imports.filter (not . T.null)) [idpDetailsAddedHtmlRendered, idpDetailsRemovedHtmlRendered] replaceHtml = @@ -690,13 +506,13 @@ renderIdPConfigChangeEmail email IdPConfigChangeEmailTemplate {..} branding adde from = Address (Just senderName) (fromEmail sender) to = Address Nothing (fromEmail email) - idpDetailsToMap :: CertDescription -> Map Text Text + idpDetailsToMap :: CertSummary -> Map Text Text idpDetailsToMap d = empty @Text @Text - & Map.insert "algorithm" (T.pack d.fingerprintAlgorithm) - & Map.insert "fingerprint" (T.pack d.fingerprint) - & Map.insert "subject" (T.pack d.subject) - & Map.insert "issuer" (T.pack d.issuer) + & Map.insert "algorithm" d.algorithm + & Map.insert "fingerprint" d.fingerprint + & Map.insert "subject" d.subject + & Map.insert "issuer" d.issuer ------------------------------------------------------------------------------- -- MIME Conversions diff --git a/libs/wire-subsystems/src/Wire/EmailSubsystem/Template.hs b/libs/wire-subsystems/src/Wire/EmailSubsystem/Template.hs index 11d36455eb2..b9fbed68e1d 100644 --- a/libs/wire-subsystems/src/Wire/EmailSubsystem/Template.hs +++ b/libs/wire-subsystems/src/Wire/EmailSubsystem/Template.hs @@ -1,4 +1,5 @@ {-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE StrictData #-} -- This file is part of the Wire Server implementation. @@ -41,6 +42,80 @@ import Wire.API.User.EmailAddress (EmailAddress) import Wire.EmailSubsystem.Templates.Team import Wire.EmailSubsystem.Templates.User +-- | Invitation URL templates (config-derived, locale-independent). Used by +-- brig to render invitation URLs for API responses, and by the composer for +-- invitation emails. +data InvitationUrlTemplates = InvitationUrlTemplates + { personalUser :: Template, + newUser :: Template + } + +-- | Customizable branding text for emails/sms/calls, mirroring the former +-- Brig configuration. +data BrandingOpts = BrandingOpts + { brand :: !Text, + brandUrl :: !Text, + brandLabelUrl :: !Text, + brandLogoUrl :: !Text, + brandService :: !Text, + copyright :: !Text, + misuse :: !Text, + legal :: !Text, + forgot :: !Text, + support :: !Text + } + deriving stock (Show, Generic) + deriving anyclass (FromJSON) + +-- | Function to be applied everywhere where email/sms/call +-- templating is used (ensures that placeholders are replaced +-- by the appropriate branding, typically Wire) +genTemplateBranding :: BrandingOpts -> TemplateBranding +genTemplateBranding BrandingOpts {..} = fn + where + fn "brand" = brand + fn "brand_url" = brandUrl + fn "brand_label_url" = brandLabelUrl + fn "brand_logo" = brandLogoUrl + fn "brand_service" = brandService + fn "copyright" = copyright + fn "misuse" = misuse + fn "legal" = legal + fn "forgot" = forgot + fn "support" = support + fn other = other + +genTemplateBrandingMap :: BrandingOpts -> Map Text Text +genTemplateBrandingMap opts = + Map.fromList + [ ("brand", opts.brand), + ("brand_url", opts.brandUrl), + ("brand_label_url", opts.brandLabelUrl), + ("brand_logo", opts.brandLogoUrl), + ("brand_service", opts.brandService), + ("copyright", opts.copyright), + ("misuse", opts.misuse), + ("legal", opts.legal), + ("forgot", opts.forgot), + ("support", opts.support) + ] + +-- | Provider settings, mirroring the former Brig configuration. +data ProviderOpts = ProviderOpts + { -- | Homepage URL + homeUrl :: !Text, + -- | Activation URL template + providerActivationUrl :: !Text, + -- | Approval URL template + approvalUrl :: !Text, + -- | Approval email recipient + approvalTo :: !EmailAddress, + -- | Password reset URL template + providerPwResetUrl :: !Text + } + deriving stock (Show, Generic) + deriving anyclass (FromJSON) + -- | Lookup a localised item from a 'Localised' structure. forLocale :: -- | 'Just' the preferred locale or 'Nothing' for @@ -268,6 +343,7 @@ data UserTemplateOpts = UserTemplateOpts deletionUrl :: !Text } deriving stock (Show, Generic) + deriving anyclass (FromJSON) loadUserTemplates :: UserTemplateOpts -> FilePath -> Locale -> EmailAddress -> IO (Localised UserTemplates) loadUserTemplates opts templatesDir defLocale sender = readLocalesDir defLocale templatesDir "user" $ \fp -> @@ -349,3 +425,18 @@ loadUserTemplates opts templatesDir defLocale sender = readLocalesDir defLocale deletionUrl = template opts.deletionUrl readTemplate' = readTemplateWithDefault templatesDir defLocale "user" readText' = readTextWithDefault templatesDir defLocale "user" + +-- | All options needed to load the full set of email templates (worker-side +-- email composition). Mirrors the email-template settings brig used to +-- configure. +data EmailTemplatesOpts = EmailTemplatesOpts + { templateDir :: !FilePath, + defaultLocale :: !(Maybe Locale), + emailSender :: !EmailAddress, + templateBranding :: !BrandingOpts, + user :: !UserTemplateOpts, + team :: !TeamOpts, + provider :: !ProviderOpts + } + deriving stock (Show, Generic) + deriving anyclass (FromJSON) diff --git a/services/brig/src/Brig/Provider/Template.hs b/libs/wire-subsystems/src/Wire/EmailSubsystem/Templates/Provider.hs similarity index 73% rename from services/brig/src/Brig/Provider/Template.hs rename to libs/wire-subsystems/src/Wire/EmailSubsystem/Templates/Provider.hs index 7de713abb89..d74947dc00d 100644 --- a/services/brig/src/Brig/Provider/Template.hs +++ b/libs/wire-subsystems/src/Wire/EmailSubsystem/Templates/Provider.hs @@ -15,7 +15,10 @@ -- You should have received a copy of the GNU Affero General Public License along -- with this program. If not, see . -module Brig.Provider.Template +-- | Provider email templates, loaded from the @provider@ subtree of the +-- bundled templates directory. Moved from brig: the +-- background-worker composes provider emails, so it needs the loaders. +module Wire.EmailSubsystem.Templates.Provider ( ProviderTemplates (..), ActivationEmailTemplate (..), ApprovalRequestEmailTemplate (..), @@ -25,15 +28,14 @@ module Brig.Provider.Template ) where -import Brig.Options import Data.ByteString.Conversion (fromByteString) import Data.Misc (HttpsUrl) import Data.Text.Encoding (encodeUtf8) import Data.Text.Template import Imports -import Wire.API.User.Identity +import Wire.API.Locale (Locale) +import Wire.API.User.EmailAddress (EmailAddress) import Wire.EmailSubsystem.Template hiding (readTemplate, readText) -import Wire.EmailSubsystem.Templates.User data ProviderTemplates = ProviderTemplates { activationEmail :: !ActivationEmailTemplate, @@ -43,6 +45,15 @@ data ProviderTemplates = ProviderTemplates passwordResetEmail :: !PasswordResetEmailTemplate } +data ActivationEmailTemplate = ActivationEmailTemplate + { activationEmailUrl :: !Template, + activationEmailSubject :: !Template, + activationEmailBodyText :: !Template, + activationEmailBodyHtml :: !Template, + activationEmailSender :: !EmailAddress, + activationEmailSenderName :: !Text + } + data ApprovalRequestEmailTemplate = ApprovalRequestEmailTemplate { approvalRequestEmailUrl :: !Template, approvalRequestEmailSubject :: !Template, @@ -62,28 +73,37 @@ data ApprovalConfirmEmailTemplate = ApprovalConfirmEmailTemplate approvalConfirmEmailHomeUrl :: !HttpsUrl } -loadProviderTemplates :: Opts -> IO (Localised ProviderTemplates) -loadProviderTemplates o = readLocalesDir defLocale (templateDir gOptions) "provider" $ \fp -> +data PasswordResetEmailTemplate = PasswordResetEmailTemplate + { passwordResetEmailUrl :: !Template, + passwordResetEmailSubject :: !Template, + passwordResetEmailBodyText :: !Template, + passwordResetEmailBodyHtml :: !Template, + passwordResetEmailSender :: !EmailAddress, + passwordResetEmailSenderName :: !Text + } + +loadProviderTemplates :: ProviderOpts -> FilePath -> Locale -> EmailAddress -> IO (Localised ProviderTemplates) +loadProviderTemplates pOptions templatesDir defLocale sender = readLocalesDir defLocale templatesDir "provider" $ \fp -> ProviderTemplates <$> ( ActivationEmailTemplate activationUrl' <$> readTemplate fp "email/activation-subject.txt" <*> readTemplate fp "email/activation.txt" <*> readTemplate fp "email/activation.html" - <*> pure (emailSender gOptions) + <*> pure sender <*> readText fp "email/sender.txt" ) <*> ( ActivationEmailTemplate activationUrl' <$> readTemplate fp "email/update-subject.txt" <*> readTemplate fp "email/update.txt" <*> readTemplate fp "email/update.html" - <*> pure (emailSender gOptions) + <*> pure sender <*> readText fp "email/sender.txt" ) <*> ( ApprovalRequestEmailTemplate approvalUrl' <$> readTemplate fp "email/approval-request-subject.txt" <*> readTemplate fp "email/approval-request.txt" <*> readTemplate fp "email/approval-request.html" - <*> pure (emailSender gOptions) + <*> pure sender <*> readText fp "email/sender.txt" <*> pure (approvalTo pOptions) ) @@ -91,7 +111,7 @@ loadProviderTemplates o = readLocalesDir defLocale (templateDir gOptions) "provi <$> readTemplate fp "email/approval-confirm-subject.txt" <*> readTemplate fp "email/approval-confirm.txt" <*> readTemplate fp "email/approval-confirm.html" - <*> pure (emailSender gOptions) + <*> pure sender <*> readText fp "email/sender.txt" <*> pure (fromMaybe (error "Invalid HTTPS URL") maybeUrl) ) @@ -99,16 +119,13 @@ loadProviderTemplates o = readLocalesDir defLocale (templateDir gOptions) "provi <$> readTemplate fp "email/password-reset-subject.txt" <*> readTemplate fp "email/password-reset.txt" <*> readTemplate fp "email/password-reset.html" - <*> pure (emailSender gOptions) + <*> pure sender <*> readText fp "email/sender.txt" ) where maybeUrl = fromByteString . encodeUtf8 $ pOptions.homeUrl - gOptions = o.emailSMS.general - pOptions = o.emailSMS.provider - defLocale = defaultTemplateLocale o.settings - readTemplate = readTemplateWithDefault gOptions.templateDir defLocale "provider" - readText = readTextWithDefault gOptions.templateDir defLocale "provider" + readTemplate = readTemplateWithDefault templatesDir defLocale "provider" + readText = readTextWithDefault templatesDir defLocale "provider" -- URL templates activationUrl' = template pOptions.providerActivationUrl approvalUrl' = template pOptions.approvalUrl diff --git a/libs/wire-subsystems/src/Wire/EnterpriseLoginSubsystem/Interpreter.hs b/libs/wire-subsystems/src/Wire/EnterpriseLoginSubsystem/Interpreter.hs index 54539dcd495..39798b669c1 100644 --- a/libs/wire-subsystems/src/Wire/EnterpriseLoginSubsystem/Interpreter.hs +++ b/libs/wire-subsystems/src/Wire/EnterpriseLoginSubsystem/Interpreter.hs @@ -30,19 +30,18 @@ where import Bilge hiding (delete) import Control.Lens ((^.), (^..), (^?)) import Data.Aeson qualified as Aeson -import Data.Aeson.Encode.Pretty qualified as Aeson import Data.ByteString.Conversion (toByteString') import Data.ByteString.Lazy qualified as BL import Data.Domain import Data.Id import Data.Qualified import Data.Text.Encoding qualified as Text -import Data.Text.Internal.Builder (fromLazyText, fromText, toLazyText) +import Data.Text.Internal.Builder (fromText, toLazyText) +import Data.Text.Lazy (toStrict) import Data.Text.Lazy.Builder (Builder) import Data.Text.Lazy.Encoding as LT import Imports hiding (lookup) import Network.HTTP.Types.Method -import Network.Mail.Mime (Address (Address), Mail (mailHeaders, mailParts, mailTo), emptyMail, plainPart) import Polysemy import Polysemy.Error (Error, note, throw) import Polysemy.Error qualified as Error @@ -52,6 +51,7 @@ import Polysemy.TinyLog qualified as Log import SAML2.WebSSO qualified as SAML import System.Logger.Message qualified as Log import Util.Options +import Wire.API.BackgroundJobs.Email import Wire.API.EnterpriseLogin import Wire.API.Routes.Public.Brig.DomainVerification import Wire.API.Routes.Version @@ -65,7 +65,7 @@ import Wire.DomainVerificationChallengeStore mkStoredDomainVerificationChallenge, ) import Wire.DomainVerificationChallengeStore qualified as Challenge -import Wire.EmailSending (EmailSending, sendMail) +import Wire.EmailSending.Queueing (EmailQueueing, queueEmail) import Wire.EnterpriseLoginSubsystem import Wire.EnterpriseLoginSubsystem.Error import Wire.GalleyAPIAccess @@ -95,7 +95,7 @@ runEnterpriseLoginSubsystemWithConfig :: Member GalleyAPIAccess r, Member SparAPIAccess r, Member TinyLog r, - Member EmailSending r, + Member EmailQueueing r, Member Random r, Member Rpc r, Member UserKeyStore r, @@ -120,7 +120,7 @@ runEnterpriseLoginSubsystem :: Member SparAPIAccess r, Member TinyLog r, Member (Input EnterpriseLoginSubsystemConfig) r, - Member EmailSending r, + Member EmailQueueing r, Member Random r, Member Rpc r, Member UserKeyStore r, @@ -308,7 +308,7 @@ deleteDomainImpl :: ( Member DomainRegistrationStore r, Member TinyLog r, Member (Input EnterpriseLoginSubsystemConfig) r, - Member EmailSending r + Member EmailQueueing r ) => Domain -> Sem r () @@ -328,7 +328,7 @@ unauthorizeImpl :: Member (Error EnterpriseLoginSubsystemError) r, Member TinyLog r, Member (Input EnterpriseLoginSubsystemConfig) r, - Member EmailSending r + Member EmailQueueing r ) => Domain -> Sem r () @@ -358,7 +358,7 @@ updateDomainRegistrationImpl :: Member (Error EnterpriseLoginSubsystemError) r, Member TinyLog r, Member (Input EnterpriseLoginSubsystemConfig) r, - Member EmailSending r + Member EmailQueueing r ) => Domain -> DomainRegistrationUpdate -> @@ -384,7 +384,7 @@ lockDomainImpl :: ( Member DomainRegistrationStore r, Member TinyLog r, Member (Input EnterpriseLoginSubsystemConfig) r, - Member EmailSending r + Member EmailQueueing r ) => Domain -> Sem r () @@ -408,7 +408,7 @@ unlockDomainImpl :: Member (Error EnterpriseLoginSubsystemError) r, Member TinyLog r, Member (Input EnterpriseLoginSubsystemConfig) r, - Member EmailSending r + Member EmailQueueing r ) => Domain -> Sem r () @@ -434,7 +434,7 @@ preAuthorizeImpl :: Member (Error EnterpriseLoginSubsystemError) r, Member TinyLog r, Member (Input EnterpriseLoginSubsystemConfig) r, - Member EmailSending r + Member EmailQueueing r ) => Domain -> Sem r () @@ -524,21 +524,10 @@ validate dr = do Backend _ _ -> when (dr.teamInvite /= NotAllowed) $ throw EnterpriseLoginSubsystemOperationForbidden _ -> pure () -mkAuditMail :: EmailAddress -> EmailAddress -> Text -> LText -> Mail -mkAuditMail from to subject bdy = - (emptyMail (Address Nothing (fromEmail from))) - { mailTo = [Address Nothing (fromEmail to)], - mailHeaders = - [ ("Subject", subject), - ("X-Zeta-Purpose", "audit") - ], - mailParts = [[plainPart bdy]] - } - sendAuditMail :: ( Member (Input EnterpriseLoginSubsystemConfig) r, Member TinyLog r, - Member EmailSending r + Member EmailQueueing r ) => Builder -> Text -> @@ -546,43 +535,33 @@ sendAuditMail :: Maybe DomainRegistration -> Sem r () sendAuditMail url subject mBefore mAfter = do - let encodeDomainRegistrationPretty = - maybe - "null" - (Aeson.encodePretty . mkDomainRegistrationResponse @V10) let encodeDomainRegistration = maybe "null" (Aeson.encode . mkDomainRegistrationResponse @V10) - let auditLog :: LText = - toLazyText $ - url - <> " called;\nOld value:\n" - <> fromLazyText - (LT.decodeUtf8 (encodeDomainRegistrationPretty mBefore)) - <> "\nNew value:\n" - <> fromLazyText - ( LT.decodeUtf8 - ( encodeDomainRegistrationPretty - mAfter - ) - ) Log.info $ Log.msg (Log.val "Domain registration audit log") . Log.field "url" (LT.encodeUtf8 $ toLazyText url) . Log.field "old_value" (encodeDomainRegistration mBefore) . Log.field "new_value" (encodeDomainRegistration mAfter) mConfig <- inputs emailConfig - for_ mConfig $ \config -> do - let mail = mkAuditMail (config.auditEmailSender) (config.auditEmailRecipient) subject auditLog - sendMail mail + for_ mConfig $ \config -> + queueEmail . EnterpriseAuditEmail $ + MkEnterpriseAuditEmail + { from = config.auditEmailSender, + to = config.auditEmailRecipient, + subject = subject, + url = toStrict (toLazyText url), + before = mkDomainRegistrationResponse @V10 <$> mBefore, + after = mkDomainRegistrationResponse @V10 <$> mAfter + } updateDomainRedirectImpl :: ( Member (Error EnterpriseLoginSubsystemError) r, Member TinyLog r, Member DomainRegistrationStore r, Member (Input EnterpriseLoginSubsystemConfig) r, - Member EmailSending r + Member EmailQueueing r ) => Token -> Domain -> @@ -614,7 +593,7 @@ updateTeamInviteImpl :: ( Member (Error EnterpriseLoginSubsystemError) r, Member (Input EnterpriseLoginSubsystemConfig) r, Member DomainRegistrationStore r, - Member EmailSending r, + Member EmailQueueing r, Member GalleyAPIAccess r, Member SparAPIAccess r, Member TinyLog r, diff --git a/libs/wire-subsystems/src/Wire/TeamInvitationSubsystem/Interpreter.hs b/libs/wire-subsystems/src/Wire/TeamInvitationSubsystem/Interpreter.hs index 82002248f68..6f5a004274d 100644 --- a/libs/wire-subsystems/src/Wire/TeamInvitationSubsystem/Interpreter.hs +++ b/libs/wire-subsystems/src/Wire/TeamInvitationSubsystem/Interpreter.hs @@ -31,6 +31,7 @@ import Network.Wai.Utilities.Exception (displayExceptionNoBacktrace) import Polysemy import Polysemy.Error import Polysemy.Input (Input, input, runInputConst) +import Polysemy.Output (ignoreOutput) import Polysemy.TinyLog import System.Logger.Message as Log import URI.ByteString @@ -44,6 +45,8 @@ import Wire.API.Team.Role import Wire.API.User import Wire.Arbitrary import Wire.EmailSubsystem +import Wire.EmailSubsystem.Interpreter (renderInvitationUrl) +import Wire.EmailSubsystem.Template (InvitationUrlTemplates (..)) import Wire.EnterpriseLoginSubsystem import Wire.GalleyAPIAccess hiding (AddTeamMember) import Wire.GalleyAPIAccess qualified as GalleyAPIAccess @@ -83,7 +86,8 @@ runTeamInvitationSubsystem :: Member EmailSubsystem r, Member EnterpriseLoginSubsystem r, Member TeamSubsystem r, - Member UserKeyStore r + Member UserKeyStore r, + Member (Input InvitationUrlTemplates) r ) => TeamInvitationSubsystemConfig -> InterpreterFor TeamInvitationSubsystem r @@ -111,7 +115,8 @@ inviteUserImpl :: Member EnterpriseLoginSubsystem r, Member TeamSubsystem r, Member UserKeyStore r, - Member UserStore r + Member UserStore r, + Member (Input InvitationUrlTemplates) r ) => Local UserId -> TeamId -> @@ -209,6 +214,7 @@ createInvitation' :: Member Random r, Member (Input TeamInvitationSubsystemConfig) r, Member Now r, + Member (Input InvitationUrlTemplates) r, Member EmailSubsystem r, Member EnterpriseLoginSubsystem r, Member UserKeyStore r @@ -271,14 +277,20 @@ createInvitation' tid mExpectedInvId inviteeRole mbInviterUid inviterEmail invRe } in Store.insertInvitation insertInv timeout - let sendOp = case invitationFlow of - InviteExistingUser -> sendTeamInvitationMailPersonalUser - InviteNewUser -> - -- NB: this is not guarded by the `validateSAMLEmails` feature, so auto-activation - -- is not supported here. - sendTeamInvitationMail - - invitationUrl <- sendOp email tid inviterEmail code invRequest.locale + case invitationFlow of + InviteExistingUser -> sendTeamInvitationMailPersonalUser email tid inviterEmail code invRequest.locale + InviteNewUser -> + -- NB: this is not guarded by the `validateSAMLEmails` feature, so auto-activation + -- is not supported here. + sendTeamInvitationMail email tid inviterEmail code invRequest.locale + -- The invitation URL in API responses is rendered here (config-derived, + -- locale-independent); the email itself is composed by the worker. + urlTemplate <- + input @InvitationUrlTemplates + <&> case invitationFlow of + InviteExistingUser -> (.personalUser) + InviteNewUser -> (.newUser) + invitationUrl <- ignoreOutput $ renderInvitationUrl urlTemplate tid code inv <- toInvitation invitationUrl showInvitationUrl newInv pure (inv, code) where diff --git a/libs/wire-subsystems/test/unit/Wire/EmailSending/ComposerSpec.hs b/libs/wire-subsystems/test/unit/Wire/EmailSending/ComposerSpec.hs new file mode 100644 index 00000000000..ab68c361106 --- /dev/null +++ b/libs/wire-subsystems/test/unit/Wire/EmailSending/ComposerSpec.hs @@ -0,0 +1,136 @@ +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2026 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.EmailSending.ComposerSpec (spec) where + +import Data.Aeson qualified as Aeson +import Data.Code qualified as Code +import Data.Id +import Data.Range (unsafeRange) +import Data.Text.Encoding (decodeUtf8) +import Data.UUID qualified as UUID +import Imports +import Network.Mail.Mime +import Polysemy +import Polysemy.Output +import Test.Hspec +import Test.QuickCheck (property, (===)) +import Wire.API.BackgroundJobs.Email +import Wire.API.Jobs (EmailsJobPayload (SendEmail), SendEmailJobPayload (..)) +import Wire.API.User +import Wire.API.User.Activation +import Wire.EmailSending.Composer +import Wire.EmailSubsystem.Interpreter (InvitationEmail (..), renderActivationMail, renderInvitationEmail, renderSecondFactorVerificationEmail) +import Wire.EmailSubsystem.Template (forLocale) +import Wire.EmailSubsystem.TemplateFixtures +import Wire.EmailSubsystem.Templates.Team (invitationEmail) +import Wire.EmailSubsystem.Templates.User qualified as U + +spec :: Spec +spec = do + templates <- runIO loadTestEmailTemplates + describe "Wire.EmailSending.Composer" $ do + describe "JSON roundtrip" $ + it "all variants roundtrip" $ + property $ \reqId req -> + let job = SendEmail (SendEmailJobPayload reqId req) + in Aeson.decode (Aeson.encode job) === Just job + describe "composition" $ do + it "activation request composes to the direct render" $ do + let (errs, composed) = + run . runOutputList @Text $ + composeEmail templates (ActivationEmail (MkActivationEmail testTo testName testKey testCode (Just defLocale))) + tpl = activationEmailTpls templates + (errs', direct) = run . runOutputList @Text $ renderActivationMail testTo testName testKey testCode tpl branding + lookupHeader "Subject" composed `shouldBe` lookupHeader "Subject" direct + composed.mailTo `shouldBe` direct.mailTo + composed.mailFrom `shouldBe` direct.mailFrom + length composed.mailParts `shouldBe` length direct.mailParts + errs `shouldBe` errs' + errs `shouldBe` [] + it "login verification composes to the direct render" $ do + let req = LoginVerificationEmail (MkSecondFactorVerificationEmail testTo testCodeValue (Just defLocale)) + (errs, composed) = run . runOutputList @Text $ composeEmail templates req + tpl = U.verificationLoginEmail . snd $ forLocale Nothing templates.userTemplates + (errs', direct) = run . runOutputList @Text $ renderSecondFactorVerificationEmail testTo testCodeValue tpl branding + composed.mailTo `shouldBe` direct.mailTo + lookupHeader "Subject" composed `shouldBe` lookupHeader "Subject" direct + errs `shouldBe` errs' + it "scim token verification composes to the direct render" $ do + let req = ScimTokenVerificationEmail (MkSecondFactorVerificationEmail testTo testCodeValue (Just defLocale)) + (errs, composed) = run . runOutputList @Text $ composeEmail templates req + tpl = U.verificationScimTokenEmail . snd $ forLocale Nothing templates.userTemplates + (errs', direct) = run . runOutputList @Text $ renderSecondFactorVerificationEmail testTo testCodeValue tpl branding + composed.mailTo `shouldBe` direct.mailTo + lookupHeader "Subject" composed `shouldBe` lookupHeader "Subject" direct + errs `shouldBe` errs' + it "team invitation composes to the direct render" $ do + let req = TeamInvitationEmail (MkTeamInvitationEmail {to = testTo, teamId = testTeamId, inviter = testInviter, code = testCode2, locale = Nothing}) + (errs, composed) = run . runOutputList @Text $ composeEmail templates req + tpl = invitationEmail . snd $ forLocale Nothing templates.teamTemplates + (errs', direct) = run . runOutputList @Text $ renderInvitationEmail (InvitationEmail testTo testTeamId testCode2 testInviter) tpl branding + composed.mailTo `shouldBe` (fst direct).mailTo + lookupHeader "Subject" composed `shouldBe` lookupHeader "Subject" (fst direct) + errs `shouldBe` errs' + it "provider password reset composes with provider sender and purpose" $ do + let (_, mail) = + run . runOutputList @Text $ + composeEmail templates (ProviderPasswordResetEmail (MkProviderPasswordResetEmail testTo testCodeKey testCodeValue)) + mail.mailFrom.addressEmail `shouldBe` fromEmail emailSender + lookupHeader "X-Zeta-Purpose" mail `shouldBe` Just "ProviderPasswordReset" + it "enterprise audit composes with recipient, subject and purpose" $ do + let (_, mail) = + run . runOutputList @Text $ + composeEmail templates (EnterpriseAuditEmail (MkEnterpriseAuditEmail emailSender testTo "audit subject" "https://example.com/url" Nothing Nothing)) + mail.mailTo `shouldBe` [Address Nothing (fromEmail testTo)] + lookupHeader "Subject" mail `shouldBe` Just "audit subject" + lookupHeader "X-Zeta-Purpose" mail `shouldBe` Just "audit" + +activationEmailTpls :: EmailTemplates -> U.ActivationEmailTemplate +activationEmailTpls templates = + (.activationEmail) . snd $ forLocale Nothing templates.userTemplates + +lookupHeader :: Text -> Mail -> Maybe Text +lookupHeader name mail = + listToMaybe [v | (k, v) <- mail.mailHeaders, decodeUtf8 k == name] + +testTo :: EmailAddress +testTo = fromJust $ emailAddressText "test@example.com" + +testName :: Name +testName = Name "Test" + +testKey :: ActivationKey +testKey = ActivationKey "testkey" + +testCode :: ActivationCode +testCode = ActivationCode "testcode" + +testTeamId :: TeamId +testTeamId = Id (fromJust (UUID.fromString "123e4567-e89b-12d3-a456-426614174000")) + +testInviter :: EmailAddress +testInviter = fromJust $ emailAddressText "inviter@example.com" + +testCode2 :: InvitationCode +testCode2 = InvitationCode "ZoMX0xs=" + +testCodeKey :: Code.Key +testCodeKey = Code.Key (unsafeRange "01234567890123456789") + +testCodeValue :: Code.Value +testCodeValue = Code.Value (unsafeRange "testcode1") diff --git a/libs/wire-subsystems/test/unit/Wire/EmailSubsystem/TemplateFixtures.hs b/libs/wire-subsystems/test/unit/Wire/EmailSubsystem/TemplateFixtures.hs index b6d744ef82c..de5a4422c3f 100644 --- a/libs/wire-subsystems/test/unit/Wire/EmailSubsystem/TemplateFixtures.hs +++ b/libs/wire-subsystems/test/unit/Wire/EmailSubsystem/TemplateFixtures.hs @@ -25,7 +25,9 @@ import Imports import Text.Email.Parser (unsafeEmailAddress) import Wire.API.Locale import Wire.API.User.EmailAddress (EmailAddress) -import Wire.EmailSubsystem.Template +import Wire.EmailSending.Composer (EmailTemplates (..)) +import Wire.EmailSubsystem.Template hiding (emailSender) +import Wire.EmailSubsystem.Templates.Provider import Wire.EmailSubsystem.Templates.Team import Wire.EmailSubsystem.Templates.User @@ -77,3 +79,32 @@ loadTestTeamTemplates = loadTeamTemplates teamOpts "templates" defLocale emailSe -- | Load the on-disk user templates. See 'loadTestTeamTemplates'. loadTestUserTemplates :: IO (Localised UserTemplates) loadTestUserTemplates = loadUserTemplates userTemplateOpts "templates" defLocale emailSender + +providerOpts :: ProviderOpts +providerOpts = + ProviderOpts + { homeUrl = "https://example.com/", + providerActivationUrl = "https://example.com/provider-activate/?key=${key}&code=${code}", + approvalUrl = "https://example.com/provider-approve/?key=${key}&code=${code}", + approvalTo = emailSender, + providerPwResetUrl = "https://example.com/provider-reset/?key=${key}&code=${code}" + } + +-- | Load the on-disk provider templates. See 'loadTestTeamTemplates'. +loadTestProviderTemplates :: IO (Localised ProviderTemplates) +loadTestProviderTemplates = loadProviderTemplates providerOpts "templates" defLocale emailSender + +-- | Load the full composer fixture set (all template bundles plus branding). +loadTestEmailTemplates :: IO EmailTemplates +loadTestEmailTemplates = do + user <- loadTestUserTemplates + team <- loadTestTeamTemplates + provider <- loadTestProviderTemplates + pure + EmailTemplates + { userTemplates = user, + teamTemplates = team, + providerTemplates = provider, + brandingFn = id, + brandingMap = branding + } diff --git a/libs/wire-subsystems/test/unit/Wire/MockInterpreters/EmailSubsystem.hs b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/EmailSubsystem.hs index 305bebed550..3f51a0176ea 100644 --- a/libs/wire-subsystems/test/unit/Wire/MockInterpreters/EmailSubsystem.hs +++ b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/EmailSubsystem.hs @@ -53,8 +53,8 @@ noopEmailSubsystemInterpreter = interpret \case SendAccountDeletionEmail {} -> pure () SendTeamActivationMail {} -> pure () SendTeamDeletionVerificationMail {} -> pure () - SendTeamInvitationMail {} -> pure "" - SendTeamInvitationMailPersonalUser {} -> pure "" + SendTeamInvitationMail {} -> pure () + SendTeamInvitationMailPersonalUser {} -> pure () SendMemberWelcomeEmail {} -> pure () SendNewTeamOwnerWelcomeEmail {} -> pure () SendSAMLIdPChanged {} -> pure () diff --git a/libs/wire-subsystems/test/unit/Wire/SAMLEmailSubsystem/InterpreterSpec.hs b/libs/wire-subsystems/test/unit/Wire/SAMLEmailSubsystem/InterpreterSpec.hs index 5d8363dad4f..440ee2bf6a4 100644 --- a/libs/wire-subsystems/test/unit/Wire/SAMLEmailSubsystem/InterpreterSpec.hs +++ b/libs/wire-subsystems/test/unit/Wire/SAMLEmailSubsystem/InterpreterSpec.hs @@ -33,15 +33,18 @@ import Imports import Network.Mail.Mime (Address (..), Mail (..), Part (..), PartContent (..)) import Polysemy import Polysemy.Error (runError) +import Polysemy.Output import Polysemy.State import SAML2.WebSSO import System.FilePath +import System.IO.Unsafe (unsafePerformIO) import System.Logger qualified as Logger import Test.Hspec import Test.Hspec.QuickCheck import Test.QuickCheck import Text.Email.Parser (unsafeEmailAddress) import URI.ByteString +import Wire.API.BackgroundJobs.Email (SendEmailRequest) import Wire.API.Error (ErrorS) import Wire.API.Error.Galley (GalleyError (TeamMemberNotFound, TeamNotFound)) import Wire.API.Locale @@ -52,12 +55,11 @@ import Wire.API.Team.Permission (fullPermissions) import Wire.API.Team.Role (Role (..)) import Wire.API.User.EmailAddress (fromEmail) import Wire.API.User.IdentityProvider -import Wire.EmailSending +import Wire.EmailSending.Composer (EmailTemplates (..), composeEmail) +import Wire.EmailSending.Queueing (EmailQueueing (QueueEmail)) import Wire.EmailSubsystem qualified as Email import Wire.EmailSubsystem.Interpreter -import Wire.EmailSubsystem.Template import Wire.EmailSubsystem.TemplateFixtures -import Wire.EmailSubsystem.Templates.Team import Wire.GalleyAPIAccess import Wire.MockInterpreters import Wire.SAMLEmailSubsystem @@ -68,6 +70,7 @@ import Wire.StoredUser (StoredUser (..)) import Wire.TeamSubsystem import Wire.TeamSubsystem.GalleyAPI (interpretTeamSubsystemToGalleyAPI) import Wire.UserStore +import Prelude qualified data RenderedTextParts = RenderedTextParts { created :: LText, @@ -96,7 +99,6 @@ spec = do parseLocalUnsafe = fromMaybe (error "Unknown locale") . parseLocale -- Run duplicated IO tasks here to save some time - teamTemplates :: Localised TeamTemplates <- runIO loadTestTeamTemplates newCerts <- runIO $ X509.readCertificates "test/resources/saml/certs.store" describe "SendSAMLIdPChanged" $ do @@ -113,7 +115,7 @@ spec = do storedUser' = patchStoredUser storedUser teamId userLocale uid notif = IdPCreated (Just uid) idp' - (mails, logs, _res) <- runInterpreters [storedUser'] teamMap teamTemplates $ do + (mails, logs, _res) <- runInterpreters [storedUser'] teamMap $ do sendSAMLIdPChanged notif assertNoWarnLogs logs @@ -129,7 +131,7 @@ spec = do let idp' = patchIdP idp teamId storedUser' = patchStoredUser storedUser teamId userLocale uid notif = IdPDeleted uid idp' - (mails, logs, _res) <- runInterpreters [storedUser'] teamMap teamTemplates $ do + (mails, logs, _res) <- runInterpreters [storedUser'] teamMap $ do sendSAMLIdPChanged notif assertNoWarnLogs logs @@ -162,7 +164,7 @@ spec = do ) storedUser' = patchStoredUser storedUser teamId userLocale uid notif = IdPUpdated uid idpOld' idpNew' - (mails, logs, _res) <- runInterpreters [storedUser'] teamMap teamTemplates $ do + (mails, logs, _res) <- runInterpreters [storedUser'] teamMap $ do sendSAMLIdPChanged notif assertNoWarnLogs logs @@ -181,7 +183,7 @@ spec = do teamMember :: TeamMember = mkTeamMember uid (rolePermissions role) Nothing UserLegalHoldDisabled teamMap :: Map TeamId [TeamMember] = Map.singleton teamId [teamMember] - (mails, logs, _res) <- runInterpreters [storedUser'] teamMap teamTemplates $ do + (mails, logs, _res) <- runInterpreters [storedUser'] teamMap $ do sendSAMLIdPChanged notif assertNoWarnLogs logs @@ -196,7 +198,7 @@ spec = do teamMember :: TeamMember = mkTeamMember uid (rolePermissions role) Nothing UserLegalHoldDisabled teamMap :: Map TeamId [TeamMember] = Map.singleton teamId [teamMember] - (mails, logs, _res) <- runInterpreters [storedUser'] teamMap teamTemplates $ do + (mails, logs, _res) <- runInterpreters [storedUser'] teamMap $ do sendSAMLIdPChanged notif assertNoWarnLogs logs @@ -215,7 +217,7 @@ spec = do ) users - (mails, logs, _res) <- runInterpreters (fst <$> users) teamMap teamTemplates $ do + (mails, logs, _res) <- runInterpreters (fst <$> users) teamMap $ do sendSAMLIdPChanged notif assertNoWarnLogs logs @@ -333,7 +335,6 @@ assertMailTextPartWithFile mail expectedTextPart = do runInterpreters :: [StoredUser] -> Map TeamId [TeamMember] -> - Localised TeamTemplates -> Sem '[ SAMLEmailSubsystem, TeamSubsystem, @@ -343,31 +344,59 @@ runInterpreters :: State (Map UserId Password), GalleyAPIAccess, Logger (Logger.Msg -> Logger.Msg), - EmailSending, - State [Mail], + Output SendEmailRequest, ErrorS 'TeamMemberNotFound, ErrorS 'TeamNotFound, Embed IO ] a -> IO ([Mail], [(Level, LByteString)], a) -runInterpreters users teamMap teamTemplates action = do +runInterpreters users teamMap action = do lr <- newLogRecorder - (mails, res) <- + (reqs, res) <- runM . fmap (either (error . show) (either (error . show) Imports.id)) . runError @(Tagged 'TeamNotFound ()) . runError @(Tagged 'TeamMemberNotFound ()) - . runState @[Mail] [] -- Use runState to capture and return the Mail state - . recordingEmailSendingInterpreter + . runOutputList @SendEmailRequest . recordLogs lr . miniGalleyAPIAccess teamMap def . evalState @(Map UserId Password) mempty . evalState @[StoredUser] users . inMemoryUserStoreInterpreter - . emailSubsystemInterpreter undefined teamTemplates branding + . emailSubsystemToOutput . interpretTeamSubsystemToGalleyAPI . samlEmailSubsystemInterpreter $ action logs <- readIORef lr.recordedLogs + let (errs, mails) = run . runOutputList @Text $ traverse (composeEmail emailTemplatesFixture) reqs + errs `shouldBe` [] pure (mails, logs, res) + +-- | Templates used to compose the recorded requests into mails. Loaded once +-- (the test suite runs with the package directory as working directory). +emailTemplatesFixture :: EmailTemplates +emailTemplatesFixture = unsafePerformIO $ do + user <- loadTestUserTemplates + teamTpls <- loadTestTeamTemplates + provider <- loadTestProviderTemplates + pure + EmailTemplates + { userTemplates = user, + teamTemplates = teamTpls, + providerTemplates = provider, + brandingFn = Prelude.id, + brandingMap = branding + } +{-# NOINLINE emailTemplatesFixture #-} + +-- | Interpret 'EmailSubsystem' by enqueueing into the 'Output' effect, so the +-- recorded requests can be composed to mails afterwards. +emailSubsystemToOutput :: + (Member (Output SendEmailRequest) r) => + Sem (Email.EmailSubsystem : r) a -> + Sem r a +emailSubsystemToOutput = + interpret @EmailQueueing (\case QueueEmail req -> Polysemy.Output.output req) + . emailSubsystemInterpreter + . raiseUnder @EmailQueueing diff --git a/libs/wire-subsystems/test/unit/Wire/TeamInvitationSubsystem/InterpreterSpec.hs b/libs/wire-subsystems/test/unit/Wire/TeamInvitationSubsystem/InterpreterSpec.hs index ef2f85d7657..9f60d196193 100644 --- a/libs/wire-subsystems/test/unit/Wire/TeamInvitationSubsystem/InterpreterSpec.hs +++ b/libs/wire-subsystems/test/unit/Wire/TeamInvitationSubsystem/InterpreterSpec.hs @@ -28,10 +28,12 @@ import Data.Map qualified as Map import Data.Qualified import Data.Tagged (Tagged) import Data.Text.Encoding +import Data.Text.Template (template) import Data.Time import Imports import Polysemy import Polysemy.Error +import Polysemy.Input (runInputConst) import Polysemy.State import Polysemy.TinyLog import System.Random (StdGen, mkStdGen) @@ -48,6 +50,7 @@ import Wire.API.Team.Permission import Wire.API.Team.Role (defaultRole) import Wire.API.User import Wire.EmailSubsystem +import Wire.EmailSubsystem.Template (InvitationUrlTemplates (..)) import Wire.EnterpriseLoginSubsystem import Wire.GalleyAPIAccess import Wire.InvitationStore @@ -153,11 +156,18 @@ runAllEffectsWithUserKeys initialUsers args = . discardTinyLogs . enterpriseLoginSubsystemTestInterpreter args.constGuardResult +testInvitationUrlTemplates :: InvitationUrlTemplates +testInvitationUrlTemplates = + InvitationUrlTemplates + { personalUser = template "https://example.com/accept-invitation/?team-code=${code}", + newUser = template "https://example.com/join/?team-code=${code}" + } + runInviteScenarioObserved :: InviteScenarioInput -> Either LocalErrors InviteScenarioObservation runInviteScenarioObserved input = - runAllEffectsWithUserKeys [input.inviter] args . runTeamInvitationSubsystem config $ do + runAllEffectsWithUserKeys [input.inviter] args . runInputConst testInvitationUrlTemplates . runTeamInvitationSubsystem config $ do for_ input.liveInvitations $ \inv -> void $ insertInvitation inv 3_000_000 for_ input.pendingScimUsers $ \(indexTeam, email, uid) -> deleteKey (mkEmailKey email) >> insertPendingScimUser indexTeam email uid @@ -541,7 +551,7 @@ spec = do -- run the test -- outcome :: Either LocalErrors () - outcome = runAllEffects args . runTeamInvitationSubsystem cfg $ do + outcome = runAllEffects args . runInputConst testInvitationUrlTemplates . runTeamInvitationSubsystem cfg $ do void $ inviteUser inviterLuid tid invReq -- result invariants @@ -632,6 +642,6 @@ spec = do } outcome :: Either LocalErrors () - outcome = runAllEffects interpreterArgs . runTeamInvitationSubsystem config $ do + outcome = runAllEffects interpreterArgs . runInputConst testInvitationUrlTemplates . runTeamInvitationSubsystem config $ do void $ inviteUser inviterLuid tid invitationRequest in pure $ outcome === Left (ESubsystem TeamInvitationBlockedDomain) diff --git a/libs/wire-subsystems/wire-subsystems.cabal b/libs/wire-subsystems/wire-subsystems.cabal index 42196d6e18c..d65a87ee5ca 100644 --- a/libs/wire-subsystems/wire-subsystems.cabal +++ b/libs/wire-subsystems/wire-subsystems.cabal @@ -331,12 +331,15 @@ library Wire.DomainVerificationChallengeStore.DualWrite Wire.DomainVerificationChallengeStore.Postgres Wire.EmailSending + Wire.EmailSending.Composer Wire.EmailSending.Options + Wire.EmailSending.Queueing Wire.EmailSending.SES Wire.EmailSending.SMTP Wire.EmailSubsystem Wire.EmailSubsystem.Interpreter Wire.EmailSubsystem.Template + Wire.EmailSubsystem.Templates.Provider Wire.EmailSubsystem.Templates.Team Wire.EmailSubsystem.Templates.User Wire.EnterpriseLoginSubsystem @@ -636,6 +639,7 @@ test-suite wire-subsystems-tests Wire.ConversationSubsystem.InterpreterSpec Wire.ConversationSubsystem.MessageSpec Wire.ConversationSubsystem.One2OneSpec + Wire.EmailSending.ComposerSpec Wire.EmailSubsystem.TemplateFixtures Wire.EmailSubsystem.TemplateSpec Wire.EnterpriseLoginSubsystem.InterpreterSpec diff --git a/nix/wire-server.nix b/nix/wire-server.nix index c3a3010efe6..f45c76bfa1c 100644 --- a/nix/wire-server.nix +++ b/nix/wire-server.nix @@ -281,7 +281,7 @@ let # # extraContents :: Map Exe Derivation -> Map Text [Derivation] extraContents = exes: { - brig = [ brig-templates ]; + background-worker = [ brig-templates ]; brig-integration = [ brig-templates pkgs.mls-test-cli pkgs.awscli2 ]; galley-integration = [ pkgs.mls-test-cli pkgs.awscli2 ]; stern-integration = [ pkgs.awscli2 ]; diff --git a/services/background-worker/background-worker.cabal b/services/background-worker/background-worker.cabal index a43796a4ca7..c2465265698 100644 --- a/services/background-worker/background-worker.cabal +++ b/services/background-worker/background-worker.cabal @@ -24,6 +24,7 @@ library Wire.BackgroundWorker.Workers Wire.DeadUserNotificationWatcher Wire.Effects + Wire.EmailJobsWorker Wire.MeetingsCleanupWorker Wire.PostgresMigrations @@ -36,6 +37,8 @@ library build-depends: aeson + , amazonka + , amazonka-ses , amqp , arbiter-core , arbiter-worker diff --git a/services/background-worker/background-worker.integration.yaml b/services/background-worker/background-worker.integration.yaml index e264ce14016..be731a4e46f 100644 --- a/services/background-worker/background-worker.integration.yaml +++ b/services/background-worker/background-worker.integration.yaml @@ -45,6 +45,46 @@ rabbitmq: caCert: test/resources/rabbitmq-ca.pem insecureSkipVerifyTls: false +# Email transport for the background-worker (same shape as brig's emailSMS.email). +# SES takes precedence over SMTP when both are configured. +# Email templates for composing the emails queued by brig; +# mirrors the values brig used to configure in its emailSMS block. +emailTemplates: + templateDir: ../../libs/wire-subsystems/templates + emailSender: backend-integration@wire.com + templateBranding: + brand: Wire + brandUrl: https://wire.com + brandLabelUrl: wire.com # This is the text in the label for the above URL + brandLogoUrl: https://wire.com/p/img/email/logo-email-black.png + brandService: Wire Service Provider + copyright: © WIRE SWISS GmbH + misuse: misuse@wire.com + legal: https://wire.com/legal/ + forgot: https://wire.com/forgot/ + support: https://support.wire.com/ + user: + activationUrl: https://example.com/verify/?key=${key}&code=${code} + teamActivationUrl: https://example.com/verify/?key=${key}&code=${code} + passwordResetUrl: https://example.com/reset/?key=${key}&code=${code} + deletionUrl: https://example.com/d/?key=${key}&code=${code} + team: + tInvitationUrl: https://example.com/join/?team-code=${code} + tExistingUserInvitationUrl: https://example.com/accept-invitation/?team-code=${code} + tActivationUrl: https://example.com/verify/?key=${key}&code=${code} + tCreatorWelcomeUrl: https://example.com/creator-welcome-website + tMemberWelcomeUrl: https://example.com/member-welcome-website + provider: + homeUrl: https://provider.localhost/ + providerActivationUrl: http://127.0.0.1:8080/verify/bot/?key=${key}&code=${code} + approvalUrl: http://127.0.0.1:8080/provider/approve?key=${key}&code=${code} + approvalTo: success@simulator.amazonses.com + providerPwResetUrl: http://127.0.0.1:8080/reset/bot/?key=${key}&code=${code} + +email: + sesQueue: integration-brig-events + sesEndpoint: http://localhost:4569 # https://email.eu-west-1.amazonaws.com + backendNotificationPusher: pushBackoffMinWait: 1000 # 1ms pushBackoffMaxWait: 1000000 # 1s @@ -82,9 +122,9 @@ jobs: # Meetings cleanup configuration for integration meetingsCleanup: - cleanOlderThanHours: 0.0014 # Clean meetings older than ~5 seconds + cleanOlderThanHours: 0.0014 # Clean meetings older than ~5 seconds batchSize: 100 - schedule: "* * * * *" # Run every minute + schedule: "* * * * *" # Run every minute postgresMigration: conversation: postgresql diff --git a/services/background-worker/default.nix b/services/background-worker/default.nix index acf79b6e195..a98c39287a0 100644 --- a/services/background-worker/default.nix +++ b/services/background-worker/default.nix @@ -4,6 +4,8 @@ # dependencies are added or removed. { mkDerivation , aeson +, amazonka +, amazonka-ses , amqp , arbiter-core , arbiter-worker @@ -67,6 +69,8 @@ mkDerivation { isExecutable = true; libraryHaskellDepends = [ aeson + amazonka + amazonka-ses amqp arbiter-core arbiter-worker diff --git a/services/background-worker/src/Wire/BackgroundWorker/Env.hs b/services/background-worker/src/Wire/BackgroundWorker/Env.hs index ed784a33db9..87dec8283ce 100644 --- a/services/background-worker/src/Wire/BackgroundWorker/Env.hs +++ b/services/background-worker/src/Wire/BackgroundWorker/Env.hs @@ -20,6 +20,8 @@ module Wire.BackgroundWorker.Env where +import Amazonka qualified +import Amazonka.SES qualified as SES import Cassandra (ClientState) import Cassandra.Util (defInitCassandra) import Control.Monad.Base @@ -51,6 +53,9 @@ import Wire.API.Conversation.Protocol (ProtocolTag) import Wire.API.Team.Feature (LegalholdConfig, npProject) import Wire.API.Team.FeatureFlags (FanoutLimit, FeatureFlags) import Wire.BackgroundWorker.Options +import Wire.EmailSending.Composer (EmailTemplates, loadEmailTemplates) +import Wire.EmailSending.Options qualified as EmailOpt +import Wire.EmailSending.SMTP qualified as SMTP import Wire.JobSubsystem.Migrations (mkArbiterConnectionString) import Wire.Options.Galley (GuestLinkTTLSeconds, conversationCodeURISettings) import Wire.Options.Galley qualified as Galley @@ -73,6 +78,10 @@ workerName = \case DeadUserNotificationWatcher -> "dead-user-notification-watcher" BackgroundJobConsumer -> "background-job-consumer" +-- | The configured outbound email transport. Exactly one is built from +-- 'Opts.email' (a required sum), so the "no transport" state is unrepresentable. +data EmailTransport = EmailTransportSMTP !SMTP.SMTP | EmailTransportSES !Amazonka.Env + data Env = Env { http2Manager :: Http2Manager, rabbitmqAdminClient :: Maybe (RabbitMqAdmin.AdminAPI (Servant.AsClientT IO)), @@ -113,7 +122,9 @@ data Env = Env passwordHashingOptions :: !PasswordHashingOptions, checkGroupInfo :: !(Maybe Bool), convCodeURI :: Either HttpsUrl (Map Domain HttpsUrl), - passwordHashingRateLimitEnv :: RateLimitEnv + passwordHashingRateLimitEnv :: RateLimitEnv, + emailTransport :: EmailTransport, + emailComposition :: EmailTemplates } data BackendNotificationMetrics = BackendNotificationMetrics @@ -217,6 +228,21 @@ mkEnv opts galleyOpts = do listClientsUsingBrig = galleyOpts._settings._intraListing } passwordHashingRateLimitEnv <- newRateLimitEnv galleyOpts._settings._passwordHashingRateLimit + emailTransport <- case opts.email of + EmailOpt.EmailSMTP s -> do + let smtpHost = s.smtpEndpoint.host + smtpPort = Just (fromIntegral s.smtpEndpoint.port) + smtpCredentials <- case EmailOpt.smtpCredentials s of + Just (EmailOpt.EmailSMTPCredentials u pwd) -> + Just . (SMTP.Username u,) . SMTP.Password <$> initCredentials pwd + _ -> pure Nothing + EmailTransportSMTP <$> SMTP.initSMTP logger smtpHost smtpPort smtpCredentials s.smtpConnType + EmailOpt.EmailAWS aws -> do + let AWSEndpoint {..} = aws.sesEndpoint + sesEndpoint = + Amazonka.setEndpoint _awsSecure _awsHost _awsPort SES.defaultService + EmailTransportSES <$> (Amazonka.newEnv Amazonka.discover <&> Amazonka.configureService sesEndpoint) + emailComposition <- loadEmailTemplates opts.emailTemplates Log.info logger $ Log.msg @Text "Environment initialized" pure Env {..} diff --git a/services/background-worker/src/Wire/BackgroundWorker/Options.hs b/services/background-worker/src/Wire/BackgroundWorker/Options.hs index 61df5d5d14f..14cb91b9f24 100644 --- a/services/background-worker/src/Wire/BackgroundWorker/Options.hs +++ b/services/background-worker/src/Wire/BackgroundWorker/Options.hs @@ -30,6 +30,8 @@ import Network.AMQP.Extended import System.Cron (CronSchedule, parseCronSchedule) import System.Logger.Extended import Util.Options +import Wire.EmailSending.Options (EmailOpts) +import Wire.EmailSubsystem.Template (EmailTemplatesOpts) import Wire.Migration import Wire.PostgresMigrationOpts @@ -57,7 +59,9 @@ data Opts = Opts migrateDomainRegistration :: !Bool, jobs :: JobConfig, meetingsCleanup :: MeetingsCleanupConfig, - backgroundJobs :: BackgroundJobsConfig + backgroundJobs :: BackgroundJobsConfig, + email :: !EmailOpts, + emailTemplates :: !EmailTemplatesOpts } deriving (Show, Generic) deriving (FromJSON) via Generically Opts diff --git a/services/background-worker/src/Wire/BackgroundWorker/Workers.hs b/services/background-worker/src/Wire/BackgroundWorker/Workers.hs index e28c1e92d14..0d663cdaf28 100644 --- a/services/background-worker/src/Wire/BackgroundWorker/Workers.hs +++ b/services/background-worker/src/Wire/BackgroundWorker/Workers.hs @@ -40,6 +40,7 @@ import Wire.AdminlessJobsWorker (runAdminlessDeletionJob, runAdminlessReminderJo import Wire.BackgroundWorker.Env (AppT, Env (..), runAppT) import Wire.BackgroundWorker.Options (JobConfig (..), JobJitter (..), MeetingsCleanupConfig (..)) import Wire.BackgroundWorker.Util +import Wire.EmailJobsWorker (runSendEmailJob) import Wire.ExternalAccess.External import Wire.JobSubsystem.ArbiterAdapter import Wire.JobSubsystem.Migrations (runJobMigrations) @@ -119,10 +120,10 @@ toJobJitter = \case -- | Start the worker pools for the job queues. -- -- Each domain queue has its own Arbiter table and worker pool. The meetings --- pool owns the recurring cleanup cron job, while the conversations pool owns --- the adminless one-off jobs. Both pools are supervised by Arbiter's --- multi-pool runner, so they share the process lifecycle without sharing a --- payload type or queue. +-- pool owns the recurring cleanup cron job, the conversations pool owns the +-- adminless one-off jobs, and the emails pool sends the outbound mail queued +-- by brig. All pools are supervised by Arbiter's multi-pool runner, so they +-- share the process lifecycle without sharing a payload type or queue. runJobRunner :: Env -> ExtEnv -> @@ -132,7 +133,7 @@ runJobRunner :: runJobRunner env extEnv runnerConfig cleanupConfig = do Log.info runnerConfig.jobRunnerLogger $ Log.msg (Log.val "Starting job worker") - . Log.field "queue_names" (T.intercalate "," [meetingsQueueName, conversationsQueueName]) + . Log.field "queue_names" (T.intercalate "," [meetingsQueueName, conversationsQueueName, emailsQueueName]) . Log.field "schedule" (show runnerConfig.jobRunnerSchedule) let arbiterEnv = mkNewWireArbiterEnv runnerConfig.jobRunnerSchemaName env.hasqlPool @@ -154,6 +155,14 @@ runJobRunner env extEnv runnerConfig cleanupConfig = do AdminlessDeletion payload -> runAppT env $ runAdminlessDeletionJob extEnv (mapJobPayload (const payload) job) AdminlessReminder payload -> runAppT env $ runAdminlessReminderJob extEnv (mapJobPayload (const payload) job) + emailsWorkerHandler _conn job = liftIO $ do + Log.info runnerConfig.jobRunnerLogger $ + Log.msg (Log.val "Running job") + . Log.field "queue_name" emailsQueueName + . Log.field "payload_type" (emailsJobPayloadTypeName job.payload) + case job.payload of + SendEmail payload -> runAppT env $ runSendEmailJob extEnv (mapJobPayload (const payload) job) + cronJob <- case ArbiterWorkerCron.cronJob "meetings-cleanup" (serializeCronSchedule runnerConfig.jobRunnerSchedule) @@ -189,6 +198,17 @@ runJobRunner env extEnv runnerConfig cleanupConfig = do ) ) + emailsWorkerConfig <- + ( ArbiterWorker.transactionalWorkerConfig + runnerConfig.jobRunnerSettings.jobWorkerThreads + emailsWorkerHandler :: + IO + ( ArbiterWorker.WorkerConfig + (WireArbiter JobRegistry) + EmailsJobPayload + ) + ) + let meetingsWorkerConfig' = applyExplicitDefaults runnerConfig.jobRunnerSettings @@ -199,9 +219,14 @@ runJobRunner env extEnv runnerConfig cleanupConfig = do applyExplicitDefaults runnerConfig.jobRunnerSettings conversationsWorkerConfig + emailsWorkerConfig' = + applyExplicitDefaults + runnerConfig.jobRunnerSettings + emailsWorkerConfig workerPools = [ ArbiterWorker.namedWorkerPool meetingsWorkerConfig', - ArbiterWorker.namedWorkerPool conversationsWorkerConfig' + ArbiterWorker.namedWorkerPool conversationsWorkerConfig', + ArbiterWorker.namedWorkerPool emailsWorkerConfig' ] workerAsync <- @@ -223,6 +248,10 @@ conversationsJobPayloadTypeName = \case AdminlessDeletion _ -> "adminless_deletion" AdminlessReminder _ -> "adminless_reminder" +emailsJobPayloadTypeName :: EmailsJobPayload -> Text +emailsJobPayloadTypeName = \case + SendEmail _ -> "send_email" + mapJobPayload :: (a -> b) -> ArbiterCore.JobRead a -> ArbiterCore.JobRead b mapJobPayload f job = ArbiterCore.Job diff --git a/services/background-worker/src/Wire/Effects.hs b/services/background-worker/src/Wire/Effects.hs index 66dbee09c56..9498e27068e 100644 --- a/services/background-worker/src/Wire/Effects.hs +++ b/services/background-worker/src/Wire/Effects.hs @@ -64,7 +64,7 @@ import Wire.API.Team.Feature (AllTeamFeatures, LegalholdConfig) import Wire.API.Team.FeatureFlags (FanoutLimit, FeatureDefaults, FeatureFlags, currentFanoutLimit) import Wire.BackendNotificationQueueAccess (BackendNotificationQueueAccess) import Wire.BackendNotificationQueueAccess.RabbitMq qualified as BackendNotificationQueueAccess -import Wire.BackgroundWorker.Env (Env (..)) +import Wire.BackgroundWorker.Env (EmailTransport (..), Env (..)) import Wire.BrigAPIAccess (BrigAPIAccess) import Wire.BrigAPIAccess.Rpc import Wire.ClientSubsystem.Error (ClientError) @@ -76,6 +76,9 @@ import Wire.ConversationStore (ConversationStore, MLSCommitLockStore) import Wire.ConversationStore.Cassandra (MigrationError (..), interpretConversationStoreByMigration, interpretMLSCommitLockStoreToCassandra) import Wire.ConversationSubsystem (ConversationSubsystem) import Wire.ConversationSubsystem.Interpreter (ConversationSubsystemError, GroupInfoCheckEnabled (..), IntraListing (..), interpretConversationSubsystem) +import Wire.EmailSending (EmailSending) +import Wire.EmailSending.SES (emailViaSESInterpreter) +import Wire.EmailSending.SMTP (emailViaSMTPInterpreter) import Wire.ExternalAccess (ExternalAccess) import Wire.ExternalAccess.External import Wire.FeaturesConfigSubsystem (FeaturesConfigSubsystem, getAllTeamFeaturesForServer) @@ -192,7 +195,8 @@ makeVerifiedRequestFreshManagerIO logger fpr url reqBuilder = do makeVerifiedRequestWithManagerIO logger mgr verifyFingerprints fpr url reqBuilder type BackgroundWorkerEffects = - '[ ConversationSubsystem, + '[ EmailSending, + ConversationSubsystem, MeetingNotifier, TeamCollaboratorsSubsystem, Input AllTeamFeatures, @@ -370,6 +374,7 @@ runBackgroundWorkerEffects env extEnv requestId mJobId = . interpretTeamCollaboratorsSubsystem (interpretBrigAccess env.brigEndpoint) . discardMeetingNotifier . interpretConversationSubsystem + . emailSendingInterpreter env where interpretTeamFeatureStore = case env.postgresMigration.teamFeatures of CassandraStorage -> interpretTeamFeatureStoreToCassandra @@ -413,3 +418,13 @@ runBackgroundWorkerEffects env extEnv requestId mJobId = case mJobId of Nothing -> field "request" (unRequestId requestId) Just jId -> field "request" (unRequestId requestId) . field "job" (idToText jId) + +-- | Interpret 'EmailSending' for the background-worker: SMTP or SES, whichever +-- transport 'mkEnv' built from the required @email@ config (a sum, so the +-- "no transport" state is unrepresentable). Used by the Arbiter @emails@ worker +-- pool ("Wire.EmailJobsWorker"); send failures are retried by Arbiter's +-- bounded retry/backoff and eventually land in the queue's DLQ. +emailSendingInterpreter :: (Member (Embed IO) r) => Env -> InterpreterFor EmailSending r +emailSendingInterpreter env = case env.emailTransport of + EmailTransportSMTP smtp -> emailViaSMTPInterpreter env.logger smtp + EmailTransportSES ses -> emailViaSESInterpreter ses diff --git a/services/background-worker/src/Wire/EmailJobsWorker.hs b/services/background-worker/src/Wire/EmailJobsWorker.hs new file mode 100644 index 00000000000..0271094c10e --- /dev/null +++ b/services/background-worker/src/Wire/EmailJobsWorker.hs @@ -0,0 +1,56 @@ +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2026 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.EmailJobsWorker + ( runSendEmailJob, + ) +where + +import Arbiter.Core.Exceptions (throwRetryable) +import Arbiter.Core.Job.Types (JobRead, notVisibleUntil, payload) +import Imports +import System.Logger qualified as Log +import Wire.API.Jobs (SendEmailJobPayload (..)) +import Wire.BackgroundWorker.Env (AppT, Env (..)) +import Wire.Effects (runBackgroundWorkerEffects) +import Wire.EmailSending (sendMail) +import Wire.EmailSending.Composer (composeEmail) +import Wire.EmailSubsystem.Template (logEmailRenderErrors) +import Wire.ExternalAccess.External (ExtEnv) + +-- | Compose and send one outbound email queued by brig on the Arbiter +-- @emails@ queue. +-- +-- The payload is the composing request (email type, locale, inputs); the mail +-- itself is composed here from the bundled localized templates right before +-- sending. A failing compose or send surfaces as @'Left' 'Text'@ from +-- 'runBackgroundWorkerEffects' and is rethrown as retryable so Arbiter's +-- bounded retry/backoff (and, eventually, the DLQ) applies. +runSendEmailJob :: ExtEnv -> JobRead SendEmailJobPayload -> AppT IO () +runSendEmailJob extEnv job = do + env <- ask + Log.debug env.logger $ + Log.msg (Log.val "Running send-email job") + . Log.field "request_id" (show job.payload.sendEmailJobRequestId) + . Log.field "scheduled_for" (show job.notVisibleUntil) + result <- + liftIO $ + runBackgroundWorkerEffects env extEnv job.payload.sendEmailJobRequestId Nothing $ + logEmailRenderErrors "send-email job" $ + composeEmail env.emailComposition job.payload.sendEmailJobRequest + >>= sendMail + either (liftIO . throwRetryable) pure result diff --git a/services/background-worker/test/Test/Wire/BackendNotificationPusherSpec.hs b/services/background-worker/test/Test/Wire/BackendNotificationPusherSpec.hs index 7222120d93a..d6f302294af 100644 --- a/services/background-worker/test/Test/Wire/BackendNotificationPusherSpec.hs +++ b/services/background-worker/test/Test/Wire/BackendNotificationPusherSpec.hs @@ -364,6 +364,8 @@ spec = do hasqlPool = undefined amqpJobsPublisherChannel = undefined amqpBackendNotificationsChannel = undefined + emailTransport = undefined + emailComposition = undefined federationDomain = Domain "local" postgresMigration = PostgresMigrationOpts @@ -428,6 +430,8 @@ spec = do hasqlPool = undefined amqpJobsPublisherChannel = undefined amqpBackendNotificationsChannel = undefined + emailTransport = undefined + emailComposition = undefined federationDomain = Domain "local" postgresMigration = PostgresMigrationOpts diff --git a/services/background-worker/test/Test/Wire/Util.hs b/services/background-worker/test/Test/Wire/Util.hs index 5d89532bfec..5c3d608c16b 100644 --- a/services/background-worker/test/Test/Wire/Util.hs +++ b/services/background-worker/test/Test/Wire/Util.hs @@ -70,6 +70,8 @@ testEnv = do } hasqlPool = undefined amqpJobsPublisherChannel = undefined + emailTransport = undefined + emailComposition = undefined amqpBackendNotificationsChannel = undefined federationDomain = Domain "local" gundeckEndpoint = undefined diff --git a/services/brig/brig.cabal b/services/brig/brig.cabal index 89b1d88f7a7..ecdf0f34d7f 100644 --- a/services/brig/brig.cabal +++ b/services/brig/brig.cabal @@ -125,7 +125,6 @@ library Brig.Provider.Email Brig.Provider.RPC Brig.Provider.Tag - Brig.Provider.Template Brig.Queue Brig.Queue.Stomp Brig.Queue.Types @@ -184,8 +183,6 @@ library Brig.Schema.V92_AddUserType Brig.Schema.V93_AddScimPendingUserEmail Brig.Team.API - Brig.Team.Template - Brig.Template Brig.User.API.Handle Brig.User.Auth Brig.User.Auth.Cookie @@ -193,7 +190,6 @@ library Brig.User.EJPD Brig.User.Search.Index Brig.User.Search.SearchIndex - Brig.User.Template Brig.Version hs-source-dirs: src @@ -208,6 +204,7 @@ library , amazonka-ses >=2 , amazonka-sqs >=2 , amqp + , arbiter-core , async >=2.1 , auto-update >=0.1 , base >=4 && <5 @@ -258,7 +255,6 @@ library , metrics-core >=0.3 , metrics-wai >=0.3 , mime - , mime-mail >=0.4 , mmorph , MonadRandom >=0.5 , mtl >=2.1 diff --git a/services/brig/brig.integration.yaml b/services/brig/brig.integration.yaml index 8be11f028bd..090c50dfc77 100644 --- a/services/brig/brig.integration.yaml +++ b/services/brig/brig.integration.yaml @@ -110,33 +110,10 @@ emailSMS: # that may be used for this general: - templateDir: ../../libs/wire-subsystems/templates emailSender: backend-integration@wire.com smsSender: "+123456789" # or MG123456789... (twilio alphanumeric sender id) - templateBranding: - brand: Wire - brandUrl: https://wire.com - brandLabelUrl: wire.com # This is the text in the label for the above URL - brandLogoUrl: https://wire.com/p/img/email/logo-email-black.png - brandService: Wire Service Provider - copyright: © WIRE SWISS GmbH - misuse: misuse@wire.com - legal: https://wire.com/legal/ - forgot: https://wire.com/forgot/ - support: https://support.wire.com/ user: - activationUrl: https://example.com/verify/?key=${key}&code=${code} smsActivationUrl: https://example.com/v/${code} - passwordResetUrl: https://example.com/reset/?key=${key}&code=${code} - invitationUrl: https://example.com/register?invitation_code=${code} - deletionUrl: https://example.com/d/?key=${key}&code=${code} - - provider: - homeUrl: https://provider.localhost/ - providerActivationUrl: http://127.0.0.1:8080/verify/bot/?key=${key}&code=${code} - approvalUrl: http://127.0.0.1:8080/provider/approve?key=${key}&code=${code} - approvalTo: success@simulator.amazonses.com - providerPwResetUrl: http://127.0.0.1:8080/reset/bot/?key=${key}&code=${code} team: tInvitationUrl: https://example.com/join/?team-code=${code} diff --git a/services/brig/default.nix b/services/brig/default.nix index e431f9c93db..d7fdec736a4 100644 --- a/services/brig/default.nix +++ b/services/brig/default.nix @@ -9,6 +9,7 @@ , amazonka-ses , amazonka-sqs , amqp +, arbiter-core , async , attoparsec , auto-update @@ -161,6 +162,7 @@ mkDerivation { amazonka-ses amazonka-sqs amqp + arbiter-core async auto-update base @@ -211,7 +213,6 @@ mkDerivation { metrics-core metrics-wai mime - mime-mail mmorph MonadRandom mtl diff --git a/services/brig/src/Brig/API/Public.hs b/services/brig/src/Brig/API/Public.hs index dd5471760b1..78391b33723 100644 --- a/services/brig/src/Brig/API/Public.hs +++ b/services/brig/src/Brig/API/Public.hs @@ -48,7 +48,6 @@ import Brig.Effects.ConnectionStore import Brig.Options hiding (internalEvents) import Brig.Provider.API import Brig.Team.API qualified as Team -import Brig.Template (InvitationUrlTemplates) import Brig.User.API.Handle qualified as Handle import Brig.User.Auth.Cookie qualified as Auth import Brig.User.Client qualified as API @@ -162,8 +161,9 @@ import Wire.ClientSubsystem qualified as ClientSubsystem import Wire.ClientSubsystem.Error import Wire.DeleteQueue import Wire.DomainRegistrationStore (DomainRegistrationStore) -import Wire.EmailSending (EmailSending) +import Wire.EmailSending.Queueing (EmailQueueing) import Wire.EmailSubsystem +import Wire.EmailSubsystem.Template (InvitationUrlTemplates) import Wire.EnterpriseLoginSubsystem (EnterpriseLoginSubsystem) import Wire.EnterpriseLoginSubsystem qualified as EnterpriseLogin import Wire.Error @@ -365,7 +365,7 @@ servantSitemap :: Member (UserPendingActivationStore p) r, Member AuthenticationSubsystem r, Member DeleteQueue r, - Member EmailSending r, + Member EmailQueueing r, Member EmailSubsystem r, Member Events r, Member FederationConfigStore r, diff --git a/services/brig/src/Brig/App.hs b/services/brig/src/Brig/App.hs index 27812d06b47..0f7bb34f223 100644 --- a/services/brig/src/Brig/App.hs +++ b/services/brig/src/Brig/App.hs @@ -30,8 +30,6 @@ module Brig.App mkIndexEnv, newEnv, closeEnv, - providerTemplatesWithLocale, - teamTemplatesWithLocale, invitationUrlTemplates, cargoholdLens, galleyLens, @@ -44,17 +42,12 @@ module Brig.App wireServerEnterpriseEndpointLens, casClientLens, hasqlPoolLens, - smtpEnvLens, emailSenderLens, + invitationUrlsLens, awsEnvLens, appLoggerLens, internalEventsLens, requestIdLens, - userTemplatesLens, - providerTemplatesLens, - teamTemplatesLens, - templateBrandingLens, - templateBrandingAsMapLens, httpManagerLens, http2ManagerLens, extGetManagerLens, @@ -111,14 +104,10 @@ import Brig.Calling qualified as Calling import Brig.DeleteQueue.Interpreter import Brig.Options (ElasticSearchOpts, Opts, Settings (..)) import Brig.Options qualified as Opt -import Brig.Provider.Template import Brig.Queue.Stomp qualified as Stomp import Brig.Queue.Types import Brig.Schema.Run qualified as Migrations -import Brig.Team.Template -import Brig.Template (InvitationUrlTemplates (..), genTemplateBranding, genTemplateBrandingMap) import Brig.User.Search.Index (IndexEnv (..), MonadIndexIO (..), runIndexIO) -import Brig.User.Template import Cassandra (runClient) import Cassandra qualified as Cas import Cassandra.Util (initCassandraForService) @@ -140,6 +129,7 @@ import Data.Text qualified as Text import Data.Text.Encoding (encodeUtf8) import Data.Text.Encoding qualified as Text import Data.Text.IO qualified as Text +import Data.Text.Template (template) import Data.Time.Clock import Database.Bloodhound qualified as ES import HTTP2.Client.Manager (Http2Manager, http2ManagerWithSSLCtx) @@ -165,15 +155,12 @@ import System.Logger.Extended qualified as Log import Util.Options import Util.SuffixNamer import Wire.API.Federation.Error (federationNotImplemented) -import Wire.API.Locale (Locale) import Wire.API.Routes.Version import Wire.API.User.Identity import Wire.AuthenticationSubsystem.Config (ZAuthEnv) import Wire.AuthenticationSubsystem.Config qualified as AuthenticationSubsystem import Wire.EmailSending.Options qualified as EmailOpt -import Wire.EmailSending.SMTP qualified as SMTP -import Wire.EmailSubsystem.Template (Localised, TemplateBranding, forLocale) -import Wire.EmailSubsystem.Templates.User +import Wire.EmailSubsystem.Template (InvitationUrlTemplates (..), TeamOpts (..)) import Wire.ExternalAccess.External import Wire.PostgresMigrationOpts import Wire.RateLimit.Interpreter @@ -201,17 +188,12 @@ data Env = Env wireServerEnterpriseEndpoint :: Maybe Endpoint, casClient :: Cas.ClientState, hasqlPool :: HasqlPool.Pool, - smtpEnv :: Maybe SMTP.SMTP, emailSender :: EmailAddress, + invitationUrls :: InvitationUrlTemplates, awsEnv :: AWS.Env, appLogger :: Logger, internalEvents :: QueueEnv, requestId :: RequestId, - userTemplates :: Localised UserTemplates, - providerTemplates :: Localised ProviderTemplates, - teamTemplates :: Localised TeamTemplates, - templateBranding :: TemplateBranding, - templateBrandingAsMap :: Map Text Text, httpManager :: Manager, http2Manager :: Http2Manager, extGetManager :: (Manager, [Fingerprint Rsa] -> SSL.SSL -> IO ()), @@ -265,12 +247,7 @@ newEnv opts = do mgr <- initHttpManager h2Mgr <- initHttp2Manager ext <- initExtGetManager - utp <- loadUserTemplates opts - ptp <- loadProviderTemplates opts - ttp <- loadTeamTemplatesWithBrigOpts opts - let branding = genTemplateBranding . Opt.templateBranding . Opt.general . Opt.emailSMS $ opts - brandingAsMap = genTemplateBrandingMap . Opt.templateBranding . Opt.general . Opt.emailSMS $ opts - (emailAWSOpts, emailSMTP) <- emailConn lgr $ Opt.email (Opt.emailSMS opts) + emailAWSOpts <- emailConn $ Opt.email (Opt.emailSMS opts) aws <- AWS.mkEnv lgr (Opt.aws opts) emailAWSOpts mgr zau <- initZAuth opts clock <- mkAutoUpdate defaultUpdateSettings {updateAction = getCurrentTime} @@ -320,17 +297,16 @@ newEnv opts = do wireServerEnterpriseEndpoint = opts.wireServerEnterprise, casClient = cas, hasqlPool = hasqlPool, - smtpEnv = emailSMTP, emailSender = opts.emailSMS.general.emailSender, + invitationUrls = + InvitationUrlTemplates + { personalUser = template opts.emailSMS.team.tExistingUserInvitationUrl, + newUser = template opts.emailSMS.team.tInvitationUrl + }, awsEnv = aws, -- used by `journalEvent` directly appLogger = lgr, internalEvents = (eventsQueue :: QueueEnv), requestId = RequestId defRequestId, - userTemplates = utp, - providerTemplates = ptp, - teamTemplates = ttp, - templateBranding = branding, - templateBrandingAsMap = brandingAsMap, httpManager = mgr, http2Manager = h2Mgr, extGetManager = ext, @@ -354,16 +330,8 @@ newEnv opts = do postgresMigration = opts.postgresMigration } where - emailConn _ (EmailOpt.EmailAWS aws) = pure (Just aws, Nothing) - emailConn lgr (EmailOpt.EmailSMTP s) = do - let h = s.smtpEndpoint.host - p = Just . fromInteger . toInteger $ s.smtpEndpoint.port - smtpCredentials <- case EmailOpt.smtpCredentials s of - Just (EmailOpt.EmailSMTPCredentials u p') -> do - Just . (SMTP.Username u,) . SMTP.Password <$> initCredentials p' - _ -> pure Nothing - smtp <- SMTP.initSMTP lgr h p smtpCredentials (EmailOpt.smtpConnType s) - pure (Nothing, Just smtp) + emailConn (EmailOpt.EmailAWS aws) = pure (Just aws) + emailConn (EmailOpt.EmailSMTP _) = pure Nothing mkEndpoint service = RPC.host (encodeUtf8 service.host) . RPC.port service.port $ RPC.empty mkIndexEnv :: ElasticSearchOpts -> Logger -> Endpoint -> Manager -> IO IndexEnv @@ -475,22 +443,8 @@ initCassandra o g = (Just schemaVersion) g -teamTemplatesWithLocale :: (MonadReader Env m) => Maybe Locale -> m (Locale, TeamTemplates) -teamTemplatesWithLocale l = forLocale l <$> asks (.teamTemplates) - -providerTemplatesWithLocale :: (MonadReader Env m) => Maybe Locale -> m (Locale, ProviderTemplates) -providerTemplatesWithLocale l = forLocale l <$> asks (.providerTemplates) - invitationUrlTemplates :: (MonadReader Env m) => m InvitationUrlTemplates -invitationUrlTemplates = do - -- this works because team templates is not affected by `forLocale`; it is useful where we - -- use the `TeamTemplates` only for finding invitation url templates (those are not localized). - teamTemplates <- snd <$> teamTemplatesWithLocale Nothing - pure $ - InvitationUrlTemplates - { personalUser = teamTemplates.existingUserInvitationEmail.invitationEmailUrl, - newUser = teamTemplates.invitationEmail.invitationEmailUrl - } +invitationUrlTemplates = asks (.invitationUrls) closeEnv :: Env -> IO () closeEnv e = do diff --git a/services/brig/src/Brig/CanonicalInterpreter.hs b/services/brig/src/Brig/CanonicalInterpreter.hs index 4414567c910..fe4fb71788f 100644 --- a/services/brig/src/Brig/CanonicalInterpreter.hs +++ b/services/brig/src/Brig/CanonicalInterpreter.hs @@ -25,7 +25,6 @@ import Brig.Effects.ConnectionStore.Cassandra (connectionStoreToCassandra) import Brig.IO.Intra (runEvents) import Brig.Options (Settings (consumableNotifications), federationDomainConfigs, federationStrategy) import Brig.Options qualified as Opt -import Brig.Template (InvitationUrlTemplates) import Brig.User.Search.Index (IndexEnv (..)) import Cassandra qualified as Cas import Control.Exception (ErrorCall) @@ -88,11 +87,10 @@ import Wire.DomainVerificationChallengeStore import Wire.DomainVerificationChallengeStore.Cassandra import Wire.DomainVerificationChallengeStore.DualWrite (interpretDomainVerificationChallengeStoreToCassandraAndPostgres) import Wire.DomainVerificationChallengeStore.Postgres (interpretDomainVerificationChallengeStoreToPostgres) -import Wire.EmailSending -import Wire.EmailSending.SES -import Wire.EmailSending.SMTP +import Wire.EmailSending.Queueing (EmailQueueing, emailViaQueueInterpreter) import Wire.EmailSubsystem import Wire.EmailSubsystem.Interpreter +import Wire.EmailSubsystem.Template (InvitationUrlTemplates) import Wire.EnterpriseLoginSubsystem import Wire.EnterpriseLoginSubsystem.Error (EnterpriseLoginSubsystemError, enterpriseLoginSubsystemErrorToHttpError) import Wire.EnterpriseLoginSubsystem.Interpreter @@ -273,7 +271,7 @@ type BrigLowerLevelEffects = PasswordResetCodeStore, GalleyAPIAccess, SparAPIAccess, - EmailSending, + EmailQueueing, Rpc, Metrics, Embed Cas.Client, @@ -451,7 +449,7 @@ runBrigToIO e (AppT ma) = do . interpretClientToIO e.casClient . runMetricsToIO . runRpcWithHttp e.httpManager e.requestId - . emailSendingInterpreter e + . emailViaQueueInterpreter e.requestId e.hasqlPool . interpretSparAPIAccessToRpc e.sparEndpoint . interpretGalleyAPIAccessToRpc e.disabledVersions e.galleyEndpoint . passwordResetCodeStoreToCassandra @Cas.Client @@ -518,7 +516,7 @@ runBrigToIO e (AppT ma) = do . runDeleteQueue e.internalEvents . interpretPropertySubsystem propertySubsystemConfig . interpretVerificationCodeSubsystem - . emailSubsystemInterpreter e.userTemplates e.teamTemplates e.templateBrandingAsMap + . emailSubsystemInterpreter . interpretAppStoreToPostgres . interpretTeamCollaboratorsStoreToPostgres . interpretTeamSubsystemToGalleyAPI @@ -559,9 +557,3 @@ rethrowHttpErrorIO act = do case eithError of Left err -> embedToFinal $ throwM $ err Right a -> pure a - -emailSendingInterpreter :: (Member (Embed IO) r) => Env -> InterpreterFor EmailSending r -emailSendingInterpreter e = do - case e.smtpEnv of - Just smtp -> emailViaSMTPInterpreter e.appLogger smtp - Nothing -> emailViaSESInterpreter (e.awsEnv ^. amazonkaEnv) diff --git a/services/brig/src/Brig/Options.hs b/services/brig/src/Brig/Options.hs index df05f68fd7d..6e3429721dd 100644 --- a/services/brig/src/Brig/Options.hs +++ b/services/brig/src/Brig/Options.hs @@ -126,74 +126,31 @@ instance FromJSON InternalEventsOpts where InternalEventsOpts <$> parseJSON (Object o) data EmailSMSGeneralOpts = EmailSMSGeneralOpts - { -- | Email, SMS, ... template directory - templateDir :: !FilePath, - -- | Email sender address + { -- | Email sender address (used by SCIM invitations and the enterprise + -- audit email; all other email is composed and sent by the + -- background-worker) emailSender :: !EmailAddress, -- | Twilio sender identifier (sender phone number in E.104 format) -- or twilio messaging sender ID - see -- https://www.twilio.com/docs/sms/send-messages#use-an-alphanumeric-sender-id - smsSender :: !Text, - -- | Customizable branding text for - -- emails/sms/calls - templateBranding :: !BrandingOpts + smsSender :: !Text } deriving (Show, Generic) instance FromJSON EmailSMSGeneralOpts -data BrandingOpts = BrandingOpts - { brand :: !Text, - brandUrl :: !Text, - brandLabelUrl :: !Text, - brandLogoUrl :: !Text, - brandService :: !Text, - copyright :: !Text, - misuse :: !Text, - legal :: !Text, - forgot :: !Text, - support :: !Text - } - deriving (Show, Generic) - -instance FromJSON BrandingOpts - data EmailUserOpts = EmailUserOpts - { -- | Activation URL template - activationUrl :: !Text, - -- | SMS activation URL template - smsActivationUrl :: !Text, - -- | Password reset URL template - passwordResetUrl :: !Text, - -- | Deletion URL template - deletionUrl :: !Text + { -- | SMS activation URL template + smsActivationUrl :: !Text } deriving (Show, Generic) instance FromJSON EmailUserOpts --- | Provider settings -data ProviderOpts = ProviderOpts - { -- | Homepage URL - homeUrl :: !Text, - -- | Activation URL template - providerActivationUrl :: !Text, - -- | Approval URL template - approvalUrl :: !Text, - -- | Approval email recipient - approvalTo :: !EmailAddress, - -- | Password reset URL template - providerPwResetUrl :: !Text - } - deriving (Show, Generic) - -instance FromJSON ProviderOpts - data EmailSMSOpts = EmailSMSOpts { email :: !EmailOpts, general :: !EmailSMSGeneralOpts, user :: !EmailUserOpts, - provider :: !ProviderOpts, team :: !TeamOpts } deriving (Show, Generic) diff --git a/services/brig/src/Brig/Provider/API.hs b/services/brig/src/Brig/Provider/API.hs index 7c5089e9f3c..ec4439b5c6d 100644 --- a/services/brig/src/Brig/Provider/API.hs +++ b/services/brig/src/Brig/Provider/API.hs @@ -125,7 +125,7 @@ import Wire.ClientStore qualified as ClientStore import Wire.ClientSubsystem as ClientSubsystem import Wire.ClientSubsystem.Error import Wire.DeleteQueue -import Wire.EmailSending (EmailSending) +import Wire.EmailSending.Queueing (EmailQueueing) import Wire.Error import Wire.GalleyAPIAccess (GalleyAPIAccess) import Wire.GalleyAPIAccess qualified as GalleyAPIAccess @@ -206,7 +206,7 @@ servicesAPI = providerAPI :: ( Member GalleyAPIAccess r, Member AuthenticationSubsystem r, - Member EmailSending r, + Member EmailQueueing r, Member HashPassword r, Member VerificationCodeSubsystem r, Member RateLimit r, @@ -242,7 +242,7 @@ internalProviderAPI = newAccount :: ( Member GalleyAPIAccess r, - Member EmailSending r, + Member EmailQueueing r, Member HashPassword r, Member VerificationCodeSubsystem r, Member RateLimit r @@ -284,7 +284,7 @@ newAccount ip new = do activateAccountKey :: ( Member GalleyAPIAccess r, - Member EmailSending r, + Member EmailQueueing r, Member VerificationCodeSubsystem r ) => Code.Key -> @@ -353,7 +353,7 @@ login l = do s <- asks (.settings) pure $ ProviderTokenCookie (ProviderToken token) (not s.cookieInsecure) -beginPasswordReset :: (Member GalleyAPIAccess r, Member EmailSending r, Member VerificationCodeSubsystem r) => Public.PasswordReset -> (Handler r) () +beginPasswordReset :: (Member GalleyAPIAccess r, Member EmailQueueing r, Member VerificationCodeSubsystem r) => Public.PasswordReset -> (Handler r) () beginPasswordReset (Public.PasswordReset target) = do guardSecondFactorDisabled Nothing pid <- wrapClientE (DB.lookupKey (mkEmailKey target)) >>= maybeBadCredentials @@ -407,7 +407,7 @@ updateAccountProfile pid upd = do updateAccountEmail :: ( Member GalleyAPIAccess r, - Member EmailSending r, + Member EmailQueueing r, Member VerificationCodeSubsystem r ) => ProviderId -> diff --git a/services/brig/src/Brig/Provider/Email.hs b/services/brig/src/Brig/Provider/Email.hs index 5d8b558dced..2088f28f077 100644 --- a/services/brig/src/Brig/Provider/Email.hs +++ b/services/brig/src/Brig/Provider/Email.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE RecordWildCards #-} - -- This file is part of the Wire Server implementation. -- -- Copyright (C) 2022 Wire Swiss GmbH @@ -25,151 +23,27 @@ module Brig.Provider.Email where import Brig.App -import Brig.Provider.Template import Data.Code qualified as Code -import Data.Range -import Data.Text (pack) -import Data.Text.Ascii qualified as Ascii -import Data.Text.Lazy qualified as LT -import Data.Text.Template import Imports -import Network.Mail.Mime import Polysemy +import Wire.API.BackgroundJobs.Email import Wire.API.User -import Wire.EmailSending -import Wire.EmailSubsystem.Interpreter (mkMimeAddress) -import Wire.EmailSubsystem.Template (TemplateBranding, renderHtmlWithBranding, renderTextWithBranding) - -------------------------------------------------------------------------------- --- Activation Email - -sendActivationMail :: (Member EmailSending r) => Name -> EmailAddress -> Code.Key -> Code.Value -> Bool -> (AppT r) () -sendActivationMail name email key code update = do - tpl <- selectTemplate update . snd <$> providerTemplatesWithLocale Nothing - branding <- asks (.templateBranding) - let mail = ActivationEmail email name key code - liftSem $ sendMail $ renderActivationMail mail tpl branding - where - selectTemplate True = activationEmailUpdate - selectTemplate False = activationEmail - -data ActivationEmail = ActivationEmail - { acmTo :: !EmailAddress, - acmName :: !Name, - acmKey :: !Code.Key, - acmCode :: !Code.Value - } - -renderActivationMail :: ActivationEmail -> ActivationEmailTemplate -> TemplateBranding -> Mail -renderActivationMail ActivationEmail {..} ActivationEmailTemplate {..} branding = - (emptyMail from) - { mailTo = [to], - mailHeaders = - [ ("Subject", LT.toStrict subj), - ("X-Zeta-Purpose", "ProviderActivation"), - ("X-Zeta-Key", Ascii.toText (fromRange key)), - ("X-Zeta-Code", Ascii.toText (fromRange code)) - ], - mailParts = [[plainPart txt, htmlPart html]] - } - where - (Code.Key key, Code.Value code) = (acmKey, acmCode) - from = Address (Just activationEmailSenderName) (fromEmail activationEmailSender) - to = mkMimeAddress acmName acmTo - txt = renderTextWithBranding activationEmailBodyText replace branding - html = renderHtmlWithBranding activationEmailBodyHtml replace branding - subj = renderTextWithBranding activationEmailSubject replace branding - replace "url" = renderActivationUrl activationEmailUrl acmKey acmCode branding - replace "email" = fromEmail acmTo - replace "name" = fromName acmName - replace x = x - -renderActivationUrl :: Template -> Code.Key -> Code.Value -> TemplateBranding -> Text -renderActivationUrl t (Code.Key k) (Code.Value v) branding = - LT.toStrict $ renderTextWithBranding t replace branding - where - replace "key" = Ascii.toText (fromRange k) - replace "code" = Ascii.toText (fromRange v) - replace x = x - --------------------------------------------------------------------------------- --- Approval Confirmation Email - -sendApprovalConfirmMail :: (Member EmailSending r) => Name -> EmailAddress -> (AppT r) () -sendApprovalConfirmMail name email = do - tpl <- approvalConfirmEmail . snd <$> providerTemplatesWithLocale Nothing - branding <- asks (.templateBranding) - let mail = ApprovalConfirmEmail email name - liftSem $ sendMail $ renderApprovalConfirmMail mail tpl branding - -data ApprovalConfirmEmail = ApprovalConfirmEmail - { apcTo :: !EmailAddress, - apcName :: !Name - } - -renderApprovalConfirmMail :: ApprovalConfirmEmail -> ApprovalConfirmEmailTemplate -> TemplateBranding -> Mail -renderApprovalConfirmMail ApprovalConfirmEmail {..} ApprovalConfirmEmailTemplate {..} branding = - (emptyMail from) - { mailTo = [to], - mailHeaders = - [ ("Subject", LT.toStrict subj), - ("X-Zeta-Purpose", "ProviderApprovalConfirm") - ], - mailParts = [[plainPart txt, htmlPart html]] - } - where - from = Address (Just approvalConfirmEmailSenderName) (fromEmail approvalConfirmEmailSender) - to = mkMimeAddress apcName apcTo - txt = renderTextWithBranding approvalConfirmEmailBodyText replace branding - html = renderHtmlWithBranding approvalConfirmEmailBodyHtml replace branding - subj = renderTextWithBranding approvalConfirmEmailSubject replace branding - replace "homeUrl" = pack $ show approvalConfirmEmailHomeUrl - replace "email" = fromEmail apcTo - replace "name" = fromName apcName - replace x = x - --------------------------------------------------------------------------------- --- Password Reset Email - -sendPasswordResetMail :: (Member EmailSending r) => EmailAddress -> Code.Key -> Code.Value -> (AppT r) () -sendPasswordResetMail to key code = do - tpl <- passwordResetEmail . snd <$> providerTemplatesWithLocale Nothing - branding <- asks (.templateBranding) - let mail = PasswordResetEmail to key code - liftSem $ sendMail $ renderPwResetMail mail tpl branding - -data PasswordResetEmail = PasswordResetEmail - { pwrTo :: !EmailAddress, - pwrKey :: !Code.Key, - pwrCode :: !Code.Value - } - -renderPwResetMail :: PasswordResetEmail -> PasswordResetEmailTemplate -> TemplateBranding -> Mail -renderPwResetMail PasswordResetEmail {..} PasswordResetEmailTemplate {..} branding = - (emptyMail from) - { mailTo = [to], - mailHeaders = - [ ("Subject", LT.toStrict subj), - ("X-Zeta-Purpose", "ProviderPasswordReset"), - ("X-Zeta-Key", Ascii.toText (fromRange key)), - ("X-Zeta-Code", Ascii.toText (fromRange code)) - ], - mailParts = [[plainPart txt, htmlPart html]] - } - where - (Code.Key key, Code.Value code) = (pwrKey, pwrCode) - from = Address (Just passwordResetEmailSenderName) (fromEmail passwordResetEmailSender) - to = Address Nothing (fromEmail pwrTo) - txt = renderTextWithBranding passwordResetEmailBodyText replace branding - html = renderHtmlWithBranding passwordResetEmailBodyHtml replace branding - subj = renderTextWithBranding passwordResetEmailSubject replace branding - replace "url" = renderPwResetUrl passwordResetEmailUrl pwrKey pwrCode branding - replace x = x - -renderPwResetUrl :: Template -> Code.Key -> Code.Value -> TemplateBranding -> Text -renderPwResetUrl t (Code.Key k) (Code.Value v) branding = - LT.toStrict $ renderTextWithBranding t replace branding - where - replace "key" = Ascii.toText (fromRange k) - replace "code" = Ascii.toText (fromRange v) - replace x = x +import Wire.EmailSending.Queueing + +sendActivationMail :: (Member EmailQueueing r) => Name -> EmailAddress -> Code.Key -> Code.Value -> Bool -> (AppT r) () +sendActivationMail name email key code update = + liftSem $ + queueEmail $ + ProviderActivationEmail (MkProviderActivationEmail email name key code update) + +sendApprovalConfirmMail :: (Member EmailQueueing r) => Name -> EmailAddress -> (AppT r) () +sendApprovalConfirmMail name email = + liftSem $ + queueEmail $ + ProviderApprovalConfirmEmail (MkProviderApprovalConfirmEmail email name) + +sendPasswordResetMail :: (Member EmailQueueing r) => EmailAddress -> Code.Key -> Code.Value -> (AppT r) () +sendPasswordResetMail to key code = + liftSem $ + queueEmail $ + ProviderPasswordResetEmail (MkProviderPasswordResetEmail to key code) diff --git a/services/brig/src/Brig/Run.hs b/services/brig/src/Brig/Run.hs index 7cc07fc7f2d..6e75c762fc4 100644 --- a/services/brig/src/Brig/Run.hs +++ b/services/brig/src/Brig/Run.hs @@ -18,6 +18,7 @@ module Brig.Run (run, mkApp, migratePostgres) where import AWS.Util (readAuthExpiration) +import Arbiter.Core qualified as ArbiterCore import Brig.API.Federation import Brig.API.Handler import Brig.API.Internal qualified as IAPI @@ -69,6 +70,7 @@ import Wire.API.Routes.Version import Wire.API.Routes.Version.Wai import Wire.API.User (AccountStatus (PendingInvitation)) import Wire.DeleteQueue +import Wire.JobSubsystem.Migrations (mkArbiterConnectionString, runJobMigrations) import Wire.OpenTelemetry (withTracer) import Wire.PostgresMigrations import Wire.Sem.Paging qualified as P @@ -84,6 +86,11 @@ run :: Opts -> IO () run opts = withTracer \tracer -> do (app, e) <- mkApp opts runAllMigrations e.hasqlPool.rawPool e.appLogger + arbiterConnStr <- + mkArbiterConnectionString + opts.postgresql + opts.postgresqlPassword + runJobMigrations arbiterConnStr ArbiterCore.defaultSchemaName let s = Server.newSettings (server e) internalEventListener <- Async.async $ diff --git a/services/brig/src/Brig/Team/API.hs b/services/brig/src/Brig/Team/API.hs index 48430fbebab..1bdc43ce306 100644 --- a/services/brig/src/Brig/Team/API.hs +++ b/services/brig/src/Brig/Team/API.hs @@ -31,7 +31,6 @@ import Brig.API.User (createUserInviteViaScim) import Brig.API.User qualified as API import Brig.API.Util (logEmail, logInvitationCode) import Brig.App as App -import Brig.Template import Control.Lens (view, (^.)) import Control.Monad.Trans.Except import Data.ByteString.Conversion (toByteString) @@ -70,6 +69,7 @@ import Wire.API.User hiding (fromEmail) import Wire.AuthenticationSubsystem import Wire.BlockListStore import Wire.EmailSubsystem.Interpreter (renderInvitationUrl) +import Wire.EmailSubsystem.Template (InvitationUrlTemplates (..)) import Wire.Error import Wire.Events (Events) import Wire.GalleyAPIAccess (GalleyAPIAccess, ShowOrHideInvitationUrl (..)) diff --git a/services/brig/src/Brig/Team/Template.hs b/services/brig/src/Brig/Team/Template.hs deleted file mode 100644 index caffd40e85d..00000000000 --- a/services/brig/src/Brig/Team/Template.hs +++ /dev/null @@ -1,39 +0,0 @@ --- This file is part of the Wire Server implementation. --- --- Copyright (C) 2022 Wire Swiss GmbH --- --- This program is free software: you can redistribute it and/or modify it under --- the terms of the GNU Affero General Public License as published by the Free --- Software Foundation, either version 3 of the License, or (at your option) any --- later version. --- --- This program is distributed in the hope that it will be useful, but WITHOUT --- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS --- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more --- details. --- --- You should have received a copy of the GNU Affero General Public License along --- with this program. If not, see . - -module Brig.Team.Template - ( TeamTemplates (..), - InvitationEmailTemplate (..), - MemberWelcomeEmailTemplate (..), - loadTeamTemplatesWithBrigOpts, - ) -where - -import Brig.Options -import Imports -import Wire.EmailSubsystem.Template -import Wire.EmailSubsystem.Templates.Team - --- FUTUREWORK: This can be inlined once the `API.Template` have been migrated --- to wire-subsystem unit tests. -loadTeamTemplatesWithBrigOpts :: Opts -> IO (Localised TeamTemplates) -loadTeamTemplatesWithBrigOpts o = - loadTeamTemplates - o.emailSMS.team - o.emailSMS.general.templateDir - (defaultTemplateLocale o.settings) - (emailSender o.emailSMS.general) diff --git a/services/brig/src/Brig/Template.hs b/services/brig/src/Brig/Template.hs deleted file mode 100644 index 0b530261d05..00000000000 --- a/services/brig/src/Brig/Template.hs +++ /dev/null @@ -1,72 +0,0 @@ -{-# LANGUAGE RecordWildCards #-} - --- This file is part of the Wire Server implementation. --- --- Copyright (C) 2022 Wire Swiss GmbH --- --- This program is free software: you can redistribute it and/or modify it under --- the terms of the GNU Affero General Public License as published by the Free --- Software Foundation, either version 3 of the License, or (at your option) any --- later version. --- --- This program is distributed in the hope that it will be useful, but WITHOUT --- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS --- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more --- details. --- --- You should have received a copy of the GNU Affero General Public License along --- with this program. If not, see . - --- | Common templating utilities. -module Brig.Template - ( InvitationUrlTemplates (..), - genTemplateBranding, - genTemplateBrandingMap, - ) -where - -import Brig.Options -import Data.Map.Strict qualified as Map -import Data.Text.Template (Template) -import Imports - -data InvitationUrlTemplates = InvitationUrlTemplates - { personalUser :: Template, - newUser :: Template - } - --- | See 'genTemplateBranding'. -type TemplateBranding = Text -> Text - --- | Function to be applied everywhere where email/sms/call --- templating is used (ensures that placeholders are replaced --- by the appropriate branding, typically Wire) -genTemplateBranding :: BrandingOpts -> TemplateBranding -genTemplateBranding BrandingOpts {..} = fn - where - fn "brand" = brand - fn "brand_url" = brandUrl - fn "brand_label_url" = brandLabelUrl - fn "brand_logo" = brandLogoUrl - fn "brand_service" = brandService - fn "copyright" = copyright - fn "misuse" = misuse - fn "legal" = legal - fn "forgot" = forgot - fn "support" = support - fn other = other - -genTemplateBrandingMap :: BrandingOpts -> Map Text Text -genTemplateBrandingMap opts = - Map.fromList - [ ("brand", opts.brand), - ("brand_url", opts.brandUrl), - ("brand_label_url", opts.brandLabelUrl), - ("brand_logo", opts.brandLogoUrl), - ("brand_service", opts.brandService), - ("copyright", opts.copyright), - ("misuse", opts.misuse), - ("legal", opts.legal), - ("forgot", opts.forgot), - ("support", opts.support) - ] diff --git a/services/brig/src/Brig/User/Template.hs b/services/brig/src/Brig/User/Template.hs deleted file mode 100644 index 9f9636f510e..00000000000 --- a/services/brig/src/Brig/User/Template.hs +++ /dev/null @@ -1,40 +0,0 @@ --- This file is part of the Wire Server implementation. --- --- Copyright (C) 2022 Wire Swiss GmbH --- --- This program is free software: you can redistribute it and/or modify it under --- the terms of the GNU Affero General Public License as published by the Free --- Software Foundation, either version 3 of the License, or (at your option) any --- later version. --- --- This program is distributed in the hope that it will be useful, but WITHOUT --- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS --- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more --- details. --- --- You should have received a copy of the GNU Affero General Public License along --- with this program. If not, see . - -module Brig.User.Template (loadUserTemplates) where - -import Brig.Options qualified as Opt -import Imports -import Wire.EmailSubsystem.Template hiding (loadUserTemplates) -import Wire.EmailSubsystem.Template qualified as EmailTemplate -import Wire.EmailSubsystem.Templates.User - -loadUserTemplates :: Opt.Opts -> IO (Localised UserTemplates) -loadUserTemplates o = - EmailTemplate.loadUserTemplates - userTemplateOpts - o.emailSMS.general.templateDir - (Opt.defaultTemplateLocale o.settings) - o.emailSMS.general.emailSender - where - userTemplateOpts = - UserTemplateOpts - { activationUrl = o.emailSMS.user.activationUrl, - teamActivationUrl = o.emailSMS.team.tActivationUrl, - passwordResetUrl = o.emailSMS.user.passwordResetUrl, - deletionUrl = o.emailSMS.user.deletionUrl - }