{-# LINE 1 "OpenSSL/PKCS7.hsc" #-}
{-# LANGUAGE DeriveDataTypeable       #-}
{-# LANGUAGE EmptyDataDecls           #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE CApiFFI                  #-}
{-# OPTIONS_HADDOCK prune             #-}
-- |An interface to PKCS#7 structure and S\/MIME message.
module OpenSSL.PKCS7
    ( -- * Types
      Pkcs7
    , PKCS7 -- private
    , Pkcs7Flag(..)
    , Pkcs7VerifyStatus(..)
    , wrapPkcs7Ptr -- private
    , withPkcs7Ptr -- private

      -- * Encryption and Signing
    , pkcs7Sign
    , pkcs7Verify
    , pkcs7Encrypt
    , pkcs7Decrypt

      -- * S\/MIME
    , writeSmime
    , readSmime
    )
    where

import           Data.List
import           Data.Traversable
import           Data.Typeable
import           Foreign
import           Foreign.C
import           OpenSSL.BIO
import           OpenSSL.EVP.Cipher hiding (cipher)
import           OpenSSL.EVP.PKey
import           OpenSSL.EVP.Internal
import           OpenSSL.Stack
import           OpenSSL.Utils
import           OpenSSL.X509
import           OpenSSL.X509.Store


{- PKCS#7 -------------------------------------------------------------------- -}

-- |@'Pkcs7'@ represents an abstract PKCS#7 structure. The concrete
-- type of structure is hidden in the object: such polymorphism isn't
-- very haskellish but please get it out of your mind since OpenSSL is
-- written in C.
newtype Pkcs7 = Pkcs7 (ForeignPtr PKCS7)
data {-# CTYPE "openssl/pkcs7.h" "PKCS7" #-} PKCS7

-- |@'Pkcs7Flag'@ is a set of flags that are used in many operations
-- related to PKCS#7.
data Pkcs7Flag = Pkcs7Text
               | Pkcs7NoCerts
               | Pkcs7NoSigs
               | Pkcs7NoChain
               | Pkcs7NoIntern
               | Pkcs7NoVerify
               | Pkcs7Detached
               | Pkcs7Binary
               | Pkcs7NoAttr
               | Pkcs7NoSmimeCap
               | Pkcs7NoOldMimeType
               | Pkcs7CRLFEOL
                 deriving (Int -> Pkcs7Flag -> ShowS
[Pkcs7Flag] -> ShowS
Pkcs7Flag -> String
(Int -> Pkcs7Flag -> ShowS)
-> (Pkcs7Flag -> String)
-> ([Pkcs7Flag] -> ShowS)
-> Show Pkcs7Flag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Pkcs7Flag] -> ShowS
$cshowList :: [Pkcs7Flag] -> ShowS
show :: Pkcs7Flag -> String
$cshow :: Pkcs7Flag -> String
showsPrec :: Int -> Pkcs7Flag -> ShowS
$cshowsPrec :: Int -> Pkcs7Flag -> ShowS
Show, Pkcs7Flag -> Pkcs7Flag -> Bool
(Pkcs7Flag -> Pkcs7Flag -> Bool)
-> (Pkcs7Flag -> Pkcs7Flag -> Bool) -> Eq Pkcs7Flag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Pkcs7Flag -> Pkcs7Flag -> Bool
$c/= :: Pkcs7Flag -> Pkcs7Flag -> Bool
== :: Pkcs7Flag -> Pkcs7Flag -> Bool
$c== :: Pkcs7Flag -> Pkcs7Flag -> Bool
Eq, Typeable)

flagToInt :: Pkcs7Flag -> CInt
flagToInt :: Pkcs7Flag -> CInt
flagToInt Pkcs7Flag
Pkcs7Text          = CInt
1
{-# LINE 70 "OpenSSL/PKCS7.hsc" #-}
flagToInt Pkcs7NoCerts       = 2
{-# LINE 71 "OpenSSL/PKCS7.hsc" #-}
flagToInt Pkcs7NoSigs        = 4
{-# LINE 72 "OpenSSL/PKCS7.hsc" #-}
flagToInt Pkcs7NoChain       = 8
{-# LINE 73 "OpenSSL/PKCS7.hsc" #-}
flagToInt Pkcs7NoIntern      = 16
{-# LINE 74 "OpenSSL/PKCS7.hsc" #-}
flagToInt Pkcs7NoVerify      = 32
{-# LINE 75 "OpenSSL/PKCS7.hsc" #-}
flagToInt Pkcs7Detached      = 64
{-# LINE 76 "OpenSSL/PKCS7.hsc" #-}
flagToInt Pkcs7Binary        = 128
{-# LINE 77 "OpenSSL/PKCS7.hsc" #-}
flagToInt Pkcs7NoAttr        = 256
{-# LINE 78 "OpenSSL/PKCS7.hsc" #-}
flagToInt Pkcs7NoSmimeCap    = 512
{-# LINE 79 "OpenSSL/PKCS7.hsc" #-}
flagToInt Pkcs7NoOldMimeType = 1024
{-# LINE 80 "OpenSSL/PKCS7.hsc" #-}
flagToInt Pkcs7CRLFEOL       = 2048
{-# LINE 81 "OpenSSL/PKCS7.hsc" #-}

-- |@'Pkcs7VerifyStatus'@ represents a result of PKCS#7
-- verification. See 'pkcs7Verify'.
data Pkcs7VerifyStatus
    = Pkcs7VerifySuccess (Maybe String) -- ^ Nothing if the PKCS#7
                                        --   signature was a detached
                                        --   signature, and @Just content@
                                        --   if it wasn't.
    | Pkcs7VerifyFailure
      deriving (Int -> Pkcs7VerifyStatus -> ShowS
[Pkcs7VerifyStatus] -> ShowS
Pkcs7VerifyStatus -> String
(Int -> Pkcs7VerifyStatus -> ShowS)
-> (Pkcs7VerifyStatus -> String)
-> ([Pkcs7VerifyStatus] -> ShowS)
-> Show Pkcs7VerifyStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Pkcs7VerifyStatus] -> ShowS
$cshowList :: [Pkcs7VerifyStatus] -> ShowS
show :: Pkcs7VerifyStatus -> String
$cshow :: Pkcs7VerifyStatus -> String
showsPrec :: Int -> Pkcs7VerifyStatus -> ShowS
$cshowsPrec :: Int -> Pkcs7VerifyStatus -> ShowS
Show, Pkcs7VerifyStatus -> Pkcs7VerifyStatus -> Bool
(Pkcs7VerifyStatus -> Pkcs7VerifyStatus -> Bool)
-> (Pkcs7VerifyStatus -> Pkcs7VerifyStatus -> Bool)
-> Eq Pkcs7VerifyStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Pkcs7VerifyStatus -> Pkcs7VerifyStatus -> Bool
$c/= :: Pkcs7VerifyStatus -> Pkcs7VerifyStatus -> Bool
== :: Pkcs7VerifyStatus -> Pkcs7VerifyStatus -> Bool
$c== :: Pkcs7VerifyStatus -> Pkcs7VerifyStatus -> Bool
Eq, Typeable)


flagListToInt :: [Pkcs7Flag] -> CInt
flagListToInt :: [Pkcs7Flag] -> CInt
flagListToInt = (CInt -> CInt -> CInt) -> CInt -> [CInt] -> CInt
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' CInt -> CInt -> CInt
forall a. Bits a => a -> a -> a
(.|.) CInt
0 ([CInt] -> CInt) -> ([Pkcs7Flag] -> [CInt]) -> [Pkcs7Flag] -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pkcs7Flag -> CInt) -> [Pkcs7Flag] -> [CInt]
forall a b. (a -> b) -> [a] -> [b]
map Pkcs7Flag -> CInt
flagToInt


foreign import capi "openssl/pkcs7.h &PKCS7_free"
        _free :: FunPtr (Ptr PKCS7 -> IO ())

foreign import capi "HsOpenSSL.h HsOpenSSL_PKCS7_is_detached"
        _is_detached :: Ptr PKCS7 -> IO CLong

foreign import capi "openssl/pkcs7.h PKCS7_sign"
        _sign :: Ptr X509_ -> Ptr EVP_PKEY -> Ptr STACK -> Ptr BIO_ -> CInt -> IO (Ptr PKCS7)

foreign import capi "openssl/pkcs7.h PKCS7_verify"
        _verify :: Ptr PKCS7 -> Ptr STACK -> Ptr X509_STORE -> Ptr BIO_ -> Ptr BIO_ -> CInt -> IO CInt

foreign import capi "openssl/pkcs7.h PKCS7_encrypt"
        _encrypt :: Ptr STACK -> Ptr BIO_ -> Ptr EVP_CIPHER -> CInt -> IO (Ptr PKCS7)

foreign import capi "openssl/pkcs7.h PKCS7_decrypt"
        _decrypt :: Ptr PKCS7 -> Ptr EVP_PKEY -> Ptr X509_ -> Ptr BIO_ -> CInt -> IO CInt


wrapPkcs7Ptr :: Ptr PKCS7 -> IO Pkcs7
wrapPkcs7Ptr :: Ptr PKCS7 -> IO Pkcs7
wrapPkcs7Ptr = (ForeignPtr PKCS7 -> Pkcs7) -> IO (ForeignPtr PKCS7) -> IO Pkcs7
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ForeignPtr PKCS7 -> Pkcs7
Pkcs7 (IO (ForeignPtr PKCS7) -> IO Pkcs7)
-> (Ptr PKCS7 -> IO (ForeignPtr PKCS7)) -> Ptr PKCS7 -> IO Pkcs7
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FinalizerPtr PKCS7 -> Ptr PKCS7 -> IO (ForeignPtr PKCS7)
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr PKCS7
_free


withPkcs7Ptr :: Pkcs7 -> (Ptr PKCS7 -> IO a) -> IO a
withPkcs7Ptr :: forall a. Pkcs7 -> (Ptr PKCS7 -> IO a) -> IO a
withPkcs7Ptr (Pkcs7 ForeignPtr PKCS7
pkcs7) = ForeignPtr PKCS7 -> (Ptr PKCS7 -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr PKCS7
pkcs7


isDetachedSignature :: Pkcs7 -> IO Bool
isDetachedSignature :: Pkcs7 -> IO Bool
isDetachedSignature Pkcs7
pkcs7
    = Pkcs7 -> (Ptr PKCS7 -> IO Bool) -> IO Bool
forall a. Pkcs7 -> (Ptr PKCS7 -> IO a) -> IO a
withPkcs7Ptr Pkcs7
pkcs7 ((Ptr PKCS7 -> IO Bool) -> IO Bool)
-> (Ptr PKCS7 -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \ Ptr PKCS7
pkcs7Ptr ->
      (CLong -> Bool) -> IO CLong -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (CLong -> CLong -> Bool
forall a. Eq a => a -> a -> Bool
== CLong
1) (Ptr PKCS7 -> IO CLong
_is_detached Ptr PKCS7
pkcs7Ptr)


pkcs7Sign' :: KeyPair key => X509 -> key -> [X509] -> BIO -> [Pkcs7Flag] -> IO Pkcs7
pkcs7Sign' :: forall key.
KeyPair key =>
X509 -> key -> [X509] -> BIO -> [Pkcs7Flag] -> IO Pkcs7
pkcs7Sign' X509
signCert key
pkey [X509]
certs BIO
input [Pkcs7Flag]
flagList
    = X509 -> (Ptr X509_ -> IO Pkcs7) -> IO Pkcs7
forall a. X509 -> (Ptr X509_ -> IO a) -> IO a
withX509Ptr X509
signCert ((Ptr X509_ -> IO Pkcs7) -> IO Pkcs7)
-> (Ptr X509_ -> IO Pkcs7) -> IO Pkcs7
forall a b. (a -> b) -> a -> b
$ \ Ptr X509_
signCertPtr ->
      key -> (Ptr EVP_PKEY -> IO Pkcs7) -> IO Pkcs7
forall k a. PKey k => k -> (Ptr EVP_PKEY -> IO a) -> IO a
withPKeyPtr' key
pkey    ((Ptr EVP_PKEY -> IO Pkcs7) -> IO Pkcs7)
-> (Ptr EVP_PKEY -> IO Pkcs7) -> IO Pkcs7
forall a b. (a -> b) -> a -> b
$ \ Ptr EVP_PKEY
pkeyPtr     ->
      [X509] -> (Ptr STACK -> IO Pkcs7) -> IO Pkcs7
forall a. [X509] -> (Ptr STACK -> IO a) -> IO a
withX509Stack [X509]
certs  ((Ptr STACK -> IO Pkcs7) -> IO Pkcs7)
-> (Ptr STACK -> IO Pkcs7) -> IO Pkcs7
forall a b. (a -> b) -> a -> b
$ \ Ptr STACK
certStack   ->
      BIO -> (Ptr BIO_ -> IO Pkcs7) -> IO Pkcs7
forall a. BIO -> (Ptr BIO_ -> IO a) -> IO a
withBioPtr BIO
input     ((Ptr BIO_ -> IO Pkcs7) -> IO Pkcs7)
-> (Ptr BIO_ -> IO Pkcs7) -> IO Pkcs7
forall a b. (a -> b) -> a -> b
$ \ Ptr BIO_
inputPtr    ->
      Ptr X509_
-> Ptr EVP_PKEY -> Ptr STACK -> Ptr BIO_ -> CInt -> IO (Ptr PKCS7)
_sign Ptr X509_
signCertPtr Ptr EVP_PKEY
pkeyPtr Ptr STACK
certStack Ptr BIO_
inputPtr ([Pkcs7Flag] -> CInt
flagListToInt [Pkcs7Flag]
flagList)
           IO (Ptr PKCS7) -> (Ptr PKCS7 -> IO (Ptr PKCS7)) -> IO (Ptr PKCS7)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr PKCS7 -> IO (Ptr PKCS7)
forall a. Ptr a -> IO (Ptr a)
failIfNull
           IO (Ptr PKCS7) -> (Ptr PKCS7 -> IO Pkcs7) -> IO Pkcs7
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr PKCS7 -> IO Pkcs7
wrapPkcs7Ptr

-- |@'pkcs7Sign'@ creates a PKCS#7 signedData structure.
pkcs7Sign :: KeyPair key =>
             X509        -- ^ certificate to sign with
          -> key         -- ^ corresponding private key
          -> [X509]      -- ^ optional additional set of certificates
                         --   to include in the PKCS#7 structure (for
                         --   example any intermediate CAs in the
                         --   chain)
          -> String      -- ^ data to be signed
          -> [Pkcs7Flag] -- ^ An optional set of flags:
                         --
                         --   ['Pkcs7Text'] Many S\/MIME clients
                         --   expect the signed content to include
                         --   valid MIME headers. If the 'Pkcs7Text'
                         --   flag is set MIME headers for type
                         --   \"text\/plain\" are prepended to the
                         --   data.
                         --
                         --   ['Pkcs7NoCerts'] If 'Pkcs7NoCerts' is
                         --   set the signer's certificate will not be
                         --   included in the PKCS#7 structure, the
                         --   signer's certificate must still be
                         --   supplied in the parameter though. This
                         --   can reduce the size of the signature if
                         --   the signer's certificate can be obtained
                         --   by other means: for example a previously
                         --   signed message.
                         --
                         --   ['Pkcs7Detached'] The data being signed
                         --   is included in the PKCS#7 structure,
                         --   unless 'Pkcs7Detached' is set in which
                         --   case it is ommited. This is used for
                         --   PKCS#7 detached signatures which are
                         --   used in S\/MIME plaintext signed message
                         --   for example.
                         --
                         --   ['Pkcs7Binary'] Normally the supplied
                         --   content is translated into MIME
                         --   canonical format (as required by the
                         --   S\/MIME specifications) but if
                         --   'Pkcs7Binary' is set no translation
                         --   occurs. This option should be uesd if
                         --   the supplied data is in binary format
                         --   otherwise the translation will corrupt
                         --   it.
                         --
                         --   ['Pkcs7NoAttr']
                         --
                         --   ['Pkcs7NoSmimeCap'] The signedData
                         --   structure includes several PKCS#7
                         --   authenticatedAttributes including the
                         --   signing time, the PKCS#7 content type
                         --   and the supported list of ciphers in an
                         --   SMIMECapabilities attribute. If
                         --   'Pkcs7NoAttr' is set then no
                         --   authenticatedAttributes will be used. If
                         --   Pkcs7NoSmimeCap is set then just the
                         --   SMIMECapabilities are omitted.
          -> IO Pkcs7
pkcs7Sign :: forall key.
KeyPair key =>
X509 -> key -> [X509] -> String -> [Pkcs7Flag] -> IO Pkcs7
pkcs7Sign X509
signCert key
pkey [X509]
certs String
input [Pkcs7Flag]
flagList
    = do BIO
mem <- String -> IO BIO
newConstMem String
input
         X509 -> key -> [X509] -> BIO -> [Pkcs7Flag] -> IO Pkcs7
forall key.
KeyPair key =>
X509 -> key -> [X509] -> BIO -> [Pkcs7Flag] -> IO Pkcs7
pkcs7Sign' X509
signCert key
pkey [X509]
certs BIO
mem [Pkcs7Flag]
flagList


pkcs7Verify' :: Pkcs7 -> [X509] -> X509Store -> Maybe BIO -> [Pkcs7Flag] -> IO (Maybe BIO, Bool)
pkcs7Verify' :: Pkcs7
-> [X509]
-> X509Store
-> Maybe BIO
-> [Pkcs7Flag]
-> IO (Maybe BIO, Bool)
pkcs7Verify' Pkcs7
pkcs7 [X509]
certs X509Store
store Maybe BIO
inData [Pkcs7Flag]
flagList
    = Pkcs7
-> (Ptr PKCS7 -> IO (Maybe BIO, Bool)) -> IO (Maybe BIO, Bool)
forall a. Pkcs7 -> (Ptr PKCS7 -> IO a) -> IO a
withPkcs7Ptr Pkcs7
pkcs7     ((Ptr PKCS7 -> IO (Maybe BIO, Bool)) -> IO (Maybe BIO, Bool))
-> (Ptr PKCS7 -> IO (Maybe BIO, Bool)) -> IO (Maybe BIO, Bool)
forall a b. (a -> b) -> a -> b
$ \ Ptr PKCS7
pkcs7Ptr  ->
      [X509]
-> (Ptr STACK -> IO (Maybe BIO, Bool)) -> IO (Maybe BIO, Bool)
forall a. [X509] -> (Ptr STACK -> IO a) -> IO a
withX509Stack [X509]
certs    ((Ptr STACK -> IO (Maybe BIO, Bool)) -> IO (Maybe BIO, Bool))
-> (Ptr STACK -> IO (Maybe BIO, Bool)) -> IO (Maybe BIO, Bool)
forall a b. (a -> b) -> a -> b
$ \ Ptr STACK
certStack ->
      X509Store
-> (Ptr X509_STORE -> IO (Maybe BIO, Bool)) -> IO (Maybe BIO, Bool)
forall a. X509Store -> (Ptr X509_STORE -> IO a) -> IO a
withX509StorePtr X509Store
store ((Ptr X509_STORE -> IO (Maybe BIO, Bool)) -> IO (Maybe BIO, Bool))
-> (Ptr X509_STORE -> IO (Maybe BIO, Bool)) -> IO (Maybe BIO, Bool)
forall a b. (a -> b) -> a -> b
$ \ Ptr X509_STORE
storePtr  ->
      Maybe BIO
-> (Ptr BIO_ -> IO (Maybe BIO, Bool)) -> IO (Maybe BIO, Bool)
forall a. Maybe BIO -> (Ptr BIO_ -> IO a) -> IO a
withBioPtr' Maybe BIO
inData     ((Ptr BIO_ -> IO (Maybe BIO, Bool)) -> IO (Maybe BIO, Bool))
-> (Ptr BIO_ -> IO (Maybe BIO, Bool)) -> IO (Maybe BIO, Bool)
forall a b. (a -> b) -> a -> b
$ \ Ptr BIO_
inDataPtr ->
      do Bool
isDetached <- Pkcs7 -> IO Bool
isDetachedSignature Pkcs7
pkcs7
         Maybe BIO
outData    <- if Bool
isDetached then
                           Maybe BIO -> IO (Maybe BIO)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe BIO
forall a. Maybe a
Nothing
                       else
                           (BIO -> Maybe BIO) -> IO BIO -> IO (Maybe BIO)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap BIO -> Maybe BIO
forall a. a -> Maybe a
Just IO BIO
newMem
         Maybe BIO
-> (Ptr BIO_ -> IO (Maybe BIO, Bool)) -> IO (Maybe BIO, Bool)
forall a. Maybe BIO -> (Ptr BIO_ -> IO a) -> IO a
withBioPtr' Maybe BIO
outData ((Ptr BIO_ -> IO (Maybe BIO, Bool)) -> IO (Maybe BIO, Bool))
-> (Ptr BIO_ -> IO (Maybe BIO, Bool)) -> IO (Maybe BIO, Bool)
forall a b. (a -> b) -> a -> b
$ \ Ptr BIO_
outDataPtr ->
             Ptr PKCS7
-> Ptr STACK
-> Ptr X509_STORE
-> Ptr BIO_
-> Ptr BIO_
-> CInt
-> IO CInt
_verify Ptr PKCS7
pkcs7Ptr Ptr STACK
certStack Ptr X509_STORE
storePtr Ptr BIO_
inDataPtr Ptr BIO_
outDataPtr ([Pkcs7Flag] -> CInt
flagListToInt [Pkcs7Flag]
flagList)
                  IO CInt -> (CInt -> IO (Maybe BIO, Bool)) -> IO (Maybe BIO, Bool)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe BIO -> CInt -> IO (Maybe BIO, Bool)
interpret Maybe BIO
outData
    where
      interpret :: Maybe BIO -> CInt -> IO (Maybe BIO, Bool)
      interpret :: Maybe BIO -> CInt -> IO (Maybe BIO, Bool)
interpret Maybe BIO
bio CInt
1 = (Maybe BIO, Bool) -> IO (Maybe BIO, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe BIO
bio    , Bool
True )
      interpret Maybe BIO
_   CInt
_ = (Maybe BIO, Bool) -> IO (Maybe BIO, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe BIO
forall a. Maybe a
Nothing, Bool
False)

-- |@'pkcs7Verify'@ verifies a PKCS#7 signedData structure.
pkcs7Verify :: Pkcs7           -- ^ A PKCS#7 structure to verify.
            -> [X509]          -- ^ Set of certificates in which to
                               --   search for the signer's
                               --   certificate.
            -> X509Store       -- ^ Trusted certificate store (used
                               --   for chain verification).
            -> Maybe String    -- ^ Signed data if the content is not
                               --   present in the PKCS#7 structure
                               --   (that is it is detached).
            -> [Pkcs7Flag]     -- ^ An optional set of flags:
                               --
                               --   ['Pkcs7NoIntern'] If
                               --   'Pkcs7NoIntern' is set the
                               --   certificates in the message itself
                               --   are not searched when locating the
                               --   signer's certificate. This means
                               --   that all the signers certificates
                               --   must be in the second argument
                               --   (['X509']).
                               --
                               --   ['Pkcs7Text'] If the 'Pkcs7Text'
                               --   flag is set MIME headers for type
                               --   \"text\/plain\" are deleted from
                               --   the content. If the content is not
                               --   of type \"text\/plain\" then an
                               --   error is returned.
                               --
                               --   ['Pkcs7NoVerify'] If
                               --   'Pkcs7NoVerify' is set the
                               --   signer's certificates are not
                               --   chain verified.
                               --
                               --   ['Pkcs7NoChain'] If 'Pkcs7NoChain'
                               --   is set then the certificates
                               --   contained in the message are not
                               --   used as untrusted CAs. This means
                               --   that the whole verify chain (apart
                               --   from the signer's certificate)
                               --   must be contained in the trusted
                               --   store.
                               --
                               --   ['Pkcs7NoSigs'] If 'Pkcs7NoSigs'
                               --   is set then the signatures on the
                               --   data are not checked.
            -> IO Pkcs7VerifyStatus
pkcs7Verify :: Pkcs7
-> [X509]
-> X509Store
-> Maybe String
-> [Pkcs7Flag]
-> IO Pkcs7VerifyStatus
pkcs7Verify Pkcs7
pkcs7 [X509]
certs X509Store
store Maybe String
inData [Pkcs7Flag]
flagList
    = do Maybe BIO
inDataBio               <- Maybe String -> (String -> IO BIO) -> IO (Maybe BIO)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Maybe String
inData String -> IO BIO
newConstMem
         (Maybe BIO
outDataBio, Bool
isSuccess) <- Pkcs7
-> [X509]
-> X509Store
-> Maybe BIO
-> [Pkcs7Flag]
-> IO (Maybe BIO, Bool)
pkcs7Verify' Pkcs7
pkcs7 [X509]
certs X509Store
store Maybe BIO
inDataBio [Pkcs7Flag]
flagList
         if Bool
isSuccess then
             do Maybe String
outData <- Maybe BIO -> (BIO -> IO String) -> IO (Maybe String)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Maybe BIO
outDataBio BIO -> IO String
bioRead
                Pkcs7VerifyStatus -> IO Pkcs7VerifyStatus
forall (m :: * -> *) a. Monad m => a -> m a
return (Pkcs7VerifyStatus -> IO Pkcs7VerifyStatus)
-> Pkcs7VerifyStatus -> IO Pkcs7VerifyStatus
forall a b. (a -> b) -> a -> b
$ Maybe String -> Pkcs7VerifyStatus
Pkcs7VerifySuccess Maybe String
outData
           else
             Pkcs7VerifyStatus -> IO Pkcs7VerifyStatus
forall (m :: * -> *) a. Monad m => a -> m a
return Pkcs7VerifyStatus
Pkcs7VerifyFailure


pkcs7Encrypt' :: [X509] -> BIO -> Cipher -> [Pkcs7Flag] -> IO Pkcs7
pkcs7Encrypt' :: [X509] -> BIO -> Cipher -> [Pkcs7Flag] -> IO Pkcs7
pkcs7Encrypt' [X509]
certs BIO
input Cipher
cipher [Pkcs7Flag]
flagList
    = [X509] -> (Ptr STACK -> IO Pkcs7) -> IO Pkcs7
forall a. [X509] -> (Ptr STACK -> IO a) -> IO a
withX509Stack [X509]
certs  ((Ptr STACK -> IO Pkcs7) -> IO Pkcs7)
-> (Ptr STACK -> IO Pkcs7) -> IO Pkcs7
forall a b. (a -> b) -> a -> b
$ \ Ptr STACK
certsPtr  ->
      BIO -> (Ptr BIO_ -> IO Pkcs7) -> IO Pkcs7
forall a. BIO -> (Ptr BIO_ -> IO a) -> IO a
withBioPtr    BIO
input  ((Ptr BIO_ -> IO Pkcs7) -> IO Pkcs7)
-> (Ptr BIO_ -> IO Pkcs7) -> IO Pkcs7
forall a b. (a -> b) -> a -> b
$ \ Ptr BIO_
inputPtr  ->
      Cipher -> (Ptr EVP_CIPHER -> IO Pkcs7) -> IO Pkcs7
forall a. Cipher -> (Ptr EVP_CIPHER -> IO a) -> IO a
withCipherPtr Cipher
cipher ((Ptr EVP_CIPHER -> IO Pkcs7) -> IO Pkcs7)
-> (Ptr EVP_CIPHER -> IO Pkcs7) -> IO Pkcs7
forall a b. (a -> b) -> a -> b
$ \ Ptr EVP_CIPHER
cipherPtr ->
      Ptr STACK -> Ptr BIO_ -> Ptr EVP_CIPHER -> CInt -> IO (Ptr PKCS7)
_encrypt Ptr STACK
certsPtr Ptr BIO_
inputPtr Ptr EVP_CIPHER
cipherPtr ([Pkcs7Flag] -> CInt
flagListToInt [Pkcs7Flag]
flagList)
           IO (Ptr PKCS7) -> (Ptr PKCS7 -> IO (Ptr PKCS7)) -> IO (Ptr PKCS7)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr PKCS7 -> IO (Ptr PKCS7)
forall a. Ptr a -> IO (Ptr a)
failIfNull
           IO (Ptr PKCS7) -> (Ptr PKCS7 -> IO Pkcs7) -> IO Pkcs7
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr PKCS7 -> IO Pkcs7
wrapPkcs7Ptr

-- |@'pkcs7Encrypt'@ creates a PKCS#7 envelopedData structure.
pkcs7Encrypt :: [X509]      -- ^ A list of recipient certificates.
             -> String      -- ^ The content to be encrypted.
             -> Cipher      -- ^ The symmetric cipher to use.
             -> [Pkcs7Flag] -- ^ An optional set of flags:
                            --
                            --   ['Pkcs7Text'] If the 'Pkcs7Text' flag
                            --   is set MIME headers for type
                            --   \"text\/plain\" are prepended to the
                            --   data.
                            --
                            --   ['Pkcs7Binary'] Normally the supplied
                            --   content is translated into MIME
                            --   canonical format (as required by the
                            --   S\/MIME specifications) if
                            --   'Pkcs7Binary' is set no translation
                            --   occurs. This option should be used if
                            --   the supplied data is in binary format
                            --   otherwise the translation will
                            --   corrupt it. If 'Pkcs7Binary' is set
                            --   then 'Pkcs7Text' is ignored.
             -> IO Pkcs7
pkcs7Encrypt :: [X509] -> String -> Cipher -> [Pkcs7Flag] -> IO Pkcs7
pkcs7Encrypt [X509]
certs String
input Cipher
cipher [Pkcs7Flag]
flagList
    = do BIO
mem <- String -> IO BIO
newConstMem String
input
         [X509] -> BIO -> Cipher -> [Pkcs7Flag] -> IO Pkcs7
pkcs7Encrypt' [X509]
certs BIO
mem Cipher
cipher [Pkcs7Flag]
flagList


pkcs7Decrypt' :: KeyPair key => Pkcs7 -> key -> X509 -> BIO -> [Pkcs7Flag] -> IO ()
pkcs7Decrypt' :: forall key.
KeyPair key =>
Pkcs7 -> key -> X509 -> BIO -> [Pkcs7Flag] -> IO ()
pkcs7Decrypt' Pkcs7
pkcs7 key
pkey X509
cert BIO
output [Pkcs7Flag]
flagList
    = Pkcs7 -> (Ptr PKCS7 -> IO ()) -> IO ()
forall a. Pkcs7 -> (Ptr PKCS7 -> IO a) -> IO a
withPkcs7Ptr Pkcs7
pkcs7  ((Ptr PKCS7 -> IO ()) -> IO ()) -> (Ptr PKCS7 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ Ptr PKCS7
pkcs7Ptr  ->
      key -> (Ptr EVP_PKEY -> IO ()) -> IO ()
forall k a. PKey k => k -> (Ptr EVP_PKEY -> IO a) -> IO a
withPKeyPtr' key
pkey   ((Ptr EVP_PKEY -> IO ()) -> IO ())
-> (Ptr EVP_PKEY -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ Ptr EVP_PKEY
pkeyPtr   ->
      X509 -> (Ptr X509_ -> IO ()) -> IO ()
forall a. X509 -> (Ptr X509_ -> IO a) -> IO a
withX509Ptr  X509
cert   ((Ptr X509_ -> IO ()) -> IO ()) -> (Ptr X509_ -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ Ptr X509_
certPtr   ->
      BIO -> (Ptr BIO_ -> IO ()) -> IO ()
forall a. BIO -> (Ptr BIO_ -> IO a) -> IO a
withBioPtr   BIO
output ((Ptr BIO_ -> IO ()) -> IO ()) -> (Ptr BIO_ -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ Ptr BIO_
outputPtr ->
      Ptr PKCS7
-> Ptr EVP_PKEY -> Ptr X509_ -> Ptr BIO_ -> CInt -> IO CInt
_decrypt Ptr PKCS7
pkcs7Ptr Ptr EVP_PKEY
pkeyPtr Ptr X509_
certPtr Ptr BIO_
outputPtr ([Pkcs7Flag] -> CInt
flagListToInt [Pkcs7Flag]
flagList)
           IO CInt -> (CInt -> IO CInt) -> IO CInt
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (CInt -> Bool) -> CInt -> IO CInt
forall a. (a -> Bool) -> a -> IO a
failIf (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
1)
           IO CInt -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>  () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- |@'pkcs7Decrypt'@ decrypts content from PKCS#7 envelopedData
-- structure.
pkcs7Decrypt :: KeyPair key =>
                Pkcs7       -- ^ The PKCS#7 structure to decrypt.
             -> key         -- ^ The private key of the recipient.
             -> X509        -- ^ The recipient's certificate.
             -> [Pkcs7Flag] -- ^ An optional set of flags:
                            --
                            --   ['Pkcs7Text'] If the 'Pkcs7Text' flag
                            --   is set MIME headers for type
                            --   \"text\/plain\" are deleted from the
                            --   content. If the content is not of
                            --   type \"text\/plain\" then an error is
                            --   thrown.
             -> IO String   -- ^ The decrypted content.
pkcs7Decrypt :: forall key.
KeyPair key =>
Pkcs7 -> key -> X509 -> [Pkcs7Flag] -> IO String
pkcs7Decrypt Pkcs7
pkcs7 key
pkey X509
cert [Pkcs7Flag]
flagList
    = do BIO
mem <- IO BIO
newMem
         Pkcs7 -> key -> X509 -> BIO -> [Pkcs7Flag] -> IO ()
forall key.
KeyPair key =>
Pkcs7 -> key -> X509 -> BIO -> [Pkcs7Flag] -> IO ()
pkcs7Decrypt' Pkcs7
pkcs7 key
pkey X509
cert BIO
mem [Pkcs7Flag]
flagList
         BIO -> IO String
bioRead BIO
mem


{- S/MIME -------------------------------------------------------------------- -}

foreign import capi unsafe "openssl/pkcs7.h SMIME_write_PKCS7"
        _SMIME_write_PKCS7 :: Ptr BIO_ -> Ptr PKCS7 -> Ptr BIO_ -> CInt -> IO CInt

foreign import capi unsafe "openssl/pkcs7.h SMIME_read_PKCS7"
        _SMIME_read_PKCS7 :: Ptr BIO_ -> Ptr (Ptr BIO_) -> IO (Ptr PKCS7)

-- |@'writeSmime'@ writes PKCS#7 structure to S\/MIME message.
writeSmime :: Pkcs7        -- ^ A PKCS#7 structure to be written.
           -> Maybe String -- ^ If cleartext signing
                           --   (multipart\/signed) is being used then
                           --   the signed data must be supplied here.
           -> [Pkcs7Flag]  -- ^ An optional set of flags:
                           --
                           --   ['Pkcs7Detached'] If 'Pkcs7Detached'
                           --   is set then cleartext signing will be
                           --   used, this option only makes sense for
                           --   signedData where 'Pkcs7Detached' is
                           --   also set when 'pkcs7Sign' is also
                           --   called.
                           --
                           --   ['Pkcs7Text'] If the 'Pkcs7Text' flag
                           --   is set MIME headers for type
                           --   \"text\/plain\" are added to the
                           --   content, this only makes sense if
                           --   'Pkcs7Detached' is also set.
           -> IO String    -- ^ The result S\/MIME message.
writeSmime :: Pkcs7 -> Maybe String -> [Pkcs7Flag] -> IO String
writeSmime Pkcs7
pkcs7 Maybe String
dataStr [Pkcs7Flag]
flagList
    = do BIO
outBio  <- IO BIO
newMem
         Maybe BIO
dataBio <- Maybe String -> (String -> IO BIO) -> IO (Maybe BIO)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Maybe String
dataStr String -> IO BIO
newConstMem
         BIO -> Pkcs7 -> Maybe BIO -> [Pkcs7Flag] -> IO ()
writeSmime' BIO
outBio Pkcs7
pkcs7 Maybe BIO
dataBio [Pkcs7Flag]
flagList
         BIO -> IO String
bioRead BIO
outBio


writeSmime' :: BIO -> Pkcs7 -> Maybe BIO -> [Pkcs7Flag] -> IO ()
writeSmime' :: BIO -> Pkcs7 -> Maybe BIO -> [Pkcs7Flag] -> IO ()
writeSmime' BIO
outBio Pkcs7
pkcs7 Maybe BIO
dataBio [Pkcs7Flag]
flagList
    = BIO -> (Ptr BIO_ -> IO ()) -> IO ()
forall a. BIO -> (Ptr BIO_ -> IO a) -> IO a
withBioPtr   BIO
outBio  ((Ptr BIO_ -> IO ()) -> IO ()) -> (Ptr BIO_ -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ Ptr BIO_
outBioPtr  ->
      Pkcs7 -> (Ptr PKCS7 -> IO ()) -> IO ()
forall a. Pkcs7 -> (Ptr PKCS7 -> IO a) -> IO a
withPkcs7Ptr Pkcs7
pkcs7   ((Ptr PKCS7 -> IO ()) -> IO ()) -> (Ptr PKCS7 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ Ptr PKCS7
pkcs7Ptr   ->
      Maybe BIO -> (Ptr BIO_ -> IO ()) -> IO ()
forall a. Maybe BIO -> (Ptr BIO_ -> IO a) -> IO a
withBioPtr'  Maybe BIO
dataBio ((Ptr BIO_ -> IO ()) -> IO ()) -> (Ptr BIO_ -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ Ptr BIO_
dataBioPtr ->
      Ptr BIO_ -> Ptr PKCS7 -> Ptr BIO_ -> CInt -> IO CInt
_SMIME_write_PKCS7 Ptr BIO_
outBioPtr Ptr PKCS7
pkcs7Ptr Ptr BIO_
dataBioPtr ([Pkcs7Flag] -> CInt
flagListToInt [Pkcs7Flag]
flagList)
           IO CInt -> (CInt -> IO CInt) -> IO CInt
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (CInt -> Bool) -> CInt -> IO CInt
forall a. (a -> Bool) -> a -> IO a
failIf (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
1)
           IO CInt -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>  () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- |@'readSmime'@ parses S\/MIME message.
readSmime :: String -- ^ The message to be read.
          -> IO (Pkcs7, Maybe String) -- ^ (The result PKCS#7
                                      --   structure, @Just content@
                                      --   if the PKCS#7 structure was
                                      --   a cleartext signature and
                                      --   @Nothing@ if it wasn't.)
readSmime :: String -> IO (Pkcs7, Maybe String)
readSmime String
input
    = do BIO
inBio           <- String -> IO BIO
newConstMem String
input
         (Pkcs7
pkcs7, Maybe BIO
outBio) <- BIO -> IO (Pkcs7, Maybe BIO)
readSmime' BIO
inBio
         Maybe String
output          <- Maybe BIO -> (BIO -> IO String) -> IO (Maybe String)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Maybe BIO
outBio BIO -> IO String
bioRead
         (Pkcs7, Maybe String) -> IO (Pkcs7, Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Pkcs7
pkcs7, Maybe String
output)


readSmime' :: BIO -> IO (Pkcs7, Maybe BIO)
readSmime' :: BIO -> IO (Pkcs7, Maybe BIO)
readSmime' BIO
inBio
    = BIO -> (Ptr BIO_ -> IO (Pkcs7, Maybe BIO)) -> IO (Pkcs7, Maybe BIO)
forall a. BIO -> (Ptr BIO_ -> IO a) -> IO a
withBioPtr BIO
inBio ((Ptr BIO_ -> IO (Pkcs7, Maybe BIO)) -> IO (Pkcs7, Maybe BIO))
-> (Ptr BIO_ -> IO (Pkcs7, Maybe BIO)) -> IO (Pkcs7, Maybe BIO)
forall a b. (a -> b) -> a -> b
$ \ Ptr BIO_
inBioPtr     ->
      (Ptr (Ptr BIO_) -> IO (Pkcs7, Maybe BIO)) -> IO (Pkcs7, Maybe BIO)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca           ((Ptr (Ptr BIO_) -> IO (Pkcs7, Maybe BIO))
 -> IO (Pkcs7, Maybe BIO))
-> (Ptr (Ptr BIO_) -> IO (Pkcs7, Maybe BIO))
-> IO (Pkcs7, Maybe BIO)
forall a b. (a -> b) -> a -> b
$ \ Ptr (Ptr BIO_)
outBioPtrPtr ->
      do Ptr (Ptr BIO_) -> Ptr BIO_ -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (Ptr BIO_)
outBioPtrPtr Ptr BIO_
forall a. Ptr a
nullPtr

         Pkcs7
pkcs7     <- Ptr BIO_ -> Ptr (Ptr BIO_) -> IO (Ptr PKCS7)
_SMIME_read_PKCS7 Ptr BIO_
inBioPtr Ptr (Ptr BIO_)
outBioPtrPtr
                      IO (Ptr PKCS7) -> (Ptr PKCS7 -> IO (Ptr PKCS7)) -> IO (Ptr PKCS7)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr PKCS7 -> IO (Ptr PKCS7)
forall a. Ptr a -> IO (Ptr a)
failIfNull
                      IO (Ptr PKCS7) -> (Ptr PKCS7 -> IO Pkcs7) -> IO Pkcs7
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr PKCS7 -> IO Pkcs7
wrapPkcs7Ptr
         Ptr BIO_
outBioPtr <- Ptr (Ptr BIO_) -> IO (Ptr BIO_)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr BIO_)
outBioPtrPtr
         Maybe BIO
outBio    <- if Ptr BIO_
outBioPtr Ptr BIO_ -> Ptr BIO_ -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr BIO_
forall a. Ptr a
nullPtr then
                          Maybe BIO -> IO (Maybe BIO)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe BIO
forall a. Maybe a
Nothing
                      else
                          (BIO -> Maybe BIO) -> IO BIO -> IO (Maybe BIO)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap BIO -> Maybe BIO
forall a. a -> Maybe a
Just (Ptr BIO_ -> IO BIO
wrapBioPtr Ptr BIO_
outBioPtr)

         (Pkcs7, Maybe BIO) -> IO (Pkcs7, Maybe BIO)
forall (m :: * -> *) a. Monad m => a -> m a
return (Pkcs7
pkcs7, Maybe BIO
outBio)