[Brig] Move password verification to the AuthenticationSubsystem, move to Argon2id with new settings.

Makefile

@@ -62,6 +62,10 @@ full-clean: clean
 	clean-rabbit
 	@echo -e "\n\n*** NOTE: you may want to also 'rm -rf ~/.cabal/store \$$CABAL_DIR/store', not sure.\n"
 
+.PHONY: clean-rabbit
+clean-rabbit:
+	rabbitmqadmin -f pretty_json list queues vhost name messages | jq -r '.[] | "rabbitmqadmin delete queue name=\(.name) --vhost=\(.vhost)"' | bash
+
 .PHONY: clean
 clean:
 	cabal clean

changelog.d/5-internal/pwd

@@ -0,0 +1 @@
+Changed default password hashing from Scrypt to Argon2id.

libs/wire-api/src/Wire/API/Password.hs

@@ -1,4 +1,6 @@
 {-# LANGUAGE RecordWildCards #-}
+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
+
 -- This file is part of the Wire Server implementation.
 --
 -- Copyright (C) 2022 Wire Swiss GmbH <opensource@wire.com>
@@ -15,21 +17,22 @@
 --
 -- 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/>.
-{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
-{-# OPTIONS_GHC -Wno-unused-top-binds #-}
 
 module Wire.API.Password
   ( Password,
     PasswordStatus (..),
     genPassword,
-    mkSafePasswordScrypt,
-    mkSafePasswordArgon2id,
+    mkSafePassword,
     verifyPassword,
     verifyPasswordWithStatus,
+    PasswordReqBody (..),
+
+    -- * Only for testing
+    genTestPasswords,
     unsafeMkPassword,
     hashPasswordArgon2idWithSalt,
     hashPasswordArgon2idWithOptions,
-    PasswordReqBody (..),
+    mkSafePasswordScrypt,
   )
 where
 
@@ -110,8 +113,8 @@ defaultScryptParams =
 defaultOptions :: Argon2idOptions
 defaultOptions =
   Argon2.Options
-    { iterations = 5,
-      memory = 2 ^ (17 :: Int),
+    { iterations = 1,
+      memory = 2 ^ (14 :: Int),
       parallelism = 4,
       variant = Argon2.Argon2id,
       version = Argon2.Version13
@@ -138,8 +141,8 @@ genPassword =
 mkSafePasswordScrypt :: (MonadIO m) => PlainTextPassword' t -> m Password
 mkSafePasswordScrypt = fmap Password . hashPasswordScrypt . Text.encodeUtf8 . fromPlainTextPassword
 
-mkSafePasswordArgon2id :: (MonadIO m) => PlainTextPassword' t -> m Password
-mkSafePasswordArgon2id = fmap Password . hashPasswordArgon2id . Text.encodeUtf8 . fromPlainTextPassword
+mkSafePassword :: (MonadIO m) => PlainTextPassword' t -> m Password
+mkSafePassword = fmap Password . hashPasswordArgon2id . Text.encodeUtf8 . fromPlainTextPassword
 
 -- | Verify a plaintext password from user input against a stretched
 -- password from persistent storage.
@@ -168,7 +171,7 @@ hashPasswordScrypt password = do
 
 hashPasswordArgon2id :: (MonadIO m) => ByteString -> m Text
 hashPasswordArgon2id pwd = do
-  salt <- newSalt 32
+  salt <- newSalt 16
   pure $ hashPasswordArgon2idWithSalt salt pwd
 
 hashPasswordArgon2idWithSalt :: ByteString -> ByteString -> Text
@@ -277,12 +280,12 @@ parseScryptPasswordHashParams passwordHash = do
 
 hashPasswordWithOptions :: Argon2idOptions -> ByteString -> ByteString -> ByteString
 hashPasswordWithOptions opts password salt =
-  case (Argon2.hash opts password salt 64) of
-    -- CryptoFailed occurs when salt, output or input are too small/big.
-    -- since we control those values ourselves, it should never have a runtime error
-    -- unless we've caused it ourselves.
-    CryptoFailed cErr -> error $ "Impossible error: " <> show cErr
-    CryptoPassed hash -> hash
+  let tagSize = 16
+   in case (Argon2.hash opts password salt tagSize) of
+        -- CryptoFailed occurs when salt, output or input are too small/big.
+        -- since we control those values ourselves, it should never have a runtime error
+        CryptoFailed cErr -> error $ "Impossible error: " <> show cErr
+        CryptoPassed hash -> hash
 
 hashPasswordWithParams ::
   ( ByteArrayAccess password,
@@ -352,3 +355,12 @@ instance ToSchema PasswordReqBody where
     object "PasswordReqBody" $
       PasswordReqBody
         <$> fromPasswordReqBody .= maybe_ (optField "password" schema)
+
+-------------------------------------------------------------------------------
+-- Generate test passwords, benchmark
+
+genTestPasswords :: IO [(Text, Text)]
+genTestPasswords = replicateM 100 do
+  pwd <- genPassword
+  hash <- mkSafePassword pwd
+  pure (fromPlainTextPassword pwd, fromPassword hash)

libs/wire-api/src/Wire/API/Provider.hs

@@ -202,6 +202,7 @@ instance ToSchema ProviderLogin where
 -- DeleteProvider
 
 -- | Input data for a provider deletion request.
+-- | FUTUREWORK: look into a phase out of PlainTextPassword6
 newtype DeleteProvider = DeleteProvider
   {deleteProviderPassword :: PlainTextPassword6}
   deriving stock (Eq, Show)

libs/wire-api/test/unit/Test/Wire/API/Password.hs

@@ -32,31 +32,29 @@ tests =
       testCase "verify old scrypt password still works" testHashingOldScrypt
     ]
 
--- TODO: Address password hashing being wrong
--- https://wearezeta.atlassian.net/browse/WPB-9746
 testHashPasswordScrypt :: IO ()
 testHashPasswordScrypt = do
   pwd <- genPassword
-  hashed <- mkSafePasswordScrypt pwd
+  hashed <- mkSafePassword pwd
   let (correct, status) = verifyPasswordWithStatus pwd hashed
   assertBool "Password could not be verified" correct
   assertEqual "Password could not be verified" status PasswordStatusOk
 
 testHashPasswordArgon2id :: IO ()
 testHashPasswordArgon2id = do
   pwd <- genPassword
-  hashed <- mkSafePasswordArgon2id pwd
+  hashed <- mkSafePassword pwd
   let (correct, status) = verifyPasswordWithStatus pwd hashed
-  assertBool "Password could not be verified" correct
   assertEqual "Password could not be verified" status PasswordStatusOk
+  assertBool "Password could not be verified" correct
 
 testUpdateHash :: IO ()
 testUpdateHash = do
   let orig = plainTextPassword8Unsafe "Test password scrypt to argon2id."
       -- password hashed with scrypt and random salt
       expected = unsafeMkPassword "14|8|1|ktYx5i1DMOEfm+tXpw9i7ZVPdeqbxgxYxUbmDVLSAzQ=|Fzy0sNfXQQnJW98ncyN51PUChFWH1tpVJCxjz5JRZEReVa0//zJ6MeopiEh84Ny8lzwdvRPHDqnSS/lkPEB7Ow=="
       -- password re-hashed with argon2id and re-used salt for simplicity
-      newHash = unsafeMkPassword "$argon2id$v=19$m=131072,t=5,p=4$ktYx5i1DMOEfm+tXpw9i7ZVPdeqbxgxYxUbmDVLSAzQ=$iS/9tVk49W8bO/APETqNzMmREerdETTvSXcA7nSpqrsGrV1N33+MVaKnhWhBHqIxM92HFPsV5GP0dpgCUHmJRg=="
+      newHash = unsafeMkPassword "$argon2id$v=19$m=4194304,t=1,p=8$lj6+HdIcCpO1zvz8An56fg$Qx8OzYTq0hDNqGG9tW1dug"
       -- verify password with scrypt
       (correct, status) = verifyPasswordWithStatus orig expected
 

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

@@ -23,14 +23,18 @@ import Data.Misc
 import Data.Qualified
 import Imports
 import Polysemy
+import Wire.API.Password (Password, PasswordStatus)
 import Wire.API.User
-import Wire.API.User.Password
+import Wire.API.User.Password (PasswordResetCode, PasswordResetIdentity)
 import Wire.UserKeyStore
 
 data AuthenticationSubsystem m a where
-  VerifyPassword :: Local UserId -> PlainTextPassword6 -> AuthenticationSubsystem m ()
+  VerifyPasswordError :: Local UserId -> PlainTextPassword6 -> AuthenticationSubsystem m ()
   CreatePasswordResetCode :: EmailKey -> AuthenticationSubsystem m ()
   ResetPassword :: PasswordResetIdentity -> PasswordResetCode -> PlainTextPassword8 -> AuthenticationSubsystem m ()
+  VerifyPassword :: PlainTextPassword6 -> Password -> AuthenticationSubsystem m (Bool, PasswordStatus)
+  VerifyUserPassword :: UserId -> PlainTextPassword6 -> AuthenticationSubsystem r (Bool, PasswordStatus)
+  VerifyProviderPassword :: ProviderId -> PlainTextPassword6 -> AuthenticationSubsystem r (Bool, PasswordStatus)
   -- For testing
   InternalLookupPasswordResetCode :: EmailKey -> AuthenticationSubsystem m (Maybe PasswordResetPair)
 

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

@@ -36,15 +36,16 @@ import Polysemy.TinyLog qualified as Log
 import System.Logger
 import Wire.API.Allowlists (AllowlistEmailDomains)
 import Wire.API.Allowlists qualified as AllowLists
-import Wire.API.Password
+import Wire.API.Password as Password
 import Wire.API.User
 import Wire.API.User.Password
 import Wire.AuthenticationSubsystem (AuthenticationSubsystem (..))
 import Wire.AuthenticationSubsystem.Error
 import Wire.EmailSubsystem
 import Wire.HashPassword
 import Wire.PasswordResetCodeStore
-import Wire.PasswordStore
+import Wire.PasswordStore (PasswordStore)
+import Wire.PasswordStore qualified as PasswordStore
 import Wire.Sem.Now
 import Wire.Sem.Now qualified as Now
 import Wire.SessionStore
@@ -70,22 +71,15 @@ interpretAuthenticationSubsystem ::
 interpretAuthenticationSubsystem userSubsystemInterpreter =
   interpret $
     userSubsystemInterpreter . \case
-      VerifyPassword luid password -> verifyPasswordImpl luid password
+      VerifyPasswordError luid plaintext -> verifyPasswordErrorImpl luid plaintext
       CreatePasswordResetCode userKey -> createPasswordResetCodeImpl userKey
       ResetPassword ident resetCode newPassword -> resetPasswordImpl ident resetCode newPassword
+      VerifyPassword plaintext pwd -> verifyPasswordImpl plaintext pwd
+      VerifyUserPassword uid plaintext -> verifyUserPasswordImpl uid plaintext
+      VerifyProviderPassword pid plaintext -> verifyProviderPasswordImpl pid plaintext
+      -- Testing
       InternalLookupPasswordResetCode userKey -> internalLookupPasswordResetCodeImpl userKey
 
-verifyPasswordImpl ::
-  ( Member PasswordStore r,
-    Member (Error AuthenticationSubsystemError) r
-  ) =>
-  Local UserId ->
-  PlainTextPassword6 ->
-  Sem r ()
-verifyPasswordImpl (tUnqualified -> uid) password = do
-  p <- lookupHashedPassword uid >>= maybe (throw AuthenticationSubsystemMissingAuth) pure
-  unless (Wire.API.Password.verifyPassword password p) $ throw AuthenticationSubsystemBadCredentials
-
 maxAttempts :: Int32
 maxAttempts = 3
 
@@ -149,7 +143,9 @@ createPasswordResetCodeImpl target =
       Right v -> pure v
 
 lookupActiveUserIdByUserKey ::
-  (Member UserSubsystem r, Member (Input (Local ())) r) =>
+  ( Member UserSubsystem r,
+    Member (Input (Local ())) r
+  ) =>
   EmailKey ->
   Sem r (Maybe UserId)
 lookupActiveUserIdByUserKey target =
@@ -230,7 +226,7 @@ resetPasswordImpl ident code pw = do
       Log.debug $ field "user" (toByteString uid) . field "action" (val "User.completePasswordReset")
       checkNewIsDifferent uid pw
       hashedPw <- hashPassword pw
-      upsertHashedPassword uid hashedPw
+      PasswordStore.upsertHashedPassword uid hashedPw
       codeDelete key
       deleteAllCookies uid
   where
@@ -246,10 +242,10 @@ resetPasswordImpl ident code pw = do
 
     checkNewIsDifferent :: UserId -> PlainTextPassword' t -> Sem r ()
     checkNewIsDifferent uid newPassword = do
-      mCurrentPassword <- lookupHashedPassword uid
+      mCurrentPassword <- PasswordStore.lookupHashedPassword uid
       case mCurrentPassword of
         Just currentPassword
-          | (verifyPassword newPassword currentPassword) -> throw AuthenticationSubsystemResetPasswordMustDiffer
+          | (Password.verifyPassword newPassword currentPassword) -> throw AuthenticationSubsystemResetPasswordMustDiffer
         _ -> pure ()
 
     verify :: PasswordResetPair -> Sem r (Maybe UserId)
@@ -266,3 +262,44 @@ resetPasswordImpl ident code pw = do
           pure Nothing
         Just PRQueryData {} -> codeDelete k $> Nothing
         Nothing -> pure Nothing
+
+verifyPasswordImpl ::
+  PlainTextPassword6 ->
+  Password ->
+  Sem r (Bool, PasswordStatus)
+verifyPasswordImpl plaintext password = do
+  pure $ Password.verifyPasswordWithStatus plaintext password
+
+verifyProviderPasswordImpl ::
+  (Member PasswordStore r, Member (Error AuthenticationSubsystemError) r) =>
+  ProviderId ->
+  PlainTextPassword6 ->
+  Sem r (Bool, PasswordStatus)
+verifyProviderPasswordImpl pid plaintext = do
+  -- We type-erase uid here
+  password <-
+    PasswordStore.lookupHashedProviderPassword pid
+      >>= maybe (throw AuthenticationSubsystemBadCredentials) pure
+  verifyPasswordImpl plaintext password
+
+verifyUserPasswordImpl ::
+  (Member PasswordStore r, Member (Error AuthenticationSubsystemError) r) =>
+  UserId ->
+  PlainTextPassword6 ->
+  Sem r (Bool, PasswordStatus)
+verifyUserPasswordImpl uid plaintext = do
+  password <-
+    PasswordStore.lookupHashedPassword uid
+      >>= maybe (throw AuthenticationSubsystemBadCredentials) pure
+  verifyPasswordImpl plaintext password
+
+verifyPasswordErrorImpl ::
+  ( Member PasswordStore r,
+    Member (Error AuthenticationSubsystemError) r
+  ) =>
+  Local UserId ->
+  PlainTextPassword6 ->
+  Sem r ()
+verifyPasswordErrorImpl (tUnqualified -> uid) password = do
+  unlessM (fst <$> verifyUserPasswordImpl uid password) do
+    throw AuthenticationSubsystemBadCredentials

libs/wire-subsystems/src/Wire/HashPassword.hs

@@ -15,4 +15,4 @@ makeSem ''HashPassword
 
 runHashPassword :: (Member (Embed IO) r) => InterpreterFor HashPassword r
 runHashPassword = interpret $ \case
-  HashPassword pw -> liftIO $ Password.mkSafePasswordScrypt pw
+  HashPassword pw -> liftIO $ Password.mkSafePassword pw

libs/wire-subsystems/src/Wire/PasswordStore.hs

@@ -10,5 +10,6 @@ import Wire.API.Password
 data PasswordStore m a where
   UpsertHashedPassword :: UserId -> Password -> PasswordStore m ()
   LookupHashedPassword :: UserId -> PasswordStore m (Maybe Password)
+  LookupHashedProviderPassword :: ProviderId -> PasswordStore m (Maybe Password)
 
 makeSem ''PasswordStore

libs/wire-subsystems/src/Wire/PasswordStore/Cassandra.hs

@@ -16,6 +16,12 @@ interpretPasswordStore casClient =
     runEmbedded (runClient casClient) . \case
       UpsertHashedPassword uid password -> embed $ updatePasswordImpl uid password
       LookupHashedPassword uid -> embed $ lookupPasswordImpl uid
+      LookupHashedProviderPassword pid -> embed $ lookupProviderPasswordImpl pid
+
+lookupProviderPasswordImpl :: (MonadClient m) => ProviderId -> m (Maybe Password)
+lookupProviderPasswordImpl u =
+  (runIdentity =<<)
+    <$> retry x1 (query1 providerPasswordSelect (params LocalQuorum (Identity u)))
 
 lookupPasswordImpl :: (MonadClient m) => UserId -> m (Maybe Password)
 lookupPasswordImpl u =
@@ -29,6 +35,10 @@ updatePasswordImpl u p = do
 ------------------------------------------------------------------------
 -- Queries
 
+providerPasswordSelect :: PrepQuery R (Identity ProviderId) (Identity (Maybe Password))
+providerPasswordSelect =
+  "SELECT password FROM provider WHERE id = ?"
+
 passwordSelect :: PrepQuery R (Identity UserId) (Identity (Maybe Password))
 passwordSelect = "SELECT password FROM user WHERE id = ?"
 

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

@@ -925,7 +925,7 @@ acceptTeamInvitationImpl luid pw code = do
   mSelfProfile <- getSelfProfileImpl luid
   let mEmailKey = mkEmailKey <$> (userEmail . selfUser =<< mSelfProfile)
       mTid = mSelfProfile >>= userTeam . selfUser
-  verifyPassword luid pw
+  verifyPasswordError luid pw
   inv <- internalFindTeamInvitationImpl mEmailKey code
   let tid = inv.teamId
   let minvmeta = (,inv.createdAt) <$> inv.createdBy

libs/wire-subsystems/test/unit/Wire/MockInterpreters/PasswordStore.hs

@@ -1,3 +1,5 @@
+{-# OPTIONS_GHC -Wwarn #-}
+
 module Wire.MockInterpreters.PasswordStore where
 
 import Data.Id
@@ -15,3 +17,4 @@ inMemoryPasswordStoreInterpreter :: (Member (State (Map UserId Password)) r) =>
 inMemoryPasswordStoreInterpreter = interpret $ \case
   UpsertHashedPassword uid password -> modify $ Map.insert uid password
   LookupHashedPassword uid -> gets $ Map.lookup uid
+  LookupHashedProviderPassword _uid -> todo ("Implement as needed" :: String)

services/brig/brig.integration.yaml

@@ -171,7 +171,7 @@ optSettings:
     timeout: 5  # seconds.  if you reach the limit, how long do you have to wait to try again.
     retryLimit: 5  # how many times can you have a failed login in that timeframe.
   setSuspendInactiveUsers:  # if this is omitted: never suspend inactive users.
-    suspendTimeout: 4
+    suspendTimeout: 10
   setRichInfoLimit: 5000  # should be in sync with Spar
   setDefaultUserLocale: en
   setMaxTeamSize: 32