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_iterative :: (B.ByteString -> B.ByteString -> B.ByteString)
-> B.ByteString
-> B.ByteString
-> Integer
-> B.ByteString
pbkdf2_iterative prf password salt iterations = B.concat $ pbkdf2' (B.pack []) 1
where
hash' = prf password
pbkdf2' :: B.ByteString -> Bin.Word32 -> [B.ByteString]
pbkdf2' i c = let prev = (pbkdf2'' (hash' $ B.concat [i, salt, B.pack $ octetsBE c])) in prev:(pbkdf2' (prf prev i) (c + 1))
pbkdf2'' hash = pbkdf2''' hash hash 1
pbkdf2''' prev_hash prev_result i
| i == iterations = prev_result
| i > iterations = error "Count must be at least 1"
| otherwise = pbkdf2''' current_hash result (i + 1)
where
current_hash = (hash' prev_hash)
result = xorByteStrings current_hash prev_result
pbkdf2 :: (B.ByteString -> B.ByteString -> B.ByteString)
-> B.ByteString
-> B.ByteString
-> Integer
-> B.ByteString
pbkdf2 prf password salt iterations = B.concat $ pbkdf2' 1 True
where
hash' = prf password
pbkdf2' :: Bin.Word32 -> Bool -> [B.ByteString]
pbkdf2' 1 False = error "Hashing algorithm looped, stopping to maintain security of data"
pbkdf2' i _ = (pbkdf2'' (hash' $ B.concat [salt, B.pack $ octetsBE i])):(pbkdf2' (i + 1) False)
pbkdf2'' hash = pbkdf2''' hash hash 1
pbkdf2''' prev_hash prev_result i
| i == iterations = prev_result
| i > iterations = error "Count must be at least 1"
| otherwise = pbkdf2''' current_hash result (i + 1)
where
current_hash = (hash' prev_hash)
result = xorByteStrings current_hash prev_result