{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
module Test.Demo where
import qualified API.Brig as BrigP
import qualified API.BrigInternal as BrigI
import qualified API.GalleyInternal as GalleyI
import qualified API.Nginz as Nginz
import GHC.Stack
import SetupHelpers
import Testlib.Prelude
import Testlib.VersionedFed
testDeleteUnknownClient :: (HasCallStack) => App ()
testDeleteUnknownClient :: HasCallStack => App ()
testDeleteUnknownClient = do
user <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
let fakeClientId = String
"deadbeefdeadbeef"
bindResponse (BrigP.deleteClient user fakeClientId) $ \Response
resp -> do
Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
404
Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"label" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"client-not-found"
testModifiedBrig :: (HasCallStack) => App ()
testModifiedBrig :: HasCallStack => App ()
testModifiedBrig = do
ServiceOverrides -> (HasCallStack => String -> App ()) -> App ()
forall a.
HasCallStack =>
ServiceOverrides -> (HasCallStack => String -> App a) -> App a
withModifiedBackend
(ServiceOverrides
forall a. Default a => a
def {brigCfg = setField "optSettings.setFederationDomain" "overridden.example.com"})
((HasCallStack => String -> App ()) -> App ())
-> (HasCallStack => String -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \String
domain -> do
App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> App Response
BrigP.getAPIVersion String
domain)
((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
(Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"domain") App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"overridden.example.com"
testModifiedGalley :: (HasCallStack) => App ()
testModifiedGalley :: HasCallStack => App ()
testModifiedGalley = do
(_user, tid, _) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1
let getFeatureStatus :: (MakesValue domain) => domain -> String -> App Value
getFeatureStatus domain
domain String
team = do
App Response -> (Response -> App Value) -> App Value
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (domain -> String -> String -> App Response
forall domain_.
(HasCallStack, MakesValue domain_) =>
domain_ -> String -> String -> App Response
GalleyI.getTeamFeature domain
domain String
team String
"searchVisibility") ((Response -> App Value) -> App Value)
-> (Response -> App Value) -> App Value
forall a b. (a -> b) -> a -> b
$ \Response
res -> do
Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
Response
res.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"status"
getFeatureStatus OwnDomain tid `shouldMatch` "disabled"
withModifiedBackend
def {galleyCfg = setField "settings.featureFlags.teamSearchVisibility" "enabled-by-default"}
$ \String
domain -> do
(_user, tid', _) <- String -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam String
domain Int
1
getFeatureStatus domain tid' `shouldMatch` "enabled"
testModifiedCannon :: (HasCallStack) => App ()
testModifiedCannon :: HasCallStack => App ()
testModifiedCannon = do
ServiceOverrides -> (HasCallStack => String -> App ()) -> App ()
forall a.
HasCallStack =>
ServiceOverrides -> (HasCallStack => String -> App a) -> App a
withModifiedBackend ServiceOverrides
forall a. Default a => a
def ((HasCallStack => String -> App ()) -> App ())
-> (HasCallStack => String -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \String
_ -> () -> App ()
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
testModifiedGundeck :: (HasCallStack) => App ()
testModifiedGundeck :: HasCallStack => App ()
testModifiedGundeck = do
ServiceOverrides -> (HasCallStack => String -> App ()) -> App ()
forall a.
HasCallStack =>
ServiceOverrides -> (HasCallStack => String -> App a) -> App a
withModifiedBackend ServiceOverrides
forall a. Default a => a
def ((HasCallStack => String -> App ()) -> App ())
-> (HasCallStack => String -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \String
_ -> () -> App ()
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
testModifiedCargohold :: (HasCallStack) => App ()
testModifiedCargohold :: HasCallStack => App ()
testModifiedCargohold = do
ServiceOverrides -> (HasCallStack => String -> App ()) -> App ()
forall a.
HasCallStack =>
ServiceOverrides -> (HasCallStack => String -> App a) -> App a
withModifiedBackend ServiceOverrides
forall a. Default a => a
def ((HasCallStack => String -> App ()) -> App ())
-> (HasCallStack => String -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \String
_ -> () -> App ()
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
testModifiedSpar :: (HasCallStack) => App ()
testModifiedSpar :: HasCallStack => App ()
testModifiedSpar = do
ServiceOverrides -> (HasCallStack => String -> App ()) -> App ()
forall a.
HasCallStack =>
ServiceOverrides -> (HasCallStack => String -> App a) -> App a
withModifiedBackend ServiceOverrides
forall a. Default a => a
def ((HasCallStack => String -> App ()) -> App ())
-> (HasCallStack => String -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \String
_ -> () -> App ()
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
testModifiedServices :: (HasCallStack) => App ()
testModifiedServices :: HasCallStack => App ()
testModifiedServices = do
let serviceMap :: ServiceOverrides
serviceMap =
ServiceOverrides
forall a. Default a => a
def
{ brigCfg = setField "optSettings.setFederationDomain" "overridden.example.com",
galleyCfg = setField "settings.featureFlags.teamSearchVisibility" "enabled-by-default"
}
ServiceOverrides -> (HasCallStack => String -> App ()) -> App ()
forall a.
HasCallStack =>
ServiceOverrides -> (HasCallStack => String -> App a) -> App a
withModifiedBackend ServiceOverrides
serviceMap ((HasCallStack => String -> App ()) -> App ())
-> (HasCallStack => String -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \String
domain -> do
(_user, tid, _) <- String -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam String
domain Int
1
bindResponse (GalleyI.getTeamFeature domain tid "searchVisibility") $ \Response
res -> do
Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
Response
res.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"status" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"enabled"
bindResponse (BrigP.getAPIVersion domain)
$ \Response
resp -> do
Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
(Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"domain") App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"overridden.example.com"
bindResponse (Nginz.getSystemSettingsUnAuthorized domain)
$ \Response
resp -> do
Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"setRestrictUserCreation" App Value -> Bool -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Bool
False
testDynamicBackend :: (HasCallStack) => App ()
testDynamicBackend :: HasCallStack => App ()
testDynamicBackend = do
ownDomain <- Domain -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objDomain Domain
OwnDomain
user <- randomUser OwnDomain def
uid <- objId user
bindResponse (BrigP.getSelf user) $ \Response
resp -> do
Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
(Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id") App Value -> App String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId Value
user
startDynamicBackends [def] $ \[String]
dynDomains -> do
[dynDomain] <- [String] -> App [String]
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [String]
dynDomains
bindResponse (Nginz.getSystemSettingsUnAuthorized dynDomain)
$ \Response
resp -> do
Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"setRestrictUserCreation" App Value -> Bool -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Bool
False
bindResponse (BrigP.getSelf' dynDomain uid) $ \Response
resp -> do
Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
404
userD1 <- randomUser dynDomain def
uidD1 <- objId userD1
bindResponse (BrigP.getSelf userD1) $ \Response
resp -> do
Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
(Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id") App Value -> App String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId Value
userD1
bindResponse (BrigP.getSelf' ownDomain uidD1) $ \Response
resp -> do
Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
404
testStartMultipleDynamicBackends :: (HasCallStack) => App ()
testStartMultipleDynamicBackends :: HasCallStack => App ()
testStartMultipleDynamicBackends = do
let assertCorrectDomain :: b -> App ()
assertCorrectDomain b
domain =
App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (b -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> App Response
BrigP.getAPIVersion b
domain)
((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
(Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"domain") App Value -> b -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` b
domain
[ServiceOverrides] -> ([String] -> App ()) -> App ()
forall a.
HasCallStack =>
[ServiceOverrides] -> ([String] -> App a) -> App a
startDynamicBackends [ServiceOverrides
forall a. Default a => a
def, ServiceOverrides
forall a. Default a => a
def, ServiceOverrides
forall a. Default a => a
def] (([String] -> App ()) -> App ()) -> ([String] -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ (String -> App ()) -> [String] -> App ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> App ()
forall {b}. MakesValue b => b -> App ()
assertCorrectDomain
testIndependentESIndices :: (HasCallStack) => App ()
testIndependentESIndices :: HasCallStack => App ()
testIndependentESIndices = do
u1 <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
u2 <- randomUser OwnDomain def
uid2 <- objId u2
connectTwoUsers u1 u2
BrigI.refreshIndex OwnDomain
bindResponse (BrigP.searchContacts u1 (u2 %. "name") OwnDomain) $ \Response
resp -> do
Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
docs <- Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"documents" App Value -> (Value -> App [Value]) -> App [Value]
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 [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList
case docs of
[] -> String -> App ()
forall a. HasCallStack => String -> App a
assertFailure String
"Expected a non empty result, but got an empty one"
Value
doc : [Value]
_ -> Value
doc Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
uid2
startDynamicBackends [def] $ \[String]
dynDomains -> do
[dynDomain] <- [String] -> App [String]
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [String]
dynDomains
uD1 <- randomUser dynDomain def
bindResponse (BrigP.searchContacts uD1 (u2 %. "name") dynDomain) $ \Response
resp -> do
Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
docs <- Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"documents" App Value -> (Value -> App [Value]) -> App [Value]
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 [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList
null docs `shouldMatch` True
uD2 <- randomUser dynDomain def
uidD2 <- objId uD2
connectTwoUsers uD1 uD2
BrigI.refreshIndex dynDomain
bindResponse (BrigP.searchContacts uD1 (uD2 %. "name") dynDomain) $ \Response
resp -> do
Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
docs <- Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"documents" App Value -> (Value -> App [Value]) -> App [Value]
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 [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList
case docs of
[] -> String -> App ()
forall a. HasCallStack => String -> App a
assertFailure String
"Expected a non empty result, but got an empty one"
Value
doc : [Value]
_ -> Value
doc Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
uidD2
testDynamicBackendsFederation :: (HasCallStack) => App ()
testDynamicBackendsFederation :: HasCallStack => App ()
testDynamicBackendsFederation = do
[ServiceOverrides] -> ([String] -> App ()) -> App ()
forall a.
HasCallStack =>
[ServiceOverrides] -> ([String] -> App a) -> App a
startDynamicBackends [ServiceOverrides
forall a. Default a => a
def, ServiceOverrides
forall a. Default a => a
def] (([String] -> App ()) -> App ()) -> ([String] -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \[String
aDynDomain, String
anotherDynDomain] -> do
[u1, u2] <- [String] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createAndConnectUsers [String
aDynDomain, String
anotherDynDomain]
bindResponse (BrigP.getConnection u1 u2) assertSuccess
bindResponse (BrigP.getConnection u2 u1) assertSuccess
testWebSockets :: (HasCallStack) => App ()
testWebSockets :: HasCallStack => App ()
testWebSockets = do
user <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
withWebSocket user $ \WebSocket
ws -> do
client <- Value -> AddClient -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> AddClient -> App Response
BrigP.addClient Value
user AddClient
forall a. Default a => a
def App Response -> (Response -> App Value) -> App Value
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 Value
Int -> Response -> App Value
getJSON Int
201
n <- awaitMatch (\Value
n -> Value -> App Value
forall a. MakesValue a => a -> App Value
nPayload Value
n App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"type" App Value -> String -> App Bool
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App Bool
`isEqual` String
"user.client-add") ws
nPayload n %. "client.id" `shouldMatch` (client %. "id")
testMultipleBackends :: App ()
testMultipleBackends :: App ()
testMultipleBackends = do
ownDomainRes <- (Domain -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> App Response
BrigP.getAPIVersion Domain
OwnDomain App Response -> (Response -> App Value) -> App Value
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 Value
Int -> Response -> App Value
getJSON Int
200) App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"domain"
otherDomainRes <- (BrigP.getAPIVersion OtherDomain >>= getJSON 200) %. "domain"
ownDomainRes `shouldMatch` OwnDomain
otherDomainRes `shouldMatch` OtherDomain
OwnDomain `shouldNotMatch` OtherDomain
testUnrace :: App ()
testUnrace :: App ()
testUnrace = do
App () -> App ()
forall a. App a -> App a
retryT (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ Bool
True Bool -> Bool -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Bool
True
testLegacyFedInstance :: (HasCallStack) => AnyFedDomain -> App ()
testLegacyFedInstance :: HasCallStack => AnyFedDomain -> App ()
testLegacyFedInstance AnyFedDomain
domain = do
res <- AnyFedDomain -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> App Response
BrigP.getAPIVersion AnyFedDomain
domain App Response -> (Response -> App Value) -> App Value
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 Value
Int -> Response -> App Value
getJSON Int
200
res %. "domain" `shouldMatch` domain
testLegacyFedFederation :: (HasCallStack) => AnyFedDomain -> App ()
testLegacyFedFederation :: HasCallStack => AnyFedDomain -> App ()
testLegacyFedFederation AnyFedDomain
domain = do
alice <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
bob <- randomUser domain def
bob' <- BrigP.getUser alice bob >>= getJSON 200
bob' %. "qualified_id" `shouldMatch` (bob %. "qualified_id")
testLegacyFedFederationV2 :: (HasCallStack) => FedDomain 2 -> App ()
testLegacyFedFederationV2 :: HasCallStack => FedDomain 2 -> App ()
testLegacyFedFederationV2 FedDomain 2
fedDomainV2 = do
alice <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
bob <- randomUser fedDomainV2 def
bob' <- BrigP.getUser alice bob >>= getJSON 200
bob' %. "qualified_id" `shouldMatch` (bob %. "qualified_id")