allow XAUTH2 tokens for SMTP

wireapp · Sep 30, 2024 · 7c60a5d · 7c60a5d
1 parent 5521ea5
commit 7c60a5d
Show file tree

Hide file tree

Showing 4 changed files with 39 additions and 22 deletions.
diff --git a/charts/brig/templates/configmap.yaml b/charts/brig/templates/configmap.yaml
@@ -122,8 +122,13 @@ data:
         smtpConnType: {{ .smtp.connType }}
         {{- if .smtp.username }}
         smtpCredentials:
+          smtpAuth: {{ .smtp.auth | default "basic" }}
           smtpUsername: {{ .smtp.username }}
+          {{- if eq .smtp.auth "xauth2" }}
+          smtpXAUTH2Token: {{ .smtp.xauth2TokenFile }}
+          {{- else }}
           smtpPassword: {{ .smtp.passwordFile }}
+          {{- end }}
         {{- end }}
       {{- end }}
       general:

diff --git a/libs/wire-subsystems/src/Wire/EmailSending/SMTP.hs b/libs/wire-subsystems/src/Wire/EmailSending/SMTP.hs
@@ -24,8 +24,7 @@ module Wire.EmailSending.SMTP
     initSMTPWithTimeout,
     SMTPConnType (..),
     SMTP (..),
-    Username (..),
-    Password (..),
+    Credential (..),
     SMTPPoolException (..),
   )
 where
@@ -53,9 +52,11 @@ emailViaSMTPInterpreter :: (Member (Embed IO) r) => Logger -> SMTP -> Interprete
 emailViaSMTPInterpreter logger smtp = interpret \case
   SendMail mail -> sendMailImpl logger smtp mail
 
-newtype Username = Username Text
-
-newtype Password = Password Text
+data Credential
+  = -- | username and password
+    BasicAuth Text Text
+  | -- | username and token
+    XAUTH2Token Text Text
 
 data SMTP = SMTP {pool :: !(Pool SMTP.SMTPConnection)}
 
@@ -80,7 +81,7 @@ initSMTP ::
   Logger ->
   Text ->
   Maybe PortNumber ->
-  Maybe (Username, Password) ->
+  Maybe Credential ->
   SMTPConnType ->
   IO SMTP
 initSMTP = initSMTPWithTimeout defaultTimeoutDuration
@@ -95,7 +96,7 @@ initSMTPWithTimeout ::
   Logger ->
   Text ->
   Maybe PortNumber ->
-  Maybe (Username, Password) ->
+  Maybe Credential ->
   SMTPConnType ->
   IO SMTP
 initSMTPWithTimeout timeoutDuration lg host port credentials connType = do
@@ -143,10 +144,13 @@ initSMTPWithTimeout timeoutDuration lg host port credentials connType = do
           SMTP.connectSMTPSSLWithSettings (unpack host) $
             SMTP.defaultSettingsSMTPSSL {SMTP.sslPort = p}
       ok <- case credentials of
-        (Just (Username u, Password p)) ->
+        Just (BasicAuth u p) ->
           ensureTimeout $
             SMTP.authenticate SMTP.LOGIN (unpack u) (unpack p) conn
-        _ -> pure True
+        Just (XAUTH2Token u t) ->
+          ensureTimeout $
+            SMTP.authenticate SMTP.XOAUTH2 (unpack u) (unpack t) conn
+        Nothing -> pure True
       if ok
         then pure conn
         else CE.throw SMTPUnauthorized

diff --git a/services/brig/src/Brig/App.hs b/services/brig/src/Brig/App.hs
@@ -306,10 +306,11 @@ newEnv opts = do
     emailConn lgr (Opt.EmailSMTP s) = do
       let h = s.smtpEndpoint.host
           p = Just . fromInteger . toInteger $ s.smtpEndpoint.port
-      smtpCredentials <- case s.smtpCredentials of
-        Just (Opt.EmailSMTPCredentials u p') -> do
-          Just . (SMTP.Username u,) . SMTP.Password <$> initCredentials p'
-        _ -> pure Nothing
+      smtpCredentials <- for s.smtpCredentials \case
+        Opt.EmailSMTPBasicAuth u passFile ->
+          SMTP.BasicAuth u <$> initCredentials passFile
+        Opt.EmailSMTPXAUTH2 u tokenFile ->
+          SMTP.XAUTH2Token u <$> initCredentials tokenFile
       smtp <- SMTP.initSMTP lgr h p smtpCredentials s.smtpConnType
       pure (Nothing, Just smtp)
     mkEndpoint service = RPC.host (encodeUtf8 service.host) . RPC.port service.port $ RPC.empty

diff --git a/services/brig/src/Brig/Options.hs b/services/brig/src/Brig/Options.hs
@@ -116,17 +116,24 @@ data EmailAWSOpts = EmailAWSOpts
 
 instance FromJSON EmailAWSOpts
 
-data EmailSMTPCredentials = EmailSMTPCredentials
-  { -- | Username to authenticate
-    --   against the SMTP server
-    smtpUsername :: !Text,
-    -- | File containing password to
-    --   authenticate against the SMTP server
-    smtpPassword :: !FilePathSecrets
-  }
+data EmailSMTPCredentials
+  = -- | username and password file
+    EmailSMTPBasicAuth !Text !FilePathSecrets
+  | -- | username and token file
+    EmailSMTPXAUTH2 !Text !FilePathSecrets
   deriving (Show, Generic)
 
-instance FromJSON EmailSMTPCredentials
+instance FromJSON EmailSMTPCredentials where
+  parseJSON = withObject "smtpCredentials" $ \v ->
+    v .:? "smtpAuth" .!= ("basic" :: String) >>= \case
+      "xauth2" ->
+        EmailSMTPXAUTH2
+          <$> v .: "smtpUsername"
+          <*> v .: "smtpXAUTH2Token"
+      _ ->
+        EmailSMTPBasicAuth
+          <$> v .: "smtpUsername"
+          <*> v .: "smtpPassword"
 
 data EmailSMTPOpts = EmailSMTPOpts
   { -- | Hostname of the SMTP server to connect to