{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Data.Password.PBKDF2 (
PBKDF2
, Password
, mkPassword
, hashPassword
, PasswordHash(..)
, checkPassword
, PasswordCheck(..)
, hashPasswordWithParams
, defaultParams
, 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 (
PasswordCheck(..)
, PasswordHash(..)
, Salt(..)
, mkPassword
, unsafeShowPassword
)
import Data.Password.Internal (Password(..), from64, readT, toBytes)
import qualified Data.Password.Internal (newSalt)
data PBKDF2
hashPassword :: MonadIO m => Password -> m (PasswordHash PBKDF2)
hashPassword :: 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
/= :: PBKDF2Params -> PBKDF2Params -> Bool
$c/= :: PBKDF2Params -> PBKDF2Params -> Bool
== :: PBKDF2Params -> PBKDF2Params -> Bool
$c== :: 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
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 :: Word32 -> PBKDF2Algorithm -> Word32 -> Word32 -> PBKDF2Params
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
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 =
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
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 Text
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
pass) (ByteString -> Bytes
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert ByteString
salt :: Bytes)
params :: Parameters
params = Parameters :: Int -> Int -> Parameters
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 :: PBKDF2Params -> Password -> m (PasswordHash PBKDF2)
hashPasswordWithParams PBKDF2Params
params Password
pass = IO (PasswordHash PBKDF2) -> m (PasswordHash PBKDF2)
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 (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 Text
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
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'
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
paramList Int -> Int -> Bool
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 <- 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
producedKey :: ByteString
producedKey = PBKDF2Params -> Salt PBKDF2 -> Password -> ByteString
hashPasswordWithSalt' PBKDF2Params :: Word32 -> PBKDF2Algorithm -> Word32 -> Word32 -> PBKDF2Params
PBKDF2Params{Word32
PBKDF2Algorithm
pbkdf2Salt :: Word32
pbkdf2OutputLength :: Word32
pbkdf2Iterations :: Word32
pbkdf2Algorithm :: PBKDF2Algorithm
pbkdf2OutputLength :: Word32
pbkdf2Iterations :: Word32
pbkdf2Algorithm :: PBKDF2Algorithm
pbkdf2Salt :: Word32
..} (ByteString -> Salt PBKDF2
forall a. ByteString -> Salt a
Salt ByteString
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 (m :: * -> *) a. Monad m => a -> m a
return PasswordCheck
PasswordCheckSuccess
where
pbkdf2Salt :: Word32
pbkdf2Salt = Word32
16
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
/= :: PBKDF2Algorithm -> PBKDF2Algorithm -> Bool
$c/= :: PBKDF2Algorithm -> PBKDF2Algorithm -> Bool
== :: PBKDF2Algorithm -> PBKDF2Algorithm -> Bool
$c== :: 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
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 = 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 :: 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 :: m (Salt PBKDF2)
newSalt = Int -> m (Salt PBKDF2)
forall (m :: * -> *) a. MonadIO m => Int -> m (Salt a)
Data.Password.Internal.newSalt Int
16