1-- |
2-- Module      : Crypto.Cipher.XSalsa
3-- License     : BSD-style
4-- Maintainer  : Brandon Hamilton <brandon.hamilton@gmail.com>
5-- Stability   : stable
6-- Portability : good
7--
8-- Implementation of XSalsa20 algorithm
9-- <https://cr.yp.to/snuffle/xsalsa-20081128.pdf>
10-- Based on the Salsa20 algorithm with 256 bit key extended with 192 bit nonce
11
12{-# LANGUAGE ForeignFunctionInterface #-}
13module Crypto.Cipher.XSalsa
14    ( initialize
15    , derive
16    , combine
17    , generate
18    , State
19    ) where
20
21import           Crypto.Internal.ByteArray (ByteArrayAccess)
22import qualified Crypto.Internal.ByteArray as B
23import           Crypto.Internal.Compat
24import           Crypto.Internal.Imports
25import           Foreign.Ptr
26import           Crypto.Cipher.Salsa hiding (initialize)
27
28-- | Initialize a new XSalsa context with the number of rounds,
29-- the key and the nonce associated.
30initialize :: (ByteArrayAccess key, ByteArrayAccess nonce)
31           => Int    -- ^ number of rounds (8,12,20)
32           -> key    -- ^ the key (256 bits)
33           -> nonce  -- ^ the nonce (192 bits)
34           -> State  -- ^ the initial XSalsa state
35initialize nbRounds key nonce
36    | kLen /= 32                      = error "XSalsa: key length should be 256 bits"
37    | nonceLen /= 24                  = error "XSalsa: nonce length should be 192 bits"
38    | nbRounds `notElem` [8,12,20]    = error "XSalsa: rounds should be 8, 12 or 20"
39    | otherwise = unsafeDoIO $ do
40        stPtr <- B.alloc 132 $ \stPtr ->
41            B.withByteArray nonce $ \noncePtr  ->
42            B.withByteArray key   $ \keyPtr ->
43                ccryptonite_xsalsa_init stPtr nbRounds kLen keyPtr nonceLen noncePtr
44        return $ State stPtr
45  where kLen     = B.length key
46        nonceLen = B.length nonce
47
48-- | Use an already initialized context and new nonce material to derive another
49-- XSalsa context.
50--
51-- This allows a multi-level cascade where a first key @k1@ and nonce @n1@ is
52-- used to get @HState(k1,n1)@, and this value is then used as key @k2@ to build
53-- @XSalsa(k2,n2)@.  Function 'initialize' is to be called with the first 192
54-- bits of @n1|n2@, and the call to @derive@ should add the remaining 128 bits.
55--
56-- The output context always uses the same number of rounds as the input
57-- context.
58derive :: ByteArrayAccess nonce
59       => State  -- ^ base XSalsa state
60       -> nonce  -- ^ the remainder nonce (128 bits)
61       -> State  -- ^ the new XSalsa state
62derive (State stPtr') nonce
63    | nonceLen /= 16 = error "XSalsa: nonce length should be 128 bits"
64    | otherwise = unsafeDoIO $ do
65        stPtr <- B.copy stPtr' $ \stPtr ->
66            B.withByteArray nonce $ \noncePtr  ->
67                ccryptonite_xsalsa_derive stPtr nonceLen noncePtr
68        return $ State stPtr
69  where nonceLen = B.length nonce
70
71foreign import ccall "cryptonite_xsalsa_init"
72    ccryptonite_xsalsa_init :: Ptr State -> Int -> Int -> Ptr Word8 -> Int -> Ptr Word8 -> IO ()
73
74foreign import ccall "cryptonite_xsalsa_derive"
75    ccryptonite_xsalsa_derive :: Ptr State -> Int -> Ptr Word8 -> IO ()
76