{-# LANGUAGE CPP                      #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE CApiFFI                  #-}
-- |An interface to PEM routines.
module OpenSSL.PEM
    ( -- * Password supply
      PemPasswordCallback
    , PemPasswordRWState(..)
    , PemPasswordSupply(..)

      -- * Private key
    , writePKCS8PrivateKey
    , readPrivateKey

      -- * Public key
    , writePublicKey
    , readPublicKey

      -- * X.509 certificate
    , writeX509
    , readX509

      -- * PKCS#10 certificate request
    , PemX509ReqFormat(..)
    , writeX509Req
    , readX509Req

      -- * Certificate Revocation List
    , writeCRL
    , readCRL

      -- * PKCS#7 structure
    , writePkcs7
    , readPkcs7

      -- * DH parameters
    , writeDHParams
    , readDHParams
    )
    where
import           Control.Exception hiding (try)
import           Control.Monad
import qualified Data.ByteString.Char8 as B8
import           Data.Maybe
import           Foreign
import           Foreign.C
import           OpenSSL.BIO
import           OpenSSL.EVP.Cipher hiding (cipher)
import           OpenSSL.EVP.PKey
import           OpenSSL.EVP.Internal
import           OpenSSL.DH.Internal
import           OpenSSL.PKCS7
import           OpenSSL.Utils
import           OpenSSL.X509
import           OpenSSL.X509.Request
import           OpenSSL.X509.Revocation
#if !MIN_VERSION_base(4,6,0)
import           Prelude hiding (catch)
#endif
import           System.IO


-- |@'PemPasswordCallback'@ represents a callback function to supply a
-- password.
--
--   [@Int@] The maximum length of the password to be accepted.
--
--   [@PemPasswordRWState@] The context.
--
--   [@IO String@] The resulting password.
--
type PemPasswordCallback  = Int -> PemPasswordRWState -> IO String
type PemPasswordCallback' = Ptr CChar -> Int -> Int -> Ptr () -> IO Int


-- |@'PemPasswordRWState'@ represents a context of
-- 'PemPasswordCallback'.
data PemPasswordRWState = PwRead  -- ^ The callback was called to get
                                  --   a password to read something
                                  --   encrypted.
                        | PwWrite -- ^ The callback was called to get
                                  --   a password to encrypt
                                  --   something.

-- |@'PemPasswordSupply'@ represents a way to supply password.
--
-- FIXME: using PwTTY causes an error but I don't know why:
-- \"error:0906406D:PEM routines:DEF_CALLBACK:problems getting
-- password\"
data PemPasswordSupply = PwNone       -- ^ no password
                       | PwStr String -- ^ password in a static string
                       | PwBS B8.ByteString -- ^ password in a static bytestring.
                       | PwCallback PemPasswordCallback -- ^ get a
                                                        --   password
                                                        --   by a
                                                        --   callback
                       | PwTTY        -- ^ read a password from TTY


foreign import ccall "wrapper"
        mkPemPasswordCallback :: PemPasswordCallback' -> IO (FunPtr PemPasswordCallback')


rwflagToState :: Int -> PemPasswordRWState
rwflagToState :: Int -> PemPasswordRWState
rwflagToState Int
0 = PemPasswordRWState
PwRead
rwflagToState Int
1 = PemPasswordRWState
PwWrite
rwflagToState Int
_ = forall a. HasCallStack => a
undefined


callPasswordCB :: PemPasswordCallback -> PemPasswordCallback'
callPasswordCB :: PemPasswordCallback -> PemPasswordCallback'
callPasswordCB PemPasswordCallback
cb Ptr CChar
buf Int
bufLen Int
rwflag Ptr ()
_
    = let mode :: PemPasswordRWState
mode = Int -> PemPasswordRWState
rwflagToState Int
rwflag
          try :: IO Int
try  = do String
passStr <- PemPasswordCallback
cb Int
bufLen PemPasswordRWState
mode
                    let passLen :: Int
passLen = forall (t :: * -> *) a. Foldable t => t a -> Int
length String
passStr

                    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
passLen forall a. Ord a => a -> a -> Bool
> Int
bufLen)
                         forall a b. (a -> b) -> a -> b
$ forall a. Int -> IO a
failForTooLongPassword Int
bufLen

                    forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray Ptr CChar
buf forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a. Enum a => Int -> a
toEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum) String
passStr
                    forall (m :: * -> *) a. Monad m => a -> m a
return Int
passLen
      in
        IO Int
try forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \ SomeException
exc ->
            do Handle -> String -> IO ()
hPutStrLn Handle
stderr (forall a. Show a => a -> String
show (SomeException
exc :: SomeException))
               forall (m :: * -> *) a. Monad m => a -> m a
return Int
0 -- zero indicates an error
    where
      failForTooLongPassword :: Int -> IO a
      failForTooLongPassword :: forall a. Int -> IO a
failForTooLongPassword Int
len
          = forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"callPasswordCB: the password which the callback returned is too long: "
                  forall a. [a] -> [a] -> [a]
++ String
"it must be at most " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
len forall a. [a] -> [a] -> [a]
++ String
" bytes.")


{- PKCS#8 -------------------------------------------------------------------- -}

foreign import capi safe "openssl/pem.h PEM_write_bio_PKCS8PrivateKey"
        _write_bio_PKCS8PrivateKey :: Ptr BIO_
                                   -> Ptr EVP_PKEY
                                   -> Ptr EVP_CIPHER
                                   -> Ptr CChar
                                   -> CInt
                                   -> FunPtr PemPasswordCallback'
                                   -> Ptr a
                                   -> IO CInt

writePKCS8PrivateKey' :: KeyPair key =>
                         BIO
                      -> key
                      -> Maybe (Cipher, PemPasswordSupply)
                      -> IO ()
writePKCS8PrivateKey' :: forall key.
KeyPair key =>
BIO -> key -> Maybe (Cipher, PemPasswordSupply) -> IO ()
writePKCS8PrivateKey' BIO
bio key
key Maybe (Cipher, PemPasswordSupply)
encryption
    = forall a. BIO -> (Ptr BIO_ -> IO a) -> IO a
withBioPtr BIO
bio   forall a b. (a -> b) -> a -> b
$ \ Ptr BIO_
bioPtr  ->
      forall k a. PKey k => k -> (Ptr EVP_PKEY -> IO a) -> IO a
withPKeyPtr' key
key forall a b. (a -> b) -> a -> b
$ \ Ptr EVP_PKEY
pkeyPtr ->
      do CInt
ret <- case Maybe (Cipher, PemPasswordSupply)
encryption of
                  Maybe (Cipher, PemPasswordSupply)
Nothing
                      -> forall a.
Ptr BIO_
-> Ptr EVP_PKEY
-> Ptr EVP_CIPHER
-> Ptr CChar
-> CInt
-> FunPtr PemPasswordCallback'
-> Ptr a
-> IO CInt
_write_bio_PKCS8PrivateKey Ptr BIO_
bioPtr Ptr EVP_PKEY
pkeyPtr forall a. Ptr a
nullPtr forall a. Ptr a
nullPtr CInt
0 forall a. FunPtr a
nullFunPtr forall a. Ptr a
nullPtr

                  Just (Cipher
_, PemPasswordSupply
PwNone)
                      -> forall a.
Ptr BIO_
-> Ptr EVP_PKEY
-> Ptr EVP_CIPHER
-> Ptr CChar
-> CInt
-> FunPtr PemPasswordCallback'
-> Ptr a
-> IO CInt
_write_bio_PKCS8PrivateKey Ptr BIO_
bioPtr Ptr EVP_PKEY
pkeyPtr forall a. Ptr a
nullPtr forall a. Ptr a
nullPtr CInt
0 forall a. FunPtr a
nullFunPtr forall a. Ptr a
nullPtr

                  Just (Cipher
cipher, PwStr String
passStr)
                      -> forall a. String -> (CStringLen -> IO a) -> IO a
withCStringLen String
passStr forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
passPtr, Int
passLen) ->
                         forall a. Cipher -> (Ptr EVP_CIPHER -> IO a) -> IO a
withCipherPtr Cipher
cipher   forall a b. (a -> b) -> a -> b
$ \ Ptr EVP_CIPHER
cipherPtr          ->
                         forall a.
Ptr BIO_
-> Ptr EVP_PKEY
-> Ptr EVP_CIPHER
-> Ptr CChar
-> CInt
-> FunPtr PemPasswordCallback'
-> Ptr a
-> IO CInt
_write_bio_PKCS8PrivateKey Ptr BIO_
bioPtr Ptr EVP_PKEY
pkeyPtr Ptr EVP_CIPHER
cipherPtr Ptr CChar
passPtr (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
passLen) forall a. FunPtr a
nullFunPtr forall a. Ptr a
nullPtr
                  Just (Cipher
cipher, PwBS ByteString
passStr)
                      -> forall t. ByteString -> (CStringLen -> IO t) -> IO t
withBS ByteString
passStr forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
passPtr, Int
passLen) ->
                         forall a. Cipher -> (Ptr EVP_CIPHER -> IO a) -> IO a
withCipherPtr Cipher
cipher   forall a b. (a -> b) -> a -> b
$ \ Ptr EVP_CIPHER
cipherPtr          ->
                         forall a.
Ptr BIO_
-> Ptr EVP_PKEY
-> Ptr EVP_CIPHER
-> Ptr CChar
-> CInt
-> FunPtr PemPasswordCallback'
-> Ptr a
-> IO CInt
_write_bio_PKCS8PrivateKey Ptr BIO_
bioPtr Ptr EVP_PKEY
pkeyPtr Ptr EVP_CIPHER
cipherPtr Ptr CChar
passPtr (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
passLen) forall a. FunPtr a
nullFunPtr forall a. Ptr a
nullPtr
                  Just (Cipher
cipher, PwCallback PemPasswordCallback
cb)
                      -> forall a. Cipher -> (Ptr EVP_CIPHER -> IO a) -> IO a
withCipherPtr Cipher
cipher forall a b. (a -> b) -> a -> b
$ \ Ptr EVP_CIPHER
cipherPtr ->
                         forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (PemPasswordCallback' -> IO (FunPtr PemPasswordCallback')
mkPemPasswordCallback forall a b. (a -> b) -> a -> b
$ PemPasswordCallback -> PemPasswordCallback'
callPasswordCB PemPasswordCallback
cb) forall a. FunPtr a -> IO ()
freeHaskellFunPtr forall a b. (a -> b) -> a -> b
$ \FunPtr PemPasswordCallback'
cbPtr ->
                         forall a.
Ptr BIO_
-> Ptr EVP_PKEY
-> Ptr EVP_CIPHER
-> Ptr CChar
-> CInt
-> FunPtr PemPasswordCallback'
-> Ptr a
-> IO CInt
_write_bio_PKCS8PrivateKey Ptr BIO_
bioPtr Ptr EVP_PKEY
pkeyPtr Ptr EVP_CIPHER
cipherPtr forall a. Ptr a
nullPtr CInt
0 FunPtr PemPasswordCallback'
cbPtr forall a. Ptr a
nullPtr

                  Just (Cipher
cipher, PemPasswordSupply
PwTTY)
                      -> forall a. Cipher -> (Ptr EVP_CIPHER -> IO a) -> IO a
withCipherPtr Cipher
cipher forall a b. (a -> b) -> a -> b
$ \ Ptr EVP_CIPHER
cipherPtr ->
                         forall a.
Ptr BIO_
-> Ptr EVP_PKEY
-> Ptr EVP_CIPHER
-> Ptr CChar
-> CInt
-> FunPtr PemPasswordCallback'
-> Ptr a
-> IO CInt
_write_bio_PKCS8PrivateKey Ptr BIO_
bioPtr Ptr EVP_PKEY
pkeyPtr Ptr EVP_CIPHER
cipherPtr forall a. Ptr a
nullPtr CInt
0 forall a. FunPtr a
nullFunPtr forall a. Ptr a
nullPtr
         forall a. (a -> Bool) -> a -> IO ()
failIf_ (forall a. Eq a => a -> a -> Bool
/= CInt
1) CInt
ret

-- |@'writePKCS8PrivateKey'@ writes a private key to PEM string in
-- PKCS#8 format.
writePKCS8PrivateKey
    :: KeyPair key =>
       key       -- ^ private key to write
    -> Maybe (Cipher, PemPasswordSupply) -- ^ Either (symmetric cipher
                                         --   algorithm, password
                                         --   supply) or @Nothing@. If
                                         --   @Nothing@ is given the
                                         --   private key is not
                                         --   encrypted.
    -> IO String -- ^ the result PEM string
writePKCS8PrivateKey :: forall key.
KeyPair key =>
key -> Maybe (Cipher, PemPasswordSupply) -> IO String
writePKCS8PrivateKey key
pkey Maybe (Cipher, PemPasswordSupply)
encryption
    = do BIO
mem <- IO BIO
newMem
         forall key.
KeyPair key =>
BIO -> key -> Maybe (Cipher, PemPasswordSupply) -> IO ()
writePKCS8PrivateKey' BIO
mem key
pkey Maybe (Cipher, PemPasswordSupply)
encryption
         BIO -> IO String
bioRead BIO
mem


foreign import capi safe "openssl/pem.h PEM_read_bio_PrivateKey"
        _read_bio_PrivateKey :: Ptr BIO_
                             -> Ptr (Ptr EVP_PKEY)
                             -> FunPtr PemPasswordCallback'
                             -> CString
                             -> IO (Ptr EVP_PKEY)

readPrivateKey' :: BIO -> PemPasswordSupply -> IO SomeKeyPair
readPrivateKey' :: BIO -> PemPasswordSupply -> IO SomeKeyPair
readPrivateKey' BIO
bio PemPasswordSupply
supply
    = forall a. BIO -> (Ptr BIO_ -> IO a) -> IO a
withBioPtr BIO
bio forall a b. (a -> b) -> a -> b
$ \ Ptr BIO_
bioPtr ->
      do Ptr EVP_PKEY
pkeyPtr <- case PemPasswordSupply
supply of
                      PemPasswordSupply
PwNone
                          -> forall a. String -> (Ptr CChar -> IO a) -> IO a
withCString String
"" forall a b. (a -> b) -> a -> b
$ \ Ptr CChar
strPtr ->
                             Ptr BIO_
-> Ptr (Ptr EVP_PKEY)
-> FunPtr PemPasswordCallback'
-> Ptr CChar
-> IO (Ptr EVP_PKEY)
_read_bio_PrivateKey Ptr BIO_
bioPtr forall a. Ptr a
nullPtr forall a. FunPtr a
nullFunPtr (forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
strPtr)
                      PwStr String
passStr
                          -> forall a. String -> (Ptr CChar -> IO a) -> IO a
withCString String
passStr forall a b. (a -> b) -> a -> b
$
                             Ptr BIO_
-> Ptr (Ptr EVP_PKEY)
-> FunPtr PemPasswordCallback'
-> Ptr CChar
-> IO (Ptr EVP_PKEY)
_read_bio_PrivateKey Ptr BIO_
bioPtr forall a. Ptr a
nullPtr forall a. FunPtr a
nullFunPtr
                      PwBS ByteString
passStr
                          -> forall t. ByteString -> (CStringLen -> IO t) -> IO t
withBS ByteString
passStr forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
passPtr,Int
_) ->
                             Ptr BIO_
-> Ptr (Ptr EVP_PKEY)
-> FunPtr PemPasswordCallback'
-> Ptr CChar
-> IO (Ptr EVP_PKEY)
_read_bio_PrivateKey Ptr BIO_
bioPtr forall a. Ptr a
nullPtr forall a. FunPtr a
nullFunPtr Ptr CChar
passPtr
                      PwCallback PemPasswordCallback
cb
                          -> forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (PemPasswordCallback' -> IO (FunPtr PemPasswordCallback')
mkPemPasswordCallback forall a b. (a -> b) -> a -> b
$ PemPasswordCallback -> PemPasswordCallback'
callPasswordCB PemPasswordCallback
cb) forall a. FunPtr a -> IO ()
freeHaskellFunPtr forall a b. (a -> b) -> a -> b
$ \FunPtr PemPasswordCallback'
cbPtr ->
                             Ptr BIO_
-> Ptr (Ptr EVP_PKEY)
-> FunPtr PemPasswordCallback'
-> Ptr CChar
-> IO (Ptr EVP_PKEY)
_read_bio_PrivateKey Ptr BIO_
bioPtr forall a. Ptr a
nullPtr FunPtr PemPasswordCallback'
cbPtr forall a. Ptr a
nullPtr
                      PemPasswordSupply
PwTTY
                          -> Ptr BIO_
-> Ptr (Ptr EVP_PKEY)
-> FunPtr PemPasswordCallback'
-> Ptr CChar
-> IO (Ptr EVP_PKEY)
_read_bio_PrivateKey Ptr BIO_
bioPtr forall a. Ptr a
nullPtr forall a. FunPtr a
nullFunPtr forall a. Ptr a
nullPtr
         forall a. Ptr a -> IO ()
failIfNull_ Ptr EVP_PKEY
pkeyPtr
         forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. HasCallStack => Maybe a -> a
fromJust (Ptr EVP_PKEY -> IO VaguePKey
wrapPKeyPtr Ptr EVP_PKEY
pkeyPtr forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall k. PKey k => VaguePKey -> IO (Maybe k)
fromPKey)

-- |@'readPrivateKey' pem supply@ reads a private key in PEM string.
readPrivateKey :: String -> PemPasswordSupply -> IO SomeKeyPair
readPrivateKey :: String -> PemPasswordSupply -> IO SomeKeyPair
readPrivateKey String
pemStr PemPasswordSupply
supply
    = do BIO
mem <- String -> IO BIO
newConstMem String
pemStr
         BIO -> PemPasswordSupply -> IO SomeKeyPair
readPrivateKey' BIO
mem PemPasswordSupply
supply


{- Public Key ---------------------------------------------------------------- -}

foreign import capi unsafe "openssl/pem.h PEM_write_bio_PUBKEY"
        _write_bio_PUBKEY :: Ptr BIO_ -> Ptr EVP_PKEY -> IO CInt

foreign import capi unsafe "openssl/pem.h PEM_read_bio_PUBKEY"
        _read_bio_PUBKEY :: Ptr BIO_
                         -> Ptr (Ptr EVP_PKEY)
                         -> FunPtr PemPasswordCallback'
                         -> Ptr ()
                         -> IO (Ptr EVP_PKEY)


writePublicKey' :: PublicKey key => BIO -> key -> IO ()
writePublicKey' :: forall key. PublicKey key => BIO -> key -> IO ()
writePublicKey' BIO
bio key
key
    = forall a. BIO -> (Ptr BIO_ -> IO a) -> IO a
withBioPtr BIO
bio   forall a b. (a -> b) -> a -> b
$ \ Ptr BIO_
bioPtr  ->
      forall k a. PKey k => k -> (Ptr EVP_PKEY -> IO a) -> IO a
withPKeyPtr' key
key forall a b. (a -> b) -> a -> b
$ \ Ptr EVP_PKEY
pkeyPtr ->
      Ptr BIO_ -> Ptr EVP_PKEY -> IO CInt
_write_bio_PUBKEY Ptr BIO_
bioPtr Ptr EVP_PKEY
pkeyPtr forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (a -> Bool) -> a -> IO a
failIf (forall a. Eq a => a -> a -> Bool
/= CInt
1) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- |@'writePublicKey' pubkey@ writes a public to PEM string.
writePublicKey :: PublicKey key => key -> IO String
writePublicKey :: forall key. PublicKey key => key -> IO String
writePublicKey key
pkey
    = do BIO
mem <- IO BIO
newMem
         forall key. PublicKey key => BIO -> key -> IO ()
writePublicKey' BIO
mem key
pkey
         BIO -> IO String
bioRead BIO
mem

-- Why the heck PEM_read_bio_PUBKEY takes pem_password_cb? Is there
-- any form of encrypted public key?
readPublicKey' :: BIO -> IO SomePublicKey
readPublicKey' :: BIO -> IO SomePublicKey
readPublicKey' BIO
bio
    = forall a. BIO -> (Ptr BIO_ -> IO a) -> IO a
withBioPtr BIO
bio forall a b. (a -> b) -> a -> b
$ \ Ptr BIO_
bioPtr ->
      forall a. String -> (Ptr CChar -> IO a) -> IO a
withCString String
"" forall a b. (a -> b) -> a -> b
$ \ Ptr CChar
passPtr ->
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. HasCallStack => Maybe a -> a
fromJust
           ( Ptr BIO_
-> Ptr (Ptr EVP_PKEY)
-> FunPtr PemPasswordCallback'
-> Ptr ()
-> IO (Ptr EVP_PKEY)
_read_bio_PUBKEY Ptr BIO_
bioPtr forall a. Ptr a
nullPtr forall a. FunPtr a
nullFunPtr (forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
passPtr)
             forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Ptr a -> IO (Ptr a)
failIfNull
             forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr EVP_PKEY -> IO VaguePKey
wrapPKeyPtr
             forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall k. PKey k => VaguePKey -> IO (Maybe k)
fromPKey
           )

-- |@'readPublicKey' pem@ reads a public key in PEM string.
readPublicKey :: String -> IO SomePublicKey
readPublicKey :: String -> IO SomePublicKey
readPublicKey String
pemStr
    = String -> IO BIO
newConstMem String
pemStr forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= BIO -> IO SomePublicKey
readPublicKey'


{- X.509 certificate --------------------------------------------------------- -}

foreign import capi unsafe "openssl/pem.h PEM_write_bio_X509"
        _write_bio_X509 :: Ptr BIO_
                        -> Ptr X509_
                        -> IO CInt

foreign import capi safe "openssl/pem.h PEM_read_bio_X509"
        _read_bio_X509 :: Ptr BIO_
                       -> Ptr (Ptr X509_)
                       -> FunPtr PemPasswordCallback'
                       -> Ptr ()
                       -> IO (Ptr X509_)

writeX509' :: BIO -> X509 -> IO ()
writeX509' :: BIO -> X509 -> IO ()
writeX509' BIO
bio X509
x509
    = forall a. BIO -> (Ptr BIO_ -> IO a) -> IO a
withBioPtr BIO
bio   forall a b. (a -> b) -> a -> b
$ \ Ptr BIO_
bioPtr  ->
      forall a. X509 -> (Ptr X509_ -> IO a) -> IO a
withX509Ptr X509
x509 forall a b. (a -> b) -> a -> b
$ \ Ptr X509_
x509Ptr ->
      Ptr BIO_ -> Ptr X509_ -> IO CInt
_write_bio_X509 Ptr BIO_
bioPtr Ptr X509_
x509Ptr
           forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (a -> Bool) -> a -> IO a
failIf (forall a. Eq a => a -> a -> Bool
/= CInt
1)
           forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>  forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- |@'writeX509' cert@ writes an X.509 certificate to PEM string.
writeX509 :: X509 -> IO String
writeX509 :: X509 -> IO String
writeX509 X509
x509
    = do BIO
mem <- IO BIO
newMem
         BIO -> X509 -> IO ()
writeX509' BIO
mem X509
x509
         BIO -> IO String
bioRead BIO
mem


-- I believe X.509 isn't encrypted.
readX509' :: BIO -> IO X509
readX509' :: BIO -> IO X509
readX509' BIO
bio
    = forall a. BIO -> (Ptr BIO_ -> IO a) -> IO a
withBioPtr BIO
bio forall a b. (a -> b) -> a -> b
$ \ Ptr BIO_
bioPtr ->
      forall a. String -> (Ptr CChar -> IO a) -> IO a
withCString String
"" forall a b. (a -> b) -> a -> b
$ \ Ptr CChar
passPtr ->
      Ptr BIO_
-> Ptr (Ptr X509_)
-> FunPtr PemPasswordCallback'
-> Ptr ()
-> IO (Ptr X509_)
_read_bio_X509 Ptr BIO_
bioPtr forall a. Ptr a
nullPtr forall a. FunPtr a
nullFunPtr (forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
passPtr)
           forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Ptr a -> IO (Ptr a)
failIfNull
           forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr X509_ -> IO X509
wrapX509

-- |@'readX509' pem@ reads an X.509 certificate in PEM string.
readX509 :: String -> IO X509
readX509 :: String -> IO X509
readX509 String
pemStr
    = String -> IO BIO
newConstMem String
pemStr forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= BIO -> IO X509
readX509'


{- PKCS#10 certificate request ----------------------------------------------- -}

foreign import capi unsafe "openssl/pem.h PEM_write_bio_X509_REQ"
        _write_bio_X509_REQ :: Ptr BIO_
                            -> Ptr X509_REQ
                            -> IO CInt

foreign import capi unsafe "openssl/pem.h PEM_write_bio_X509_REQ_NEW"
        _write_bio_X509_REQ_NEW :: Ptr BIO_
                                -> Ptr X509_REQ
                                -> IO CInt

foreign import capi safe "openssl/pem.h PEM_read_bio_X509_REQ"
        _read_bio_X509_REQ :: Ptr BIO_
                           -> Ptr (Ptr X509_REQ)
                           -> FunPtr PemPasswordCallback'
                           -> Ptr ()
                           -> IO (Ptr X509_REQ)

-- |@'PemX509ReqFormat'@ represents format of PKCS#10 certificate
-- request.
data PemX509ReqFormat
    = ReqNewFormat -- ^ The new format, whose header is \"NEW
                   --   CERTIFICATE REQUEST\".
    | ReqOldFormat -- ^ The old format, whose header is \"CERTIFICATE
                   --   REQUEST\".


writeX509Req' :: BIO -> X509Req -> PemX509ReqFormat -> IO ()
writeX509Req' :: BIO -> X509Req -> PemX509ReqFormat -> IO ()
writeX509Req' BIO
bio X509Req
req PemX509ReqFormat
format
    = forall a. BIO -> (Ptr BIO_ -> IO a) -> IO a
withBioPtr BIO
bio     forall a b. (a -> b) -> a -> b
$ \ Ptr BIO_
bioPtr ->
      forall a. X509Req -> (Ptr X509_REQ -> IO a) -> IO a
withX509ReqPtr X509Req
req forall a b. (a -> b) -> a -> b
$ \ Ptr X509_REQ
reqPtr ->
      Ptr BIO_ -> Ptr X509_REQ -> IO CInt
writer Ptr BIO_
bioPtr Ptr X509_REQ
reqPtr
                 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (a -> Bool) -> a -> IO a
failIf (forall a. Eq a => a -> a -> Bool
/= CInt
1)
                 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>  forall (m :: * -> *) a. Monad m => a -> m a
return ()
    where
      writer :: Ptr BIO_ -> Ptr X509_REQ -> IO CInt
writer = case PemX509ReqFormat
format of
                 PemX509ReqFormat
ReqNewFormat -> Ptr BIO_ -> Ptr X509_REQ -> IO CInt
_write_bio_X509_REQ_NEW
                 PemX509ReqFormat
ReqOldFormat -> Ptr BIO_ -> Ptr X509_REQ -> IO CInt
_write_bio_X509_REQ

-- |@'writeX509Req'@ writes a PKCS#10 certificate request to PEM
-- string.
writeX509Req :: X509Req          -- ^ request
             -> PemX509ReqFormat -- ^ format
             -> IO String        -- ^ the result PEM string
writeX509Req :: X509Req -> PemX509ReqFormat -> IO String
writeX509Req X509Req
req PemX509ReqFormat
format
    = do BIO
mem <- IO BIO
newMem
         BIO -> X509Req -> PemX509ReqFormat -> IO ()
writeX509Req' BIO
mem X509Req
req PemX509ReqFormat
format
         BIO -> IO String
bioRead BIO
mem


readX509Req' :: BIO -> IO X509Req
readX509Req' :: BIO -> IO X509Req
readX509Req' BIO
bio
    = forall a. BIO -> (Ptr BIO_ -> IO a) -> IO a
withBioPtr BIO
bio forall a b. (a -> b) -> a -> b
$ \ Ptr BIO_
bioPtr ->
      forall a. String -> (Ptr CChar -> IO a) -> IO a
withCString String
"" forall a b. (a -> b) -> a -> b
$ \ Ptr CChar
passPtr ->
      Ptr BIO_
-> Ptr (Ptr X509_REQ)
-> FunPtr PemPasswordCallback'
-> Ptr ()
-> IO (Ptr X509_REQ)
_read_bio_X509_REQ Ptr BIO_
bioPtr forall a. Ptr a
nullPtr forall a. FunPtr a
nullFunPtr (forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
passPtr)
           forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Ptr a -> IO (Ptr a)
failIfNull
           forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr X509_REQ -> IO X509Req
wrapX509Req

-- |@'readX509Req'@ reads a PKCS#10 certificate request in PEM string.
readX509Req :: String -> IO X509Req
readX509Req :: String -> IO X509Req
readX509Req String
pemStr
    = String -> IO BIO
newConstMem String
pemStr forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= BIO -> IO X509Req
readX509Req'


{- Certificate Revocation List ----------------------------------------------- -}

foreign import capi unsafe "openssl/pem.h PEM_write_bio_X509_CRL"
        _write_bio_X509_CRL :: Ptr BIO_
                            -> Ptr X509_CRL
                            -> IO CInt

foreign import capi safe "openssl/pem.h PEM_read_bio_X509_CRL"
        _read_bio_X509_CRL :: Ptr BIO_
                           -> Ptr (Ptr X509_CRL)
                           -> FunPtr PemPasswordCallback'
                           -> Ptr ()
                           -> IO (Ptr X509_CRL)


writeCRL' :: BIO -> CRL -> IO ()
writeCRL' :: BIO -> CRL -> IO ()
writeCRL' BIO
bio CRL
crl
    = forall a. BIO -> (Ptr BIO_ -> IO a) -> IO a
withBioPtr BIO
bio forall a b. (a -> b) -> a -> b
$ \ Ptr BIO_
bioPtr ->
      forall a. CRL -> (Ptr X509_CRL -> IO a) -> IO a
withCRLPtr CRL
crl forall a b. (a -> b) -> a -> b
$ \ Ptr X509_CRL
crlPtr ->
      Ptr BIO_ -> Ptr X509_CRL -> IO CInt
_write_bio_X509_CRL Ptr BIO_
bioPtr Ptr X509_CRL
crlPtr
           forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (a -> Bool) -> a -> IO a
failIf (forall a. Eq a => a -> a -> Bool
/= CInt
1)
           forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>  forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- |@'writeCRL' crl@ writes a Certificate Revocation List to PEM
-- string.
writeCRL :: CRL -> IO String
writeCRL :: CRL -> IO String
writeCRL CRL
crl
    = do BIO
mem <- IO BIO
newMem
         BIO -> CRL -> IO ()
writeCRL' BIO
mem CRL
crl
         BIO -> IO String
bioRead BIO
mem


readCRL' :: BIO -> IO CRL
readCRL' :: BIO -> IO CRL
readCRL' BIO
bio
    = forall a. BIO -> (Ptr BIO_ -> IO a) -> IO a
withBioPtr BIO
bio forall a b. (a -> b) -> a -> b
$ \ Ptr BIO_
bioPtr ->
      forall a. String -> (Ptr CChar -> IO a) -> IO a
withCString String
"" forall a b. (a -> b) -> a -> b
$ \ Ptr CChar
passPtr ->
      Ptr BIO_
-> Ptr (Ptr X509_CRL)
-> FunPtr PemPasswordCallback'
-> Ptr ()
-> IO (Ptr X509_CRL)
_read_bio_X509_CRL Ptr BIO_
bioPtr forall a. Ptr a
nullPtr forall a. FunPtr a
nullFunPtr (forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
passPtr)
           forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Ptr a -> IO (Ptr a)
failIfNull
           forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr X509_CRL -> IO CRL
wrapCRL

-- |@'readCRL' pem@ reads a Certificate Revocation List in PEM string.
readCRL :: String -> IO CRL
readCRL :: String -> IO CRL
readCRL String
pemStr
    = String -> IO BIO
newConstMem String
pemStr forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= BIO -> IO CRL
readCRL'


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

foreign import capi unsafe "openssl/pem.h PEM_write_bio_PKCS7"
        _write_bio_PKCS7 :: Ptr BIO_
                         -> Ptr PKCS7
                         -> IO CInt

foreign import capi safe "openssl/pem.h PEM_read_bio_PKCS7"
        _read_bio_PKCS7 :: Ptr BIO_
                        -> Ptr (Ptr PKCS7)
                        -> FunPtr PemPasswordCallback'
                        -> Ptr ()
                        -> IO (Ptr PKCS7)


writePkcs7' :: BIO -> Pkcs7 -> IO ()
writePkcs7' :: BIO -> Pkcs7 -> IO ()
writePkcs7' BIO
bio Pkcs7
pkcs7
    = forall a. BIO -> (Ptr BIO_ -> IO a) -> IO a
withBioPtr BIO
bio     forall a b. (a -> b) -> a -> b
$ \ Ptr BIO_
bioPtr ->
      forall a. Pkcs7 -> (Ptr PKCS7 -> IO a) -> IO a
withPkcs7Ptr Pkcs7
pkcs7 forall a b. (a -> b) -> a -> b
$ \ Ptr PKCS7
pkcs7Ptr ->
      Ptr BIO_ -> Ptr PKCS7 -> IO CInt
_write_bio_PKCS7 Ptr BIO_
bioPtr Ptr PKCS7
pkcs7Ptr
           forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (a -> Bool) -> a -> IO a
failIf (forall a. Eq a => a -> a -> Bool
/= CInt
1)
           forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>  forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- |@'writePkcs7' p7@ writes a PKCS#7 structure to PEM string.
writePkcs7 :: Pkcs7 -> IO String
writePkcs7 :: Pkcs7 -> IO String
writePkcs7 Pkcs7
pkcs7
    = do BIO
mem <- IO BIO
newMem
         BIO -> Pkcs7 -> IO ()
writePkcs7' BIO
mem Pkcs7
pkcs7
         BIO -> IO String
bioRead BIO
mem


readPkcs7' :: BIO -> IO Pkcs7
readPkcs7' :: BIO -> IO Pkcs7
readPkcs7' BIO
bio
    = forall a. BIO -> (Ptr BIO_ -> IO a) -> IO a
withBioPtr BIO
bio forall a b. (a -> b) -> a -> b
$ \ Ptr BIO_
bioPtr ->
      forall a. String -> (Ptr CChar -> IO a) -> IO a
withCString String
"" forall a b. (a -> b) -> a -> b
$ \ Ptr CChar
passPtr ->
      Ptr BIO_
-> Ptr (Ptr PKCS7)
-> FunPtr PemPasswordCallback'
-> Ptr ()
-> IO (Ptr PKCS7)
_read_bio_PKCS7 Ptr BIO_
bioPtr forall a. Ptr a
nullPtr forall a. FunPtr a
nullFunPtr (forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
passPtr)
           forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Ptr a -> IO (Ptr a)
failIfNull
           forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr PKCS7 -> IO Pkcs7
wrapPkcs7Ptr

-- |@'readPkcs7' pem@ reads a PKCS#7 structure in PEM string.
readPkcs7 :: String -> IO Pkcs7
readPkcs7 :: String -> IO Pkcs7
readPkcs7 String
pemStr
    = String -> IO BIO
newConstMem String
pemStr forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= BIO -> IO Pkcs7
readPkcs7'

{- DH parameters ------------------------------------------------------------- -}

foreign import capi unsafe "openssl/pem.h PEM_write_bio_DHparams"
        _write_bio_DH :: Ptr BIO_
                      -> Ptr DH_
                      -> IO CInt

foreign import capi safe "openssl/pem.h PEM_read_bio_DHparams"
        _read_bio_DH :: Ptr BIO_
                     -> Ptr (Ptr DH_)
                     -> FunPtr PemPasswordCallback'
                     -> Ptr ()
                     -> IO (Ptr DH_)

writeDHParams' :: BIO -> DHP -> IO ()
writeDHParams' :: BIO -> DHP -> IO ()
writeDHParams' BIO
bio DHP
dh
    = forall a. BIO -> (Ptr BIO_ -> IO a) -> IO a
withBioPtr BIO
bio forall a b. (a -> b) -> a -> b
$ \ Ptr BIO_
bioPtr ->
      forall a. DHP -> (Ptr DH_ -> IO a) -> IO a
withDHPPtr DHP
dh  forall a b. (a -> b) -> a -> b
$ \ Ptr DH_
dhPtr ->
        Ptr BIO_ -> Ptr DH_ -> IO CInt
_write_bio_DH Ptr BIO_
bioPtr Ptr DH_
dhPtr forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (a -> Bool) -> a -> IO ()
failIf_ (forall a. Eq a => a -> a -> Bool
/= CInt
1)

-- |@'writeDHParams' dh@ writes DH parameters to PEM string.
writeDHParams :: DHP -> IO String
writeDHParams :: DHP -> IO String
writeDHParams DHP
dh
    = do BIO
mem <- IO BIO
newMem
         BIO -> DHP -> IO ()
writeDHParams' BIO
mem DHP
dh
         BIO -> IO String
bioRead BIO
mem

readDHParams' :: BIO -> IO DHP
readDHParams' :: BIO -> IO DHP
readDHParams' BIO
bio
    = forall a. BIO -> (Ptr BIO_ -> IO a) -> IO a
withBioPtr BIO
bio forall a b. (a -> b) -> a -> b
$ \ Ptr BIO_
bioPtr ->
      forall a. String -> (Ptr CChar -> IO a) -> IO a
withCString String
"" forall a b. (a -> b) -> a -> b
$ \ Ptr CChar
passPtr ->
        Ptr BIO_
-> Ptr (Ptr DH_)
-> FunPtr PemPasswordCallback'
-> Ptr ()
-> IO (Ptr DH_)
_read_bio_DH Ptr BIO_
bioPtr forall a. Ptr a
nullPtr forall a. FunPtr a
nullFunPtr (forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
passPtr)
          forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Ptr a -> IO (Ptr a)
failIfNull
          forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr DH_ -> IO DHP
wrapDHPPtr

-- |@'readDHParams' pem@ reads DH parameters in PEM string.
readDHParams :: String -> IO DHP
readDHParams :: String -> IO DHP
readDHParams String
pemStr
    = String -> IO BIO
newConstMem String
pemStr forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= BIO -> IO DHP
readDHParams'


withBS :: B8.ByteString -> ((Ptr CChar, Int) -> IO t) -> IO t
withBS :: forall t. ByteString -> (CStringLen -> IO t) -> IO t
withBS ByteString
passStr CStringLen -> IO t
act =
  forall t. ByteString -> (CStringLen -> IO t) -> IO t
B8.useAsCStringLen ByteString
passStr forall a b. (a -> b) -> a -> b
$ \ (Ptr CChar
passPtr, Int
passLen) ->
  forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. IO a -> IO b -> IO a
finally (forall a. Ptr a -> CInt -> CSize -> IO ()
memset Ptr CChar
passPtr CInt
0 forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
passLen) forall a b. (a -> b) -> a -> b
$
  CStringLen -> IO t
act (forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
passPtr, Int
passLen)

foreign import capi unsafe "string.h memset" memset :: Ptr a -> CInt -> CSize -> IO ()