{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Data.Password.PBKDF2 (
PBKDF2
, Password
, mkPassword
, hashPassword
, PasswordHash(..)
, checkPassword
, PasswordCheck(..)
, hashPasswordWithParams
, defaultParams
, extractParams
, PBKDF2Params(..)
, PBKDF2Algorithm(..)
, hashPasswordWithSalt
, newSalt
, Salt(..)
, unsafeShowPassword
,
) where
import Control.Monad (guard)
import Control.Monad.IO.Class (MonadIO(liftIO))
import Crypto.Hash.Algorithms as Crypto (MD5(..))
import Crypto.KDF.PBKDF2 as PBKDF2
#if MIN_VERSION_base64(1,0,0)
import Data.Base64.Types (extractBase64)
#endif
import Data.ByteArray (ByteArray, ByteArrayAccess, Bytes, constEq, convert)
import Data.ByteString (ByteString)
import Data.ByteString.Base64 (encodeBase64)
import qualified Data.ByteString.Char8 as C8 (length)
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import qualified Data.Text as T (intercalate, pack, split, stripPrefix)
import Data.Word (Word32)
import Data.Password.Types (
Password
, PasswordHash(..)
, mkPassword
, unsafeShowPassword
, Salt(..)
)
import Data.Password.Internal (
PasswordCheck(..)
, from64
, readT
, toBytes
)
import qualified Data.Password.Internal (newSalt)
data PBKDF2
hashPassword :: MonadIO m => Password -> m (PasswordHash PBKDF2)
hashPassword :: forall (m :: * -> *).
MonadIO m =>
Password -> m (PasswordHash PBKDF2)
hashPassword = PBKDF2Params -> Password -> m (PasswordHash PBKDF2)
forall (m :: * -> *).
MonadIO m =>
PBKDF2Params -> Password -> m (PasswordHash PBKDF2)
hashPasswordWithParams PBKDF2Params
defaultParams
data PBKDF2Params = PBKDF2Params {
PBKDF2Params -> Word32
pbkdf2Salt :: Word32,
PBKDF2Params -> PBKDF2Algorithm
pbkdf2Algorithm :: PBKDF2Algorithm,
PBKDF2Params -> Word32
pbkdf2Iterations :: Word32,
PBKDF2Params -> Word32
pbkdf2OutputLength :: Word32
} deriving (PBKDF2Params -> PBKDF2Params -> Bool
(PBKDF2Params -> PBKDF2Params -> Bool)
-> (PBKDF2Params -> PBKDF2Params -> Bool) -> Eq PBKDF2Params
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PBKDF2Params -> PBKDF2Params -> Bool
== :: PBKDF2Params -> PBKDF2Params -> Bool
$c/= :: PBKDF2Params -> PBKDF2Params -> Bool
/= :: PBKDF2Params -> PBKDF2Params -> Bool
Eq, Int -> PBKDF2Params -> ShowS
[PBKDF2Params] -> ShowS
PBKDF2Params -> String
(Int -> PBKDF2Params -> ShowS)
-> (PBKDF2Params -> String)
-> ([PBKDF2Params] -> ShowS)
-> Show PBKDF2Params
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PBKDF2Params -> ShowS
showsPrec :: Int -> PBKDF2Params -> ShowS
$cshow :: PBKDF2Params -> String
show :: PBKDF2Params -> String
$cshowList :: [PBKDF2Params] -> ShowS
showList :: [PBKDF2Params] -> ShowS
Show)
defaultParams :: PBKDF2Params
defaultParams :: PBKDF2Params
defaultParams = PBKDF2Params {
pbkdf2Salt :: Word32
pbkdf2Salt = Word32
16,
pbkdf2Algorithm :: PBKDF2Algorithm
pbkdf2Algorithm = PBKDF2Algorithm
PBKDF2_SHA512,
pbkdf2Iterations :: Word32
pbkdf2Iterations = Word32
25 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* Word32
1000,
pbkdf2OutputLength :: Word32
pbkdf2OutputLength = Word32
64
}
hashPasswordWithSalt :: PBKDF2Params -> Salt PBKDF2 -> Password -> PasswordHash PBKDF2
hashPasswordWithSalt :: PBKDF2Params -> Salt PBKDF2 -> Password -> PasswordHash PBKDF2
hashPasswordWithSalt params :: PBKDF2Params
params@PBKDF2Params{Word32
PBKDF2Algorithm
pbkdf2Salt :: PBKDF2Params -> Word32
pbkdf2Algorithm :: PBKDF2Params -> PBKDF2Algorithm
pbkdf2Iterations :: PBKDF2Params -> Word32
pbkdf2OutputLength :: PBKDF2Params -> Word32
pbkdf2Salt :: Word32
pbkdf2Algorithm :: PBKDF2Algorithm
pbkdf2Iterations :: Word32
pbkdf2OutputLength :: Word32
..} s :: Salt PBKDF2
s@(Salt ByteString
salt) Password
pass =
Text -> PasswordHash PBKDF2
forall a. Text -> PasswordHash a
PasswordHash (Text -> PasswordHash PBKDF2) -> Text -> PasswordHash PBKDF2
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
":"
[ PBKDF2Algorithm -> Text
algToText PBKDF2Algorithm
pbkdf2Algorithm
, String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Word32 -> String
forall a. Show a => a -> String
show Word32
pbkdf2Iterations
, ByteString -> Text
b64 ByteString
salt
, ByteString -> Text
b64 ByteString
key
]
where
#if MIN_VERSION_base64(1,0,0)
b64 :: ByteString -> Text
b64 = Base64 'StdPadded Text -> Text
forall (k :: Alphabet) a. Base64 k a -> a
extractBase64 (Base64 'StdPadded Text -> Text)
-> (ByteString -> Base64 'StdPadded Text) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Base64 'StdPadded Text
encodeBase64
#else
b64 = encodeBase64
#endif
key :: ByteString
key = PBKDF2Params -> Salt PBKDF2 -> Password -> ByteString
hashPasswordWithSalt' PBKDF2Params
params Salt PBKDF2
s Password
pass
hashPasswordWithSalt' :: PBKDF2Params -> Salt PBKDF2 -> Password -> ByteString
hashPasswordWithSalt' :: PBKDF2Params -> Salt PBKDF2 -> Password -> ByteString
hashPasswordWithSalt' PBKDF2Params{Word32
PBKDF2Algorithm
pbkdf2Salt :: PBKDF2Params -> Word32
pbkdf2Algorithm :: PBKDF2Params -> PBKDF2Algorithm
pbkdf2Iterations :: PBKDF2Params -> Word32
pbkdf2OutputLength :: PBKDF2Params -> Word32
pbkdf2Salt :: Word32
pbkdf2Algorithm :: PBKDF2Algorithm
pbkdf2Iterations :: Word32
pbkdf2OutputLength :: Word32
..} (Salt ByteString
salt) Password
pass =
Bytes -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert (Bytes
pbkdf2Hash :: Bytes)
where
pbkdf2Hash :: Bytes
pbkdf2Hash = PBKDF2Algorithm -> Parameters -> Bytes -> Bytes -> Bytes
forall password salt hash.
(ByteArrayAccess password, ByteArrayAccess salt, ByteArray hash) =>
PBKDF2Algorithm -> Parameters -> password -> salt -> hash
algToFunc
PBKDF2Algorithm
pbkdf2Algorithm
Parameters
params
(Text -> Bytes
toBytes (Text -> Bytes) -> Text -> Bytes
forall a b. (a -> b) -> a -> b
$ Password -> Text
unsafeShowPassword Password
pass)
(ByteString -> Bytes
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert ByteString
salt :: Bytes)
params :: Parameters
params = PBKDF2.Parameters {
iterCounts :: Int
PBKDF2.iterCounts = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
pbkdf2Iterations,
outputLength :: Int
PBKDF2.outputLength = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Word32 -> Int
forall a b. (a -> b) -> a -> b
$ PBKDF2Algorithm -> Word32 -> Word32
maxOutputLength PBKDF2Algorithm
pbkdf2Algorithm Word32
pbkdf2OutputLength
}
hashPasswordWithParams :: MonadIO m => PBKDF2Params -> Password -> m (PasswordHash PBKDF2)
hashPasswordWithParams :: forall (m :: * -> *).
MonadIO m =>
PBKDF2Params -> Password -> m (PasswordHash PBKDF2)
hashPasswordWithParams PBKDF2Params
params Password
pass = IO (PasswordHash PBKDF2) -> m (PasswordHash PBKDF2)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (PasswordHash PBKDF2) -> m (PasswordHash PBKDF2))
-> IO (PasswordHash PBKDF2) -> m (PasswordHash PBKDF2)
forall a b. (a -> b) -> a -> b
$ do
Salt PBKDF2
salt <- Int -> IO (Salt PBKDF2)
forall (m :: * -> *) a. MonadIO m => Int -> m (Salt a)
Data.Password.Internal.newSalt (Int -> IO (Salt PBKDF2))
-> (Word32 -> Int) -> Word32 -> IO (Salt PBKDF2)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> IO (Salt PBKDF2)) -> Word32 -> IO (Salt PBKDF2)
forall a b. (a -> b) -> a -> b
$ PBKDF2Params -> Word32
pbkdf2Salt PBKDF2Params
params
PasswordHash PBKDF2 -> IO (PasswordHash PBKDF2)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (PasswordHash PBKDF2 -> IO (PasswordHash PBKDF2))
-> PasswordHash PBKDF2 -> IO (PasswordHash PBKDF2)
forall a b. (a -> b) -> a -> b
$ PBKDF2Params -> Salt PBKDF2 -> Password -> PasswordHash PBKDF2
hashPasswordWithSalt PBKDF2Params
params Salt PBKDF2
salt Password
pass
checkPassword :: Password -> PasswordHash PBKDF2 -> PasswordCheck
checkPassword :: Password -> PasswordHash PBKDF2 -> PasswordCheck
checkPassword Password
pass PasswordHash PBKDF2
passHash =
PasswordCheck -> Maybe PasswordCheck -> PasswordCheck
forall a. a -> Maybe a -> a
fromMaybe PasswordCheck
PasswordCheckFail (Maybe PasswordCheck -> PasswordCheck)
-> Maybe PasswordCheck -> PasswordCheck
forall a b. (a -> b) -> a -> b
$ do
(PBKDF2Params
params, Salt PBKDF2
salt, ByteString
hashedKey) <- PasswordHash PBKDF2
-> Maybe (PBKDF2Params, Salt PBKDF2, ByteString)
parsePBKDF2PasswordHashParams PasswordHash PBKDF2
passHash
let producedKey :: ByteString
producedKey = PBKDF2Params -> Salt PBKDF2 -> Password -> ByteString
hashPasswordWithSalt' PBKDF2Params
params Salt PBKDF2
salt Password
pass
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ ByteString
hashedKey ByteString -> ByteString -> Bool
forall bs1 bs2.
(ByteArrayAccess bs1, ByteArrayAccess bs2) =>
bs1 -> bs2 -> Bool
`constEq` ByteString
producedKey
PasswordCheck -> Maybe PasswordCheck
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return PasswordCheck
PasswordCheckSuccess
parsePBKDF2PasswordHashParams :: PasswordHash PBKDF2 -> Maybe (PBKDF2Params, Salt PBKDF2, ByteString)
parsePBKDF2PasswordHashParams :: PasswordHash PBKDF2
-> Maybe (PBKDF2Params, Salt PBKDF2, ByteString)
parsePBKDF2PasswordHashParams (PasswordHash Text
passHash) = do
let passHash' :: Text
passHash' = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
passHash (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
"pbkdf2:" Text -> Text -> Maybe Text
`T.stripPrefix` Text
passHash
paramList :: [Text]
paramList = (Char -> Bool) -> Text -> [Text]
T.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':') Text
passHash'
case [Text]
paramList of
[Text
algT, Text
iterationsT, Text
salt64, Text
hashedKey64] -> do
PBKDF2Algorithm
pbkdf2Algorithm <- Text -> Maybe PBKDF2Algorithm
textToAlg Text
algT
Word32
pbkdf2Iterations <- Text -> Maybe Word32
forall a. Read a => Text -> Maybe a
readT Text
iterationsT
ByteString
salt <- Text -> Maybe ByteString
from64 Text
salt64
ByteString
hashedKey <- Text -> Maybe ByteString
from64 Text
hashedKey64
let pbkdf2OutputLength :: Word32
pbkdf2OutputLength = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
C8.length ByteString
hashedKey
pbkdf2Salt :: Word32
pbkdf2Salt = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
C8.length ByteString
salt
(PBKDF2Params, Salt PBKDF2, ByteString)
-> Maybe (PBKDF2Params, Salt PBKDF2, ByteString)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (PBKDF2Params{Word32
PBKDF2Algorithm
pbkdf2Salt :: Word32
pbkdf2Algorithm :: PBKDF2Algorithm
pbkdf2Iterations :: Word32
pbkdf2OutputLength :: Word32
pbkdf2Algorithm :: PBKDF2Algorithm
pbkdf2Iterations :: Word32
pbkdf2OutputLength :: Word32
pbkdf2Salt :: Word32
..}, ByteString -> Salt PBKDF2
forall a. ByteString -> Salt a
Salt ByteString
salt, ByteString
hashedKey)
[Text]
_ -> Maybe (PBKDF2Params, Salt PBKDF2, ByteString)
forall a. Maybe a
Nothing
extractParams :: PasswordHash PBKDF2 -> Maybe PBKDF2Params
PasswordHash PBKDF2
passHash =
(\(PBKDF2Params
params, Salt PBKDF2
_, ByteString
_) -> PBKDF2Params
params) ((PBKDF2Params, Salt PBKDF2, ByteString) -> PBKDF2Params)
-> Maybe (PBKDF2Params, Salt PBKDF2, ByteString)
-> Maybe PBKDF2Params
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PasswordHash PBKDF2
-> Maybe (PBKDF2Params, Salt PBKDF2, ByteString)
parsePBKDF2PasswordHashParams PasswordHash PBKDF2
passHash
data PBKDF2Algorithm =
PBKDF2_MD5
| PBKDF2_SHA1
| PBKDF2_SHA256
| PBKDF2_SHA512
deriving (PBKDF2Algorithm -> PBKDF2Algorithm -> Bool
(PBKDF2Algorithm -> PBKDF2Algorithm -> Bool)
-> (PBKDF2Algorithm -> PBKDF2Algorithm -> Bool)
-> Eq PBKDF2Algorithm
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PBKDF2Algorithm -> PBKDF2Algorithm -> Bool
== :: PBKDF2Algorithm -> PBKDF2Algorithm -> Bool
$c/= :: PBKDF2Algorithm -> PBKDF2Algorithm -> Bool
/= :: PBKDF2Algorithm -> PBKDF2Algorithm -> Bool
Eq, Int -> PBKDF2Algorithm -> ShowS
[PBKDF2Algorithm] -> ShowS
PBKDF2Algorithm -> String
(Int -> PBKDF2Algorithm -> ShowS)
-> (PBKDF2Algorithm -> String)
-> ([PBKDF2Algorithm] -> ShowS)
-> Show PBKDF2Algorithm
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PBKDF2Algorithm -> ShowS
showsPrec :: Int -> PBKDF2Algorithm -> ShowS
$cshow :: PBKDF2Algorithm -> String
show :: PBKDF2Algorithm -> String
$cshowList :: [PBKDF2Algorithm] -> ShowS
showList :: [PBKDF2Algorithm] -> ShowS
Show)
maxOutputLength :: PBKDF2Algorithm -> Word32 -> Word32
maxOutputLength :: PBKDF2Algorithm -> Word32 -> Word32
maxOutputLength = Word32 -> Word32 -> Word32
forall a. Ord a => a -> a -> a
min (Word32 -> Word32 -> Word32)
-> (PBKDF2Algorithm -> Word32)
-> PBKDF2Algorithm
-> Word32
-> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
PBKDF2Algorithm
PBKDF2_MD5 -> Word32
16
PBKDF2Algorithm
PBKDF2_SHA1 -> Word32
20
PBKDF2Algorithm
PBKDF2_SHA256 -> Word32
32
PBKDF2Algorithm
PBKDF2_SHA512 -> Word32
64
algToText :: PBKDF2Algorithm -> Text
algToText :: PBKDF2Algorithm -> Text
algToText = \case
PBKDF2Algorithm
PBKDF2_MD5 -> Text
"md5"
PBKDF2Algorithm
PBKDF2_SHA1 -> Text
"sha1"
PBKDF2Algorithm
PBKDF2_SHA256 -> Text
"sha256"
PBKDF2Algorithm
PBKDF2_SHA512 -> Text
"sha512"
textToAlg :: Text -> Maybe PBKDF2Algorithm
textToAlg :: Text -> Maybe PBKDF2Algorithm
textToAlg = \case
Text
"md5" -> PBKDF2Algorithm -> Maybe PBKDF2Algorithm
forall a. a -> Maybe a
Just PBKDF2Algorithm
PBKDF2_MD5
Text
"sha1" -> PBKDF2Algorithm -> Maybe PBKDF2Algorithm
forall a. a -> Maybe a
Just PBKDF2Algorithm
PBKDF2_SHA1
Text
"sha256" -> PBKDF2Algorithm -> Maybe PBKDF2Algorithm
forall a. a -> Maybe a
Just PBKDF2Algorithm
PBKDF2_SHA256
Text
"sha512" -> PBKDF2Algorithm -> Maybe PBKDF2Algorithm
forall a. a -> Maybe a
Just PBKDF2Algorithm
PBKDF2_SHA512
Text
_ -> Maybe PBKDF2Algorithm
forall a. Maybe a
Nothing
algToFunc :: (ByteArrayAccess password, ByteArrayAccess salt, ByteArray hash)
=> PBKDF2Algorithm -> PBKDF2.Parameters -> password -> salt -> hash
algToFunc :: forall password salt hash.
(ByteArrayAccess password, ByteArrayAccess salt, ByteArray hash) =>
PBKDF2Algorithm -> Parameters -> password -> salt -> hash
algToFunc = \case
PBKDF2Algorithm
PBKDF2_MD5 -> PRF password -> Parameters -> password -> salt -> hash
forall password salt ba.
(ByteArrayAccess password, ByteArrayAccess salt, ByteArray ba) =>
PRF password -> Parameters -> password -> salt -> ba
PBKDF2.generate (MD5 -> PRF password
forall a password.
(HashAlgorithm a, ByteArrayAccess password) =>
a -> PRF password
PBKDF2.prfHMAC MD5
Crypto.MD5)
PBKDF2Algorithm
PBKDF2_SHA1 -> Parameters -> password -> salt -> hash
forall password salt out.
(ByteArrayAccess password, ByteArrayAccess salt, ByteArray out) =>
Parameters -> password -> salt -> out
PBKDF2.fastPBKDF2_SHA1
PBKDF2Algorithm
PBKDF2_SHA256 -> Parameters -> password -> salt -> hash
forall password salt out.
(ByteArrayAccess password, ByteArrayAccess salt, ByteArray out) =>
Parameters -> password -> salt -> out
PBKDF2.fastPBKDF2_SHA256
PBKDF2Algorithm
PBKDF2_SHA512 -> Parameters -> password -> salt -> hash
forall password salt out.
(ByteArrayAccess password, ByteArrayAccess salt, ByteArray out) =>
Parameters -> password -> salt -> out
PBKDF2.fastPBKDF2_SHA512
newSalt :: MonadIO m => m (Salt PBKDF2)
newSalt :: forall (m :: * -> *). MonadIO m => m (Salt PBKDF2)
newSalt = Int -> m (Salt PBKDF2)
forall (m :: * -> *) a. MonadIO m => Int -> m (Salt a)
Data.Password.Internal.newSalt Int
16