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

-- This file is part of the Wire Server implementation.
--
-- Copyright (C) 2025 Wire Swiss GmbH <opensource@wire.com>
--
-- This program is free software: you can redistribute it and/or modify it under
-- the terms of the GNU Affero General Public License as published by the Free
-- Software Foundation, either version 3 of the License, or (at your option) any
-- later version.
--
-- This program is distributed in the hope that it will be useful, but WITHOUT
-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more
-- details.
--
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see <https://www.gnu.org/licenses/>.

module Test.Register where

import API.Brig
import API.BrigInternal
import API.Common
import API.GalleyInternal (setTeamFeatureLockStatus, setTeamFeatureStatus)
import SetupHelpers
import Testlib.Prelude

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

  -- [customer admin] post no-registration config
  Domain
-> Versioned -> String -> Maybe String -> Value -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain
-> Versioned -> String -> Maybe String -> Value -> App Response
updateDomainRedirect
    Domain
OwnDomain
    Versioned
version
    String
domain
    (String -> Maybe String
forall a. a -> Maybe a
Just DomainRegistrationSetup
setup.ownershipToken)
    (Versioned -> String -> String -> Value
mkDomainRedirectBackend Versioned
version String
"https://example.com" String
"https://webapp.example.com")
    App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
200

  let email :: String
email = String
"user@" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
domain
  Domain -> AddUser -> App Response
forall dom.
(HasCallStack, MakesValue dom) =>
dom -> AddUser -> App Response
addUser Domain
OwnDomain AddUser
forall a. Default a => a
def {email = Just email} App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
403
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"label" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"condition-failed"

testDisallowRegistrationWhenEmailDomainDoesNotAllowRegistration :: (HasCallStack) => App ()
testDisallowRegistrationWhenEmailDomainDoesNotAllowRegistration :: HasCallStack => App ()
testDisallowRegistrationWhenEmailDomainDoesNotAllowRegistration = [Versioned] -> (Versioned -> App ()) -> App ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int -> Versioned
ExplicitVersion Int
8, Versioned
Versioned] \Versioned
version -> do
  String
domain <- App String
randomDomain

  -- [backoffice] preauth
  Domain -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> App Response
domainRegistrationPreAuthorize Domain
OwnDomain String
domain App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
204
  DomainRegistrationSetup
setup <- Domain -> String -> App DomainRegistrationSetup
forall domain.
(MakesValue domain, HasCallStack) =>
domain -> String -> App DomainRegistrationSetup
setupOwnershipTokenForBackend Domain
OwnDomain String
domain

  -- [customer admin] post no-registration config
  Domain
-> Versioned -> String -> Maybe String -> Value -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain
-> Versioned -> String -> Maybe String -> Value -> App Response
updateDomainRedirect
    Domain
OwnDomain
    Versioned
version
    String
domain
    (String -> Maybe String
forall a. a -> Maybe a
Just DomainRegistrationSetup
setup.ownershipToken)
    ([Pair] -> Value
object [String
"domain_redirect" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"no-registration"])
    App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
200

  let email :: String
email = String
"user@" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
domain
  Domain -> AddUser -> App Response
forall dom.
(HasCallStack, MakesValue dom) =>
dom -> AddUser -> App Response
addUser Domain
OwnDomain AddUser
forall a. Default a => a
def {email = Just email} App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
403
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"label" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"condition-failed"

  Domain -> AddUser -> App Response
forall dom.
(HasCallStack, MakesValue dom) =>
dom -> AddUser -> App Response
addUser Domain
OwnDomain AddUser
forall a. Default a => a
def {email = Just email, newTeamName = Just "new test team"} App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
403
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"label" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"condition-failed"

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

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

  String
domain <- App String
randomDomain
  DomainRegistrationSetup
setup <- Value -> String -> App DomainRegistrationSetup
forall domain.
(MakesValue domain, HasCallStack) =>
domain -> String -> App DomainRegistrationSetup
setupOwnershipTokenForTeam Value
owner String
domain
  Value -> String -> String -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> String -> String -> App Response
authorizeTeam Value
owner String
domain DomainRegistrationSetup
setup.ownershipToken App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
200

  -- [customer admin] post no-registration config
  Value -> String -> Value -> App Response
forall user payload.
(HasCallStack, MakesValue user, MakesValue payload) =>
user -> String -> payload -> App Response
updateTeamInvite
    Value
owner
    String
domain
    ([Pair] -> Value
object [String
"team_invite" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"team", String
"team" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
tid])
    App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
200

  let email :: String
email = String
"user@" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
domain
  Domain -> AddUser -> App Response
forall dom.
(HasCallStack, MakesValue dom) =>
dom -> AddUser -> App Response
addUser Domain
OwnDomain AddUser
forall a. Default a => a
def {email = Just email} App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Response -> App ()
Response -> App ()
assertSuccess

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

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

  String
domain <- App String
randomDomain
  DomainRegistrationSetup
setup <- Value -> String -> App DomainRegistrationSetup
forall domain.
(MakesValue domain, HasCallStack) =>
domain -> String -> App DomainRegistrationSetup
setupOwnershipTokenForTeam Value
owner String
domain
  Value -> String -> String -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> String -> String -> App Response
authorizeTeam Value
owner String
domain DomainRegistrationSetup
setup.ownershipToken App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
200

  App Response -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App Response -> App ()) -> App Response -> App ()
forall a b. (a -> b) -> a -> b
$ Value -> String -> String -> String -> App Response
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App Response
setTeamFeatureStatus Value
owner String
tid String
"sso" String
"enabled"
  (Response
idp, (IdPMetadata, SignPrivCreds)
idpMeta) <- Value -> App (Response, (IdPMetadata, SignPrivCreds))
forall owner.
(HasCallStack, MakesValue owner) =>
owner -> App (Response, (IdPMetadata, SignPrivCreds))
registerTestIdPWithMetaWithPrivateCreds Value
owner
  String
idpId <- App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString (App Value -> App String) -> App Value -> App String
forall a b. (a -> b) -> a -> b
$ Response
idp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id"

  Value -> String -> Value -> App Response
forall user payload.
(HasCallStack, MakesValue user, MakesValue payload) =>
user -> String -> payload -> App Response
updateTeamInvite Value
owner String
domain ([Pair] -> Value
object [String
"team_invite" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"not-allowed", String
"sso" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
idpId])
    App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
200

  let email :: String
email = String
"user@" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
domain
  Domain -> AddUser -> App Response
forall dom.
(HasCallStack, MakesValue dom) =>
dom -> AddUser -> App Response
addUser Domain
OwnDomain AddUser
forall a. Default a => a
def {email = Just email} App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
403
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"label" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"condition-failed"

  -- Registering with SSO works
  App (Maybe String, SignedAuthnResponse) -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App (Maybe String, SignedAuthnResponse) -> App ())
-> App (Maybe String, SignedAuthnResponse) -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack =>
Bool
-> String
-> String
-> (String, (IdPMetadata, SignPrivCreds))
-> App (Maybe String, SignedAuthnResponse)
Bool
-> String
-> String
-> (String, (IdPMetadata, SignPrivCreds))
-> App (Maybe String, SignedAuthnResponse)
loginWithSamlEmail Bool
True String
tid (String
"sso@" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
domain) (String
idpId, (IdPMetadata, SignPrivCreds)
idpMeta)

  (Value
owner2, String
_, [Value]
_) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1

  -- TODO: Do we have to block SSO and SCIM regsitrations for other teams here?

  -- Inviting a user to another team doesn't work
  Value -> PostInvitation -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> PostInvitation -> App Response
postInvitation Value
owner2 PostInvitation
forall a. Default a => a
def {email = Just email} App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
403
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"label" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"condition-failed"

  -- Inviting a user to the same team also doesn't work
  Value -> PostInvitation -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> PostInvitation -> App Response
postInvitation Value
owner PostInvitation
forall a. Default a => a
def {email = Just email} App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
403
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"label" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"condition-failed"

  Value -> String -> Value -> App Response
forall user payload.
(HasCallStack, MakesValue user, MakesValue payload) =>
user -> String -> payload -> App Response
updateTeamInvite Value
owner String
domain ([Pair] -> Value
object [String
"team_invite" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"allowed", String
"sso" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
idpId])
    App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
200

  -- Now invitation to any teams works
  Value
invitationToTeam2 <- Value -> PostInvitation -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> PostInvitation -> App Response
postInvitation Value
owner2 PostInvitation
forall a. Default a => a
def {email = Just email} App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
201
  String
invitationCodeToTeam2 <- (Value -> Value -> App Response
forall user inv.
(HasCallStack, MakesValue user, MakesValue inv) =>
user -> inv -> App Response
getInvitationCode Value
owner2 Value
invitationToTeam2 App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
200) App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"code" 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
  HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
    (Response -> App ()) -> App Response -> App ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> AddUser -> App Response
forall dom.
(HasCallStack, MakesValue dom) =>
dom -> AddUser -> App Response
addUser
      Value
owner2
      AddUser
forall a. Default a => a
def
        { email = Just email,
          teamCode = Just invitationCodeToTeam2
        }

  let email2 :: String
email2 = String
"user2@" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
domain
  Value
invitationToOrigTeam <- Value -> PostInvitation -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> PostInvitation -> App Response
postInvitation Value
owner PostInvitation
forall a. Default a => a
def {email = Just email2} App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
201
  String
invitationCodeToOrigTeam <- (Value -> Value -> App Response
forall user inv.
(HasCallStack, MakesValue user, MakesValue inv) =>
user -> inv -> App Response
getInvitationCode Value
owner Value
invitationToOrigTeam App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
200) App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"code" 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
  HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
    (Response -> App ()) -> App Response -> App ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> AddUser -> App Response
forall dom.
(HasCallStack, MakesValue dom) =>
dom -> AddUser -> App Response
addUser
      Value
owner
      AddUser
forall a. Default a => a
def
        { email = Just email2,
          teamCode = Just invitationCodeToOrigTeam
        }

  Value -> String -> Value -> App Response
forall user payload.
(HasCallStack, MakesValue user, MakesValue payload) =>
user -> String -> payload -> App Response
updateTeamInvite Value
owner String
domain ([Pair] -> Value
object [String
"team_invite" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"team", String
"sso" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
idpId, String
"team" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
tid])
    App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
200

  -- Now invitaions only work for the orig team
  let email3 :: String
email3 = String
"user3@" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
domain
  Value -> PostInvitation -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> PostInvitation -> App Response
postInvitation Value
owner2 PostInvitation
forall a. Default a => a
def {email = Just email3} App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
403
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"label" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"condition-failed"

  Value
invitation2ToOrigTeam <- Value -> PostInvitation -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> PostInvitation -> App Response
postInvitation Value
owner PostInvitation
forall a. Default a => a
def {email = Just email3} App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
201
  String
invitation2CodeToOrigTeam <- (Value -> Value -> App Response
forall user inv.
(HasCallStack, MakesValue user, MakesValue inv) =>
user -> inv -> App Response
getInvitationCode Value
owner Value
invitation2ToOrigTeam App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
200) App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"code" 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
  HasCallStack => Response -> App ()
Response -> App ()
assertSuccess
    (Response -> App ()) -> App Response -> App ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> AddUser -> App Response
forall dom.
(HasCallStack, MakesValue dom) =>
dom -> AddUser -> App Response
addUser
      Value
owner
      AddUser
forall a. Default a => a
def
        { email = Just email3,
          teamCode = Just invitation2CodeToOrigTeam
        }

testDisallowAcceptingInvitesAfterDomainIsClaimed :: (HasCallStack) => App ()
testDisallowAcceptingInvitesAfterDomainIsClaimed :: HasCallStack => App ()
testDisallowAcceptingInvitesAfterDomainIsClaimed = [Versioned] -> (Versioned -> App ()) -> App ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int -> Versioned
ExplicitVersion Int
8, Versioned
Versioned] \Versioned
version -> do
  String
domain <- App String
randomDomain
  (Value
owner, String
_, [Value]
_) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
1
  let email :: String
email = String
"user@" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
domain
  Value
invitation <- Value -> PostInvitation -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> PostInvitation -> App Response
postInvitation Value
owner PostInvitation
forall a. Default a => a
def {email = Just email} App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
201
  String
invitationCode <- (Value -> Value -> App Response
forall user inv.
(HasCallStack, MakesValue user, MakesValue inv) =>
user -> inv -> App Response
getInvitationCode Value
owner Value
invitation App Response -> (Response -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App Value
Int -> Response -> App Value
getJSON Int
200) App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"code" 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

  -- [backoffice] preauth
  Domain -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> App Response
domainRegistrationPreAuthorize Domain
OwnDomain String
domain App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
204
  DomainRegistrationSetup
setup <- Domain -> String -> App DomainRegistrationSetup
forall domain.
(MakesValue domain, HasCallStack) =>
domain -> String -> App DomainRegistrationSetup
setupOwnershipTokenForBackend Domain
OwnDomain String
domain

  -- [customer admin] post no-registration config
  Domain
-> Versioned -> String -> Maybe String -> Value -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain
-> Versioned -> String -> Maybe String -> Value -> App Response
updateDomainRedirect
    Domain
OwnDomain
    Versioned
version
    String
domain
    (String -> Maybe String
forall a. a -> Maybe a
Just DomainRegistrationSetup
setup.ownershipToken)
    (Versioned -> String -> String -> Value
mkDomainRedirectBackend Versioned
version String
"https:/example.com" String
"https://webapp.example.com")
    App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
200

  Value -> AddUser -> App Response
forall dom.
(HasCallStack, MakesValue dom) =>
dom -> AddUser -> App Response
addUser Value
owner AddUser
forall a. Default a => a
def {email = Just email, teamCode = Just invitationCode} App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
403
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"label" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"condition-failed"