Make mkPasswordResetKey pure

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

@@ -24,6 +24,7 @@ module Wire.API.User.Password
     CompletePasswordReset (..),
     PasswordResetIdentity (..),
     PasswordResetKey (..),
+    mkPasswordResetKey,
     PasswordResetCode (..),
 
     -- * deprecated
@@ -33,9 +34,13 @@ where
 
 import Cassandra qualified as C
 import Control.Lens ((?~))
+import Crypto.Hash
 import Data.Aeson qualified as A
 import Data.Aeson.Types (Parser)
+import Data.ByteArray qualified as ByteArray
+import Data.ByteString qualified as BS
 import Data.ByteString.Conversion
+import Data.Id
 import Data.Misc (PlainTextPassword8)
 import Data.OpenApi qualified as S
 import Data.OpenApi.ParamSchema
@@ -175,6 +180,14 @@ newtype PasswordResetKey = PasswordResetKey
   deriving stock (Eq, Show, Ord)
   deriving newtype (ToSchema, FromByteString, ToByteString, A.FromJSON, A.ToJSON, Arbitrary)
 
+mkPasswordResetKey :: UserId -> PasswordResetKey
+mkPasswordResetKey userId =
+  PasswordResetKey
+    . encodeBase64Url
+    . BS.pack
+    . ByteArray.unpack
+    $ hashWith SHA256 (toByteString' userId)
+
 instance ToParamSchema PasswordResetKey where
   toParamSchema _ = toParamSchema (Proxy @Text)
 

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

@@ -34,7 +34,6 @@ data PRQueryData f = PRQueryData
   }
 
 data CodeStore m a where
-  MkPasswordResetKey :: UserId -> CodeStore m PasswordResetKey
   GenerateEmailCode :: CodeStore m PasswordResetCode
   GeneratePhoneCode :: CodeStore m PasswordResetCode
   CodeSelect :: PasswordResetKey -> CodeStore m (Maybe (PRQueryData Maybe))

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

@@ -23,14 +23,12 @@ module Wire.CodeStore.Cassandra
 where
 
 import Cassandra
-import Data.ByteString.Conversion (toByteString')
 import Data.Id
 import Data.Text (pack)
 import Data.Text.Ascii
 import Data.Time.Clock
 import Imports
 import OpenSSL.BN (randIntegerZeroToNMinusOne)
-import OpenSSL.EVP.Digest (digestBS, getDigestByName)
 import OpenSSL.Random (randBytes)
 import Polysemy
 import Text.Printf
@@ -46,7 +44,6 @@ codeStoreToCassandra =
   interpret $
     embed @m
       . \case
-        MkPasswordResetKey uid -> mkPwdResetKey uid
         GenerateEmailCode -> genEmailCode
         GeneratePhoneCode -> genPhoneCode
         CodeSelect prk ->
@@ -82,11 +79,6 @@ genPhoneCode =
   PasswordResetCode . unsafeFromText . pack . printf "%06d"
     <$> liftIO (randIntegerZeroToNMinusOne 1000000)
 
-mkPwdResetKey :: MonadIO m => UserId -> m PasswordResetKey
-mkPwdResetKey u = do
-  d <- liftIO $ getDigestByName "SHA256" >>= maybe (error "SHA256 not found") pure
-  pure . PasswordResetKey . encodeBase64Url . digestBS d $ toByteString' u
-
 interpretClientToIO ::
   Member (Final IO) r =>
   ClientState ->

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

@@ -22,7 +22,6 @@ module Wire.MiniBackend
   )
 where
 
-import Data.ByteString.Conversion
 import Data.Default (Default (def))
 import Data.Domain
 import Data.Handle (Handle)
@@ -338,7 +337,7 @@ runNoFederationStackState localBackend teamMember cfg =
   runAllErrorsUnsafe . interpretNoFederationStackState localBackend teamMember def cfg
 
 interpretNoFederationStack ::
-  (HasCallStack, Members AllErrors r) =>
+  Members AllErrors r =>
   MiniBackend ->
   Maybe TeamMember ->
   AllFeatureConfigs ->
@@ -349,7 +348,7 @@ interpretNoFederationStack localBackend teamMember galleyConfigs cfg =
   snd <$$> interpretNoFederationStackState localBackend teamMember galleyConfigs cfg
 
 interpretNoFederationStackState ::
-  (HasCallStack, Members AllErrors r) =>
+  Members AllErrors r =>
   MiniBackend ->
   Maybe TeamMember ->
   AllFeatureConfigs ->
@@ -425,8 +424,6 @@ staticCodeStore ::
   Member (State MiniBackend) r =>
   InterpreterFor CodeStore r
 staticCodeStore = interpret \case
-  MkPasswordResetKey uid ->
-    pure . PasswordResetKey . encodeBase64Url $ toByteString' uid
   GenerateEmailCode ->
     pure . PasswordResetCode . encodeBase64Url $ "email-code"
   GeneratePhoneCode -> (error "deprecated")

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

@@ -64,7 +64,7 @@ create ::
   Either Email Phone ->
   Sem r PasswordResetPair
 create u target = do
-  key <- mkPasswordResetKey u
+  let key = mkPasswordResetKey u
   now <- Now.get
   code <- either (const generateEmailCode) (const generatePhoneCode) target
   codeInsert
@@ -80,7 +80,7 @@ lookup ::
   UserId ->
   Sem r (Maybe PasswordResetCode)
 lookup u = do
-  key <- mkPasswordResetKey u
+  let key = mkPasswordResetKey u
   now <- Now.get
   validate now =<< codeSelect key
   where

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

@@ -537,16 +537,16 @@ checkNewIsDifferent uid pw = do
     _ -> pure ()
 
 mkPasswordResetKey' ::
-  (Member (Error UserSubsystemError) r, Member UserKeyStore r, Member CodeStore r) =>
+  (Member (Error UserSubsystemError) r, Member UserKeyStore r) =>
   PasswordResetIdentity ->
   Sem r PasswordResetKey
 mkPasswordResetKey' ident = case ident of
   PasswordResetIdentityKey k -> pure k
   PasswordResetEmailIdentity e -> do
-    lookupKey (userEmailKey e)
-      >>= traverse mkPasswordResetKey
-      >>= maybe (throw UserSubsystemInvalidPasswordResetKey) pure
-  PasswordResetPhoneIdentity p ->
-    lookupKey (userPhoneKey p)
-      >>= traverse mkPasswordResetKey
-      >>= maybe (throw UserSubsystemInvalidPasswordResetKey) pure
+    mUserId <- lookupKey (userEmailKey e)
+    let mResetKey = mkPasswordResetKey <$> mUserId
+    maybe (throw UserSubsystemInvalidPasswordResetKey) pure mResetKey
+  PasswordResetPhoneIdentity p -> do
+    mUserId <- lookupKey (userPhoneKey p)
+    let mResetKey = mkPasswordResetKey <$> mUserId
+    maybe (throw UserSubsystemInvalidPasswordResetKey) pure mResetKey