{-# OPTIONS_GHC -Wno-ambiguous-fields #-}

module Test.Meetings where

import API.Galley
import qualified API.GalleyInternal as I
import Control.Monad.Reader (ask)
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import Data.Time.Clock
import qualified Data.Time.Format as Time
import MLS.Util
import Notifications (isConvCreateMeetingNotif, isConvDeleteMeetingNotif, isMeetingDeleteNotif, isMeetingMemberAddNotif, isMeetingUpdateNotif, isMemberJoinNotif, isWelcomeNotif)
import SetupHelpers
import System.Timeout (timeout)
import Testlib.Prelude
import Text.Regex.TDFA ((=~))
import UnliftIO.Concurrent (threadDelay)

testMeetingCreate :: (HasCallStack) => App ()
testMeetingCreate = do
  (owner, _tid, _members) <- createTeam OwnDomain 1
  ownerId <- owner %. "id" >>= asString
  now <- liftIO getCurrentTime
  let startTime = addUTCTime 3600 now
      endTime = addUTCTime 7200 now
      newMeeting = defaultMeetingJson "Team Standup" startTime endTime ["alice@example.com", "bob@example.com"]

  meeting <-
    withWebSocket owner $ \ws -> do
      resp <- postMeetings owner newMeeting
      assertSuccess resp
      void $ awaitMatch isConvCreateMeetingNotif ws
      m <- getJSON 201 resp
      -- meeting.create is not delivered to the initiator (WPB-27857)
      assertNoEvent 1 ws
      pure m

  meeting %. "title" `shouldMatch` ("Team Standup" :: String)
  meeting %. "qualified_creator" %. "id" `shouldMatch` ownerId
  meeting %. "invited_emails" `shouldMatch` (["alice@example.com", "bob@example.com"] :: [String])

  -- The full conversation is returned alongside the legacy field
  assertConversationMatchesLegacy meeting

  -- Verify fetching the meeting
  (meetingId, domain) <- getMeetingIdAndDomain meeting
  r2 <- getMeeting owner domain meetingId
  assertSuccess r2

  fetchedMeeting <- getJSON 200 r2
  fetchedMeeting %. "title" `shouldMatch` ("Team Standup" :: String)

-- Regression: meeting conversations must grant InviteAccess so that MLS
-- commits adding participants succeed. Without InviteAccess, Galley rejects
-- the join in performConversationJoin (ensureAccess conv InviteAccess) with
-- 403 access-denied.
testMeetingMLSAddParticipant :: (HasCallStack) => App ()
testMeetingMLSAddParticipant = do
  (alice, _tid, [bob]) <- createTeam OwnDomain 2
  alice1 <- createMLSClient def alice
  bob1 <- createMLSClient def bob
  _ <- uploadNewKeyPackage def bob1
  now <- liftIO getCurrentTime
  let startTime = addUTCTime 3600 now
      endTime = addUTCTime 7200 now
      newMeeting = defaultMeetingJson "MLS Meeting" startTime endTime []

  meeting <- postMeetings alice newMeeting >>= getJSON 201
  convQid <- meeting %. "qualified_conversation"

  conv <- getConversation alice convQid >>= getJSON 200
  convId <- objConvId conv
  createGroup def alice1 convId

  memberAddNotif <-
    withWebSocket bob $ \ws -> do
      void $ createAddCommit alice1 convId [bob] >>= sendAndConsumeCommitBundle
      let isMeetingAddSequenceNotif notif = do
            isMemberJoin <- isMemberJoinNotif notif
            isMeetingMemberAdd <- isMeetingMemberAddNotif notif
            isWelcome <- isWelcomeNotif notif
            pure $ isMemberJoin || isMeetingMemberAdd || isWelcome
      sequenceNotifs <- replicateM 3 (awaitMatch isMeetingAddSequenceNotif ws)
      sequenceTypes <- for sequenceNotifs $ \notif -> notif %. "payload.0.type" >>= asString
      sequenceTypes
        `shouldMatchSet` [ "conversation.member-join",
                           "meeting.member-add",
                           "conversation.mls-welcome"
                         ]
      case [n | (t, n) <- zip sequenceTypes sequenceNotifs, t == "meeting.member-add"] of
        (notif : _) -> pure notif
        [] -> assertFailure "expected a meeting.member-add notification in the add sequence"

  assertMeetingNotif memberAddNotif (meeting %. "qualified_id")
  memberAddNotif %. "payload.0.qualified_conversation" `shouldMatch` convQid

  bindResponse (getConversation alice convQid) $ \res -> do
    res.status `shouldMatchInt` 200
    (length <$> (res.json %. "members.others" & asList)) `shouldMatchInt` 1
    res.json %. "members.others.0.qualified_id" `shouldMatch` objQidObject bob

-- | Helper to extract meetingId and domain from a meeting JSON object
getMeetingIdAndDomain :: (HasCallStack) => Value -> App (String, String)
getMeetingIdAndDomain meeting = do
  meetingId <- meeting %. "qualified_id" %. "id" >>= asString
  domain <- meeting %. "qualified_id" %. "domain" >>= asString
  pure (meetingId, domain)

-- | On create/update responses, the full @conversation@ object is returned
-- alongside the legacy @qualified_conversation@ field. This asserts that both
-- refer to the same conversation.
assertConversationMatchesLegacy :: (HasCallStack) => Value -> App ()
assertConversationMatchesLegacy meeting = do
  convId <- meeting %. "conversation" %. "qualified_id"
  legacyConvId <- meeting %. "qualified_conversation"
  convId `shouldMatch` legacyConvId

-- | Assert a meeting lifecycle notification carries the meeting's qualified id flat
-- at payload.0.qualified_id and has NO "data" wrapper (proves the no-nesting
-- contract).
assertMeetingNotif ::
  (HasCallStack, MakesValue notif, MakesValue qid) =>
  notif ->
  qid ->
  App ()
assertMeetingNotif notif qid = do
  notif %. "payload.0.qualified_id" `shouldMatch` qid
  assertFieldMissing notif "payload.0.data"

-- | Helper to create a default new meeting JSON object
defaultMeetingJson :: String -> UTCTime -> UTCTime -> [String] -> Value
defaultMeetingJson title startTime endTime invitedEmails =
  object
    [ "title" .= title,
      "start_time" .= startTime,
      "end_time" .= endTime,
      "invited_emails" .= invitedEmails
    ]

testMeetingGetNotFound :: (HasCallStack) => App ()
testMeetingGetNotFound = do
  (owner, _tid, _members) <- createTeam OwnDomain 1
  fakeMeetingId <- randomId

  getMeeting owner "example.com" fakeMeetingId >>= assertLabel 404 "meeting-not-found"

-- Test that disabled MeetingsConfig feature blocks creation
testMeetingsConfigDisabledBlocksCreate :: (HasCallStack) => App ()
testMeetingsConfigDisabledBlocksCreate = do
  (owner, tid, _members) <- createTeam OwnDomain 1

  -- Disable the MeetingsConfig feature
  let firstMeeting = object ["status" .= "disabled", "lockStatus" .= "unlocked"]
  I.setTeamFeatureConfig owner tid "meetings" firstMeeting >>= assertStatus 200

  -- Try to create a meeting - should fail
  now <- liftIO getCurrentTime
  let startTime = addUTCTime 3600 now
      endTime = addUTCTime 7200 now
      newMeeting = defaultMeetingJson "Team Standup" startTime endTime []

  postMeetings owner newMeeting >>= assertLabel 403 "invalid-op"

-- | Read endpoints (@GET /meetings/list@, @GET /meetings/{domain}/{id}@) treat a
-- team with the @meetings@ feature disabled as "no meetings" (list -> @200 []@,
-- get -> @404 meeting-not-found@) instead of @403 invalid-op@, while write
-- endpoints (@POST /meetings@) keep the hard gate and still return @403
-- invalid-op@. See WPB-27329.
testMeetingsReadsWhenDisabled :: (HasCallStack) => App ()
testMeetingsReadsWhenDisabled = do
  (owner, tid, _members) <- createTeam OwnDomain 1
  now <- liftIO getCurrentTime
  let startTime = addUTCTime 3600 now
      endTime = addUTCTime 7200 now
      newMeeting = defaultMeetingJson "test meeting" startTime endTime []

  -- Enabled (default): create a meeting to use as the read target later.
  meeting <- postMeetings owner newMeeting >>= getJSON 201
  (meetingId, domain) <- getMeetingIdAndDomain meeting

  -- Positive control while enabled: the created meeting is directly findable.
  getMeeting owner domain meetingId >>= assertStatus 200

  -- Disable the meetings feature for the team.
  let disabled = object ["status" .= "disabled", "lockStatus" .= "unlocked"]
  I.setTeamFeatureConfig owner tid "meetings" disabled >>= assertStatus 200

  -- Read paths treat a disabled feature as "no meetings": list -> 200 [], get -> 404.
  getMeetingsList owner `bindResponse` \resp -> do
    resp.status `shouldMatchInt` 200
    meetings <- resp.json & asList
    shouldBeEmpty meetings

  getMeeting owner domain meetingId >>= assertLabel 404 "meeting-not-found"

  -- Write paths keep the hard gate: create -> 403 invalid-op (unchanged behavior).
  postMeetings owner newMeeting >>= assertLabel 403 "invalid-op"

  -- Re-enable: the previously-created meeting is readable again.
  let enabled = object ["status" .= "enabled", "lockStatus" .= "unlocked"]
  I.setTeamFeatureConfig owner tid "meetings" enabled >>= assertStatus 200

  listResp2 <- getMeetingsList owner
  assertSuccess listResp2
  meetings2 <- listResp2.json & asList
  fetchedIds <- forM meetings2 $ \m -> m %. "qualified_id" %. "id" >>= asString
  (meetingId `elem` fetchedIds) `shouldMatch` True

-- Test that creating a meeting with a start time in the past is rejected
testMeetingCreatePastStartTime :: (HasCallStack) => App ()
testMeetingCreatePastStartTime = do
  (owner, _tid, _members) <- createTeam OwnDomain 1
  now <- liftIO getCurrentTime
  let startTime = addUTCTime (negate 3600) now
      endTime = addUTCTime 3600 now
      newMeeting = defaultMeetingJson "Past Meeting" startTime endTime []

  postMeetings owner newMeeting >>= assertLabel 403 "invalid-op"

testMeetingRecurrence :: (HasCallStack) => App ()
testMeetingRecurrence = do
  (owner, _tid, _members) <- createTeam OwnDomain 1
  now <- liftIO getCurrentTime
  let startTime = addUTCTime 3600 now
      endTime = addUTCTime 7200 now
      recurrenceUntil = Time.formatTime Time.defaultTimeLocale "%FT%TZ" $ addUTCTime (30 * nominalDay) now -- format to avoid rounding expectation mismatch
      recurrence =
        object
          [ "frequency" .= "daily",
            "interval" .= (1 :: Int),
            "until" .= recurrenceUntil
          ]
      newMeeting =
        object
          [ "title" .= "Daily Standup with Recurrence",
            "start_time" .= startTime,
            "end_time" .= endTime,
            "recurrence" .= recurrence,
            "invited_emails" .= ["charlie@example.com"]
          ]

  r1 <- postMeetings owner newMeeting
  assertSuccess r1

  meeting <- getJSON 201 r1
  (meetingId, domain) <- getMeetingIdAndDomain meeting
  let updatedRecurrence =
        object
          [ "frequency" .= "weekly",
            "interval" .= (2 :: Int)
          ]
      updatedMeeting =
        object
          [ "title" .= "Updated Standup",
            "start_date" .= startTime,
            "end_date" .= endTime,
            "recurrence" .= updatedRecurrence
          ]

  r2 <- withWebSocket owner $ \ws -> do
    resp <- putMeeting owner domain meetingId updatedMeeting
    assertSuccess resp
    -- meeting.update is not delivered to the initiator (WPB-27857)
    assertNoEvent 1 ws
    pure resp

  updated <- getJSON 200 r2
  updated %. "title" `shouldMatch` ("Updated Standup" :: String)
  recurrence' <- updated %. "recurrence"
  recurrence' %. "frequency" `shouldMatch` "weekly"
  recurrence' %. "interval" `shouldMatchInt` 2

  -- The full conversation is still returned on update
  assertConversationMatchesLegacy updated

testMeetingUpdateNotFound :: (HasCallStack) => App ()
testMeetingUpdateNotFound = do
  (owner, _tid, _members) <- createTeam OwnDomain 1
  fakeMeetingId <- randomId
  now <- liftIO getCurrentTime
  let startTime = addUTCTime 3600 now
      endTime = addUTCTime 7200 now
      update =
        object
          [ "title" .= "Updated",
            "start_date" .= startTime,
            "end_date" .= endTime
          ]

  putMeeting owner "example.com" fakeMeetingId update >>= assertStatus 404

testMeetingUpdateUnauthorized :: (HasCallStack) => App ()
testMeetingUpdateUnauthorized = 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
  let update =
        object
          [ "title" .= "Hijacked",
            "start_date" .= startTime,
            "end_date" .= endTime
          ]

  putMeeting otherUser domain meetingId update >>= assertStatus 404

testMeetingListEmpty :: (HasCallStack) => App ()
testMeetingListEmpty = do
  (owner, _tid, _members) <- createTeam OwnDomain 1
  resp <- getMeetingsList owner
  assertSuccess resp
  meetings <- resp.json & asList
  length (meetings :: [Value]) `shouldMatchInt` 0

testMeetingListNoMeetings :: (HasCallStack) => App ()
testMeetingListNoMeetings = do
  (owner, _tid, _members) <- createTeam OwnDomain 1
  _ <- createTeam OwnDomain 1
  resp <- getMeetingsList owner
  assertSuccess resp
  meetings <- resp.json & asList
  length (meetings :: [Value]) `shouldMatchInt` 0

testMeetingListMultiple :: (HasCallStack) => App ()
testMeetingListMultiple = do
  (owner, _tid, _members) <- createTeam OwnDomain 1
  now <- liftIO getCurrentTime
  let firstMeeting = defaultMeetingJson "First Meeting" (addUTCTime 3600 now) (addUTCTime 7200 now) []
      secondMeeting = defaultMeetingJson "Second Meeting" (addUTCTime 3600 now) (addUTCTime 7200 now) []
      thirdMeeting = defaultMeetingJson "Third Meeting" (addUTCTime 3600 now) (addUTCTime 7200 now) []
  r1 <- postMeetings owner firstMeeting
  assertSuccess r1
  m1 <- getJSON 201 r1
  (id1, _) <- getMeetingIdAndDomain m1

  r2 <- postMeetings owner secondMeeting
  assertSuccess r2
  m2 <- getJSON 201 r2
  (id2, _) <- getMeetingIdAndDomain m2

  r3 <- postMeetings owner thirdMeeting
  assertSuccess r3
  m3 <- getJSON 201 r3
  (id3, _) <- getMeetingIdAndDomain m3

  resp <- getMeetingsList owner
  assertSuccess resp
  meetings <- resp.json & asList
  length (meetings :: [Value]) `shouldMatchInt` 3

  titles <- forM meetings $ \m -> m %. "title" >>= asString
  let expectedTitles = ["First Meeting", "Second Meeting", "Third Meeting"]
  (all (`elem` titles) expectedTitles) `shouldMatch` True

  fetchedIds <- forM meetings $ \m -> m %. "qualified_id" %. "id" >>= asString
  let expectedIds = [id1, id2, id3]
  (all (`elem` fetchedIds) expectedIds) `shouldMatch` True

testMeetingListPagination :: (HasCallStack) => App ()
testMeetingListPagination = do
  (owner, _tid, _members) <- createTeam OwnDomain 1
  now <- liftIO getCurrentTime

  -- The internal page size is 1000, so we create 1001 meetings to test pagination.
  -- This ensures `hasMore = True` is triggered and multiple pages are fetched.
  forM_ [(1 :: Int) .. 1001] $ \i -> do
    let meeting = defaultMeetingJson ("Meeting " <> show i) (addUTCTime 3600 now) (addUTCTime 7200 now) []
    postMeetings owner meeting >>= assertStatus 201

  resp <- getMeetingsList owner
  assertSuccess resp
  meetings <- resp.json & asList
  length (meetings :: [Value]) `shouldMatchInt` 1001

testMeetingAddInvitation :: (HasCallStack) => App ()
testMeetingAddInvitation = do
  (owner, _tid, _members) <- createTeam OwnDomain 1
  now <- liftIO getCurrentTime
  let startTime = addUTCTime 3600 now
      endTime = addUTCTime 7200 now
      newMeeting = defaultMeetingJson "Team Standup" startTime endTime ["alice@example.com"]
  meeting <- postMeetings owner newMeeting >>= getJSON 201
  (meetingId, domain) <- getMeetingIdAndDomain meeting
  let invitation = object ["emails" .= ["bob@example.com"]]
  postMeetingInvitation owner domain meetingId invitation >>= assertStatus 200
  updated <- getMeeting owner domain meetingId >>= getJSON 200
  updated %. "invited_emails" `shouldMatch` ["alice@example.com", "bob@example.com"]

testMeetingAddInvitationNotFound :: (HasCallStack) => App ()
testMeetingAddInvitationNotFound = do
  (owner, _tid, _members) <- createTeam OwnDomain 1
  fakeMeetingId <- randomId
  let invitation = object ["emails" .= ["bob@example.com"]]
  postMeetingInvitation owner "example.com" fakeMeetingId invitation >>= assertStatus 404

testMeetingRemoveInvitation :: (HasCallStack) => App ()
testMeetingRemoveInvitation = do
  (owner, _tid, _members) <- createTeam OwnDomain 1
  now <- liftIO getCurrentTime
  let startTime = addUTCTime 3600 now
      endTime = addUTCTime 7200 now
      newMeeting = defaultMeetingJson "Team Standup" startTime endTime ["alice@example.com", "bob@example.com"]

  meeting <- postMeetings owner newMeeting >>= getJSON 201
  (meetingId, domain) <- getMeetingIdAndDomain meeting
  let removeInvitation = object ["emails" .= ["alice@example.com"]]

  deleteMeetingInvitation owner domain meetingId removeInvitation >>= assertStatus 200

  updated <- getMeeting owner domain meetingId >>= getJSON 200
  updated %. "invited_emails" `shouldMatch` ["bob@example.com"]

testMeetingRemoveInvitationNotFound :: (HasCallStack) => App ()
testMeetingRemoveInvitationNotFound = do
  (owner, _tid, _members) <- createTeam OwnDomain 1
  fakeMeetingId <- randomId
  let removeInvitation = object ["emails" .= ["alice@example.com"]]

  deleteMeetingInvitation owner "example.com" fakeMeetingId removeInvitation >>= assertStatus 404

testMeetingReplaceInvitation :: (HasCallStack) => App ()
testMeetingReplaceInvitation = do
  (owner, _tid, _members) <- createTeam OwnDomain 1
  now <- liftIO getCurrentTime
  let startTime = addUTCTime 3600 now
      endTime = addUTCTime 7200 now
      newMeeting = defaultMeetingJson "Team Standup" startTime endTime ["alice@example.com", "bob@example.com"]

  meeting <- postMeetings owner newMeeting >>= getJSON 201
  (meetingId, domain) <- getMeetingIdAndDomain meeting
  let invitation = object ["emails" .= ["charlie@example.com"]]
  putMeetingInvitation owner domain meetingId invitation >>= assertStatus 200
  updated <- getMeeting owner domain meetingId >>= getJSON 200
  updated %. "invited_emails" `shouldMatch` ["charlie@example.com"]

testMeetingReplaceInvitationEmpty :: (HasCallStack) => App ()
testMeetingReplaceInvitationEmpty = do
  (owner, _tid, _members) <- createTeam OwnDomain 1
  now <- liftIO getCurrentTime
  let startTime = addUTCTime 3600 now
      endTime = addUTCTime 7200 now
      newMeeting = defaultMeetingJson "Team Standup" startTime endTime ["alice@example.com", "bob@example.com"]

  meeting <- postMeetings owner newMeeting >>= getJSON 201
  (meetingId, domain) <- getMeetingIdAndDomain meeting
  let invitation = object ["emails" .= ([] :: [String])]
  putMeetingInvitation owner domain meetingId invitation >>= assertStatus 200
  updated <- getMeeting owner domain meetingId >>= getJSON 200
  updated %. "invited_emails" `shouldMatch` ([] :: [String])

testMeetingReplaceInvitationNotFound :: (HasCallStack) => App ()
testMeetingReplaceInvitationNotFound = do
  (owner, _tid, _members) <- createTeam OwnDomain 1
  fakeMeetingId <- randomId
  let invitation = object ["emails" .= ["bob@example.com"]]
  putMeetingInvitation owner "example.com" fakeMeetingId invitation >>= assertStatus 404

testMeetingReplaceInvitationUnauthorized :: (HasCallStack) => App ()
testMeetingReplaceInvitationUnauthorized = do
  (owner, _tid, _members) <- createTeam OwnDomain 1
  (otherUser, _, _) <- createTeam OwnDomain 1
  now <- liftIO getCurrentTime
  let startTime = addUTCTime 3600 now
      endTime = addUTCTime 7200 now
      newMeeting = defaultMeetingJson "Team Standup" startTime endTime ["alice@example.com"]

  meeting <- postMeetings owner newMeeting >>= getJSON 201
  (meetingId, domain) <- getMeetingIdAndDomain meeting
  let invitation = object ["emails" .= ["eve@example.com"]]
  putMeetingInvitation otherUser domain meetingId invitation >>= 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
  withWebSocket owner $ \ws -> do
    deleteMeeting owner domain meetingId >>= assertStatus 200
    void $ awaitMatch isConvDeleteMeetingNotif ws
    -- meeting.delete is not delivered to the initiator (WPB-27857). The
    -- conversation.delete-meeting event above is the only event the
    -- initiator receives; the socket should be quiet afterwards.
    assertNoEvent 1 ws
  getMeeting owner domain meetingId >>= assertStatus 404

-- | WPB-27857: the meeting initiator no longer receives its own lifecycle
-- events, but other members of the meeting conversation still do. At creation
-- time the conversation's only local member is the creator, so 'meeting.create'
-- has no other recipient (the multi-member path is covered at the unit level in
-- "Wire.MeetingsSubsystem.InterpreterSpec"); here we verify that a member who
-- joined after creation still receives 'meeting.update' and 'meeting.delete'.
testMeetingLifecycleEventsDeliveredToMembers :: (HasCallStack) => App ()
testMeetingLifecycleEventsDeliveredToMembers = do
  (owner, _tid, [participant]) <- createTeam OwnDomain 2
  ownerClient <- createMLSClient def owner
  participantClient <- createMLSClient def participant
  _ <- uploadNewKeyPackage def participantClient
  now <- liftIO getCurrentTime
  let startTime = addUTCTime 3600 now
      endTime = addUTCTime 7200 now
      newMeeting = defaultMeetingJson "Lifecycle Meeting" startTime endTime []

  meeting <- postMeetings owner newMeeting >>= getJSON 201
  (meetingId, domain) <- getMeetingIdAndDomain meeting

  -- Add the second team member to the meeting conversation via MLS, so that
  -- they are among the recipients of subsequent lifecycle events.
  convQid <- meeting %. "qualified_conversation"
  conv <- getConversation owner convQid >>= getJSON 200
  convId <- objConvId conv
  createGroup def ownerClient convId
  void $ createAddCommit ownerClient convId [participant] >>= sendAndConsumeCommitBundle

  -- The non-initiator member receives 'meeting.update'; the initiator-exclusion
  -- half of WPB-27857 is asserted in 'testMeetingRecurrence'.
  updateNotif <-
    withWebSocket participant $ \ws -> do
      putMeeting owner domain meetingId (object ["title" .= "Updated Lifecycle Meeting"]) >>= assertSuccess
      awaitMatch isMeetingUpdateNotif ws
  assertMeetingNotif updateNotif (meeting %. "qualified_id")

  -- The non-initiator member receives 'meeting.delete'. The preceding
  -- 'conversation.delete-meeting' event is expected and skipped by 'awaitMatch'.
  deleteNotif <-
    withWebSocket participant $ \ws -> do
      deleteMeeting owner domain meetingId >>= assertStatus 200
      awaitMatch isMeetingDeleteNotif ws
  assertMeetingNotif deleteNotif (meeting %. "qualified_id")

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

testMeetingCleanup :: (HasCallStack) => App ()
testMeetingCleanup = do
  env <- ask
  timedOutResult <- liftIO $ timeout (2 * 60 * 1_000_000) $ runAppWithEnv env $ do
    -- 2 minutes timeout
    (owner, _tid, _members) <- createTeam OwnDomain 1
    now <- liftIO getCurrentTime
    -- Create a meeting that starts now and ends 1s later.
    -- Configured retention is 0.0014 hours (~5 seconds).
    -- cutoffTime will be now' - 5s.
    -- We need end_date < cutoffTime.
    -- If we wait 7 seconds, now' = now + 7s.
    -- cutoffTime = now + 7s - 5s = now + 2s.
    -- end_date (now + 1s) < cutoffTime (now + 2s).
    let startTime = now
        endTime = addUTCTime 1 now
        newMeeting = defaultMeetingJson "Cleanup Test" startTime endTime []

    r1 <- postMeetings owner newMeeting
    assertSuccess r1
    meeting <- getJSON 201 r1
    (meetingId, domain) <- getMeetingIdAndDomain meeting

    -- Wait 7 seconds to ensure meeting is old enough
    liftIO $ threadDelay 7_000_000

    -- Wait for cleanup job to run
    waitForCleanupJob OwnDomain

    -- Check it's gone
    getMeeting owner domain meetingId >>= assertStatus 404

  case timedOutResult of
    Just () -> pure ()
    Nothing -> assertFailure "testMeetingCleanup timed out after 2 minutes"

waitForCleanupJob :: (HasCallStack, MakesValue domain) => domain -> App ()
waitForCleanupJob domain = do
  initialMetrics <- getMetricsBody domain
  let initialCount = getRunCount initialMetrics

  waitForIncrease domain initialCount
  where
    getMetricsBody d = do
      getMetrics d BackgroundWorker `bindResponse` \resp -> do
        resp.status `shouldMatchInt` 200
        pure $ Text.unpack $ Text.decodeUtf8 resp.body

    getRunCount metrics =
      let (_, _, _, matches) :: (String, String, String, [String]) =
            metrics =~ "wire_meetings_cleanup_runs_total ([0-9]+(\\.[0-9]+)?)"
       in case matches of
            [val, _] -> floor @_ @Integer (read @Double val)
            _ -> 0

    waitForIncrease d oldVal = do
      metrics <- getMetricsBody d
      let newVal = getRunCount metrics
      -- We wait until it increases.
      -- Note: if oldVal was 0 (metric didn't exist), getting 0 again means it hasn't run.
      -- If it runs, it should become >= 1.
      -- But wait, if matches is empty, we return 0.
      -- If the metric appears, it will be >= 1 (initialized at 0? Counter starts at 0).
      -- If it runs, it increments.
      when (newVal <= oldVal) $ do
        liftIO $ threadDelay 1_000_000 -- Wait 1s
        waitForIncrease d oldVal

testMeetingExpiration :: (HasCallStack) => App ()
testMeetingExpiration = do
  (owner, _tid, _members) <- createTeam OwnDomain 1
  now <- liftIO getCurrentTime
  let startTime = now
      -- meetingValidityPeriodSeconds is configured to 5 seconds in galley.integration.yaml
      endTime = addUTCTime 1 now
      newMeeting = defaultMeetingJson "Expiring Meeting" startTime endTime []

  r1 <- postMeetings owner newMeeting
  assertSuccess r1
  meeting <- getJSON 201 r1
  (meetingId, domain) <- getMeetingIdAndDomain meeting

  -- Check it is accessible immediately (endTime = now+1, well within the 5s validity)
  getMeeting owner domain meetingId >>= assertStatus 200

  -- Wait 7 seconds so endTime (now+1) is past the validity cutoff (now+7-5 = now+2)
  liftIO $ threadDelay 7_000_000

  -- Check it is expired
  getMeeting owner domain meetingId >>= assertStatus 404

-- A recurring meeting whose original time slot has passed but whose
-- recurrence window is still open must remain visible in the list (and via
-- get-meeting) after the meeting validity period elapses.
testMeetingListRecurringNotExpired :: (HasCallStack) => App ()
testMeetingListRecurringNotExpired = do
  (owner, _tid, _members) <- createTeam OwnDomain 1
  now <- liftIO getCurrentTime
  -- startTime = now, endTime = now+1: the slot only becomes "past" after the
  -- threadDelay below; the recurrence window stays open for 30 days.
  -- meetingValidityPeriodSeconds is 5s in galley.integration.yaml.
  let startTime = now
      endTime = addUTCTime 1 now
      recurrenceUntil = Time.formatTime Time.defaultTimeLocale "%FT%TZ" $ addUTCTime (30 * nominalDay) now
      recurrence =
        object
          [ "frequency" .= "daily",
            "interval" .= (1 :: Int),
            "until" .= recurrenceUntil
          ]
      newMeeting =
        object
          [ "title" .= "Recurring Past Meeting",
            "start_time" .= startTime,
            "end_time" .= endTime,
            "recurrence" .= recurrence,
            "invited_emails" .= ([] :: [String])
          ]

  meeting <- postMeetings owner newMeeting >>= getJSON 201
  (meetingId, domain) <- getMeetingIdAndDomain meeting

  -- Wait 7s beyond the validity period so a non-recurring meeting would expire.
  liftIO $ threadDelay 7_000_000

  -- Still accessible directly.
  getMeeting owner domain meetingId >>= assertStatus 200

  -- Still listed.
  resp <- getMeetingsList owner
  assertSuccess resp
  meetings <- resp.json & asList
  length meetings `shouldMatchInt` 1
