{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Data.Password.Scrypt (
Scrypt
, Password
, mkPassword
, hashPassword
, PasswordHash(..)
, checkPassword
, PasswordCheck(..)
, hashPasswordWithParams
, defaultParams
, extractParams
, ScryptParams(..)
, hashPasswordWithSalt
, newSalt
, Salt(..)
, unsafeShowPassword
,
) where
import Control.Monad (guard)
import Control.Monad.IO.Class (MonadIO(liftIO))
import Crypto.KDF.Scrypt as Scrypt (Parameters(..), generate)
import Data.ByteArray (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 qualified Data.Text as T (intercalate, split)
import Data.Word (Word32)
import Data.Password.Types (
Password
, PasswordHash(..)
, mkPassword
, unsafeShowPassword
, Salt(..)
)
import Data.Password.Internal (
PasswordCheck(..)
, from64
, readT
, showT
, toBytes
)
import qualified Data.Password.Internal (newSalt)
data Scrypt
hashPassword :: MonadIO m => Password -> m (PasswordHash Scrypt)
hashPassword :: forall (m :: * -> *).
MonadIO m =>
Password -> m (PasswordHash Scrypt)
hashPassword = forall (m :: * -> *).
MonadIO m =>
ScryptParams -> Password -> m (PasswordHash Scrypt)
hashPasswordWithParams ScryptParams
defaultParams
data ScryptParams = ScryptParams {
ScryptParams -> Word32
scryptSalt :: Word32,
ScryptParams -> Word32
scryptRounds :: Word32,
ScryptParams -> Word32
scryptBlockSize :: Word32,
ScryptParams -> Word32
scryptParallelism :: Word32,
ScryptParams -> Word32
scryptOutputLength :: Word32
} deriving (ScryptParams -> ScryptParams -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScryptParams -> ScryptParams -> Bool
$c/= :: ScryptParams -> ScryptParams -> Bool
== :: ScryptParams -> ScryptParams -> Bool
$c== :: ScryptParams -> ScryptParams -> Bool
Eq, Int -> ScryptParams -> ShowS
[ScryptParams] -> ShowS
ScryptParams -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ScryptParams] -> ShowS
$cshowList :: [ScryptParams] -> ShowS
show :: ScryptParams -> String
$cshow :: ScryptParams -> String
showsPrec :: Int -> ScryptParams -> ShowS
$cshowsPrec :: Int -> ScryptParams -> ShowS
Show)
defaultParams :: ScryptParams
defaultParams :: ScryptParams
defaultParams = ScryptParams {
scryptSalt :: Word32
scryptSalt = Word32
32,
scryptRounds :: Word32
scryptRounds = Word32
14,
scryptBlockSize :: Word32
scryptBlockSize = Word32
8,
scryptParallelism :: Word32
scryptParallelism = Word32
1,
scryptOutputLength :: Word32
scryptOutputLength = Word32
64
}
hashPasswordWithSalt :: ScryptParams -> Salt Scrypt -> Password -> PasswordHash Scrypt
hashPasswordWithSalt :: ScryptParams -> Salt Scrypt -> Password -> PasswordHash Scrypt
hashPasswordWithSalt params :: ScryptParams
params@ScryptParams{Word32
scryptOutputLength :: Word32
scryptParallelism :: Word32
scryptBlockSize :: Word32
scryptRounds :: Word32
scryptSalt :: Word32
scryptOutputLength :: ScryptParams -> Word32
scryptParallelism :: ScryptParams -> Word32
scryptBlockSize :: ScryptParams -> Word32
scryptRounds :: ScryptParams -> Word32
scryptSalt :: ScryptParams -> Word32
..} s :: Salt Scrypt
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
"|"
[ forall a. Show a => a -> Text
showT Word32
scryptRounds
, forall a. Show a => a -> Text
showT Word32
scryptBlockSize
, forall a. Show a => a -> Text
showT Word32
scryptParallelism
, ByteString -> Text
encodeBase64 ByteString
salt
, ByteString -> Text
encodeBase64 ByteString
key
]
where
key :: ByteString
key = ScryptParams -> Salt Scrypt -> Password -> ByteString
hashPasswordWithSalt' ScryptParams
params Salt Scrypt
s Password
pass
hashPasswordWithSalt' :: ScryptParams -> Salt Scrypt -> Password -> ByteString
hashPasswordWithSalt' :: ScryptParams -> Salt Scrypt -> Password -> ByteString
hashPasswordWithSalt' ScryptParams{Word32
scryptOutputLength :: Word32
scryptParallelism :: Word32
scryptBlockSize :: Word32
scryptRounds :: Word32
scryptSalt :: Word32
scryptOutputLength :: ScryptParams -> Word32
scryptParallelism :: ScryptParams -> Word32
scryptBlockSize :: ScryptParams -> Word32
scryptRounds :: ScryptParams -> Word32
scryptSalt :: ScryptParams -> Word32
..} (Salt ByteString
salt) Password
pass =
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert (Bytes
scryptHash :: Bytes)
where
scryptHash :: Bytes
scryptHash = forall password salt output.
(ByteArrayAccess password, ByteArrayAccess salt,
ByteArray output) =>
Parameters -> password -> salt -> output
Scrypt.generate
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 = Scrypt.Parameters {
n :: Word64
n = Word64
2 forall a b. (Num a, Integral b) => a -> b -> a
^ Word32
scryptRounds,
r :: Int
r = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
scryptBlockSize,
p :: Int
p = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
scryptParallelism,
outputLength :: Int
outputLength = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
scryptOutputLength
}
hashPasswordWithParams :: MonadIO m => ScryptParams -> Password -> m (PasswordHash Scrypt)
hashPasswordWithParams :: forall (m :: * -> *).
MonadIO m =>
ScryptParams -> Password -> m (PasswordHash Scrypt)
hashPasswordWithParams ScryptParams
params Password
pass = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
Salt Scrypt
salt <- forall (m :: * -> *) a. MonadIO m => Int -> m (Salt a)
Data.Password.Internal.newSalt Int
saltLength
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ScryptParams -> Salt Scrypt -> Password -> PasswordHash Scrypt
hashPasswordWithSalt ScryptParams
params Salt Scrypt
salt Password
pass
where
saltLength :: Int
saltLength = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ ScryptParams -> Word32
scryptSalt ScryptParams
params
checkPassword :: Password -> PasswordHash Scrypt -> PasswordCheck
checkPassword :: Password -> PasswordHash Scrypt -> PasswordCheck
checkPassword Password
pass PasswordHash Scrypt
passHash =
forall a. a -> Maybe a -> a
fromMaybe PasswordCheck
PasswordCheckFail forall a b. (a -> b) -> a -> b
$ do
(ScryptParams
params, Salt Scrypt
salt, ByteString
hashedKey) <- PasswordHash Scrypt
-> Maybe (ScryptParams, Salt Scrypt, ByteString)
parseScryptPasswordHashParams PasswordHash Scrypt
passHash
let producedKey :: ByteString
producedKey = ScryptParams -> Salt Scrypt -> Password -> ByteString
hashPasswordWithSalt' ScryptParams
params Salt Scrypt
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
parseScryptPasswordHashParams :: PasswordHash Scrypt -> Maybe (ScryptParams, Salt Scrypt, ByteString)
parseScryptPasswordHashParams :: PasswordHash Scrypt
-> Maybe (ScryptParams, Salt Scrypt, ByteString)
parseScryptPasswordHashParams (PasswordHash Text
passHash) = do
let 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
5
let [ Text
scryptRoundsT,
Text
scryptBlockSizeT,
Text
scryptParallelismT,
Text
salt64,
Text
hashedKey64 ] = [Text]
paramList
Word32
scryptRounds <- forall a. Read a => Text -> Maybe a
readT Text
scryptRoundsT
Word32
scryptBlockSize <- forall a. Read a => Text -> Maybe a
readT Text
scryptBlockSizeT
Word32
scryptParallelism <- forall a. Read a => Text -> Maybe a
readT Text
scryptParallelismT
ByteString
salt <- Text -> Maybe ByteString
from64 Text
salt64
ByteString
hashedKey <- Text -> Maybe ByteString
from64 Text
hashedKey64
let scryptOutputLength :: Word32
scryptOutputLength = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ ByteString -> Int
C8.length ByteString
hashedKey
scryptSalt :: Word32
scryptSalt = 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 (ScryptParams{Word32
scryptSalt :: Word32
scryptOutputLength :: Word32
scryptParallelism :: Word32
scryptBlockSize :: Word32
scryptRounds :: Word32
scryptOutputLength :: Word32
scryptParallelism :: Word32
scryptBlockSize :: Word32
scryptRounds :: Word32
scryptSalt :: Word32
..}, forall a. ByteString -> Salt a
Salt ByteString
salt, ByteString
hashedKey)
extractParams :: PasswordHash Scrypt -> Maybe ScryptParams
PasswordHash Scrypt
passHash =
(\(ScryptParams
params, Salt Scrypt
_, ByteString
_) -> ScryptParams
params) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PasswordHash Scrypt
-> Maybe (ScryptParams, Salt Scrypt, ByteString)
parseScryptPasswordHashParams PasswordHash Scrypt
passHash
newSalt :: MonadIO m => m (Salt Scrypt)
newSalt :: forall (m :: * -> *). MonadIO m => m (Salt Scrypt)
newSalt = forall (m :: * -> *) a. MonadIO m => Int -> m (Salt a)
Data.Password.Internal.newSalt Int
32