HsOpenSSL 0.5.2 → 0.6

raw patch · 22 files changed

+908/−354 lines, 22 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• HsOpenSSL.cabal +8/−8
• NEWS +77/−0
• OpenSSL.hsc +2/−2
• OpenSSL/BN.hsc +1/−1
• OpenSSL/DSA.hsc +234/−94
• OpenSSL/EVP/Open.hsc +11/−8
• OpenSSL/EVP/PKey.hsc +233/−65
• OpenSSL/EVP/Seal.hsc +23/−23
• OpenSSL/EVP/Sign.hsc +14/−11
• OpenSSL/EVP/Verify.hsc +14/−11
• OpenSSL/PEM.hsc +19/−14
• OpenSSL/PKCS7.hsc +10/−8
• OpenSSL/RSA.hsc +182/−56
• OpenSSL/X509.hsc +18/−13
• OpenSSL/X509/Request.hsc +14/−9
• OpenSSL/X509/Revocation.hsc +9/−8
• cbits/HsOpenSSL.c +20/−0
• cbits/HsOpenSSL.h +2/−0
• examples/GenRSAKey.hs +8/−15
• examples/HelloWorld.hs +3/−3
• examples/Makefile +2/−1
• examples/PKCS7.hs +4/−4

@@ -1,11 +1,11 @@ Name: HsOpenSSL-Synopsis: (Part of) OpenSSL binding for Haskell+Synopsis: (Incomplete) OpenSSL binding for Haskell Description:-        HsOpenSSL is a (part of) OpenSSL binding for Haskell. It can-        generate RSA and DSA keys, read and write PEM files, generate-        message digests, sign and verify messages, encrypt and decrypt-        messages.-Version: 0.5.2+        HsOpenSSL is an (incomplete) OpenSSL binding for Haskell. It+        can generate RSA and DSA keys, read and write PEM files,+        generate message digests, sign and verify messages, encrypt+        and decrypt messages.+Version: 0.6 License: PublicDomain License-File: COPYING Author: Adam Langley <agl at imperialviolet.org>, PHO <pho at cielonegro.org>@@ -16,7 +16,6 @@ Tested-With: GHC == 6.10.1 Cabal-Version: >= 1.6 Build-Type: Configure- Extra-Source-Files: 	AUTHORS 	HsOpenSSL.buildinfo.in@@ -77,7 +76,8 @@           OpenSSL.X509.Name   Extensions:           ForeignFunctionInterface, EmptyDataDecls, MagicHash,-          UnboxedTuples, UnliftedFFITypes, DeriveDataTypeable+          UnboxedTuples, UnliftedFFITypes, DeriveDataTypeable,+          ExistentialQuantification, RankNTypes   ghc-options:           -Wall   C-Sources:

@@ -1,5 +1,82 @@ -*- Coding: utf-8 -*- +Changes from 0.5.2 to 0.6+-------------------------+* INCOMPATIBLE CHANGES:+    + OpenSSL.DSA:+        - The data type "DSA" is now broken into two separate types+          "DSAPubKey" and "DSAKeyPair" to distinguish between public+          keys and keypairs at type-level. These two data types are+          instances of class "DSAKey".+        - These functions are renamed to avoid name collision with+          OpenSSL.RSA:+            # generateParameters       --> generateDSAParameters+            # generateKey              --> generateDSAKey+            # generateParametersAndKey --> generateDSAParametersAndKey+            # signDigestedData         --> signDigestedDataWithDSA+            # verifyDigestedData       --> verifyDigestedDataWithDSA+        - These functions are broken into two separate functions:+            # dsaToTuple --> dsaPubKeyToTuple, dsaKeyPairToTuple+            # tupleToDSA --> tupleToDSAPubKey, tupleToDSAKeyPair+    + OpenSSL.RSA:+        - The data type "RSA" is now broken into two separate types+          "RSAPubKey" and "RSAKeyPair" to distinguish between public+          keys and keypairs at type-level. These two data types are+          instances of class "RSAKey".+    + OpenSSL.EVP.PKey:+        - The data type "PKey" is now broken into two separate+          classes, not data types, "PublicKey" and "KeyPair" to+          distinguish between public keys and keypairs at+          type-level. You can pass "RSAPubKey" and such like directly+          to cryptographic functions instead of the prior polymorphic+          type "PKey", for the sake of type classes.+    + OpenSSL.EVP.Open:+        - These functions now take "KeyPair k" instead of "PKey":+            # open+            # openBS+            # openLBS+    + OpenSSL.EVP.Seal:+        - These functions now take "SomePublicKey" instead of "PKey":+            # seal+            # sealBS+            # sealLBS+    + OpenSSL.EVP.Sign:+        - These functions now take "KeyPair k" instead of "PKey":+            # sign+            # signBS+            # signLBS+    + OpenSSL.EVP.Verify:+        - These functions now take "PublicKey k" instead of "PKey":+            # verify+            # verifyBS+            # verifyLBS+    + OpenSSL.PEM:+        - writePKCS8PrivateKey now takes "KeyPair k" instead of "PKey".+        - readPrivateKey now returns "SomeKeyPair" instead of "PKey".+        - writePublicKey now takes "PublicKey k" instead of "PKey".+        - readPublicKey now returns "SomePublicKey" instead of "PKey".+    + OpenSSL.PKCS7:+        - pkcs7Sign now takes "KeyPair k" instead of "PKey".+        - pkcs7Decrypt now takes "KeyPair k" instead of "PKey".+    + OpenSSL.X509:+        - signX509 now takes "KeyPair k" instead of "PKey".+        - verifyX509 now takes "PublicKey k" instead of "PKey".+        - getPublicKey now returns "SomePublicKey" instead of "PKey".+        - setPublicKey now takes "PublicKey k" instead of "PKey".+    + OpenSSL.X509.Request:+        - signX509Req now takes "KeyPair k" instead of "PKey".+        - verifyX509Req now takes "PublicKey k" instead of "PKey".+        - getPublicKey now returns "SomePublicKey" instead of "PKey".+        - setPublicKey now takes "PublicKey k" instead of "PKey".+    + OpenSSL.X509.Revocation:+        - signCRL now takes "KeyPair k" instead of "PKey".+        - verifyCRL now takes "PublicKey k" instead of "PKey".+* OpenSSL.RSA:+    - RSAPubKey and RSAKeyPair are now instances of Eq, Ord and Show.+    - New function: generateRSAKey'+* OpenSSL.DSA:+    - DSAPubKey and DSAKeyPair are now instances of Eq, Ord and Show.+ Changes from 0.5.1 to 0.5.2 --------------------------- * Fixed incorrect dependency declaration in HsOpenSSL.cabal. No

@@ -1,10 +1,10 @@ {- -*- haskell -*- -} --- |HsOpenSSL is a (part of) OpenSSL binding for Haskell. It can+-- |HsOpenSSL is an (incomplete) OpenSSL binding for Haskell. It can -- generate RSA and DSA keys, read and write PEM files, generate -- message digests, sign and verify messages, encrypt and decrypt -- messages.  But since OpenSSL is a very large library, it is uneasy--- to cover everything in it.+-- to cover every parts of it. -- -- Features that aren't (yet) supported: --

@@ -187,7 +187,7 @@ -- | This is a GHC specific, fast conversion between Integers and OpenSSL --   bignums. It returns a malloced BigNum. integerToBN :: Integer -> IO BigNum-integerToBN 0 = do+integerToBN (S## 0##) = do   bnptr <- mallocBytes (#size BIGNUM)   (#poke BIGNUM, d) bnptr nullPtr   -- This is needed to give GHC enough type information

@@ -9,84 +9,156 @@  module OpenSSL.DSA     ( -- * Type-      DSA-    , DSA_ -- private-    , withDSAPtr -- private+      DSAKey(..)+    , DSAPubKey+    , DSAKeyPair+    , DSA -- private        -- * Key and parameter generation-    , generateParameters-    , generateKey-    , generateParametersAndKey+    , generateDSAParameters+    , generateDSAKey+    , generateDSAParametersAndKey        -- * Signing and verification-    , signDigestedData-    , verifyDigestedData+    , signDigestedDataWithDSA+    , verifyDigestedDataWithDSA        -- * Extracting fields of DSA objects-    , dsaP-    , dsaQ-    , dsaG     , dsaPrivate-    , dsaPublic-    , dsaToTuple-    , tupleToDSA+    , dsaPubKeyToTuple+    , dsaKeyPairToTuple+    , tupleToDSAPubKey+    , tupleToDSAKeyPair     ) where  import           Control.Monad+import qualified Data.ByteString as BS+import           Data.Typeable import           Foreign import           Foreign.C (CString) import           Foreign.C.Types import           OpenSSL.BN import           OpenSSL.Utils-import qualified Data.ByteString as BS+import           System.IO.Unsafe --- | The type of a DSA key, includes parameters p, q, g.-newtype DSA = DSA (ForeignPtr DSA_)+-- | The type of a DSA public key, includes parameters p, q, g and public.+newtype DSAPubKey = DSAPubKey (ForeignPtr DSA)+    deriving Typeable -data DSA_+-- | The type of a DSA keypair, includes parameters p, q, g, public and private.+newtype DSAKeyPair = DSAKeyPair (ForeignPtr DSA)+    deriving Typeable +-- DSAPubKey and DSAKeyPair are in fact the same type at the OpenSSL+-- level, but we want to treat them differently for type-safety.+data DSA++-- |@'DSAKey' a@ is either 'DSAPubKey' or 'DSAKeyPair'.+class DSAKey k where+    -- |Return the length of key.+    dsaSize :: k -> Int+    dsaSize dsa+        = unsafePerformIO $+          withDSAPtr dsa $ \ dsaPtr ->+              _size dsaPtr >>= return . fromIntegral++    -- |Return the public prime number of the key.+    dsaP :: k -> Integer+    dsaP = peekI (#peek DSA, p)++    -- |Return the public 160-bit subprime, @q | p - 1@ of the key.+    dsaQ :: k -> Integer+    dsaQ = peekI (#peek DSA, q)++    -- |Return the public generator of subgroup of the key.+    dsaG :: k -> Integer+    dsaG = peekI (#peek DSA, g)++    -- |Return the public key @y = g^x@.+    dsaPublic :: k -> Integer+    dsaPublic = peekI (#peek DSA, pub_key)++    -- private+    withDSAPtr   :: k -> (Ptr DSA -> IO a) -> IO a+    peekDSAPtr   :: Ptr DSA -> IO (Maybe k)+    absorbDSAPtr :: Ptr DSA -> IO (Maybe k)+++instance DSAKey DSAPubKey where+    withDSAPtr (DSAPubKey fp) = withForeignPtr fp+    peekDSAPtr dsaPtr         = _pubDup dsaPtr >>= absorbDSAPtr+    absorbDSAPtr dsaPtr       = newForeignPtr _free dsaPtr >>= return . Just . DSAPubKey+++instance DSAKey DSAKeyPair where+    withDSAPtr (DSAKeyPair fp) = withForeignPtr fp+    peekDSAPtr dsaPtr+        = do hasP <- hasDSAPrivateKey dsaPtr+             if hasP then+                 _privDup dsaPtr >>= absorbDSAPtr+               else+                 return Nothing+    absorbDSAPtr dsaPtr+        = do hasP <- hasDSAPrivateKey dsaPtr+             if hasP then+                 newForeignPtr _free dsaPtr >>= return . Just . DSAKeyPair+               else+                 return Nothing+++hasDSAPrivateKey :: Ptr DSA -> IO Bool+hasDSAPrivateKey dsaPtr+    = (#peek DSA, priv_key) dsaPtr >>= return . (/= nullPtr)++ foreign import ccall unsafe "&DSA_free"-        _free :: FunPtr (Ptr DSA_ -> IO ())+        _free :: FunPtr (Ptr DSA -> IO ())  foreign import ccall unsafe "DSA_free"-        dsa_free :: Ptr DSA_ -> IO ()+        dsa_free :: Ptr DSA -> IO ()  foreign import ccall unsafe "BN_free"         _bn_free :: Ptr BIGNUM -> IO ()  foreign import ccall unsafe "DSA_new"-        _dsa_new :: IO (Ptr DSA_)+        _dsa_new :: IO (Ptr DSA)  foreign import ccall unsafe "DSA_generate_key"-        _dsa_generate_key :: Ptr DSA_ -> IO ()+        _dsa_generate_key :: Ptr DSA -> IO ()  foreign import ccall unsafe "HsOpenSSL_dsa_sign"-        _dsa_sign :: Ptr DSA_ -> CString -> CInt -> Ptr (Ptr BIGNUM) -> Ptr (Ptr BIGNUM) -> IO CInt+        _dsa_sign :: Ptr DSA -> CString -> CInt -> Ptr (Ptr BIGNUM) -> Ptr (Ptr BIGNUM) -> IO CInt  foreign import ccall unsafe "HsOpenSSL_dsa_verify"-        _dsa_verify :: Ptr DSA_ -> CString -> CInt -> Ptr BIGNUM -> Ptr BIGNUM -> IO CInt--withDSAPtr :: DSA -> (Ptr DSA_ -> IO a) -> IO a-withDSAPtr (DSA ptr) = withForeignPtr ptr+        _dsa_verify :: Ptr DSA -> CString -> CInt -> Ptr BIGNUM -> Ptr BIGNUM -> IO CInt  foreign import ccall safe "DSA_generate_parameters"-        _generate_params :: CInt -> Ptr CChar -> CInt -> Ptr CInt -> Ptr CInt -> Ptr () -> Ptr () -> IO (Ptr DSA_)+        _generate_params :: CInt -> Ptr CChar -> CInt -> Ptr CInt -> Ptr CInt -> Ptr () -> Ptr () -> IO (Ptr DSA) -peekDSA :: (Ptr DSA_ -> IO (Ptr BIGNUM)) -> DSA -> IO (Maybe Integer)-peekDSA peeker (DSA dsa) = do-  withForeignPtr dsa (\ptr -> do-    bn <- peeker ptr-    if bn == nullPtr-       then return Nothing-       else peekBN (wrapBN bn) >>= return . Just)+foreign import ccall unsafe "HsOpenSSL_DSAPublicKey_dup"+        _pubDup :: Ptr DSA -> IO (Ptr DSA) +foreign import ccall unsafe "HsOpenSSL_DSAPrivateKey_dup"+        _privDup :: Ptr DSA -> IO (Ptr DSA)++foreign import ccall unsafe "DSA_size"+        _size :: Ptr DSA -> IO CInt++peekI :: DSAKey k => (Ptr DSA -> IO (Ptr BIGNUM)) -> k -> Integer+peekI peeker dsa+    = unsafePerformIO $+      withDSAPtr dsa $ \ dsaPtr ->+          do bn <- peeker dsaPtr+             when (bn == nullPtr) $ fail "peekI: got a nullPtr"+             peekBN (wrapBN bn)+ -- | Generate DSA parameters (*not* a key, but required for a key). This is a --   compute intensive operation. See FIPS 186-2, app 2. This agrees with the --   test vectors given in FIP 186-2, app 5-generateParameters :: Int  -- ^ The number of bits in the generated prime: 512 <= x <= 1024-                   -> Maybe BS.ByteString  -- ^ optional seed, its length must be 20 bytes-                   -> IO (Int, Int, Integer, Integer, Integer)  -- ^ (iteration count, generator count, p, q, g)-generateParameters nbits mseed = do+generateDSAParameters :: Int  -- ^ The number of bits in the generated prime: 512 <= x <= 1024+                      -> Maybe BS.ByteString  -- ^ optional seed, its length must be 20 bytes+                      -> IO (Int, Int, Integer, Integer, Integer)  -- ^ (iteration count, generator count, p, q, g)+generateDSAParameters nbits mseed = do   when (nbits < 512 || nbits > 1024) $ fail "Invalid DSA bit size"   alloca (\i1 -> do     alloca (\i2 -> do@@ -123,84 +195,89 @@   return (a, toHex p, toHex q, g) -} --- | Generate a new DSA key, given valid parameters-generateKey :: Integer  -- ^ p-            -> Integer  -- ^ q-            -> Integer  -- ^ g-            -> IO DSA-generateKey p q g = do+-- | Generate a new DSA keypair, given valid parameters+generateDSAKey :: Integer  -- ^ p+               -> Integer  -- ^ q+               -> Integer  -- ^ g+               -> IO DSAKeyPair+generateDSAKey p q g = do   ptr <- _dsa_new   newBN p >>= return . unwrapBN >>= (#poke DSA, p) ptr   newBN q >>= return . unwrapBN >>= (#poke DSA, q) ptr   newBN g >>= return . unwrapBN >>= (#poke DSA, g) ptr   _dsa_generate_key ptr-  newForeignPtr _free ptr >>= return . DSA---- |Return the public prime number of the key.-dsaP :: DSA -> IO (Maybe Integer)-dsaP = peekDSA (#peek DSA, p)---- |Return the public 160-bit subprime, @q | p-1@ of the key.-dsaQ :: DSA -> IO (Maybe Integer)-dsaQ = peekDSA (#peek DSA, q)---- |Return the public generator of subgroup of the key.-dsaG :: DSA -> IO (Maybe Integer)-dsaG = peekDSA (#peek DSA, g)---- |Return the public key @y = g^x@.-dsaPublic :: DSA -> IO (Maybe Integer)-dsaPublic = peekDSA (#peek DSA, pub_key)+  newForeignPtr _free ptr >>= return . DSAKeyPair  -- |Return the private key @x@.-dsaPrivate :: DSA -> IO (Maybe Integer)-dsaPrivate = peekDSA (#peek DSA, priv_key)+dsaPrivate :: DSAKeyPair -> Integer+dsaPrivate = peekI (#peek DSA, priv_key) --- | Convert a DSA object to a tuple of its members in the order p, q, g,---   public, private. If this is a public key, private will be Nothing-dsaToTuple :: DSA -> IO (Integer, Integer, Integer, Integer, Maybe Integer)-dsaToTuple dsa = do-  Just p <- peekDSA (#peek DSA, p) dsa-  Just q <- peekDSA (#peek DSA, q) dsa-  Just g <- peekDSA (#peek DSA, g) dsa-  Just pub <- peekDSA (#peek DSA, pub_key) dsa-  private <- peekDSA (#peek DSA, priv_key) dsa+-- | Convert a DSAPubKey object to a tuple of its members in the+--   order p, q, g, and public.+dsaPubKeyToTuple :: DSAKeyPair -> (Integer, Integer, Integer, Integer)+dsaPubKeyToTuple dsa+    = let p   = peekI (#peek DSA, p) dsa+          q   = peekI (#peek DSA, q) dsa+          g   = peekI (#peek DSA, g) dsa+          pub = peekI (#peek DSA, pub_key) dsa+      in+        (p, q, g, pub) -  return (p, q, g, pub, private)+-- | Convert a DSAKeyPair object to a tuple of its members in the+--   order p, q, g, public and private.+dsaKeyPairToTuple :: DSAKeyPair -> (Integer, Integer, Integer, Integer, Integer)+dsaKeyPairToTuple dsa+    = let p   = peekI (#peek DSA, p) dsa+          q   = peekI (#peek DSA, q) dsa+          g   = peekI (#peek DSA, g) dsa+          pub = peekI (#peek DSA, pub_key ) dsa+          pri = peekI (#peek DSA, priv_key) dsa+      in+        (p, q, g, pub, pri) --- | Convert a tuple of members (in the same format as from dsaToTuple) into a---   DSA object-tupleToDSA :: (Integer, Integer, Integer, Integer, Maybe Integer) -> IO DSA-tupleToDSA (p, q, g, pub, mpriv) = do+-- | Convert a tuple of members (in the same format as from+--   'dsaPubKeyToTuple') into a DSAPubKey object+tupleToDSAPubKey :: (Integer, Integer, Integer, Integer) -> DSAPubKey+tupleToDSAPubKey (p, q, g, pub) = unsafePerformIO $ do   ptr <- _dsa_new-  newBN p >>= return . unwrapBN >>= (#poke DSA, p) ptr-  newBN q >>= return . unwrapBN >>= (#poke DSA, q) ptr-  newBN g >>= return . unwrapBN >>= (#poke DSA, g) ptr+  newBN p   >>= return . unwrapBN >>= (#poke DSA, p) ptr+  newBN q   >>= return . unwrapBN >>= (#poke DSA, q) ptr+  newBN g   >>= return . unwrapBN >>= (#poke DSA, g) ptr   newBN pub >>= return . unwrapBN >>= (#poke DSA, pub_key) ptr-  case mpriv of-       Just priv -> newBN priv >>= return . unwrapBN >>= (#poke DSA, priv_key) ptr-       Nothing -> (#poke DSA, priv_key) ptr nullPtr-  newForeignPtr _free ptr >>= return . DSA+  (#poke DSA, priv_key) ptr nullPtr+  newForeignPtr _free ptr >>= return . DSAPubKey +-- | Convert a tuple of members (in the same format as from+--   'dsaPubKeyToTuple') into a DSAPubKey object+tupleToDSAKeyPair :: (Integer, Integer, Integer, Integer, Integer) -> DSAKeyPair+tupleToDSAKeyPair (p, q, g, pub, pri) = unsafePerformIO $ do+  ptr <- _dsa_new+  newBN p   >>= return . unwrapBN >>= (#poke DSA, p) ptr+  newBN q   >>= return . unwrapBN >>= (#poke DSA, q) ptr+  newBN g   >>= return . unwrapBN >>= (#poke DSA, g) ptr+  newBN pub >>= return . unwrapBN >>= (#poke DSA, pub_key ) ptr+  newBN pri >>= return . unwrapBN >>= (#poke DSA, priv_key) ptr+  newForeignPtr _free ptr >>= return . DSAKeyPair+ -- | A utility function to generate both the parameters and the key pair at the --   same time. Saves serialising and deserialising the parameters too-generateParametersAndKey :: Int  -- ^ The number of bits in the generated prime: 512 <= x <= 1024-                         -> Maybe BS.ByteString  -- ^ optional seed, its length must be 20 bytes-                         -> IO DSA-generateParametersAndKey nbits mseed = do+generateDSAParametersAndKey :: Int  -- ^ The number of bits in the generated prime: 512 <= x <= 1024+                            -> Maybe BS.ByteString  -- ^ optional seed, its length must be 20 bytes+                            -> IO DSAKeyPair+generateDSAParametersAndKey nbits mseed = do   (\x -> case mseed of               Nothing -> x (nullPtr, 0)               Just seed -> BS.useAsCStringLen seed x) (\(seedptr, seedlen) -> do     ptr <- _generate_params (fromIntegral nbits) seedptr (fromIntegral seedlen) nullPtr nullPtr nullPtr nullPtr     failIfNull ptr     _dsa_generate_key ptr-    newForeignPtr _free ptr >>= return . DSA)+    newForeignPtr _free ptr >>= return . DSAKeyPair)  -- | Sign pre-digested data. The DSA specs call for SHA1 to be used so, if you --   use anything else, YMMV. Returns a pair of Integers which, together, are --   the signature-signDigestedData :: DSA -> BS.ByteString -> IO (Integer, Integer)-signDigestedData dsa bytes = do+signDigestedDataWithDSA :: DSAKeyPair -> BS.ByteString -> IO (Integer, Integer)+signDigestedDataWithDSA dsa bytes = do   BS.useAsCStringLen bytes (\(ptr, len) -> do     alloca (\rptr -> do       alloca (\sptr -> do@@ -213,10 +290,73 @@           return (r, s)))))  -- | Verify pre-digested data given a signature.-verifyDigestedData :: DSA -> BS.ByteString -> (Integer, Integer) -> IO Bool-verifyDigestedData dsa bytes (r, s) = do+verifyDigestedDataWithDSA :: DSAKey k => k -> BS.ByteString -> (Integer, Integer) -> IO Bool+verifyDigestedDataWithDSA dsa bytes (r, s) = do   BS.useAsCStringLen bytes (\(ptr, len) -> do     withBN r (\bnR -> do       withBN s (\bnS -> do         withDSAPtr dsa (\dsaptr -> do           _dsa_verify dsaptr ptr (fromIntegral len) (unwrapBN bnR) (unwrapBN bnS) >>= return . (== 1)))))+++instance Eq DSAPubKey where+    a == b+        = dsaP      a == dsaP      b &&+          dsaQ      a == dsaQ      b &&+          dsaG      a == dsaG      b &&+          dsaPublic a == dsaPublic b++instance Eq DSAKeyPair where+    a == b+        = dsaP       a == dsaP       b &&+          dsaQ       a == dsaQ       b &&+          dsaG       a == dsaG       b &&+          dsaPublic  a == dsaPublic  b &&+          dsaPrivate a == dsaPrivate b++instance Ord DSAPubKey where+    a `compare` b+        | dsaP      a < dsaP      b = LT+        | dsaP      a > dsaP      b = GT+        | dsaQ      a < dsaQ      b = LT+        | dsaQ      a > dsaQ      b = GT+        | dsaG      a < dsaG      b = LT+        | dsaG      a > dsaG      b = GT+        | dsaPublic a < dsaPublic b = LT+        | dsaPublic a > dsaPublic b = GT+        | otherwise                 = EQ++instance Ord DSAKeyPair where+    a `compare` b+        | dsaP       a < dsaP       b = LT+        | dsaP       a > dsaP       b = GT+        | dsaQ       a < dsaQ       b = LT+        | dsaQ       a > dsaQ       b = GT+        | dsaG       a < dsaG       b = LT+        | dsaG       a > dsaG       b = GT+        | dsaPublic  a < dsaPublic  b = LT+        | dsaPublic  a > dsaPublic  b = GT+        | dsaPrivate a < dsaPrivate b = LT+        | dsaPrivate a > dsaPrivate b = GT+        | otherwise                   = EQ++instance Show DSAPubKey where+    show a+        = concat [ "DSAPubKey {"+                 , "dsaP = ", show (dsaP a), ", "+                 , "dsaQ = ", show (dsaQ a), ", "+                 , "dsaG = ", show (dsaG a), ", "+                 , "dsaPublic = ", show (dsaPublic a)+                 , "}"+                 ]++instance Show DSAKeyPair where+    show a+        = concat [ "DSAPubKey {"+                 , "dsaP = ", show (dsaP a), ", "+                 , "dsaQ = ", show (dsaQ a), ", "+                 , "dsaG = ", show (dsaG a), ", "+                 , "dsaPublic = ", show (dsaPublic a), ", "+                 , "dsaPrivate = ", show (dsaPrivate a)+                 , "}"+                 ]

@@ -30,33 +30,35 @@                   -> IO CInt  -openInit :: Cipher -> String -> String -> PKey -> IO CipherCtx+openInit :: KeyPair key => Cipher -> String -> String -> key -> IO CipherCtx openInit cipher encKey iv pkey     = do ctx <- newCtx          withCipherCtxPtr ctx $ \ ctxPtr ->              withCStringLen encKey $ \ (encKeyPtr, encKeyLen) ->                  withCString iv $ \ ivPtr ->-                     withPKeyPtr pkey $ \ pkeyPtr ->+                     withPKeyPtr' pkey $ \ pkeyPtr ->                          _OpenInit ctxPtr cipher encKeyPtr (fromIntegral encKeyLen) ivPtr pkeyPtr                               >>= failIf (== 0)          return ctx  -- |@'open'@ lazilly decrypts a stream of data. The input string -- doesn't necessarily have to be finite.-open :: Cipher -- ^ symmetric cipher algorithm to use+open :: KeyPair key =>+        Cipher -- ^ symmetric cipher algorithm to use      -> String -- ^ encrypted symmetric key to decrypt the input string      -> String -- ^ IV-     -> PKey   -- ^ private key to decrypt the symmetric key+     -> key    -- ^ private key to decrypt the symmetric key      -> String -- ^ input string to decrypt      -> String -- ^ decrypted string open cipher encKey iv pkey input     = L8.unpack $ openLBS cipher encKey iv pkey $ L8.pack input  -- |@'openBS'@ decrypts a chunk of data.-openBS :: Cipher     -- ^ symmetric cipher algorithm to use+openBS :: KeyPair key =>+          Cipher     -- ^ symmetric cipher algorithm to use        -> String     -- ^ encrypted symmetric key to decrypt the input string        -> String     -- ^ IV-       -> PKey       -- ^ private key to decrypt the symmetric key+       -> key        -- ^ private key to decrypt the symmetric key        -> B8.ByteString -- ^ input string to decrypt        -> B8.ByteString -- ^ decrypted string openBS cipher encKey iv pkey input@@ -66,10 +68,11 @@  -- |@'openLBS'@ lazilly decrypts a stream of data. The input string -- doesn't necessarily have to be finite.-openLBS :: Cipher         -- ^ symmetric cipher algorithm to use+openLBS :: KeyPair key =>+           Cipher         -- ^ symmetric cipher algorithm to use         -> String         -- ^ encrypted symmetric key to decrypt the input string         -> String         -- ^ IV-        -> PKey           -- ^ private key to decrypt the symmetric key+        -> key            -- ^ private key to decrypt the symmetric key         -> L8.ByteString -- ^ input string to decrypt         -> L8.ByteString -- ^ decrypted string openLBS cipher encKey iv pkey input

@@ -7,26 +7,24 @@ #include "HsOpenSSL.h"  module OpenSSL.EVP.PKey-    ( PKey-    , EVP_PKEY -- private--    , wrapPKeyPtr -- private-    , withPKeyPtr -- private-    , unsafePKeyToPtr -- private-    , touchPKey -- private-    , pkeySize -- private-    , pkeyDefaultMD -- private+    ( PublicKey(..)+    , KeyPair(..)+    , SomePublicKey+    , SomeKeyPair -      -- FIXME: newPKeyDSA, newPKeyDH and newPKeyECKey may be needed-#ifndef OPENSSL_NO_RSA-    , newPKeyRSA-#endif-#ifndef OPENSSL_NO_DSA-    , newPKeyDSA-#endif+    -- private+    , PKey(..)+    , EVP_PKEY+    , withPKeyPtr+    , withPKeyPtr'+    , wrapPKeyPtr+    , unsafePKeyToPtr+    , touchPKey     )     where +import           Data.Typeable+import           Data.Maybe import           Foreign import           Foreign.C import           OpenSSL.DSA@@ -34,89 +32,259 @@ import           OpenSSL.RSA import           OpenSSL.Utils --- |@PKey@ is an opaque object that represents either public key or--- public\/private keypair. The concrete algorithm of asymmetric--- cipher is hidden in the object.-newtype PKey     = PKey (ForeignPtr EVP_PKEY)+-- VaguePKey is a ForeignPtr to EVP_PKEY, that is either public key or+-- a ker pair. We can't tell which at compile time.+newtype VaguePKey = VaguePKey (ForeignPtr EVP_PKEY) data    EVP_PKEY +-- Instances of class PKey can be converted back and forth to+-- VaguePKey.+class PKey k where+    -- Wrap the key (i.g. RSA) into EVP_PKEY.+    toPKey        :: k -> IO VaguePKey +    -- Extract the concrete key from the EVP_PKEY. Returns Nothing if+    -- the type mismatches.+    fromPKey      :: VaguePKey -> IO (Maybe k)++    -- Do the same as EVP_PKEY_size().+    pkeySize      :: k -> Int++    -- Return the default digesting algorithm for the key.+    pkeyDefaultMD :: k -> IO Digest++-- |Instances of this class has at least public portion of a+-- keypair. They might or might not have the private key.+class (Eq k, Typeable k, PKey k) => PublicKey k where++    -- |Wrap an arbitrary public key into polymorphic type+    -- 'SomePublicKey'.+    fromPublicKey :: k -> SomePublicKey+    fromPublicKey = SomePublicKey++    -- |Cast from the polymorphic type 'SomePublicKey' to the concrete+    -- type. Return 'Nothing' if failed.+    toPublicKey :: SomePublicKey -> Maybe k+    toPublicKey (SomePublicKey pk) = cast pk++-- |Instances of this class has both of public and private portions of+-- a keypair.+class PublicKey a => KeyPair a where++    -- |Wrap an arbitrary keypair into polymorphic type 'SomeKeyPair'.+    fromKeyPair :: a -> SomeKeyPair+    fromKeyPair = SomeKeyPair++    -- |Cast from the polymorphic type 'SomeKeyPair' to the concrete+    -- type. Return 'Nothing' if failed.+    toKeyPair :: SomeKeyPair -> Maybe a+    toKeyPair (SomeKeyPair pk) = cast pk++-- Reconstruct the concrete public-key type from an EVP_PKEY.+withConcretePubKey :: VaguePKey -> (forall k. PublicKey k => k -> IO a) -> IO a+withConcretePubKey pk f+    = withPKeyPtr pk $ \ pkeyPtr ->+          do pkeyType <- (#peek EVP_PKEY, type) pkeyPtr :: IO CInt+             case pkeyType of+#ifndef OPENSSL_NO_RSA+               (#const EVP_PKEY_RSA)+                   -> do rsaPtr   <- _get1_RSA pkeyPtr+                         Just rsa <- absorbRSAPtr rsaPtr+                         f (rsa :: RSAPubKey)+#endif+#ifndef OPENSSL_NO_DSA+               (#const EVP_PKEY_DSA)+                   -> do dsaPtr   <- _get1_DSA pkeyPtr+                         Just dsa <- absorbDSAPtr dsaPtr+                         f (dsa :: DSAPubKey)+#endif+               _   -> fail ("withConcretePubKey: unsupported EVP_PKEY type: " ++ show pkeyType)++-- Reconstruct the concrete keypair type from an EVP_PKEY.+withConcreteKeyPair :: VaguePKey -> (forall k. KeyPair k => k -> IO a) -> IO a+withConcreteKeyPair pk f+    = withPKeyPtr pk $ \ pkeyPtr ->+          do pkeyType <- (#peek EVP_PKEY, type) pkeyPtr :: IO CInt+             case pkeyType of+#ifndef OPENSSL_NO_RSA+               (#const EVP_PKEY_RSA)+                   -> do rsaPtr   <- _get1_RSA pkeyPtr+                         Just rsa <- absorbRSAPtr rsaPtr+                         f (rsa :: RSAKeyPair)+#endif+#ifndef OPENSSL_NO_DSA+               (#const EVP_PKEY_DSA)+                   -> do dsaPtr   <- _get1_DSA pkeyPtr+                         Just dsa <- absorbDSAPtr dsaPtr+                         f (dsa :: DSAKeyPair)+#endif+               _   -> fail ("withConcreteKeyPair: unsupported EVP_PKEY type: " ++ show pkeyType)+++-- |This is an opaque type to hold an arbitrary public key in it. The+-- actual key type can be safelly type-casted using 'toPublicKey'.+data SomePublicKey = forall k. PublicKey k => SomePublicKey !k+    deriving Typeable++instance Eq SomePublicKey where+    (SomePublicKey a) == (SomePublicKey b)+        = case cast b of+            Just c  -> a == c+            Nothing -> False  -- different types++instance PublicKey SomePublicKey where+    fromPublicKey = id+    toPublicKey   = Just++instance PKey SomePublicKey where+    toPKey        (SomePublicKey k) = toPKey k+    pkeySize      (SomePublicKey k) = pkeySize k+    pkeyDefaultMD (SomePublicKey k) = pkeyDefaultMD k+    fromPKey pk+        = withConcretePubKey pk (return . Just . SomePublicKey)+++-- |This is an opaque type to hold an arbitrary keypair in it. The+-- actual key type can be safelly type-casted using 'toKeyPair'.+data SomeKeyPair = forall k. KeyPair k => SomeKeyPair !k+    deriving Typeable++instance Eq SomeKeyPair where+    (SomeKeyPair a) == (SomeKeyPair b)+        = case cast b of+            Just c  -> a == c+            Nothing -> False++instance PublicKey SomeKeyPair where+    -- Cast the keypair to a public key, hiding its private part.+    fromPublicKey (SomeKeyPair k)+        = SomePublicKey k++    -- It's impossible to cast a public key to a keypair.+    toPublicKey _ = Nothing++instance KeyPair SomeKeyPair where+    fromKeyPair = id+    toKeyPair   = Just++instance PKey SomeKeyPair where+    toPKey        (SomeKeyPair k) = toPKey k+    pkeySize      (SomeKeyPair k) = pkeySize k+    pkeyDefaultMD (SomeKeyPair k) = pkeyDefaultMD k+    fromPKey pk+        = withConcreteKeyPair pk (return . Just . SomeKeyPair)++ foreign import ccall unsafe "EVP_PKEY_new"         _pkey_new :: IO (Ptr EVP_PKEY)  foreign import ccall unsafe "&EVP_PKEY_free"         _pkey_free :: FunPtr (Ptr EVP_PKEY -> IO ()) -foreign import ccall unsafe "EVP_PKEY_size"-        _pkey_size :: Ptr EVP_PKEY -> IO CInt --wrapPKeyPtr :: Ptr EVP_PKEY -> IO PKey-wrapPKeyPtr pkeyPtr-    = newForeignPtr _pkey_free pkeyPtr >>= return . PKey+wrapPKeyPtr :: Ptr EVP_PKEY -> IO VaguePKey+wrapPKeyPtr ptr+    = newForeignPtr _pkey_free ptr >>= return . VaguePKey  -withPKeyPtr :: PKey -> (Ptr EVP_PKEY -> IO a) -> IO a-withPKeyPtr (PKey pkey) = withForeignPtr pkey+withPKeyPtr' :: PKey k => k -> (Ptr EVP_PKEY -> IO a) -> IO a+withPKeyPtr' k f = do pk <- toPKey k+                      withPKeyPtr pk f  -unsafePKeyToPtr :: PKey -> Ptr EVP_PKEY-unsafePKeyToPtr (PKey pkey) = unsafeForeignPtrToPtr pkey+withPKeyPtr :: VaguePKey -> (Ptr EVP_PKEY -> IO a) -> IO a+withPKeyPtr (VaguePKey pkey) = withForeignPtr pkey  -touchPKey :: PKey -> IO ()-touchPKey (PKey pkey) = touchForeignPtr pkey+unsafePKeyToPtr :: VaguePKey -> Ptr EVP_PKEY+unsafePKeyToPtr (VaguePKey pkey) = unsafeForeignPtrToPtr pkey  -pkeySize :: PKey -> IO Int-pkeySize pkey-    = withPKeyPtr pkey $ \ pkeyPtr ->-      _pkey_size pkeyPtr >>= return . fromIntegral+touchPKey :: VaguePKey -> IO ()+touchPKey (VaguePKey pkey) = touchForeignPtr pkey  -pkeyDefaultMD :: PKey -> IO Digest-pkeyDefaultMD pkey-    = withPKeyPtr pkey $ \ pkeyPtr ->-      do pkeyType   <- (#peek EVP_PKEY, type) pkeyPtr :: IO CInt-         digestName <- case pkeyType of #ifndef OPENSSL_NO_RSA-                         (#const EVP_PKEY_RSA) -> return "sha1"-#endif-#ifndef OPENSSLNO_DSA-                         (#const EVP_PKEY_DSA) -> return "dss1"-#endif-                         _ -> fail ("pkeyDefaultMD: unsupported pkey type: " ++ show pkeyType)-         mDigest <- getDigestByName digestName-         case mDigest of-           Just digest -> return digest-           Nothing     -> fail ("pkeyDefaultMD: digest method not found: " ++ digestName)-+-- The resulting Ptr RSA must be freed by caller.+foreign import ccall unsafe "EVP_PKEY_get1_RSA"+        _get1_RSA :: Ptr EVP_PKEY -> IO (Ptr RSA) -#ifndef OPENSSL_NO_RSA foreign import ccall unsafe "EVP_PKEY_set1_RSA"-        _set1_RSA :: Ptr EVP_PKEY -> Ptr RSA_ -> IO CInt+        _set1_RSA :: Ptr EVP_PKEY -> Ptr RSA -> IO CInt --- |@'newPKeyRSA' rsa@ encapsulates an RSA key into 'PKey'.-newPKeyRSA :: RSA -> PKey-newPKeyRSA rsa-    = unsafePerformIO $-      withRSAPtr rsa $ \ rsaPtr ->++rsaToPKey :: RSAKey k => k -> IO VaguePKey+rsaToPKey rsa+    = withRSAPtr rsa $ \ rsaPtr ->       do pkeyPtr <- _pkey_new >>= failIfNull          _set1_RSA pkeyPtr rsaPtr >>= failIf (/= 1)          wrapPKeyPtr pkeyPtr++rsaFromPKey :: RSAKey k => VaguePKey -> IO (Maybe k)+rsaFromPKey pk+        = withPKeyPtr pk $ \ pkeyPtr ->+          do pkeyType <- (#peek EVP_PKEY, type) pkeyPtr :: IO CInt+             case pkeyType of+               (#const EVP_PKEY_RSA)+                   -> do rsaPtr <- _get1_RSA pkeyPtr+                         rsaM   <- absorbRSAPtr rsaPtr+                         return rsaM+               _   -> return Nothing++instance PublicKey RSAPubKey+instance PKey RSAPubKey where+    toPKey          = rsaToPKey+    fromPKey        = rsaFromPKey+    pkeySize        = rsaSize+    pkeyDefaultMD _ = return . fromJust =<< getDigestByName "sha1"++instance KeyPair RSAKeyPair+instance PublicKey RSAKeyPair+instance PKey RSAKeyPair where+    toPKey          = rsaToPKey+    fromPKey        = rsaFromPKey+    pkeySize        = rsaSize+    pkeyDefaultMD _ = return . fromJust =<< getDigestByName "sha1" #endif   #ifndef OPENSSL_NO_DSA+foreign import ccall unsafe "EVP_PKEY_get1_DSA"+        _get1_DSA :: Ptr EVP_PKEY -> IO (Ptr DSA)+ foreign import ccall unsafe "EVP_PKEY_set1_DSA"-        _set1_DSA :: Ptr EVP_PKEY -> Ptr DSA_ -> IO CInt+        _set1_DSA :: Ptr EVP_PKEY -> Ptr DSA -> IO CInt --- |@'newPKeyDSA' dsa@ encapsulates an 'DSA' key into 'PKey'.-newPKeyDSA :: DSA -> PKey-newPKeyDSA dsa-    = unsafePerformIO $-      withDSAPtr dsa $ \ dsaPtr ->+dsaToPKey :: DSAKey k => k -> IO VaguePKey+dsaToPKey dsa+    = withDSAPtr dsa $ \ dsaPtr ->       do pkeyPtr <- _pkey_new >>= failIfNull          _set1_DSA pkeyPtr dsaPtr >>= failIf (/= 1)          wrapPKeyPtr pkeyPtr++dsaFromPKey :: DSAKey k => VaguePKey -> IO (Maybe k)+dsaFromPKey pk+        = withPKeyPtr pk $ \ pkeyPtr ->+          do pkeyType <- (#peek EVP_PKEY, type) pkeyPtr :: IO CInt+             case pkeyType of+               (#const EVP_PKEY_DSA)+                   -> do dsaPtr <- _get1_DSA pkeyPtr+                         dsaM   <- absorbDSAPtr dsaPtr+                         return dsaM+               _   -> return Nothing++instance PublicKey DSAPubKey+instance PKey DSAPubKey where+    toPKey          = dsaToPKey+    fromPKey        = dsaFromPKey+    pkeySize        = dsaSize+    pkeyDefaultMD _ = return . fromJust =<< getDigestByName "dss1"++instance KeyPair DSAKeyPair+instance PublicKey DSAKeyPair+instance PKey DSAKeyPair where+    toPKey          = dsaToPKey+    fromPKey        = dsaFromPKey+    pkeySize        = dsaSize+    pkeyDefaultMD _ = return . fromJust =<< getDigestByName "dss1" #endif

@@ -31,7 +31,7 @@                   -> IO CInt  -sealInit :: Cipher -> [PKey] -> IO (CipherCtx, [String], String)+sealInit :: Cipher -> [SomePublicKey] -> IO (CipherCtx, [String], String)  sealInit _ []     = fail "sealInit: at least one public key is required"@@ -55,7 +55,8 @@           -- [PKey] から Ptr (Ptr EVP_PKEY) を作る。後でそれぞれの          -- PKey を touchForeignPtr する事を忘れてはならない。-         pubKeysPtr <- newArray $ map unsafePKeyToPtr pubKeys+         pkeys      <- mapM toPKey pubKeys+         pubKeysPtr <- newArray $ map unsafePKeyToPtr pkeys           -- 確保した領域を解放する IO アクションを作って置く          let cleanup = do mapM_ free encKeyBufs@@ -63,7 +64,7 @@                           free encKeyBufsLenPtr                           free ivPtr                           free pubKeysPtr-                          mapM_ touchPKey pubKeys+                          mapM_ touchPKey pkeys           -- いよいよ EVP_SealInit を呼ぶ。          ret <- withCipherCtxPtr ctx $ \ ctxPtr ->@@ -81,21 +82,20 @@       nKeys :: Int       nKeys = length pubKeys -      mallocEncKeyBuf :: Storable a => PKey -> IO (Ptr a)-      mallocEncKeyBuf pubKey-          = pkeySize pubKey >>= mallocArray+      mallocEncKeyBuf :: (PKey k, Storable a) => k -> IO (Ptr a)+      mallocEncKeyBuf = mallocArray . pkeySize  -- |@'seal'@ lazilly encrypts a stream of data. The input string -- doesn't necessarily have to be finite.-seal :: Cipher        -- ^ symmetric cipher algorithm to use-     -> [PKey]        -- ^ A list of public keys to encrypt a-                      --   symmetric key. At least one public key must-                      --   be supplied. If two or more keys are given,-                      --   the symmetric key are encrypted by each-                      --   public keys so that any of the-                      --   corresponding private keys can decrypt the-                      --   message.-     -> String        -- ^ input string to encrypt+seal :: Cipher          -- ^ symmetric cipher algorithm to use+     -> [SomePublicKey] -- ^ A list of public keys to encrypt a+                        --   symmetric key. At least one public key+                        --   must be supplied. If two or more keys are+                        --   given, the symmetric key are encrypted by+                        --   each public keys so that any of the+                        --   corresponding private keys can decrypt+                        --   the message.+     -> String          -- ^ input string to encrypt      -> IO (String, [String], String) -- ^ (encrypted string, list of                                       --   encrypted asymmetric keys,                                       --   IV)@@ -104,10 +104,10 @@          return (L8.unpack output, encKeys, iv)  -- |@'sealBS'@ strictly encrypts a chunk of data.-sealBS :: Cipher     -- ^ symmetric cipher algorithm to use-       -> [PKey]     -- ^ list of public keys to encrypt a symmetric-                     --   key-       -> B8.ByteString -- ^ input string to encrypt+sealBS :: Cipher          -- ^ symmetric cipher algorithm to use+       -> [SomePublicKey] -- ^ list of public keys to encrypt a+                          --   symmetric key+       -> B8.ByteString   -- ^ input string to encrypt        -> IO (B8.ByteString, [String], String) -- ^ (encrypted string,                                             --   list of encrypted                                             --   asymmetric keys, IV)@@ -118,10 +118,10 @@  -- |@'sealLBS'@ lazilly encrypts a stream of data. The input string -- doesn't necessarily have to be finite.-sealLBS :: Cipher         -- ^ symmetric cipher algorithm to use-        -> [PKey]         -- ^ list of public keys to encrypt a-                          --   symmetric key-        -> L8.ByteString -- ^ input string to encrypt+sealLBS :: Cipher          -- ^ symmetric cipher algorithm to use+        -> [SomePublicKey] -- ^ list of public keys to encrypt a+                           --   symmetric key+        -> L8.ByteString   -- ^ input string to encrypt         -> IO (L8.ByteString, [String], String) -- ^ (encrypted                                                  --   string, list of                                                  --   encrypted

@@ -24,11 +24,11 @@         _SignFinal :: Ptr EVP_MD_CTX -> Ptr CChar -> Ptr CUInt -> Ptr EVP_PKEY -> IO CInt  -signFinal :: DigestCtx -> PKey -> IO String-signFinal ctx pkey-    = do maxLen <- pkeySize pkey+signFinal :: KeyPair k => DigestCtx -> k -> IO String+signFinal ctx k+    = do let maxLen = pkeySize k          withDigestCtxPtr ctx $ \ ctxPtr ->-             withPKeyPtr pkey $ \ pkeyPtr ->+             withPKeyPtr' k $ \ pkeyPtr ->                  allocaArray maxLen $ \ bufPtr ->                      alloca $ \ bufLenPtr ->                          do _SignFinal ctxPtr bufPtr bufLenPtr pkeyPtr@@ -40,16 +40,18 @@ -- |@'sign'@ generates a signature from a stream of data. The string -- must not contain any letters which aren't in the range of U+0000 - -- U+00FF.-sign :: Digest    -- ^ message digest algorithm to use-     -> PKey      -- ^ private key to sign the message digest+sign :: KeyPair key =>+        Digest    -- ^ message digest algorithm to use+     -> key       -- ^ private key to sign the message digest      -> String    -- ^ input string      -> IO String -- ^ the result signature sign md pkey input     = signLBS md pkey $ L8.pack input  -- |@'signBS'@ generates a signature from a chunk of data.-signBS :: Digest     -- ^ message digest algorithm to use-       -> PKey       -- ^ private key to sign the message digest+signBS :: KeyPair key =>+          Digest     -- ^ message digest algorithm to use+       -> key        -- ^ private key to sign the message digest        -> B8.ByteString -- ^ input string        -> IO String  -- ^ the result signature signBS md pkey input@@ -57,10 +59,11 @@          signFinal ctx pkey  -- |@'signLBS'@ generates a signature from a stream of data.-signLBS :: Digest         -- ^ message digest algorithm to use-        -> PKey           -- ^ private key to sign the message digest+signLBS :: KeyPair key =>+           Digest        -- ^ message digest algorithm to use+        -> key           -- ^ private key to sign the message digest         -> L8.ByteString -- ^ input string-        -> IO String      -- ^ the result signature+        -> IO String     -- ^ the result signature signLBS md pkey input     = do ctx <- digestLazily md input          signFinal ctx pkey

@@ -31,11 +31,11 @@         _VerifyFinal :: Ptr EVP_MD_CTX -> Ptr CChar -> CUInt -> Ptr EVP_PKEY -> IO CInt  -verifyFinalBS :: DigestCtx -> String -> PKey -> IO VerifyStatus-verifyFinalBS ctx sig pkey+verifyFinalBS :: PublicKey k => DigestCtx -> String -> k -> IO VerifyStatus+verifyFinalBS ctx sig k     = withDigestCtxPtr ctx $ \ ctxPtr ->       withCStringLen sig $ \ (buf, len) ->-      withPKeyPtr pkey $ \ pkeyPtr ->+      withPKeyPtr' k $ \ pkeyPtr ->       _VerifyFinal ctxPtr buf (fromIntegral len) pkeyPtr >>= interpret     where       interpret :: CInt -> IO VerifyStatus@@ -46,29 +46,32 @@ -- |@'verify'@ verifies a signature and a stream of data. The string -- must not contain any letters which aren't in the range of U+0000 - -- U+00FF.-verify :: Digest          -- ^ message digest algorithm to use+verify :: PublicKey key =>+          Digest          -- ^ message digest algorithm to use        -> String          -- ^ message signature-       -> PKey            -- ^ public key to verify the signature+       -> key             -- ^ public key to verify the signature        -> String          -- ^ input string to verify        -> IO VerifyStatus -- ^ the result of verification verify md sig pkey input     = verifyLBS md sig pkey (L8.pack input)  -- |@'verifyBS'@ verifies a signature and a chunk of data.-verifyBS :: Digest          -- ^ message digest algorithm to use+verifyBS :: PublicKey key =>+            Digest          -- ^ message digest algorithm to use          -> String          -- ^ message signature-         -> PKey            -- ^ public key to verify the signature-         -> B8.ByteString      -- ^ input string to verify+         -> key             -- ^ public key to verify the signature+         -> B8.ByteString   -- ^ input string to verify          -> IO VerifyStatus -- ^ the result of verification verifyBS md sig pkey input     = do ctx <- digestStrictly md input          verifyFinalBS ctx sig pkey  -- |@'verifyLBS'@ verifies a signature of a stream of data.-verifyLBS :: Digest          -- ^ message digest algorithm to use+verifyLBS :: PublicKey key =>+             Digest          -- ^ message digest algorithm to use           -> String          -- ^ message signature-          -> PKey            -- ^ public key to verify the signature-          -> L8.ByteString  -- ^ input string to verify+          -> key             -- ^ public key to verify the signature+          -> L8.ByteString   -- ^ input string to verify           -> IO VerifyStatus -- ^ the result of verification verifyLBS md sig pkey input     = do ctx <- digestLazily md input

@@ -37,6 +37,7 @@  import           Control.Exception hiding (try) import           Control.Monad+import           Data.Maybe import           Foreign import           Foreign.C import           OpenSSL.BIO@@ -131,13 +132,14 @@                                    -> Ptr a                                    -> IO CInt -writePKCS8PrivateKey' :: BIO-                      -> PKey+writePKCS8PrivateKey' :: KeyPair key =>+                         BIO+                      -> key                       -> Maybe (Cipher, PemPasswordSupply)                       -> IO ()-writePKCS8PrivateKey' bio pkey encryption+writePKCS8PrivateKey' bio key encryption     = withBioPtr bio   $ \ bioPtr  ->-      withPKeyPtr pkey $ \ pkeyPtr ->+      withPKeyPtr' key $ \ pkeyPtr ->       do ret <- case encryption of                   Nothing                       -> _write_bio_PKCS8PrivateKey bioPtr pkeyPtr nullPtr nullPtr 0 nullFunPtr nullPtr@@ -166,7 +168,8 @@ -- |@'writePKCS8PrivateKey'@ writes a private key to PEM string in -- PKCS#8 format. writePKCS8PrivateKey-    :: PKey      -- ^ private key to write+    :: KeyPair key =>+       key       -- ^ private key to write     -> Maybe (Cipher, PemPasswordSupply) -- ^ Either (symmetric cipher                                          --   algorithm, password                                          --   supply) or @Nothing@. If@@ -187,7 +190,7 @@                              -> Ptr ()                              -> IO (Ptr EVP_PKEY) -readPrivateKey' :: BIO -> PemPasswordSupply -> IO PKey+readPrivateKey' :: BIO -> PemPasswordSupply -> IO SomeKeyPair readPrivateKey' bio supply     = withBioPtr bio $ \ bioPtr ->       do pkeyPtr <- case supply of@@ -210,10 +213,10 @@                       PwTTY                           -> _read_bio_PrivateKey bioPtr nullPtr nullFunPtr nullPtr           failIfNull pkeyPtr-         wrapPKeyPtr pkeyPtr+         wrapPKeyPtr pkeyPtr >>= fromPKey >>= return . fromJust  -- |@'readPrivateKey' pem supply@ reads a private key in PEM string.-readPrivateKey :: String -> PemPasswordSupply -> IO PKey+readPrivateKey :: String -> PemPasswordSupply -> IO SomeKeyPair readPrivateKey pemStr supply     = do mem <- newConstMem pemStr          readPrivateKey' mem supply@@ -232,14 +235,14 @@                          -> IO (Ptr EVP_PKEY)  -writePublicKey' :: BIO -> PKey -> IO ()-writePublicKey' bio pkey+writePublicKey' :: PublicKey key => BIO -> key -> IO ()+writePublicKey' bio key     = withBioPtr bio   $ \ bioPtr  ->-      withPKeyPtr pkey $ \ pkeyPtr ->+      withPKeyPtr' key $ \ pkeyPtr ->       _write_bio_PUBKEY bioPtr pkeyPtr >>= failIf (/= 1) >> return ()  -- |@'writePublicKey' pubkey@ writes a public to PEM string.-writePublicKey :: PKey -> IO String+writePublicKey :: PublicKey key => key -> IO String writePublicKey pkey     = do mem <- newMem          writePublicKey' mem pkey@@ -247,16 +250,18 @@  -- Why the heck PEM_read_bio_PUBKEY takes pem_password_cb? Is there -- any form of encrypted public key?-readPublicKey' :: BIO -> IO PKey+readPublicKey' :: BIO -> IO SomePublicKey readPublicKey' bio     = withBioPtr bio $ \ bioPtr ->       withCString "" $ \ passPtr ->       _read_bio_PUBKEY bioPtr nullPtr nullFunPtr (castPtr passPtr)            >>= failIfNull            >>= wrapPKeyPtr+           >>= fromPKey+           >>= return . fromJust  -- |@'readPublicKey' pem@ reads a public key in PEM string.-readPublicKey :: String -> IO PKey+readPublicKey :: String -> IO SomePublicKey readPublicKey pemStr     = newConstMem pemStr >>= readPublicKey' 

@@ -129,10 +129,10 @@            >>= return . (== 1)  -pkcs7Sign' :: X509 -> PKey -> [X509] -> BIO -> [Pkcs7Flag] -> IO Pkcs7+pkcs7Sign' :: KeyPair key => X509 -> key -> [X509] -> BIO -> [Pkcs7Flag] -> IO Pkcs7 pkcs7Sign' signCert pkey certs input flagList     = withX509Ptr signCert $ \ signCertPtr ->-      withPKeyPtr pkey     $ \ pkeyPtr     ->+      withPKeyPtr' pkey    $ \ pkeyPtr     ->       withX509Stack certs  $ \ certStack   ->       withBioPtr input     $ \ inputPtr    ->       _sign signCertPtr pkeyPtr certStack inputPtr (flagListToInt flagList)@@ -140,8 +140,9 @@            >>= wrapPkcs7Ptr  -- |@'pkcs7Sign'@ creates a PKCS#7 signedData structure.-pkcs7Sign :: X509        -- ^ certificate to sign with-          -> PKey        -- ^ corresponding private key+pkcs7Sign :: KeyPair key =>+             X509        -- ^ certificate to sign with+          -> key         -- ^ corresponding private key           -> [X509]      -- ^ optional additional set of certificates                          --   to include in the PKCS#7 structure (for                          --   example any intermediate CAs in the@@ -313,10 +314,10 @@          pkcs7Encrypt' certs mem cipher flagList  -pkcs7Decrypt' :: Pkcs7 -> PKey -> X509 -> BIO -> [Pkcs7Flag] -> IO ()+pkcs7Decrypt' :: KeyPair key => Pkcs7 -> key -> X509 -> BIO -> [Pkcs7Flag] -> IO () pkcs7Decrypt' pkcs7 pkey cert output flagList     = withPkcs7Ptr pkcs7  $ \ pkcs7Ptr  ->-      withPKeyPtr  pkey   $ \ pkeyPtr   ->+      withPKeyPtr' pkey   $ \ pkeyPtr   ->       withX509Ptr  cert   $ \ certPtr   ->       withBioPtr   output $ \ outputPtr ->       _decrypt pkcs7Ptr pkeyPtr certPtr outputPtr (flagListToInt flagList)@@ -325,8 +326,9 @@  -- |@'pkcs7Decrypt'@ decrypts content from PKCS#7 envelopedData -- structure.-pkcs7Decrypt :: Pkcs7       -- ^ The PKCS#7 structure to decrypt.-             -> PKey        -- ^ The private key of the recipient.+pkcs7Decrypt :: KeyPair key =>+                Pkcs7       -- ^ The PKCS#7 structure to decrypt.+             -> key         -- ^ The private key of the recipient.              -> X509        -- ^ The recipient's certificate.              -> [Pkcs7Flag] -- ^ An optional set of flags:                             --

@@ -8,17 +8,17 @@  module OpenSSL.RSA     ( -- * Type-      RSA-    , RSA_ -- private-    , withRSAPtr -- private+      RSAKey(..)+    , RSAPubKey+    , RSAKeyPair+    , RSA -- private        -- * Generating keypair     , RSAGenKeyCallback-    , generateKey+    , generateRSAKey+    , generateRSAKey'        -- * Exploring keypair-    , rsaN-    , rsaE     , rsaD     , rsaP     , rsaQ@@ -29,25 +29,92 @@     where  import           Control.Monad+import           Data.Typeable import           Foreign import           Foreign.C import           OpenSSL.BN import           OpenSSL.Utils+import           System.IO.Unsafe --- |@'RSA'@ is an opaque object that represents either RSA public key--- or public\/private keypair.-newtype RSA  = RSA (ForeignPtr RSA_)-data    RSA_+-- |@'RSAPubKey'@ is an opaque object that represents RSA public key.+newtype RSAPubKey  = RSAPubKey (ForeignPtr RSA)+    deriving Typeable +-- |@'RSAKeyPair'@ is an opaque object that represents RSA keypair.+newtype RSAKeyPair = RSAKeyPair (ForeignPtr RSA)+    deriving Typeable +-- RSAPubKey and RSAKeyPair are in fact the same type at the OpenSSL+-- level, but we want to treat them differently for type-safety.+data RSA++-- |@'RSAKey' a@ is either 'RSAPubKey' or 'RSAKeyPair'.+class RSAKey k where+    -- |@'rsaSize' key@ returns the length of key.+    rsaSize :: k -> Int+    rsaSize rsa+        = unsafePerformIO $+          withRSAPtr rsa $ \ rsaPtr ->+              _size rsaPtr >>= return . fromIntegral++    -- |@'rsaN' key@ returns the public modulus of the key.+    rsaN :: k -> Integer+    rsaN = peekI (#peek RSA, n)++    -- |@'rsaE' key@ returns the public exponent of the key.+    rsaE :: k -> Integer+    rsaE = peekI (#peek RSA, e)++    -- private+    withRSAPtr   :: k -> (Ptr RSA -> IO a) -> IO a+    peekRSAPtr   :: Ptr RSA -> IO (Maybe k)+    absorbRSAPtr :: Ptr RSA -> IO (Maybe k)+++instance RSAKey RSAPubKey where+    withRSAPtr (RSAPubKey fp) = withForeignPtr fp+    peekRSAPtr rsaPtr         = _pubDup rsaPtr >>= absorbRSAPtr+    absorbRSAPtr rsaPtr       = newForeignPtr _free rsaPtr >>= return . Just . RSAPubKey+++instance RSAKey RSAKeyPair where+    withRSAPtr (RSAKeyPair fp) = withForeignPtr fp+    peekRSAPtr rsaPtr+        = do hasP <- hasRSAPrivateKey rsaPtr+             if hasP then+                 _privDup rsaPtr >>= absorbRSAPtr+               else+                 return Nothing+    absorbRSAPtr rsaPtr+        = do hasP <- hasRSAPrivateKey rsaPtr+             if hasP then+                 newForeignPtr _free rsaPtr >>= return . Just . RSAKeyPair+               else+                 return Nothing+++hasRSAPrivateKey :: Ptr RSA -> IO Bool+hasRSAPrivateKey rsaPtr+    = do d <- (#peek RSA, d) rsaPtr+         p <- (#peek RSA, p) rsaPtr+         q <- (#peek RSA, q) rsaPtr+         return (d /= nullPtr && p /= nullPtr && q /= nullPtr)+                                               ++ foreign import ccall unsafe "&RSA_free"-        _free :: FunPtr (Ptr RSA_ -> IO ())+        _free :: FunPtr (Ptr RSA -> IO ()) +foreign import ccall unsafe "RSAPublicKey_dup"+        _pubDup :: Ptr RSA -> IO (Ptr RSA) -withRSAPtr :: RSA -> (Ptr RSA_ -> IO a) -> IO a-withRSAPtr (RSA rsa) = withForeignPtr rsa+foreign import ccall unsafe "RSAPrivateKey_dup"+        _privDup :: Ptr RSA -> IO (Ptr RSA) +foreign import ccall unsafe "RSA_size"+        _size :: Ptr RSA -> IO CInt + {- generation --------------------------------------------------------------- -}  -- |@'RSAGenKeyCallback'@ represents a callback function to get@@ -75,79 +142,138 @@         mkGenKeyCallback :: RSAGenKeyCallback' -> IO (FunPtr RSAGenKeyCallback')  foreign import ccall safe "RSA_generate_key"-        _generate_key :: CInt -> CInt -> FunPtr RSAGenKeyCallback' -> Ptr a -> IO (Ptr RSA_)+        _generate_key :: CInt -> CInt -> FunPtr RSAGenKeyCallback' -> Ptr a -> IO (Ptr RSA) --- |@'generateKey'@ generates an RSA keypair.-generateKey :: Int    -- ^ The number of bits of the public modulus-                      --   (i.e. key size). Key sizes with @n < 1024@-                      --   should be considered insecure.-            -> Int    -- ^ The public exponent. It is an odd number,-                      --   typically 3, 17 or 65537.-            -> Maybe RSAGenKeyCallback -- ^ A callback function.-            -> IO RSA -- ^ The generated keypair.+-- |@'generateRSAKey'@ generates an RSA keypair.+generateRSAKey :: Int    -- ^ The number of bits of the public modulus+                         --   (i.e. key size). Key sizes with @n <+                         --   1024@ should be considered insecure.+               -> Int    -- ^ The public exponent. It is an odd+                         --   number, typically 3, 17 or 65537.+               -> Maybe RSAGenKeyCallback -- ^ A callback function.+               -> IO RSAKeyPair -- ^ The generated keypair. -generateKey nbits e Nothing+generateRSAKey nbits e Nothing     = do ptr <- _generate_key (fromIntegral nbits) (fromIntegral e) nullFunPtr nullPtr          failIfNull ptr-         newForeignPtr _free ptr >>= return . RSA+         newForeignPtr _free ptr >>= return . RSAKeyPair -generateKey nbits e (Just cb)+generateRSAKey nbits e (Just cb)     = do cbPtr <- mkGenKeyCallback                   $ \ arg1 arg2 _ -> cb arg1 arg2          ptr   <- _generate_key (fromIntegral nbits) (fromIntegral e) cbPtr nullPtr          freeHaskellFunPtr cbPtr          failIfNull ptr-         newForeignPtr _free ptr >>= return . RSA+         newForeignPtr _free ptr >>= return . RSAKeyPair +-- |A simplified alternative to 'generateRSAKey'+generateRSAKey' :: Int   -- ^ The number of bits of the public modulus+                         --   (i.e. key size). Key sizes with @n <+                         --   1024@ should be considered insecure.+                -> Int   -- ^ The public exponent. It is an odd+                         --   number, typically 3, 17 or 65537.+                -> IO RSAKeyPair -- ^ The generated keypair.+generateRSAKey' nbits e+    = generateRSAKey nbits e Nothing + {- exploration -------------------------------------------------------------- -} -peekRSAPublic :: (Ptr RSA_ -> IO (Ptr BIGNUM)) -> RSA -> IO Integer-peekRSAPublic peeker rsa-    = withRSAPtr rsa $ \ rsaPtr ->+peekI :: RSAKey a => (Ptr RSA -> IO (Ptr BIGNUM)) -> a -> Integer+peekI peeker rsa+    = unsafePerformIO $+      withRSAPtr rsa $ \ rsaPtr ->       do bn <- peeker rsaPtr-         when (bn == nullPtr) $ fail "peekRSAPublic: got a nullPtr"+         when (bn == nullPtr) $ fail "peekI: got a nullPtr"          peekBN (wrapBN bn) --peekRSAPrivate :: (Ptr RSA_ -> IO (Ptr BIGNUM)) -> RSA -> IO (Maybe Integer)-peekRSAPrivate peeker rsa-    = withRSAPtr rsa $ \ rsaPtr ->+peekMI :: RSAKey a => (Ptr RSA -> IO (Ptr BIGNUM)) -> a -> Maybe Integer+peekMI peeker rsa+    = unsafePerformIO $+      withRSAPtr rsa $ \ rsaPtr ->       do bn <- peeker rsaPtr          if bn == nullPtr then              return Nothing            else              peekBN (wrapBN bn) >>= return . Just --- |@'rsaN' pubKey@ returns the public modulus of the key.-rsaN :: RSA -> IO Integer-rsaN = peekRSAPublic (#peek RSA, n)---- |@'rsaE' pubKey@ returns the public exponent of the key.-rsaE :: RSA -> IO Integer-rsaE = peekRSAPublic (#peek RSA, e)---- |@'rsaD' privKey@ returns the private exponent of the key. If--- @privKey@ is not really a private key, the result is @Nothing@.-rsaD :: RSA -> IO (Maybe Integer)-rsaD = peekRSAPrivate (#peek RSA, d)+-- |@'rsaD' privKey@ returns the private exponent of the key.+rsaD :: RSAKeyPair -> Integer+rsaD = peekI (#peek RSA, d)  -- |@'rsaP' privkey@ returns the secret prime factor @p@ of the key.-rsaP :: RSA -> IO (Maybe Integer)-rsaP = peekRSAPrivate (#peek RSA, p)+rsaP :: RSAKeyPair -> Integer+rsaP = peekI (#peek RSA, p)  -- |@'rsaQ' privkey@ returns the secret prime factor @q@ of the key.-rsaQ :: RSA -> IO (Maybe Integer)-rsaQ = peekRSAPrivate (#peek RSA, q)+rsaQ :: RSAKeyPair -> Integer+rsaQ = peekI (#peek RSA, q)  -- |@'rsaDMP1' privkey@ returns @d mod (p-1)@ of the key.-rsaDMP1 :: RSA -> IO (Maybe Integer)-rsaDMP1 = peekRSAPrivate (#peek RSA, dmp1)+rsaDMP1 :: RSAKeyPair -> Maybe Integer+rsaDMP1 = peekMI (#peek RSA, dmp1)  -- |@'rsaDMQ1' privkey@ returns @d mod (q-1)@ of the key.-rsaDMQ1 :: RSA -> IO (Maybe Integer)-rsaDMQ1 = peekRSAPrivate (#peek RSA, dmq1)+rsaDMQ1 :: RSAKeyPair -> Maybe Integer+rsaDMQ1 = peekMI (#peek RSA, dmq1)  -- |@'rsaIQMP' privkey@ returns @q^-1 mod p@ of the key.-rsaIQMP :: RSA -> IO (Maybe Integer)-rsaIQMP = peekRSAPrivate (#peek RSA, iqmp)+rsaIQMP :: RSAKeyPair -> Maybe Integer+rsaIQMP = peekMI (#peek RSA, iqmp)+++{- instances ---------------------------------------------------------------- -}++instance Eq RSAPubKey where+    a == b+        = rsaN a == rsaN b &&+          rsaE a == rsaE b++instance Eq RSAKeyPair where+    a == b+        = rsaN a == rsaN b &&+          rsaE a == rsaE b &&+          rsaD a == rsaD b &&+          rsaP a == rsaP b &&+          rsaQ a == rsaQ b++instance Ord RSAPubKey where+    a `compare` b+        | rsaN a < rsaN b = LT+        | rsaN a > rsaN b = GT+        | rsaE a < rsaE b = LT+        | rsaE a > rsaE b = GT+        | otherwise       = EQ++instance Ord RSAKeyPair where+    a `compare` b+        | rsaN a < rsaN b = LT+        | rsaN a > rsaN b = GT+        | rsaE a < rsaE b = LT+        | rsaE a > rsaE b = GT+        | rsaD a < rsaD b = LT+        | rsaD a > rsaD b = GT+        | rsaP a < rsaP b = LT+        | rsaP a > rsaP b = GT+        | rsaQ a < rsaQ b = LT+        | rsaQ a > rsaQ b = GT+        | otherwise       = EQ++instance Show RSAPubKey where+    show a+        = concat [ "RSAPubKey {"+                 , "rsaN = ", show (rsaN a), ", "+                 , "rsaE = ", show (rsaE a)+                 , "}"+                 ] ++instance Show RSAKeyPair where+    show a+        = concat [ "RSAKeyPair {"+                 , "rsaN = ", show (rsaN a), ", "+                 , "rsaE = ", show (rsaE a), ", "+                 , "rsaD = ", show (rsaD a), ", "+                 , "rsaP = ", show (rsaP a), ", "+                 , "rsaQ = ", show (rsaQ a)+                 , "}"+                 ] 

@@ -52,6 +52,7 @@  import           Control.Monad import           Data.Time.Clock+import           Data.Maybe import           Foreign import           Foreign.C import           OpenSSL.ASN1@@ -187,18 +188,19 @@           | otherwise = EQ  -- |@'signX509'@ signs a certificate with an issuer private key.-signX509 :: X509         -- ^ The certificate to be signed.-         -> PKey         -- ^ The private key to sign with.+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 pkey mDigest+signX509 x509 key mDigest     = withX509Ptr x509 $ \ x509Ptr ->-      withPKeyPtr pkey $ \ pkeyPtr ->+      withPKeyPtr' key $ \ pkeyPtr ->       do digest <- case mDigest of                      Just md -> return md-                     Nothing -> pkeyDefaultMD pkey+                     Nothing -> pkeyDefaultMD key          withMDPtr digest $ \ digestPtr ->              _sign x509Ptr pkeyPtr digestPtr                   >>= failIf (== 0)@@ -206,12 +208,13 @@  -- |@'verifyX509'@ verifies a signature of certificate with an issuer -- public key.-verifyX509 :: X509 -- ^ The certificate to be verified.-           -> PKey -- ^ The public key to verify with.+verifyX509 :: PublicKey key =>+              X509 -- ^ The certificate to be verified.+           -> key  -- ^ The public key to verify with.            -> IO VerifyStatus-verifyX509 x509 pkey+verifyX509 x509 key     = withX509Ptr x509 $ \ x509Ptr ->-      withPKeyPtr pkey $ \ pkeyPtr ->+      withPKeyPtr' key $ \ pkeyPtr ->       _verify x509Ptr pkeyPtr            >>= interpret     where@@ -344,19 +347,21 @@  -- |@'getPublicKey' cert@ returns the public key of the subject of -- certificate.-getPublicKey :: X509 -> IO PKey+getPublicKey :: X509 -> IO SomePublicKey getPublicKey x509     = withX509Ptr x509 $ \ x509Ptr ->       _get_pubkey x509Ptr            >>= failIfNull            >>= wrapPKeyPtr+           >>= fromPKey+           >>= return . fromJust  -- |@'setPublicKey' cert pubkey@ updates the public key of the subject -- of certificate.-setPublicKey :: X509 -> PKey -> IO ()-setPublicKey x509 pkey+setPublicKey :: PublicKey key => X509 -> key -> IO ()+setPublicKey x509 key     = withX509Ptr x509 $ \ x509Ptr ->-      withPKeyPtr pkey $ \ pkeyPtr ->+      withPKeyPtr' key $ \ pkeyPtr ->       _set_pubkey x509Ptr pkeyPtr            >>= failIf (/= 1)            >>  return ()

@@ -34,6 +34,7 @@     where  import           Control.Monad+import           Data.Maybe import           Foreign import           Foreign.C import           OpenSSL.BIO@@ -107,15 +108,16 @@  -- |@'signX509Req'@ signs a certificate request with a subject private -- key.-signX509Req :: X509Req      -- ^ The request to be signed.-            -> PKey         -- ^ The private key to sign with.+signX509Req :: KeyPair key =>+               X509Req      -- ^ The request to be signed.+            -> key          -- ^ The private key to sign with.             -> Maybe Digest -- ^ A hashing algorithm to use. If                             --   @Nothing@ the most suitable algorithm                             --   for the key is automatically used.             -> IO () signX509Req req pkey mDigest     = withX509ReqPtr req  $ \ reqPtr  ->-      withPKeyPtr    pkey $ \ pkeyPtr ->+      withPKeyPtr'   pkey $ \ pkeyPtr ->       do digest <- case mDigest of                      Just md -> return md                      Nothing -> pkeyDefaultMD pkey@@ -126,12 +128,13 @@  -- |@'verifyX509Req'@ verifies a signature of certificate request with -- a subject public key.-verifyX509Req :: X509Req -- ^ The request to be verified.-              -> PKey    -- ^ The public key to verify with.+verifyX509Req :: PublicKey key =>+                 X509Req -- ^ The request to be verified.+              -> key     -- ^ The public key to verify with.               -> IO VerifyStatus verifyX509Req req pkey     = withX509ReqPtr req  $ \ reqPtr  ->-      withPKeyPtr    pkey $ \ pkeyPtr ->+      withPKeyPtr'   pkey $ \ pkeyPtr ->       _verify reqPtr pkeyPtr            >>= interpret     where@@ -189,19 +192,21 @@  -- |@'getPublicKey' req@ returns the public key of the subject of -- certificate request.-getPublicKey :: X509Req -> IO PKey+getPublicKey :: X509Req -> IO SomePublicKey getPublicKey req     = withX509ReqPtr req $ \ reqPtr ->       _get_pubkey reqPtr            >>= failIfNull            >>= wrapPKeyPtr+           >>= fromPKey+           >>= return . fromJust  -- |@'setPublicKey' req@ updates the public key of the subject of -- certificate request.-setPublicKey :: X509Req -> PKey -> IO ()+setPublicKey :: PublicKey key => X509Req -> key -> IO () setPublicKey req pkey     = withX509ReqPtr req  $ \ reqPtr  ->-      withPKeyPtr    pkey $ \ pkeyPtr ->+      withPKeyPtr'   pkey $ \ pkeyPtr ->       _set_pubkey reqPtr pkeyPtr            >>= failIf (/= 1)            >>  return ()

@@ -161,18 +161,19 @@ withCRLPtr (CRL crl) = withForeignPtr crl  -- |@'signCRL'@ signs a revocation list with an issuer private key.-signCRL :: CRL          -- ^ The revocation list to be signed.-        -> PKey         -- ^ The private key to sign with.+signCRL :: KeyPair key =>+           CRL          -- ^ The revocation list to be signed.+        -> key          -- ^ The private key to sign with.         -> Maybe Digest -- ^ A hashing algorithm to use. If @Nothing@                         --   the most suitable algorithm for the key                         --   is automatically used.         -> IO ()-signCRL crl pkey mDigest+signCRL crl key mDigest     = withCRLPtr crl   $ \ crlPtr  ->-      withPKeyPtr pkey $ \ pkeyPtr ->+      withPKeyPtr' key $ \ pkeyPtr ->       do digest <- case mDigest of                      Just md -> return md-                     Nothing -> pkeyDefaultMD pkey+                     Nothing -> pkeyDefaultMD key          withMDPtr digest $ \ digestPtr ->              _sign crlPtr pkeyPtr digestPtr                   >>= failIf (== 0)@@ -180,10 +181,10 @@  -- |@'verifyCRL'@ verifies a signature of revocation list with an -- issuer public key.-verifyCRL :: CRL -> PKey -> IO VerifyStatus-verifyCRL crl pkey+verifyCRL :: PublicKey key => CRL -> key -> IO VerifyStatus+verifyCRL crl key     = withCRLPtr crl   $ \ crlPtr ->-      withPKeyPtr pkey $ \ pkeyPtr ->+      withPKeyPtr' key $ \ pkeyPtr ->       _verify crlPtr pkeyPtr            >>= interpret     where

@@ -203,3 +203,23 @@   sig.s = s;   return dsa->meth->dsa_do_verify(ddata, dlen, &sig, dsa); }++#if !defined(DSAPublicKey_dup)+# define DSAPublicKey_dup(dsa)                                      \+    (DSA *)ASN1_dup((i2d_of_void *)i2d_DSAPublicKey,                \+                    (d2i_of_void *)d2i_DSAPublicKey,(char *)dsa)+#endif++#if !defined(DSAPrivateKey_dup)+#define DSAPrivateKey_dup(dsa)                                      \+    (DSA *)ASN1_dup((i2d_of_void *)i2d_DSAPrivateKey,               \+                    (d2i_of_void *)d2i_DSAPrivateKey,(char *)dsa)+#endif++DSA* HsOpenSSL_DSAPublicKey_dup(const DSA* dsa) {+    return DSAPublicKey_dup(dsa);+}++DSA* HsOpenSSL_DSAPrivateKey_dup(const DSA* dsa) {+    return DSAPrivateKey_dup(dsa);+}

@@ -68,5 +68,7 @@                        BIGNUM **r, BIGNUM **s); int HsOpenSSL_dsa_verify(DSA *dsa, const unsigned char *ddata, int len,                          BIGNUM *r, BIGNUM *s);+DSA* HsOpenSSL_DSAPublicKey_dup(const DSA* dsa);+DSA* HsOpenSSL_DSAPrivateKey_dup(const DSA* dsa);  #endif

@@ -12,7 +12,7 @@            printf "Generating RSA key-pair, nbits = %d, e = %d:\n" keyBits keyE           -          rsa  <- generateKey keyBits keyE $ Just $ \ phase _ ->+          rsa  <- generateRSAKey keyBits keyE $ Just $ \ phase _ ->                   do hPutChar stdout $ case phase of                                          0 -> '.'                                          1 -> '+'@@ -23,24 +23,17 @@            printf "Done.\n"           -          n    <- rsaN rsa-          e    <- rsaE rsa-          d    <- rsaD rsa-          p    <- rsaP rsa-          q    <- rsaQ rsa-          dmp1 <- rsaDMP1 rsa-          dmq1 <- rsaDMQ1 rsa-          iqmp <- rsaIQMP rsa+          let n    = rsaN rsa+              e    = rsaE rsa+              d    = rsaD rsa+              p    = rsaP rsa+              q    = rsaQ rsa            printf "n (public modulus) = %s\n" (show n)           printf "e (public exponent) = %s\n" (show e)           printf "d (private exponent) = %s\n" (show d)           printf "p (secret prime factor) = %s\n" (show p)           printf "q (secret prime factor) = %s\n" (show q)-          printf "dmp1 (d mod (p-1)) = %s\n" (show dmp1)-          printf "dmq1 (d mod (q-1)) = %s\n" (show dmq1)-          printf "iqmp (q^-1 mod p) = %s\n" (show iqmp) -          let pkey = newPKeyRSA rsa-          writePKCS8PrivateKey pkey Nothing >>= putStr-          writePublicKey pkey >>= putStr+          writePKCS8PrivateKey rsa Nothing >>= putStr+          writePublicKey       rsa         >>= putStr

@@ -16,7 +16,7 @@           des <- liftM fromJust $ getCipherByName "DES-CBC"            putStrLn "generating RSA keypair..."-          pkey <- liftM newPKeyRSA $ generateKey 512 65537 Nothing+          rsa <- generateRSAKey 512 65537 Nothing            let plainText = "Hello, world!"           putStrLn ("plain text to encrypt: " ++ plainText)@@ -24,7 +24,7 @@           putStrLn ""            putStrLn "encrypting..."-          (encrypted, [encKey], iv) <- seal des [pkey] plainText+          (encrypted, [encKey], iv) <- seal des [fromPublicKey rsa] plainText                      putStrLn ("encrypted symmetric key: " ++ binToHex encKey)           putStrLn ("IV: " ++ binToHex iv)@@ -33,7 +33,7 @@           putStrLn ""            putStrLn "decrypting..."-          let decrypted = open des encKey iv pkey encrypted+          let decrypted = open des encKey iv rsa encrypted            putStrLn ("decrypted message: " ++ decrypted) 

@@ -4,12 +4,13 @@ 	ghc $(GHCFLAGS) --make GenRSAKey 	ghc $(GHCFLAGS) --make HelloWorld 	ghc $(GHCFLAGS) --make PKCS7+	ghc $(GHCFLAGS) --make Server  run: build 	./PKCS7 #	./HelloWorld  clean:-	rm -f HelloWorld GenRSAKey PKCS7 *.hi *.o+	rm -f HelloWorld GenRSAKey PKCS7 Server *.hi *.o  .PHONY: build run clean

@@ -12,10 +12,10 @@ import OpenSSL.X509.Store  main = withOpenSSL $-       do pkey <- liftM newPKeyRSA $ generateKey 512 65537 Nothing-          cert <- genCert pkey+       do rsa  <- generateRSAKey 512 65537 Nothing+          cert <- genCert rsa -          pkcs7 <- pkcs7Sign cert pkey [] "Hello, world!" [Pkcs7NoCerts]+          pkcs7 <- pkcs7Sign cert rsa [] "Hello, world!" [Pkcs7NoCerts]            store <- newX509Store           addCertToStore store cert@@ -24,7 +24,7 @@           return ()  -genCert :: PKey -> IO X509+genCert :: KeyPair k => k -> IO X509 genCert pkey     = do x509 <- newX509          setVersion x509 2