{-# LINE 1 "Bindings/Nettle/Cipher/Camellia.hsc" #-}
{-# LANGUAGE ForeignFunctionInterface #-}




module Bindings.Nettle.Cipher.Camellia where
import Foreign.Ptr (Ptr,FunPtr,plusPtr)
import Foreign.Ptr (wordPtrToPtr,castPtrToFunPtr)
import Foreign.Storable
import Foreign.C.Types
import Foreign.C.String (CString,CStringLen,CWString,CWStringLen)
import Foreign.Marshal.Alloc (alloca)
import Foreign.Marshal.Array (peekArray,pokeArray)
import Data.Int
import Data.Word

{-# LINE 8 "Bindings/Nettle/Cipher/Camellia.hsc" #-}

c'CAMELLIA_BLOCK_SIZE = 16
c'CAMELLIA_BLOCK_SIZE :: (Num a) => a

{-# LINE 10 "Bindings/Nettle/Cipher/Camellia.hsc" #-}
c'CAMELLIA128_KEY_SIZE = 16
c'CAMELLIA128_KEY_SIZE :: (Num a) => a

{-# LINE 11 "Bindings/Nettle/Cipher/Camellia.hsc" #-}
c'CAMELLIA192_KEY_SIZE = 24
c'CAMELLIA192_KEY_SIZE :: (Num a) => a

{-# LINE 12 "Bindings/Nettle/Cipher/Camellia.hsc" #-}
c'CAMELLIA256_KEY_SIZE = 32
c'CAMELLIA256_KEY_SIZE :: (Num a) => a

{-# LINE 13 "Bindings/Nettle/Cipher/Camellia.hsc" #-}


{-# LINE 15 "Bindings/Nettle/Cipher/Camellia.hsc" #-}
data C'camellia128_ctx = C'camellia128_ctx{
} deriving (Eq,Show)
instance Storable C'camellia128_ctx where
  sizeOf _ = 192
  alignment _ = 8
  peek _p = do
    return $ C'camellia128_ctx
  poke _p (C'camellia128_ctx) = do
    return ()

{-# LINE 16 "Bindings/Nettle/Cipher/Camellia.hsc" #-}


{-# LINE 18 "Bindings/Nettle/Cipher/Camellia.hsc" #-}
data C'camellia256_ctx = C'camellia256_ctx{
} deriving (Eq,Show)
instance Storable C'camellia256_ctx where
  sizeOf _ = 256
  alignment _ = 8
  peek _p = do
    return $ C'camellia256_ctx
  poke _p (C'camellia256_ctx) = do
    return ()

{-# LINE 19 "Bindings/Nettle/Cipher/Camellia.hsc" #-}

foreign import ccall "nettle_camellia128_set_encrypt_key" c'nettle_camellia128_set_encrypt_key
  :: Ptr C'camellia128_ctx -> CUInt -> Ptr CUChar -> IO ()
foreign import ccall "&nettle_camellia128_set_encrypt_key" p'nettle_camellia128_set_encrypt_key
  :: FunPtr (Ptr C'camellia128_ctx -> CUInt -> Ptr CUChar -> IO ())

{-# LINE 21 "Bindings/Nettle/Cipher/Camellia.hsc" #-}
foreign import ccall "nettle_camellia_set_decrypt_key" c'nettle_camellia_set_decrypt_key
  :: Ptr C'camellia128_ctx -> CUInt -> Ptr CUChar -> IO ()
foreign import ccall "&nettle_camellia_set_decrypt_key" p'nettle_camellia_set_decrypt_key
  :: FunPtr (Ptr C'camellia128_ctx -> CUInt -> Ptr CUChar -> IO ())

{-# LINE 22 "Bindings/Nettle/Cipher/Camellia.hsc" #-}
foreign import ccall "nettle_camellia128_invert_key" c'nettle_camellia128_invert_key
  :: Ptr C'camellia128_ctx -> Ptr C'camellia128_ctx -> IO ()
foreign import ccall "&nettle_camellia128_invert_key" p'nettle_camellia128_invert_key
  :: FunPtr (Ptr C'camellia128_ctx -> Ptr C'camellia128_ctx -> IO ())

{-# LINE 23 "Bindings/Nettle/Cipher/Camellia.hsc" #-}
foreign import ccall "nettle_camellia128_crypt" c'nettle_camellia128_crypt
  :: Ptr C'camellia128_ctx -> CUInt -> Ptr CUChar -> Ptr CUChar -> IO ()
foreign import ccall "&nettle_camellia128_crypt" p'nettle_camellia128_crypt
  :: FunPtr (Ptr C'camellia128_ctx -> CUInt -> Ptr CUChar -> Ptr CUChar -> IO ())

{-# LINE 24 "Bindings/Nettle/Cipher/Camellia.hsc" #-}

foreign import ccall "nettle_camellia192_set_encrypt_key" c'nettle_camellia192_set_encrypt_key
  :: Ptr C'camellia256_ctx -> CUInt -> Ptr CUChar -> IO ()
foreign import ccall "&nettle_camellia192_set_encrypt_key" p'nettle_camellia192_set_encrypt_key
  :: FunPtr (Ptr C'camellia256_ctx -> CUInt -> Ptr CUChar -> IO ())

{-# LINE 26 "Bindings/Nettle/Cipher/Camellia.hsc" #-}
foreign import ccall "nettle_camellia192_set_decrypt_key" c'nettle_camellia192_set_decrypt_key
  :: Ptr C'camellia256_ctx -> CUInt -> Ptr CUChar -> IO ()
foreign import ccall "&nettle_camellia192_set_decrypt_key" p'nettle_camellia192_set_decrypt_key
  :: FunPtr (Ptr C'camellia256_ctx -> CUInt -> Ptr CUChar -> IO ())

{-# LINE 27 "Bindings/Nettle/Cipher/Camellia.hsc" #-}

foreign import ccall "nettle_camellia256_set_encrypt_key" c'nettle_camellia256_set_encrypt_key
  :: Ptr C'camellia256_ctx -> CUInt -> Ptr CUChar -> IO ()
foreign import ccall "&nettle_camellia256_set_encrypt_key" p'nettle_camellia256_set_encrypt_key
  :: FunPtr (Ptr C'camellia256_ctx -> CUInt -> Ptr CUChar -> IO ())

{-# LINE 29 "Bindings/Nettle/Cipher/Camellia.hsc" #-}
foreign import ccall "nettle_camellia256_set_decrypt_key" c'nettle_camellia256_set_decrypt_key
  :: Ptr C'camellia256_ctx -> CUInt -> Ptr CUChar -> IO ()
foreign import ccall "&nettle_camellia256_set_decrypt_key" p'nettle_camellia256_set_decrypt_key
  :: FunPtr (Ptr C'camellia256_ctx -> CUInt -> Ptr CUChar -> IO ())

{-# LINE 30 "Bindings/Nettle/Cipher/Camellia.hsc" #-}
foreign import ccall "nettle_camellia256_invert_key" c'nettle_camellia256_invert_key
  :: Ptr C'camellia256_ctx -> Ptr C'camellia256_ctx -> IO ()
foreign import ccall "&nettle_camellia256_invert_key" p'nettle_camellia256_invert_key
  :: FunPtr (Ptr C'camellia256_ctx -> Ptr C'camellia256_ctx -> IO ())

{-# LINE 31 "Bindings/Nettle/Cipher/Camellia.hsc" #-}
foreign import ccall "nettle_camellia256_crypt" c'nettle_camellia256_crypt
  :: Ptr C'camellia256_ctx -> CUInt -> Ptr CUChar -> Ptr CUChar -> IO ()
foreign import ccall "&nettle_camellia256_crypt" p'nettle_camellia256_crypt
  :: FunPtr (Ptr C'camellia256_ctx -> CUInt -> Ptr CUChar -> Ptr CUChar -> IO ())

{-# LINE 32 "Bindings/Nettle/Cipher/Camellia.hsc" #-}