From 0cd1e5eb02bec89d8655c535cb09541155919a6e Mon Sep 17 00:00:00 2001 From: Igor Ranieri Date: Wed, 25 Sep 2024 13:45:06 +0200 Subject: [PATCH 01/30] Use Argon2id instead of scrypt, with default params. --- libs/wire-api/src/Wire/API/Password.hs | 16 +++++++++------- .../wire-api/test/unit/Test/Wire/API/Password.hs | 2 +- libs/wire-subsystems/src/Wire/HashPassword.hs | 2 +- services/brig/src/Brig/API/OAuth.hs | 2 +- services/brig/src/Brig/API/User.hs | 2 +- services/brig/src/Brig/Data/User.hs | 4 ++-- services/brig/src/Brig/Provider/API.hs | 4 ++-- services/brig/src/Brig/Provider/DB.hs | 2 +- services/brig/test/integration/API/User/Auth.hs | 4 ++-- services/galley/src/Galley/API/Update.hs | 4 ++-- 10 files changed, 22 insertions(+), 20 deletions(-) diff --git a/libs/wire-api/src/Wire/API/Password.hs b/libs/wire-api/src/Wire/API/Password.hs index c7aa15111ff..39af70530df 100644 --- a/libs/wire-api/src/Wire/API/Password.hs +++ b/libs/wire-api/src/Wire/API/Password.hs @@ -22,14 +22,16 @@ module Wire.API.Password ( Password, PasswordStatus (..), genPassword, - mkSafePasswordScrypt, - mkSafePasswordArgon2id, + mkSafePassword, verifyPassword, verifyPasswordWithStatus, + PasswordReqBody (..), + + -- * Only for testing unsafeMkPassword, hashPasswordArgon2idWithSalt, hashPasswordArgon2idWithOptions, - PasswordReqBody (..), + mkSafePasswordScrypt, ) where @@ -110,8 +112,8 @@ defaultScryptParams = defaultOptions :: Argon2idOptions defaultOptions = Argon2.Options - { iterations = 5, - memory = 2 ^ (17 :: Int), + { iterations = 1, + memory = 2 ^ (21 :: Int), parallelism = 4, variant = Argon2.Argon2id, version = Argon2.Version13 @@ -138,8 +140,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. diff --git a/libs/wire-api/test/unit/Test/Wire/API/Password.hs b/libs/wire-api/test/unit/Test/Wire/API/Password.hs index 8850a377c79..dcbd630ca8c 100644 --- a/libs/wire-api/test/unit/Test/Wire/API/Password.hs +++ b/libs/wire-api/test/unit/Test/Wire/API/Password.hs @@ -45,7 +45,7 @@ testHashPasswordScrypt = do 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 diff --git a/libs/wire-subsystems/src/Wire/HashPassword.hs b/libs/wire-subsystems/src/Wire/HashPassword.hs index 54c65c3ee74..48444c0d691 100644 --- a/libs/wire-subsystems/src/Wire/HashPassword.hs +++ b/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 diff --git a/services/brig/src/Brig/API/OAuth.hs b/services/brig/src/Brig/API/OAuth.hs index e66dc240b14..97e23180230 100644 --- a/services/brig/src/Brig/API/OAuth.hs +++ b/services/brig/src/Brig/API/OAuth.hs @@ -101,7 +101,7 @@ registerOAuthClient (OAuthClientConfig name uri) = do createSecret = OAuthClientPlainTextSecret <$> rand32Bytes hashClientSecret :: (MonadIO m) => OAuthClientPlainTextSecret -> m Password - hashClientSecret = mkSafePasswordScrypt . plainTextPassword8Unsafe . toText . unOAuthClientPlainTextSecret + hashClientSecret = mkSafePassword . plainTextPassword8Unsafe . toText . unOAuthClientPlainTextSecret rand32Bytes :: (MonadIO m) => m AsciiBase16 rand32Bytes = liftIO . fmap encodeBase16 $ randBytes 32 diff --git a/services/brig/src/Brig/API/User.hs b/services/brig/src/Brig/API/User.hs index 6d40b450a4c..bccba92ac46 100644 --- a/services/brig/src/Brig/API/User.hs +++ b/services/brig/src/Brig/API/User.hs @@ -846,7 +846,7 @@ changePassword uid cp = do throwE ChangePasswordNoIdentity currpw <- lift $ liftSem $ lookupHashedPassword uid let newpw = cpNewPassword cp - hashedNewPw <- mkSafePasswordScrypt newpw + hashedNewPw <- mkSafePassword newpw case (currpw, cpOldPassword cp) of (Nothing, _) -> lift . liftSem $ upsertHashedPassword uid hashedNewPw (Just _, Nothing) -> throwE InvalidCurrentPassword diff --git a/services/brig/src/Brig/Data/User.hs b/services/brig/src/Brig/Data/User.hs index 4e3013a19bd..d8c78110db2 100644 --- a/services/brig/src/Brig/Data/User.hs +++ b/services/brig/src/Brig/Data/User.hs @@ -128,7 +128,7 @@ newAccount u inv tid mbHandle = do (Just (toUUID -> uuid), _) -> pure uuid (_, Just uuid) -> pure uuid (Nothing, Nothing) -> liftIO nextRandom - passwd <- maybe (pure Nothing) (fmap Just . liftIO . mkSafePasswordScrypt) pass + passwd <- maybe (pure Nothing) (fmap Just . liftIO . mkSafePassword) pass expiry <- case status of Ephemeral -> do -- Ephemeral users' expiry time is in expires_in (default sessionTokenTimeout) seconds @@ -200,7 +200,7 @@ authenticate u pw = where hashAndUpdatePwd :: UserId -> PlainTextPassword8 -> AppT r () hashAndUpdatePwd uid pwd = do - hashed <- mkSafePasswordScrypt pwd + hashed <- mkSafePassword pwd liftSem $ upsertHashedPassword uid hashed -- | Password reauthentication. If the account has a password, reauthentication diff --git a/services/brig/src/Brig/Provider/API.hs b/services/brig/src/Brig/Provider/API.hs index dea4ba451c5..d92ecbcdd5b 100644 --- a/services/brig/src/Brig/Provider/API.hs +++ b/services/brig/src/Brig/Provider/API.hs @@ -215,10 +215,10 @@ newAccount new = do let emailKey = mkEmailKey email wrapClientE (DB.lookupKey emailKey) >>= mapM_ (const $ throwStd emailExists) (safePass, newPass) <- case pass of - Just newPass -> (,Nothing) <$> mkSafePasswordScrypt newPass + Just newPass -> (,Nothing) <$> mkSafePassword newPass Nothing -> do newPass <- genPassword - safePass <- mkSafePasswordScrypt newPass + safePass <- mkSafePassword newPass pure (safePass, Just newPass) pid <- wrapClientE $ DB.insertAccount name safePass url descr let gen = mkVerificationCodeGen email diff --git a/services/brig/src/Brig/Provider/DB.hs b/services/brig/src/Brig/Provider/DB.hs index 67a9454ac6b..c285d2417db 100644 --- a/services/brig/src/Brig/Provider/DB.hs +++ b/services/brig/src/Brig/Provider/DB.hs @@ -131,7 +131,7 @@ updateAccountPassword :: PlainTextPassword6 -> m () updateAccountPassword pid pwd = do - p <- liftIO $ mkSafePasswordScrypt pwd + p <- liftIO $ mkSafePassword pwd retry x5 $ write cql $ params LocalQuorum (p, pid) where cql :: PrepQuery W (Password, ProviderId) () diff --git a/services/brig/test/integration/API/User/Auth.hs b/services/brig/test/integration/API/User/Auth.hs index 518e4dfc162..f37ad772048 100644 --- a/services/brig/test/integration/API/User/Auth.hs +++ b/services/brig/test/integration/API/User/Auth.hs @@ -62,7 +62,7 @@ import UnliftIO.Async hiding (wait) import Util import Util.Timeout import Wire.API.Conversation (Conversation (..)) -import Wire.API.Password (Password, mkSafePasswordScrypt) +import Wire.API.Password (Password, mkSafePassword) import Wire.API.User as Public import Wire.API.User.Auth as Auth import Wire.API.User.Auth.LegalHold @@ -193,7 +193,7 @@ testLoginWith6CharPassword brig db = do updatePassword :: (MonadClient m) => UserId -> PlainTextPassword6 -> m () updatePassword u t = do - p <- liftIO $ mkSafePasswordScrypt t + p <- liftIO $ mkSafePassword t retry x5 $ write userPasswordUpdate (params LocalQuorum (p, u)) userPasswordUpdate :: PrepQuery W (Password, UserId) () diff --git a/services/galley/src/Galley/API/Update.hs b/services/galley/src/Galley/API/Update.hs index a05438a3e10..e447c96c71b 100644 --- a/services/galley/src/Galley/API/Update.hs +++ b/services/galley/src/Galley/API/Update.hs @@ -125,7 +125,7 @@ import Wire.API.Federation.API import Wire.API.Federation.API.Galley import Wire.API.Federation.Error import Wire.API.Message -import Wire.API.Password (mkSafePasswordScrypt) +import Wire.API.Password (mkSafePassword) import Wire.API.Routes.Public (ZHostValue) import Wire.API.Routes.Public.Galley.Messaging import Wire.API.Routes.Public.Util (UpdateResult (..)) @@ -569,7 +569,7 @@ addCode lusr mbZHost mZcon lcnv mReq = do Nothing -> do ttl <- realToFrac . unGuestLinkTTLSeconds . fromMaybe defGuestLinkTTLSeconds . view (settings . guestLinkTTLSeconds) <$> input code <- E.generateCode (tUnqualified lcnv) ReusableCode (Timeout ttl) - mPw <- for (mReq >>= (.password)) mkSafePasswordScrypt + mPw <- for (mReq >>= (.password)) mkSafePassword E.createCode code mPw now <- input let event = Event (tUntagged lcnv) Nothing (tUntagged lusr) now (EdConvCodeUpdate (mkConversationCodeInfo (isJust mPw) (codeKey code) (codeValue code) convUri)) From f96f5012c99c531e1553b3dfc51f35d475e6d528 Mon Sep 17 00:00:00 2001 From: Igor Ranieri Date: Thu, 26 Sep 2024 13:43:36 +0200 Subject: [PATCH 02/30] Added verifyPassword to subsystem --- libs/wire-api/src/Wire/API/Provider.hs | 1 + .../src/Wire/AuthenticationSubsystem.hs | 14 ++- .../AuthenticationSubsystem/Interpreter.hs | 55 +++++++---- .../src/Wire/UserSubsystem/Interpreter.hs | 2 +- .../InterpreterSpec.hs | 1 - services/brig/src/Brig/Provider/API.hs | 99 +++++++++++++------ 6 files changed, 118 insertions(+), 54 deletions(-) diff --git a/libs/wire-api/src/Wire/API/Provider.hs b/libs/wire-api/src/Wire/API/Provider.hs index 8923fc6e5ed..fbde37da2ce 100644 --- a/libs/wire-api/src/Wire/API/Provider.hs +++ b/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) diff --git a/libs/wire-subsystems/src/Wire/AuthenticationSubsystem.hs b/libs/wire-subsystems/src/Wire/AuthenticationSubsystem.hs index e4200377d92..effae7cde6b 100644 --- a/libs/wire-subsystems/src/Wire/AuthenticationSubsystem.hs +++ b/libs/wire-subsystems/src/Wire/AuthenticationSubsystem.hs @@ -24,14 +24,24 @@ import Data.Qualified import Imports import Polysemy 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 () + VerifyPasswordE :: Local UserId -> PlainTextPassword6 -> AuthenticationSubsystem m () CreatePasswordResetCode :: EmailKey -> AuthenticationSubsystem m () ResetPassword :: PasswordResetIdentity -> PasswordResetCode -> PlainTextPassword8 -> AuthenticationSubsystem m () + VerifyPassword :: UserId -> PlainTextPassword6 -> AuthenticationSubsystem m Bool -- For testing InternalLookupPasswordResetCode :: EmailKey -> AuthenticationSubsystem m (Maybe PasswordResetPair) makeSem ''AuthenticationSubsystem + +verifyProviderPassword :: + (Member AuthenticationSubsystem r) => + ProviderId -> + PlainTextPassword6 -> + Sem r Bool +verifyProviderPassword pid pwd = + let uid = Id . toUUID $ pid + in verifyPassword uid pwd diff --git a/libs/wire-subsystems/src/Wire/AuthenticationSubsystem/Interpreter.hs b/libs/wire-subsystems/src/Wire/AuthenticationSubsystem/Interpreter.hs index 183d1130c6e..3a8cff06362 100644 --- a/libs/wire-subsystems/src/Wire/AuthenticationSubsystem/Interpreter.hs +++ b/libs/wire-subsystems/src/Wire/AuthenticationSubsystem/Interpreter.hs @@ -36,7 +36,7 @@ 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 (..)) @@ -44,7 +44,8 @@ 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,13 @@ interpretAuthenticationSubsystem :: interpretAuthenticationSubsystem userSubsystemInterpreter = interpret $ userSubsystemInterpreter . \case - VerifyPassword luid password -> verifyPasswordImpl luid password + VerifyPasswordE luid plaintext -> verifyPasswordEImpl luid plaintext CreatePasswordResetCode userKey -> createPasswordResetCodeImpl userKey ResetPassword ident resetCode newPassword -> resetPasswordImpl ident resetCode newPassword + VerifyPassword uid plaintext -> verifyPasswordImpl uid 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 +141,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 +224,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 +240,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 +260,28 @@ resetPasswordImpl ident code pw = do pure Nothing Just PRQueryData {} -> codeDelete k $> Nothing Nothing -> pure Nothing + +verifyPasswordImpl :: + ( Member (Error AuthenticationSubsystemError) r, + Member PasswordStore r + ) => + UserId -> + PlainTextPassword6 -> + Sem r Bool +verifyPasswordImpl uid plaintext = do + password <- + -- We type-erase uid here, as this could be a provider or bot id. + PasswordStore.lookupHashedPassword uid + >>= maybe (throw AuthenticationSubsystemMissingAuth) pure + pure $ Password.verifyPassword plaintext password + +verifyPasswordEImpl :: + ( Member PasswordStore r, + Member (Error AuthenticationSubsystemError) r + ) => + Local UserId -> + PlainTextPassword6 -> + Sem r () +verifyPasswordEImpl (tUnqualified -> uid) password = do + unlessM (verifyPasswordImpl uid password) do + throw AuthenticationSubsystemBadCredentials diff --git a/libs/wire-subsystems/src/Wire/UserSubsystem/Interpreter.hs b/libs/wire-subsystems/src/Wire/UserSubsystem/Interpreter.hs index f0318d5bff7..8bf6281b6f7 100644 --- a/libs/wire-subsystems/src/Wire/UserSubsystem/Interpreter.hs +++ b/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 + verifyPasswordE luid pw inv <- internalFindTeamInvitationImpl mEmailKey code let tid = inv.teamId let minvmeta = (,inv.createdAt) <$> inv.createdBy diff --git a/libs/wire-subsystems/test/unit/Wire/AuthenticationSubsystem/InterpreterSpec.hs b/libs/wire-subsystems/test/unit/Wire/AuthenticationSubsystem/InterpreterSpec.hs index f553aa595dc..c9ca63d208a 100644 --- a/libs/wire-subsystems/test/unit/Wire/AuthenticationSubsystem/InterpreterSpec.hs +++ b/libs/wire-subsystems/test/unit/Wire/AuthenticationSubsystem/InterpreterSpec.hs @@ -189,7 +189,6 @@ spec = describe "AuthenticationSubsystem.Interpreter" do -- Reset password still works with previously generated reset code resetPassword (PasswordResetEmailIdentity email) code newPassword - (,mCaughtExc) <$> lookupHashedPassword uid in (fmap (Password.verifyPassword newPassword) newPasswordHash === Just True) .&&. (mCaughtException === Nothing) diff --git a/services/brig/src/Brig/Provider/API.hs b/services/brig/src/Brig/Provider/API.hs index d92ecbcdd5b..20048684420 100644 --- a/services/brig/src/Brig/Provider/API.hs +++ b/services/brig/src/Brig/Provider/API.hs @@ -62,7 +62,11 @@ import Data.LegalHold import Data.List qualified as List import Data.List1 (maybeList1) import Data.Map.Strict qualified as Map -import Data.Misc (Fingerprint (..), FutureWork (FutureWork), Rsa) +import Data.Misc + ( Fingerprint (Fingerprint), + FutureWork (FutureWork), + Rsa, + ) import Data.Qualified import Data.Range import Data.Set qualified as Set @@ -117,6 +121,7 @@ import Wire.API.User.Auth import Wire.API.User.Client import Wire.API.User.Client qualified as Public (Client, ClientCapability (ClientSupportsLegalholdImplicitConsent), PubClient (..), UserClientPrekeyMap, UserClients, userClients) import Wire.API.User.Client.Prekey qualified as Public (PrekeyId) +import Wire.AuthenticationSubsystem as Authentication import Wire.DeleteQueue import Wire.EmailSending (EmailSending) import Wire.Error @@ -151,6 +156,7 @@ botAPI = servicesAPI :: ( Member GalleyAPIAccess r, + Member AuthenticationSubsystem r, Member DeleteQueue r, Member (Error UserSubsystemError) r ) => @@ -171,6 +177,7 @@ servicesAPI = providerAPI :: ( Member GalleyAPIAccess r, + Member AuthenticationSubsystem r, Member EmailSending r, Member VerificationCodeSubsystem r ) => @@ -265,20 +272,31 @@ activateAccountKey key val = do lift $ sendApprovalConfirmMail name email pure . Just $ Public.ProviderActivationResponse email -getActivationCodeH :: (Member GalleyAPIAccess r, Member VerificationCodeSubsystem r) => EmailAddress -> (Handler r) Code.KeyValuePair +getActivationCodeH :: + ( Member GalleyAPIAccess r, + Member VerificationCodeSubsystem r + ) => + EmailAddress -> + (Handler r) Code.KeyValuePair getActivationCodeH email = do guardSecondFactorDisabled Nothing let gen = mkVerificationCodeGen email code <- lift . liftSem $ internalLookupCode gen.genKey IdentityVerification maybe (throwStd activationKeyNotFound) (pure . codeToKeyValuePair) code -login :: (Member GalleyAPIAccess r) => ProviderLogin -> Handler r ProviderTokenCookie +login :: + ( Member GalleyAPIAccess r, + Member AuthenticationSubsystem r + ) => + ProviderLogin -> + Handler r ProviderTokenCookie login l = do guardSecondFactorDisabled Nothing - pid <- wrapClientE (DB.lookupKey (mkEmailKey (providerLoginEmail l))) >>= maybeBadCredentials - pass <- wrapClientE (DB.lookupPassword pid) >>= maybeBadCredentials - unless (verifyPassword (providerLoginPassword l) pass) $ - throwStd (errorToWai @'E.BadCredentials) + pid <- + wrapClientE (DB.lookupKey (mkEmailKey (providerLoginEmail l))) + >>= maybeBadCredentials + unlessM (lift . liftSem $ Authentication.verifyProviderPassword pid l.providerLoginPassword) do + throwStd (errorToWai @E.BadCredentials) token <- ZAuth.newProviderToken pid s <- asks (.settings) pure $ ProviderTokenCookie (ProviderToken token) (not s.cookieInsecure) @@ -295,16 +313,21 @@ beginPasswordReset (Public.PasswordReset target) = do Right code -> lift $ sendPasswordResetMail target (code.codeKey) (code.codeValue) -completePasswordReset :: (Member GalleyAPIAccess r, Member VerificationCodeSubsystem r) => Public.CompletePasswordReset -> (Handler r) () +completePasswordReset :: + ( Member GalleyAPIAccess r, + Member AuthenticationSubsystem r, + Member VerificationCodeSubsystem r + ) => + Public.CompletePasswordReset -> + (Handler r) () completePasswordReset (Public.CompletePasswordReset key val newpwd) = do guardSecondFactorDisabled Nothing code <- (lift . liftSem $ verifyCode key VerificationCode.PasswordReset val) >>= maybeInvalidCode case Id <$> code.codeAccount of - Nothing -> throwStd (errorToWai @'E.InvalidPasswordResetCode) + Nothing -> throwStd (errorToWai @E.InvalidPasswordResetCode) Just pid -> do - oldpass <- wrapClientE (DB.lookupPassword pid) >>= maybeBadCredentials - when (verifyPassword newpwd oldpass) $ do - throwStd (errorToWai @'E.ResetPasswordMustDiffer) + whenM (lift . liftSem $ Authentication.verifyProviderPassword pid newpwd) do + throwStd (errorToWai @E.ResetPasswordMustDiffer) wrapClientE $ do DB.updateAccountPassword pid newpwd lift . liftSem $ deleteCode key VerificationCode.PasswordReset @@ -328,7 +351,14 @@ updateAccountProfile pid upd = do (updateProviderUrl upd) (updateProviderDescr upd) -updateAccountEmail :: (Member GalleyAPIAccess r, Member EmailSending r, Member VerificationCodeSubsystem r) => ProviderId -> Public.EmailUpdate -> (Handler r) () +updateAccountEmail :: + ( Member GalleyAPIAccess r, + Member EmailSending r, + Member VerificationCodeSubsystem r + ) => + ProviderId -> + Public.EmailUpdate -> + (Handler r) () updateAccountEmail pid (Public.EmailUpdate email) = do guardSecondFactorDisabled Nothing let emailKey = mkEmailKey email @@ -344,14 +374,19 @@ updateAccountEmail pid (Public.EmailUpdate email) = do (Just (toUUID pid)) lift $ sendActivationMail (Name "name") email code.codeKey code.codeValue True -updateAccountPassword :: (Member GalleyAPIAccess r) => ProviderId -> Public.PasswordChange -> (Handler r) () +updateAccountPassword :: + ( Member GalleyAPIAccess r, + Member AuthenticationSubsystem r + ) => + ProviderId -> + Public.PasswordChange -> + (Handler r) () updateAccountPassword pid upd = do guardSecondFactorDisabled Nothing - pass <- wrapClientE (DB.lookupPassword pid) >>= maybeBadCredentials - unless (verifyPassword (oldPassword upd) pass) $ - throwStd (errorToWai @'E.BadCredentials) - when (verifyPassword (newPassword upd) pass) $ - throwStd (errorToWai @'E.ResetPasswordMustDiffer) + unlessM (lift . liftSem $ Authentication.verifyProviderPassword pid upd.oldPassword) do + throwStd (errorToWai @E.BadCredentials) + whenM (lift . liftSem $ Authentication.verifyProviderPassword pid upd.newPassword) do + throwStd (errorToWai @E.ResetPasswordMustDiffer) wrapClientE $ DB.updateAccountPassword pid (newPassword upd) addService :: @@ -424,16 +459,17 @@ updateService pid sid upd = do (serviceEnabled svc) updateServiceConn :: - (Member GalleyAPIAccess r) => + ( Member GalleyAPIAccess r, + Member AuthenticationSubsystem r + ) => ProviderId -> ServiceId -> Public.UpdateServiceConn -> Handler r () updateServiceConn pid sid upd = do guardSecondFactorDisabled Nothing - pass <- wrapClientE (DB.lookupPassword pid) >>= maybeBadCredentials - unless (verifyPassword (updateServiceConnPassword upd) pass) $ - throwStd (errorToWai @'E.BadCredentials) + unlessM (lift . liftSem $ Authentication.verifyProviderPassword pid upd.updateServiceConnPassword) $ + throwStd (errorToWai @E.BadCredentials) scon <- wrapClientE (DB.lookupServiceConn pid sid) >>= maybeServiceNotFound svc <- wrapClientE (DB.lookupServiceProfile pid sid) >>= maybeServiceNotFound let newBaseUrl = updateServiceConnUrl upd @@ -472,6 +508,7 @@ updateServiceConn pid sid upd = do -- delete the service. See 'finishDeleteService'. deleteService :: ( Member GalleyAPIAccess r, + Member AuthenticationSubsystem r, Member DeleteQueue r ) => ProviderId -> @@ -480,10 +517,8 @@ deleteService :: (Handler r) () deleteService pid sid del = do guardSecondFactorDisabled Nothing - pass <- wrapClientE (DB.lookupPassword pid) >>= maybeBadCredentials - -- We don't care about pwd status when deleting things - unless (verifyPassword (deleteServicePassword del) pass) $ - throwStd (errorToWai @'E.BadCredentials) + unlessM (lift . liftSem $ Authentication.verifyProviderPassword pid del.deleteServicePassword) do + throwStd (errorToWai @E.BadCredentials) _ <- wrapClientE (DB.lookupService pid sid) >>= maybeServiceNotFound -- Disable the service wrapClientE $ DB.updateServiceConn pid sid Nothing Nothing Nothing (Just False) @@ -516,7 +551,8 @@ finishDeleteService pid sid = do kick (bid, cid, _) = deleteBot (botUserId bid) Nothing bid cid deleteAccount :: - ( Member GalleyAPIAccess r + ( Member GalleyAPIAccess r, + Member AuthenticationSubsystem r ) => ProviderId -> Public.DeleteProvider -> @@ -524,10 +560,9 @@ deleteAccount :: deleteAccount pid del = do guardSecondFactorDisabled Nothing prov <- wrapClientE (DB.lookupAccount pid) >>= maybeInvalidProvider - pass <- wrapClientE (DB.lookupPassword pid) >>= maybeBadCredentials - -- We don't care about pwd status when deleting things - unless (verifyPassword (deleteProviderPassword del) pass) $ - throwStd (errorToWai @'E.BadCredentials) + -- We don't care about pwd update status (scrypt, argon2id etc) when deleting things + unlessM (lift . liftSem $ Authentication.verifyProviderPassword pid del.deleteProviderPassword) do + throwStd (errorToWai @E.BadCredentials) svcs <- wrapClientE $ DB.listServices pid forM_ svcs $ \svc -> do let sid = serviceId svc From 0ee692759b25850998c6113f1c0b6657c26e17ff Mon Sep 17 00:00:00 2001 From: Igor Ranieri Date: Thu, 26 Sep 2024 09:24:56 +0200 Subject: [PATCH 03/30] Improved handling of pwds between bots and users. --- .../src/Wire/AuthenticationSubsystem.hs | 14 +++----- .../AuthenticationSubsystem/Interpreter.hs | 34 ++++++++++++++----- services/brig/src/Brig/Provider/API.hs | 14 ++++---- 3 files changed, 36 insertions(+), 26 deletions(-) diff --git a/libs/wire-subsystems/src/Wire/AuthenticationSubsystem.hs b/libs/wire-subsystems/src/Wire/AuthenticationSubsystem.hs index effae7cde6b..218dc7f6bad 100644 --- a/libs/wire-subsystems/src/Wire/AuthenticationSubsystem.hs +++ b/libs/wire-subsystems/src/Wire/AuthenticationSubsystem.hs @@ -23,6 +23,7 @@ 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 (PasswordResetCode, PasswordResetIdentity) import Wire.UserKeyStore @@ -31,17 +32,10 @@ data AuthenticationSubsystem m a where VerifyPasswordE :: Local UserId -> PlainTextPassword6 -> AuthenticationSubsystem m () CreatePasswordResetCode :: EmailKey -> AuthenticationSubsystem m () ResetPassword :: PasswordResetIdentity -> PasswordResetCode -> PlainTextPassword8 -> AuthenticationSubsystem m () - VerifyPassword :: UserId -> PlainTextPassword6 -> AuthenticationSubsystem m Bool + 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) makeSem ''AuthenticationSubsystem - -verifyProviderPassword :: - (Member AuthenticationSubsystem r) => - ProviderId -> - PlainTextPassword6 -> - Sem r Bool -verifyProviderPassword pid pwd = - let uid = Id . toUUID $ pid - in verifyPassword uid pwd diff --git a/libs/wire-subsystems/src/Wire/AuthenticationSubsystem/Interpreter.hs b/libs/wire-subsystems/src/Wire/AuthenticationSubsystem/Interpreter.hs index 3a8cff06362..e67a408f6cb 100644 --- a/libs/wire-subsystems/src/Wire/AuthenticationSubsystem/Interpreter.hs +++ b/libs/wire-subsystems/src/Wire/AuthenticationSubsystem/Interpreter.hs @@ -74,7 +74,9 @@ interpretAuthenticationSubsystem userSubsystemInterpreter = VerifyPasswordE luid plaintext -> verifyPasswordEImpl luid plaintext CreatePasswordResetCode userKey -> createPasswordResetCodeImpl userKey ResetPassword ident resetCode newPassword -> resetPasswordImpl ident resetCode newPassword - VerifyPassword uid plaintext -> verifyPasswordImpl uid plaintext + VerifyPassword plaintext pwd -> verifyPasswordImpl plaintext pwd + VerifyUserPassword uid plaintext -> verifyUserPasswordImpl uid plaintext + VerifyProviderPassword pid plaintext -> verifyProviderPasswordImpl pid plaintext -- Testing InternalLookupPasswordResetCode userKey -> internalLookupPasswordResetCodeImpl userKey @@ -262,18 +264,32 @@ resetPasswordImpl ident code pw = do Nothing -> pure Nothing verifyPasswordImpl :: - ( Member (Error AuthenticationSubsystemError) r, - Member PasswordStore r - ) => + 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 pwd = + let uid = Id . toUUID $ pid + in verifyUserPasswordImpl uid pwd + +verifyUserPasswordImpl :: + (Member PasswordStore r, Member (Error AuthenticationSubsystemError) r) => UserId -> PlainTextPassword6 -> - Sem r Bool -verifyPasswordImpl uid plaintext = do + Sem r (Bool, PasswordStatus) +verifyUserPasswordImpl uid plaintext = do password <- -- We type-erase uid here, as this could be a provider or bot id. PasswordStore.lookupHashedPassword uid - >>= maybe (throw AuthenticationSubsystemMissingAuth) pure - pure $ Password.verifyPassword plaintext password + >>= maybe (throw AuthenticationSubsystemBadCredentials) pure + verifyPasswordImpl plaintext password verifyPasswordEImpl :: ( Member PasswordStore r, @@ -283,5 +299,5 @@ verifyPasswordEImpl :: PlainTextPassword6 -> Sem r () verifyPasswordEImpl (tUnqualified -> uid) password = do - unlessM (verifyPasswordImpl uid password) do + unlessM (fst <$> verifyUserPasswordImpl uid password) do throw AuthenticationSubsystemBadCredentials diff --git a/services/brig/src/Brig/Provider/API.hs b/services/brig/src/Brig/Provider/API.hs index 20048684420..ea9ad6b23eb 100644 --- a/services/brig/src/Brig/Provider/API.hs +++ b/services/brig/src/Brig/Provider/API.hs @@ -295,7 +295,7 @@ login l = do pid <- wrapClientE (DB.lookupKey (mkEmailKey (providerLoginEmail l))) >>= maybeBadCredentials - unlessM (lift . liftSem $ Authentication.verifyProviderPassword pid l.providerLoginPassword) do + unlessM (fst <$> (lift . liftSem $ Authentication.verifyProviderPassword pid l.providerLoginPassword)) do throwStd (errorToWai @E.BadCredentials) token <- ZAuth.newProviderToken pid s <- asks (.settings) @@ -326,7 +326,7 @@ completePasswordReset (Public.CompletePasswordReset key val newpwd) = do case Id <$> code.codeAccount of Nothing -> throwStd (errorToWai @E.InvalidPasswordResetCode) Just pid -> do - whenM (lift . liftSem $ Authentication.verifyProviderPassword pid newpwd) do + whenM (fst <$> (lift . liftSem $ Authentication.verifyProviderPassword pid newpwd)) do throwStd (errorToWai @E.ResetPasswordMustDiffer) wrapClientE $ do DB.updateAccountPassword pid newpwd @@ -383,9 +383,9 @@ updateAccountPassword :: (Handler r) () updateAccountPassword pid upd = do guardSecondFactorDisabled Nothing - unlessM (lift . liftSem $ Authentication.verifyProviderPassword pid upd.oldPassword) do + unlessM (fst <$> (lift . liftSem $ Authentication.verifyProviderPassword pid upd.oldPassword)) do throwStd (errorToWai @E.BadCredentials) - whenM (lift . liftSem $ Authentication.verifyProviderPassword pid upd.newPassword) do + whenM (fst <$> (lift . liftSem $ Authentication.verifyProviderPassword pid upd.newPassword)) do throwStd (errorToWai @E.ResetPasswordMustDiffer) wrapClientE $ DB.updateAccountPassword pid (newPassword upd) @@ -468,7 +468,7 @@ updateServiceConn :: Handler r () updateServiceConn pid sid upd = do guardSecondFactorDisabled Nothing - unlessM (lift . liftSem $ Authentication.verifyProviderPassword pid upd.updateServiceConnPassword) $ + unlessM (fst <$> (lift . liftSem $ Authentication.verifyProviderPassword pid upd.updateServiceConnPassword)) $ throwStd (errorToWai @E.BadCredentials) scon <- wrapClientE (DB.lookupServiceConn pid sid) >>= maybeServiceNotFound svc <- wrapClientE (DB.lookupServiceProfile pid sid) >>= maybeServiceNotFound @@ -517,7 +517,7 @@ deleteService :: (Handler r) () deleteService pid sid del = do guardSecondFactorDisabled Nothing - unlessM (lift . liftSem $ Authentication.verifyProviderPassword pid del.deleteServicePassword) do + unlessM (fst <$> (lift . liftSem $ Authentication.verifyProviderPassword pid del.deleteServicePassword)) do throwStd (errorToWai @E.BadCredentials) _ <- wrapClientE (DB.lookupService pid sid) >>= maybeServiceNotFound -- Disable the service @@ -561,7 +561,7 @@ deleteAccount pid del = do guardSecondFactorDisabled Nothing prov <- wrapClientE (DB.lookupAccount pid) >>= maybeInvalidProvider -- We don't care about pwd update status (scrypt, argon2id etc) when deleting things - unlessM (lift . liftSem $ Authentication.verifyProviderPassword pid del.deleteProviderPassword) do + unlessM (fst <$> (lift . liftSem $ Authentication.verifyProviderPassword pid del.deleteProviderPassword)) do throwStd (errorToWai @E.BadCredentials) svcs <- wrapClientE $ DB.listServices pid forM_ svcs $ \svc -> do From 33ebee707a6b71e70e395442995ff2ae8030c95f Mon Sep 17 00:00:00 2001 From: Igor Ranieri Date: Thu, 26 Sep 2024 12:11:20 +0200 Subject: [PATCH 04/30] [brig] Use auth subsystem to verify pwds. --- services/brig/src/Brig/API/Auth.hs | 14 +++++++++---- services/brig/src/Brig/API/Client.hs | 12 ++++++++---- services/brig/src/Brig/API/Internal.hs | 6 ++++-- services/brig/src/Brig/API/OAuth.hs | 27 +++++++++++++++++++++----- services/brig/src/Brig/API/Public.hs | 5 ++++- services/brig/src/Brig/Data/Client.hs | 18 +++++++++-------- services/brig/src/Brig/Data/User.hs | 26 +++++++++++++++---------- services/brig/src/Brig/Provider/API.hs | 22 ++++++++++++++++++--- services/brig/src/Brig/User/Auth.hs | 15 +++++++++----- 9 files changed, 103 insertions(+), 42 deletions(-) diff --git a/services/brig/src/Brig/API/Auth.hs b/services/brig/src/Brig/API/Auth.hs index 578bb4629bc..2b9421b14c2 100644 --- a/services/brig/src/Brig/API/Auth.hs +++ b/services/brig/src/Brig/API/Auth.hs @@ -49,6 +49,7 @@ import Wire.API.User.Auth hiding (access) import Wire.API.User.Auth.LegalHold import Wire.API.User.Auth.ReAuth import Wire.API.User.Auth.Sso +import Wire.AuthenticationSubsystem (AuthenticationSubsystem) import Wire.BlockListStore import Wire.EmailSubsystem (EmailSubsystem) import Wire.Events (Events) @@ -102,7 +103,8 @@ login :: Member Events r, Member (Input (Local ())) r, Member UserSubsystem r, - Member VerificationCodeSubsystem r + Member VerificationCodeSubsystem r, + Member AuthenticationSubsystem r ) => Login -> Maybe Bool -> @@ -161,7 +163,8 @@ listCookies lusr (fold -> labels) = removeCookies :: ( Member TinyLog r, Member PasswordStore r, - Member UserSubsystem r + Member UserSubsystem r, + Member AuthenticationSubsystem r ) => Local UserId -> RemoveCookies -> @@ -173,7 +176,8 @@ legalHoldLogin :: ( Member GalleyAPIAccess r, Member TinyLog r, Member UserSubsystem r, - Member Events r + Member Events r, + Member AuthenticationSubsystem r ) => LegalHoldLogin -> Handler r SomeAccess @@ -184,6 +188,7 @@ legalHoldLogin lhl = do ssoLogin :: ( Member TinyLog r, + Member AuthenticationSubsystem r, Member UserSubsystem r, Member Events r ) => @@ -201,13 +206,14 @@ getLoginCode _ = throwStd loginCodeNotFound reauthenticate :: ( Member GalleyAPIAccess r, Member VerificationCodeSubsystem r, + Member AuthenticationSubsystem r, Member UserSubsystem r ) => Local UserId -> ReAuthUser -> Handler r () reauthenticate luid@(tUnqualified -> uid) body = do - wrapClientE (User.reauthenticate uid (reAuthPassword body)) !>> reauthError + (User.reauthenticate uid (reAuthPassword body)) !>> reauthError case reAuthCodeAction body of Just action -> Auth.verifyCode (reAuthCode body) action luid diff --git a/services/brig/src/Brig/API/Client.hs b/services/brig/src/Brig/API/Client.hs index ce9cd717a7e..d5282714d12 100644 --- a/services/brig/src/Brig/API/Client.hs +++ b/services/brig/src/Brig/API/Client.hs @@ -102,6 +102,7 @@ import Wire.API.User.Client.DPoPAccessToken import Wire.API.User.Client.Prekey import Wire.API.UserEvent import Wire.API.UserMap (QualifiedUserMap (QualifiedUserMap, qualifiedUserMap), UserMap (userMap)) +import Wire.AuthenticationSubsystem (AuthenticationSubsystem) import Wire.DeleteQueue import Wire.EmailSubsystem (EmailSubsystem, sendNewClientEmail) import Wire.Events (Events) @@ -165,6 +166,7 @@ addClient :: Member UserSubsystem r, Member DeleteQueue r, Member EmailSubsystem r, + Member AuthenticationSubsystem r, Member VerificationCodeSubsystem r, Member Events r ) => @@ -184,6 +186,7 @@ addClientWithReAuthPolicy :: Member EmailSubsystem r, Member Events r, Member UserSubsystem r, + Member AuthenticationSubsystem r, Member VerificationCodeSubsystem r ) => Data.ReAuthPolicy -> @@ -207,8 +210,7 @@ addClientWithReAuthPolicy policy luid@(tUnqualified -> u) con new = do else id lhcaps = ClientSupportsLegalholdImplicitConsent (clt0, old, count) <- - wrapClientE - (Data.addClientWithReAuthPolicy policy luid clientId' new maxPermClients caps) + Data.addClientWithReAuthPolicy policy luid clientId' new maxPermClients caps !>> ClientDataError let clt = clt0 {clientMLSPublicKeys = newClientMLSPublicKeys new} lift $ do @@ -251,7 +253,9 @@ updateClient u c r = do -- nb. We must ensure that the set of clients known to brig is always -- a superset of the clients known to galley. rmClient :: - (Member DeleteQueue r) => + ( Member DeleteQueue r, + Member AuthenticationSubsystem r + ) => UserId -> ConnId -> ClientId -> @@ -267,7 +271,7 @@ rmClient u con clt pw = -- Temporary clients don't need to re-auth TemporaryClientType -> pure () -- All other clients must authenticate - _ -> wrapClientE (Data.reauthenticate u pw) !>> ClientDataError . ClientReAuthError + _ -> Data.reauthenticate u pw !>> ClientDataError . ClientReAuthError lift $ execDelete u (Just con) client claimPrekey :: diff --git a/services/brig/src/Brig/API/Internal.hs b/services/brig/src/Brig/API/Internal.hs index d5abf271fc1..052c5cdb59f 100644 --- a/services/brig/src/Brig/API/Internal.hs +++ b/services/brig/src/Brig/API/Internal.hs @@ -275,7 +275,8 @@ authAPI :: Member TinyLog r, Member Events r, Member UserSubsystem r, - Member VerificationCodeSubsystem r + Member VerificationCodeSubsystem r, + Member AuthenticationSubsystem r ) => ServerT BrigIRoutes.AuthAPI (Handler r) authAPI = @@ -425,7 +426,8 @@ addClientInternalH :: Member EmailSubsystem r, Member Events r, Member UserSubsystem r, - Member VerificationCodeSubsystem r + Member VerificationCodeSubsystem r, + Member AuthenticationSubsystem r ) => UserId -> Maybe Bool -> diff --git a/services/brig/src/Brig/API/OAuth.hs b/services/brig/src/Brig/API/OAuth.hs index 97e23180230..0ab2f89a4fe 100644 --- a/services/brig/src/Brig/API/OAuth.hs +++ b/services/brig/src/Brig/API/OAuth.hs @@ -56,6 +56,7 @@ import Wire.API.Password import Wire.API.Routes.Internal.Brig.OAuth qualified as I import Wire.API.Routes.Named (Named (Named)) import Wire.API.Routes.Public.Brig.OAuth +import Wire.AuthenticationSubsystem (AuthenticationSubsystem) import Wire.Error import Wire.Sem.Jwk import Wire.Sem.Jwk qualified as Jwk @@ -75,7 +76,12 @@ internalOauthAPI = -------------------------------------------------------------------------------- -- API Public -oauthAPI :: (Member Now r, Member Jwk r) => ServerT OAuthAPI (Handler r) +oauthAPI :: + ( Member Now r, + Member Jwk r, + Member AuthenticationSubsystem r + ) => + ServerT OAuthAPI (Handler r) oauthAPI = Named @"get-oauth-client" getOAuthClient :<|> Named @"create-oauth-auth-code" createNewOAuthAuthorizationCode @@ -345,17 +351,28 @@ revokeOAuthAccountAccessV6 (tUnqualified -> uid) cid = do rts <- lift $ wrapClient $ lookupOAuthRefreshTokens uid for_ rts $ \rt -> when (rt.clientId == cid) $ lift $ wrapClient $ deleteOAuthRefreshToken uid rt.refreshTokenId -revokeOAuthAccountAccess :: Local UserId -> OAuthClientId -> PasswordReqBody -> (Handler r) () +revokeOAuthAccountAccess :: + (Member AuthenticationSubsystem r) => + Local UserId -> + OAuthClientId -> + PasswordReqBody -> + (Handler r) () revokeOAuthAccountAccess luid@(tUnqualified -> uid) cid req = do - wrapClientE (reauthenticate uid req.fromPasswordReqBody) !>> toAccessDenied + reauthenticate uid req.fromPasswordReqBody !>> toAccessDenied revokeOAuthAccountAccessV6 luid cid where toAccessDenied :: ReAuthError -> HttpError toAccessDenied _ = StdError $ errorToWai @'AccessDenied -deleteOAuthRefreshTokenById :: Local UserId -> OAuthClientId -> OAuthRefreshTokenId -> PasswordReqBody -> (Handler r) () +deleteOAuthRefreshTokenById :: + (Member AuthenticationSubsystem r) => + Local UserId -> + OAuthClientId -> + OAuthRefreshTokenId -> + PasswordReqBody -> + (Handler r) () deleteOAuthRefreshTokenById (tUnqualified -> uid) cid tokenId req = do - wrapClientE (reauthenticate uid req.fromPasswordReqBody) !>> toAccessDenied + reauthenticate uid req.fromPasswordReqBody !>> toAccessDenied mInfo <- lift $ wrapClient $ lookupOAuthRefreshTokenInfo tokenId case mInfo of Nothing -> pure () diff --git a/services/brig/src/Brig/API/Public.hs b/services/brig/src/Brig/API/Public.hs index 838d5979403..017f225a190 100644 --- a/services/brig/src/Brig/API/Public.hs +++ b/services/brig/src/Brig/API/Public.hs @@ -588,6 +588,7 @@ addClient :: Member DeleteQueue r, Member NotificationSubsystem r, Member EmailSubsystem r, + Member AuthenticationSubsystem r, Member VerificationCodeSubsystem r, Member Events r, Member UserSubsystem r @@ -604,7 +605,9 @@ addClient lusr con new = do !>> clientError deleteClient :: - (Member DeleteQueue r) => + ( Member AuthenticationSubsystem r, + Member DeleteQueue r + ) => UserId -> ConnId -> ClientId -> diff --git a/services/brig/src/Brig/Data/Client.hs b/services/brig/src/Brig/Data/Client.hs index 42f92476fc9..201f60ab49d 100644 --- a/services/brig/src/Brig/Data/Client.hs +++ b/services/brig/src/Brig/Data/Client.hs @@ -79,6 +79,7 @@ import Data.Text qualified as Text import Data.Time.Clock import Data.UUID qualified as UUID import Imports +import Polysemy (Member) import Prometheus qualified as Prom import System.CryptoBox (Result (Success)) import System.CryptoBox qualified as CryptoBox @@ -90,6 +91,7 @@ import Wire.API.User.Auth import Wire.API.User.Client hiding (UpdateClient (..)) import Wire.API.User.Client.Prekey import Wire.API.UserMap (UserMap (..)) +import Wire.AuthenticationSubsystem (AuthenticationSubsystem) data ClientDataError = TooManyClients @@ -116,20 +118,20 @@ reAuthForNewClients :: ReAuthPolicy reAuthForNewClients count upsert = count > 0 && not upsert addClient :: - ( MonadClient m, - MonadReader Brig.App.Env m + ( MonadReader Brig.App.Env (AppT r), + Member AuthenticationSubsystem r ) => Local UserId -> ClientId -> NewClient -> Int -> Maybe ClientCapabilityList -> - ExceptT ClientDataError m (Client, [Client], Word) + ExceptT ClientDataError (AppT r) (Client, [Client], Word) addClient = addClientWithReAuthPolicy reAuthForNewClients addClientWithReAuthPolicy :: - ( MonadClient m, - MonadReader Brig.App.Env m + ( MonadReader Brig.App.Env (AppT r), + Member AuthenticationSubsystem r ) => ReAuthPolicy -> Local UserId -> @@ -137,9 +139,9 @@ addClientWithReAuthPolicy :: NewClient -> Int -> Maybe ClientCapabilityList -> - ExceptT ClientDataError m (Client, [Client], Word) + ExceptT ClientDataError (AppT r) (Client, [Client], Word) addClientWithReAuthPolicy reAuthPolicy u newId c maxPermClients caps = do - clients <- lookupClients (tUnqualified u) + clients <- wrapClientE $ lookupClients (tUnqualified u) let typed = filter ((== newClientType c) . clientType) clients let count = length typed let upsert = any exists typed @@ -149,7 +151,7 @@ addClientWithReAuthPolicy reAuthPolicy u newId c maxPermClients caps = do let capacity = fmap (+ (-count)) limit unless (maybe True (> 0) capacity || upsert) $ throwE TooManyClients - new <- insert (tUnqualified u) + new <- wrapClientE $ insert (tUnqualified u) let !total = fromIntegral (length clients + if upsert then 0 else 1) let old = maybe (filter (not . exists) typed) (const []) limit pure (new, old, total) diff --git a/services/brig/src/Brig/Data/User.hs b/services/brig/src/Brig/Data/User.hs index d8c78110db2..7db8a6e7e79 100644 --- a/services/brig/src/Brig/Data/User.hs +++ b/services/brig/src/Brig/Data/User.hs @@ -86,6 +86,7 @@ import Wire.API.Provider.Service import Wire.API.Team.Feature import Wire.API.User import Wire.API.User.RichInfo +import Wire.AuthenticationSubsystem as AuthenticationSubsystem import Wire.PasswordStore -- | Authentication errors. @@ -180,8 +181,14 @@ newAccountInviteViaScim uid externalId tid locale name email = do defSupportedProtocols -- | Mandatory password authentication. -authenticate :: forall r. (Member PasswordStore r) => UserId -> PlainTextPassword6 -> ExceptT AuthError (AppT r) () +authenticate :: + forall r. + (Member PasswordStore r, Member AuthenticationSubsystem r) => + UserId -> + PlainTextPassword6 -> + ExceptT AuthError (AppT r) () authenticate u pw = + -- TODO: Move this logic into auth subsystem. lift (wrapHttp $ lookupAuth u) >>= \case Nothing -> throwE AuthInvalidUser Just (_, Deleted) -> throwE AuthInvalidUser @@ -189,8 +196,9 @@ authenticate u pw = Just (_, Ephemeral) -> throwE AuthEphemeral Just (_, PendingInvitation) -> throwE AuthPendingInvitation Just (Nothing, _) -> throwE AuthInvalidCredentials - Just (Just pw', Active) -> - case verifyPasswordWithStatus pw pw' of + Just (Just pw', Active) -> do + res <- lift $ liftSem (AuthenticationSubsystem.verifyPassword pw pw') + case res of (False, _) -> throwE AuthInvalidCredentials (True, PasswordStatusNeedsUpdate) -> do -- FUTUREWORK(elland): 6char pwd allowed for now @@ -207,14 +215,12 @@ authenticate u pw = -- is mandatory. If the account has no password, or is an SSO user, and no password is given, -- reauthentication is a no-op. reauthenticate :: - ( MonadClient m, - MonadReader Env m - ) => + (Member AuthenticationSubsystem r) => UserId -> Maybe PlainTextPassword6 -> - ExceptT ReAuthError m () + ExceptT ReAuthError (AppT r) () reauthenticate u pw = - lift (lookupAuth u) >>= \case + wrapClientE (lookupAuth u) >>= \case Nothing -> throwE (ReAuthError AuthInvalidUser) Just (_, Deleted) -> throwE (ReAuthError AuthInvalidUser) Just (_, Suspended) -> throwE (ReAuthError AuthSuspended) @@ -225,10 +231,10 @@ reauthenticate u pw = where maybeReAuth pw' = case pw of Nothing -> do - musr <- lookupUser NoPendingInvitations u + musr <- wrapClientE $ lookupUser NoPendingInvitations u unless (maybe False isSamlUser musr) $ throwE ReAuthMissingPassword Just p -> - unless (verifyPassword p pw') $ + unlessM (fst <$> lift (liftSem (AuthenticationSubsystem.verifyPassword p pw'))) do throwE (ReAuthError AuthInvalidCredentials) isSamlUser :: User -> Bool diff --git a/services/brig/src/Brig/Provider/API.hs b/services/brig/src/Brig/Provider/API.hs index ea9ad6b23eb..3c195a5bf84 100644 --- a/services/brig/src/Brig/Provider/API.hs +++ b/services/brig/src/Brig/Provider/API.hs @@ -138,7 +138,8 @@ import Wire.VerificationCodeSubsystem botAPI :: ( Member GalleyAPIAccess r, Member (Concurrency 'Unsafe) r, - Member DeleteQueue r + Member DeleteQueue r, + Member AuthenticationSubsystem r ) => ServerT BotAPI (Handler r) botAPI = @@ -691,7 +692,15 @@ updateServiceWhitelist uid con tid upd = do -------------------------------------------------------------------------------- -- Bot API -addBot :: (Member GalleyAPIAccess r) => UserId -> ConnId -> ConvId -> Public.AddBot -> (Handler r) Public.AddBotResponse +addBot :: + ( Member GalleyAPIAccess r, + Member AuthenticationSubsystem r + ) => + UserId -> + ConnId -> + ConvId -> + Public.AddBot -> + (Handler r) Public.AddBotResponse addBot zuid zcon cid add = do guardSecondFactorDisabled (Just zuid) zusr <- lift (wrapClient $ User.lookupUser NoPendingInvitations zuid) >>= maybeInvalidUser @@ -761,7 +770,14 @@ addBot zuid zcon cid add = do -- implicitly in the next line. pure $ FutureWork @'UnprotectedBot undefined lbid <- qualifyLocal (botUserId bid) - wrapClientE (User.addClient lbid bcl newClt maxPermClients (Just $ ClientCapabilityList $ Set.singleton Public.ClientSupportsLegalholdImplicitConsent)) + ( User.addClient + lbid + bcl + newClt + maxPermClients + ( Just $ ClientCapabilityList $ Set.singleton Public.ClientSupportsLegalholdImplicitConsent + ) + ) !>> const (StdError $ badGatewayWith "MalformedPrekeys") -- Add the bot to the conversation diff --git a/services/brig/src/Brig/User/Auth.hs b/services/brig/src/Brig/User/Auth.hs index 39c5b1ef139..597c8156554 100644 --- a/services/brig/src/Brig/User/Auth.hs +++ b/services/brig/src/Brig/User/Auth.hs @@ -72,6 +72,7 @@ import Wire.API.User import Wire.API.User.Auth import Wire.API.User.Auth.LegalHold import Wire.API.User.Auth.Sso +import Wire.AuthenticationSubsystem (AuthenticationSubsystem) import Wire.Events (Events) import Wire.GalleyAPIAccess (GalleyAPIAccess) import Wire.GalleyAPIAccess qualified as GalleyAPIAccess @@ -95,7 +96,8 @@ login :: Member VerificationCodeSubsystem r, Member (Input (Local ())) r, Member UserSubsystem r, - Member Events r + Member Events r, + Member AuthenticationSubsystem r ) => Login -> CookieType -> @@ -218,7 +220,8 @@ renewAccess uts at mcid = do revokeAccess :: ( Member TinyLog r, Member PasswordStore r, - Member UserSubsystem r + Member UserSubsystem r, + Member AuthenticationSubsystem r ) => Local UserId -> PlainTextPassword6 -> @@ -379,13 +382,14 @@ validateToken ut at = do ssoLogin :: ( Member TinyLog r, Member UserSubsystem r, - Member Events r + Member Events r, + Member AuthenticationSubsystem r ) => SsoLogin -> CookieType -> ExceptT LoginError (AppT r) (Access ZAuth.User) ssoLogin (SsoLogin uid label) typ = do - wrapHttpClientE (Data.reauthenticate uid Nothing) `catchE` \case + (Data.reauthenticate uid Nothing) `catchE` \case ReAuthMissingPassword -> pure () ReAuthCodeVerificationRequired -> pure () ReAuthCodeVerificationNoPendingCode -> pure () @@ -403,13 +407,14 @@ legalHoldLogin :: ( Member GalleyAPIAccess r, Member TinyLog r, Member UserSubsystem r, + Member AuthenticationSubsystem r, Member Events r ) => LegalHoldLogin -> CookieType -> ExceptT LegalHoldLoginError (AppT r) (Access ZAuth.LegalHoldUser) legalHoldLogin (LegalHoldLogin uid pw label) typ = do - wrapHttpClientE (Data.reauthenticate uid pw) !>> LegalHoldReAuthError + (Data.reauthenticate uid pw) !>> LegalHoldReAuthError -- legalhold login is only possible if -- the user is a team user -- and the team has legalhold enabled From 4b22fc4330d9ac3975aaa7435071be6588abeae9 Mon Sep 17 00:00:00 2001 From: Igor Ranieri Date: Thu, 26 Sep 2024 14:15:49 +0200 Subject: [PATCH 05/30] Adapt argon2id params. --- libs/wire-api/src/Wire/API/Password.hs | 19 ++++++++++--------- .../InterpreterSpec.hs | 1 + 2 files changed, 11 insertions(+), 9 deletions(-) diff --git a/libs/wire-api/src/Wire/API/Password.hs b/libs/wire-api/src/Wire/API/Password.hs index 39af70530df..3a753fc7c82 100644 --- a/libs/wire-api/src/Wire/API/Password.hs +++ b/libs/wire-api/src/Wire/API/Password.hs @@ -113,8 +113,8 @@ defaultOptions :: Argon2idOptions defaultOptions = Argon2.Options { iterations = 1, - memory = 2 ^ (21 :: Int), - parallelism = 4, + memory = 2 ^ (32 :: Int), + parallelism = 8, variant = Argon2.Argon2id, version = Argon2.Version13 } @@ -170,7 +170,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 @@ -279,12 +279,13 @@ 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 = 32 + 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 + -- unless we've caused it ourselves. + CryptoFailed cErr -> error $ "Impossible error: " <> show cErr + CryptoPassed hash -> hash hashPasswordWithParams :: ( ByteArrayAccess password, diff --git a/libs/wire-subsystems/test/unit/Wire/AuthenticationSubsystem/InterpreterSpec.hs b/libs/wire-subsystems/test/unit/Wire/AuthenticationSubsystem/InterpreterSpec.hs index c9ca63d208a..f553aa595dc 100644 --- a/libs/wire-subsystems/test/unit/Wire/AuthenticationSubsystem/InterpreterSpec.hs +++ b/libs/wire-subsystems/test/unit/Wire/AuthenticationSubsystem/InterpreterSpec.hs @@ -189,6 +189,7 @@ spec = describe "AuthenticationSubsystem.Interpreter" do -- Reset password still works with previously generated reset code resetPassword (PasswordResetEmailIdentity email) code newPassword + (,mCaughtExc) <$> lookupHashedPassword uid in (fmap (Password.verifyPassword newPassword) newPasswordHash === Just True) .&&. (mCaughtException === Nothing) From f4ce01a2f4140a00b54a951f3bc24dbbe3a7e540 Mon Sep 17 00:00:00 2001 From: Igor Ranieri Date: Thu, 26 Sep 2024 15:24:36 +0200 Subject: [PATCH 06/30] Adjusted params again, updated tests. --- libs/wire-api/src/Wire/API/Password.hs | 15 ++++++++++++--- libs/wire-api/test/unit/Test/Wire/API/Password.hs | 4 +--- 2 files changed, 13 insertions(+), 6 deletions(-) diff --git a/libs/wire-api/src/Wire/API/Password.hs b/libs/wire-api/src/Wire/API/Password.hs index 3a753fc7c82..bfbaf5e6817 100644 --- a/libs/wire-api/src/Wire/API/Password.hs +++ b/libs/wire-api/src/Wire/API/Password.hs @@ -28,6 +28,7 @@ module Wire.API.Password PasswordReqBody (..), -- * Only for testing + genTestPasswords, unsafeMkPassword, hashPasswordArgon2idWithSalt, hashPasswordArgon2idWithOptions, @@ -113,7 +114,7 @@ defaultOptions :: Argon2idOptions defaultOptions = Argon2.Options { iterations = 1, - memory = 2 ^ (32 :: Int), + memory = 2 ^ (22 :: Int), parallelism = 8, variant = Argon2.Argon2id, version = Argon2.Version13 @@ -279,11 +280,10 @@ parseScryptPasswordHashParams passwordHash = do hashPasswordWithOptions :: Argon2idOptions -> ByteString -> ByteString -> ByteString hashPasswordWithOptions opts password salt = - let tagSize = 32 + 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 - -- unless we've caused it ourselves. CryptoFailed cErr -> error $ "Impossible error: " <> show cErr CryptoPassed hash -> hash @@ -355,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) diff --git a/libs/wire-api/test/unit/Test/Wire/API/Password.hs b/libs/wire-api/test/unit/Test/Wire/API/Password.hs index dcbd630ca8c..c4003a9a164 100644 --- a/libs/wire-api/test/unit/Test/Wire/API/Password.hs +++ b/libs/wire-api/test/unit/Test/Wire/API/Password.hs @@ -32,12 +32,10 @@ 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 From e8954ca325acb23d019e75ec87f4a13944f55c35 Mon Sep 17 00:00:00 2001 From: Igor Ranieri Date: Thu, 26 Sep 2024 16:26:39 +0200 Subject: [PATCH 07/30] Fixed test. --- libs/wire-api/test/unit/Test/Wire/API/Password.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libs/wire-api/test/unit/Test/Wire/API/Password.hs b/libs/wire-api/test/unit/Test/Wire/API/Password.hs index c4003a9a164..07fe7185866 100644 --- a/libs/wire-api/test/unit/Test/Wire/API/Password.hs +++ b/libs/wire-api/test/unit/Test/Wire/API/Password.hs @@ -54,7 +54,7 @@ testUpdateHash = do -- 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 From cda74314db558dfcc344d6c34cfaaa0c2d1ed45b Mon Sep 17 00:00:00 2001 From: Igor Ranieri Date: Wed, 2 Oct 2024 10:14:20 +0200 Subject: [PATCH 08/30] Added changelog. --- changelog.d/5-internal/pwd | 1 + 1 file changed, 1 insertion(+) create mode 100644 changelog.d/5-internal/pwd diff --git a/changelog.d/5-internal/pwd b/changelog.d/5-internal/pwd new file mode 100644 index 00000000000..d0789bc9df4 --- /dev/null +++ b/changelog.d/5-internal/pwd @@ -0,0 +1 @@ +Changed default password hashing from Scrypt to Argon2id. From 0c48e8db865430dedf46a14744401f7d4bb66c5e Mon Sep 17 00:00:00 2001 From: Igor Ranieri Date: Wed, 2 Oct 2024 14:44:49 +0200 Subject: [PATCH 09/30] Fixed bug with provider pwd. --- .../src/Wire/AuthenticationSubsystem/Interpreter.hs | 10 ++++++---- libs/wire-subsystems/src/Wire/PasswordStore.hs | 1 + .../src/Wire/PasswordStore/Cassandra.hs | 10 ++++++++++ .../unit/Wire/MockInterpreters/PasswordStore.hs | 3 +++ services/brig/src/Brig/Provider/DB.hs | 13 ------------- 5 files changed, 20 insertions(+), 17 deletions(-) diff --git a/libs/wire-subsystems/src/Wire/AuthenticationSubsystem/Interpreter.hs b/libs/wire-subsystems/src/Wire/AuthenticationSubsystem/Interpreter.hs index e67a408f6cb..a584722a5de 100644 --- a/libs/wire-subsystems/src/Wire/AuthenticationSubsystem/Interpreter.hs +++ b/libs/wire-subsystems/src/Wire/AuthenticationSubsystem/Interpreter.hs @@ -275,9 +275,12 @@ verifyProviderPasswordImpl :: ProviderId -> PlainTextPassword6 -> Sem r (Bool, PasswordStatus) -verifyProviderPasswordImpl pid pwd = - let uid = Id . toUUID $ pid - in verifyUserPasswordImpl uid pwd +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) => @@ -286,7 +289,6 @@ verifyUserPasswordImpl :: Sem r (Bool, PasswordStatus) verifyUserPasswordImpl uid plaintext = do password <- - -- We type-erase uid here, as this could be a provider or bot id. PasswordStore.lookupHashedPassword uid >>= maybe (throw AuthenticationSubsystemBadCredentials) pure verifyPasswordImpl plaintext password diff --git a/libs/wire-subsystems/src/Wire/PasswordStore.hs b/libs/wire-subsystems/src/Wire/PasswordStore.hs index 48a358aa827..54b66aa02ea 100644 --- a/libs/wire-subsystems/src/Wire/PasswordStore.hs +++ b/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 diff --git a/libs/wire-subsystems/src/Wire/PasswordStore/Cassandra.hs b/libs/wire-subsystems/src/Wire/PasswordStore/Cassandra.hs index 933faeb298d..1503e2152cb 100644 --- a/libs/wire-subsystems/src/Wire/PasswordStore/Cassandra.hs +++ b/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 = ?" diff --git a/libs/wire-subsystems/test/unit/Wire/MockInterpreters/PasswordStore.hs b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/PasswordStore.hs index a90b9184eab..921eb00ebfa 100644 --- a/libs/wire-subsystems/test/unit/Wire/MockInterpreters/PasswordStore.hs +++ b/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) diff --git a/services/brig/src/Brig/Provider/DB.hs b/services/brig/src/Brig/Provider/DB.hs index c285d2417db..b5bb0243120 100644 --- a/services/brig/src/Brig/Provider/DB.hs +++ b/services/brig/src/Brig/Provider/DB.hs @@ -103,19 +103,6 @@ lookupAccountProfile :: m (Maybe ProviderProfile) lookupAccountProfile p = fmap ProviderProfile <$> lookupAccount p -lookupPassword :: - (MonadClient m) => - ProviderId -> - m (Maybe Password) -lookupPassword p = - fmap (fmap runIdentity) $ - retry x1 $ - query1 cql $ - params LocalQuorum (Identity p) - where - cql :: PrepQuery R (Identity ProviderId) (Identity Password) - cql = "SELECT password FROM provider WHERE id = ?" - deleteAccount :: (MonadClient m) => ProviderId -> From 789bc9b488afb85ef09004eacd00102cea813c9a Mon Sep 17 00:00:00 2001 From: Igor Ranieri Date: Wed, 2 Oct 2024 14:58:19 +0200 Subject: [PATCH 10/30] Increase tolerance for local user suspension in integration tests. --- services/brig/brig.integration.yaml | 2 +- services/brig/src/Brig/API/Auth.hs | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/services/brig/brig.integration.yaml b/services/brig/brig.integration.yaml index 6333a9fe1c0..3aa2ea8ba36 100644 --- a/services/brig/brig.integration.yaml +++ b/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 diff --git a/services/brig/src/Brig/API/Auth.hs b/services/brig/src/Brig/API/Auth.hs index 2b9421b14c2..4c3e9c4a563 100644 --- a/services/brig/src/Brig/API/Auth.hs +++ b/services/brig/src/Brig/API/Auth.hs @@ -213,7 +213,7 @@ reauthenticate :: ReAuthUser -> Handler r () reauthenticate luid@(tUnqualified -> uid) body = do - (User.reauthenticate uid (reAuthPassword body)) !>> reauthError + User.reauthenticate uid body.reAuthPassword !>> reauthError case reAuthCodeAction body of Just action -> Auth.verifyCode (reAuthCode body) action luid From 7ba0b80ab36554b8b7f7a8657e4e2fa6d3b0335d Mon Sep 17 00:00:00 2001 From: Igor Ranieri Date: Wed, 2 Oct 2024 15:51:39 +0200 Subject: [PATCH 11/30] Use Scrypt for OAuth. --- services/brig/src/Brig/API/OAuth.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/services/brig/src/Brig/API/OAuth.hs b/services/brig/src/Brig/API/OAuth.hs index 0ab2f89a4fe..af0194d2f6d 100644 --- a/services/brig/src/Brig/API/OAuth.hs +++ b/services/brig/src/Brig/API/OAuth.hs @@ -106,8 +106,9 @@ registerOAuthClient (OAuthClientConfig name uri) = do createSecret :: (MonadIO m) => m OAuthClientPlainTextSecret createSecret = OAuthClientPlainTextSecret <$> rand32Bytes + -- TODO(elland): figure out why hashClientSecret :: (MonadIO m) => OAuthClientPlainTextSecret -> m Password - hashClientSecret = mkSafePassword . plainTextPassword8Unsafe . toText . unOAuthClientPlainTextSecret + hashClientSecret = mkSafePasswordScrypt . plainTextPassword8Unsafe . toText . unOAuthClientPlainTextSecret rand32Bytes :: (MonadIO m) => m AsciiBase16 rand32Bytes = liftIO . fmap encodeBase16 $ randBytes 32 From a4c3b967864b0e9ade3fc44432ec985792fdb6c2 Mon Sep 17 00:00:00 2001 From: Igor Ranieri Date: Wed, 2 Oct 2024 16:25:55 +0200 Subject: [PATCH 12/30] [wip] Use scrypt in select places. --- services/brig/src/Brig/Data/User.hs | 2 +- services/brig/src/Brig/Provider/API.hs | 14 +++++++------- services/brig/src/Brig/Provider/DB.hs | 2 +- services/galley/src/Galley/API/Update.hs | 4 ++-- 4 files changed, 11 insertions(+), 11 deletions(-) diff --git a/services/brig/src/Brig/Data/User.hs b/services/brig/src/Brig/Data/User.hs index 7db8a6e7e79..90442eba128 100644 --- a/services/brig/src/Brig/Data/User.hs +++ b/services/brig/src/Brig/Data/User.hs @@ -129,7 +129,7 @@ newAccount u inv tid mbHandle = do (Just (toUUID -> uuid), _) -> pure uuid (_, Just uuid) -> pure uuid (Nothing, Nothing) -> liftIO nextRandom - passwd <- maybe (pure Nothing) (fmap Just . liftIO . mkSafePassword) pass + passwd <- maybe (pure Nothing) (fmap Just . liftIO . mkSafePasswordScrypt) pass expiry <- case status of Ephemeral -> do -- Ephemeral users' expiry time is in expires_in (default sessionTokenTimeout) seconds diff --git a/services/brig/src/Brig/Provider/API.hs b/services/brig/src/Brig/Provider/API.hs index 3c195a5bf84..2b5d81f8199 100644 --- a/services/brig/src/Brig/Provider/API.hs +++ b/services/brig/src/Brig/Provider/API.hs @@ -215,18 +215,18 @@ newAccount :: (Handler r) Public.NewProviderResponse newAccount new = do guardSecondFactorDisabled Nothing - let email = (Public.newProviderEmail new) - let name = Public.newProviderName new - let pass = Public.newProviderPassword new - let descr = fromRange (Public.newProviderDescr new) - let url = Public.newProviderUrl new + let email = new.newProviderEmail + let name = new.newProviderName + let pass = new.newProviderPassword + let descr = fromRange new.newProviderDescr + let url = new.newProviderUrl let emailKey = mkEmailKey email wrapClientE (DB.lookupKey emailKey) >>= mapM_ (const $ throwStd emailExists) (safePass, newPass) <- case pass of - Just newPass -> (,Nothing) <$> mkSafePassword newPass + Just newPass -> (,Nothing) <$> mkSafePasswordScrypt newPass Nothing -> do newPass <- genPassword - safePass <- mkSafePassword newPass + safePass <- mkSafePasswordScrypt newPass pure (safePass, Just newPass) pid <- wrapClientE $ DB.insertAccount name safePass url descr let gen = mkVerificationCodeGen email diff --git a/services/brig/src/Brig/Provider/DB.hs b/services/brig/src/Brig/Provider/DB.hs index b5bb0243120..427608cecc2 100644 --- a/services/brig/src/Brig/Provider/DB.hs +++ b/services/brig/src/Brig/Provider/DB.hs @@ -118,7 +118,7 @@ updateAccountPassword :: PlainTextPassword6 -> m () updateAccountPassword pid pwd = do - p <- liftIO $ mkSafePassword pwd + p <- liftIO $ mkSafePasswordScrypt pwd retry x5 $ write cql $ params LocalQuorum (p, pid) where cql :: PrepQuery W (Password, ProviderId) () diff --git a/services/galley/src/Galley/API/Update.hs b/services/galley/src/Galley/API/Update.hs index e447c96c71b..a05438a3e10 100644 --- a/services/galley/src/Galley/API/Update.hs +++ b/services/galley/src/Galley/API/Update.hs @@ -125,7 +125,7 @@ import Wire.API.Federation.API import Wire.API.Federation.API.Galley import Wire.API.Federation.Error import Wire.API.Message -import Wire.API.Password (mkSafePassword) +import Wire.API.Password (mkSafePasswordScrypt) import Wire.API.Routes.Public (ZHostValue) import Wire.API.Routes.Public.Galley.Messaging import Wire.API.Routes.Public.Util (UpdateResult (..)) @@ -569,7 +569,7 @@ addCode lusr mbZHost mZcon lcnv mReq = do Nothing -> do ttl <- realToFrac . unGuestLinkTTLSeconds . fromMaybe defGuestLinkTTLSeconds . view (settings . guestLinkTTLSeconds) <$> input code <- E.generateCode (tUnqualified lcnv) ReusableCode (Timeout ttl) - mPw <- for (mReq >>= (.password)) mkSafePassword + mPw <- for (mReq >>= (.password)) mkSafePasswordScrypt E.createCode code mPw now <- input let event = Event (tUntagged lcnv) Nothing (tUntagged lusr) now (EdConvCodeUpdate (mkConversationCodeInfo (isJust mPw) (codeKey code) (codeValue code) convUri)) From 6fc7577d955d167b17ce861e2d1d7f9620a81ef4 Mon Sep 17 00:00:00 2001 From: Igor Ranieri Date: Wed, 2 Oct 2024 16:43:10 +0200 Subject: [PATCH 13/30] Clean up pragma. --- libs/wire-api/src/Wire/API/Password.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/libs/wire-api/src/Wire/API/Password.hs b/libs/wire-api/src/Wire/API/Password.hs index bfbaf5e6817..835885f7df7 100644 --- a/libs/wire-api/src/Wire/API/Password.hs +++ b/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 @@ -15,8 +17,6 @@ -- -- You should have received a copy of the GNU Affero General Public License along -- with this program. If not, see . -{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} -{-# OPTIONS_GHC -Wno-unused-top-binds #-} module Wire.API.Password ( Password, From 1adaaca9f51de09aec22fb844a3474fed5eeaf5c Mon Sep 17 00:00:00 2001 From: Igor Ranieri Date: Wed, 2 Oct 2024 16:45:02 +0200 Subject: [PATCH 14/30] Extract rabbit queue into own make cmd. --- Makefile | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/Makefile b/Makefile index ad9e1eb4f1a..cee77a4bbf0 100644 --- a/Makefile +++ b/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 From 47b0dcb3f87017f43b638cac79d710bd145c26a0 Mon Sep 17 00:00:00 2001 From: Igor Ranieri Date: Thu, 3 Oct 2024 10:45:41 +0200 Subject: [PATCH 15/30] Updating provider pwd to argon. --- services/brig/src/Brig/Provider/DB.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/services/brig/src/Brig/Provider/DB.hs b/services/brig/src/Brig/Provider/DB.hs index 427608cecc2..b5bb0243120 100644 --- a/services/brig/src/Brig/Provider/DB.hs +++ b/services/brig/src/Brig/Provider/DB.hs @@ -118,7 +118,7 @@ updateAccountPassword :: PlainTextPassword6 -> m () updateAccountPassword pid pwd = do - p <- liftIO $ mkSafePasswordScrypt pwd + p <- liftIO $ mkSafePassword pwd retry x5 $ write cql $ params LocalQuorum (p, pid) where cql :: PrepQuery W (Password, ProviderId) () From cca6c0ac4b2e3cef1ab71b0e316c62ccc2109b82 Mon Sep 17 00:00:00 2001 From: Igor Ranieri Date: Thu, 3 Oct 2024 11:25:30 +0200 Subject: [PATCH 16/30] Restored argon for provider new acc. --- services/brig/src/Brig/Provider/API.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/services/brig/src/Brig/Provider/API.hs b/services/brig/src/Brig/Provider/API.hs index 2b5d81f8199..79d43931efe 100644 --- a/services/brig/src/Brig/Provider/API.hs +++ b/services/brig/src/Brig/Provider/API.hs @@ -223,10 +223,10 @@ newAccount new = do let emailKey = mkEmailKey email wrapClientE (DB.lookupKey emailKey) >>= mapM_ (const $ throwStd emailExists) (safePass, newPass) <- case pass of - Just newPass -> (,Nothing) <$> mkSafePasswordScrypt newPass + Just newPass -> (,Nothing) <$> mkSafePassword newPass Nothing -> do newPass <- genPassword - safePass <- mkSafePasswordScrypt newPass + safePass <- mkSafePassword newPass pure (safePass, Just newPass) pid <- wrapClientE $ DB.insertAccount name safePass url descr let gen = mkVerificationCodeGen email From dfc9fc015cb08c41c0db478fa8674fcb38f5c422 Mon Sep 17 00:00:00 2001 From: Igor Ranieri Date: Thu, 3 Oct 2024 15:06:56 +0200 Subject: [PATCH 17/30] Test using only Scrypt. --- libs/wire-api/src/Wire/API/Password.hs | 6 +++--- libs/wire-api/test/unit/Test/Wire/API/Password.hs | 4 ++-- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/libs/wire-api/src/Wire/API/Password.hs b/libs/wire-api/src/Wire/API/Password.hs index 835885f7df7..8a8c3800679 100644 --- a/libs/wire-api/src/Wire/API/Password.hs +++ b/libs/wire-api/src/Wire/API/Password.hs @@ -142,7 +142,7 @@ mkSafePasswordScrypt :: (MonadIO m) => PlainTextPassword' t -> m Password mkSafePasswordScrypt = fmap Password . hashPasswordScrypt . Text.encodeUtf8 . fromPlainTextPassword mkSafePassword :: (MonadIO m) => PlainTextPassword' t -> m Password -mkSafePassword = fmap Password . hashPasswordArgon2id . Text.encodeUtf8 . fromPlainTextPassword +mkSafePassword = fmap Password . hashPasswordScrypt . Text.encodeUtf8 . fromPlainTextPassword -- | Verify a plaintext password from user input against a stretched -- password from persistent storage. @@ -169,8 +169,8 @@ hashPasswordScrypt password = do Text.decodeUtf8 . B64.encode $ key ] -hashPasswordArgon2id :: (MonadIO m) => ByteString -> m Text -hashPasswordArgon2id pwd = do +_hashPasswordArgon2id :: (MonadIO m) => ByteString -> m Text +_hashPasswordArgon2id pwd = do salt <- newSalt 16 pure $ hashPasswordArgon2idWithSalt salt pwd diff --git a/libs/wire-api/test/unit/Test/Wire/API/Password.hs b/libs/wire-api/test/unit/Test/Wire/API/Password.hs index 07fe7185866..a6db378e005 100644 --- a/libs/wire-api/test/unit/Test/Wire/API/Password.hs +++ b/libs/wire-api/test/unit/Test/Wire/API/Password.hs @@ -44,9 +44,9 @@ testHashPasswordArgon2id :: IO () testHashPasswordArgon2id = do pwd <- genPassword hashed <- mkSafePassword pwd - let (correct, status) = verifyPasswordWithStatus pwd hashed + let (correct, _status) = verifyPasswordWithStatus pwd hashed + -- assertEqual "Password could not be verified" status PasswordStatusOk assertBool "Password could not be verified" correct - assertEqual "Password could not be verified" status PasswordStatusOk testUpdateHash :: IO () testUpdateHash = do From 0cd22c41e67b4821b43234a14d4bd1318fb58843 Mon Sep 17 00:00:00 2001 From: Igor Ranieri Date: Mon, 7 Oct 2024 08:38:24 +0200 Subject: [PATCH 18/30] Renamed function, restored argon2id. --- libs/wire-api/src/Wire/API/Password.hs | 6 +++--- libs/wire-api/test/unit/Test/Wire/API/Password.hs | 4 ++-- libs/wire-subsystems/src/Wire/AuthenticationSubsystem.hs | 2 +- .../src/Wire/AuthenticationSubsystem/Interpreter.hs | 6 +++--- libs/wire-subsystems/src/Wire/UserSubsystem/Interpreter.hs | 2 +- services/brig/src/Brig/API/OAuth.hs | 3 +-- services/galley/src/Galley/API/Update.hs | 4 ++-- 7 files changed, 13 insertions(+), 14 deletions(-) diff --git a/libs/wire-api/src/Wire/API/Password.hs b/libs/wire-api/src/Wire/API/Password.hs index 8a8c3800679..835885f7df7 100644 --- a/libs/wire-api/src/Wire/API/Password.hs +++ b/libs/wire-api/src/Wire/API/Password.hs @@ -142,7 +142,7 @@ mkSafePasswordScrypt :: (MonadIO m) => PlainTextPassword' t -> m Password mkSafePasswordScrypt = fmap Password . hashPasswordScrypt . Text.encodeUtf8 . fromPlainTextPassword mkSafePassword :: (MonadIO m) => PlainTextPassword' t -> m Password -mkSafePassword = fmap Password . hashPasswordScrypt . Text.encodeUtf8 . fromPlainTextPassword +mkSafePassword = fmap Password . hashPasswordArgon2id . Text.encodeUtf8 . fromPlainTextPassword -- | Verify a plaintext password from user input against a stretched -- password from persistent storage. @@ -169,8 +169,8 @@ hashPasswordScrypt password = do Text.decodeUtf8 . B64.encode $ key ] -_hashPasswordArgon2id :: (MonadIO m) => ByteString -> m Text -_hashPasswordArgon2id pwd = do +hashPasswordArgon2id :: (MonadIO m) => ByteString -> m Text +hashPasswordArgon2id pwd = do salt <- newSalt 16 pure $ hashPasswordArgon2idWithSalt salt pwd diff --git a/libs/wire-api/test/unit/Test/Wire/API/Password.hs b/libs/wire-api/test/unit/Test/Wire/API/Password.hs index a6db378e005..7eba339f596 100644 --- a/libs/wire-api/test/unit/Test/Wire/API/Password.hs +++ b/libs/wire-api/test/unit/Test/Wire/API/Password.hs @@ -44,8 +44,8 @@ testHashPasswordArgon2id :: IO () testHashPasswordArgon2id = do pwd <- genPassword hashed <- mkSafePassword pwd - let (correct, _status) = verifyPasswordWithStatus pwd hashed - -- assertEqual "Password could not be verified" status PasswordStatusOk + let (correct, status) = verifyPasswordWithStatus pwd hashed + assertEqual "Password could not be verified" status PasswordStatusOk assertBool "Password could not be verified" correct testUpdateHash :: IO () diff --git a/libs/wire-subsystems/src/Wire/AuthenticationSubsystem.hs b/libs/wire-subsystems/src/Wire/AuthenticationSubsystem.hs index 218dc7f6bad..61ebe2f6660 100644 --- a/libs/wire-subsystems/src/Wire/AuthenticationSubsystem.hs +++ b/libs/wire-subsystems/src/Wire/AuthenticationSubsystem.hs @@ -29,7 +29,7 @@ import Wire.API.User.Password (PasswordResetCode, PasswordResetIdentity) import Wire.UserKeyStore data AuthenticationSubsystem m a where - VerifyPasswordE :: 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) diff --git a/libs/wire-subsystems/src/Wire/AuthenticationSubsystem/Interpreter.hs b/libs/wire-subsystems/src/Wire/AuthenticationSubsystem/Interpreter.hs index a584722a5de..e98153cbb87 100644 --- a/libs/wire-subsystems/src/Wire/AuthenticationSubsystem/Interpreter.hs +++ b/libs/wire-subsystems/src/Wire/AuthenticationSubsystem/Interpreter.hs @@ -71,7 +71,7 @@ interpretAuthenticationSubsystem :: interpretAuthenticationSubsystem userSubsystemInterpreter = interpret $ userSubsystemInterpreter . \case - VerifyPasswordE luid plaintext -> verifyPasswordEImpl luid plaintext + VerifyPasswordError luid plaintext -> verifyPasswordErrorImpl luid plaintext CreatePasswordResetCode userKey -> createPasswordResetCodeImpl userKey ResetPassword ident resetCode newPassword -> resetPasswordImpl ident resetCode newPassword VerifyPassword plaintext pwd -> verifyPasswordImpl plaintext pwd @@ -293,13 +293,13 @@ verifyUserPasswordImpl uid plaintext = do >>= maybe (throw AuthenticationSubsystemBadCredentials) pure verifyPasswordImpl plaintext password -verifyPasswordEImpl :: +verifyPasswordErrorImpl :: ( Member PasswordStore r, Member (Error AuthenticationSubsystemError) r ) => Local UserId -> PlainTextPassword6 -> Sem r () -verifyPasswordEImpl (tUnqualified -> uid) password = do +verifyPasswordErrorImpl (tUnqualified -> uid) password = do unlessM (fst <$> verifyUserPasswordImpl uid password) do throw AuthenticationSubsystemBadCredentials diff --git a/libs/wire-subsystems/src/Wire/UserSubsystem/Interpreter.hs b/libs/wire-subsystems/src/Wire/UserSubsystem/Interpreter.hs index 8bf6281b6f7..a88e9209364 100644 --- a/libs/wire-subsystems/src/Wire/UserSubsystem/Interpreter.hs +++ b/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 - verifyPasswordE luid pw + verifyPasswordError luid pw inv <- internalFindTeamInvitationImpl mEmailKey code let tid = inv.teamId let minvmeta = (,inv.createdAt) <$> inv.createdBy diff --git a/services/brig/src/Brig/API/OAuth.hs b/services/brig/src/Brig/API/OAuth.hs index af0194d2f6d..0ab2f89a4fe 100644 --- a/services/brig/src/Brig/API/OAuth.hs +++ b/services/brig/src/Brig/API/OAuth.hs @@ -106,9 +106,8 @@ registerOAuthClient (OAuthClientConfig name uri) = do createSecret :: (MonadIO m) => m OAuthClientPlainTextSecret createSecret = OAuthClientPlainTextSecret <$> rand32Bytes - -- TODO(elland): figure out why hashClientSecret :: (MonadIO m) => OAuthClientPlainTextSecret -> m Password - hashClientSecret = mkSafePasswordScrypt . plainTextPassword8Unsafe . toText . unOAuthClientPlainTextSecret + hashClientSecret = mkSafePassword . plainTextPassword8Unsafe . toText . unOAuthClientPlainTextSecret rand32Bytes :: (MonadIO m) => m AsciiBase16 rand32Bytes = liftIO . fmap encodeBase16 $ randBytes 32 diff --git a/services/galley/src/Galley/API/Update.hs b/services/galley/src/Galley/API/Update.hs index a05438a3e10..e447c96c71b 100644 --- a/services/galley/src/Galley/API/Update.hs +++ b/services/galley/src/Galley/API/Update.hs @@ -125,7 +125,7 @@ import Wire.API.Federation.API import Wire.API.Federation.API.Galley import Wire.API.Federation.Error import Wire.API.Message -import Wire.API.Password (mkSafePasswordScrypt) +import Wire.API.Password (mkSafePassword) import Wire.API.Routes.Public (ZHostValue) import Wire.API.Routes.Public.Galley.Messaging import Wire.API.Routes.Public.Util (UpdateResult (..)) @@ -569,7 +569,7 @@ addCode lusr mbZHost mZcon lcnv mReq = do Nothing -> do ttl <- realToFrac . unGuestLinkTTLSeconds . fromMaybe defGuestLinkTTLSeconds . view (settings . guestLinkTTLSeconds) <$> input code <- E.generateCode (tUnqualified lcnv) ReusableCode (Timeout ttl) - mPw <- for (mReq >>= (.password)) mkSafePasswordScrypt + mPw <- for (mReq >>= (.password)) mkSafePassword E.createCode code mPw now <- input let event = Event (tUntagged lcnv) Nothing (tUntagged lusr) now (EdConvCodeUpdate (mkConversationCodeInfo (isJust mPw) (codeKey code) (codeValue code) convUri)) From 7f7adab916f8938a12636c09887406a37c488756 Mon Sep 17 00:00:00 2001 From: Igor Ranieri Date: Mon, 7 Oct 2024 10:01:38 +0200 Subject: [PATCH 19/30] Make argon2id hashing quicker. --- libs/wire-api/src/Wire/API/Password.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/libs/wire-api/src/Wire/API/Password.hs b/libs/wire-api/src/Wire/API/Password.hs index 835885f7df7..123c74adcc8 100644 --- a/libs/wire-api/src/Wire/API/Password.hs +++ b/libs/wire-api/src/Wire/API/Password.hs @@ -114,8 +114,8 @@ defaultOptions :: Argon2idOptions defaultOptions = Argon2.Options { iterations = 1, - memory = 2 ^ (22 :: Int), - parallelism = 8, + memory = 2 ^ (20 :: Int), + parallelism = 4, variant = Argon2.Argon2id, version = Argon2.Version13 } From b927f377e6f985ae13c2a2be228c04ba503a0d6a Mon Sep 17 00:00:00 2001 From: Igor Ranieri Date: Mon, 7 Oct 2024 10:40:12 +0200 Subject: [PATCH 20/30] Make it even lighter. --- libs/wire-api/src/Wire/API/Password.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libs/wire-api/src/Wire/API/Password.hs b/libs/wire-api/src/Wire/API/Password.hs index 123c74adcc8..f41cce51e83 100644 --- a/libs/wire-api/src/Wire/API/Password.hs +++ b/libs/wire-api/src/Wire/API/Password.hs @@ -114,7 +114,7 @@ defaultOptions :: Argon2idOptions defaultOptions = Argon2.Options { iterations = 1, - memory = 2 ^ (20 :: Int), + memory = 2 ^ (14 :: Int), parallelism = 4, variant = Argon2.Argon2id, version = Argon2.Version13 From 6455c8eba17d74013a8b9138b1e18e992f37baa1 Mon Sep 17 00:00:00 2001 From: Igor Ranieri Date: Mon, 7 Oct 2024 10:42:06 +0200 Subject: [PATCH 21/30] Fixed rebase issue. --- Makefile | 4 ---- 1 file changed, 4 deletions(-) diff --git a/Makefile b/Makefile index cee77a4bbf0..ad9e1eb4f1a 100644 --- a/Makefile +++ b/Makefile @@ -62,10 +62,6 @@ 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 From 791eb357de28c973af711a333d3e704de6ffa5ca Mon Sep 17 00:00:00 2001 From: Igor Ranieri Date: Mon, 7 Oct 2024 15:22:00 +0200 Subject: [PATCH 22/30] Refactored Password, cleaning up code and exports. --- libs/types-common/src/Data/Misc.hs | 6 +- libs/wire-api/src/Wire/API/Password.hs | 241 ++++++++++-------- .../test/unit/Test/Wire/API/Password.hs | 7 +- 3 files changed, 135 insertions(+), 119 deletions(-) diff --git a/libs/types-common/src/Data/Misc.hs b/libs/types-common/src/Data/Misc.hs index fc896fb1e59..2ee31511d75 100644 --- a/libs/types-common/src/Data/Misc.hs +++ b/libs/types-common/src/Data/Misc.hs @@ -378,8 +378,6 @@ showT = Text.pack . show {-# INLINE showT #-} -- | Decodes a base64 'Text' to a regular 'ByteString' (if possible) -from64 :: Text -> Maybe ByteString -from64 = hush . B64.decode . encodeUtf8 - where - hush = either (const Nothing) Just +from64 :: Text -> Either String ByteString +from64 = B64.decode . encodeUtf8 {-# INLINE from64 #-} diff --git a/libs/wire-api/src/Wire/API/Password.hs b/libs/wire-api/src/Wire/API/Password.hs index f41cce51e83..767dbb0480f 100644 --- a/libs/wire-api/src/Wire/API/Password.hs +++ b/libs/wire-api/src/Wire/API/Password.hs @@ -1,5 +1,4 @@ {-# LANGUAGE RecordWildCards #-} -{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} -- This file is part of the Wire Server implementation. -- @@ -19,7 +18,7 @@ -- with this program. If not, see . module Wire.API.Password - ( Password, + ( Password (..), PasswordStatus (..), genPassword, mkSafePassword, @@ -28,15 +27,14 @@ module Wire.API.Password PasswordReqBody (..), -- * Only for testing - genTestPasswords, - unsafeMkPassword, hashPasswordArgon2idWithSalt, hashPasswordArgon2idWithOptions, mkSafePasswordScrypt, + parsePassword, ) where -import Cassandra +import Cassandra hiding (params) import Crypto.Error import Crypto.KDF.Argon2 qualified as Argon2 import Crypto.KDF.Scrypt as Scrypt @@ -55,8 +53,9 @@ import Imports import OpenSSL.Random (randBytes) -- | A derived, stretched password that can be safely stored. -newtype Password = Password - {fromPassword :: Text} +data Password + = Argon2Password Argon2HashedPassword + | ScryptPassword ScryptHashedPassword instance Show Password where show _ = "" @@ -64,13 +63,26 @@ instance Show Password where instance Cql Password where ctype = Tagged BlobColumn - fromCql (CqlBlob lbs) = pure . Password . Text.decodeUtf8 . toStrict $ lbs + fromCql (CqlBlob lbs) = parsePassword . Text.decodeUtf8 . toStrict $ lbs fromCql _ = Left "password: expected blob" - toCql = CqlBlob . fromStrict . Text.encodeUtf8 . fromPassword + toCql pw = CqlBlob . fromStrict $ Text.encodeUtf8 encoded + where + encoded = case pw of + Argon2Password argon2pw -> encodeArgon2HashedPassword argon2pw + ScryptPassword scryptpw -> encodeScryptPassword scryptpw -unsafeMkPassword :: Text -> Password -unsafeMkPassword = Password +data Argon2HashedPassword = Argon2HashedPassword + { opts :: Argon2.Options, + salt :: ByteString, + hashedKey :: ByteString + } + +data ScryptHashedPassword = ScryptHashedPassword + { params :: ScryptParameters, + salt :: ByteString, + hashedKey :: ByteString + } data PasswordStatus = PasswordStatusOk @@ -79,8 +91,6 @@ data PasswordStatus ------------------------------------------------------------------------------- -type Argon2idOptions = Argon2.Options - data ScryptParameters = ScryptParameters { -- | Bytes to randomly generate as a unique salt, default is __32__ saltLength :: Word32, @@ -110,7 +120,7 @@ defaultScryptParams = } -- | These are the default values suggested, as extracted from the crypton library. -defaultOptions :: Argon2idOptions +defaultOptions :: Argon2.Options defaultOptions = Argon2.Options { iterations = 1, @@ -139,10 +149,10 @@ genPassword = randBytes 12 mkSafePasswordScrypt :: (MonadIO m) => PlainTextPassword' t -> m Password -mkSafePasswordScrypt = fmap Password . hashPasswordScrypt . Text.encodeUtf8 . fromPlainTextPassword +mkSafePasswordScrypt = fmap ScryptPassword . hashPasswordScrypt . Text.encodeUtf8 . fromPlainTextPassword mkSafePassword :: (MonadIO m) => PlainTextPassword' t -> m Password -mkSafePassword = fmap Password . hashPasswordArgon2id . Text.encodeUtf8 . fromPlainTextPassword +mkSafePassword = fmap Argon2Password . hashPasswordArgon2id . Text.encodeUtf8 . fromPlainTextPassword -- | Verify a plaintext password from user input against a stretched -- password from persistent storage. @@ -150,37 +160,49 @@ verifyPassword :: PlainTextPassword' t -> Password -> Bool verifyPassword = (fst .) . verifyPasswordWithStatus verifyPasswordWithStatus :: PlainTextPassword' t -> Password -> (Bool, PasswordStatus) -verifyPasswordWithStatus plain opaque = - let actual = fromPlainTextPassword plain - expected = fromPassword opaque - in checkPassword actual expected +verifyPasswordWithStatus (fromPlainTextPassword -> plain) hashed = + case hashed of + (Argon2Password Argon2HashedPassword {..}) -> + let producedKey = hashPasswordWithOptions opts (Text.encodeUtf8 plain) salt + in (hashedKey `constEq` producedKey, PasswordStatusOk) + (ScryptPassword ScryptHashedPassword {..}) -> + let producedKey = hashPasswordWithParams params (Text.encodeUtf8 plain) salt + in (hashedKey `constEq` producedKey, PasswordStatusNeedsUpdate) -hashPasswordScrypt :: (MonadIO m) => ByteString -> m Text +hashPasswordScrypt :: (MonadIO m) => ByteString -> m ScryptHashedPassword hashPasswordScrypt password = do salt <- newSalt $ fromIntegral defaultScryptParams.saltLength - let key = hashPasswordWithParams defaultScryptParams password salt - pure $ - Text.intercalate - "|" - [ showT defaultScryptParams.rounds, - showT defaultScryptParams.blockSize, - showT defaultScryptParams.parallelism, - Text.decodeUtf8 . B64.encode $ salt, - Text.decodeUtf8 . B64.encode $ key - ] - -hashPasswordArgon2id :: (MonadIO m) => ByteString -> m Text + let params = defaultScryptParams + let hashedKey = hashPasswordWithParams params password salt + pure ScryptHashedPassword {..} + +encodeScryptPassword :: ScryptHashedPassword -> Text +encodeScryptPassword ScryptHashedPassword {..} = + Text.intercalate + "|" + [ showT defaultScryptParams.rounds, + showT defaultScryptParams.blockSize, + showT defaultScryptParams.parallelism, + Text.decodeUtf8 . B64.encode $ salt, + Text.decodeUtf8 . B64.encode $ hashedKey + ] + +hashPasswordArgon2id :: (MonadIO m) => ByteString -> m Argon2HashedPassword hashPasswordArgon2id pwd = do salt <- newSalt 16 pure $ hashPasswordArgon2idWithSalt salt pwd -hashPasswordArgon2idWithSalt :: ByteString -> ByteString -> Text +hashPasswordArgon2idWithSalt :: ByteString -> ByteString -> Argon2HashedPassword hashPasswordArgon2idWithSalt = hashPasswordArgon2idWithOptions defaultOptions -hashPasswordArgon2idWithOptions :: Argon2idOptions -> ByteString -> ByteString -> Text +hashPasswordArgon2idWithOptions :: Argon2.Options -> ByteString -> ByteString -> Argon2HashedPassword hashPasswordArgon2idWithOptions opts salt pwd = do - let key = hashPasswordWithOptions opts pwd salt - optsStr = + let hashedKey = hashPasswordWithOptions opts pwd salt + in Argon2HashedPassword {..} + +encodeArgon2HashedPassword :: Argon2HashedPassword -> Text +encodeArgon2HashedPassword Argon2HashedPassword {..} = + let optsStr = Text.intercalate "," [ "m=" <> showT opts.memory, @@ -194,91 +216,95 @@ hashPasswordArgon2idWithOptions opts salt pwd = do "v=" <> versionToNum opts.version, optsStr, encodeWithoutPadding salt, - encodeWithoutPadding key + encodeWithoutPadding hashedKey ] where encodeWithoutPadding = Text.dropWhileEnd (== '=') . Text.decodeUtf8 . B64.encode -checkPassword :: Text -> Text -> (Bool, PasswordStatus) -checkPassword actual expected = +parsePassword :: Text -> Either String Password +parsePassword expected = case parseArgon2idPasswordHashOptions expected of - Just (opts, salt, hashedKey) -> - let producedKey = hashPasswordWithOptions opts (Text.encodeUtf8 actual) salt - in (hashedKey `constEq` producedKey, PasswordStatusOk) - Nothing -> + Right hashedPassword -> Right $ Argon2Password hashedPassword + Left argon2ParseError -> case parseScryptPasswordHashParams $ Text.encodeUtf8 expected of - Just (sparams, saltS, hashedKeyS) -> - let producedKeyS = hashPasswordWithParams sparams (Text.encodeUtf8 actual) saltS - in (hashedKeyS `constEq` producedKeyS, PasswordStatusNeedsUpdate) - Nothing -> (False, PasswordStatusNeedsUpdate) + Right hashedPassword -> Right $ ScryptPassword hashedPassword + Left scryptParseError -> + Left $ + "failed to parse password are argon2 or scrypt hashed password: argon2 parse error: " + <> argon2ParseError + <> ", scrypt parse error: " + <> scryptParseError newSalt :: (MonadIO m) => Int -> m ByteString newSalt i = liftIO $ getRandomBytes i {-# INLINE newSalt #-} -parseArgon2idPasswordHashOptions :: Text -> Maybe (Argon2idOptions, ByteString, ByteString) +parseArgon2idPasswordHashOptions :: Text -> Either String Argon2HashedPassword parseArgon2idPasswordHashOptions passwordHash = do - let paramList = Text.split (== '$') passwordHash - guard (length paramList >= 5) - let (_ : variantT : vp : ps : sh : rest) = paramList - variant <- parseVariant variantT - case rest of - [hashedKey64] -> do - version <- parseVersion vp - parseAll variant version ps sh hashedKey64 - [] -> parseAll variant Argon2.Version10 vp ps sh - _ -> Nothing - where - parseVariant = splitMaybe "argon2" letterToVariant - parseVersion = splitMaybe "v=" numToVersion - -parseAll :: Argon2.Variant -> Argon2.Version -> Text -> Text -> Text -> Maybe (Argon2idOptions, ByteString, ByteString) -parseAll variant version parametersT salt64 hashedKey64 = do - (memory, iterations, parallelism) <- parseParameters parametersT - salt <- from64 $ unsafePad64 salt64 - hashedKey <- from64 $ unsafePad64 hashedKey64 - pure (Argon2.Options {..}, salt, hashedKey) + let paramsList = Text.split (== '$') passwordHash + -- The first param is empty string b/c the string begins with a separator `$`. + case paramsList of + ["", variantStr, verStr, opts, salt, hashedKey64] -> do + version <- parseVersion verStr + parseAll variantStr version opts salt hashedKey64 + ["", variantStr, opts, salt, hashedKey64] -> do + parseAll variantStr Argon2.Version10 opts salt hashedKey64 + _ -> Left $ "failed to parse argon2id hashed password, expected 5 or 6 params, got: " <> show (length paramsList) where - parseParameters paramsT = do - let paramsL = Text.split (== ',') paramsT - guard $ Imports.length paramsL == 3 - go paramsL (Nothing, Nothing, Nothing) + parseVersion = + maybe (Left "failed to parse argon2 version") Right + . splitMaybe "v=" numToVersion + + parseAll :: Text -> Argon2.Version -> Text -> Text -> Text -> Either String Argon2HashedPassword + parseAll variantStr version parametersStr salt64 hashedKey64 = do + variant <- parseVariant variantStr + (memory, iterations, parallelism) <- parseParameters parametersStr + -- We pad the Base64 with '=' chars because we drop them while encoding this. + -- At the time of implementation we've opted to be consistent with how the + -- CLI of the reference implementation of Argon2id outputs this. + salt <- from64 $ unsafePad64 salt64 + hashedKey <- from64 $ unsafePad64 hashedKey64 + pure $ Argon2HashedPassword {opts = (Argon2.Options {..}), ..} where - go [] (Just m, Just t, Just p) = Just (m, t, p) - go [] _ = Nothing - go (x : xs) (m, t, p) = - case Text.splitAt 2 x of - ("m=", i) -> go xs (readT i, t, p) - ("t=", i) -> go xs (m, readT i, p) - ("p=", i) -> go xs (m, t, readT i) - _ -> Nothing - -parseScryptPasswordHashParams :: ByteString -> Maybe (ScryptParameters, ByteString, ByteString) + parseVariant = + maybe (Left "failed to parse argon2 variant") Right + . splitMaybe "argon2" letterToVariant + parseParameters paramsT = + let paramsList = Text.split (== ',') paramsT + in go paramsList (Nothing, Nothing, Nothing) + where + go [] (Just m, Just t, Just p) = Right (m, t, p) + go [] (Nothing, _, _) = Left "failed to parse Argon2Options: failed to read parameter 'm'" + go [] (_, Nothing, _) = Left "failed to parse Argon2Options: failed to read parameter 't'" + go [] (_, _, Nothing) = Left "failed to parse Argon2Options: failed to read parameter 'p'" + go (x : xs) (m, t, p) = + case Text.splitAt 2 x of + ("m=", i) -> go xs (readT i, t, p) + ("t=", i) -> go xs (m, readT i, p) + ("p=", i) -> go xs (m, t, readT i) + (unknownParam, _) -> Left $ "failed to parse Argon2Options: Unknown param: " <> Text.unpack unknownParam + +parseScryptPasswordHashParams :: ByteString -> Either String ScryptHashedPassword parseScryptPasswordHashParams passwordHash = do let paramList = Text.split (== '|') . Text.decodeUtf8 $ passwordHash - guard (length paramList == 5) - let [ scryptRoundsT, - scryptBlockSizeT, - scryptParallelismT, - salt64, - hashedKey64 - ] = paramList - rounds <- readT scryptRoundsT - blockSize <- readT scryptBlockSizeT - parallelism <- readT scryptParallelismT - salt <- from64 salt64 - hashedKey <- from64 hashedKey64 - let outputLength = fromIntegral $ C8.length hashedKey - saltLength = fromIntegral $ C8.length salt - pure - ( ScryptParameters {..}, - salt, - hashedKey - ) + case paramList of + [roundsStr, blockSizeStr, parallelismStr, salt64, hashedKey64] -> do + rounds <- eitherFromMaybe "rounds" $ readT roundsStr + blockSize <- eitherFromMaybe "blockSize" $ readT blockSizeStr + parallelism <- eitherFromMaybe "parellelism" $ readT parallelismStr + salt <- from64 salt64 + hashedKey <- from64 hashedKey64 + let outputLength = fromIntegral $ C8.length hashedKey + saltLength = fromIntegral $ C8.length salt + pure $ ScryptHashedPassword {params = ScryptParameters {..}, ..} + _ -> Left $ "failed to parse ScryptHashedPassword: expected exactly 5 params" + where + eitherFromMaybe :: String -> Maybe a -> Either String a + eitherFromMaybe paramName = maybe (Left $ "failed to parse scrypt parameter: " <> paramName) Right ------------------------------------------------------------------------------- -hashPasswordWithOptions :: Argon2idOptions -> ByteString -> ByteString -> ByteString +hashPasswordWithOptions :: Argon2.Options -> ByteString -> ByteString -> ByteString hashPasswordWithOptions opts password salt = let tagSize = 16 in case (Argon2.hash opts password salt tagSize) of @@ -355,12 +381,3 @@ 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) diff --git a/libs/wire-api/test/unit/Test/Wire/API/Password.hs b/libs/wire-api/test/unit/Test/Wire/API/Password.hs index 7eba339f596..2915365ef2b 100644 --- a/libs/wire-api/test/unit/Test/Wire/API/Password.hs +++ b/libs/wire-api/test/unit/Test/Wire/API/Password.hs @@ -14,6 +14,7 @@ -- -- You should have received a copy of the GNU Affero General Public License along -- with this program. If not, see . +{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} module Test.Wire.API.Password where @@ -52,12 +53,12 @@ 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==" + Right expected = parsePassword "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=4194304,t=1,p=8$lj6+HdIcCpO1zvz8An56fg$Qx8OzYTq0hDNqGG9tW1dug" -- verify password with scrypt (correct, status) = verifyPasswordWithStatus orig expected + newHash <- either assertFailure pure $ parsePassword "$argon2id$v=19$m=4194304,t=1,p=8$lj6+HdIcCpO1zvz8An56fg$Qx8OzYTq0hDNqGG9tW1dug" assertBool "Password did not match hash." correct assertEqual "Password could not be verified" status PasswordStatusNeedsUpdate @@ -70,7 +71,7 @@ testHashingOldScrypt :: IO () testHashingOldScrypt = forConcurrently_ pwds $ \pwd -> do let orig = plainTextPassword8Unsafe (fst pwd) - expected = unsafeMkPassword (snd pwd) + Right expected = parsePassword (snd pwd) (correct, status) = verifyPasswordWithStatus orig expected assertBool "Password did not match hash." correct assertEqual "Password could not be verified" status PasswordStatusNeedsUpdate From 4b724e7629038bfaae6b9d4e0d4479a0e6b1bdbc Mon Sep 17 00:00:00 2001 From: Igor Ranieri Date: Mon, 7 Oct 2024 15:29:44 +0200 Subject: [PATCH 23/30] Fixed tests. --- .../test/unit/Wire/MockInterpreters/HashPassword.hs | 11 ++++++----- .../test/unit/Wire/MockInterpreters/PasswordStore.hs | 4 +--- 2 files changed, 7 insertions(+), 8 deletions(-) diff --git a/libs/wire-subsystems/test/unit/Wire/MockInterpreters/HashPassword.hs b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/HashPassword.hs index 05c15259bec..84c8897292a 100644 --- a/libs/wire-subsystems/test/unit/Wire/MockInterpreters/HashPassword.hs +++ b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/HashPassword.hs @@ -10,11 +10,12 @@ import Wire.HashPassword staticHashPasswordInterpreter :: InterpreterFor HashPassword r staticHashPasswordInterpreter = interpret $ \case - HashPassword password -> go (hashPasswordArgon2idWithOptions fastArgon2IdOptions) "9bytesalt" password - where - go alg salt password = do - let passwordBS = Text.encodeUtf8 (fromPlainTextPassword password) - pure $ unsafeMkPassword $ alg salt passwordBS + HashPassword password -> + pure . Argon2Password $ + hashPasswordArgon2idWithOptions + fastArgon2IdOptions + "9bytesalt" + (Text.encodeUtf8 (fromPlainTextPassword password)) fastArgon2IdOptions :: Argon2.Options fastArgon2IdOptions = diff --git a/libs/wire-subsystems/test/unit/Wire/MockInterpreters/PasswordStore.hs b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/PasswordStore.hs index 921eb00ebfa..a0eb7fc845c 100644 --- a/libs/wire-subsystems/test/unit/Wire/MockInterpreters/PasswordStore.hs +++ b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/PasswordStore.hs @@ -1,5 +1,3 @@ -{-# OPTIONS_GHC -Wwarn #-} - module Wire.MockInterpreters.PasswordStore where import Data.Id @@ -17,4 +15,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) + LookupHashedProviderPassword _uid -> error ("Implement as needed" :: String) From 004900ed66f71183fdca26ee0c63ad4e77e689b1 Mon Sep 17 00:00:00 2001 From: Igor Ranieri Date: Mon, 7 Oct 2024 16:06:05 +0200 Subject: [PATCH 24/30] Updated Scrypt params. --- libs/wire-api/src/Wire/API/Password.hs | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/libs/wire-api/src/Wire/API/Password.hs b/libs/wire-api/src/Wire/API/Password.hs index 767dbb0480f..c424e249a2f 100644 --- a/libs/wire-api/src/Wire/API/Password.hs +++ b/libs/wire-api/src/Wire/API/Password.hs @@ -119,12 +119,13 @@ defaultScryptParams = outputLength = 64 } --- | These are the default values suggested, as extracted from the crypton library. +-- | Recommended in the RFC as the second choice: https://www.rfc-editor.org/rfc/rfc9106.html#name-parameter-choice +-- The first choice takes ~1s to hash passwords which seems like too much. defaultOptions :: Argon2.Options defaultOptions = Argon2.Options - { iterations = 1, - memory = 2 ^ (14 :: Int), + { iterations = 3, + memory = 2 ^ (16 :: Int), parallelism = 4, variant = Argon2.Argon2id, version = Argon2.Version13 From 7ef727508e91eef3610be617ec2b7d95a3307405 Mon Sep 17 00:00:00 2001 From: Igor Ranieri Date: Mon, 7 Oct 2024 16:08:02 +0200 Subject: [PATCH 25/30] Added importand TODO for tomorrow. --- libs/wire-api/src/Wire/API/Password.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/libs/wire-api/src/Wire/API/Password.hs b/libs/wire-api/src/Wire/API/Password.hs index c424e249a2f..d5a4f02933a 100644 --- a/libs/wire-api/src/Wire/API/Password.hs +++ b/libs/wire-api/src/Wire/API/Password.hs @@ -305,6 +305,7 @@ parseScryptPasswordHashParams passwordHash = do ------------------------------------------------------------------------------- +-- TODO: Force strictnes on this function, the hash function can break unsafely and we should probably force it as soon as possible. hashPasswordWithOptions :: Argon2.Options -> ByteString -> ByteString -> ByteString hashPasswordWithOptions opts password salt = let tagSize = 16 From 481bbd197eb9fa18a88d090b38d61bf4fa946ecb Mon Sep 17 00:00:00 2001 From: Igor Ranieri Date: Tue, 8 Oct 2024 08:58:03 +0200 Subject: [PATCH 26/30] Adjusted argon2 values, forced strictness on hashing. --- libs/wire-api/src/Wire/API/Password.hs | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/libs/wire-api/src/Wire/API/Password.hs b/libs/wire-api/src/Wire/API/Password.hs index d5a4f02933a..490cb85e730 100644 --- a/libs/wire-api/src/Wire/API/Password.hs +++ b/libs/wire-api/src/Wire/API/Password.hs @@ -1,4 +1,5 @@ {-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE StrictData #-} -- This file is part of the Wire Server implementation. -- @@ -124,8 +125,8 @@ defaultScryptParams = defaultOptions :: Argon2.Options defaultOptions = Argon2.Options - { iterations = 3, - memory = 2 ^ (16 :: Int), + { iterations = 1, + memory = 2 ^ (20 :: Int), parallelism = 4, variant = Argon2.Argon2id, version = Argon2.Version13 @@ -175,7 +176,7 @@ hashPasswordScrypt password = do salt <- newSalt $ fromIntegral defaultScryptParams.saltLength let params = defaultScryptParams let hashedKey = hashPasswordWithParams params password salt - pure ScryptHashedPassword {..} + pure $! ScryptHashedPassword {..} encodeScryptPassword :: ScryptHashedPassword -> Text encodeScryptPassword ScryptHashedPassword {..} = @@ -191,7 +192,7 @@ encodeScryptPassword ScryptHashedPassword {..} = hashPasswordArgon2id :: (MonadIO m) => ByteString -> m Argon2HashedPassword hashPasswordArgon2id pwd = do salt <- newSalt 16 - pure $ hashPasswordArgon2idWithSalt salt pwd + pure $! hashPasswordArgon2idWithSalt salt pwd hashPasswordArgon2idWithSalt :: ByteString -> ByteString -> Argon2HashedPassword hashPasswordArgon2idWithSalt = hashPasswordArgon2idWithOptions defaultOptions @@ -305,15 +306,14 @@ parseScryptPasswordHashParams passwordHash = do ------------------------------------------------------------------------------- --- TODO: Force strictnes on this function, the hash function can break unsafely and we should probably force it as soon as possible. hashPasswordWithOptions :: Argon2.Options -> ByteString -> ByteString -> ByteString -hashPasswordWithOptions opts password salt = +hashPasswordWithOptions opts password salt = do 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 + 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, From 14f80e976c492846577589a0308ae593ba6e3d4a Mon Sep 17 00:00:00 2001 From: Igor Ranieri Date: Tue, 8 Oct 2024 09:45:15 +0200 Subject: [PATCH 27/30] Cleanup + reduce memory usage of argon2id for now. --- libs/wire-api/src/Wire/API/Password.hs | 7 ++++--- libs/wire-subsystems/src/Wire/AuthenticationSubsystem.hs | 2 +- .../src/Wire/AuthenticationSubsystem/Interpreter.hs | 6 +++--- libs/wire-subsystems/src/Wire/UserSubsystem/Interpreter.hs | 2 +- services/brig/src/Brig/Data/User.hs | 2 +- services/brig/src/Brig/Provider/API.hs | 6 +++--- 6 files changed, 13 insertions(+), 12 deletions(-) diff --git a/libs/wire-api/src/Wire/API/Password.hs b/libs/wire-api/src/Wire/API/Password.hs index 490cb85e730..6684999ac6b 100644 --- a/libs/wire-api/src/Wire/API/Password.hs +++ b/libs/wire-api/src/Wire/API/Password.hs @@ -126,7 +126,8 @@ defaultOptions :: Argon2.Options defaultOptions = Argon2.Options { iterations = 1, - memory = 2 ^ (20 :: Int), + -- TODO: fix this after meeting with Security + memory = 2 ^ (18 :: Int), parallelism = 4, variant = Argon2.Argon2id, version = Argon2.Version13 @@ -232,9 +233,9 @@ parsePassword expected = Right hashedPassword -> Right $ ScryptPassword hashedPassword Left scryptParseError -> Left $ - "failed to parse password are argon2 or scrypt hashed password: argon2 parse error: " + "Failed to parse Argon2 or Scrypt. Argon2 parse error: " <> argon2ParseError - <> ", scrypt parse error: " + <> ", Scrypt parse error: " <> scryptParseError newSalt :: (MonadIO m) => Int -> m ByteString diff --git a/libs/wire-subsystems/src/Wire/AuthenticationSubsystem.hs b/libs/wire-subsystems/src/Wire/AuthenticationSubsystem.hs index 61ebe2f6660..3b593a746c8 100644 --- a/libs/wire-subsystems/src/Wire/AuthenticationSubsystem.hs +++ b/libs/wire-subsystems/src/Wire/AuthenticationSubsystem.hs @@ -29,11 +29,11 @@ import Wire.API.User.Password (PasswordResetCode, PasswordResetIdentity) import Wire.UserKeyStore data AuthenticationSubsystem m a where - 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) + VerifyUserPasswordError :: Local UserId -> PlainTextPassword6 -> AuthenticationSubsystem m () VerifyProviderPassword :: ProviderId -> PlainTextPassword6 -> AuthenticationSubsystem r (Bool, PasswordStatus) -- For testing InternalLookupPasswordResetCode :: EmailKey -> AuthenticationSubsystem m (Maybe PasswordResetPair) diff --git a/libs/wire-subsystems/src/Wire/AuthenticationSubsystem/Interpreter.hs b/libs/wire-subsystems/src/Wire/AuthenticationSubsystem/Interpreter.hs index e98153cbb87..89dc1f3b39a 100644 --- a/libs/wire-subsystems/src/Wire/AuthenticationSubsystem/Interpreter.hs +++ b/libs/wire-subsystems/src/Wire/AuthenticationSubsystem/Interpreter.hs @@ -71,11 +71,11 @@ interpretAuthenticationSubsystem :: interpretAuthenticationSubsystem userSubsystemInterpreter = interpret $ userSubsystemInterpreter . \case - 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 + VerifyUserPasswordError luid plaintext -> verifyUserPasswordErrorImpl luid plaintext VerifyProviderPassword pid plaintext -> verifyProviderPasswordImpl pid plaintext -- Testing InternalLookupPasswordResetCode userKey -> internalLookupPasswordResetCodeImpl userKey @@ -293,13 +293,13 @@ verifyUserPasswordImpl uid plaintext = do >>= maybe (throw AuthenticationSubsystemBadCredentials) pure verifyPasswordImpl plaintext password -verifyPasswordErrorImpl :: +verifyUserPasswordErrorImpl :: ( Member PasswordStore r, Member (Error AuthenticationSubsystemError) r ) => Local UserId -> PlainTextPassword6 -> Sem r () -verifyPasswordErrorImpl (tUnqualified -> uid) password = do +verifyUserPasswordErrorImpl (tUnqualified -> uid) password = do unlessM (fst <$> verifyUserPasswordImpl uid password) do throw AuthenticationSubsystemBadCredentials diff --git a/libs/wire-subsystems/src/Wire/UserSubsystem/Interpreter.hs b/libs/wire-subsystems/src/Wire/UserSubsystem/Interpreter.hs index a88e9209364..bbcbe719eb8 100644 --- a/libs/wire-subsystems/src/Wire/UserSubsystem/Interpreter.hs +++ b/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 - verifyPasswordError luid pw + verifyUserPasswordError luid pw inv <- internalFindTeamInvitationImpl mEmailKey code let tid = inv.teamId let minvmeta = (,inv.createdAt) <$> inv.createdBy diff --git a/services/brig/src/Brig/Data/User.hs b/services/brig/src/Brig/Data/User.hs index 90442eba128..caaa7c160cc 100644 --- a/services/brig/src/Brig/Data/User.hs +++ b/services/brig/src/Brig/Data/User.hs @@ -188,7 +188,7 @@ authenticate :: PlainTextPassword6 -> ExceptT AuthError (AppT r) () authenticate u pw = - -- TODO: Move this logic into auth subsystem. + -- FUTUREWORK: Move this logic into auth subsystem. lift (wrapHttp $ lookupAuth u) >>= \case Nothing -> throwE AuthInvalidUser Just (_, Deleted) -> throwE AuthInvalidUser diff --git a/services/brig/src/Brig/Provider/API.hs b/services/brig/src/Brig/Provider/API.hs index 79d43931efe..65070d3b420 100644 --- a/services/brig/src/Brig/Provider/API.hs +++ b/services/brig/src/Brig/Provider/API.hs @@ -201,7 +201,7 @@ internalProviderAPI :: Member VerificationCodeSubsystem r ) => ServerT BrigIRoutes.ProviderAPI (Handler r) -internalProviderAPI = Named @"get-provider-activation-code" getActivationCodeH +internalProviderAPI = Named @"get-provider-activation-code" getActivationCode -------------------------------------------------------------------------------- -- Public API (Unauthenticated) @@ -273,13 +273,13 @@ activateAccountKey key val = do lift $ sendApprovalConfirmMail name email pure . Just $ Public.ProviderActivationResponse email -getActivationCodeH :: +getActivationCode :: ( Member GalleyAPIAccess r, Member VerificationCodeSubsystem r ) => EmailAddress -> (Handler r) Code.KeyValuePair -getActivationCodeH email = do +getActivationCode email = do guardSecondFactorDisabled Nothing let gen = mkVerificationCodeGen email code <- lift . liftSem $ internalLookupCode gen.genKey IdentityVerification From f4c4804c2a42823c12d2a3e26d4e1bd5f6d088d4 Mon Sep 17 00:00:00 2001 From: Igor Ranieri Date: Tue, 8 Oct 2024 10:00:07 +0200 Subject: [PATCH 28/30] hi ci From 12f413d3cfeb09e1cdd384e8ea6eee9759b23b7d Mon Sep 17 00:00:00 2001 From: Igor Ranieri Date: Tue, 8 Oct 2024 11:00:52 +0200 Subject: [PATCH 29/30] lowered argon2id settings again. --- libs/wire-api/src/Wire/API/Password.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libs/wire-api/src/Wire/API/Password.hs b/libs/wire-api/src/Wire/API/Password.hs index 6684999ac6b..125e4e92e2e 100644 --- a/libs/wire-api/src/Wire/API/Password.hs +++ b/libs/wire-api/src/Wire/API/Password.hs @@ -127,7 +127,7 @@ defaultOptions = Argon2.Options { iterations = 1, -- TODO: fix this after meeting with Security - memory = 2 ^ (18 :: Int), + memory = 2 ^ (16 :: Int), parallelism = 4, variant = Argon2.Argon2id, version = Argon2.Version13 From 7c47c67ec05f5d27897694e2721792f31f471c5d Mon Sep 17 00:00:00 2001 From: Igor Ranieri Date: Tue, 8 Oct 2024 16:06:02 +0200 Subject: [PATCH 30/30] Adjusting values after running Kratos --- libs/wire-api/src/Wire/API/Password.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/libs/wire-api/src/Wire/API/Password.hs b/libs/wire-api/src/Wire/API/Password.hs index 125e4e92e2e..0935b4ca5a5 100644 --- a/libs/wire-api/src/Wire/API/Password.hs +++ b/libs/wire-api/src/Wire/API/Password.hs @@ -127,8 +127,8 @@ defaultOptions = Argon2.Options { iterations = 1, -- TODO: fix this after meeting with Security - memory = 2 ^ (16 :: Int), - parallelism = 4, + memory = 2 ^ (17 :: Int), + parallelism = 32, variant = Argon2.Argon2id, version = Argon2.Version13 }