packages feed

HsOpenSSL 0.10.1.4 → 0.10.2

raw patch · 13 files changed

+557/−514 lines, 13 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

+ OpenSSL.Session: readPtr :: SSL -> Ptr a -> Int -> IO Int
+ OpenSSL.Session: tryReadPtr :: SSL -> Ptr a -> Int -> IO (SSLResult Int)
+ OpenSSL.Session: tryWritePtr :: SSL -> Ptr a -> Int -> IO (SSLResult ())
+ OpenSSL.Session: writePtr :: SSL -> Ptr a -> Int -> IO ()

Files

HsOpenSSL.cabal view
@@ -15,7 +15,7 @@     encourages you to use and improve the tls package instead as long     as possible.     .-Version:       0.10.1.4+Version:       0.10.2 License:       PublicDomain License-File:  COPYING Author:        Adam Langley, Mikhail Vorozhtsov, PHO, Taru Karttunen
NEWS view
@@ -1,5 +1,21 @@ -*- coding: utf-8 -*- +Changes from 0.10.1.4 to 0.10.2+-------------------------------+* Merged #9 "Add raw pointer read/write operations" by Iavor+  S. Diatchki:++  - OpenSSL.Session.readPtr+  - OpenSSL.Session.tryReadPtr+  - OpenSSL.Session.writePtr+  - OpenSSL.Session.tryWritePtr++* Fixed #8 "HsOpenSSL 0.10.1.4 won't build" reported by vcxp:++  - Workaround for broken versions of Cabal, including one that comes+    with ghc-7.0.4.++ Changes from 0.10.1.3 to 0.10.1.4 --------------------------------- * Fixed #7 "Haskell Platform 2011.4 Support", reported by stepcut:
OpenSSL/BN.hsc view
@@ -50,20 +50,20 @@ import           OpenSSL.Utils import           System.IO.Unsafe -#ifndef __GLASGOW_HASKELL__-import           Control.Monad-import           Foreign.C-#else+#ifdef __GLASGOW_HASKELL__ import           Foreign.C.Types import           GHC.Base-#if __GLASGOW_HASKELL__ < 612+#  if MIN_VERSION_integer_gmp(0,2,0)+import           GHC.Integer.GMP.Internals+#  else import           GHC.Num import           GHC.Prim import           GHC.Integer.Internals import           GHC.IOBase (IO(..))+#  endif #else-import           GHC.Integer.GMP.Internals-#endif+import           Control.Monad+import           Foreign.C #endif  -- |'BigNum' is an opaque object representing a big number.@@ -282,11 +282,11 @@   BS.useAsCStringLen mpi (\(ptr, len) -> do     _mpi2bn ptr (fromIntegral len) nullPtr) >>= return . wrapBN --- | Convert an Integer to an MPI. SEe bnToMPI for the format+-- | Convert an Integer to an MPI. See bnToMPI for the format integerToMPI :: Integer -> IO BS.ByteString integerToMPI v = bracket (integerToBN v) (_free . unwrapBN) bnToMPI --- | Convert an MPI to an Integer. SEe bnToMPI for the format+-- | Convert an MPI to an Integer. See bnToMPI for the format mpiToInteger :: BS.ByteString -> IO Integer mpiToInteger mpi = do   bn <- mpiToBN mpi
+ OpenSSL/DH.hs view
@@ -0,0 +1,98 @@+{-# LANGUAGE CPP #-}+-- | Diffie-Hellman key exchange+module OpenSSL.DH+    ( DHP+    , DH+    , DHGen(..)+    , genDHParams+    , getDHLength+    , checkDHParams+    , genDH+    , getDHParams+    , getDHPublicKey+    , computeDHKey+    )+    where+import Data.Word (Word8)+import Data.ByteString (ByteString)+import qualified Data.ByteString.Internal as BS+import Control.Applicative ((<$>))+import Foreign.Ptr (Ptr, nullPtr)+#if MIN_VERSION_base(4,5,0)+import Foreign.C.Types (CInt(..))+#else+import Foreign.C.Types (CInt)+#endif+import Foreign.Marshal.Alloc (alloca)+import OpenSSL.BN+import OpenSSL.DH.Internal+import OpenSSL.Utils++data DHGen = DHGen2+           | DHGen5+           deriving (Eq, Ord, Show)++-- | @'genDHParams' gen n@ generates @n@-bit long DH parameters.+genDHParams :: DHGen -> Int -> IO DHP+genDHParams gen len = do+    _DH_generate_parameters (fromIntegral len) gen' nullPtr nullPtr+      >>= failIfNull+      >>= wrapDHPPtr+  where gen' = case gen of+                 DHGen2 -> 2+                 DHGen5 -> 5++-- | Get DH parameters length (in bits).+getDHLength :: DHP -> IO Int+getDHLength dh = fromIntegral <$> withDHPPtr dh _DH_length++-- | Check that DH parameters are coherent.+checkDHParams :: DHP -> IO Bool+checkDHParams dh = alloca $ \pErr ->+                     withDHPPtr dh $ \dhPtr -> _DH_check dhPtr pErr++-- | The first step of a key exchange. Public and private keys are generated.+genDH :: DHP -> IO DH+genDH dh = do+  dh' <- withDHPPtr dh _DH_dup >>= failIfNull >>= wrapDHPPtr+  withDHPPtr dh' _DH_generate_key >>= failIf_ (/= 1)+  return $ asDH dh'++-- | Get parameters of a key exchange.+getDHParams :: DH -> DHP+getDHParams = asDHP++-- | Get the public key.+getDHPublicKey :: DH -> IO Integer+getDHPublicKey dh =+  withDHPtr dh $ \dhPtr -> do+    pKey <- _DH_get_pub_key dhPtr+    bnToInteger (wrapBN pKey)++-- | Compute the shared key using the other party's public key.+computeDHKey :: DH -> Integer -> IO ByteString+computeDHKey dh pubKey =+  withDHPtr dh $ \dhPtr ->+    withBN pubKey $ \bn -> do+      size <- fromIntegral <$> _DH_size dhPtr+      BS.createAndTrim size $ \bsPtr ->+        fromIntegral <$> _DH_compute_key bsPtr (unwrapBN bn) dhPtr+          >>= failIf (< 0)++foreign import ccall "DH_generate_parameters"+  _DH_generate_parameters :: CInt -> CInt -> Ptr () -> Ptr () -> IO (Ptr DH_)+foreign import ccall "DH_generate_key"+  _DH_generate_key :: Ptr DH_ -> IO CInt+foreign import ccall "DH_compute_key"+  _DH_compute_key :: Ptr Word8 -> Ptr BIGNUM -> Ptr DH_ -> IO CInt+foreign import ccall "DH_check"+  _DH_check :: Ptr DH_ -> Ptr CInt -> IO Bool+foreign import ccall unsafe "DH_size"+  _DH_size :: Ptr DH_ -> IO CInt+foreign import ccall unsafe "HsOpenSSL_DHparams_dup"+  _DH_dup :: Ptr DH_ -> IO (Ptr DH_)+foreign import ccall unsafe "HsOpenSSL_DH_get_pub_key"+  _DH_get_pub_key :: Ptr DH_ -> IO (Ptr BIGNUM)+foreign import ccall unsafe "HsOpenSSL_DH_length"+  _DH_length :: Ptr DH_ -> IO CInt+
− OpenSSL/DH.hsc 
@@ -1,97 +0,0 @@--- | Diffie-Hellman key exchange-module OpenSSL.DH-    ( DHP-    , DH-    , DHGen(..)-    , genDHParams-    , getDHLength-    , checkDHParams-    , genDH-    , getDHParams-    , getDHPublicKey-    , computeDHKey-    )-    where-import Data.Word (Word8)-import Data.ByteString (ByteString)-import qualified Data.ByteString.Internal as BS-import Control.Applicative ((<$>))-import Foreign.Ptr (Ptr, nullPtr)-#if __GLASGOW_HASKELL__ >= 703-import Foreign.C.Types (CInt(..))-#else-import Foreign.C.Types (CInt)-#endif-import Foreign.Marshal.Alloc (alloca)-import OpenSSL.BN-import OpenSSL.DH.Internal-import OpenSSL.Utils--data DHGen = DHGen2-           | DHGen5-           deriving (Eq, Ord, Show)---- | @'genDHParams' gen n@ generates @n@-bit long DH parameters.-genDHParams :: DHGen -> Int -> IO DHP-genDHParams gen len = do-    _DH_generate_parameters (fromIntegral len) gen' nullPtr nullPtr-      >>= failIfNull-      >>= wrapDHPPtr-  where gen' = case gen of-                 DHGen2 -> 2-                 DHGen5 -> 5---- | Get DH parameters length (in bits).-getDHLength :: DHP -> IO Int-getDHLength dh = fromIntegral <$> withDHPPtr dh _DH_length---- | Check that DH parameters are coherent.-checkDHParams :: DHP -> IO Bool-checkDHParams dh = alloca $ \pErr ->-                     withDHPPtr dh $ \dhPtr -> _DH_check dhPtr pErr---- | The first step of a key exchange. Public and private keys are generated.-genDH :: DHP -> IO DH-genDH dh = do-  dh' <- withDHPPtr dh _DH_dup >>= failIfNull >>= wrapDHPPtr-  withDHPPtr dh' _DH_generate_key >>= failIf_ (/= 1)-  return $ asDH dh'---- | Get parameters of a key exchange.-getDHParams :: DH -> DHP-getDHParams = asDHP---- | Get the public key.-getDHPublicKey :: DH -> IO Integer-getDHPublicKey dh =-  withDHPtr dh $ \dhPtr -> do-    pKey <- _DH_get_pub_key dhPtr-    bnToInteger (wrapBN pKey)---- | Compute the shared key using the other party's public key.-computeDHKey :: DH -> Integer -> IO ByteString-computeDHKey dh pubKey =-  withDHPtr dh $ \dhPtr ->-    withBN pubKey $ \bn -> do-      size <- fromIntegral <$> _DH_size dhPtr-      BS.createAndTrim size $ \bsPtr ->-        fromIntegral <$> _DH_compute_key bsPtr (unwrapBN bn) dhPtr-          >>= failIf (< 0)--foreign import ccall "DH_generate_parameters"-  _DH_generate_parameters :: CInt -> CInt -> Ptr () -> Ptr () -> IO (Ptr DH_)-foreign import ccall "DH_generate_key"-  _DH_generate_key :: Ptr DH_ -> IO CInt-foreign import ccall "DH_compute_key"-  _DH_compute_key :: Ptr Word8 -> Ptr BIGNUM -> Ptr DH_ -> IO CInt-foreign import ccall "DH_check"-  _DH_check :: Ptr DH_ -> Ptr CInt -> IO Bool-foreign import ccall unsafe "DH_size"-  _DH_size :: Ptr DH_ -> IO CInt-foreign import ccall unsafe "HsOpenSSL_DHparams_dup"-  _DH_dup :: Ptr DH_ -> IO (Ptr DH_)-foreign import ccall unsafe "HsOpenSSL_DH_get_pub_key"-  _DH_get_pub_key :: Ptr DH_ -> IO (Ptr BIGNUM)-foreign import ccall unsafe "HsOpenSSL_DH_length"-  _DH_length :: Ptr DH_ -> IO CInt-
OpenSSL/DSA.hsc view
@@ -40,9 +40,6 @@ import           Foreign.C.Types import           OpenSSL.BN import           OpenSSL.Utils-#if !(defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 612)-import           System.IO.Unsafe-#endif  -- | The type of a DSA public key, includes parameters p, q, g and public. newtype DSAPubKey = DSAPubKey (ForeignPtr DSA)
OpenSSL/EVP/Internal.hsc view
@@ -1,4 +1,4 @@-module OpenSSL.EVP.Internal ( +module OpenSSL.EVP.Internal (     Cipher(..),     EVP_CIPHER,     withCipherPtr,@@ -51,7 +51,7 @@ import Control.Applicative ((<$>)) import Control.Exception (mask, mask_, bracket_, onException) import Foreign.C.Types (CChar)-#if __GLASGOW_HASKELL__ >= 703+#if MIN_VERSION_base(4,5,0) import Foreign.C.Types (CInt(..), CUInt(..), CSize(..)) #else import Foreign.C.Types (CInt, CUInt, CSize)@@ -306,4 +306,3 @@  touchPKey :: VaguePKey -> IO () touchPKey (VaguePKey pkey) = touchForeignPtr pkey-
OpenSSL/RSA.hsc view
@@ -37,9 +37,6 @@ import           Foreign.C import           OpenSSL.BN import           OpenSSL.Utils-#if !(defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__)-import           System.IO.Unsafe-#endif  -- |@'RSAPubKey'@ is an opaque object that represents RSA public key. newtype RSAPubKey  = RSAPubKey (ForeignPtr RSA)
OpenSSL/Session.hsc view
@@ -34,8 +34,12 @@   , tryConnect   , read   , tryRead+  , readPtr+  , tryReadPtr   , write   , tryWrite+  , writePtr+  , tryWritePtr   , lazyRead   , lazyWrite   , shutdown@@ -444,6 +448,17 @@                               WantWrite -> return (0,              0, WantWrite )          return $ bs <$ result +-- | Read some data into a raw pointer buffer.+-- Retrns the number of bytes read.+readPtr :: SSL -> Ptr a -> Int -> IO Int+readPtr ssl ptr len = sslBlock (\h -> tryReadPtr h ptr len) ssl++-- | Try to read some data into a raw pointer buffer, without blocking.+tryReadPtr :: SSL -> Ptr a -> Int -> IO (SSLResult Int)+tryReadPtr ssl bufPtr nBytes =+  fmap (fmap fromIntegral) (sslIOInner "SSL_read" _ssl_read (castPtr bufPtr) nBytes ssl)++ foreign import ccall "SSL_write" _ssl_write :: Ptr SSL_ -> Ptr Word8 -> CInt -> IO CInt  -- | Write a given ByteString to the SSL connection. Either all the data is@@ -456,13 +471,24 @@ tryWrite ssl bs     | B.null bs = return $ SSLDone ()     | otherwise-        = B.unsafeUseAsCStringLen bs $ \(ptr, len) ->-          do result <- sslIOInner "SSL_write" _ssl_write ptr len ssl-             case result of-               SSLDone 0 -> ioError $ errnoToIOError "SSL_write" ePIPE Nothing Nothing-               SSLDone _ -> return $ SSLDone ()-               WantRead  -> return WantRead-               WantWrite -> return WantWrite+        = B.unsafeUseAsCStringLen bs $ \(ptr, len) -> tryWritePtr ssl ptr len++-- | Send some data from a raw pointer buffer.+writePtr :: SSL -> Ptr a -> Int -> IO ()+writePtr ssl ptr len = sslBlock (\h -> tryWritePtr h ptr len) ssl >> return ()++-- | Send some data from a raw pointer buffer, without blocking.+tryWritePtr :: SSL -> Ptr a -> Int -> IO (SSLResult ())+tryWritePtr ssl ptr len =+  do result <- sslIOInner "SSL_write" _ssl_write (castPtr ptr) len ssl+     case result of+       SSLDone 0 -> ioError $ errnoToIOError "SSL_write" ePIPE Nothing Nothing+       SSLDone _ -> return $ SSLDone ()+       WantRead  -> return WantRead+       WantWrite -> return WantWrite+++  -- | Lazily read all data until reaching EOF. If the connection dies --   without a graceful SSL shutdown, an exception is raised.
OpenSSL/Utils.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE CPP #-} module OpenSSL.Utils     ( failIfNull     , failIfNull_@@ -10,14 +9,12 @@     , peekCStringCLen     )     where--import           Foreign-import           Foreign.C-import           OpenSSL.ERR-import           Data.List (unfoldr)-#if !(defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__)-import           Data.Bits ((.&.), (.|.), shiftR, shiftL)-#endif+import Foreign.C.String+import Foreign.C.Types+import Foreign.Ptr+import OpenSSL.ERR+import Data.Bits+import Data.List  failIfNull :: Ptr a -> IO (Ptr a) failIfNull ptr@@ -96,7 +93,6 @@   byteHex 'E' = 14   byteHex 'F' = 15   byteHex _   = undefined-  peekCStringCLen :: (Ptr CChar, CInt) -> IO String peekCStringCLen (p, n)
+ OpenSSL/X509.hs view
@@ -0,0 +1,382 @@+{-# LANGUAGE CPP #-}+{-# 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++    , 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++-- |@'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++-- |@'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++-- |@'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
− OpenSSL/X509.hsc 
@@ -1,381 +0,0 @@-{-# 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--    , 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---- |@'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---- |@'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---- |@'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
cbits/HsOpenSSL.h view
@@ -20,6 +20,16 @@ #include <openssl/x509v3.h> #include <openssl/dsa.h> +/* A dirty hack to work around for broken versions of Cabal:+ * https://github.com/phonohawk/HsOpenSSL/issues/8+ *+ * The trick is to abuse the fact that -Icbits is always passed to+ * hsc2hs so we can reach the cabal_macros.h from cbits.+ */+#if !defined(MIN_VERSION_base)+#  include "../dist/build/autogen/cabal_macros.h"+#endif+ /* OpenSSL ********************************************************************/ void HsOpenSSL_OpenSSL_add_all_algorithms(); void HsOpenSSL_OPENSSL_free(void* ptr);