[chore] Port 2FA tests

changelog.d/5-internal/port-2fa-tests

@@ -0,0 +1 @@
+Ported 2FA tests to the new integration test suite

integration/integration.cabal

@@ -125,6 +125,7 @@ library
     Test.Federation
     Test.Federator
     Test.LegalHold
+    Test.Login
     Test.MessageTimer
     Test.MLS
     Test.MLS.KeyPackage

integration/test/API/BrigInternal.hs

@@ -253,3 +253,11 @@ getEJPDInfo dom handles mode = do
         "include_contacts" -> [("include_contacts", "true")]
         bad -> error $ show bad
   submit "POST" $ req & addJSONObject ["ejpd_request" .= handles] & addQueryParams query
+
+-- https://staging-nginz-https.zinfra.io/api-internal/swagger-ui/brig/#/brig/get_i_users__uid__verification_code__action_
+getVerificationCode :: (HasCallStack, MakesValue user) => user -> String -> App Response
+getVerificationCode user action = do
+  uid <- objId user
+  domain <- objDomain user
+  req <- baseRequest domain Brig Unversioned $ joinHttpPath ["i", "users", uid, "verification-code", action]
+  submit "GET" req

integration/test/API/GalleyInternal.hs

@@ -44,6 +44,13 @@ setTeamFeatureStatus domain team featureName status = do
   res <- submit "PATCH" $ req & addJSONObject ["status" .= status]
   res.status `shouldMatchInt` 200
 
+setTeamFeatureLockStatus :: (HasCallStack, MakesValue domain, MakesValue team) => domain -> team -> String -> String -> App ()
+setTeamFeatureLockStatus domain team featureName status = do
+  tid <- asString team
+  req <- baseRequest domain Galley Unversioned $ joinHttpPath ["i", "teams", tid, "features", featureName, status]
+  res <- submit "PUT" $ req
+  res.status `shouldMatchInt` 200
+
 getFederationStatus ::
   ( HasCallStack,
     MakesValue user
@@ -79,3 +86,14 @@ legalholdIsEnabled tid uid = do
   tidStr <- asString tid
   baseRequest uid Galley Unversioned do joinHttpPath ["i", "teams", tidStr, "features", "legalhold"]
     >>= submit "GET"
+
+generateVerificationCode :: (HasCallStack, MakesValue domain, MakesValue email) => domain -> email -> App ()
+generateVerificationCode domain email = do
+  res <- generateVerificationCode' domain email
+  res.status `shouldMatchInt` 200
+
+generateVerificationCode' :: (HasCallStack, MakesValue domain, MakesValue email) => domain -> email -> App Response
+generateVerificationCode' domain email = do
+  req <- baseRequest domain Brig Versioned "/verification-code/send"
+  emailStr <- asString email
+  submit "POST" $ req & addJSONObject ["email" .= emailStr, "action" .= "login"]

integration/test/API/Nginz.hs

@@ -14,6 +14,14 @@ login domain email pw = do
   pwStr <- make pw >>= asString
   submit "POST" (req & addJSONObject ["email" .= emailStr, "password" .= pwStr, "label" .= "auth"])
 
+loginWith2ndFactor :: (HasCallStack, MakesValue domain, MakesValue email, MakesValue password, MakesValue sndFactor) => domain -> email -> password -> sndFactor -> App Response
+loginWith2ndFactor domain email pw sf = do
+  req <- rawBaseRequest domain Nginz Unversioned "/login"
+  emailStr <- make email >>= asString
+  pwStr <- make pw >>= asString
+  sfStr <- make sf >>= asString
+  submit "POST" (req & addJSONObject ["email" .= emailStr, "password" .= pwStr, "label" .= "auth", "verification_code" .= sfStr])
+
 access :: (HasCallStack, MakesValue domain, MakesValue cookie) => domain -> cookie -> App Response
 access domain cookie = do
   req <- rawBaseRequest domain Nginz Unversioned "/access"

integration/test/Test/Login.hs

@@ -0,0 +1,119 @@
+{-# 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 = do
+  (owner, team, []) <- createTeam OwnDomain 0
+  email <- owner %. "email"
+  setTeamFeatureLockStatus owner team "sndFactorPasswordChallenge" "unlocked"
+  setTeamFeatureStatus owner team "sndFactorPasswordChallenge" "enabled"
+  generateVerificationCode owner email
+  code <- getVerificationCode owner "login" >>= getJSON 200 >>= asString
+  bindResponse (loginWith2ndFactor owner email defPassword code) $ \resp -> do
+    resp.status `shouldMatchInt` 200
+
+-- @SF.Channel @TSFI.RESTfulAPI @S2
+--
+-- Test that login fails with wrong second factor email verification code
+testLoginVerify6DigitWrongCodeFails :: HasCallStack => App ()
+testLoginVerify6DigitWrongCodeFails = do
+  (owner, team, []) <- createTeam OwnDomain 0
+  email <- owner %. "email"
+  setTeamFeatureLockStatus owner team "sndFactorPasswordChallenge" "unlocked"
+  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) $ \resp -> do
+    resp.status `shouldMatchInt` 403
+    resp.json %. "label" `shouldMatch` "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 = do
+  (owner, team, []) <- createTeam OwnDomain 0
+  email <- owner %. "email"
+  setTeamFeatureLockStatus owner team "sndFactorPasswordChallenge" "unlocked"
+  setTeamFeatureStatus owner team "sndFactorPasswordChallenge" "enabled"
+  bindResponse (login owner email defPassword) $ \resp -> do
+    resp.status `shouldMatchInt` 403
+    resp.json %. "label" `shouldMatch` "code-authentication-required"
+
+-- @END
+
+-- @SF.Channel @TSFI.RESTfulAPI @S2
+--
+-- Test that login fails with expired second factor email verification code
+testLoginVerify6DigitExpiredCodeFails :: HasCallStack => App ()
+testLoginVerify6DigitExpiredCodeFails = do
+  withModifiedBackend
+    (def {brigCfg = setField "optSettings.setVerificationTimeout" (Aeson.Number 1)})
+    $ \domain -> do
+      (owner, team, []) <- createTeam domain 0
+      email <- owner %. "email"
+      setTeamFeatureLockStatus owner team "sndFactorPasswordChallenge" "unlocked"
+      setTeamFeatureStatus owner team "sndFactorPasswordChallenge" "enabled"
+      generateVerificationCode owner email
+      code <- getVerificationCode owner "login" >>= getJSON 200 >>= asString
+      liftIO $ threadDelay 2_000_100
+      bindResponse (loginWith2ndFactor owner email defPassword code) \resp -> do
+        resp.status `shouldMatchInt` 403
+        resp.json %. "label" `shouldMatch` "code-authentication-failed"
+
+-- @END
+
+testLoginVerify6DigitResendCodeSuccessAndRateLimiting :: HasCallStack => App ()
+testLoginVerify6DigitResendCodeSuccessAndRateLimiting = do
+  (owner, team, []) <- createTeam OwnDomain 0
+  email <- owner %. "email"
+  setTeamFeatureLockStatus owner team "sndFactorPasswordChallenge" "unlocked"
+  setTeamFeatureStatus owner team "sndFactorPasswordChallenge" "enabled"
+  generateVerificationCode owner email
+  fstCode <- getVerificationCode owner "login" >>= getJSON 200 >>= asString
+  bindResponse (generateVerificationCode' owner email) $ \resp -> do
+    resp.status `shouldMatchInt` 429
+  mostRecentCode <- retryT $ do
+    resp <- generateVerificationCode' owner email
+    resp.status `shouldMatchInt` 200
+    getVerificationCode owner "login" >>= getJSON 200 >>= asString
+
+  bindResponse (loginWith2ndFactor owner email defPassword fstCode) \resp -> do
+    resp.status `shouldMatchInt` 403
+    resp.json %. "label" `shouldMatch` "code-authentication-failed"
+
+  bindResponse (loginWith2ndFactor owner email defPassword mostRecentCode) \resp -> do
+    resp.status `shouldMatchInt` 200
+
+testLoginVerify6DigitLimitRetries :: HasCallStack => App ()
+testLoginVerify6DigitLimitRetries = do
+  (owner, team, []) <- createTeam OwnDomain 0
+  email <- owner %. "email"
+  setTeamFeatureLockStatus owner team "sndFactorPasswordChallenge" "unlocked"
+  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) -> do
+    bindResponse (loginWith2ndFactor owner email defPassword wrongCode) \resp -> do
+      resp.status `shouldMatchInt` 403
+      resp.json %. "label" `shouldMatch` "code-authentication-failed"
+  -- after 3 failed attempts, login with correct code should fail as well
+  bindResponse (loginWith2ndFactor owner email defPassword correctCode) \resp -> do
+    resp.status `shouldMatchInt` 403
+    resp.json %. "label" `shouldMatch` "code-authentication-failed"