{-# LINE 1 "OpenSSL/DER.hsc" #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE CApiFFI #-}
module OpenSSL.DER
( toDERPub
, fromDERPub
, toDERPriv
, fromDERPriv
)
where
{-# LINE 15 "OpenSSL/DER.hsc" #-}
import OpenSSL.RSA (RSA, RSAKey, RSAKeyPair, RSAPubKey,
absorbRSAPtr, withRSAPtr)
import Data.ByteString (ByteString)
import qualified Data.ByteString as B (useAsCStringLen)
import qualified Data.ByteString.Internal as BI (createAndTrim)
import Foreign.Ptr (Ptr, nullPtr, castPtr)
import Foreign.C.Types (CLong(..), CInt(..))
import Foreign.Marshal.Alloc (alloca)
import Foreign.Storable (poke)
import GHC.Word (Word8)
import System.IO.Unsafe (unsafePerformIO)
type CDecodeFun = Ptr (Ptr RSA) -> Ptr (Ptr Word8) -> CLong -> IO (Ptr RSA)
type CEncodeFun = Ptr RSA -> Ptr (Ptr Word8) -> IO CInt
foreign import capi unsafe "HsOpenSSL.h d2i_RSAPublicKey"
_fromDERPub :: CDecodeFun
foreign import capi unsafe "HsOpenSSL.h i2d_RSAPublicKey"
_toDERPub :: CEncodeFun
foreign import capi unsafe "HsOpenSSL.h d2i_RSAPrivateKey"
_fromDERPriv :: CDecodeFun
foreign import capi unsafe "HsOpenSSL.h i2d_RSAPrivateKey"
_toDERPriv :: CEncodeFun
makeDecodeFun :: RSAKey k => CDecodeFun -> ByteString -> Maybe k
makeDecodeFun fun bs = unsafePerformIO . usingConvedBS $ \(csPtr, ci) -> do
rsaPtr <- fun nullPtr (castPtr csPtr) ci
if rsaPtr == nullPtr then return Nothing else absorbRSAPtr rsaPtr
where usingConvedBS io = B.useAsCStringLen bs $ \(cs, len) ->
alloca $ \csPtr -> poke csPtr cs >> io (csPtr, fromIntegral len)
makeEncodeFun :: RSAKey k => CEncodeFun -> k -> ByteString
makeEncodeFun fun k = unsafePerformIO $ do
requiredSize <- withRSAPtr k $ flip fun nullPtr
BI.createAndTrim (fromIntegral requiredSize) $ \ptr ->
alloca $ \pptr ->
(fromIntegral <$>) . withRSAPtr k $ \key ->
poke pptr ptr >> fun key pptr
toDERPub :: RSAKey k
=> k
-> ByteString
toDERPub = makeEncodeFun _toDERPub
fromDERPub :: ByteString -> Maybe RSAPubKey
fromDERPub = makeDecodeFun _fromDERPub
toDERPriv :: RSAKeyPair -> ByteString
toDERPriv = makeEncodeFun _toDERPriv
fromDERPriv :: RSAKey k
=> ByteString
-> Maybe k
fromDERPriv = makeDecodeFun _fromDERPriv