From 1f9d7af56fe0afa44c128232646e69258fff1000 Mon Sep 17 00:00:00 2001 From: Vincent Hanquez Date: Fri, 1 Aug 2014 04:53:53 -0700 Subject: [PATCH] add a working implementation of scrypt. --- Crypto/KDF/Scrypt.hs | 33 +++++++++++--- cbits/cryptonite_scrypt.c | 90 +++++++++++++++++++++++++++++++++++++++ cryptonite.cabal | 5 ++- tests/KAT_Scrypt.hs | 10 +++-- 4 files changed, 127 insertions(+), 11 deletions(-) create mode 100644 cbits/cryptonite_scrypt.c diff --git a/Crypto/KDF/Scrypt.hs b/Crypto/KDF/Scrypt.hs index 693c1dd..bfce230 100644 --- a/Crypto/KDF/Scrypt.hs +++ b/Crypto/KDF/Scrypt.hs @@ -8,6 +8,7 @@ -- Scrypt key derivation function as defined in Colin Percival's paper "Stronger Key Derivation via Sequential Memory-Hard Functions" . -- {-# LANGUAGE BangPatterns #-} +{-# LANGUAGE ForeignFunctionInterface #-} module Crypto.KDF.Scrypt ( Parameters(..) , generate @@ -17,25 +18,45 @@ import Data.Word import Data.Bits import Data.ByteString (ByteString) import qualified Data.ByteString as B -import qualified Data.ByteString.Internal as B (unsafeCreate, memset) import Data.Byteable -import Foreign.Storable +import Foreign.Marshal.Alloc import Foreign.Ptr (Ptr, plusPtr) -import Control.Applicative -import Control.Monad (forM_, void) +import Control.Monad (forM_) +import System.IO.Unsafe + +import Crypto.Hash (SHA256(..)) import qualified Crypto.KDF.PBKDF2 as PBKDF2 -- | Parameters for Scrypt data Parameters = Parameters { password :: ByteString -- ^ Password (bytes encoded) , salt :: ByteString -- ^ Salt (bytes encoded) - , n :: Int -- ^ Cpu/Memory cost ratio. must be a power of 2 greater than 1 + , n :: Word64 -- ^ Cpu/Memory cost ratio. must be a power of 2 greater than 1. also known as N. , r :: Int -- ^ Must satisfy r * p < 2^30 , p :: Int -- ^ Must satisfy r * p < 2^30 , 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 :: Parameters -> B.ByteString -generate params = undefined +generate params + | r params * p params >= 0x40000000 = + error "Scrypt: invalid parameters: r and p constraint" + | popCount (n params) /= 1 = + error "Scrypt: invalid parameters: n not a power of 2" + | otherwise = unsafePerformIO $ do + let b = PBKDF2.generate prf + (PBKDF2.Parameters (password params) (salt params) 1 (p params * 128 * r params)) + allocaBytesAligned (128*(fromIntegral $ n params)*(r params)) 8 $ \v -> + allocaBytesAligned (256*r params) 8 $ \xy -> + withBytePtr b $ \bPtr -> + forM_ [0..(p params-1)] $ \i -> + ccryptonite_scrypt_smix (bPtr `plusPtr` (i * 128 * (r params))) + (fromIntegral $ r params) (n params) v xy + + return $ PBKDF2.generate prf (PBKDF2.Parameters (password params) b 1 (outputLength params)) + where prf = PBKDF2.prfHMAC SHA256 diff --git a/cbits/cryptonite_scrypt.c b/cbits/cryptonite_scrypt.c new file mode 100644 index 0000000..fc3fd04 --- /dev/null +++ b/cbits/cryptonite_scrypt.c @@ -0,0 +1,90 @@ +/* + * Copyright (C) 2014 Vincent Hanquez + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions + * are met: + * 1. Redistributions of source code must retain the above copyright + * notice, this list of conditions and the following disclaimer. + * 2. Redistributions in binary form must reproduce the above copyright + * notice, this list of conditions and the following disclaimer in the + * documentation and/or other materials provided with the distribution. + * + * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR + * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES + * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. + * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, + * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT + * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, + * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY + * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT + * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF + * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + * + * Based on scrypt from Colin Percival's paper + */ + +#include +#include +#include "cryptonite_bitfn.h" +#include "cryptonite_salsa.h" + +static void blockmix_salsa8(uint32_t *in, uint32_t *out, uint32_t *X, const uint32_t r) +{ + int i; + + array_copy32(X, &in[(2 * r - 1) * 16], 16); + + for (i = 0; i < 2 * r; i += 2) { + cryptonite_salsa_core_xor(8, (block *) X, (block *) &in[i*16]); + array_copy32(&out[i * 8], X, 16); + + cryptonite_salsa_core_xor(8, (block *) X, (block *) &in[i*16+16]); + array_copy32(&out[i * 8 + r * 16], X, 16); + } +} + +static inline uint64_t integerify(uint32_t *B, const uint32_t r) +{ + return le64_to_cpu(*((uint64_t *) (B + (2*r-1) * 16))); +} + +static inline uint32_t load32(const uint8_t *p) +{ + return le32_to_cpu(*((uint32_t *) p)); +} + +static inline void store32(const uint8_t *p, uint32_t val) +{ + *((uint32_t *) p) = cpu_to_le32(val); +} + +void cryptonite_scrypt_smix(uint8_t *B, const uint32_t r, const uint64_t N, uint32_t *V, uint32_t *XY) +{ + uint32_t *X = XY; + uint32_t *Y = &XY[32 * r]; + uint32_t *Z = &XY[64 * r]; + uint64_t i, j; + int k; + const int r32 = 32*r; + + for (k = 0; k < r32; k++) + X[k] = load32(&B[4 * k]); + for (i = 0; i < N; i += 2) { + array_copy32(&V[i * r32], X, r32); + blockmix_salsa8(X, Y, Z, r); + array_copy32(&V[(i + 1) * r32], Y, r32); + blockmix_salsa8(Y, X, Z, r); + } + for (i = 0; i < N; i += 2) { + j = integerify(X, r) & (N - 1); + array_xor32(X, &V[j * r32], r32); + blockmix_salsa8(X, Y, Z, r); + + j = integerify(Y, r) & (N - 1); + array_xor32(Y, &V[j * r32], r32); + blockmix_salsa8(Y, X, Z, r); + } + for (k = 0; k < r32; k++) + store32(&B[4*k], X[k]); +} diff --git a/cryptonite.cabal b/cryptonite.cabal index 9f4d4af..9f8030e 100644 --- a/cryptonite.cabal +++ b/cryptonite.cabal @@ -27,6 +27,7 @@ Library Crypto.MAC.Poly1305 Crypto.MAC.HMAC Crypto.KDF.PBKDF2 + Crypto.KDF.Scrypt Crypto.Hash Crypto.Hash.SHA1 Crypto.Hash.SHA224 @@ -49,9 +50,8 @@ Library Other-modules: Crypto.Hash.Internal , Crypto.Hash.Utils , Crypto.Hash.Types - , Crypto.KDF.Scrypt , Crypto.Random.Entropy.Source - Build-depends: base >= 4 && < 5 + Build-depends: base >= 4.5 && < 5 , bytestring , securemem , byteable @@ -75,6 +75,7 @@ Library , cbits/cryptonite_skein512.c , cbits/cryptonite_tiger.c , cbits/cryptonite_whirlpool.c + , cbits/cryptonite_scrypt.c if (arch(i386) || arch(x86_64)) CPP-options: -DARCH_IS_LITTLE_ENDIAN diff --git a/tests/KAT_Scrypt.hs b/tests/KAT_Scrypt.hs index 75ab7e0..a65572a 100644 --- a/tests/KAT_Scrypt.hs +++ b/tests/KAT_Scrypt.hs @@ -6,8 +6,11 @@ import Data.ByteString.Char8 () import Test.Tasty import Test.Tasty.HUnit +import Data.Word -vectors :: [ ((ByteString, ByteString, Int, Int, Int, Int), ByteString) ] +import qualified Crypto.KDF.Scrypt as Scrypt + +vectors :: [ ((ByteString, ByteString, Word64, Int, Int, Int), ByteString) ] vectors = [ ( ("", "", 16, 1, 1, 64) @@ -25,5 +28,6 @@ vectors = ] tests = testGroup "Scrypt" - [ - ] + $ map toCase $ zip [(1::Int)..] vectors + where toCase (i, ((pass,salt,n,r,p,dklen), output)) = + testCase (show i) (output @=? Scrypt.generate (Scrypt.Parameters pass salt n r p dklen))