{-# 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.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
  (owner, team, []) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
0
  email <- owner %. "email"
  setTeamFeatureLockStatus owner team "sndFactorPasswordChallenge" "unlocked"
  assertSuccess =<< setTeamFeatureStatus owner team "sndFactorPasswordChallenge" "enabled"
  generateVerificationCode owner email
  code <- getVerificationCode owner "login" >>= getJSON 200 >>= asString
  bindResponse (loginWith2ndFactor owner email defPassword code) $ \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
  (owner, team, []) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
0
  email <- owner %. "email"
  setTeamFeatureLockStatus owner team "sndFactorPasswordChallenge" "unlocked"
  assertSuccess =<< setTeamFeatureStatus owner team "sndFactorPasswordChallenge" "enabled"
  generateVerificationCode owner email
  correctCode <- getVerificationCode owner "login" >>= getJSON 200 >>= asString
  let wrongCode :: String = printf "%06d" $ (read @Int correctCode) + 1 `mod` 1000000
  bindResponse (loginWith2ndFactor owner email defPassword 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"

-- @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
  (owner, team, []) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
0
  email <- owner %. "email"
  setTeamFeatureLockStatus owner team "sndFactorPasswordChallenge" "unlocked"
  assertSuccess =<< setTeamFeatureStatus owner team "sndFactorPasswordChallenge" "enabled"
  bindResponse (login owner email defPassword) $ \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
      (owner, team, []) <- String -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam String
domain Int
0
      email <- owner %. "email"
      setTeamFeatureLockStatus owner team "sndFactorPasswordChallenge" "unlocked"
      assertSuccess =<< setTeamFeatureStatus owner team "sndFactorPasswordChallenge" "enabled"
      bindResponse (getTeamFeature owner team "sndFactorPasswordChallenge") $ \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"
      generateVerificationCode owner email
      code <- bindResponse (getVerificationCode owner "login") $ \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
      liftIO $ threadDelay 2_000_100
      bindResponse (loginWith2ndFactor owner email defPassword 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
  (owner, team, []) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
0
  email <- owner %. "email"
  setTeamFeatureLockStatus owner team "sndFactorPasswordChallenge" "unlocked"
  assertSuccess =<< setTeamFeatureStatus owner team "sndFactorPasswordChallenge" "enabled"
  generateVerificationCode owner email
  fstCode <- getVerificationCode owner "login" >>= getJSON 200 >>= asString
  bindResponse (generateVerificationCode' owner email) $ \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
429
  mostRecentCode <- retryT $ do
    resp <- generateVerificationCode' owner email
    resp.status `shouldMatchInt` 200
    getVerificationCode owner "login" >>= getJSON 200 >>= asString

  bindResponse (loginWith2ndFactor owner email defPassword 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"

  bindResponse (loginWith2ndFactor owner email defPassword 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
  (owner, team, []) <- Domain -> Int -> App (Value, String, [Value])
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> Int -> App (Value, String, [Value])
createTeam Domain
OwnDomain Int
0
  email <- owner %. "email"
  setTeamFeatureLockStatus owner team "sndFactorPasswordChallenge" "unlocked"
  assertSuccess =<< setTeamFeatureStatus owner team "sndFactorPasswordChallenge" "enabled"
  generateVerificationCode owner email
  correctCode <- getVerificationCode owner "login" >>= getJSON 200 >>= asString
  let wrongCode :: String = printf "%06d" $ (read @Int correctCode) + 1 `mod` 1000000
  -- try login with wrong code should fail 3 times
  forM_ [1 .. 3] $ \(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
  bindResponse (loginWith2ndFactor owner email defPassword 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"