{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}

-- | This module is meant to show how Testlib can be used
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

-- | Deleting unknown clients should fail with 404.
testDeleteUnknownClient :: (HasCallStack) => App ()
testDeleteUnknownClient :: HasCallStack => App ()
testDeleteUnknownClient = do
  Value
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
fakeClientId = String
"deadbeefdeadbeef"
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> String -> App Response
forall user client.
(HasCallStack, MakesValue user, MakesValue client) =>
user -> client -> App Response
BrigP.deleteClient Value
user String
fakeClientId) ((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
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
  (Value
_user, String
tid, [Value]
_) <- 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 :: forall domain. 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"

  Domain -> String -> App Value
forall domain. MakesValue domain => domain -> String -> App Value
getFeatureStatus Domain
OwnDomain String
tid App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"disabled"

  ServiceOverrides -> (HasCallStack => String -> App ()) -> App ()
forall a.
HasCallStack =>
ServiceOverrides -> (HasCallStack => String -> App a) -> App a
withModifiedBackend
    ServiceOverrides
forall a. Default a => a
def {galleyCfg = setField "settings.featureFlags.teamSearchVisibility" "enabled-by-default"}
    ((HasCallStack => String -> App ()) -> App ())
-> (HasCallStack => String -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \String
domain -> do
      (Value
_user, String
tid', [Value]
_) <- String -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam String
domain Int
1
      String -> String -> App Value
forall domain. MakesValue domain => domain -> String -> App Value
getFeatureStatus String
domain String
tid' App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"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
    (Value
_user, String
tid, [Value]
_) <- String -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam String
domain Int
1
    App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (String -> String -> String -> App Response
forall domain_.
(HasCallStack, MakesValue domain_) =>
domain_ -> String -> String -> App Response
GalleyI.getTeamFeature String
domain String
tid String
"searchVisibility") ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
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" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"enabled"

    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"

    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
Nginz.getSystemSettingsUnAuthorized 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
"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
  String
ownDomain <- Domain -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objDomain Domain
OwnDomain
  Value
user <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
  String
uid <- Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId Value
user
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> App Response
BrigP.getSelf Value
user) ((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
"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

  [ServiceOverrides] -> ([String] -> App ()) -> App ()
forall a. [ServiceOverrides] -> ([String] -> App a) -> App a
startDynamicBackends [ServiceOverrides
forall a. Default a => a
def] (([String] -> App ()) -> App ()) -> ([String] -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \[String]
dynDomains -> do
    [String
dynDomain] <- [String] -> App [String]
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [String]
dynDomains
    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
Nginz.getSystemSettingsUnAuthorized String
dynDomain)
      ((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
"setRestrictUserCreation" App Value -> Bool -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Bool
False

    -- user created in own domain should not be found in dynamic backend
    App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (HasCallStack => String -> String -> App Response
String -> String -> App Response
BrigP.getSelf' String
dynDomain String
uid) ((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
404

    -- now create a user in the dynamic backend
    Value
userD1 <- String -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser String
dynDomain CreateUser
forall a. Default a => a
def
    String
uidD1 <- Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId Value
userD1
    App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> App Response
BrigP.getSelf Value
userD1) ((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
"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

    -- the d1 user should not be found in the own domain
    App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (HasCallStack => String -> String -> App Response
String -> String -> App Response
BrigP.getSelf' String
ownDomain String
uidD1) ((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
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. [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
  Value
u1 <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
  Value
u2 <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
  String
uid2 <- Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId Value
u2
  Value -> Value -> App ()
forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> App ()
connectTwoUsers Value
u1 Value
u2
  Domain -> App ()
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> App ()
BrigI.refreshIndex Domain
OwnDomain
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> App Value -> Domain -> App Response
forall user searchTerm domain.
(MakesValue user, MakesValue searchTerm, MakesValue domain) =>
user -> searchTerm -> domain -> App Response
BrigP.searchContacts Value
u1 (Value
u2 Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"name") Domain
OwnDomain) ((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
    [Value]
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 [Value]
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
  [ServiceOverrides] -> ([String] -> App ()) -> App ()
forall a. [ServiceOverrides] -> ([String] -> App a) -> App a
startDynamicBackends [ServiceOverrides
forall a. Default a => a
def] (([String] -> App ()) -> App ()) -> ([String] -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \[String]
dynDomains -> do
    [String
dynDomain] <- [String] -> App [String]
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [String]
dynDomains
    Value
uD1 <- String -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser String
dynDomain CreateUser
forall a. Default a => a
def
    -- searching for u1 on the dyn backend should yield no result
    App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> App Value -> String -> App Response
forall user searchTerm domain.
(MakesValue user, MakesValue searchTerm, MakesValue domain) =>
user -> searchTerm -> domain -> App Response
BrigP.searchContacts Value
uD1 (Value
u2 Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"name") String
dynDomain) ((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
      [Value]
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
      [Value] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Value]
docs Bool -> Bool -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Bool
True
    Value
uD2 <- String -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser String
dynDomain CreateUser
forall a. Default a => a
def
    String
uidD2 <- Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
objId Value
uD2
    Value -> Value -> App ()
forall alice bob.
(HasCallStack, MakesValue alice, MakesValue bob) =>
alice -> bob -> App ()
connectTwoUsers Value
uD1 Value
uD2
    String -> App ()
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> App ()
BrigI.refreshIndex String
dynDomain
    -- searching for uD2 on the dyn backend should yield a result
    App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> App Value -> String -> App Response
forall user searchTerm domain.
(MakesValue user, MakesValue searchTerm, MakesValue domain) =>
user -> searchTerm -> domain -> App Response
BrigP.searchContacts Value
uD1 (Value
uD2 Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"name") String
dynDomain) ((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
      [Value]
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 [Value]
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. [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
    [Value
u1, Value
u2] <- [String] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createAndConnectUsers [String
aDynDomain, String
anotherDynDomain]
    App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> Value -> App Response
forall user client.
(HasCallStack, MakesValue user, MakesValue client) =>
user -> client -> App Response
BrigP.getConnection Value
u1 Value
u2) HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
    App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> Value -> App Response
forall user client.
(HasCallStack, MakesValue user, MakesValue client) =>
user -> client -> App Response
BrigP.getConnection Value
u2 Value
u1) HasCallStack => Response -> App ()
Response -> App ()
assertSuccess

testWebSockets :: (HasCallStack) => App ()
testWebSockets :: HasCallStack => App ()
testWebSockets = do
  Value
user <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
  Value -> (WebSocket -> App ()) -> App ()
forall w a.
(HasCallStack, ToWSConnect w) =>
w -> (WebSocket -> App a) -> App a
withWebSocket Value
user ((WebSocket -> App ()) -> App ())
-> (WebSocket -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \WebSocket
ws -> do
    Value
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
    Value
n <- HasCallStack => (Value -> App Bool) -> WebSocket -> App Value
(Value -> App Bool) -> WebSocket -> App Value
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") WebSocket
ws
    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
"client.id" App Value -> App Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (Value
client Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id")

testMultipleBackends :: App ()
testMultipleBackends :: App ()
testMultipleBackends = do
  Value
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"
  Value
otherDomainRes <- (Domain -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> App Response
BrigP.getAPIVersion Domain
OtherDomain 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"
  Value
ownDomainRes Value -> Domain -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Domain
OwnDomain
  Value
otherDomainRes Value -> Domain -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Domain
OtherDomain
  Domain
OwnDomain Domain -> Domain -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldNotMatch` Domain
OtherDomain

testUnrace :: App ()
testUnrace :: App ()
testUnrace = do
  {-
  -- the following would retry for ~30s and only then fail
  retryT $ do
    True `shouldMatch` True
    True `shouldMatch` False
  -}
  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
  Value
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
  Value
res Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"domain" App Value -> AnyFedDomain -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` AnyFedDomain
domain

testLegacyFedFederation :: (HasCallStack) => AnyFedDomain -> App ()
testLegacyFedFederation :: HasCallStack => AnyFedDomain -> App ()
testLegacyFedFederation AnyFedDomain
domain = do
  Value
alice <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
  Value
bob <- AnyFedDomain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser AnyFedDomain
domain CreateUser
forall a. Default a => a
def

  Value
bob' <- Value -> Value -> App Response
forall user client.
(HasCallStack, MakesValue user, MakesValue client) =>
user -> client -> App Response
BrigP.getUser Value
alice Value
bob 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
  Value
bob' Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id" App Value -> App Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (Value
bob Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"qualified_id")