module Crypto.Pbkdf2 (pbkdf2, pbkdf2_iterative) where
import Data.Bits (shiftR)
import Data.Bits(xor)
import qualified Data.ByteString.Lazy as B
import qualified Data.Binary as Bin
octetsBE :: Bin.Word32 -> [Bin.Word8]
octetsBE w =
[ fromIntegral (w `shiftR` 24)
, fromIntegral (w `shiftR` 16)
, fromIntegral (w `shiftR` 8)
, fromIntegral w
]
xorByteStrings x y
| B.length x == B.length y = B.pack $ B.zipWith xor x y
| otherwise = error "xor bytestrings are not of equal length"
pbkdf2_internal createBlocks prf password salt iterations = B.concat $ createBlocks $ first_iteration . hash'
where
hash' = prf password
first_iteration hash = additional_iterations hash hash 1
additional_iterations prev_hash prev_result i
| i == iterations = prev_result
| i > iterations = error "Count must be at least 1"
| otherwise = additional_iterations current_hash result (i + 1)
where
current_hash = (hash' prev_hash)
result = xorByteStrings current_hash prev_result
pbkdf2_iterative :: (B.ByteString -> B.ByteString -> B.ByteString)
-> B.ByteString
-> B.ByteString
-> Integer
-> B.ByteString
pbkdf2_iterative prf password salt iterations = pbkdf2_internal (createBlocks (B.pack []) 1) prf password salt iterations
where
createBlocks :: B.ByteString -> Bin.Word32 -> (B.ByteString -> B.ByteString) -> [B.ByteString]
createBlocks blockSalt i hash = let prev = (hash $ B.concat [blockSalt, salt, B.pack $ octetsBE i])
in prev:(createBlocks (prf prev blockSalt) (i + 1) hash)
pbkdf2 :: (B.ByteString -> B.ByteString -> B.ByteString)
-> B.ByteString
-> B.ByteString
-> Integer
-> B.ByteString
pbkdf2 prf password salt iterations = pbkdf2_internal (createBlocks True 1) prf password salt iterations
where
createBlocks :: Bool -> Bin.Word32 -> (B.ByteString -> B.ByteString) -> [B.ByteString]
createBlocks False 1 _ = error "Hashing algorithm looped, stopping to maintain security of data"
createBlocks _ i hash = (hash $ B.concat [salt, B.pack $ octetsBE i]):(createBlocks False (i + 1) hash)