1-- |
2-- Module      : Crypto.Cipher.RC4
3-- License     : BSD-style
4-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
5-- Stability   : stable
6-- Portability : Good
7--
8-- Simple implementation of the RC4 stream cipher.
9-- http://en.wikipedia.org/wiki/RC4
10--
11-- Initial FFI implementation by Peter White <peter@janrain.com>
12--
13-- Reorganized and simplified to have an opaque context.
14--
15{-# LANGUAGE ForeignFunctionInterface #-}
16{-# LANGUAGE GeneralizedNewtypeDeriving #-}
17module Crypto.Cipher.RC4
18    ( initialize
19    , combine
20    , generate
21    , State
22    ) where
23
24import           Data.Word
25import           Foreign.Ptr
26import           Crypto.Internal.ByteArray (ScrubbedBytes, ByteArray, ByteArrayAccess)
27import qualified Crypto.Internal.ByteArray as B
28
29import           Crypto.Internal.Compat
30import           Crypto.Internal.Imports
31
32-- | The encryption state for RC4
33--
34-- This type is an instance of 'ByteArrayAccess' for debugging purpose. Internal
35-- layout is architecture dependent, may contain uninitialized data fragments,
36-- and change in future versions.  The bytearray should not be used as input to
37-- cryptographic algorithms.
38newtype State = State ScrubbedBytes
39    deriving (ByteArrayAccess,NFData)
40
41-- | C Call for initializing the encryptor
42foreign import ccall unsafe "cryptonite_rc4.h cryptonite_rc4_init"
43    c_rc4_init :: Ptr Word8 -- ^ The rc4 key
44               -> Word32    -- ^ The key length
45               -> Ptr State -- ^ The context
46               -> IO ()
47
48foreign import ccall unsafe "cryptonite_rc4.h cryptonite_rc4_combine"
49    c_rc4_combine :: Ptr State        -- ^ Pointer to the permutation
50                  -> Ptr Word8      -- ^ Pointer to the clear text
51                  -> Word32         -- ^ Length of the clear text
52                  -> Ptr Word8      -- ^ Output buffer
53                  -> IO ()
54
55-- | RC4 context initialization.
56--
57-- seed the context with an initial key. the key size need to be
58-- adequate otherwise security takes a hit.
59initialize :: ByteArrayAccess key
60           => key   -- ^ The key
61           -> State -- ^ The RC4 context with the key mixed in
62initialize key = unsafeDoIO $ do
63    st <- B.alloc 264 $ \stPtr ->
64        B.withByteArray key $ \keyPtr -> c_rc4_init keyPtr (fromIntegral $ B.length key) (castPtr stPtr)
65    return $ State st
66
67-- | generate the next len bytes of the rc4 stream without combining
68-- it to anything.
69generate :: ByteArray ba => State -> Int -> (State, ba)
70generate ctx len = combine ctx (B.zero len)
71
72-- | RC4 xor combination of the rc4 stream with an input
73combine :: ByteArray ba
74        => State               -- ^ rc4 context
75        -> ba                  -- ^ input
76        -> (State, ba)         -- ^ new rc4 context, and the output
77combine (State prevSt) clearText = unsafeDoIO $
78    B.allocRet len            $ \outptr ->
79    B.withByteArray clearText $ \clearPtr -> do
80        st <- B.copy prevSt $ \stPtr ->
81                c_rc4_combine (castPtr stPtr) clearPtr (fromIntegral len) outptr
82        return $! State st
83    --return $! (State st, B.PS outfptr 0 len)
84  where len = B.length clearText
85