PKey.hs

{-# OPTIONS_GHC -optc-D__GLASGOW_HASKELL__=606 #-}
{-# INCLUDE "HsOpenSSL.h" #-}
{-# LINE 1 "OpenSSL/EVP/PKey.hsc" #-}
{- -*- haskell -*- -}
{-# LINE 2 "OpenSSL/EVP/PKey.hsc" #-}

-- #prune

-- |An interface to asymmetric cipher keypair.


{-# LINE 8 "OpenSSL/EVP/PKey.hsc" #-}

module OpenSSL.EVP.PKey
    ( PKey
    , EVP_PKEY -- private

    , wrapPKeyPtr -- private
    , withPKeyPtr -- private
    , unsafePKeyToPtr -- private
    , touchPKey -- private
    , pkeySize -- private
    , pkeyDefaultMD -- private

      -- FIXME: newPKeyDSA, newPKeyDH and newPKeyECKey may be needed

{-# LINE 22 "OpenSSL/EVP/PKey.hsc" #-}
    , newPKeyRSA

{-# LINE 24 "OpenSSL/EVP/PKey.hsc" #-}

{-# LINE 25 "OpenSSL/EVP/PKey.hsc" #-}
    , newPKeyDSA

{-# LINE 27 "OpenSSL/EVP/PKey.hsc" #-}
    )
    where

import           Foreign
import           OpenSSL.DSA
import           OpenSSL.EVP.Digest
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)
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 Int


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


pkeyDefaultMD :: PKey -> IO Digest
pkeyDefaultMD pkey
    = withPKeyPtr pkey $ \ pkeyPtr ->
      do pkeyType   <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) pkeyPtr :: IO Int
{-# LINE 80 "OpenSSL/EVP/PKey.hsc" #-}
         digestName <- case pkeyType of

{-# LINE 82 "OpenSSL/EVP/PKey.hsc" #-}
                         (6) -> return "sha1"
{-# LINE 83 "OpenSSL/EVP/PKey.hsc" #-}

{-# LINE 84 "OpenSSL/EVP/PKey.hsc" #-}

{-# LINE 85 "OpenSSL/EVP/PKey.hsc" #-}
                         (116) -> return "dss1"
{-# LINE 86 "OpenSSL/EVP/PKey.hsc" #-}

{-# LINE 87 "OpenSSL/EVP/PKey.hsc" #-}
                         _ -> 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)



{-# LINE 95 "OpenSSL/EVP/PKey.hsc" #-}
foreign import ccall unsafe "EVP_PKEY_set1_RSA"
        _set1_RSA :: Ptr EVP_PKEY -> Ptr RSA_ -> IO Int

-- |@'newPKeyRSA' rsa@ encapsulates an RSA key into 'PKey'.
newPKeyRSA :: RSA -> PKey
newPKeyRSA rsa
    = unsafePerformIO $
      withRSAPtr rsa $ \ rsaPtr ->
      do pkeyPtr <- _pkey_new >>= failIfNull
         _set1_RSA pkeyPtr rsaPtr >>= failIf (/= 1)
         wrapPKeyPtr pkeyPtr

{-# LINE 107 "OpenSSL/EVP/PKey.hsc" #-}



{-# LINE 110 "OpenSSL/EVP/PKey.hsc" #-}
foreign import ccall unsafe "EVP_PKEY_set1_DSA"
        _set1_DSA :: Ptr EVP_PKEY -> Ptr DSA_ -> IO Int

-- |@'newPKeyDSA' dsa@ encapsulates an 'DSA' key into 'PKey'.
newPKeyDSA :: DSA -> PKey
newPKeyDSA dsa
    = unsafePerformIO $
      withDSAPtr dsa $ \ dsaPtr ->
      do pkeyPtr <- _pkey_new >>= failIfNull
         _set1_DSA pkeyPtr dsaPtr >>= failIf (/= 1)
         wrapPKeyPtr pkeyPtr