1-- |
2-- Module      : Crypto.KDF.PBKDF2
3-- License     : BSD-style
4-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
5-- Stability   : experimental
6-- Portability : unknown
7--
8-- Password Based Key Derivation Function 2
9--
10{-# LANGUAGE BangPatterns #-}
11{-# LANGUAGE ForeignFunctionInterface #-}
12
13module Crypto.KDF.PBKDF2
14    ( PRF
15    , prfHMAC
16    , Parameters(..)
17    , generate
18    , fastPBKDF2_SHA1
19    , fastPBKDF2_SHA256
20    , fastPBKDF2_SHA512
21    ) where
22
23import           Data.Word
24import           Data.Bits
25import           Foreign.Marshal.Alloc
26import           Foreign.Ptr (plusPtr, Ptr)
27import           Foreign.C.Types (CUInt(..), CSize(..))
28
29import           Crypto.Hash (HashAlgorithm)
30import qualified Crypto.MAC.HMAC as HMAC
31
32import           Crypto.Internal.ByteArray (ByteArray, ByteArrayAccess, Bytes)
33import qualified Crypto.Internal.ByteArray as B
34import           Data.Memory.PtrMethods
35
36-- | The PRF used for PBKDF2
37type PRF password =
38       password -- ^ the password parameters
39    -> Bytes    -- ^ the content
40    -> Bytes    -- ^ prf(password,content)
41
42-- | PRF for PBKDF2 using HMAC with the hash algorithm as parameter
43prfHMAC :: (HashAlgorithm a, ByteArrayAccess password)
44        => a
45        -> PRF password
46prfHMAC alg k = hmacIncr alg (HMAC.initialize k)
47  where hmacIncr :: HashAlgorithm a => a -> HMAC.Context a -> (Bytes -> Bytes)
48        hmacIncr _ !ctx = \b -> B.convert $ HMAC.finalize $ HMAC.update ctx b
49
50-- | Parameters for PBKDF2
51data Parameters = Parameters
52    { iterCounts   :: Int -- ^ the number of user-defined iterations for the algorithms. e.g. WPA2 uses 4000.
53    , outputLength :: Int -- ^ the number of bytes to generate out of PBKDF2
54    }
55
56-- | generate the pbkdf2 key derivation function from the output
57generate :: (ByteArrayAccess password, ByteArrayAccess salt, ByteArray ba)
58         => PRF password
59         -> Parameters
60         -> password
61         -> salt
62         -> ba
63generate prf params password salt =
64    B.allocAndFreeze (outputLength params) $ \p -> do
65        memSet p 0 (outputLength params)
66        loop 1 (outputLength params) p
67  where
68    !runPRF = prf password
69    !hLen   = B.length $ runPRF B.empty
70
71    -- run the following f function on each complete chunk.
72    -- when having an incomplete chunk, we call partial.
73    -- partial need to be the last call.
74    --
75    -- f(pass,salt,c,i) = U1 xor U2 xor .. xor Uc
76    -- U1 = PRF(pass,salt || BE32(i))
77    -- Uc = PRF(pass,Uc-1)
78    loop iterNb len p
79        | len == 0   = return ()
80        | len < hLen = partial iterNb len p
81        | otherwise  = do
82            let applyMany 0 _     = return ()
83                applyMany i uprev = do
84                    let uData = runPRF uprev
85                    B.withByteArray uData $ \u -> memXor p p u hLen
86                    applyMany (i-1) uData
87            applyMany (iterCounts params) (B.convert salt `B.append` toBS iterNb)
88            loop (iterNb+1) (len - hLen) (p `plusPtr` hLen)
89
90    partial iterNb len p = allocaBytesAligned hLen 8 $ \tmp -> do
91        let applyMany :: Int -> Bytes -> IO ()
92            applyMany 0 _     = return ()
93            applyMany i uprev = do
94                let uData = runPRF uprev
95                B.withByteArray uData $ \u -> memXor tmp tmp u hLen
96                applyMany (i-1) uData
97        memSet tmp 0 hLen
98        applyMany (iterCounts params) (B.convert salt `B.append` toBS iterNb)
99        memCopy p tmp len
100
101    -- big endian encoding of Word32
102    toBS :: ByteArray ba => Word32 -> ba
103    toBS w = B.pack [a,b,c,d]
104      where a = fromIntegral (w `shiftR` 24)
105            b = fromIntegral ((w `shiftR` 16) .&. 0xff)
106            c = fromIntegral ((w `shiftR` 8) .&. 0xff)
107            d = fromIntegral (w .&. 0xff)
108{-# NOINLINE generate #-}
109
110fastPBKDF2_SHA1 :: (ByteArrayAccess password, ByteArrayAccess salt, ByteArray out)
111                => Parameters
112                -> password
113                -> salt
114                -> out
115fastPBKDF2_SHA1 params password salt =
116    B.allocAndFreeze (outputLength params) $ \outPtr ->
117    B.withByteArray password $ \passPtr ->
118    B.withByteArray salt $ \saltPtr ->
119        c_cryptonite_fastpbkdf2_hmac_sha1
120            passPtr (fromIntegral $ B.length password)
121            saltPtr (fromIntegral $ B.length salt)
122            (fromIntegral $ iterCounts params)
123            outPtr (fromIntegral $ outputLength params)
124
125fastPBKDF2_SHA256 :: (ByteArrayAccess password, ByteArrayAccess salt, ByteArray out)
126                  => Parameters
127                  -> password
128                  -> salt
129                  -> out
130fastPBKDF2_SHA256 params password salt =
131    B.allocAndFreeze (outputLength params) $ \outPtr ->
132    B.withByteArray password $ \passPtr ->
133    B.withByteArray salt $ \saltPtr ->
134        c_cryptonite_fastpbkdf2_hmac_sha256
135            passPtr (fromIntegral $ B.length password)
136            saltPtr (fromIntegral $ B.length salt)
137            (fromIntegral $ iterCounts params)
138            outPtr (fromIntegral $ outputLength params)
139
140fastPBKDF2_SHA512 :: (ByteArrayAccess password, ByteArrayAccess salt, ByteArray out)
141                  => Parameters
142                  -> password
143                  -> salt
144                  -> out
145fastPBKDF2_SHA512 params password salt =
146    B.allocAndFreeze (outputLength params) $ \outPtr ->
147    B.withByteArray password $ \passPtr ->
148    B.withByteArray salt $ \saltPtr ->
149        c_cryptonite_fastpbkdf2_hmac_sha512
150            passPtr (fromIntegral $ B.length password)
151            saltPtr (fromIntegral $ B.length salt)
152            (fromIntegral $ iterCounts params)
153            outPtr (fromIntegral $ outputLength params)
154
155
156foreign import ccall unsafe "cryptonite_pbkdf2.h cryptonite_fastpbkdf2_hmac_sha1"
157    c_cryptonite_fastpbkdf2_hmac_sha1 :: Ptr Word8 -> CSize
158                                      -> Ptr Word8 -> CSize
159                                      -> CUInt
160                                      -> Ptr Word8 -> CSize
161                                      -> IO ()
162
163foreign import ccall unsafe "cryptonite_pbkdf2.h cryptonite_fastpbkdf2_hmac_sha256"
164    c_cryptonite_fastpbkdf2_hmac_sha256 :: Ptr Word8 -> CSize
165                                        -> Ptr Word8 -> CSize
166                                        -> CUInt
167                                        -> Ptr Word8 -> CSize
168                                        -> IO ()
169
170foreign import ccall unsafe "cryptonite_pbkdf2.h cryptonite_fastpbkdf2_hmac_sha512"
171    c_cryptonite_fastpbkdf2_hmac_sha512 :: Ptr Word8 -> CSize
172                                        -> Ptr Word8 -> CSize
173                                        -> CUInt
174                                        -> Ptr Word8 -> CSize
175                                        -> IO ()
176