-- |
-- 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 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 qualified Data.ByteString.Internal as BSI
import Data.Foldable (forM_)
import Data.Memory.PtrMethods (memCopy, memSet, memXor)
import Data.Word
import Foreign.ForeignPtr (ForeignPtr, mallocForeignPtrBytes, withForeignPtr)
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 algorithm shall not allocate
        -- any more dynamic memory after this point. ForeignPtrs allocate
        -- pinned memory, so raw pointers to them are stable.
        KeySchedule
ksClean      <- IO KeySchedule
Blowfish.createKeySchedule
        KeySchedule
ksDirty      <- IO KeySchedule
Blowfish.createKeySchedule
        ForeignPtr Word8
ctxFP        <- Int -> IO (ForeignPtr Word8)
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes Int
ctxLen  :: IO (ForeignPtr Word8)
        ForeignPtr Word8
outFP        <- Int -> IO (ForeignPtr Word8)
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes Int
outLen  :: IO (ForeignPtr Word8)
        ForeignPtr Word8
tmpFP        <- Int -> IO (ForeignPtr Word8)
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes Int
tmpLen  :: IO (ForeignPtr Word8)
        ForeignPtr Word8
blkFP        <- Int -> IO (ForeignPtr Word8)
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes Int
blkLen  :: IO (ForeignPtr Word8)
        ForeignPtr Word8
passHashFP   <- Int -> IO (ForeignPtr Word8)
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes Int
hashLen :: IO (ForeignPtr Word8)
        ForeignPtr Word8
saltHashFP   <- Int -> IO (ForeignPtr Word8)
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes Int
hashLen :: IO (ForeignPtr Word8)
        -- Finally erase all memory areas that contain information from
        -- which the derived key could be reconstructed.
        ForeignPtr Word8 -> Int -> IO () -> IO ()
finallyErase ForeignPtr Word8
outFP Int
outLen (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
            ForeignPtr Word8 -> Int -> IO () -> IO ()
finallyErase ForeignPtr Word8
passHashFP Int
hashLen (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                pass -> (Ptr Word8 -> IO ()) -> IO ()
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
forall p a. pass -> (Ptr p -> IO a) -> IO a
B.withByteArray pass
pass ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \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 ->
                        ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
ctxFP      ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ctxPtr'     ->
                        ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
outFP      ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
outPtr      ->
                        ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
tmpFP      ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
tmpPtr      ->
                        ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
blkFP      ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
blkPtr      ->
                        ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
passHashFP ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
passHashPtr ->
                        ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
saltHashFP ((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)
                            -- Create a stable ByteString view of the password hash
                            -- (passHashFP is not modified after this point).
                            let passHashBS :: ByteString
passHashBS = ForeignPtr Word8 -> Int -> Int -> ByteString
BSI.fromForeignPtr ForeignPtr Word8
passHashFP Int
0 Int
hashLen
                            [Int] -> (Int -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
1 .. Int
blocks] ((Int -> IO ()) -> IO ()) -> (Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Int
block -> do
                                -- Poke the increased block counter.
                                Ptr Word8 -> Int -> Word8 -> IO ()
forall b. Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
blkPtr Int
0 (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
block Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
24) :: Word8)
                                Ptr Word8 -> Int -> Word8 -> IO ()
forall b. Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
blkPtr Int
1 (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
block Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
16) :: Word8)
                                Ptr Word8 -> Int -> Word8 -> IO ()
forall b. Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
blkPtr Int
2 (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
block Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
8) :: Word8)
                                Ptr Word8 -> Int -> Word8 -> IO ()
forall b. Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
blkPtr Int
3 (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
block Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
0 :: Int) :: Word8)
                                -- 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)
                                let saltHashBS :: ByteString
saltHashBS = ForeignPtr Word8 -> Int -> Int -> ByteString
BSI.fromForeignPtr ForeignPtr Word8
saltHashFP Int
0 Int
hashLen
                                KeySchedule -> KeySchedule -> IO ()
Blowfish.copyKeySchedule KeySchedule
ksDirty KeySchedule
ksClean
                                KeySchedule -> ByteString -> ByteString -> Ptr Word8 -> IO ()
forall pass salt.
(ByteArrayAccess pass, ByteArrayAccess salt) =>
KeySchedule -> pass -> salt -> Ptr Word8 -> IO ()
hashInternalMutable KeySchedule
ksDirty ByteString
passHashBS ByteString
saltHashBS Ptr Word8
tmpPtr
                                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)
                                    let saltHashBS2 :: ByteString
saltHashBS2 = ForeignPtr Word8 -> Int -> Int -> ByteString
BSI.fromForeignPtr ForeignPtr Word8
saltHashFP Int
0 Int
hashLen
                                    KeySchedule -> KeySchedule -> IO ()
Blowfish.copyKeySchedule KeySchedule
ksDirty KeySchedule
ksClean
                                    KeySchedule -> ByteString -> ByteString -> Ptr Word8 -> IO ()
forall pass salt.
(ByteArrayAccess pass, ByteArrayAccess salt) =>
KeySchedule -> pass -> salt -> Ptr Word8 -> IO ()
hashInternalMutable KeySchedule
ksDirty ByteString
passHashBS ByteString
saltHashBS2 Ptr Word8
tmpPtr
                                    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
                                        Word8
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
                                        Ptr Word8 -> Int -> Word8 -> IO ()
forall b. Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
keyPtr Int
keyIdx Word8
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
        KeySchedule
ks0 <- IO KeySchedule
Blowfish.createKeySchedule
        Int -> (Ptr Word8 -> IO ()) -> IO output
forall ba p. ByteArray ba => Int -> (Ptr p -> IO ()) -> IO ba
B.alloc Int
32 ((Ptr Word8 -> IO ()) -> IO output)
-> (Ptr Word8 -> IO ()) -> IO output
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
outPtr -> KeySchedule -> pass -> salt -> Ptr Word8 -> IO ()
forall pass salt.
(ByteArrayAccess pass, ByteArrayAccess salt) =>
KeySchedule -> pass -> salt -> Ptr Word8 -> IO ()
hashInternalMutable KeySchedule
ks0 pass
passHash salt
saltHash Ptr Word8
outPtr

hashInternalMutable
    :: (B.ByteArrayAccess pass, B.ByteArrayAccess salt)
    => Blowfish.KeySchedule
    -> pass
    -> salt
    -> Ptr Word8
    -> IO ()
hashInternalMutable :: forall pass salt.
(ByteArrayAccess pass, ByteArrayAccess salt) =>
KeySchedule -> pass -> salt -> Ptr Word8 -> IO ()
hashInternalMutable KeySchedule
bfks pass
passHash salt
saltHash Ptr Word8
outPtr = 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.
    Int -> Word64 -> IO ()
store Int
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
    Int -> Word64 -> IO ()
store Int
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
    Int -> Word64 -> IO ()
store Int
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
    Int -> Word64 -> IO ()
store Int
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 :: Int -> Word64 -> IO ()
    store :: Int -> Word64 -> IO ()
store Int
o Word64
w64 = do
        Ptr Word8 -> Int -> Word8 -> IO ()
forall b. Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
outPtr (Int
o Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0) (Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
w64 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
32) :: Word8)
        Ptr Word8 -> Int -> Word8 -> IO ()
forall b. Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
outPtr (Int
o Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
w64 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
40) :: Word8)
        Ptr Word8 -> Int -> Word8 -> IO ()
forall b. Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
outPtr (Int
o Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) (Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
w64 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
48) :: Word8)
        Ptr Word8 -> Int -> Word8 -> IO ()
forall b. Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
outPtr (Int
o Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3) (Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
w64 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
56) :: Word8)
        Ptr Word8 -> Int -> Word8 -> IO ()
forall b. Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
outPtr (Int
o Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4) (Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
w64 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
0)  :: Word8)
        Ptr Word8 -> Int -> Word8 -> IO ()
forall b. Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
outPtr (Int
o Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
5) (Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
w64 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
8)  :: Word8)
        Ptr Word8 -> Int -> Word8 -> IO ()
forall b. Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
outPtr (Int
o Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
6) (Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
w64 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
16) :: Word8)
        Ptr Word8 -> Int -> Word8 -> IO ()
forall b. Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
outPtr (Int
o Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
7) (Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
w64 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
24) :: Word8)
    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 :: ForeignPtr Word8 -> Int -> IO () -> IO ()
finallyErase :: ForeignPtr Word8 -> Int -> IO () -> IO ()
finallyErase ForeignPtr Word8
fp Int
len IO ()
action =
    IO ()
action IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
`finally` ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fp (\Ptr Word8
ptr -> Ptr Word8 -> Word8 -> Int -> IO ()
memSet Ptr Word8
ptr Word8
0 Int
len)