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

module Test.Login where

import API.BrigInternal (getVerificationCode)
import API.Common (defPassword)
import API.GalleyInternal
import API.Nginz (login, loginWith2ndFactor)
import Control.Concurrent (threadDelay)
import qualified Data.Aeson as Aeson
import SetupHelpers
import Testlib.Prelude
import Text.Printf (printf)

testLoginVerify6DigitEmailCodeSuccess :: (HasCallStack) => App ()
testLoginVerify6DigitEmailCodeSuccess :: HasCallStack => App ()
testLoginVerify6DigitEmailCodeSuccess = do
  (Value
owner, String
team, []) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
0
  Value
email <- Value
owner Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"email"
  Value -> String -> String -> String -> App ()
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App ()
setTeamFeatureLockStatus Value
owner String
team String
"sndFactorPasswordChallenge" String
"unlocked"
  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 -> String -> String -> String -> App Response
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App Response
setTeamFeatureStatus Value
owner String
team String
"sndFactorPasswordChallenge" String
"enabled"
  Value -> Value -> App ()
forall domain email.
(HasCallStack, MakesValue domain, MakesValue email) =>
domain -> email -> App ()
generateVerificationCode Value
owner Value
email
  String
code <- Value -> String -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> String -> App Response
getVerificationCode Value
owner String
"login" 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 -> (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 Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> Value -> String -> String -> App Response
forall domain email password sndFactor.
(HasCallStack, MakesValue domain, MakesValue email,
 MakesValue password, MakesValue sndFactor) =>
domain -> email -> password -> sndFactor -> App Response
loginWith2ndFactor Value
owner Value
email String
defPassword String
code) ((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

-- @SF.Channel @TSFI.RESTfulAPI @S2
--
-- Test that login fails with wrong second factor email verification code
testLoginVerify6DigitWrongCodeFails :: (HasCallStack) => App ()
testLoginVerify6DigitWrongCodeFails :: HasCallStack => App ()
testLoginVerify6DigitWrongCodeFails = do
  (Value
owner, String
team, []) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
0
  Value
email <- Value
owner Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"email"
  Value -> String -> String -> String -> App ()
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App ()
setTeamFeatureLockStatus Value
owner String
team String
"sndFactorPasswordChallenge" String
"unlocked"
  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 -> String -> String -> String -> App Response
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App Response
setTeamFeatureStatus Value
owner String
team String
"sndFactorPasswordChallenge" String
"enabled"
  Value -> Value -> App ()
forall domain email.
(HasCallStack, MakesValue domain, MakesValue email) =>
domain -> email -> App ()
generateVerificationCode Value
owner Value
email
  String
correctCode <- Value -> String -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> String -> App Response
getVerificationCode Value
owner String
"login" 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 -> (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
  let String
wrongCode :: String = String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"%06d" (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ (forall a. Read a => String -> a
read @Int String
correctCode) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
1000000
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> Value -> String -> String -> App Response
forall domain email password sndFactor.
(HasCallStack, MakesValue domain, MakesValue email,
 MakesValue password, MakesValue sndFactor) =>
domain -> email -> password -> sndFactor -> App Response
loginWith2ndFactor Value
owner Value
email String
defPassword String
wrongCode) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
403
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"label" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"code-authentication-failed"

-- @END

-- @SF.Channel @TSFI.RESTfulAPI @S2
--
-- Test that login without verification code fails if SndFactorPasswordChallenge feature is enabled in team
testLoginVerify6DigitMissingCodeFails :: (HasCallStack) => App ()
testLoginVerify6DigitMissingCodeFails :: HasCallStack => App ()
testLoginVerify6DigitMissingCodeFails = do
  (Value
owner, String
team, []) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
0
  Value
email <- Value
owner Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"email"
  Value -> String -> String -> String -> App ()
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App ()
setTeamFeatureLockStatus Value
owner String
team String
"sndFactorPasswordChallenge" String
"unlocked"
  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 -> String -> String -> String -> App Response
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App Response
setTeamFeatureStatus Value
owner String
team String
"sndFactorPasswordChallenge" String
"enabled"
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> Value -> String -> App Response
forall domain email password.
(HasCallStack, MakesValue domain, MakesValue email,
 MakesValue password) =>
domain -> email -> password -> App Response
login Value
owner Value
email String
defPassword) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
403
    Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"label" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"code-authentication-required"

-- @END

-- @SF.Channel @TSFI.RESTfulAPI @S2
--
-- Test that login fails with expired second factor email verification code
testLoginVerify6DigitExpiredCodeFails :: (HasCallStack) => App ()
testLoginVerify6DigitExpiredCodeFails :: HasCallStack => App ()
testLoginVerify6DigitExpiredCodeFails = do
  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.setVerificationTimeout" (Aeson.Number 2)})
    ((HasCallStack => String -> App ()) -> App ())
-> (HasCallStack => String -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \String
domain -> do
      (Value
owner, String
team, []) <- String -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam String
domain Int
0
      Value
email <- Value
owner Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"email"
      Value -> String -> String -> String -> App ()
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App ()
setTeamFeatureLockStatus Value
owner String
team String
"sndFactorPasswordChallenge" String
"unlocked"
      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 -> String -> String -> String -> App Response
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App Response
setTeamFeatureStatus Value
owner String
team String
"sndFactorPasswordChallenge" String
"enabled"
      App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> String -> String -> App Response
forall domain_.
(HasCallStack, MakesValue domain_) =>
domain_ -> String -> String -> App Response
getTeamFeature Value
owner String
team String
"sndFactorPasswordChallenge") ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
        Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
        Response
resp.json App Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"status" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"enabled"
      Value -> Value -> App ()
forall domain email.
(HasCallStack, MakesValue domain, MakesValue email) =>
domain -> email -> App ()
generateVerificationCode Value
owner Value
email
      String
code <- App Response -> (Response -> App String) -> App String
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> String -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> String -> App Response
getVerificationCode Value
owner String
"login") ((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
        App Value -> App String
forall a. (HasCallStack, MakesValue a) => a -> App String
asString Response
resp.json
      IO () -> App ()
forall a. IO a -> App a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> App ()) -> IO () -> App ()
forall a b. (a -> b) -> a -> b
$ Int -> IO ()
threadDelay Int
2_000_100
      App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> Value -> String -> String -> App Response
forall domain email password sndFactor.
(HasCallStack, MakesValue domain, MakesValue email,
 MakesValue password, MakesValue sndFactor) =>
domain -> email -> password -> sndFactor -> App Response
loginWith2ndFactor Value
owner Value
email String
defPassword String
code) \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
"code-authentication-failed"

-- @END

testLoginVerify6DigitResendCodeSuccessAndRateLimiting :: (HasCallStack) => App ()
testLoginVerify6DigitResendCodeSuccessAndRateLimiting :: HasCallStack => App ()
testLoginVerify6DigitResendCodeSuccessAndRateLimiting = do
  (Value
owner, String
team, []) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
0
  Value
email <- Value
owner Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"email"
  Value -> String -> String -> String -> App ()
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App ()
setTeamFeatureLockStatus Value
owner String
team String
"sndFactorPasswordChallenge" String
"unlocked"
  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 -> String -> String -> String -> App Response
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App Response
setTeamFeatureStatus Value
owner String
team String
"sndFactorPasswordChallenge" String
"enabled"
  Value -> Value -> App ()
forall domain email.
(HasCallStack, MakesValue domain, MakesValue email) =>
domain -> email -> App ()
generateVerificationCode Value
owner Value
email
  String
fstCode <- Value -> String -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> String -> App Response
getVerificationCode Value
owner String
"login" 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 -> (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 Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> Value -> App Response
forall domain email.
(HasCallStack, MakesValue domain, MakesValue email) =>
domain -> email -> App Response
generateVerificationCode' Value
owner Value
email) ((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
429
  String
mostRecentCode <- App String -> App String
forall a. App a -> App a
retryT (App String -> App String) -> App String -> App String
forall a b. (a -> b) -> a -> b
$ do
    Response
resp <- Value -> Value -> App Response
forall domain email.
(HasCallStack, MakesValue domain, MakesValue email) =>
domain -> email -> App Response
generateVerificationCode' Value
owner Value
email
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    Value -> String -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> String -> App Response
getVerificationCode Value
owner String
"login" 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 -> (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 Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> Value -> String -> String -> App Response
forall domain email password sndFactor.
(HasCallStack, MakesValue domain, MakesValue email,
 MakesValue password, MakesValue sndFactor) =>
domain -> email -> password -> sndFactor -> App Response
loginWith2ndFactor Value
owner Value
email String
defPassword String
fstCode) \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
"code-authentication-failed"

  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> Value -> String -> String -> App Response
forall domain email password sndFactor.
(HasCallStack, MakesValue domain, MakesValue email,
 MakesValue password, MakesValue sndFactor) =>
domain -> email -> password -> sndFactor -> App Response
loginWith2ndFactor Value
owner Value
email String
defPassword String
mostRecentCode) \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200

testLoginVerify6DigitLimitRetries :: (HasCallStack) => App ()
testLoginVerify6DigitLimitRetries :: HasCallStack => App ()
testLoginVerify6DigitLimitRetries = do
  (Value
owner, String
team, []) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
0
  Value
email <- Value
owner Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"email"
  Value -> String -> String -> String -> App ()
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App ()
setTeamFeatureLockStatus Value
owner String
team String
"sndFactorPasswordChallenge" String
"unlocked"
  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 -> String -> String -> String -> App Response
forall domain team.
(HasCallStack, MakesValue domain, MakesValue team) =>
domain -> team -> String -> String -> App Response
setTeamFeatureStatus Value
owner String
team String
"sndFactorPasswordChallenge" String
"enabled"
  Value -> Value -> App ()
forall domain email.
(HasCallStack, MakesValue domain, MakesValue email) =>
domain -> email -> App ()
generateVerificationCode Value
owner Value
email
  String
correctCode <- Value -> String -> App Response
forall user.
(HasCallStack, MakesValue user) =>
user -> String -> App Response
getVerificationCode Value
owner String
"login" 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 -> (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
  let String
wrongCode :: String = String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"%06d" (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ (forall a. Read a => String -> a
read @Int String
correctCode) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
1000000
  -- try login with wrong code should fail 3 times
  [Int] -> (Int -> App ()) -> App ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
1 .. Int
3] ((Int -> App ()) -> App ()) -> (Int -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \(Int
_ :: Int) -> do
    App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> Value -> String -> String -> App Response
forall domain email password sndFactor.
(HasCallStack, MakesValue domain, MakesValue email,
 MakesValue password, MakesValue sndFactor) =>
domain -> email -> password -> sndFactor -> App Response
loginWith2ndFactor Value
owner Value
email String
defPassword String
wrongCode) \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
"code-authentication-failed"
  -- after 3 failed attempts, login with correct code should fail as well
  App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> Value -> String -> String -> App Response
forall domain email password sndFactor.
(HasCallStack, MakesValue domain, MakesValue email,
 MakesValue password, MakesValue sndFactor) =>
domain -> email -> password -> sndFactor -> App Response
loginWith2ndFactor Value
owner Value
email String
defPassword String
correctCode) \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
"code-authentication-failed"