Add extractParams for Argon2, PBKDF2, and Scrypt

password/ChangeLog.md

@@ -1,5 +1,11 @@
 # Changelog for `password`
 
+## 3.0.2.0
+
+-   Add `extractParams` on `PasswordHash`s
+    Thanks to [@blackheaven](https://github.com/blackheaven)
+    [#61](https://github.com/cdepillabout/password/pull/61)
+
 ## 3.0.1.0
 
 -   Argon2 hashes without a version field are interpreted as being of version 1.0

password/password.cabal

@@ -1,7 +1,7 @@
 cabal-version: 1.12
 
 name:           password
-version:        3.0.1.0
+version:        3.0.2.0
 category:       Data
 synopsis:       Hashing and checking of passwords
 description:

password/src/Data/Password/Argon2.hs

@@ -52,6 +52,7 @@ module Data.Password.Argon2 (
   -- * Hashing Manually (Argon2)
   , hashPasswordWithParams
   , defaultParams
+  , extractParams
   , Argon2Params(..)
   , Argon2.Variant(..)
   , Argon2.Version(..)
@@ -274,14 +275,17 @@ hashPasswordWithParams params pass = liftIO $ do
 --
 -- prop> \(Blind badpass) -> let correctPasswordHash = hashPasswordWithSalt testParams salt "foobar" in checkPassword badpass correctPasswordHash == PasswordCheckFail
 checkPassword :: Password -> PasswordHash Argon2 -> PasswordCheck
-checkPassword pass (PasswordHash passHash) =
+checkPassword pass passHash =
   fromMaybe PasswordCheckFail $ do
-    let paramList = T.split (== '$') passHash
-    (argon2Params, salt, hashedKey) <- parseArgon2Params paramList
+    (argon2Params, salt, hashedKey) <- parseArgon2PasswordHashParams passHash 
     let producedKey = hashPasswordWithSalt' argon2Params salt pass
     guard $ hashedKey `constEq` producedKey
     return PasswordCheckSuccess
 
+parseArgon2PasswordHashParams :: PasswordHash Argon2 -> Maybe (Argon2Params, Salt Argon2, ByteString)
+parseArgon2PasswordHashParams (PasswordHash passHash) =
+  parseArgon2Params $ T.split (== '$') passHash
+
 parseArgon2Params :: [Text] -> Maybe (Argon2Params, Salt Argon2, ByteString)
 -- vp - version or params
 -- ps - params or salt
@@ -309,7 +313,7 @@ parseAll argon2Variant argon2Version parametersT salt64 hashedKey64 = do
     salt <- from64 $ unsafePad64 salt64
     hashedKey <- from64 $ unsafePad64 hashedKey64
     let argon2OutputLength = fromIntegral $ B.length hashedKey -- only here because of warnings
-        argon2Salt = 16 -- only here because of warnings
+        argon2Salt = fromIntegral $ B.length salt
     pure (Argon2Params{..}, Salt salt, hashedKey)
   where
     parseParameters paramsT = do
@@ -326,6 +330,20 @@ parseAll argon2Variant argon2Version parametersT salt64 hashedKey64 = do
             ("p=", i) -> go xs (m, t, readT i)
             _ -> Nothing
 
+-- | Extracts 'Argon2Params' from a 'PasswordHash' 'Argon2'.
+--
+-- Returns 'Just Argon2Params' on success.
+--
+-- >>> let pass = mkPassword "foobar"
+-- >>> passHash <- hashPassword pass
+-- >>> extractParams passHash == Just defaultParams
+-- True
+--
+-- @since 3.0.2.0
+extractParams :: PasswordHash Argon2 -> Maybe Argon2Params
+extractParams passHash =
+  (\(params, _, _) -> params) <$> parseArgon2PasswordHashParams passHash
+
 -- | 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

password/src/Data/Password/Bcrypt.hs

@@ -45,6 +45,7 @@ module Data.Password.Bcrypt (
   , PasswordCheck(..)
   -- * Hashing Manually (bcrypt)
   , hashPasswordWithParams
+  , extractParams
   -- ** Hashing with salt (DISADVISED)
   --
   -- | Hashing with a set 'Salt' is almost never what you want
@@ -59,9 +60,12 @@ module Data.Password.Bcrypt (
     -- $setup
   ) where
 
+import Control.Monad (guard)
 import Control.Monad.IO.Class (MonadIO(liftIO))
 import Crypto.KDF.BCrypt as Bcrypt (bcrypt, validatePassword)
 import Data.ByteArray (Bytes, convert)
+import qualified Data.Text as T
+import Text.Read (readMaybe)
 
 import Data.Password.Types (
     Password
@@ -183,6 +187,22 @@ checkPassword pass (PasswordHash passHash) =
       then PasswordCheckSuccess
       else PasswordCheckFail
 
+-- | Extracts the cost parameter as an 'Int' from a 'PasswordHash' 'Bcrypt'
+--
+-- >>> let pass = mkPassword "foobar"
+-- >>> passHash <- hashPassword pass
+-- >>> extractParams passHash == Just 10
+-- True
+--
+-- @since 3.0.2.0
+extractParams :: PasswordHash Bcrypt -> Maybe Int
+extractParams (PasswordHash passHash) =
+  case T.split (== '$') passHash of
+    [_, version, cost, _pass] -> do
+      guard $ elem version $ map T.pack ["2", " 2a", " 2x", " 2y", " 2b"]
+      readMaybe $ T.unpack cost
+    _ -> Nothing
+
 -- | Generate a random 16-byte @bcrypt@ salt
 --
 -- @since 2.0.0.0

password/src/Data/Password/PBKDF2.hs

@@ -51,6 +51,7 @@ module Data.Password.PBKDF2 (
   -- * Hashing Manually (PBKDF2)
   , hashPasswordWithParams
   , defaultParams
+  , extractParams
   , PBKDF2Params(..)
   , PBKDF2Algorithm(..)
   -- ** Hashing with salt (DISADVISED)
@@ -233,8 +234,15 @@ hashPasswordWithParams params pass = liftIO $ do
 --
 -- prop> \(Blind badpass) -> let correctPasswordHash = hashPasswordWithSalt testParams salt "foobar" in checkPassword badpass correctPasswordHash == PasswordCheckFail
 checkPassword :: Password -> PasswordHash PBKDF2 -> PasswordCheck
-checkPassword pass (PasswordHash passHash) =
+checkPassword pass passHash =
   fromMaybe PasswordCheckFail $ do
+    (params, salt, hashedKey) <- parsePBKDF2PasswordHashParams passHash
+    let producedKey = hashPasswordWithSalt' params salt pass
+    guard $ hashedKey `constEq` producedKey
+    return PasswordCheckSuccess
+
+parsePBKDF2PasswordHashParams :: PasswordHash PBKDF2 -> Maybe (PBKDF2Params, Salt PBKDF2, ByteString)
+parsePBKDF2PasswordHashParams (PasswordHash passHash) = do
     -- This step makes it possible to also check the following format:
     -- "pbkdf2:sha256:150000:etc.etc."
     let passHash' = fromMaybe passHash $ "pbkdf2:" `T.stripPrefix` passHash
@@ -249,11 +257,22 @@ checkPassword pass (PasswordHash passHash) =
     salt <- from64 salt64
     hashedKey <- from64 hashedKey64
     let pbkdf2OutputLength = fromIntegral $ C8.length hashedKey
-        producedKey = hashPasswordWithSalt' PBKDF2Params{..} (Salt salt) pass
-    guard $ hashedKey `constEq` producedKey
-    return PasswordCheckSuccess
-  where
-    pbkdf2Salt = 16
+        pbkdf2Salt = fromIntegral $ C8.length salt
+    return (PBKDF2Params{..}, Salt salt, hashedKey)
+
+-- | Extracts 'PBKDF2Params' from a 'PasswordHash' 'PBKDF2'.
+--
+-- Returns 'Just PBKDF2Params' on success.
+--
+-- >>> let pass = mkPassword "foobar"
+-- >>> passHash <- hashPassword pass
+-- >>> extractParams passHash == Just defaultParams
+-- True
+--
+-- @since 3.0.2.0
+extractParams :: PasswordHash PBKDF2 -> Maybe PBKDF2Params
+extractParams passHash =
+  (\(params, _, _) -> params) <$> parsePBKDF2PasswordHashParams passHash
 
 
 -- | Type of algorithm to use for hashing PBKDF2 passwords.

password/src/Data/Password/Scrypt.hs

@@ -46,6 +46,7 @@ module Data.Password.Scrypt (
   -- * Hashing Manually (scrypt)
   , hashPasswordWithParams
   , defaultParams
+  , extractParams
   , ScryptParams(..)
   -- ** Hashing with salt (DISADVISED)
   --
@@ -243,8 +244,15 @@ hashPasswordWithParams params pass = liftIO $ do
 --
 -- prop> \(Blind badpass) -> let correctPasswordHash = hashPasswordWithSalt testParams salt "foobar" in checkPassword badpass correctPasswordHash == PasswordCheckFail
 checkPassword :: Password -> PasswordHash Scrypt -> PasswordCheck
-checkPassword pass (PasswordHash passHash) =
+checkPassword pass passHash =
   fromMaybe PasswordCheckFail $ do
+    (params, salt, hashedKey) <- parseScryptPasswordHashParams passHash
+    let producedKey = hashPasswordWithSalt' params salt pass
+    guard $ hashedKey `constEq` producedKey
+    return PasswordCheckSuccess
+
+parseScryptPasswordHashParams :: PasswordHash Scrypt -> Maybe (ScryptParams, Salt Scrypt, ByteString)
+parseScryptPasswordHashParams (PasswordHash passHash) = do
     let paramList = T.split (== '|') passHash
     guard $ length paramList == 5
     let [ scryptRoundsT,
@@ -258,11 +266,22 @@ checkPassword pass (PasswordHash passHash) =
     salt <- from64 salt64
     hashedKey <- from64 hashedKey64
     let scryptOutputLength = fromIntegral $ C8.length hashedKey
-        producedKey = hashPasswordWithSalt' ScryptParams{..} (Salt salt) pass
-    guard $ hashedKey `constEq` producedKey
-    return PasswordCheckSuccess
-  where
-    scryptSalt = 32 -- only here because of warnings
+        scryptSalt = fromIntegral $ C8.length salt
+    return (ScryptParams{..}, Salt salt, hashedKey)
+
+-- | Extracts 'ScryptParams' from a 'PasswordHash' 'Scrypt'.
+--
+-- Returns 'Just ScryptParams' on success.
+--
+-- >>> let pass = mkPassword "foobar"
+-- >>> passHash <- hashPassword pass
+-- >>> extractParams passHash == Just defaultParams
+-- True
+--
+-- @since 3.0.2.0
+extractParams :: PasswordHash Scrypt -> Maybe ScryptParams
+extractParams passHash =
+  (\(params, _, _) -> params) <$> parseScryptPasswordHashParams passHash
 
 -- | Generate a random 32-byte @scrypt@ salt
 --

password/test/tasty/Argon2.hs

@@ -12,25 +12,26 @@ import Internal
 testArgon2 :: TestTree
 testArgon2 = testGroup "Argon2"
   [ referenceTest
-  , testCorrectPassword "Argon2 (hashPassword)" hashFast checkPassword
+  , testCorrectPassword "Argon2 (hashPassword, fast)" hashFast checkPassword extractParams fastParams
+  , testCorrectPassword "Argon2 (hashPassword, slow)" hashSlow checkPassword extractParams slowParams
   , testIncorrectPassword "Argon2 (hashPassword) fail" hashFast checkPassword
   , testWithSalt "Argon2 (hashPasswordWithSalt)"
                  (hashPasswordWithSalt fastParams)
                  checkPassword
-  , testWithParams "Argon2 (Argon2i)" $ fastParams{ argon2Variant = Argon2i }
-  , testWithParams "Argon2 (Argon2d)" $ fastParams{ argon2Variant = Argon2d }
+                 extractParams
+                 fastParams
+  , testWithParams "Argon2 (Argon2i)" (fastParams{ argon2Variant = Argon2i })
+  , testWithParams "Argon2 (Argon2d)" (fastParams{ argon2Variant = Argon2d })
   , paddingTests
   , omittedVersionTest
   ]
   where
     testWithParams s params =
-      testWithSalt s (hashPasswordWithSalt params) checkPassword
+      testWithSalt s (hashPasswordWithSalt params) checkPassword extractParams params
     hashFast = hashPasswordWithParams fastParams
-    fastParams =
-      defaultParams{
-        argon2MemoryCost = 2 ^ (8 :: Int),
-        argon2TimeCost = 1
-      }
+    fastParams = defaultParams{ argon2MemoryCost = 2 ^ (8 :: Int), argon2TimeCost = 1 }
+    hashSlow = hashPasswordWithParams slowParams
+    slowParams = defaultParams{ argon2MemoryCost = 2 ^ (8 :: Int), argon2TimeCost = 4 }
 
 paddingTests :: TestTree
 paddingTests = testGroup "Padding"

password/test/tasty/Bcrypt.hs

@@ -4,12 +4,13 @@ import Test.Tasty
 
 import Data.Password.Bcrypt
 
-import Internal (testCorrectPassword, testIncorrectPassword, testWithSalt)
+import Internal
 
 
 testBcrypt :: TestTree
 testBcrypt = testGroup "bcrypt"
-  [ testCorrectPassword "Bcrypt (hashPassword)" (hashPasswordWithParams 4) checkPassword
+  [ testCorrectPassword "Bcrypt (hashPassword)" (hashPasswordWithParams 4) checkPassword extractParams 4
+  , testCorrectPassword "Bcrypt (hashPassword)" (hashPasswordWithParams 8) checkPassword extractParams 8
   , testIncorrectPassword "Bcrypt (hashPassword) fail" (hashPasswordWithParams 4) checkPassword
-  , testWithSalt "Bcrypt (hashPasswordWithSalt)" (hashPasswordWithSalt 4) checkPassword
+  , testWithSalt "Bcrypt (hashPasswordWithSalt)" (hashPasswordWithSalt 4) checkPassword extractParams 4
   ]

password/test/tasty/Internal.hs

@@ -11,15 +11,18 @@ import Data.Password.Types (mkPassword, Password, PasswordHash)
 import Data.Password.Bcrypt (PasswordCheck(..), Salt(..))
 
 
-testCorrectPassword :: String
+testCorrectPassword :: (Eq params, Show params)
+                    => String
                     -> (Password -> IO (PasswordHash a))
                     -> (Password -> PasswordHash a -> PasswordCheck)
+                    -> (PasswordHash a -> Maybe params)
+                    -> params
                     -> TestTree
-testCorrectPassword s hashF checkF = testProperty s $
+testCorrectPassword s hashF checkF extractParamsF defaultParams = testProperty s $
   \pass -> ioProperty $ do
     let pw = mkPassword pass
     hpw <- hashF pw
-    return $ checkF pw hpw === PasswordCheckSuccess
+    return $ (checkF pw hpw === PasswordCheckSuccess) .&&. extractParamsF hpw === Just defaultParams
 
 testIncorrectPassword :: String
                       -> (Password -> IO (PasswordHash a))
@@ -35,15 +38,18 @@ testIncorrectPassword s hashF checkF = testProperty s $
   where
     isEmpty c = c `elem` ["", "\NUL"]
 
-testWithSalt :: String
+testWithSalt :: (Eq params, Show params)
+             => String
              -> (Salt a -> Password -> PasswordHash a)
              -> (Password -> PasswordHash a -> PasswordCheck)
+             -> (PasswordHash a -> Maybe params)
+             -> params
              -> TestTree
-testWithSalt s hashWithSalt checkF = testProperty s $
+testWithSalt s hashWithSalt checkF extractParamsF defaultParams = testProperty s $
   \pass salt ->
     let pw = mkPassword pass
         hpw = hashWithSalt salt pw
-    in checkF pw hpw === PasswordCheckSuccess
+    in (checkF pw hpw === PasswordCheckSuccess) .&&. extractParamsF hpw === Just defaultParams
 
 instance Arbitrary (Salt a) where
   arbitrary = Salt . pack <$> vector 16

password/test/tasty/PBKDF2.hs

@@ -28,9 +28,11 @@ testPBKDF2 = testGroup "PBKDF2"
       "PBKDF2 (hashPasswordWithSalt)"
       (hashPasswordWithSalt testParams)
       checkPassword
-  , testIt "PBKDF2 (md5)"    (defaultParams{ pbkdf2Algorithm = PBKDF2_MD5, pbkdf2Iterations = 1000 })
-  , testIt "PBKDF2 (sha1)"   (testParams{ pbkdf2Algorithm = PBKDF2_SHA1 })
-  , testIt "PBKDF2 (sha256)" (testParams{ pbkdf2Algorithm = PBKDF2_SHA256 })
+      extractParams
+      testParams
+  , testIt "PBKDF2 (md5)"    (defaultParams{ pbkdf2Algorithm = PBKDF2_MD5, pbkdf2Iterations = 1000, pbkdf2OutputLength = 16 })
+  , testIt "PBKDF2 (sha1)"   (testParams{ pbkdf2Algorithm = PBKDF2_SHA1, pbkdf2OutputLength = 20 })
+  , testIt "PBKDF2 (sha256)" (testParams{ pbkdf2Algorithm = PBKDF2_SHA256, pbkdf2OutputLength = 32 })
   , testFast Crypto.SHA1   20 PBKDF2.fastPBKDF2_SHA1
   , testFast Crypto.SHA256 32 PBKDF2.fastPBKDF2_SHA256
   , testFast Crypto.SHA512 64 PBKDF2.fastPBKDF2_SHA512
@@ -39,9 +41,11 @@ testPBKDF2 = testGroup "PBKDF2"
       "PBKDF2 (pbkdf2:sha-...)"
       (hashPasswordWithParams testParams)
       (\pass (PasswordHash hash) -> checkPassword pass . PasswordHash $ "pbkdf2:" <> hash)
+      extractParams
+      testParams
   ]
   where
-    testIt s params = testCorrectPassword s (hashPasswordWithParams params) checkPassword
+    testIt s params = testCorrectPassword s (hashPasswordWithParams params) checkPassword extractParams params
     testParams = defaultParams{ pbkdf2Iterations = 4 * 1000 }
 
 testFast :: (HashAlgorithm a, Show a)

password/test/tasty/Scrypt.hs

@@ -16,15 +16,21 @@ import Internal
 
 testScrypt :: TestTree
 testScrypt = testGroup "scrypt"
-  [ testCorrectPassword "Scrypt (hashPassword)" hash8Rounds checkPassword
+  [ testCorrectPassword "Scrypt (hashPassword, 8 rounds)" hash8Rounds checkPassword extractParams testsParams8Rounds
+  , testCorrectPassword "Scrypt (hashPassword, 4 rounds)" hash4Rounds checkPassword extractParams testsParams4Rounds
   , testIncorrectPassword "Scrypt (hashPassword) fail" hash8Rounds checkPassword
   , testWithSalt "Scrypt (hashPasswordWithSalt)"
-                 (hashPasswordWithSalt defaultParams{ scryptRounds = 8 })
+                 (hashPasswordWithSalt testsParams8Rounds)
                  checkPassword
+                 extractParams
+                 testsParams8Rounds
   , testProperty "scrypt <-> cryptonite" $ withMaxSuccess 10 checkScrypt
   ]
   where
-    hash8Rounds = hashPasswordWithParams defaultParams{ scryptRounds = 8 }
+    hash8Rounds = hashPasswordWithParams testsParams8Rounds
+    testsParams8Rounds = defaultParams{ scryptRounds = 8, scryptSalt = 16 }
+    hash4Rounds = hashPasswordWithParams testsParams4Rounds
+    testsParams4Rounds = defaultParams{ scryptRounds = 4, scryptSalt = 16 }
 
 checkScrypt :: Text -> Property
 checkScrypt pass = ioProperty $ do