-- |
-- 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Parameters -> Parameters -> Bool
$c/= :: Parameters -> Parameters -> Bool
== :: Parameters -> Parameters -> Bool
$c== :: Parameters -> Parameters -> Bool
Eq, Eq 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
min :: Parameters -> Parameters -> Parameters
$cmin :: Parameters -> Parameters -> Parameters
max :: Parameters -> Parameters -> Parameters
$cmax :: Parameters -> Parameters -> Parameters
>= :: Parameters -> Parameters -> Bool
$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
compare :: Parameters -> Parameters -> Ordering
$ccompare :: Parameters -> Parameters -> Ordering
Ord, Int -> Parameters -> ShowS
[Parameters] -> ShowS
Parameters -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Parameters] -> ShowS
$cshowList :: [Parameters] -> ShowS
show :: Parameters -> String
$cshow :: Parameters -> String
showsPrec :: Int -> Parameters -> ShowS
$cshowsPrec :: Int -> 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 forall a. Ord a => a -> a -> Bool
< Int
1       = forall a. HasCallStack => String -> a
error String
"BCryptPBKDF: iterCounts must be > 0"
    | Int
keyLen forall a. Ord a => a -> a -> Bool
< Int
1 Bool -> Bool -> Bool
|| Int
keyLen forall a. Ord a => a -> a -> Bool
> Int
1024 = forall a. HasCallStack => String -> a
error String
"BCryptPBKDF: outputLength must be in 1..1024"
    | Bool
otherwise                   = 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 = forall ba. ByteArrayAccess ba => ba -> Int
B.length pass
pass
    saltLen :: Int
saltLen = forall ba. ByteArrayAccess ba => ba -> Int
B.length salt
salt
    keyLen :: Int
keyLen  = Parameters -> Int
outputLength Parameters
params
    ctxLen :: Int
ctxLen  = forall a. HashAlgorithm a => a -> Int
hashInternalContextSize SHA512
SHA512
    hashLen :: Int
hashLen = forall a. HashAlgorithm a => a -> Int
hashDigestSize SHA512
SHA512 -- 64
    blocks :: Int
blocks  = (Int
keyLen forall a. Num a => a -> a -> a
+ Int
outLen forall a. Num a => a -> a -> a
- Int
1) 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.
        KeySchedule
ksClean        <- IO KeySchedule
Blowfish.createKeySchedule
        KeySchedule
ksDirty        <- IO KeySchedule
Blowfish.createKeySchedule
        MutableBlock Word8 RealWorld
ctxMBlock      <- forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
CountOf ty -> prim (MutableBlock ty (PrimState prim))
Block.newPinned (forall ty. Int -> CountOf ty
CountOf Int
ctxLen  :: CountOf Word8)
        MutableBlock Word8 RealWorld
outMBlock      <- forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
CountOf ty -> prim (MutableBlock ty (PrimState prim))
Block.newPinned (forall ty. Int -> CountOf ty
CountOf Int
outLen  :: CountOf Word8)
        MutableBlock Word8 RealWorld
tmpMBlock      <- forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
CountOf ty -> prim (MutableBlock ty (PrimState prim))
Block.newPinned (forall ty. Int -> CountOf ty
CountOf Int
tmpLen  :: CountOf Word8)
        MutableBlock Word8 RealWorld
blkMBlock      <- forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
CountOf ty -> prim (MutableBlock ty (PrimState prim))
Block.newPinned (forall ty. Int -> CountOf ty
CountOf Int
blkLen  :: CountOf Word8)
        MutableBlock Word8 RealWorld
passHashMBlock <- forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
CountOf ty -> prim (MutableBlock ty (PrimState prim))
Block.newPinned (forall ty. Int -> CountOf ty
CountOf Int
hashLen :: CountOf Word8)
        MutableBlock Word8 RealWorld
saltHashMBlock <- forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
CountOf ty -> prim (MutableBlock ty (PrimState prim))
Block.newPinned (forall ty. Int -> CountOf ty
CountOf Int
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.
        MutableBlock Word8 (PrimState IO) -> IO () -> IO ()
finallyErase MutableBlock Word8 RealWorld
outMBlock forall a b. (a -> b) -> a -> b
$ MutableBlock Word8 (PrimState IO) -> IO () -> IO ()
finallyErase MutableBlock Word8 RealWorld
passHashMBlock forall a b. (a -> b) -> a -> b
$
            forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
B.withByteArray pass
pass                forall a b. (a -> b) -> a -> b
$ \Ptr Word8
passPtr->
            forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
B.withByteArray salt
salt                forall a b. (a -> b) -> a -> b
$ \Ptr Word8
saltPtr->
            forall (prim :: * -> *) ty a.
PrimMonad prim =>
MutableBlock ty (PrimState prim) -> (Ptr ty -> prim a) -> prim a
Block.withMutablePtr MutableBlock Word8 RealWorld
ctxMBlock      forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ctxPtr->
            forall (prim :: * -> *) ty a.
PrimMonad prim =>
MutableBlock ty (PrimState prim) -> (Ptr ty -> prim a) -> prim a
Block.withMutablePtr MutableBlock Word8 RealWorld
outMBlock      forall a b. (a -> b) -> a -> b
$ \Ptr Word8
outPtr->
            forall (prim :: * -> *) ty a.
PrimMonad prim =>
MutableBlock ty (PrimState prim) -> (Ptr ty -> prim a) -> prim a
Block.withMutablePtr MutableBlock Word8 RealWorld
tmpMBlock      forall a b. (a -> b) -> a -> b
$ \Ptr Word8
tmpPtr->
            forall (prim :: * -> *) ty a.
PrimMonad prim =>
MutableBlock ty (PrimState prim) -> (Ptr ty -> prim a) -> prim a
Block.withMutablePtr MutableBlock Word8 RealWorld
blkMBlock      forall a b. (a -> b) -> a -> b
$ \Ptr Word8
blkPtr->
            forall (prim :: * -> *) ty a.
PrimMonad prim =>
MutableBlock ty (PrimState prim) -> (Ptr ty -> prim a) -> prim a
Block.withMutablePtr MutableBlock Word8 RealWorld
passHashMBlock forall a b. (a -> b) -> a -> b
$ \Ptr Word8
passHashPtr->
            forall (prim :: * -> *) ty a.
PrimMonad prim =>
MutableBlock ty (PrimState prim) -> (Ptr ty -> prim a) -> prim a
Block.withMutablePtr MutableBlock Word8 RealWorld
saltHashMBlock forall a b. (a -> b) -> a -> b
$ \Ptr Word8
saltHashPtr-> do
                -- Hash the password.
                let shaPtr :: Ptr (Context SHA512)
shaPtr = forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
ctxPtr :: Ptr (Context SHA512)
                forall a. HashAlgorithm a => Ptr (Context a) -> IO ()
hashInternalInit     Ptr (Context SHA512)
shaPtr
                forall a.
HashAlgorithm a =>
Ptr (Context a) -> Ptr Word8 -> Word32 -> IO ()
hashInternalUpdate   Ptr (Context SHA512)
shaPtr Ptr Word8
passPtr (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
passLen)
                forall a.
HashAlgorithm a =>
Ptr (Context a) -> Ptr (Digest a) -> IO ()
hashInternalFinalize Ptr (Context SHA512)
shaPtr (forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
passHashPtr)
                Block Word8
passHashBlock <- forall (prim :: * -> *) ty.
PrimMonad prim =>
MutableBlock ty (PrimState prim) -> prim (Block ty)
Block.unsafeFreeze MutableBlock Word8 RealWorld
passHashMBlock
                forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
1..Int
blocks] forall a b. (a -> b) -> a -> b
$ \Int
block-> do
                    -- Poke the increased block counter.
                    forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
MutableBlock ty (PrimState prim) -> Offset ty -> ty -> prim ()
Block.unsafeWrite MutableBlock Word8 RealWorld
blkMBlock Offset Word8
0 (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Int
block forall a. Bits a => a -> Int -> a
`shiftR` Int
24)
                    forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
MutableBlock ty (PrimState prim) -> Offset ty -> ty -> prim ()
Block.unsafeWrite MutableBlock Word8 RealWorld
blkMBlock Offset Word8
1 (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Int
block forall a. Bits a => a -> Int -> a
`shiftR` Int
16)
                    forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
MutableBlock ty (PrimState prim) -> Offset ty -> ty -> prim ()
Block.unsafeWrite MutableBlock Word8 RealWorld
blkMBlock Offset Word8
2 (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Int
block forall a. Bits a => a -> Int -> a
`shiftR`  Int
8)
                    forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
MutableBlock ty (PrimState prim) -> Offset ty -> ty -> prim ()
Block.unsafeWrite MutableBlock Word8 RealWorld
blkMBlock Offset Word8
3 (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Int
block forall a. Bits a => a -> Int -> a
`shiftR`  Int
0)
                    -- First round (slightly different).
                    forall a. HashAlgorithm a => Ptr (Context a) -> IO ()
hashInternalInit     Ptr (Context SHA512)
shaPtr
                    forall a.
HashAlgorithm a =>
Ptr (Context a) -> Ptr Word8 -> Word32 -> IO ()
hashInternalUpdate   Ptr (Context SHA512)
shaPtr Ptr Word8
saltPtr (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
saltLen)
                    forall a.
HashAlgorithm a =>
Ptr (Context a) -> Ptr Word8 -> Word32 -> IO ()
hashInternalUpdate   Ptr (Context SHA512)
shaPtr Ptr Word8
blkPtr  (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
blkLen)
                    forall a.
HashAlgorithm a =>
Ptr (Context a) -> Ptr (Digest a) -> IO ()
hashInternalFinalize Ptr (Context SHA512)
shaPtr (forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
saltHashPtr)
                    forall (prim :: * -> *) ty.
PrimMonad prim =>
MutableBlock ty (PrimState prim) -> prim (Block ty)
Block.unsafeFreeze MutableBlock Word8 RealWorld
saltHashMBlock 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
                        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
tmpMBlock
                    Ptr Word8 -> Ptr Word8 -> Int -> IO ()
memCopy Ptr Word8
outPtr Ptr Word8
tmpPtr Int
outLen
                    -- Remaining rounds.
                    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
2..Parameters -> Int
iterCounts Parameters
params] forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ do
                        forall a. HashAlgorithm a => Ptr (Context a) -> IO ()
hashInternalInit     Ptr (Context SHA512)
shaPtr
                        forall a.
HashAlgorithm a =>
Ptr (Context a) -> Ptr Word8 -> Word32 -> IO ()
hashInternalUpdate   Ptr (Context SHA512)
shaPtr Ptr Word8
tmpPtr (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
tmpLen)
                        forall a.
HashAlgorithm a =>
Ptr (Context a) -> Ptr (Digest a) -> IO ()
hashInternalFinalize Ptr (Context SHA512)
shaPtr (forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
saltHashPtr)
                        forall (prim :: * -> *) ty.
PrimMonad prim =>
MutableBlock ty (PrimState prim) -> prim (Block ty)
Block.unsafeFreeze MutableBlock Word8 RealWorld
saltHashMBlock 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
                            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
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.
                    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
0..Int
outLen forall a. Num a => a -> a -> a
- Int
1] forall a b. (a -> b) -> a -> b
$ \Int
outIdx-> do
                        let keyIdx :: Int
keyIdx = Int
outIdx forall a. Num a => a -> a -> a
* Int
blocks forall a. Num a => a -> a -> a
+ Int
block forall a. Num a => a -> a -> a
- Int
1
                        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
keyIdx forall a. Ord a => a -> a -> Bool
< Int
keyLen) forall a b. (a -> b) -> a -> b
$ do
                            Word8
w8 <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
outPtr Int
outIdx :: IO Word8
                            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
    | forall ba. ByteArrayAccess ba => ba -> Int
B.length pass
passHash forall a. Eq a => a -> a -> Bool
/= Int
64 = forall a. HasCallStack => String -> a
error String
"passHash must be 512 bits"
    | forall ba. ByteArrayAccess ba => ba -> Int
B.length salt
saltHash forall a. Eq a => a -> a -> Bool
/= Int
64 = forall a. HasCallStack => String -> a
error String
"saltHash must be 512 bits"
    | Bool
otherwise = forall a. IO a -> a
unsafeDoIO forall a b. (a -> b) -> a -> b
$ do
        KeySchedule
ks0 <- IO KeySchedule
Blowfish.createKeySchedule
        MutableBlock Word8 RealWorld
outMBlock <- forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
CountOf ty -> prim (MutableBlock ty (PrimState prim))
Block.newPinned CountOf Word8
32
        forall pass salt.
(ByteArrayAccess pass, ByteArrayAccess salt) =>
KeySchedule
-> pass -> salt -> MutableBlock Word8 (PrimState IO) -> IO ()
hashInternalMutable KeySchedule
ks0 pass
passHash salt
saltHash MutableBlock Word8 RealWorld
outMBlock
        forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall ty (prim :: * -> *).
(PrimType ty, PrimMonad prim) =>
MutableBlock ty (PrimState prim) -> prim (Block ty)
Block.freeze MutableBlock Word8 RealWorld
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
    forall key salt.
(ByteArrayAccess key, ByteArrayAccess salt) =>
KeySchedule -> key -> salt -> IO ()
Blowfish.expandKeyWithSalt KeySchedule
bfks pass
passHash salt
saltHash
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
0..Int
63 :: Int] forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ do
        forall key. ByteArrayAccess key => KeySchedule -> key -> IO ()
Blowfish.expandKey KeySchedule
bfks salt
saltHash
        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 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 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 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 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
            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 forall a. Num a => a -> a -> a
+ Offset Word8
0) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Word64
w64 forall a. Bits a => a -> Int -> a
`shiftR` Int
32)
            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 forall a. Num a => a -> a -> a
+ Offset Word8
1) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Word64
w64 forall a. Bits a => a -> Int -> a
`shiftR` Int
40)
            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 forall a. Num a => a -> a -> a
+ Offset Word8
2) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Word64
w64 forall a. Bits a => a -> Int -> a
`shiftR` Int
48)
            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 forall a. Num a => a -> a -> a
+ Offset Word8
3) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Word64
w64 forall a. Bits a => a -> Int -> a
`shiftR` Int
56)
            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 forall a. Num a => a -> a -> a
+ Offset Word8
4) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Word64
w64 forall a. Bits a => a -> Int -> a
`shiftR`  Int
0)
            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 forall a. Num a => a -> a -> a
+ Offset Word8
5) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Word64
w64 forall a. Bits a => a -> Int -> a
`shiftR`  Int
8)
            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 forall a. Num a => a -> a -> a
+ Offset Word8
6) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Word64
w64 forall a. Bits a => a -> Int -> a
`shiftR` Int
16)
            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 forall a. Num a => a -> a -> a
+ Offset Word8
7) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Word64
w64 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 = 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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Word64 -> IO Word64
cipher (Int
i 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 forall a b. IO a -> IO b -> IO a
`finally` 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 = forall ty st. MutableBlock ty st -> CountOf Word8
Block.mutableLengthBytes MutableBlock Word8 (PrimState IO)
mblock