Add Argon2id support on top of Scrypt for password hashing

changelog.d/5-internal/wpb-5490-passive-password-migration

@@ -0,0 +1,4 @@
+Passively migrate user passwords from scrypt to argon2id.
+
+By passively we mean that whenever a user re-enters their passwords, if it was hashed using scrypt, it is then rehashed using argon2id and stored as such. 
+If that user has a legacy short password (under 8 characters in length), it does not migrate to argon2id.

libs/types-common/src/Data/Misc.hs

@@ -59,6 +59,7 @@ module Data.Misc
     FutureWork (..),
     from64,
     readT,
+    showT,
   )
 where
 
@@ -367,6 +368,11 @@ readT :: Read a => Text -> Maybe a
 readT = readMaybe . Text.unpack
 {-# INLINE readT #-}
 
+-- | Same as 'show' but works on 'Text'
+showT :: Show a => a -> Text
+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

libs/wire-api/src/Wire/API/Error/Brig.hs

@@ -92,6 +92,7 @@ data BrigError
   | InvalidProvider
   | ProviderNotFound
   | TeamsNotFederating
+  | PasswordIsStale
 
 instance (Typeable (MapError e), KnownError (MapError e)) => IsSwaggerError (e :: BrigError) where
   addToOpenApi = addStaticErrorToSwagger @(MapError e)
@@ -275,3 +276,5 @@ type instance MapError 'PendingInvitationNotFound = 'StaticError 404 "not-found"
 type instance MapError 'ConflictingInvitations = 'StaticError 409 "conflicting-invitations" "Multiple conflicting invitations to different teams exists."
 
 type instance MapError 'TeamsNotFederating = 'StaticError 403 "team-not-federating" "The target user is owned by a federated backend, but is not in an allow-listed team"
+
+type instance MapError 'PasswordIsStale = 'StaticError 403 "password-is-stale" "The password is too old, please update your password."

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

@@ -16,17 +16,23 @@
 -- 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/>.
 {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
+{-# OPTIONS_GHC -Wno-unused-top-binds #-}
 
 module Wire.API.Password
   ( Password,
+    PasswordStatus (..),
     genPassword,
     mkSafePassword,
+    mkSafePasswordArgon2id,
     verifyPassword,
+    verifyPasswordWithStatus,
     unsafeMkPassword,
   )
 where
 
 import Cassandra
+import Crypto.Error
+import Crypto.KDF.Argon2 qualified as Argon2
 import Crypto.KDF.Scrypt as Scrypt
 import Crypto.Random
 import Data.ByteArray hiding (length)
@@ -57,8 +63,15 @@ instance Cql Password where
 unsafeMkPassword :: Text -> Password
 unsafeMkPassword = Password
 
+data PasswordStatus
+  = PasswordStatusOk
+  | PasswordStatusNeedsUpdate
+  deriving (Show, Eq)
+
 -------------------------------------------------------------------------------
 
+type Argon2idOptions = Argon2.Options
+
 data ScryptParameters = ScryptParameters
   { -- | Bytes to randomly generate as a unique salt, default is __32__
     saltLength :: Word32,
@@ -87,6 +100,17 @@ defaultParams =
       outputLength = 64
     }
 
+-- | These are the default values suggested, as extracted from the crypton library.
+defaultOptions :: Argon2idOptions
+defaultOptions =
+  Argon2.Options
+    { iterations = 5,
+      memory = 2 ^ (17 :: Int),
+      parallelism = 4,
+      variant = Argon2.Argon2id,
+      version = Argon2.Version13
+    }
+
 fromScrypt :: ScryptParameters -> Parameters
 fromScrypt scryptParams =
   Parameters
@@ -107,57 +131,118 @@ genPassword =
 
 -- | Stretch a plaintext password so that it can be safely stored.
 mkSafePassword :: MonadIO m => PlainTextPassword' t -> m Password
-mkSafePassword = fmap Password . hashPassword . Text.encodeUtf8 . fromPlainTextPassword
+mkSafePassword = fmap Password . hashPasswordScrypt . Text.encodeUtf8 . fromPlainTextPassword
+
+mkSafePasswordArgon2id :: MonadIO m => PlainTextPassword' t -> m Password
+mkSafePasswordArgon2id = fmap Password . hashPasswordArgon2id . Text.encodeUtf8 . fromPlainTextPassword
 
 -- | Verify a plaintext password from user input against a stretched
 -- password from persistent storage.
 verifyPassword :: PlainTextPassword' t -> Password -> Bool
-verifyPassword plain opaque =
+verifyPassword = (fst .) . verifyPasswordWithStatus
+
+verifyPasswordWithStatus :: PlainTextPassword' t -> Password -> (Bool, PasswordStatus)
+verifyPasswordWithStatus plain opaque =
   let actual = fromPlainTextPassword plain
       expected = fromPassword opaque
    in checkPassword actual expected
 
-hashPassword :: MonadIO m => ByteString -> m Text
-hashPassword password = do
+hashPasswordArgon2id :: MonadIO m => ByteString -> m Text
+hashPasswordArgon2id pwd = do
   salt <- newSalt $ fromIntegral defaultParams.saltLength
-  let key = hashPasswordWithSalt password salt
+  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
   pure $
     Text.intercalate
       "|"
-      [ "14",
-        "8",
-        "1",
+      [ showT defaultParams.rounds,
+        showT defaultParams.blockSize,
+        showT defaultParams.parallelism,
         Text.decodeUtf8 . B64.encode $ salt,
         Text.decodeUtf8 . B64.encode $ key
       ]
 
-hashPasswordWithSalt :: ByteString -> ByteString -> ByteString
-hashPasswordWithSalt password salt = hashPasswordWithParams defaultParams password salt
-
-hashPasswordWithParams ::
-  ( ByteArrayAccess password,
-    ByteArrayAccess salt
-  ) =>
-  ScryptParameters ->
-  password ->
-  salt ->
-  ByteString
-hashPasswordWithParams parameters password salt = convert (generate (fromScrypt parameters) password salt :: Bytes)
-
-checkPassword :: Text -> Text -> Bool
-checkPassword actual expected = fromMaybe False $ do
-  (sparams, salt, hashedKey) <- parseScryptPasswordHashParams $ Text.encodeUtf8 expected
-  let producedKey = hashPasswordWithParams sparams (Text.encodeUtf8 actual) salt
-  pure $ hashedKey `constEq` producedKey
+checkPassword :: Text -> Text -> (Bool, PasswordStatus)
+checkPassword actual expected =
+  case parseArgon2idPasswordHashOptions expected of
+    Just (opts, salt, hashedKey) ->
+      let producedKey = hashPasswordWithOptions opts (Text.encodeUtf8 actual) salt
+       in (hashedKey `constEq` producedKey, PasswordStatusOk)
+    Nothing ->
+      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)
 
 newSalt :: MonadIO m => Int -> m ByteString
 newSalt i = liftIO $ getRandomBytes i
 {-# INLINE newSalt #-}
 
+parseArgon2idPasswordHashOptions :: Text -> Maybe (Argon2idOptions, ByteString, ByteString)
+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)
+  where
+    parseParameters paramsT = do
+      let paramsL = Text.split (== ',') paramsT
+      guard $ Imports.length paramsL == 3
+      go paramsL (Nothing, Nothing, Nothing)
+      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)
 parseScryptPasswordHashParams passwordHash = do
   let paramList = Text.split (== '|') . Text.decodeUtf8 $ passwordHash
-  guard $ length paramList == 5
+  guard (length paramList == 5)
   let [ scryptRoundsT,
         scryptBlockSizeT,
         scryptParallelismT,
@@ -176,3 +261,69 @@ parseScryptPasswordHashParams passwordHash = do
       salt,
       hashedKey
     )
+
+-------------------------------------------------------------------------------
+
+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
+
+hashPasswordWithParams ::
+  ( ByteArrayAccess password,
+    ByteArrayAccess salt
+  ) =>
+  ScryptParameters ->
+  password ->
+  salt ->
+  ByteString
+hashPasswordWithParams parameters password salt = convert (generate (fromScrypt parameters) password salt :: Bytes)
+
+--------------------------------------------------------------------------------
+
+-- | Makes a letter out of the variant
+variantToCode :: Argon2.Variant -> Text
+variantToCode = \case
+  Argon2.Argon2i -> "i"
+  Argon2.Argon2d -> "d"
+  Argon2.Argon2id -> "id"
+
+-- | Parses the variant parameter in the encoded hash
+letterToVariant :: Text -> Maybe Argon2.Variant
+letterToVariant = \case
+  "i" -> Just Argon2.Argon2i
+  "d" -> Just Argon2.Argon2d
+  "id" -> Just Argon2.Argon2id
+  _ -> Nothing
+
+-- | Parses the "v=" parameter in the encoded hash
+numToVersion :: Text -> Maybe Argon2.Version
+numToVersion "16" = Just Argon2.Version10
+numToVersion "19" = Just Argon2.Version13
+numToVersion _ = Nothing
+
+-- | Makes number for the "v=" parameter in the encoded hash
+versionToNum :: Argon2.Version -> Text
+versionToNum Argon2.Version10 = "16"
+versionToNum Argon2.Version13 = "19"
+
+-- | Strips the given 'match' if it matches and uses
+--   the function on the remainder of the given text.
+splitMaybe :: Text -> (Text -> Maybe a) -> Text -> Maybe a
+splitMaybe match f t =
+  Text.stripPrefix match t >>= f
+
+-- | (UNSAFE) Pad a base64 text to "length `rem` 4 == 0" with "="
+--
+-- prop> \bs -> let b64 = encodeBase64 bs in unsafePad64 (T.dropWhileEnd (== '=') b64) == b64
+unsafePad64 :: Text -> Text
+unsafePad64 t
+  | remains == 0 = t
+  | otherwise = t <> pad
+  where
+    remains = Text.length t `rem` 4
+    pad = Text.replicate (4 - remains) "="

libs/wire-api/test/unit/Test/Wire/API/Password.hs

@@ -27,23 +27,45 @@ import Wire.API.Password
 tests :: TestTree
 tests =
   testGroup "Password" $
-    [ testCase "hash password" testHashPassword,
-      testCase "verify compat" verifyPasswordHashingRemainsCompatible
+    [ testCase "hash password argon2id" testHashPasswordArgon2id,
+      testCase "update pwd hash" testUpdateHash,
+      testCase "verify old scrypt password still works" testHashingOldScrypt
     ]
 
-testHashPassword :: IO ()
-testHashPassword = do
+testHashPasswordArgon2id :: IO ()
+testHashPasswordArgon2id = do
   pwd <- genPassword
-  hashed <- mkSafePassword pwd
-  let correct = verifyPassword pwd hashed
+  hashed <- mkSafePasswordArgon2id pwd
+  let (correct, status) = verifyPasswordWithStatus pwd hashed
   assertBool "Password could not be verified" correct
+  assertEqual "Password could not be verified" status PasswordStatusOk
 
-verifyPasswordHashingRemainsCompatible :: IO ()
-verifyPasswordHashingRemainsCompatible = do
-  forConcurrently_ pwds $ \pwd ->
+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=="
+      -- 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=="
+      -- verify password with scrypt
+      (correct, status) = verifyPasswordWithStatus orig expected
+
+  assertBool "Password did not match hash." correct
+  assertEqual "Password could not be verified" status PasswordStatusNeedsUpdate
+
+  -- verify again with argon2id
+  let (correctNew, statusNew) = verifyPasswordWithStatus orig newHash
+  assertBool "Password hash update failed." correctNew
+  assertEqual "Password could not be verified" statusNew PasswordStatusOk
+
+testHashingOldScrypt :: IO ()
+testHashingOldScrypt =
+  forConcurrently_ pwds $ \pwd -> do
     let orig = plainTextPassword8Unsafe (fst pwd)
         expected = unsafeMkPassword (snd pwd)
-     in assertBool "Oops" (verifyPassword orig expected)
+        (correct, status) = verifyPasswordWithStatus orig expected
+    assertBool "Password did not match hash." correct
+    assertEqual "Password could not be verified" status PasswordStatusNeedsUpdate
   where
     -- Password and hashes generated using the old code, but verified using the new one.
     pwds =

services/brig/src/Brig/API/Error.hs

@@ -125,6 +125,7 @@ loginError LoginFailed = StdError (errorToWai @'E.BadCredentials)
 loginError LoginSuspended = StdError (errorToWai @'E.AccountSuspended)
 loginError LoginEphemeral = StdError (errorToWai @'E.AccountEphemeral)
 loginError LoginPendingActivation = StdError (errorToWai @'E.AccountPending)
+loginError LoginPasswordUpdateRequired = StdError (errorToWai @'E.PasswordIsStale)
 loginError (LoginThrottled wait) =
   RichError
     loginsTooFrequent

services/brig/src/Brig/API/Types.hs

@@ -153,6 +153,7 @@ data LoginError
   | LoginBlocked RetryAfter
   | LoginCodeRequired
   | LoginCodeInvalid
+  | LoginPasswordUpdateRequired
 
 data VerificationCodeError
   = VerificationCodeRequired