{-# OPTIONS_GHC -Wno-ambiguous-fields #-}

-- | See also: "Test.EnterpriseLogin"
module Test.DomainVerification where

import API.Brig
import API.BrigInternal
import API.Common
import API.GalleyInternal (setTeamFeatureLockStatus, setTeamFeatureStatus)
import API.Spar
import Control.Concurrent (threadDelay)
import Control.Monad.Trans.Maybe
import SetupHelpers
import Test.DNSMock
import Testlib.Prelude

testDomainVerificationGetOwnershipToken :: (HasCallStack) => App ()
testDomainVerificationGetOwnershipToken :: HasCallStack => App ()
testDomainVerificationGetOwnershipToken = do
  String
domain <- App String
randomDomain
  Domain -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> App Response
domainRegistrationPreAuthorize Domain
OwnDomain String
domain 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
204
  ChallengeSetup
challenge <- Domain -> String -> App ChallengeSetup
forall domain.
(MakesValue domain, HasCallStack) =>
domain -> String -> App ChallengeSetup
setupChallenge Domain
OwnDomain String
domain

  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Domain -> String -> String -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> String -> String -> App Response
verifyDomain Domain
OwnDomain String
domain ChallengeSetup
challenge.challengeId ChallengeSetup
challenge.challengeToken) ((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
403
    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
"domain-verification-failed"

  HasCallStack =>
String -> String -> String -> String -> String -> App ()
String -> String -> String -> String -> String -> App ()
registerTechnitiumRecord ChallengeSetup
challenge.technitiumToken String
domain (String
"wire-domain." String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
domain) String
"TXT" ChallengeSetup
challenge.dnsToken

  -- verify domain
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Domain -> String -> String -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> String -> String -> App Response
verifyDomain Domain
OwnDomain String
domain ChallengeSetup
challenge.challengeId ChallengeSetup
challenge.challengeToken) ((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 String -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App String -> App ()) -> App String -> App ()
forall a b. (a -> b) -> a -> b
$ Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"domain_ownership_token" 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

  -- the challenge should be deleted after successful verification
  Domain -> String -> String -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> String -> String -> App Response
verifyDomain Domain
OwnDomain String
domain ChallengeSetup
challenge.challengeId ChallengeSetup
challenge.challengeToken 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
404

testCreateChallengeFailsIfLocked :: (HasCallStack) => App ()
testCreateChallengeFailsIfLocked :: HasCallStack => App ()
testCreateChallengeFailsIfLocked = do
  String
domain <- App String
randomDomain
  Domain -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> App Response
domainRegistrationLock Domain
OwnDomain String
domain 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
204
  Domain -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> App Response
getDomainVerificationChallenge Domain
OwnDomain String
domain App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
403
    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
"operation-forbidden-for-domain-registration-state"

testVerifyChallengeFailsIfNotPreauthorized :: (HasCallStack) => App ()
testVerifyChallengeFailsIfNotPreauthorized :: HasCallStack => App ()
testVerifyChallengeFailsIfNotPreauthorized = do
  String
domain <- App String
randomDomain
  ChallengeSetup
challenge <- Domain -> String -> App ChallengeSetup
forall domain.
(MakesValue domain, HasCallStack) =>
domain -> String -> App ChallengeSetup
setupChallenge Domain
OwnDomain String
domain
  HasCallStack =>
String -> String -> String -> String -> String -> App ()
String -> String -> String -> String -> String -> App ()
registerTechnitiumRecord ChallengeSetup
challenge.technitiumToken String
domain (String
"wire-domain." String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
domain) String
"TXT" ChallengeSetup
challenge.dnsToken
  Domain -> String -> String -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> String -> String -> App Response
verifyDomain Domain
OwnDomain String
domain ChallengeSetup
challenge.challengeId ChallengeSetup
challenge.challengeToken App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
403
    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
"operation-forbidden-for-domain-registration-state"

testDomainVerificationOnPremFlow :: (HasCallStack) => App ()
testDomainVerificationOnPremFlow :: HasCallStack => App ()
testDomainVerificationOnPremFlow = [Versioned] -> (Versioned -> App ()) -> App ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int -> Versioned
ExplicitVersion Int
8, Versioned
Versioned] \Versioned
version -> do
  String
domain <- App String
randomDomain
  App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def {email = Just ("paolo@" <> domain)}

  Domain -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> App Response
domainRegistrationPreAuthorize Domain
OwnDomain String
domain 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
204

  DomainRegistrationSetup
setup <- Domain -> String -> App DomainRegistrationSetup
forall domain.
(MakesValue domain, HasCallStack) =>
domain -> String -> App DomainRegistrationSetup
setupOwnershipTokenForBackend Domain
OwnDomain String
domain
  let ownershipToken :: String
ownershipToken = DomainRegistrationSetup
setup.ownershipToken

  -- post config without ownership token (this is not allowed)
  Domain
-> Versioned -> String -> Maybe String -> Value -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain
-> Versioned -> String -> Maybe String -> Value -> App Response
updateDomainRedirect
    Domain
OwnDomain
    Versioned
version
    String
domain
    Maybe String
forall a. Maybe a
Nothing
    (Versioned -> String -> String -> Value
mkDomainRedirectBackend Versioned
version String
"https://wire.example.com" String
"https://webapp.wire.example.com")
    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
400

  -- [customer admin] post config (happy flow)
  HasCallStack => String -> Versioned -> String -> Value -> App ()
String -> Versioned -> String -> Value -> App ()
checkUpdateRedirectSuccessful
    String
domain
    Versioned
version
    String
ownershipToken
    (Versioned -> String -> String -> Value
mkDomainRedirectBackend Versioned
version String
"https://wire.example.com" String
"https://webapp.wire.example.com")

  -- idempotence
  HasCallStack => String -> Versioned -> String -> Value -> App ()
String -> Versioned -> String -> Value -> App ()
checkUpdateRedirectSuccessful
    String
domain
    Versioned
version
    String
ownershipToken
    (Versioned -> String -> String -> Value
mkDomainRedirectBackend Versioned
version String
"https://wire.example.com" String
"https://webapp.wire.example.com")

  -- [customer admin] update the previously set backend url
  HasCallStack => String -> Versioned -> String -> Value -> App ()
String -> Versioned -> String -> Value -> App ()
checkUpdateRedirectSuccessful
    String
domain
    Versioned
version
    String
ownershipToken
    (Versioned -> String -> String -> Value
mkDomainRedirectBackend Versioned
version String
"https://wire2.example.com" String
"https://webapp.wire2.example.com")

  -- [customer admin] update to no-registration
  HasCallStack => String -> Versioned -> String -> Value -> App ()
String -> Versioned -> String -> Value -> App ()
checkUpdateRedirectSuccessful
    String
domain
    Versioned
version
    String
ownershipToken
    ([Pair] -> Value
object [String
"domain_redirect" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"no-registration"])

  -- idempotence
  HasCallStack => String -> Versioned -> String -> Value -> App ()
String -> Versioned -> String -> Value -> App ()
checkUpdateRedirectSuccessful
    String
domain
    Versioned
version
    String
ownershipToken
    ([Pair] -> Value
object [String
"domain_redirect" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"no-registration"])

  -- [customer admin] transition from no-registration back to backend
  HasCallStack => String -> Versioned -> String -> Value -> App ()
String -> Versioned -> String -> Value -> App ()
checkUpdateRedirectSuccessful
    String
domain
    Versioned
version
    String
ownershipToken
    (Versioned -> String -> String -> Value
mkDomainRedirectBackend Versioned
version String
"https://wire.example.com" String
"https://webapp.wire.example.com")
  where
    checkUpdateRedirectSuccessful :: (HasCallStack) => String -> Versioned -> String -> Value -> App ()
    checkUpdateRedirectSuccessful :: HasCallStack => String -> Versioned -> String -> Value -> App ()
checkUpdateRedirectSuccessful String
domain Versioned
version String
token Value
config = do
      Domain
-> Versioned -> String -> Maybe String -> Value -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain
-> Versioned -> String -> Maybe String -> Value -> App Response
updateDomainRedirect
        Domain
OwnDomain
        Versioned
version
        String
domain
        (String -> Maybe String
forall a. a -> Maybe a
Just String
token)
        Value
config
        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
200

      App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Domain -> Versioned -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Versioned -> String -> App Response
getDomainRegistrationFromEmail Domain
OwnDomain Versioned
version (String
"sven@" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
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_redirect" App Value -> App Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (Value
config Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"domain_redirect")
        case Versioned
version of
          ExplicitVersion Int
v
            | Int
v Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
8 ->
                App Value -> String -> App (Maybe Value)
forall a.
(HasCallStack, MakesValue a) =>
a -> String -> App (Maybe Value)
lookupField Response
resp.json String
"backend_url" App (Maybe Value) -> App (Maybe Value) -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (Value -> String -> App (Maybe Value)
forall a.
(HasCallStack, MakesValue a) =>
a -> String -> App (Maybe Value)
lookupField Value
config String
"backend_url")
          Versioned
_ -> do
            let backendUrl :: a -> App (Maybe Value)
backendUrl a
v = MaybeT App Value -> App (Maybe Value)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT App Value -> App (Maybe Value))
-> MaybeT App Value -> App (Maybe Value)
forall a b. (a -> b) -> a -> b
$ a -> String -> MaybeT App Value
forall a.
(HasCallStack, MakesValue a) =>
a -> String -> MaybeT App Value
lookupFieldM a
v String
"backend" MaybeT App Value -> (Value -> MaybeT App Value) -> MaybeT App Value
forall a b. MaybeT App a -> (a -> MaybeT App b) -> MaybeT App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Value -> String -> MaybeT App Value)
-> String -> Value -> MaybeT App Value
forall a b c. (a -> b -> c) -> b -> a -> c
flip Value -> String -> MaybeT App Value
forall a.
(HasCallStack, MakesValue a) =>
a -> String -> MaybeT App Value
lookupFieldM String
"config_url"
                webappUrl :: a -> App (Maybe Value)
webappUrl a
v = MaybeT App Value -> App (Maybe Value)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT App Value -> App (Maybe Value))
-> MaybeT App Value -> App (Maybe Value)
forall a b. (a -> b) -> a -> b
$ a -> String -> MaybeT App Value
forall a.
(HasCallStack, MakesValue a) =>
a -> String -> MaybeT App Value
lookupFieldM a
v String
"backend" MaybeT App Value -> (Value -> MaybeT App Value) -> MaybeT App Value
forall a b. MaybeT App a -> (a -> MaybeT App b) -> MaybeT App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Value -> String -> MaybeT App Value)
-> String -> Value -> MaybeT App Value
forall a b c. (a -> b -> c) -> b -> a -> c
flip Value -> String -> MaybeT App Value
forall a.
(HasCallStack, MakesValue a) =>
a -> String -> MaybeT App Value
lookupFieldM String
"webapp_url"

            App Value -> App (Maybe Value)
forall {a}. MakesValue a => a -> App (Maybe Value)
backendUrl Response
resp.json App (Maybe Value) -> App (Maybe Value) -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value -> App (Maybe Value)
forall {a}. MakesValue a => a -> App (Maybe Value)
backendUrl Value
config
            App Value -> App (Maybe Value)
forall {a}. MakesValue a => a -> App (Maybe Value)
webappUrl Response
resp.json App (Maybe Value) -> App (Maybe Value) -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value -> App (Maybe Value)
forall {a}. MakesValue a => a -> App (Maybe Value)
webappUrl Value
config

      App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Domain -> Versioned -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Versioned -> String -> App Response
getDomainRegistrationFromEmail Domain
OwnDomain Versioned
version (String
"paolo@" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
domain)) \Response
resp -> do
        Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
        Bool
isBackend <- Value
config Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"domain_redirect" 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 String -> (String -> Bool) -> App Bool
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"backend")
        if Bool
isBackend
          then do
            Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"domain_redirect" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"no-registration"
            Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"due_to_existing_account" App Value -> Bool -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Bool
True
          else do
            Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"domain_redirect" App Value -> App Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (Value
config Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"domain_redirect")
            App Value -> String -> App (Maybe Value)
forall a.
(HasCallStack, MakesValue a) =>
a -> String -> App (Maybe Value)
lookupField Response
resp.json String
"due_to_existing_account" App (Maybe Value) -> Maybe Bool -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (Maybe Bool
forall a. Maybe a
Nothing :: Maybe Bool)

testDomainVerificationWrongAuth :: (HasCallStack) => App ()
testDomainVerificationWrongAuth :: HasCallStack => App ()
testDomainVerificationWrongAuth = [Versioned] -> (Versioned -> App ()) -> App ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int -> Versioned
ExplicitVersion Int
8, Versioned
Versioned] \Versioned
version -> do
  String
domain <- App String
randomDomain
  String
wrongDomain <- App String
randomDomain
  Domain -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> App Response
domainRegistrationPreAuthorize Domain
OwnDomain String
domain 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
204
  App DomainRegistrationSetup -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App DomainRegistrationSetup -> App ())
-> App DomainRegistrationSetup -> App ()
forall a b. (a -> b) -> a -> b
$ Domain -> String -> App DomainRegistrationSetup
forall domain.
(MakesValue domain, HasCallStack) =>
domain -> String -> App DomainRegistrationSetup
setupOwnershipTokenForBackend Domain
OwnDomain String
domain
  Domain -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> App Response
domainRegistrationPreAuthorize Domain
OwnDomain String
wrongDomain 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
204
  DomainRegistrationSetup
wrongSetup <- Domain -> String -> App DomainRegistrationSetup
forall domain.
(MakesValue domain, HasCallStack) =>
domain -> String -> App DomainRegistrationSetup
setupOwnershipTokenForBackend Domain
OwnDomain String
wrongDomain
  let wrongToken :: String
wrongToken = DomainRegistrationSetup
wrongSetup.ownershipToken

  -- [customer admin] post config with wrong token
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse
    ( Domain
-> Versioned -> String -> Maybe String -> Value -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain
-> Versioned -> String -> Maybe String -> Value -> App Response
updateDomainRedirect
        Domain
OwnDomain
        Versioned
version
        String
domain
        (String -> Maybe String
forall a. a -> Maybe a
Just String
wrongToken)
        (Versioned -> String -> String -> Value
mkDomainRedirectBackend Versioned
version String
"https://wire.example.com" String
"https://webapp.wire.example.com")
    )
    ((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
401
      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
"domain-registration-update-auth-failure"

testDomainVerificationOnPremFlowNoRegistration :: (HasCallStack) => App ()
testDomainVerificationOnPremFlowNoRegistration :: HasCallStack => App ()
testDomainVerificationOnPremFlowNoRegistration = [Versioned] -> (Versioned -> App ()) -> App ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int -> Versioned
ExplicitVersion Int
8, Versioned
Versioned] \Versioned
version -> do
  String
domain <- App String
randomDomain
  Domain -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> App Response
domainRegistrationPreAuthorize Domain
OwnDomain String
domain 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
204
  DomainRegistrationSetup
setup <- Domain -> String -> App DomainRegistrationSetup
forall domain.
(MakesValue domain, HasCallStack) =>
domain -> String -> App DomainRegistrationSetup
setupOwnershipTokenForBackend Domain
OwnDomain String
domain

  -- [customer admin] post no-registration config
  Domain
-> Versioned -> String -> Maybe String -> Value -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain
-> Versioned -> String -> Maybe String -> Value -> App Response
updateDomainRedirect
    Domain
OwnDomain
    Versioned
version
    String
domain
    (String -> Maybe String
forall a. a -> Maybe a
Just DomainRegistrationSetup
setup.ownershipToken)
    ([Pair] -> Value
object [String
"domain_redirect" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"no-registration"])
    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
200

  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Domain -> Versioned -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Versioned -> String -> App Response
getDomainRegistrationFromEmail Domain
OwnDomain Versioned
version (String
"paolo@" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
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_redirect" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"no-registration"

testDomainVerificationRemoveFailure :: (HasCallStack) => App ()
testDomainVerificationRemoveFailure :: HasCallStack => App ()
testDomainVerificationRemoveFailure = [Versioned] -> (Versioned -> App ()) -> App ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int -> Versioned
ExplicitVersion Int
8, Versioned
Versioned] \Versioned
version -> do
  String
domain <- App String
randomDomain
  Domain -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> App Response
domainRegistrationPreAuthorize Domain
OwnDomain String
domain 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
204
  DomainRegistrationSetup
setup <- Domain -> String -> App DomainRegistrationSetup
forall domain.
(MakesValue domain, HasCallStack) =>
domain -> String -> App DomainRegistrationSetup
setupOwnershipTokenForBackend Domain
OwnDomain String
domain

  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Domain -> Versioned -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Versioned -> String -> App Response
getDomainRegistrationFromEmail Domain
OwnDomain Versioned
version (String
"paolo@" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
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_redirect" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"pre-authorized"

  -- [customer admin] try to remove entry
  Domain
-> Versioned -> String -> Maybe String -> Value -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain
-> Versioned -> String -> Maybe String -> Value -> App Response
updateDomainRedirect
    Domain
OwnDomain
    Versioned
version
    String
domain
    (String -> Maybe String
forall a. a -> Maybe a
Just DomainRegistrationSetup
setup.ownershipToken)
    ([Pair] -> Value
object [String
"domain_redirect" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"remove"])
    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

  -- check that it's still set to preauthorized
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Domain -> Versioned -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Versioned -> String -> App Response
getDomainRegistrationFromEmail Domain
OwnDomain Versioned
version (String
"paolo@" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
domain)) \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200

  -- [customer admin] set it to no-registration, then remove
  Domain
-> Versioned -> String -> Maybe String -> Value -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain
-> Versioned -> String -> Maybe String -> Value -> App Response
updateDomainRedirect
    Domain
OwnDomain
    Versioned
version
    String
domain
    (String -> Maybe String
forall a. a -> Maybe a
Just DomainRegistrationSetup
setup.ownershipToken)
    ([Pair] -> Value
object [String
"domain_redirect" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"no-registration"])
    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
200

  Domain
-> Versioned -> String -> Maybe String -> Value -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain
-> Versioned -> String -> Maybe String -> Value -> App Response
updateDomainRedirect
    Domain
OwnDomain
    Versioned
version
    String
domain
    (String -> Maybe String
forall a. a -> Maybe a
Just DomainRegistrationSetup
setup.ownershipToken)
    ([Pair] -> Value
object [String
"domain_redirect" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"remove"])
    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
200

testDomainVerificationLockedState :: (HasCallStack) => App ()
testDomainVerificationLockedState :: HasCallStack => App ()
testDomainVerificationLockedState = [Versioned] -> (Versioned -> App ()) -> App ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int -> Versioned
ExplicitVersion Int
8, Versioned
Versioned] \Versioned
version -> do
  String
domain <- App String
randomDomain
  Domain -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> App Response
domainRegistrationPreAuthorize Domain
OwnDomain String
domain 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
204
  DomainRegistrationSetup
setup <- Domain -> String -> App DomainRegistrationSetup
forall domain.
(MakesValue domain, HasCallStack) =>
domain -> String -> App DomainRegistrationSetup
setupOwnershipTokenForBackend Domain
OwnDomain String
domain
  Domain -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> App Response
domainRegistrationLock Domain
OwnDomain String
domain 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
204

  -- domain redirect cannot be updated
  -- as locking overwrites any previous entry, the auth token will also be removed,
  -- and this will result in an auth failure
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse
    ( Domain
-> Versioned -> String -> Maybe String -> Value -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain
-> Versioned -> String -> Maybe String -> Value -> App Response
updateDomainRedirect
        Domain
OwnDomain
        Versioned
version
        String
domain
        (String -> Maybe String
forall a. a -> Maybe a
Just DomainRegistrationSetup
setup.ownershipToken)
        ([Pair] -> Value
object [String
"domain_redirect" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"no-registration"])
    )
    ((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
401
      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
"domain-registration-update-auth-failure"

testUpdateTeamInvite :: (HasCallStack) => App ()
testUpdateTeamInvite :: HasCallStack => App ()
testUpdateTeamInvite = [Versioned] -> (Versioned -> App ()) -> App ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int -> Versioned
ExplicitVersion Int
8, Versioned
Versioned] \Versioned
version -> do
  (Value
owner, String
tid, Value
mem : [Value]
_) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2
  String
domain <- App String
randomDomain

  -- enable domain registration feature
  HasCallStack => Response -> App ()
Response -> App ()
assertSuccess (Response -> App ()) -> App Response -> App ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< do
    Value -> String -> String -> String -> App ()
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App ()
setTeamFeatureLockStatus Value
owner String
tid String
"domainRegistration" String
"unlocked"
    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
"domainRegistration" String
"enabled"

  DomainRegistrationSetup
setup <- Value -> String -> App DomainRegistrationSetup
forall domain.
(MakesValue domain, HasCallStack) =>
domain -> String -> App DomainRegistrationSetup
setupOwnershipTokenForTeam Value
owner String
domain

  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
"domainRegistration" String
"disabled" 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

  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> String -> String -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> String -> String -> App Response
authorizeTeam Value
owner String
domain DomainRegistrationSetup
setup.ownershipToken) ((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
402
    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
"domain-registration-update-payment-required"

  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
"domainRegistration" String
"enabled" 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

  -- admin should not be able to set team-invite if the team hasn't been authorized
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse
    ( Value -> String -> Value -> App Response
forall user payload.
(HasCallStack, MakesValue user, MakesValue payload) =>
user -> String -> payload -> App Response
updateTeamInvite Value
owner String
domain ([Pair] -> Value
object [String
"team_invite" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"team", String
"team" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= 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
403
      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
"operation-forbidden-for-domain-registration-state"

  Value -> String -> String -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> String -> String -> App Response
authorizeTeam Value
owner String
domain DomainRegistrationSetup
setup.ownershipToken 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
200

  -- non-admin should not be able to set team-invite
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse
    ( Value -> String -> Value -> App Response
forall user payload.
(HasCallStack, MakesValue user, MakesValue payload) =>
user -> String -> payload -> App Response
updateTeamInvite Value
mem String
domain ([Pair] -> Value
object [String
"team_invite" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"team", String
"team" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= 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
403
      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
"operation-forbidden-for-domain-registration-state"

  -- setting team invite to the wrong team should fail
  String
fakeTeamId <- App String
HasCallStack => App String
randomId
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> String -> Value -> App Response
forall user payload.
(HasCallStack, MakesValue user, MakesValue payload) =>
user -> String -> payload -> App Response
updateTeamInvite Value
owner String
domain ([Pair] -> Value
object [String
"team_invite" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"team", String
"team" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
fakeTeamId])) ((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
403
    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
"operation-forbidden-for-domain-registration-state"

  -- [customer admin] set team-invite to team
  Value -> String -> Value -> App Response
forall user payload.
(HasCallStack, MakesValue user, MakesValue payload) =>
user -> String -> payload -> App Response
updateTeamInvite Value
owner String
domain ([Pair] -> Value
object [String
"team_invite" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"team", String
"team" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
tid])
    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
200

  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Domain -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> App Response
getDomainRegistration Domain
OwnDomain 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
domain
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"domain_redirect" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"none"
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"team_invite" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"team"
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"team" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
tid

  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Domain -> Versioned -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Versioned -> String -> App Response
getDomainRegistrationFromEmail Domain
OwnDomain Versioned
version (String
"paolo@" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
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_redirect" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"none"

  -- [customer admin] set team-invite to not-allowed
  Value -> String -> Value -> App Response
forall user payload.
(HasCallStack, MakesValue user, MakesValue payload) =>
user -> String -> payload -> App Response
updateTeamInvite Value
owner String
domain ([Pair] -> Value
object [String
"team_invite" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"not-allowed"])
    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
200

  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Domain -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> App Response
getDomainRegistration Domain
OwnDomain 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
domain
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"domain_redirect" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"none"
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"team_invite" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"not-allowed"

  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Domain -> Versioned -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Versioned -> String -> App Response
getDomainRegistrationFromEmail Domain
OwnDomain Versioned
version (String
"paolo@" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
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_redirect" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"none"

  -- [customer admin] set domain_redirect to no-registration
  Value -> String -> Value -> App Response
forall user payload.
(HasCallStack, MakesValue user, MakesValue payload) =>
user -> String -> payload -> App Response
updateTeamInvite Value
owner String
domain ([Pair] -> Value
object [String
"team_invite" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"not-allowed", String
"domain_redirect" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"no-registration"])
    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
200

  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Domain -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> App Response
getDomainRegistration Domain
OwnDomain 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
domain
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"domain_redirect" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"no-registration"
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"team_invite" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"not-allowed"

  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Domain -> Versioned -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Versioned -> String -> App Response
getDomainRegistrationFromEmail Domain
OwnDomain Versioned
version (String
"paolo@" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
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_redirect" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"no-registration"

  -- [customer admin] set domain_redirect back to none
  Value -> String -> Value -> App Response
forall user payload.
(HasCallStack, MakesValue user, MakesValue payload) =>
user -> String -> payload -> App Response
updateTeamInvite Value
owner String
domain ([Pair] -> Value
object [String
"team_invite" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"not-allowed", String
"domain_redirect" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"none"])
    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
200

  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Domain -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> App Response
getDomainRegistration Domain
OwnDomain 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
domain
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"domain_redirect" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"none"
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"team_invite" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"not-allowed"

  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Domain -> Versioned -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Versioned -> String -> App Response
getDomainRegistrationFromEmail Domain
OwnDomain Versioned
version (String
"paolo@" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
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_redirect" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"none"

testUpdateTeamInviteSSO :: (HasCallStack) => App ()
testUpdateTeamInviteSSO :: HasCallStack => App ()
testUpdateTeamInviteSSO = [Versioned] -> (Versioned -> App ()) -> App ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int -> Versioned
ExplicitVersion Int
8, Versioned
Versioned] \Versioned
version -> do
  String
domain <- App String
randomDomain
  (Value
owner, String
tid, Value
_m : [Value]
_) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2
  HasCallStack => Response -> App ()
Response -> App ()
assertSuccess (Response -> App ()) -> App Response -> App ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< do
    Value -> String -> String -> String -> App ()
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App ()
setTeamFeatureLockStatus Value
owner String
tid String
"domainRegistration" String
"unlocked"
    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
"domainRegistration" String
"enabled"

  DomainRegistrationSetup
setup <- Value -> String -> App DomainRegistrationSetup
forall domain.
(MakesValue domain, HasCallStack) =>
domain -> String -> App DomainRegistrationSetup
setupOwnershipTokenForTeam Value
owner String
domain

  Value -> String -> String -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> String -> String -> App Response
authorizeTeam Value
owner String
domain DomainRegistrationSetup
setup.ownershipToken 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
200

  -- [customer admin] post team-invite config with an invalid idp
  String
fakeIdP <- App String
HasCallStack => App String
randomId
  Value -> String -> Value -> App Response
forall user payload.
(HasCallStack, MakesValue user, MakesValue payload) =>
user -> String -> payload -> App Response
updateTeamInvite Value
owner String
domain ([Pair] -> Value
object [String
"team_invite" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"allowed", String
"sso" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
fakeIdP])
    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

  -- [customer admin] register a new idp and use it to set a team-invite config
  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
idp <- App Response -> (Response -> App Value) -> App Value
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> App Response
forall owner.
(HasCallStack, MakesValue owner) =>
owner -> App Response
registerTestIdPWithMeta Value
owner) ((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
201
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id"
  Value -> String -> Value -> App Response
forall user payload.
(HasCallStack, MakesValue user, MakesValue payload) =>
user -> String -> payload -> App Response
updateTeamInvite Value
owner String
domain ([Pair] -> Value
object [String
"team_invite" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"allowed", String
"sso" String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Value
idp])
    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
200

  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Domain -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> App Response
getDomainRegistration Domain
OwnDomain 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
domain
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"domain_redirect" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"sso"
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"team_invite" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"allowed"
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"sso_code" App Value -> Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value
idp

  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Domain -> Versioned -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Versioned -> String -> App Response
getDomainRegistrationFromEmail Domain
OwnDomain Versioned
version (String
"paolo@" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
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_redirect" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"sso"
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"sso_code" App Value -> Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value
idp

testVerifyChallengeFailsIfLocked :: (HasCallStack) => App ()
testVerifyChallengeFailsIfLocked :: HasCallStack => App ()
testVerifyChallengeFailsIfLocked = do
  (Value
owner, String
tid, Value
_m : [Value]
_) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2
  String
emailDomain <- App String
randomDomain

  -- enable domain registration feature
  HasCallStack => Response -> App ()
Response -> App ()
assertSuccess (Response -> App ()) -> App Response -> App ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< do
    Value -> String -> String -> String -> App ()
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App ()
setTeamFeatureLockStatus Value
owner String
tid String
"domainRegistration" String
"unlocked"
    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
"domainRegistration" String
"enabled"

  ChallengeSetup
challenge <- Value -> String -> App ChallengeSetup
forall domain.
(MakesValue domain, HasCallStack) =>
domain -> String -> App ChallengeSetup
setupChallengeAndDnsRecord Value
owner String
emailDomain
  Domain -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> App Response
domainRegistrationLock Domain
OwnDomain String
emailDomain 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
204
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> String -> String -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> String -> String -> App Response
verifyDomainForTeam Value
owner String
emailDomain ChallengeSetup
challenge.challengeId ChallengeSetup
challenge.challengeToken) ((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
403
    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
"operation-forbidden-for-domain-registration-state"

testUpdateTeamInviteLocked :: (HasCallStack) => App ()
testUpdateTeamInviteLocked :: HasCallStack => App ()
testUpdateTeamInviteLocked = do
  (Value
owner, String
tid, Value
_m : [Value]
_) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2
  String
domain <- App String
randomDomain

  -- enable domain registration feature
  HasCallStack => Response -> App ()
Response -> App ()
assertSuccess (Response -> App ()) -> App Response -> App ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< do
    Value -> String -> String -> String -> App ()
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App ()
setTeamFeatureLockStatus Value
owner String
tid String
"domainRegistration" String
"unlocked"
    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
"domainRegistration" String
"enabled"

  DomainRegistrationSetup
setup <- Value -> String -> App DomainRegistrationSetup
forall domain.
(MakesValue domain, HasCallStack) =>
domain -> String -> App DomainRegistrationSetup
setupOwnershipTokenForTeam Value
owner String
domain

  Value -> String -> String -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> String -> String -> App Response
authorizeTeam Value
owner String
domain DomainRegistrationSetup
setup.ownershipToken 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
200

  -- set domain-redirect to locked
  Domain -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> App Response
domainRegistrationLock Domain
OwnDomain String
domain 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
204

  -- setting team-invite to allowed should fail for on-prem domains
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> String -> Value -> App Response
forall user payload.
(HasCallStack, MakesValue user, MakesValue payload) =>
user -> String -> payload -> App Response
updateTeamInvite Value
owner String
domain ([Pair] -> Value
object [String
"team_invite" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"allowed"])) ((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
403
    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
"operation-forbidden-for-domain-registration-state"

testDisabledEnterpriseService :: (HasCallStack) => App ()
testDisabledEnterpriseService :: HasCallStack => App ()
testDisabledEnterpriseService = do
  String
domain <- App String
randomDomain

  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Domain -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> App Response
getDomainVerificationChallenge Domain
OtherDomain 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
503
    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
"enterprise-service-not-enabled"

testOverwriteOwnershipToken :: (HasCallStack) => App ()
testOverwriteOwnershipToken :: HasCallStack => App ()
testOverwriteOwnershipToken = [Versioned] -> (Versioned -> App ()) -> App ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int -> Versioned
ExplicitVersion Int
8, Versioned
Versioned] \Versioned
version -> do
  String
domain <- App String
randomDomain
  Domain -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> App Response
domainRegistrationPreAuthorize Domain
OwnDomain String
domain 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
204

  -- get an ownership token
  DomainRegistrationSetup
setup1 <- Domain -> String -> App DomainRegistrationSetup
forall domain.
(MakesValue domain, HasCallStack) =>
domain -> String -> App DomainRegistrationSetup
setupOwnershipTokenForBackend Domain
OwnDomain String
domain
  Domain
-> Versioned -> String -> Maybe String -> Value -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain
-> Versioned -> String -> Maybe String -> Value -> App Response
updateDomainRedirect
    Domain
OwnDomain
    Versioned
version
    String
domain
    (String -> Maybe String
forall a. a -> Maybe a
Just DomainRegistrationSetup
setup1.ownershipToken)
    (Versioned -> String -> String -> Value
mkDomainRedirectBackend Versioned
version String
"https://wire1.example.com" String
"https://webapp.wire1.example.com")
    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
200

  -- get a second ownership token
  DomainRegistrationSetup
setup2 <- Domain -> String -> App DomainRegistrationSetup
forall domain.
(MakesValue domain, HasCallStack) =>
domain -> String -> App DomainRegistrationSetup
setupOwnershipTokenForBackend Domain
OwnDomain String
domain
  Domain
-> Versioned -> String -> Maybe String -> Value -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain
-> Versioned -> String -> Maybe String -> Value -> App Response
updateDomainRedirect
    Domain
OwnDomain
    Versioned
version
    String
domain
    (String -> Maybe String
forall a. a -> Maybe a
Just DomainRegistrationSetup
setup2.ownershipToken)
    ([Pair] -> Value
object [String
"domain_redirect" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"remove"])
    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
200

  -- the first ownership token is not valid anymore
  Domain
-> Versioned -> String -> Maybe String -> Value -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain
-> Versioned -> String -> Maybe String -> Value -> App Response
updateDomainRedirect
    Domain
OwnDomain
    Versioned
version
    String
domain
    (String -> Maybe String
forall a. a -> Maybe a
Just DomainRegistrationSetup
setup1.ownershipToken)
    (Versioned -> String -> String -> Value
mkDomainRedirectBackend Versioned
version String
"https://wire1.example.com" String
"https://webapp.wire1.example.com")
    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
401

testChallengeTtl :: (HasCallStack) => App ()
testChallengeTtl :: HasCallStack => App ()
testChallengeTtl = 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.setChallengeTTL" (2 :: Int))})
  ((HasCallStack => String -> App ()) -> App ())
-> (HasCallStack => String -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \String
domain -> do
    String
emailDomain <- App String
randomDomain
    String -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> App Response
domainRegistrationPreAuthorize String
domain String
emailDomain 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
204

    Value
challenge <- String -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> App Response
getDomainVerificationChallenge String
domain String
emailDomain 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
    String
challengeId <- Value
challenge Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"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
    String
challengeToken <- Value
challenge Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"token" 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

    -- wait until the challenge ttl expires
    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
$ Int -> IO ()
threadDelay Int
2_500_000
    App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (String -> String -> String -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> String -> String -> App Response
verifyDomain String
domain String
emailDomain String
challengeId String
challengeToken) ((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

testGetAndDeleteRegisteredDomains :: (HasCallStack) => App ()
testGetAndDeleteRegisteredDomains :: HasCallStack => App ()
testGetAndDeleteRegisteredDomains = do
  (Value
owner, String
tid, Value
mem : [Value]
_) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2

  -- enable domain registration feature
  HasCallStack => Response -> App ()
Response -> App ()
assertSuccess (Response -> App ()) -> App Response -> App ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< do
    Value -> String -> String -> String -> App ()
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App ()
setTeamFeatureLockStatus Value
owner String
tid String
"domainRegistration" String
"unlocked"
    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
"domainRegistration" String
"enabled"

  [String]
expectedDomains <- Int -> App String -> App [String]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
5 do
    String
domain <- App String
randomDomain
    DomainRegistrationSetup
setup <- Value -> String -> App DomainRegistrationSetup
forall domain.
(MakesValue domain, HasCallStack) =>
domain -> String -> App DomainRegistrationSetup
setupOwnershipTokenForTeam Value
owner String
domain
    Value -> String -> String -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> String -> String -> App Response
authorizeTeam Value
owner String
domain DomainRegistrationSetup
setup.ownershipToken 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
200
    String -> App String
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
domain

  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> App Response
getRegisteredDomainsByTeam Value
owner 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
200
    [String]
actualDomains <- Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"registered_domains" App Value -> (App Value -> App [Value]) -> App [Value]
forall a b. a -> (a -> b) -> b
& App Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList App [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) -> [Value] -> App [String]
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 (App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString (App Value -> App String)
-> (Value -> App Value) -> Value -> App String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"domain"))
    [String]
actualDomains [String] -> [String] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatchSet` [String]
expectedDomains

  Value -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> App Response
getRegisteredDomainsByTeam Value
mem String
tid 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
  (Value
otherTeamOwner, String
_, [Value]
_) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2
  Value -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> App Response
getRegisteredDomainsByTeam Value
otherTeamOwner String
tid 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

  String
nonExistingDomain <- App String
randomDomain
  Value -> String -> String -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> String -> String -> App Response
deleteRegisteredTeamDomain Value
owner String
tid String
nonExistingDomain 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
404
  let firstDomain :: String
firstDomain = [String] -> String
forall a. HasCallStack => [a] -> a
head [String]
expectedDomains
  Value -> String -> String -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> String -> String -> App Response
deleteRegisteredTeamDomain Value
mem String
tid String
firstDomain 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
  Value -> String -> String -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> String -> String -> App Response
deleteRegisteredTeamDomain Value
otherTeamOwner String
tid String
firstDomain 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

  let checkDelete :: [String] -> App ()
      checkDelete :: [String] -> App ()
checkDelete [] =
        App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> App Response
getRegisteredDomainsByTeam Value
owner 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
200
          [Value]
actualDomains <- Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"registered_domains" 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
          [Value] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Value]
actualDomains Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
0
      checkDelete (String
domainToDelete : [String]
remainingDomains) = do
        App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> String -> String -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> String -> String -> App Response
deleteRegisteredTeamDomain Value
owner String
tid String
domainToDelete) ((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
204
        App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> App Response
getRegisteredDomainsByTeam Value
owner 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
200
          [String]
actualDomains <- Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"registered_domains" App Value -> (App Value -> App [Value]) -> App [Value]
forall a b. a -> (a -> b) -> b
& App Value -> App [Value]
forall a. (HasCallStack, MakesValue a) => a -> App [Value]
asList App [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) -> [Value] -> App [String]
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 (App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString (App Value -> App String)
-> (Value -> App Value) -> Value -> App String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"domain"))
          [String]
actualDomains [String] -> [String] -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatchSet` [String]
remainingDomains
        [String] -> App ()
checkDelete [String]
remainingDomains

  [String] -> App ()
checkDelete [String]
expectedDomains

testGetDomainRegistrationUserExistsBackend :: (HasCallStack) => App ()
testGetDomainRegistrationUserExistsBackend :: HasCallStack => App ()
testGetDomainRegistrationUserExistsBackend = [Versioned] -> (Versioned -> App ()) -> App ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int -> Versioned
ExplicitVersion Int
8, Versioned
Versioned] \Versioned
version -> do
  String
domain <- App String
randomDomain
  Domain -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> App Response
domainRegistrationPreAuthorize Domain
OwnDomain String
domain 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
204

  -- create a user with email on this domain
  App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def {email = Just ("paolo@" <> domain)}

  DomainRegistrationSetup
setup <- Domain -> String -> App DomainRegistrationSetup
forall domain.
(MakesValue domain, HasCallStack) =>
domain -> String -> App DomainRegistrationSetup
setupOwnershipTokenForBackend Domain
OwnDomain String
domain
  Domain
-> Versioned -> String -> Maybe String -> Value -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain
-> Versioned -> String -> Maybe String -> Value -> App Response
updateDomainRedirect
    Domain
OwnDomain
    Versioned
version
    String
domain
    (String -> Maybe String
forall a. a -> Maybe a
Just DomainRegistrationSetup
setup.ownershipToken)
    (Versioned -> String -> String -> Value
mkDomainRedirectBackend Versioned
version String
"https://wire.example.com" String
"https://webapp.wire.example.com")
    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
200

  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Domain -> Versioned -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Versioned -> String -> App Response
getDomainRegistrationFromEmail Domain
OwnDomain Versioned
version (String
"sven@" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> 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_redirect" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"backend"
    if Versioned
version Versioned -> Versioned -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Versioned
ExplicitVersion Int
8
      then Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"backend_url" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"https://wire.example.com"
      else do
        Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"backend.config_url" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"https://wire.example.com"
        Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"backend.webapp_url" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"https://webapp.wire.example.com"
    App Value -> String -> App (Maybe Value)
forall a.
(HasCallStack, MakesValue a) =>
a -> String -> App (Maybe Value)
lookupField Response
resp.json String
"due_to_existing_account" App (Maybe Value) -> Maybe Bool -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (Maybe Bool
forall a. Maybe a
Nothing :: Maybe Bool)

  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Domain -> Versioned -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Versioned -> String -> App Response
getDomainRegistrationFromEmail Domain
OwnDomain Versioned
version (String
"paolo@" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> 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_redirect" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"no-registration"
    -- Neither old (<= V9) nor new backend URL fields should be received
    App Value -> String -> App (Maybe Value)
forall a.
(HasCallStack, MakesValue a) =>
a -> String -> App (Maybe Value)
lookupField Response
resp.json String
"backend_url" App (Maybe Value) -> Maybe String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (Maybe String
forall a. Maybe a
Nothing :: Maybe String)
    App Value -> String -> App (Maybe Value)
forall a.
(HasCallStack, MakesValue a) =>
a -> String -> App (Maybe Value)
lookupField Response
resp.json String
"backend" App (Maybe Value) -> Maybe String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (Maybe String
forall a. Maybe a
Nothing :: Maybe String)
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"due_to_existing_account" App Value -> Bool -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Bool
True

testGetDomainRegistrationUserExistsSso :: (HasCallStack) => App ()
testGetDomainRegistrationUserExistsSso :: HasCallStack => App ()
testGetDomainRegistrationUserExistsSso = [Versioned] -> (Versioned -> App ()) -> App ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int -> Versioned
ExplicitVersion Int
8, Versioned
Versioned] \Versioned
version -> do
  String
emailDomain <- App String
randomDomain
  (Value
owner, String
tid, Value
mem : [Value]
_) <- Domain -> String -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> Int -> App (Value, String, [Value])
createTeamWithEmailDomain Domain
OwnDomain String
emailDomain Int
2
  String
memMail <- Value
mem Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"email" 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 paoloMail :: String
paoloMail = String
"paolo@" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
emailDomain
  App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def {email = Just paoloMail}
  let svenMail :: String
svenMail = String
"sven@" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
emailDomain
  App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def {email = Just svenMail, team = True}
  let newUserMail :: String
newUserMail = String
"newUser@" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
emailDomain

  -- enable domain registration feature
  HasCallStack => Response -> App ()
Response -> App ()
assertSuccess (Response -> App ()) -> App Response -> App ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< do
    Value -> String -> String -> String -> App ()
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App ()
setTeamFeatureLockStatus Value
owner String
tid String
"domainRegistration" String
"unlocked"
    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
"domainRegistration" String
"enabled"

  DomainRegistrationSetup
setup <- Value -> String -> App DomainRegistrationSetup
forall domain.
(MakesValue domain, HasCallStack) =>
domain -> String -> App DomainRegistrationSetup
setupOwnershipTokenForTeam Value
owner String
emailDomain
  Value -> String -> String -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> String -> String -> App Response
authorizeTeam Value
owner String
emailDomain DomainRegistrationSetup
setup.ownershipToken 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
200

  -- [customer admin] register a new idp and use it to set a team-invite config
  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"
  (Response
idp, (IdPMetadata, SignPrivCreds)
idpMeta) <- Value -> App (Response, (IdPMetadata, SignPrivCreds))
forall owner.
(HasCallStack, MakesValue owner) =>
owner -> App (Response, (IdPMetadata, SignPrivCreds))
registerTestIdPWithMetaWithPrivateCreds Value
owner
  String
idpId <- App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString (App Value -> App String) -> App Value -> App String
forall a b. (a -> b) -> a -> b
$ Response
idp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id"
  Value -> String -> Value -> App Response
forall user payload.
(HasCallStack, MakesValue user, MakesValue payload) =>
user -> String -> payload -> App Response
updateTeamInvite Value
owner String
emailDomain ([Pair] -> Value
object [String
"team_invite" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"allowed", String
"sso" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
idpId])
    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
200

  -- newUserMail is not registered yet
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Domain -> Versioned -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Versioned -> String -> App Response
getDomainRegistrationFromEmail Domain
OwnDomain Versioned
version String
newUserMail) \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_redirect" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"sso"
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"sso_code" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
idpId

  App (Maybe String, SignedAuthnResponse) -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App (Maybe String, SignedAuthnResponse) -> App ())
-> App (Maybe String, SignedAuthnResponse) -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack =>
Bool
-> String
-> String
-> (String, (IdPMetadata, SignPrivCreds))
-> App (Maybe String, SignedAuthnResponse)
Bool
-> String
-> String
-> (String, (IdPMetadata, SignPrivCreds))
-> App (Maybe String, SignedAuthnResponse)
loginWithSamlEmail Bool
True String
tid String
newUserMail (String
idpId, (IdPMetadata, SignPrivCreds)
idpMeta)

  -- now the account exists, and but as this is an SSO user they should be directed to the SSO flow
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Domain -> Versioned -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Versioned -> String -> App Response
getDomainRegistrationFromEmail Domain
OwnDomain Versioned
version String
newUserMail) \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_redirect" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"sso"
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"sso_code" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
idpId

  -- these have normal password accounts, and some are not members of the team
  [String] -> (String -> App ()) -> App ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [String
memMail, String
paoloMail, String
svenMail] \String
email -> do
    App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Domain -> Versioned -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Versioned -> String -> App Response
getDomainRegistrationFromEmail Domain
OwnDomain Versioned
version String
email) \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_redirect" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"no-registration"
      App Value -> String -> App (Maybe Value)
forall a.
(HasCallStack, MakesValue a) =>
a -> String -> App (Maybe Value)
lookupField Response
resp.json String
"sso_code" App (Maybe Value) -> Maybe String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (Maybe String
forall a. Maybe a
Nothing :: Maybe String)
      App Value -> String -> App (Maybe Value)
forall a.
(HasCallStack, MakesValue a) =>
a -> String -> App (Maybe Value)
lookupField Response
resp.json String
"due_to_existing_account" App (Maybe Value) -> Maybe Bool -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (Maybe Bool
forall a. Maybe a
Nothing :: Maybe Bool)

testSsoLoginNoEmailVerification :: (HasCallStack) => App ()
testSsoLoginNoEmailVerification :: HasCallStack => App ()
testSsoLoginNoEmailVerification = do
  (Value
owner, 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
  String
emailDomain <- App String
randomDomain

  HasCallStack => Response -> App ()
Response -> App ()
assertSuccess (Response -> App ()) -> App Response -> App ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< do
    Value -> String -> String -> String -> App ()
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App ()
setTeamFeatureLockStatus Value
owner String
tid String
"domainRegistration" String
"unlocked"
    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
"domainRegistration" String
"enabled"

  DomainRegistrationSetup
setup <- Value -> String -> App DomainRegistrationSetup
forall domain.
(MakesValue domain, HasCallStack) =>
domain -> String -> App DomainRegistrationSetup
setupOwnershipTokenForTeam Value
owner String
emailDomain
  Value -> String -> String -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> String -> String -> App Response
authorizeTeam Value
owner String
emailDomain DomainRegistrationSetup
setup.ownershipToken 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

  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"
  (Response
idp, (IdPMetadata, SignPrivCreds)
idpMeta) <- Value -> App (Response, (IdPMetadata, SignPrivCreds))
forall owner.
(HasCallStack, MakesValue owner) =>
owner -> App (Response, (IdPMetadata, SignPrivCreds))
registerTestIdPWithMetaWithPrivateCreds Value
owner
  String
idpId <- App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString (App Value -> App String) -> App Value -> App String
forall a b. (a -> b) -> a -> b
$ Response
idp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id"

  Value -> String -> Value -> App Response
forall user payload.
(HasCallStack, MakesValue user, MakesValue payload) =>
user -> String -> payload -> App Response
updateTeamInvite Value
owner String
emailDomain ([Pair] -> Value
object [String
"team_invite" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"not-allowed", String
"sso" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
idpId]) 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

  let email :: String
email = String
"user@" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
emailDomain
  (Just String
uid, SignedAuthnResponse
_) <- HasCallStack =>
Bool
-> String
-> String
-> (String, (IdPMetadata, SignPrivCreds))
-> App (Maybe String, SignedAuthnResponse)
Bool
-> String
-> String
-> (String, (IdPMetadata, SignPrivCreds))
-> App (Maybe String, SignedAuthnResponse)
loginWithSamlEmail Bool
True String
tid String
email (String
idpId, (IdPMetadata, SignPrivCreds)
idpMeta)
  Domain -> [String] -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> [String] -> App Response
getUsersId Domain
OwnDomain [String
uid] App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
res -> do
    Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    Value
user <- Response
res.json 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 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 (t :: * -> *) a. (HasCallStack, Foldable t) => t a -> App a
assertOne
    Value
user 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
"active"
    Value
user Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"email" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
email

  Domain -> [String] -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> [String] -> App Response
getUsersByEmail Domain
OwnDomain [String
email] App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
res -> do
    Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    Value
user <- Response
res.json 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 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 (t :: * -> *) a. (HasCallStack, Foldable t) => t a -> App a
assertOne
    Value
user 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
"active"
    Value
user Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"email" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
email

  String
otherEmailDomain <- App String
randomDomain
  let otherEmail :: String
otherEmail = String
"otherUser@" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
otherEmailDomain
  (Just String
otherUid, SignedAuthnResponse
_) <- HasCallStack =>
Bool
-> String
-> String
-> (String, (IdPMetadata, SignPrivCreds))
-> App (Maybe String, SignedAuthnResponse)
Bool
-> String
-> String
-> (String, (IdPMetadata, SignPrivCreds))
-> App (Maybe String, SignedAuthnResponse)
loginWithSamlEmail Bool
True String
tid String
otherEmail (String
idpId, (IdPMetadata, SignPrivCreds)
idpMeta)

  Domain -> [String] -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> [String] -> App Response
getUsersId Domain
OwnDomain [String
otherUid] App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
res -> do
    Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    Value
user <- Response
res.json 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 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 (t :: * -> *) a. (HasCallStack, Foldable t) => t a -> App a
assertOne
    Value
user 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
"active"
    Value -> String -> App (Maybe Value)
forall a.
(HasCallStack, MakesValue a) =>
a -> String -> App (Maybe Value)
lookupField Value
user String
"email" App (Maybe Value) -> Maybe String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (Maybe String
forall a. Maybe a
Nothing :: Maybe String)

  Domain -> [String] -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> [String] -> App Response
getUsersByEmail Domain
OwnDomain [String
otherEmail] App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \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 -> (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 App [Value] -> ([Value] -> 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
>>= [Value] -> App ()
forall a. (MakesValue a, HasCallStack) => a -> App ()
shouldBeEmpty

  Domain -> String -> App ()
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> App ()
activateEmail Domain
OwnDomain String
otherEmail
  Domain -> [String] -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> [String] -> App Response
getUsersId Domain
OwnDomain [String
otherUid] App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
res -> do
    Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    Value
user <- Response
res.json 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 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 (t :: * -> *) a. (HasCallStack, Foldable t) => t a -> App a
assertOne
    Value
user 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
"active"
    Value
user Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"email" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
otherEmail

testScimOnlyWithRegisteredEmailDomain :: (HasCallStack) => App ()
testScimOnlyWithRegisteredEmailDomain :: HasCallStack => App ()
testScimOnlyWithRegisteredEmailDomain = do
  (Value
owner, 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
  String
emailDomain <- App String
randomDomain

  HasCallStack => Response -> App ()
Response -> App ()
assertSuccess (Response -> App ()) -> App Response -> App ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< do
    Value -> String -> String -> String -> App ()
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App ()
setTeamFeatureLockStatus Value
owner String
tid String
"domainRegistration" String
"unlocked"
    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
"domainRegistration" String
"enabled"

  DomainRegistrationSetup
setup <- Value -> String -> App DomainRegistrationSetup
forall domain.
(MakesValue domain, HasCallStack) =>
domain -> String -> App DomainRegistrationSetup
setupOwnershipTokenForTeam Value
owner String
emailDomain
  Value -> String -> String -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> String -> String -> App Response
authorizeTeam Value
owner String
emailDomain DomainRegistrationSetup
setup.ownershipToken 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

  Value -> String -> Value -> App Response
forall user payload.
(HasCallStack, MakesValue user, MakesValue payload) =>
user -> String -> payload -> App Response
updateTeamInvite Value
owner String
emailDomain ([Pair] -> Value
object [String
"team_invite" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"team", String
"team" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
tid]) 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 -> CreateScimToken -> App Response
forall caller.
(HasCallStack, MakesValue caller) =>
caller -> CreateScimToken -> App Response
createScimToken Value
owner CreateScimToken
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
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
  let email :: String
email = String
"user@" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
emailDomain
      extId :: String
extId = String
email
  Value
scimUser <- String -> String -> App Value
randomScimUserWithEmail String
extId String
email
  String
uid <- App Response -> (Response -> App String) -> App String
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> String -> Value -> App Response
forall user payload.
(HasCallStack, MakesValue user, MakesValue payload) =>
user -> String -> payload -> App Response
createScimUser Value
owner String
tok Value
scimUser) ((Response -> App String) -> App String)
-> (Response -> App String) -> App String
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
201
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id" App Value -> (Value -> App String) -> App String
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString
  Domain -> String -> String -> App ()
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> String -> App ()
registerInvitedUser Domain
OwnDomain String
tid String
email
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Domain -> String -> String -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> String -> String -> App Response
login Domain
OwnDomain String
email String
defPassword) ((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
  Domain -> [String] -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> [String] -> App Response
getUsersId Domain
OwnDomain [String
uid] App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
res -> do
    Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    Value
user <- Response
res.json 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 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 (t :: * -> *) a. (HasCallStack, Foldable t) => t a -> App a
assertOne
    Value
user 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
"active"
    Value
user Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"email" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
email
  Domain -> [String] -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> [String] -> App Response
getUsersByEmail Domain
OwnDomain [String
email] App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
res -> do
    Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    Value
user <- Response
res.json 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 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 (t :: * -> *) a. (HasCallStack, Foldable t) => t a -> App a
assertOne
    Value
user 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
"active"
    Value
user Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"email" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
email

testScimAndSamlWithRegisteredEmailDomain :: (HasCallStack) => App ()
testScimAndSamlWithRegisteredEmailDomain :: HasCallStack => App ()
testScimAndSamlWithRegisteredEmailDomain = do
  (Value
owner, 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
  String
emailDomain <- App String
randomDomain

  HasCallStack => Response -> App ()
Response -> App ()
assertSuccess (Response -> App ()) -> App Response -> App ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< do
    Value -> String -> String -> String -> App ()
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App ()
setTeamFeatureLockStatus Value
owner String
tid String
"domainRegistration" String
"unlocked"
    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
"domainRegistration" String
"enabled"

  DomainRegistrationSetup
setup <- Value -> String -> App DomainRegistrationSetup
forall domain.
(MakesValue domain, HasCallStack) =>
domain -> String -> App DomainRegistrationSetup
setupOwnershipTokenForTeam Value
owner String
emailDomain
  Value -> String -> String -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> String -> String -> App Response
authorizeTeam Value
owner String
emailDomain DomainRegistrationSetup
setup.ownershipToken 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

  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"
  (Response
idp, (IdPMetadata, SignPrivCreds)
idpMeta) <- Value -> App (Response, (IdPMetadata, SignPrivCreds))
forall owner.
(HasCallStack, MakesValue owner) =>
owner -> App (Response, (IdPMetadata, SignPrivCreds))
registerTestIdPWithMetaWithPrivateCreds Value
owner
  String
idpId <- App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString (App Value -> App String) -> App Value -> App String
forall a b. (a -> b) -> a -> b
$ Response
idp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id"

  Value -> String -> Value -> App Response
forall user payload.
(HasCallStack, MakesValue user, MakesValue payload) =>
user -> String -> payload -> App Response
updateTeamInvite Value
owner String
emailDomain ([Pair] -> Value
object [String
"team_invite" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"not-allowed", String
"sso" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
idpId]) 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 -> CreateScimToken -> App Response
forall caller.
(HasCallStack, MakesValue caller) =>
caller -> CreateScimToken -> App Response
createScimToken Value
owner CreateScimToken
forall a. Default a => a
def {idp = Just idpId}
      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
  let email :: String
email = String
"user@" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
emailDomain
      extId :: String
extId = String
email
  Value
scimUser <- String -> String -> App Value
randomScimUserWithEmail String
extId String
email
  String
uid <- App Response -> (Response -> App String) -> App String
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> String -> Value -> App Response
forall user payload.
(HasCallStack, MakesValue user, MakesValue payload) =>
user -> String -> payload -> App Response
createScimUser Value
owner String
tok Value
scimUser) ((Response -> App String) -> App String)
-> (Response -> App String) -> App String
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
201
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id" App Value -> (Value -> App String) -> App String
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString
  App (Maybe String, SignedAuthnResponse) -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App (Maybe String, SignedAuthnResponse) -> App ())
-> App (Maybe String, SignedAuthnResponse) -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack =>
Bool
-> String
-> String
-> (String, (IdPMetadata, SignPrivCreds))
-> App (Maybe String, SignedAuthnResponse)
Bool
-> String
-> String
-> (String, (IdPMetadata, SignPrivCreds))
-> App (Maybe String, SignedAuthnResponse)
loginWithSamlEmail Bool
True String
tid String
email (String
idpId, (IdPMetadata, SignPrivCreds)
idpMeta)

  Domain -> [String] -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> [String] -> App Response
getUsersId Domain
OwnDomain [String
uid] App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
res -> do
    Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    Value
user <- Response
res.json 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 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 (t :: * -> *) a. (HasCallStack, Foldable t) => t a -> App a
assertOne
    Value
user 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
"active"
    Value
user Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"email" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
email

  Domain -> [String] -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> [String] -> App Response
getUsersByEmail Domain
OwnDomain [String
email] App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
res -> do
    Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    Value
user <- Response
res.json 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 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 (t :: * -> *) a. (HasCallStack, Foldable t) => t a -> App a
assertOne
    Value
user 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
"active"
    Value
user Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"email" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
email

testVerificationRequiredIfEmailDomainRedirectNotSso :: (HasCallStack) => App ()
testVerificationRequiredIfEmailDomainRedirectNotSso :: HasCallStack => App ()
testVerificationRequiredIfEmailDomainRedirectNotSso = do
  (Value
owner, 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
  String
emailDomain <- App String
randomDomain

  HasCallStack => Response -> App ()
Response -> App ()
assertSuccess (Response -> App ()) -> App Response -> App ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< do
    Value -> String -> String -> String -> App ()
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App ()
setTeamFeatureLockStatus Value
owner String
tid String
"domainRegistration" String
"unlocked"
    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
"domainRegistration" String
"enabled"

  DomainRegistrationSetup
setup <- Value -> String -> App DomainRegistrationSetup
forall domain.
(MakesValue domain, HasCallStack) =>
domain -> String -> App DomainRegistrationSetup
setupOwnershipTokenForTeam Value
owner String
emailDomain
  Value -> String -> String -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> String -> String -> App Response
authorizeTeam Value
owner String
emailDomain DomainRegistrationSetup
setup.ownershipToken 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

  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"
  (Response
idp, (IdPMetadata, SignPrivCreds)
idpMeta) <- Value -> App (Response, (IdPMetadata, SignPrivCreds))
forall owner.
(HasCallStack, MakesValue owner) =>
owner -> App (Response, (IdPMetadata, SignPrivCreds))
registerTestIdPWithMetaWithPrivateCreds Value
owner
  String
idpId <- App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString (App Value -> App String) -> App Value -> App String
forall a b. (a -> b) -> a -> b
$ Response
idp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id"

  Value -> String -> Value -> App Response
forall user payload.
(HasCallStack, MakesValue user, MakesValue payload) =>
user -> String -> payload -> App Response
updateTeamInvite Value
owner String
emailDomain ([Pair] -> Value
object [String
"team_invite" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"team", String
"team" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
tid]) 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

  let email :: String
email = String
"user@" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
emailDomain
  (Just String
uid, SignedAuthnResponse
_) <- HasCallStack =>
Bool
-> String
-> String
-> (String, (IdPMetadata, SignPrivCreds))
-> App (Maybe String, SignedAuthnResponse)
Bool
-> String
-> String
-> (String, (IdPMetadata, SignPrivCreds))
-> App (Maybe String, SignedAuthnResponse)
loginWithSamlEmail Bool
True String
tid String
email (String
idpId, (IdPMetadata, SignPrivCreds)
idpMeta)

  Domain -> [String] -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> [String] -> App Response
getUsersId Domain
OwnDomain [String
uid] App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
res -> do
    Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    Value
user <- Response
res.json 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 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 (t :: * -> *) a. (HasCallStack, Foldable t) => t a -> App a
assertOne
    Value
user 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
"active"
    Value -> String -> App (Maybe Value)
forall a.
(HasCallStack, MakesValue a) =>
a -> String -> App (Maybe Value)
lookupField Value
user String
"email" App (Maybe Value) -> Maybe String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` (Maybe String
forall a. Maybe a
Nothing :: Maybe String)

  Domain -> [String] -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> [String] -> App Response
getUsersByEmail Domain
OwnDomain [String
email] App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \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 -> (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 App [Value] -> ([Value] -> 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
>>= [Value] -> App ()
forall a. (MakesValue a, HasCallStack) => a -> App ()
shouldBeEmpty

  Domain -> String -> App ()
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> App ()
activateEmail Domain
OwnDomain String
email
  Domain -> [String] -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> [String] -> App Response
getUsersId Domain
OwnDomain [String
uid] App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
res -> do
    Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    Value
user <- Response
res.json 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 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 (t :: * -> *) a. (HasCallStack, Foldable t) => t a -> App a
assertOne
    Value
user 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
"active"
    Value
user Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"email" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
email

testDomainVerificationUpdateRedirectRequiresWebappUrl :: (HasCallStack) => App ()
testDomainVerificationUpdateRedirectRequiresWebappUrl :: HasCallStack => App ()
testDomainVerificationUpdateRedirectRequiresWebappUrl = do
  String
domain <- App String
randomDomain
  App Value -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Value -> App ()) -> App Value -> App ()
forall a b. (a -> b) -> a -> b
$ Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def {email = Just ("paolo@" <> domain)}

  Domain -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> App Response
domainRegistrationPreAuthorize Domain
OwnDomain String
domain 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
204

  DomainRegistrationSetup
setup <- Domain -> String -> App DomainRegistrationSetup
forall domain.
(MakesValue domain, HasCallStack) =>
domain -> String -> App DomainRegistrationSetup
setupOwnershipTokenForBackend Domain
OwnDomain String
domain
  let ownershipToken :: String
ownershipToken = DomainRegistrationSetup
setup.ownershipToken

  -- check that it works in general
  Domain
-> Versioned -> String -> Maybe String -> Value -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain
-> Versioned -> String -> Maybe String -> Value -> App Response
updateDomainRedirect
    Domain
OwnDomain
    Versioned
Versioned
    String
domain
    (String -> Maybe String
forall a. a -> Maybe a
Just String
ownershipToken)
    ( [Pair] -> Value
object
        [ String
"domain_redirect" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"backend",
          String
"backend"
            String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [Pair] -> Value
object
              [ String
"config_url" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"https://wire.example.com",
                String
"webapp_url" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"https://webapp.wire.example.com"
              ]
        ]
    )
    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
200

  -- see it fail when the webapp URL is missing
  Domain
-> Versioned -> String -> Maybe String -> Value -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain
-> Versioned -> String -> Maybe String -> Value -> App Response
updateDomainRedirect
    Domain
OwnDomain
    Versioned
Versioned
    String
domain
    (String -> Maybe String
forall a. a -> Maybe a
Just String
ownershipToken)
    ( [Pair] -> Value
object
        [ String
"domain_redirect" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"backend",
          String
"backend" String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [Pair] -> Value
object [String
"config" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"https://wire.example.com"]
        ]
    )
    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
400