[WPB-18127] send emails to team admins on app creation events

changelog.d/2-features/WPB-18127-send-emails-to-team-admins-on-app-creation-_-update-_-deletion

@@ -0,0 +1 @@
+Send emails to team admins on app creation / update / deletion.

libs/wire-subsystems/src/Wire/AppSubsystem/Interpreter.hs

@@ -17,6 +17,7 @@
 
 module Wire.AppSubsystem.Interpreter where
 
+import Control.Lens ((^..))
 import Data.ByteString.Conversion
 import Data.Default
 import Data.Id
@@ -46,6 +47,8 @@ import Wire.AppSubsystem
 import Wire.AuthenticationSubsystem
 import Wire.AuthenticationSubsystem.Cookie (revokeAllCookies)
 import Wire.AuthenticationSubsystem.ZAuth
+import Wire.EmailSubsystem (EmailSubsystem)
+import Wire.EmailSubsystem qualified as Email
 import Wire.Events
 import Wire.GalleyAPIAccess
 import Wire.NotificationSubsystem
@@ -59,17 +62,18 @@ import Wire.UserStore qualified as Store
 import Wire.UserSubsystem (UserSubsystem, internalUpdateSearchIndex)
 
 runAppSubsystem ::
-  ( Member UserStore r,
-    Member TinyLog r,
+  ( Member AppStore r,
+    Member EmailSubsystem r,
     Member (Error AppSubsystemError) r,
-    Member (Input AppSubsystemConfig) r,
+    Member Events r,
     Member GalleyAPIAccess r,
-    Member AppStore r,
-    Member Now r,
-    Member TeamSubsystem r,
+    Member (Input AppSubsystemConfig) r,
     Member NotificationSubsystem r,
+    Member Now r,
     Member Random r,
-    Member Events r
+    Member TeamSubsystem r,
+    Member TinyLog r,
+    Member UserStore r
   ) =>
   InterpreterFor UserSubsystem (AuthenticationSubsystem ': r) ->
   InterpreterFor AuthenticationSubsystem r ->
@@ -95,6 +99,7 @@ createAppImpl ::
     Member Now r,
     Member TeamSubsystem r,
     Member NotificationSubsystem r,
+    Member EmailSubsystem r,
     Member AuthenticationSubsystem r,
     Member UserSubsystem r,
     Member Random r
@@ -134,6 +139,8 @@ createAppImpl lusr tid newApp = do
   -- generate a team event
   generateTeamEvents creator.id tid [EdMemberJoin u.id]
 
+  notifyAdmins tid (tUnqualified lusr) "created" (fromName newApp.name) u.id
+
   c :: Cookie (Token U) <- newCookie u.id Nothing PersistentCookie Nothing RevokeSameLabel
   pure
     CreatedApp
@@ -199,8 +206,10 @@ updateAppImpl ::
     Member (Error AppSubsystemError) r,
     Member Events r,
     Member GalleyAPIAccess r,
+    Member TeamSubsystem r,
+    Member UserStore r,
     Member UserSubsystem r,
-    Member UserStore r
+    Member EmailSubsystem r
   ) =>
   Local UserId ->
   TeamId ->
@@ -222,6 +231,11 @@ updateAppImpl lusr tid appid upd = do
           eupAccentId = upd.accentId,
           eupAssets = upd.assets
         }
+  appName <-
+    fromName <$> case upd.name of
+      Just n -> pure n
+      Nothing -> (.name) <$> (Store.getUser appid >>= note AppSubsystemErrorNoApp)
+  notifyAdmins tid (tUnqualified lusr) "updated" appName appid
 
 refreshAppCookieImpl ::
   ( Member AuthenticationSubsystem r,
@@ -287,10 +301,40 @@ appNewStoredUser creator new = do
 defAppSupportedProtocols :: Set BaseProtocolTag
 defAppSupportedProtocols = Set.singleton BaseProtocolMLSTag
 
+-- | Send an app-event email to every team admin/owner.
+-- 'action' should be "created", "updated", or "deleted".
+-- Admins without an email address are silently skipped.
+notifyAdmins ::
+  ( Member TeamSubsystem r,
+    Member UserStore r,
+    Member EmailSubsystem r
+  ) =>
+  TeamId ->
+  UserId ->
+  Text ->
+  Text ->
+  UserId ->
+  Sem r ()
+notifyAdmins tid actorId action appName appId = do
+  admins <- internalGetTeamAdmins tid
+  let adminUids = admins ^.. T.teamMembers . traverse . T.userId
+  adminUsers <- Store.getUsers adminUids
+  forM_ adminUsers $ \u ->
+    for_ u.email $ \email ->
+      Email.sendAppEventEmail email u.name action appName appId tid actorId u.locale
+
 deleteAppImpl ::
-  (Member AppStore r) =>
+  ( Member AppStore r,
+    Member UserStore r,
+    Member TeamSubsystem r,
+    Member EmailSubsystem r
+  ) =>
   TeamId ->
   UserId ->
   Sem r ()
-deleteAppImpl teamId appId =
+deleteAppImpl teamId appId = do
+  appName <- maybe "" (fromName . (.name)) <$> Store.getUser appId
+  mbStoredApp <- Store.getApp appId teamId
+  let actorId = maybe appId (.creator) mbStoredApp
   Store.deleteApp appId teamId
+  notifyAdmins teamId actorId "deleted" appName appId

libs/wire-subsystems/src/Wire/EmailSubsystem.hs

@@ -61,5 +61,23 @@ data EmailSubsystem m a where
     Maybe URI ->
     Maybe Locale ->
     EmailSubsystem m ()
+  SendAppEventEmail ::
+    -- | sender email
+    EmailAddress ->
+    -- | sender name
+    Name ->
+    -- | action (one of ["created", "updated", "deleted"])
+    Text ->
+    -- | appName
+    Text ->
+    -- | appId
+    UserId ->
+    -- | tid
+    TeamId ->
+    -- | actorId
+    UserId ->
+    -- | mLocale
+    Maybe Locale ->
+    EmailSubsystem m ()
 
 makeSem ''EmailSubsystem

libs/wire-subsystems/src/Wire/EmailSubsystem/Interpreter.hs

@@ -76,6 +76,8 @@ emailSubsystemInterpreter userTpls teamTpls branding = interpret \case
   SendNewTeamOwnerWelcomeEmail email tid teamName loc name -> sendNewTeamOwnerWelcomeEmailImpl teamTpls branding email tid teamName loc name
   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
+  SendAppEventEmail email name action appName appId tid actorId mLocale ->
+    sendAppEventEmailImpl teamTpls branding email name action appName appId tid actorId mLocale
 
 -------------------------------------------------------------------------------
 -- Verification Email for
@@ -698,6 +700,63 @@ renderIdPConfigChangeEmail email IdPConfigChangeEmailTemplate {..} branding adde
         & Map.insert "subject" (T.pack d.subject)
         & Map.insert "issuer" (T.pack d.issuer)
 
+-------------------------------------------------------------------------------
+-- App Event Email
+
+sendAppEventEmailImpl ::
+  (Member EmailSending r, Member TinyLog r) =>
+  Localised TeamTemplates ->
+  Map Text Text ->
+  EmailAddress ->
+  Name ->
+  Text ->
+  Text ->
+  UserId ->
+  TeamId ->
+  UserId ->
+  Maybe Locale ->
+  Sem r ()
+sendAppEventEmailImpl teamTemplates branding email name action appName appId tid actorId mLocale = do
+  let tpl = appEventEmail . snd $ forLocale mLocale teamTemplates
+  mail <- logEmailRenderErrors "app event email" $ renderAppEventEmail email name action appName appId tid actorId tpl branding
+  sendMail mail
+
+renderAppEventEmail ::
+  (Member (Output Text) r) =>
+  EmailAddress ->
+  Name ->
+  Text ->
+  Text ->
+  UserId ->
+  TeamId ->
+  UserId ->
+  AppEventEmailTemplate ->
+  Map Text Text ->
+  Sem r Mail
+renderAppEventEmail email name action appName appId tid actorId AppEventEmailTemplate {..} branding = do
+  let replace =
+        branding
+          & Map.insert "action" action
+          & Map.insert "app_name" appName
+          & Map.insert "app_id" (idToText appId)
+          & Map.insert "team_id" (idToText tid)
+          & Map.insert "actor_id" (idToText actorId)
+  txt <- renderTextWithBrandingSem appEventEmailBodyText replace
+  html <- renderHtmlWithBrandingSem appEventEmailBodyHtml replace
+  subj <- renderTextWithBrandingSem appEventEmailSubject replace
+  pure
+    (emptyMail from)
+      { mailTo = [to],
+        mailHeaders =
+          [ ("Subject", toStrict subj),
+            ("X-Zeta-Purpose", "AppEvent")
+          ],
+        mailParts = [[plainPart txt, htmlPart html]]
+      }
+  where
+    from = Address (Just appEventEmailSenderName) (fromEmail appEventEmailSender)
+    to = mkMimeAddress name email
+
 -------------------------------------------------------------------------------
 -- MIME Conversions
 

libs/wire-subsystems/src/Wire/EmailSubsystem/Template.hs

@@ -247,6 +247,13 @@ loadTeamTemplates tOptions templatesDir defLocale sender = readLocalesDir defLoc
             <*> pure sender
             <*> readText' fp "email/sender.txt"
         )
+    <*> ( AppEventEmailTemplate
+            <$> readTemplate' fp "email/app-event-subject.txt"
+            <*> readTemplate' fp "email/app-event.txt"
+            <*> readTemplate' fp "email/app-event.html"
+            <*> pure sender
+            <*> readText' fp "email/sender.txt"
+        )
   where
     tUrl = template tOptions.tInvitationUrl
     tExistingUrl = template tOptions.tExistingUserInvitationUrl

libs/wire-subsystems/src/Wire/EmailSubsystem/Templates/Team.hs

@@ -62,10 +62,19 @@ data IdPConfigChangeEmailTemplate = IdPConfigChangeEmailTemplate
     senderName :: !Text
   }
 
+data AppEventEmailTemplate = AppEventEmailTemplate
+  { appEventEmailSubject :: !Template,
+    appEventEmailBodyText :: !Template,
+    appEventEmailBodyHtml :: !Template,
+    appEventEmailSender :: !EmailAddress,
+    appEventEmailSenderName :: !Text
+  }
+
 data TeamTemplates = TeamTemplates
   { invitationEmail :: !InvitationEmailTemplate,
     existingUserInvitationEmail :: !InvitationEmailTemplate,
     memberWelcomeEmail :: !MemberWelcomeEmailTemplate,
     newTeamOwnerWelcomeEmail :: !NewTeamOwnerWelcomeEmailTemplate,
-    idpConfigChangeEmail :: !IdPConfigChangeEmailTemplate
+    idpConfigChangeEmail :: !IdPConfigChangeEmailTemplate,
+    appEventEmail :: !AppEventEmailTemplate
   }

libs/wire-subsystems/templates/en/team/email/app-event-subject.txt

@@ -0,0 +1 @@
+App ${action} in your team