{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE CApiFFI #-}
module OpenSSL.EVP.Seal
( seal
, sealBS
, sealLBS
)
where
import qualified Data.ByteString.Char8 as B8
import qualified Data.ByteString.Lazy.Char8 as L8
import Foreign
import Foreign.C
import OpenSSL.EVP.Cipher hiding (cipher)
import OpenSSL.EVP.PKey
import OpenSSL.EVP.Internal
import OpenSSL.Utils
foreign import capi unsafe "openssl/evp.h EVP_SealInit"
_SealInit :: Ptr EVP_CIPHER_CTX
-> Cipher
-> Ptr (Ptr CChar)
-> Ptr CInt
-> Ptr CChar
-> Ptr (Ptr EVP_PKEY)
-> CInt
-> IO CInt
sealInit :: Cipher
-> [SomePublicKey]
-> IO (CipherCtx, [B8.ByteString], B8.ByteString)
sealInit :: Cipher
-> [SomePublicKey] -> IO (CipherCtx, [ByteString], ByteString)
sealInit Cipher
_ []
= forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"sealInit: at least one public key is required"
sealInit Cipher
cipher [SomePublicKey]
pubKeys
= do CipherCtx
ctx <- IO CipherCtx
newCipherCtx
[Ptr CChar]
encKeyBufs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall k a. (PKey k, Storable a) => k -> IO (Ptr a)
mallocEncKeyBuf [SomePublicKey]
pubKeys
Ptr (Ptr CChar)
encKeyBufsPtr <- forall a. Storable a => [a] -> IO (Ptr a)
newArray [Ptr CChar]
encKeyBufs
Ptr CInt
encKeyBufsLenPtr <- forall a. Storable a => Int -> IO (Ptr a)
mallocArray Int
nKeys
Ptr CChar
ivPtr <- forall a. Storable a => Int -> IO (Ptr a)
mallocArray (Cipher -> Int
cipherIvLength Cipher
cipher)
[VaguePKey]
pkeys <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall k. PKey k => k -> IO VaguePKey
toPKey [SomePublicKey]
pubKeys
Ptr (Ptr EVP_PKEY)
pubKeysPtr <- forall a. Storable a => [a] -> IO (Ptr a)
newArray forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map VaguePKey -> Ptr EVP_PKEY
unsafePKeyToPtr [VaguePKey]
pkeys
let cleanup :: IO ()
cleanup = do forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall a. Ptr a -> IO ()
free [Ptr CChar]
encKeyBufs
forall a. Ptr a -> IO ()
free Ptr (Ptr CChar)
encKeyBufsPtr
forall a. Ptr a -> IO ()
free Ptr CInt
encKeyBufsLenPtr
forall a. Ptr a -> IO ()
free Ptr CChar
ivPtr
forall a. Ptr a -> IO ()
free Ptr (Ptr EVP_PKEY)
pubKeysPtr
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ VaguePKey -> IO ()
touchPKey [VaguePKey]
pkeys
CInt
ret <- forall a. CipherCtx -> (Ptr EVP_CIPHER_CTX -> IO a) -> IO a
withCipherCtxPtr CipherCtx
ctx forall a b. (a -> b) -> a -> b
$ \ Ptr EVP_CIPHER_CTX
ctxPtr ->
Ptr EVP_CIPHER_CTX
-> Cipher
-> Ptr (Ptr CChar)
-> Ptr CInt
-> Ptr CChar
-> Ptr (Ptr EVP_PKEY)
-> CInt
-> IO CInt
_SealInit Ptr EVP_CIPHER_CTX
ctxPtr Cipher
cipher Ptr (Ptr CChar)
encKeyBufsPtr Ptr CInt
encKeyBufsLenPtr Ptr CChar
ivPtr Ptr (Ptr EVP_PKEY)
pubKeysPtr (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nKeys)
if CInt
ret forall a. Eq a => a -> a -> Bool
== CInt
0 then
IO ()
cleanup forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. IO a
raiseOpenSSLError
else
do [CInt]
encKeysLen <- forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
nKeys Ptr CInt
encKeyBufsLenPtr
[ByteString]
encKeys <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM CStringLen -> IO ByteString
B8.packCStringLen forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [Ptr CChar]
encKeyBufs (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` [CInt]
encKeysLen)
ByteString
iv <- CStringLen -> IO ByteString
B8.packCStringLen (Ptr CChar
ivPtr, Cipher -> Int
cipherIvLength Cipher
cipher)
IO ()
cleanup
forall (m :: * -> *) a. Monad m => a -> m a
return (CipherCtx
ctx, [ByteString]
encKeys, ByteString
iv)
where
nKeys :: Int
nKeys :: Int
nKeys = forall (t :: * -> *) a. Foldable t => t a -> Int
length [SomePublicKey]
pubKeys
mallocEncKeyBuf :: (PKey k, Storable a) => k -> IO (Ptr a)
mallocEncKeyBuf :: forall k a. (PKey k, Storable a) => k -> IO (Ptr a)
mallocEncKeyBuf = forall a. Storable a => Int -> IO (Ptr a)
mallocArray forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k. PKey k => k -> Int
pkeySize
seal :: Cipher
-> [SomePublicKey]
-> String
-> IO ( String
, [String]
, String
)
{-# DEPRECATED seal "Use sealBS or sealLBS instead." #-}
seal :: Cipher
-> [SomePublicKey] -> String -> IO (String, [String], String)
seal Cipher
cipher [SomePublicKey]
pubKeys String
input
= do (ByteString
output, [ByteString]
encKeys, ByteString
iv) <- Cipher
-> [SomePublicKey]
-> ByteString
-> IO (ByteString, [ByteString], ByteString)
sealLBS Cipher
cipher [SomePublicKey]
pubKeys forall a b. (a -> b) -> a -> b
$ String -> ByteString
L8.pack String
input
forall (m :: * -> *) a. Monad m => a -> m a
return ( ByteString -> String
L8.unpack ByteString
output
, ByteString -> String
B8.unpack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` [ByteString]
encKeys
, ByteString -> String
B8.unpack ByteString
iv
)
sealBS :: Cipher
-> [SomePublicKey]
-> B8.ByteString
-> IO ( B8.ByteString
, [B8.ByteString]
, B8.ByteString
)
sealBS :: Cipher
-> [SomePublicKey]
-> ByteString
-> IO (ByteString, [ByteString], ByteString)
sealBS Cipher
cipher [SomePublicKey]
pubKeys ByteString
input
= do (CipherCtx
ctx, [ByteString]
encKeys, ByteString
iv) <- Cipher
-> [SomePublicKey] -> IO (CipherCtx, [ByteString], ByteString)
sealInit Cipher
cipher [SomePublicKey]
pubKeys
ByteString
output <- CipherCtx -> ByteString -> IO ByteString
cipherStrictly CipherCtx
ctx ByteString
input
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
output, [ByteString]
encKeys, ByteString
iv)
sealLBS :: Cipher
-> [SomePublicKey]
-> L8.ByteString
-> IO ( L8.ByteString
, [B8.ByteString]
, B8.ByteString
)
sealLBS :: Cipher
-> [SomePublicKey]
-> ByteString
-> IO (ByteString, [ByteString], ByteString)
sealLBS Cipher
cipher [SomePublicKey]
pubKeys ByteString
input
= do (CipherCtx
ctx, [ByteString]
encKeys, ByteString
iv) <- Cipher
-> [SomePublicKey] -> IO (CipherCtx, [ByteString], ByteString)
sealInit Cipher
cipher [SomePublicKey]
pubKeys
ByteString
output <- CipherCtx -> ByteString -> IO ByteString
cipherLazily CipherCtx
ctx ByteString
input
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
output, [ByteString]
encKeys, ByteString
iv)