WPB-5491 Log password reset errors instead of propagating them (#4114)

changelog.d/3-bug-fixes/WPB-5491

@@ -0,0 +1 @@
+Log password reset errors instead of propagating them

libs/wire-api/src/Wire/API/Routes/Public/Brig.hs

@@ -565,8 +565,6 @@ type AccountAPI =
     :<|> Named
            "post-password-reset"
            ( Summary "Initiate a password reset."
-               :> CanThrow 'PasswordResetInProgress
-               :> CanThrow 'InvalidPasswordResetKey
                :> "password-reset"
                :> ReqBody '[JSON] NewPasswordReset
                :> MultiVerb 'POST '[JSON] '[RespondEmpty 201 "Password reset code created and sent by email."] ()

libs/wire-subsystems/src/Wire/AuthenticationSubsystem/Error.hs

@@ -27,10 +27,8 @@ import Wire.API.Error.Brig qualified as E
 
 data AuthenticationSubsystemError
   = AuthenticationSubsystemInvalidPasswordResetKey
-  | AuthenticationSubsystemPasswordResetInProgress
   | AuthenticationSubsystemResetPasswordMustDiffer
   | AuthenticationSubsystemInvalidPasswordResetCode
-  | AuthenticationSubsystemAllowListError
   deriving (Eq, Show)
 
 instance Exception AuthenticationSubsystemError
@@ -39,7 +37,5 @@ authenticationSubsystemErrorToWai :: AuthenticationSubsystemError -> Wai.Error
 authenticationSubsystemErrorToWai =
   dynErrorToWai . \case
     AuthenticationSubsystemInvalidPasswordResetKey -> dynError @(MapError E.InvalidPasswordResetKey)
-    AuthenticationSubsystemPasswordResetInProgress -> dynError @(MapError E.PasswordResetInProgress)
     AuthenticationSubsystemInvalidPasswordResetCode -> dynError @(MapError E.InvalidPasswordResetCode)
     AuthenticationSubsystemResetPasswordMustDiffer -> dynError @(MapError E.ResetPasswordMustDiffer)
-    AuthenticationSubsystemAllowListError -> dynError @(MapError E.AllowlistError)

libs/wire-subsystems/src/Wire/AuthenticationSubsystem/Interpreter.hs

@@ -78,42 +78,65 @@ maxAttempts = 3
 passwordResetCodeTtl :: NominalDiffTime
 passwordResetCodeTtl = 3600 -- 60 minutes
 
+-- This type is not exported and used for internal control flow only
+data PasswordResetError
+  = AllowListError
+  | InvalidResetKey
+  | InProgress
+  deriving (Show)
+
+instance Exception PasswordResetError where
+  displayException AllowListError = "email domain is not allowed for password reset"
+  displayException InvalidResetKey = "invalid reset key for password reset"
+  displayException InProgress = "password reset already in progress"
+
 createPasswordResetCodeImpl ::
+  forall r.
   ( Member PasswordResetCodeStore r,
     Member Now r,
     Member (Input (Local ())) r,
     Member (Input (Maybe AllowlistEmailDomains)) r,
     Member (Input (Maybe AllowlistPhonePrefixes)) r,
-    Member (Error AuthenticationSubsystemError) r,
     Member TinyLog r,
     Member UserSubsystem r,
     Member EmailSmsSubsystem r
   ) =>
   UserKey ->
   Sem r ()
-createPasswordResetCodeImpl target = do
-  allowListOk <- (\e p -> AllowLists.verify e p (toEither target)) <$> input <*> input
-  unless allowListOk $ throw AuthenticationSubsystemAllowListError
-  user <- lookupActiveUserByUserKey target >>= maybe (throw AuthenticationSubsystemInvalidPasswordResetKey) pure
-  let uid = userId user
-  Log.debug $ field "user" (toByteString uid) . field "action" (val "User.beginPasswordReset")
-
-  mExistingCode <- lookupPasswordResetCode uid
-  when (isJust mExistingCode) $
-    throw AuthenticationSubsystemPasswordResetInProgress
-
-  let key = mkPasswordResetKey uid
-  now <- Now.get
-  code <- foldKey (const generateEmailCode) (const generatePhoneCode) target
-  codeInsert
-    key
-    (PRQueryData code uid (Identity maxAttempts) (Identity (passwordResetCodeTtl `addUTCTime` now)))
-    (round passwordResetCodeTtl)
-  foldKey
-    (\email -> sendPasswordResetMail email (key, code) (Just user.userLocale))
-    (\phone -> sendPasswordResetSms phone (key, code) (Just user.userLocale))
-    target
-  pure ()
+createPasswordResetCodeImpl target =
+  logPasswordResetError =<< runError do
+    allowListOk <- (\e p -> AllowLists.verify e p (toEither target)) <$> input <*> input
+    unless allowListOk $ throw AllowListError
+    user <- lookupActiveUserByUserKey target >>= maybe (throw InvalidResetKey) pure
+    let uid = userId user
+    Log.debug $ field "user" (toByteString uid) . field "action" (val "User.beginPasswordReset")
+
+    mExistingCode <- lookupPasswordResetCode uid
+    when (isJust mExistingCode) $
+      throw InProgress
+
+    let key = mkPasswordResetKey uid
+    now <- Now.get
+    code <- foldKey (const generateEmailCode) (const generatePhoneCode) target
+    codeInsert
+      key
+      (PRQueryData code uid (Identity maxAttempts) (Identity (passwordResetCodeTtl `addUTCTime` now)))
+      (round passwordResetCodeTtl)
+    foldKey
+      (\email -> sendPasswordResetMail email (key, code) (Just user.userLocale))
+      (\phone -> sendPasswordResetSms phone (key, code) (Just user.userLocale))
+      target
+    pure ()
+  where
+    -- `PasswordResetError` are errors that we don't want to leak to the caller.
+    -- Therefore we handle them here and only log without propagating them.
+    logPasswordResetError :: Either PasswordResetError () -> Sem r ()
+    logPasswordResetError = \case
+      Left e ->
+        Log.err $
+          field "action" (val "User.beginPasswordReset")
+            . field "error" (displayException e)
+      Right v -> pure v
 
 lookupActiveUserIdByUserKey :: (Member UserSubsystem r, Member (Input (Local ())) r) => UserKey -> Sem r (Maybe UserId)
 lookupActiveUserIdByUserKey target = userId <$$> lookupActiveUserByUserKey target

libs/wire-subsystems/test/unit/Wire/AuthenticationSubsystem/InterpreterSpec.hs

@@ -30,7 +30,7 @@ import Wire.MockInterpreters
 import Wire.PasswordResetCodeStore
 import Wire.PasswordStore
 import Wire.Sem.Logger.TinyLog
-import Wire.Sem.Now
+import Wire.Sem.Now (Now)
 import Wire.SessionStore
 import Wire.UserKeyStore
 import Wire.UserSubsystem
@@ -130,8 +130,9 @@ spec = describe "AuthenticationSubsystem.Interpreter" do
               interpretDependencies localDomain [] mempty (Just ["example.com"])
                 . interpretAuthenticationSubsystem
                 $ createPasswordResetCode (userEmailKey email)
-         in emailDomain email /= "exmaple.com" ==>
-              createPasswordResetCodeResult === Left AuthenticationSubsystemAllowListError
+                  <* expectNoEmailSent
+         in emailDomain email /= "example.com" ==>
+              createPasswordResetCodeResult === Right ()
 
     prop "reset code is generated when email is in allow list" $
       \email userNoEmail ->
@@ -152,16 +153,18 @@ spec = describe "AuthenticationSubsystem.Interpreter" do
               interpretDependencies localDomain [UserAccount user status] mempty Nothing
                 . interpretAuthenticationSubsystem
                 $ createPasswordResetCode (userEmailKey email)
+                  <* expectNoEmailSent
          in status /= Active ==>
-              createPasswordResetCodeResult === Left AuthenticationSubsystemInvalidPasswordResetKey
+              createPasswordResetCodeResult === Right ()
 
     prop "reset code is not generated for when there is no user for the email" $
       \email localDomain ->
         let createPasswordResetCodeResult =
               interpretDependencies localDomain [] mempty Nothing
                 . interpretAuthenticationSubsystem
                 $ createPasswordResetCode (userEmailKey email)
-         in createPasswordResetCodeResult === Left AuthenticationSubsystemInvalidPasswordResetKey
+                  <* expectNoEmailSent
+         in createPasswordResetCodeResult === Right ()
 
     prop "reset code is only generated once" $
       \email userNoEmail newPassword ->
@@ -182,7 +185,7 @@ spec = describe "AuthenticationSubsystem.Interpreter" do
 
                   (,mCaughtExc) <$> lookupHashedPassword uid
          in (fmap (verifyPassword newPassword) newPasswordHash === Just True)
-              .&&. (mCaughtException === Just AuthenticationSubsystemPasswordResetInProgress)
+              .&&. (mCaughtException === Nothing)
 
     prop "reset code is not accepted after expiry" $
       \email userNoEmail oldPassword newPassword ->
@@ -306,3 +309,10 @@ expect1ResetPasswordEmail email =
       [] -> error "no emails sent"
       [SentMail _ (PasswordResetMail resetPair)] -> resetPair
       wrongEmails -> error $ "Wrong emails sent: " <> show wrongEmails
+
+expectNoEmailSent :: (Member (State (Map Email [SentMail])) r) => Sem r ()
+expectNoEmailSent = do
+  emails <- get
+  if null emails
+    then pure ()
+    else error $ "Expected no emails sent, got: " <> show emails

services/brig/test/integration/API/User/PasswordReset.hs

@@ -31,7 +31,6 @@ import Data.Aeson as A
 import Data.Aeson.KeyMap qualified as KeyMap
 import Data.Misc
 import Imports
-import Network.Wai.Utilities (Error (label))
 import Test.Tasty hiding (Timeout)
 import Util
 import Wire.API.User
@@ -64,10 +63,10 @@ testPasswordReset brig = do
   let newpw = plainTextPassword8Unsafe "newsecret"
   do
     initiatePasswordReset brig email !!! const 201 === statusCode
-    initiatePasswordReset brig email !!! do
-      const 409 === statusCode
-      const (Just "code-exists") === fmap label . responseJsonMaybe
-      const Nothing {- the "retry-after" header is only added for provider, not user, at the time of writing this test -} === getHeader "Retry-After"
+    -- even though a password reset is now in progress
+    -- we expect a successful response from a subsequent request to not leak any information
+    -- about the requested email
+    initiatePasswordReset brig email !!! const 201 === statusCode
 
     passwordResetData <- preparePasswordReset brig email uid newpw
     completePasswordReset brig passwordResetData !!! const 200 === statusCode