Copyright | (c) Dennis Gosnell 2019; Felix Paulusma 2020 |
---|---|
License | BSD-style (see LICENSE file) |
Maintainer | cdep.illabout@gmail.com |
Stability | experimental |
Portability | POSIX |
Safe Haskell | None |
Language | Haskell2010 |
scrypt
The scrypt
algorithm is a fairly new one. First published
in 2009, but published by the IETF in 2016 as RFC 7914.
Originally used for the Tarsnap backup service, it is
designed to be costly by requiring large amounts of memory.
Other algorithms
scrypt
does increase the memory requirement in contrast to
and Bcrypt
, but it
turns out it is not as optimal as it could be, and thus others have set out
to search for other algorithms that do fulfill on their promises.
PBKDF2
seems to be the winner in that search.Argon2
That is not to say using scrypt
somehow means your passwords
won't be properly protected. The cryptography is sound and
thus is fine for protection against brute-force attacks.
Because of the memory cost, it is generally advised to use
if you're not sure this might be a
problem on your system.Bcrypt
Synopsis
- data Scrypt
- data Password
- mkPassword :: Text -> Password
- hashPassword :: MonadIO m => Password -> m (PasswordHash Scrypt)
- newtype PasswordHash a = PasswordHash {}
- checkPassword :: Password -> PasswordHash Scrypt -> PasswordCheck
- data PasswordCheck
- hashPasswordWithParams :: MonadIO m => ScryptParams -> Password -> m (PasswordHash Scrypt)
- defaultParams :: ScryptParams
- data ScryptParams = ScryptParams {}
- hashPasswordWithSalt :: ScryptParams -> Salt Scrypt -> Password -> PasswordHash Scrypt
- newSalt :: MonadIO m => m (Salt Scrypt)
- newtype Salt a = Salt ByteString
- unsafeShowPassword :: Password -> Text
Algorithm
Plain-text Password
A plain-text password.
This represents a plain-text password that has NOT been hashed.
You should be careful with Password
. Make sure not to write it to logs or
store it in a database.
You can construct a Password
by using the mkPassword
function or as literal
strings together with the OverloadedStrings pragma (or manually, by using
fromString
on a String
). Alternatively, you could also use some of the
instances in the password-instances
library.
Hash Passwords (scrypt)
hashPassword :: MonadIO m => Password -> m (PasswordHash Scrypt) Source #
newtype PasswordHash a Source #
A hashed password.
This represents a password that has been put through a hashing function. The hashed password can be stored in a database.
Instances
Verify Passwords (scrypt)
checkPassword :: Password -> PasswordHash Scrypt -> PasswordCheck Source #
Check a Password
against a PasswordHash
Scrypt
.
Returns PasswordCheckSuccess
on success.
>>>
let pass = mkPassword "foobar"
>>>
passHash <- hashPassword pass
>>>
checkPassword pass passHash
PasswordCheckSuccess
Returns PasswordCheckFail
if an incorrect Password
or PasswordHash
Scrypt
is used.
>>>
let badpass = mkPassword "incorrect-password"
>>>
checkPassword badpass passHash
PasswordCheckFail
This should always fail if an incorrect password is given.
\(Blind badpass) -> let correctPasswordHash = hashPasswordWithSalt testParams salt "foobar" in checkPassword badpass correctPasswordHash == PasswordCheckFail
data PasswordCheck Source #
The result of checking a password against a hashed version. This is
returned by the checkPassword
functions.
PasswordCheckSuccess | The password check was successful. The plain-text password matches the hashed password. |
PasswordCheckFail | The password check failed. The plain-text password does not match the hashed password. |
Instances
Eq PasswordCheck Source # | |
Defined in Data.Password.Internal (==) :: PasswordCheck -> PasswordCheck -> Bool # (/=) :: PasswordCheck -> PasswordCheck -> Bool # | |
Read PasswordCheck Source # | |
Defined in Data.Password.Internal readsPrec :: Int -> ReadS PasswordCheck # readList :: ReadS [PasswordCheck] # | |
Show PasswordCheck Source # | |
Defined in Data.Password.Internal showsPrec :: Int -> PasswordCheck -> ShowS # show :: PasswordCheck -> String # showList :: [PasswordCheck] -> ShowS # |
Hashing Manually (scrypt)
hashPasswordWithParams :: MonadIO m => ScryptParams -> Password -> m (PasswordHash Scrypt) Source #
Hash a password using the Scrypt
algorithm with the given ScryptParams
.
N.B.: If you have any doubt in your knowledge of cryptography and/or the
Scrypt
algorithm, please just use hashPassword
.
Advice for setting the parameters:
- Memory used is about:
(2 ^
scryptRounds
) *scryptBlockSize
* 128 - Increasing
scryptBlockSize
andscryptRounds
will increase CPU time and memory used. - Increasing
scryptParallelism
will increase CPU time. (since this implementation, like most, runs thescryptParallelism
parameter in sequence, not in parallel)
Since: 2.0.0.0
defaultParams :: ScryptParams Source #
Default parameters for the Scrypt
algorithm.
>>>
defaultParams
ScryptParams {scryptSalt = 32, scryptRounds = 14, scryptBlockSize = 8, scryptParallelism = 1, scryptOutputLength = 64}
Since: 2.0.0.0
data ScryptParams Source #
Parameters used in the Scrypt
hashing algorithm.
Since: 2.0.0.0
ScryptParams | |
|
Instances
Eq ScryptParams Source # | |
Defined in Data.Password.Scrypt (==) :: ScryptParams -> ScryptParams -> Bool # (/=) :: ScryptParams -> ScryptParams -> Bool # | |
Show ScryptParams Source # | |
Defined in Data.Password.Scrypt showsPrec :: Int -> ScryptParams -> ShowS # show :: ScryptParams -> String # showList :: [ScryptParams] -> ShowS # |
Hashing with salt (DISADVISED)
Hashing with a set Salt
is almost never what you want
to do. Use hashPassword
or hashPasswordWithParams
to have
automatic generation of randomized salts.
hashPasswordWithSalt :: ScryptParams -> Salt Scrypt -> Password -> PasswordHash Scrypt Source #
Hash a password with the given ScryptParams
and also with the given Salt
instead of a randomly generated salt using scryptSalt
from ScryptParams
.
Using hashPasswordWithSalt
is strongly disadvised and hashPasswordWithParams
should be used instead. Never use a static salt in production applications!
The resulting PasswordHash
has the parameters used to hash it, as well as the
Salt
appended to it, separated by |
.
The input Salt
and resulting PasswordHash
are both base64 encoded.
>>>
let salt = Salt "abcdefghijklmnopqrstuvwxyz012345"
>>>
hashPasswordWithSalt defaultParams salt (mkPassword "foobar")
PasswordHash {unPasswordHash = "14|8|1|YWJjZGVmZ2hpamtsbW5vcHFyc3R1dnd4eXowMTIzNDU=|nENDaqWBmPKapAqQ3//H0iBImweGjoTqn5SvBS8Mc9FPFbzq6w65maYPZaO+SPamVZRXQjARQ8Y+5rhuDhjIhw=="}
(Note that we use an explicit Salt
in the example above. This is so that the
example is reproducible, but in general you should use hashPassword
. hashPassword
generates a new Salt
everytime it is called.)
A salt used by a hashing algorithm.
Since: 2.0.0.0
Unsafe debugging function to show a Password
unsafeShowPassword :: Password -> Text Source #
This is an unsafe function that shows a password in plain-text.
>>>
unsafeShowPassword ("foobar" :: Password)
"foobar"
You should generally not use this function.
Setup for doctests.
>>>
:set -XFlexibleInstances
>>>
:set -XOverloadedStrings
Import needed libraries.
>>>
import Data.Password
>>>
import Data.ByteString (pack)
>>>
import Test.QuickCheck (Arbitrary(arbitrary), Blind(Blind), vector)
>>>
import Test.QuickCheck.Instances.Text ()
>>>
instance Arbitrary (Salt a) where arbitrary = Salt . pack <$> vector 32
>>>
instance Arbitrary Password where arbitrary = fmap Password arbitrary
>>>
let salt = Salt "abcdefghijklmnopqrstuvwxyz012345"
>>>
let testParams = defaultParams {scryptRounds = 10}