{-# LINE 1 "OpenSSL/X509/Store.hsc" #-}
{-# LANGUAGE EmptyDataDecls           #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE CApiFFI                  #-}
{-# OPTIONS_HADDOCK prune             #-}
-- |An interface to X.509 certificate store.
module OpenSSL.X509.Store
    ( X509Store
    , X509_STORE -- private

    , newX509Store

    , wrapX509Store -- private
    , withX509StorePtr -- private

    , addCertToStore
    , addCRLToStore

    , X509StoreCtx
    , X509_STORE_CTX -- private

    , withX509StoreCtxPtr -- private
    , wrapX509StoreCtx -- private

    , getStoreCtxCert
    , getStoreCtxIssuer
    , getStoreCtxCRL
    , getStoreCtxChain
    )
    where


{-# LINE 34 "OpenSSL/X509/Store.hsc" #-}
import Control.Exception (throwIO, mask_)
import Foreign
import Foreign.C
import Foreign.Concurrent as FC
import OpenSSL.X509
import OpenSSL.X509.Revocation
import OpenSSL.Stack
import OpenSSL.Utils

-- |@'X509Store'@ is an opaque object that represents X.509
-- certificate store. The certificate store is usually used for chain
-- verification.
newtype X509Store  = X509Store (ForeignPtr X509_STORE)
data {-# CTYPE "openssl/x509.h" "X509_STORE" #-} X509_STORE


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

foreign import capi unsafe "openssl/x509.h X509_STORE_free"
        _free :: Ptr X509_STORE -> IO ()

foreign import capi unsafe "openssl/x509.h X509_STORE_add_cert"
        _add_cert :: Ptr X509_STORE -> Ptr X509_ -> IO CInt

foreign import capi unsafe "openssl/x509.h X509_STORE_add_crl"
        _add_crl :: Ptr X509_STORE -> Ptr X509_CRL -> IO CInt

-- |@'newX509Store'@ creates an empty X.509 certificate store.
newX509Store :: IO X509Store
newX509Store :: IO X509Store
newX509Store = IO (Ptr X509_STORE)
_new
               IO (Ptr X509_STORE)
-> (Ptr X509_STORE -> IO (Ptr X509_STORE)) -> IO (Ptr X509_STORE)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr X509_STORE -> IO (Ptr X509_STORE)
forall a. Ptr a -> IO (Ptr a)
failIfNull
               IO (Ptr X509_STORE)
-> (Ptr X509_STORE -> IO X509Store) -> IO X509Store
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Ptr X509_STORE
ptr -> IO () -> Ptr X509_STORE -> IO X509Store
wrapX509Store (Ptr X509_STORE -> IO ()
_free Ptr X509_STORE
ptr) Ptr X509_STORE
ptr

wrapX509Store :: IO () -> Ptr X509_STORE -> IO X509Store
wrapX509Store :: IO () -> Ptr X509_STORE -> IO X509Store
wrapX509Store IO ()
finaliser Ptr X509_STORE
ptr
    = do ForeignPtr X509_STORE
fp <- Ptr X509_STORE -> IO (ForeignPtr X509_STORE)
forall a. Ptr a -> IO (ForeignPtr a)
newForeignPtr_ Ptr X509_STORE
ptr
         ForeignPtr X509_STORE -> IO () -> IO ()
forall a. ForeignPtr a -> IO () -> IO ()
FC.addForeignPtrFinalizer ForeignPtr X509_STORE
fp IO ()
finaliser
         X509Store -> IO X509Store
forall (m :: * -> *) a. Monad m => a -> m a
return (X509Store -> IO X509Store) -> X509Store -> IO X509Store
forall a b. (a -> b) -> a -> b
$ ForeignPtr X509_STORE -> X509Store
X509Store ForeignPtr X509_STORE
fp

withX509StorePtr :: X509Store -> (Ptr X509_STORE -> IO a) -> IO a
withX509StorePtr :: forall a. X509Store -> (Ptr X509_STORE -> IO a) -> IO a
withX509StorePtr (X509Store ForeignPtr X509_STORE
store)
    = ForeignPtr X509_STORE -> (Ptr X509_STORE -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr X509_STORE
store

-- |@'addCertToStore' store cert@ adds a certificate to store.
addCertToStore :: X509Store -> X509 -> IO ()
addCertToStore :: X509Store -> X509 -> IO ()
addCertToStore X509Store
store X509
cert
    = X509Store -> (Ptr X509_STORE -> IO ()) -> IO ()
forall a. X509Store -> (Ptr X509_STORE -> IO a) -> IO a
withX509StorePtr X509Store
store ((Ptr X509_STORE -> IO ()) -> IO ())
-> (Ptr X509_STORE -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ Ptr X509_STORE
storePtr ->
      X509 -> (Ptr X509_ -> IO ()) -> IO ()
forall a. X509 -> (Ptr X509_ -> IO a) -> IO a
withX509Ptr X509
cert       ((Ptr X509_ -> IO ()) -> IO ()) -> (Ptr X509_ -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ Ptr X509_
certPtr  ->
      Ptr X509_STORE -> Ptr X509_ -> IO CInt
_add_cert Ptr X509_STORE
storePtr Ptr X509_
certPtr
           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 ()

-- |@'addCRLToStore' store crl@ adds a revocation list to store.
addCRLToStore :: X509Store -> CRL -> IO ()
addCRLToStore :: X509Store -> CRL -> IO ()
addCRLToStore X509Store
store CRL
crl
    = X509Store -> (Ptr X509_STORE -> IO ()) -> IO ()
forall a. X509Store -> (Ptr X509_STORE -> IO a) -> IO a
withX509StorePtr X509Store
store ((Ptr X509_STORE -> IO ()) -> IO ())
-> (Ptr X509_STORE -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ Ptr X509_STORE
storePtr ->
      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_STORE -> Ptr X509_CRL -> IO CInt
_add_crl Ptr X509_STORE
storePtr 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 ()

data {-# CTYPE "openssl/x509.h" "X509_STORE_CTX" #-} X509_STORE_CTX
newtype X509StoreCtx = X509StoreCtx (ForeignPtr X509_STORE_CTX)

foreign import capi unsafe "openssl/x509.h X509_STORE_CTX_get_current_cert"
  _store_ctx_get_current_cert :: Ptr X509_STORE_CTX -> IO (Ptr X509_)

foreign import capi unsafe "HsOpenSSL.h HsOpenSSL_X509_STORE_CTX_get0_current_issuer"
  _store_ctx_get0_current_issuer :: Ptr X509_STORE_CTX -> IO (Ptr X509_)

foreign import capi unsafe "HsOpenSSL.h HsOpenSSL_X509_STORE_CTX_get0_current_crl"
  _store_ctx_get0_current_crl :: Ptr X509_STORE_CTX -> IO (Ptr X509_CRL)


{-# LINE 109 "OpenSSL/X509/Store.hsc" #-}
foreign import capi unsafe "openssl/x509.h X509_STORE_CTX_get1_chain"
  _store_ctx_get_chain :: Ptr X509_STORE_CTX -> IO (Ptr STACK)

{-# LINE 115 "OpenSSL/X509/Store.hsc" #-}

foreign import capi unsafe "HsOpenSSL.h HsOpenSSL_X509_ref"
  _x509_ref :: Ptr X509_ -> IO ()

foreign import capi unsafe "HsOpenSSL.h HsOpenSSL_X509_CRL_ref"
  _crl_ref :: Ptr X509_CRL -> IO ()

withX509StoreCtxPtr :: X509StoreCtx -> (Ptr X509_STORE_CTX -> IO a) -> IO a
withX509StoreCtxPtr :: forall a. X509StoreCtx -> (Ptr X509_STORE_CTX -> IO a) -> IO a
withX509StoreCtxPtr (X509StoreCtx ForeignPtr X509_STORE_CTX
fp) = ForeignPtr X509_STORE_CTX -> (Ptr X509_STORE_CTX -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr X509_STORE_CTX
fp

wrapX509StoreCtx :: IO () -> Ptr X509_STORE_CTX -> IO X509StoreCtx
wrapX509StoreCtx :: IO () -> Ptr X509_STORE_CTX -> IO X509StoreCtx
wrapX509StoreCtx IO ()
finaliser Ptr X509_STORE_CTX
ptr =
  ForeignPtr X509_STORE_CTX -> X509StoreCtx
X509StoreCtx (ForeignPtr X509_STORE_CTX -> X509StoreCtx)
-> IO (ForeignPtr X509_STORE_CTX) -> IO X509StoreCtx
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr X509_STORE_CTX -> IO () -> IO (ForeignPtr X509_STORE_CTX)
forall a. Ptr a -> IO () -> IO (ForeignPtr a)
FC.newForeignPtr Ptr X509_STORE_CTX
ptr IO ()
finaliser

getStoreCtxCert :: X509StoreCtx -> IO X509
getStoreCtxCert :: X509StoreCtx -> IO X509
getStoreCtxCert X509StoreCtx
ctx = X509StoreCtx -> (Ptr X509_STORE_CTX -> IO X509) -> IO X509
forall a. X509StoreCtx -> (Ptr X509_STORE_CTX -> IO a) -> IO a
withX509StoreCtxPtr X509StoreCtx
ctx ((Ptr X509_STORE_CTX -> IO X509) -> IO X509)
-> (Ptr X509_STORE_CTX -> IO X509) -> IO X509
forall a b. (a -> b) -> a -> b
$ \Ptr X509_STORE_CTX
pCtx -> do
  Ptr X509_
pCert <- Ptr X509_STORE_CTX -> IO (Ptr X509_)
_store_ctx_get_current_cert Ptr X509_STORE_CTX
pCtx
  if Ptr X509_
pCert Ptr X509_ -> Ptr X509_ -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr X509_
forall a. Ptr a
nullPtr
    then IOError -> IO X509
forall e a. Exception e => e -> IO a
throwIO (IOError -> IO X509) -> IOError -> IO X509
forall a b. (a -> b) -> a -> b
$ String -> IOError
userError String
"BUG: NULL certificate in X509_STORE_CTX"
    else IO X509 -> IO X509
forall a. IO a -> IO a
mask_ (IO X509 -> IO X509) -> IO X509 -> IO X509
forall a b. (a -> b) -> a -> b
$ Ptr X509_ -> IO ()
_x509_ref Ptr X509_
pCert IO () -> IO X509 -> IO X509
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr X509_ -> IO X509
wrapX509 Ptr X509_
pCert

getStoreCtxIssuer :: X509StoreCtx -> IO (Maybe X509)
getStoreCtxIssuer :: X509StoreCtx -> IO (Maybe X509)
getStoreCtxIssuer X509StoreCtx
ctx = X509StoreCtx
-> (Ptr X509_STORE_CTX -> IO (Maybe X509)) -> IO (Maybe X509)
forall a. X509StoreCtx -> (Ptr X509_STORE_CTX -> IO a) -> IO a
withX509StoreCtxPtr X509StoreCtx
ctx ((Ptr X509_STORE_CTX -> IO (Maybe X509)) -> IO (Maybe X509))
-> (Ptr X509_STORE_CTX -> IO (Maybe X509)) -> IO (Maybe X509)
forall a b. (a -> b) -> a -> b
$ \Ptr X509_STORE_CTX
pCtx -> do
  Ptr X509_
pCert <- Ptr X509_STORE_CTX -> IO (Ptr X509_)
_store_ctx_get0_current_issuer Ptr X509_STORE_CTX
pCtx
  if Ptr X509_
pCert Ptr X509_ -> Ptr X509_ -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr X509_
forall a. Ptr a
nullPtr
    then Maybe X509 -> IO (Maybe X509)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe X509
forall a. Maybe a
Nothing
    else (X509 -> Maybe X509) -> IO X509 -> IO (Maybe X509)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap X509 -> Maybe X509
forall a. a -> Maybe a
Just (IO X509 -> IO (Maybe X509)) -> IO X509 -> IO (Maybe X509)
forall a b. (a -> b) -> a -> b
$ IO X509 -> IO X509
forall a. IO a -> IO a
mask_ (IO X509 -> IO X509) -> IO X509 -> IO X509
forall a b. (a -> b) -> a -> b
$ Ptr X509_ -> IO ()
_x509_ref Ptr X509_
pCert IO () -> IO X509 -> IO X509
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr X509_ -> IO X509
wrapX509 Ptr X509_
pCert

getStoreCtxCRL :: X509StoreCtx -> IO (Maybe CRL)
getStoreCtxCRL :: X509StoreCtx -> IO (Maybe CRL)
getStoreCtxCRL X509StoreCtx
ctx = X509StoreCtx
-> (Ptr X509_STORE_CTX -> IO (Maybe CRL)) -> IO (Maybe CRL)
forall a. X509StoreCtx -> (Ptr X509_STORE_CTX -> IO a) -> IO a
withX509StoreCtxPtr X509StoreCtx
ctx ((Ptr X509_STORE_CTX -> IO (Maybe CRL)) -> IO (Maybe CRL))
-> (Ptr X509_STORE_CTX -> IO (Maybe CRL)) -> IO (Maybe CRL)
forall a b. (a -> b) -> a -> b
$ \Ptr X509_STORE_CTX
pCtx -> do
  Ptr X509_CRL
pCrl <- Ptr X509_STORE_CTX -> IO (Ptr X509_CRL)
_store_ctx_get0_current_crl Ptr X509_STORE_CTX
pCtx
  if Ptr X509_CRL
pCrl Ptr X509_CRL -> Ptr X509_CRL -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr X509_CRL
forall a. Ptr a
nullPtr
    then Maybe CRL -> IO (Maybe CRL)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe CRL
forall a. Maybe a
Nothing
    else (CRL -> Maybe CRL) -> IO CRL -> IO (Maybe CRL)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CRL -> Maybe CRL
forall a. a -> Maybe a
Just (IO CRL -> IO (Maybe CRL)) -> IO CRL -> IO (Maybe CRL)
forall a b. (a -> b) -> a -> b
$ IO CRL -> IO CRL
forall a. IO a -> IO a
mask_ (IO CRL -> IO CRL) -> IO CRL -> IO CRL
forall a b. (a -> b) -> a -> b
$ Ptr X509_CRL -> IO ()
_crl_ref Ptr X509_CRL
pCrl IO () -> IO CRL -> IO CRL
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr X509_CRL -> IO CRL
wrapCRL Ptr X509_CRL
pCrl

getStoreCtxChain :: X509StoreCtx -> IO [X509]
getStoreCtxChain :: X509StoreCtx -> IO [X509]
getStoreCtxChain X509StoreCtx
ctx = X509StoreCtx -> (Ptr X509_STORE_CTX -> IO [X509]) -> IO [X509]
forall a. X509StoreCtx -> (Ptr X509_STORE_CTX -> IO a) -> IO a
withX509StoreCtxPtr X509StoreCtx
ctx ((Ptr X509_STORE_CTX -> IO [X509]) -> IO [X509])
-> (Ptr X509_STORE_CTX -> IO [X509]) -> IO [X509]
forall a b. (a -> b) -> a -> b
$ \Ptr X509_STORE_CTX
pCtx -> do
  Ptr STACK
stack <- Ptr X509_STORE_CTX -> IO (Ptr STACK)
_store_ctx_get_chain Ptr X509_STORE_CTX
pCtx
  ((Ptr X509_ -> IO X509) -> Ptr STACK -> IO [X509]
forall a b. (Ptr a -> IO b) -> Ptr STACK -> IO [b]
`mapStack` Ptr STACK
stack) ((Ptr X509_ -> IO X509) -> IO [X509])
-> (Ptr X509_ -> IO X509) -> IO [X509]
forall a b. (a -> b) -> a -> b
$ \Ptr X509_
pCert -> IO X509 -> IO X509
forall a. IO a -> IO a
mask_ (IO X509 -> IO X509) -> IO X509 -> IO X509
forall a b. (a -> b) -> a -> b
$ Ptr X509_ -> IO ()
_x509_ref Ptr X509_
pCert IO () -> IO X509 -> IO X509
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr X509_ -> IO X509
wrapX509 Ptr X509_
pCert