{-# LANGUAGE RecordWildCards #-}

module Wire.EmailSubsystem.Interpreter
  ( emailSubsystemInterpreter,
    mkMimeAddress,
  )
where

import Data.Code qualified as Code
import Data.Id
import Data.Json.Util
import Data.Range (fromRange)
import Data.Text qualified as Text
import Data.Text.Ascii qualified as Ascii
import Data.Text.Lazy (toStrict)
import Imports
import Network.Mail.Mime
import Polysemy
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.EmailSubsystem
import Wire.EmailSubsystem.Template

emailSubsystemInterpreter :: (Member EmailSending r) => Localised UserTemplates -> Localised TeamTemplates -> TemplateBranding -> InterpreterFor EmailSubsystem r
emailSubsystemInterpreter :: forall (r :: EffectRow).
Member EmailSending r =>
Localised UserTemplates
-> Localised TeamTemplates
-> TemplateBranding
-> InterpreterFor EmailSubsystem r
emailSubsystemInterpreter Localised UserTemplates
userTpls Localised TeamTemplates
teamTpls TemplateBranding
branding = (forall (rInitial :: EffectRow) x.
 EmailSubsystem (Sem rInitial) x -> Sem r x)
-> Sem (EmailSubsystem : r) a -> Sem r a
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
FirstOrder e "interpret" =>
(forall (rInitial :: EffectRow) x. e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret \case
  SendPasswordResetMail EmailAddress
email (PasswordResetKey
key, PasswordResetCode
code) Maybe Locale
mLocale -> Localised UserTemplates
-> TemplateBranding
-> EmailAddress
-> PasswordResetKey
-> PasswordResetCode
-> Maybe Locale
-> Sem r ()
forall (r :: EffectRow).
Member EmailSending r =>
Localised UserTemplates
-> TemplateBranding
-> EmailAddress
-> PasswordResetKey
-> PasswordResetCode
-> Maybe Locale
-> Sem r ()
sendPasswordResetMailImpl Localised UserTemplates
userTpls TemplateBranding
branding EmailAddress
email PasswordResetKey
key PasswordResetCode
code Maybe Locale
mLocale
  SendVerificationMail EmailAddress
email ActivationKey
key ActivationCode
code Maybe Locale
mLocale -> Localised UserTemplates
-> TemplateBranding
-> EmailAddress
-> ActivationKey
-> ActivationCode
-> Maybe Locale
-> Sem r ()
forall (r :: EffectRow).
Member EmailSending r =>
Localised UserTemplates
-> TemplateBranding
-> EmailAddress
-> ActivationKey
-> ActivationCode
-> Maybe Locale
-> Sem r ()
sendVerificationMailImpl Localised UserTemplates
userTpls TemplateBranding
branding EmailAddress
email ActivationKey
key ActivationCode
code Maybe Locale
mLocale
  SendTeamDeletionVerificationMail EmailAddress
email Value
code Maybe Locale
mLocale -> Localised UserTemplates
-> TemplateBranding
-> EmailAddress
-> Value
-> Maybe Locale
-> Sem r ()
forall (r :: EffectRow).
Member EmailSending r =>
Localised UserTemplates
-> TemplateBranding
-> EmailAddress
-> Value
-> Maybe Locale
-> Sem r ()
sendTeamDeletionVerificationMailImpl Localised UserTemplates
userTpls TemplateBranding
branding EmailAddress
email Value
code Maybe Locale
mLocale
  SendCreateScimTokenVerificationMail EmailAddress
email Value
code Maybe Locale
mLocale -> Localised UserTemplates
-> TemplateBranding
-> EmailAddress
-> Value
-> Maybe Locale
-> Sem r ()
forall (r :: EffectRow).
Member EmailSending r =>
Localised UserTemplates
-> TemplateBranding
-> EmailAddress
-> Value
-> Maybe Locale
-> Sem r ()
sendCreateScimTokenVerificationMailImpl Localised UserTemplates
userTpls TemplateBranding
branding EmailAddress
email Value
code Maybe Locale
mLocale
  SendLoginVerificationMail EmailAddress
email Value
code Maybe Locale
mLocale -> Localised UserTemplates
-> TemplateBranding
-> EmailAddress
-> Value
-> Maybe Locale
-> Sem r ()
forall (r :: EffectRow).
Member EmailSending r =>
Localised UserTemplates
-> TemplateBranding
-> EmailAddress
-> Value
-> Maybe Locale
-> Sem r ()
sendLoginVerificationMailImpl Localised UserTemplates
userTpls TemplateBranding
branding EmailAddress
email Value
code Maybe Locale
mLocale
  SendActivationMail EmailAddress
email Name
name ActivationKey
key ActivationCode
code Maybe Locale
mLocale -> Localised UserTemplates
-> TemplateBranding
-> EmailAddress
-> Name
-> ActivationKey
-> ActivationCode
-> Maybe Locale
-> Sem r ()
forall (r :: EffectRow).
Member EmailSending r =>
Localised UserTemplates
-> TemplateBranding
-> EmailAddress
-> Name
-> ActivationKey
-> ActivationCode
-> Maybe Locale
-> Sem r ()
sendActivationMailImpl Localised UserTemplates
userTpls TemplateBranding
branding EmailAddress
email Name
name ActivationKey
key ActivationCode
code Maybe Locale
mLocale
  SendEmailAddressUpdateMail EmailAddress
email Name
name ActivationKey
key ActivationCode
code Maybe Locale
mLocale -> Localised UserTemplates
-> TemplateBranding
-> EmailAddress
-> Name
-> ActivationKey
-> ActivationCode
-> Maybe Locale
-> Sem r ()
forall (r :: EffectRow).
Member EmailSending r =>
Localised UserTemplates
-> TemplateBranding
-> EmailAddress
-> Name
-> ActivationKey
-> ActivationCode
-> Maybe Locale
-> Sem r ()
sendEmailAddressUpdateMailImpl Localised UserTemplates
userTpls TemplateBranding
branding EmailAddress
email Name
name ActivationKey
key ActivationCode
code Maybe Locale
mLocale
  SendTeamActivationMail EmailAddress
email Name
name ActivationKey
key ActivationCode
code Maybe Locale
mLocale Text
teamName -> Localised UserTemplates
-> TemplateBranding
-> EmailAddress
-> Name
-> ActivationKey
-> ActivationCode
-> Maybe Locale
-> Text
-> Sem r ()
forall (r :: EffectRow).
Member EmailSending r =>
Localised UserTemplates
-> TemplateBranding
-> EmailAddress
-> Name
-> ActivationKey
-> ActivationCode
-> Maybe Locale
-> Text
-> Sem r ()
sendTeamActivationMailImpl Localised UserTemplates
userTpls TemplateBranding
branding EmailAddress
email Name
name ActivationKey
key ActivationCode
code Maybe Locale
mLocale Text
teamName
  SendNewClientEmail EmailAddress
email Name
name Client
client Locale
locale -> Localised UserTemplates
-> TemplateBranding
-> EmailAddress
-> Name
-> Client
-> Locale
-> Sem r ()
forall (r :: EffectRow).
Member EmailSending r =>
Localised UserTemplates
-> TemplateBranding
-> EmailAddress
-> Name
-> Client
-> Locale
-> Sem r ()
sendNewClientEmailImpl Localised UserTemplates
userTpls TemplateBranding
branding EmailAddress
email Name
name Client
client Locale
locale
  SendAccountDeletionEmail EmailAddress
email Name
name Key
key Value
code Locale
locale -> Localised UserTemplates
-> TemplateBranding
-> EmailAddress
-> Name
-> Key
-> Value
-> Locale
-> Sem r ()
forall (r :: EffectRow).
Member EmailSending r =>
Localised UserTemplates
-> TemplateBranding
-> EmailAddress
-> Name
-> Key
-> Value
-> Locale
-> Sem r ()
sendAccountDeletionEmailImpl Localised UserTemplates
userTpls TemplateBranding
branding EmailAddress
email Name
name Key
key Value
code Locale
locale
  SendUpgradePersonalToTeamConfirmationEmail EmailAddress
email Name
name Text
teamName Locale
locale -> Localised UserTemplates
-> TemplateBranding
-> EmailAddress
-> Name
-> Text
-> Locale
-> Sem r ()
forall (r :: EffectRow).
Member EmailSending r =>
Localised UserTemplates
-> TemplateBranding
-> EmailAddress
-> Name
-> Text
-> Locale
-> Sem r ()
sendUpgradePersonalToTeamConfirmationEmailImpl Localised UserTemplates
userTpls TemplateBranding
branding EmailAddress
email Name
name Text
teamName Locale
locale
  SendTeamInvitationMail EmailAddress
email TeamId
tid EmailAddress
from InvitationCode
code Maybe Locale
loc -> Localised TeamTemplates
-> TemplateBranding
-> EmailAddress
-> TeamId
-> EmailAddress
-> InvitationCode
-> Maybe Locale
-> Sem r Text
forall (r :: EffectRow).
Member EmailSending r =>
Localised TeamTemplates
-> TemplateBranding
-> EmailAddress
-> TeamId
-> EmailAddress
-> InvitationCode
-> Maybe Locale
-> Sem r Text
sendTeamInvitationMailImpl Localised TeamTemplates
teamTpls TemplateBranding
branding EmailAddress
email TeamId
tid EmailAddress
from InvitationCode
code Maybe Locale
loc
  SendTeamInvitationMailPersonalUser EmailAddress
email TeamId
tid EmailAddress
from InvitationCode
code Maybe Locale
loc -> Localised TeamTemplates
-> TemplateBranding
-> EmailAddress
-> TeamId
-> EmailAddress
-> InvitationCode
-> Maybe Locale
-> Sem r Text
forall (r :: EffectRow).
Member EmailSending r =>
Localised TeamTemplates
-> TemplateBranding
-> EmailAddress
-> TeamId
-> EmailAddress
-> InvitationCode
-> Maybe Locale
-> Sem r Text
sendTeamInvitationMailPersonalUserImpl Localised TeamTemplates
teamTpls TemplateBranding
branding EmailAddress
email TeamId
tid EmailAddress
from InvitationCode
code Maybe Locale
loc

-------------------------------------------------------------------------------
-- Verification Email for
-- - Login
-- - Creation of ScimToken
-- - Team Deletion

sendTeamDeletionVerificationMailImpl ::
  (Member EmailSending r) =>
  Localised UserTemplates ->
  TemplateBranding ->
  EmailAddress ->
  Code.Value ->
  Maybe Locale ->
  Sem r ()
sendTeamDeletionVerificationMailImpl :: forall (r :: EffectRow).
Member EmailSending r =>
Localised UserTemplates
-> TemplateBranding
-> EmailAddress
-> Value
-> Maybe Locale
-> Sem r ()
sendTeamDeletionVerificationMailImpl Localised UserTemplates
userTemplates TemplateBranding
branding EmailAddress
email Value
code Maybe Locale
mLocale = do
  let tpl :: SecondFactorVerificationEmailTemplate
tpl = UserTemplates -> SecondFactorVerificationEmailTemplate
verificationTeamDeletionEmail (UserTemplates -> SecondFactorVerificationEmailTemplate)
-> ((Locale, UserTemplates) -> UserTemplates)
-> (Locale, UserTemplates)
-> SecondFactorVerificationEmailTemplate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Locale, UserTemplates) -> UserTemplates
forall a b. (a, b) -> b
snd ((Locale, UserTemplates) -> SecondFactorVerificationEmailTemplate)
-> (Locale, UserTemplates) -> SecondFactorVerificationEmailTemplate
forall a b. (a -> b) -> a -> b
$ Maybe Locale -> Localised UserTemplates -> (Locale, UserTemplates)
forall a. Maybe Locale -> Localised a -> (Locale, a)
forLocale Maybe Locale
mLocale Localised UserTemplates
userTemplates
  Mail -> Sem r ()
forall (r :: EffectRow). Member EmailSending r => Mail -> Sem r ()
sendMail (Mail -> Sem r ()) -> Mail -> Sem r ()
forall a b. (a -> b) -> a -> b
$ EmailAddress
-> Value
-> SecondFactorVerificationEmailTemplate
-> TemplateBranding
-> Mail
renderSecondFactorVerificationEmail EmailAddress
email Value
code SecondFactorVerificationEmailTemplate
tpl TemplateBranding
branding

sendCreateScimTokenVerificationMailImpl ::
  (Member EmailSending r) =>
  Localised UserTemplates ->
  TemplateBranding ->
  EmailAddress ->
  Code.Value ->
  Maybe Locale ->
  Sem r ()
sendCreateScimTokenVerificationMailImpl :: forall (r :: EffectRow).
Member EmailSending r =>
Localised UserTemplates
-> TemplateBranding
-> EmailAddress
-> Value
-> Maybe Locale
-> Sem r ()
sendCreateScimTokenVerificationMailImpl Localised UserTemplates
userTemplates TemplateBranding
branding EmailAddress
email Value
code Maybe Locale
mLocale = do
  let tpl :: SecondFactorVerificationEmailTemplate
tpl = UserTemplates -> SecondFactorVerificationEmailTemplate
verificationScimTokenEmail (UserTemplates -> SecondFactorVerificationEmailTemplate)
-> ((Locale, UserTemplates) -> UserTemplates)
-> (Locale, UserTemplates)
-> SecondFactorVerificationEmailTemplate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Locale, UserTemplates) -> UserTemplates
forall a b. (a, b) -> b
snd ((Locale, UserTemplates) -> SecondFactorVerificationEmailTemplate)
-> (Locale, UserTemplates) -> SecondFactorVerificationEmailTemplate
forall a b. (a -> b) -> a -> b
$ Maybe Locale -> Localised UserTemplates -> (Locale, UserTemplates)
forall a. Maybe Locale -> Localised a -> (Locale, a)
forLocale Maybe Locale
mLocale Localised UserTemplates
userTemplates
  Mail -> Sem r ()
forall (r :: EffectRow). Member EmailSending r => Mail -> Sem r ()
sendMail (Mail -> Sem r ()) -> Mail -> Sem r ()
forall a b. (a -> b) -> a -> b
$ EmailAddress
-> Value
-> SecondFactorVerificationEmailTemplate
-> TemplateBranding
-> Mail
renderSecondFactorVerificationEmail EmailAddress
email Value
code SecondFactorVerificationEmailTemplate
tpl TemplateBranding
branding

sendLoginVerificationMailImpl ::
  (Member EmailSending r) =>
  Localised UserTemplates ->
  TemplateBranding ->
  EmailAddress ->
  Code.Value ->
  Maybe Locale ->
  Sem r ()
sendLoginVerificationMailImpl :: forall (r :: EffectRow).
Member EmailSending r =>
Localised UserTemplates
-> TemplateBranding
-> EmailAddress
-> Value
-> Maybe Locale
-> Sem r ()
sendLoginVerificationMailImpl Localised UserTemplates
userTemplates TemplateBranding
branding EmailAddress
email Value
code Maybe Locale
mLocale = do
  let tpl :: SecondFactorVerificationEmailTemplate
tpl = UserTemplates -> SecondFactorVerificationEmailTemplate
verificationLoginEmail (UserTemplates -> SecondFactorVerificationEmailTemplate)
-> ((Locale, UserTemplates) -> UserTemplates)
-> (Locale, UserTemplates)
-> SecondFactorVerificationEmailTemplate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Locale, UserTemplates) -> UserTemplates
forall a b. (a, b) -> b
snd ((Locale, UserTemplates) -> SecondFactorVerificationEmailTemplate)
-> (Locale, UserTemplates) -> SecondFactorVerificationEmailTemplate
forall a b. (a -> b) -> a -> b
$ Maybe Locale -> Localised UserTemplates -> (Locale, UserTemplates)
forall a. Maybe Locale -> Localised a -> (Locale, a)
forLocale Maybe Locale
mLocale Localised UserTemplates
userTemplates
  Mail -> Sem r ()
forall (r :: EffectRow). Member EmailSending r => Mail -> Sem r ()
sendMail (Mail -> Sem r ()) -> Mail -> Sem r ()
forall a b. (a -> b) -> a -> b
$ EmailAddress
-> Value
-> SecondFactorVerificationEmailTemplate
-> TemplateBranding
-> Mail
renderSecondFactorVerificationEmail EmailAddress
email Value
code SecondFactorVerificationEmailTemplate
tpl TemplateBranding
branding

renderSecondFactorVerificationEmail ::
  EmailAddress ->
  Code.Value ->
  SecondFactorVerificationEmailTemplate ->
  TemplateBranding ->
  Mail
renderSecondFactorVerificationEmail :: EmailAddress
-> Value
-> SecondFactorVerificationEmailTemplate
-> TemplateBranding
-> Mail
renderSecondFactorVerificationEmail EmailAddress
email Value
codeValue SecondFactorVerificationEmailTemplate {Text
EmailAddress
Template
sndFactorVerificationEmailSubject :: Template
sndFactorVerificationEmailBodyText :: Template
sndFactorVerificationEmailBodyHtml :: Template
sndFactorVerificationEmailSender :: EmailAddress
sndFactorVerificationEmailSenderName :: Text
$sel:sndFactorVerificationEmailSubject:SecondFactorVerificationEmailTemplate :: SecondFactorVerificationEmailTemplate -> Template
$sel:sndFactorVerificationEmailBodyText:SecondFactorVerificationEmailTemplate :: SecondFactorVerificationEmailTemplate -> Template
$sel:sndFactorVerificationEmailBodyHtml:SecondFactorVerificationEmailTemplate :: SecondFactorVerificationEmailTemplate -> Template
$sel:sndFactorVerificationEmailSender:SecondFactorVerificationEmailTemplate :: SecondFactorVerificationEmailTemplate -> EmailAddress
$sel:sndFactorVerificationEmailSenderName:SecondFactorVerificationEmailTemplate :: SecondFactorVerificationEmailTemplate -> Text
..} TemplateBranding
branding =
  (Address -> Mail
emptyMail Address
from)
    { mailTo = [to],
      mailHeaders =
        [ ("Subject", toStrict subj),
          ("X-Zeta-Purpose", "SecondFactorVerification"),
          ("X-Zeta-Code", code)
        ],
      mailParts = [[plainPart txt, htmlPart html]]
    }
  where
    from :: Address
from = Maybe Text -> Text -> Address
Address (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
sndFactorVerificationEmailSenderName) (EmailAddress -> Text
fromEmail EmailAddress
sndFactorVerificationEmailSender)
    to :: Address
to = Maybe Text -> Text -> Address
Address Maybe Text
forall a. Maybe a
Nothing (EmailAddress -> Text
fromEmail EmailAddress
email)
    txt :: Text
txt = Template -> TemplateBranding -> TemplateBranding -> Text
renderTextWithBranding Template
sndFactorVerificationEmailBodyText TemplateBranding
replace TemplateBranding
branding
    html :: Text
html = Template -> TemplateBranding -> TemplateBranding -> Text
renderHtmlWithBranding Template
sndFactorVerificationEmailBodyHtml TemplateBranding
replace TemplateBranding
branding
    subj :: Text
subj = Template -> TemplateBranding -> TemplateBranding -> Text
renderTextWithBranding Template
sndFactorVerificationEmailSubject TemplateBranding
replace TemplateBranding
branding
    code :: Text
code = AsciiText Base64Url -> Text
forall {k} (c :: k). AsciiText c -> Text
Ascii.toText (Range 6 20 (AsciiText Base64Url) -> AsciiText Base64Url
forall (n :: Nat) (m :: Nat) a. Range n m a -> a
fromRange Value
codeValue.asciiValue)
    replace :: Text -> Text
    replace :: TemplateBranding
replace Text
"email" = EmailAddress -> Text
fromEmail EmailAddress
email
    replace Text
"code" = Text
code
    replace Text
x = Text
x

-------------------------------------------------------------------------------
-- Activation Email

sendActivationMailImpl ::
  (Member EmailSending r) =>
  Localised UserTemplates ->
  TemplateBranding ->
  EmailAddress ->
  Name ->
  ActivationKey ->
  ActivationCode ->
  Maybe Locale ->
  Sem r ()
sendActivationMailImpl :: forall (r :: EffectRow).
Member EmailSending r =>
Localised UserTemplates
-> TemplateBranding
-> EmailAddress
-> Name
-> ActivationKey
-> ActivationCode
-> Maybe Locale
-> Sem r ()
sendActivationMailImpl Localised UserTemplates
userTemplates TemplateBranding
branding EmailAddress
email Name
name ActivationKey
akey ActivationCode
acode Maybe Locale
mLocale = do
  let tpl :: ActivationEmailTemplate
tpl = UserTemplates -> ActivationEmailTemplate
activationEmail (UserTemplates -> ActivationEmailTemplate)
-> ((Locale, UserTemplates) -> UserTemplates)
-> (Locale, UserTemplates)
-> ActivationEmailTemplate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Locale, UserTemplates) -> UserTemplates
forall a b. (a, b) -> b
snd ((Locale, UserTemplates) -> ActivationEmailTemplate)
-> (Locale, UserTemplates) -> ActivationEmailTemplate
forall a b. (a -> b) -> a -> b
$ Maybe Locale -> Localised UserTemplates -> (Locale, UserTemplates)
forall a. Maybe Locale -> Localised a -> (Locale, a)
forLocale Maybe Locale
mLocale Localised UserTemplates
userTemplates
  Mail -> Sem r ()
forall (r :: EffectRow). Member EmailSending r => Mail -> Sem r ()
sendMail (Mail -> Sem r ()) -> Mail -> Sem r ()
forall a b. (a -> b) -> a -> b
$ EmailAddress
-> Name
-> ActivationKey
-> ActivationCode
-> ActivationEmailTemplate
-> TemplateBranding
-> Mail
renderActivationMail EmailAddress
email Name
name ActivationKey
akey ActivationCode
acode ActivationEmailTemplate
tpl TemplateBranding
branding

sendEmailAddressUpdateMailImpl ::
  (Member EmailSending r) =>
  Localised UserTemplates ->
  TemplateBranding ->
  EmailAddress ->
  Name ->
  ActivationKey ->
  ActivationCode ->
  Maybe Locale ->
  Sem r ()
sendEmailAddressUpdateMailImpl :: forall (r :: EffectRow).
Member EmailSending r =>
Localised UserTemplates
-> TemplateBranding
-> EmailAddress
-> Name
-> ActivationKey
-> ActivationCode
-> Maybe Locale
-> Sem r ()
sendEmailAddressUpdateMailImpl Localised UserTemplates
userTemplates TemplateBranding
branding EmailAddress
email Name
name ActivationKey
akey ActivationCode
acode Maybe Locale
mLocale = do
  let tpl :: ActivationEmailTemplate
tpl = UserTemplates -> ActivationEmailTemplate
activationEmailUpdate (UserTemplates -> ActivationEmailTemplate)
-> ((Locale, UserTemplates) -> UserTemplates)
-> (Locale, UserTemplates)
-> ActivationEmailTemplate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Locale, UserTemplates) -> UserTemplates
forall a b. (a, b) -> b
snd ((Locale, UserTemplates) -> ActivationEmailTemplate)
-> (Locale, UserTemplates) -> ActivationEmailTemplate
forall a b. (a -> b) -> a -> b
$ Maybe Locale -> Localised UserTemplates -> (Locale, UserTemplates)
forall a. Maybe Locale -> Localised a -> (Locale, a)
forLocale Maybe Locale
mLocale Localised UserTemplates
userTemplates
  Mail -> Sem r ()
forall (r :: EffectRow). Member EmailSending r => Mail -> Sem r ()
sendMail (Mail -> Sem r ()) -> Mail -> Sem r ()
forall a b. (a -> b) -> a -> b
$ EmailAddress
-> Name
-> ActivationKey
-> ActivationCode
-> ActivationEmailTemplate
-> TemplateBranding
-> Mail
renderActivationMail EmailAddress
email Name
name ActivationKey
akey ActivationCode
acode ActivationEmailTemplate
tpl TemplateBranding
branding

renderActivationMail :: EmailAddress -> Name -> ActivationKey -> ActivationCode -> ActivationEmailTemplate -> TemplateBranding -> Mail
renderActivationMail :: EmailAddress
-> Name
-> ActivationKey
-> ActivationCode
-> ActivationEmailTemplate
-> TemplateBranding
-> Mail
renderActivationMail EmailAddress
email Name
name akey :: ActivationKey
akey@(ActivationKey AsciiText Base64Url
key) acode :: ActivationCode
acode@(ActivationCode AsciiText Base64Url
code) ActivationEmailTemplate {Text
EmailAddress
Template
activationEmailUrl :: Template
activationEmailSubject :: Template
activationEmailBodyText :: Template
activationEmailBodyHtml :: Template
activationEmailSender :: EmailAddress
activationEmailSenderName :: Text
$sel:activationEmailUrl:ActivationEmailTemplate :: ActivationEmailTemplate -> Template
$sel:activationEmailSubject:ActivationEmailTemplate :: ActivationEmailTemplate -> Template
$sel:activationEmailBodyText:ActivationEmailTemplate :: ActivationEmailTemplate -> Template
$sel:activationEmailBodyHtml:ActivationEmailTemplate :: ActivationEmailTemplate -> Template
$sel:activationEmailSender:ActivationEmailTemplate :: ActivationEmailTemplate -> EmailAddress
$sel:activationEmailSenderName:ActivationEmailTemplate :: ActivationEmailTemplate -> Text
..} TemplateBranding
branding =
  (Address -> Mail
emptyMail Address
from)
    { mailTo = [to],
      -- To make automated processing possible, the activation code is also added to
      -- headers. {#RefActivationEmailHeaders}
      mailHeaders =
        [ ("Subject", toStrict subj),
          ("X-Zeta-Purpose", "Activation"),
          ("X-Zeta-Key", Ascii.toText key),
          ("X-Zeta-Code", Ascii.toText code)
        ],
      mailParts = [[plainPart txt, htmlPart html]]
    }
  where
    from, to :: Address
    from :: Address
from = Maybe Text -> Text -> Address
Address (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
activationEmailSenderName) (EmailAddress -> Text
fromEmail EmailAddress
activationEmailSender)
    to :: Address
to = Name -> EmailAddress -> Address
mkMimeAddress Name
name EmailAddress
email

    txt, html, subj :: LText
    txt :: Text
txt = Template -> TemplateBranding -> TemplateBranding -> Text
renderTextWithBranding Template
activationEmailBodyText TemplateBranding
replace TemplateBranding
branding
    html :: Text
html = Template -> TemplateBranding -> TemplateBranding -> Text
renderHtmlWithBranding Template
activationEmailBodyHtml TemplateBranding
replace TemplateBranding
branding
    subj :: Text
subj = Template -> TemplateBranding -> TemplateBranding -> Text
renderTextWithBranding Template
activationEmailSubject TemplateBranding
replace TemplateBranding
branding

    replace :: Text -> Text
    replace :: TemplateBranding
replace Text
"url" = Template
-> ActivationKey -> ActivationCode -> TemplateBranding -> Text
renderActivationUrl Template
activationEmailUrl ActivationKey
akey ActivationCode
acode TemplateBranding
branding
    replace Text
"email" = EmailAddress -> Text
fromEmail EmailAddress
email
    replace Text
"name" = Name -> Text
fromName Name
name
    replace Text
x = Text
x

renderActivationUrl :: Template -> ActivationKey -> ActivationCode -> TemplateBranding -> Text
renderActivationUrl :: Template
-> ActivationKey -> ActivationCode -> TemplateBranding -> Text
renderActivationUrl Template
t (ActivationKey AsciiText Base64Url
k) (ActivationCode AsciiText Base64Url
c) TemplateBranding
branding =
  Text -> Text
toStrict (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Template -> TemplateBranding -> TemplateBranding -> Text
renderTextWithBranding Template
t TemplateBranding
replace TemplateBranding
branding
  where
    replace :: Text -> Text
    replace :: TemplateBranding
replace Text
"key" = AsciiText Base64Url -> Text
forall {k} (c :: k). AsciiText c -> Text
Ascii.toText AsciiText Base64Url
k
    replace Text
"code" = AsciiText Base64Url -> Text
forall {k} (c :: k). AsciiText c -> Text
Ascii.toText AsciiText Base64Url
c
    replace Text
x = Text
x

-------------------------------------------------------------------------------
-- Team Activation Email

sendTeamActivationMailImpl ::
  (Member EmailSending r) =>
  Localised UserTemplates ->
  TemplateBranding ->
  EmailAddress ->
  Name ->
  ActivationKey ->
  ActivationCode ->
  Maybe Locale ->
  Text ->
  Sem r ()
sendTeamActivationMailImpl :: forall (r :: EffectRow).
Member EmailSending r =>
Localised UserTemplates
-> TemplateBranding
-> EmailAddress
-> Name
-> ActivationKey
-> ActivationCode
-> Maybe Locale
-> Text
-> Sem r ()
sendTeamActivationMailImpl Localised UserTemplates
userTemplates TemplateBranding
branding EmailAddress
email Name
name ActivationKey
akey ActivationCode
acode Maybe Locale
mLocale Text
teamName = do
  let tpl :: TeamActivationEmailTemplate
tpl = UserTemplates -> TeamActivationEmailTemplate
teamActivationEmail (UserTemplates -> TeamActivationEmailTemplate)
-> ((Locale, UserTemplates) -> UserTemplates)
-> (Locale, UserTemplates)
-> TeamActivationEmailTemplate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Locale, UserTemplates) -> UserTemplates
forall a b. (a, b) -> b
snd ((Locale, UserTemplates) -> TeamActivationEmailTemplate)
-> (Locale, UserTemplates) -> TeamActivationEmailTemplate
forall a b. (a -> b) -> a -> b
$ Maybe Locale -> Localised UserTemplates -> (Locale, UserTemplates)
forall a. Maybe Locale -> Localised a -> (Locale, a)
forLocale Maybe Locale
mLocale Localised UserTemplates
userTemplates
  Mail -> Sem r ()
forall (r :: EffectRow). Member EmailSending r => Mail -> Sem r ()
sendMail (Mail -> Sem r ()) -> Mail -> Sem r ()
forall a b. (a -> b) -> a -> b
$ EmailAddress
-> Name
-> Text
-> ActivationKey
-> ActivationCode
-> TeamActivationEmailTemplate
-> TemplateBranding
-> Mail
renderTeamActivationMail EmailAddress
email Name
name Text
teamName ActivationKey
akey ActivationCode
acode TeamActivationEmailTemplate
tpl TemplateBranding
branding

renderTeamActivationMail :: EmailAddress -> Name -> Text -> ActivationKey -> ActivationCode -> TeamActivationEmailTemplate -> TemplateBranding -> Mail
renderTeamActivationMail :: EmailAddress
-> Name
-> Text
-> ActivationKey
-> ActivationCode
-> TeamActivationEmailTemplate
-> TemplateBranding
-> Mail
renderTeamActivationMail EmailAddress
email Name
name Text
teamName akey :: ActivationKey
akey@(ActivationKey AsciiText Base64Url
key) acode :: ActivationCode
acode@(ActivationCode AsciiText Base64Url
code) TeamActivationEmailTemplate {Text
EmailAddress
Template
teamActivationEmailUrl :: Template
teamActivationEmailSubject :: Template
teamActivationEmailBodyText :: Template
teamActivationEmailBodyHtml :: Template
teamActivationEmailSender :: EmailAddress
teamActivationEmailSenderName :: Text
$sel:teamActivationEmailUrl:TeamActivationEmailTemplate :: TeamActivationEmailTemplate -> Template
$sel:teamActivationEmailSubject:TeamActivationEmailTemplate :: TeamActivationEmailTemplate -> Template
$sel:teamActivationEmailBodyText:TeamActivationEmailTemplate :: TeamActivationEmailTemplate -> Template
$sel:teamActivationEmailBodyHtml:TeamActivationEmailTemplate :: TeamActivationEmailTemplate -> Template
$sel:teamActivationEmailSender:TeamActivationEmailTemplate :: TeamActivationEmailTemplate -> EmailAddress
$sel:teamActivationEmailSenderName:TeamActivationEmailTemplate :: TeamActivationEmailTemplate -> Text
..} TemplateBranding
branding =
  (Address -> Mail
emptyMail Address
from)
    { mailTo = [to],
      mailHeaders =
        [ ("Subject", toStrict subj),
          ("X-Zeta-Purpose", "Activation"),
          ("X-Zeta-Key", Ascii.toText key),
          ("X-Zeta-Code", Ascii.toText code)
        ],
      mailParts = [[plainPart txt, htmlPart html]]
    }
  where
    from, to :: Address
    from :: Address
from = Maybe Text -> Text -> Address
Address (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
teamActivationEmailSenderName) (EmailAddress -> Text
fromEmail EmailAddress
teamActivationEmailSender)
    to :: Address
to = Name -> EmailAddress -> Address
mkMimeAddress Name
name EmailAddress
email
    txt, html, subj :: LText
    txt :: Text
txt = Template -> TemplateBranding -> TemplateBranding -> Text
renderTextWithBranding Template
teamActivationEmailBodyText TemplateBranding
replace TemplateBranding
branding
    html :: Text
html = Template -> TemplateBranding -> TemplateBranding -> Text
renderHtmlWithBranding Template
teamActivationEmailBodyHtml TemplateBranding
replace TemplateBranding
branding
    subj :: Text
subj = Template -> TemplateBranding -> TemplateBranding -> Text
renderTextWithBranding Template
teamActivationEmailSubject TemplateBranding
replace TemplateBranding
branding
    replace :: Text -> Text
    replace :: TemplateBranding
replace Text
"url" = Template
-> ActivationKey -> ActivationCode -> TemplateBranding -> Text
renderActivationUrl Template
teamActivationEmailUrl ActivationKey
akey ActivationCode
acode TemplateBranding
branding
    replace Text
"email" = EmailAddress -> Text
fromEmail EmailAddress
email
    replace Text
"name" = Name -> Text
fromName Name
name
    replace Text
"team" = Text
teamName
    replace Text
x = Text
x

-------------------------------------------------------------------------------
-- Verification Email

sendVerificationMailImpl ::
  (Member EmailSending r) =>
  Localised UserTemplates ->
  TemplateBranding ->
  EmailAddress ->
  ActivationKey ->
  ActivationCode ->
  Maybe Locale ->
  Sem r ()
sendVerificationMailImpl :: forall (r :: EffectRow).
Member EmailSending r =>
Localised UserTemplates
-> TemplateBranding
-> EmailAddress
-> ActivationKey
-> ActivationCode
-> Maybe Locale
-> Sem r ()
sendVerificationMailImpl Localised UserTemplates
userTemplates TemplateBranding
branding EmailAddress
email ActivationKey
akey ActivationCode
acode Maybe Locale
mLocale = do
  let tpl :: VerificationEmailTemplate
tpl = UserTemplates -> VerificationEmailTemplate
verificationEmail (UserTemplates -> VerificationEmailTemplate)
-> ((Locale, UserTemplates) -> UserTemplates)
-> (Locale, UserTemplates)
-> VerificationEmailTemplate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Locale, UserTemplates) -> UserTemplates
forall a b. (a, b) -> b
snd ((Locale, UserTemplates) -> VerificationEmailTemplate)
-> (Locale, UserTemplates) -> VerificationEmailTemplate
forall a b. (a -> b) -> a -> b
$ Maybe Locale -> Localised UserTemplates -> (Locale, UserTemplates)
forall a. Maybe Locale -> Localised a -> (Locale, a)
forLocale Maybe Locale
mLocale Localised UserTemplates
userTemplates
  Mail -> Sem r ()
forall (r :: EffectRow). Member EmailSending r => Mail -> Sem r ()
sendMail (Mail -> Sem r ()) -> Mail -> Sem r ()
forall a b. (a -> b) -> a -> b
$ EmailAddress
-> ActivationKey
-> ActivationCode
-> VerificationEmailTemplate
-> TemplateBranding
-> Mail
renderVerificationMail EmailAddress
email ActivationKey
akey ActivationCode
acode VerificationEmailTemplate
tpl TemplateBranding
branding

renderVerificationMail :: EmailAddress -> ActivationKey -> ActivationCode -> VerificationEmailTemplate -> TemplateBranding -> Mail
renderVerificationMail :: EmailAddress
-> ActivationKey
-> ActivationCode
-> VerificationEmailTemplate
-> TemplateBranding
-> Mail
renderVerificationMail EmailAddress
email ActivationKey
akey ActivationCode
acode VerificationEmailTemplate {Text
EmailAddress
Template
verificationEmailUrl :: Template
verificationEmailSubject :: Template
verificationEmailBodyText :: Template
verificationEmailBodyHtml :: Template
verificationEmailSender :: EmailAddress
verificationEmailSenderName :: Text
$sel:verificationEmailUrl:VerificationEmailTemplate :: VerificationEmailTemplate -> Template
$sel:verificationEmailSubject:VerificationEmailTemplate :: VerificationEmailTemplate -> Template
$sel:verificationEmailBodyText:VerificationEmailTemplate :: VerificationEmailTemplate -> Template
$sel:verificationEmailBodyHtml:VerificationEmailTemplate :: VerificationEmailTemplate -> Template
$sel:verificationEmailSender:VerificationEmailTemplate :: VerificationEmailTemplate -> EmailAddress
$sel:verificationEmailSenderName:VerificationEmailTemplate :: VerificationEmailTemplate -> Text
..} TemplateBranding
branding =
  (Address -> Mail
emptyMail Address
from)
    { mailTo = [to],
      -- To make automated processing possible, the activation code is also added to
      -- headers. {#RefActivationEmailHeaders}
      mailHeaders =
        [ ("Subject", toStrict subj),
          ("X-Zeta-Purpose", "Verification"),
          ("X-Zeta-Code", Ascii.toText code)
        ],
      mailParts = [[plainPart txt, htmlPart html]]
    }
  where
    (ActivationKey AsciiText Base64Url
_, ActivationCode AsciiText Base64Url
code) = (ActivationKey
akey, ActivationCode
acode)
    from :: Address
from = Maybe Text -> Text -> Address
Address (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
verificationEmailSenderName) (EmailAddress -> Text
fromEmail EmailAddress
verificationEmailSender)
    to :: Address
to = Maybe Text -> Text -> Address
Address Maybe Text
forall a. Maybe a
Nothing (EmailAddress -> Text
fromEmail EmailAddress
email)
    txt :: Text
txt = Template -> TemplateBranding -> TemplateBranding -> Text
renderTextWithBranding Template
verificationEmailBodyText TemplateBranding
replace TemplateBranding
branding
    html :: Text
html = Template -> TemplateBranding -> TemplateBranding -> Text
renderHtmlWithBranding Template
verificationEmailBodyHtml TemplateBranding
replace TemplateBranding
branding
    subj :: Text
subj = Template -> TemplateBranding -> TemplateBranding -> Text
renderTextWithBranding Template
verificationEmailSubject TemplateBranding
replace TemplateBranding
branding
    replace :: TemplateBranding
replace Text
"code" = AsciiText Base64Url -> Text
forall {k} (c :: k). AsciiText c -> Text
Ascii.toText AsciiText Base64Url
code
    replace Text
"email" = EmailAddress -> Text
fromEmail EmailAddress
email
    replace Text
x = Text
x

-------------------------------------------------------------------------------
-- Password Reset Email

sendPasswordResetMailImpl ::
  (Member EmailSending r) =>
  Localised UserTemplates ->
  TemplateBranding ->
  EmailAddress ->
  PasswordResetKey ->
  PasswordResetCode ->
  Maybe Locale ->
  Sem r ()
sendPasswordResetMailImpl :: forall (r :: EffectRow).
Member EmailSending r =>
Localised UserTemplates
-> TemplateBranding
-> EmailAddress
-> PasswordResetKey
-> PasswordResetCode
-> Maybe Locale
-> Sem r ()
sendPasswordResetMailImpl Localised UserTemplates
userTemplates TemplateBranding
branding EmailAddress
email PasswordResetKey
pkey PasswordResetCode
pcode Maybe Locale
mLocale = do
  let tpl :: PasswordResetEmailTemplate
tpl = UserTemplates -> PasswordResetEmailTemplate
passwordResetEmail (UserTemplates -> PasswordResetEmailTemplate)
-> ((Locale, UserTemplates) -> UserTemplates)
-> (Locale, UserTemplates)
-> PasswordResetEmailTemplate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Locale, UserTemplates) -> UserTemplates
forall a b. (a, b) -> b
snd ((Locale, UserTemplates) -> PasswordResetEmailTemplate)
-> (Locale, UserTemplates) -> PasswordResetEmailTemplate
forall a b. (a -> b) -> a -> b
$ Maybe Locale -> Localised UserTemplates -> (Locale, UserTemplates)
forall a. Maybe Locale -> Localised a -> (Locale, a)
forLocale Maybe Locale
mLocale Localised UserTemplates
userTemplates
  Mail -> Sem r ()
forall (r :: EffectRow). Member EmailSending r => Mail -> Sem r ()
sendMail (Mail -> Sem r ()) -> Mail -> Sem r ()
forall a b. (a -> b) -> a -> b
$ EmailAddress
-> PasswordResetKey
-> PasswordResetCode
-> PasswordResetEmailTemplate
-> TemplateBranding
-> Mail
renderPwResetMail EmailAddress
email PasswordResetKey
pkey PasswordResetCode
pcode PasswordResetEmailTemplate
tpl TemplateBranding
branding

renderPwResetMail :: EmailAddress -> PasswordResetKey -> PasswordResetCode -> PasswordResetEmailTemplate -> TemplateBranding -> Mail
renderPwResetMail :: EmailAddress
-> PasswordResetKey
-> PasswordResetCode
-> PasswordResetEmailTemplate
-> TemplateBranding
-> Mail
renderPwResetMail EmailAddress
email PasswordResetKey
pkey PasswordResetCode
pcode PasswordResetEmailTemplate {Text
EmailAddress
Template
passwordResetEmailUrl :: Template
passwordResetEmailSubject :: Template
passwordResetEmailBodyText :: Template
passwordResetEmailBodyHtml :: Template
passwordResetEmailSender :: EmailAddress
passwordResetEmailSenderName :: Text
$sel:passwordResetEmailUrl:PasswordResetEmailTemplate :: PasswordResetEmailTemplate -> Template
$sel:passwordResetEmailSubject:PasswordResetEmailTemplate :: PasswordResetEmailTemplate -> Template
$sel:passwordResetEmailBodyText:PasswordResetEmailTemplate :: PasswordResetEmailTemplate -> Template
$sel:passwordResetEmailBodyHtml:PasswordResetEmailTemplate :: PasswordResetEmailTemplate -> Template
$sel:passwordResetEmailSender:PasswordResetEmailTemplate :: PasswordResetEmailTemplate -> EmailAddress
$sel:passwordResetEmailSenderName:PasswordResetEmailTemplate :: PasswordResetEmailTemplate -> Text
..} TemplateBranding
branding =
  (Address -> Mail
emptyMail Address
from)
    { mailTo = [to],
      mailHeaders =
        [ ("Subject", toStrict subj),
          ("X-Zeta-Purpose", "PasswordReset"),
          ("X-Zeta-Key", Ascii.toText key),
          ("X-Zeta-Code", Ascii.toText code)
        ],
      mailParts = [[plainPart txt, htmlPart html]]
    }
  where
    (PasswordResetKey AsciiText Base64Url
key, PasswordResetCode AsciiText Base64Url
code) = (PasswordResetKey
pkey, PasswordResetCode
pcode)
    from :: Address
from = Maybe Text -> Text -> Address
Address (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
passwordResetEmailSenderName) (EmailAddress -> Text
fromEmail EmailAddress
passwordResetEmailSender)
    to :: Address
to = Maybe Text -> Text -> Address
Address Maybe Text
forall a. Maybe a
Nothing (EmailAddress -> Text
fromEmail EmailAddress
email)
    txt :: Text
txt = Template -> TemplateBranding -> TemplateBranding -> Text
renderTextWithBranding Template
passwordResetEmailBodyText TemplateBranding
replace TemplateBranding
branding
    html :: Text
html = Template -> TemplateBranding -> TemplateBranding -> Text
renderHtmlWithBranding Template
passwordResetEmailBodyHtml TemplateBranding
replace TemplateBranding
branding
    subj :: Text
subj = Template -> TemplateBranding -> TemplateBranding -> Text
renderTextWithBranding Template
passwordResetEmailSubject TemplateBranding
replace TemplateBranding
branding
    replace :: TemplateBranding
replace Text
"url" = Template
-> (PasswordResetKey, PasswordResetCode)
-> TemplateBranding
-> Text
renderPwResetUrl Template
passwordResetEmailUrl (PasswordResetKey
pkey, PasswordResetCode
pcode) TemplateBranding
branding
    replace Text
x = Text
x

renderPwResetUrl :: Template -> PasswordResetPair -> TemplateBranding -> Text
renderPwResetUrl :: Template
-> (PasswordResetKey, PasswordResetCode)
-> TemplateBranding
-> Text
renderPwResetUrl Template
t (PasswordResetKey AsciiText Base64Url
k, PasswordResetCode AsciiText Base64Url
c) TemplateBranding
branding =
  Text -> Text
toStrict (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Template -> TemplateBranding -> TemplateBranding -> Text
renderTextWithBranding Template
t TemplateBranding
replace TemplateBranding
branding
  where
    replace :: TemplateBranding
replace Text
"key" = AsciiText Base64Url -> Text
forall {k} (c :: k). AsciiText c -> Text
Ascii.toText AsciiText Base64Url
k
    replace Text
"code" = AsciiText Base64Url -> Text
forall {k} (c :: k). AsciiText c -> Text
Ascii.toText AsciiText Base64Url
c
    replace Text
x = Text
x

-------------------------------------------------------------------------------
-- New Client Email

sendNewClientEmailImpl ::
  (Member EmailSending r) =>
  Localised UserTemplates ->
  TemplateBranding ->
  EmailAddress ->
  Name ->
  Client ->
  Locale ->
  Sem r ()
sendNewClientEmailImpl :: forall (r :: EffectRow).
Member EmailSending r =>
Localised UserTemplates
-> TemplateBranding
-> EmailAddress
-> Name
-> Client
-> Locale
-> Sem r ()
sendNewClientEmailImpl Localised UserTemplates
userTemplates TemplateBranding
branding EmailAddress
email Name
name Client
client Locale
locale = do
  let tpl :: NewClientEmailTemplate
tpl = UserTemplates -> NewClientEmailTemplate
newClientEmail (UserTemplates -> NewClientEmailTemplate)
-> ((Locale, UserTemplates) -> UserTemplates)
-> (Locale, UserTemplates)
-> NewClientEmailTemplate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Locale, UserTemplates) -> UserTemplates
forall a b. (a, b) -> b
snd ((Locale, UserTemplates) -> NewClientEmailTemplate)
-> (Locale, UserTemplates) -> NewClientEmailTemplate
forall a b. (a -> b) -> a -> b
$ Maybe Locale -> Localised UserTemplates -> (Locale, UserTemplates)
forall a. Maybe Locale -> Localised a -> (Locale, a)
forLocale (Locale -> Maybe Locale
forall a. a -> Maybe a
Just Locale
locale) Localised UserTemplates
userTemplates
  Mail -> Sem r ()
forall (r :: EffectRow). Member EmailSending r => Mail -> Sem r ()
sendMail (Mail -> Sem r ()) -> Mail -> Sem r ()
forall a b. (a -> b) -> a -> b
$ EmailAddress
-> Name
-> Locale
-> Client
-> NewClientEmailTemplate
-> TemplateBranding
-> Mail
renderNewClientEmail EmailAddress
email Name
name Locale
locale Client
client NewClientEmailTemplate
tpl TemplateBranding
branding

renderNewClientEmail :: EmailAddress -> Name -> Locale -> Client -> NewClientEmailTemplate -> TemplateBranding -> Mail
renderNewClientEmail :: EmailAddress
-> Name
-> Locale
-> Client
-> NewClientEmailTemplate
-> TemplateBranding
-> Mail
renderNewClientEmail EmailAddress
email Name
name Locale
locale Client {Maybe Text
Maybe UTCTime
Maybe CookieLabel
Maybe ClientClass
MLSPublicKeys
ClientId
UTCTimeMillis
ClientType
ClientCapabilityList
clientId :: ClientId
clientType :: ClientType
clientTime :: UTCTimeMillis
clientClass :: Maybe ClientClass
clientLabel :: Maybe Text
clientCookie :: Maybe CookieLabel
clientModel :: Maybe Text
clientCapabilities :: ClientCapabilityList
clientMLSPublicKeys :: MLSPublicKeys
clientLastActive :: Maybe UTCTime
$sel:clientId:Client :: Client -> ClientId
$sel:clientType:Client :: Client -> ClientType
$sel:clientTime:Client :: Client -> UTCTimeMillis
$sel:clientClass:Client :: Client -> Maybe ClientClass
$sel:clientLabel:Client :: Client -> Maybe Text
$sel:clientCookie:Client :: Client -> Maybe CookieLabel
$sel:clientModel:Client :: Client -> Maybe Text
$sel:clientCapabilities:Client :: Client -> ClientCapabilityList
$sel:clientMLSPublicKeys:Client :: Client -> MLSPublicKeys
$sel:clientLastActive:Client :: Client -> Maybe UTCTime
..} NewClientEmailTemplate {Text
EmailAddress
Template
newClientEmailSubject :: Template
newClientEmailBodyText :: Template
newClientEmailBodyHtml :: Template
newClientEmailSender :: EmailAddress
newClientEmailSenderName :: Text
$sel:newClientEmailSubject:NewClientEmailTemplate :: NewClientEmailTemplate -> Template
$sel:newClientEmailBodyText:NewClientEmailTemplate :: NewClientEmailTemplate -> Template
$sel:newClientEmailBodyHtml:NewClientEmailTemplate :: NewClientEmailTemplate -> Template
$sel:newClientEmailSender:NewClientEmailTemplate :: NewClientEmailTemplate -> EmailAddress
$sel:newClientEmailSenderName:NewClientEmailTemplate :: NewClientEmailTemplate -> Text
..} TemplateBranding
branding =
  (Address -> Mail
emptyMail Address
from)
    { mailTo = [to],
      mailHeaders =
        [ ("Subject", toStrict subj),
          ("X-Zeta-Purpose", "NewDevice")
        ],
      mailParts = [[plainPart txt, htmlPart html]]
    }
  where
    from :: Address
from = Maybe Text -> Text -> Address
Address (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
newClientEmailSenderName) (EmailAddress -> Text
fromEmail EmailAddress
newClientEmailSender)
    to :: Address
to = Name -> EmailAddress -> Address
mkMimeAddress Name
name EmailAddress
email
    txt :: Text
txt = Template -> TemplateBranding -> TemplateBranding -> Text
renderTextWithBranding Template
newClientEmailBodyText TemplateBranding
replace TemplateBranding
branding
    html :: Text
html = Template -> TemplateBranding -> TemplateBranding -> Text
renderHtmlWithBranding Template
newClientEmailBodyHtml TemplateBranding
replace TemplateBranding
branding
    subj :: Text
subj = Template -> TemplateBranding -> TemplateBranding -> Text
renderTextWithBranding Template
newClientEmailSubject TemplateBranding
replace TemplateBranding
branding
    replace :: TemplateBranding
replace Text
"name" = Name -> Text
fromName Name
name
    replace Text
"label" = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
forall s. IsString s => s
defRequestId Maybe Text
clientLabel
    replace Text
"model" = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
forall s. IsString s => s
defRequestId Maybe Text
clientModel
    replace Text
"date" =
      String -> TimeLocale -> UTCTime -> Text
formatDateTime
        String
"%A %e %B %Y, %H:%M - %Z"
        (Locale -> TimeLocale
timeLocale Locale
locale)
        (UTCTimeMillis -> UTCTime
fromUTCTimeMillis UTCTimeMillis
clientTime)
    replace Text
x = Text
x

-------------------------------------------------------------------------------
-- Deletion Email

sendAccountDeletionEmailImpl ::
  (Member EmailSending r) =>
  Localised UserTemplates ->
  TemplateBranding ->
  EmailAddress ->
  Name ->
  Code.Key ->
  Code.Value ->
  Locale ->
  Sem r ()
sendAccountDeletionEmailImpl :: forall (r :: EffectRow).
Member EmailSending r =>
Localised UserTemplates
-> TemplateBranding
-> EmailAddress
-> Name
-> Key
-> Value
-> Locale
-> Sem r ()
sendAccountDeletionEmailImpl Localised UserTemplates
userTemplates TemplateBranding
branding EmailAddress
email Name
name Key
key Value
code Locale
locale = do
  let tpl :: DeletionEmailTemplate
tpl = UserTemplates -> DeletionEmailTemplate
deletionEmail (UserTemplates -> DeletionEmailTemplate)
-> ((Locale, UserTemplates) -> UserTemplates)
-> (Locale, UserTemplates)
-> DeletionEmailTemplate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Locale, UserTemplates) -> UserTemplates
forall a b. (a, b) -> b
snd ((Locale, UserTemplates) -> DeletionEmailTemplate)
-> (Locale, UserTemplates) -> DeletionEmailTemplate
forall a b. (a -> b) -> a -> b
$ Maybe Locale -> Localised UserTemplates -> (Locale, UserTemplates)
forall a. Maybe Locale -> Localised a -> (Locale, a)
forLocale (Locale -> Maybe Locale
forall a. a -> Maybe a
Just Locale
locale) Localised UserTemplates
userTemplates
  Mail -> Sem r ()
forall (r :: EffectRow). Member EmailSending r => Mail -> Sem r ()
sendMail (Mail -> Sem r ()) -> Mail -> Sem r ()
forall a b. (a -> b) -> a -> b
$ EmailAddress
-> Name
-> Key
-> Value
-> DeletionEmailTemplate
-> TemplateBranding
-> Mail
renderDeletionEmail EmailAddress
email Name
name Key
key Value
code DeletionEmailTemplate
tpl TemplateBranding
branding

renderDeletionEmail :: EmailAddress -> Name -> Code.Key -> Code.Value -> DeletionEmailTemplate -> TemplateBranding -> Mail
renderDeletionEmail :: EmailAddress
-> Name
-> Key
-> Value
-> DeletionEmailTemplate
-> TemplateBranding
-> Mail
renderDeletionEmail EmailAddress
email Name
name Key
cKey Value
cValue DeletionEmailTemplate {Text
EmailAddress
Template
deletionEmailUrl :: Template
deletionEmailSubject :: Template
deletionEmailBodyText :: Template
deletionEmailBodyHtml :: Template
deletionEmailSender :: EmailAddress
deletionEmailSenderName :: Text
$sel:deletionEmailUrl:DeletionEmailTemplate :: DeletionEmailTemplate -> Template
$sel:deletionEmailSubject:DeletionEmailTemplate :: DeletionEmailTemplate -> Template
$sel:deletionEmailBodyText:DeletionEmailTemplate :: DeletionEmailTemplate -> Template
$sel:deletionEmailBodyHtml:DeletionEmailTemplate :: DeletionEmailTemplate -> Template
$sel:deletionEmailSender:DeletionEmailTemplate :: DeletionEmailTemplate -> EmailAddress
$sel:deletionEmailSenderName:DeletionEmailTemplate :: DeletionEmailTemplate -> Text
..} TemplateBranding
branding =
  (Address -> Mail
emptyMail Address
from)
    { mailTo = [to],
      mailHeaders =
        [ ("Subject", toStrict subj),
          ("X-Zeta-Purpose", "Delete"),
          ("X-Zeta-Key", key),
          ("X-Zeta-Code", code)
        ],
      mailParts = [[plainPart txt, htmlPart html]]
    }
  where
    from :: Address
from = Maybe Text -> Text -> Address
Address (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
deletionEmailSenderName) (EmailAddress -> Text
fromEmail EmailAddress
deletionEmailSender)
    to :: Address
to = Name -> EmailAddress -> Address
mkMimeAddress Name
name EmailAddress
email
    txt :: Text
txt = Template -> TemplateBranding -> TemplateBranding -> Text
renderTextWithBranding Template
deletionEmailBodyText TemplateBranding
replace1 TemplateBranding
branding
    html :: Text
html = Template -> TemplateBranding -> TemplateBranding -> Text
renderHtmlWithBranding Template
deletionEmailBodyHtml TemplateBranding
replace1 TemplateBranding
branding
    subj :: Text
subj = Template -> TemplateBranding -> TemplateBranding -> Text
renderTextWithBranding Template
deletionEmailSubject TemplateBranding
replace1 TemplateBranding
branding
    key :: Text
key = AsciiText Base64Url -> Text
forall {k} (c :: k). AsciiText c -> Text
Ascii.toText (Range 20 20 (AsciiText Base64Url) -> AsciiText Base64Url
forall (n :: Nat) (m :: Nat) a. Range n m a -> a
fromRange (Key -> Range 20 20 (AsciiText Base64Url)
Code.asciiKey Key
cKey))
    code :: Text
code = AsciiText Base64Url -> Text
forall {k} (c :: k). AsciiText c -> Text
Ascii.toText (Range 6 20 (AsciiText Base64Url) -> AsciiText Base64Url
forall (n :: Nat) (m :: Nat) a. Range n m a -> a
fromRange (Value -> Range 6 20 (AsciiText Base64Url)
Code.asciiValue Value
cValue))
    replace1 :: TemplateBranding
replace1 Text
"url" = Text -> Text
toStrict (Template -> TemplateBranding -> TemplateBranding -> Text
renderTextWithBranding Template
deletionEmailUrl TemplateBranding
replace2 TemplateBranding
branding)
    replace1 Text
"email" = EmailAddress -> Text
fromEmail EmailAddress
email
    replace1 Text
"name" = Name -> Text
fromName Name
name
    replace1 Text
x = Text
x
    replace2 :: TemplateBranding
replace2 Text
"key" = Text
key
    replace2 Text
"code" = Text
code
    replace2 Text
x = Text
x

--------------------------------------------------------------------------------
-- Upgrade personal user to team owner confirmation email

sendUpgradePersonalToTeamConfirmationEmailImpl ::
  (Member EmailSending r) =>
  Localised UserTemplates ->
  TemplateBranding ->
  EmailAddress ->
  Name ->
  Text ->
  Locale ->
  Sem r ()
sendUpgradePersonalToTeamConfirmationEmailImpl :: forall (r :: EffectRow).
Member EmailSending r =>
Localised UserTemplates
-> TemplateBranding
-> EmailAddress
-> Name
-> Text
-> Locale
-> Sem r ()
sendUpgradePersonalToTeamConfirmationEmailImpl Localised UserTemplates
userTemplates TemplateBranding
branding EmailAddress
email Name
name Text
teamName Locale
locale = do
  let tpl :: UpgradePersonalToTeamEmailTemplate
tpl = UserTemplates -> UpgradePersonalToTeamEmailTemplate
upgradePersonalToTeamEmail (UserTemplates -> UpgradePersonalToTeamEmailTemplate)
-> ((Locale, UserTemplates) -> UserTemplates)
-> (Locale, UserTemplates)
-> UpgradePersonalToTeamEmailTemplate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Locale, UserTemplates) -> UserTemplates
forall a b. (a, b) -> b
snd ((Locale, UserTemplates) -> UpgradePersonalToTeamEmailTemplate)
-> (Locale, UserTemplates) -> UpgradePersonalToTeamEmailTemplate
forall a b. (a -> b) -> a -> b
$ Maybe Locale -> Localised UserTemplates -> (Locale, UserTemplates)
forall a. Maybe Locale -> Localised a -> (Locale, a)
forLocale (Locale -> Maybe Locale
forall a. a -> Maybe a
Just Locale
locale) Localised UserTemplates
userTemplates
  Mail -> Sem r ()
forall (r :: EffectRow). Member EmailSending r => Mail -> Sem r ()
sendMail (Mail -> Sem r ()) -> Mail -> Sem r ()
forall a b. (a -> b) -> a -> b
$ EmailAddress
-> Name
-> Text
-> UpgradePersonalToTeamEmailTemplate
-> TemplateBranding
-> Mail
renderUpgradePersonalToTeamConfirmationEmail EmailAddress
email Name
name Text
teamName UpgradePersonalToTeamEmailTemplate
tpl TemplateBranding
branding

renderUpgradePersonalToTeamConfirmationEmail :: EmailAddress -> Name -> Text -> UpgradePersonalToTeamEmailTemplate -> TemplateBranding -> Mail
renderUpgradePersonalToTeamConfirmationEmail :: EmailAddress
-> Name
-> Text
-> UpgradePersonalToTeamEmailTemplate
-> TemplateBranding
-> Mail
renderUpgradePersonalToTeamConfirmationEmail EmailAddress
email Name
name Text
_teamName UpgradePersonalToTeamEmailTemplate {Text
EmailAddress
Template
upgradePersonalToTeamEmailSubject :: Template
upgradePersonalToTeamEmailBodyText :: Template
upgradePersonalToTeamEmailBodyHtml :: Template
upgradePersonalToTeamEmailSender :: EmailAddress
upgradePersonalToTeamEmailSenderName :: Text
$sel:upgradePersonalToTeamEmailSubject:UpgradePersonalToTeamEmailTemplate :: UpgradePersonalToTeamEmailTemplate -> Template
$sel:upgradePersonalToTeamEmailBodyText:UpgradePersonalToTeamEmailTemplate :: UpgradePersonalToTeamEmailTemplate -> Template
$sel:upgradePersonalToTeamEmailBodyHtml:UpgradePersonalToTeamEmailTemplate :: UpgradePersonalToTeamEmailTemplate -> Template
$sel:upgradePersonalToTeamEmailSender:UpgradePersonalToTeamEmailTemplate :: UpgradePersonalToTeamEmailTemplate -> EmailAddress
$sel:upgradePersonalToTeamEmailSenderName:UpgradePersonalToTeamEmailTemplate :: UpgradePersonalToTeamEmailTemplate -> Text
..} TemplateBranding
branding =
  (Address -> Mail
emptyMail Address
from)
    { mailTo = [to],
      mailHeaders =
        [ ("Subject", toStrict subj),
          ("X-Zeta-Purpose", "Upgrade")
        ],
      mailParts = [[plainPart txt, htmlPart html]]
    }
  where
    from :: Address
from = Maybe Text -> Text -> Address
Address (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
upgradePersonalToTeamEmailSenderName) (EmailAddress -> Text
fromEmail EmailAddress
upgradePersonalToTeamEmailSender)
    to :: Address
to = Name -> EmailAddress -> Address
mkMimeAddress Name
name EmailAddress
email
    txt :: Text
txt = Template -> TemplateBranding -> TemplateBranding -> Text
renderTextWithBranding Template
upgradePersonalToTeamEmailBodyText TemplateBranding
replace1 TemplateBranding
branding
    html :: Text
html = Template -> TemplateBranding -> TemplateBranding -> Text
renderHtmlWithBranding Template
upgradePersonalToTeamEmailBodyHtml TemplateBranding
replace1 TemplateBranding
branding
    subj :: Text
subj = Template -> TemplateBranding -> TemplateBranding -> Text
renderTextWithBranding Template
upgradePersonalToTeamEmailSubject TemplateBranding
replace1 TemplateBranding
branding
    replace1 :: TemplateBranding
replace1 Text
"email" = EmailAddress -> Text
fromEmail EmailAddress
email
    replace1 Text
"name" = Name -> Text
fromName Name
name
    replace1 Text
x = Text
x

-------------------------------------------------------------------------------
-- Invitation Email

sendTeamInvitationMailImpl :: (Member EmailSending r) => Localised TeamTemplates -> TemplateBranding -> EmailAddress -> TeamId -> EmailAddress -> InvitationCode -> Maybe Locale -> Sem r Text
sendTeamInvitationMailImpl :: forall (r :: EffectRow).
Member EmailSending r =>
Localised TeamTemplates
-> TemplateBranding
-> EmailAddress
-> TeamId
-> EmailAddress
-> InvitationCode
-> Maybe Locale
-> Sem r Text
sendTeamInvitationMailImpl Localised TeamTemplates
teamTemplates TemplateBranding
branding EmailAddress
to TeamId
tid EmailAddress
from InvitationCode
code Maybe Locale
loc = do
  let tpl :: InvitationEmailTemplate
tpl = TeamTemplates -> InvitationEmailTemplate
invitationEmail (TeamTemplates -> InvitationEmailTemplate)
-> ((Locale, TeamTemplates) -> TeamTemplates)
-> (Locale, TeamTemplates)
-> InvitationEmailTemplate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Locale, TeamTemplates) -> TeamTemplates
forall a b. (a, b) -> b
snd ((Locale, TeamTemplates) -> InvitationEmailTemplate)
-> (Locale, TeamTemplates) -> InvitationEmailTemplate
forall a b. (a -> b) -> a -> b
$ Maybe Locale -> Localised TeamTemplates -> (Locale, TeamTemplates)
forall a. Maybe Locale -> Localised a -> (Locale, a)
forLocale Maybe Locale
loc Localised TeamTemplates
teamTemplates
      mail :: InvitationEmail
mail = EmailAddress
-> TeamId -> InvitationCode -> EmailAddress -> InvitationEmail
InvitationEmail EmailAddress
to TeamId
tid InvitationCode
code EmailAddress
from
      (Mail
renderedMail, Text
renderedInvitaitonUrl) = InvitationEmail
-> InvitationEmailTemplate -> TemplateBranding -> (Mail, Text)
renderInvitationEmail InvitationEmail
mail InvitationEmailTemplate
tpl TemplateBranding
branding
  Mail -> Sem r ()
forall (r :: EffectRow). Member EmailSending r => Mail -> Sem r ()
sendMail Mail
renderedMail
  Text -> Sem r Text
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
renderedInvitaitonUrl

sendTeamInvitationMailPersonalUserImpl :: (Member EmailSending r) => Localised TeamTemplates -> TemplateBranding -> EmailAddress -> TeamId -> EmailAddress -> InvitationCode -> Maybe Locale -> Sem r Text
sendTeamInvitationMailPersonalUserImpl :: forall (r :: EffectRow).
Member EmailSending r =>
Localised TeamTemplates
-> TemplateBranding
-> EmailAddress
-> TeamId
-> EmailAddress
-> InvitationCode
-> Maybe Locale
-> Sem r Text
sendTeamInvitationMailPersonalUserImpl Localised TeamTemplates
teamTemplates TemplateBranding
branding EmailAddress
to TeamId
tid EmailAddress
from InvitationCode
code Maybe Locale
loc = do
  let tpl :: InvitationEmailTemplate
tpl = TeamTemplates -> InvitationEmailTemplate
existingUserInvitationEmail (TeamTemplates -> InvitationEmailTemplate)
-> ((Locale, TeamTemplates) -> TeamTemplates)
-> (Locale, TeamTemplates)
-> InvitationEmailTemplate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Locale, TeamTemplates) -> TeamTemplates
forall a b. (a, b) -> b
snd ((Locale, TeamTemplates) -> InvitationEmailTemplate)
-> (Locale, TeamTemplates) -> InvitationEmailTemplate
forall a b. (a -> b) -> a -> b
$ Maybe Locale -> Localised TeamTemplates -> (Locale, TeamTemplates)
forall a. Maybe Locale -> Localised a -> (Locale, a)
forLocale Maybe Locale
loc Localised TeamTemplates
teamTemplates
      mail :: InvitationEmail
mail = EmailAddress
-> TeamId -> InvitationCode -> EmailAddress -> InvitationEmail
InvitationEmail EmailAddress
to TeamId
tid InvitationCode
code EmailAddress
from
      (Mail
renderedMail, Text
renderedInvitaitonUrl) = InvitationEmail
-> InvitationEmailTemplate -> TemplateBranding -> (Mail, Text)
renderInvitationEmail InvitationEmail
mail InvitationEmailTemplate
tpl TemplateBranding
branding
  Mail -> Sem r ()
forall (r :: EffectRow). Member EmailSending r => Mail -> Sem r ()
sendMail Mail
renderedMail
  Text -> Sem r Text
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
renderedInvitaitonUrl

data InvitationEmail = InvitationEmail
  { InvitationEmail -> EmailAddress
invTo :: !EmailAddress,
    InvitationEmail -> TeamId
invTeamId :: !TeamId,
    InvitationEmail -> InvitationCode
invInvCode :: !InvitationCode,
    InvitationEmail -> EmailAddress
invInviter :: !EmailAddress
  }

renderInvitationEmail :: InvitationEmail -> InvitationEmailTemplate -> TemplateBranding -> (Mail, Text)
renderInvitationEmail :: InvitationEmail
-> InvitationEmailTemplate -> TemplateBranding -> (Mail, Text)
renderInvitationEmail InvitationEmail {EmailAddress
TeamId
InvitationCode
$sel:invTo:InvitationEmail :: InvitationEmail -> EmailAddress
$sel:invTeamId:InvitationEmail :: InvitationEmail -> TeamId
$sel:invInvCode:InvitationEmail :: InvitationEmail -> InvitationCode
$sel:invInviter:InvitationEmail :: InvitationEmail -> EmailAddress
invTo :: EmailAddress
invTeamId :: TeamId
invInvCode :: InvitationCode
invInviter :: EmailAddress
..} InvitationEmailTemplate {Text
EmailAddress
Template
invitationEmailUrl :: Template
invitationEmailSubject :: Template
invitationEmailBodyText :: Template
invitationEmailBodyHtml :: Template
invitationEmailSender :: EmailAddress
invitationEmailSenderName :: Text
$sel:invitationEmailUrl:InvitationEmailTemplate :: InvitationEmailTemplate -> Template
$sel:invitationEmailSubject:InvitationEmailTemplate :: InvitationEmailTemplate -> Template
$sel:invitationEmailBodyText:InvitationEmailTemplate :: InvitationEmailTemplate -> Template
$sel:invitationEmailBodyHtml:InvitationEmailTemplate :: InvitationEmailTemplate -> Template
$sel:invitationEmailSender:InvitationEmailTemplate :: InvitationEmailTemplate -> EmailAddress
$sel:invitationEmailSenderName:InvitationEmailTemplate :: InvitationEmailTemplate -> Text
..} TemplateBranding
branding =
  ( (Address -> Mail
emptyMail Address
from)
      { mailTo = [to],
        mailHeaders =
          [ ("Subject", toStrict subj),
            ("X-Zeta-Purpose", "TeamInvitation"),
            ("X-Zeta-Code", Ascii.toText code)
          ],
        mailParts = [[plainPart txt, htmlPart html]]
      },
    Text
invitationUrl
  )
  where
    (InvitationCode AsciiText Base64Url
code) = InvitationCode
invInvCode
    from :: Address
from = Maybe Text -> Text -> Address
Address (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
invitationEmailSenderName) (EmailAddress -> Text
fromEmail EmailAddress
invitationEmailSender)
    to :: Address
to = Maybe Text -> Text -> Address
Address Maybe Text
forall a. Maybe a
Nothing (EmailAddress -> Text
fromEmail EmailAddress
invTo)
    txt :: Text
txt = Template -> TemplateBranding -> TemplateBranding -> Text
renderTextWithBranding Template
invitationEmailBodyText TemplateBranding
replace TemplateBranding
branding
    html :: Text
html = Template -> TemplateBranding -> TemplateBranding -> Text
renderHtmlWithBranding Template
invitationEmailBodyHtml TemplateBranding
replace TemplateBranding
branding
    subj :: Text
subj = Template -> TemplateBranding -> TemplateBranding -> Text
renderTextWithBranding Template
invitationEmailSubject TemplateBranding
replace TemplateBranding
branding
    invitationUrl :: Text
invitationUrl = Template -> TeamId -> InvitationCode -> TemplateBranding -> Text
renderInvitationUrl Template
invitationEmailUrl TeamId
invTeamId InvitationCode
invInvCode TemplateBranding
branding
    replace :: TemplateBranding
replace Text
"url" = Text
invitationUrl
    replace Text
"inviter" = EmailAddress -> Text
fromEmail EmailAddress
invInviter
    replace Text
x = Text
x

renderInvitationUrl :: Template -> TeamId -> InvitationCode -> TemplateBranding -> Text
renderInvitationUrl :: Template -> TeamId -> InvitationCode -> TemplateBranding -> Text
renderInvitationUrl Template
t TeamId
tid (InvitationCode AsciiText Base64Url
c) TemplateBranding
branding =
  Text -> Text
toStrict (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Template -> TemplateBranding -> TemplateBranding -> Text
renderTextWithBranding Template
t TemplateBranding
replace TemplateBranding
branding
  where
    replace :: TemplateBranding
replace Text
"team" = TeamId -> Text
forall {k} (a :: k). Id a -> Text
idToText TeamId
tid
    replace Text
"code" = AsciiText Base64Url -> Text
forall {k} (c :: k). AsciiText c -> Text
Ascii.toText AsciiText Base64Url
c
    replace Text
x = Text
x

-------------------------------------------------------------------------------
-- MIME Conversions

-- | Construct a MIME 'Address' from the given display 'Name' and 'Email'
-- address that does not exceed 320 bytes in length when rendered for use
-- in SMTP, which is a safe limit for most mail servers (including those of
-- Amazon SES). The display name is only included if it fits within that
-- limit, otherwise it is dropped.
mkMimeAddress :: Name -> EmailAddress -> Address
mkMimeAddress :: Name -> EmailAddress -> Address
mkMimeAddress Name
name EmailAddress
email =
  let addr :: Address
addr = Maybe Text -> Text -> Address
Address (Text -> Maybe Text
forall a. a -> Maybe a
Just (Name -> Text
fromName Name
name)) (EmailAddress -> Text
fromEmail EmailAddress
email)
   in if Text -> Int -> Ordering
Text.compareLength (Address -> Text
renderAddress Address
addr) Int
320 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT
        then Maybe Text -> Text -> Address
Address Maybe Text
forall a. Maybe a
Nothing (EmailAddress -> Text
fromEmail EmailAddress
email)
        else Address
addr