{-# LANGUAGE EmptyDataDecls           #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE CApiFFI                  #-}
{-# OPTIONS_HADDOCK prune             #-}
-- |An interface to PKCS#10 certificate request.
module OpenSSL.X509.Request
    ( -- * Type
      X509Req
    , X509_REQ -- private

      -- * Functions to manipulate request
    , newX509Req
    , wrapX509Req -- private
    , withX509ReqPtr -- private

    , signX509Req
    , verifyX509Req

    , printX509Req
    , writeX509ReqDER

    , makeX509FromReq

      -- * Accessors
    , getVersion
    , setVersion

    , getSubjectName
    , setSubjectName

    , getPublicKey
    , setPublicKey

    , addExtensions
    , addExtensionToX509
    )
    where

import           Control.Monad
import           Data.Maybe
import           Foreign
import           Foreign.C
import           OpenSSL.BIO
import           OpenSSL.EVP.Digest hiding (digest)
import           OpenSSL.EVP.PKey
import           OpenSSL.EVP.Verify
import           OpenSSL.EVP.Internal
import           OpenSSL.Utils
import           OpenSSL.X509 (X509)
import qualified OpenSSL.X509 as Cert
import           OpenSSL.X509.Name
import           Data.ByteString.Lazy (ByteString)
import           OpenSSL.Stack

-- |@'X509Req'@ is an opaque object that represents PKCS#10
-- certificate request.
newtype X509Req  = X509Req (ForeignPtr X509_REQ)
data {-# CTYPE "openssl/x509.h" "X509_REQ" #-} X509_REQ

data X509_EXT

foreign import capi unsafe "openssl/x509.h X509_REQ_new"
        _new :: IO (Ptr X509_REQ)

foreign import capi unsafe "openssl/x509.h &X509_REQ_free"
        _free :: FunPtr (Ptr X509_REQ -> IO ())

foreign import capi unsafe "openssl/x509.h X509_REQ_sign"
        _sign :: Ptr X509_REQ -> Ptr EVP_PKEY -> Ptr EVP_MD -> IO CInt

foreign import capi unsafe "openssl/x509.h X509_REQ_verify"
        _verify :: Ptr X509_REQ -> Ptr EVP_PKEY -> IO CInt

foreign import capi unsafe "openssl/x509.h X509_REQ_print"
        _print :: Ptr BIO_ -> Ptr X509_REQ -> IO CInt

foreign import capi unsafe "openssl/x509.h i2d_X509_REQ_bio"
        _req_to_der :: Ptr BIO_ -> Ptr X509_REQ -> IO CInt

foreign import capi unsafe "HsOpenSSL.h HsOpenSSL_X509_REQ_get_version"
        _get_version :: Ptr X509_REQ -> IO CLong

foreign import capi unsafe "openssl/x509.h X509_REQ_set_version"
        _set_version :: Ptr X509_REQ -> CLong -> IO CInt

foreign import capi unsafe "HsOpenSSL.h HsOpenSSL_X509_REQ_get_subject_name"
        _get_subject_name :: Ptr X509_REQ -> IO (Ptr X509_NAME)

foreign import capi unsafe "openssl/x509.h X509_REQ_set_subject_name"
        _set_subject_name :: Ptr X509_REQ -> Ptr X509_NAME -> IO CInt

foreign import capi unsafe "openssl/x509.h X509_REQ_get_pubkey"
        _get_pubkey :: Ptr X509_REQ -> IO (Ptr EVP_PKEY)

foreign import capi unsafe "openssl/x509.h X509_REQ_set_pubkey"
        _set_pubkey :: Ptr X509_REQ -> Ptr EVP_PKEY -> IO CInt

foreign import capi unsafe "openssl/x509v3.h X509V3_EXT_nconf_nid"
        _ext_create :: Ptr a -> Ptr b -> CInt -> CString -> IO (Ptr X509_EXT)

foreign import capi unsafe "openssl/x509.h X509_REQ_add_extensions"
        _req_add_extensions :: Ptr X509_REQ -> Ptr STACK -> IO CInt

foreign import capi unsafe "openssl/x509.h X509_add_ext"
    _X509_add_ext :: Ptr Cert.X509_ -> Ptr X509_EXT -> CInt -> IO CInt

-- |@'newX509Req'@ creates an empty certificate request. You must set
-- the following properties to and sign it (see 'signX509Req') to
-- actually use the certificate request.
--
--  [/Version/] See 'setVersion'.
--
--  [/Subject Name/] See 'setSubjectName'.
--
--  [/Public Key/] See 'setPublicKey'.
--
newX509Req :: IO X509Req
newX509Req :: IO X509Req
newX509Req = IO (Ptr X509_REQ)
_new IO (Ptr X509_REQ) -> (Ptr X509_REQ -> IO X509Req) -> IO X509Req
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr X509_REQ -> IO X509Req
wrapX509Req


wrapX509Req :: Ptr X509_REQ -> IO X509Req
wrapX509Req :: Ptr X509_REQ -> IO X509Req
wrapX509Req = (ForeignPtr X509_REQ -> X509Req)
-> IO (ForeignPtr X509_REQ) -> IO X509Req
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ForeignPtr X509_REQ -> X509Req
X509Req (IO (ForeignPtr X509_REQ) -> IO X509Req)
-> (Ptr X509_REQ -> IO (ForeignPtr X509_REQ))
-> Ptr X509_REQ
-> IO X509Req
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FinalizerPtr X509_REQ -> Ptr X509_REQ -> IO (ForeignPtr X509_REQ)
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr X509_REQ
_free


withX509ReqPtr :: X509Req -> (Ptr X509_REQ -> IO a) -> IO a
withX509ReqPtr :: forall a. X509Req -> (Ptr X509_REQ -> IO a) -> IO a
withX509ReqPtr (X509Req ForeignPtr X509_REQ
req) = ForeignPtr X509_REQ -> (Ptr X509_REQ -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr X509_REQ
req

-- |@'signX509Req'@ signs a certificate request with a subject private
-- key.
signX509Req :: KeyPair key =>
               X509Req      -- ^ The request to be signed.
            -> key          -- ^ The private key to sign with.
            -> Maybe Digest -- ^ A hashing algorithm to use. If
                            --   @Nothing@ the most suitable algorithm
                            --   for the key is automatically used.
            -> IO ()
signX509Req :: forall key. KeyPair key => X509Req -> key -> Maybe Digest -> IO ()
signX509Req X509Req
req key
pkey Maybe Digest
mDigest
    = 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  ->
      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 ->
      do digest <- case Maybe Digest
mDigest of
                     Just Digest
md -> Digest -> IO Digest
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Digest
md
                     Maybe Digest
Nothing -> key -> IO Digest
forall k. PKey k => k -> IO Digest
pkeyDefaultMD key
pkey
         withMDPtr digest $ \ Ptr EVP_MD
digestPtr ->
             Ptr X509_REQ -> Ptr EVP_PKEY -> Ptr EVP_MD -> IO CInt
_sign Ptr X509_REQ
reqPtr Ptr EVP_PKEY
pkeyPtr Ptr EVP_MD
digestPtr
                  IO CInt -> (CInt -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
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
0)

-- |@'verifyX509Req'@ verifies a signature of certificate request with
-- a subject public key.
verifyX509Req :: PublicKey key =>
                 X509Req -- ^ The request to be verified.
              -> key     -- ^ The public key to verify with.
              -> IO VerifyStatus
verifyX509Req :: forall key. PublicKey key => X509Req -> key -> IO VerifyStatus
verifyX509Req X509Req
req key
pkey
    = X509Req -> (Ptr X509_REQ -> IO VerifyStatus) -> IO VerifyStatus
forall a. X509Req -> (Ptr X509_REQ -> IO a) -> IO a
withX509ReqPtr X509Req
req  ((Ptr X509_REQ -> IO VerifyStatus) -> IO VerifyStatus)
-> (Ptr X509_REQ -> IO VerifyStatus) -> IO VerifyStatus
forall a b. (a -> b) -> a -> b
$ \ Ptr X509_REQ
reqPtr  ->
      key -> (Ptr EVP_PKEY -> IO VerifyStatus) -> IO VerifyStatus
forall k a. PKey k => k -> (Ptr EVP_PKEY -> IO a) -> IO a
withPKeyPtr'   key
pkey ((Ptr EVP_PKEY -> IO VerifyStatus) -> IO VerifyStatus)
-> (Ptr EVP_PKEY -> IO VerifyStatus) -> IO VerifyStatus
forall a b. (a -> b) -> a -> b
$ \ Ptr EVP_PKEY
pkeyPtr ->
      Ptr X509_REQ -> Ptr EVP_PKEY -> IO CInt
_verify Ptr X509_REQ
reqPtr Ptr EVP_PKEY
pkeyPtr
           IO CInt -> (CInt -> IO VerifyStatus) -> IO VerifyStatus
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CInt -> IO VerifyStatus
interpret
    where
      interpret :: CInt -> IO VerifyStatus
      interpret :: CInt -> IO VerifyStatus
interpret CInt
1 = VerifyStatus -> IO VerifyStatus
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return VerifyStatus
VerifySuccess
      interpret CInt
0 = VerifyStatus -> IO VerifyStatus
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return VerifyStatus
VerifyFailure
      interpret CInt
_ = IO VerifyStatus
forall a. IO a
raiseOpenSSLError

-- |@'printX509Req' req@ translates a certificate request into
-- human-readable format.
printX509Req :: X509Req -> IO String
printX509Req :: X509Req -> IO String
printX509Req X509Req
req
    = do mem <- IO BIO
newMem
         withBioPtr mem $ \ Ptr BIO_
memPtr ->
             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
_print Ptr BIO_
memPtr Ptr X509_REQ
reqPtr
                      IO CInt -> (CInt -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
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)
         bioRead mem

{- DER encoding ------------------------------------------------------------- -}

-- |@'writeX509ReqDER' req@ writes a PKCS#10 certificate request to DER string.
writeX509ReqDER :: X509Req -> IO ByteString
writeX509ReqDER :: X509Req -> IO ByteString
writeX509ReqDER X509Req
req
    = do mem <- IO BIO
newMem
         withBioPtr mem $ \ Ptr BIO_
memPtr ->
             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
_req_to_der Ptr BIO_
memPtr Ptr X509_REQ
reqPtr
                      IO CInt -> (CInt -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
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. Ord a => a -> a -> Bool
< CInt
0)
         bioReadLBS mem


-- |@'getVersion' req@ returns the version number of certificate
-- request.
getVersion :: X509Req -> IO Int
getVersion :: X509Req -> IO Int
getVersion X509Req
req
    = X509Req -> (Ptr X509_REQ -> IO Int) -> IO Int
forall a. X509Req -> (Ptr X509_REQ -> IO a) -> IO a
withX509ReqPtr X509Req
req ((Ptr X509_REQ -> IO Int) -> IO Int)
-> (Ptr X509_REQ -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \ Ptr X509_REQ
reqPtr ->
      (CLong -> Int) -> IO CLong -> IO Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CLong -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO CLong -> IO Int) -> IO CLong -> IO Int
forall a b. (a -> b) -> a -> b
$ Ptr X509_REQ -> IO CLong
_get_version Ptr X509_REQ
reqPtr

-- |@'setVersion' req ver@ updates the version number of certificate
-- request.
setVersion :: X509Req -> Int -> IO ()
setVersion :: X509Req -> Int -> IO ()
setVersion X509Req
req Int
ver
    = 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 X509_REQ -> CLong -> IO CInt
_set_version Ptr X509_REQ
reqPtr (Int -> CLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ver)
           IO CInt -> (CInt -> IO CInt) -> IO CInt
forall a b. IO a -> (a -> IO b) -> IO b
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 a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>  () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- |@'getSubjectName' req wantLongName@ returns the subject name of
-- certificate request. See 'OpenSSL.X509.getSubjectName' of
-- "OpenSSL.X509".
getSubjectName :: X509Req -> Bool -> IO [(String, String)]
getSubjectName :: X509Req -> Bool -> IO [(String, String)]
getSubjectName X509Req
req Bool
wantLongName
    = X509Req
-> (Ptr X509_REQ -> IO [(String, String)]) -> IO [(String, String)]
forall a. X509Req -> (Ptr X509_REQ -> IO a) -> IO a
withX509ReqPtr X509Req
req ((Ptr X509_REQ -> IO [(String, String)]) -> IO [(String, String)])
-> (Ptr X509_REQ -> IO [(String, String)]) -> IO [(String, String)]
forall a b. (a -> b) -> a -> b
$ \ Ptr X509_REQ
reqPtr ->
      do namePtr <- Ptr X509_REQ -> IO (Ptr X509_NAME)
_get_subject_name Ptr X509_REQ
reqPtr
         peekX509Name namePtr wantLongName

-- |@'setSubjectName' req name@ updates the subject name of
-- certificate request. See 'OpenSSL.X509.setSubjectName' of
-- "OpenSSL.X509".
setSubjectName :: X509Req -> [(String, String)] -> IO ()
setSubjectName :: X509Req -> [(String, String)] -> IO ()
setSubjectName X509Req
req [(String, String)]
subject
    = 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 ->
      [(String, String)] -> (Ptr X509_NAME -> IO ()) -> IO ()
forall a. [(String, String)] -> (Ptr X509_NAME -> IO a) -> IO a
withX509Name [(String, String)]
subject ((Ptr X509_NAME -> IO ()) -> IO ())
-> (Ptr X509_NAME -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ Ptr X509_NAME
namePtr ->
      Ptr X509_REQ -> Ptr X509_NAME -> IO CInt
_set_subject_name Ptr X509_REQ
reqPtr Ptr X509_NAME
namePtr
           IO CInt -> (CInt -> IO CInt) -> IO CInt
forall a b. IO a -> (a -> IO b) -> IO b
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 a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>  () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- |@'getPublicKey' req@ returns the public key of the subject of
-- certificate request.
getPublicKey :: X509Req -> IO SomePublicKey
getPublicKey :: X509Req -> IO SomePublicKey
getPublicKey X509Req
req
    = X509Req -> (Ptr X509_REQ -> IO SomePublicKey) -> IO SomePublicKey
forall a. X509Req -> (Ptr X509_REQ -> IO a) -> IO a
withX509ReqPtr X509Req
req ((Ptr X509_REQ -> IO SomePublicKey) -> IO SomePublicKey)
-> (Ptr X509_REQ -> IO SomePublicKey) -> IO SomePublicKey
forall a b. (a -> b) -> a -> b
$ \ Ptr X509_REQ
reqPtr ->
      (Maybe SomePublicKey -> SomePublicKey)
-> IO (Maybe SomePublicKey) -> IO SomePublicKey
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe SomePublicKey -> SomePublicKey
forall a. HasCallStack => Maybe a -> a
fromJust
           ( Ptr X509_REQ -> IO (Ptr EVP_PKEY)
_get_pubkey Ptr X509_REQ
reqPtr
             IO (Ptr EVP_PKEY)
-> (Ptr EVP_PKEY -> IO (Ptr EVP_PKEY)) -> IO (Ptr EVP_PKEY)
forall a b. IO a -> (a -> IO b) -> IO b
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 a b. IO a -> (a -> IO b) -> IO b
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 a b. IO a -> (a -> IO b) -> IO b
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
           )

-- |@'setPublicKey' req@ updates the public key of the subject of
-- certificate request.
setPublicKey :: PublicKey key => X509Req -> key -> IO ()
setPublicKey :: forall key. PublicKey key => X509Req -> key -> IO ()
setPublicKey X509Req
req key
pkey
    = 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  ->
      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 ->
      Ptr X509_REQ -> Ptr EVP_PKEY -> IO CInt
_set_pubkey Ptr X509_REQ
reqPtr Ptr EVP_PKEY
pkeyPtr
           IO CInt -> (CInt -> IO CInt) -> IO CInt
forall a b. IO a -> (a -> IO b) -> IO b
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 a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>  () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()


-- |@'addExtensions' req [(nid, str)]@
--
-- E.g., nid 85 = 'subjectAltName' http://osxr.org:8080/openssl/source/crypto/objects/objects.h#0476
--
-- (TODO: more docs; NID type)
addExtensions :: X509Req -> [(Int, String)] -> IO CInt
addExtensions :: X509Req -> [(Int, String)] -> IO CInt
addExtensions X509Req
req [(Int, String)]
exts =
  X509Req -> (Ptr X509_REQ -> IO CInt) -> IO CInt
forall a. X509Req -> (Ptr X509_REQ -> IO a) -> IO a
withX509ReqPtr X509Req
req ((Ptr X509_REQ -> IO CInt) -> IO CInt)
-> (Ptr X509_REQ -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr X509_REQ
reqPtr -> do
    extPtrs <- [(Int, String)]
-> ((Int, String) -> IO (Ptr X509_EXT)) -> IO [Ptr X509_EXT]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(Int, String)]
exts (Int, String) -> IO (Ptr X509_EXT)
forall {a}. Integral a => (a, String) -> IO (Ptr X509_EXT)
make
    withStack extPtrs $ _req_add_extensions reqPtr

  where
    make :: (a, String) -> IO (Ptr X509_EXT)
make (a
nid, String
str) = String -> (CString -> IO (Ptr X509_EXT)) -> IO (Ptr X509_EXT)
forall a. String -> (CString -> IO a) -> IO a
withCString String
str ((CString -> IO (Ptr X509_EXT)) -> IO (Ptr X509_EXT))
-> (CString -> IO (Ptr X509_EXT)) -> IO (Ptr X509_EXT)
forall a b. (a -> b) -> a -> b
$ Ptr (ZonkAny 3)
-> Ptr (ZonkAny 2) -> CInt -> CString -> IO (Ptr X509_EXT)
forall a b. Ptr a -> Ptr b -> CInt -> CString -> IO (Ptr X509_EXT)
_ext_create Ptr (ZonkAny 3)
forall a. Ptr a
nullPtr Ptr (ZonkAny 2)
forall a. Ptr a
nullPtr (a -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
nid)


-- |@'makeX509FromReq' req cert@ creates an empty X.509 certificate
-- and copies as much data from the request as possible. The resulting
-- certificate doesn't have the following data and it isn't signed so
-- you must fill them and sign it yourself.
--
--   * Serial number
--
--   * Validity (Not Before and Not After)
--
-- Example:
--
-- > import Data.Time.Clock
-- >
-- > genCert :: X509 -> EvpPKey -> Integer -> Int -> X509Req -> IO X509
-- > genCert caCert caKey serial days req
-- >     = do cert <- makeX509FromReq req caCert
-- >          now  <- getCurrentTime
-- >          setSerialNumber cert serial
-- >          setNotBefore cert $ addUTCTime (-1) now
-- >          setNotAfter  cert $ addUTCTime (days * 24 * 60 * 60) now
-- >          signX509 cert caKey Nothing
-- >          return cert
--
makeX509FromReq :: X509Req
                -> X509
                -> IO X509
makeX509FromReq :: X509Req -> X509 -> IO X509
makeX509FromReq X509Req
req X509
caCert
    = do reqPubKey <- X509Req -> IO SomePublicKey
getPublicKey X509Req
req
         verified  <- verifyX509Req req reqPubKey

         when (verified == VerifyFailure)
                  $ fail "makeX509FromReq: the request isn't properly signed by its own key."

         cert <- Cert.newX509
         Cert.setVersion cert 2 -- Version 2 means X509 v3. It's confusing.
         Cert.setIssuerName  cert =<< Cert.getSubjectName caCert False
         Cert.setSubjectName cert =<< getSubjectName req False
         Cert.setPublicKey   cert =<< getPublicKey req

         return cert

-- | Add Extensions to a certificate (when the Server accepting certs requires it)
-- E.g.:
--
-- > addExtensionToX509 cert1 87 "CA:FALSE"
-- > addExtensionToX509 cert1 85 "critical,serverAuth, clientAuth" -- when this extension field is critical
--
addExtensionToX509 :: X509 -> Int -> String -> IO Bool
addExtensionToX509 :: X509 -> Int -> String -> IO Bool
addExtensionToX509 (Cert.X509 ForeignPtr X509_
certFPtr) Int
nid String
value = do
    -- Context and config pointers are set to nullPtr for simplicity.
    -- Depending on your use case, you might need to provide actual values.
    result <- ForeignPtr X509_ -> (Ptr X509_ -> IO Bool) -> IO Bool
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr X509_
certFPtr ((Ptr X509_ -> IO Bool) -> IO Bool)
-> (Ptr X509_ -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr X509_
certPtr ->
              String -> (CString -> IO Bool) -> IO Bool
forall a. String -> (CString -> IO a) -> IO a
withCString String
value ((CString -> IO Bool) -> IO Bool)
-> (CString -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \CString
cValue -> do
                  extPtr <- Ptr (ZonkAny 1)
-> Ptr (ZonkAny 0) -> CInt -> CString -> IO (Ptr X509_EXT)
forall a b. Ptr a -> Ptr b -> CInt -> CString -> IO (Ptr X509_EXT)
_ext_create Ptr (ZonkAny 1)
forall a. Ptr a
nullPtr Ptr (ZonkAny 0)
forall a. Ptr a
nullPtr (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nid) CString
cValue
                  if extPtr /= nullPtr
                      then do
                          res <- _X509_add_ext certPtr extPtr (-1)  -- Add to the end
                          return (res == 0)
                      else return False
    return result