password-3.0.1.0: Hashing and checking of passwords
Copyright(c) Felix Paulusma 2020
LicenseBSD-style (see LICENSE file)
Maintainercdep.illabout@gmail.com
Stabilityexperimental
PortabilityPOSIX
Safe HaskellNone
LanguageHaskell2010

Data.Password.Bcrypt

Description

bcrypt

The bcrypt algorithm is a popular way of hashing passwords. It is based on the Blowfish cipher and fairly straightfoward in its usage. It has a cost parameter that, when increased, slows down the hashing speed.

It is a straightforward and easy way to get decent protection on passwords, it has also been around long enough to be battle-tested and generally considered to provide a good amount of security.

Other algorithms

bcrypt, together with PBKDF2, are only computationally intensive. And to protect from specialized hardware, new algorithms have been developed that are also resource intensive, like Scrypt and Argon2. Not having high resource demands, means an attacker with specialized software could take less time to brute-force a password, though with the default cost (10) and a decently long password, the amount of time to brute-force would still be significant.

This the algorithm to use if you're not sure about your needs, but just want a decent, proven way to encrypt your passwords.

Synopsis

Algorithm

data Bcrypt Source #

Phantom type for bcrypt

Since: 2.0.0.0

Plain-text Password

data 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.

Instances

Instances details
Show Password

CAREFUL: Show-ing a Password will always print "**PASSWORD**"

>>> show ("hello" :: Password)
"**PASSWORD**"
Instance details

Defined in Data.Password.Types

IsString Password 
Instance details

Defined in Data.Password.Types

mkPassword :: Text -> Password #

Construct a Password

Hash Passwords (bcrypt)

hashPassword :: MonadIO m => Password -> m (PasswordHash Bcrypt) Source #

Hash the Password using the bcrypt hash algorithm.

N.B.: bcrypt has a limit of 72 bytes as input, so anything longer than that will be cut off at the 72 byte point and thus any password that is 72 bytes or longer will match as long as the first 72 bytes are the same.

>>> hashPassword $ mkPassword "foobar"
PasswordHash {unPasswordHash = "$2b$10$..."}

newtype PasswordHash a #

A hashed password.

This represents a password that has been put through a hashing function. The hashed password can be stored in a database.

Constructors

PasswordHash 

Fields

Instances

Instances details
Eq (PasswordHash a) 
Instance details

Defined in Data.Password.Types

Ord (PasswordHash a) 
Instance details

Defined in Data.Password.Types

Read (PasswordHash a) 
Instance details

Defined in Data.Password.Types

Show (PasswordHash a) 
Instance details

Defined in Data.Password.Types

Verify Passwords (bcrypt)

checkPassword :: Password -> PasswordHash Bcrypt -> PasswordCheck Source #

Check a Password against a PasswordHash Bcrypt.

Returns PasswordCheckSuccess on success.

>>> let pass = mkPassword "foobar"
>>> passHash <- hashPassword pass
>>> checkPassword pass passHash
PasswordCheckSuccess

Returns PasswordCheckFail if an incorrect Password or PasswordHash Bcrypt 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 8 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.

Constructors

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.

Hashing Manually (bcrypt)

hashPasswordWithParams Source #

Arguments

:: MonadIO m 
=> Int

The cost parameter. Should be between 4 and 31 (inclusive). Values which lie outside this range will be adjusted accordingly.

-> Password

The password to be hashed.

-> m (PasswordHash Bcrypt)

The bcrypt hash in standard format.

Hash a password using the bcrypt algorithm with the given cost.

The higher the cost, the longer hashPassword and checkPassword will take to run, thus increasing the security, but taking longer and taking up more resources. The optimal cost for generic user logins would be one that would take between 0.05 - 0.5 seconds to check on the machine that will run it.

N.B.: It is advised to use hashPassword if you're unsure about the implications that changing the cost brings with it.

Since: 2.0.0.0

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 Source #

Arguments

:: Int

The cost parameter. Should be between 4 and 31 (inclusive). Values which lie outside this range will be adjusted accordingly.

-> Salt Bcrypt

The salt. MUST be 16 bytes in length or an error will be raised.

-> Password

The password to be hashed.

-> PasswordHash Bcrypt

The bcrypt hash in standard format.

Hash a password with the given cost and also with the given Salt instead of generating a random salt. Using hashPasswordWithSalt is strongly disadvised, and hashPasswordWithParams should be used instead. Never use a static salt in production applications!

N.B.: The salt HAS to be 16 bytes or this function will throw an error!

>>> let salt = Salt "abcdefghijklmnop"
>>> hashPasswordWithSalt 10 salt (mkPassword "foobar")
PasswordHash {unPasswordHash = "$2b$10$WUHhXETkX0fnYkrqZU3ta.N8Utt4U77kW4RVbchzgvBvBBEEdCD/u"}

(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 (and hashPasswordWithParams) generates a new Salt everytime it is called.)

newSalt :: MonadIO m => m (Salt Bcrypt) Source #

Generate a random 16-byte bcrypt salt

Since: 2.0.0.0

newtype Salt a #

A salt used by a hashing algorithm.

Constructors

Salt 

Fields

Instances

Instances details
Eq (Salt a) 
Instance details

Defined in Data.Password.Types

Methods

(==) :: Salt a -> Salt a -> Bool #

(/=) :: Salt a -> Salt a -> Bool #

Show (Salt a) 
Instance details

Defined in Data.Password.Types

Methods

showsPrec :: Int -> Salt a -> ShowS #

show :: Salt a -> String #

showList :: [Salt a] -> ShowS #

Unsafe debugging function to show a Password

unsafeShowPassword :: Password -> Text #

This is an unsafe function that shows a password in plain-text.

>>> unsafeShowPassword ("foobar" :: Password)
"foobar"

You should generally not use this function in production settings, as you don't want to accidentally print a password anywhere, like logs, network responses, database entries, etc.

This will mostly be used by other libraries to handle the actual password internally, though it is conceivable that, even in a production setting, a password might have to be handled in an unsafe manner at some point.

Setup for doctests.

>>> :set -XFlexibleInstances
>>> :set -XOverloadedStrings

Import needed libraries.

>>> import Data.Password.Types
>>> 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 16
>>> instance Arbitrary Password where arbitrary = fmap mkPassword arbitrary
>>> let salt = Salt "abcdefghijklmnop"