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
, Parameters -> Int
outputLength :: Int
} deriving (Parameters -> Parameters -> Bool
(Parameters -> Parameters -> Bool)
-> (Parameters -> Parameters -> Bool) -> Eq Parameters
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
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
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
$cp1Ord :: Eq 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
showList :: [Parameters] -> ShowS
$cshowList :: [Parameters] -> ShowS
show :: Parameters -> String
$cshow :: Parameters -> String
showsPrec :: Int -> Parameters -> ShowS
$cshowsPrec :: Int -> Parameters -> ShowS
Show)
generate :: (B.ByteArray pass, B.ByteArray salt, B.ByteArray output)
=> Parameters
-> pass
-> salt
-> output
generate :: 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
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
KeySchedule
ksClean <- IO KeySchedule
Blowfish.createKeySchedule
KeySchedule
ksDirty <- IO KeySchedule
Blowfish.createKeySchedule
MutableBlock Word8 RealWorld
ctxMBlock <- CountOf Word8 -> IO (MutableBlock Word8 (PrimState IO))
forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
CountOf ty -> prim (MutableBlock ty (PrimState prim))
Block.newPinned (Int -> CountOf Word8
forall ty. Int -> CountOf ty
CountOf Int
ctxLen :: CountOf Word8)
MutableBlock Word8 RealWorld
outMBlock <- CountOf Word8 -> IO (MutableBlock Word8 (PrimState IO))
forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
CountOf ty -> prim (MutableBlock ty (PrimState prim))
Block.newPinned (Int -> CountOf Word8
forall ty. Int -> CountOf ty
CountOf Int
outLen :: CountOf Word8)
MutableBlock Word8 RealWorld
tmpMBlock <- CountOf Word8 -> IO (MutableBlock Word8 (PrimState IO))
forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
CountOf ty -> prim (MutableBlock ty (PrimState prim))
Block.newPinned (Int -> CountOf Word8
forall ty. Int -> CountOf ty
CountOf Int
tmpLen :: CountOf Word8)
MutableBlock Word8 RealWorld
blkMBlock <- CountOf Word8 -> IO (MutableBlock Word8 (PrimState IO))
forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
CountOf ty -> prim (MutableBlock ty (PrimState prim))
Block.newPinned (Int -> CountOf Word8
forall ty. Int -> CountOf ty
CountOf Int
blkLen :: CountOf Word8)
MutableBlock Word8 RealWorld
passHashMBlock <- CountOf Word8 -> IO (MutableBlock Word8 (PrimState IO))
forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
CountOf ty -> prim (MutableBlock ty (PrimState prim))
Block.newPinned (Int -> CountOf Word8
forall ty. Int -> CountOf ty
CountOf Int
hashLen :: CountOf Word8)
MutableBlock Word8 RealWorld
saltHashMBlock <- CountOf Word8 -> IO (MutableBlock Word8 (PrimState IO))
forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
CountOf ty -> prim (MutableBlock ty (PrimState prim))
Block.newPinned (Int -> CountOf Word8
forall ty. Int -> CountOf ty
CountOf Int
hashLen :: CountOf Word8)
MutableBlock Word8 (PrimState IO) -> IO () -> IO ()
finallyErase MutableBlock Word8 RealWorld
MutableBlock Word8 (PrimState IO)
outMBlock (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ MutableBlock Word8 (PrimState IO) -> IO () -> IO ()
finallyErase MutableBlock Word8 RealWorld
MutableBlock Word8 (PrimState IO)
passHashMBlock (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
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
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
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)
Block Word8
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
[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
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)
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 (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
[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 (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
[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 a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
outPtr Int
outIdx :: IO Word8
Ptr Word8 -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
keyPtr Int
keyIdx Word8
w8
hashInternal :: (B.ByteArrayAccess pass, B.ByteArrayAccess salt, B.ByteArray output)
=> pass
-> salt
-> output
hashInternal :: 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
MutableBlock Word8 RealWorld
outMBlock <- CountOf Word8 -> IO (MutableBlock Word8 (PrimState IO))
forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
CountOf ty -> prim (MutableBlock ty (PrimState prim))
Block.newPinned CountOf Word8
32
KeySchedule
-> pass -> salt -> MutableBlock Word8 (PrimState IO) -> IO ()
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
MutableBlock Word8 (PrimState IO)
outMBlock
Block Word8 -> output
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert (Block Word8 -> output) -> IO (Block Word8) -> IO output
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` MutableBlock Word8 (PrimState IO) -> IO (Block Word8)
forall ty (prim :: * -> *).
(PrimType ty, PrimMonad prim) =>
MutableBlock ty (PrimState prim) -> prim (Block ty)
Block.freeze MutableBlock Word8 RealWorld
MutableBlock Word8 (PrimState IO)
outMBlock
hashInternalMutable :: (B.ByteArrayAccess pass, B.ByteArrayAccess salt)
=> Blowfish.KeySchedule
-> pass
-> salt
-> MutableBlock Word8 (PrimState IO)
-> IO ()
hashInternalMutable :: 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
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 (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 (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