{-# 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 Control.Concurrent (threadDelay)
import SetupHelpers
import Test.DNSMock
import Testlib.Prelude

mkDomainRedirectBackend :: String -> Value
mkDomainRedirectBackend :: String -> Value
mkDomainRedirectBackend String
url = [Pair] -> Value
object [String
"domain_redirect" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"backend", String
"backend_url" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
url]

testDomainVerificationGetOwnershipToken :: (HasCallStack) => App ()
testDomainVerificationGetOwnershipToken :: HasCallStack => App ()
testDomainVerificationGetOwnershipToken = do
  String
domain <- App String
randomDomain
  ChallengeSetup
challenge <- HasCallStack => String -> App ChallengeSetup
String -> App ChallengeSetup
setupChallenge 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

testDomainVerificationOnPremFlow :: (HasCallStack) => App ()
testDomainVerificationOnPremFlow :: HasCallStack => App ()
testDomainVerificationOnPremFlow = do
  String
domain <- App String
randomDomain
  DomainRegistrationSetup
setup <- HasCallStack => String -> App DomainRegistrationSetup
String -> App DomainRegistrationSetup
setupOwnershipToken String
domain
  let ownershipToken :: String
ownershipToken = DomainRegistrationSetup
setup.ownershipToken

  -- cannot set config for non-preauthorized domain
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse
    ( Domain -> String -> Maybe String -> Value -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> Maybe String -> Value -> App Response
updateDomainRedirect
        Domain
OwnDomain
        String
domain
        (String -> Maybe String
forall a. a -> Maybe a
Just String
ownershipToken)
        (String -> Value
mkDomainRedirectBackend String
"https://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
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"

  -- preauth
  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

  -- post config without ownership token (this is not allowed)
  Domain -> String -> Maybe String -> Value -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> Maybe String -> Value -> App Response
updateDomainRedirect
    Domain
OwnDomain
    String
domain
    Maybe String
forall a. Maybe a
Nothing
    (String -> Value
mkDomainRedirectBackend 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

  -- [customer admin] post config (happy flow)
  Domain -> String -> Maybe String -> Value -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> Maybe String -> Value -> App Response
updateDomainRedirect
    Domain
OwnDomain
    String
domain
    (String -> Maybe String
forall a. a -> Maybe a
Just String
ownershipToken)
    (String -> Value
mkDomainRedirectBackend 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
200

  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)}

  -- [customer user] pull the redirect config based on email
  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
getDomainRegistrationFromEmail Domain
OwnDomain (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 -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"backend"
    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"

  -- [customer user] using a registered emails should return `none`
  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
getDomainRegistrationFromEmail Domain
OwnDomain (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"

testDomainVerificationWrongAuth :: (HasCallStack) => App ()
testDomainVerificationWrongAuth :: HasCallStack => App ()
testDomainVerificationWrongAuth = do
  String
domain <- App String
randomDomain
  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
$ HasCallStack => String -> App DomainRegistrationSetup
String -> App DomainRegistrationSetup
setupOwnershipToken String
domain
  DomainRegistrationSetup
wrongSetup <- HasCallStack => String -> App DomainRegistrationSetup
String -> App DomainRegistrationSetup
setupOwnershipToken (String -> App DomainRegistrationSetup)
-> App String -> App DomainRegistrationSetup
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< App String
randomDomain
  let wrongToken :: String
wrongToken = DomainRegistrationSetup
wrongSetup.ownershipToken

  -- [backoffice] preauth
  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

  -- [customer admin] post config with wrong token
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse
    ( Domain -> String -> Maybe String -> Value -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> Maybe String -> Value -> App Response
updateDomainRedirect
        Domain
OwnDomain
        String
domain
        (String -> Maybe String
forall a. a -> Maybe a
Just String
wrongToken)
        (String -> Value
mkDomainRedirectBackend String
"https://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 = do
  String
domain <- App String
randomDomain
  DomainRegistrationSetup
setup <- HasCallStack => String -> App DomainRegistrationSetup
String -> App DomainRegistrationSetup
setupOwnershipToken String
domain

  -- [backoffice] preauth
  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

  -- [customer admin] post no-registration config
  Domain -> String -> Maybe String -> Value -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> Maybe String -> Value -> App Response
updateDomainRedirect
    Domain
OwnDomain
    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 -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> App Response
getDomainRegistrationFromEmail Domain
OwnDomain (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 = do
  String
domain <- App String
randomDomain
  DomainRegistrationSetup
setup <- HasCallStack => String -> App DomainRegistrationSetup
String -> App DomainRegistrationSetup
setupOwnershipToken String
domain

  -- [backoffice] preauth
  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 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
getDomainRegistrationFromEmail Domain
OwnDomain (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
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse
    ( Domain -> String -> Maybe String -> Value -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> Maybe String -> Value -> App Response
updateDomainRedirect
        Domain
OwnDomain
        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"])
    )
    ((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"

  -- 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 -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> App Response
getDomainRegistrationFromEmail Domain
OwnDomain (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 -> String -> Maybe String -> Value -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> Maybe String -> Value -> App Response
updateDomainRedirect
    Domain
OwnDomain
    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 -> String -> Maybe String -> Value -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> Maybe String -> Value -> App Response
updateDomainRedirect
    Domain
OwnDomain
    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

  -- removing again should fail
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse
    ( Domain -> String -> Maybe String -> Value -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> Maybe String -> Value -> App Response
updateDomainRedirect
        Domain
OwnDomain
        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"])
    )
    ((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"

testDomainVerificationLockedState :: (HasCallStack) => App ()
testDomainVerificationLockedState :: HasCallStack => App ()
testDomainVerificationLockedState = do
  String
domain <- App String
randomDomain
  DomainRegistrationSetup
setup <- HasCallStack => String -> App DomainRegistrationSetup
String -> App DomainRegistrationSetup
setupOwnershipToken String
domain

  -- [backoffice] lock the domain (public email provider)
  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 -> String -> Maybe String -> Value -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> Maybe String -> Value -> App Response
updateDomainRedirect
        Domain
OwnDomain
        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 = 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
  DomainRegistrationSetup
setup <- HasCallStack => String -> App DomainRegistrationSetup
String -> App DomainRegistrationSetup
setupOwnershipToken String
domain

  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"

  -- 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"

  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
mem 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
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"

  -- 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
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"

  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
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"

  -- 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 -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> App Response
getDomainRegistrationFromEmail Domain
OwnDomain (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 -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> App Response
getDomainRegistrationFromEmail Domain
OwnDomain (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 = 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
  DomainRegistrationSetup
setup <- HasCallStack => String -> App DomainRegistrationSetup
String -> App DomainRegistrationSetup
setupOwnershipToken String
domain

  -- 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"

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

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
  -- 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

  DomainRegistrationSetup
setup <- HasCallStack => String -> App DomainRegistrationSetup
String -> App DomainRegistrationSetup
setupOwnershipToken String
domain

  -- 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"

  -- can't authorize a team when the domain is locked
  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
403

  Domain -> String -> Value -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> Value -> App Response
updateDomainRegistration
    Domain
OwnDomain
    String
domain
    ( [Pair] -> Value
object
        [ String
"domain_redirect" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"backend",
          String
"team_invite" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"not-allowed",
          String
"backend_url" 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
204

  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

  -- 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 = 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 <- HasCallStack => String -> App DomainRegistrationSetup
String -> App DomainRegistrationSetup
setupOwnershipToken String
domain
  Domain -> String -> Maybe String -> Value -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> Maybe String -> Value -> App Response
updateDomainRedirect
    Domain
OwnDomain
    String
domain
    (String -> Maybe String
forall a. a -> Maybe a
Just DomainRegistrationSetup
setup1.ownershipToken)
    (String -> Value
mkDomainRedirectBackend String
"https://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 <- HasCallStack => String -> App DomainRegistrationSetup
String -> App DomainRegistrationSetup
setupOwnershipToken String
domain
  Domain -> String -> Maybe String -> Value -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> Maybe String -> Value -> App Response
updateDomainRedirect
    Domain
OwnDomain
    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 -> String -> Maybe String -> Value -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> Maybe String -> Value -> App Response
updateDomainRedirect
    Domain
OwnDomain
    String
domain
    (String -> Maybe String
forall a. a -> Maybe a
Just DomainRegistrationSetup
setup1.ownershipToken)
    (String -> Value
mkDomainRedirectBackend String
"https://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
registrationDomain <- App String
randomDomain
    Value
challenge <- String -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> App Response
getDomainVerificationChallenge String
domain String
registrationDomain 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
registrationDomain 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

-- helpers

data ChallengeSetup = ChallengeSetup
  { ChallengeSetup -> String
dnsToken :: String,
    ChallengeSetup -> String
challengeId :: String,
    ChallengeSetup -> String
challengeToken :: String,
    ChallengeSetup -> String
technitiumToken :: String
  }

setupChallenge :: (HasCallStack) => String -> App ChallengeSetup
setupChallenge :: HasCallStack => String -> App ChallengeSetup
setupChallenge String
domain = do
  Value
challenge <- Domain -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> App Response
getDomainVerificationChallenge Domain
OwnDomain String
domain App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
200
  String
dnsToken <- Value
challenge Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"dns_verification_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
  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

  String
technitiumToken <- App String
HasCallStack => App String
getTechnitiumApiKey
  HasCallStack => String -> String -> App ()
String -> String -> App ()
registerTechnitiumZone String
technitiumToken String
domain

  ChallengeSetup -> App ChallengeSetup
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (ChallengeSetup -> App ChallengeSetup)
-> ChallengeSetup -> App ChallengeSetup
forall a b. (a -> b) -> a -> b
$ ChallengeSetup
      { String
$sel:dnsToken:ChallengeSetup :: String
dnsToken :: String
dnsToken,
        String
$sel:challengeId:ChallengeSetup :: String
challengeId :: String
challengeId,
        String
$sel:challengeToken:ChallengeSetup :: String
challengeToken :: String
challengeToken,
        String
$sel:technitiumToken:ChallengeSetup :: String
technitiumToken :: String
technitiumToken
      }

data DomainRegistrationSetup = DomainRegistrationSetup
  { DomainRegistrationSetup -> String
dnsToken :: String,
    DomainRegistrationSetup -> String
technitiumToken :: String,
    DomainRegistrationSetup -> String
ownershipToken :: String
  }

setupOwnershipToken :: (HasCallStack) => String -> App DomainRegistrationSetup
setupOwnershipToken :: HasCallStack => String -> App DomainRegistrationSetup
setupOwnershipToken String
domain = do
  ChallengeSetup
challenge <- HasCallStack => String -> App ChallengeSetup
String -> App ChallengeSetup
setupChallenge String
domain

  -- register TXT DNS record
  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
  String
ownershipToken <- App Response -> (Response -> App String) -> App String
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 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
200
    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

  DomainRegistrationSetup -> App DomainRegistrationSetup
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DomainRegistrationSetup -> App DomainRegistrationSetup)
-> DomainRegistrationSetup -> App DomainRegistrationSetup
forall a b. (a -> b) -> a -> b
$ String -> String -> String -> DomainRegistrationSetup
DomainRegistrationSetup ChallengeSetup
challenge.dnsToken ChallengeSetup
challenge.technitiumToken String
ownershipToken