{-# LINE 1 "OpenSSL/X509/Revocation.hsc" #-}
{-# LANGUAGE DeriveDataTypeable       #-}
{-# LANGUAGE EmptyDataDecls           #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE CApiFFI                  #-}
{-# OPTIONS_HADDOCK prune             #-}
-- |An interface to Certificate Revocation List.
module OpenSSL.X509.Revocation
    ( -- * Types
      CRL
    , X509_CRL -- privae
    , RevokedCertificate(..)

      -- * Functions to manipulate revocation list
    , newCRL
    , wrapCRL -- private
    , withCRLPtr -- private

    , signCRL
    , verifyCRL

    , printCRL

    , sortCRL

      -- * Accessors
    , getVersion
    , setVersion

    , getLastUpdate
    , setLastUpdate

    , getNextUpdate
    , setNextUpdate

    , getIssuerName
    , setIssuerName

    , getRevokedList
    , addRevoked
    , getRevoked
    )
    where

import Control.Monad

{-# LINE 48 "OpenSSL/X509/Revocation.hsc" #-}
import Data.Time.Clock
import Data.Typeable
import Foreign
import Foreign.C
import OpenSSL.ASN1
import OpenSSL.BIO
import OpenSSL.EVP.Digest hiding (digest)
import OpenSSL.EVP.PKey
import OpenSSL.EVP.Verify
import OpenSSL.EVP.Internal
import OpenSSL.Stack
import OpenSSL.Utils
import OpenSSL.X509.Name

-- |@'CRL'@ is an opaque object that represents Certificate Revocation
-- List.
newtype CRL          = CRL (ForeignPtr X509_CRL)
data {-# CTYPE "openssl/x509.h" "X509_CRL" #-} X509_CRL
data {-# CTYPE "openssl/x509.h" "X509_REVOKED" #-} X509_REVOKED

-- |@'RevokedCertificate'@ represents a revoked certificate in a
-- list. Each certificates are supposed to be distinguishable by
-- issuer name and serial number, so it is sufficient to have only
-- serial number on each entries.
data RevokedCertificate
    = RevokedCertificate {
        RevokedCertificate -> Integer
revSerialNumber   :: Integer
      , RevokedCertificate -> UTCTime
revRevocationDate :: UTCTime
      }
    deriving (Int -> RevokedCertificate -> ShowS
[RevokedCertificate] -> ShowS
RevokedCertificate -> String
(Int -> RevokedCertificate -> ShowS)
-> (RevokedCertificate -> String)
-> ([RevokedCertificate] -> ShowS)
-> Show RevokedCertificate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RevokedCertificate] -> ShowS
$cshowList :: [RevokedCertificate] -> ShowS
show :: RevokedCertificate -> String
$cshow :: RevokedCertificate -> String
showsPrec :: Int -> RevokedCertificate -> ShowS
$cshowsPrec :: Int -> RevokedCertificate -> ShowS
Show, RevokedCertificate -> RevokedCertificate -> Bool
(RevokedCertificate -> RevokedCertificate -> Bool)
-> (RevokedCertificate -> RevokedCertificate -> Bool)
-> Eq RevokedCertificate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RevokedCertificate -> RevokedCertificate -> Bool
$c/= :: RevokedCertificate -> RevokedCertificate -> Bool
== :: RevokedCertificate -> RevokedCertificate -> Bool
$c== :: RevokedCertificate -> RevokedCertificate -> Bool
Eq, Typeable)


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

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

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

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

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

foreign import capi unsafe "HsOpenSSL.h HsOpenSSL_X509_CRL_get_version"
        _get_version :: Ptr X509_CRL -> IO CLong

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

foreign import capi unsafe "HsOpenSSL.h HsOpenSSL_X509_CRL_get_lastUpdate"
        _get_lastUpdate :: Ptr X509_CRL -> IO (Ptr ASN1_TIME)

foreign import capi unsafe "HsOpenSSL.h HsOpenSSL_X509_CRL_get_nextUpdate"
        _get_nextUpdate :: Ptr X509_CRL -> IO (Ptr ASN1_TIME)


{-# LINE 108 "OpenSSL/X509/Revocation.hsc" #-}
foreign import capi unsafe "openssl/x509.h X509_CRL_set1_lastUpdate"
        _set_lastUpdate :: Ptr X509_CRL -> Ptr ASN1_TIME -> IO CInt

foreign import capi unsafe "openssl/x509.h X509_CRL_set1_nextUpdate"
        _set_nextUpdate :: Ptr X509_CRL -> Ptr ASN1_TIME -> IO CInt

{-# LINE 120 "OpenSSL/X509/Revocation.hsc" #-}

foreign import capi unsafe "HsOpenSSL.h HsOpenSSL_X509_CRL_get_issuer"
        _get_issuer_name :: Ptr X509_CRL -> IO (Ptr X509_NAME)

foreign import capi unsafe "openssl/x509.h X509_CRL_set_issuer_name"
        _set_issuer_name :: Ptr X509_CRL -> Ptr X509_NAME -> IO CInt

foreign import capi unsafe "HsOpenSSL.h HsOpenSSL_X509_CRL_get_REVOKED"
        _get_REVOKED :: Ptr X509_CRL -> IO (Ptr STACK)

foreign import capi unsafe "openssl/x509.h X509_CRL_add0_revoked"
        _add0_revoked :: Ptr X509_CRL -> Ptr X509_REVOKED -> IO CInt


{-# LINE 134 "OpenSSL/X509/Revocation.hsc" #-}
-- This function is only available on OpenSSL 1.0.0 or later.
foreign import capi unsafe "openssl/x509.h X509_CRL_get0_by_serial"
        _get0_by_serial :: Ptr X509_CRL -> Ptr (Ptr X509_REVOKED)
                        -> Ptr ASN1_INTEGER -> IO CInt

{-# LINE 139 "OpenSSL/X509/Revocation.hsc" #-}

foreign import capi unsafe "openssl/x509.h X509_CRL_sort"
        _sort :: Ptr X509_CRL -> IO CInt



foreign import capi unsafe "openssl/x509.h X509_REVOKED_new"
        _new_revoked :: IO (Ptr X509_REVOKED)

foreign import capi unsafe "openssl/x509.h X509_REVOKED_free"
        freeRevoked :: Ptr X509_REVOKED -> IO ()

foreign import capi unsafe "openssl/x509.h X509_REVOKED_set_serialNumber"
        _set_serialNumber :: Ptr X509_REVOKED -> Ptr ASN1_INTEGER -> IO CInt

foreign import capi unsafe "openssl/x509.h X509_REVOKED_set_revocationDate"
        _set_revocationDate :: Ptr X509_REVOKED -> Ptr ASN1_TIME -> IO CInt

-- |@'newCRL'@ creates an empty revocation list. You must set the
-- following properties to and sign it (see 'signCRL') to actually use
-- the revocation list. If you have any certificates to be listed, you
-- must of course add them (see 'addRevoked') before signing the list.
--
--   [/Version/] See 'setVersion'.
--
--   [/Last Update/] See 'setLastUpdate'.
--
--   [/Next Update/] See 'setNextUpdate'.
--
--   [/Issuer Name/] See 'setIssuerName'.
--
newCRL :: IO CRL
newCRL :: IO CRL
newCRL = IO (Ptr X509_CRL)
_new 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


wrapCRL :: Ptr X509_CRL -> IO CRL
wrapCRL :: Ptr X509_CRL -> IO CRL
wrapCRL = (ForeignPtr X509_CRL -> CRL) -> IO (ForeignPtr X509_CRL) -> IO CRL
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ForeignPtr X509_CRL -> CRL
CRL (IO (ForeignPtr X509_CRL) -> IO CRL)
-> (Ptr X509_CRL -> IO (ForeignPtr X509_CRL))
-> Ptr X509_CRL
-> IO CRL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FinalizerPtr X509_CRL -> Ptr X509_CRL -> IO (ForeignPtr X509_CRL)
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr X509_CRL
_free


withCRLPtr :: CRL -> (Ptr X509_CRL -> IO a) -> IO a
withCRLPtr :: forall a. CRL -> (Ptr X509_CRL -> IO a) -> IO a
withCRLPtr (CRL ForeignPtr X509_CRL
crl) = ForeignPtr X509_CRL -> (Ptr X509_CRL -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr X509_CRL
crl

-- |@'signCRL'@ signs a revocation list with an issuer private key.
signCRL :: KeyPair key =>
           CRL          -- ^ The revocation list 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 ()
signCRL :: forall key. KeyPair key => CRL -> key -> Maybe Digest -> IO ()
signCRL CRL
crl key
key Maybe Digest
mDigest
    = 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  ->
      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 Digest
digest <- case Maybe Digest
mDigest of
                     Just Digest
md -> Digest -> IO Digest
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
key
         Digest -> (Ptr EVP_MD -> IO ()) -> IO ()
forall a. Digest -> (Ptr EVP_MD -> IO a) -> IO a
withMDPtr Digest
digest ((Ptr EVP_MD -> IO ()) -> IO ()) -> (Ptr EVP_MD -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ Ptr EVP_MD
digestPtr ->
             Ptr X509_CRL -> Ptr EVP_PKEY -> Ptr EVP_MD -> IO CInt
_sign Ptr X509_CRL
crlPtr Ptr EVP_PKEY
pkeyPtr Ptr EVP_MD
digestPtr
                  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
0)
         () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- |@'verifyCRL'@ verifies a signature of revocation list with an
-- issuer public key.
verifyCRL :: PublicKey key => CRL -> key -> IO VerifyStatus
verifyCRL :: forall key. PublicKey key => CRL -> key -> IO VerifyStatus
verifyCRL CRL
crl key
key
    = CRL -> (Ptr X509_CRL -> IO VerifyStatus) -> IO VerifyStatus
forall a. CRL -> (Ptr X509_CRL -> IO a) -> IO a
withCRLPtr CRL
crl   ((Ptr X509_CRL -> IO VerifyStatus) -> IO VerifyStatus)
-> (Ptr X509_CRL -> IO VerifyStatus) -> IO VerifyStatus
forall a b. (a -> b) -> a -> b
$ \ Ptr X509_CRL
crlPtr ->
      key -> (Ptr EVP_PKEY -> IO VerifyStatus) -> IO VerifyStatus
forall k a. PKey k => k -> (Ptr EVP_PKEY -> IO a) -> IO a
withPKeyPtr' key
key ((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_CRL -> Ptr EVP_PKEY -> IO CInt
_verify Ptr X509_CRL
crlPtr Ptr EVP_PKEY
pkeyPtr
           IO CInt -> (CInt -> IO VerifyStatus) -> IO VerifyStatus
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 (m :: * -> *) a. Monad m => a -> m a
return VerifyStatus
VerifySuccess
      interpret CInt
0 = VerifyStatus -> IO VerifyStatus
forall (m :: * -> *) a. Monad m => a -> m a
return VerifyStatus
VerifyFailure
      interpret CInt
_ = IO VerifyStatus
forall a. IO a
raiseOpenSSLError

-- |@'printCRL'@ translates a revocation list into human-readable
-- format.
printCRL :: CRL -> IO String
printCRL :: CRL -> IO String
printCRL CRL
crl
    = do BIO
mem <- IO BIO
newMem
         BIO -> (Ptr BIO_ -> IO ()) -> IO ()
forall a. BIO -> (Ptr BIO_ -> IO a) -> IO a
withBioPtr BIO
mem ((Ptr BIO_ -> IO ()) -> IO ()) -> (Ptr BIO_ -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ Ptr BIO_
memPtr ->
             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
_print Ptr BIO_
memPtr Ptr X509_CRL
crlPtr
                      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)
         BIO -> IO String
bioRead BIO
mem

-- |@'getVersion' crl@ returns the version number of revocation list.
getVersion :: CRL -> IO Int
getVersion :: CRL -> IO Int
getVersion CRL
crl
    = CRL -> (Ptr X509_CRL -> IO Int) -> IO Int
forall a. CRL -> (Ptr X509_CRL -> IO a) -> IO a
withCRLPtr CRL
crl ((Ptr X509_CRL -> IO Int) -> IO Int)
-> (Ptr X509_CRL -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \ Ptr X509_CRL
crlPtr ->
      (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_CRL -> IO CLong
_get_version Ptr X509_CRL
crlPtr

-- |@'setVersion' crl ver@ updates the version number of revocation
-- list.
setVersion :: CRL -> Int -> IO ()
setVersion :: CRL -> Int -> IO ()
setVersion CRL
crl Int
ver
    = 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 X509_CRL -> CLong -> IO CInt
_set_version Ptr X509_CRL
crlPtr (Int -> CLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ver)
           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 ()

-- |@'getLastUpdate' crl@ returns the time when the revocation list
-- has last been updated.
getLastUpdate :: CRL -> IO UTCTime
getLastUpdate :: CRL -> IO UTCTime
getLastUpdate CRL
crl
    = CRL -> (Ptr X509_CRL -> IO UTCTime) -> IO UTCTime
forall a. CRL -> (Ptr X509_CRL -> IO a) -> IO a
withCRLPtr CRL
crl ((Ptr X509_CRL -> IO UTCTime) -> IO UTCTime)
-> (Ptr X509_CRL -> IO UTCTime) -> IO UTCTime
forall a b. (a -> b) -> a -> b
$ \ Ptr X509_CRL
crlPtr ->
      Ptr X509_CRL -> IO (Ptr ASN1_TIME)
_get_lastUpdate Ptr X509_CRL
crlPtr
           IO (Ptr ASN1_TIME) -> (Ptr ASN1_TIME -> IO UTCTime) -> IO UTCTime
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr ASN1_TIME -> IO UTCTime
peekASN1Time

-- |@'setLastUpdate' crl utc@ updates the time when the revocation
-- list has last been updated.
setLastUpdate :: CRL -> UTCTime -> IO ()
setLastUpdate :: CRL -> UTCTime -> IO ()
setLastUpdate CRL
crl UTCTime
utc
    = 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 ->
      UTCTime -> (Ptr ASN1_TIME -> IO ()) -> IO ()
forall a. UTCTime -> (Ptr ASN1_TIME -> IO a) -> IO a
withASN1Time UTCTime
utc ((Ptr ASN1_TIME -> IO ()) -> IO ())
-> (Ptr ASN1_TIME -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ Ptr ASN1_TIME
time ->
      Ptr X509_CRL -> Ptr ASN1_TIME -> IO CInt
_set_lastUpdate Ptr X509_CRL
crlPtr Ptr ASN1_TIME
time
           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 ()

-- |@'getNextUpdate' crl@ returns the time when the revocation list
-- will next be updated.
getNextUpdate :: CRL -> IO UTCTime
getNextUpdate :: CRL -> IO UTCTime
getNextUpdate CRL
crl
    = CRL -> (Ptr X509_CRL -> IO UTCTime) -> IO UTCTime
forall a. CRL -> (Ptr X509_CRL -> IO a) -> IO a
withCRLPtr CRL
crl ((Ptr X509_CRL -> IO UTCTime) -> IO UTCTime)
-> (Ptr X509_CRL -> IO UTCTime) -> IO UTCTime
forall a b. (a -> b) -> a -> b
$ \ Ptr X509_CRL
crlPtr ->
      Ptr X509_CRL -> IO (Ptr ASN1_TIME)
_get_nextUpdate Ptr X509_CRL
crlPtr
           IO (Ptr ASN1_TIME) -> (Ptr ASN1_TIME -> IO UTCTime) -> IO UTCTime
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr ASN1_TIME -> IO UTCTime
peekASN1Time

-- |@'setNextUpdate' crl utc@ updates the time when the revocation
-- list will next be updated.
setNextUpdate :: CRL -> UTCTime -> IO ()
setNextUpdate :: CRL -> UTCTime -> IO ()
setNextUpdate CRL
crl UTCTime
utc
    = 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 ->
      UTCTime -> (Ptr ASN1_TIME -> IO ()) -> IO ()
forall a. UTCTime -> (Ptr ASN1_TIME -> IO a) -> IO a
withASN1Time UTCTime
utc ((Ptr ASN1_TIME -> IO ()) -> IO ())
-> (Ptr ASN1_TIME -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ Ptr ASN1_TIME
time ->
      Ptr X509_CRL -> Ptr ASN1_TIME -> IO CInt
_set_nextUpdate Ptr X509_CRL
crlPtr Ptr ASN1_TIME
time
           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 ()

-- |@'getIssuerName' crl wantLongName@ returns the issuer name of
-- revocation list. See 'OpenSSL.X509.getIssuerName' of
-- "OpenSSL.X509".
getIssuerName :: CRL -> Bool -> IO [(String, String)]
getIssuerName :: CRL -> Bool -> IO [(String, String)]
getIssuerName CRL
crl Bool
wantLongName
    = CRL
-> (Ptr X509_CRL -> IO [(String, String)]) -> IO [(String, String)]
forall a. CRL -> (Ptr X509_CRL -> IO a) -> IO a
withCRLPtr CRL
crl ((Ptr X509_CRL -> IO [(String, String)]) -> IO [(String, String)])
-> (Ptr X509_CRL -> IO [(String, String)]) -> IO [(String, String)]
forall a b. (a -> b) -> a -> b
$ \ Ptr X509_CRL
crlPtr ->
      do Ptr X509_NAME
namePtr <- Ptr X509_CRL -> IO (Ptr X509_NAME)
_get_issuer_name Ptr X509_CRL
crlPtr
         Ptr X509_NAME -> Bool -> IO [(String, String)]
peekX509Name Ptr X509_NAME
namePtr Bool
wantLongName

-- |@'setIssuerName' crl name@ updates the issuer name of revocation
-- list. See 'OpenSSL.X509.setIssuerName' of "OpenSSL.X509".
setIssuerName :: CRL -> [(String, String)] -> IO ()
setIssuerName :: CRL -> [(String, String)] -> IO ()
setIssuerName CRL
crl [(String, String)]
issuer
    = 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  ->
      [(String, String)] -> (Ptr X509_NAME -> IO ()) -> IO ()
forall a. [(String, String)] -> (Ptr X509_NAME -> IO a) -> IO a
withX509Name [(String, String)]
issuer ((Ptr X509_NAME -> IO ()) -> IO ())
-> (Ptr X509_NAME -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ Ptr X509_NAME
namePtr ->
      Ptr X509_CRL -> Ptr X509_NAME -> IO CInt
_set_issuer_name Ptr X509_CRL
crlPtr Ptr X509_NAME
namePtr
           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 ()

-- |@'getRevokedList' crl@ returns the list of revoked certificates.
getRevokedList :: CRL -> IO [RevokedCertificate]
getRevokedList :: CRL -> IO [RevokedCertificate]
getRevokedList CRL
crl
    = CRL
-> (Ptr X509_CRL -> IO [RevokedCertificate])
-> IO [RevokedCertificate]
forall a. CRL -> (Ptr X509_CRL -> IO a) -> IO a
withCRLPtr CRL
crl ((Ptr X509_CRL -> IO [RevokedCertificate])
 -> IO [RevokedCertificate])
-> (Ptr X509_CRL -> IO [RevokedCertificate])
-> IO [RevokedCertificate]
forall a b. (a -> b) -> a -> b
$ \ Ptr X509_CRL
crlPtr ->
        Ptr X509_CRL -> IO (Ptr STACK)
_get_REVOKED Ptr X509_CRL
crlPtr IO (Ptr STACK)
-> (Ptr STACK -> IO [RevokedCertificate])
-> IO [RevokedCertificate]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Ptr X509_REVOKED -> IO RevokedCertificate)
-> Ptr STACK -> IO [RevokedCertificate]
forall a b. (Ptr a -> IO b) -> Ptr STACK -> IO [b]
mapStack Ptr X509_REVOKED -> IO RevokedCertificate
peekRevoked

getSerialNumber :: Ptr X509_REVOKED -> IO (Ptr ASN1_INTEGER)
getRevocationDate :: Ptr X509_REVOKED -> IO (Ptr ASN1_TIME)


{-# LINE 305 "OpenSSL/X509/Revocation.hsc" #-}

foreign import capi unsafe "openssl/x509.h X509_REVOKED_get0_serialNumber"
        _get0_serialNumber :: Ptr X509_REVOKED -> IO (Ptr ASN1_INTEGER)

foreign import capi unsafe "openssl/x509.h X509_REVOKED_get0_revocationDate"
        _get0_revocationDate :: Ptr X509_REVOKED -> IO (Ptr ASN1_TIME)

getSerialNumber :: Ptr X509_REVOKED -> IO (Ptr ASN1_INTEGER)
getSerialNumber = Ptr X509_REVOKED -> IO (Ptr ASN1_INTEGER)
_get0_serialNumber
getRevocationDate :: Ptr X509_REVOKED -> IO (Ptr ASN1_TIME)
getRevocationDate = Ptr X509_REVOKED -> IO (Ptr ASN1_TIME)
_get0_revocationDate


{-# LINE 321 "OpenSSL/X509/Revocation.hsc" #-}

peekRevoked :: Ptr X509_REVOKED -> IO RevokedCertificate
peekRevoked :: Ptr X509_REVOKED -> IO RevokedCertificate
peekRevoked Ptr X509_REVOKED
rev = do
  Integer
serial <- Ptr ASN1_INTEGER -> IO Integer
peekASN1Integer (Ptr ASN1_INTEGER -> IO Integer)
-> IO (Ptr ASN1_INTEGER) -> IO Integer
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr X509_REVOKED -> IO (Ptr ASN1_INTEGER)
getSerialNumber Ptr X509_REVOKED
rev
  UTCTime
date   <- Ptr ASN1_TIME -> IO UTCTime
peekASN1Time    (Ptr ASN1_TIME -> IO UTCTime) -> IO (Ptr ASN1_TIME) -> IO UTCTime
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr X509_REVOKED -> IO (Ptr ASN1_TIME)
getRevocationDate Ptr X509_REVOKED
rev
  RevokedCertificate -> IO RevokedCertificate
forall (m :: * -> *) a. Monad m => a -> m a
return RevokedCertificate { revSerialNumber :: Integer
revSerialNumber   = Integer
serial
                            , revRevocationDate :: UTCTime
revRevocationDate = UTCTime
date
                            }

newRevoked :: RevokedCertificate -> IO (Ptr X509_REVOKED)
newRevoked :: RevokedCertificate -> IO (Ptr X509_REVOKED)
newRevoked RevokedCertificate
revoked
    = do Ptr X509_REVOKED
revPtr  <- IO (Ptr X509_REVOKED)
_new_revoked

         CInt
seriRet <- Integer -> (Ptr ASN1_INTEGER -> IO CInt) -> IO CInt
forall a. Integer -> (Ptr ASN1_INTEGER -> IO a) -> IO a
withASN1Integer (RevokedCertificate -> Integer
revSerialNumber RevokedCertificate
revoked) ((Ptr ASN1_INTEGER -> IO CInt) -> IO CInt)
-> (Ptr ASN1_INTEGER -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$
                    Ptr X509_REVOKED -> Ptr ASN1_INTEGER -> IO CInt
_set_serialNumber Ptr X509_REVOKED
revPtr

         CInt
dateRet <- UTCTime -> (Ptr ASN1_TIME -> IO CInt) -> IO CInt
forall a. UTCTime -> (Ptr ASN1_TIME -> IO a) -> IO a
withASN1Time (RevokedCertificate -> UTCTime
revRevocationDate RevokedCertificate
revoked) ((Ptr ASN1_TIME -> IO CInt) -> IO CInt)
-> (Ptr ASN1_TIME -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$
                    Ptr X509_REVOKED -> Ptr ASN1_TIME -> IO CInt
_set_revocationDate Ptr X509_REVOKED
revPtr

         if CInt
seriRet CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
1 Bool -> Bool -> Bool
|| CInt
dateRet CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
1 then
             Ptr X509_REVOKED -> IO ()
freeRevoked Ptr X509_REVOKED
revPtr IO () -> IO (Ptr X509_REVOKED) -> IO (Ptr X509_REVOKED)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO (Ptr X509_REVOKED)
forall a. IO a
raiseOpenSSLError
           else
             Ptr X509_REVOKED -> IO (Ptr X509_REVOKED)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr X509_REVOKED
revPtr

-- |@'addRevoked' crl revoked@ add the certificate to the revocation
-- list.
addRevoked :: CRL -> RevokedCertificate -> IO ()
addRevoked :: CRL -> RevokedCertificate -> IO ()
addRevoked CRL
crl RevokedCertificate
revoked
    = 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 ->
      do Ptr X509_REVOKED
revPtr <- RevokedCertificate -> IO (Ptr X509_REVOKED)
newRevoked RevokedCertificate
revoked
         CInt
ret    <- Ptr X509_CRL -> Ptr X509_REVOKED -> IO CInt
_add0_revoked Ptr X509_CRL
crlPtr Ptr X509_REVOKED
revPtr
         case CInt
ret of
           CInt
1 -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
           CInt
_ -> Ptr X509_REVOKED -> IO ()
freeRevoked Ptr X509_REVOKED
revPtr IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
forall a. IO a
raiseOpenSSLError

-- |@'getRevoked' crl serial@ looks up the corresponding revocation.
getRevoked :: CRL -> Integer -> IO (Maybe RevokedCertificate)

{-# LINE 359 "OpenSSL/X509/Revocation.hsc" #-}
getRevoked crl serial =
  withCRLPtr crl  $ \crlPtr ->
  alloca          $ \revPtr ->
  withASN1Integer serial $ \serialPtr -> do
    r <- _get0_by_serial crlPtr revPtr serialPtr
    if r == 1
      then fmap Just $ peek revPtr >>= peekRevoked
      else return Nothing

{-# LINE 373 "OpenSSL/X509/Revocation.hsc" #-}

-- |@'sortCRL' crl@ sorts the certificates in the revocation list.
sortCRL :: CRL -> IO ()
sortCRL :: CRL -> IO ()
sortCRL CRL
crl
    = 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 X509_CRL -> IO CInt
_sort Ptr X509_CRL
crlPtr 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)