{-# OPTIONS_GHC -Wno-ambiguous-fields #-}
module Test.Meetings where
import API.Galley
import qualified API.GalleyInternal as I
import Data.Time.Clock
import qualified Data.Time.Format as Time
import SetupHelpers
import Testlib.Prelude
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)
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])
(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"
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
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
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
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
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
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