{-# LANGUAGE CPP                      #-}
{-# LANGUAGE ForeignFunctionInterface #-}
-- |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
_ = PemPasswordRWState
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 = String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
passStr

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

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


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

foreign import ccall safe "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' :: BIO -> key -> Maybe (Cipher, PemPasswordSupply) -> IO ()
writePKCS8PrivateKey' BIO
bio key
key Maybe (Cipher, PemPasswordSupply)
encryption
    = BIO -> (Ptr BIO_ -> IO ()) -> IO ()
forall a. BIO -> (Ptr BIO_ -> IO a) -> IO a
withBioPtr BIO
bio   ((Ptr BIO_ -> IO ()) -> IO ()) -> (Ptr BIO_ -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ Ptr BIO_
bioPtr  ->
      key -> (Ptr EVP_PKEY -> IO ()) -> IO ()
forall k a. PKey k => k -> (Ptr EVP_PKEY -> IO a) -> IO a
withPKeyPtr' key
key ((Ptr EVP_PKEY -> IO ()) -> IO ())
-> (Ptr EVP_PKEY -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ Ptr EVP_PKEY
pkeyPtr ->
      do CInt
ret <- case Maybe (Cipher, PemPasswordSupply)
encryption of
                  Maybe (Cipher, PemPasswordSupply)
Nothing
                      -> Ptr BIO_
-> Ptr EVP_PKEY
-> Ptr EVP_CIPHER
-> Ptr CChar
-> CInt
-> FunPtr PemPasswordCallback'
-> Ptr Any
-> IO CInt
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
forall a. Ptr a
nullPtr Ptr CChar
forall a. Ptr a
nullPtr CInt
0 FunPtr PemPasswordCallback'
forall a. FunPtr a
nullFunPtr Ptr Any
forall a. Ptr a
nullPtr

                  Just (Cipher
_, PemPasswordSupply
PwNone)
                      -> Ptr BIO_
-> Ptr EVP_PKEY
-> Ptr EVP_CIPHER
-> Ptr CChar
-> CInt
-> FunPtr PemPasswordCallback'
-> Ptr Any
-> IO CInt
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
forall a. Ptr a
nullPtr Ptr CChar
forall a. Ptr a
nullPtr CInt
0 FunPtr PemPasswordCallback'
forall a. FunPtr a
nullFunPtr Ptr Any
forall a. Ptr a
nullPtr

                  Just (Cipher
cipher, PwStr String
passStr)
                      -> String -> (CStringLen -> IO CInt) -> IO CInt
forall a. String -> (CStringLen -> IO a) -> IO a
withCStringLen String
passStr ((CStringLen -> IO CInt) -> IO CInt)
-> (CStringLen -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
passPtr, Int
passLen) ->
                         Cipher -> (Ptr EVP_CIPHER -> IO CInt) -> IO CInt
forall a. Cipher -> (Ptr EVP_CIPHER -> IO a) -> IO a
withCipherPtr Cipher
cipher   ((Ptr EVP_CIPHER -> IO CInt) -> IO CInt)
-> (Ptr EVP_CIPHER -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \ Ptr EVP_CIPHER
cipherPtr          ->
                         Ptr BIO_
-> Ptr EVP_PKEY
-> Ptr EVP_CIPHER
-> Ptr CChar
-> CInt
-> FunPtr PemPasswordCallback'
-> Ptr Any
-> IO CInt
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 (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
passLen) FunPtr PemPasswordCallback'
forall a. FunPtr a
nullFunPtr Ptr Any
forall a. Ptr a
nullPtr
                  Just (Cipher
cipher, PwBS ByteString
passStr)
                      -> ByteString -> (CStringLen -> IO CInt) -> IO CInt
forall t. ByteString -> (CStringLen -> IO t) -> IO t
withBS ByteString
passStr ((CStringLen -> IO CInt) -> IO CInt)
-> (CStringLen -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
passPtr, Int
passLen) ->
                         Cipher -> (Ptr EVP_CIPHER -> IO CInt) -> IO CInt
forall a. Cipher -> (Ptr EVP_CIPHER -> IO a) -> IO a
withCipherPtr Cipher
cipher   ((Ptr EVP_CIPHER -> IO CInt) -> IO CInt)
-> (Ptr EVP_CIPHER -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \ Ptr EVP_CIPHER
cipherPtr          ->
                         Ptr BIO_
-> Ptr EVP_PKEY
-> Ptr EVP_CIPHER
-> Ptr CChar
-> CInt
-> FunPtr PemPasswordCallback'
-> Ptr Any
-> IO CInt
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 (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
passLen) FunPtr PemPasswordCallback'
forall a. FunPtr a
nullFunPtr Ptr Any
forall a. Ptr a
nullPtr
                  Just (Cipher
cipher, PwCallback PemPasswordCallback
cb)
                      -> Cipher -> (Ptr EVP_CIPHER -> IO CInt) -> IO CInt
forall a. Cipher -> (Ptr EVP_CIPHER -> IO a) -> IO a
withCipherPtr Cipher
cipher ((Ptr EVP_CIPHER -> IO CInt) -> IO CInt)
-> (Ptr EVP_CIPHER -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \ Ptr EVP_CIPHER
cipherPtr ->
                         IO (FunPtr PemPasswordCallback')
-> (FunPtr PemPasswordCallback' -> IO ())
-> (FunPtr PemPasswordCallback' -> IO CInt)
-> IO CInt
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (PemPasswordCallback' -> IO (FunPtr PemPasswordCallback')
mkPemPasswordCallback (PemPasswordCallback' -> IO (FunPtr PemPasswordCallback'))
-> PemPasswordCallback' -> IO (FunPtr PemPasswordCallback')
forall a b. (a -> b) -> a -> b
$ PemPasswordCallback -> PemPasswordCallback'
callPasswordCB PemPasswordCallback
cb) FunPtr PemPasswordCallback' -> IO ()
forall a. FunPtr a -> IO ()
freeHaskellFunPtr ((FunPtr PemPasswordCallback' -> IO CInt) -> IO CInt)
-> (FunPtr PemPasswordCallback' -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \FunPtr PemPasswordCallback'
cbPtr ->
                         Ptr BIO_
-> Ptr EVP_PKEY
-> Ptr EVP_CIPHER
-> Ptr CChar
-> CInt
-> FunPtr PemPasswordCallback'
-> Ptr Any
-> IO CInt
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
forall a. Ptr a
nullPtr CInt
0 FunPtr PemPasswordCallback'
cbPtr Ptr Any
forall a. Ptr a
nullPtr
               
                  Just (Cipher
cipher, PemPasswordSupply
PwTTY)
                      -> Cipher -> (Ptr EVP_CIPHER -> IO CInt) -> IO CInt
forall a. Cipher -> (Ptr EVP_CIPHER -> IO a) -> IO a
withCipherPtr Cipher
cipher ((Ptr EVP_CIPHER -> IO CInt) -> IO CInt)
-> (Ptr EVP_CIPHER -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \ Ptr EVP_CIPHER
cipherPtr ->
                         Ptr BIO_
-> Ptr EVP_PKEY
-> Ptr EVP_CIPHER
-> Ptr CChar
-> CInt
-> FunPtr PemPasswordCallback'
-> Ptr Any
-> IO CInt
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
forall a. Ptr a
nullPtr CInt
0 FunPtr PemPasswordCallback'
forall a. FunPtr a
nullFunPtr Ptr Any
forall a. Ptr a
nullPtr
         (CInt -> Bool) -> CInt -> IO ()
forall a. (a -> Bool) -> a -> IO ()
failIf_ (CInt -> CInt -> Bool
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 :: key -> Maybe (Cipher, PemPasswordSupply) -> IO String
writePKCS8PrivateKey key
pkey Maybe (Cipher, PemPasswordSupply)
encryption
    = do BIO
mem <- IO BIO
newMem
         BIO -> key -> Maybe (Cipher, PemPasswordSupply) -> IO ()
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 ccall safe "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
    = BIO -> (Ptr BIO_ -> IO SomeKeyPair) -> IO SomeKeyPair
forall a. BIO -> (Ptr BIO_ -> IO a) -> IO a
withBioPtr BIO
bio ((Ptr BIO_ -> IO SomeKeyPair) -> IO SomeKeyPair)
-> (Ptr BIO_ -> IO SomeKeyPair) -> IO SomeKeyPair
forall a b. (a -> b) -> a -> b
$ \ Ptr BIO_
bioPtr ->
      do Ptr EVP_PKEY
pkeyPtr <- case PemPasswordSupply
supply of
                      PemPasswordSupply
PwNone
                          -> String -> (Ptr CChar -> IO (Ptr EVP_PKEY)) -> IO (Ptr EVP_PKEY)
forall a. String -> (Ptr CChar -> IO a) -> IO a
withCString String
"" ((Ptr CChar -> IO (Ptr EVP_PKEY)) -> IO (Ptr EVP_PKEY))
-> (Ptr CChar -> IO (Ptr EVP_PKEY)) -> IO (Ptr EVP_PKEY)
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 Ptr (Ptr EVP_PKEY)
forall a. Ptr a
nullPtr FunPtr PemPasswordCallback'
forall a. FunPtr a
nullFunPtr (Ptr CChar -> Ptr CChar
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
strPtr)
                      PwStr String
passStr
                          -> String -> (Ptr CChar -> IO (Ptr EVP_PKEY)) -> IO (Ptr EVP_PKEY)
forall a. String -> (Ptr CChar -> IO a) -> IO a
withCString String
passStr ((Ptr CChar -> IO (Ptr EVP_PKEY)) -> IO (Ptr EVP_PKEY))
-> (Ptr CChar -> IO (Ptr EVP_PKEY)) -> IO (Ptr EVP_PKEY)
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 Ptr (Ptr EVP_PKEY)
forall a. Ptr a
nullPtr FunPtr PemPasswordCallback'
forall a. FunPtr a
nullFunPtr
                      PwBS ByteString
passStr
                          -> ByteString
-> (CStringLen -> IO (Ptr EVP_PKEY)) -> IO (Ptr EVP_PKEY)
forall t. ByteString -> (CStringLen -> IO t) -> IO t
withBS ByteString
passStr ((CStringLen -> IO (Ptr EVP_PKEY)) -> IO (Ptr EVP_PKEY))
-> (CStringLen -> IO (Ptr EVP_PKEY)) -> IO (Ptr EVP_PKEY)
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 Ptr (Ptr EVP_PKEY)
forall a. Ptr a
nullPtr FunPtr PemPasswordCallback'
forall a. FunPtr a
nullFunPtr Ptr CChar
passPtr
                      PwCallback PemPasswordCallback
cb
                          -> IO (FunPtr PemPasswordCallback')
-> (FunPtr PemPasswordCallback' -> IO ())
-> (FunPtr PemPasswordCallback' -> IO (Ptr EVP_PKEY))
-> IO (Ptr EVP_PKEY)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (PemPasswordCallback' -> IO (FunPtr PemPasswordCallback')
mkPemPasswordCallback (PemPasswordCallback' -> IO (FunPtr PemPasswordCallback'))
-> PemPasswordCallback' -> IO (FunPtr PemPasswordCallback')
forall a b. (a -> b) -> a -> b
$ PemPasswordCallback -> PemPasswordCallback'
callPasswordCB PemPasswordCallback
cb) FunPtr PemPasswordCallback' -> IO ()
forall a. FunPtr a -> IO ()
freeHaskellFunPtr ((FunPtr PemPasswordCallback' -> IO (Ptr EVP_PKEY))
 -> IO (Ptr EVP_PKEY))
-> (FunPtr PemPasswordCallback' -> IO (Ptr EVP_PKEY))
-> IO (Ptr EVP_PKEY)
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 Ptr (Ptr EVP_PKEY)
forall a. Ptr a
nullPtr FunPtr PemPasswordCallback'
cbPtr Ptr CChar
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 Ptr (Ptr EVP_PKEY)
forall a. Ptr a
nullPtr FunPtr PemPasswordCallback'
forall a. FunPtr a
nullFunPtr Ptr CChar
forall a. Ptr a
nullPtr 
         Ptr EVP_PKEY -> IO ()
forall a. Ptr a -> IO ()
failIfNull_ Ptr EVP_PKEY
pkeyPtr
         (Maybe SomeKeyPair -> SomeKeyPair)
-> IO (Maybe SomeKeyPair) -> IO SomeKeyPair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe SomeKeyPair -> SomeKeyPair
forall a. HasCallStack => Maybe a -> a
fromJust (Ptr EVP_PKEY -> IO VaguePKey
wrapPKeyPtr Ptr EVP_PKEY
pkeyPtr IO VaguePKey
-> (VaguePKey -> IO (Maybe SomeKeyPair)) -> IO (Maybe SomeKeyPair)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= VaguePKey -> IO (Maybe SomeKeyPair)
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 ccall unsafe "PEM_write_bio_PUBKEY"
        _write_bio_PUBKEY :: Ptr BIO_ -> Ptr EVP_PKEY -> IO CInt

foreign import ccall unsafe "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' :: BIO -> key -> IO ()
writePublicKey' BIO
bio key
key
    = BIO -> (Ptr BIO_ -> IO ()) -> IO ()
forall a. BIO -> (Ptr BIO_ -> IO a) -> IO a
withBioPtr BIO
bio   ((Ptr BIO_ -> IO ()) -> IO ()) -> (Ptr BIO_ -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ Ptr BIO_
bioPtr  ->
      key -> (Ptr EVP_PKEY -> IO ()) -> IO ()
forall k a. PKey k => k -> (Ptr EVP_PKEY -> IO a) -> IO a
withPKeyPtr' key
key ((Ptr EVP_PKEY -> IO ()) -> IO ())
-> (Ptr EVP_PKEY -> IO ()) -> IO ()
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 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 ()

-- |@'writePublicKey' pubkey@ writes a public to PEM string.
writePublicKey :: PublicKey key => key -> IO String
writePublicKey :: key -> IO String
writePublicKey key
pkey
    = do BIO
mem <- IO BIO
newMem
         BIO -> key -> IO ()
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
    = BIO -> (Ptr BIO_ -> IO SomePublicKey) -> IO SomePublicKey
forall a. BIO -> (Ptr BIO_ -> IO a) -> IO a
withBioPtr BIO
bio ((Ptr BIO_ -> IO SomePublicKey) -> IO SomePublicKey)
-> (Ptr BIO_ -> IO SomePublicKey) -> IO SomePublicKey
forall a b. (a -> b) -> a -> b
$ \ Ptr BIO_
bioPtr ->
      String -> (Ptr CChar -> IO SomePublicKey) -> IO SomePublicKey
forall a. String -> (Ptr CChar -> IO a) -> IO a
withCString String
"" ((Ptr CChar -> IO SomePublicKey) -> IO SomePublicKey)
-> (Ptr CChar -> IO SomePublicKey) -> IO SomePublicKey
forall a b. (a -> b) -> a -> b
$ \ Ptr CChar
passPtr ->
      (Maybe SomePublicKey -> SomePublicKey)
-> IO (Maybe SomePublicKey) -> IO SomePublicKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe SomePublicKey -> SomePublicKey
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 Ptr (Ptr EVP_PKEY)
forall a. Ptr a
nullPtr FunPtr PemPasswordCallback'
forall a. FunPtr a
nullFunPtr (Ptr CChar -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
passPtr)
             IO (Ptr EVP_PKEY)
-> (Ptr EVP_PKEY -> IO (Ptr EVP_PKEY)) -> IO (Ptr EVP_PKEY)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr EVP_PKEY -> IO (Ptr EVP_PKEY)
forall a. Ptr a -> IO (Ptr a)
failIfNull
             IO (Ptr EVP_PKEY) -> (Ptr EVP_PKEY -> IO VaguePKey) -> IO VaguePKey
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr EVP_PKEY -> IO VaguePKey
wrapPKeyPtr
             IO VaguePKey
-> (VaguePKey -> IO (Maybe SomePublicKey))
-> IO (Maybe SomePublicKey)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= VaguePKey -> IO (Maybe SomePublicKey)
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 IO BIO -> (BIO -> IO SomePublicKey) -> IO SomePublicKey
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= BIO -> IO SomePublicKey
readPublicKey'


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

foreign import ccall unsafe "PEM_write_bio_X509"
        _write_bio_X509 :: Ptr BIO_
                        -> Ptr X509_
                        -> IO CInt

foreign import ccall safe "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
    = BIO -> (Ptr BIO_ -> IO ()) -> IO ()
forall a. BIO -> (Ptr BIO_ -> IO a) -> IO a
withBioPtr BIO
bio   ((Ptr BIO_ -> IO ()) -> IO ()) -> (Ptr BIO_ -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ Ptr BIO_
bioPtr  ->
      X509 -> (Ptr X509_ -> IO ()) -> IO ()
forall a. X509 -> (Ptr X509_ -> IO a) -> IO a
withX509Ptr X509
x509 ((Ptr X509_ -> IO ()) -> IO ()) -> (Ptr X509_ -> IO ()) -> IO ()
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
           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 ()

-- |@'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
    = BIO -> (Ptr BIO_ -> IO X509) -> IO X509
forall a. BIO -> (Ptr BIO_ -> IO a) -> IO a
withBioPtr BIO
bio ((Ptr BIO_ -> IO X509) -> IO X509)
-> (Ptr BIO_ -> IO X509) -> IO X509
forall a b. (a -> b) -> a -> b
$ \ Ptr BIO_
bioPtr ->
      String -> (Ptr CChar -> IO X509) -> IO X509
forall a. String -> (Ptr CChar -> IO a) -> IO a
withCString String
"" ((Ptr CChar -> IO X509) -> IO X509)
-> (Ptr CChar -> IO X509) -> IO X509
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 Ptr (Ptr X509_)
forall a. Ptr a
nullPtr FunPtr PemPasswordCallback'
forall a. FunPtr a
nullFunPtr (Ptr CChar -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
passPtr)
           IO (Ptr X509_) -> (Ptr X509_ -> IO (Ptr X509_)) -> IO (Ptr X509_)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr X509_ -> IO (Ptr X509_)
forall a. Ptr a -> IO (Ptr a)
failIfNull
           IO (Ptr X509_) -> (Ptr X509_ -> IO X509) -> IO X509
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 IO BIO -> (BIO -> IO X509) -> IO X509
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= BIO -> IO X509
readX509'


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

foreign import ccall unsafe "PEM_write_bio_X509_REQ"
        _write_bio_X509_REQ :: Ptr BIO_
                            -> Ptr X509_REQ
                            -> IO CInt

foreign import ccall unsafe "PEM_write_bio_X509_REQ_NEW"
        _write_bio_X509_REQ_NEW :: Ptr BIO_
                                -> Ptr X509_REQ
                                -> IO CInt

foreign import ccall safe "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
    = BIO -> (Ptr BIO_ -> IO ()) -> IO ()
forall a. BIO -> (Ptr BIO_ -> IO a) -> IO a
withBioPtr BIO
bio     ((Ptr BIO_ -> IO ()) -> IO ()) -> (Ptr BIO_ -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ Ptr BIO_
bioPtr ->
      X509Req -> (Ptr X509_REQ -> IO ()) -> IO ()
forall a. X509Req -> (Ptr X509_REQ -> IO a) -> IO a
withX509ReqPtr X509Req
req ((Ptr X509_REQ -> IO ()) -> IO ())
-> (Ptr X509_REQ -> IO ()) -> IO ()
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
                 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 ()
    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
    = BIO -> (Ptr BIO_ -> IO X509Req) -> IO X509Req
forall a. BIO -> (Ptr BIO_ -> IO a) -> IO a
withBioPtr BIO
bio ((Ptr BIO_ -> IO X509Req) -> IO X509Req)
-> (Ptr BIO_ -> IO X509Req) -> IO X509Req
forall a b. (a -> b) -> a -> b
$ \ Ptr BIO_
bioPtr ->
      String -> (Ptr CChar -> IO X509Req) -> IO X509Req
forall a. String -> (Ptr CChar -> IO a) -> IO a
withCString String
"" ((Ptr CChar -> IO X509Req) -> IO X509Req)
-> (Ptr CChar -> IO X509Req) -> IO X509Req
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 Ptr (Ptr X509_REQ)
forall a. Ptr a
nullPtr FunPtr PemPasswordCallback'
forall a. FunPtr a
nullFunPtr (Ptr CChar -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
passPtr)
           IO (Ptr X509_REQ)
-> (Ptr X509_REQ -> IO (Ptr X509_REQ)) -> IO (Ptr X509_REQ)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr X509_REQ -> IO (Ptr X509_REQ)
forall a. Ptr a -> IO (Ptr a)
failIfNull
           IO (Ptr X509_REQ) -> (Ptr X509_REQ -> IO X509Req) -> IO X509Req
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 IO BIO -> (BIO -> IO X509Req) -> IO X509Req
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= BIO -> IO X509Req
readX509Req'


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

foreign import ccall unsafe "PEM_write_bio_X509_CRL"
        _write_bio_X509_CRL :: Ptr BIO_
                            -> Ptr X509_CRL
                            -> IO CInt

foreign import ccall safe "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
    = BIO -> (Ptr BIO_ -> IO ()) -> IO ()
forall a. BIO -> (Ptr BIO_ -> IO a) -> IO a
withBioPtr BIO
bio ((Ptr BIO_ -> IO ()) -> IO ()) -> (Ptr BIO_ -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ Ptr BIO_
bioPtr ->
      CRL -> (Ptr X509_CRL -> IO ()) -> IO ()
forall a. CRL -> (Ptr X509_CRL -> IO a) -> IO a
withCRLPtr CRL
crl ((Ptr X509_CRL -> IO ()) -> IO ())
-> (Ptr X509_CRL -> IO ()) -> IO ()
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
           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 ()

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


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

foreign import ccall unsafe "PEM_write_bio_PKCS7"
        _write_bio_PKCS7 :: Ptr BIO_
                         -> Ptr PKCS7
                         -> IO CInt

foreign import ccall safe "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
    = BIO -> (Ptr BIO_ -> IO ()) -> IO ()
forall a. BIO -> (Ptr BIO_ -> IO a) -> IO a
withBioPtr BIO
bio     ((Ptr BIO_ -> IO ()) -> IO ()) -> (Ptr BIO_ -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ Ptr BIO_
bioPtr ->
      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 ->
      Ptr BIO_ -> Ptr PKCS7 -> IO CInt
_write_bio_PKCS7 Ptr BIO_
bioPtr Ptr PKCS7
pkcs7Ptr
           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 ()

-- |@'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
    = BIO -> (Ptr BIO_ -> IO Pkcs7) -> IO Pkcs7
forall a. BIO -> (Ptr BIO_ -> IO a) -> IO a
withBioPtr BIO
bio ((Ptr BIO_ -> IO Pkcs7) -> IO Pkcs7)
-> (Ptr BIO_ -> IO Pkcs7) -> IO Pkcs7
forall a b. (a -> b) -> a -> b
$ \ Ptr BIO_
bioPtr ->
      String -> (Ptr CChar -> IO Pkcs7) -> IO Pkcs7
forall a. String -> (Ptr CChar -> IO a) -> IO a
withCString String
"" ((Ptr CChar -> IO Pkcs7) -> IO Pkcs7)
-> (Ptr CChar -> IO Pkcs7) -> IO Pkcs7
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 Ptr (Ptr PKCS7)
forall a. Ptr a
nullPtr FunPtr PemPasswordCallback'
forall a. FunPtr a
nullFunPtr (Ptr CChar -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
passPtr)
           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

-- |@'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 IO BIO -> (BIO -> IO Pkcs7) -> IO Pkcs7
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= BIO -> IO Pkcs7
readPkcs7'

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

foreign import ccall unsafe "PEM_write_bio_DHparams"
        _write_bio_DH :: Ptr BIO_
                      -> Ptr DH_
                      -> IO CInt

foreign import ccall safe "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
    = BIO -> (Ptr BIO_ -> IO ()) -> IO ()
forall a. BIO -> (Ptr BIO_ -> IO a) -> IO a
withBioPtr BIO
bio ((Ptr BIO_ -> IO ()) -> IO ()) -> (Ptr BIO_ -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ Ptr BIO_
bioPtr ->
      DHP -> (Ptr DH_ -> IO ()) -> IO ()
forall a. DHP -> (Ptr DH_ -> IO a) -> IO a
withDHPPtr DHP
dh  ((Ptr DH_ -> IO ()) -> IO ()) -> (Ptr DH_ -> IO ()) -> IO ()
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 IO CInt -> (CInt -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (CInt -> Bool) -> CInt -> IO ()
forall a. (a -> Bool) -> a -> IO ()
failIf_ (CInt -> CInt -> Bool
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
    = BIO -> (Ptr BIO_ -> IO DHP) -> IO DHP
forall a. BIO -> (Ptr BIO_ -> IO a) -> IO a
withBioPtr BIO
bio ((Ptr BIO_ -> IO DHP) -> IO DHP) -> (Ptr BIO_ -> IO DHP) -> IO DHP
forall a b. (a -> b) -> a -> b
$ \ Ptr BIO_
bioPtr ->
      String -> (Ptr CChar -> IO DHP) -> IO DHP
forall a. String -> (Ptr CChar -> IO a) -> IO a
withCString String
"" ((Ptr CChar -> IO DHP) -> IO DHP)
-> (Ptr CChar -> IO DHP) -> IO DHP
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 Ptr (Ptr DH_)
forall a. Ptr a
nullPtr FunPtr PemPasswordCallback'
forall a. FunPtr a
nullFunPtr (Ptr CChar -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
passPtr)
          IO (Ptr DH_) -> (Ptr DH_ -> IO (Ptr DH_)) -> IO (Ptr DH_)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr DH_ -> IO (Ptr DH_)
forall a. Ptr a -> IO (Ptr a)
failIfNull
          IO (Ptr DH_) -> (Ptr DH_ -> IO DHP) -> IO DHP
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 IO BIO -> (BIO -> IO DHP) -> IO DHP
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 :: ByteString -> (CStringLen -> IO t) -> IO t
withBS ByteString
passStr CStringLen -> IO t
act =
  ByteString -> (CStringLen -> IO t) -> IO t
forall t. ByteString -> (CStringLen -> IO t) -> IO t
B8.useAsCStringLen ByteString
passStr ((CStringLen -> IO t) -> IO t) -> (CStringLen -> IO t) -> IO t
forall a b. (a -> b) -> a -> b
$ \ (Ptr CChar
passPtr, Int
passLen) ->
  (IO t -> IO () -> IO t) -> IO () -> IO t -> IO t
forall a b c. (a -> b -> c) -> b -> a -> c
flip IO t -> IO () -> IO t
forall a b. IO a -> IO b -> IO a
finally (Ptr CChar -> CInt -> CSize -> IO ()
forall a. Ptr a -> CInt -> CSize -> IO ()
memset Ptr CChar
passPtr CInt
0 (CSize -> IO ()) -> CSize -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
passLen) (IO t -> IO t) -> IO t -> IO t
forall a b. (a -> b) -> a -> b
$
  CStringLen -> IO t
act (Ptr CChar -> Ptr CChar
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
passPtr, Int
passLen)

foreign import ccall unsafe memset :: Ptr a -> CInt -> CSize -> IO ()