{-# 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
  domain <- App String
randomDomain
  domainRegistrationPreAuthorize OwnDomain domain >>= assertStatus 204
  challenge <- setupChallenge OwnDomain domain

  bindResponse (verifyDomain OwnDomain domain challenge.challengeId challenge.challengeToken) $ \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"

  registerTechnitiumRecord challenge.technitiumToken domain ("wire-domain." <> domain) "TXT" challenge.dnsToken

  -- verify domain
  bindResponse (verifyDomain OwnDomain domain challenge.challengeId challenge.challengeToken) $ \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
  verifyDomain OwnDomain domain challenge.challengeId challenge.challengeToken >>= assertStatus 404

testCreateChallengeFailsIfLocked :: (HasCallStack) => App ()
testCreateChallengeFailsIfLocked :: HasCallStack => App ()
testCreateChallengeFailsIfLocked = do
  domain <- App String
randomDomain
  domainRegistrationLock OwnDomain domain >>= assertStatus 204
  getDomainVerificationChallenge OwnDomain domain `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
  domain <- App String
randomDomain
  challenge <- setupChallenge OwnDomain domain
  registerTechnitiumRecord challenge.technitiumToken domain ("wire-domain." <> domain) "TXT" challenge.dnsToken
  verifyDomain OwnDomain domain challenge.challengeId challenge.challengeToken `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
  domain <- App String
randomDomain
  void $ randomUser OwnDomain def {email = Just ("paolo@" <> domain)}

  domainRegistrationPreAuthorize OwnDomain domain >>= assertStatus 204

  setup <- setupOwnershipTokenForBackend OwnDomain domain
  let ownershipToken = DomainRegistrationSetup
setup.ownershipToken

  -- post config without ownership token (this is not allowed)
  updateDomainRedirect
    OwnDomain
    version
    domain
    Nothing
    (mkDomainRedirectBackend version "https://wire.example.com" "https://webapp.wire.example.com")
    >>= assertStatus 400

  -- [customer admin] post config (happy flow)
  checkUpdateRedirectSuccessful
    domain
    version
    ownershipToken
    (mkDomainRedirectBackend version "https://wire.example.com" "https://webapp.wire.example.com")

  -- idempotence
  checkUpdateRedirectSuccessful
    domain
    version
    ownershipToken
    (mkDomainRedirectBackend version "https://wire.example.com" "https://webapp.wire.example.com")

  -- [customer admin] update the previously set backend url
  checkUpdateRedirectSuccessful
    domain
    version
    ownershipToken
    (mkDomainRedirectBackend version "https://wire2.example.com" "https://webapp.wire2.example.com")

  -- [customer admin] update to no-registration
  checkUpdateRedirectSuccessful
    domain
    version
    ownershipToken
    (object ["domain_redirect" .= "no-registration"])

  -- idempotence
  checkUpdateRedirectSuccessful
    domain
    version
    ownershipToken
    (object ["domain_redirect" .= "no-registration"])

  -- [customer admin] transition from no-registration back to backend
  checkUpdateRedirectSuccessful
    domain
    version
    ownershipToken
    (mkDomainRedirectBackend version "https://wire.example.com" "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
        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 isBackend
          then do
            resp.json %. "domain_redirect" `shouldMatch` "no-registration"
            resp.json %. "due_to_existing_account" `shouldMatch` True
          else do
            resp.json %. "domain_redirect" `shouldMatch` (config %. "domain_redirect")
            lookupField resp.json "due_to_existing_account" `shouldMatch` (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
  domain <- App String
randomDomain
  wrongDomain <- randomDomain
  domainRegistrationPreAuthorize OwnDomain domain >>= assertStatus 204
  void $ setupOwnershipTokenForBackend OwnDomain domain
  domainRegistrationPreAuthorize OwnDomain wrongDomain >>= assertStatus 204
  wrongSetup <- setupOwnershipTokenForBackend OwnDomain wrongDomain
  let wrongToken = DomainRegistrationSetup
wrongSetup.ownershipToken

  -- [customer admin] post config with wrong token
  bindResponse
    ( updateDomainRedirect
        OwnDomain
        version
        domain
        (Just wrongToken)
        (mkDomainRedirectBackend version "https://wire.example.com" "https://webapp.wire.example.com")
    )
    $ \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
  domain <- App String
randomDomain
  domainRegistrationPreAuthorize OwnDomain domain >>= assertStatus 204
  setup <- setupOwnershipTokenForBackend OwnDomain domain

  -- [customer admin] post no-registration config
  updateDomainRedirect
    OwnDomain
    version
    domain
    (Just setup.ownershipToken)
    (object ["domain_redirect" .= "no-registration"])
    >>= assertStatus 200

  bindResponse (getDomainRegistrationFromEmail OwnDomain version ("paolo@" ++ 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
  domain <- App String
randomDomain
  domainRegistrationPreAuthorize OwnDomain domain >>= assertStatus 204
  setup <- setupOwnershipTokenForBackend OwnDomain domain

  bindResponse (getDomainRegistrationFromEmail OwnDomain version ("paolo@" ++ 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
  updateDomainRedirect
    OwnDomain
    version
    domain
    (Just setup.ownershipToken)
    (object ["domain_redirect" .= "remove"])
    >>= assertSuccess

  -- check that it's still set to preauthorized
  bindResponse (getDomainRegistrationFromEmail OwnDomain version ("paolo@" ++ 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
  updateDomainRedirect
    OwnDomain
    version
    domain
    (Just setup.ownershipToken)
    (object ["domain_redirect" .= "no-registration"])
    >>= assertStatus 200

  updateDomainRedirect
    OwnDomain
    version
    domain
    (Just setup.ownershipToken)
    (object ["domain_redirect" .= "remove"])
    >>= assertStatus 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
  domain <- App String
randomDomain
  domainRegistrationPreAuthorize OwnDomain domain >>= assertStatus 204
  setup <- setupOwnershipTokenForBackend OwnDomain domain
  domainRegistrationLock OwnDomain domain >>= assertStatus 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
  bindResponse
    ( updateDomainRedirect
        OwnDomain
        version
        domain
        (Just setup.ownershipToken)
        (object ["domain_redirect" .= "no-registration"])
    )
    $ \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
  (owner, tid, mem : _) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2
  domain <- randomDomain

  -- enable domain registration feature
  assertSuccess =<< do
    setTeamFeatureLockStatus owner tid "domainRegistration" "unlocked"
    setTeamFeatureStatus owner tid "domainRegistration" "enabled"

  setup <- setupOwnershipTokenForTeam owner domain

  setTeamFeatureStatus owner tid "domainRegistration" "disabled" >>= assertSuccess

  bindResponse (authorizeTeam owner domain setup.ownershipToken) $ \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"

  setTeamFeatureStatus owner tid "domainRegistration" "enabled" >>= assertSuccess

  -- admin should not be able to set team-invite if the team hasn't been authorized
  bindResponse
    (updateTeamInvite owner domain (object ["team_invite" .= "team", "team" .= tid]))
    $ \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"

  authorizeTeam owner domain setup.ownershipToken >>= assertStatus 200

  -- non-admin should not be able to set team-invite
  bindResponse
    (updateTeamInvite mem domain (object ["team_invite" .= "team", "team" .= tid]))
    $ \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
  fakeTeamId <- randomId
  bindResponse (updateTeamInvite owner domain (object ["team_invite" .= "team", "team" .= fakeTeamId])) $ \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
  updateTeamInvite owner domain (object ["team_invite" .= "team", "team" .= tid])
    >>= assertStatus 200

  bindResponse (getDomainRegistration OwnDomain domain) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"domain" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
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

  bindResponse (getDomainRegistrationFromEmail OwnDomain version ("paolo@" ++ 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
  updateTeamInvite owner domain (object ["team_invite" .= "not-allowed"])
    >>= assertStatus 200

  bindResponse (getDomainRegistration OwnDomain domain) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"domain" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
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"

  bindResponse (getDomainRegistrationFromEmail OwnDomain version ("paolo@" ++ 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
  updateTeamInvite owner domain (object ["team_invite" .= "not-allowed", "domain_redirect" .= "no-registration"])
    >>= assertStatus 200

  bindResponse (getDomainRegistration OwnDomain domain) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"domain" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
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"

  bindResponse (getDomainRegistrationFromEmail OwnDomain version ("paolo@" ++ 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
  updateTeamInvite owner domain (object ["team_invite" .= "not-allowed", "domain_redirect" .= "none"])
    >>= assertStatus 200

  bindResponse (getDomainRegistration OwnDomain domain) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"domain" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
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"

  bindResponse (getDomainRegistrationFromEmail OwnDomain version ("paolo@" ++ 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
  domain <- App String
randomDomain
  (owner, tid, _m : _) <- createTeam OwnDomain 2
  assertSuccess =<< do
    setTeamFeatureLockStatus owner tid "domainRegistration" "unlocked"
    setTeamFeatureStatus owner tid "domainRegistration" "enabled"

  setup <- setupOwnershipTokenForTeam owner domain

  authorizeTeam owner domain setup.ownershipToken >>= assertStatus 200

  -- [customer admin] post team-invite config with an invalid idp
  fakeIdP <- randomId
  updateTeamInvite owner domain (object ["team_invite" .= "allowed", "sso" .= fakeIdP])
    >>= assertStatus 403

  -- [customer admin] register a new idp and use it to set a team-invite config
  void $ setTeamFeatureStatus owner tid "sso" "enabled"
  idp <- bindResponse (registerTestIdPWithMeta owner) $ \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"
  updateTeamInvite owner domain (object ["team_invite" .= "allowed", "sso" .= idp])
    >>= assertStatus 200

  bindResponse (getDomainRegistration OwnDomain domain) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"domain" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
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

  bindResponse (getDomainRegistrationFromEmail OwnDomain version ("paolo@" ++ 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
  (owner, tid, _m : _) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2
  emailDomain <- randomDomain

  -- enable domain registration feature
  assertSuccess =<< do
    setTeamFeatureLockStatus owner tid "domainRegistration" "unlocked"
    setTeamFeatureStatus owner tid "domainRegistration" "enabled"

  challenge <- setupChallengeAndDnsRecord owner emailDomain
  domainRegistrationLock OwnDomain emailDomain >>= assertStatus 204
  bindResponse (verifyDomainForTeam owner emailDomain challenge.challengeId challenge.challengeToken) $ \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
  (owner, tid, _m : _) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
2
  domain <- randomDomain

  -- enable domain registration feature
  assertSuccess =<< do
    setTeamFeatureLockStatus owner tid "domainRegistration" "unlocked"
    setTeamFeatureStatus owner tid "domainRegistration" "enabled"

  setup <- setupOwnershipTokenForTeam owner domain

  authorizeTeam owner domain setup.ownershipToken >>= assertStatus 200

  -- set domain-redirect to locked
  domainRegistrationLock OwnDomain domain >>= assertStatus 204

  -- setting team-invite to allowed should fail for on-prem domains
  bindResponse (updateTeamInvite owner domain (object ["team_invite" .= "allowed"])) $ \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
  domain <- App String
randomDomain

  bindResponse (getDomainVerificationChallenge OtherDomain domain) $ \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
  domain <- App String
randomDomain
  domainRegistrationPreAuthorize OwnDomain domain >>= assertStatus 204

  -- get an ownership token
  setup1 <- setupOwnershipTokenForBackend OwnDomain domain
  updateDomainRedirect
    OwnDomain
    version
    domain
    (Just setup1.ownershipToken)
    (mkDomainRedirectBackend version "https://wire1.example.com" "https://webapp.wire1.example.com")
    >>= assertStatus 200

  -- get a second ownership token
  setup2 <- setupOwnershipTokenForBackend OwnDomain domain
  updateDomainRedirect
    OwnDomain
    version
    domain
    (Just setup2.ownershipToken)
    (object ["domain_redirect" .= "remove"])
    >>= assertStatus 200

  -- the first ownership token is not valid anymore
  updateDomainRedirect
    OwnDomain
    version
    domain
    (Just setup1.ownershipToken)
    (mkDomainRedirectBackend version "https://wire1.example.com" "https://webapp.wire1.example.com")
    >>= assertStatus 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
    emailDomain <- App String
randomDomain
    domainRegistrationPreAuthorize domain emailDomain >>= assertStatus 204

    challenge <- getDomainVerificationChallenge domain emailDomain >>= getJSON 200
    challengeId <- challenge %. "id" & asString
    challengeToken <- challenge %. "token" & asString

    -- wait until the challenge ttl expires
    liftIO $ threadDelay 2_500_000
    bindResponse (verifyDomain domain emailDomain challengeId challengeToken) $ \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
  (owner, tid, mem : _) <- 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
  assertSuccess =<< do
    setTeamFeatureLockStatus owner tid "domainRegistration" "unlocked"
    setTeamFeatureStatus owner tid "domainRegistration" "enabled"

  expectedDomains <- replicateM 5 do
    domain <- randomDomain
    setup <- setupOwnershipTokenForTeam owner domain
    authorizeTeam owner domain setup.ownershipToken >>= assertStatus 200
    pure domain

  bindResponse (getRegisteredDomainsByTeam owner tid) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    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"))
    actualDomains `shouldMatchSet` expectedDomains

  getRegisteredDomainsByTeam mem tid >>= assertStatus 403
  (otherTeamOwner, _, _) <- createTeam OwnDomain 2
  getRegisteredDomainsByTeam otherTeamOwner tid >>= assertStatus 403

  nonExistingDomain <- randomDomain
  deleteRegisteredTeamDomain owner tid nonExistingDomain >>= assertStatus 404
  let firstDomain = [String] -> String
forall a. HasCallStack => [a] -> a
head [String]
expectedDomains
  deleteRegisteredTeamDomain mem tid firstDomain >>= assertStatus 403
  deleteRegisteredTeamDomain otherTeamOwner tid firstDomain >>= assertStatus 403

  let 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
          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
          length actualDomains `shouldMatchInt` 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
          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"))
          actualDomains `shouldMatchSet` remainingDomains
        [String] -> App ()
checkDelete [String]
remainingDomains

  checkDelete 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
  domain <- App String
randomDomain
  domainRegistrationPreAuthorize OwnDomain domain >>= assertStatus 204

  -- create a user with email on this domain
  void $ randomUser OwnDomain def {email = Just ("paolo@" <> domain)}

  setup <- setupOwnershipTokenForBackend OwnDomain domain
  updateDomainRedirect
    OwnDomain
    version
    domain
    (Just setup.ownershipToken)
    (mkDomainRedirectBackend version "https://wire.example.com" "https://webapp.wire.example.com")
    >>= assertStatus 200

  bindResponse (getDomainRegistrationFromEmail OwnDomain version ("sven@" <> 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"
    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)

  bindResponse (getDomainRegistrationFromEmail OwnDomain version ("paolo@" <> 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"
    -- 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
  emailDomain <- App String
randomDomain
  (owner, tid, mem : _) <- createTeamWithEmailDomain OwnDomain emailDomain 2
  memMail <- mem %. "email" & asString
  let paoloMail = String
"paolo@" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
emailDomain
  void $ randomUser OwnDomain def {email = Just paoloMail}
  let svenMail = String
"sven@" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
emailDomain
  void $ randomUser OwnDomain def {email = Just svenMail, team = True}
  let newUserMail = String
"newUser@" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
emailDomain

  -- enable domain registration feature
  assertSuccess =<< do
    setTeamFeatureLockStatus owner tid "domainRegistration" "unlocked"
    setTeamFeatureStatus owner tid "domainRegistration" "enabled"

  setup <- setupOwnershipTokenForTeam owner emailDomain
  authorizeTeam owner emailDomain setup.ownershipToken >>= assertStatus 200

  -- [customer admin] register a new idp and use it to set a team-invite config
  void $ setTeamFeatureStatus owner tid "sso" "enabled"
  (idp, idpMeta) <- registerTestIdPWithMetaWithPrivateCreds owner
  idpId <- asString $ idp.json %. "id"
  updateTeamInvite owner emailDomain (object ["team_invite" .= "allowed", "sso" .= idpId])
    >>= assertStatus 200

  -- newUserMail is not registered yet
  bindResponse (getDomainRegistrationFromEmail OwnDomain version 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

  void $ loginWithSamlEmail True tid newUserMail (idpId, idpMeta)

  -- now the account exists, and but as this is an SSO user they should be directed to the SSO flow
  bindResponse (getDomainRegistrationFromEmail OwnDomain version 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
  for_ [memMail, paoloMail, 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
  (owner, tid, _) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1
  emailDomain <- randomDomain

  assertSuccess =<< do
    setTeamFeatureLockStatus owner tid "domainRegistration" "unlocked"
    setTeamFeatureStatus owner tid "domainRegistration" "enabled"

  setup <- setupOwnershipTokenForTeam owner emailDomain
  authorizeTeam owner emailDomain setup.ownershipToken >>= assertSuccess

  void $ setTeamFeatureStatus owner tid "sso" "enabled"
  (idp, idpMeta) <- registerTestIdPWithMetaWithPrivateCreds owner
  idpId <- asString $ idp.json %. "id"

  updateTeamInvite owner emailDomain (object ["team_invite" .= "not-allowed", "sso" .= idpId]) >>= assertSuccess

  let email = String
"user@" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
emailDomain
  (Just uid, _) <- loginWithSamlEmail True tid email (idpId, idpMeta)
  getUsersId OwnDomain [uid] `bindResponse` \Response
res -> do
    Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    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
    user %. "status" `shouldMatch` "active"
    user %. "email" `shouldMatch` email

  getUsersByEmail OwnDomain [email] `bindResponse` \Response
res -> do
    Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    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
    user %. "status" `shouldMatch` "active"
    user %. "email" `shouldMatch` email

  otherEmailDomain <- randomDomain
  let otherEmail = String
"otherUser@" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
otherEmailDomain
  (Just otherUid, _) <- loginWithSamlEmail True tid otherEmail (idpId, idpMeta)

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

  getUsersByEmail OwnDomain [otherEmail] `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

  activateEmail OwnDomain otherEmail
  getUsersId OwnDomain [otherUid] `bindResponse` \Response
res -> do
    Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    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
    user %. "status" `shouldMatch` "active"
    user %. "email" `shouldMatch` otherEmail

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

  assertSuccess =<< do
    setTeamFeatureLockStatus owner tid "domainRegistration" "unlocked"
    setTeamFeatureStatus owner tid "domainRegistration" "enabled"

  setup <- setupOwnershipTokenForTeam owner emailDomain
  authorizeTeam owner emailDomain setup.ownershipToken >>= assertSuccess

  updateTeamInvite owner emailDomain (object ["team_invite" .= "team", "team" .= tid]) >>= assertSuccess

  tok <- createScimToken owner def >>= getJSON 200 >>= (%. "token") >>= asString
  let email = String
"user@" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
emailDomain
      extId = String
email
  scimUser <- randomScimUserWithEmail extId email
  uid <- bindResponse (createScimUser owner tok scimUser) $ \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
  registerInvitedUser OwnDomain tid email
  bindResponse (login OwnDomain email defPassword) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
  getUsersId OwnDomain [uid] `bindResponse` \Response
res -> do
    Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    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
    user %. "status" `shouldMatch` "active"
    user %. "email" `shouldMatch` email
  getUsersByEmail OwnDomain [email] `bindResponse` \Response
res -> do
    Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    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
    user %. "status" `shouldMatch` "active"
    user %. "email" `shouldMatch` email

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

  assertSuccess =<< do
    setTeamFeatureLockStatus owner tid "domainRegistration" "unlocked"
    setTeamFeatureStatus owner tid "domainRegistration" "enabled"

  setup <- setupOwnershipTokenForTeam owner emailDomain
  authorizeTeam owner emailDomain setup.ownershipToken >>= assertSuccess

  void $ setTeamFeatureStatus owner tid "sso" "enabled"
  (idp, idpMeta) <- registerTestIdPWithMetaWithPrivateCreds owner
  idpId <- asString $ idp.json %. "id"

  updateTeamInvite owner emailDomain (object ["team_invite" .= "not-allowed", "sso" .= idpId]) >>= assertSuccess

  tok <-
    createScimToken owner def {idp = Just idpId}
      >>= getJSON 200
      >>= (%. "token")
      >>= asString
  let email = String
"user@" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
emailDomain
      extId = String
email
  scimUser <- randomScimUserWithEmail extId email
  uid <- bindResponse (createScimUser owner tok scimUser) $ \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
  void $ loginWithSamlEmail True tid email (idpId, idpMeta)

  getUsersId OwnDomain [uid] `bindResponse` \Response
res -> do
    Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    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
    user %. "status" `shouldMatch` "active"
    user %. "email" `shouldMatch` email

  getUsersByEmail OwnDomain [email] `bindResponse` \Response
res -> do
    Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    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
    user %. "status" `shouldMatch` "active"
    user %. "email" `shouldMatch` email

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

  assertSuccess =<< do
    setTeamFeatureLockStatus owner tid "domainRegistration" "unlocked"
    setTeamFeatureStatus owner tid "domainRegistration" "enabled"

  setup <- setupOwnershipTokenForTeam owner emailDomain
  authorizeTeam owner emailDomain setup.ownershipToken >>= assertSuccess

  void $ setTeamFeatureStatus owner tid "sso" "enabled"
  (idp, idpMeta) <- registerTestIdPWithMetaWithPrivateCreds owner
  idpId <- asString $ idp.json %. "id"

  updateTeamInvite owner emailDomain (object ["team_invite" .= "team", "team" .= tid]) >>= assertSuccess

  let email = String
"user@" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
emailDomain
  (Just uid, _) <- loginWithSamlEmail True tid email (idpId, idpMeta)

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

  getUsersByEmail OwnDomain [email] `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

  activateEmail OwnDomain email
  getUsersId OwnDomain [uid] `bindResponse` \Response
res -> do
    Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    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
    user %. "status" `shouldMatch` "active"
    user %. "email" `shouldMatch` email

testDomainVerificationUpdateRedirectRequiresWebappUrl :: (HasCallStack) => App ()
testDomainVerificationUpdateRedirectRequiresWebappUrl :: HasCallStack => App ()
testDomainVerificationUpdateRedirectRequiresWebappUrl = do
  domain <- App String
randomDomain
  void $ randomUser OwnDomain def {email = Just ("paolo@" <> domain)}

  domainRegistrationPreAuthorize OwnDomain domain >>= assertStatus 204

  setup <- setupOwnershipTokenForBackend OwnDomain domain
  let ownershipToken = DomainRegistrationSetup
setup.ownershipToken

  -- check that it works in general
  updateDomainRedirect
    OwnDomain
    Versioned
    domain
    (Just ownershipToken)
    ( object
        [ "domain_redirect" .= "backend",
          "backend"
            .= object
              [ "config_url" .= "https://wire.example.com",
                "webapp_url" .= "https://webapp.wire.example.com"
              ]
        ]
    )
    >>= assertStatus 200

  -- see it fail when the webapp URL is missing
  updateDomainRedirect
    OwnDomain
    Versioned
    domain
    (Just ownershipToken)
    ( object
        [ "domain_redirect" .= "backend",
          "backend" .= object ["config" .= "https://wire.example.com"]
        ]
    )
    >>= assertStatus 400