{-# 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)
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"]

  meeting <-
    withWebSocket owner $ \WebSocket
ws -> do
      resp <- Value -> Value -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> Value -> App Response
postMeetings Value
owner Value
newMeeting
      assertSuccess resp
      void $ awaitMatch isConvCreateMeetingNotif ws
      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)

-- 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 :: HasCallStack => App ()
testMeetingMLSAddParticipant = do
  (alice, _tid, [bob]) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2
  alice1 <- createMLSClient def alice
  bob1 <- createMLSClient def bob
  _ <- uploadNewKeyPackage def bob1
  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
"MLS Meeting" UTCTime
startTime UTCTime
endTime []

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

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

  -- Before the fix, this add commit fails with 403 access-denied at the
  -- server (getJSON 201 below throws). After the fix it succeeds.
  void $ createAddCommit alice1 convId [bob] >>= sendAndConsumeCommitBundle

  bindResponse (getConversation alice convQid) $ \Response
res -> do
    Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    ([Value] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Value] -> Int) -> App [Value] -> App Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Response
res.json Maybe Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"members.others" App Value -> (App Value -> App [Value]) -> App [Value]
forall a b. a -> (a -> b) -> b
& App Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList)) App Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
1
    Response
res.json Maybe Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"members.others.0.qualified_id" App Value -> App Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value -> App Value
forall a. (HasCallStack, MakesValue a) => a -> App Value
objQidObject Value
bob

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

testMeetingReplaceInvitation :: (HasCallStack) => App ()
testMeetingReplaceInvitation :: HasCallStack => App ()
testMeetingReplaceInvitation = 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 invitation = [Pair] -> Value
object [String
"emails" String -> [String] -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [String
"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 :: HasCallStack => App ()
testMeetingReplaceInvitationEmpty = 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 invitation = [Pair] -> Value
object [String
"emails" String -> [String] -> Pair
forall a. ToJSON a => String -> a -> Pair
.= ([] :: [String])]
  putMeetingInvitation owner domain meetingId invitation >>= assertStatus 200
  updated <- getMeeting owner domain meetingId >>= getJSON 200
  updated %. "invited_emails" `shouldMatch` ([] :: [String])

testMeetingReplaceInvitationNotFound :: (HasCallStack) => App ()
testMeetingReplaceInvitationNotFound :: HasCallStack => App ()
testMeetingReplaceInvitationNotFound = 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"]]
  putMeetingInvitation owner "example.com" fakeMeetingId invitation >>= assertStatus 404

testMeetingReplaceInvitationUnauthorized :: (HasCallStack) => App ()
testMeetingReplaceInvitationUnauthorized :: HasCallStack => App ()
testMeetingReplaceInvitationUnauthorized = 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, _, _) <- 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 [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
"eve@example.com"]]
  putMeetingInvitation otherUser domain meetingId invitation >>= 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