{-# LANGUAGE OverloadedStrings, BangPatterns #-}
{-# LANGUAGE CPP #-}
-- |
-- This is a fork of pwstore-fast, originally copyright (c) Peter Scott, 2011,
-- and released under a BSD-style licence.
--
-- Securely store hashed, salted passwords. If you need to store and verify
-- passwords, there are many wrong ways to do it, most of them all too
-- common. Some people store users' passwords in plain text. Then, when an
-- attacker manages to get their hands on this file, they have the passwords for
-- every user's account. One step up, but still wrong, is to simply hash all
-- passwords with SHA1 or something. This is vulnerable to rainbow table and
-- dictionary attacks. One step up from that is to hash the password along with
-- a unique salt value. This is vulnerable to dictionary attacks, since guessing
-- a password is very fast. The right thing to do is to use a slow hash
-- function, to add some small but significant delay, that will be negligible
-- for legitimate users but prohibitively expensive for someone trying to guess
-- passwords by brute force. That is what this library does. It iterates a
-- SHA256 hash, with a random salt, a few thousand times. This scheme is known
-- as PBKDF1, and is generally considered secure; there is nothing innovative
-- happening here.
--
-- The API here is very simple. What you store are called /password hashes/.
-- They are strings (technically, ByteStrings) that look like this:
--
-- > "sha256|14|jEWU94phx4QzNyH94Qp4CQ==|5GEw+jxP/4WLgzt9VS3Ee3nhqBlDsrKiB+rq7JfMckU="
--
-- Each password hash shows the algorithm, the strength (more on that later),
-- the salt, and the hashed-and-salted password. You store these on your server,
-- in a database, for when you need to verify a password. You make a password
-- hash with the 'makePassword' function. Here's an example:
--
-- > >>> makePassword "hunter2" 14
-- > "sha256|14|Zo4LdZGrv/HYNAUG3q8WcA==|zKjbHZoTpuPLp1lh6ATolWGIKjhXvY4TysuKvqtNFyk="
--
-- This will hash the password @\"hunter2\"@, with strength 14, which is a good
-- default value. The strength here determines how long the hashing will
-- take. When doing the hashing, we iterate the SHA256 hash function
-- @2^strength@ times, so increasing the strength by 1 makes the hashing take
-- twice as long. When computers get faster, you can bump up the strength a
-- little bit to compensate. You can strengthen existing password hashes with
-- the 'strengthenPassword' function. Note that 'makePassword' needs to generate
-- random numbers, so its return type is 'IO' 'ByteString'. If you want to avoid
-- the 'IO' monad, you can generate your own salt and pass it to
-- 'makePasswordSalt'.
--
-- Your strength value should not be less than 12, and 14 is a good default
-- value at the time of this writing, in 2013.
--
-- Once you've got your password hashes, the second big thing you need to do
-- with them is verify passwords against them. When a user gives you a password,
-- you compare it with a password hash using the 'verifyPassword' function:
--
-- > >>> verifyPassword "wrong guess" passwordHash
-- > False
-- > >>> verifyPassword "hunter2" passwordHash
-- > True
--
-- These two functions are really all you need. If you want to make existing
-- password hashes stronger, you can use 'strengthenPassword'. Just pass it an
-- existing password hash and a new strength value, and it will return a new
-- password hash with that strength value, which will match the same password as
-- the old password hash.
--
-- Note that, as of version 2.4, you can also use PBKDF2, and specify the exact
-- iteration count. This does not have a significant effect on security, but can
-- be handy for compatibility with other code.
--
-- @since 1.4.18

module Yesod.Auth.Util.PasswordStore (

        -- * Algorithms
        pbkdf1,                 -- :: ByteString -> Salt -> Int -> ByteString
        pbkdf2,                 -- :: ByteString -> Salt -> Int -> ByteString

        -- * Registering and verifying passwords
        makePassword,           -- :: ByteString -> Int -> IO ByteString
        makePasswordWith,       -- :: (ByteString -> Salt -> Int -> ByteString) ->
                                --    ByteString -> Int -> IO ByteString
        makePasswordSalt,       -- :: ByteString -> ByteString -> Int -> ByteString
        makePasswordSaltWith,   -- :: (ByteString -> Salt -> Int -> ByteString) ->
                                --    ByteString -> Salt -> Int -> ByteString
        verifyPassword,         -- :: ByteString -> ByteString -> Bool
        verifyPasswordWith,     -- :: (ByteString -> Salt -> Int -> ByteString) ->
                                --    (Int -> Int) -> ByteString -> ByteString -> Bool

        -- * Updating password hash strength
        strengthenPassword,     -- :: ByteString -> Int -> ByteString
        passwordStrength,       -- :: ByteString -> Int

        -- * Utilities
        Salt,
        isPasswordFormatValid,  -- :: ByteString -> Bool
        genSaltIO,              -- :: IO Salt
        genSaltRandom,          -- :: (RandomGen b) => b -> (Salt, b)
        makeSalt,               -- :: ByteString -> Salt
        exportSalt,             -- :: Salt -> ByteString
        importSalt              -- :: ByteString -> Salt
  ) where

import qualified Crypto.MAC.HMAC as CH
import qualified Crypto.Hash as CH
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BL
import qualified Data.Binary as Binary
import Control.Monad
import Control.Monad.ST
import Data.STRef
import Data.Bits
import Data.ByteString.Char8 (ByteString)
import Data.ByteString.Base64 (encode, decodeLenient)
import System.IO
import System.Random
import Data.Maybe
import qualified Control.Exception
import Data.ByteArray (convert)

---------------------
-- Cryptographic base
---------------------

-- | PBKDF1 key-derivation function. Takes a password, a 'Salt', and a number of
-- iterations. The number of iterations should be at least 1000, and probably
-- more. 5000 is a reasonable number, computing almost instantaneously. This
-- will give a 32-byte 'ByteString' as output. Both the salt and this 32-byte
-- key should be stored in the password file. When a user wishes to authenticate
-- a password, just pass it and the salt to this function, and see if the output
-- matches.
--
-- @since 1.4.18
--
pbkdf1 :: ByteString -> Salt -> Int -> ByteString
pbkdf1 :: ByteString -> Salt -> Int -> ByteString
pbkdf1 ByteString
password (SaltBS ByteString
salt) Int
iter = ByteString -> Int -> ByteString
hashRounds ByteString
first_hash (Int
iter forall a. Num a => a -> a -> a
+ Int
1)
  where
    first_hash :: ByteString
first_hash =
      forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert forall a b. (a -> b) -> a -> b
$
      ((forall a. HashAlgorithm a => Context a -> Digest a
CH.hashFinalize forall a b. (a -> b) -> a -> b
$ forall a. HashAlgorithm a => Context a
CH.hashInit forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
Context a -> ba -> Context a
`CH.hashUpdate` ByteString
password forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
Context a -> ba -> Context a
`CH.hashUpdate` ByteString
salt) :: CH.Digest CH.SHA256)


-- | Hash a 'ByteString' for a given number of rounds. The number of rounds is 0
-- or more. If the number of rounds specified is 0, the ByteString will be
-- returned unmodified.
hashRounds :: ByteString -> Int -> ByteString
hashRounds :: ByteString -> Int -> ByteString
hashRounds (!ByteString
bs) Int
0 = ByteString
bs
hashRounds ByteString
bs Int
rounds = ByteString -> Int -> ByteString
hashRounds (forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert (forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
ba -> Digest a
CH.hash ByteString
bs :: CH.Digest CH.SHA256)) (Int
rounds forall a. Num a => a -> a -> a
- Int
1)

-- | Computes the hmacSHA256 of the given message, with the given 'Salt'.
hmacSHA256 :: ByteString
           -- ^ The secret (the salt)
           -> ByteString
           -- ^ The clear-text message
           -> ByteString
           -- ^ The encoded message
hmacSHA256 :: ByteString -> ByteString -> ByteString
hmacSHA256 ByteString
secret ByteString
msg =
    forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert (forall a. HMAC a -> Digest a
CH.hmacGetDigest (forall key message a.
(ByteArrayAccess key, ByteArrayAccess message, HashAlgorithm a) =>
key -> message -> HMAC a
CH.hmac ByteString
secret ByteString
msg) :: CH.Digest CH.SHA256)

-- | PBKDF2 key-derivation function.
-- For details see @http://tools.ietf.org/html/rfc2898@.
-- @32@ is the most common digest size for @SHA256@, and is
-- what the algorithm internally uses.
-- @HMAC+SHA256@ is used as @PRF@, because @HMAC+SHA1@ is considered too weak.
--
-- @since 1.4.18
--
pbkdf2 :: ByteString -> Salt -> Int -> ByteString
pbkdf2 :: ByteString -> Salt -> Int -> ByteString
pbkdf2 ByteString
password (SaltBS ByteString
salt) Int
c =
    let hLen :: Int
hLen = Int
32
        dkLen :: Int
dkLen = Int
hLen in Int -> Int -> ByteString
go Int
hLen Int
dkLen
  where
    go :: Int -> Int -> ByteString
go Int
hLen Int
dkLen | Int
dkLen forall a. Ord a => a -> a -> Bool
> (Int
2forall a b. (Num a, Integral b) => a -> b -> a
^(Int
32 :: Int) forall a. Num a => a -> a -> a
- Int
1) forall a. Num a => a -> a -> a
* Int
hLen = forall a. HasCallStack => [Char] -> a
error [Char]
"Derived key too long."
                  | Bool
otherwise =
                      let !l :: Int
l = forall a b. (RealFrac a, Integral b) => a -> b
ceiling ((forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
dkLen forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
hLen) :: Double)
                          !r :: Int
r = Int
dkLen forall a. Num a => a -> a -> a
- (Int
l forall a. Num a => a -> a -> a
- Int
1) forall a. Num a => a -> a -> a
* Int
hLen
                          chunks :: [ByteString]
chunks = [Int -> ByteString
f Int
i | Int
i <- [Int
1 .. Int
l]]
                      in ([ByteString] -> ByteString
B.concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
init forall a b. (a -> b) -> a -> b
$ [ByteString]
chunks) ByteString -> ByteString -> ByteString
`B.append` Int -> ByteString -> ByteString
B.take Int
r (forall a. [a] -> a
last [ByteString]
chunks)

    -- The @f@ function, as defined in the spec.
    -- It calls 'u' under the hood.
    f :: Int -> ByteString
    f :: Int -> ByteString
f Int
i = let !u1 :: ByteString
u1 = ByteString -> ByteString -> ByteString
hmacSHA256 ByteString
password (ByteString
salt ByteString -> ByteString -> ByteString
`B.append` Int -> ByteString
int Int
i)
      -- Using the ST Monad, for maximum performance.
      in forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
          STRef s ByteString
u <- forall a s. a -> ST s (STRef s a)
newSTRef ByteString
u1
          STRef s ByteString
accum <- forall a s. a -> ST s (STRef s a)
newSTRef ByteString
u1
          forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
2 .. Int
c] forall a b. (a -> b) -> a -> b
$ \Int
_ -> do
            forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef' STRef s ByteString
u (ByteString -> ByteString -> ByteString
hmacSHA256 ByteString
password)
            ByteString
currentU <- forall s a. STRef s a -> ST s a
readSTRef STRef s ByteString
u
            forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef' STRef s ByteString
accum (ByteString -> ByteString -> ByteString
`xor'` ByteString
currentU)
          forall s a. STRef s a -> ST s a
readSTRef STRef s ByteString
accum

    -- int(i), as defined in the spec.
    int :: Int -> ByteString
    int :: Int -> ByteString
int Int
i = let str :: [Word8]
str = ByteString -> [Word8]
BL.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Binary a => a -> ByteString
Binary.encode forall a b. (a -> b) -> a -> b
$ Int
i
            in [Word8] -> ByteString
BS.pack forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
drop (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word8]
str forall a. Num a => a -> a -> a
- Int
4) [Word8]
str

    -- | A convenience function to XOR two 'ByteString' together.
    xor' :: ByteString -> ByteString -> ByteString
    xor' :: ByteString -> ByteString -> ByteString
xor' !ByteString
b1 !ByteString
b2 = [Word8] -> ByteString
BS.pack forall a b. (a -> b) -> a -> b
$ forall a. (Word8 -> Word8 -> a) -> ByteString -> ByteString -> [a]
BS.zipWith forall a. Bits a => a -> a -> a
xor ByteString
b1 ByteString
b2

-- | Generate a 'Salt' from 128 bits of data from @\/dev\/urandom@, with the
-- system RNG as a fallback. This is the function used to generate salts by
-- 'makePassword'.
--
-- @since 1.4.18
--
genSaltIO :: IO Salt
genSaltIO :: IO Salt
genSaltIO =
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
Control.Exception.catch IO Salt
genSaltDevURandom IOError -> IO Salt
def
  where
    def :: IOError -> IO Salt
    def :: IOError -> IO Salt
def IOError
_ = IO Salt
genSaltSysRandom

-- | Generate a 'Salt' from @\/dev\/urandom@.
genSaltDevURandom :: IO Salt
genSaltDevURandom :: IO Salt
genSaltDevURandom = forall r. [Char] -> IOMode -> (Handle -> IO r) -> IO r
withFile [Char]
"/dev/urandom" IOMode
ReadMode forall a b. (a -> b) -> a -> b
$ \Handle
h -> do
                      ByteString
rawSalt <- Handle -> Int -> IO ByteString
B.hGet Handle
h Int
16
                      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ByteString -> Salt
makeSalt ByteString
rawSalt

-- | Generate a 'Salt' from 'System.Random'.
genSaltSysRandom :: IO Salt
genSaltSysRandom :: IO Salt
genSaltSysRandom = IO [Char]
randomChars forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Salt
makeSalt forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ByteString
B.pack
    where randomChars :: IO [Char]
randomChars = forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> [a]
replicate Int
16 forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *). (Random a, MonadIO m) => (a, a) -> m a
randomRIO (Char
'\NUL', Char
'\255')

-----------------------
-- Password hash format
-----------------------

-- Format: "sha256|strength|salt|hash", where strength is an unsigned int, salt
-- is a base64-encoded 16-byte random number, and hash is a base64-encoded hash
-- value.

-- | Try to parse a password hash.
readPwHash :: ByteString -> Maybe (Int, Salt, ByteString)
readPwHash :: ByteString -> Maybe (Int, Salt, ByteString)
readPwHash ByteString
pw | forall (t :: * -> *) a. Foldable t => t a -> Int
length [ByteString]
broken forall a. Eq a => a -> a -> Bool
/= Int
4
                Bool -> Bool -> Bool
|| ByteString
algorithm forall a. Eq a => a -> a -> Bool
/= ByteString
"sha256"
                Bool -> Bool -> Bool
|| ByteString -> Int
B.length ByteString
hash forall a. Eq a => a -> a -> Bool
/= Int
44 = forall a. Maybe a
Nothing
              | Bool
otherwise = case ByteString -> Maybe (Int, ByteString)
B.readInt ByteString
strBS of
                              Just (Int
strength, ByteString
_) -> forall a. a -> Maybe a
Just (Int
strength, ByteString -> Salt
SaltBS ByteString
salt, ByteString
hash)
                              Maybe (Int, ByteString)
Nothing -> forall a. Maybe a
Nothing
    where broken :: [ByteString]
broken = Char -> ByteString -> [ByteString]
B.split Char
'|' ByteString
pw
          [ByteString
algorithm, ByteString
strBS, ByteString
salt, ByteString
hash] = [ByteString]
broken

-- | Encode a password hash, from a @(strength, salt, hash)@ tuple, where
-- strength is an 'Int', and both @salt@ and @hash@ are base64-encoded
-- 'ByteString's.
writePwHash :: (Int, Salt, ByteString) -> ByteString
writePwHash :: (Int, Salt, ByteString) -> ByteString
writePwHash (Int
strength, SaltBS ByteString
salt, ByteString
hash) =
    ByteString -> [ByteString] -> ByteString
B.intercalate ByteString
"|" [ByteString
"sha256", [Char] -> ByteString
B.pack (forall a. Show a => a -> [Char]
show Int
strength), ByteString
salt, ByteString
hash]

-----------------
-- High level API
-----------------

-- | Hash a password with a given strength (14 is a good default). The output of
-- this function can be written directly to a password file or
-- database. Generates a salt using high-quality randomness from
-- @\/dev\/urandom@ or (if that is not available, for example on Windows)
-- 'System.Random', which is included in the hashed output.
--
-- @since 1.4.18
--
makePassword :: ByteString -> Int -> IO ByteString
makePassword :: ByteString -> Int -> IO ByteString
makePassword = (ByteString -> Salt -> Int -> ByteString)
-> ByteString -> Int -> IO ByteString
makePasswordWith ByteString -> Salt -> Int -> ByteString
pbkdf1

-- | A generic version of 'makePassword', which allow the user
-- to choose the algorithm to use.
--
-- >>> makePasswordWith pbkdf1 "password" 14
--
-- @since 1.4.18
--
makePasswordWith :: (ByteString -> Salt -> Int -> ByteString)
                 -- ^ The algorithm to use (e.g. pbkdf1)
                 -> ByteString
                 -- ^ The password to encrypt
                 -> Int
                 -- ^ log2 of the number of iterations
                 -> IO ByteString
makePasswordWith :: (ByteString -> Salt -> Int -> ByteString)
-> ByteString -> Int -> IO ByteString
makePasswordWith ByteString -> Salt -> Int -> ByteString
algorithm ByteString
password Int
strength = do
  Salt
salt <- IO Salt
genSaltIO
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (ByteString -> Salt -> Int -> ByteString)
-> (Int -> Int) -> ByteString -> Salt -> Int -> ByteString
makePasswordSaltWith ByteString -> Salt -> Int -> ByteString
algorithm (Int
2forall a b. (Num a, Integral b) => a -> b -> a
^) ByteString
password Salt
salt Int
strength

-- | A generic version of 'makePasswordSalt', meant to give the user
-- the maximum control over the generation parameters.
-- Note that, unlike 'makePasswordWith', this function takes the @raw@
-- number of iterations. This means the user will need to specify a
-- sensible value, typically @10000@ or @20000@.
--
-- @since 1.4.18
--
makePasswordSaltWith :: (ByteString -> Salt -> Int -> ByteString)
                     -- ^ A function modeling an algorithm (e.g. 'pbkdf1')
                     -> (Int -> Int)
                     -- ^ A function to modify the strength
                     -> ByteString
                     -- ^ A password, given as clear text
                     -> Salt
                     -- ^ A hash 'Salt'
                     -> Int
                     -- ^ The password strength (e.g. @10000, 20000, etc.@)
                     -> ByteString
makePasswordSaltWith :: (ByteString -> Salt -> Int -> ByteString)
-> (Int -> Int) -> ByteString -> Salt -> Int -> ByteString
makePasswordSaltWith ByteString -> Salt -> Int -> ByteString
algorithm Int -> Int
strengthModifier ByteString
pwd Salt
salt Int
strength = (Int, Salt, ByteString) -> ByteString
writePwHash (Int
strength, Salt
salt, ByteString
hash)
    where hash :: ByteString
hash = ByteString -> ByteString
encode forall a b. (a -> b) -> a -> b
$ ByteString -> Salt -> Int -> ByteString
algorithm ByteString
pwd Salt
salt (Int -> Int
strengthModifier Int
strength)

-- | Hash a password with a given strength (14 is a good default), using a given
-- salt. The output of this function can be written directly to a password file
-- or database. Example:
--
-- > >>> makePasswordSalt "hunter2" (makeSalt "72cd18b5ebfe6e96") 14
-- > "sha256|14|NzJjZDE4YjVlYmZlNmU5Ng==|yuiNrZW3KHX+pd0sWy9NTTsy5Yopmtx4UYscItSsoxc="
--
-- @since 1.4.18
--
makePasswordSalt :: ByteString -> Salt -> Int -> ByteString
makePasswordSalt :: ByteString -> Salt -> Int -> ByteString
makePasswordSalt = (ByteString -> Salt -> Int -> ByteString)
-> (Int -> Int) -> ByteString -> Salt -> Int -> ByteString
makePasswordSaltWith ByteString -> Salt -> Int -> ByteString
pbkdf1 (Int
2forall a b. (Num a, Integral b) => a -> b -> a
^)

-- | 'verifyPasswordWith' @algorithm userInput pwHash@ verifies
-- the password @userInput@ given by the user against the stored password
-- hash @pwHash@, with the hashing algorithm @algorithm@.  Returns 'True' if the
-- given password is correct, and 'False' if it is not.
-- This function allows the programmer to specify the algorithm to use,
-- e.g. 'pbkdf1' or 'pbkdf2'.
-- Note: If you want to verify a password previously generated with
-- 'makePasswordSaltWith', but without modifying the number of iterations,
-- you can do:
--
-- > >>> verifyPasswordWith pbkdf2 id "hunter2" "sha256..."
-- > True
--
-- @since 1.4.18
--
verifyPasswordWith :: (ByteString -> Salt -> Int -> ByteString)
                   -- ^ A function modeling an algorithm (e.g. pbkdf1)
                   -> (Int -> Int)
                   -- ^ A function to modify the strength
                   -> ByteString
                   -- ^ User password
                   -> ByteString
                   -- ^ The generated hash (e.g. sha256|14...)
                   -> Bool
verifyPasswordWith :: (ByteString -> Salt -> Int -> ByteString)
-> (Int -> Int) -> ByteString -> ByteString -> Bool
verifyPasswordWith ByteString -> Salt -> Int -> ByteString
algorithm Int -> Int
strengthModifier ByteString
userInput ByteString
pwHash =
    case ByteString -> Maybe (Int, Salt, ByteString)
readPwHash ByteString
pwHash of
      Maybe (Int, Salt, ByteString)
Nothing -> Bool
False
      Just (Int
strength, Salt
salt, ByteString
goodHash) ->
          ByteString -> ByteString
encode (ByteString -> Salt -> Int -> ByteString
algorithm ByteString
userInput Salt
salt (Int -> Int
strengthModifier Int
strength)) forall a. Eq a => a -> a -> Bool
== ByteString
goodHash

-- | Like 'verifyPasswordWith', but uses 'pbkdf1' as algorithm.
--
-- @since 1.4.18
--
verifyPassword :: ByteString -> ByteString -> Bool
verifyPassword :: ByteString -> ByteString -> Bool
verifyPassword = (ByteString -> Salt -> Int -> ByteString)
-> (Int -> Int) -> ByteString -> ByteString -> Bool
verifyPasswordWith ByteString -> Salt -> Int -> ByteString
pbkdf1 (Int
2forall a b. (Num a, Integral b) => a -> b -> a
^)

-- | Try to strengthen a password hash, by hashing it some more
-- times. @'strengthenPassword' pwHash new_strength@ will return a new password
-- hash with strength at least @new_strength@. If the password hash already has
-- strength greater than or equal to @new_strength@, then it is returned
-- unmodified. If the password hash is invalid and does not parse, it will be
-- returned without comment.
--
-- This function can be used to periodically update your password database when
-- computers get faster, in order to keep up with Moore's law. This isn't hugely
-- important, but it's a good idea.
--
-- @since 1.4.18
--
strengthenPassword :: ByteString -> Int -> ByteString
strengthenPassword :: ByteString -> Int -> ByteString
strengthenPassword ByteString
pwHash Int
newstr =
    case ByteString -> Maybe (Int, Salt, ByteString)
readPwHash ByteString
pwHash of
      Maybe (Int, Salt, ByteString)
Nothing -> ByteString
pwHash
      Just (Int
oldstr, Salt
salt, ByteString
hashB64) ->
          if Int
oldstr forall a. Ord a => a -> a -> Bool
< Int
newstr then
              (Int, Salt, ByteString) -> ByteString
writePwHash (Int
newstr, Salt
salt, ByteString
newHash)
          else
              ByteString
pwHash
          where newHash :: ByteString
newHash = ByteString -> ByteString
encode forall a b. (a -> b) -> a -> b
$ ByteString -> Int -> ByteString
hashRounds ByteString
hash Int
extraRounds
                extraRounds :: Int
extraRounds = (Int
2forall a b. (Num a, Integral b) => a -> b -> a
^Int
newstr) forall a. Num a => a -> a -> a
- (Int
2forall a b. (Num a, Integral b) => a -> b -> a
^Int
oldstr)
                hash :: ByteString
hash = ByteString -> ByteString
decodeLenient ByteString
hashB64

-- | Return the strength of a password hash.
--
-- @since 1.4.18
--
passwordStrength :: ByteString -> Int
passwordStrength :: ByteString -> Int
passwordStrength ByteString
pwHash = case ByteString -> Maybe (Int, Salt, ByteString)
readPwHash ByteString
pwHash of
                            Maybe (Int, Salt, ByteString)
Nothing               -> Int
0
                            Just (Int
strength, Salt
_, ByteString
_) -> Int
strength

------------
-- Utilities
------------

-- | A salt is a unique random value which is stored as part of the password
-- hash. You can generate a salt with 'genSaltIO' or 'genSaltRandom', or if you
-- really know what you're doing, you can create them from your own ByteString
-- values with 'makeSalt'.
--
-- @since 1.4.18
--
newtype Salt = SaltBS ByteString
    deriving (Int -> Salt -> ShowS
[Salt] -> ShowS
Salt -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Salt] -> ShowS
$cshowList :: [Salt] -> ShowS
show :: Salt -> [Char]
$cshow :: Salt -> [Char]
showsPrec :: Int -> Salt -> ShowS
$cshowsPrec :: Int -> Salt -> ShowS
Show, Salt -> Salt -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Salt -> Salt -> Bool
$c/= :: Salt -> Salt -> Bool
== :: Salt -> Salt -> Bool
$c== :: Salt -> Salt -> Bool
Eq, Eq Salt
Salt -> Salt -> Bool
Salt -> Salt -> Ordering
Salt -> Salt -> Salt
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Salt -> Salt -> Salt
$cmin :: Salt -> Salt -> Salt
max :: Salt -> Salt -> Salt
$cmax :: Salt -> Salt -> Salt
>= :: Salt -> Salt -> Bool
$c>= :: Salt -> Salt -> Bool
> :: Salt -> Salt -> Bool
$c> :: Salt -> Salt -> Bool
<= :: Salt -> Salt -> Bool
$c<= :: Salt -> Salt -> Bool
< :: Salt -> Salt -> Bool
$c< :: Salt -> Salt -> Bool
compare :: Salt -> Salt -> Ordering
$ccompare :: Salt -> Salt -> Ordering
Ord)

-- | Create a 'Salt' from a 'ByteString'. The input must be at least 8
-- characters, and can contain arbitrary bytes. Most users will not need to use
-- this function.
--
-- @since 1.4.18
--
makeSalt :: ByteString -> Salt
makeSalt :: ByteString -> Salt
makeSalt = ByteString -> Salt
SaltBS forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
encode forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
check_length
    where check_length :: ByteString -> ByteString
check_length ByteString
salt | ByteString -> Int
B.length ByteString
salt forall a. Ord a => a -> a -> Bool
< Int
8 =
                                forall a. HasCallStack => [Char] -> a
error [Char]
"Salt too short. Minimum length is 8 characters."
                            | Bool
otherwise = ByteString
salt

-- | Convert a 'Salt' into a 'ByteString'. The resulting 'ByteString' will be
-- base64-encoded. Most users will not need to use this function.
--
-- @since 1.4.18
--
exportSalt :: Salt -> ByteString
exportSalt :: Salt -> ByteString
exportSalt (SaltBS ByteString
bs) = ByteString
bs

-- | Convert a raw 'ByteString' into a 'Salt'.
-- Use this function with caution, since using a weak salt will result in a
-- weak password.
--
-- @since 1.4.18
--
importSalt :: ByteString -> Salt
importSalt :: ByteString -> Salt
importSalt = ByteString -> Salt
SaltBS

-- | Is the format of a password hash valid? Attempts to parse a given password
-- hash. Returns 'True' if it parses correctly, and 'False' otherwise.
--
-- @since 1.4.18
--
isPasswordFormatValid :: ByteString -> Bool
isPasswordFormatValid :: ByteString -> Bool
isPasswordFormatValid = forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe (Int, Salt, ByteString)
readPwHash

-- | Generate a 'Salt' with 128 bits of data taken from a given random number
-- generator. Returns the salt and the updated random number generator. This is
-- meant to be used with 'makePasswordSalt' by people who would prefer to either
-- use their own random number generator or avoid the 'IO' monad.
--
-- @since 1.4.18
--
genSaltRandom :: (RandomGen b) => b -> (Salt, b)
genSaltRandom :: forall b. RandomGen b => b -> (Salt, b)
genSaltRandom b
gen = (Salt
salt, b
newgen)
    where rands :: t -> Int -> [(Char, t)]
rands t
_ Int
0 = []
          rands t
g Int
n = (Char
a, t
g') forall a. a -> [a] -> [a]
: t -> Int -> [(Char, t)]
rands t
g' (Int
nforall a. Num a => a -> a -> a
-Int
1 :: Int)
              where (Char
a, t
g') = forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
randomR (Char
'\NUL', Char
'\255') t
g
          salt :: Salt
salt   = ByteString -> Salt
makeSalt forall a b. (a -> b) -> a -> b
$ [Char] -> ByteString
B.pack forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst (forall {t}. RandomGen t => t -> Int -> [(Char, t)]
rands b
gen Int
16)
          newgen :: b
newgen = forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
last (forall {t}. RandomGen t => t -> Int -> [(Char, t)]
rands b
gen Int
16)

#if !MIN_VERSION_base(4, 6, 0)
-- | Strict version of 'modifySTRef'
modifySTRef' :: STRef s a -> (a -> a) -> ST s ()
modifySTRef' ref f = do
    x <- readSTRef ref
    let x' = f x
    x' `seq` writeSTRef ref x'
#endif