{-# LANGUAGE ForeignFunctionInterface, CPP #-}
-- |
-- Module      : Crypto.Cipher.RC4
-- License     : BSD-style
-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
-- Stability   : stable
-- Portability : Good
--
-- Simple implementation of the RC4 stream cipher.
-- http://en.wikipedia.org/wiki/RC4
--
-- Initial FFI implementation by Peter White <peter@janrain.com>
--
-- Reorganized and simplified to have an opaque context.
--
module Crypto.Cipher.RC4
    (
      RC4
    -- * deprecated types
    , Ctx(..)
    -- * deprecated functions, use crypto-cipher-types StreamCipher function
    , initCtx
    , generate
    , combine
    , encrypt
    , decrypt
    ) where

import Data.Word
import Data.Byteable
import Foreign.Ptr
import Foreign.ForeignPtr
import System.IO.Unsafe
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Internal as B
import Control.Applicative ((<$>))
import Crypto.Cipher.Types

----------------------------------------------------------------------
unsafeDoIO :: IO a -> a
#if __GLASGOW_HASKELL__ > 704
unsafeDoIO :: IO a -> a
unsafeDoIO = IO a -> a
forall a. IO a -> a
unsafeDupablePerformIO
#else
unsafeDoIO = unsafePerformIO
#endif

-- | RC4 Stream cipher
newtype RC4 = RC4 Ctx

instance Byteable RC4 where
    toBytes :: RC4 -> ByteString
toBytes (RC4 (Ctx b :: ByteString
b)) = ByteString
b

instance Cipher RC4 where
    cipherInit :: Key RC4 -> RC4
cipherInit key :: Key RC4
key  = Ctx -> RC4
RC4 (ByteString -> Ctx
initCtx (ByteString -> Ctx) -> ByteString -> Ctx
forall a b. (a -> b) -> a -> b
$ Key RC4 -> ByteString
forall a. Byteable a => a -> ByteString
toBytes Key RC4
key)
    cipherName :: RC4 -> String
cipherName _    = "RC4"
    cipherKeySize :: RC4 -> KeySizeSpecifier
cipherKeySize _ = Int -> Int -> KeySizeSpecifier
KeySizeRange 1 1024

instance StreamCipher RC4 where
    streamCombine :: RC4 -> ByteString -> (ByteString, RC4)
streamCombine (RC4 ctx :: Ctx
ctx) b :: ByteString
b = (\(ctx2 :: Ctx
ctx2, r :: ByteString
r) -> (ByteString
r, Ctx -> RC4
RC4 Ctx
ctx2)) ((Ctx, ByteString) -> (ByteString, RC4))
-> (Ctx, ByteString) -> (ByteString, RC4)
forall a b. (a -> b) -> a -> b
$ Ctx -> ByteString -> (Ctx, ByteString)
combine Ctx
ctx ByteString
b

-- | The encryption context for RC4
newtype Ctx = Ctx B.ByteString

instance Show Ctx where
    show :: Ctx -> String
show _ = "RC4.Ctx"

-- | C Call for initializing the encryptor
foreign import ccall unsafe "rc4.h rc4_init"
    c_rc4_init :: Ptr Word8 -- ^ The rc4 key
               -> Word32    -- ^ The key length
               -> Ptr Ctx   -- ^ The context
               -> IO ()

foreign import ccall unsafe "rc4.h rc4_combine"
    c_rc4_combine :: Ptr Ctx        -- ^ Pointer to the permutation
                  -> Ptr Word8      -- ^ Pointer to the clear text
                  -> Word32         -- ^ Length of the clear text
                  -> Ptr Word8      -- ^ Output buffer
                  -> IO ()

withByteStringPtr :: ByteString -> (Ptr Word8 -> IO a) -> IO a
withByteStringPtr :: ByteString -> (Ptr Word8 -> IO a) -> IO a
withByteStringPtr b :: ByteString
b f :: Ptr Word8 -> IO a
f = ForeignPtr Word8 -> (Ptr Word8 -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fptr ((Ptr Word8 -> IO a) -> IO a) -> (Ptr Word8 -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr Word8
ptr -> Ptr Word8 -> IO a
f (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
off)
    where (fptr :: ForeignPtr Word8
fptr, off :: Int
off, _) = ByteString -> (ForeignPtr Word8, Int, Int)
B.toForeignPtr ByteString
b

-- | RC4 context initialization.
--
-- seed the context with an initial key. the key size need to be
-- adequate otherwise security takes a hit.
initCtx :: B.ByteString -- ^ The key
        -> Ctx          -- ^ The RC4 context with the key mixed in
initCtx :: ByteString -> Ctx
initCtx key :: ByteString
key = IO Ctx -> Ctx
forall a. IO a -> a
unsafeDoIO (IO Ctx -> Ctx) -> IO Ctx -> Ctx
forall a b. (a -> b) -> a -> b
$
    ByteString -> Ctx
Ctx (ByteString -> Ctx) -> IO ByteString -> IO Ctx
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> (Ptr Word8 -> IO ()) -> IO ByteString
B.create 264 ((Ptr Word8 -> IO ()) -> IO ByteString)
-> (Ptr Word8 -> IO ()) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \ctx :: Ptr Word8
ctx -> ByteString -> (CStringLen -> IO ()) -> IO ()
forall a. ByteString -> (CStringLen -> IO a) -> IO a
B.useAsCStringLen ByteString
key ((CStringLen -> IO ()) -> IO ()) -> (CStringLen -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(keyPtr :: Ptr CChar
keyPtr,keyLen :: Int
keyLen) -> Ptr Word8 -> Word32 -> Ptr Ctx -> IO ()
c_rc4_init (Ptr CChar -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
keyPtr) (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
keyLen) (Ptr Word8 -> Ptr Ctx
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
ctx))

-- | generate the next len bytes of the rc4 stream without combining
-- it to anything.
generate :: Ctx -> Int -> (Ctx, B.ByteString)
generate :: Ctx -> Int -> (Ctx, ByteString)
generate ctx :: Ctx
ctx len :: Int
len = Ctx -> ByteString -> (Ctx, ByteString)
combine Ctx
ctx (Int -> Word8 -> ByteString
B.replicate Int
len 0)

-- | RC4 xor combination of the rc4 stream with an input
combine :: Ctx                 -- ^ rc4 context
        -> B.ByteString        -- ^ input
        -> (Ctx, B.ByteString) -- ^ new rc4 context, and the output
combine :: Ctx -> ByteString -> (Ctx, ByteString)
combine (Ctx cctx :: ByteString
cctx) clearText :: ByteString
clearText = IO (Ctx, ByteString) -> (Ctx, ByteString)
forall a. IO a -> a
unsafeDoIO (IO (Ctx, ByteString) -> (Ctx, ByteString))
-> IO (Ctx, ByteString) -> (Ctx, ByteString)
forall a b. (a -> b) -> a -> b
$
    Int -> IO (ForeignPtr Word8)
forall a. Int -> IO (ForeignPtr a)
B.mallocByteString 264 IO (ForeignPtr Word8)
-> (ForeignPtr Word8 -> IO (Ctx, ByteString))
-> IO (Ctx, ByteString)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \dctx :: ForeignPtr Word8
dctx ->
    Int -> IO (ForeignPtr Word8)
forall a. Int -> IO (ForeignPtr a)
B.mallocByteString Int
len IO (ForeignPtr Word8)
-> (ForeignPtr Word8 -> IO (Ctx, ByteString))
-> IO (Ctx, ByteString)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \outfptr :: ForeignPtr Word8
outfptr ->
    ByteString
-> (Ptr Word8 -> IO (Ctx, ByteString)) -> IO (Ctx, ByteString)
forall a. ByteString -> (Ptr Word8 -> IO a) -> IO a
withByteStringPtr ByteString
clearText ((Ptr Word8 -> IO (Ctx, ByteString)) -> IO (Ctx, ByteString))
-> (Ptr Word8 -> IO (Ctx, ByteString)) -> IO (Ctx, ByteString)
forall a b. (a -> b) -> a -> b
$ \clearPtr :: Ptr Word8
clearPtr ->
    ByteString
-> (Ptr Word8 -> IO (Ctx, ByteString)) -> IO (Ctx, ByteString)
forall a. ByteString -> (Ptr Word8 -> IO a) -> IO a
withByteStringPtr ByteString
cctx ((Ptr Word8 -> IO (Ctx, ByteString)) -> IO (Ctx, ByteString))
-> (Ptr Word8 -> IO (Ctx, ByteString)) -> IO (Ctx, ByteString)
forall a b. (a -> b) -> a -> b
$ \srcCtx :: Ptr Word8
srcCtx ->
    ForeignPtr Word8
-> (Ptr Word8 -> IO (Ctx, ByteString)) -> IO (Ctx, ByteString)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
dctx ((Ptr Word8 -> IO (Ctx, ByteString)) -> IO (Ctx, ByteString))
-> (Ptr Word8 -> IO (Ctx, ByteString)) -> IO (Ctx, ByteString)
forall a b. (a -> b) -> a -> b
$ \dstCtx :: Ptr Word8
dstCtx -> do
    ForeignPtr Word8
-> (Ptr Word8 -> IO (Ctx, ByteString)) -> IO (Ctx, ByteString)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
outfptr ((Ptr Word8 -> IO (Ctx, ByteString)) -> IO (Ctx, ByteString))
-> (Ptr Word8 -> IO (Ctx, ByteString)) -> IO (Ctx, ByteString)
forall a b. (a -> b) -> a -> b
$ \outptr :: Ptr Word8
outptr -> do
        Ptr Word8 -> Ptr Word8 -> Int -> IO ()
B.memcpy Ptr Word8
dstCtx Ptr Word8
srcCtx 264
        Ptr Ctx -> Ptr Word8 -> Word32 -> Ptr Word8 -> IO ()
c_rc4_combine (Ptr Word8 -> Ptr Ctx
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
dstCtx) Ptr Word8
clearPtr (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len) Ptr Word8
outptr
        (Ctx, ByteString) -> IO (Ctx, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Ctx, ByteString) -> IO (Ctx, ByteString))
-> (Ctx, ByteString) -> IO (Ctx, ByteString)
forall a b. (a -> b) -> a -> b
$! (ByteString -> Ctx
Ctx (ByteString -> Ctx) -> ByteString -> Ctx
forall a b. (a -> b) -> a -> b
$! ForeignPtr Word8 -> Int -> Int -> ByteString
B.PS ForeignPtr Word8
dctx 0 264, ForeignPtr Word8 -> Int -> Int -> ByteString
B.PS ForeignPtr Word8
outfptr 0 Int
len)
    where len :: Int
len = ByteString -> Int
B.length ByteString
clearText

{-# DEPRECATED encrypt "use combine instead" #-}
{-# DEPRECATED decrypt "use combine instead" #-}
encrypt,decrypt :: Ctx -> B.ByteString -> (Ctx, B.ByteString)
encrypt :: Ctx -> ByteString -> (Ctx, ByteString)
encrypt = Ctx -> ByteString -> (Ctx, ByteString)
combine
decrypt :: Ctx -> ByteString -> (Ctx, ByteString)
decrypt = Ctx -> ByteString -> (Ctx, ByteString)
combine