module OpenSSL.EVP.PKey
( PKey
, EVP_PKEY
, wrapPKeyPtr
, withPKeyPtr
, unsafePKeyToPtr
, touchPKey
, pkeySize
, pkeyDefaultMD
, newPKeyRSA
, newPKeyDSA
)
where
import Foreign
import Foreign.C
import OpenSSL.DSA
import OpenSSL.EVP.Digest hiding (digest)
import OpenSSL.RSA
import OpenSSL.Utils
newtype PKey = PKey (ForeignPtr EVP_PKEY)
data EVP_PKEY
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
withPKeyPtr :: PKey -> (Ptr EVP_PKEY -> IO a) -> IO a
withPKeyPtr (PKey pkey) = withForeignPtr pkey
unsafePKeyToPtr :: PKey -> Ptr EVP_PKEY
unsafePKeyToPtr (PKey pkey) = unsafeForeignPtrToPtr pkey
touchPKey :: PKey -> IO ()
touchPKey (PKey pkey) = touchForeignPtr pkey
pkeySize :: PKey -> IO Int
pkeySize pkey
= withPKeyPtr pkey $ \ pkeyPtr ->
_pkey_size pkeyPtr >>= return . fromIntegral
pkeyDefaultMD :: PKey -> IO Digest
pkeyDefaultMD pkey
= withPKeyPtr pkey $ \ pkeyPtr ->
do pkeyType <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) pkeyPtr :: IO CInt
digestName <- case pkeyType of
(6) -> return "sha1"
(116) -> return "dss1"
_ -> 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)
foreign import ccall unsafe "EVP_PKEY_set1_RSA"
_set1_RSA :: Ptr EVP_PKEY -> Ptr RSA_ -> IO CInt
newPKeyRSA :: RSA -> PKey
newPKeyRSA rsa
= unsafePerformIO $
withRSAPtr rsa $ \ rsaPtr ->
do pkeyPtr <- _pkey_new >>= failIfNull
_set1_RSA pkeyPtr rsaPtr >>= failIf (/= 1)
wrapPKeyPtr pkeyPtr
foreign import ccall unsafe "EVP_PKEY_set1_DSA"
_set1_DSA :: Ptr EVP_PKEY -> Ptr DSA_ -> IO CInt
newPKeyDSA :: DSA -> PKey
newPKeyDSA dsa
= unsafePerformIO $
withDSAPtr dsa $ \ dsaPtr ->
do pkeyPtr <- _pkey_new >>= failIfNull
_set1_DSA pkeyPtr dsaPtr >>= failIf (/= 1)
wrapPKeyPtr pkeyPtr