    {-# 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 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1)
      where
        first_hash :: ByteString
    first_hash =
          Digest SHA256 -> ByteString
    forall bin bout.
    (ByteArrayAccess bin, ByteArray bout) =>
    bin -> bout
    convert (Digest SHA256 -> ByteString) -> Digest SHA256 -> ByteString
    forall a b. (a -> b) -> a -> b
    $
          ((Context SHA256 -> Digest SHA256
    forall a. HashAlgorithm a => Context a -> Digest a
    CH.hashFinalize (Context SHA256 -> Digest SHA256)
    -> Context SHA256 -> Digest SHA256
    forall a b. (a -> b) -> a -> b
    $ Context SHA256
    forall a. HashAlgorithm a => Context a
    CH.hashInit Context SHA256 -> ByteString -> Context SHA256
    forall ba a.
    (ByteArrayAccess ba, HashAlgorithm a) =>
    Context a -> ba -> Context a
    `CH.hashUpdate` ByteString
    password Context SHA256 -> ByteString -> Context SHA256
    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 (Digest SHA256 -> ByteString
    forall bin bout.
    (ByteArrayAccess bin, ByteArray bout) =>
    bin -> bout
    convert (ByteString -> Digest SHA256
    forall ba a.
    (ByteArrayAccess ba, HashAlgorithm a) =>
    ba -> Digest a
    CH.hash ByteString
    bs :: CH.Digest CH.SHA256)) (Int
    rounds Int -> Int -> Int
    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 =
        Digest SHA256 -> ByteString
    forall bin bout.
    (ByteArrayAccess bin, ByteArray bout) =>
    bin -> bout
    convert (HMAC SHA256 -> Digest SHA256
    forall a. HMAC a -> Digest a
    CH.hmacGetDigest (ByteString -> ByteString -> HMAC SHA256
    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 Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > (Int
    2Int -> Int -> Int
    forall a b. (Num a, Integral b) => a -> b -> a
    ^(Int
    32 :: Int) Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1) Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    hLen = [Char] -> ByteString
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "Derived key too long."
                      | Bool
    otherwise =
                          let !l :: Int
    l = Double -> Int
    forall b. Integral b => Double -> b
    forall a b. (RealFrac a, Integral b) => a -> b
    ceiling ((Int -> Double
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    dkLen Double -> Double -> Double
    forall a. Fractional a => a -> a -> a
    / Int -> Double
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    hLen) :: Double)
                              !r :: Int
    r = Int
    dkLen Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - (Int
    l Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1) Int -> Int -> Int
    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 ([ByteString] -> ByteString)
    -> ([ByteString] -> [ByteString]) -> [ByteString] -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [ByteString] -> [ByteString]
    forall a. HasCallStack => [a] -> [a]
    init ([ByteString] -> ByteString) -> [ByteString] -> ByteString
    forall a b. (a -> b) -> a -> b
    $ [ByteString]
    chunks) ByteString -> ByteString -> ByteString
    `B.append` Int -> ByteString -> ByteString
    B.take Int
    r ([ByteString] -> ByteString
    forall a. HasCallStack => [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 s. ST s ByteString) -> ByteString
    forall a. (forall s. ST s a) -> a
    runST ((forall s. ST s ByteString) -> ByteString)
    -> (forall s. ST s ByteString) -> ByteString
    forall a b. (a -> b) -> a -> b
    $ do
              u <- ByteString -> ST s (STRef s ByteString)
    forall a s. a -> ST s (STRef s a)
    newSTRef ByteString
    u1
              accum <- newSTRef u1
              forM_ [2 .. c] $ \Int
    _ -> do
                STRef s ByteString -> (ByteString -> ByteString) -> ST s ()
    forall s a. STRef s a -> (a -> a) -> ST s ()
    modifySTRef' STRef s ByteString
    u (ByteString -> ByteString -> ByteString
    hmacSHA256 ByteString
    password)
                currentU <- STRef s ByteString -> ST s ByteString
    forall s a. STRef s a -> ST s a
    readSTRef STRef s ByteString
    u
                modifySTRef' accum (`xor'` currentU)
              readSTRef 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 (ByteString -> [Word8]) -> (Int -> ByteString) -> Int -> [Word8]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> ByteString
    forall a. Binary a => a -> ByteString
    Binary.encode (Int -> [Word8]) -> Int -> [Word8]
    forall a b. (a -> b) -> a -> b
    $ Int
    i
                in [Word8] -> ByteString
    BS.pack ([Word8] -> ByteString) -> [Word8] -> ByteString
    forall a b. (a -> b) -> a -> b
    $ Int -> [Word8] -> [Word8]
    forall a. Int -> [a] -> [a]
    drop ([Word8] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Word8]
    str Int -> Int -> Int
    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 ([Word8] -> ByteString) -> [Word8] -> ByteString
    forall a b. (a -> b) -> a -> b
    $ (Word8 -> Word8 -> Word8) -> ByteString -> ByteString -> [Word8]
    forall a. (Word8 -> Word8 -> a) -> ByteString -> ByteString -> [a]
    BS.zipWith Word8 -> Word8 -> Word8
    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 =
        IO Salt -> (IOError -> IO Salt) -> IO Salt
    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 = [Char] -> IOMode -> (Handle -> IO Salt) -> IO Salt
    forall r. [Char] -> IOMode -> (Handle -> IO r) -> IO r
    withFile [Char]
    "/dev/urandom" IOMode
    ReadMode ((Handle -> IO Salt) -> IO Salt) -> (Handle -> IO Salt) -> IO Salt
    forall a b. (a -> b) -> a -> b
    $ \Handle
    h -> do
                          rawSalt <- Handle -> Int -> IO ByteString
    B.hGet Handle
    h Int
    16
                          return $ makeSalt rawSalt

    -- | Generate a 'Salt' from 'System.Random'.
    genSaltSysRandom :: IO Salt
    genSaltSysRandom :: IO Salt
    genSaltSysRandom = IO [Char]
    randomChars IO [Char] -> ([Char] -> IO Salt) -> IO Salt
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Salt -> IO Salt
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Salt -> IO Salt) -> ([Char] -> Salt) -> [Char] -> IO Salt
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> Salt
    makeSalt (ByteString -> Salt) -> ([Char] -> ByteString) -> [Char] -> Salt
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Char] -> ByteString
    B.pack
        where randomChars :: IO [Char]
    randomChars = [IO Char] -> IO [Char]
    forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    forall (m :: * -> *) a. Monad m => [m a] -> m [a]
    sequence ([IO Char] -> IO [Char]) -> [IO Char] -> IO [Char]
    forall a b. (a -> b) -> a -> b
    $ Int -> IO Char -> [IO Char]
    forall a. Int -> a -> [a]
    replicate Int
    16 (IO Char -> [IO Char]) -> IO Char -> [IO Char]
    forall a b. (a -> b) -> a -> b
    $ (Char, Char) -> IO Char
    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 | [ByteString] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [ByteString]
    broken Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Int
    4
                    Bool -> Bool -> Bool
    || ByteString
    algorithm ByteString -> ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    /= ByteString
    "sha256"
                    Bool -> Bool -> Bool
    || ByteString -> Int
    B.length ByteString
    hash Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Int
    44 = Maybe (Int, Salt, ByteString)
    forall a. Maybe a
    Nothing
                  | Bool
    otherwise = case ByteString -> Maybe (Int, ByteString)
    B.readInt ByteString
    strBS of
                                  Just (Int
    strength, ByteString
    _) -> (Int, Salt, ByteString) -> Maybe (Int, Salt, ByteString)
    forall a. a -> Maybe a
    Just (Int
    strength, ByteString -> Salt
    SaltBS ByteString
    salt, ByteString
    hash)
                                  Maybe (Int, ByteString)
    Nothing -> Maybe (Int, Salt, ByteString)
    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 (Int -> [Char]
    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 <- IO Salt
    genSaltIO
      return $ makePasswordSaltWith algorithm (2^) password salt 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 (ByteString -> ByteString) -> ByteString -> ByteString
    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
    2Int -> Int -> Int
    forall 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)) ByteString -> ByteString -> Bool
    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
    2Int -> Int -> Int
    forall 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 Int -> Int -> Bool
    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 (ByteString -> ByteString) -> ByteString -> ByteString
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Int -> ByteString
    hashRounds ByteString
    hash Int
    extraRounds
                    extraRounds :: Int
    extraRounds = (Int
    2Int -> Int -> Int
    forall a b. (Num a, Integral b) => a -> b -> a
    ^Int
    newstr) Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - (Int
    2Int -> Int -> Int
    forall 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]
    (Int -> Salt -> ShowS)
    -> (Salt -> [Char]) -> ([Salt] -> ShowS) -> Show Salt
    forall a.
    (Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Salt -> ShowS
    showsPrec :: Int -> Salt -> ShowS
    $cshow :: Salt -> [Char]
    show :: Salt -> [Char]
    $cshowList :: [Salt] -> ShowS
    showList :: [Salt] -> ShowS
    Show, Salt -> Salt -> Bool
    (Salt -> Salt -> Bool) -> (Salt -> Salt -> Bool) -> Eq Salt
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Salt -> Salt -> Bool
    == :: Salt -> Salt -> Bool
    $c/= :: Salt -> Salt -> Bool
    /= :: Salt -> Salt -> Bool
    Eq, Eq Salt
    Eq Salt =>
    (Salt -> Salt -> Ordering)
    -> (Salt -> Salt -> Bool)
    -> (Salt -> Salt -> Bool)
    -> (Salt -> Salt -> Bool)
    -> (Salt -> Salt -> Bool)
    -> (Salt -> Salt -> Salt)
    -> (Salt -> Salt -> Salt)
    -> Ord 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
    $ccompare :: Salt -> Salt -> Ordering
    compare :: Salt -> Salt -> Ordering
    $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
    >= :: Salt -> Salt -> Bool
    $cmax :: Salt -> Salt -> Salt
    max :: Salt -> Salt -> Salt
    $cmin :: Salt -> Salt -> Salt
    min :: Salt -> Salt -> Salt
    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 (ByteString -> Salt)
    -> (ByteString -> ByteString) -> ByteString -> Salt
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> ByteString
    encode (ByteString -> ByteString)
    -> (ByteString -> ByteString) -> ByteString -> ByteString
    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 Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    8 =
                                    [Char] -> ByteString
    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 = Maybe (Int, Salt, ByteString) -> Bool
    forall a. Maybe a -> Bool
    isJust (Maybe (Int, Salt, ByteString) -> Bool)
    -> (ByteString -> Maybe (Int, Salt, ByteString))
    -> ByteString
    -> Bool
    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') (Char, t) -> [(Char, t)] -> [(Char, t)]
    forall a. a -> [a] -> [a]
    : t -> Int -> [(Char, t)]
    rands t
    g' (Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1 :: Int)
                  where (Char
    a, t
    g') = (Char, Char) -> t -> (Char, t)
    forall g. RandomGen g => (Char, Char) -> g -> (Char, 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 (ByteString -> Salt) -> ByteString -> Salt
    forall a b. (a -> b) -> a -> b
    $ [Char] -> ByteString
    B.pack ([Char] -> ByteString) -> [Char] -> ByteString
    forall a b. (a -> b) -> a -> b
    $ ((Char, b) -> Char) -> [(Char, b)] -> [Char]
    forall a b. (a -> b) -> [a] -> [b]
    map (Char, b) -> Char
    forall a b. (a, b) -> a
    fst (b -> Int -> [(Char, b)]
    forall {t}. RandomGen t => t -> Int -> [(Char, t)]
    rands b
    gen Int
    16)
              newgen :: b
    newgen = (Char, b) -> b
    forall a b. (a, b) -> b
    snd ((Char, b) -> b) -> (Char, b) -> b
    forall a b. (a -> b) -> a -> b
    $ [(Char, b)] -> (Char, b)
    forall a. HasCallStack => [a] -> a
    last (b -> Int -> [(Char, b)]
    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