add PBKDF2

Crypto/KDF/PBKDF2.hs

@@ -0,0 +1,90 @@
+{-# LANGUAGE BangPatterns       #-}
+-- |
+-- Module      : Crypto.KDF.PBKDF2
+-- License     : BSD-style
+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
+-- Stability   : experimental
+-- Portability : unknown
+--
+-- Password Based Key Derivation Function 2
+--
+module Crypto.KDF.PBKDF2
+    ( PRF
+    , prfHMAC
+    , Parameters(..)
+    , generate
+    ) where
+
+import Data.Word
+import Data.Bits
+import Data.ByteString (ByteString)
+import qualified Data.ByteString as B
+import qualified Data.ByteString.Internal as B (unsafeCreate, memset)
+import Data.Byteable
+import Foreign.Storable
+import Foreign.Ptr (Ptr, plusPtr)
+import Control.Applicative
+import Control.Monad (forM_, void)
+
+import Crypto.Hash (HashAlgorithm)
+import qualified Crypto.MAC.HMAC as HMAC
+
+-- | The PRF used for PBKDF2
+type PRF = B.ByteString -- ^ the password parameters
+        -> B.ByteString -- ^ the content
+        -> B.ByteString -- ^ prf(password,content)
+
+-- | PRF for PBKDF2 using HMAC with the hash algorithm as parameter
+prfHMAC :: HashAlgorithm a
+        => a   -- ^ the Hash Algorithm to use with HMAC
+        -> PRF -- ^ the PRF functiont o use
+prfHMAC alg k = hmacIncr alg (HMAC.initialize k)
+  where hmacIncr :: HashAlgorithm a => a -> HMAC.Context a -> (ByteString -> ByteString)
+        hmacIncr _ !ctx = \b -> toBytes $ HMAC.finalize $ HMAC.update ctx b
+
+-- | Parameters for PBKDF2
+data Parameters = Parameters
+    { password     :: ByteString
+    , salt         :: ByteString
+    , iterCounts   :: Int
+    , outputLength :: Int
+    }
+
+-- | generate the pbkdf2 key derivation function from the output
+generate :: PRF -> Parameters -> B.ByteString
+generate prf params =
+    B.take (outputLength params) $ B.concat $ map f [1..l]
+  where
+    !runPRF = prf (password params)
+    !hLen   = B.length $ runPRF B.empty
+    
+    -- f(pass,salt,c,i) = U1 xor U2 xor .. xor Uc
+    -- U1 = PRF(pass,salt || BE32(i))
+    -- Uc = PRF(pass,Uc-1)
+    f iterNb   = B.unsafeCreate hLen $ \dst -> do
+        let applyMany 0 _     = return ()
+            applyMany i uprev =
+                let u = runPRF uprev
+                 in bsXor dst u >> applyMany (i-1) u
+        void $ B.memset dst 0 (fromIntegral hLen)
+        applyMany (iterCounts params) (salt params `B.append` toBS iterNb)
+
+    -- a mutable version of xor, that allow to not reallocate
+    -- the accumulate buffer.
+    bsXor :: Ptr Word8 -> ByteString -> IO ()
+    bsXor d sBs = withBytePtr sBs $ \s ->
+        forM_ [0..hLen-1] $ \i -> do
+            v <- xor <$> peek (s `plusPtr` i) <*> peek (d `plusPtr` i)
+            poke (d `plusPtr` i) (v :: Word8)
+
+    -- count the number of blocks necessary
+    l = let (q,rema) = (outputLength params) `divMod` hLen
+         in fromIntegral (q + if rema > 0 then 1 else 0)
+    
+    -- big endian encoding of Word32
+    toBS :: Word32 -> ByteString
+    toBS w = B.pack [a,b,c,d]
+      where a = fromIntegral (w `shiftR` 24)
+            b = fromIntegral ((w `shiftR` 16) .&. 0xff)
+            c = fromIntegral ((w `shiftR` 8) .&. 0xff)
+            d = fromIntegral (w .&. 0xff)

cryptonite.cabal

@@ -24,6 +24,7 @@ Library
                      Crypto.Cipher.Salsa
                      Crypto.MAC.Poly1305
                      Crypto.MAC.HMAC
+                     Crypto.KDF.PBKDF2
                      Crypto.Hash
                      Crypto.Hash.SHA1
                      Crypto.Hash.SHA224

tests/KAT_PBKDF2.hs

@@ -1,17 +1,21 @@
 {-# LANGUAGE OverloadedStrings #-}
 
 -- from <http://www.ietf.org/rfc/rfc6070.txt>
-module KAT_PBKDF2 (vectors) where
+module KAT_PBKDF2 (tests) where
+
+import Crypto.Hash (SHA1(..), SHA256(..))
+import qualified Crypto.KDF.PBKDF2 as PBKDF2
 
 import Data.ByteString (ByteString)
-import qualified Data.ByteString as B
 import Data.ByteString.Char8 ()
 
+import Test.Tasty
+import Test.Tasty.HUnit
+
 type VectParams = (ByteString, ByteString, Int, Int)
 
--- PBKDF-HMAC-SHA1
-vectors :: [ (VectParams, ByteString) ]
-vectors =
+vectors_hmac_sha1 :: [ (VectParams, ByteString) ]
+vectors_hmac_sha1 =
     [
         ( ("password","salt",2,20)
         , "\xea\x6c\x01\x4d\xc7\x2d\x6f\x8c\xcd\x1e\xd9\x2a\xce\x1d\x41\xf0\xd8\xde\x89\x57"
@@ -28,4 +32,23 @@ vectors =
         )
     ]
 
+vectors_hmac_sha256 =
+    [   ( ("password", "salt", 2, 32)
+        , "\xae\x4d\x0c\x95\xaf\x6b\x46\xd3\x2d\x0a\xdf\xf9\x28\xf0\x6d\xd0\x2a\x30\x3f\x8e\xf3\xc2\x51\xdf\xd6\xe2\xd8\x5a\x95\x47\x4c\x43"
+        )
+    ,   ( ("passwordPASSWORDpassword", "saltSALTsaltSALTsaltSALTsaltSALTsalt", 4096, 40)
+        , "\x34\x8c\x89\xdb\xcb\xd3\x2b\x2f\x32\xd8\x14\xb8\x11\x6e\x84\xcf\x2b\x17\x34\x7e\xbc\x18\x00\x18\x1c\x4e\x2a\x1f\xb8\xdd\x53\xe1\xc6\x35\x51\x8c\x7d\xac\x47\xe9"
+        )
+    ]
 
+tests = testGroup "PBKDF2"
+    [ testGroup "KATs-HMAC-SHA1" (katTests (PBKDF2.prfHMAC SHA1) vectors_hmac_sha1)
+    , testGroup "KATs-HMAC-SHA256" (katTests (PBKDF2.prfHMAC SHA256) vectors_hmac_sha256)
+    ]
+  where katTests prf vects = map (toKatTest prf) $ zip is vects
+
+        toKatTest prf (i, ((pass, salt, iter, dkLen), output)) =
+            testCase (show i) (output @=? PBKDF2.generate prf (PBKDF2.Parameters pass salt iter dkLen))
+
+        is :: [Int]
+        is = [1..]

tests/Tests.hs

@@ -70,6 +70,7 @@ tests = testGroup "cryptonite"
         ]
     , KATHash.tests
     , KAT_HMAC.tests
+    , KAT_PBKDF2.tests
     ]
   where chachaRunSimple expected rounds klen nonceLen =
             let chacha = ChaCha.initialize rounds (B.replicate klen 0) (B.replicate nonceLen 0)