Move reading/writing of user passwords to UserStore

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

@@ -47,15 +47,16 @@ import Wire.EmailSubsystem
 import Wire.Events
 import Wire.HashPassword
 import Wire.PasswordResetCodeStore
-import Wire.PasswordStore (PasswordStore, upsertHashedPassword)
+import Wire.PasswordStore (PasswordStore)
 import Wire.PasswordStore qualified as PasswordStore
 import Wire.RateLimit
 import Wire.Sem.Now
 import Wire.Sem.Now qualified as Now
 import Wire.Sem.Random (Random)
 import Wire.SessionStore
 import Wire.UserKeyStore
-import Wire.UserStore
+import Wire.UserStore (UserStore)
+import Wire.UserStore qualified as UserStore
 import Wire.UserSubsystem (UserSubsystem, getLocalAccountBy)
 import Wire.UserSubsystem qualified as User
 
@@ -119,15 +120,14 @@ instance Exception PasswordResetError where
 authenticateEitherImpl ::
   ( Member UserStore r,
     Member HashPassword r,
-    Member PasswordStore r,
     Member RateLimit r
   ) =>
   UserId ->
   PlainTextPassword6 ->
   Sem r (Either AuthError ())
 authenticateEitherImpl uid plaintext = do
   runError $
-    getUserAuthenticationInfo uid >>= \case
+    UserStore.getUserAuthenticationInfo uid >>= \case
       Nothing -> throw AuthInvalidUser
       Just (_, Deleted) -> throw AuthInvalidUser
       Just (_, Suspended) -> throw AuthSuspended
@@ -144,7 +144,7 @@ authenticateEitherImpl uid plaintext = do
     hashAndUpdatePwd pwd = do
       tryHashPassword6 rateLimitKey pwd >>= \case
         Left _ -> pure ()
-        Right hashed -> upsertHashedPassword uid hashed
+        Right hashed -> UserStore.upsertHashedPassword uid hashed
 
 -- | Password reauthentication. If the account has a password, reauthentication
 -- is mandatory. If
@@ -161,7 +161,7 @@ reauthenticateEitherImpl ::
   Maybe (PlainTextPassword' t) ->
   Sem r (Either ReAuthError ())
 reauthenticateEitherImpl user plaintextMaybe =
-  getUserAuthenticationInfo user
+  UserStore.getUserAuthenticationInfo user
     >>= runError
       . \case
         Nothing -> throw (ReAuthError AuthInvalidUser)
@@ -296,8 +296,8 @@ resetPasswordImpl ::
     Member UserSubsystem r,
     Member HashPassword r,
     Member SessionStore r,
-    Member PasswordStore r,
-    Member RateLimit r
+    Member RateLimit r,
+    Member UserStore r
   ) =>
   PasswordResetIdentity ->
   PasswordResetCode ->
@@ -314,7 +314,7 @@ resetPasswordImpl ident code pw = do
       Log.debug $ field "user" (toByteString uid) . field "action" (val "User.completePasswordReset")
       checkNewIsDifferent uid pw
       hashedPw <- hashPassword8 rateLimitKey pw
-      PasswordStore.upsertHashedPassword uid hashedPw
+      UserStore.upsertHashedPassword uid hashedPw
       codeDelete key
       deleteAllCookies uid
   where
@@ -330,7 +330,7 @@ resetPasswordImpl ident code pw = do
 
     checkNewIsDifferent :: UserId -> PlainTextPassword' t -> Sem r ()
     checkNewIsDifferent uid newPassword = do
-      mCurrentPassword <- PasswordStore.lookupHashedPassword uid
+      mCurrentPassword <- UserStore.lookupHashedPassword uid
       case mCurrentPassword of
         Just currentPassword ->
           whenM (verifyPassword (RateLimitUser uid) newPassword currentPassword) $
@@ -369,25 +369,25 @@ verifyProviderPasswordImpl pid plaintext = do
   verifyPasswordWithStatus (RateLimitProvider pid) plaintext password
 
 verifyUserPasswordImpl ::
-  ( Member PasswordStore r,
-    Member (Error AuthenticationSubsystemError) r,
+  ( Member (Error AuthenticationSubsystemError) r,
     Member HashPassword r,
-    Member RateLimit r
+    Member RateLimit r,
+    Member UserStore r
   ) =>
   UserId ->
   PlainTextPassword6 ->
   Sem r (Bool, PasswordStatus)
 verifyUserPasswordImpl uid plaintext = do
   password <-
-    PasswordStore.lookupHashedPassword uid
+    UserStore.lookupHashedPassword uid
       >>= maybe (throw AuthenticationSubsystemBadCredentials) pure
   verifyPasswordWithStatus (RateLimitUser uid) plaintext password
 
 verifyUserPasswordErrorImpl ::
-  ( Member PasswordStore r,
-    Member (Error AuthenticationSubsystemError) r,
+  ( Member (Error AuthenticationSubsystemError) r,
     Member HashPassword r,
-    Member RateLimit r
+    Member RateLimit r,
+    Member UserStore r
   ) =>
   Local UserId ->
   PlainTextPassword6 ->

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

@@ -25,8 +25,7 @@ import Polysemy
 import Wire.API.Password
 
 data PasswordStore m a where
-  UpsertHashedPassword :: UserId -> Password -> PasswordStore m ()
-  LookupHashedPassword :: UserId -> PasswordStore m (Maybe Password)
+  -- | FUTUREWORK: When we create ProviderStore, we should migrate this action to that.
   LookupHashedProviderPassword :: ProviderId -> PasswordStore m (Maybe Password)
 
 makeSem ''PasswordStore

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

@@ -31,33 +31,16 @@ interpretPasswordStore :: (Member (Embed IO) r) => ClientState -> InterpreterFor
 interpretPasswordStore casClient =
   interpret $
     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 =
-  (runIdentity =<<)
-    <$> retry x1 (query1 passwordSelect (params LocalQuorum (Identity u)))
-
-updatePasswordImpl :: (MonadClient m) => UserId -> Password -> m ()
-updatePasswordImpl u p = do
-  retry x5 $ write userPasswordUpdate (params LocalQuorum (p, u))
-
 ------------------------------------------------------------------------
 -- 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 = ?"
-
-userPasswordUpdate :: PrepQuery W (Password, UserId) ()
-userPasswordUpdate = {- `IF EXISTS`, but that requires benchmarking -} "UPDATE user SET password = ? WHERE id = ?"

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

@@ -105,6 +105,8 @@ data UserStore m a where
   GetRichInfo :: UserId -> UserStore m (Maybe RichInfoAssocList)
   LookupRichInfos :: [UserId] -> UserStore m [(UserId, RichInfo)]
   UpdateRichInfo :: UserId -> RichInfoAssocList -> UserStore m ()
+  UpsertHashedPassword :: UserId -> Password -> UserStore m ()
+  LookupHashedPassword :: UserId -> UserStore m (Maybe Password)
   GetUserAuthenticationInfo :: UserId -> UserStore m (Maybe (Maybe Password, AccountStatus))
   SetUserSearchable :: UserId -> SetSearchable -> UserStore m ()
   UpdateFeatureConferenceCalling :: UserId -> Maybe FeatureStatus -> UserStore m ()

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

@@ -71,6 +71,8 @@ interpretUserStoreCassandra casClient =
       UpdateUserTeam uid tid -> updateUserTeamImpl uid tid
       GetRichInfo uid -> getRichInfoImpl uid
       LookupRichInfos uids -> lookupRichInfosImpl uids
+      UpsertHashedPassword uid pw -> upsertHashedPasswordImpl uid pw
+      LookupHashedPassword uid -> lookupHashedPasswordImpl uid
       GetUserAuthenticationInfo uid -> getUserAuthenticationInfoImpl uid
       DeleteEmail uid -> deleteEmailImpl uid
       SetUserSearchable uid searchable -> setUserSearchableImpl uid searchable
@@ -90,6 +92,21 @@ createUserImpl new mbConv = retry x5 . batch $ do
     for_ mbTid $ \tid ->
       addPrepQuery insertServiceTeam (pid, sid, BotId new.id, cid, tid)
 
+upsertHashedPasswordImpl :: (MonadClient m) => UserId -> Password -> m ()
+upsertHashedPasswordImpl u p = do
+  retry x5 $ write userPasswordUpdate (params LocalQuorum (p, u))
+  where
+    userPasswordUpdate :: PrepQuery W (Password, UserId) ()
+    userPasswordUpdate = "UPDATE user SET password = ? WHERE id = ?"
+
+lookupHashedPasswordImpl :: (MonadClient m) => UserId -> m (Maybe Password)
+lookupHashedPasswordImpl u =
+  (runIdentity =<<)
+    <$> retry x1 (query1 selectPassword (params LocalQuorum (Identity u)))
+  where
+    selectPassword :: PrepQuery R (Identity UserId) (Identity (Maybe Password))
+    selectPassword = "SELECT password FROM user WHERE id = ?"
+
 getUserAuthenticationInfoImpl :: UserId -> Client (Maybe (Maybe Password, AccountStatus))
 getUserAuthenticationInfoImpl uid = fmap f <$> retry x1 (query1 authSelect (params LocalQuorum (Identity uid)))
   where