-- |
-- Module      : Crypto.KDF.PBKDF2
-- License     : BSD-style
-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
-- Stability   : experimental
-- Portability : unknown
--
-- Password Based Key Derivation Function 2
--
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ForeignFunctionInterface #-}

module Crypto.KDF.PBKDF2
    ( PRF
    , prfHMAC
    , Parameters(..)
    , generate
    , fastPBKDF2_SHA1
    , fastPBKDF2_SHA256
    , fastPBKDF2_SHA512
    ) where

import           Data.Word
import           Data.Bits
import           Foreign.Marshal.Alloc
import           Foreign.Ptr (plusPtr, Ptr)
import           Foreign.C.Types (CUInt(..), CSize(..))

import           Crypto.Hash (HashAlgorithm)
import qualified Crypto.MAC.HMAC as HMAC

import           Crypto.Internal.ByteArray (ByteArray, ByteArrayAccess, Bytes)
import qualified Crypto.Internal.ByteArray as B
import           Data.Memory.PtrMethods

-- | The PRF used for PBKDF2
type PRF password =
       password -- ^ the password parameters
    -> Bytes    -- ^ the content
    -> Bytes    -- ^ prf(password,content)

-- | PRF for PBKDF2 using HMAC with the hash algorithm as parameter
prfHMAC :: (HashAlgorithm a, ByteArrayAccess password)
        => a
        -> PRF password
prfHMAC :: a -> PRF password
prfHMAC a
alg password
k = a -> Context a -> Bytes -> Bytes
forall a. HashAlgorithm a => a -> Context a -> Bytes -> Bytes
hmacIncr a
alg (password -> Context a
forall key a.
(ByteArrayAccess key, HashAlgorithm a) =>
key -> Context a
HMAC.initialize password
k)
  where hmacIncr :: HashAlgorithm a => a -> HMAC.Context a -> (Bytes -> Bytes)
        hmacIncr :: a -> Context a -> Bytes -> Bytes
hmacIncr a
_ !Context a
ctx = \Bytes
b -> HMAC a -> Bytes
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert (HMAC a -> Bytes) -> HMAC a -> Bytes
forall a b. (a -> b) -> a -> b
$ Context a -> HMAC a
forall a. HashAlgorithm a => Context a -> HMAC a
HMAC.finalize (Context a -> HMAC a) -> Context a -> HMAC a
forall a b. (a -> b) -> a -> b
$ Context a -> Bytes -> Context a
forall message a.
(ByteArrayAccess message, HashAlgorithm a) =>
Context a -> message -> Context a
HMAC.update Context a
ctx Bytes
b

-- | Parameters for PBKDF2
data Parameters = Parameters
    { Parameters -> Int
iterCounts   :: Int -- ^ the number of user-defined iterations for the algorithms. e.g. WPA2 uses 4000.
    , Parameters -> Int
outputLength :: Int -- ^ the number of bytes to generate out of PBKDF2
    }

-- | generate the pbkdf2 key derivation function from the output
generate :: (ByteArrayAccess password, ByteArrayAccess salt, ByteArray ba)
         => PRF password
         -> Parameters
         -> password
         -> salt
         -> ba
generate :: PRF password -> Parameters -> password -> salt -> ba
generate PRF password
prf Parameters
params password
password salt
salt =
    Int -> (Ptr Word8 -> IO ()) -> ba
forall a p. ByteArray a => Int -> (Ptr p -> IO ()) -> a
B.allocAndFreeze (Parameters -> Int
outputLength Parameters
params) ((Ptr Word8 -> IO ()) -> ba) -> (Ptr Word8 -> IO ()) -> ba
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> do
        Ptr Word8 -> Word8 -> Int -> IO ()
memSet Ptr Word8
p Word8
0 (Parameters -> Int
outputLength Parameters
params)
        Word32 -> Int -> Ptr Word8 -> IO ()
loop Word32
1 (Parameters -> Int
outputLength Parameters
params) Ptr Word8
p
  where
    !runPRF :: Bytes -> Bytes
runPRF = PRF password
prf password
password
    !hLen :: Int
hLen   = Bytes -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length (Bytes -> Int) -> Bytes -> Int
forall a b. (a -> b) -> a -> b
$ Bytes -> Bytes
runPRF Bytes
forall a. ByteArray a => a
B.empty

    -- run the following f function on each complete chunk.
    -- when having an incomplete chunk, we call partial.
    -- partial need to be the last call.
    --
    -- f(pass,salt,c,i) = U1 xor U2 xor .. xor Uc
    -- U1 = PRF(pass,salt || BE32(i))
    -- Uc = PRF(pass,Uc-1)
    loop :: Word32 -> Int -> Ptr Word8 -> IO ()
loop Word32
iterNb Int
len Ptr Word8
p
        | Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0   = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
hLen = Word32 -> Int -> Ptr Word8 -> IO ()
partial Word32
iterNb Int
len Ptr Word8
p
        | Bool
otherwise  = do
            let applyMany :: t -> Bytes -> IO ()
applyMany t
0 Bytes
_     = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                applyMany t
i Bytes
uprev = do
                    let uData :: Bytes
uData = Bytes -> Bytes
runPRF Bytes
uprev
                    Bytes -> (Ptr Word8 -> IO ()) -> IO ()
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
B.withByteArray Bytes
uData ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
u -> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> Int -> IO ()
memXor Ptr Word8
p Ptr Word8
p Ptr Word8
u Int
hLen
                    t -> Bytes -> IO ()
applyMany (t
it -> t -> t
forall a. Num a => a -> a -> a
-t
1) Bytes
uData
            Int -> Bytes -> IO ()
forall t. (Eq t, Num t) => t -> Bytes -> IO ()
applyMany (Parameters -> Int
iterCounts Parameters
params) (salt -> Bytes
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert salt
salt Bytes -> Bytes -> Bytes
forall bs. ByteArray bs => bs -> bs -> bs
`B.append` Word32 -> Bytes
forall ba. ByteArray ba => Word32 -> ba
toBS Word32
iterNb)
            Word32 -> Int -> Ptr Word8 -> IO ()
loop (Word32
iterNbWord32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+Word32
1) (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
hLen) (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
hLen)

    partial :: Word32 -> Int -> Ptr Word8 -> IO ()
partial Word32
iterNb Int
len Ptr Word8
p = Int -> Int -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned Int
hLen Int
8 ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
tmp -> do
        let applyMany :: Int -> Bytes -> IO ()
            applyMany :: Int -> Bytes -> IO ()
applyMany Int
0 Bytes
_     = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            applyMany Int
i Bytes
uprev = do
                let uData :: Bytes
uData = Bytes -> Bytes
runPRF Bytes
uprev
                Bytes -> (Ptr Word8 -> IO ()) -> IO ()
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
B.withByteArray Bytes
uData ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
u -> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> Int -> IO ()
memXor Ptr Word8
tmp Ptr Word8
tmp Ptr Word8
u Int
hLen
                Int -> Bytes -> IO ()
applyMany (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Bytes
uData
        Ptr Word8 -> Word8 -> Int -> IO ()
memSet Ptr Word8
tmp Word8
0 Int
hLen
        Int -> Bytes -> IO ()
applyMany (Parameters -> Int
iterCounts Parameters
params) (salt -> Bytes
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert salt
salt Bytes -> Bytes -> Bytes
forall bs. ByteArray bs => bs -> bs -> bs
`B.append` Word32 -> Bytes
forall ba. ByteArray ba => Word32 -> ba
toBS Word32
iterNb)
        Ptr Word8 -> Ptr Word8 -> Int -> IO ()
memCopy Ptr Word8
p Ptr Word8
tmp Int
len

    -- big endian encoding of Word32
    toBS :: ByteArray ba => Word32 -> ba
    toBS :: Word32 -> ba
toBS Word32
w = [Word8] -> ba
forall a. ByteArray a => [Word8] -> a
B.pack [Word8
a,Word8
b,Word8
c,Word8
d]
      where a :: Word8
a = Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
w Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
24)
            b :: Word8
b = Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word32
w Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
16) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0xff)
            c :: Word8
c = Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word32
w Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
8) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0xff)
            d :: Word8
d = Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
w Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0xff)
{-# NOINLINE generate #-}

fastPBKDF2_SHA1 :: (ByteArrayAccess password, ByteArrayAccess salt, ByteArray out)
                => Parameters
                -> password
                -> salt
                -> out
fastPBKDF2_SHA1 :: Parameters -> password -> salt -> out
fastPBKDF2_SHA1 Parameters
params password
password salt
salt =
    Int -> (Ptr Word8 -> IO ()) -> out
forall a p. ByteArray a => Int -> (Ptr p -> IO ()) -> a
B.allocAndFreeze (Parameters -> Int
outputLength Parameters
params) ((Ptr Word8 -> IO ()) -> out) -> (Ptr Word8 -> IO ()) -> out
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
outPtr ->
    password -> (Ptr Word8 -> IO ()) -> IO ()
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
B.withByteArray password
password ((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 ->
        Ptr Word8
-> CSize
-> Ptr Word8
-> CSize
-> CUInt
-> Ptr Word8
-> CSize
-> IO ()
c_cryptonite_fastpbkdf2_hmac_sha1
            Ptr Word8
passPtr (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CSize) -> Int -> CSize
forall a b. (a -> b) -> a -> b
$ password -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length password
password)
            Ptr Word8
saltPtr (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CSize) -> Int -> CSize
forall a b. (a -> b) -> a -> b
$ salt -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length salt
salt)
            (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> Int -> CUInt
forall a b. (a -> b) -> a -> b
$ Parameters -> Int
iterCounts Parameters
params)
            Ptr Word8
outPtr (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CSize) -> Int -> CSize
forall a b. (a -> b) -> a -> b
$ Parameters -> Int
outputLength Parameters
params)

fastPBKDF2_SHA256 :: (ByteArrayAccess password, ByteArrayAccess salt, ByteArray out)
                  => Parameters
                  -> password
                  -> salt
                  -> out
fastPBKDF2_SHA256 :: Parameters -> password -> salt -> out
fastPBKDF2_SHA256 Parameters
params password
password salt
salt =
    Int -> (Ptr Word8 -> IO ()) -> out
forall a p. ByteArray a => Int -> (Ptr p -> IO ()) -> a
B.allocAndFreeze (Parameters -> Int
outputLength Parameters
params) ((Ptr Word8 -> IO ()) -> out) -> (Ptr Word8 -> IO ()) -> out
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
outPtr ->
    password -> (Ptr Word8 -> IO ()) -> IO ()
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
B.withByteArray password
password ((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 ->
        Ptr Word8
-> CSize
-> Ptr Word8
-> CSize
-> CUInt
-> Ptr Word8
-> CSize
-> IO ()
c_cryptonite_fastpbkdf2_hmac_sha256
            Ptr Word8
passPtr (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CSize) -> Int -> CSize
forall a b. (a -> b) -> a -> b
$ password -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length password
password)
            Ptr Word8
saltPtr (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CSize) -> Int -> CSize
forall a b. (a -> b) -> a -> b
$ salt -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length salt
salt)
            (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> Int -> CUInt
forall a b. (a -> b) -> a -> b
$ Parameters -> Int
iterCounts Parameters
params)
            Ptr Word8
outPtr (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CSize) -> Int -> CSize
forall a b. (a -> b) -> a -> b
$ Parameters -> Int
outputLength Parameters
params)

fastPBKDF2_SHA512 :: (ByteArrayAccess password, ByteArrayAccess salt, ByteArray out)
                  => Parameters
                  -> password
                  -> salt
                  -> out
fastPBKDF2_SHA512 :: Parameters -> password -> salt -> out
fastPBKDF2_SHA512 Parameters
params password
password salt
salt =
    Int -> (Ptr Word8 -> IO ()) -> out
forall a p. ByteArray a => Int -> (Ptr p -> IO ()) -> a
B.allocAndFreeze (Parameters -> Int
outputLength Parameters
params) ((Ptr Word8 -> IO ()) -> out) -> (Ptr Word8 -> IO ()) -> out
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
outPtr ->
    password -> (Ptr Word8 -> IO ()) -> IO ()
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
B.withByteArray password
password ((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 ->
        Ptr Word8
-> CSize
-> Ptr Word8
-> CSize
-> CUInt
-> Ptr Word8
-> CSize
-> IO ()
c_cryptonite_fastpbkdf2_hmac_sha512
            Ptr Word8
passPtr (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CSize) -> Int -> CSize
forall a b. (a -> b) -> a -> b
$ password -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length password
password)
            Ptr Word8
saltPtr (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CSize) -> Int -> CSize
forall a b. (a -> b) -> a -> b
$ salt -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length salt
salt)
            (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> Int -> CUInt
forall a b. (a -> b) -> a -> b
$ Parameters -> Int
iterCounts Parameters
params)
            Ptr Word8
outPtr (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CSize) -> Int -> CSize
forall a b. (a -> b) -> a -> b
$ Parameters -> Int
outputLength Parameters
params)


foreign import ccall unsafe "cryptonite_pbkdf2.h cryptonite_fastpbkdf2_hmac_sha1"
    c_cryptonite_fastpbkdf2_hmac_sha1 :: Ptr Word8 -> CSize
                                      -> Ptr Word8 -> CSize
                                      -> CUInt
                                      -> Ptr Word8 -> CSize
                                      -> IO ()

foreign import ccall unsafe "cryptonite_pbkdf2.h cryptonite_fastpbkdf2_hmac_sha256"
    c_cryptonite_fastpbkdf2_hmac_sha256 :: Ptr Word8 -> CSize
                                        -> Ptr Word8 -> CSize
                                        -> CUInt
                                        -> Ptr Word8 -> CSize
                                        -> IO ()

foreign import ccall unsafe "cryptonite_pbkdf2.h cryptonite_fastpbkdf2_hmac_sha512"
    c_cryptonite_fastpbkdf2_hmac_sha512 :: Ptr Word8 -> CSize
                                        -> Ptr Word8 -> CSize
                                        -> CUInt
                                        -> Ptr Word8 -> CSize
                                        -> IO ()