{-# LANGUAGE CPP                      #-}
{-# LANGUAGE ForeignFunctionInterface #-}
-- |An interface to symmetric cipher algorithms.
module OpenSSL.EVP.Cipher
    ( Cipher
    , getCipherByName
    , getCipherNames

    , CryptoMode(..)

    , cipher
    , cipherBS
    , cipherLBS
    , cipherStrictLBS
    )
    where
import qualified Data.ByteString.Char8 as B8
import qualified Data.ByteString.Lazy.Char8 as L8
import Foreign
import Foreign.C
import OpenSSL.Objects
import OpenSSL.EVP.Internal

#if !MIN_VERSION_base(4,8,0)
import Data.Monoid
#endif

foreign import ccall unsafe "EVP_get_cipherbyname"
        _get_cipherbyname :: CString -> IO (Ptr EVP_CIPHER)

-- |@'getCipherByName' name@ returns a symmetric cipher algorithm
-- whose name is @name@. If no algorithms are found, the result is
-- @Nothing@.
getCipherByName :: String -> IO (Maybe Cipher)
getCipherByName :: String -> IO (Maybe Cipher)
getCipherByName String
name
    = String -> (CString -> IO (Maybe Cipher)) -> IO (Maybe Cipher)
forall a. String -> (CString -> IO a) -> IO a
withCString String
name ((CString -> IO (Maybe Cipher)) -> IO (Maybe Cipher))
-> (CString -> IO (Maybe Cipher)) -> IO (Maybe Cipher)
forall a b. (a -> b) -> a -> b
$ \ CString
namePtr ->
      do Ptr EVP_CIPHER
ptr <- CString -> IO (Ptr EVP_CIPHER)
_get_cipherbyname CString
namePtr
         if Ptr EVP_CIPHER
ptr Ptr EVP_CIPHER -> Ptr EVP_CIPHER -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr EVP_CIPHER
forall a. Ptr a
nullPtr then
             Maybe Cipher -> IO (Maybe Cipher)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Cipher
forall a. Maybe a
Nothing
           else
             Maybe Cipher -> IO (Maybe Cipher)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Cipher -> IO (Maybe Cipher))
-> Maybe Cipher -> IO (Maybe Cipher)
forall a b. (a -> b) -> a -> b
$ Cipher -> Maybe Cipher
forall a. a -> Maybe a
Just (Cipher -> Maybe Cipher) -> Cipher -> Maybe Cipher
forall a b. (a -> b) -> a -> b
$ Ptr EVP_CIPHER -> Cipher
Cipher Ptr EVP_CIPHER
ptr

-- |@'getCipherNames'@ returns a list of name of symmetric cipher
-- algorithms.
getCipherNames :: IO [String]
getCipherNames :: IO [String]
getCipherNames = ObjNameType -> Bool -> IO [String]
getObjNames ObjNameType
CipherMethodType Bool
True

{- encrypt/decrypt ----------------------------------------------------------- -}

-- | Encrypt a lazy bytestring in a strict manner. Does not leak the keys.
cipherStrictLBS :: Cipher         -- ^ Cipher
                -> B8.ByteString  -- ^ Key
                -> B8.ByteString  -- ^ IV
                -> CryptoMode     -- ^ Encrypt\/Decrypt
                -> L8.ByteString  -- ^ Input
                -> IO L8.ByteString
cipherStrictLBS :: Cipher
-> ByteString
-> ByteString
-> CryptoMode
-> ByteString
-> IO ByteString
cipherStrictLBS Cipher
c ByteString
key ByteString
iv CryptoMode
mode ByteString
input =
    do CipherCtx
ctx <- Cipher -> ByteString -> ByteString -> CryptoMode -> IO CipherCtx
cipherInitBS Cipher
c ByteString
key ByteString
iv CryptoMode
mode
       [ByteString]
xs  <- CipherCtx -> ByteString -> IO ByteString
cipherUpdateBS CipherCtx
ctx (ByteString -> IO ByteString) -> [ByteString] -> IO [ByteString]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
`mapM` ByteString -> [ByteString]
L8.toChunks ByteString
input
       ByteString
x   <- CipherCtx -> IO ByteString
cipherFinalBS  CipherCtx
ctx
       ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
L8.fromChunks ([ByteString]
xs [ByteString] -> [ByteString] -> [ByteString]
forall a. Monoid a => a -> a -> a
`mappend` [ByteString
x])

-- |@'cipher'@ lazilly encrypts or decrypts a stream of data. The
-- input string doesn't necessarily have to be finite.
cipher :: Cipher     -- ^ algorithm to use
       -> String     -- ^ symmetric key
       -> String     -- ^ IV
       -> CryptoMode -- ^ operation
       -> String     -- ^ An input string to encrypt\/decrypt. Note
                     --   that the string must not contain any letters
                     --   which aren't in the range of U+0000 -
                     --   U+00FF.
       -> IO String  -- ^ the result string
{-# DEPRECATED cipher "Use cipherBS, cipherLBS or cipherStrictLBS." #-}
cipher :: Cipher -> String -> String -> CryptoMode -> String -> IO String
cipher Cipher
c String
key String
iv CryptoMode
mode String
input
    = (ByteString -> String) -> IO ByteString -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> String
L8.unpack (IO ByteString -> IO String) -> IO ByteString -> IO String
forall a b. (a -> b) -> a -> b
$ Cipher
-> ByteString
-> ByteString
-> CryptoMode
-> ByteString
-> IO ByteString
cipherLBS Cipher
c (String -> ByteString
B8.pack String
key) (String -> ByteString
B8.pack String
iv) CryptoMode
mode (String -> ByteString
L8.pack String
input)

-- |@'cipherBS'@ strictly encrypts or decrypts a chunk of data.
cipherBS :: Cipher           -- ^ algorithm to use
         -> B8.ByteString    -- ^ symmetric key
         -> B8.ByteString    -- ^ IV
         -> CryptoMode       -- ^ operation
         -> B8.ByteString    -- ^ input string to encrypt\/decrypt
         -> IO B8.ByteString -- ^ the result string
cipherBS :: Cipher
-> ByteString
-> ByteString
-> CryptoMode
-> ByteString
-> IO ByteString
cipherBS Cipher
c ByteString
key ByteString
iv CryptoMode
mode ByteString
input
    = do CipherCtx
ctx <- Cipher -> ByteString -> ByteString -> CryptoMode -> IO CipherCtx
cipherInitBS Cipher
c ByteString
key ByteString
iv CryptoMode
mode
         CipherCtx -> ByteString -> IO ByteString
cipherStrictly CipherCtx
ctx ByteString
input

-- |@'cipherLBS'@ lazilly encrypts or decrypts a stream of data. The
-- input string doesn't necessarily have to be finite.
cipherLBS :: Cipher           -- ^ algorithm to use
          -> B8.ByteString    -- ^ symmetric key
          -> B8.ByteString    -- ^ IV
          -> CryptoMode       -- ^ operation
          -> L8.ByteString    -- ^ input string to encrypt\/decrypt
          -> IO L8.ByteString -- ^ the result string
cipherLBS :: Cipher
-> ByteString
-> ByteString
-> CryptoMode
-> ByteString
-> IO ByteString
cipherLBS Cipher
c ByteString
key ByteString
iv CryptoMode
mode ByteString
input
    = do CipherCtx
ctx <- Cipher -> ByteString -> ByteString -> CryptoMode -> IO CipherCtx
cipherInitBS Cipher
c ByteString
key ByteString
iv CryptoMode
mode
         CipherCtx -> ByteString -> IO ByteString
cipherLazily CipherCtx
ctx ByteString
input