{-# LANGUAGE DuplicateRecordFields #-}
{-# OPTIONS_GHC -Wno-incomplete-patterns #-}

module Test.Brig where

import API.Brig as BrigP
import qualified API.BrigInternal as BrigI
import API.Common
import API.GalleyInternal (setTeamFeatureStatus)
import API.Spar
import Data.Aeson.Types hiding ((.=))
import Data.List.Split
import Data.String.Conversions
import qualified Data.UUID as UUID
import qualified Data.UUID.V4 as UUID
import GHC.Stack
import SAML2.WebSSO.Test.Util (SampleIdP (..), makeSampleIdPMetadata)
import SetupHelpers
import System.IO.Extra
import Testlib.Assertions
import Testlib.Prelude
import UnliftIO.Temporary

testCrudFederationRemotes :: (HasCallStack) => App ()
testCrudFederationRemotes :: HasCallStack => App ()
testCrudFederationRemotes = do
  String
otherDomain <- Domain -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString Domain
OtherDomain
  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
ownDomain -> do
    let parseFedConns :: (HasCallStack) => Response -> App [Value]
        parseFedConns :: HasCallStack => Response -> App [Value]
parseFedConns Response
resp =
          -- Pick out the list of federation domain configs
          HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
200 Response
resp App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"remotes"
            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
              -- Enforce that the values are objects and not something else
              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) -> [Value] -> App [Value]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((Object -> Value) -> App Object -> App Value
forall a b. (a -> b) -> App a -> App b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Object -> Value
Object (App Object -> App Value)
-> (Value -> App Object) -> Value -> App Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> App Object
forall a. (HasCallStack, MakesValue a) => a -> App Object
asObject)

        addTest :: (MakesValue fedConn, Ord fedConn2, ToJSON fedConn2, MakesValue fedConn2, HasCallStack) => fedConn -> [fedConn2] -> App ()
        addTest :: forall fedConn fedConn2.
(MakesValue fedConn, Ord fedConn2, ToJSON fedConn2,
 MakesValue fedConn2, HasCallStack) =>
fedConn -> [fedConn2] -> App ()
addTest fedConn
fedConn [fedConn2]
want = do
          App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (String -> fedConn -> App Response
forall dom fedConn.
(HasCallStack, MakesValue dom, MakesValue fedConn) =>
dom -> fedConn -> App Response
BrigI.createFedConn String
ownDomain fedConn
fedConn) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
res -> do
            String -> App () -> App ()
forall a. String -> App a -> App a
addFailureContext (String
"res = " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Response -> String
forall a. Show a => a -> String
show Response
res) (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
            [Value]
res2 <- HasCallStack => Response -> App [Value]
Response -> App [Value]
parseFedConns (Response -> App [Value]) -> App Response -> App [Value]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> App Response
forall dom. (HasCallStack, MakesValue dom) => dom -> App Response
BrigI.readFedConns String
ownDomain
            [Value] -> [Value]
forall a. Ord a => [a] -> [a]
sort [Value]
res2 [Value] -> [fedConn2] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` [fedConn2] -> [fedConn2]
forall a. Ord a => [a] -> [a]
sort [fedConn2]
want

        updateTest :: (MakesValue fedConn, Ord fedConn2, ToJSON fedConn2, MakesValue fedConn2, HasCallStack) => String -> fedConn -> [fedConn2] -> App ()
        updateTest :: forall fedConn fedConn2.
(MakesValue fedConn, Ord fedConn2, ToJSON fedConn2,
 MakesValue fedConn2, HasCallStack) =>
String -> fedConn -> [fedConn2] -> App ()
updateTest String
domain fedConn
fedConn [fedConn2]
want = do
          App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (String -> String -> fedConn -> App Response
forall owndom fedConn.
(HasCallStack, MakesValue owndom, MakesValue fedConn) =>
owndom -> String -> fedConn -> App Response
BrigI.updateFedConn String
ownDomain String
domain fedConn
fedConn) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
res -> do
            String -> App () -> App ()
forall a. String -> App a -> App a
addFailureContext (String
"res = " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Response -> String
forall a. Show a => a -> String
show Response
res) (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
            [Value]
res2 <- HasCallStack => Response -> App [Value]
Response -> App [Value]
parseFedConns (Response -> App [Value]) -> App Response -> App [Value]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> App Response
forall dom. (HasCallStack, MakesValue dom) => dom -> App Response
BrigI.readFedConns String
ownDomain
            [Value] -> [Value]
forall a. Ord a => [a] -> [a]
sort [Value]
res2 [Value] -> [fedConn2] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` [fedConn2] -> [fedConn2]
forall a. Ord a => [a] -> [a]
sort [fedConn2]
want

    String
dom1 :: String <- (String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
".example.com") (String -> String) -> (UUID -> String) -> UUID -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UUID -> String
UUID.toString (UUID -> String) -> App UUID -> App String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UUID -> App UUID
forall a. IO a -> App a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UUID
UUID.nextRandom

    let remote1, remote1' :: BrigI.FedConn
        remote1 :: FedConn
remote1 = String -> String -> Maybe [String] -> FedConn
BrigI.FedConn String
dom1 String
"no_search" Maybe [String]
forall a. Maybe a
Nothing
        remote1' :: FedConn
remote1' = FedConn
remote1 {BrigI.searchStrategy = "full_search", BrigI.restriction = Just []}

        cfgRemotesExpect :: BrigI.FedConn
        cfgRemotesExpect :: FedConn
cfgRemotesExpect = String -> String -> Maybe [String] -> FedConn
BrigI.FedConn (String -> String
forall a b. ConvertibleStrings a b => a -> b
cs String
otherDomain) String
"full_search" Maybe [String]
forall a. Maybe a
Nothing

    [Value]
cfgRemotes <- HasCallStack => Response -> App [Value]
Response -> App [Value]
parseFedConns (Response -> App [Value]) -> App Response -> App [Value]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> App Response
forall dom. (HasCallStack, MakesValue dom) => dom -> App Response
BrigI.readFedConns String
ownDomain
    [Value]
cfgRemotes [Value] -> [Value] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` ([] @Value)
    -- entries present in the config file can be idempotently added if identical, but cannot be
    -- updated.
    FedConn -> [FedConn] -> App ()
forall fedConn fedConn2.
(MakesValue fedConn, Ord fedConn2, ToJSON fedConn2,
 MakesValue fedConn2, HasCallStack) =>
fedConn -> [fedConn2] -> App ()
addTest FedConn
cfgRemotesExpect [FedConn
cfgRemotesExpect]
    -- create
    FedConn -> [FedConn] -> App ()
forall fedConn fedConn2.
(MakesValue fedConn, Ord fedConn2, ToJSON fedConn2,
 MakesValue fedConn2, HasCallStack) =>
fedConn -> [fedConn2] -> App ()
addTest FedConn
remote1 [FedConn
cfgRemotesExpect, FedConn
remote1]
    FedConn -> [FedConn] -> App ()
forall fedConn fedConn2.
(MakesValue fedConn, Ord fedConn2, ToJSON fedConn2,
 MakesValue fedConn2, HasCallStack) =>
fedConn -> [fedConn2] -> App ()
addTest FedConn
remote1 [FedConn
cfgRemotesExpect, FedConn
remote1] -- idempotency
    -- update
    String -> FedConn -> [FedConn] -> App ()
forall fedConn fedConn2.
(MakesValue fedConn, Ord fedConn2, ToJSON fedConn2,
 MakesValue fedConn2, HasCallStack) =>
String -> fedConn -> [fedConn2] -> App ()
updateTest (FedConn -> String
BrigI.domain FedConn
remote1) FedConn
remote1' [FedConn
cfgRemotesExpect, FedConn
remote1']

testCrudOAuthClient :: (HasCallStack) => App ()
testCrudOAuthClient :: HasCallStack => App ()
testCrudOAuthClient = 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 appName :: String
appName = String
"foobar"
  let url :: String
url = String
"https://example.com/callback.html"
  Value
clientId <- App Response -> (Response -> App Value) -> App Value
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> String -> String -> App Response
forall user name url.
(HasCallStack, MakesValue user, MakesValue name, MakesValue url) =>
user -> name -> url -> App Response
BrigI.registerOAuthClient Value
user String
appName String
url) ((Response -> App Value) -> App Value)
-> (Response -> App Value) -> App Value
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
"client_id"
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> Value -> App Response
forall dom fedConn.
(HasCallStack, MakesValue dom, MakesValue fedConn) =>
dom -> fedConn -> App Response
BrigI.getOAuthClient Value
user Value
clientId) ((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
"application_name" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
appName
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"redirect_url" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
url
  let newName :: String
newName = String
"barfoo"
  let newUrl :: String
newUrl = String
"https://example.com/callback2.html"
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> Value -> String -> String -> App Response
forall user cid name url.
(HasCallStack, MakesValue user, MakesValue cid, MakesValue name,
 MakesValue url) =>
user -> cid -> name -> url -> App Response
BrigI.updateOAuthClient Value
user Value
clientId String
newName String
newUrl) ((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
"application_name" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
newName
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"redirect_url" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
newUrl
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> Value -> App Response
forall dom fedConn.
(HasCallStack, MakesValue dom, MakesValue fedConn) =>
dom -> fedConn -> App Response
BrigI.deleteOAuthClient Value
user Value
clientId) ((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
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> Value -> App Response
forall dom fedConn.
(HasCallStack, MakesValue dom, MakesValue fedConn) =>
dom -> fedConn -> App Response
BrigI.getOAuthClient Value
user Value
clientId) ((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

testCrudFederationRemoteTeams :: (HasCallStack) => App ()
testCrudFederationRemoteTeams :: HasCallStack => App ()
testCrudFederationRemoteTeams = do
  (Value
_, 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
  (Value
_, String
tid2, [Value]
_) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1
  String
rd <- (\String
n -> String
n String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
".wire.com") (String -> String) -> App String -> App String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> App String
randomName
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Domain -> String -> String -> App Response
forall user name url.
(HasCallStack, MakesValue user, MakesValue name, MakesValue url) =>
user -> name -> url -> App Response
BrigI.addFederationRemoteTeam' Domain
OwnDomain String
rd String
tid) ((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
533
  App Response -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Response -> App ()) -> App Response -> App ()
forall a b. (a -> b) -> a -> b
$ Domain -> FedConn -> App Response
forall dom fedConn.
(HasCallStack, MakesValue dom, MakesValue fedConn) =>
dom -> fedConn -> App Response
BrigI.createFedConn Domain
OwnDomain (FedConn -> App Response) -> FedConn -> App Response
forall a b. (a -> b) -> a -> b
$ String -> String -> Maybe [String] -> FedConn
BrigI.FedConn String
rd String
"full_search" Maybe [String]
forall a. Maybe a
Nothing
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Domain -> String -> String -> App Response
forall user name url.
(HasCallStack, MakesValue user, MakesValue name, MakesValue url) =>
user -> name -> url -> App Response
BrigI.addFederationRemoteTeam' Domain
OwnDomain String
rd String
tid) ((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
533
  App Response -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Response -> App ()) -> App Response -> App ()
forall a b. (a -> b) -> a -> b
$ Domain -> String -> FedConn -> App Response
forall owndom fedConn.
(HasCallStack, MakesValue owndom, MakesValue fedConn) =>
owndom -> String -> fedConn -> App Response
BrigI.updateFedConn Domain
OwnDomain String
rd (FedConn -> App Response) -> FedConn -> App Response
forall a b. (a -> b) -> a -> b
$ String -> String -> Maybe [String] -> FedConn
BrigI.FedConn String
rd String
"full_search" ([String] -> Maybe [String]
forall a. a -> Maybe a
Just [])
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Domain -> String -> App Response
forall dom fedConn.
(HasCallStack, MakesValue dom, MakesValue fedConn) =>
dom -> fedConn -> App Response
BrigI.getFederationRemoteTeams Domain
OwnDomain String
rd) ((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 -> [String] -> App ()
checkAbsence Response
resp [String
tid, String
tid2]
  Domain -> String -> String -> App ()
forall domain remoteDomain team.
(HasCallStack, MakesValue domain, MakesValue remoteDomain,
 MakesValue team) =>
domain -> remoteDomain -> team -> App ()
BrigI.addFederationRemoteTeam Domain
OwnDomain String
rd String
tid
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Domain -> String -> App Response
forall dom fedConn.
(HasCallStack, MakesValue dom, MakesValue fedConn) =>
dom -> fedConn -> App Response
BrigI.getFederationRemoteTeams Domain
OwnDomain String
rd) ((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 -> [String] -> App ()
checkPresence Response
resp [String
tid]
    Response -> [String] -> App ()
checkAbsence Response
resp [String
tid2]
  Domain -> String -> String -> App ()
forall domain remoteDomain team.
(HasCallStack, MakesValue domain, MakesValue remoteDomain,
 MakesValue team) =>
domain -> remoteDomain -> team -> App ()
BrigI.addFederationRemoteTeam Domain
OwnDomain String
rd String
tid2
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Domain -> String -> App Response
forall dom fedConn.
(HasCallStack, MakesValue dom, MakesValue fedConn) =>
dom -> fedConn -> App Response
BrigI.getFederationRemoteTeams Domain
OwnDomain String
rd) ((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 -> [String] -> App ()
checkPresence Response
resp [String
tid, String
tid2]
  Domain -> String -> String -> App ()
forall domain remoteDomain team.
(HasCallStack, MakesValue domain, MakesValue remoteDomain,
 MakesValue team) =>
domain -> remoteDomain -> team -> App ()
BrigI.deleteFederationRemoteTeam Domain
OwnDomain String
rd String
tid
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Domain -> String -> App Response
forall dom fedConn.
(HasCallStack, MakesValue dom, MakesValue fedConn) =>
dom -> fedConn -> App Response
BrigI.getFederationRemoteTeams Domain
OwnDomain String
rd) ((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 -> [String] -> App ()
checkPresence Response
resp [String
tid2]
    Response -> [String] -> App ()
checkAbsence Response
resp [String
tid]
  Domain -> String -> String -> App ()
forall domain remoteDomain team.
(HasCallStack, MakesValue domain, MakesValue remoteDomain,
 MakesValue team) =>
domain -> remoteDomain -> team -> App ()
BrigI.deleteFederationRemoteTeam Domain
OwnDomain String
rd String
tid2
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Domain -> String -> App Response
forall dom fedConn.
(HasCallStack, MakesValue dom, MakesValue fedConn) =>
dom -> fedConn -> App Response
BrigI.getFederationRemoteTeams Domain
OwnDomain String
rd) ((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 -> [String] -> App ()
checkAbsence Response
resp [String
tid, String
tid2]
  where
    checkAbsence :: Response -> [String] -> App ()
    checkAbsence :: Response -> [String] -> App ()
checkAbsence Response
resp [String]
tids = do
      [Value]
l <- Response
resp.json 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
      [String]
remoteTeams <- [Value] -> (Value -> App String) -> App [String]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Value]
l (\Value
e -> Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"team_id" App Value -> (App Value -> App String) -> App String
forall a b. a -> (a -> b) -> b
& App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString)
      Bool -> App () -> App ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\String
t -> String
t String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
remoteTeams) [String]
tids) (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ String -> App ()
forall a. HasCallStack => String -> App a
assertFailure String
"Expected response to not contain any of the teams"

    checkPresence :: Response -> [String] -> App ()
    checkPresence :: Response -> [String] -> App ()
checkPresence Response
resp [String]
tids = do
      [Value]
l <- Response
resp.json 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
      [String]
remoteTeams <- [Value] -> (Value -> App String) -> App [String]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Value]
l (\Value
e -> Value
e Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"team_id" App Value -> (App Value -> App String) -> App String
forall a b. a -> (a -> b) -> b
& App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString)
      Bool -> App () -> App ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\String
t -> String
t String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [String]
remoteTeams) [String]
tids) (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ String -> App ()
forall a. HasCallStack => String -> App a
assertFailure String
"Expected response to contain all of the teams"

testSFTCredentials :: (HasCallStack) => App ()
testSFTCredentials :: HasCallStack => App ()
testSFTCredentials = do
  let ttl :: Int
ttl = (Int
60 :: Int)
  String -> (String -> Handle -> App ()) -> App ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
String -> (String -> Handle -> m a) -> m a
withSystemTempFile String
"sft-secret" ((String -> Handle -> App ()) -> App ())
-> (String -> Handle -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \String
secretFile Handle
secretHandle -> do
    IO () -> App ()
forall a. IO a -> App a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> App ()) -> IO () -> App ()
forall a b. (a -> b) -> a -> b
$ do
      Handle -> String -> IO ()
hPutStr Handle
secretHandle String
"xMtZyTpu=Leb?YKCoq#BXQR:gG^UrE83dNWzFJ2VcD"
      Handle -> IO ()
hClose Handle
secretHandle
    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 "sft.sftBaseDomain" "integration-tests.zinfra.io"
                  . setField "sft.sftToken.ttl" ttl
                  . setField "sft.sftToken.secret" secretFile
                  . setField "optSettings.setSftListAllServers" "enabled"
              )
          }
      )
      ((HasCallStack => String -> App ()) -> App ())
-> (HasCallStack => String -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \String
domain -> do
        Value
user <- String -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser String
domain CreateUser
forall a. Default a => a
def
        App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> App Response
forall dom. (HasCallStack, MakesValue dom) => dom -> App Response
getCallsConfigV2 Value
user) \Response
resp -> do
          [Value]
sftServersAll <- Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"sft_servers_all" 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
          Bool -> App () -> App ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Value] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Value]
sftServersAll) (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ String -> App ()
forall a. HasCallStack => String -> App a
assertFailure String
"sft_servers_all missing"
          [Value] -> (Value -> App ()) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Value]
sftServersAll ((Value -> App ()) -> App ()) -> (Value -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Value
s -> do
            String
cred <- Value
s Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"credential" App Value -> (App Value -> App String) -> App String
forall a b. a -> (a -> b) -> b
& App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString
            Bool -> App () -> App ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
cred) (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ String -> App ()
forall a. HasCallStack => String -> App a
assertFailure String
"credential missing"
            String
usr <- Value
s Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"username" App Value -> (App Value -> App String) -> App String
forall a b. a -> (a -> b) -> b
& App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString
            let parts :: [String]
parts = String -> String -> [String]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn String
"." String
usr
            Bool -> App () -> App ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
parts Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
5) (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ String -> App ()
forall a. HasCallStack => String -> App a
assertFailure String
"username should have 5 parts"
            Bool -> App () -> App ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
2 ([String] -> String
forall a. HasCallStack => [a] -> a
head [String]
parts) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"d=") (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ String -> App ()
forall a. HasCallStack => String -> App a
assertFailure String
"missing expiry time identifier"
            Bool -> App () -> App ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
2 ([String]
parts [String] -> Int -> String
forall a. HasCallStack => [a] -> Int -> a
!! Int
1) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"v=") (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ String -> App ()
forall a. HasCallStack => String -> App a
assertFailure String
"missing version identifier"
            Bool -> App () -> App ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
2 ([String]
parts [String] -> Int -> String
forall a. HasCallStack => [a] -> Int -> a
!! Int
2) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"k=") (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ String -> App ()
forall a. HasCallStack => String -> App a
assertFailure String
"missing key ID identifier"
            Bool -> App () -> App ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
2 ([String]
parts [String] -> Int -> String
forall a. HasCallStack => [a] -> Int -> a
!! Int
3) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"s=") (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ String -> App ()
forall a. HasCallStack => String -> App a
assertFailure String
"missing federation identifier"
            Bool -> App () -> App ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
2 ([String]
parts [String] -> Int -> String
forall a. HasCallStack => [a] -> Int -> a
!! Int
4) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"r=") (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ String -> App ()
forall a. HasCallStack => String -> App a
assertFailure String
"missing random data identifier"
            [String] -> (String -> App ()) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [String]
parts ((String -> App ()) -> App ()) -> (String -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \String
part -> Bool -> App () -> App ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
part Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
3) (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ String -> App ()
forall a. HasCallStack => String -> App a
assertFailure (String
"value missing for " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
part)

testSFTNoCredentials :: (HasCallStack) => App ()
testSFTNoCredentials :: HasCallStack => App ()
testSFTNoCredentials = 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 "sft.sftBaseDomain" "integration-tests.zinfra.io"
              . setField "optSettings.setSftListAllServers" "enabled"
          )
      }
  )
  ((HasCallStack => String -> App ()) -> App ())
-> (HasCallStack => String -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \String
domain -> do
    Value
user <- String -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser String
domain CreateUser
forall a. Default a => a
def
    App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> App Response
forall dom. (HasCallStack, MakesValue dom) => dom -> App Response
getCallsConfigV2 Value
user) \Response
resp -> do
      [Value]
sftServersAll <- Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"sft_servers_all" 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
      Bool -> App () -> App ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Value] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Value]
sftServersAll) (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ String -> App ()
forall a. HasCallStack => String -> App a
assertFailure String
"sft_servers_all missing"
      [Value] -> (Value -> App ()) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Value]
sftServersAll ((Value -> App ()) -> App ()) -> (Value -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Value
s -> do
        Maybe Value
credM <- Value -> String -> App (Maybe Value)
forall a.
(HasCallStack, MakesValue a) =>
a -> String -> App (Maybe Value)
lookupField Value
s String
"credential"
        Bool -> App () -> App ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Value -> Bool
forall a. Maybe a -> Bool
isJust Maybe Value
credM) (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ String -> App ()
forall a. HasCallStack => String -> App a
assertFailure String
"should not generate credential"
        Maybe Value
usrM <- Value -> String -> App (Maybe Value)
forall a.
(HasCallStack, MakesValue a) =>
a -> String -> App (Maybe Value)
lookupField Value
s String
"username"
        Bool -> App () -> App ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Value -> Bool
forall a. Maybe a -> Bool
isJust Maybe Value
usrM) (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ String -> App ()
forall a. HasCallStack => String -> App a
assertFailure String
"should not generate username"

testSFTFederation :: (HasCallStack) => App ()
testSFTFederation :: HasCallStack => App ()
testSFTFederation = 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 "sft.sftBaseDomain" "integration-tests.zinfra.io"
                . removeField "multiSFT"
            )
        }
    )
    ((HasCallStack => String -> App ()) -> App ())
-> (HasCallStack => String -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \String
domain -> do
      Value
user <- String -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser String
domain CreateUser
forall a. Default a => a
def
      App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> App Response
forall dom. (HasCallStack, MakesValue dom) => dom -> App Response
getCallsConfigV2 Value
user) \Response
resp -> do
        Maybe Value
isFederatingM <- App Value -> String -> App (Maybe Value)
forall a.
(HasCallStack, MakesValue a) =>
a -> String -> App (Maybe Value)
lookupField Response
resp.json String
"is_federating"
        Bool -> App () -> App ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Value -> Bool
forall a. Maybe a -> Bool
isJust Maybe Value
isFederatingM) (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ String -> App ()
forall a. HasCallStack => String -> App a
assertFailure String
"is_federating should not be present"
  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 "sft.sftBaseDomain" "integration-tests.zinfra.io"
                . setField "multiSFT" True
            )
        }
    )
    ((HasCallStack => String -> App ()) -> App ())
-> (HasCallStack => String -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \String
domain -> do
      Value
user <- String -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser String
domain CreateUser
forall a. Default a => a
def
      App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> App Response
forall dom. (HasCallStack, MakesValue dom) => dom -> App Response
getCallsConfigV2 Value
user) \Response
resp -> do
        Bool
isFederating <-
          App Bool -> (Value -> App Bool) -> Maybe Value -> App Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> App Bool
forall a. HasCallStack => String -> App a
assertFailure String
"is_federating missing") Value -> App Bool
forall a. (HasCallStack, MakesValue a) => a -> App Bool
asBool
            (Maybe Value -> App Bool) -> App (Maybe Value) -> App Bool
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< App Value -> String -> App (Maybe Value)
forall a.
(HasCallStack, MakesValue a) =>
a -> String -> App (Maybe Value)
lookupField Response
resp.json String
"is_federating"
        Bool -> App () -> App ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
isFederating (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ String -> App ()
forall a. HasCallStack => String -> App a
assertFailure String
"is_federating should be true"
  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 "sft.sftBaseDomain" "integration-tests.zinfra.io"
                . setField "multiSFT" False
            )
        }
    )
    ((HasCallStack => String -> App ()) -> App ())
-> (HasCallStack => String -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \String
domain -> do
      Value
user <- String -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser String
domain CreateUser
forall a. Default a => a
def
      App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> App Response
forall dom. (HasCallStack, MakesValue dom) => dom -> App Response
getCallsConfigV2 Value
user) \Response
resp -> do
        Bool
isFederating <-
          App Bool -> (Value -> App Bool) -> Maybe Value -> App Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> App Bool
forall a. HasCallStack => String -> App a
assertFailure String
"is_federating missing") Value -> App Bool
forall a. (HasCallStack, MakesValue a) => a -> App Bool
asBool
            (Maybe Value -> App Bool) -> App (Maybe Value) -> App Bool
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< App Value -> String -> App (Maybe Value)
forall a.
(HasCallStack, MakesValue a) =>
a -> String -> App (Maybe Value)
lookupField Response
resp.json String
"is_federating"
        Bool -> App () -> App ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isFederating (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ String -> App ()
forall a. HasCallStack => String -> App a
assertFailure String
"is_federating should be false"

testDeleteEmail :: (HasCallStack) => App ()
testDeleteEmail :: HasCallStack => App ()
testDeleteEmail = do
  (Value
owner, String
tid, [Value
usr]) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2
  Value -> PutSelf -> App Response
forall caller.
(HasCallStack, MakesValue caller) =>
caller -> PutSelf -> App Response
putSelf Value
usr (Maybe Int
-> Maybe [Value] -> Maybe String -> Maybe [String] -> PutSelf
PutSelf Maybe Int
forall a. Maybe a
Nothing Maybe [Value]
forall a. Maybe a
Nothing (String -> Maybe String
forall a. a -> Maybe a
Just String
"Alice") Maybe [String]
forall a. Maybe a
Nothing) 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 => Response -> App ()
Response -> App ()
assertSuccess
  String
email <- Value -> App Response
forall dom. (HasCallStack, MakesValue dom) => dom -> App Response
getSelf Value
usr 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 -> (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 -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"email") 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 associateUsrWithSSO :: (HasCallStack) => App ()
      associateUsrWithSSO :: HasCallStack => App ()
associateUsrWithSSO = do
        App Response -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Response -> App ()) -> App Response -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> String -> String -> String -> App Response
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App Response
setTeamFeatureStatus Value
owner String
tid String
"sso" String
"enabled"
        Value -> App Response
forall dom. (HasCallStack, MakesValue dom) => dom -> App Response
registerTestIdPWithMeta Value
owner 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 => Response -> App ()
Response -> App ()
assertSuccess
        String
tok <- Value -> App Response
forall dom. (HasCallStack, MakesValue dom) => dom -> App Response
createScimToken Value
owner 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 -> (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 -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"token") 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
        App Response -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Response -> App ()) -> App Response -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> String -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> String -> App Response
findUsersByExternalId Value
owner String
tok String
email

      searchShouldBe :: (HasCallStack) => String -> App ()
      searchShouldBe :: HasCallStack => String -> App ()
searchShouldBe String
expected = do
        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 -> String -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> String -> App Response
BrigP.searchTeam Value
owner String
email) ((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
          Int
numDocs <- [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
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 String
expected of
            String
"empty" -> Int
numDocs Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
0
            String
"non-empty" -> Int
numDocs Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
1

  Value -> App Response
forall dom. (HasCallStack, MakesValue dom) => dom -> App Response
deleteSelfEmail Value
usr 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
403
  HasCallStack => String -> App ()
String -> App ()
searchShouldBe String
"non-empty"
  App ()
HasCallStack => App ()
associateUsrWithSSO
  Value -> App Response
forall dom. (HasCallStack, MakesValue dom) => dom -> App Response
deleteSelfEmail Value
usr 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 => Response -> App ()
Response -> App ()
assertSuccess
  HasCallStack => String -> App ()
String -> App ()
searchShouldBe String
"empty"

registerTestIdPWithMeta :: (HasCallStack, MakesValue owner) => owner -> App Response
registerTestIdPWithMeta :: forall dom. (HasCallStack, MakesValue dom) => dom -> App Response
registerTestIdPWithMeta owner
owner = do
  SampleIdP IdPMetadata
idpmeta SignPrivCreds
_ SignCreds
_ SignedCertificate
_ <- App SampleIdP
forall (m :: * -> *).
(HasCallStack, MonadIO m, MonadRandom m) =>
m SampleIdP
makeSampleIdPMetadata
  owner -> IdPMetadata -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> IdPMetadata -> App Response
createIdp owner
owner IdPMetadata
idpmeta