password-1.0.0.0: plain-text password and hashed password datatypes and functions

Copyright(c) Dennis Gosnell 2019
LicenseBSD-style (see LICENSE file)
Maintainercdep.illabout@gmail.com
Stabilityexperimental
PortabilityPOSIX
Safe HaskellNone
LanguageHaskell2010

Data.Password

Contents

Description

This module provides an easy way for interacting with passwords from Haskell. It provides the types Pass and PassHash, which correspond to plain-text and hashed passwords.

It also provides functions for hashing (hashPass) and checking passwords (checkPass).

The real benefit of this module is that there is a corresponding password-instances module that provides canonical typeclass instances for Pass and PassHash for many common typeclasses, like FromJSON from aeson, PersistField from persistent, etc.

See the password-instances module for more information.

Synopsis

Plaintext Password

data Pass Source #

A plain-text password.

This represents a plain-text password that has NOT been hashed.

You should be careful with Pass. Make sure not to write it to logs or store it in a database.

You can construct a Pass by using the mkPass 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
Show Pass Source #

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

>>> show $ mkPass "hello"
"**PASSWORD**"

Since: 1.0.0.0

Instance details

Defined in Data.Password

Methods

showsPrec :: Int -> Pass -> ShowS #

show :: Pass -> String #

showList :: [Pass] -> ShowS #

IsString Pass Source # 
Instance details

Defined in Data.Password

Methods

fromString :: String -> Pass #

mkPass :: Text -> Pass Source #

Construct a Pass

Since: 1.0.0.0

Hashed Password

newtype PassHash 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.

Constructors

PassHash 

Fields

Instances
Eq PassHash Source # 
Instance details

Defined in Data.Password

Ord PassHash Source # 
Instance details

Defined in Data.Password

Read PassHash Source # 
Instance details

Defined in Data.Password

Show PassHash Source # 
Instance details

Defined in Data.Password

newtype Salt #

Constructors

Salt 

Fields

Instances
Eq Salt 
Instance details

Defined in Crypto.Scrypt

Methods

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

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

Show Salt 
Instance details

Defined in Crypto.Scrypt

Methods

showsPrec :: Int -> Salt -> ShowS #

show :: Salt -> String #

showList :: [Salt] -> ShowS #

Functions for Hashing Plaintext Passwords

hashPass :: MonadIO m => Pass -> m PassHash Source #

Just like hashPassWithSalt, but generate a new Salt everytime with a call to newSalt.

>>> hashPass $ mkPass "foobar"
PassHash {unPassHash = "14|8|1|...|..."}

hashPassWithSalt :: Salt -> Pass -> PassHash Source #

Hash a password with the given Salt.

The resulting PassHash has the parameters used to hash it, as well as the Salt appended to it, separated by |.

The input Salt and resulting PassHash are both byte-64 encoded.

>>> let salt = Salt "abcdefghijklmnopqrstuvwxyz012345"
>>> hashPassWithSalt salt (mkPass "foobar")
PassHash {unPassHash = "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 hashPass. hashPass generates a new Salt everytime it is called.)

This function uses the hash function from the scrypt package: encryptPass.

newSalt :: MonadIO m => m Salt Source #

Generate a random 32-byte salt.

Functions for Checking Plaintext Passwords Against Hashed Passwords

checkPass :: Pass -> PassHash -> PassCheck Source #

Check a Pass against a PassHash.

Returns PassCheckSuccess on success.

>>> let salt = Salt "abcdefghijklmnopqrstuvwxyz012345"
>>> let pass = mkPass "foobar"
>>> let passHash = hashPassWithSalt salt pass
>>> checkPass pass passHash
PassCheckSuccess

Returns PassCheckFail If an incorrect Pass or PassHash is used.

>>> let badpass = mkPass "incorrect-password"
>>> checkPass badpass passHash
PassCheckFail

This should always fail if an incorrect password is given.

\(Blind badpass) -> let correctPassHash = hashPassWithSalt salt "foobar" in checkPass badpass correctPassHash == PassCheckFail

data PassCheck Source #

The result of a checking a password against a hashed version. This is returned by checkPass.

Constructors

PassCheckSuccess

The password check was successful. The plain-text password matches the hashed password.

PassCheckFail

The password check failed. The plain-text password does not match the hashed password.

Instances
Eq PassCheck Source # 
Instance details

Defined in Data.Password

Read PassCheck Source # 
Instance details

Defined in Data.Password

Show PassCheck Source # 
Instance details

Defined in Data.Password

Unsafe Debugging Functions for Showing a Password

unsafeShowPassword :: Pass -> String Source #

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

>>> unsafeShowPasswordText $ mkPass "foobar"
"foobar"

You should generally not use this function.

unsafeShowPasswordText :: Pass -> Text Source #

This is like unsafeShowPassword but produces a Text instead of a String.

Setup for doctests.

>>> :set -XOverloadedStrings

Import needed libraries.

>>> import Data.ByteString (pack)
>>> import Test.QuickCheck (Arbitrary(arbitrary), Blind(Blind), vector)
>>> import Test.QuickCheck.Instances.ByteString ()
>>> import Test.QuickCheck.Instances.Text ()

Arbitrary instances for types exported from this library.

>>> instance Arbitrary Salt where arbitrary = Salt . pack <$> vector 32
>>> instance Arbitrary Pass where arbitrary = fmap Pass arbitrary
>>> instance Arbitrary PassHash where arbitrary = hashPassWithSalt <$> arbitrary <*> arbitrary

Arbitrary instances for types exported from Crypto.Scrypt.

>>> instance Arbitrary Scrypt.Pass where arbitrary = fmap Scrypt.Pass arbitrary
>>> instance Arbitrary EncryptedPass where arbitrary = encryptPass defaultParams <$> arbitrary <*> arbitrary