    -- |
    -- Module      : Crypto.KDF.BCryptPBKDF
    -- License     : BSD-style
    -- Stability   : experimental
    -- Portability : Good
    --
    -- Port of the bcrypt_pbkdf key derivation function from OpenBSD
    -- as described at <http://man.openbsd.org/bcrypt_pbkdf.3>.
    module Crypto.KDF.BCryptPBKDF (
        Parameters (..),
        generate,
        hashInternal,
    )
    where

    import Basement.Block (MutableBlock)
    import qualified Basement.Block as Block
    import qualified Basement.Block.Mutable as Block
    import Basement.Monad (PrimState)
    import Basement.Types.OffsetSize (CountOf (..), Offset (..))
    import Control.Exception (finally)
    import Control.Monad (when)
    import qualified Crypto.Cipher.Blowfish.Box as Blowfish
    import qualified Crypto.Cipher.Blowfish.Primitive as Blowfish
    import Crypto.Hash.Algorithms (SHA512 (..))
    import Crypto.Hash.Types (
        Context,
        hashDigestSize,
        hashInternalContextSize,
        hashInternalFinalize,
        hashInternalInit,
        hashInternalUpdate,
     )
    import Crypto.Internal.Compat (unsafeDoIO)
    import Data.Bits
    import qualified Data.ByteArray as B
    import Data.Foldable (forM_)
    import Data.Memory.PtrMethods (memCopy, memSet, memXor)
    import Data.Word
    import Foreign.Ptr (Ptr, castPtr)
    import Foreign.Storable (peekByteOff, pokeByteOff)

    data Parameters = Parameters
        { Parameters -> Int
    iterCounts :: Int
        -- ^ The number of user-defined iterations for the algorithm
        --   (must be > 0)
        , Parameters -> Int
    outputLength :: Int
        -- ^ The number of bytes to generate out of BCryptPBKDF
        --   (must be in 1..1024)
        }
        deriving (Parameters -> Parameters -> Bool
    (Parameters -> Parameters -> Bool)
    -> (Parameters -> Parameters -> Bool) -> Eq Parameters
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Parameters -> Parameters -> Bool
    == :: Parameters -> Parameters -> Bool
    $c/= :: Parameters -> Parameters -> Bool
    /= :: Parameters -> Parameters -> Bool
    Eq, Eq Parameters
    Eq Parameters =>
    (Parameters -> Parameters -> Ordering)
    -> (Parameters -> Parameters -> Bool)
    -> (Parameters -> Parameters -> Bool)
    -> (Parameters -> Parameters -> Bool)
    -> (Parameters -> Parameters -> Bool)
    -> (Parameters -> Parameters -> Parameters)
    -> (Parameters -> Parameters -> Parameters)
    -> Ord Parameters
    Parameters -> Parameters -> Bool
    Parameters -> Parameters -> Ordering
    Parameters -> Parameters -> Parameters
    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 :: Parameters -> Parameters -> Ordering
    compare :: Parameters -> Parameters -> Ordering
    $c< :: Parameters -> Parameters -> Bool
    < :: Parameters -> Parameters -> Bool
    $c<= :: Parameters -> Parameters -> Bool
    <= :: Parameters -> Parameters -> Bool
    $c> :: Parameters -> Parameters -> Bool
    > :: Parameters -> Parameters -> Bool
    $c>= :: Parameters -> Parameters -> Bool
    >= :: Parameters -> Parameters -> Bool
    $cmax :: Parameters -> Parameters -> Parameters
    max :: Parameters -> Parameters -> Parameters
    $cmin :: Parameters -> Parameters -> Parameters
    min :: Parameters -> Parameters -> Parameters
    Ord, Int -> Parameters -> ShowS
    [Parameters] -> ShowS
    Parameters -> String
    (Int -> Parameters -> ShowS)
    -> (Parameters -> String)
    -> ([Parameters] -> ShowS)
    -> Show Parameters
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Parameters -> ShowS
    showsPrec :: Int -> Parameters -> ShowS
    $cshow :: Parameters -> String
    show :: Parameters -> String
    $cshowList :: [Parameters] -> ShowS
    showList :: [Parameters] -> ShowS
    Show)

    -- | Derive a key of specified length using the bcrypt_pbkdf algorithm.
    generate
        :: (B.ByteArray pass, B.ByteArray salt, B.ByteArray output)
        => Parameters
        -> pass
        -> salt
        -> output
    generate :: forall pass salt output.
    (ByteArray pass, ByteArray salt, ByteArray output) =>
    Parameters -> pass -> salt -> output
    generate Parameters
    params pass
    pass salt
    salt
        | Parameters -> Int
    iterCounts Parameters
    params Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    1 = String -> output
    forall a. HasCallStack => String -> a
    error String
    "BCryptPBKDF: iterCounts must be > 0"
        | Int
    keyLen Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    1 Bool -> Bool -> Bool
    || Int
    keyLen Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    1024 =
            String -> output
    forall a. HasCallStack => String -> a
    error String
    "BCryptPBKDF: outputLength must be in 1..1024"
        | Bool
    otherwise = Int -> (Ptr Word8 -> IO ()) -> output
    forall a p. ByteArray a => Int -> (Ptr p -> IO ()) -> a
    B.unsafeCreate Int
    keyLen Ptr Word8 -> IO ()
    deriveKey
      where
        outLen, tmpLen, blkLen, keyLen, passLen, saltLen, ctxLen, hashLen, blocks :: Int
        outLen :: Int
    outLen = Int
    32
        tmpLen :: Int
    tmpLen = Int
    32
        blkLen :: Int
    blkLen = Int
    4
        passLen :: Int
    passLen = pass -> Int
    forall ba. ByteArrayAccess ba => ba -> Int
    B.length pass
    pass
        saltLen :: Int
    saltLen = salt -> Int
    forall ba. ByteArrayAccess ba => ba -> Int
    B.length salt
    salt
        keyLen :: Int
    keyLen = Parameters -> Int
    outputLength Parameters
    params
        ctxLen :: Int
    ctxLen = SHA512 -> Int
    forall a. HashAlgorithm a => a -> Int
    hashInternalContextSize SHA512
    SHA512
        hashLen :: Int
    hashLen = SHA512 -> Int
    forall a. HashAlgorithm a => a -> Int
    hashDigestSize SHA512
    SHA512 -- 64
        blocks :: Int
    blocks = (Int
    keyLen Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    outLen Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1) Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` Int
    outLen

        deriveKey :: Ptr Word8 -> IO ()
        deriveKey :: Ptr Word8 -> IO ()
    deriveKey Ptr Word8
    keyPtr = do
            -- Allocate all necessary memory. The algorihm shall not allocate
            -- any more dynamic memory after this point. Blocks need to be pinned
            -- as pointers to them are passed to the SHA512 implementation.
            ksClean <- IO KeySchedule
    Blowfish.createKeySchedule
            ksDirty <- Blowfish.createKeySchedule
            ctxMBlock <- Block.newPinned (CountOf ctxLen :: CountOf Word8)
            outMBlock <- Block.newPinned (CountOf outLen :: CountOf Word8)
            tmpMBlock <- Block.newPinned (CountOf tmpLen :: CountOf Word8)
            blkMBlock <- Block.newPinned (CountOf blkLen :: CountOf Word8)
            passHashMBlock <- Block.newPinned (CountOf hashLen :: CountOf Word8)
            saltHashMBlock <- Block.newPinned (CountOf hashLen :: CountOf Word8)
            -- Finally erase all memory areas that contain information from
            -- which the derived key could be reconstructed.
            -- As all MutableBlocks are pinned it shall be guaranteed that
            -- no temporary trampoline buffers are allocated.
            finallyErase outMBlock $
                finallyErase passHashMBlock $
                    B.withByteArray pass $ \Ptr Word8
    passPtr ->
                        salt -> (Ptr Word8 -> IO ()) -> IO ()
    forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
    forall p a. salt -> (Ptr p -> IO a) -> IO a
    B.withByteArray salt
    salt ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \Ptr Word8
    saltPtr ->
                            MutableBlock Word8 (PrimState IO) -> (Ptr Word8 -> IO ()) -> IO ()
    forall (prim :: * -> *) ty a.
    PrimMonad prim =>
    MutableBlock ty (PrimState prim) -> (Ptr ty -> prim a) -> prim a
    Block.withMutablePtr MutableBlock Word8 RealWorld
    MutableBlock Word8 (PrimState IO)
    ctxMBlock ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \Ptr Word8
    ctxPtr ->
                                MutableBlock Word8 (PrimState IO) -> (Ptr Word8 -> IO ()) -> IO ()
    forall (prim :: * -> *) ty a.
    PrimMonad prim =>
    MutableBlock ty (PrimState prim) -> (Ptr ty -> prim a) -> prim a
    Block.withMutablePtr MutableBlock Word8 RealWorld
    MutableBlock Word8 (PrimState IO)
    outMBlock ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \Ptr Word8
    outPtr ->
                                    MutableBlock Word8 (PrimState IO) -> (Ptr Word8 -> IO ()) -> IO ()
    forall (prim :: * -> *) ty a.
    PrimMonad prim =>
    MutableBlock ty (PrimState prim) -> (Ptr ty -> prim a) -> prim a
    Block.withMutablePtr MutableBlock Word8 RealWorld
    MutableBlock Word8 (PrimState IO)
    tmpMBlock ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \Ptr Word8
    tmpPtr ->
                                        MutableBlock Word8 (PrimState IO) -> (Ptr Word8 -> IO ()) -> IO ()
    forall (prim :: * -> *) ty a.
    PrimMonad prim =>
    MutableBlock ty (PrimState prim) -> (Ptr ty -> prim a) -> prim a
    Block.withMutablePtr MutableBlock Word8 RealWorld
    MutableBlock Word8 (PrimState IO)
    blkMBlock ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \Ptr Word8
    blkPtr ->
                                            MutableBlock Word8 (PrimState IO) -> (Ptr Word8 -> IO ()) -> IO ()
    forall (prim :: * -> *) ty a.
    PrimMonad prim =>
    MutableBlock ty (PrimState prim) -> (Ptr ty -> prim a) -> prim a
    Block.withMutablePtr MutableBlock Word8 RealWorld
    MutableBlock Word8 (PrimState IO)
    passHashMBlock ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \Ptr Word8
    passHashPtr ->
                                                MutableBlock Word8 (PrimState IO) -> (Ptr Word8 -> IO ()) -> IO ()
    forall (prim :: * -> *) ty a.
    PrimMonad prim =>
    MutableBlock ty (PrimState prim) -> (Ptr ty -> prim a) -> prim a
    Block.withMutablePtr MutableBlock Word8 RealWorld
    MutableBlock Word8 (PrimState IO)
    saltHashMBlock ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \Ptr Word8
    saltHashPtr -> do
                                                    -- Hash the password.
                                                    let shaPtr :: Ptr (Context SHA512)
    shaPtr = Ptr Word8 -> Ptr (Context SHA512)
    forall a b. Ptr a -> Ptr b
    castPtr Ptr Word8
    ctxPtr :: Ptr (Context SHA512)
                                                    Ptr (Context SHA512) -> IO ()
    forall a. HashAlgorithm a => Ptr (Context a) -> IO ()
    hashInternalInit Ptr (Context SHA512)
    shaPtr
                                                    Ptr (Context SHA512) -> Ptr Word8 -> Word32 -> IO ()
    forall a.
    HashAlgorithm a =>
    Ptr (Context a) -> Ptr Word8 -> Word32 -> IO ()
    hashInternalUpdate Ptr (Context SHA512)
    shaPtr Ptr Word8
    passPtr (Int -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    passLen)
                                                    Ptr (Context SHA512) -> Ptr (Digest SHA512) -> IO ()
    forall a.
    HashAlgorithm a =>
    Ptr (Context a) -> Ptr (Digest a) -> IO ()
    hashInternalFinalize Ptr (Context SHA512)
    shaPtr (Ptr Word8 -> Ptr (Digest SHA512)
    forall a b. Ptr a -> Ptr b
    castPtr Ptr Word8
    passHashPtr)
                                                    passHashBlock <- MutableBlock Word8 (PrimState IO) -> IO (Block Word8)
    forall (prim :: * -> *) ty.
    PrimMonad prim =>
    MutableBlock ty (PrimState prim) -> prim (Block ty)
    Block.unsafeFreeze MutableBlock Word8 RealWorld
    MutableBlock Word8 (PrimState IO)
    passHashMBlock
                                                    forM_ [1 .. blocks] $ \Int
    block -> do
                                                        -- Poke the increased block counter.
                                                        MutableBlock Word8 (PrimState IO) -> Offset Word8 -> Word8 -> IO ()
    forall (prim :: * -> *) ty.
    (PrimMonad prim, PrimType ty) =>
    MutableBlock ty (PrimState prim) -> Offset ty -> ty -> prim ()
    Block.unsafeWrite MutableBlock Word8 RealWorld
    MutableBlock Word8 (PrimState IO)
    blkMBlock Offset Word8
    0 (Int -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Word8) -> Int -> Word8
    forall a b. (a -> b) -> a -> b
    $ Int
    block Int -> Int -> Int
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    24)
                                                        MutableBlock Word8 (PrimState IO) -> Offset Word8 -> Word8 -> IO ()
    forall (prim :: * -> *) ty.
    (PrimMonad prim, PrimType ty) =>
    MutableBlock ty (PrimState prim) -> Offset ty -> ty -> prim ()
    Block.unsafeWrite MutableBlock Word8 RealWorld
    MutableBlock Word8 (PrimState IO)
    blkMBlock Offset Word8
    1 (Int -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Word8) -> Int -> Word8
    forall a b. (a -> b) -> a -> b
    $ Int
    block Int -> Int -> Int
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    16)
                                                        MutableBlock Word8 (PrimState IO) -> Offset Word8 -> Word8 -> IO ()
    forall (prim :: * -> *) ty.
    (PrimMonad prim, PrimType ty) =>
    MutableBlock ty (PrimState prim) -> Offset ty -> ty -> prim ()
    Block.unsafeWrite MutableBlock Word8 RealWorld
    MutableBlock Word8 (PrimState IO)
    blkMBlock Offset Word8
    2 (Int -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Word8) -> Int -> Word8
    forall a b. (a -> b) -> a -> b
    $ Int
    block Int -> Int -> Int
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    8)
                                                        MutableBlock Word8 (PrimState IO) -> Offset Word8 -> Word8 -> IO ()
    forall (prim :: * -> *) ty.
    (PrimMonad prim, PrimType ty) =>
    MutableBlock ty (PrimState prim) -> Offset ty -> ty -> prim ()
    Block.unsafeWrite MutableBlock Word8 RealWorld
    MutableBlock Word8 (PrimState IO)
    blkMBlock Offset Word8
    3 (Int -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Word8) -> Int -> Word8
    forall a b. (a -> b) -> a -> b
    $ Int
    block Int -> Int -> Int
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    0)
                                                        -- First round (slightly different).
                                                        Ptr (Context SHA512) -> IO ()
    forall a. HashAlgorithm a => Ptr (Context a) -> IO ()
    hashInternalInit Ptr (Context SHA512)
    shaPtr
                                                        Ptr (Context SHA512) -> Ptr Word8 -> Word32 -> IO ()
    forall a.
    HashAlgorithm a =>
    Ptr (Context a) -> Ptr Word8 -> Word32 -> IO ()
    hashInternalUpdate Ptr (Context SHA512)
    shaPtr Ptr Word8
    saltPtr (Int -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    saltLen)
                                                        Ptr (Context SHA512) -> Ptr Word8 -> Word32 -> IO ()
    forall a.
    HashAlgorithm a =>
    Ptr (Context a) -> Ptr Word8 -> Word32 -> IO ()
    hashInternalUpdate Ptr (Context SHA512)
    shaPtr Ptr Word8
    blkPtr (Int -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    blkLen)
                                                        Ptr (Context SHA512) -> Ptr (Digest SHA512) -> IO ()
    forall a.
    HashAlgorithm a =>
    Ptr (Context a) -> Ptr (Digest a) -> IO ()
    hashInternalFinalize Ptr (Context SHA512)
    shaPtr (Ptr Word8 -> Ptr (Digest SHA512)
    forall a b. Ptr a -> Ptr b
    castPtr Ptr Word8
    saltHashPtr)
                                                        MutableBlock Word8 (PrimState IO) -> IO (Block Word8)
    forall (prim :: * -> *) ty.
    PrimMonad prim =>
    MutableBlock ty (PrimState prim) -> prim (Block ty)
    Block.unsafeFreeze MutableBlock Word8 RealWorld
    MutableBlock Word8 (PrimState IO)
    saltHashMBlock IO (Block Word8) -> (Block Word8 -> IO ()) -> IO ()
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \Block Word8
    x -> do
                                                            KeySchedule -> KeySchedule -> IO ()
    Blowfish.copyKeySchedule KeySchedule
    ksDirty KeySchedule
    ksClean
                                                            KeySchedule
    -> Block Word8
    -> Block Word8
    -> MutableBlock Word8 (PrimState IO)
    -> IO ()
    forall pass salt.
    (ByteArrayAccess pass, ByteArrayAccess salt) =>
    KeySchedule
    -> pass -> salt -> MutableBlock Word8 (PrimState IO) -> IO ()
    hashInternalMutable KeySchedule
    ksDirty Block Word8
    passHashBlock Block Word8
    x MutableBlock Word8 RealWorld
    MutableBlock Word8 (PrimState IO)
    tmpMBlock
                                                        Ptr Word8 -> Ptr Word8 -> Int -> IO ()
    memCopy Ptr Word8
    outPtr Ptr Word8
    tmpPtr Int
    outLen
                                                        -- Remaining rounds.
                                                        [Int] -> (Int -> IO ()) -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ [Int
    2 .. Parameters -> Int
    iterCounts Parameters
    params] ((Int -> IO ()) -> IO ()) -> (Int -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ IO () -> Int -> IO ()
    forall a b. a -> b -> a
    const (IO () -> Int -> IO ()) -> IO () -> Int -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
                                                            Ptr (Context SHA512) -> IO ()
    forall a. HashAlgorithm a => Ptr (Context a) -> IO ()
    hashInternalInit Ptr (Context SHA512)
    shaPtr
                                                            Ptr (Context SHA512) -> Ptr Word8 -> Word32 -> IO ()
    forall a.
    HashAlgorithm a =>
    Ptr (Context a) -> Ptr Word8 -> Word32 -> IO ()
    hashInternalUpdate Ptr (Context SHA512)
    shaPtr Ptr Word8
    tmpPtr (Int -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    tmpLen)
                                                            Ptr (Context SHA512) -> Ptr (Digest SHA512) -> IO ()
    forall a.
    HashAlgorithm a =>
    Ptr (Context a) -> Ptr (Digest a) -> IO ()
    hashInternalFinalize Ptr (Context SHA512)
    shaPtr (Ptr Word8 -> Ptr (Digest SHA512)
    forall a b. Ptr a -> Ptr b
    castPtr Ptr Word8
    saltHashPtr)
                                                            MutableBlock Word8 (PrimState IO) -> IO (Block Word8)
    forall (prim :: * -> *) ty.
    PrimMonad prim =>
    MutableBlock ty (PrimState prim) -> prim (Block ty)
    Block.unsafeFreeze MutableBlock Word8 RealWorld
    MutableBlock Word8 (PrimState IO)
    saltHashMBlock IO (Block Word8) -> (Block Word8 -> IO ()) -> IO ()
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \Block Word8
    x -> do
                                                                KeySchedule -> KeySchedule -> IO ()
    Blowfish.copyKeySchedule KeySchedule
    ksDirty KeySchedule
    ksClean
                                                                KeySchedule
    -> Block Word8
    -> Block Word8
    -> MutableBlock Word8 (PrimState IO)
    -> IO ()
    forall pass salt.
    (ByteArrayAccess pass, ByteArrayAccess salt) =>
    KeySchedule
    -> pass -> salt -> MutableBlock Word8 (PrimState IO) -> IO ()
    hashInternalMutable KeySchedule
    ksDirty Block Word8
    passHashBlock Block Word8
    x MutableBlock Word8 RealWorld
    MutableBlock Word8 (PrimState IO)
    tmpMBlock
                                                            Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> Int -> IO ()
    memXor Ptr Word8
    outPtr Ptr Word8
    outPtr Ptr Word8
    tmpPtr Int
    outLen
                                                        -- Spread the current out buffer evenly over the key buffer.
                                                        -- After both loops have run every byte of the key buffer
                                                        -- will have been written to exactly once and every byte
                                                        -- of the output will have been used.
                                                        [Int] -> (Int -> IO ()) -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ [Int
    0 .. Int
    outLen Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1] ((Int -> IO ()) -> IO ()) -> (Int -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \Int
    outIdx -> do
                                                            let keyIdx :: Int
    keyIdx = Int
    outIdx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    blocks Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    block Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1
                                                            Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Int
    keyIdx Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    keyLen) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
                                                                w8 <- Ptr Word8 -> Int -> IO Word8
    forall b. Ptr b -> Int -> IO Word8
    forall a b. Storable a => Ptr b -> Int -> IO a
    peekByteOff Ptr Word8
    outPtr Int
    outIdx :: IO Word8
                                                                pokeByteOff keyPtr keyIdx w8

    -- | Internal hash function used by `generate`.
    --
    -- Normal users should not need this.
    hashInternal
        :: (B.ByteArrayAccess pass, B.ByteArrayAccess salt, B.ByteArray output)
        => pass
        -> salt
        -> output
    hashInternal :: forall pass salt output.
    (ByteArrayAccess pass, ByteArrayAccess salt, ByteArray output) =>
    pass -> salt -> output
    hashInternal pass
    passHash salt
    saltHash
        | pass -> Int
    forall ba. ByteArrayAccess ba => ba -> Int
    B.length pass
    passHash Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Int
    64 = String -> output
    forall a. HasCallStack => String -> a
    error String
    "passHash must be 512 bits"
        | salt -> Int
    forall ba. ByteArrayAccess ba => ba -> Int
    B.length salt
    saltHash Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Int
    64 = String -> output
    forall a. HasCallStack => String -> a
    error String
    "saltHash must be 512 bits"
        | Bool
    otherwise = IO output -> output
    forall a. IO a -> a
    unsafeDoIO (IO output -> output) -> IO output -> output
    forall a b. (a -> b) -> a -> b
    $ do
            ks0 <- IO KeySchedule
    Blowfish.createKeySchedule
            outMBlock <- Block.newPinned 32
            hashInternalMutable ks0 passHash saltHash outMBlock
            B.convert `fmap` Block.freeze outMBlock

    hashInternalMutable
        :: (B.ByteArrayAccess pass, B.ByteArrayAccess salt)
        => Blowfish.KeySchedule
        -> pass
        -> salt
        -> MutableBlock Word8 (PrimState IO)
        -> IO ()
    hashInternalMutable :: forall pass salt.
    (ByteArrayAccess pass, ByteArrayAccess salt) =>
    KeySchedule
    -> pass -> salt -> MutableBlock Word8 (PrimState IO) -> IO ()
    hashInternalMutable KeySchedule
    bfks pass
    passHash salt
    saltHash MutableBlock Word8 (PrimState IO)
    outMBlock = do
        KeySchedule -> pass -> salt -> IO ()
    forall key salt.
    (ByteArrayAccess key, ByteArrayAccess salt) =>
    KeySchedule -> key -> salt -> IO ()
    Blowfish.expandKeyWithSalt KeySchedule
    bfks pass
    passHash salt
    saltHash
        [Int] -> (Int -> IO ()) -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ [Int
    0 .. Int
    63 :: Int] ((Int -> IO ()) -> IO ()) -> (Int -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ IO () -> Int -> IO ()
    forall a b. a -> b -> a
    const (IO () -> Int -> IO ()) -> IO () -> Int -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
            KeySchedule -> salt -> IO ()
    forall key. ByteArrayAccess key => KeySchedule -> key -> IO ()
    Blowfish.expandKey KeySchedule
    bfks salt
    saltHash
            KeySchedule -> pass -> IO ()
    forall key. ByteArrayAccess key => KeySchedule -> key -> IO ()
    Blowfish.expandKey KeySchedule
    bfks pass
    passHash
        -- "OxychromaticBlowfishSwatDynamite" represented as 4 Word64 in big-endian.
        Offset Word8 -> Word64 -> IO ()
    store Offset Word8
    0 (Word64 -> IO ()) -> IO Word64 -> IO ()
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Int -> Word64 -> IO Word64
    cipher Int
    64 Word64
    0x4f78796368726f6d
        Offset Word8 -> Word64 -> IO ()
    store Offset Word8
    8 (Word64 -> IO ()) -> IO Word64 -> IO ()
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Int -> Word64 -> IO Word64
    cipher Int
    64 Word64
    0x61746963426c6f77
        Offset Word8 -> Word64 -> IO ()
    store Offset Word8
    16 (Word64 -> IO ()) -> IO Word64 -> IO ()
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Int -> Word64 -> IO Word64
    cipher Int
    64 Word64
    0x6669736853776174
        Offset Word8 -> Word64 -> IO ()
    store Offset Word8
    24 (Word64 -> IO ()) -> IO Word64 -> IO ()
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Int -> Word64 -> IO Word64
    cipher Int
    64 Word64
    0x44796e616d697465
      where
        store :: Offset Word8 -> Word64 -> IO ()
        store :: Offset Word8 -> Word64 -> IO ()
    store Offset Word8
    o Word64
    w64 = do
            MutableBlock Word8 (PrimState IO) -> Offset Word8 -> Word8 -> IO ()
    forall (prim :: * -> *) ty.
    (PrimMonad prim, PrimType ty) =>
    MutableBlock ty (PrimState prim) -> Offset ty -> ty -> prim ()
    Block.unsafeWrite MutableBlock Word8 (PrimState IO)
    outMBlock (Offset Word8
    o Offset Word8 -> Offset Word8 -> Offset Word8
    forall a. Num a => a -> a -> a
    + Offset Word8
    0) (Word64 -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word64 -> Word8) -> Word64 -> Word8
    forall a b. (a -> b) -> a -> b
    $ Word64
    w64 Word64 -> Int -> Word64
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    32)
            MutableBlock Word8 (PrimState IO) -> Offset Word8 -> Word8 -> IO ()
    forall (prim :: * -> *) ty.
    (PrimMonad prim, PrimType ty) =>
    MutableBlock ty (PrimState prim) -> Offset ty -> ty -> prim ()
    Block.unsafeWrite MutableBlock Word8 (PrimState IO)
    outMBlock (Offset Word8
    o Offset Word8 -> Offset Word8 -> Offset Word8
    forall a. Num a => a -> a -> a
    + Offset Word8
    1) (Word64 -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word64 -> Word8) -> Word64 -> Word8
    forall a b. (a -> b) -> a -> b
    $ Word64
    w64 Word64 -> Int -> Word64
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    40)
            MutableBlock Word8 (PrimState IO) -> Offset Word8 -> Word8 -> IO ()
    forall (prim :: * -> *) ty.
    (PrimMonad prim, PrimType ty) =>
    MutableBlock ty (PrimState prim) -> Offset ty -> ty -> prim ()
    Block.unsafeWrite MutableBlock Word8 (PrimState IO)
    outMBlock (Offset Word8
    o Offset Word8 -> Offset Word8 -> Offset Word8
    forall a. Num a => a -> a -> a
    + Offset Word8
    2) (Word64 -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word64 -> Word8) -> Word64 -> Word8
    forall a b. (a -> b) -> a -> b
    $ Word64
    w64 Word64 -> Int -> Word64
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    48)
            MutableBlock Word8 (PrimState IO) -> Offset Word8 -> Word8 -> IO ()
    forall (prim :: * -> *) ty.
    (PrimMonad prim, PrimType ty) =>
    MutableBlock ty (PrimState prim) -> Offset ty -> ty -> prim ()
    Block.unsafeWrite MutableBlock Word8 (PrimState IO)
    outMBlock (Offset Word8
    o Offset Word8 -> Offset Word8 -> Offset Word8
    forall a. Num a => a -> a -> a
    + Offset Word8
    3) (Word64 -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word64 -> Word8) -> Word64 -> Word8
    forall a b. (a -> b) -> a -> b
    $ Word64
    w64 Word64 -> Int -> Word64
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    56)
            MutableBlock Word8 (PrimState IO) -> Offset Word8 -> Word8 -> IO ()
    forall (prim :: * -> *) ty.
    (PrimMonad prim, PrimType ty) =>
    MutableBlock ty (PrimState prim) -> Offset ty -> ty -> prim ()
    Block.unsafeWrite MutableBlock Word8 (PrimState IO)
    outMBlock (Offset Word8
    o Offset Word8 -> Offset Word8 -> Offset Word8
    forall a. Num a => a -> a -> a
    + Offset Word8
    4) (Word64 -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word64 -> Word8) -> Word64 -> Word8
    forall a b. (a -> b) -> a -> b
    $ Word64
    w64 Word64 -> Int -> Word64
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    0)
            MutableBlock Word8 (PrimState IO) -> Offset Word8 -> Word8 -> IO ()
    forall (prim :: * -> *) ty.
    (PrimMonad prim, PrimType ty) =>
    MutableBlock ty (PrimState prim) -> Offset ty -> ty -> prim ()
    Block.unsafeWrite MutableBlock Word8 (PrimState IO)
    outMBlock (Offset Word8
    o Offset Word8 -> Offset Word8 -> Offset Word8
    forall a. Num a => a -> a -> a
    + Offset Word8
    5) (Word64 -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word64 -> Word8) -> Word64 -> Word8
    forall a b. (a -> b) -> a -> b
    $ Word64
    w64 Word64 -> Int -> Word64
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    8)
            MutableBlock Word8 (PrimState IO) -> Offset Word8 -> Word8 -> IO ()
    forall (prim :: * -> *) ty.
    (PrimMonad prim, PrimType ty) =>
    MutableBlock ty (PrimState prim) -> Offset ty -> ty -> prim ()
    Block.unsafeWrite MutableBlock Word8 (PrimState IO)
    outMBlock (Offset Word8
    o Offset Word8 -> Offset Word8 -> Offset Word8
    forall a. Num a => a -> a -> a
    + Offset Word8
    6) (Word64 -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word64 -> Word8) -> Word64 -> Word8
    forall a b. (a -> b) -> a -> b
    $ Word64
    w64 Word64 -> Int -> Word64
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    16)
            MutableBlock Word8 (PrimState IO) -> Offset Word8 -> Word8 -> IO ()
    forall (prim :: * -> *) ty.
    (PrimMonad prim, PrimType ty) =>
    MutableBlock ty (PrimState prim) -> Offset ty -> ty -> prim ()
    Block.unsafeWrite MutableBlock Word8 (PrimState IO)
    outMBlock (Offset Word8
    o Offset Word8 -> Offset Word8 -> Offset Word8
    forall a. Num a => a -> a -> a
    + Offset Word8
    7) (Word64 -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word64 -> Word8) -> Word64 -> Word8
    forall a b. (a -> b) -> a -> b
    $ Word64
    w64 Word64 -> Int -> Word64
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    24)
        cipher :: Int -> Word64 -> IO Word64
        cipher :: Int -> Word64 -> IO Word64
    cipher Int
    0 Word64
    block = Word64 -> IO Word64
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Word64
    block
        cipher Int
    i Word64
    block = KeySchedule -> Word64 -> IO Word64
    Blowfish.cipherBlockMutable KeySchedule
    bfks Word64
    block IO Word64 -> (Word64 -> IO Word64) -> IO Word64
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Int -> Word64 -> IO Word64
    cipher (Int
    i Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1)

    finallyErase :: MutableBlock Word8 (PrimState IO) -> IO () -> IO ()
    finallyErase :: MutableBlock Word8 (PrimState IO) -> IO () -> IO ()
    finallyErase MutableBlock Word8 (PrimState IO)
    mblock IO ()
    action =
        IO ()
    action IO () -> IO () -> IO ()
    forall a b. IO a -> IO b -> IO a
    `finally` MutableBlock Word8 (PrimState IO) -> (Ptr Word8 -> IO ()) -> IO ()
    forall (prim :: * -> *) ty a.
    PrimMonad prim =>
    MutableBlock ty (PrimState prim) -> (Ptr ty -> prim a) -> prim a
    Block.withMutablePtr MutableBlock Word8 (PrimState IO)
    mblock (\Ptr Word8
    ptr -> Ptr Word8 -> Word8 -> Int -> IO ()
    memSet Ptr Word8
    ptr Word8
    0 Int
    len)
      where
        CountOf Int
    len = MutableBlock Word8 RealWorld -> CountOf Word8
    forall ty st. MutableBlock ty st -> CountOf Word8
    Block.mutableLengthBytes MutableBlock Word8 RealWorld
    MutableBlock Word8 (PrimState IO)
    mblock