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

  bindResponse (verifyDomain OwnDomain domain challenge.challengeId challenge.challengeToken) $ \resp -> do
    resp.status `shouldMatchInt` 403
    resp.json %. "label" `shouldMatch` "domain-verification-failed"

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

  -- verify domain
  bindResponse (verifyDomain OwnDomain domain challenge.challengeId challenge.challengeToken) $ \resp -> do
    resp.status `shouldMatchInt` 200
    void $ resp.json %. "domain_ownership_token" & asString

  -- the challenge should be deleted after successful verification
  verifyDomain OwnDomain domain challenge.challengeId challenge.challengeToken >>= assertStatus 404

testCreateChallengeFailsIfLocked :: (HasCallStack) => App ()
testCreateChallengeFailsIfLocked = do
  domain <- randomDomain
  domainRegistrationLock OwnDomain domain >>= assertStatus 204
  getDomainVerificationChallenge OwnDomain domain `bindResponse` \resp -> do
    resp.status `shouldMatchInt` 403
    resp.json %. "label" `shouldMatch` "operation-forbidden-for-domain-registration-state"

testVerifyChallengeFailsIfNotPreauthorized :: (HasCallStack) => App ()
testVerifyChallengeFailsIfNotPreauthorized = do
  domain <- randomDomain
  challenge <- setupChallenge OwnDomain domain
  registerTechnitiumRecord challenge.technitiumToken domain ("wire-domain." <> domain) "TXT" challenge.dnsToken
  verifyDomain OwnDomain domain challenge.challengeId challenge.challengeToken `bindResponse` \resp -> do
    resp.status `shouldMatchInt` 403
    resp.json %. "label" `shouldMatch` "operation-forbidden-for-domain-registration-state"

testDomainVerificationOnPremFlow :: (HasCallStack) => App ()
testDomainVerificationOnPremFlow = forM_ [ExplicitVersion 8, Versioned] \version -> do
  domain <- randomDomain
  void $ randomUser OwnDomain def {email = Just ("paolo@" <> domain)}

  domainRegistrationPreAuthorize OwnDomain domain >>= assertStatus 204

  setup <- setupOwnershipTokenForBackend OwnDomain domain
  let ownershipToken = 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 domain version token config = do
      updateDomainRedirect
        OwnDomain
        version
        domain
        (Just token)
        config
        >>= assertStatus 200

      bindResponse (getDomainRegistrationFromEmail OwnDomain version ("sven@" ++ domain)) \resp -> do
        resp.status `shouldMatchInt` 200
        resp.json %. "domain_redirect" `shouldMatch` (config %. "domain_redirect")
        case version of
          ExplicitVersion v
            | v <= 8 ->
                lookupField resp.json "backend_url" `shouldMatch` (lookupField config "backend_url")
          _ -> do
            let backendUrl v = runMaybeT $ lookupFieldM v "backend" >>= flip lookupFieldM "config_url"
                webappUrl v = runMaybeT $ lookupFieldM v "backend" >>= flip lookupFieldM "webapp_url"

            backendUrl resp.json `shouldMatch` backendUrl config
            webappUrl resp.json `shouldMatch` webappUrl config

      bindResponse (getDomainRegistrationFromEmail OwnDomain version ("paolo@" ++ domain)) \resp -> do
        resp.status `shouldMatchInt` 200
        isBackend <- config %. "domain_redirect" >>= asString <&> (== "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 = forM_ [ExplicitVersion 8, Versioned] \version -> do
  domain <- randomDomain
  wrongDomain <- randomDomain
  domainRegistrationPreAuthorize OwnDomain domain >>= assertStatus 204
  void $ setupOwnershipTokenForBackend OwnDomain domain
  domainRegistrationPreAuthorize OwnDomain wrongDomain >>= assertStatus 204
  wrongSetup <- setupOwnershipTokenForBackend OwnDomain wrongDomain
  let wrongToken = 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")
    )
    $ \resp -> do
      resp.status `shouldMatchInt` 401
      resp.json %. "label" `shouldMatch` "domain-registration-update-auth-failure"

testDomainVerificationOnPremFlowNoRegistration :: (HasCallStack) => App ()
testDomainVerificationOnPremFlowNoRegistration = forM_ [ExplicitVersion 8, Versioned] \version -> do
  domain <- 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)) \resp -> do
    resp.status `shouldMatchInt` 200
    resp.json %. "domain_redirect" `shouldMatch` "no-registration"

testDomainVerificationRemoveFailure :: (HasCallStack) => App ()
testDomainVerificationRemoveFailure = forM_ [ExplicitVersion 8, Versioned] \version -> do
  domain <- randomDomain
  domainRegistrationPreAuthorize OwnDomain domain >>= assertStatus 204
  setup <- setupOwnershipTokenForBackend OwnDomain domain

  bindResponse (getDomainRegistrationFromEmail OwnDomain version ("paolo@" ++ domain)) \resp -> do
    resp.status `shouldMatchInt` 200
    resp.json %. "domain_redirect" `shouldMatch` "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)) \resp -> do
    resp.status `shouldMatchInt` 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 = forM_ [ExplicitVersion 8, Versioned] \version -> do
  domain <- 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"])
    )
    $ \resp -> do
      resp.status `shouldMatchInt` 401
      resp.json %. "label" `shouldMatch` "domain-registration-update-auth-failure"

testUpdateTeamInvite :: (HasCallStack) => App ()
testUpdateTeamInvite = forM_ [ExplicitVersion 8, Versioned] \version -> do
  (owner, tid, mem : _) <- createTeam OwnDomain 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) $ \resp -> do
    resp.status `shouldMatchInt` 402
    resp.json %. "label" `shouldMatch` "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]))
    $ \resp -> do
      resp.status `shouldMatchInt` 403
      resp.json %. "label" `shouldMatch` "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]))
    $ \resp -> do
      resp.status `shouldMatchInt` 403
      resp.json %. "label" `shouldMatch` "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])) $ \resp -> do
    resp.status `shouldMatchInt` 403
    resp.json %. "label" `shouldMatch` "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) $ \resp -> do
    resp.status `shouldMatchInt` 200
    resp.json %. "domain" `shouldMatch` domain
    resp.json %. "domain_redirect" `shouldMatch` "none"
    resp.json %. "team_invite" `shouldMatch` "team"
    resp.json %. "team" `shouldMatch` tid

  bindResponse (getDomainRegistrationFromEmail OwnDomain version ("paolo@" ++ domain)) \resp -> do
    resp.status `shouldMatchInt` 200
    resp.json %. "domain_redirect" `shouldMatch` "none"

  -- [customer admin] set team-invite to not-allowed
  updateTeamInvite owner domain (object ["team_invite" .= "not-allowed"])
    >>= assertStatus 200

  bindResponse (getDomainRegistration OwnDomain domain) $ \resp -> do
    resp.status `shouldMatchInt` 200
    resp.json %. "domain" `shouldMatch` domain
    resp.json %. "domain_redirect" `shouldMatch` "none"
    resp.json %. "team_invite" `shouldMatch` "not-allowed"

  bindResponse (getDomainRegistrationFromEmail OwnDomain version ("paolo@" ++ domain)) \resp -> do
    resp.status `shouldMatchInt` 200
    resp.json %. "domain_redirect" `shouldMatch` "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) $ \resp -> do
    resp.status `shouldMatchInt` 200
    resp.json %. "domain" `shouldMatch` domain
    resp.json %. "domain_redirect" `shouldMatch` "no-registration"
    resp.json %. "team_invite" `shouldMatch` "not-allowed"

  bindResponse (getDomainRegistrationFromEmail OwnDomain version ("paolo@" ++ domain)) \resp -> do
    resp.status `shouldMatchInt` 200
    resp.json %. "domain_redirect" `shouldMatch` "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) $ \resp -> do
    resp.status `shouldMatchInt` 200
    resp.json %. "domain" `shouldMatch` domain
    resp.json %. "domain_redirect" `shouldMatch` "none"
    resp.json %. "team_invite" `shouldMatch` "not-allowed"

  bindResponse (getDomainRegistrationFromEmail OwnDomain version ("paolo@" ++ domain)) \resp -> do
    resp.status `shouldMatchInt` 200
    resp.json %. "domain_redirect" `shouldMatch` "none"

testUpdateTeamInviteSSO :: (HasCallStack) => App ()
testUpdateTeamInviteSSO = forM_ [ExplicitVersion 8, Versioned] \version -> do
  domain <- 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) $ \resp -> do
    resp.status `shouldMatchInt` 201
    resp.json %. "id"
  updateTeamInvite owner domain (object ["team_invite" .= "allowed", "sso" .= idp])
    >>= assertStatus 200

  bindResponse (getDomainRegistration OwnDomain domain) $ \resp -> do
    resp.status `shouldMatchInt` 200
    resp.json %. "domain" `shouldMatch` domain
    resp.json %. "domain_redirect" `shouldMatch` "sso"
    resp.json %. "team_invite" `shouldMatch` "allowed"
    resp.json %. "sso_code" `shouldMatch` idp

  bindResponse (getDomainRegistrationFromEmail OwnDomain version ("paolo@" ++ domain)) \resp -> do
    resp.status `shouldMatchInt` 200
    resp.json %. "domain_redirect" `shouldMatch` "sso"
    resp.json %. "sso_code" `shouldMatch` idp

testVerifyChallengeFailsIfLocked :: (HasCallStack) => App ()
testVerifyChallengeFailsIfLocked = do
  (owner, tid, _m : _) <- createTeam OwnDomain 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) $ \resp -> do
    resp.status `shouldMatchInt` 403
    resp.json %. "label" `shouldMatch` "operation-forbidden-for-domain-registration-state"

testUpdateTeamInviteLocked :: (HasCallStack) => App ()
testUpdateTeamInviteLocked = do
  (owner, tid, _m : _) <- createTeam OwnDomain 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"])) $ \resp -> do
    resp.status `shouldMatchInt` 403
    resp.json %. "label" `shouldMatch` "operation-forbidden-for-domain-registration-state"

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

  bindResponse (getDomainVerificationChallenge OtherDomain domain) $ \resp -> do
    resp.status `shouldMatchInt` 503
    resp.json %. "label" `shouldMatch` "enterprise-service-not-enabled"

testOverwriteOwnershipToken :: (HasCallStack) => App ()
testOverwriteOwnershipToken = forM_ [ExplicitVersion 8, Versioned] \version -> do
  domain <- 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 = withModifiedBackend
  (def {brigCfg = (setField "optSettings.setChallengeTTL" (2 :: Int))})
  $ \domain -> do
    emailDomain <- 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) $ \resp -> do
      resp.status `shouldMatchInt` 404

testGetAndDeleteRegisteredDomains :: (HasCallStack) => App ()
testGetAndDeleteRegisteredDomains = do
  (owner, tid, mem : _) <- createTeam OwnDomain 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) $ \resp -> do
    resp.status `shouldMatchInt` 200
    actualDomains <- resp.json %. "registered_domains" & asList >>= traverse (asString . (%. "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 = head expectedDomains
  deleteRegisteredTeamDomain mem tid firstDomain >>= assertStatus 403
  deleteRegisteredTeamDomain otherTeamOwner tid firstDomain >>= assertStatus 403

  let checkDelete :: [String] -> App ()
      checkDelete [] =
        bindResponse (getRegisteredDomainsByTeam owner tid) $ \resp -> do
          resp.status `shouldMatchInt` 200
          actualDomains <- resp.json %. "registered_domains" & asList
          length actualDomains `shouldMatchInt` 0
      checkDelete (domainToDelete : remainingDomains) = do
        bindResponse (deleteRegisteredTeamDomain owner tid domainToDelete) $ \resp -> do
          resp.status `shouldMatchInt` 204
        bindResponse (getRegisteredDomainsByTeam owner tid) $ \resp -> do
          resp.status `shouldMatchInt` 200
          actualDomains <- resp.json %. "registered_domains" & asList >>= traverse (asString . (%. "domain"))
          actualDomains `shouldMatchSet` remainingDomains
        checkDelete remainingDomains

  checkDelete expectedDomains

testGetDomainRegistrationUserExistsBackend :: (HasCallStack) => App ()
testGetDomainRegistrationUserExistsBackend = forM_ [ExplicitVersion 8, Versioned] \version -> do
  domain <- 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)) $ \resp -> do
    resp.status `shouldMatchInt` 200
    resp.json %. "domain_redirect" `shouldMatch` "backend"
    if version == ExplicitVersion 8
      then resp.json %. "backend_url" `shouldMatch` "https://wire.example.com"
      else do
        resp.json %. "backend.config_url" `shouldMatch` "https://wire.example.com"
        resp.json %. "backend.webapp_url" `shouldMatch` "https://webapp.wire.example.com"
    lookupField resp.json "due_to_existing_account" `shouldMatch` (Nothing :: Maybe Bool)

  bindResponse (getDomainRegistrationFromEmail OwnDomain version ("paolo@" <> domain)) $ \resp -> do
    resp.status `shouldMatchInt` 200
    resp.json %. "domain_redirect" `shouldMatch` "no-registration"
    -- Neither old (<= V9) nor new backend URL fields should be received
    lookupField resp.json "backend_url" `shouldMatch` (Nothing :: Maybe String)
    lookupField resp.json "backend" `shouldMatch` (Nothing :: Maybe String)
    resp.json %. "due_to_existing_account" `shouldMatch` True

testGetDomainRegistrationUserExistsSso :: (HasCallStack) => App ()
testGetDomainRegistrationUserExistsSso = forM_ [ExplicitVersion 8, Versioned] \version -> do
  emailDomain <- randomDomain
  (owner, tid, mem : _) <- createTeamWithEmailDomain OwnDomain emailDomain 2
  memMail <- mem %. "email" & asString
  let paoloMail = "paolo@" <> emailDomain
  void $ randomUser OwnDomain def {email = Just paoloMail}
  let svenMail = "sven@" <> emailDomain
  void $ randomUser OwnDomain def {email = Just svenMail, team = True}
  let newUserMail = "newUser@" <> 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) \resp -> do
    resp.status `shouldMatchInt` 200
    resp.json %. "domain_redirect" `shouldMatch` "sso"
    resp.json %. "sso_code" `shouldMatch` 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) \resp -> do
    resp.status `shouldMatchInt` 200
    resp.json %. "domain_redirect" `shouldMatch` "sso"
    resp.json %. "sso_code" `shouldMatch` idpId

  -- these have normal password accounts, and some are not members of the team
  for_ [memMail, paoloMail, svenMail] \email -> do
    bindResponse (getDomainRegistrationFromEmail OwnDomain version email) \resp -> do
      resp.status `shouldMatchInt` 200
      resp.json %. "domain_redirect" `shouldMatch` "no-registration"
      lookupField resp.json "sso_code" `shouldMatch` (Nothing :: Maybe String)
      lookupField resp.json "due_to_existing_account" `shouldMatch` (Nothing :: Maybe Bool)

testSsoLoginNoEmailVerification :: (HasCallStack) => App ()
testSsoLoginNoEmailVerification = do
  (owner, tid, _) <- createTeam OwnDomain 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 = "user@" <> emailDomain
  (Just uid, _) <- loginWithSamlEmail True tid email (idpId, idpMeta)
  getUsersId OwnDomain [uid] `bindResponse` \res -> do
    res.status `shouldMatchInt` 200
    user <- res.json & asList >>= assertOne
    user %. "status" `shouldMatch` "active"
    user %. "email" `shouldMatch` email

  getUsersByEmail OwnDomain [email] `bindResponse` \res -> do
    res.status `shouldMatchInt` 200
    user <- res.json & asList >>= assertOne
    user %. "status" `shouldMatch` "active"
    user %. "email" `shouldMatch` email

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

  getUsersId OwnDomain [otherUid] `bindResponse` \res -> do
    res.status `shouldMatchInt` 200
    user <- res.json & asList >>= assertOne
    user %. "status" `shouldMatch` "active"
    lookupField user "email" `shouldMatch` (Nothing :: Maybe String)

  getUsersByEmail OwnDomain [otherEmail] `bindResponse` \res -> do
    res.status `shouldMatchInt` 200
    res.json & asList >>= shouldBeEmpty

  activateEmail OwnDomain otherEmail
  getUsersId OwnDomain [otherUid] `bindResponse` \res -> do
    res.status `shouldMatchInt` 200
    user <- res.json & asList >>= assertOne
    user %. "status" `shouldMatch` "active"
    user %. "email" `shouldMatch` otherEmail

testScimOnlyWithRegisteredEmailDomain :: (HasCallStack) => App ()
testScimOnlyWithRegisteredEmailDomain = do
  (owner, tid, _) <- createTeam OwnDomain 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 = "user@" <> emailDomain
      extId = email
  scimUser <- randomScimUserWithEmail extId email
  uid <- bindResponse (createScimUser owner tok scimUser) $ \resp -> do
    resp.status `shouldMatchInt` 201
    resp.json %. "id" >>= asString
  registerInvitedUser OwnDomain tid email
  bindResponse (login OwnDomain email defPassword) $ \resp -> do
    resp.status `shouldMatchInt` 200
  getUsersId OwnDomain [uid] `bindResponse` \res -> do
    res.status `shouldMatchInt` 200
    user <- res.json & asList >>= assertOne
    user %. "status" `shouldMatch` "active"
    user %. "email" `shouldMatch` email
  getUsersByEmail OwnDomain [email] `bindResponse` \res -> do
    res.status `shouldMatchInt` 200
    user <- res.json & asList >>= assertOne
    user %. "status" `shouldMatch` "active"
    user %. "email" `shouldMatch` email

testScimAndSamlWithRegisteredEmailDomain :: (HasCallStack) => App ()
testScimAndSamlWithRegisteredEmailDomain = do
  (owner, tid, _) <- createTeam OwnDomain 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 = "user@" <> emailDomain
      extId = email
  scimUser <- randomScimUserWithEmail extId email
  uid <- bindResponse (createScimUser owner tok scimUser) $ \resp -> do
    resp.status `shouldMatchInt` 201
    resp.json %. "id" >>= asString
  void $ loginWithSamlEmail True tid email (idpId, idpMeta)

  getUsersId OwnDomain [uid] `bindResponse` \res -> do
    res.status `shouldMatchInt` 200
    user <- res.json & asList >>= assertOne
    user %. "status" `shouldMatch` "active"
    user %. "email" `shouldMatch` email

  getUsersByEmail OwnDomain [email] `bindResponse` \res -> do
    res.status `shouldMatchInt` 200
    user <- res.json & asList >>= assertOne
    user %. "status" `shouldMatch` "active"
    user %. "email" `shouldMatch` email

testVerificationRequiredIfEmailDomainRedirectNotSso :: (HasCallStack) => App ()
testVerificationRequiredIfEmailDomainRedirectNotSso = do
  (owner, tid, _) <- createTeam OwnDomain 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 = "user@" <> emailDomain
  (Just uid, _) <- loginWithSamlEmail True tid email (idpId, idpMeta)

  getUsersId OwnDomain [uid] `bindResponse` \res -> do
    res.status `shouldMatchInt` 200
    user <- res.json & asList >>= assertOne
    user %. "status" `shouldMatch` "active"
    lookupField user "email" `shouldMatch` (Nothing :: Maybe String)

  getUsersByEmail OwnDomain [email] `bindResponse` \res -> do
    res.status `shouldMatchInt` 200
    res.json & asList >>= shouldBeEmpty

  activateEmail OwnDomain email
  getUsersId OwnDomain [uid] `bindResponse` \res -> do
    res.status `shouldMatchInt` 200
    user <- res.json & asList >>= assertOne
    user %. "status" `shouldMatch` "active"
    user %. "email" `shouldMatch` email

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

  domainRegistrationPreAuthorize OwnDomain domain >>= assertStatus 204

  setup <- setupOwnershipTokenForBackend OwnDomain domain
  let ownershipToken = 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
