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/Interpreter.hs b/libs/wire-subsystems/src/Wire/AppSubsystem/Interpreter.hs index 513deff6bfa..bd66d2d2620 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 (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 diff --git a/libs/wire-subsystems/src/Wire/EmailSubsystem.hs b/libs/wire-subsystems/src/Wire/EmailSubsystem.hs index 0ab910e724c..55f55629fe3 100644 --- a/libs/wire-subsystems/src/Wire/EmailSubsystem.hs +++ b/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 diff --git a/libs/wire-subsystems/src/Wire/EmailSubsystem/Interpreter.hs b/libs/wire-subsystems/src/Wire/EmailSubsystem/Interpreter.hs index 5a9b54fa14d..d8514fa2788 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 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 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..bd85542e3d9 --- /dev/null +++ b/libs/wire-subsystems/test/unit/Wire/AppSubsystem/InterpreterSpec.hs @@ -0,0 +1,243 @@ +{-# 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.Domain +import Data.Id +import Data.LegalHold (UserLegalHoldStatus (..)) +import Data.Map qualified as Map +import Data.Qualified +import Data.Tagged (Tagged) +import Imports +import Polysemy +import Polysemy.Error +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 (fullPermissions) +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.MockInterpreters +import Wire.MockInterpreters.EmailSubsystem (SentMail (..), SentMailContent (..)) +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.UserStore +import Wire.UserSubsystem + +-- | 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, + AppStore, + EmailSubsystem, + State (Map EmailAddress [SentMail]), + NotificationSubsystem, + State [Push], + Now, + TinyLog, + Input AppSubsystemConfig, + Error AppSubsystemError, + Random, + ErrorS 'TeamMemberNotFound, + ErrorS 'TeamNotFound + ] + a -> + Either AppSubsystemError (a, Map EmailAddress [SentMail]) +runAppEffects initialUsers initialApps teams action = + run + . fmap (either (error . show) (either (error . show) id)) + . runError @(Tagged 'TeamNotFound ()) + . runError @(Tagged 'TeamMemberNotFound ()) + . runRandomPure + . runError @AppSubsystemError + . runInputConst def + . noopLogger + . interpretNowConst defaultTime + . evalState @[Push] [] + . inMemoryNotificationSubsystemInterpreter + . runState @(Map EmailAddress [SentMail]) mempty + . inMemoryEmailSubsystemInterpreter + . evalState @[StoredApp] initialApps + . inMemoryAppStoreInterpreter + . runInMemoryUserStoreInterpreter initialUsers mempty + . miniGalleyAPIAccess teams def + . interpretTeamSubsystemToGalleyAPI + . runAppSubsystem stubUserSubsystem stubAuthSubsystem + $ action + where + stubAuthSubsystem :: forall r. InterpreterFor AuthenticationSubsystem r + stubAuthSubsystem = interpret $ \case + _ -> error "AuthenticationSubsystem: unexpected call in AppSubsystem unit test" + + stubUserSubsystem :: forall r. InterpreterFor UserSubsystem (AuthenticationSubsystem ': r) + stubUserSubsystem = interpret $ \case + _ -> error "UserSubsystem: 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) (adminId :: UserId) (adminEmail :: EmailAddress) (appName :: Name) -> + let appUser = mkStoredUser appId appName Nothing (Just tid) + admin = mkStoredUser adminId (Name "Admin") (Just adminEmail) (Just tid) + storedApp = mkStoredApp appId tid creatorId + teams = Map.singleton tid [mkOwnerMember adminId] + result = runAppEffects [appUser, admin] [storedApp] teams $ deleteApp tid appId + in case result of + Left err -> counterexample (show err) False + Right ((), sentEmails) -> + Map.lookup adminEmail sentEmails + === Just + [ SentMail + Nothing + AppEventMail + { aeAction = "deleted", + aeAppName = fromName appName, + aeAppId = appId, + aeTeamId = tid, + aeActorId = creatorId + } + ] + + 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 + -- actor is owner-level (has CreateApp); admin is also owner-level (isAdminOrOwner) + 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..848b60b6744 100644 --- a/libs/wire-subsystems/test/unit/Wire/MockInterpreters/EmailSubsystem.hs +++ b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/EmailSubsystem.hs @@ -17,6 +17,7 @@ module Wire.MockInterpreters.EmailSubsystem where +import Data.Id import Data.Map qualified as Map import Imports import Polysemy @@ -30,12 +31,22 @@ data SentMail = SentMail } deriving (Show, Eq) -data SentMailContent = PasswordResetMail PasswordResetPair +data SentMailContent + = PasswordResetMail PasswordResetPair + | AppEventMail + { aeAction :: Text, + aeAppName :: Text, + aeAppId :: UserId, + aeTeamId :: TeamId, + aeActorId :: UserId + } 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 action appName appId tid actorId mLocale -> + modify $ Map.insertWith (<>) email [SentMail mLocale $ AppEventMail action appName appId tid actorId] _ -> 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/wire-subsystems.cabal b/libs/wire-subsystems/wire-subsystems.cabal index 0f4c739c004..3d4f8cd54aa 100644 --- a/libs/wire-subsystems/wire-subsystems.cabal +++ b/libs/wire-subsystems/wire-subsystems.cabal @@ -577,6 +577,7 @@ test-suite wire-subsystems-tests other-modules: Spec Wire.ActivationCodeStore.InterpreterSpec + Wire.AppSubsystem.InterpreterSpec Wire.AuthenticationSubsystem.InterpreterSpec Wire.BrigAPIAccess.RpcSpec Wire.ClientSubsystem.InterpreterSpec