{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Crypto.Cipher.RC4
( initialize
, combine
, generate
, State
) where
import Data.Word
import Foreign.Ptr
import Crypto.Internal.ByteArray (ScrubbedBytes, ByteArray, ByteArrayAccess)
import qualified Crypto.Internal.ByteArray as B
import Crypto.Internal.Compat
import Crypto.Internal.Imports
newtype State = State ScrubbedBytes
deriving (State -> Int
forall p. State -> Ptr p -> IO ()
forall ba.
(ba -> Int)
-> (forall p a. ba -> (Ptr p -> IO a) -> IO a)
-> (forall p. ba -> Ptr p -> IO ())
-> ByteArrayAccess ba
forall p a. State -> (Ptr p -> IO a) -> IO a
copyByteArrayToPtr :: forall p. State -> Ptr p -> IO ()
$ccopyByteArrayToPtr :: forall p. State -> Ptr p -> IO ()
withByteArray :: forall p a. State -> (Ptr p -> IO a) -> IO a
$cwithByteArray :: forall p a. State -> (Ptr p -> IO a) -> IO a
length :: State -> Int
$clength :: State -> Int
ByteArrayAccess,State -> ()
forall a. (a -> ()) -> NFData a
rnf :: State -> ()
$crnf :: State -> ()
NFData)
foreign import ccall unsafe "cryptonite_rc4.h cryptonite_rc4_init"
c_rc4_init :: Ptr Word8
-> Word32
-> Ptr State
-> IO ()
foreign import ccall unsafe "cryptonite_rc4.h cryptonite_rc4_combine"
c_rc4_combine :: Ptr State
-> Ptr Word8
-> Word32
-> Ptr Word8
-> IO ()
initialize :: ByteArrayAccess key
=> key
-> State
initialize :: forall key. ByteArrayAccess key => key -> State
initialize key
key = forall a. IO a -> a
unsafeDoIO forall a b. (a -> b) -> a -> b
$ do
ScrubbedBytes
st <- forall ba p. ByteArray ba => Int -> (Ptr p -> IO ()) -> IO ba
B.alloc Int
264 forall a b. (a -> b) -> a -> b
$ \Ptr Any
stPtr ->
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
B.withByteArray key
key forall a b. (a -> b) -> a -> b
$ \Ptr Word8
keyPtr -> Ptr Word8 -> Word32 -> Ptr State -> IO ()
c_rc4_init Ptr Word8
keyPtr (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall ba. ByteArrayAccess ba => ba -> Int
B.length key
key) (forall a b. Ptr a -> Ptr b
castPtr Ptr Any
stPtr)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ScrubbedBytes -> State
State ScrubbedBytes
st
generate :: ByteArray ba => State -> Int -> (State, ba)
generate :: forall ba. ByteArray ba => State -> Int -> (State, ba)
generate State
ctx Int
len = forall ba. ByteArray ba => State -> ba -> (State, ba)
combine State
ctx (forall ba. ByteArray ba => Int -> ba
B.zero Int
len)
combine :: ByteArray ba
=> State
-> ba
-> (State, ba)
combine :: forall ba. ByteArray ba => State -> ba -> (State, ba)
combine (State ScrubbedBytes
prevSt) ba
clearText = forall a. IO a -> a
unsafeDoIO forall a b. (a -> b) -> a -> b
$
forall ba p a. ByteArray ba => Int -> (Ptr p -> IO a) -> IO (a, ba)
B.allocRet Int
len forall a b. (a -> b) -> a -> b
$ \Ptr Word8
outptr ->
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
B.withByteArray ba
clearText forall a b. (a -> b) -> a -> b
$ \Ptr Word8
clearPtr -> do
ScrubbedBytes
st <- forall bs1 bs2 p.
(ByteArrayAccess bs1, ByteArray bs2) =>
bs1 -> (Ptr p -> IO ()) -> IO bs2
B.copy ScrubbedBytes
prevSt forall a b. (a -> b) -> a -> b
$ \Ptr Any
stPtr ->
Ptr State -> Ptr Word8 -> Word32 -> Ptr Word8 -> IO ()
c_rc4_combine (forall a b. Ptr a -> Ptr b
castPtr Ptr Any
stPtr) Ptr Word8
clearPtr (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len) Ptr Word8
outptr
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! ScrubbedBytes -> State
State ScrubbedBytes
st
where len :: Int
len = forall ba. ByteArrayAccess ba => ba -> Int
B.length ba
clearText