diff --git a/changelog.d/2-features/WPB-18127-send-emails-to-team-admins-on-app-creation-_-update-_-deletion b/changelog.d/2-features/WPB-18127-send-emails-to-team-admins-on-app-creation-_-update-_-deletion new file mode 100644 index 00000000000..3924726d000 --- /dev/null +++ b/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. diff --git a/libs/wire-subsystems/src/Wire/AppSubsystem.hs b/libs/wire-subsystems/src/Wire/AppSubsystem.hs index ed16ba5bfa7..3cab079ca8b 100644 --- a/libs/wire-subsystems/src/Wire/AppSubsystem.hs +++ b/libs/wire-subsystems/src/Wire/AppSubsystem.hs @@ -42,9 +42,10 @@ instance Default AppSubsystemConfig where data AppSubsystemError = AppSubsystemErrorNoPerm | AppSubsystemErrorMissingAuth - | AppSubsystemErrorNoUser -- The user having created the app not found - | AppSubsystemErrorAppUserNotFound -- The user used to "enact" the app not found - | AppSubsystemErrorNoApp + | AppSubsystemErrorNoCreator + | AppSubsystemErrorNoAppData + | AppSubsystemErrorNoAppUser + | AppSubsystemErrorNoAppTeamMember deriving (Eq, Show) instance Exception AppSubsystemError @@ -54,9 +55,11 @@ appSubsystemErrorToHttpError = StdError . \case AppSubsystemErrorNoPerm -> Wai.mkError status403 "app-no-permission" "User does not have permission to create or manage apps" AppSubsystemErrorMissingAuth -> Wai.mkError status403 "missing-auth" "Re-authentication via password required" - AppSubsystemErrorNoUser -> Wai.mkError status403 "create-app-no-user" "App owner not found" - AppSubsystemErrorAppUserNotFound -> Wai.mkError status403 "app-user-not-found" "App user not found" - AppSubsystemErrorNoApp -> Wai.mkError status404 "app-not-found" "App not found" + -- TODO(fisx): announce these changes. + AppSubsystemErrorNoCreator -> Wai.mkError status403 "no-app-creator" "App owner not found" + AppSubsystemErrorNoAppData -> Wai.mkError status404 "app-not-found" "App not found (metadata record)" + AppSubsystemErrorNoAppUser -> Wai.mkError status404 "app-not-found" "App not found (user record)" + AppSubsystemErrorNoAppTeamMember -> Wai.mkError status404 "app-not-found" "App not found (team member record)" data AppSubsystem m a where CreateApp :: Local UserId -> TeamId -> NewApp -> AppSubsystem m CreatedApp diff --git a/libs/wire-subsystems/src/Wire/AppSubsystem/Interpreter.hs b/libs/wire-subsystems/src/Wire/AppSubsystem/Interpreter.hs index 513deff6bfa..5370c54e62a 100644 --- a/libs/wire-subsystems/src/Wire/AppSubsystem/Interpreter.hs +++ b/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 (AppEvent (..), 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] + createAppSendEmail creator tid u.id newApp + c :: Cookie (Token U) <- newCookie u.id Nothing PersistentCookie Nothing RevokeSameLabel pure CreatedApp @@ -145,24 +152,52 @@ createAppImpl lusr tid newApp = do cookie = mkSomeToken c.cookieValue } +-- | Everything needed solely to notify team admins that an app was created. +-- Values retrieved or computed by 'createAppImpl' and reused here are passed +-- in: @creator@ (the actor, from the permission check) and @appId@ (the newly +-- created app user's id). +createAppSendEmail :: + ( Member TeamSubsystem r, + Member UserStore r, + Member (Error AppSubsystemError) r, + Member EmailSubsystem r + ) => + StoredUser -> + TeamId -> + UserId -> + NewApp -> + Sem r () +createAppSendEmail creator tid appId newApp = do + appTeamMember <- internalGetTeamMember appId tid >>= note AppSubsystemErrorNoAppTeamMember + notifyAdmins tid appId $ + NewAppCreated + { actorName = Just creator.name, + actorEmail = creator.email, + newAppName = Just newApp.name, + appCreatedAt = memberToAppCreatedAt appTeamMember + } + +memberToAppCreatedAt :: T.TeamMember -> Maybe UTCTimeMillis +memberToAppCreatedAt = (^? T.newTeamMember . T.nInvitation . _Just . _2) + -- | Check that @lusr@ is member of team with @tid@. ensureTeamMember :: - ( Member UserStore r, - Member (Error AppSubsystemError) r, - Member GalleyAPIAccess r + ( Member TeamSubsystem r, + Member UserStore r, + Member (Error AppSubsystemError) r ) => Local UserId -> TeamId -> Sem r (StoredUser, T.TeamMember) ensureTeamMember lusr tid = do - storedUser <- Store.getUser (tUnqualified lusr) >>= note AppSubsystemErrorNoUser - teamMember <- getTeamMember storedUser.id tid >>= note AppSubsystemErrorNoPerm + storedUser <- Store.getUser (tUnqualified lusr) >>= note AppSubsystemErrorNoCreator + teamMember <- internalGetTeamMember storedUser.id tid >>= note AppSubsystemErrorNoPerm pure (storedUser, teamMember) getAppImpl :: ( Member AppStore r, + Member TeamSubsystem r, Member (Error AppSubsystemError) r, - Member GalleyAPIAccess r, Member UserStore r ) => Local UserId -> @@ -171,7 +206,7 @@ getAppImpl :: Sem r AppInfo getAppImpl lusr tid uid = do void $ ensureTeamMember lusr tid - storedApp <- Store.getApp uid tid >>= note AppSubsystemErrorNoApp + storedApp <- Store.getApp uid tid >>= note AppSubsystemErrorNoAppData pure $ storedAppToAppInfo storedApp storedAppToAppInfo :: StoredApp -> AppInfo @@ -183,8 +218,8 @@ storedAppToAppInfo app = getAppsImpl :: ( Member AppStore r, + Member TeamSubsystem r, Member (Error AppSubsystemError) r, - Member GalleyAPIAccess r, Member UserStore r ) => Local UserId -> @@ -198,9 +233,10 @@ updateAppImpl :: ( Member AppStore r, 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 -> @@ -208,11 +244,12 @@ updateAppImpl :: PutApp -> Sem r () updateAppImpl lusr tid appid upd = do - (_updater, umem) <- ensureTeamMember lusr tid + (updater, umem) <- ensureTeamMember lusr tid note AppSubsystemErrorNoPerm $ guard (T.hasPermission umem T.CreateApp) + oldApp <- Store.getUser appid >>= note AppSubsystemErrorNoAppUser Store.updateApp tid appid (Store.MkStoredAppUpdate {category = upd.category, description = upd.description}) >>= \case Right () -> pure () - Left Store.NotFound -> throw AppSubsystemErrorNoApp + Left Store.NotFound -> throw AppSubsystemErrorNoAppData Store.updateUser appid (def {Store.name = upd.name, Store.assets = upd.assets, Store.accentId = upd.accentId}) internalUpdateSearchIndex appid generateUserEvent appid Nothing $ @@ -222,13 +259,41 @@ updateAppImpl lusr tid appid upd = do eupAccentId = upd.accentId, eupAssets = upd.assets } + updateAppSendEmail updater oldApp tid appid upd + +updateAppSendEmail :: + ( Member TeamSubsystem r, + Member (Error AppSubsystemError) r, + Member UserStore r, + Member EmailSubsystem r + ) => + StoredUser -> + StoredUser -> + TeamId -> + UserId -> + PutApp -> + Sem r () +updateAppSendEmail updater oldApp tid appid upd = do + appTeamMember <- internalGetTeamMember appid tid >>= note AppSubsystemErrorNoAppTeamMember + let oldAppName = oldApp.name + newAppName = fromMaybe oldAppName upd.name + notifyAdmins tid appid $ + DetailsChangedForApp + { actorName = Just updater.name, + actorEmail = updater.email, + newAppName = Just newAppName, + appCreatedAt = memberToAppCreatedAt appTeamMember, + oldAppName = Just oldAppName + } refreshAppCookieImpl :: ( Member AuthenticationSubsystem r, Member AppStore r, Member (Error RetryAfter) r, Member (Error AppSubsystemError) r, - Member GalleyAPIAccess r + Member TeamSubsystem r, + Member UserStore r, + Member EmailSubsystem r ) => Local UserId -> TeamId -> @@ -239,16 +304,42 @@ refreshAppCookieImpl (tUnqualified -> uid) tid appId mbPassword = do reauthenticateEither uid mbPassword >>= either (const $ throw AppSubsystemErrorMissingAuth) (const $ pure ()) - mem <- getTeamMember uid tid >>= note AppSubsystemErrorNoPerm + mem <- internalGetTeamMember uid tid >>= note AppSubsystemErrorNoPerm note AppSubsystemErrorNoPerm $ guard (T.hasPermission mem T.ManageApps) - void $ Store.getApp appId tid >>= note AppSubsystemErrorNoApp + void $ Store.getApp appId tid >>= note AppSubsystemErrorNoAppData revokeAllCookies appId c :: Cookie (Token U) <- newCookieLimited appId Nothing PersistentCookie Nothing RevokeSameLabel >>= either throw pure + refreshAppCookieSendEmail mem uid tid appId pure $ mkSomeToken c.cookieValue +-- | Everything needed solely to notify team admins that an app's token was +-- refreshed. Only the identifiers known to 'refreshAppCookieImpl' are passed +-- in: @actorId@ (the caller), @tid@ and @appId@. +refreshAppCookieSendEmail :: + ( Member TeamSubsystem r, + Member UserStore r, + Member (Error AppSubsystemError) r, + Member EmailSubsystem r + ) => + T.TeamMember -> + UserId -> + TeamId -> + UserId -> + Sem r () +refreshAppCookieSendEmail mem actorId tid appId = do + appUser <- Store.getUser appId >>= note AppSubsystemErrorNoAppUser + (actorName, actorEmail) <- appEventActor actorId + notifyAdmins tid appId $ + AppTokenUpdated + { actorName = actorName, + actorEmail = actorEmail, + newAppName = Just appUser.name, + appCreatedAt = memberToAppCreatedAt mem + } + appNewStoredUser :: (Member (Input AppSubsystemConfig) r, Member Random r) => StoredUser -> @@ -287,10 +378,91 @@ appNewStoredUser creator new = do defAppSupportedProtocols :: Set BaseProtocolTag defAppSupportedProtocols = Set.singleton BaseProtocolMLSTag +-- | Send the notification email for an 'AppEvent' to every team admin/owner. +-- Admins without an email address are silently skipped. +notifyAdmins :: + ( Member TeamSubsystem r, + Member UserStore r, + Member EmailSubsystem r + ) => + TeamId -> + UserId -> + AppEvent -> + Sem r () +notifyAdmins tid appId event = 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 tid appId event u.locale + +-- | Best-effort actor identity for an 'AppEvent'. +appEventActor :: (Member UserStore r) => UserId -> Sem r (Maybe Name, Maybe EmailAddress) +appEventActor actorId = do + mu <- Store.getUser actorId + pure ((.name) <$> mu, (.email) =<< mu) + +-- | TODO: no operation toggles app availability yet. This helper wires the +-- 'AppAvailabilityChanged' event end-to-end; call it from the availability +-- toggle once that operation exists. +notifyAppAvailabilityChanged :: + ( Member TeamSubsystem r, + Member UserStore r, + Member EmailSubsystem r + ) => + TeamId -> + UserId -> + UserId -> + Sem r () +notifyAppAvailabilityChanged tid appId actorId = do + appName <- (.name) <$$> Store.getUser appId + appCreatedAt <- internalGetTeamMember appId tid <&> (>>= memberToAppCreatedAt) + (actorName, actorEmail) <- appEventActor actorId + notifyAdmins tid appId $ + AppAvailabilityChanged + { actorName = actorName, + actorEmail = actorEmail, + newAppName = appName, + appCreatedAt = appCreatedAt + } + deleteAppImpl :: - (Member AppStore r) => + ( Member AppStore r, + Member UserStore r, + Member TeamSubsystem r, + Member EmailSubsystem r, + Member (Error AppSubsystemError) r + ) => TeamId -> UserId -> Sem r () -deleteAppImpl teamId appId = +deleteAppImpl teamId appId = do + storedApp <- Store.getApp appId teamId >>= note AppSubsystemErrorNoAppData Store.deleteApp appId teamId + deleteAppSendEmail storedApp.creator teamId appId + +-- | Everything needed solely to notify team admins that an app was deleted. +-- @actorId@ is resolved from the app record (which must be read before the app +-- is deleted) and passed in; the app user itself is not deleted, so its name +-- and the actor's details can still be looked up here. +deleteAppSendEmail :: + ( Member TeamSubsystem r, + Member UserStore r, + Member EmailSubsystem r + ) => + UserId -> + TeamId -> + UserId -> + Sem r () +deleteAppSendEmail actorId tid appId = do + appName <- (.name) <$$> Store.getUser appId + appCreatedAt <- internalGetTeamMember appId tid <&> (>>= memberToAppCreatedAt) + (actorName, actorEmail) <- appEventActor actorId + notifyAdmins tid appId $ + AppDeleted + { actorName = actorName, + actorEmail = actorEmail, + newAppName = appName, + appCreatedAt = appCreatedAt + } diff --git a/libs/wire-subsystems/src/Wire/EmailSubsystem.hs b/libs/wire-subsystems/src/Wire/EmailSubsystem.hs index 0ab910e724c..5906a5b879d 100644 --- a/libs/wire-subsystems/src/Wire/EmailSubsystem.hs +++ b/libs/wire-subsystems/src/Wire/EmailSubsystem.hs @@ -1,4 +1,5 @@ {-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS_GHC -Wno-partial-fields #-} -- This file is part of the Wire Server implementation. -- @@ -21,6 +22,7 @@ module Wire.EmailSubsystem where import Data.Code qualified as Code import Data.Id +import Data.Json.Util import Data.X509.Extended (CertDescription) import Imports import Polysemy @@ -31,6 +33,48 @@ import Wire.API.User import Wire.API.User.Activation (ActivationCode, ActivationKey) import Wire.API.User.Client (Client (..)) +-- | A typed description of something that happened to an app in a team. Each +-- constructor corresponds to a distinct admin-notification email (and template). +-- +-- Most of the `Maybe`s are implausible or impossible corner cases, +-- Nothing is handled in `renderAppEventEmail`. +-- +-- See https://www.figma.com/design/AMNqFhTUElOZDJfbUYnMmJ/Apps--Services----Integrations?node-id=431-2452 +data AppEvent + = NewAppCreated + { actorName :: Maybe Name, + actorEmail :: Maybe EmailAddress, + newAppName :: Maybe Name, + appCreatedAt :: Maybe UTCTimeMillis + {- TODO: appPermissions :: AppPermissions -} + } + | DetailsChangedForApp + { actorName :: Maybe Name, + actorEmail :: Maybe EmailAddress, + newAppName :: Maybe Name, + appCreatedAt :: Maybe UTCTimeMillis, + oldAppName :: Maybe Name + } + | AppTokenUpdated + { actorName :: Maybe Name, + actorEmail :: Maybe EmailAddress, + newAppName :: Maybe Name, + appCreatedAt :: Maybe UTCTimeMillis + } + | AppDeleted + { actorName :: Maybe Name, + actorEmail :: Maybe EmailAddress, + newAppName :: Maybe Name, + appCreatedAt :: Maybe UTCTimeMillis + } + | AppAvailabilityChanged + { actorName :: Maybe Name, + actorEmail :: Maybe EmailAddress, + newAppName :: Maybe Name, + appCreatedAt :: Maybe UTCTimeMillis + } + deriving (Eq, Show) + data EmailSubsystem m a where SendPasswordResetMail :: EmailAddress -> PasswordResetPair -> Maybe Locale -> EmailSubsystem m () SendVerificationMail :: EmailAddress -> ActivationKey -> ActivationCode -> Maybe Locale -> EmailSubsystem m () @@ -61,5 +105,19 @@ data EmailSubsystem m a where Maybe URI -> Maybe Locale -> EmailSubsystem m () + SendAppEventEmail :: + -- | recipient email + EmailAddress -> + -- | recipient name + Name -> + -- | team the app belongs to + TeamId -> + -- | app id + UserId -> + -- | the event that occurred + AppEvent -> + -- | recipient locale + Maybe Locale -> + EmailSubsystem m () makeSem ''EmailSubsystem diff --git a/libs/wire-subsystems/src/Wire/EmailSubsystem/Interpreter.hs b/libs/wire-subsystems/src/Wire/EmailSubsystem/Interpreter.hs index 5a9b54fa14d..bb8c1a62ae7 100644 --- a/libs/wire-subsystems/src/Wire/EmailSubsystem/Interpreter.hs +++ b/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 tid appId event mLocale -> + sendAppEventEmailImpl teamTpls branding email name tid appId event mLocale ------------------------------------------------------------------------------- -- Verification Email for @@ -698,6 +700,73 @@ renderIdPConfigChangeEmail email IdPConfigChangeEmailTemplate {..} branding adde & Map.insert "subject" (T.pack d.subject) & Map.insert "issuer" (T.pack d.issuer) +------------------------------------------------------------------------------- +-- App Event Email + +-- https://www.figma.com/design/AMNqFhTUElOZDJfbUYnMmJ/Apps--Services----Integrations?node-id=431-2452&p=f&t=PVFSkjqPlWKxbHUw-0 + +-- | The action label substituted into the (currently single, mocked) app-event +-- template. This is where the per-'AppEvent' template selection happens; once +-- real per-event templates exist, dispatch on the constructor here instead. +appEventAction :: AppEvent -> Text +appEventAction = \case + NewAppCreated {} -> "created" + DetailsChangedForApp {} -> "details_changed" + AppTokenUpdated {} -> "token_updated" + AppDeleted {} -> "deleted" + AppAvailabilityChanged {} -> "availability_changed" + +sendAppEventEmailImpl :: + (Member EmailSending r, Member TinyLog r) => + Localised TeamTemplates -> + Map Text Text -> + EmailAddress -> + Name -> + TeamId -> + UserId -> + AppEvent -> + Maybe Locale -> + Sem r () +sendAppEventEmailImpl teamTemplates branding email name tid appId event mLocale = do + let tpl = appEventEmail . snd $ forLocale mLocale teamTemplates + mail <- logEmailRenderErrors "app event email" $ renderAppEventEmail email name tid appId event tpl branding + sendMail mail + +renderAppEventEmail :: + (Member (Output Text) r) => + EmailAddress -> + Name -> + TeamId -> + UserId -> + AppEvent -> + AppEventEmailTemplate -> + Map Text Text -> + Sem r Mail +renderAppEventEmail email name tid appId event AppEventEmailTemplate {..} branding = do + let replace = + branding + & Map.insert "action" (appEventAction event) + & Map.insert "app_name" (maybe "-/-" fromName event.newAppName) + & Map.insert "app_id" (idToText appId) + & Map.insert "team_id" (idToText tid) + & Map.insert "actor_name" (maybe "-/-" fromName event.actorName) + & Map.insert "actor_email" (maybe "-/-" fromEmail event.actorEmail) + 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 diff --git a/libs/wire-subsystems/src/Wire/EmailSubsystem/Template.hs b/libs/wire-subsystems/src/Wire/EmailSubsystem/Template.hs index 2a2550cfd35..2717d628e5b 100644 --- a/libs/wire-subsystems/src/Wire/EmailSubsystem/Template.hs +++ b/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 diff --git a/libs/wire-subsystems/src/Wire/EmailSubsystem/Templates/Team.hs b/libs/wire-subsystems/src/Wire/EmailSubsystem/Templates/Team.hs index 6833e6dae52..426c8a14669 100644 --- a/libs/wire-subsystems/src/Wire/EmailSubsystem/Templates/Team.hs +++ b/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 } diff --git a/libs/wire-subsystems/templates/en/team/email/app-event-subject.txt b/libs/wire-subsystems/templates/en/team/email/app-event-subject.txt new file mode 100644 index 00000000000..18188d5b58d --- /dev/null +++ b/libs/wire-subsystems/templates/en/team/email/app-event-subject.txt @@ -0,0 +1 @@ +App ${action} in your team \ No newline at end of file diff --git a/libs/wire-subsystems/templates/en/team/email/app-event.html b/libs/wire-subsystems/templates/en/team/email/app-event.html new file mode 100644 index 00000000000..1c33df2c72e --- /dev/null +++ b/libs/wire-subsystems/templates/en/team/email/app-event.html @@ -0,0 +1 @@ +App ${action} in your team

${brand_label_url}

App ${action} in your team

The app ${app_name} (ID: ${app_id}) was ${action} in your team.

Team ID:
${team_id}

Performed by user ID:
${actor_id}

If you did not expect this change, please review your team settings.

Privacy Policy and Terms of Use · Report misuse
${copyright}. All rights reserved.

                                                           
\ No newline at end of file diff --git a/libs/wire-subsystems/templates/en/team/email/app-event.txt b/libs/wire-subsystems/templates/en/team/email/app-event.txt new file mode 100644 index 00000000000..ca31d8857ab --- /dev/null +++ b/libs/wire-subsystems/templates/en/team/email/app-event.txt @@ -0,0 +1,15 @@ +[${brand_logo}] + +${brand_label_url} [${brand_url}] + +APP ${action} IN YOUR TEAM +The app "${app_name}" (ID: ${app_id}) was ${action} in your team by ${actor_handle}. + + +-------------------------------------------------------------------------------- + +If you did not expect this change, please review your team settings. +[${support}] + +Privacy Policy and Terms of Use [${legal}]ยท Report misuse [${misuse}] +${copyright}. All rights reserved. diff --git a/libs/wire-subsystems/test/unit/Wire/AppSubsystem/InterpreterSpec.hs b/libs/wire-subsystems/test/unit/Wire/AppSubsystem/InterpreterSpec.hs new file mode 100644 index 00000000000..07f2000de2a --- /dev/null +++ b/libs/wire-subsystems/test/unit/Wire/AppSubsystem/InterpreterSpec.hs @@ -0,0 +1,282 @@ +{-# OPTIONS_GHC -Wno-ambiguous-fields #-} + +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2025 Wire Swiss GmbH +-- +-- This program is free software: you can redistribute it and/or modify it under +-- the terms of the GNU Affero General Public License as published by the Free +-- Software Foundation, either version 3 of the License, or (at your option) any +-- later version. +-- +-- This program is distributed in the hope that it will be useful, but WITHOUT +-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more +-- details. +-- +-- You should have received a copy of the GNU Affero General Public License along +-- with this program. If not, see . + +module Wire.AppSubsystem.InterpreterSpec (spec) where + +import Data.Default (def) +import Data.Id +import Data.Json.Util +import Data.LegalHold (UserLegalHoldStatus (..), defUserLegalHoldStatus) +import Data.Map qualified as Map +import Data.Qualified +import Data.Range +import Data.Tagged (Tagged) +import Imports +import Polysemy +import Polysemy.Error +import Polysemy.Input +import Polysemy.Internal +import Polysemy.State +import Polysemy.TinyLog (TinyLog) +import Test.Hspec +import Test.Hspec.QuickCheck +import Test.QuickCheck +import Wire.API.Error (ErrorS) +import Wire.API.Error.Galley (GalleyError (TeamMemberNotFound, TeamNotFound)) +import Wire.API.Team.Member +import Wire.API.Team.Permission +import Wire.API.Team.Role +import Wire.API.User +import Wire.AppStore hiding (deleteApp, updateApp) +import Wire.AppSubsystem +import Wire.AppSubsystem.Interpreter +import Wire.AuthenticationSubsystem +import Wire.EmailSubsystem +import Wire.Events (Events) +import Wire.GalleyAPIAccess +import Wire.MockInterpreters +import Wire.NotificationSubsystem +import Wire.Sem.Now (Now) +import Wire.Sem.Random (Random) +import Wire.StoredUser (StoredUser (..)) +import Wire.TeamSubsystem +import Wire.TeamSubsystem.GalleyAPI (interpretTeamSubsystemToGalleyAPI) +import Wire.UserKeyStore +import Wire.UserStore + +type LowerAppEffects = + '[ Now, + Random, + TinyLog, + Input AppSubsystemConfig, + State [Push], + State [MiniEvent], + State (Map EmailAddress [SentMail]), + State [StoredApp], + Error AppSubsystemError, + ErrorS 'TeamMemberNotFound, + ErrorS 'TeamNotFound + ] + +-- | I wonder if we should do this everywhere? +(.<) :: (a -> b) -> (b -> c) -> a -> c +f .< g = g . f + +infixr 9 .< + +runLowerAppEffects :: + [StoredApp] -> + Sem (LowerAppEffects `Append` r) a -> + Sem r (Either AppSubsystemError (a, Map EmailAddress [SentMail])) +runLowerAppEffects initialApps = + interpretNowConst defaultTime + .< runRandomPure + .< noopLogger + .< runInputConst def + .< evalState @[Push] [] + .< evalState @[MiniEvent] [] + .< runState @(Map EmailAddress [SentMail]) mempty + .< evalState @[StoredApp] initialApps + .< runError @AppSubsystemError + .< runError @(Tagged 'TeamMemberNotFound ()) + .< runError @(Tagged 'TeamNotFound ()) + .< fmap (either (error . show) (either (error . show) (fmap swap))) + +-- | Run a single AppSubsystem operation and return the emails that were sent. +-- UserSubsystem and AuthenticationSubsystem are stubs: they crash loudly if invoked. +runAppEffects :: + [StoredUser] -> + [StoredApp] -> + Map TeamId [TeamMember] -> + Sem + ( '[ AppSubsystem, + TeamSubsystem, + GalleyAPIAccess, + UserStore, + UserKeyStore, + AppStore, + EmailSubsystem, + NotificationSubsystem, + Events + ] + `Append` LowerAppEffects + ) + a -> + Either AppSubsystemError (a, Map EmailAddress [SentMail]) +runAppEffects initialUsers initialApps teams action = + run + . ( runAppSubsystem inMemoryUserSubsystemInterpreter stubAuthSubsystem + .< interpretTeamSubsystemToGalleyAPI + .< miniGalleyAPIAccess teams def + .< runInMemoryUserStoreInterpreter initialUsers mempty + .< runInMemoryUserKeyStoreIntepreterWithStoredUsers initialUsers + .< inMemoryAppStoreInterpreter + .< inMemoryEmailSubsystemInterpreter + .< inMemoryNotificationSubsystemInterpreter + .< miniEventInterpreter + .< runLowerAppEffects initialApps + ) + $ action + where + stubAuthSubsystem :: forall r. InterpreterFor AuthenticationSubsystem r + stubAuthSubsystem = interpret $ \case + _ -> error "AuthenticationSubsystem: unexpected call in AppSubsystem unit test" + +-- | Minimal StoredUser with only the fields we care about set. +mkStoredUser :: UserId -> Name -> Maybe EmailAddress -> Maybe TeamId -> StoredUser +mkStoredUser uid uname email tid = + StoredUser + { id = uid, + userType = Nothing, + name = uname, + textStatus = Nothing, + pict = Nothing, + email = email, + emailUnvalidated = Nothing, + ssoId = Nothing, + accentId = ColourId 0, + assets = Nothing, + activated = True, + status = Just Active, + expires = Nothing, + language = Nothing, + country = Nothing, + providerId = Nothing, + serviceId = Nothing, + handle = Nothing, + teamId = tid, + managedBy = Nothing, + supportedProtocols = Nothing, + searchable = Nothing + } + +-- | A team member with full (owner) permissions, so they pass both CreateApp +-- and isAdminOrOwner checks. +mkOwnerMember :: UserId -> TeamMember +mkOwnerMember uid = mkTeamMember uid fullPermissions Nothing UserLegalHoldDisabled + +-- | A minimal StoredApp. +mkStoredApp :: UserId -> TeamId -> UserId -> StoredApp +mkStoredApp appId tid creatorId = + StoredApp + { id = appId, + teamId = tid, + meta = mempty, + category = Category "other", + description = unsafeRange "", + creator = creatorId + } + +spec :: Spec +spec = describe "AppSubsystem" $ do + describe "deleteApp" $ do + prop "sends an email to each team admin that has an email address" $ + \(tid :: TeamId) (appId :: UserId) (creatorId :: UserId) (creatorEmail :: EmailAddress) (adminId :: UserId) (adminEmail :: EmailAddress) (appName :: Name) -> + appId /= creatorId && creatorId /= adminId && appId /= adminId ==> + let appUser = mkStoredUser appId appName Nothing (Just tid) + creator = mkStoredUser creatorId (Name "Creator") (Just creatorEmail) (Just tid) + admin = mkStoredUser adminId (Name "Admin") (Just adminEmail) (Just tid) + storedApp = mkStoredApp appId tid creatorId + teams :: Map TeamId [TeamMember] = + Map.singleton + tid + [ mkOwnerMember adminId, + let perms = rolePermissions RoleMember + info = Just (creatorId, (toUTCTimeMillis defaultTime)) + in mkTeamMember appId perms info defUserLegalHoldStatus + ] + result = runAppEffects [appUser, creator, admin] [storedApp] teams $ do + deleteApp tid appId + in case result of + Left err -> counterexample (show err) False + Right ((), sentEmails) -> + Map.lookup adminEmail sentEmails + === Just + [ SentMail + Nothing + ( AppEventMail + tid + appId + AppDeleted + { actorName = Just (Name "Creator"), + actorEmail = Just creatorEmail, + newAppName = Just appName, + appCreatedAt = Just (toUTCTimeMillis defaultTime) + } + ) + ] + + prop "skips admins without an email address" $ + \(tid :: TeamId) (appId :: UserId) (creatorId :: UserId) (adminId :: UserId) -> + let appUser = mkStoredUser appId (Name "App") Nothing (Just tid) + adminNoEmail = mkStoredUser adminId (Name "Admin") Nothing (Just tid) + storedApp = mkStoredApp appId tid creatorId + teams = Map.singleton tid [mkOwnerMember adminId] + result = runAppEffects [appUser, adminNoEmail] [storedApp] teams $ deleteApp tid appId + in case result of + Left err -> counterexample (show err) False + Right ((), sentEmails) -> sentEmails === mempty + + prop "sends to all admins in the team" $ + \(tid :: TeamId) (appId :: UserId) (creatorId :: UserId) (admin1Id :: UserId) (admin1Email :: EmailAddress) (admin2Id :: UserId) (admin2Email :: EmailAddress) -> + admin1Id /= admin2Id && admin1Email /= admin2Email ==> + let appUser = mkStoredUser appId (Name "App") Nothing (Just tid) + admin1 = mkStoredUser admin1Id (Name "Admin1") (Just admin1Email) (Just tid) + admin2 = mkStoredUser admin2Id (Name "Admin2") (Just admin2Email) (Just tid) + storedApp = mkStoredApp appId tid creatorId + teams = Map.singleton tid [mkOwnerMember admin1Id, mkOwnerMember admin2Id] + result = runAppEffects [appUser, admin1, admin2] [storedApp] teams $ deleteApp tid appId + in case result of + Left err -> counterexample (show err) False + Right ((), sentEmails) -> + counterexample (show sentEmails) $ + Map.size sentEmails === 2 + + describe "updateApp" $ do + prop "sends an email to each team admin that has an email address" $ + \(tid :: TeamId) (appId :: UserId) (actorId :: UserId) (adminId :: UserId) (adminEmail :: EmailAddress) (newName :: Name) -> + appId /= actorId && actorId /= adminId ==> + let lusr = toLocalUnsafe testDomain actorId + actor = mkStoredUser actorId (Name "Actor") Nothing (Just tid) + appUser = mkStoredUser appId (Name "App") Nothing (Just tid) + admin = mkStoredUser adminId (Name "Admin") (Just adminEmail) (Just tid) + storedApp = mkStoredApp appId tid actorId + teams = Map.singleton tid [mkOwnerMember actorId, mkOwnerMember adminId] + upd = PutApp {name = Just newName, assets = Nothing, accentId = Nothing, category = Nothing, description = Nothing} + result = runAppEffects [actor, appUser, admin] [storedApp] teams $ updateApp lusr tid appId upd + in case result of + Left err -> counterexample (show err) False + Right ((), sentEmails) -> + counterexample (show sentEmails) $ + Map.member adminEmail sentEmails === True + + prop "skips admins without an email address" $ + \(tid :: TeamId) (appId :: UserId) (actorId :: UserId) (adminId :: UserId) (newName :: Name) -> + appId /= actorId && actorId /= adminId ==> + let lusr = toLocalUnsafe testDomain actorId + actor = mkStoredUser actorId (Name "Actor") Nothing (Just tid) + appUser = mkStoredUser appId (Name "App") Nothing (Just tid) + adminNoEmail = mkStoredUser adminId (Name "Admin") Nothing (Just tid) + storedApp = mkStoredApp appId tid actorId + teams = Map.singleton tid [mkOwnerMember actorId, mkOwnerMember adminId] + upd = PutApp {name = Just newName, assets = Nothing, accentId = Nothing, category = Nothing, description = Nothing} + result = runAppEffects [actor, appUser, adminNoEmail] [storedApp] teams $ updateApp lusr tid appId upd + in case result of + Left err -> counterexample (show err) False + Right ((), sentEmails) -> sentEmails === mempty diff --git a/libs/wire-subsystems/test/unit/Wire/MockInterpreters/AppStore.hs b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/AppStore.hs index cfad2f156f1..c4c99afe84b 100644 --- a/libs/wire-subsystems/test/unit/Wire/MockInterpreters/AppStore.hs +++ b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/AppStore.hs @@ -23,6 +23,7 @@ import Imports import Polysemy import Polysemy.State import Wire.AppStore +import Wire.AppStore qualified as Store inMemoryAppStoreInterpreter :: forall r. @@ -32,5 +33,9 @@ inMemoryAppStoreInterpreter = interpret $ \case CreateApp app -> modify (app :) GetApp uid tid -> gets $ find $ \app -> app.id == uid && app.teamId == tid GetApps tid -> gets $ filter $ \app -> app.teamId == tid - UpdateApp _owner _app _upd -> error $ "inMemoryAppStoreInterpreter: UpdateApp" + UpdateApp _teamId appId _upd -> + gets $ \apps -> + if any (\a -> a.id == appId) apps + then Right () + else Left Store.NotFound DeleteApp uid tid -> modify $ filter $ \app -> not (app.id == uid && app.teamId == tid) diff --git a/libs/wire-subsystems/test/unit/Wire/MockInterpreters/EmailSubsystem.hs b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/EmailSubsystem.hs index 305bebed550..409ee16bbb3 100644 --- a/libs/wire-subsystems/test/unit/Wire/MockInterpreters/EmailSubsystem.hs +++ b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/EmailSubsystem.hs @@ -1,3 +1,5 @@ +{-# OPTIONS_GHC -Wno-partial-fields #-} + -- This file is part of the Wire Server implementation. -- -- Copyright (C) 2025 Wire Swiss GmbH @@ -17,6 +19,7 @@ module Wire.MockInterpreters.EmailSubsystem where +import Data.Id import Data.Map qualified as Map import Imports import Polysemy @@ -30,12 +33,20 @@ data SentMail = SentMail } deriving (Show, Eq) -data SentMailContent = PasswordResetMail PasswordResetPair +data SentMailContent + = PasswordResetMail PasswordResetPair + | AppEventMail + { aeTeamId :: TeamId, + aeAppId :: UserId, + aeEvent :: AppEvent + } deriving (Show, Eq) inMemoryEmailSubsystemInterpreter :: (Member (State (Map EmailAddress [SentMail])) r) => InterpreterFor EmailSubsystem r inMemoryEmailSubsystemInterpreter = interpret \case SendPasswordResetMail email keyCodePair mLocale -> modify $ Map.insertWith (<>) email [SentMail mLocale $ PasswordResetMail keyCodePair] + SendAppEventEmail email _name tid appId event mLocale -> + modify $ Map.insertWith (<>) email [SentMail mLocale $ AppEventMail tid appId event] _ -> error "inMemoryEmailSubsystemInterpreter: implement on demand" getEmailsSentTo :: (Member (State (Map EmailAddress [SentMail])) r) => EmailAddress -> Sem r [SentMail] @@ -58,3 +69,4 @@ noopEmailSubsystemInterpreter = interpret \case SendMemberWelcomeEmail {} -> pure () SendNewTeamOwnerWelcomeEmail {} -> pure () SendSAMLIdPChanged {} -> pure () + SendAppEventEmail {} -> pure () diff --git a/libs/wire-subsystems/test/unit/Wire/MockInterpreters/UserSubsystem.hs b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/UserSubsystem.hs index c5feaeae032..7d9509131dd 100644 --- a/libs/wire-subsystems/test/unit/Wire/MockInterpreters/UserSubsystem.hs +++ b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/UserSubsystem.hs @@ -86,7 +86,7 @@ inMemoryUserSubsystemInterpreter = BlockListInsert _ -> error "BlockListInsert: implement on demand (userSubsystemInterpreter)" UpdateTeamSearchVisibilityInbound _ -> error "UpdateTeamSearchVisibilityInbound: implement on demand (userSubsystemInterpreter)" AcceptTeamInvitation {} -> error "AcceptTeamInvitation: implement on demand (userSubsystemInterpreter)" - InternalUpdateSearchIndex _ -> error "InternalUpdateSearchIndex: implement on demand (userSubsystemInterpreter)" + InternalUpdateSearchIndex _ -> pure () -- error "InternalUpdateSearchIndex: implement on demand (userSubsystemInterpreter)" InternalFindTeamInvitation {} -> error "InternalFindTeamInvitation: implement on demand (userSubsystemInterpreter)" GetUserExportData _ -> error "GetUserExportData: implement on demand (userSubsystemInterpreter)" RemoveEmailEither _ -> error "RemoveEmailEither: implement on demand (userSubsystemInterpreter)" diff --git a/libs/wire-subsystems/wire-subsystems.cabal b/libs/wire-subsystems/wire-subsystems.cabal index 680a8e71519..6ecea75a7be 100644 --- a/libs/wire-subsystems/wire-subsystems.cabal +++ b/libs/wire-subsystems/wire-subsystems.cabal @@ -579,6 +579,7 @@ test-suite wire-subsystems-tests other-modules: Spec Wire.ActivationCodeStore.InterpreterSpec + Wire.AppSubsystem.InterpreterSpec Wire.AuthenticationSubsystem.InterpreterSpec Wire.BrigAPIAccess.RpcSpec Wire.ClientSubsystem.InterpreterSpec