{-# 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
import Data.ByteArray (ByteArray, ByteArrayAccess, Bytes, constEq, convert)
import Data.ByteString (ByteString)
import qualified Data.ByteString.Base64 as Base64
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 = 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PBKDF2Params -> PBKDF2Params -> Bool
$c/= :: PBKDF2Params -> PBKDF2Params -> Bool
== :: PBKDF2Params -> PBKDF2Params -> Bool
$c== :: PBKDF2Params -> PBKDF2Params -> Bool
Eq, Int -> PBKDF2Params -> ShowS
[PBKDF2Params] -> ShowS
PBKDF2Params -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PBKDF2Params] -> ShowS
$cshowList :: [PBKDF2Params] -> ShowS
show :: PBKDF2Params -> String
$cshow :: PBKDF2Params -> String
showsPrec :: Int -> PBKDF2Params -> ShowS
$cshowsPrec :: Int -> 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 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
pbkdf2OutputLength :: Word32
pbkdf2Iterations :: Word32
pbkdf2Algorithm :: PBKDF2Algorithm
pbkdf2Salt :: Word32
pbkdf2OutputLength :: PBKDF2Params -> Word32
pbkdf2Iterations :: PBKDF2Params -> Word32
pbkdf2Algorithm :: PBKDF2Params -> PBKDF2Algorithm
pbkdf2Salt :: PBKDF2Params -> Word32
..} s :: Salt PBKDF2
s@(Salt ByteString
salt) Password
pass =
forall a. Text -> PasswordHash a
PasswordHash forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
":"
[ PBKDF2Algorithm -> Text
algToText PBKDF2Algorithm
pbkdf2Algorithm
, String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Word32
pbkdf2Iterations
, ByteString -> Text
b64 ByteString
salt
, ByteString -> Text
b64 ByteString
key
]
where
b64 :: ByteString -> Text
b64 = ByteString -> Text
Base64.encodeBase64
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
pbkdf2OutputLength :: Word32
pbkdf2Iterations :: Word32
pbkdf2Algorithm :: PBKDF2Algorithm
pbkdf2Salt :: Word32
pbkdf2OutputLength :: PBKDF2Params -> Word32
pbkdf2Iterations :: PBKDF2Params -> Word32
pbkdf2Algorithm :: PBKDF2Params -> PBKDF2Algorithm
pbkdf2Salt :: PBKDF2Params -> Word32
..} (Salt ByteString
salt) Password
pass =
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert (Bytes
pbkdf2Hash :: Bytes)
where
pbkdf2Hash :: Bytes
pbkdf2Hash = forall password salt hash.
(ByteArrayAccess password, ByteArrayAccess salt, ByteArray hash) =>
PBKDF2Algorithm -> Parameters -> password -> salt -> hash
algToFunc
PBKDF2Algorithm
pbkdf2Algorithm
Parameters
params
(Text -> Bytes
toBytes forall a b. (a -> b) -> a -> b
$ Password -> Text
unsafeShowPassword Password
pass)
(forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert ByteString
salt :: Bytes)
params :: Parameters
params = PBKDF2.Parameters {
iterCounts :: Int
PBKDF2.iterCounts = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
pbkdf2Iterations,
outputLength :: Int
PBKDF2.outputLength = forall a b. (Integral a, Num b) => a -> b
fromIntegral 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 = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
Salt PBKDF2
salt <- forall (m :: * -> *) a. MonadIO m => Int -> m (Salt a)
Data.Password.Internal.newSalt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ PBKDF2Params -> Word32
pbkdf2Salt PBKDF2Params
params
forall (m :: * -> *) a. Monad m => a -> m a
return 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 =
forall a. a -> Maybe a -> a
fromMaybe PasswordCheck
PasswordCheckFail 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
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ ByteString
hashedKey forall bs1 bs2.
(ByteArrayAccess bs1, ByteArrayAccess bs2) =>
bs1 -> bs2 -> Bool
`constEq` ByteString
producedKey
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' = forall a. a -> Maybe a -> a
fromMaybe Text
passHash 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 (forall a. Eq a => a -> a -> Bool
== Char
':') Text
passHash'
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
paramList forall a. Eq a => a -> a -> Bool
== Int
4
let [ Text
algT,
Text
iterationsT,
Text
salt64,
Text
hashedKey64 ] = [Text]
paramList
PBKDF2Algorithm
pbkdf2Algorithm <- Text -> Maybe PBKDF2Algorithm
textToAlg Text
algT
Word32
pbkdf2Iterations <- 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 = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ ByteString -> Int
C8.length ByteString
hashedKey
pbkdf2Salt :: Word32
pbkdf2Salt = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ ByteString -> Int
C8.length ByteString
salt
forall (m :: * -> *) a. Monad m => a -> m a
return (PBKDF2Params{Word32
PBKDF2Algorithm
pbkdf2Salt :: Word32
pbkdf2OutputLength :: Word32
pbkdf2Iterations :: Word32
pbkdf2Algorithm :: PBKDF2Algorithm
pbkdf2OutputLength :: Word32
pbkdf2Iterations :: Word32
pbkdf2Algorithm :: PBKDF2Algorithm
pbkdf2Salt :: Word32
..}, forall a. ByteString -> Salt a
Salt ByteString
salt, ByteString
hashedKey)
extractParams :: PasswordHash PBKDF2 -> Maybe PBKDF2Params
PasswordHash PBKDF2
passHash =
(\(PBKDF2Params
params, Salt PBKDF2
_, ByteString
_) -> PBKDF2Params
params) 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PBKDF2Algorithm -> PBKDF2Algorithm -> Bool
$c/= :: PBKDF2Algorithm -> PBKDF2Algorithm -> Bool
== :: PBKDF2Algorithm -> PBKDF2Algorithm -> Bool
$c== :: PBKDF2Algorithm -> PBKDF2Algorithm -> Bool
Eq, Int -> PBKDF2Algorithm -> ShowS
[PBKDF2Algorithm] -> ShowS
PBKDF2Algorithm -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PBKDF2Algorithm] -> ShowS
$cshowList :: [PBKDF2Algorithm] -> ShowS
show :: PBKDF2Algorithm -> String
$cshow :: PBKDF2Algorithm -> String
showsPrec :: Int -> PBKDF2Algorithm -> ShowS
$cshowsPrec :: Int -> PBKDF2Algorithm -> ShowS
Show)
maxOutputLength :: PBKDF2Algorithm -> Word32 -> Word32
maxOutputLength :: PBKDF2Algorithm -> Word32 -> Word32
maxOutputLength = forall a. Ord a => a -> a -> a
min 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" -> forall a. a -> Maybe a
Just PBKDF2Algorithm
PBKDF2_MD5
Text
"sha1" -> forall a. a -> Maybe a
Just PBKDF2Algorithm
PBKDF2_SHA1
Text
"sha256" -> forall a. a -> Maybe a
Just PBKDF2Algorithm
PBKDF2_SHA256
Text
"sha512" -> forall a. a -> Maybe a
Just PBKDF2Algorithm
PBKDF2_SHA512
Text
_ -> 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 -> forall password salt ba.
(ByteArrayAccess password, ByteArrayAccess salt, ByteArray ba) =>
PRF password -> Parameters -> password -> salt -> ba
PBKDF2.generate (forall a password.
(HashAlgorithm a, ByteArrayAccess password) =>
a -> PRF password
PBKDF2.prfHMAC MD5
Crypto.MD5)
PBKDF2Algorithm
PBKDF2_SHA1 -> forall password salt out.
(ByteArrayAccess password, ByteArrayAccess salt, ByteArray out) =>
Parameters -> password -> salt -> out
PBKDF2.fastPBKDF2_SHA1
PBKDF2Algorithm
PBKDF2_SHA256 -> forall password salt out.
(ByteArrayAccess password, ByteArrayAccess salt, ByteArray out) =>
Parameters -> password -> salt -> out
PBKDF2.fastPBKDF2_SHA256
PBKDF2Algorithm
PBKDF2_SHA512 -> 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 = forall (m :: * -> *) a. MonadIO m => Int -> m (Salt a)
Data.Password.Internal.newSalt Int
16