Scrypt.hs

{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ForeignFunctionInterface #-}

-- |
-- 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>.
module Crypto.KDF.Scrypt (
    Parameters (..),
    generate,
    tryGenerate,
) where

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

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

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

foreign import ccall "crypton_scrypt_smix"
    ccrypton_scrypt_smix
        :: Ptr Word8 -> Word32 -> Word64 -> Ptr Word8 -> Ptr Word8 -> IO ()

-- | Generate the scrypt key derivation data
--
-- Parameters the implementation refuses raise a 'CryptoError'; 'tryGenerate'
-- reports the same condition as 'CryptoFailed'.
generate
    :: (ByteArrayAccess password, ByteArrayAccess salt, ByteArray output)
    => Parameters
    -> password
    -> salt
    -> output
generate params password salt = throwCryptoError (tryGenerate params password salt)

-- | Generate the scrypt key derivation data, reporting parameters the
-- implementation refuses rather than raising.
--
-- @n@ has to be a power of two greater than 1, @r@ and @p@ positive, @r@
-- times @p@ below 2^30, and the 128 * @r@ * @n@ bytes of working memory
-- addressable.
tryGenerate
    :: (ByteArrayAccess password, ByteArrayAccess salt, ByteArray output)
    => Parameters
    -> password
    -> salt
    -> CryptoFailable output
tryGenerate params password salt
    | not (validParameters params) = CryptoFailed CryptoError_ParameterInvalid
    | otherwise = CryptoPassed $ unsafeDoIO $ do
        let b = PBKDF2.generate prf (PBKDF2.Parameters 1 intLen) password salt :: B.Bytes
        newSalt <- B.copy b $ \bPtr ->
            allocaBytesAligned (128 * (fromIntegral $ n params) * (r params)) 8 $ \v ->
                allocaBytesAligned (256 * r params + 64) 8 $ \xy -> do
                    forM_ [0 .. (p params - 1)] $ \i ->
                        ccrypton_scrypt_smix
                            (bPtr `plusPtr` (i * 128 * (r params)))
                            (fromIntegral $ r params)
                            (n params)
                            v
                            xy

        return $
            PBKDF2.generate
                prf
                (PBKDF2.Parameters 1 (outputLength params))
                password
                (newSalt :: B.Bytes)
  where
    prf = PBKDF2.prfHMAC SHA256
    intLen = p params * 128 * r params
{-# NOINLINE tryGenerate #-}

-- Checked in Integer, so that no product can wrap before it is compared.
validParameters :: Parameters -> Bool
validParameters params =
    n params >= 2
        && popCount (n params) == 1
        && r' >= 1
        && p' >= 1
        && r' * p' < 0x40000000
        && 128 * r' * n' <= maxInt
        && 128 * r' * p' <= maxInt
  where
    n' = toInteger (n params)
    r' = toInteger (r params)
    p' = toInteger (p params)
    maxInt = toInteger (maxBound :: Int)