Move password reset code to AuthenticationSubsystem (#4086)

This introduces a new Subsystem: AuthenticationSubsystem along with a few store effects. The new subsystem is not tested with MiniBackend, instead there is a stack of interpreters which are a composition of interpreters that MiniBackend uses. This allows us to mock the UserSubsystem as a whole and not worry about its internals. As a result of this MiniBackend now lives in the tests and not the wire-subsystem library and the intepreters it uses no longer directly depend on `State MiniBackend` but rather on a subset of this state, which can be lifted to `State MiniBackend`.

We decided PasswordStore is a separate store even if the password is stored in the user table because most of the time it is accessed independently and it seems simpler that AuthenticationSubsystem is the only thing that cares about it.

Drive by fix: Ensure that brig logs request IDs in every place where polysemy logging effect is used.

Co-authored-by: Matthias Fischmann <[email protected]>
Co-authored-by: Akshay Mankar <[email protected]>

changelog.d/3-bug-fixes/WPB-8890

@@ -0,0 +1 @@
+Log request ids in brig.

changelog.d/5-internal/WPB-8890-subsystems

@@ -0,0 +1 @@
+Introduce authentication subsystem with password reset.

services/brig/src/Brig/Allowlists.hs → libs/wire-api/src/Wire/API/Allowlists.hs

@@ -18,7 +18,7 @@
 -- | > docs/reference/user/activation.md {#RefActivationAllowlist}
 --
 -- Email/phone whitelist.
-module Brig.Allowlists
+module Wire.API.Allowlists
   ( AllowlistEmailDomains (..),
     AllowlistPhonePrefixes (..),
     verify,

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

@@ -22,11 +22,13 @@ module Wire.API.Password
   ( Password,
     PasswordStatus (..),
     genPassword,
-    mkSafePassword,
+    mkSafePasswordScrypt,
     mkSafePasswordArgon2id,
     verifyPassword,
     verifyPasswordWithStatus,
     unsafeMkPassword,
+    hashPasswordArgon2idWithSalt,
+    hashPasswordArgon2idWithOptions,
   )
 where
 
@@ -90,8 +92,8 @@ data ScryptParameters = ScryptParameters
   }
   deriving (Eq, Show)
 
-defaultParams :: ScryptParameters
-defaultParams =
+defaultScryptParams :: ScryptParameters
+defaultScryptParams =
   ScryptParameters
     { saltLength = 32,
       rounds = 14,
@@ -129,9 +131,8 @@ genPassword =
   liftIO . fmap (plainTextPassword8Unsafe . Text.decodeUtf8 . B64.encode) $
     randBytes 12
 
--- | Stretch a plaintext password so that it can be safely stored.
-mkSafePassword :: (MonadIO m) => PlainTextPassword' t -> m Password
-mkSafePassword = fmap Password . hashPasswordScrypt . Text.encodeUtf8 . fromPlainTextPassword
+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
@@ -147,44 +148,50 @@ verifyPasswordWithStatus plain opaque =
       expected = fromPassword opaque
    in checkPassword actual expected
 
-hashPasswordArgon2id :: (MonadIO m) => ByteString -> m Text
-hashPasswordArgon2id pwd = do
-  salt <- newSalt $ fromIntegral defaultParams.saltLength
-  let key = hashPasswordWithOptions defaultOptions pwd salt
-      opts =
-        Text.intercalate
-          ","
-          [ "m=" <> showT defaultOptions.memory,
-            "t=" <> showT defaultOptions.iterations,
-            "p=" <> showT defaultOptions.parallelism
-          ]
-  pure $
-    "$argon2"
-      <> Text.intercalate
-        "$"
-        [ variantToCode defaultOptions.variant,
-          "v=" <> versionToNum defaultOptions.version,
-          opts,
-          encodeWithoutPadding salt,
-          encodeWithoutPadding key
-        ]
-  where
-    encodeWithoutPadding = Text.dropWhileEnd (== '=') . Text.decodeUtf8 . B64.encode
-
 hashPasswordScrypt :: (MonadIO m) => ByteString -> m Text
 hashPasswordScrypt password = do
-  salt <- newSalt $ fromIntegral defaultParams.saltLength
-  let key = hashPasswordWithParams defaultParams password salt
+  salt <- newSalt $ fromIntegral defaultScryptParams.saltLength
+  let key = hashPasswordWithParams defaultScryptParams password salt
   pure $
     Text.intercalate
       "|"
-      [ showT defaultParams.rounds,
-        showT defaultParams.blockSize,
-        showT defaultParams.parallelism,
+      [ 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
+hashPasswordArgon2id pwd = do
+  salt <- newSalt 32
+  pure $ hashPasswordArgon2idWithSalt salt pwd
+
+hashPasswordArgon2idWithSalt :: ByteString -> ByteString -> Text
+hashPasswordArgon2idWithSalt = hashPasswordArgon2idWithOptions defaultOptions
+
+hashPasswordArgon2idWithOptions :: Argon2idOptions -> ByteString -> ByteString -> Text
+hashPasswordArgon2idWithOptions opts salt pwd = do
+  let key = hashPasswordWithOptions opts pwd salt
+      optsStr =
+        Text.intercalate
+          ","
+          [ "m=" <> showT opts.memory,
+            "t=" <> showT opts.iterations,
+            "p=" <> showT opts.parallelism
+          ]
+   in "$argon2"
+        <> Text.intercalate
+          "$"
+          [ variantToCode opts.variant,
+            "v=" <> versionToNum opts.version,
+            optsStr,
+            encodeWithoutPadding salt,
+            encodeWithoutPadding key
+          ]
+  where
+    encodeWithoutPadding = Text.dropWhileEnd (== '=') . Text.decodeUtf8 . B64.encode
+
 checkPassword :: Text -> Text -> (Bool, PasswordStatus)
 checkPassword actual expected =
   case parseArgon2idPasswordHashOptions expected of

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

@@ -38,6 +38,7 @@ module Wire.API.User.Auth
     Cookie (..),
     CookieLabel (..),
     RemoveCookies (..),
+    toUnitCookie,
 
     -- * Token
     AccessToken (..),
@@ -59,6 +60,7 @@ module Wire.API.User.Auth
   )
 where
 
+import Cassandra
 import Control.Applicative
 import Control.Lens ((?~), (^.))
 import Control.Lens.TH
@@ -140,6 +142,8 @@ newtype LoginCode = LoginCode
   deriving newtype (Arbitrary)
   deriving (FromJSON, ToJSON, S.ToSchema) via Schema LoginCode
 
+deriving instance Cql LoginCode
+
 instance ToSchema LoginCode where
   schema = LoginCode <$> fromLoginCode .= text "LoginCode"
 
@@ -281,11 +285,20 @@ newtype CookieLabel = CookieLabel
       ToSchema
     )
 
+deriving instance Cql CookieLabel
+
 newtype CookieId = CookieId
   {cookieIdNum :: Word32}
   deriving stock (Eq, Show, Generic)
   deriving newtype (ToSchema, FromJSON, ToJSON, Arbitrary)
 
+instance Cql CookieId where
+  ctype = Cassandra.Tagged BigIntColumn
+  toCql = CqlBigInt . fromIntegral . cookieIdNum
+
+  fromCql (CqlBigInt i) = pure (CookieId (fromIntegral i))
+  fromCql _ = Left "fromCql: invalid cookie id"
+
 data CookieType
   = -- | A session cookie. These are mainly intended for clients
     -- that are web browsers. For other clients, session cookies
@@ -301,12 +314,25 @@ data CookieType
   deriving (Arbitrary) via (GenericUniform CookieType)
   deriving (FromJSON, ToJSON, S.ToSchema) via Schema CookieType
 
+instance Cql CookieType where
+  ctype = Cassandra.Tagged IntColumn
+
+  toCql SessionCookie = CqlInt 0
+  toCql PersistentCookie = CqlInt 1
+
+  fromCql (CqlInt 0) = pure SessionCookie
+  fromCql (CqlInt 1) = pure PersistentCookie
+  fromCql _ = Left "fromCql: invalid cookie type"
+
 instance ToSchema CookieType where
   schema =
     enum @Text "CookieType" $
       element "session" SessionCookie
         <> element "persistent" PersistentCookie
 
+toUnitCookie :: Cookie a -> Cookie ()
+toUnitCookie c = c {cookieValue = ()}
+
 --------------------------------------------------------------------------------
 -- Login
 

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
@@ -172,9 +177,17 @@ data PasswordResetIdentity
 -- | Opaque identifier per user (SHA256 of the user ID).
 newtype PasswordResetKey = PasswordResetKey
   {fromPasswordResetKey :: AsciiBase64Url}
-  deriving stock (Eq, Show)
+  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-api/test/unit/Test/Wire/API/Password.hs

@@ -32,6 +32,14 @@ tests =
       testCase "verify old scrypt password still works" testHashingOldScrypt
     ]
 
+testHashPasswordScrypt :: IO ()
+testHashPasswordScrypt = do
+  pwd <- genPassword
+  hashed <- mkSafePasswordScrypt pwd
+  let (correct, status) = verifyPasswordWithStatus pwd hashed
+  assertBool "Password could not be verified" correct
+  assertEqual "Password could not be verified" status PasswordStatusOk
+
 testHashPasswordArgon2id :: IO ()
 testHashPasswordArgon2id = do
   pwd <- genPassword

libs/wire-api/wire-api.cabal

@@ -68,6 +68,7 @@ library
 
   -- cabal-fmt: expand src
   exposed-modules:
+    Wire.API.Allowlists
     Wire.API.ApplyMods
     Wire.API.Asset
     Wire.API.Bot

libs/wire-subsystems/default.nix

@@ -16,6 +16,7 @@
 , cassandra-util
 , containers
 , cql
+, crypton
 , currency-codes
 , data-default
 , data-timeout
@@ -130,6 +131,7 @@ mkDerivation {
     bilge
     bytestring
     containers
+    crypton
     data-default
     errors
     extended
@@ -148,6 +150,7 @@ mkDerivation {
     string-conversions
     text
     time
+    tinylog
     transformers
     types-common
     wire-api

services/brig/src/Brig/Effects/PasswordResetStore.hs → libs/wire-subsystems/src/Wire/AuthenticationSubsystem.hs

@@ -16,25 +16,20 @@
 -- with this program. If not, see <https://www.gnu.org/licenses/>.
 {-# LANGUAGE TemplateHaskell #-}
 
-module Brig.Effects.PasswordResetStore where
+module Wire.AuthenticationSubsystem where
 
-import Brig.Types.User (PasswordResetPair)
 import Data.Id
+import Data.Misc
 import Imports
 import Polysemy
-import Wire.API.User.Identity
+import Wire.API.User
 import Wire.API.User.Password
+import Wire.UserKeyStore
 
-data PasswordResetStore m a where
-  CreatePasswordResetCode ::
-    UserId ->
-    Either Email Phone ->
-    PasswordResetStore m PasswordResetPair
-  LookupPasswordResetCode ::
-    UserId ->
-    PasswordResetStore m (Maybe PasswordResetCode)
-  VerifyPasswordResetCode ::
-    PasswordResetPair ->
-    PasswordResetStore m (Maybe UserId)
+data AuthenticationSubsystem m a where
+  CreatePasswordResetCode :: UserKey -> AuthenticationSubsystem m (UserId, PasswordResetPair)
+  ResetPassword :: PasswordResetIdentity -> PasswordResetCode -> PlainTextPassword8 -> AuthenticationSubsystem m ()
+  -- For testing
+  InternalLookupPasswordResetCode :: UserKey -> AuthenticationSubsystem m (Maybe PasswordResetPair)
 
-makeSem ''PasswordResetStore
+makeSem ''AuthenticationSubsystem

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

@@ -0,0 +1,45 @@
+-- This file is part of the Wire Server implementation.
+--
+-- Copyright (C) 2024 Wire Swiss GmbH <[email protected]>
+--
+-- This program is free software: you can redistribute it and/or modify it under
+-- the terms of the GNU Affero General Public License as published by the Free
+-- Software Foundation, either version 3 of the License, or (at your option) any
+-- later version.
+--
+-- This program is distributed in the hope that it will be useful, but WITHOUT
+-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more
+-- details.
+--
+-- You should have received a copy of the GNU Affero General Public License along
+-- with this program. If not, see <https://www.gnu.org/licenses/>.
+module Wire.AuthenticationSubsystem.Error
+  ( AuthenticationSubsystemError (..),
+    authenticationSubsystemErrorToWai,
+  )
+where
+
+import Imports
+import Network.Wai.Utilities.Error qualified as Wai
+import Wire.API.Error
+import Wire.API.Error.Brig qualified as E
+
+data AuthenticationSubsystemError
+  = AuthenticationSubsystemInvalidPasswordResetKey
+  | AuthenticationSubsystemPasswordResetInProgress
+  | AuthenticationSubsystemResetPasswordMustDiffer
+  | AuthenticationSubsystemInvalidPasswordResetCode
+  | AuthenticationSubsystemAllowListError
+  deriving (Eq, Show)
+
+instance Exception AuthenticationSubsystemError
+
+authenticationSubsystemErrorToWai :: AuthenticationSubsystemError -> Wai.Error
+authenticationSubsystemErrorToWai =
+  dynErrorToWai . \case
+    AuthenticationSubsystemInvalidPasswordResetKey -> dynError @(MapError E.InvalidPasswordResetKey)
+    AuthenticationSubsystemPasswordResetInProgress -> dynError @(MapError E.PasswordResetInProgress)
+    AuthenticationSubsystemInvalidPasswordResetCode -> dynError @(MapError E.InvalidPasswordResetCode)
+    AuthenticationSubsystemResetPasswordMustDiffer -> dynError @(MapError E.ResetPasswordMustDiffer)
+    AuthenticationSubsystemAllowListError -> dynError @(MapError E.AllowlistError)