From e6483884fa264c5059f31347479c885ca9eb14c8 Mon Sep 17 00:00:00 2001 From: Akshay Mankar Date: Mon, 17 Jun 2024 14:46:10 +0200 Subject: [PATCH] Make mkPasswordResetKey pure --- libs/wire-api/src/Wire/API/User/Password.hs | 13 +++++++++++++ libs/wire-subsystems/src/Wire/CodeStore.hs | 1 - .../src/Wire/CodeStore/Cassandra.hs | 8 -------- libs/wire-subsystems/src/Wire/MiniBackend.hs | 7 ++----- .../src/Wire/PasswordStore/Interpreter.hs | 4 ++-- .../src/Wire/UserSubsystem/Interpreter.hs | 16 ++++++++-------- 6 files changed, 25 insertions(+), 24 deletions(-) diff --git a/libs/wire-api/src/Wire/API/User/Password.hs b/libs/wire-api/src/Wire/API/User/Password.hs index 9d95edd4761..e9d1eb7ae28 100644 --- a/libs/wire-api/src/Wire/API/User/Password.hs +++ b/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) diff --git a/libs/wire-subsystems/src/Wire/CodeStore.hs b/libs/wire-subsystems/src/Wire/CodeStore.hs index 31a3ae51112..c2e0526e04b 100644 --- a/libs/wire-subsystems/src/Wire/CodeStore.hs +++ b/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)) diff --git a/libs/wire-subsystems/src/Wire/CodeStore/Cassandra.hs b/libs/wire-subsystems/src/Wire/CodeStore/Cassandra.hs index a4520626bf0..1605789e3c3 100644 --- a/libs/wire-subsystems/src/Wire/CodeStore/Cassandra.hs +++ b/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 -> diff --git a/libs/wire-subsystems/src/Wire/MiniBackend.hs b/libs/wire-subsystems/src/Wire/MiniBackend.hs index adc1bdd91d9..a738d1cefd6 100644 --- a/libs/wire-subsystems/src/Wire/MiniBackend.hs +++ b/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") diff --git a/libs/wire-subsystems/src/Wire/PasswordStore/Interpreter.hs b/libs/wire-subsystems/src/Wire/PasswordStore/Interpreter.hs index dbfd6210e3d..a6e5211cad0 100644 --- a/libs/wire-subsystems/src/Wire/PasswordStore/Interpreter.hs +++ b/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 diff --git a/libs/wire-subsystems/src/Wire/UserSubsystem/Interpreter.hs b/libs/wire-subsystems/src/Wire/UserSubsystem/Interpreter.hs index 1fac78fb8ee..eacefc6d2e6 100644 --- a/libs/wire-subsystems/src/Wire/UserSubsystem/Interpreter.hs +++ b/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