Merge pull request #293 from ocheron/xsalsa-derive

Add XSalsa.derive

Crypto/Cipher/XSalsa.hs

@@ -12,6 +12,7 @@
 {-# LANGUAGE ForeignFunctionInterface #-}
 module Crypto.Cipher.XSalsa
     ( initialize
+    , derive
     , combine
     , generate
     , State
@@ -44,5 +45,31 @@ initialize nbRounds key nonce
   where kLen     = B.length key
         nonceLen = B.length nonce
 
+-- | Use an already initialized context and new nonce material to derive another
+-- XSalsa context.
+--
+-- This allows a multi-level cascade where a first key @k1@ and nonce @n1@ is
+-- used to get @HState(k1,n1)@, and this value is then used as key @k2@ to build
+-- @XSalsa(k2,n2)@.  Function 'initialize' is to be called with the first 192
+-- bits of @n1|n2@, and the call to @derive@ should add the remaining 128 bits.
+--
+-- The output context always uses the same number of rounds as the input
+-- context.
+derive :: ByteArrayAccess nonce
+       => State  -- ^ base XSalsa state
+       -> nonce  -- ^ the remainder nonce (128 bits)
+       -> State  -- ^ the new XSalsa state
+derive (State stPtr') nonce
+    | nonceLen /= 16 = error "XSalsa: nonce length should be 128 bits"
+    | otherwise = unsafeDoIO $ do
+        stPtr <- B.copy stPtr' $ \stPtr ->
+            B.withByteArray nonce $ \noncePtr  ->
+                ccryptonite_xsalsa_derive stPtr nonceLen noncePtr
+        return $ State stPtr
+  where nonceLen = B.length nonce
+
 foreign import ccall "cryptonite_xsalsa_init"
     ccryptonite_xsalsa_init :: Ptr State -> Int -> Int -> Ptr Word8 -> Int -> Ptr Word8 -> IO ()
+
+foreign import ccall "cryptonite_xsalsa_derive"
+    ccryptonite_xsalsa_derive :: Ptr State -> Int -> Ptr Word8 -> IO ()

Crypto/Tutorial.hs

@@ -8,6 +8,9 @@ module Crypto.Tutorial
 
       -- * Symmetric block ciphers
       -- $symmetric_block_ciphers
+
+      -- * Combining primitives
+      -- $combining_primitives
     ) where
 
 -- $api_design
@@ -147,3 +150,46 @@ module Crypto.Tutorial
 -- >           putStrLn $ "Original Message: " ++ show msg
 -- >           putStrLn $ "Message after encryption: " ++ show eMsg
 -- >           putStrLn $ "Message after decryption: " ++ show dMsg
+
+-- $combining_primitives
+--
+-- This example shows how to use Curve25519, XSalsa and Poly1305 primitives to
+-- emulate NaCl's @crypto_box@ construct.
+--
+-- > import qualified Data.ByteArray as BA
+-- > import           Data.ByteString (ByteString)
+-- > import qualified Data.ByteString as B
+-- >
+-- > import qualified Crypto.Cipher.XSalsa as XSalsa
+-- > import qualified Crypto.MAC.Poly1305 as Poly1305
+-- > import qualified Crypto.PubKey.Curve25519 as X25519
+-- >
+-- > -- | Build a @crypto_box@ packet encrypting the specified content with a
+-- > -- 192-bit nonce, receiver public key and sender private key.
+-- > crypto_box content nonce pk sk = BA.convert tag `B.append` c
+-- >   where
+-- >     zero         = B.replicate 16 0
+-- >     shared       = X25519.dh pk sk
+-- >     (iv0, iv1)   = B.splitAt 8 nonce
+-- >     state0       = XSalsa.initialize 20 shared (zero `B.append` iv0)
+-- >     state1       = XSalsa.derive state0 iv1
+-- >     (rs, state2) = XSalsa.generate state1 32
+-- >     (c, _)       = XSalsa.combine state2 content
+-- >     tag          = Poly1305.auth (rs :: ByteString) c
+-- >
+-- > -- | Try to open a @crypto_box@ packet and recover the content using the
+-- > -- 192-bit nonce, sender public key and receiver private key.
+-- > crypto_box_open packet nonce pk sk
+-- >     | B.length packet < 16 = Nothing
+-- >     | BA.constEq tag' tag  = Just content
+-- >     | otherwise            = Nothing
+-- >   where
+-- >     (tag', c)    = B.splitAt 16 packet
+-- >     zero         = B.replicate 16 0
+-- >     shared       = X25519.dh pk sk
+-- >     (iv0, iv1)   = B.splitAt 8 nonce
+-- >     state0       = XSalsa.initialize 20 shared (zero `B.append` iv0)
+-- >     state1       = XSalsa.derive state0 iv1
+-- >     (rs, state2) = XSalsa.generate state1 32
+-- >     (content, _) = XSalsa.combine state2 c
+-- >     tag          = Poly1305.auth (rs :: ByteString) c

cbits/cryptonite_xsalsa.c

@@ -47,13 +47,27 @@ void cryptonite_xsalsa_init(cryptonite_salsa_context *ctx, uint8_t nb_rounds,
        (x6, x7, x8, x9) is the first 128 bits of a 192-bit nonce
   */
   cryptonite_salsa_init_core(&ctx->st, keylen, key, 8, iv);
-  ctx->st.d[ 8] = load_le32(iv + 8);
-  ctx->st.d[ 9] = load_le32(iv + 12);
+
+  /* Continue initialization in a separate function that may also
+     be called independently */
+  cryptonite_xsalsa_derive(ctx, ivlen - 8, iv + 8);
+}
+
+void cryptonite_xsalsa_derive(cryptonite_salsa_context *ctx,
+                              uint32_t ivlen, const uint8_t *iv)
+{
+  /* Finish creating initial 512-bit input block:
+       (x6, x7, x8, x9) is the first 128 bits of a 192-bit nonce
+
+     Except iv has been shifted by 64 bits so there are now only 128 bits ahead.
+  */
+  ctx->st.d[ 8] += load_le32(iv + 0);
+  ctx->st.d[ 9] += load_le32(iv + 4);
 
   /* Compute (z0, z1, . . . , z15) = doubleround ^(r/2) (x0, x1, . . . , x15) */
   block hSalsa;
   memset(&hSalsa, 0, sizeof(block));
-  cryptonite_salsa_core_xor(nb_rounds, &hSalsa, &ctx->st);
+  cryptonite_salsa_core_xor(ctx->nb_rounds, &hSalsa, &ctx->st);
  
   /* Build a new 512-bit input block (x′0, x′1, . . . , x′15):
        (x′0, x′5, x′10, x′15) is the Salsa20 constant
@@ -69,8 +83,8 @@ void cryptonite_xsalsa_init(cryptonite_salsa_context *ctx, uint8_t nb_rounds,
   ctx->st.d[12] = hSalsa.d[ 7] - ctx->st.d[ 7];
   ctx->st.d[13] = hSalsa.d[ 8] - ctx->st.d[ 8];
   ctx->st.d[14] = hSalsa.d[ 9] - ctx->st.d[ 9];
-  ctx->st.d[ 6] = load_le32(iv + 16);
-  ctx->st.d[ 7] = load_le32(iv + 20);
+  ctx->st.d[ 6] = load_le32(iv + 8);
+  ctx->st.d[ 7] = load_le32(iv + 12);
   ctx->st.d[ 8] = 0;
   ctx->st.d[ 9] = 0;
 }

cbits/cryptonite_xsalsa.h

@@ -33,5 +33,6 @@
 #include "cryptonite_salsa.h"
 
 void cryptonite_xsalsa_init(cryptonite_salsa_context *ctx, uint8_t nb_rounds, uint32_t keylen, const uint8_t *key, uint32_t ivlen, const uint8_t *iv);
+void cryptonite_xsalsa_derive(cryptonite_salsa_context *ctx, uint32_t ivlen, const uint8_t *iv);
 
 #endif

tests/XSalsa.hs

@@ -98,11 +98,31 @@ vectors =
        , "\xB2\xB7\x95\xFE\x6C\x1D\x4C\x83\xC1\x32\x7E\x01\x5A\x67\xD4\x46\x5F\xD8\xE3\x28\x13\x57\x5C\xBA\xB2\x63\xE2\x0E\xF0\x58\x64\xD2\xDC\x17\xE0\xE4\xEB\x81\x43\x6A\xDF\xE9\xF6\x38\xDC\xC1\xC8\xD7\x8F\x6B\x03\x06\xBA\xF9\x38\xE5\xD2\xAB\x0B\x3E\x05\xE7\x35\xCC\x6F\xFF\x2D\x6E\x02\xE3\xD6\x04\x84\xBE\xA7\xC7\xA8\xE1\x3E\x23\x19\x7F\xEA\x7B\x04\xD4\x7D\x48\xF4\xA4\xE5\x94\x41\x74\x53\x94\x92\x80\x0D\x3E\xF5\x1E\x2E\xE5\xE4\xC8\xA0\xBD\xF0\x50\xC2\xDD\x3D\xD7\x4F\xCE\x5E\x7E\x5C\x37\x36\x4F\x75\x47\xA1\x14\x80\xA3\x06\x3B\x9A\x0A\x15\x7B\x15\xB1\x0A\x5A\x95\x4D\xE2\x73\x1C\xED\x05\x5A\xA2\xE2\x76\x7F\x08\x91\xD4\x32\x9C\x42\x6F\x38\x08\xEE\x86\x7B\xED\x0D\xC7\x5B\x59\x22\xB7\xCF\xB8\x95\x70\x0F\xDA\x01\x61\x05\xA4\xC7\xB7\xF0\xBB\x90\xF0\x29\xF6\xBB\xCB\x04\xAC\x36\xAC\x16") 
     ]
 
+-- Test vector from paper "Cryptography in NaCl"
+vectorsCB :: [Vector]
+vectorsCB =
+    [ ( 20
+       , "\x4A\x5D\x9D\x5B\xA4\xCE\x2D\xE1\x72\x8E\x3B\xF4\x80\x35\x0F\x25\xE0\x7E\x21\xC9\x47\xD1\x9E\x33\x76\xF0\x9B\x3C\x1E\x16\x17\x42"
+       , "\x69\x69\x6E\xE9\x55\xB6\x2B\x73\xCD\x62\xBD\xA8\x75\xFC\x73\xD6\x82\x19\xE0\x03\x6B\x7A\x0B\x37"
+       , "\xBE\x07\x5F\xC5\x3C\x81\xF2\xD5\xCF\x14\x13\x16\xEB\xEB\x0C\x7B\x52\x28\xC5\x2A\x4C\x62\xCB\xD4\x4B\x66\x84\x9B\x64\x24\x4F\xFC\xE5\xEC\xBA\xAF\x33\xBD\x75\x1A\x1A\xC7\x28\xD4\x5E\x6C\x61\x29\x6C\xDC\x3C\x01\x23\x35\x61\xF4\x1D\xB6\x6C\xCE\x31\x4A\xDB\x31\x0E\x3B\xE8\x25\x0C\x46\xF0\x6D\xCE\xEA\x3A\x7F\xA1\x34\x80\x57\xE2\xF6\x55\x6A\xD6\xB1\x31\x8A\x02\x4A\x83\x8F\x21\xAF\x1F\xDE\x04\x89\x77\xEB\x48\xF5\x9F\xFD\x49\x24\xCA\x1C\x60\x90\x2E\x52\xF0\xA0\x89\xBC\x76\x89\x70\x40\xE0\x82\xF9\x37\x76\x38\x48\x64\x5E\x07\x05"
+       , "\x8E\x99\x3B\x9F\x48\x68\x12\x73\xC2\x96\x50\xBA\x32\xFC\x76\xCE\x48\x33\x2E\xA7\x16\x4D\x96\xA4\x47\x6F\xB8\xC5\x31\xA1\x18\x6A\xC0\xDF\xC1\x7C\x98\xDC\xE8\x7B\x4D\xA7\xF0\x11\xEC\x48\xC9\x72\x71\xD2\xC2\x0F\x9B\x92\x8F\xE2\x27\x0D\x6F\xB8\x63\xD5\x17\x38\xB4\x8E\xEE\xE3\x14\xA7\xCC\x8A\xB9\x32\x16\x45\x48\xE5\x26\xAE\x90\x22\x43\x68\x51\x7A\xCF\xEA\xBD\x6B\xB3\x73\x2B\xC0\xE9\xDA\x99\x83\x2B\x61\xCA\x01\xB6\xDE\x56\x24\x4A\x9E\x88\xD5\xF9\xB3\x79\x73\xF6\x22\xA4\x3D\x14\xA6\x59\x9B\x1F\x65\x4C\xB4\x5A\x74\xE3\x55\xA5")
+    ]
+
 tests = testGroup "XSalsa"
     [ testGroup "KAT" $
         map (\(i,f) -> testCase (show (i :: Int)) f) $ zip [1..] $ map (\(r, k, i, p, e) -> salsaRunSimple r k i p e) vectors
+    , testGroup "crypto_box encryption" $
+        map (\(i,f) -> testCase (show (i :: Int)) f) $ zip [1..] $ map (\(r, k, i, p, e) -> cryptoBoxEnc r k i p e) vectorsCB
     ]
   where
       salsaRunSimple rounds key nonce plain expected =
           let salsa = XSalsa.initialize rounds key nonce
           in fst (XSalsa.combine salsa plain) @?= expected
+
+      cryptoBoxEnc rounds shared nonce plain expected =
+          let zero        = B.replicate 16 0
+              (iv0, iv1)  = B.splitAt 8 nonce
+              salsa0      = XSalsa.initialize rounds shared (zero `B.append` iv0)
+              salsa1      = XSalsa.derive salsa0 iv1
+              (_, salsa2) = XSalsa.generate salsa1 32 :: (B.ByteString, XSalsa.State)
+          in fst (XSalsa.combine salsa2 plain) @?= expected