{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Data.Password.Scrypt (
Scrypt
, Password
, mkPassword
, hashPassword
, PasswordHash(..)
, checkPassword
, PasswordCheck(..)
, hashPasswordWithParams
, defaultParams
, ScryptParams(..)
, hashPasswordWithSalt
, newSalt
, Salt(..)
, unsafeShowPassword
,
) where
import Control.Monad (guard)
import Control.Monad.IO.Class (MonadIO(liftIO))
import Crypto.KDF.Scrypt as Scrypt
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 (
PasswordCheck(..)
, PasswordHash(..)
, Salt(..)
, mkPassword
, unsafeShowPassword
)
import Data.Password.Internal (Password(..), from64, readT, showT, toBytes)
import qualified Data.Password.Internal (newSalt)
data Scrypt
hashPassword :: MonadIO m => Password -> m (PasswordHash Scrypt)
hashPassword :: Password -> m (PasswordHash Scrypt)
hashPassword = ScryptParams -> Password -> m (PasswordHash Scrypt)
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
(ScryptParams -> ScryptParams -> Bool)
-> (ScryptParams -> ScryptParams -> Bool) -> Eq ScryptParams
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
(Int -> ScryptParams -> ShowS)
-> (ScryptParams -> String)
-> ([ScryptParams] -> ShowS)
-> Show ScryptParams
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 :: Word32 -> Word32 -> Word32 -> Word32 -> Word32 -> ScryptParams
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 =
Text -> PasswordHash Scrypt
forall a. Text -> PasswordHash a
PasswordHash (Text -> PasswordHash Scrypt) -> Text -> PasswordHash Scrypt
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
"|"
[ Word32 -> Text
forall a. Show a => a -> Text
showT Word32
scryptRounds
, Word32 -> Text
forall a. Show a => a -> Text
showT Word32
scryptBlockSize
, Word32 -> Text
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 Text
pass) =
Bytes -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert (Bytes
scryptHash :: Bytes)
where
scryptHash :: Bytes
scryptHash = Parameters -> Bytes -> Bytes -> Bytes
forall password salt output.
(ByteArrayAccess password, ByteArrayAccess salt,
ByteArray output) =>
Parameters -> password -> salt -> output
Scrypt.generate 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 :: Word64 -> Int -> Int -> Int -> Parameters
Scrypt.Parameters {
n :: Word64
n = Word64
2 Word64 -> Word32 -> Word64
forall a b. (Num a, Integral b) => a -> b -> a
^ Word32
scryptRounds,
r :: Int
r = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
scryptBlockSize,
p :: Int
p = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
scryptParallelism,
outputLength :: Int
outputLength = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
scryptOutputLength
}
hashPasswordWithParams :: MonadIO m => ScryptParams -> Password -> m (PasswordHash Scrypt)
hashPasswordWithParams :: ScryptParams -> Password -> m (PasswordHash Scrypt)
hashPasswordWithParams ScryptParams
params Password
pass = IO (PasswordHash Scrypt) -> m (PasswordHash Scrypt)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (PasswordHash Scrypt) -> m (PasswordHash Scrypt))
-> IO (PasswordHash Scrypt) -> m (PasswordHash Scrypt)
forall a b. (a -> b) -> a -> b
$ do
Salt Scrypt
salt <- Int -> IO (Salt Scrypt)
forall (m :: * -> *) a. MonadIO m => Int -> m (Salt a)
Data.Password.Internal.newSalt Int
saltLength
PasswordHash Scrypt -> IO (PasswordHash Scrypt)
forall (m :: * -> *) a. Monad m => a -> m a
return (PasswordHash Scrypt -> IO (PasswordHash Scrypt))
-> PasswordHash Scrypt -> IO (PasswordHash Scrypt)
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 = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Word32 -> Int
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 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 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
5
let [ Text
scryptRoundsT,
Text
scryptBlockSizeT,
Text
scryptParallelismT,
Text
salt64,
Text
hashedKey64 ] = [Text]
paramList
Word32
scryptRounds <- Text -> Maybe Word32
forall a. Read a => Text -> Maybe a
readT Text
scryptRoundsT
Word32
scryptBlockSize <- Text -> Maybe Word32
forall a. Read a => Text -> Maybe a
readT Text
scryptBlockSizeT
Word32
scryptParallelism <- Text -> Maybe Word32
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 = 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 = ScryptParams -> Salt Scrypt -> Password -> ByteString
hashPasswordWithSalt' ScryptParams :: Word32 -> Word32 -> Word32 -> Word32 -> Word32 -> ScryptParams
ScryptParams{Word32
scryptSalt :: Word32
scryptOutputLength :: Word32
scryptParallelism :: Word32
scryptBlockSize :: Word32
scryptRounds :: Word32
scryptOutputLength :: Word32
scryptParallelism :: Word32
scryptBlockSize :: Word32
scryptRounds :: Word32
scryptSalt :: Word32
..} (ByteString -> Salt Scrypt
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
scryptSalt :: Word32
scryptSalt = Word32
32
newSalt :: MonadIO m => m (Salt Scrypt)
newSalt :: m (Salt Scrypt)
newSalt = Int -> m (Salt Scrypt)
forall (m :: * -> *) a. MonadIO m => Int -> m (Salt a)
Data.Password.Internal.newSalt Int
32