Skip to content
Open
Show file tree
Hide file tree
Changes from 1 commit
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
6 changes: 6 additions & 0 deletions changelog.d/2-features/WPB-21964-delete
Original file line number Diff line number Diff line change
@@ -0,0 +1,6 @@
`DELETE /meetings/:domain/:meetingId` for deleting meetings.

Authorization: only the meeting creator can delete the meeting.
Validity: meetings that ended too long ago cannot be deleted (configurable validity period).

When a meeting is deleted, the associated MLS conversation is also deleted if it's a MeetingConversation type.
5 changes: 5 additions & 0 deletions integration/test/API/Galley.hs
Original file line number Diff line number Diff line change
Expand Up @@ -990,6 +990,11 @@ putMeeting user domain meetingId updatedMeeting = do
req <- baseRequest user Galley Versioned (joinHttpPath ["meetings", domain, meetingId])
submit "PUT" $ req & addJSON updatedMeeting

deleteMeeting :: (HasCallStack, MakesValue user) => user -> String -> String -> App Response
deleteMeeting user domain meetingId = do
req <- baseRequest user Galley Versioned (joinHttpPath ["meetings", domain, meetingId])
submit "DELETE" req

getMeeting :: (HasCallStack, MakesValue user) => user -> String -> String -> App Response
getMeeting user domain meetingId = do
req <- baseRequest user Galley Versioned (joinHttpPath ["meetings", domain, meetingId])
Expand Down
48 changes: 48 additions & 0 deletions integration/test/Test/Meetings.hs
Original file line number Diff line number Diff line change
Expand Up @@ -197,3 +197,51 @@ testMeetingUpdateUnauthorized = do
]

putMeeting otherUser domain meetingId update >>= assertStatus 404

testMeetingDelete :: (HasCallStack) => App ()
testMeetingDelete = do
(owner, _tid, _members) <- createTeam OwnDomain 1
now <- liftIO getCurrentTime
let startTime = addUTCTime 3600 now
endTime = addUTCTime 7200 now
recurrenceUntil = addUTCTime (30 * 24 * 3600) now
recurrence =
object
[ "frequency" .= "daily",
"interval" .= (1 :: Int),
"until" .= recurrenceUntil
]
newMeeting =
object
[ "title" .= "Team Standup",
"start_time" .= startTime,
"end_time" .= endTime,
"invited_emails" .= ([] :: [String]),
"recurrence" .= recurrence
]
r1 <- postMeetings owner newMeeting
assertSuccess r1
meeting <- getJSON 201 r1
(meetingId, domain) <- getMeetingIdAndDomain meeting
deleteMeeting owner domain meetingId >>= assertStatus 200
getMeeting owner domain meetingId >>= assertStatus 404

testMeetingDeleteNotFound :: (HasCallStack) => App ()
testMeetingDeleteNotFound = do
(owner, _tid, _members) <- createTeam OwnDomain 1
fakeMeetingId <- randomId
deleteMeeting owner "example.com" fakeMeetingId >>= assertStatus 404

testMeetingDeleteUnauthorized :: (HasCallStack) => App ()
testMeetingDeleteUnauthorized = do
(owner, _tid, _members) <- createTeam OwnDomain 1
(otherUser, _, _membersOther) <- createTeam OwnDomain 1
now <- liftIO getCurrentTime
let startTime = addUTCTime 3600 now
endTime = addUTCTime 7200 now
newMeeting = defaultMeetingJson "Team Standup" startTime endTime []
r1 <- postMeetings owner newMeeting
assertSuccess r1
meeting <- getJSON 201 r1
(meetingId, domain) <- getMeetingIdAndDomain meeting
deleteMeeting otherUser domain meetingId >>= assertStatus 404
16 changes: 16 additions & 0 deletions libs/wire-api/src/Wire/API/Routes/Public/Galley/Meetings.hs
Original file line number Diff line number Diff line change
Expand Up @@ -62,6 +62,22 @@ type MeetingsAPI =
'[Respond 200 "Meeting updated" Meeting]
Meeting
)
:<|> Named
"delete-meeting"
( Summary "Delete a meeting"
:> From 'V15
:> ZLocalUser
:> "meetings"
:> Capture "domain" Domain
:> Capture "id" MeetingId
:> CanThrow 'MeetingNotFound
:> CanThrow 'AccessDenied
:> MultiVerb
'DELETE
'[JSON]
'[RespondEmpty 200 "Meeting deleted"]
()
)
:<|> Named
"get-meeting"
( Summary "Get a single meeting by ID"
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -43,7 +43,7 @@ import Wire.API.Team.HardTruncationLimit (hardTruncationLimit)
import Wire.API.UserGroup
import Wire.BackgroundJobsPublisher
import Wire.BackgroundJobsRunner (BackgroundJobsRunner (..))
import Wire.ConversationStore (ConversationStore, getConversation, upsertMembers)
import Wire.ConversationStore (ConversationStore, upsertMembers)
import Wire.ConversationSubsystem
import Wire.Sem.Random
import Wire.StoredConversation
Expand Down
2 changes: 2 additions & 0 deletions libs/wire-subsystems/src/Wire/ConversationSubsystem.hs
Original file line number Diff line number Diff line change
Expand Up @@ -67,5 +67,7 @@ data ConversationSubsystem m a where
ConvId ->
UserId ->
ConversationSubsystem m (Maybe LocalMember)
GetConversation :: ConvId -> ConversationSubsystem m (Maybe StoredConversation)
DeleteConversation :: ConvId -> ConversationSubsystem m ()

makeSem ''ConversationSubsystem
Original file line number Diff line number Diff line change
Expand Up @@ -145,6 +145,10 @@ interpretConversationSubsystem = interpret $ \case
internalGetClientIdsImpl uids
ConversationSubsystem.InternalGetLocalMember cid uid ->
ConvStore.getLocalMember cid uid
ConversationSubsystem.GetConversation cid ->
ConvStore.getConversation cid
ConversationSubsystem.DeleteConversation cid ->
ConvStore.deleteConversation cid
Copy link
Copy Markdown
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This is a bit strange, I would assume the ConversationSubsystem to also handle authorization/team membership checks.

Copy link
Copy Markdown
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I would agree, except that:

  • Other operations don't (I agree that it could be a defect)
  • As far as I can see, only getLocalConvForUser, in galley do directly check permissions.

Copy link
Copy Markdown
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

It is only delegating to ConversationStore, can't you use ConverstationStore directly where you need this? Otherwise it's the wrong abstraction, IMO.

Copy link
Copy Markdown
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

@akshaymankar reminded me that we should not use other's subsystems store in #4918 (comment)

Copy link
Copy Markdown
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

IDK, why shouldn't the meeting subsystem use the conversation store? Because a meeting is a conversation, right? (we should not be more catholic than the pope ;-))

Copy link
Copy Markdown
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

If you ask me, the right solution would be to move all the code related to conversation deletion from galley to the conversation subsystem, including all the permission checks and what not. Then call this from here and also from galley. This would also solve the other comment about the team to conversation index and other clean up operations that are still missing here. But this would take some more effort as there are a lot of dependencies.


createGroupConversationGeneric ::
forall r.
Expand Down
3 changes: 3 additions & 0 deletions libs/wire-subsystems/src/Wire/MeetingsStore.hs
Original file line number Diff line number Diff line change
Expand Up @@ -145,6 +145,9 @@ data MeetingsStore m a where
Maybe UTCTime ->
Maybe (Maybe Recurrence) ->
MeetingsStore m (Maybe StoredMeeting)
DeleteMeeting ::
MeetingId ->
MeetingsStore m ()
GetMeeting ::
MeetingId ->
MeetingsStore m (Maybe StoredMeeting)
Expand Down
25 changes: 25 additions & 0 deletions libs/wire-subsystems/src/Wire/MeetingsStore/Postgres.hs
Original file line number Diff line number Diff line change
Expand Up @@ -52,6 +52,8 @@ interpretMeetingsStoreToPostgres =
createMeetingImpl title creator startTime endTime recurrence convId emails trial
UpdateMeeting meetingId title startDate endDate schedule ->
updateMeetingImpl meetingId title startDate endDate schedule
DeleteMeeting meetingId ->
deleteMeetingImpl meetingId
GetMeeting meetingId ->
getMeetingImpl meetingId

Expand Down Expand Up @@ -238,6 +240,29 @@ updateMeetingImpl meetingId mTitle mStartDate mEndDate mRecurrence = do
created_at :: timestamptz, updated_at :: timestamptz
|]

-- * Delete

deleteMeetingImpl ::
( Member (Input Pool) r,
Member (Embed IO) r,
Member (Error UsageError) r
) =>
MeetingId ->
Sem r ()
deleteMeetingImpl meetingId = do
pool <- input
result <- liftIO $ use pool session
either throw pure result
where
session :: Session ()
session = statement (toUUID meetingId) deleteStatement
deleteStatement :: Statement UUID ()
deleteStatement =
[resultlessStatement|
DELETE FROM meetings
WHERE id = ($1 :: uuid)
|]

-- * Get

getMeetingImpl ::
Expand Down
4 changes: 4 additions & 0 deletions libs/wire-subsystems/src/Wire/MeetingsSubsystem.hs
Original file line number Diff line number Diff line change
Expand Up @@ -36,6 +36,10 @@ data MeetingsSubsystem m a where
Qualified MeetingId ->
UpdateMeeting ->
MeetingsSubsystem m (Maybe Meeting)
DeleteMeeting ::
Local UserId ->
Qualified MeetingId ->
MeetingsSubsystem m Bool
GetMeeting ::
Local UserId ->
Qualified MeetingId ->
Expand Down
34 changes: 34 additions & 0 deletions libs/wire-subsystems/src/Wire/MeetingsSubsystem/Interpreter.hs
Original file line number Diff line number Diff line change
Expand Up @@ -65,6 +65,8 @@ interpretMeetingsSubsystem validityPeriod = interpret $ \case
createMeetingImpl zUser newMeeting
UpdateMeeting zUser meetingId update ->
updateMeetingImpl zUser meetingId update validityPeriod
DeleteMeeting zUser meetingId ->
deleteMeetingImpl zUser meetingId validityPeriod
GetMeeting zUser meetingId ->
getMeetingImpl zUser meetingId validityPeriod

Expand Down Expand Up @@ -167,6 +169,38 @@ updateMeetingImpl zUser meetingId update validityPeriod = do
update.recurrence
pure $ storedMeetingToMeeting (tDomain zUser) updatedMeeting

deleteMeetingImpl ::
( Member Store.MeetingsStore r,
Member ConversationSubsystem r,
Member Now r
) =>
Local UserId ->
Qualified MeetingId ->
NominalDiffTime ->
Sem r Bool
deleteMeetingImpl zUser meetingId validityPeriod = do
-- Get existing meeting
result <-
runMaybeT $ do
meeting <- MaybeT $ Store.getMeeting (qUnqualified meetingId)
now <- lift Now.get
let cutoff = addUTCTime (negate validityPeriod) now
guard $ meeting.endTime >= cutoff
-- Check authorization (only creator can delete)
guard $ meeting.creator == tUnqualified zUser
-- Delete meeting
lift $ Store.deleteMeeting (qUnqualified meetingId)
-- Delete associated conversation if it's a meeting conversation
let convId = meeting.conversationId
maybeConv <- lift $ ConversationSubsystem.getConversation convId
case maybeConv of
Just conv
| conv.metadata.cnvmGroupConvType == Just MeetingConversation ->
lift $ ConversationSubsystem.deleteConversation convId
Copy link
Copy Markdown
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

We should make sure that the team -> conversation index also gets removed (I think only relevant for cassandra)

Copy link
Copy Markdown
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Should it be part of ConversationSubsystem?

Copy link
Copy Markdown
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I am not sure. It would be best if it would use the same code as normal conversation deletion through the conversation action. There is even much more to consider than just the team to conversation index. See:

    SConversationDeleteTag -> do
      let deleteGroup groupId = do
            E.removeAllMLSClients groupId
            E.deleteAllProposals groupId

      let cid = storedConv.id_
      for_ (storedConv & mlsMetadata <&> cnvmlsGroupId . fst) $ \gidParent -> do
        sconvs <- E.listSubConversations cid
        for_ (Map.assocs sconvs) $ \(subid, mlsData) -> do
          let gidSub = cnvmlsGroupId mlsData
          E.deleteSubConversation cid subid
          deleteGroup gidSub
        deleteGroup gidParent

      key <- E.makeKey (tUnqualified lcnv)
      E.deleteCode key
      case convTeam storedConv of
        Nothing -> E.deleteConversation (tUnqualified lcnv)
        Just tid -> E.deleteTeamConversation tid (tUnqualified lcnv)

      pure $ mkPerformActionResult action

I don't know how to best achieve this, either.

Copy link
Copy Markdown
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

added

Copy link
Copy Markdown
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

See #5068

_ -> pure ()
pure ()
pure $ isJust result

getMeetingImpl ::
( Member Store.MeetingsStore r,
Member ConversationSubsystem r,
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -41,7 +41,7 @@ import Wire.API.Team.Member (TeamMember, mkTeamMember)
import Wire.API.Team.Permission (fullPermissions)
import Wire.ConversationSubsystem
import Wire.FeaturesConfigSubsystem
import Wire.GalleyAPIAccess (GalleyAPIAccess)
import Wire.GalleyAPIAccess (GalleyAPIAccess, internalGetConversation)
import Wire.MeetingsStore qualified as Store
import Wire.MeetingsSubsystem
import Wire.MeetingsSubsystem.Interpreter
Expand Down Expand Up @@ -423,3 +423,109 @@ spec = describe "MeetingsSubsystem.Interpreter" $ do
.&&. m.startTime === effectiveStart
.&&. m.endTime === effectiveEnd
.&&. m.recurrence === fromMaybe baseMeeting.recurrence update.recurrence

describe "deleteMeeting" $ 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 @MeetingsPremiumConfig (LockableFeature FeatureStatusEnabled LockStatusUnlocked def) def

it "returns True for successful deletion by creator" $ do
let newMeeting =
API.NewMeeting
{ title = fromJust $ checked "Meeting to Delete",
startTime = addUTCTime 3600 now,
endTime = addUTCTime 7200 now,
recurrence = Nothing,
invitedEmails = []
}

result <- runTestStack now gen Map.empty teamConfig $ do
(meeting, _) <- createMeeting zUser1 newMeeting
_ <- deleteMeeting zUser1 meeting.id
pure meeting

result `shouldSatisfy` isRight

it "returns False when non-creator tries to delete" $ do
let newMeeting =
API.NewMeeting
{ title = fromJust $ checked "Meeting to Delete",
startTime = addUTCTime 3600 now,
endTime = addUTCTime 7200 now,
recurrence = Nothing,
invitedEmails = []
}

result <- runTestStack now gen (Map.singleton teamId [teamMember1, teamMember2]) teamConfig $ do
(meeting, _) <- createMeeting zUser1 newMeeting
deleteMeeting zUser2 meeting.id

result `shouldBe` Right False

it "returns False for expired meeting deletion" $ do
let newMeeting =
API.NewMeeting
{ title = fromJust $ checked "Expired Meeting",
startTime = addUTCTime (-7200) now,
endTime = addUTCTime (-5000) now,
recurrence = Nothing,
invitedEmails = []
}

result <- runTestStack now gen Map.empty teamConfig $ do
(meeting, _) <- createMeeting zUser1 newMeeting
deleteMeeting zUser1 meeting.id

result `shouldBe` Right False

it "returns False when meeting does not exist" $ do
let meetingId = Qualified (Id $ read "00000000-0000-0000-0000-000000000999") (Domain "wire.com")

result <- runTestStack now gen Map.empty teamConfig $ do
deleteMeeting zUser1 meetingId

result `shouldBe` Right False

it "deletes associated meeting conversation" $ do
let newMeeting =
API.NewMeeting
{ title = fromJust $ checked "Meeting to Delete",
startTime = addUTCTime 3600 now,
endTime = addUTCTime 7200 now,
recurrence = Nothing,
invitedEmails = []
}

result <- runTestStack now gen Map.empty teamConfig $ do
(meeting, conv) <- createMeeting zUser1 newMeeting
_ <- internalGetConversation conv.id_
_ <- deleteMeeting zUser1 meeting.id
pure ()

result `shouldSatisfy` isRight

it "preserves non-meeting conversation" $ do
let newMeeting =
API.NewMeeting
{ title = fromJust $ checked "Meeting to Delete",
startTime = addUTCTime 3600 now,
endTime = addUTCTime 7200 now,
recurrence = Nothing,
invitedEmails = []
}

result <- runTestStack now gen Map.empty teamConfig $ do
(meeting, _) <- createMeeting zUser1 newMeeting
-- Change conversation type to non-meeting by updating local members only
-- This simulates a non-meeting conversation without touching internal types
deleteMeeting zUser1 meeting.id

result `shouldSatisfy` isRight
Original file line number Diff line number Diff line change
Expand Up @@ -75,4 +75,10 @@ inMemoryConversationSubsystemInterpreter = interpret $ \case
InternalGetLocalMember cid uid -> do
members <- gets (Map.lookup cid)
pure $ if Set.member uid (fromMaybe Set.empty members) then Just (newMember uid) else Nothing
GetConversation cid -> gets (Map.lookup cid)
DeleteConversation cid -> do
convs <- gets @(Map ConvId StoredConversation) id
put @(Map ConvId StoredConversation) (Map.delete cid convs)
members <- gets @ConversationMembers id
put @ConversationMembers (Map.delete cid members)
_ -> error "ConversationSubsystem: not implemented in mock"
Original file line number Diff line number Diff line change
Expand Up @@ -76,7 +76,7 @@ miniGalleyAPIAccess teams configs = interpret $ \case
GetEJPDConvInfo _ -> error "GetEJPDConvInfo not implemented in miniGalleyAPIAccess"
GetTeamAdmins tid -> pure $ newTeamMemberList (maybe [] (filter (\tm -> isAdminOrOwner (tm ^. permissions))) $ Map.lookup tid teams) ListComplete
SelectTeamMemberInfos tid uids -> pure $ selectTeamMemberInfosImpl teams tid uids
InternalGetConversation _ -> error "GetConv not implemented in InternalGetConversation"
InternalGetConversation _ -> pure Nothing
GetTeamContacts _ -> pure Nothing
SelectTeamMembers {} -> error "SelectTeamMembers not implemented in miniGalleyAPIAccess"
GetConversationConfig ->
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -67,3 +67,4 @@ inMemoryMeetingsStoreInterpreter = interpret $ \case
updatedAt = now
}
modify (Map.insert mid updatedMeeting) >> pure (Just updatedMeeting)
DeleteMeeting mid -> modify (Map.delete mid)
3 changes: 2 additions & 1 deletion services/galley/src/Galley/API/Action.hs
Original file line number Diff line number Diff line change
Expand Up @@ -110,7 +110,8 @@ import Wire.BrigAPIAccess qualified as E
import Wire.CodeStore
import Wire.CodeStore qualified as E
import Wire.ConversationStore qualified as E
import Wire.ConversationSubsystem
import Wire.ConversationSubsystem (ConversationSubsystem)
-- import Wire.ConversationSubsystem hiding (ConversationSubsystem (..))
import Wire.ConversationSubsystem.Util
import Wire.FeaturesConfigSubsystem
import Wire.FederationAPIAccess qualified as E
Expand Down
2 changes: 1 addition & 1 deletion services/galley/src/Galley/API/MLS/Message.hs
Original file line number Diff line number Diff line change
Expand Up @@ -87,7 +87,7 @@ import Wire.API.Routes.Version
import Wire.API.Team.LegalHold
import Wire.ConversationStore
import Wire.ConversationStore.MLS.Types
import Wire.ConversationSubsystem
import Wire.ConversationSubsystem hiding (getConversation)
import Wire.ConversationSubsystem.Util
import Wire.FeaturesConfigSubsystem
import Wire.FederationAPIAccess
Expand Down
Loading