-- |
-- Module      : Crypto.KDF.Scrypt
-- License     : BSD-style
-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
-- Stability   : experimental
-- Portability : unknown
--
-- Scrypt key derivation function as defined in Colin Percival's paper
-- "Stronger Key Derivation via Sequential Memory-Hard Functions"
-- <http://www.tarsnap.com/scrypt/scrypt.pdf>.
--
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ForeignFunctionInterface #-}
module Crypto.KDF.Scrypt
    ( Parameters(..)
    , generate
    ) where

import           Data.Word
import           Foreign.Marshal.Alloc
import           Foreign.Ptr (Ptr, plusPtr)
import           Control.Monad (forM_)

import           Crypto.Hash (SHA256(..))
import qualified Crypto.KDF.PBKDF2 as PBKDF2
import           Crypto.Internal.Compat (popCount, unsafeDoIO)
import           Crypto.Internal.ByteArray (ByteArray, ByteArrayAccess)
import qualified Crypto.Internal.ByteArray as B

-- | Parameters for Scrypt
data Parameters = Parameters
    { Parameters -> Word64
n            :: Word64 -- ^ Cpu/Memory cost ratio. must be a power of 2 greater than 1. also known as N.
    , Parameters -> Int
r            :: Int    -- ^ Must satisfy r * p < 2^30
    , Parameters -> Int
p            :: Int    -- ^ Must satisfy r * p < 2^30
    , Parameters -> Int
outputLength :: Int    -- ^ the number of bytes to generate out of Scrypt
    }

foreign import ccall "cryptonite_scrypt_smix"
    ccryptonite_scrypt_smix :: Ptr Word8 -> Word32 -> Word64 -> Ptr Word8 -> Ptr Word8 -> IO ()

-- | Generate the scrypt key derivation data
generate :: (ByteArrayAccess password, ByteArrayAccess salt, ByteArray output)
         => Parameters
         -> password
         -> salt
         -> output
generate :: Parameters -> password -> salt -> output
generate Parameters
params password
password salt
salt
    | Parameters -> Int
r Parameters
params Int -> Int -> Int
forall a. Num a => a -> a -> a
* Parameters -> Int
p Parameters
params Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0x40000000 =
        [Char] -> output
forall a. HasCallStack => [Char] -> a
error [Char]
"Scrypt: invalid parameters: r and p constraint"
    | Word64 -> Int
forall a. Bits a => a -> Int
popCount (Parameters -> Word64
n Parameters
params) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
1 =
        [Char] -> output
forall a. HasCallStack => [Char] -> a
error [Char]
"Scrypt: invalid parameters: n not a power of 2"
    | Bool
otherwise = IO output -> output
forall a. IO a -> a
unsafeDoIO (IO output -> output) -> IO output -> output
forall a b. (a -> b) -> a -> b
$ do
        let b :: Bytes
b = PRF password -> Parameters -> password -> salt -> Bytes
forall password salt ba.
(ByteArrayAccess password, ByteArrayAccess salt, ByteArray ba) =>
PRF password -> Parameters -> password -> salt -> ba
PBKDF2.generate PRF password
prf (Int -> Int -> Parameters
PBKDF2.Parameters Int
1 Int
intLen) password
password salt
salt :: B.Bytes
        Bytes
newSalt <- Bytes -> (Ptr Any -> IO ()) -> IO Bytes
forall bs1 bs2 p.
(ByteArrayAccess bs1, ByteArray bs2) =>
bs1 -> (Ptr p -> IO ()) -> IO bs2
B.copy Bytes
b ((Ptr Any -> IO ()) -> IO Bytes) -> (Ptr Any -> IO ()) -> IO Bytes
forall a b. (a -> b) -> a -> b
$ \Ptr Any
bPtr ->
            Int -> Int -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned (Int
128Int -> Int -> Int
forall a. Num a => a -> a -> a
*(Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int) -> Word64 -> Int
forall a b. (a -> b) -> a -> b
$ Parameters -> Word64
n Parameters
params)Int -> Int -> Int
forall a. Num a => a -> a -> a
*(Parameters -> Int
r Parameters
params)) Int
8 ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
v ->
            Int -> Int -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned (Int
256Int -> Int -> Int
forall a. Num a => a -> a -> a
*Parameters -> Int
r Parameters
params Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
64) Int
8 ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
xy -> do
                [Int] -> (Int -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
0..(Parameters -> Int
p Parameters
paramsInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)] ((Int -> IO ()) -> IO ()) -> (Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Int
i ->
                    Ptr Word8 -> Word32 -> Word64 -> Ptr Word8 -> Ptr Word8 -> IO ()
ccryptonite_scrypt_smix (Ptr Any
bPtr Ptr Any -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
128 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Parameters -> Int
r Parameters
params)))
                                            (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ Parameters -> Int
r Parameters
params) (Parameters -> Word64
n Parameters
params) Ptr Word8
v Ptr Word8
xy

        output -> IO output
forall (m :: * -> *) a. Monad m => a -> m a
return (output -> IO output) -> output -> IO output
forall a b. (a -> b) -> a -> b
$ PRF password -> Parameters -> password -> Bytes -> output
forall password salt ba.
(ByteArrayAccess password, ByteArrayAccess salt, ByteArray ba) =>
PRF password -> Parameters -> password -> salt -> ba
PBKDF2.generate PRF password
prf (Int -> Int -> Parameters
PBKDF2.Parameters Int
1 (Parameters -> Int
outputLength Parameters
params)) password
password (Bytes
newSalt :: B.Bytes)
  where prf :: PRF password
prf    = SHA256 -> PRF password
forall a password.
(HashAlgorithm a, ByteArrayAccess password) =>
a -> PRF password
PBKDF2.prfHMAC SHA256
SHA256
        intLen :: Int
intLen = Parameters -> Int
p Parameters
params Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
128 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Parameters -> Int
r Parameters
params
{-# NOINLINE generate #-}