{-# LANGUAGE ForeignFunctionInterface, CPP #-}
module Crypto.Cipher.RC4
(
RC4
, Ctx(..)
, 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
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
newtype Ctx = Ctx B.ByteString
instance Show Ctx where
show :: Ctx -> String
show _ = "RC4.Ctx"
foreign import ccall unsafe "rc4.h rc4_init"
c_rc4_init :: Ptr Word8
-> Word32
-> Ptr Ctx
-> IO ()
foreign import ccall unsafe "rc4.h rc4_combine"
c_rc4_combine :: Ptr Ctx
-> Ptr Word8
-> Word32
-> Ptr Word8
-> 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
initCtx :: B.ByteString
-> Ctx
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 :: 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)
combine :: Ctx
-> B.ByteString
-> (Ctx, B.ByteString)
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