{-# 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 SetupHelpers
import System.Timeout (timeout)
import Testlib.Prelude
import Text.Regex.TDFA ((=~))
import UnliftIO.Concurrent (threadDelay)

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

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

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

  resp <- postMeetings owner newMeeting
  assertSuccess resp

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

  -- 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)

testMeetingGetNotFound :: (HasCallStack) => App ()
testMeetingGetNotFound :: HasCallStack => App ()
testMeetingGetNotFound = do
  (owner, _tid, _members) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1
  fakeMeetingId <- randomId

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

-- Test that personal (non-team) users create trial meetings
testMeetingCreatePersonalUserTrial :: (HasCallStack) => App ()
testMeetingCreatePersonalUserTrial :: HasCallStack => App ()
testMeetingCreatePersonalUserTrial = do
  personalUser <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
  now <- liftIO getCurrentTime
  let startTime = NominalDiffTime -> UTCTime -> UTCTime
addUTCTime NominalDiffTime
3600 UTCTime
now
      endTime = NominalDiffTime -> UTCTime -> UTCTime
addUTCTime NominalDiffTime
7200 UTCTime
now
      newMeeting = String -> UTCTime -> UTCTime -> [String] -> Value
defaultMeetingJson String
"Personal Meeting" UTCTime
startTime UTCTime
endTime []

  r <- postMeetings personalUser newMeeting
  assertSuccess r

  meeting <- getJSON 201 r
  meeting %. "trial" `shouldMatch` True

-- Test that paying team members create non-trial meetings
testMeetingCreatePayingTeamNonTrial :: (HasCallStack) => App ()
testMeetingCreatePayingTeamNonTrial :: HasCallStack => App ()
testMeetingCreatePayingTeamNonTrial = do
  (owner, tid, _members) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1

  let firstMeeting = [Pair] -> Value
object [String
"status" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"enabled"]
  I.setTeamFeatureLockStatus owner tid "meetingsPremium" "unlocked"
  I.setTeamFeatureConfig owner tid "meetingsPremium" firstMeeting >>= assertStatus 200

  now <- liftIO getCurrentTime
  let startTime = NominalDiffTime -> UTCTime -> UTCTime
addUTCTime NominalDiffTime
3600 UTCTime
now
      endTime = NominalDiffTime -> UTCTime -> UTCTime
addUTCTime NominalDiffTime
7200 UTCTime
now
      newMeeting = String -> UTCTime -> UTCTime -> [String] -> Value
defaultMeetingJson String
"Paying Team Meeting" UTCTime
startTime UTCTime
endTime []

  r <- postMeetings owner newMeeting
  assertSuccess r

  meeting <- getJSON 201 r
  meeting %. "trial" `shouldMatch` False

-- Test that disabled MeetingsConfig feature blocks creation
testMeetingsConfigDisabledBlocksCreate :: (HasCallStack) => App ()
testMeetingsConfigDisabledBlocksCreate :: HasCallStack => App ()
testMeetingsConfigDisabledBlocksCreate = do
  (owner, tid, _members) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1

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

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

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

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

  r1 <- postMeetings owner newMeeting
  assertSuccess r1

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

  r2 <- putMeeting owner domain meetingId updatedMeeting
  assertSuccess r2

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

testMeetingUpdateNotFound :: (HasCallStack) => App ()
testMeetingUpdateNotFound :: HasCallStack => App ()
testMeetingUpdateNotFound = do
  (owner, _tid, _members) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1
  fakeMeetingId <- randomId
  now <- liftIO getCurrentTime
  let startTime = NominalDiffTime -> UTCTime -> UTCTime
addUTCTime NominalDiffTime
3600 UTCTime
now
      endTime = NominalDiffTime -> UTCTime -> UTCTime
addUTCTime NominalDiffTime
7200 UTCTime
now
      update =
        [Pair] -> Value
object
          [ String
"title" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"Updated",
            String
"start_date" String -> UTCTime -> Pair
forall a. ToJSON a => String -> a -> Pair
.= UTCTime
startTime,
            String
"end_date" String -> UTCTime -> Pair
forall a. ToJSON a => String -> a -> Pair
.= UTCTime
endTime
          ]

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

testMeetingUpdateUnauthorized :: (HasCallStack) => App ()
testMeetingUpdateUnauthorized :: HasCallStack => App ()
testMeetingUpdateUnauthorized = do
  (owner, _tid, _members) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1
  (otherUser, _, _membersOther) <- createTeam OwnDomain 1
  now <- liftIO getCurrentTime
  let startTime = NominalDiffTime -> UTCTime -> UTCTime
addUTCTime NominalDiffTime
3600 UTCTime
now
      endTime = NominalDiffTime -> UTCTime -> UTCTime
addUTCTime NominalDiffTime
7200 UTCTime
now
      newMeeting = String -> UTCTime -> UTCTime -> [String] -> Value
defaultMeetingJson String
"Team Standup" UTCTime
startTime UTCTime
endTime []

  r1 <- postMeetings owner newMeeting
  assertSuccess r1

  meeting <- getJSON 201 r1
  (meetingId, domain) <- getMeetingIdAndDomain meeting
  let update =
        [Pair] -> Value
object
          [ String
"title" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"Hijacked",
            String
"start_date" String -> UTCTime -> Pair
forall a. ToJSON a => String -> a -> Pair
.= UTCTime
startTime,
            String
"end_date" String -> UTCTime -> Pair
forall a. ToJSON a => String -> a -> Pair
.= UTCTime
endTime
          ]

  putMeeting otherUser domain meetingId update >>= assertStatus 404

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

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

testMeetingListMultiple :: (HasCallStack) => App ()
testMeetingListMultiple :: HasCallStack => App ()
testMeetingListMultiple = do
  (owner, _tid, _members) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1
  now <- liftIO getCurrentTime
  let firstMeeting = String -> UTCTime -> UTCTime -> [String] -> Value
defaultMeetingJson String
"First Meeting" (NominalDiffTime -> UTCTime -> UTCTime
addUTCTime NominalDiffTime
3600 UTCTime
now) (NominalDiffTime -> UTCTime -> UTCTime
addUTCTime NominalDiffTime
7200 UTCTime
now) []
      secondMeeting = String -> UTCTime -> UTCTime -> [String] -> Value
defaultMeetingJson String
"Second Meeting" (NominalDiffTime -> UTCTime -> UTCTime
addUTCTime NominalDiffTime
3600 UTCTime
now) (NominalDiffTime -> UTCTime -> UTCTime
addUTCTime NominalDiffTime
7200 UTCTime
now) []
      thirdMeeting = String -> UTCTime -> UTCTime -> [String] -> Value
defaultMeetingJson String
"Third Meeting" (NominalDiffTime -> UTCTime -> UTCTime
addUTCTime NominalDiffTime
3600 UTCTime
now) (NominalDiffTime -> UTCTime -> UTCTime
addUTCTime NominalDiffTime
7200 UTCTime
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 $ \Value
m -> Value
m Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"title" App Value -> (Value -> App String) -> App String
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString
  let expectedTitles = [String
"First Meeting", String
"Second Meeting", String
"Third Meeting"]
  (all (`elem` titles) expectedTitles) `shouldMatch` True

  fetchedIds <- forM meetings $ \Value
m -> Value
m Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id" App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id" App Value -> (Value -> App String) -> App String
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString
  let expectedIds = [String
id1, String
id2, String
id3]
  (all (`elem` fetchedIds) expectedIds) `shouldMatch` True

testMeetingListPagination :: (HasCallStack) => App ()
testMeetingListPagination :: HasCallStack => App ()
testMeetingListPagination = do
  (owner, _tid, _members) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
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] $ \Int
i -> do
    let meeting :: Value
meeting = String -> UTCTime -> UTCTime -> [String] -> Value
defaultMeetingJson (String
"Meeting " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
i) (NominalDiffTime -> UTCTime -> UTCTime
addUTCTime NominalDiffTime
3600 UTCTime
now) (NominalDiffTime -> UTCTime -> UTCTime
addUTCTime NominalDiffTime
7200 UTCTime
now) []
    Value -> Value -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> Value -> App Response
postMeetings Value
owner Value
meeting App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
201

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

testMeetingAddInvitation :: (HasCallStack) => App ()
testMeetingAddInvitation :: HasCallStack => App ()
testMeetingAddInvitation = do
  (owner, _tid, _members) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1
  now <- liftIO getCurrentTime
  let startTime = NominalDiffTime -> UTCTime -> UTCTime
addUTCTime NominalDiffTime
3600 UTCTime
now
      endTime = NominalDiffTime -> UTCTime -> UTCTime
addUTCTime NominalDiffTime
7200 UTCTime
now
      newMeeting = String -> UTCTime -> UTCTime -> [String] -> Value
defaultMeetingJson String
"Team Standup" UTCTime
startTime UTCTime
endTime [String
"alice@example.com"]
  meeting <- postMeetings owner newMeeting >>= getJSON 201
  (meetingId, domain) <- getMeetingIdAndDomain meeting
  let invitation = [Pair] -> Value
object [String
"emails" String -> [String] -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [String
"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 :: HasCallStack => App ()
testMeetingAddInvitationNotFound = do
  (owner, _tid, _members) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1
  fakeMeetingId <- randomId
  let invitation = [Pair] -> Value
object [String
"emails" String -> [String] -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [String
"bob@example.com"]]
  postMeetingInvitation owner "example.com" fakeMeetingId invitation >>= assertStatus 404

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

  meeting <- postMeetings owner newMeeting >>= getJSON 201
  (meetingId, domain) <- getMeetingIdAndDomain meeting
  let removeInvitation = [Pair] -> Value
object [String
"emails" String -> [String] -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [String
"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 :: HasCallStack => App ()
testMeetingRemoveInvitationNotFound = do
  (owner, _tid, _members) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1
  fakeMeetingId <- randomId
  let removeInvitation = [Pair] -> Value
object [String
"emails" String -> [String] -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [String
"alice@example.com"]]

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

testMeetingDelete :: (HasCallStack) => App ()
testMeetingDelete :: HasCallStack => App ()
testMeetingDelete = do
  (owner, _tid, _members) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1
  now <- liftIO getCurrentTime
  let startTime = NominalDiffTime -> UTCTime -> UTCTime
addUTCTime NominalDiffTime
3600 UTCTime
now
      endTime = NominalDiffTime -> UTCTime -> UTCTime
addUTCTime NominalDiffTime
7200 UTCTime
now
      recurrenceUntil = NominalDiffTime -> UTCTime -> UTCTime
addUTCTime (NominalDiffTime
30 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
24 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
3600) UTCTime
now
      recurrence =
        [Pair] -> Value
object
          [ String
"frequency" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"daily",
            String
"interval" String -> Int -> Pair
forall a. ToJSON a => String -> a -> Pair
.= (Int
1 :: Int),
            String
"until" String -> UTCTime -> Pair
forall a. ToJSON a => String -> a -> Pair
.= UTCTime
recurrenceUntil
          ]
      newMeeting =
        [Pair] -> Value
object
          [ String
"title" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"Team Standup",
            String
"start_time" String -> UTCTime -> Pair
forall a. ToJSON a => String -> a -> Pair
.= UTCTime
startTime,
            String
"end_time" String -> UTCTime -> Pair
forall a. ToJSON a => String -> a -> Pair
.= UTCTime
endTime,
            String
"invited_emails" String -> [String] -> Pair
forall a. ToJSON a => String -> a -> Pair
.= ([] :: [String]),
            String
"recurrence" String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Value
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 :: HasCallStack => App ()
testMeetingDeleteNotFound = do
  (owner, _tid, _members) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1
  fakeMeetingId <- randomId
  deleteMeeting owner "example.com" fakeMeetingId >>= assertStatus 404

testMeetingDeleteUnauthorized :: (HasCallStack) => App ()
testMeetingDeleteUnauthorized :: HasCallStack => App ()
testMeetingDeleteUnauthorized = do
  (owner, _tid, _members) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1
  (otherUser, _, _membersOther) <- createTeam OwnDomain 1
  now <- liftIO getCurrentTime
  let startTime = NominalDiffTime -> UTCTime -> UTCTime
addUTCTime NominalDiffTime
3600 UTCTime
now
      endTime = NominalDiffTime -> UTCTime -> UTCTime
addUTCTime NominalDiffTime
7200 UTCTime
now
      newMeeting = String -> UTCTime -> UTCTime -> [String] -> Value
defaultMeetingJson String
"Team Standup" UTCTime
startTime UTCTime
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 :: HasCallStack => App ()
testMeetingCleanup = do
  env <- App Env
forall r (m :: * -> *). MonadReader r m => m r
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 ends now.
    -- Configured retention is 0.0014 hours (~5 seconds).
    -- cutoffTime will be now' - 5s.
    -- We need end_date < cutoffTime.
    -- If we wait 6 seconds, now' = now + 6s.
    -- cutoffTime = now + 6s - 5s = now + 1s.
    -- end_date (now) < cutoffTime (now + 1s).
    let startTime = NominalDiffTime -> UTCTime -> UTCTime
addUTCTime (NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a
negate NominalDiffTime
3600) UTCTime
now
        endTime = UTCTime
now
        newMeeting = String -> UTCTime -> UTCTime -> [String] -> Value
defaultMeetingJson String
"Cleanup Test" UTCTime
startTime UTCTime
endTime []

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

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

    -- Wait for cleanup job to run
    waitForCleanupJob OwnDomain

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

  case timedOutResult of
    Just () -> () -> App ()
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Maybe ()
Nothing -> String -> App ()
forall a. HasCallStack => String -> App a
assertFailure String
"testMeetingCleanup timed out after 2 minutes"

waitForCleanupJob :: (HasCallStack, MakesValue domain) => domain -> App ()
waitForCleanupJob :: forall domain.
(HasCallStack, MakesValue domain) =>
domain -> App ()
waitForCleanupJob domain
domain = do
  initialMetrics <- domain -> App String
forall {domain}. MakesValue domain => domain -> App String
getMetricsBody domain
domain
  let initialCount = String -> Integer
forall {source1}.
RegexContext Regex source1 (String, String, String, [String]) =>
source1 -> Integer
getRunCount String
initialMetrics

  waitForIncrease domain initialCount
  where
    getMetricsBody :: domain -> App String
getMetricsBody domain
d = do
      domain -> Service -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Service -> App Response
getMetrics domain
d Service
BackgroundWorker App Response -> (Response -> App String) -> App String
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
        Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
        String -> App String
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> App String) -> String -> App String
forall a b. (a -> b) -> a -> b
$ Text -> String
Text.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
Text.decodeUtf8 Response
resp.body

    getRunCount :: source1 -> Integer
getRunCount source1
metrics =
      let (String
_, String
_, String
_, [String]
matches) :: (String, String, String, [String]) =
            source1
metrics source1 -> String -> (String, String, String, [String])
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ String
"wire_meetings_cleanup_runs_total ([0-9]+(\\.[0-9]+)?)"
       in case [String]
matches of
            [String
val, String
_] -> forall a b. (RealFrac a, Integral b) => a -> b
floor @_ @Integer (forall a. Read a => String -> a
read @Double String
val)
            [String]
_ -> Integer
0

    waitForIncrease :: t -> Integer -> App ()
waitForIncrease t
d Integer
oldVal = do
      metrics <- t -> App String
forall {domain}. MakesValue domain => domain -> App String
getMetricsBody t
d
      let newVal = String -> Integer
forall {source1}.
RegexContext Regex source1 (String, String, String, [String]) =>
source1 -> Integer
getRunCount String
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 :: HasCallStack => App ()
testMeetingExpiration = do
  (owner, _tid, _members) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1
  now <- liftIO getCurrentTime
  let startTime = NominalDiffTime -> UTCTime -> UTCTime
addUTCTime (NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a
negate NominalDiffTime
3600) UTCTime
now
      -- meetingValidityPeriodSeconds is configured to 5 seconds in galley.integration.yaml
      endTime = UTCTime
now
      newMeeting = String -> UTCTime -> UTCTime -> [String] -> Value
defaultMeetingJson String
"Expiring Meeting" UTCTime
startTime UTCTime
endTime []

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

  -- Check it is accessible immediately (endDate = now, so valid until now + 5s)
  getMeeting owner domain meetingId >>= assertStatus 200

  -- Wait 6 seconds
  liftIO $ threadDelay 6_000_000

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