1-- |
2-- Module      : Crypto.Cipher.Salsa
3-- License     : BSD-style
4-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
5-- Stability   : stable
6-- Portability : good
7--
8{-# LANGUAGE ForeignFunctionInterface #-}
9{-# LANGUAGE GeneralizedNewtypeDeriving #-}
10module Crypto.Cipher.Salsa
11    ( initialize
12    , combine
13    , generate
14    , State(..)
15    ) where
16
17import           Crypto.Internal.ByteArray (ByteArrayAccess, ByteArray, ScrubbedBytes)
18import qualified Crypto.Internal.ByteArray as B
19import           Crypto.Internal.Compat
20import           Crypto.Internal.Imports
21import           Foreign.Ptr
22import           Foreign.C.Types
23
24-- | Salsa context
25newtype State = State ScrubbedBytes
26    deriving (NFData)
27
28-- | Initialize a new Salsa 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 (128 or 256 bits)
33           -> nonce  -- ^ the nonce (64 or 96 bits)
34           -> State  -- ^ the initial Salsa state
35initialize nbRounds key nonce
36    | kLen `notElem` [16,32]          = error "Salsa: key length should be 128 or 256 bits"
37    | nonceLen `notElem` [8,12]       = error "Salsa: nonce length should be 64 or 96 bits"
38    | nbRounds `notElem` [8,12,20]    = error "Salsa: 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_salsa_init stPtr nbRounds kLen keyPtr nonceLen noncePtr
44        return $ State stPtr
45  where kLen     = B.length key
46        nonceLen = B.length nonce
47
48-- | Combine the salsa output and an arbitrary message with a xor,
49-- and return the combined output and the new state.
50combine :: ByteArray ba
51        => State      -- ^ the current Salsa state
52        -> ba         -- ^ the source to xor with the generator
53        -> (ba, State)
54combine prevSt@(State prevStMem) src
55    | B.null src = (B.empty, prevSt)
56    | otherwise  = unsafeDoIO $ do
57        (out, st) <- B.copyRet prevStMem $ \ctx ->
58            B.alloc (B.length src) $ \dstPtr ->
59            B.withByteArray src    $ \srcPtr -> do
60                ccryptonite_salsa_combine dstPtr ctx srcPtr (fromIntegral $ B.length src)
61        return (out, State st)
62
63-- | Generate a number of bytes from the Salsa output directly
64generate :: ByteArray ba
65         => State -- ^ the current Salsa state
66         -> Int   -- ^ the length of data to generate
67         -> (ba, State)
68generate prevSt@(State prevStMem) len
69    | len <= 0  = (B.empty, prevSt)
70    | otherwise = unsafeDoIO $ do
71        (out, st) <- B.copyRet prevStMem $ \ctx ->
72            B.alloc len $ \dstPtr ->
73                ccryptonite_salsa_generate dstPtr ctx (fromIntegral len)
74        return (out, State st)
75
76foreign import ccall "cryptonite_salsa_init"
77    ccryptonite_salsa_init :: Ptr State -> Int -> Int -> Ptr Word8 -> Int -> Ptr Word8 -> IO ()
78
79foreign import ccall "cryptonite_salsa_combine"
80    ccryptonite_salsa_combine :: Ptr Word8 -> Ptr State -> Ptr Word8 -> CUInt -> IO ()
81
82foreign import ccall "cryptonite_salsa_generate"
83    ccryptonite_salsa_generate :: Ptr Word8 -> Ptr State -> CUInt -> IO ()
84