Hello community, here is the log from the commit of package ghc-HsOpenSSL for openSUSE:Factory checked in at 2017-03-20 17:06:42 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-HsOpenSSL (Old) and /work/SRC/openSUSE:Factory/.ghc-HsOpenSSL.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-HsOpenSSL" Mon Mar 20 17:06:42 2017 rev:4 rq:477438 version:0.11.4.1 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-HsOpenSSL/ghc-HsOpenSSL.changes 2017-02-11 01:40:26.783248094 +0100 +++ /work/SRC/openSUSE:Factory/.ghc-HsOpenSSL.new/ghc-HsOpenSSL.changes 2017-03-20 17:06:43.873859199 +0100 @@ -1,0 +2,5 @@ +Mon Feb 27 10:12:20 UTC 2017 - [email protected] + +- Update to version 0.11.4.1 with cabal2obs. + +------------------------------------------------------------------- Old: ---- HsOpenSSL-0.11.4.tar.gz New: ---- HsOpenSSL-0.11.4.1.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-HsOpenSSL.spec ++++++ --- /var/tmp/diff_new_pack.b16qR2/_old 2017-03-20 17:06:44.685744561 +0100 +++ /var/tmp/diff_new_pack.b16qR2/_new 2017-03-20 17:06:44.685744561 +0100 @@ -19,7 +19,7 @@ %global pkg_name HsOpenSSL %bcond_with tests Name: ghc-%{pkg_name} -Version: 0.11.4 +Version: 0.11.4.1 Release: 0 Summary: Partial OpenSSL binding for Haskell License: SUSE-Public-Domain ++++++ HsOpenSSL-0.11.4.tar.gz -> HsOpenSSL-0.11.4.1.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/HsOpenSSL-0.11.4/ChangeLog new/HsOpenSSL-0.11.4.1/ChangeLog --- old/HsOpenSSL-0.11.4/ChangeLog 2017-01-24 02:44:40.000000000 +0100 +++ new/HsOpenSSL-0.11.4.1/ChangeLog 2017-02-26 22:48:27.000000000 +0100 @@ -1,3 +1,9 @@ +2017-02-27 Vladimir Shabanov <[email protected]> + + * HsOpenSSL.cabal (Version): Bump version to 0.11.4.1 + + * Updated for OpenSSL 1.1.0 (#16) + 2017-01-24 Vladimir Shabanov <[email protected]> * HsOpenSSL.cabal (Version): Bump version to 0.11.4 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/HsOpenSSL-0.11.4/HsOpenSSL.cabal new/HsOpenSSL-0.11.4.1/HsOpenSSL.cabal --- old/HsOpenSSL-0.11.4/HsOpenSSL.cabal 2017-01-24 02:44:40.000000000 +0100 +++ new/HsOpenSSL-0.11.4.1/HsOpenSSL.cabal 2017-02-26 22:48:27.000000000 +0100 @@ -12,7 +12,7 @@ <http://hackage.haskell.org/package/tls>, which is a pure Haskell implementation of SSL. . -Version: 0.11.4 +Version: 0.11.4.1 License: PublicDomain License-File: COPYING Author: Adam Langley, Mikhail Vorozhtsov, PHO, Taru Karttunen diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/HsOpenSSL-0.11.4/OpenSSL/Stack.hs new/HsOpenSSL-0.11.4.1/OpenSSL/Stack.hs --- old/HsOpenSSL-0.11.4/OpenSSL/Stack.hs 2017-01-24 02:44:40.000000000 +0100 +++ new/HsOpenSSL-0.11.4.1/OpenSSL/Stack.hs 1970-01-01 01:00:00.000000000 +0100 @@ -1,61 +0,0 @@ -{-# LANGUAGE EmptyDataDecls #-} -{-# LANGUAGE ForeignFunctionInterface #-} -module OpenSSL.Stack - ( STACK - , mapStack - , withStack - , withForeignStack - ) - where -import Control.Exception -import Foreign -import Foreign.C - - -data STACK - - -foreign import ccall unsafe "sk_new_null" - skNewNull :: IO (Ptr STACK) - -foreign import ccall unsafe "sk_free" - skFree :: Ptr STACK -> IO () - -foreign import ccall unsafe "sk_push" - skPush :: Ptr STACK -> Ptr () -> IO () - -foreign import ccall unsafe "sk_num" - skNum :: Ptr STACK -> IO CInt - -foreign import ccall unsafe "sk_value" - skValue :: Ptr STACK -> CInt -> IO (Ptr ()) - - -mapStack :: (Ptr a -> IO b) -> Ptr STACK -> IO [b] -mapStack m st - = do num <- skNum st - mapM (\ i -> fmap castPtr (skValue st i) >>= m) - $ take (fromIntegral num) [0..] - - -newStack :: [Ptr a] -> IO (Ptr STACK) -newStack values - = do st <- skNewNull - mapM_ (skPush st . castPtr) values - return st - - -withStack :: [Ptr a] -> (Ptr STACK -> IO b) -> IO b -withStack values - = bracket (newStack values) skFree - - -withForeignStack :: (fp -> Ptr obj) - -> (fp -> IO ()) - -> [fp] - -> (Ptr STACK -> IO ret) - -> IO ret -withForeignStack unsafeFpToPtr touchFp fps action - = do ret <- withStack (map unsafeFpToPtr fps) action - mapM_ touchFp fps - return ret diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/HsOpenSSL-0.11.4/OpenSSL/Stack.hsc new/HsOpenSSL-0.11.4.1/OpenSSL/Stack.hsc --- old/HsOpenSSL-0.11.4/OpenSSL/Stack.hsc 1970-01-01 01:00:00.000000000 +0100 +++ new/HsOpenSSL-0.11.4.1/OpenSSL/Stack.hsc 2017-02-26 22:48:26.000000000 +0100 @@ -0,0 +1,78 @@ +{-# LANGUAGE EmptyDataDecls #-} +{-# LANGUAGE ForeignFunctionInterface #-} +module OpenSSL.Stack + ( STACK + , mapStack + , withStack + , withForeignStack + ) + where +#include "HsOpenSSL.h" +import Control.Exception +import Foreign +import Foreign.C + + +data STACK + + +#if OPENSSL_VERSION_NUMBER >= 0x10100000L +foreign import ccall unsafe "OPENSSL_sk_new_null" + skNewNull :: IO (Ptr STACK) + +foreign import ccall unsafe "OPENSSL_sk_free" + skFree :: Ptr STACK -> IO () + +foreign import ccall unsafe "OPENSSL_sk_push" + skPush :: Ptr STACK -> Ptr () -> IO () + +foreign import ccall unsafe "OPENSSL_sk_num" + skNum :: Ptr STACK -> IO CInt + +foreign import ccall unsafe "OPENSSL_sk_value" + skValue :: Ptr STACK -> CInt -> IO (Ptr ()) +#else +foreign import ccall unsafe "sk_new_null" + skNewNull :: IO (Ptr STACK) + +foreign import ccall unsafe "sk_free" + skFree :: Ptr STACK -> IO () + +foreign import ccall unsafe "sk_push" + skPush :: Ptr STACK -> Ptr () -> IO () + +foreign import ccall unsafe "sk_num" + skNum :: Ptr STACK -> IO CInt + +foreign import ccall unsafe "sk_value" + skValue :: Ptr STACK -> CInt -> IO (Ptr ()) +#endif + +mapStack :: (Ptr a -> IO b) -> Ptr STACK -> IO [b] +mapStack m st + = do num <- skNum st + mapM (\ i -> fmap castPtr (skValue st i) >>= m) + $ take (fromIntegral num) [0..] + + +newStack :: [Ptr a] -> IO (Ptr STACK) +newStack values + = do st <- skNewNull + mapM_ (skPush st . castPtr) values + return st + + +withStack :: [Ptr a] -> (Ptr STACK -> IO b) -> IO b +withStack values + = bracket (newStack values) skFree + + +withForeignStack :: (fp -> Ptr obj) + -> (fp -> IO ()) + -> [fp] + -> (Ptr STACK -> IO ret) + -> IO ret +withForeignStack unsafeFpToPtr touchFp fps action + = do ret <- withStack (map unsafeFpToPtr fps) action + mapM_ touchFp fps + return ret diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/HsOpenSSL-0.11.4/OpenSSL/X509/Revocation.hsc new/HsOpenSSL-0.11.4.1/OpenSSL/X509/Revocation.hsc --- old/HsOpenSSL-0.11.4/OpenSSL/X509/Revocation.hsc 2017-01-24 02:44:40.000000000 +0100 +++ new/HsOpenSSL-0.11.4.1/OpenSSL/X509/Revocation.hsc 2017-02-26 22:48:26.000000000 +0100 @@ -100,14 +100,22 @@ foreign import ccall unsafe "HsOpenSSL_X509_CRL_get_lastUpdate" _get_lastUpdate :: Ptr X509_CRL -> IO (Ptr ASN1_TIME) -foreign import ccall unsafe "X509_CRL_set_lastUpdate" - _set_lastUpdate :: Ptr X509_CRL -> Ptr ASN1_TIME -> IO CInt - foreign import ccall unsafe "HsOpenSSL_X509_CRL_get_nextUpdate" _get_nextUpdate :: Ptr X509_CRL -> IO (Ptr ASN1_TIME) +#if OPENSSL_VERSION_NUMBER >= 0x10100000L +foreign import ccall unsafe "X509_CRL_set1_lastUpdate" + _set_lastUpdate :: Ptr X509_CRL -> Ptr ASN1_TIME -> IO CInt + +foreign import ccall unsafe "X509_CRL_set1_nextUpdate" + _set_nextUpdate :: Ptr X509_CRL -> Ptr ASN1_TIME -> IO CInt +#else +foreign import ccall unsafe "X509_CRL_set_lastUpdate" + _set_lastUpdate :: Ptr X509_CRL -> Ptr ASN1_TIME -> IO CInt + foreign import ccall unsafe "X509_CRL_set_nextUpdate" _set_nextUpdate :: Ptr X509_CRL -> Ptr ASN1_TIME -> IO CInt +#endif foreign import ccall unsafe "HsOpenSSL_X509_CRL_get_issuer" _get_issuer_name :: Ptr X509_CRL -> IO (Ptr X509_NAME) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/HsOpenSSL-0.11.4/OpenSSL/X509/Store.hs new/HsOpenSSL-0.11.4.1/OpenSSL/X509/Store.hs --- old/HsOpenSSL-0.11.4/OpenSSL/X509/Store.hs 2017-01-24 02:44:40.000000000 +0100 +++ new/HsOpenSSL-0.11.4.1/OpenSSL/X509/Store.hs 1970-01-01 01:00:00.000000000 +0100 @@ -1,147 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE EmptyDataDecls #-} -{-# LANGUAGE ForeignFunctionInterface #-} -{-# 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 -#if !MIN_VERSION_base(4,8,0) -import Control.Applicative ((<$>)) -#endif -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 X509_STORE - - -foreign import ccall unsafe "X509_STORE_new" - _new :: IO (Ptr X509_STORE) - -foreign import ccall unsafe "X509_STORE_free" - _free :: Ptr X509_STORE -> IO () - -foreign import ccall unsafe "X509_STORE_add_cert" - _add_cert :: Ptr X509_STORE -> Ptr X509_ -> IO CInt - -foreign import ccall unsafe "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 = _new - >>= failIfNull - >>= \ ptr -> wrapX509Store (_free ptr) ptr - -wrapX509Store :: IO () -> Ptr X509_STORE -> IO X509Store -wrapX509Store finaliser ptr - = do fp <- newForeignPtr_ ptr - FC.addForeignPtrFinalizer fp finaliser - return $ X509Store fp - -withX509StorePtr :: X509Store -> (Ptr X509_STORE -> IO a) -> IO a -withX509StorePtr (X509Store store) - = withForeignPtr store - --- |@'addCertToStore' store cert@ adds a certificate to store. -addCertToStore :: X509Store -> X509 -> IO () -addCertToStore store cert - = withX509StorePtr store $ \ storePtr -> - withX509Ptr cert $ \ certPtr -> - _add_cert storePtr certPtr - >>= failIf (/= 1) - >> return () - --- |@'addCRLToStore' store crl@ adds a revocation list to store. -addCRLToStore :: X509Store -> CRL -> IO () -addCRLToStore store crl - = withX509StorePtr store $ \ storePtr -> - withCRLPtr crl $ \ crlPtr -> - _add_crl storePtr crlPtr - >>= failIf (/= 1) - >> return () - -data X509_STORE_CTX -newtype X509StoreCtx = X509StoreCtx (ForeignPtr X509_STORE_CTX) - -foreign import ccall unsafe "X509_STORE_CTX_get_current_cert" - _store_ctx_get_current_cert :: Ptr X509_STORE_CTX -> IO (Ptr X509_) - -foreign import ccall unsafe "HsOpenSSL_X509_STORE_CTX_get0_current_issuer" - _store_ctx_get0_current_issuer :: Ptr X509_STORE_CTX -> IO (Ptr X509_) - -foreign import ccall unsafe "HsOpenSSL_X509_STORE_CTX_get0_current_crl" - _store_ctx_get0_current_crl :: Ptr X509_STORE_CTX -> IO (Ptr X509_CRL) - -foreign import ccall unsafe "X509_STORE_CTX_get_chain" - _store_ctx_get_chain :: Ptr X509_STORE_CTX -> IO (Ptr STACK) - -foreign import ccall unsafe "HsOpenSSL_X509_ref" - _x509_ref :: Ptr X509_ -> IO () - -foreign import ccall unsafe "HsOpenSSL_X509_CRL_ref" - _crl_ref :: Ptr X509_CRL -> IO () - -withX509StoreCtxPtr :: X509StoreCtx -> (Ptr X509_STORE_CTX -> IO a) -> IO a -withX509StoreCtxPtr (X509StoreCtx fp) = withForeignPtr fp - -wrapX509StoreCtx :: IO () -> Ptr X509_STORE_CTX -> IO X509StoreCtx -wrapX509StoreCtx finaliser ptr = - X509StoreCtx <$> FC.newForeignPtr ptr finaliser - -getStoreCtxCert :: X509StoreCtx -> IO X509 -getStoreCtxCert ctx = withX509StoreCtxPtr ctx $ \pCtx -> do - pCert <- _store_ctx_get_current_cert pCtx - if pCert == nullPtr - then throwIO $ userError "BUG: NULL certificate in X509_STORE_CTX" - else mask_ $ _x509_ref pCert >> wrapX509 pCert - -getStoreCtxIssuer :: X509StoreCtx -> IO (Maybe X509) -getStoreCtxIssuer ctx = withX509StoreCtxPtr ctx $ \pCtx -> do - pCert <- _store_ctx_get0_current_issuer pCtx - if pCert == nullPtr - then return Nothing - else fmap Just $ mask_ $ _x509_ref pCert >> wrapX509 pCert - -getStoreCtxCRL :: X509StoreCtx -> IO (Maybe CRL) -getStoreCtxCRL ctx = withX509StoreCtxPtr ctx $ \pCtx -> do - pCrl <- _store_ctx_get0_current_crl pCtx - if pCrl == nullPtr - then return Nothing - else fmap Just $ mask_ $ _crl_ref pCrl >> wrapCRL pCrl - -getStoreCtxChain :: X509StoreCtx -> IO [X509] -getStoreCtxChain ctx = withX509StoreCtxPtr ctx $ \pCtx -> do - stack <- _store_ctx_get_chain pCtx - (`mapStack` stack) $ \pCert -> mask_ $ _x509_ref pCert >> wrapX509 pCert diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/HsOpenSSL-0.11.4/OpenSSL/X509/Store.hsc new/HsOpenSSL-0.11.4.1/OpenSSL/X509/Store.hsc --- old/HsOpenSSL-0.11.4/OpenSSL/X509/Store.hsc 1970-01-01 01:00:00.000000000 +0100 +++ new/HsOpenSSL-0.11.4.1/OpenSSL/X509/Store.hsc 2017-02-26 22:48:26.000000000 +0100 @@ -0,0 +1,152 @@ +{-# LANGUAGE EmptyDataDecls #-} +{-# LANGUAGE ForeignFunctionInterface #-} +{-# 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 +#include "HsOpenSSL.h" +#if !MIN_VERSION_base(4,8,0) +import Control.Applicative ((<$>)) +#endif +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 X509_STORE + + +foreign import ccall unsafe "X509_STORE_new" + _new :: IO (Ptr X509_STORE) + +foreign import ccall unsafe "X509_STORE_free" + _free :: Ptr X509_STORE -> IO () + +foreign import ccall unsafe "X509_STORE_add_cert" + _add_cert :: Ptr X509_STORE -> Ptr X509_ -> IO CInt + +foreign import ccall unsafe "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 = _new + >>= failIfNull + >>= \ ptr -> wrapX509Store (_free ptr) ptr + +wrapX509Store :: IO () -> Ptr X509_STORE -> IO X509Store +wrapX509Store finaliser ptr + = do fp <- newForeignPtr_ ptr + FC.addForeignPtrFinalizer fp finaliser + return $ X509Store fp + +withX509StorePtr :: X509Store -> (Ptr X509_STORE -> IO a) -> IO a +withX509StorePtr (X509Store store) + = withForeignPtr store + +-- |@'addCertToStore' store cert@ adds a certificate to store. +addCertToStore :: X509Store -> X509 -> IO () +addCertToStore store cert + = withX509StorePtr store $ \ storePtr -> + withX509Ptr cert $ \ certPtr -> + _add_cert storePtr certPtr + >>= failIf (/= 1) + >> return () + +-- |@'addCRLToStore' store crl@ adds a revocation list to store. +addCRLToStore :: X509Store -> CRL -> IO () +addCRLToStore store crl + = withX509StorePtr store $ \ storePtr -> + withCRLPtr crl $ \ crlPtr -> + _add_crl storePtr crlPtr + >>= failIf (/= 1) + >> return () + +data X509_STORE_CTX +newtype X509StoreCtx = X509StoreCtx (ForeignPtr X509_STORE_CTX) + +foreign import ccall unsafe "X509_STORE_CTX_get_current_cert" + _store_ctx_get_current_cert :: Ptr X509_STORE_CTX -> IO (Ptr X509_) + +foreign import ccall unsafe "HsOpenSSL_X509_STORE_CTX_get0_current_issuer" + _store_ctx_get0_current_issuer :: Ptr X509_STORE_CTX -> IO (Ptr X509_) + +foreign import ccall unsafe "HsOpenSSL_X509_STORE_CTX_get0_current_crl" + _store_ctx_get0_current_crl :: Ptr X509_STORE_CTX -> IO (Ptr X509_CRL) + +#if OPENSSL_VERSION_NUMBER >= 0x10100000L +foreign import ccall unsafe "X509_STORE_CTX_get1_chain" + _store_ctx_get_chain :: Ptr X509_STORE_CTX -> IO (Ptr STACK) +#else +foreign import ccall unsafe "X509_STORE_CTX_get_chain" + _store_ctx_get_chain :: Ptr X509_STORE_CTX -> IO (Ptr STACK) +#endif + +foreign import ccall unsafe "HsOpenSSL_X509_ref" + _x509_ref :: Ptr X509_ -> IO () + +foreign import ccall unsafe "HsOpenSSL_X509_CRL_ref" + _crl_ref :: Ptr X509_CRL -> IO () + +withX509StoreCtxPtr :: X509StoreCtx -> (Ptr X509_STORE_CTX -> IO a) -> IO a +withX509StoreCtxPtr (X509StoreCtx fp) = withForeignPtr fp + +wrapX509StoreCtx :: IO () -> Ptr X509_STORE_CTX -> IO X509StoreCtx +wrapX509StoreCtx finaliser ptr = + X509StoreCtx <$> FC.newForeignPtr ptr finaliser + +getStoreCtxCert :: X509StoreCtx -> IO X509 +getStoreCtxCert ctx = withX509StoreCtxPtr ctx $ \pCtx -> do + pCert <- _store_ctx_get_current_cert pCtx + if pCert == nullPtr + then throwIO $ userError "BUG: NULL certificate in X509_STORE_CTX" + else mask_ $ _x509_ref pCert >> wrapX509 pCert + +getStoreCtxIssuer :: X509StoreCtx -> IO (Maybe X509) +getStoreCtxIssuer ctx = withX509StoreCtxPtr ctx $ \pCtx -> do + pCert <- _store_ctx_get0_current_issuer pCtx + if pCert == nullPtr + then return Nothing + else fmap Just $ mask_ $ _x509_ref pCert >> wrapX509 pCert + +getStoreCtxCRL :: X509StoreCtx -> IO (Maybe CRL) +getStoreCtxCRL ctx = withX509StoreCtxPtr ctx $ \pCtx -> do + pCrl <- _store_ctx_get0_current_crl pCtx + if pCrl == nullPtr + then return Nothing + else fmap Just $ mask_ $ _crl_ref pCrl >> wrapCRL pCrl + +getStoreCtxChain :: X509StoreCtx -> IO [X509] +getStoreCtxChain ctx = withX509StoreCtxPtr ctx $ \pCtx -> do + stack <- _store_ctx_get_chain pCtx + (`mapStack` stack) $ \pCert -> mask_ $ _x509_ref pCert >> wrapX509 pCert diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/HsOpenSSL-0.11.4/OpenSSL/X509.hs new/HsOpenSSL-0.11.4.1/OpenSSL/X509.hs --- old/HsOpenSSL-0.11.4/OpenSSL/X509.hs 2017-01-24 02:44:40.000000000 +0100 +++ new/HsOpenSSL-0.11.4.1/OpenSSL/X509.hs 1970-01-01 01:00:00.000000000 +0100 @@ -1,422 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE EmptyDataDecls #-} -{-# LANGUAGE ForeignFunctionInterface #-} -{-# OPTIONS_HADDOCK prune #-} --- |An interface to X.509 certificate. -module OpenSSL.X509 - ( -- * Type - X509 - , X509_ - - -- * Functions to manipulate certificate - , newX509 - , wrapX509 -- private - , withX509Ptr -- private - , withX509Stack -- private - , unsafeX509ToPtr -- private - , touchX509 -- private - - , writeDerX509 - , readDerX509 - , compareX509 - - , signX509 - , verifyX509 - - , printX509 - - -- * Accessors - , getVersion - , setVersion - - , getSerialNumber - , setSerialNumber - - , getIssuerName - , setIssuerName - - , getSubjectName - , setSubjectName - - , getNotBefore - , setNotBefore - - , getNotAfter - , setNotAfter - - , getPublicKey - , setPublicKey - - , getSubjectEmail - ) - where -import Control.Monad -import Data.Time.Clock -import Data.Maybe -import Foreign.ForeignPtr -#if MIN_VERSION_base(4,4,0) -import Foreign.ForeignPtr.Unsafe as Unsafe -#else -import Foreign.ForeignPtr as Unsafe -#endif -import Foreign.Ptr -import Foreign.C -import OpenSSL.ASN1 -import OpenSSL.BIO -import OpenSSL.EVP.Digest -import OpenSSL.EVP.PKey -import OpenSSL.EVP.Verify -import OpenSSL.EVP.Internal -import OpenSSL.Utils -import OpenSSL.Stack -import OpenSSL.X509.Name -import Data.ByteString.Lazy (ByteString) - --- |@'X509'@ is an opaque object that represents X.509 certificate. -newtype X509 = X509 (ForeignPtr X509_) -data X509_ - - -foreign import ccall unsafe "X509_new" - _new :: IO (Ptr X509_) - -foreign import ccall unsafe "&X509_free" - _free :: FunPtr (Ptr X509_ -> IO ()) - -foreign import ccall unsafe "X509_print" - _print :: Ptr BIO_ -> Ptr X509_ -> IO CInt - -foreign import ccall unsafe "X509_cmp" - _cmp :: Ptr X509_ -> Ptr X509_ -> IO CInt - -foreign import ccall unsafe "HsOpenSSL_X509_get_version" - _get_version :: Ptr X509_ -> IO CLong - -foreign import ccall unsafe "X509_set_version" - _set_version :: Ptr X509_ -> CLong -> IO CInt - -foreign import ccall unsafe "X509_get_serialNumber" - _get_serialNumber :: Ptr X509_ -> IO (Ptr ASN1_INTEGER) - -foreign import ccall unsafe "X509_set_serialNumber" - _set_serialNumber :: Ptr X509_ -> Ptr ASN1_INTEGER -> IO CInt - -foreign import ccall unsafe "X509_get_issuer_name" - _get_issuer_name :: Ptr X509_ -> IO (Ptr X509_NAME) - -foreign import ccall unsafe "X509_set_issuer_name" - _set_issuer_name :: Ptr X509_ -> Ptr X509_NAME -> IO CInt - -foreign import ccall unsafe "X509_get_subject_name" - _get_subject_name :: Ptr X509_ -> IO (Ptr X509_NAME) - -foreign import ccall unsafe "X509_set_subject_name" - _set_subject_name :: Ptr X509_ -> Ptr X509_NAME -> IO CInt - -foreign import ccall unsafe "HsOpenSSL_X509_get_notBefore" - _get_notBefore :: Ptr X509_ -> IO (Ptr ASN1_TIME) - -foreign import ccall unsafe "X509_set_notBefore" - _set_notBefore :: Ptr X509_ -> Ptr ASN1_TIME -> IO CInt - -foreign import ccall unsafe "HsOpenSSL_X509_get_notAfter" - _get_notAfter :: Ptr X509_ -> IO (Ptr ASN1_TIME) - -foreign import ccall unsafe "X509_set_notAfter" - _set_notAfter :: Ptr X509_ -> Ptr ASN1_TIME -> IO CInt - -foreign import ccall unsafe "X509_get_pubkey" - _get_pubkey :: Ptr X509_ -> IO (Ptr EVP_PKEY) - -foreign import ccall unsafe "X509_set_pubkey" - _set_pubkey :: Ptr X509_ -> Ptr EVP_PKEY -> IO CInt - -foreign import ccall unsafe "X509_get1_email" - _get1_email :: Ptr X509_ -> IO (Ptr STACK) - -foreign import ccall unsafe "X509_email_free" - _email_free :: Ptr STACK -> IO () - -foreign import ccall unsafe "X509_sign" - _sign :: Ptr X509_ -> Ptr EVP_PKEY -> Ptr EVP_MD -> IO CInt - -foreign import ccall unsafe "X509_verify" - _verify :: Ptr X509_ -> Ptr EVP_PKEY -> IO CInt - -foreign import ccall safe "i2d_X509_bio" - _write_bio_X509 :: Ptr BIO_ - -> Ptr X509_ - -> IO CInt - -foreign import ccall safe "d2i_X509_bio" - _read_bio_X509 :: Ptr BIO_ - -> Ptr (Ptr X509_) - -> IO (Ptr X509_) - --- |@'newX509'@ creates an empty certificate. You must set the --- following properties to and sign it (see 'signX509') to actually --- use the certificate. --- --- [/Version/] See 'setVersion'. --- --- [/Serial number/] See 'setSerialNumber'. --- --- [/Issuer name/] See 'setIssuerName'. --- --- [/Subject name/] See 'setSubjectName'. --- --- [/Validity/] See 'setNotBefore' and 'setNotAfter'. --- --- [/Public Key/] See 'setPublicKey'. --- -newX509 :: IO X509 -newX509 = _new >>= failIfNull >>= wrapX509 - - -wrapX509 :: Ptr X509_ -> IO X509 -wrapX509 = fmap X509 . newForeignPtr _free - - -withX509Ptr :: X509 -> (Ptr X509_ -> IO a) -> IO a -withX509Ptr (X509 x509) = withForeignPtr x509 - - -withX509Stack :: [X509] -> (Ptr STACK -> IO a) -> IO a -withX509Stack = withForeignStack unsafeX509ToPtr touchX509 - - -unsafeX509ToPtr :: X509 -> Ptr X509_ -unsafeX509ToPtr (X509 x509) = Unsafe.unsafeForeignPtrToPtr x509 - - -touchX509 :: X509 -> IO () -touchX509 (X509 x509) = touchForeignPtr x509 - -writeX509' :: BIO -> X509 -> IO () -writeX509' bio x509 - = withBioPtr bio $ \ bioPtr -> - withX509Ptr x509 $ \ x509Ptr -> - _write_bio_X509 bioPtr x509Ptr - >>= failIf (< 0) - >> return () - --- |@'writeDerX509' cert@ writes an X.509 certificate to DER string. -writeDerX509 :: X509 -> IO ByteString -writeDerX509 x509 - = do mem <- newMem - writeX509' mem x509 - bioReadLBS mem - -readX509' :: BIO -> IO X509 -readX509' bio - = withBioPtr bio $ \ bioPtr -> - _read_bio_X509 bioPtr nullPtr - >>= failIfNull - >>= wrapX509 - --- |@'readDerX509' der@ reads in a certificate. -readDerX509 :: ByteString -> IO X509 -readDerX509 derStr - = newConstMemLBS derStr >>= readX509' - --- |@'compareX509' cert1 cert2@ compares two certificates. -compareX509 :: X509 -> X509 -> IO Ordering -compareX509 cert1 cert2 - = withX509Ptr cert1 $ \ cert1Ptr -> - withX509Ptr cert2 $ \ cert2Ptr -> - fmap interpret (_cmp cert1Ptr cert2Ptr) - where - interpret :: CInt -> Ordering - interpret n - | n > 0 = GT - | n < 0 = LT - | otherwise = EQ - --- |@'signX509'@ signs a certificate with an issuer private key. -signX509 :: KeyPair key => - X509 -- ^ The certificate 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 () -signX509 x509 key mDigest - = withX509Ptr x509 $ \ x509Ptr -> - withPKeyPtr' key $ \ pkeyPtr -> - do dig <- case mDigest of - Just md -> return md - Nothing -> pkeyDefaultMD key - withMDPtr dig $ \ digestPtr -> - _sign x509Ptr pkeyPtr digestPtr - >>= failIf_ (== 0) - return () - --- |@'verifyX509'@ verifies a signature of certificate with an issuer --- public key. -verifyX509 :: PublicKey key => - X509 -- ^ The certificate to be verified. - -> key -- ^ The public key to verify with. - -> IO VerifyStatus -verifyX509 x509 key - = withX509Ptr x509 $ \ x509Ptr -> - withPKeyPtr' key $ \ pkeyPtr -> - _verify x509Ptr pkeyPtr - >>= interpret - where - interpret :: CInt -> IO VerifyStatus - interpret 1 = return VerifySuccess - interpret 0 = return VerifyFailure - interpret _ = raiseOpenSSLError - --- |@'printX509' cert@ translates a certificate into human-readable --- format. -printX509 :: X509 -> IO String -printX509 x509 - = do mem <- newMem - withX509Ptr x509 $ \ x509Ptr -> - withBioPtr mem $ \ memPtr -> - _print memPtr x509Ptr - >>= failIf_ (/= 1) - bioRead mem - --- |@'getVersion' cert@ returns the version number of certificate. It --- seems the number is 0-origin: version 2 means X.509 v3. -getVersion :: X509 -> IO Int -getVersion x509 - = withX509Ptr x509 $ \ x509Ptr -> - liftM fromIntegral $ _get_version x509Ptr - --- |@'setVersion' cert ver@ updates the version number of certificate. -setVersion :: X509 -> Int -> IO () -setVersion x509 ver - = withX509Ptr x509 $ \ x509Ptr -> - _set_version x509Ptr (fromIntegral ver) - >>= failIf (/= 1) - >> return () - --- |@'getSerialNumber' cert@ returns the serial number of certificate. -getSerialNumber :: X509 -> IO Integer -getSerialNumber x509 - = withX509Ptr x509 $ \ x509Ptr -> - _get_serialNumber x509Ptr - >>= peekASN1Integer - --- |@'setSerialNumber' cert num@ updates the serial number of --- certificate. -setSerialNumber :: X509 -> Integer -> IO () -setSerialNumber x509 serial - = withX509Ptr x509 $ \ x509Ptr -> - withASN1Integer serial $ \ serialPtr -> - _set_serialNumber x509Ptr serialPtr - >>= failIf (/= 1) - >> return () - --- |@'getIssuerName'@ returns the issuer name of certificate. -getIssuerName :: X509 -- ^ The certificate to examine. - -> Bool -- ^ @True@ if you want the keys of each parts - -- to be of long form (e.g. \"commonName\"), - -- or @False@ if you don't (e.g. \"CN\"). - -> IO [(String, String)] -- ^ Pairs of key and value, - -- for example \[(\"C\", - -- \"JP\"), (\"ST\", - -- \"Some-State\"), ...\]. -getIssuerName x509 wantLongName - = withX509Ptr x509 $ \ x509Ptr -> - do namePtr <- _get_issuer_name x509Ptr - peekX509Name namePtr wantLongName - --- |@'setIssuerName' cert name@ updates the issuer name of --- certificate. Keys of each parts may be of either long form or short --- form. See 'getIssuerName'. -setIssuerName :: X509 -> [(String, String)] -> IO () -setIssuerName x509 issuer - = withX509Ptr x509 $ \ x509Ptr -> - withX509Name issuer $ \ namePtr -> - _set_issuer_name x509Ptr namePtr - >>= failIf (/= 1) - >> return () - --- |@'getSubjectName' cert wantLongName@ returns the subject name of --- certificate. See 'getIssuerName'. -getSubjectName :: X509 -> Bool -> IO [(String, String)] -getSubjectName x509 wantLongName - = withX509Ptr x509 $ \ x509Ptr -> - do namePtr <- _get_subject_name x509Ptr - peekX509Name namePtr wantLongName - --- |@'setSubjectName' cert name@ updates the subject name of --- certificate. See 'setIssuerName'. -setSubjectName :: X509 -> [(String, String)] -> IO () -setSubjectName x509 subject - = withX509Ptr x509 $ \ x509Ptr -> - withX509Name subject $ \ namePtr -> - _set_subject_name x509Ptr namePtr - >>= failIf (/= 1) - >> return () - --- |@'getNotBefore' cert@ returns the time when the certificate begins --- to be valid. -getNotBefore :: X509 -> IO UTCTime -getNotBefore x509 - = withX509Ptr x509 $ \ x509Ptr -> - _get_notBefore x509Ptr - >>= peekASN1Time - --- |@'setNotBefore' cert utc@ updates the time when the certificate --- begins to be valid. -setNotBefore :: X509 -> UTCTime -> IO () -setNotBefore x509 utc - = withX509Ptr x509 $ \ x509Ptr -> - withASN1Time utc $ \ time -> - _set_notBefore x509Ptr time - >>= failIf (/= 1) - >> return () - --- |@'getNotAfter' cert@ returns the time when the certificate --- expires. -getNotAfter :: X509 -> IO UTCTime -getNotAfter x509 - = withX509Ptr x509 $ \ x509Ptr -> - _get_notAfter x509Ptr - >>= peekASN1Time - --- |@'setNotAfter' cert utc@ updates the time when the certificate --- expires. -setNotAfter :: X509 -> UTCTime -> IO () -setNotAfter x509 utc - = withX509Ptr x509 $ \ x509Ptr -> - withASN1Time utc $ \ time -> - _set_notAfter x509Ptr time - >>= failIf (/= 1) - >> return () - --- |@'getPublicKey' cert@ returns the public key of the subject of --- certificate. -getPublicKey :: X509 -> IO SomePublicKey -getPublicKey x509 - = withX509Ptr x509 $ \ x509Ptr -> - fmap fromJust ( _get_pubkey x509Ptr - >>= failIfNull - >>= wrapPKeyPtr - >>= fromPKey - ) - --- |@'setPublicKey' cert pubkey@ updates the public key of the subject --- of certificate. -setPublicKey :: PublicKey key => X509 -> key -> IO () -setPublicKey x509 key - = withX509Ptr x509 $ \ x509Ptr -> - withPKeyPtr' key $ \ pkeyPtr -> - _set_pubkey x509Ptr pkeyPtr - >>= failIf (/= 1) - >> return () - --- |@'getSubjectEmail' cert@ returns every subject email addresses in --- the certificate. -getSubjectEmail :: X509 -> IO [String] -getSubjectEmail x509 - = withX509Ptr x509 $ \ x509Ptr -> - do st <- _get1_email x509Ptr - list <- mapStack peekCString st - _email_free st - return list diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/HsOpenSSL-0.11.4/OpenSSL/X509.hsc new/HsOpenSSL-0.11.4.1/OpenSSL/X509.hsc --- old/HsOpenSSL-0.11.4/OpenSSL/X509.hsc 1970-01-01 01:00:00.000000000 +0100 +++ new/HsOpenSSL-0.11.4.1/OpenSSL/X509.hsc 2017-02-26 22:48:26.000000000 +0100 @@ -0,0 +1,430 @@ +{-# LANGUAGE EmptyDataDecls #-} +{-# LANGUAGE ForeignFunctionInterface #-} +{-# OPTIONS_HADDOCK prune #-} +-- |An interface to X.509 certificate. +module OpenSSL.X509 + ( -- * Type + X509 + , X509_ + + -- * Functions to manipulate certificate + , newX509 + , wrapX509 -- private + , withX509Ptr -- private + , withX509Stack -- private + , unsafeX509ToPtr -- private + , touchX509 -- private + + , writeDerX509 + , readDerX509 + , compareX509 + + , signX509 + , verifyX509 + + , printX509 + + -- * Accessors + , getVersion + , setVersion + + , getSerialNumber + , setSerialNumber + + , getIssuerName + , setIssuerName + + , getSubjectName + , setSubjectName + + , getNotBefore + , setNotBefore + + , getNotAfter + , setNotAfter + + , getPublicKey + , setPublicKey + + , getSubjectEmail + ) + where +#include "HsOpenSSL.h" +import Control.Monad +import Data.Time.Clock +import Data.Maybe +import Foreign.ForeignPtr +#if MIN_VERSION_base(4,4,0) +import Foreign.ForeignPtr.Unsafe as Unsafe +#else +import Foreign.ForeignPtr as Unsafe +#endif +import Foreign.Ptr +import Foreign.C +import OpenSSL.ASN1 +import OpenSSL.BIO +import OpenSSL.EVP.Digest +import OpenSSL.EVP.PKey +import OpenSSL.EVP.Verify +import OpenSSL.EVP.Internal +import OpenSSL.Utils +import OpenSSL.Stack +import OpenSSL.X509.Name +import Data.ByteString.Lazy (ByteString) + +-- |@'X509'@ is an opaque object that represents X.509 certificate. +newtype X509 = X509 (ForeignPtr X509_) +data X509_ + + +foreign import ccall unsafe "X509_new" + _new :: IO (Ptr X509_) + +foreign import ccall unsafe "&X509_free" + _free :: FunPtr (Ptr X509_ -> IO ()) + +foreign import ccall unsafe "X509_print" + _print :: Ptr BIO_ -> Ptr X509_ -> IO CInt + +foreign import ccall unsafe "X509_cmp" + _cmp :: Ptr X509_ -> Ptr X509_ -> IO CInt + +foreign import ccall unsafe "HsOpenSSL_X509_get_version" + _get_version :: Ptr X509_ -> IO CLong + +foreign import ccall unsafe "X509_set_version" + _set_version :: Ptr X509_ -> CLong -> IO CInt + +foreign import ccall unsafe "X509_get_serialNumber" + _get_serialNumber :: Ptr X509_ -> IO (Ptr ASN1_INTEGER) + +foreign import ccall unsafe "X509_set_serialNumber" + _set_serialNumber :: Ptr X509_ -> Ptr ASN1_INTEGER -> IO CInt + +foreign import ccall unsafe "X509_get_issuer_name" + _get_issuer_name :: Ptr X509_ -> IO (Ptr X509_NAME) + +foreign import ccall unsafe "X509_set_issuer_name" + _set_issuer_name :: Ptr X509_ -> Ptr X509_NAME -> IO CInt + +foreign import ccall unsafe "X509_get_subject_name" + _get_subject_name :: Ptr X509_ -> IO (Ptr X509_NAME) + +foreign import ccall unsafe "X509_set_subject_name" + _set_subject_name :: Ptr X509_ -> Ptr X509_NAME -> IO CInt + +foreign import ccall unsafe "HsOpenSSL_X509_get_notBefore" + _get_notBefore :: Ptr X509_ -> IO (Ptr ASN1_TIME) + +foreign import ccall unsafe "HsOpenSSL_X509_get_notAfter" + _get_notAfter :: Ptr X509_ -> IO (Ptr ASN1_TIME) + +#if OPENSSL_VERSION_NUMBER >= 0x10100000L +foreign import ccall unsafe "X509_set1_notBefore" + _set_notBefore :: Ptr X509_ -> Ptr ASN1_TIME -> IO CInt + +foreign import ccall unsafe "X509_set1_notAfter" + _set_notAfter :: Ptr X509_ -> Ptr ASN1_TIME -> IO CInt +#else +foreign import ccall unsafe "X509_set_notBefore" + _set_notBefore :: Ptr X509_ -> Ptr ASN1_TIME -> IO CInt + +foreign import ccall unsafe "X509_set_notAfter" + _set_notAfter :: Ptr X509_ -> Ptr ASN1_TIME -> IO CInt +#endif + +foreign import ccall unsafe "X509_get_pubkey" + _get_pubkey :: Ptr X509_ -> IO (Ptr EVP_PKEY) + +foreign import ccall unsafe "X509_set_pubkey" + _set_pubkey :: Ptr X509_ -> Ptr EVP_PKEY -> IO CInt + +foreign import ccall unsafe "X509_get1_email" + _get1_email :: Ptr X509_ -> IO (Ptr STACK) + +foreign import ccall unsafe "X509_email_free" + _email_free :: Ptr STACK -> IO () + +foreign import ccall unsafe "X509_sign" + _sign :: Ptr X509_ -> Ptr EVP_PKEY -> Ptr EVP_MD -> IO CInt + +foreign import ccall unsafe "X509_verify" + _verify :: Ptr X509_ -> Ptr EVP_PKEY -> IO CInt + +foreign import ccall safe "i2d_X509_bio" + _write_bio_X509 :: Ptr BIO_ + -> Ptr X509_ + -> IO CInt + +foreign import ccall safe "d2i_X509_bio" + _read_bio_X509 :: Ptr BIO_ + -> Ptr (Ptr X509_) + -> IO (Ptr X509_) + +-- |@'newX509'@ creates an empty certificate. You must set the +-- following properties to and sign it (see 'signX509') to actually +-- use the certificate. +-- +-- [/Version/] See 'setVersion'. +-- +-- [/Serial number/] See 'setSerialNumber'. +-- +-- [/Issuer name/] See 'setIssuerName'. +-- +-- [/Subject name/] See 'setSubjectName'. +-- +-- [/Validity/] See 'setNotBefore' and 'setNotAfter'. +-- +-- [/Public Key/] See 'setPublicKey'. +-- +newX509 :: IO X509 +newX509 = _new >>= failIfNull >>= wrapX509 + + +wrapX509 :: Ptr X509_ -> IO X509 +wrapX509 = fmap X509 . newForeignPtr _free + + +withX509Ptr :: X509 -> (Ptr X509_ -> IO a) -> IO a +withX509Ptr (X509 x509) = withForeignPtr x509 + + +withX509Stack :: [X509] -> (Ptr STACK -> IO a) -> IO a +withX509Stack = withForeignStack unsafeX509ToPtr touchX509 + + +unsafeX509ToPtr :: X509 -> Ptr X509_ +unsafeX509ToPtr (X509 x509) = Unsafe.unsafeForeignPtrToPtr x509 + + +touchX509 :: X509 -> IO () +touchX509 (X509 x509) = touchForeignPtr x509 + +writeX509' :: BIO -> X509 -> IO () +writeX509' bio x509 + = withBioPtr bio $ \ bioPtr -> + withX509Ptr x509 $ \ x509Ptr -> + _write_bio_X509 bioPtr x509Ptr + >>= failIf (< 0) + >> return () + +-- |@'writeDerX509' cert@ writes an X.509 certificate to DER string. +writeDerX509 :: X509 -> IO ByteString +writeDerX509 x509 + = do mem <- newMem + writeX509' mem x509 + bioReadLBS mem + +readX509' :: BIO -> IO X509 +readX509' bio + = withBioPtr bio $ \ bioPtr -> + _read_bio_X509 bioPtr nullPtr + >>= failIfNull + >>= wrapX509 + +-- |@'readDerX509' der@ reads in a certificate. +readDerX509 :: ByteString -> IO X509 +readDerX509 derStr + = newConstMemLBS derStr >>= readX509' + +-- |@'compareX509' cert1 cert2@ compares two certificates. +compareX509 :: X509 -> X509 -> IO Ordering +compareX509 cert1 cert2 + = withX509Ptr cert1 $ \ cert1Ptr -> + withX509Ptr cert2 $ \ cert2Ptr -> + fmap interpret (_cmp cert1Ptr cert2Ptr) + where + interpret :: CInt -> Ordering + interpret n + | n > 0 = GT + | n < 0 = LT + | otherwise = EQ + +-- |@'signX509'@ signs a certificate with an issuer private key. +signX509 :: KeyPair key => + X509 -- ^ The certificate 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 () +signX509 x509 key mDigest + = withX509Ptr x509 $ \ x509Ptr -> + withPKeyPtr' key $ \ pkeyPtr -> + do dig <- case mDigest of + Just md -> return md + Nothing -> pkeyDefaultMD key + withMDPtr dig $ \ digestPtr -> + _sign x509Ptr pkeyPtr digestPtr + >>= failIf_ (== 0) + return () + +-- |@'verifyX509'@ verifies a signature of certificate with an issuer +-- public key. +verifyX509 :: PublicKey key => + X509 -- ^ The certificate to be verified. + -> key -- ^ The public key to verify with. + -> IO VerifyStatus +verifyX509 x509 key + = withX509Ptr x509 $ \ x509Ptr -> + withPKeyPtr' key $ \ pkeyPtr -> + _verify x509Ptr pkeyPtr + >>= interpret + where + interpret :: CInt -> IO VerifyStatus + interpret 1 = return VerifySuccess + interpret 0 = return VerifyFailure + interpret _ = raiseOpenSSLError + +-- |@'printX509' cert@ translates a certificate into human-readable +-- format. +printX509 :: X509 -> IO String +printX509 x509 + = do mem <- newMem + withX509Ptr x509 $ \ x509Ptr -> + withBioPtr mem $ \ memPtr -> + _print memPtr x509Ptr + >>= failIf_ (/= 1) + bioRead mem + +-- |@'getVersion' cert@ returns the version number of certificate. It +-- seems the number is 0-origin: version 2 means X.509 v3. +getVersion :: X509 -> IO Int +getVersion x509 + = withX509Ptr x509 $ \ x509Ptr -> + liftM fromIntegral $ _get_version x509Ptr + +-- |@'setVersion' cert ver@ updates the version number of certificate. +setVersion :: X509 -> Int -> IO () +setVersion x509 ver + = withX509Ptr x509 $ \ x509Ptr -> + _set_version x509Ptr (fromIntegral ver) + >>= failIf (/= 1) + >> return () + +-- |@'getSerialNumber' cert@ returns the serial number of certificate. +getSerialNumber :: X509 -> IO Integer +getSerialNumber x509 + = withX509Ptr x509 $ \ x509Ptr -> + _get_serialNumber x509Ptr + >>= peekASN1Integer + +-- |@'setSerialNumber' cert num@ updates the serial number of +-- certificate. +setSerialNumber :: X509 -> Integer -> IO () +setSerialNumber x509 serial + = withX509Ptr x509 $ \ x509Ptr -> + withASN1Integer serial $ \ serialPtr -> + _set_serialNumber x509Ptr serialPtr + >>= failIf (/= 1) + >> return () + +-- |@'getIssuerName'@ returns the issuer name of certificate. +getIssuerName :: X509 -- ^ The certificate to examine. + -> Bool -- ^ @True@ if you want the keys of each parts + -- to be of long form (e.g. \"commonName\"), + -- or @False@ if you don't (e.g. \"CN\"). + -> IO [(String, String)] -- ^ Pairs of key and value, + -- for example \[(\"C\", + -- \"JP\"), (\"ST\", + -- \"Some-State\"), ...\]. +getIssuerName x509 wantLongName + = withX509Ptr x509 $ \ x509Ptr -> + do namePtr <- _get_issuer_name x509Ptr + peekX509Name namePtr wantLongName + +-- |@'setIssuerName' cert name@ updates the issuer name of +-- certificate. Keys of each parts may be of either long form or short +-- form. See 'getIssuerName'. +setIssuerName :: X509 -> [(String, String)] -> IO () +setIssuerName x509 issuer + = withX509Ptr x509 $ \ x509Ptr -> + withX509Name issuer $ \ namePtr -> + _set_issuer_name x509Ptr namePtr + >>= failIf (/= 1) + >> return () + +-- |@'getSubjectName' cert wantLongName@ returns the subject name of +-- certificate. See 'getIssuerName'. +getSubjectName :: X509 -> Bool -> IO [(String, String)] +getSubjectName x509 wantLongName + = withX509Ptr x509 $ \ x509Ptr -> + do namePtr <- _get_subject_name x509Ptr + peekX509Name namePtr wantLongName + +-- |@'setSubjectName' cert name@ updates the subject name of +-- certificate. See 'setIssuerName'. +setSubjectName :: X509 -> [(String, String)] -> IO () +setSubjectName x509 subject + = withX509Ptr x509 $ \ x509Ptr -> + withX509Name subject $ \ namePtr -> + _set_subject_name x509Ptr namePtr + >>= failIf (/= 1) + >> return () + +-- |@'getNotBefore' cert@ returns the time when the certificate begins +-- to be valid. +getNotBefore :: X509 -> IO UTCTime +getNotBefore x509 + = withX509Ptr x509 $ \ x509Ptr -> + _get_notBefore x509Ptr + >>= peekASN1Time + +-- |@'setNotBefore' cert utc@ updates the time when the certificate +-- begins to be valid. +setNotBefore :: X509 -> UTCTime -> IO () +setNotBefore x509 utc + = withX509Ptr x509 $ \ x509Ptr -> + withASN1Time utc $ \ time -> + _set_notBefore x509Ptr time + >>= failIf (/= 1) + >> return () + +-- |@'getNotAfter' cert@ returns the time when the certificate +-- expires. +getNotAfter :: X509 -> IO UTCTime +getNotAfter x509 + = withX509Ptr x509 $ \ x509Ptr -> + _get_notAfter x509Ptr + >>= peekASN1Time + +-- |@'setNotAfter' cert utc@ updates the time when the certificate +-- expires. +setNotAfter :: X509 -> UTCTime -> IO () +setNotAfter x509 utc + = withX509Ptr x509 $ \ x509Ptr -> + withASN1Time utc $ \ time -> + _set_notAfter x509Ptr time + >>= failIf (/= 1) + >> return () + +-- |@'getPublicKey' cert@ returns the public key of the subject of +-- certificate. +getPublicKey :: X509 -> IO SomePublicKey +getPublicKey x509 + = withX509Ptr x509 $ \ x509Ptr -> + fmap fromJust ( _get_pubkey x509Ptr + >>= failIfNull + >>= wrapPKeyPtr + >>= fromPKey + ) + +-- |@'setPublicKey' cert pubkey@ updates the public key of the subject +-- of certificate. +setPublicKey :: PublicKey key => X509 -> key -> IO () +setPublicKey x509 key + = withX509Ptr x509 $ \ x509Ptr -> + withPKeyPtr' key $ \ pkeyPtr -> + _set_pubkey x509Ptr pkeyPtr + >>= failIf (/= 1) + >> return () + +-- |@'getSubjectEmail' cert@ returns every subject email addresses in +-- the certificate. +getSubjectEmail :: X509 -> IO [String] +getSubjectEmail x509 + = withX509Ptr x509 $ \ x509Ptr -> + do st <- _get1_email x509Ptr + list <- mapStack peekCString st + _email_free st + return list
