diff --git a/changelog.d/2-features/wpb-26705-meeting-events.md b/changelog.d/2-features/wpb-26705-meeting-events.md new file mode 100644 index 00000000000..6eff9dce988 --- /dev/null +++ b/changelog.d/2-features/wpb-26705-meeting-events.md @@ -0,0 +1,7 @@ +* Added meeting lifecycle events: `meeting.create`, `meeting.update`, and + `meeting.delete` (WPB-26705). These websocket notifications are pushed to all + local members of the meeting's conversation on every successful create, update, + and delete operation. The events use the standard conversation event envelope: + each payload contains the event `type`, the meeting's qualified ID in the `data` + field, the `qualified_conversation`, `qualified_from`, `via`, `time`, and + optional `team`. diff --git a/integration/test/Notifications.hs b/integration/test/Notifications.hs index 67281da2d6e..9b1aa274a0f 100644 --- a/integration/test/Notifications.hs +++ b/integration/test/Notifications.hs @@ -196,6 +196,18 @@ isConvCreateMeetingNotif :: (HasCallStack, MakesValue a) => a -> App Bool isConvCreateMeetingNotif n = fieldEquals n "payload.0.type" "conversation.create-meeting" +isMeetingCreateNotif :: (HasCallStack, MakesValue a) => a -> App Bool +isMeetingCreateNotif n = + fieldEquals n "payload.0.type" "meeting.create" + +isMeetingUpdateNotif :: (HasCallStack, MakesValue a) => a -> App Bool +isMeetingUpdateNotif n = + fieldEquals n "payload.0.type" "meeting.update" + +isMeetingDeleteNotif :: (HasCallStack, MakesValue a) => a -> App Bool +isMeetingDeleteNotif n = + fieldEquals n "payload.0.type" "meeting.delete" + -- | like 'isConvCreateNotif' but excludes self conversations isConvCreateNotifNotSelf :: (HasCallStack, MakesValue a) => a -> App Bool isConvCreateNotifNotSelf n = diff --git a/integration/test/Test/Meetings.hs b/integration/test/Test/Meetings.hs index 5355471b5cf..8b237f42a6f 100644 --- a/integration/test/Test/Meetings.hs +++ b/integration/test/Test/Meetings.hs @@ -10,7 +10,7 @@ import qualified Data.Text.Encoding as Text import Data.Time.Clock import qualified Data.Time.Format as Time import MLS.Util -import Notifications (isConvCreateMeetingNotif) +import Notifications (isConvCreateMeetingNotif, isMeetingCreateNotif, isMeetingDeleteNotif, isMeetingUpdateNotif) import SetupHelpers import System.Timeout (timeout) import Testlib.Prelude @@ -31,6 +31,7 @@ testMeetingCreate = do resp <- postMeetings owner newMeeting assertSuccess resp void $ awaitMatch isConvCreateMeetingNotif ws + void $ awaitMatch isMeetingCreateNotif ws getJSON 201 resp meeting %. "title" `shouldMatch` ("Team Standup" :: String) @@ -202,8 +203,11 @@ testMeetingRecurrence = do "recurrence" .= updatedRecurrence ] - r2 <- putMeeting owner domain meetingId updatedMeeting - assertSuccess r2 + r2 <- withWebSocket owner $ \ws -> do + resp <- putMeeting owner domain meetingId updatedMeeting + assertSuccess resp + void $ awaitMatch isMeetingUpdateNotif ws + pure resp updated <- getJSON 200 r2 updated %. "title" `shouldMatch` ("Updated Standup" :: String) @@ -443,7 +447,9 @@ testMeetingDelete = do assertSuccess r1 meeting <- getJSON 201 r1 (meetingId, domain) <- getMeetingIdAndDomain meeting - deleteMeeting owner domain meetingId >>= assertStatus 200 + withWebSocket owner $ \ws -> do + deleteMeeting owner domain meetingId >>= assertStatus 200 + void $ awaitMatch isMeetingDeleteNotif ws getMeeting owner domain meetingId >>= assertStatus 404 testMeetingDeleteNotFound :: (HasCallStack) => App () diff --git a/libs/wire-api/src/Wire/API/Event/Conversation.hs b/libs/wire-api/src/Wire/API/Event/Conversation.hs index a75477d2ade..5ae6a3a5b89 100644 --- a/libs/wire-api/src/Wire/API/Event/Conversation.hs +++ b/libs/wire-api/src/Wire/API/Event/Conversation.hs @@ -58,6 +58,9 @@ module Wire.API.Event.Conversation _EdMLSMessage, _EdMLSWelcome, _EdAddPermissionUpdate, + _EdMeetingCreate, + _EdMeetingUpdate, + _EdMeetingDelete, -- * Event data helpers SimpleMember (..), @@ -194,6 +197,9 @@ data EventType | ProtocolUpdate | AddPermissionUpdate | ConvHistoryUpdate + | MeetingCreate + | MeetingUpdate + | MeetingDelete deriving stock (Eq, Show, Generic, Enum, Bounded, Ord) deriving (Arbitrary) via (GenericUniform EventType) deriving (FromJSON, ToJSON, S.ToSchema) via Schema EventType @@ -222,7 +228,10 @@ instance ToSchema EventType where element "conversation.mls-welcome" MLSWelcome, element "conversation.protocol-update" ProtocolUpdate, element "conversation.add-permission-update" AddPermissionUpdate, - element "conversation.history-update" ConvHistoryUpdate + element "conversation.history-update" ConvHistoryUpdate, + element "meeting.create" MeetingCreate, + element "meeting.update" MeetingUpdate, + element "meeting.delete" MeetingDelete ] data EventData @@ -247,6 +256,9 @@ data EventData | EdProtocolUpdate P.ProtocolTag | EdAddPermissionUpdate Conv.AddPermissionUpdate | EdConvHistoryUpdate History + | EdMeetingCreate (Qualified MeetingId) + | EdMeetingUpdate (Qualified MeetingId) + | EdMeetingDelete (Qualified MeetingId) deriving stock (Eq, Show, Generic) genEventData :: EventType -> QC.Gen EventData @@ -272,6 +284,9 @@ genEventData = \case ProtocolUpdate -> EdProtocolUpdate <$> arbitrary AddPermissionUpdate -> EdAddPermissionUpdate <$> arbitrary ConvHistoryUpdate -> EdConvHistoryUpdate <$> arbitrary + MeetingCreate -> EdMeetingCreate <$> arbitrary + MeetingUpdate -> EdMeetingUpdate <$> arbitrary + MeetingDelete -> EdMeetingDelete <$> arbitrary eventDataType :: EventData -> EventType eventDataType (EdMembersJoin _) = MemberJoin @@ -295,6 +310,9 @@ eventDataType (EdConvReset _) = ConvReset eventDataType (EdProtocolUpdate _) = ProtocolUpdate eventDataType (EdAddPermissionUpdate _) = AddPermissionUpdate eventDataType (EdConvHistoryUpdate _) = ConvHistoryUpdate +eventDataType (EdMeetingCreate _) = MeetingCreate +eventDataType (EdMeetingUpdate _) = MeetingUpdate +eventDataType (EdMeetingDelete _) = MeetingDelete createConversationEventData :: OwnConversation GroupConvType -> EventData @@ -326,6 +344,9 @@ isCellsConversationEvent eventType = ProtocolUpdate -> False AddPermissionUpdate -> False ConvHistoryUpdate -> False + MeetingCreate -> False + MeetingUpdate -> False + MeetingDelete -> False -------------------------------------------------------------------------------- -- Event data helpers @@ -529,6 +550,9 @@ taggedEventDataSchema = ProtocolUpdate -> tag _EdProtocolUpdate (unnamed (unProtocolUpdate <$> P.ProtocolUpdate .= schema)) AddPermissionUpdate -> tag _EdAddPermissionUpdate (unnamed schema) ConvHistoryUpdate -> tag _EdConvHistoryUpdate (unnamed schema) + MeetingCreate -> tag _EdMeetingCreate (unnamed schema) + MeetingUpdate -> tag _EdMeetingUpdate (unnamed schema) + MeetingDelete -> tag _EdMeetingDelete (unnamed schema) memberLeaveSchema :: ValueSchema NamedSwaggerDoc (EdMemberLeftReason, QualifiedUserIdList) memberLeaveSchema = diff --git a/libs/wire-api/test/unit/Test/Wire/API/Conversation.hs b/libs/wire-api/test/unit/Test/Wire/API/Conversation.hs index aa9527a3e69..4c9f6fbe679 100644 --- a/libs/wire-api/test/unit/Test/Wire/API/Conversation.hs +++ b/libs/wire-api/test/unit/Test/Wire/API/Conversation.hs @@ -85,6 +85,9 @@ testIsCellsConversationEvent = OtrMessageAdd -> isCellsConversationEvent e === False ProtocolUpdate -> isCellsConversationEvent e === False Typing -> isCellsConversationEvent e === False + MeetingCreate -> isCellsConversationEvent e === False + MeetingUpdate -> isCellsConversationEvent e === False + MeetingDelete -> isCellsConversationEvent e === False -------------------------------------------------------------------------------- -- Legacy conversion tests diff --git a/libs/wire-subsystems/src/Wire/MeetingsSubsystem/Interpreter.hs b/libs/wire-subsystems/src/Wire/MeetingsSubsystem/Interpreter.hs index 77602276cad..38ccb3f569f 100644 --- a/libs/wire-subsystems/src/Wire/MeetingsSubsystem/Interpreter.hs +++ b/libs/wire-subsystems/src/Wire/MeetingsSubsystem/Interpreter.hs @@ -26,6 +26,7 @@ import Data.ByteString.Conversion (toByteString') import Data.Default (def) import Data.Domain (Domain) import Data.Id +import Data.Json.Util (toJSONObject) import Data.Map qualified as Map import Data.Qualified (Local, Qualified (..), inputQualifyLocal, qualifyAs, tDomain, tUnqualified) import Data.Range (Range, unsafeRange) @@ -40,7 +41,9 @@ import Polysemy.TinyLog qualified as TinyLog import System.Logger qualified as Log import Wire.API.Conversation hiding (Member) import Wire.API.Conversation.Role (roleNameWireAdmin) +import Wire.API.Event.Conversation qualified as ConvEvent import Wire.API.Meeting qualified as API +import Wire.API.Push.V2 qualified as PushV2 import Wire.API.Routes.MultiTablePaging qualified as MultiTablePaging import Wire.API.Team.Feature (FeatureStatus (..), LockableFeature (..), MeetingsConfig) import Wire.API.User (BaseProtocolTag (BaseProtocolMLSTag), EmailAddress) @@ -49,6 +52,7 @@ import Wire.ConversationSubsystem qualified as ConversationSubsystem import Wire.FeaturesConfigSubsystem (FeaturesConfigSubsystem, getFeatureForTeam) import Wire.MeetingsStore qualified as Store import Wire.MeetingsSubsystem +import Wire.NotificationSubsystem import Wire.Sem.Now (Now) import Wire.Sem.Now qualified as Now import Wire.StoredConversation @@ -83,6 +87,7 @@ interpretMeetingsSubsystem :: Member ConversationSubsystem r, Member TeamSubsystem r, Member FeaturesConfigSubsystem r, + Member NotificationSubsystem r, Member Now r, Member TinyLog r, Member (Error MeetingError) r, @@ -115,6 +120,8 @@ createMeetingImpl :: Member ConversationSubsystem r, Member TeamSubsystem r, Member FeaturesConfigSubsystem r, + Member NotificationSubsystem r, + Member Now r, Member (Error MeetingError) r ) => Local UserId -> @@ -171,6 +178,9 @@ createMeetingImpl zUser newMeeting = do newMeeting.invitedEmails trial + let qMeetingId = Qualified storedMeeting.id (tDomain zUser) + pushMeetingEvent zUser Nothing storedConv.localMembers (Qualified storedConv.id_ (tDomain zUser)) conversationTeamId (ConvEvent.EdMeetingCreate qMeetingId) + pure $ storedMeetingToMeetingWithConversation zUser storedConv storedMeeting updateMeetingImpl :: @@ -178,6 +188,7 @@ updateMeetingImpl :: Member ConversationSubsystem r, Member TeamSubsystem r, Member FeaturesConfigSubsystem r, + Member NotificationSubsystem r, Member TinyLog r, Member (Error MeetingError) r, Member Now r @@ -213,6 +224,7 @@ updateMeetingImpl zUser meetingId update validityPeriod = do update.endTime update.recurrence conv <- MaybeT $ getMeetingConversationOrFail meetingId updatedMeeting.conversationId + lift $ pushMeetingEvent zUser Nothing conv.localMembers (Qualified conv.id_ (tDomain zUser)) maybeTeamId (ConvEvent.EdMeetingUpdate meetingId) pure $ storedMeetingToMeetingWithConversation zUser conv updatedMeeting deleteMeetingImpl :: @@ -220,6 +232,7 @@ deleteMeetingImpl :: Member ConversationSubsystem r, Member TeamSubsystem r, Member FeaturesConfigSubsystem r, + Member NotificationSubsystem r, Member TinyLog r, Member (Error MeetingError) r, Member Now r @@ -248,6 +261,7 @@ deleteMeetingImpl zUser connId meetingId validityPeriod = do void $ ConversationSubsystem.deleteLocalConversation zUser connId lConvId lift $ Store.deleteMeeting (qUnqualified meetingId) + lift $ pushMeetingEvent zUser (Just connId) conv.localMembers (Qualified conv.id_ (tDomain zUser)) maybeTeamId (ConvEvent.EdMeetingDelete meetingId) pure $ isJust result getMeetingImpl :: @@ -304,6 +318,43 @@ getMeetingConversationOrFail meetingId convId = do . Log.field "meetingId" (toByteString' (qUnqualified meetingId)) pure Nothing +-- | Push a meeting lifecycle event to all local members of the meeting's +-- conversation via the 'NotificationSubsystem'. Meetings are not federated, so +-- only local members are notified. +pushMeetingEvent :: + ( Member NotificationSubsystem r, + Member Now r + ) => + Local UserId -> + Maybe ConnId -> + [LocalMember] -> + Qualified ConvId -> + Maybe TeamId -> + ConvEvent.EventData -> + Sem r () +pushMeetingEvent lUser conn members qConvId mTeamId edata = do + now <- Now.get + let evt = + ConvEvent.Event + { evtConv = qConvId, + evtSubConv = Nothing, + evtFrom = + ConvEvent.EventFromUser + (Qualified (tUnqualified lUser) (tDomain lUser)), + evtTime = now, + evtTeam = mTeamId, + evtData = edata + } + pushNotifications + [ def + { origin = Just (tUnqualified lUser), + json = toJSONObject evt, + recipients = map localMemberToRecipient members, + route = PushV2.RouteDirect, + conn + } + ] + -- Helper function to convert StoredMeeting to API.Meeting storedMeetingToMeeting :: Domain -> Store.StoredMeeting -> API.Meeting storedMeetingToMeeting domain sm = diff --git a/libs/wire-subsystems/test/unit/Wire/MeetingsSubsystem/InterpreterSpec.hs b/libs/wire-subsystems/test/unit/Wire/MeetingsSubsystem/InterpreterSpec.hs index 03fb7b2288a..fd63a40687a 100644 --- a/libs/wire-subsystems/test/unit/Wire/MeetingsSubsystem/InterpreterSpec.hs +++ b/libs/wire-subsystems/test/unit/Wire/MeetingsSubsystem/InterpreterSpec.hs @@ -17,6 +17,7 @@ module Wire.MeetingsSubsystem.InterpreterSpec (spec) where +import Data.Aeson (Result (..), Value (Object), fromJSON) import Data.ByteString.Char8 qualified as C import Data.Default (def) import Data.Domain (Domain (..)) @@ -43,6 +44,7 @@ import Text.Email.Parser (unsafeEmailAddress) import Wire.API.Conversation (Access (InviteAccess, PrivateAccess), Conversation (metadata, qualifiedId), ConversationMetadata (cnvmAccess)) import Wire.API.Error (ErrorS) import Wire.API.Error.Galley (GalleyError (TeamMemberNotFound, TeamNotFound)) +import Wire.API.Event.Conversation qualified as ConvEvent import Wire.API.Meeting qualified as API import Wire.API.Team.Feature import Wire.API.Team.Member (TeamMember, mkTeamMember) @@ -54,6 +56,7 @@ import Wire.MeetingsStore qualified as Store import Wire.MeetingsSubsystem import Wire.MeetingsSubsystem.Interpreter import Wire.MockInterpreters +import Wire.NotificationSubsystem (NotificationSubsystem, Push (..)) import Wire.Sem.Logger.TinyLog (discardTinyLogs) import Wire.Sem.Now (Now) import Wire.Sem.Random (Random) @@ -67,11 +70,13 @@ type TestStack = ConversationSubsystem, TeamSubsystem, FeaturesConfigSubsystem, + NotificationSubsystem, TinyLog, Error MeetingError, State (Map MeetingId Store.StoredMeeting), State (Map ConvId StoredConversation), State (Map ConvId (Set UserId)), + State [Push], GalleyAPIAccess, Now, State UTCTime, @@ -117,17 +122,35 @@ runTestStack now gen teams configs = . evalState now . interpretNowAsState . miniGalleyAPIAccess teams configs + . evalState ([] :: [Push]) . evalState Map.empty . evalState Map.empty . evalState Map.empty . runError @MeetingError . discardTinyLogs + . inMemoryNotificationSubsystemInterpreter . interpretFeaturesConfigSubsystemPure configs . interpretTeamSubsystemToGalleyAPI . inMemoryConversationSubsystemInterpreter . inMemoryMeetingsStoreInterpreter . interpretMeetingsSubsystem 3600 +-- | Decode all 'Push' payloads that are conversation events carrying meeting +-- lifecycle data. +extractMeetingEvents :: [Push] -> [ConvEvent.Event] +extractMeetingEvents pushes = + [ e + | push <- pushes, + Success e <- [fromJSON (Object push.json)], + isMeetingEvent e + ] + where + isMeetingEvent e = case e.evtData of + ConvEvent.EdMeetingCreate _ -> True + ConvEvent.EdMeetingUpdate _ -> True + ConvEvent.EdMeetingDelete _ -> True + _ -> False + spec :: Spec spec = describe "MeetingsSubsystem.Interpreter" $ do it "creates a meeting and can retrieve it" $ do @@ -1191,3 +1214,98 @@ spec = describe "MeetingsSubsystem.Interpreter" $ do replaceInvitedEmails zUserTeam meeting.meeting.id [unsafeEmailAddress "test" "example.com"] result2 `shouldBe` Left MeetingsFeatureDisabled + + describe "meeting events" $ do + let now = UTCTime (fromGregorian 2026 1 1) 0 + gen = mkStdGen 42 + uid1 = Id $ read "00000000-0000-0000-0000-000000000001" + uid2 = Id $ read "00000000-0000-0000-0000-000000000002" + zUser1 = toLocalUnsafe (Domain "wire.com") uid1 + zUser2 = toLocalUnsafe (Domain "wire.com") uid2 + teamId = Id $ read "00000000-0000-0000-0000-000000000100" + teamMember1 = mkTeamMember uid1 fullPermissions Nothing UserLegalHoldDisabled + teamMember2 = mkTeamMember uid2 fullPermissions Nothing UserLegalHoldDisabled + teamConfig = + npUpdate @MeetingsConfig (LockableFeature FeatureStatusEnabled LockStatusUnlocked def) def + newMeeting = + API.NewMeeting + { title = fromJust $ checked "Event Test Meeting", + startTime = addUTCTime 3600 now, + endTime = addUTCTime 7200 now, + recurrence = Nothing, + invitedEmails = [] + } + + it "emits a meeting.create event on successful create" $ do + result <- + runTestStack now gen (Map.singleton teamId [teamMember1]) teamConfig $ do + meeting <- createMeeting zUser1 newMeeting + pushes <- get @[Push] + pure (meeting, pushes) + + case result of + Left err -> fail $ "Error: " <> show err + Right (meeting, pushes) -> do + let events = extractMeetingEvents pushes + length events `shouldBe` 1 + case (head events).evtData of + ConvEvent.EdMeetingCreate mid -> mid `shouldBe` meeting.meeting.id + other -> fail $ "expected EdMeetingCreate, got " <> show other + + it "emits a meeting.update event on successful update" $ do + result <- + runTestStack now gen (Map.singleton teamId [teamMember1]) teamConfig $ do + meeting <- createMeeting zUser1 newMeeting + put @[Push] [] + _ <- updateMeeting zUser1 meeting.meeting.id (API.UpdateMeeting Nothing Nothing (Just (unsafeRange "Updated")) Nothing) + get @[Push] + + case result of + Left err -> fail $ "Error: " <> show err + Right pushes -> do + let events = extractMeetingEvents pushes + length events `shouldBe` 1 + case (head events).evtData of + ConvEvent.EdMeetingUpdate _ -> pure () + other -> fail $ "expected EdMeetingUpdate, got " <> show other + + it "emits a meeting.delete event on successful delete" $ do + result <- + runTestStack now gen (Map.singleton teamId [teamMember1]) teamConfig $ do + meeting <- createMeeting zUser1 newMeeting + put @[Push] [] + _ <- deleteMeeting zUser1 (ConnId "test-conn") meeting.meeting.id + get @[Push] + + case result of + Left err -> fail $ "Error: " <> show err + Right pushes -> do + let events = extractMeetingEvents pushes + length events `shouldBe` 1 + case (head events).evtData of + ConvEvent.EdMeetingDelete _ -> pure () + other -> fail $ "expected EdMeetingDelete, got " <> show other + + it "does not emit an event when updateMeeting fails (non-creator)" $ do + result <- + runTestStack now gen (Map.singleton teamId [teamMember1, teamMember2]) teamConfig $ do + meeting <- createMeeting zUser1 newMeeting + put @[Push] [] + _ <- updateMeeting zUser2 meeting.meeting.id (API.UpdateMeeting Nothing Nothing (Just (unsafeRange "Hijack")) Nothing) + get @[Push] + + case result of + Left err -> fail $ "Error: " <> show err + Right pushes -> extractMeetingEvents pushes `shouldBe` [] + + it "does not emit an event when deleteMeeting fails (non-creator)" $ do + result <- + runTestStack now gen (Map.singleton teamId [teamMember1, teamMember2]) teamConfig $ do + meeting <- createMeeting zUser1 newMeeting + put @[Push] [] + _ <- deleteMeeting zUser2 (ConnId "test-conn") meeting.meeting.id + get @[Push] + + case result of + Left err -> fail $ "Error: " <> show err + Right pushes -> extractMeetingEvents pushes `shouldBe` []