module Test.Migration.DomainRegistration (testDomainRegistrationMigration) where

import qualified API.Brig as Brig
import qualified API.BrigInternal as BrigInternal
import API.Common
import qualified API.GalleyInternal as GalleyInternal
import Control.Error (MaybeT (..))
import Control.Monad.Codensity
import Control.Monad.Reader
import SetupHelpers
import Test.DNSMock
import Test.Migration.Util (waitForMigration)
import Testlib.Prelude
import Testlib.ResourcePool

data DomainRegistrationTestCase = TeamFlow TeamStep | OnPremFlow OnPremStep

type EmailDomain = String

type AuthToken = String

type TeamId = String

type Owner = Value

type Config = Value

type OwnershipToken = String

data OnPremStep
  = PreAuthorization EmailDomain
  | SetupChallenge EmailDomain
  | VerifyDomain EmailDomain ChallengeSetup
  | PostConfig EmailDomain AuthToken Config
  | OnPremVerify EmailDomain Config
  | OnPremSuccess EmailDomain Config

data TeamStep
  = TeamSetupChallenge (Owner, TeamId) EmailDomain
  | TeamVerifyDomain (Owner, TeamId) EmailDomain ChallengeSetup
  | TeamAuthorizeTeam (Owner, TeamId) EmailDomain OwnershipToken
  | TeamUpdateConfig (Owner, TeamId) EmailDomain
  | TeamSuccess (Owner, TeamId) EmailDomain

testDomainRegistrationMigration :: (HasCallStack) => App ()
testDomainRegistrationMigration :: HasCallStack => App ()
testDomainRegistrationMigration = do
  resourcePool <- (Env -> ResourcePool BackendResource)
-> App (ResourcePool BackendResource)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (.resourcePool)
  runCodensity (acquireResources 1 resourcePool) $ \[BackendResource
backend] -> do
    let domain :: String
domain = BackendResource
backend.berDomain
    let initTestCases :: App [DomainRegistrationTestCase]
initTestCases = do
          [t1, t2, t3, t4] <- Int
-> App DomainRegistrationTestCase
-> App [DomainRegistrationTestCase]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
4 (App DomainRegistrationTestCase
 -> App [DomainRegistrationTestCase])
-> App DomainRegistrationTestCase
-> App [DomainRegistrationTestCase]
forall a b. (a -> b) -> a -> b
$ OnPremStep -> DomainRegistrationTestCase
OnPremFlow (OnPremStep -> DomainRegistrationTestCase)
-> (String -> OnPremStep) -> String -> DomainRegistrationTestCase
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> OnPremStep
PreAuthorization (String -> DomainRegistrationTestCase)
-> App String -> App DomainRegistrationTestCase
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> App String
randomDomain
          [t5, t6, t7, t8] <- replicateM 4 $ do
            (owner, tid, _) <- createTeam domain 1
            GalleyInternal.setTeamFeatureLockStatus owner tid "domainRegistration" "unlocked"
            GalleyInternal.setTeamFeatureStatus owner tid "domainRegistration" "enabled" >>= assertSuccess
            TeamFlow . TeamSetupChallenge (owner, tid) <$> randomDomain

          sequence
            [ pure t1,
              runStep domain t2,
              runStep domain t3 >>= runStep domain,
              runStep domain t4 >>= runStep domain >>= runStep domain,
              pure t5,
              runStep domain t6,
              runStep domain t7 >>= runStep domain,
              runStep domain t8 >>= runStep domain >>= runStep domain
            ]

    testCases1 <- Codensity App String -> forall b. (String -> App b) -> App b
forall k (m :: k -> *) a.
Codensity m a -> forall (b :: k). (a -> m b) -> m b
runCodensity (HasCallStack =>
BackendResource -> ServiceOverrides -> Codensity App String
BackendResource -> ServiceOverrides -> Codensity App String
startDynamicBackend BackendResource
backend (String -> Bool -> ServiceOverrides
conf String
"cassandra" Bool
False)) ((String -> App [DomainRegistrationTestCase])
 -> App [DomainRegistrationTestCase])
-> (App [DomainRegistrationTestCase]
    -> String -> App [DomainRegistrationTestCase])
-> App [DomainRegistrationTestCase]
-> App [DomainRegistrationTestCase]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. App [DomainRegistrationTestCase]
-> String -> App [DomainRegistrationTestCase]
forall a b. a -> b -> a
const (App [DomainRegistrationTestCase]
 -> App [DomainRegistrationTestCase])
-> App [DomainRegistrationTestCase]
-> App [DomainRegistrationTestCase]
forall a b. (a -> b) -> a -> b
$ do
      testCases0 <- App [DomainRegistrationTestCase]
initTestCases
      nextStepCases <- for testCases0 (runStep domain)
      newCases <- initTestCases
      pure $ nextStepCases <> newCases

    testCases2 <- runCodensity (startDynamicBackend backend (conf "migration-to-postgresql" False)) . const $ do
      nextStepCases <- for testCases1 (runStep domain)
      newCases <- initTestCases
      pure $ nextStepCases <> newCases

    testCases3 <- runCodensity (startDynamicBackend backend (conf "migration-to-postgresql" True)) . const $ do
      nextStepCases <- for testCases2 (runStep domain)
      newCases <- initTestCases
      waitForMigration domain counterName

      nextStepCases' <- for (nextStepCases <> newCases) (runStep domain)
      newCases' <- initTestCases
      pure $ nextStepCases' <> newCases'

    runCodensity (startDynamicBackend backend (conf "postgresql" False)) . const $ do
      for_ testCases3 (runAll domain)
  where
    runStep :: (HasCallStack) => String -> DomainRegistrationTestCase -> App DomainRegistrationTestCase
    -- TEAM FLOW
    runStep :: HasCallStack =>
String
-> DomainRegistrationTestCase -> App DomainRegistrationTestCase
runStep String
domain (TeamFlow (TeamSetupChallenge (Value, String)
team String
emailDomain)) = do
      challenge <- String -> String -> App ChallengeSetup
forall domain.
(MakesValue domain, HasCallStack) =>
domain -> String -> App ChallengeSetup
setupChallenge String
domain String
emailDomain
      registerTechnitiumRecord challenge.technitiumToken emailDomain ("wire-domain." <> emailDomain) "TXT" challenge.dnsToken
      pure $ TeamFlow $ TeamVerifyDomain team emailDomain challenge
    runStep String
_ (TeamFlow (TeamVerifyDomain team :: (Value, String)
team@(Value
owner, String
_) String
emailDomain ChallengeSetup
challenge)) = do
      token <- App Response -> (Response -> App String) -> App String
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> String -> String -> String -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> String -> String -> String -> App Response
Brig.verifyDomainForTeam Value
owner String
emailDomain ChallengeSetup
challenge.challengeId ChallengeSetup
challenge.challengeToken) ((Response -> App String) -> App String)
-> (Response -> App String) -> App String
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
        Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
        Response
resp.json Maybe 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
      pure $ TeamFlow $ TeamAuthorizeTeam team emailDomain token
    runStep String
_ (TeamFlow (TeamAuthorizeTeam team :: (Value, String)
team@(Value
owner, String
_) String
emailDomain String
token)) = do
      Value -> String -> String -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> String -> String -> App Response
Brig.authorizeTeam Value
owner String
emailDomain String
token 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
      DomainRegistrationTestCase -> App DomainRegistrationTestCase
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DomainRegistrationTestCase -> App DomainRegistrationTestCase)
-> DomainRegistrationTestCase -> App DomainRegistrationTestCase
forall a b. (a -> b) -> a -> b
$ TeamStep -> DomainRegistrationTestCase
TeamFlow (TeamStep -> DomainRegistrationTestCase)
-> TeamStep -> DomainRegistrationTestCase
forall a b. (a -> b) -> a -> b
$ (Value, String) -> String -> TeamStep
TeamUpdateConfig (Value, String)
team String
emailDomain
    runStep String
domain (TeamFlow (TeamUpdateConfig team :: (Value, String)
team@(Value
owner, String
tid) String
emailDomain)) = do
      App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> String -> Value -> App Response
forall user payload.
(HasCallStack, MakesValue user, MakesValue payload) =>
user -> String -> payload -> App Response
Brig.updateTeamInvite Value
owner String
emailDomain ([Pair] -> Value
object [String
"team_invite" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"team", String
"team" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
tid])) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
res -> do
        Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
      HasCallStack => String -> String -> String -> App ()
String -> String -> String -> App ()
verifyTeamConfig String
domain String
tid String
emailDomain
      DomainRegistrationTestCase -> App DomainRegistrationTestCase
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DomainRegistrationTestCase -> App DomainRegistrationTestCase)
-> DomainRegistrationTestCase -> App DomainRegistrationTestCase
forall a b. (a -> b) -> a -> b
$ TeamStep -> DomainRegistrationTestCase
TeamFlow (TeamStep -> DomainRegistrationTestCase)
-> TeamStep -> DomainRegistrationTestCase
forall a b. (a -> b) -> a -> b
$ (Value, String) -> String -> TeamStep
TeamSuccess (Value, String)
team String
emailDomain
    runStep String
domain (TeamFlow (TeamSuccess team :: (Value, String)
team@(Value
_, String
tid) String
emailDomain)) = do
      HasCallStack => String -> String -> String -> App ()
String -> String -> String -> App ()
verifyTeamConfig String
domain String
tid String
emailDomain
      DomainRegistrationTestCase -> App DomainRegistrationTestCase
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DomainRegistrationTestCase -> App DomainRegistrationTestCase)
-> DomainRegistrationTestCase -> App DomainRegistrationTestCase
forall a b. (a -> b) -> a -> b
$ TeamStep -> DomainRegistrationTestCase
TeamFlow (TeamStep -> DomainRegistrationTestCase)
-> TeamStep -> DomainRegistrationTestCase
forall a b. (a -> b) -> a -> b
$ (Value, String) -> String -> TeamStep
TeamSuccess (Value, String)
team String
emailDomain
    -- ON PREM FLOW
    runStep String
domain (OnPremFlow (PreAuthorization String
emailDomain)) = do
      String -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> App Response
BrigInternal.domainRegistrationPreAuthorize String
domain String
emailDomain App Response -> (Response -> App ()) -> App ()
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
204
      DomainRegistrationTestCase -> App DomainRegistrationTestCase
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DomainRegistrationTestCase -> App DomainRegistrationTestCase)
-> DomainRegistrationTestCase -> App DomainRegistrationTestCase
forall a b. (a -> b) -> a -> b
$ OnPremStep -> DomainRegistrationTestCase
OnPremFlow (OnPremStep -> DomainRegistrationTestCase)
-> OnPremStep -> DomainRegistrationTestCase
forall a b. (a -> b) -> a -> b
$ String -> OnPremStep
SetupChallenge String
emailDomain
    runStep String
domain (OnPremFlow (SetupChallenge String
emailDomain)) = do
      challenge <- String -> String -> App ChallengeSetup
forall domain.
(MakesValue domain, HasCallStack) =>
domain -> String -> App ChallengeSetup
setupChallenge String
domain String
emailDomain
      registerTechnitiumRecord challenge.technitiumToken emailDomain ("wire-domain." <> emailDomain) "TXT" challenge.dnsToken
      pure $ OnPremFlow $ VerifyDomain emailDomain challenge
    runStep String
domain (OnPremFlow (VerifyDomain String
emailDomain ChallengeSetup
challenge)) = do
      App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (String -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> App Response
BrigInternal.getDomainRegistration String
domain String
emailDomain) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
res -> do
        Response
res.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
      token <- App Response -> (Response -> App String) -> App String
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (String -> String -> String -> String -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> String -> String -> String -> App Response
Brig.verifyDomain String
domain String
emailDomain ChallengeSetup
challenge.challengeId ChallengeSetup
challenge.challengeToken) ((Response -> App String) -> App String)
-> (Response -> App String) -> App String
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
        Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
        Response
resp.json Maybe 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
      let config = String -> String -> Value
mkDomainRedirectBackend String
"https://wire.example.com" String
"https://webapp.wire.example.com"
      pure $ OnPremFlow $ PostConfig emailDomain token config
    runStep String
domain (OnPremFlow (PostConfig String
emailDomain String
token Value
config)) = do
      String
-> Versioned -> String -> Maybe String -> Value -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain
-> Versioned -> String -> Maybe String -> Value -> App Response
Brig.updateDomainRedirect String
domain Versioned
Versioned String
emailDomain (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
      DomainRegistrationTestCase -> App DomainRegistrationTestCase
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DomainRegistrationTestCase -> App DomainRegistrationTestCase)
-> DomainRegistrationTestCase -> App DomainRegistrationTestCase
forall a b. (a -> b) -> a -> b
$ OnPremStep -> DomainRegistrationTestCase
OnPremFlow (String -> Value -> OnPremStep
OnPremVerify String
emailDomain Value
config)
    runStep String
domain (OnPremFlow (OnPremVerify String
emailDomain Value
config)) = do
      HasCallStack => String -> String -> Value -> App ()
String -> String -> Value -> App ()
verifyOnPremConfig String
domain String
emailDomain Value
config
      DomainRegistrationTestCase -> App DomainRegistrationTestCase
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DomainRegistrationTestCase -> App DomainRegistrationTestCase)
-> DomainRegistrationTestCase -> App DomainRegistrationTestCase
forall a b. (a -> b) -> a -> b
$ OnPremStep -> DomainRegistrationTestCase
OnPremFlow (OnPremStep -> DomainRegistrationTestCase)
-> OnPremStep -> DomainRegistrationTestCase
forall a b. (a -> b) -> a -> b
$ String -> Value -> OnPremStep
OnPremSuccess String
emailDomain Value
config
    runStep String
domain success :: DomainRegistrationTestCase
success@(OnPremFlow (OnPremSuccess String
emailDomain Value
config)) = do
      HasCallStack => String -> String -> Value -> App ()
String -> String -> Value -> App ()
verifyOnPremConfig String
domain String
emailDomain Value
config
      DomainRegistrationTestCase -> App DomainRegistrationTestCase
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DomainRegistrationTestCase
success

    verifyOnPremConfig :: (HasCallStack) => String -> String -> Value -> App ()
    verifyOnPremConfig :: HasCallStack => String -> String -> Value -> App ()
verifyOnPremConfig String
domain String
emailDomain Value
config =
      App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (String -> Versioned -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Versioned -> String -> App Response
Brig.getDomainRegistrationFromEmail String
domain Versioned
Versioned (String
"ruffy@" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
emailDomain)) \Response
resp -> do
        Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
        Response
resp.json Maybe 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")
        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"
        Maybe 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
        Maybe 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

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

      App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (String -> Versioned -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Versioned -> String -> App Response
Brig.getDomainRegistrationFromEmail String
domain Versioned
Versioned (String
"ruffy@" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
emailDomain)) \Response
resp -> do
        Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
        Response
resp.json Maybe 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"

    runAll :: (HasCallStack) => String -> DomainRegistrationTestCase -> App ()
    runAll :: HasCallStack => String -> DomainRegistrationTestCase -> App ()
runAll String
domain success :: DomainRegistrationTestCase
success@(OnPremFlow (OnPremSuccess String
_ Value
_)) = App DomainRegistrationTestCase -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App DomainRegistrationTestCase -> App ())
-> App DomainRegistrationTestCase -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack =>
String
-> DomainRegistrationTestCase -> App DomainRegistrationTestCase
String
-> DomainRegistrationTestCase -> App DomainRegistrationTestCase
runStep String
domain DomainRegistrationTestCase
success
    runAll String
domain success :: DomainRegistrationTestCase
success@(TeamFlow (TeamSuccess (Value, String)
_ String
_)) = App DomainRegistrationTestCase -> App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (App DomainRegistrationTestCase -> App ())
-> App DomainRegistrationTestCase -> App ()
forall a b. (a -> b) -> a -> b
$ HasCallStack =>
String
-> DomainRegistrationTestCase -> App DomainRegistrationTestCase
String
-> DomainRegistrationTestCase -> App DomainRegistrationTestCase
runStep String
domain DomainRegistrationTestCase
success
    runAll String
domain DomainRegistrationTestCase
inProgress = HasCallStack => String -> DomainRegistrationTestCase -> App ()
String -> DomainRegistrationTestCase -> App ()
runAll String
domain (DomainRegistrationTestCase -> App ())
-> App DomainRegistrationTestCase -> App ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< HasCallStack =>
String
-> DomainRegistrationTestCase -> App DomainRegistrationTestCase
String
-> DomainRegistrationTestCase -> App DomainRegistrationTestCase
runStep String
domain DomainRegistrationTestCase
inProgress

    mkDomainRedirectBackend :: String -> String -> Value
    mkDomainRedirectBackend :: String -> String -> Value
mkDomainRedirectBackend String
configUrl String
webappUrl =
      [Pair] -> Value
object
        [ String
"domain_redirect" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"backend",
          String
"backend" String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= [Pair] -> Value
object [String
"config_url" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
configUrl, String
"webapp_url" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
webappUrl]
        ]

    conf :: String -> Bool -> ServiceOverrides
    conf :: String -> Bool -> ServiceOverrides
conf String
db Bool
runMigration =
      ServiceOverrides
forall a. Default a => a
def
        { brigCfg = setField "postgresMigration.domainRegistration" db,
          backgroundWorkerCfg =
            setField "postgresMigration.domainRegistration" db
              >=> setField "migrateDomainRegistration" runMigration
        }

    counterName :: String
    counterName :: String
counterName = String
"^wire_domain_registration_migration_finished"