    -- | Password encoding and validation using bcrypt.
    --
    -- Example usage:
    --
    -- >>> import Crypto.KDF.BCrypt (hashPassword, validatePassword)
    -- >>> import qualified Data.ByteString.Char8 as B
    -- >>>
    -- >>> let bcryptHash = B.pack "$2a$10$MJJifxfaqQmbx1Mhsq3oq.YmMmfNhkyW4s/MS3K5rIMVfB7w0Q/OW"
    -- >>> let password = B.pack "password"
    -- >>> validatePassword password bcryptHash
    -- >>> True
    -- >>> let otherPassword = B.pack "otherpassword"
    -- >>> otherHash <- hashPassword 12 otherPassword :: IO B.ByteString
    -- >>> validatePassword otherPassword otherHash
    -- >>> True
    --
    -- See <https://www.usenix.org/conference/1999-usenix-annual-technical-conference/future-adaptable-password-scheme>
    -- for details of the original algorithm.
    --
    -- The functions @hashPassword@ and @validatePassword@ should be all that
    -- most users need.
    --
    -- Hashes are strings of the form
    -- @$2a$10$MJJifxfaqQmbx1Mhsq3oq.YmMmfNhkyW4s/MS3K5rIMVfB7w0Q/OW@ which
    -- encode a version number, an integer cost parameter and the concatenated
    -- salt and hash bytes (each separately Base64 encoded. Incrementing the
    -- cost parameter approximately doubles the time taken to calculate the hash.
    --
    -- The different version numbers evolved to account for bugs in the standard
    -- C implementations. They don't represent different versions of the algorithm
    -- itself and in most cases should produce identical results.
    -- The most up to date version is @2b@ and this implementation uses the
    -- @2b@ version prefix, but will also attempt to validate
    -- against hashes with versions @2a@ and @2y@. Version @2@ or @2x@ will be
    -- rejected. No attempt is made to differentiate between the different versions
    -- when validating a password, but in practice this shouldn't cause any problems
    -- if passwords are UTF-8 encoded (which they should be) and less than 256
    -- characters long.
    --
    -- The cost parameter can be between 4 and 31 inclusive, but anything less than
    -- 10 is probably not strong enough. High values may be prohibitively slow
    -- depending on your hardware. Choose the highest value you can without having
    -- an unacceptable impact on your users. The cost parameter can also be varied
    -- depending on the account, since it is unique to an individual hash.

    module Crypto.KDF.BCrypt
        ( hashPassword
        , validatePassword
        , validatePasswordEither
        , bcrypt
        )
    where

    import           Control.Monad                    (forM_, unless, when)
    import           Crypto.Cipher.Blowfish.Primitive (Context, createKeySchedule,
                                                       encrypt, expandKey,
                                                       expandKeyWithSalt,
                                                       freezeKeySchedule)
    import           Crypto.Internal.Compat
    import           Crypto.Random                    (MonadRandom, getRandomBytes)
    import           Data.ByteArray                   (ByteArray, ByteArrayAccess,
                                                       Bytes)
    import qualified Data.ByteArray                   as B
    import           Data.ByteArray.Encoding
    import           Data.Char

    data BCryptHash = BCH Char Int Bytes Bytes

    -- | Create a bcrypt hash for a password with a provided cost value.
    -- Typically used to create a hash when a new user account is registered
    -- or when a user changes their password.
    --
    -- Each increment of the cost approximately doubles the time taken.
    -- The 16 bytes of random salt will be generated internally.
    hashPassword :: (MonadRandom m, ByteArray password, ByteArray hash)
                 => Int
                 -- ^ The cost parameter. Should be between 4 and 31 (inclusive).
                 -- Values which lie outside this range will be adjusted accordingly.
                 -> password
                 -- ^ The password. Should be the UTF-8 encoded bytes of the password text.
                 -> m hash
                 -- ^ The bcrypt hash in standard format.
    hashPassword :: Int -> password -> m hash
    hashPassword cost :: Int
    cost password :: password
    password = do
        Bytes
    salt <- Int -> m Bytes
    forall (m :: * -> *) byteArray.
    (MonadRandom m, ByteArray byteArray) =>
    Int -> m byteArray
    getRandomBytes 16
        hash -> m hash
    forall (m :: * -> *) a. Monad m => a -> m a
    return (hash -> m hash) -> hash -> m hash
    forall a b. (a -> b) -> a -> b
    $ Int -> Bytes -> password -> hash
    forall salt password output.
    (ByteArray salt, ByteArray password, ByteArray output) =>
    Int -> salt -> password -> output
    bcrypt Int
    cost (Bytes
    salt :: Bytes) password
    password

    -- | Create a bcrypt hash for a password with a provided cost value and salt.
    --
    -- Cost value under 4 will be automatically adjusted back to 10 for safety reason.
    bcrypt :: (ByteArray salt, ByteArray password, ByteArray output)
           => Int
           -- ^ The cost parameter. Should be between 4 and 31 (inclusive).
           -- Values which lie outside this range will be adjusted accordingly.
           -> salt
           -- ^ The salt. Must be 16 bytes in length or an error will be raised.
           -> password
           -- ^ The password. Should be the UTF-8 encoded bytes of the password text.
           -> output
           -- ^ The bcrypt hash in standard format.
    bcrypt :: Int -> salt -> password -> output
    bcrypt cost :: Int
    cost salt :: salt
    salt password :: password
    password = [salt] -> output
    forall bin bout.
    (ByteArrayAccess bin, ByteArray bout) =>
    [bin] -> bout
    B.concat [salt
    header, salt -> Word8 -> salt
    forall a. ByteArray a => a -> Word8 -> a
    B.snoc salt
    costBytes Word8
    dollar, salt -> salt
    forall ba. ByteArray ba => ba -> ba
    b64 salt
    salt, salt -> salt
    forall ba. ByteArray ba => ba -> ba
    b64 salt
    hash]
      where
        hash :: salt
    hash   = Char -> Int -> salt -> password -> salt
    forall salt password output.
    (ByteArrayAccess salt, ByteArray password, ByteArray output) =>
    Char -> Int -> salt -> password -> output
    rawHash 'b' Int
    realCost salt
    salt password
    password
        header :: salt
    header = [Word8] -> salt
    forall a. ByteArray a => [Word8] -> a
    B.pack [Word8
    dollar, Int -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Char -> Int
    ord '2'), Int -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Char -> Int
    ord 'b'), Word8
    dollar]
        dollar :: Word8
    dollar = Int -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Char -> Int
    ord '$')
        zero :: Word8
    zero   = Int -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Char -> Int
    ord '0')
        costBytes :: salt
    costBytes  = [Word8] -> salt
    forall a. ByteArray a => [Word8] -> a
    B.pack [Word8
    zero Word8 -> Word8 -> Word8
    forall a. Num a => a -> a -> a
    + Int -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int
    realCost Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` 10), Word8
    zero Word8 -> Word8 -> Word8
    forall a. Num a => a -> a -> a
    + Int -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int
    realCost Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `mod` 10)]
        realCost :: Int
    realCost
            | Int
    cost Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < 4  = 10 -- 4 is virtually pointless so go for 10
            | Int
    cost Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > 31 = 31
            | Bool
    otherwise = Int
    cost

        b64 :: (ByteArray ba) => ba -> ba
        b64 :: ba -> ba
    b64 = Base -> ba -> ba
    forall bin bout.
    (ByteArrayAccess bin, ByteArray bout) =>
    Base -> bin -> bout
    convertToBase Base
    Base64OpenBSD

    -- | Check a password against a stored bcrypt hash when authenticating a user.
    --
    -- Returns @False@ if the password doesn't match the hash, or if the hash is
    -- invalid or an unsupported version.
    validatePassword :: (ByteArray password, ByteArray hash) => password -> hash -> Bool
    validatePassword :: password -> hash -> Bool
    validatePassword password :: password
    password bcHash :: hash
    bcHash = (String -> Bool) -> (Bool -> Bool) -> Either String Bool -> Bool
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either (Bool -> String -> Bool
    forall a b. a -> b -> a
    const Bool
    False) Bool -> Bool
    forall a. a -> a
    id (password -> hash -> Either String Bool
    forall password hash.
    (ByteArray password, ByteArray hash) =>
    password -> hash -> Either String Bool
    validatePasswordEither password
    password hash
    bcHash)

    -- | Check a password against a bcrypt hash
    --
    -- As for @validatePassword@ but will provide error information if the hash is invalid or
    -- an unsupported version.
    validatePasswordEither :: (ByteArray password, ByteArray hash) => password -> hash -> Either String Bool
    validatePasswordEither :: password -> hash -> Either String Bool
    validatePasswordEither password :: password
    password bcHash :: hash
    bcHash = do
        BCH version :: Char
    version cost :: Int
    cost salt :: Bytes
    salt hash :: Bytes
    hash <- hash -> Either String BCryptHash
    forall ba. ByteArray ba => ba -> Either String BCryptHash
    parseBCryptHash hash
    bcHash
        Bool -> Either String Bool
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool -> Either String Bool) -> Bool -> Either String Bool
    forall a b. (a -> b) -> a -> b
    $ (Char -> Int -> Bytes -> password -> Bytes
    forall salt password output.
    (ByteArrayAccess salt, ByteArray password, ByteArray output) =>
    Char -> Int -> salt -> password -> output
    rawHash Char
    version Int
    cost Bytes
    salt password
    password :: Bytes) Bytes -> Bytes -> Bool
    forall bs1 bs2.
    (ByteArrayAccess bs1, ByteArrayAccess bs2) =>
    bs1 -> bs2 -> Bool
    `B.constEq` Bytes
    hash

    rawHash :: (ByteArrayAccess salt, ByteArray password, ByteArray output) => Char -> Int -> salt -> password -> output
    rawHash :: Char -> Int -> salt -> password -> output
    rawHash _ cost :: Int
    cost salt :: salt
    salt password :: password
    password = Int -> output -> output
    forall bs. ByteArray bs => Int -> bs -> bs
    B.take 23 output
    hash -- Another compatibility bug. Ignore last byte of hash
      where
        hash :: output
    hash = Int -> output -> output
    forall t p. (Num t, ByteArray p, Ord t) => t -> p -> p
    loop (0 :: Int) output
    orpheanBeholder

        loop :: t -> p -> p
    loop i :: t
    i input :: p
    input
            | t
    i t -> t -> Bool
    forall a. Ord a => a -> a -> Bool
    < 64    = t -> p -> p
    loop (t
    it -> t -> t
    forall a. Num a => a -> a -> a
    +1) (Context -> p -> p
    forall ba. ByteArray ba => Context -> ba -> ba
    encrypt Context
    ctx p
    input)
            | Bool
    otherwise = p
    input

        -- Truncate the password if necessary and append a null byte for C compatibility
        key :: password
    key = password -> Word8 -> password
    forall a. ByteArray a => a -> Word8 -> a
    B.snoc (Int -> password -> password
    forall bs. ByteArray bs => Int -> bs -> bs
    B.take 72 password
    password) 0

        ctx :: Context
    ctx = password -> salt -> Int -> Context
    forall key salt.
    (ByteArrayAccess key, ByteArrayAccess salt) =>
    key -> salt -> Int -> Context
    expensiveBlowfishContext password
    key salt
    salt Int
    cost

        -- The BCrypt plaintext: "OrpheanBeholderScryDoubt"
        orpheanBeholder :: output
    orpheanBeholder = [Word8] -> output
    forall a. ByteArray a => [Word8] -> a
    B.pack [79,114,112,104,101,97,110,66,101,104,111,108,100,101,114,83,99,114,121,68,111,117,98,116]

    -- "$2a$10$XajjQvNhvvRt5GSeFk1xFeyqRrsxkhBkUiQeg0dt.wU1qD4aFDcga"
    parseBCryptHash :: (ByteArray ba) => ba -> Either String BCryptHash
    parseBCryptHash :: ba -> Either String BCryptHash
    parseBCryptHash bc :: ba
    bc = do
        Bool -> Either String () -> Either String ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (ba -> Int
    forall ba. ByteArrayAccess ba => ba -> Int
    B.length ba
    bc Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == 60      Bool -> Bool -> Bool
    &&
                ba -> Int -> Word8
    forall a. ByteArrayAccess a => a -> Int -> Word8
    B.index ba
    bc 0 Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word8
    dollar Bool -> Bool -> Bool
    &&
                ba -> Int -> Word8
    forall a. ByteArrayAccess a => a -> Int -> Word8
    B.index ba
    bc 1 Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Char -> Int
    ord '2') Bool -> Bool -> Bool
    &&
                ba -> Int -> Word8
    forall a. ByteArrayAccess a => a -> Int -> Word8
    B.index ba
    bc 3 Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word8
    dollar Bool -> Bool -> Bool
    &&
                ba -> Int -> Word8
    forall a. ByteArrayAccess a => a -> Int -> Word8
    B.index ba
    bc 6 Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word8
    dollar) (String -> Either String ()
    forall a b. a -> Either a b
    Left "Invalid hash format")
        Bool -> Either String () -> Either String ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (Char
    version Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == 'b' Bool -> Bool -> Bool
    || Char
    version Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == 'a' Bool -> Bool -> Bool
    || Char
    version Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == 'y') (String -> Either String ()
    forall a b. a -> Either a b
    Left ("Unsupported minor version: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [Char
    version]))
        Bool -> Either String () -> Either String ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Int
    costTens Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > 3 Bool -> Bool -> Bool
    || Int
    cost Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > 31 Bool -> Bool -> Bool
    || Int
    cost Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < 4)  (String -> Either String ()
    forall a b. a -> Either a b
    Left "Invalid bcrypt cost")
        (salt :: Bytes
    salt, hash :: Bytes
    hash) <- ba -> Either String (Bytes, Bytes)
    forall a b bin.
    (ByteArray a, ByteArray b, ByteArray bin) =>
    bin -> Either String (a, b)
    decodeSaltHash (Int -> ba -> ba
    forall bs. ByteArray bs => Int -> bs -> bs
    B.drop 7 ba
    bc)
        BCryptHash -> Either String BCryptHash
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Char -> Int -> Bytes -> Bytes -> BCryptHash
    BCH Char
    version Int
    cost Bytes
    salt Bytes
    hash)
      where
        dollar :: Word8
    dollar    = Int -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Char -> Int
    ord '$')
        zero :: Int
    zero      = Char -> Int
    ord '0'
        costTens :: Int
    costTens  = Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (ba -> Int -> Word8
    forall a. ByteArrayAccess a => a -> Int -> Word8
    B.index ba
    bc 4) Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    zero
        costUnits :: Int
    costUnits = Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (ba -> Int -> Word8
    forall a. ByteArrayAccess a => a -> Int -> Word8
    B.index ba
    bc 5) Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    zero
        version :: Char
    version   = Int -> Char
    chr (Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (ba -> Int -> Word8
    forall a. ByteArrayAccess a => a -> Int -> Word8
    B.index ba
    bc 2))
        cost :: Int
    cost      = Int
    costUnits Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + 10Int -> Int -> Int
    forall a. Num a => a -> a -> a
    *Int
    costTens :: Int

        decodeSaltHash :: bin -> Either String (a, b)
    decodeSaltHash saltHash :: bin
    saltHash = do
            let (s :: bin
    s, h :: bin
    h) = Int -> bin -> (bin, bin)
    forall bs. ByteArray bs => Int -> bs -> (bs, bs)
    B.splitAt 22 bin
    saltHash
            a
    salt <- Base -> bin -> Either String a
    forall bin bout.
    (ByteArrayAccess bin, ByteArray bout) =>
    Base -> bin -> Either String bout
    convertFromBase Base
    Base64OpenBSD bin
    s
            b
    hash <- Base -> bin -> Either String b
    forall bin bout.
    (ByteArrayAccess bin, ByteArray bout) =>
    Base -> bin -> Either String bout
    convertFromBase Base
    Base64OpenBSD bin
    h
            (a, b) -> Either String (a, b)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (a
    salt, b
    hash)

    -- | Create a key schedule for the BCrypt "EKS" version.
    --
    -- Salt must be a 128-bit byte array.
    -- Cost must be between 4 and 31 inclusive
    -- See <https://www.usenix.org/conference/1999-usenix-annual-technical-conference/future-adaptable-password-scheme>
    expensiveBlowfishContext :: (ByteArrayAccess key, ByteArrayAccess salt) => key-> salt -> Int -> Context
    expensiveBlowfishContext :: key -> salt -> Int -> Context
    expensiveBlowfishContext keyBytes :: key
    keyBytes saltBytes :: salt
    saltBytes cost :: Int
    cost
      | salt -> Int
    forall ba. ByteArrayAccess ba => ba -> Int
    B.length salt
    saltBytes Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= 16 = String -> Context
    forall a. HasCallStack => String -> a
    error "bcrypt salt must be 16 bytes"
      | Bool
    otherwise = IO Context -> Context
    forall a. IO a -> a
    unsafeDoIO (IO Context -> Context) -> IO Context -> Context
    forall a b. (a -> b) -> a -> b
    $ do
            KeySchedule
    ks <- IO KeySchedule
    createKeySchedule
            KeySchedule -> key -> salt -> IO ()
    forall key salt.
    (ByteArrayAccess key, ByteArrayAccess salt) =>
    KeySchedule -> key -> salt -> IO ()
    expandKeyWithSalt KeySchedule
    ks key
    keyBytes salt
    saltBytes
            [Int] -> (Int -> IO ()) -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ [1..2Int -> Int -> Int
    forall a b. (Num a, Integral b) => a -> b -> a
    ^Int
    cost :: Int] ((Int -> IO ()) -> IO ()) -> (Int -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \_ -> do
                KeySchedule -> key -> IO ()
    forall key. ByteArrayAccess key => KeySchedule -> key -> IO ()
    expandKey KeySchedule
    ks key
    keyBytes
                KeySchedule -> salt -> IO ()
    forall key. ByteArrayAccess key => KeySchedule -> key -> IO ()
    expandKey KeySchedule
    ks salt
    saltBytes
            KeySchedule -> IO Context
    freezeKeySchedule KeySchedule
    ks