diff --git a/Crypto/Cipher/Salsa.hs b/Crypto/Cipher/Salsa.hs new file mode 100644 index 0000000..47daa63 --- /dev/null +++ b/Crypto/Cipher/Salsa.hs @@ -0,0 +1,127 @@ +-- | +-- Module : Crypto.Cipher.Salsa +-- License : BSD-style +-- Maintainer : Vincent Hanquez +-- Stability : stable +-- Portability : good +-- +{-# LANGUAGE ForeignFunctionInterface #-} +module Crypto.Cipher.Salsa + ( initialize + , combine + , generate + , State + ) where + +import Control.Applicative +import Data.SecureMem +import Data.ByteString (ByteString) +import qualified Data.ByteString.Internal as B +import qualified Data.ByteString as B +import Data.Byteable +import Data.Word +import Data.Bits (xor) +import Foreign.Ptr +import Foreign.ForeignPtr +import Foreign.C.Types +import Foreign.Storable +import System.IO.Unsafe + +-- | Salsa context +data State = State Int -- number of rounds + SecureMem -- Salsa's state + ByteString -- previous generated chunk + +round64 :: Int -> (Bool, Int) +round64 len + | len == 0 = (True, 0) + | m == 0 = (True, len) + | otherwise = (False, len + (64 - m)) + where m = len `mod` 64 + +-- | Initialize a new Salsa context with the number of rounds, +-- the key and the nonce associated. +initialize :: Byteable key + => Int -- ^ number of rounds (8,12,20) + -> key -- ^ the key (128 or 256 bits) + -> ByteString -- ^ the nonce (64 or 96 bits) + -> State -- ^ the initial Salsa state +initialize nbRounds key nonce + | not (kLen `elem` [16,32]) = error "Salsa: key length should be 128 or 256 bits" + | not (nonceLen `elem` [8,12]) = error "Salsa: nonce length should be 64 or 96 bits" + | not (nbRounds `elem` [8,12,20]) = error "Salsa: rounds should be 8, 12 or 20" + | otherwise = unsafePerformIO $ do + stPtr <- createSecureMem 64 $ \stPtr -> + withBytePtr nonce $ \noncePtr -> + withBytePtr key $ \keyPtr -> + ccryptonite_salsa_init (castPtr stPtr) kLen keyPtr nonceLen noncePtr + return $ State nbRounds stPtr B.empty + where kLen = byteableLength key + nonceLen = B.length nonce + +-- | Combine the salsa output and an arbitrary message with a xor, +-- and return the combined output and the new state. +combine :: State -- ^ the current Salsa state + -> ByteString -- ^ the source to xor with the generator + -> (ByteString, State) +combine prev@(State nbRounds prevSt prevOut) src + | outputLen == 0 = (B.empty, prev) + | outputLen <= prevBufLen = + -- we have enough byte in the previous buffer to complete the query + -- without having to generate any extra bytes + let (b1,b2) = B.splitAt outputLen prevOut + in (B.pack $ B.zipWith xor b1 src, State nbRounds prevSt b2) + | otherwise = unsafePerformIO $ do + -- adjusted len is the number of bytes lefts to generate after + -- copying from the previous buffer. + let adjustedLen = outputLen - prevBufLen + (roundedAlready, newBytesToGenerate) = round64 adjustedLen + nextBufLen = newBytesToGenerate - adjustedLen + + fptr <- B.mallocByteString (newBytesToGenerate + prevBufLen) + newSt <- withForeignPtr fptr $ \dstPtr -> + withBytePtr src $ \srcPtr -> do + -- copy the previous buffer by xor if any + withBytePtr prevOut $ \prevPtr -> + loopXor dstPtr srcPtr prevPtr prevBufLen + + -- then create a new mutable copy of state + st <- secureMemCopy prevSt + withSecureMemPtr st $ \stPtr -> + ccryptonite_salsa_combine nbRounds + (dstPtr `plusPtr` prevBufLen) + (castPtr stPtr) + (srcPtr `plusPtr` prevBufLen) + (fromIntegral newBytesToGenerate) + return st + -- return combined byte + return ( B.PS fptr 0 outputLen + , State nbRounds newSt (if roundedAlready then B.empty else B.PS fptr outputLen nextBufLen)) + where + outputLen = B.length src + prevBufLen = B.length prevOut + + loopXor :: Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> Int -> IO () + loopXor _ _ _ 0 = return () + loopXor d s1 s2 n = do + (xor <$> peek s1 <*> peek s2) >>= poke d + loopXor (d `plusPtr` 1) (s1 `plusPtr` 1) (s2 `plusPtr` 1) (n-1) + +-- | Generate a number of bytes from the Salsa output directly +-- +-- TODO: use salsa_generate directly instead of using combine xor'ing with 0. +generate :: State -- ^ the current Salsa state + -> Int -- ^ the length of data to generate + -> (ByteString, State) +generate st len = combine st (B.replicate len 0) + +foreign import ccall "cryptonite_salsa_init" + ccryptonite_salsa_init :: Ptr State -> Int -> Ptr Word8 -> Int -> Ptr Word8 -> IO () + +foreign import ccall "cryptonite_salsa_combine" + ccryptonite_salsa_combine :: Int -> Ptr Word8 -> Ptr State -> Ptr Word8 -> CUInt -> IO () + +{- +foreign import ccall "cryptonite_salsa_generate" + ccryptonite_salsa_generate :: Int -> Ptr Word8 -> Ptr State -> CUInt -> IO () +-} diff --git a/README.md b/README.md index c0a2c9d..6dd3177 100644 --- a/README.md +++ b/README.md @@ -18,6 +18,10 @@ Links * [ChaCha](http://cr.yp.to/chacha.html) * [ChaCha-test-vectors](https://github.com/secworks/chacha_testvectors.git) +* [Salsa](http://cr.yp.to/snuffle.html) +* [Salsa128-test-vectors](https://github.com/alexwebr/salsa20/blob/master/test_vectors.128) +* [Salsa256-test-vectors](https://github.com/alexwebr/salsa20/blob/master/test_vectors.256) + TODO ---- diff --git a/cbits/cryptonite_salsa.c b/cbits/cryptonite_salsa.c new file mode 100644 index 0000000..8dfdc15 --- /dev/null +++ b/cbits/cryptonite_salsa.c @@ -0,0 +1,241 @@ +/* + * Copyright (c) 2014 Vincent Hanquez + * + * All rights reserved. + * + * 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. + * 3. Neither the name of the author nor the names of his contributors + * may be used to endorse or promote products derived from this software + * without specific prior written permission. + * + * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``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 AUTHORS OR CONTRIBUTORS 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. + */ + +#include +#include "cryptonite_salsa.h" +#include "cryptonite_bitfn.h" +#include + +#define USE_8BITS 0 + +static const uint8_t sigma[16] = "expand 32-byte k"; +static const uint8_t tau[16] = "expand 16-byte k"; + +#define QR (a,b,c,d) \ + b ^= rol32(a+d, 7); \ + c ^= rol32(b+a, 9); \ + d ^= rol32(c+b, 13); \ + a ^= rol32(d+c, 18); + +uint32_t load32(const uint8_t *p) +{ + return le32_to_cpu(*((uint32_t *) p)); +} + +static void salsa_core(int rounds, block *out, const cryptonite_salsa_state *in) +{ + uint32_t x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, x15; + int i; + + x0 = in->d[0]; x1 = in->d[1]; x2 = in->d[2]; x3 = in->d[3]; + x4 = in->d[4]; x5 = in->d[5]; x6 = in->d[6]; x7 = in->d[7]; + x8 = in->d[8]; x9 = in->d[9]; x10 = in->d[10]; x11 = in->d[11]; + x12 = in->d[12]; x13 = in->d[13]; x14 = in->d[14]; x15 = in->d[15]; + + for (i = rounds; i > 0; i -= 2) { + //QR (x0,x4,x8,x12); + //QR (x5,x9,x13,x1); + //QR (x10,x14,x2,x6); + //QR (x15,x3,x7,x11); + x4 ^= rol32( x0+x12, 7); + x8 ^= rol32( x4+ x0, 9); + x12 ^= rol32( x8+ x4,13); + x0 ^= rol32(x12+ x8,18); + + x9 ^= rol32( x5+ x1, 7); + x13 ^= rol32( x9+ x5, 9); + x1 ^= rol32(x13+ x9,13); + x5 ^= rol32( x1+x13,18); + + x14 ^= rol32(x10+ x6, 7); + x2 ^= rol32(x14+x10, 9); + x6 ^= rol32( x2+x14,13); + x10 ^= rol32( x6+ x2,18); + + x3 ^= rol32(x15+x11, 7); + x7 ^= rol32( x3+x15, 9); + x11 ^= rol32( x7+ x3,13); + x15 ^= rol32(x11+ x7,18); + + //QR (x0,x1,x2,x3); + //QR (x5,x6,x7,x4); + //QR (x10,x11,x8,x9); + //QR (x15,x12,x13,x14); + + x1 ^= rol32( x0+ x3, 7); + x2 ^= rol32( x1+ x0, 9); + x3 ^= rol32( x2+ x1,13); + x0 ^= rol32( x3+ x2,18); + + x6 ^= rol32( x5+ x4, 7); + x7 ^= rol32( x6+ x5, 9); + x4 ^= rol32( x7+ x6,13); + x5 ^= rol32( x4+ x7,18); + + x11 ^= rol32(x10+ x9, 7); + x8 ^= rol32(x11+x10, 9); + x9 ^= rol32( x8+x11,13); + x10 ^= rol32( x9+ x8,18); + + x12 ^= rol32(x15+x14, 7); + x13 ^= rol32(x12+x15, 9); + x14 ^= rol32(x13+x12,13); + x15 ^= rol32(x14+x13,18); + + } + + x0 += in->d[0]; x1 += in->d[1]; x2 += in->d[2]; x3 += in->d[3]; + x4 += in->d[4]; x5 += in->d[5]; x6 += in->d[6]; x7 += in->d[7]; + x8 += in->d[8]; x9 += in->d[9]; x10 += in->d[10]; x11 += in->d[11]; + x12 += in->d[12]; x13 += in->d[13]; x14 += in->d[14]; x15 += in->d[15]; + + out->d[0] = cpu_to_le32(x0); + out->d[1] = cpu_to_le32(x1); + out->d[2] = cpu_to_le32(x2); + out->d[3] = cpu_to_le32(x3); + out->d[4] = cpu_to_le32(x4); + out->d[5] = cpu_to_le32(x5); + out->d[6] = cpu_to_le32(x6); + out->d[7] = cpu_to_le32(x7); + out->d[8] = cpu_to_le32(x8); + out->d[9] = cpu_to_le32(x9); + out->d[10] = cpu_to_le32(x10); + out->d[11] = cpu_to_le32(x11); + out->d[12] = cpu_to_le32(x12); + out->d[13] = cpu_to_le32(x13); + out->d[14] = cpu_to_le32(x14); + out->d[15] = cpu_to_le32(x15); +} + +/* only 2 valids values are 256 (32) and 128 (16) */ +void cryptonite_salsa_init(cryptonite_salsa_state *st, + uint32_t keylen, const uint8_t *key, + uint32_t ivlen, const uint8_t *iv) +{ + const uint8_t *constants = (keylen == 32) ? sigma : tau; + int i; + + st->d[0] = load32(constants + 0); + st->d[5] = load32(constants + 4); + st->d[10] = load32(constants + 8); + st->d[15] = load32(constants + 12); + + st->d[1] = load32(key + 0); + st->d[2] = load32(key + 4); + st->d[3] = load32(key + 8); + st->d[4] = load32(key + 12); + /* we repeat the key on 128 bits */ + if (keylen == 32) + key += 16; + st->d[11] = load32(key + 0); + st->d[12] = load32(key + 4); + st->d[13] = load32(key + 8); + st->d[14] = load32(key + 12); + + st->d[9] = 0; + switch (ivlen) { + case 8: + st->d[6] = load32(iv + 0); + st->d[7] = load32(iv + 4); + st->d[8] = 0; + break; + case 12: + st->d[6] = load32(iv + 0); + st->d[7] = load32(iv + 4); + st->d[8] = load32(iv + 8); + default: + return; + } +} + +void cryptonite_salsa_combine(uint32_t rounds, block *dst, cryptonite_salsa_state *st, const block *src, uint32_t bytes) +{ + block out; + int i; + + if (!bytes) + return; + + for (;; bytes -= 64, src += 1, dst += 1) { + salsa_core(rounds, &out, st); + + st->d[8] += 1; + if (st->d[8] == 0) + st->d[9] += 1; + + if (bytes <= 64) { + for (i = 0; i < bytes; i++) + dst->b[i] = src->b[i] ^ out.b[i]; + for (; i < 64; i++) + dst->b[i] = out.b[i]; + return; + } + +#if USE_8BITS + for (i = 0; i < 64; ++i) + dst->b[i] = src->b[i] ^ out.b[i]; +#else + /* fast copy using 64 bits */ + for (i = 0; i < 8; i++) + dst->q[i] = src->q[i] ^ out.q[i]; +#endif + } +} + +void cryptonite_salsa_generate(uint32_t rounds, block *dst, cryptonite_salsa_state *st, uint32_t bytes) +{ + block out; + int i; + + if (!bytes) + return; + + for (;; bytes -= 64, dst += 1) { + salsa_core(rounds, &out, st); + + st->d[8] += 1; + if (st->d[8] == 0) + st->d[9] += 1; + + if (bytes <= 64) { + for (i = 0; i < bytes; ++i) + dst->b[i] = out.b[i]; + return; + } +#if USE_8BITS + for (i = 0; i < 64; ++i) + dst->b[i] = out.b[i]; +#else + for (i = 0; i < 8; i++) + dst->q[i] = out.q[i]; +#endif + } +} + diff --git a/cbits/cryptonite_salsa.h b/cbits/cryptonite_salsa.h new file mode 100644 index 0000000..8efc13a --- /dev/null +++ b/cbits/cryptonite_salsa.h @@ -0,0 +1,45 @@ +/* + * Copyright (c) 2014 Vincent Hanquez + * + * All rights reserved. + * + * 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. + * 3. Neither the name of the author nor the names of his contributors + * may be used to endorse or promote products derived from this software + * without specific prior written permission. + * + * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``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 AUTHORS OR CONTRIBUTORS 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. + */ +#ifndef CRYPTONITE_CHACHA +#define CRYPTONITE_CHACHA + +typedef union { + uint64_t q[8]; + uint32_t d[16]; + uint8_t b[64]; +} block; + +typedef block cryptonite_salsa_state; + +void cryptonite_salsa_init(cryptonite_salsa_state *st, uint32_t keylen, const uint8_t *key, uint32_t ivlen, const uint8_t *iv); +void cryptonite_salsa_combine(uint32_t rounds, block *dst, cryptonite_salsa_state *st, const block *src, uint32_t bytes); +void cryptonite_salsa_generate(uint32_t rounds, block *dst, cryptonite_salsa_state *st, uint32_t bytes); + +#endif diff --git a/cryptonite.cabal b/cryptonite.cabal index bad6975..a0d69d3 100644 --- a/cryptonite.cabal +++ b/cryptonite.cabal @@ -21,6 +21,7 @@ source-repository head Library Exposed-modules: Crypto.Cipher.ChaCha + Crypto.Cipher.Salsa Build-depends: base >= 4 && < 5 , bytestring , securemem @@ -28,6 +29,7 @@ Library ghc-options: -Wall -fwarn-tabs -optc-O3 default-language: Haskell2010 C-sources: cbits/cryptonite_chacha.c + , cbits/cryptonite_salsa.c if (arch(i386) || arch(x86_64)) CPP-options: -DARCH_IS_LITTLE_ENDIAN diff --git a/tests/KATSalsa.hs b/tests/KATSalsa.hs new file mode 100644 index 0000000..101de7a --- /dev/null +++ b/tests/KATSalsa.hs @@ -0,0 +1,25 @@ +{-# LANGUAGE OverloadedStrings #-} +module KATSalsa (vectors) where + +import qualified Data.ByteString as B + +key :: B.ByteString +key = "\xEA\xEB\xEC\xED\xEE\xEF\xF0\xF1\xF2\xF3\xF4\xF5\xF6\xF7\xF8\xF9\xFA\xFB\xFC\xFD\xFE\xFF\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09" + +iv = B.replicate 8 0 + +vectors :: [(Int, B.ByteString, B.ByteString, [(Int, B.ByteString)] )] +vectors = + [ (20, key, iv + , [ (0, "\x99\xA8\xCC\xEC\x6C\x5B\x2A\x0B\x6E\x33\x6C\xB2\x06\x52\x24\x1C\x32\xB2\x4D\x34\xAC\xC0\x45\x7E\xF6\x79\x17\x8E\xDE\x7C\xF8\x05\x80\x5A\x93\x05\xC7\xC4\x99\x09\x68\x3B\xD1\xA8\x03\x32\x78\x17\x62\x7C\xA4\x6F\xE8\xB9\x29\xB6\xDF\x00\x12\xBD\x86\x41\x83\xBE") + , (192, "\x2D\x22\x6C\x11\xF4\x7B\x3C\x0C\xCD\x09\x59\xB6\x1F\x59\xD5\xCC\x30\xFC\xEF\x6D\xBB\x8C\xBB\x3D\xCC\x1C\xC2\x52\x04\xFC\xD4\x49\x8C\x37\x42\x6A\x63\xBE\xA3\x28\x2B\x1A\x8A\x0D\x60\xE1\x3E\xB2\xFE\x59\x24\x1A\x9F\x6A\xF4\x26\x68\x98\x66\xED\xC7\x69\xE1\xE6\x48\x2F\xE1\xC1\x28\xA1\x5C\x11\x23\xB5\x65\x5E\xD5\x46\xDF\x01\x4C\xE0\xC4\x55\xDB\xF5\xD3\xA1\x3D\x9C\xD4\xF0\xE2\xD1\xDA\xB9\xF1\x2F\xB6\x8C\x54\x42\x61\xD7\xF8\x8E\xAC\x1C\x6C\xBF\x99\x3F\xBB\xB8\xE0\xAA\x85\x10\xBF\xF8\xE7\x38\x35\xA1\xE8\x6E\xAD\xBB") + , (448, "\x05\x97\x18\x8A\x1C\x19\x25\x57\x69\xBE\x1C\x21\x03\x99\xAD\x17\x2E\xB4\x6C\x52\xF9\x2F\xD5\x41\xDF\x2E\xAD\x71\xB1\xFF\x8E\xA7\xAD\xD3\x80\xEC\x71\xA5\xFD\x7A\xDB\x51\x81\xEA\xDD\x18\x25\xEC\x02\x77\x9A\x45\x09\xBE\x58\x32\x70\x8C\xA2\x83\x6C\x16\x93\xA5") + ]) + , (20 + , "\x00\x53\xA6\xF9\x4C\x9F\xF2\x45\x98\xEB\x3E\x91\xE4\x37\x8A\xDD\x30\x83\xD6\x29\x7C\xCF\x22\x75\xC8\x1B\x6E\xC1\x14\x67\xBA\x0D" + , "\x0D\x74\xDB\x42\xA9\x10\x77\xDE" + , [ (0, "\xF5\xFA\xD5\x3F\x79\xF9\xDF\x58\xC4\xAE\xA0\xD0\xED\x9A\x96\x01\xF2\x78\x11\x2C\xA7\x18\x0D\x56\x5B\x42\x0A\x48\x01\x96\x70\xEA\xF2\x4C\xE4\x93\xA8\x62\x63\xF6\x77\xB4\x6A\xCE\x19\x24\x77\x3D\x2B\xB2\x55\x71\xE1\xAA\x85\x93\x75\x8F\xC3\x82\xB1\x28\x0B\x71") + , (65472, "\xB7\x0C\x50\x13\x9C\x63\x33\x2E\xF6\xE7\x7A\xC5\x43\x38\xA4\x07\x9B\x82\xBE\xC9\xF9\xA4\x03\xDF\xEA\x82\x1B\x83\xF7\x86\x07\x91\x65\x0E\xF1\xB2\x48\x9D\x05\x90\xB1\xDE\x77\x2E\xED\xA4\xE3\xBC\xD6\x0F\xA7\xCE\x9C\xD6\x23\xD9\xD2\xFD\x57\x58\xB8\x65\x3E\x70\x81\x58\x2C\x65\xD7\x56\x2B\x80\xAE\xC2\xF1\xA6\x73\xA9\xD0\x1C\x9F\x89\x2A\x23\xD4\x91\x9F\x6A\xB4\x7B\x91\x54\xE0\x8E\x69\x9B\x41\x17\xD7\xC6\x66\x47\x7B\x60\xF8\x39\x14\x81\x68\x2F\x5D\x95\xD9\x66\x23\xDB\xC4\x89\xD8\x8D\xAA\x69\x56\xB9\xF0\x64\x6B\x6E") + , (131008, "\xA1\x3F\xFA\x12\x08\xF8\xBF\x50\x90\x08\x86\xFA\xAB\x40\xFD\x10\xE8\xCA\xA3\x06\xE6\x3D\xF3\x95\x36\xA1\x56\x4F\xB7\x60\xB2\x42\xA9\xD6\xA4\x62\x8C\xDC\x87\x87\x62\x83\x4E\x27\xA5\x41\xDA\x2A\x5E\x3B\x34\x45\x98\x9C\x76\xF6\x11\xE0\xFE\xC6\xD9\x1A\xCA\xCC") + ]) + ] diff --git a/tests/Tests.hs b/tests/Tests.hs index be37825..52019a5 100644 --- a/tests/Tests.hs +++ b/tests/Tests.hs @@ -7,6 +7,9 @@ import Test.Tasty.QuickCheck import Test.Tasty.HUnit import qualified Crypto.Cipher.ChaCha as ChaCha +import qualified Crypto.Cipher.Salsa as Salsa + +import qualified KATSalsa b8_128_k0_i0 = "\xe2\x8a\x5f\xa4\xa6\x7f\x8c\x5d\xef\xed\x3e\x6f\xb7\x30\x34\x86\xaa\x84\x27\xd3\x14\x19\xa7\x29\x57\x2d\x77\x79\x53\x49\x11\x20\xb6\x4a\xb8\xe7\x2b\x8d\xeb\x85\xcd\x6a\xea\x7c\xb6\x08\x9a\x10\x18\x24\xbe\xeb\x08\x81\x4a\x42\x8a\xab\x1f\xa2\xc8\x16\x08\x1b\x8a\x26\xaf\x44\x8a\x1b\xa9\x06\x36\x8f\xd8\xc8\x38\x31\xc1\x8c\xec\x8c\xed\x81\x1a\x02\x8e\x67\x5b\x8d\x2b\xe8\xfc\xe0\x81\x16\x5c\xea\xe9\xf1\xd1\xb7\xa9\x75\x49\x77\x49\x48\x05\x69\xce\xb8\x3d\xe6\xa0\xa5\x87\xd4\x98\x4f\x19\x92\x5f\x5d\x33\x8e\x43\x0d" @@ -34,9 +37,26 @@ tests = testGroup "cryptonite" , testCase "12-256-K0-I0" (chachaRunSimple b12_256_k0_i0 12 32 8) , testCase "20-256-K0-I0" (chachaRunSimple b20_256_k0_i0 20 32 8) ] + , testGroup "Salsa" + [ testGroup "KAT" $ + map (\(i,f) -> testCase (show (i :: Int)) f) $ zip [1..] $ map (\(r, k,i,e) -> salsaRunSimple e r k i) KATSalsa.vectors + ] ] where chachaRunSimple expected rounds klen nonceLen = let chacha = ChaCha.initialize rounds (B.replicate klen 0) (B.replicate nonceLen 0) in expected @=? fst (ChaCha.generate chacha (B.length expected)) + salsaRunSimple expected rounds key nonce = + let salsa = Salsa.initialize rounds key nonce + in map snd expected @=? salsaLoop 0 salsa expected + + salsaLoop _ _ [] = [] + salsaLoop current salsa (r@(ofs,expectBs):rs) + | current < ofs = + let (_, salsaNext) = Salsa.generate salsa (ofs - current) + in salsaLoop ofs salsaNext (r:rs) + | current == ofs = + let (e, salsaNext) = Salsa.generate salsa (B.length expectBs) + in e : salsaLoop (current + B.length expectBs) salsaNext rs + | otherwise = error "internal error in salsaLoop" main = defaultMain tests