|
| 1 | +{-# LANGUAGE ForeignFunctionInterface, RecordWildCards, NamedFieldPuns #-} |
| 2 | + |
| 3 | +-- |Scrypt is a sequential memory-hard key derivation function. This module |
| 4 | +-- provides bindings to a fast C implementation of scrypt, written by Colin |
| 5 | +-- Percival. See <http://www.tarsnap.com/scrypt.html> for more information |
| 6 | +-- on scrypt. |
| 7 | +module Crypto.Scrypt |
| 8 | + ( |
| 9 | + -- *Parameters to the @scrypt@ function |
| 10 | + ScryptParams, params, defaultParams |
| 11 | + -- * The @scrypt@ key derivation function |
| 12 | + , scrypt, getSalt |
| 13 | + , Pass(..), Salt(..), PassHash(..) |
| 14 | + ) where |
| 15 | + |
| 16 | +import Control.Applicative ((<$>)) |
| 17 | +import Data.ByteString |
| 18 | +import Data.Maybe |
| 19 | +import Foreign |
| 20 | +import Foreign.C |
| 21 | +import System.IO |
| 22 | + |
| 23 | + |
| 24 | +newtype Pass = Pass ByteString deriving (Show) |
| 25 | +newtype Salt = Salt ByteString deriving (Show) |
| 26 | +newtype PassHash = PassHash ByteString deriving (Show,Eq) |
| 27 | + |
| 28 | +-- |Encapsulates the three tuning parameters to the 'scrypt' function: @N@, |
| 29 | +-- @r@ and @p@. The parameters affect running time and memory usage: |
| 30 | +-- |
| 31 | +-- /Memory usage/ is approximately @128*r*N@ bytes. Note that the |
| 32 | +-- 'params' function takes @log_2(N)@ as a parameter. As an example, the |
| 33 | +-- 'defaultParams' |
| 34 | +-- |
| 35 | +-- @ log_2(N) = 14, r = 8, and p = 1@ |
| 36 | +-- |
| 37 | +-- lead to 'scrypt' using @128 * 8 * 2^14 = 16M@ bytes of memory. |
| 38 | +-- |
| 39 | +-- /Running time/ is proportional to all of @N@, @r@ and @p@. However |
| 40 | +-- @p@ only as an insignificant influence on memory usage an can thus be |
| 41 | +-- used to tune the running time of 'scrypt'. |
| 42 | +-- |
| 43 | +data ScryptParams = Params { logN, r, p, bufLen :: Integer} |
| 44 | + |
| 45 | +-- |Constructor function for the 'ScryptParams' data type |
| 46 | +params :: Integer |
| 47 | + -- ^ @log_2(N)@. Scrypt's @N@ parameter must be a power of two greater |
| 48 | + -- than one, thus it's logarithm to base two must be greater than zero. |
| 49 | + -> Integer |
| 50 | + -- ^ The parameter @r@, an integer greater than zero. |
| 51 | + -> Integer |
| 52 | + -- ^ The parameter @p@, an integer greater than zero. @r@ and @p@ |
| 53 | + -- must satisfy @r * p < 2^30@. |
| 54 | + -> Maybe ScryptParams |
| 55 | + -- ^ Returns 'Just' the parameter object for valid arguments, |
| 56 | + -- otherwise 'Nothing'. |
| 57 | +params logN r p | valid = Just ps |
| 58 | + | otherwise = Nothing |
| 59 | + where |
| 60 | + ps = Params { logN, r, p, bufLen = 64 } |
| 61 | + valid = and [ logN > 0, r > 0, p > 0 |
| 62 | + , r*p < 2^(30 :: Int) |
| 63 | + , bufLen ps <= 2^(32 :: Int)-1 * 32 |
| 64 | + ] |
| 65 | + |
| 66 | +-- |Default parameters as recommended in the scrypt paper: |
| 67 | +-- |
| 68 | +-- @ N = 2^14, r = 8, p = 1 @ |
| 69 | +-- |
| 70 | +-- Equivalent to @'fromJust' ('params' 14 8 1)@. |
| 71 | +defaultParams :: ScryptParams |
| 72 | +defaultParams = fromJust (params 14 8 1) |
| 73 | + |
| 74 | +-- |Reads a 32-byte random salt from @\/dev\/urandom@. |
| 75 | +getSalt :: IO Salt |
| 76 | +getSalt = Salt <$> withBinaryFile "/dev/urandom" ReadMode (flip hGet 32) |
| 77 | + |
| 78 | +-- |Calculates a 64-byte hash from the given password, salt and parameters. |
| 79 | +scrypt :: ScryptParams -> Salt -> Pass -> PassHash |
| 80 | +scrypt Params{..} (Salt salt) (Pass pass) = |
| 81 | + PassHash <$> unsafePerformIO $ |
| 82 | + useAsCStringLen salt $ \(saltPtr, saltLen) -> |
| 83 | + useAsCStringLen pass $ \(passPtr, passLen) -> |
| 84 | + allocaBytes (fromIntegral bufLen) $ \bufPtr -> do |
| 85 | + throwErrnoIfMinus1_ "c_scrypt" $ c_scrypt |
| 86 | + (castPtr passPtr) (fromIntegral passLen) |
| 87 | + (castPtr saltPtr) (fromIntegral saltLen) |
| 88 | + (2^logN) (fromIntegral r) (fromIntegral p) |
| 89 | + bufPtr (fromIntegral bufLen) |
| 90 | + packCStringLen (castPtr bufPtr, fromIntegral bufLen) |
| 91 | + |
| 92 | +foreign import ccall unsafe "crypto_scrypt" c_scrypt |
| 93 | + :: Ptr Word8 -> CSize |
| 94 | + -> Ptr Word8 -> CSize |
| 95 | + -> Word64 -> Word32 -> Word32 -- N, r, p |
| 96 | + -> Ptr Word8 -> CSize |
| 97 | + -> IO CInt |
0 commit comments