cryptonite-openssl (empty) → 0.1
raw patch · 14 files changed
+1140/−0 lines, 14 filesdep +basedep +bytestringdep +cryptonitesetup-changed
Dependencies added: base, bytestring, cryptonite, memory, tasty, tasty-hunit, tasty-kat, tasty-quickcheck
Files
- Crypto/OpenSSL.hs +12/−0
- Crypto/OpenSSL/AES.hs +110/−0
- Crypto/OpenSSL/AES/Foreign.hsc +89/−0
- Crypto/OpenSSL/ASN1.hs +24/−0
- Crypto/OpenSSL/BN.hs +43/−0
- Crypto/OpenSSL/BN/Foreign.hs +35/−0
- Crypto/OpenSSL/ECC.hs +456/−0
- Crypto/OpenSSL/ECC/Foreign.hs +172/−0
- Crypto/OpenSSL/Misc.hs +38/−0
- LICENSE +29/−0
- README.md +60/−0
- Setup.hs +2/−0
- cryptonite-openssl.cabal +60/−0
- tests/Tests.hs +10/−0
+ Crypto/OpenSSL.hs view
@@ -0,0 +1,12 @@+-- |+-- Module : Crypto.OpenSSL+-- License : BSD-style+-- Stability : experimental+-- Portability : Unix+--+module Crypto.OpenSSL+ ( OpenSSLError(..)+ , OpenSSLGcmError(..)+ ) where++import Crypto.OpenSSL.Misc (OpenSSLError(..), OpenSSLGcmError(..))
+ Crypto/OpenSSL/AES.hs view
@@ -0,0 +1,110 @@+-- |+-- Module : Crypto.OpenSSL.AES+-- License : BSD-style+-- Stability : experimental+-- Portability : Unix+--+module Crypto.OpenSSL.AES+ ( isSupportedGCM+ , encryptGCM+ , decryptGCM+ , OpenSSLGcmError(..)+ ) where++import Crypto.OpenSSL.AES.Foreign+import Crypto.OpenSSL.Misc+import Control.Monad+import Foreign.Marshal.Alloc+import Foreign.ForeignPtr+import Foreign.Ptr+import Foreign.C.Types+import Foreign.Storable+import Data.ByteString (ByteString)+import qualified Data.ByteArray as B+import qualified Data.Memory.PtrMethods as B (memSet)++type GCMCtx = ForeignPtr EVP_CIPHER_CTX++data Direction = DirectionEncrypt | DirectionDecrypt++isSupportedGCM :: Bool+isSupportedGCM = doIO $ do+ cipher <- ssl_c_aes_256_gcm+ return (cipher /= nullPtr)+{-# NOINLINE isSupportedGCM #-}++withGCM :: Direction -> ByteString -> ByteString -> (Ptr EVP_CIPHER_CTX -> IO a) -> a+withGCM direction key iv f = doIO $ do+ cipher <- ssl_c_aes_256_gcm+ when (cipher == nullPtr) $ error "openssl doesn't have a GCM cipher"+ fptr <- contextNew $ \ctx -> checkRet "encryptinit_ex" (ssl_c_encryptinit_ex ctx cipher nullEngine nullPtr nullPtr)+ withForeignPtr fptr $ \ctx ->+ B.withByteArray key $ \keyPtr ->+ B.withByteArray iv $ \ivPtr -> do+ checkRet "ctx_ctrl_set_ivlen" (ssl_c_cipher_ctx_ctrl ctx ctrl_GCM_SET_IVLEN 12 nullPtr)+ case direction of+ DirectionEncrypt -> checkRet "encryptinit_ex" (ssl_c_encryptinit_ex ctx nullPtr nullEngine keyPtr ivPtr)+ DirectionDecrypt -> checkRet "decryptinit_ex" (ssl_c_decryptinit_ex ctx nullPtr nullEngine keyPtr ivPtr)+ f ctx+{-# NOINLINE withGCM #-}++-- | One shot function to GCM data without any incremental handling+encryptGCM :: ByteString -> ByteString -> ByteString -> ByteString -> ByteString+encryptGCM key iv header input = withGCM DirectionEncrypt key iv $ \ctx -> do+ -- consume the header as authenticated data+ when (headerLength > 0) $ do+ B.withByteArray header $ \h ->+ checkRet "encryptupdate-header" (alloca $ \outl -> ssl_c_encryptupdate ctx nullPtr outl h (fromIntegral headerLength))++ -- consume the input data and, create output data + GCM tag+ alloca $ \ptrOutl ->+ B.withByteArray input $ \inp -> do+ B.alloc ciphertextLength $ \out -> do+ checkRet "encryptupdate-input" (ssl_c_encryptupdate ctx out ptrOutl inp (fromIntegral inputLength))+ encryptedLen <- peek ptrOutl+ checkRet "encryptfinal_ex" (ssl_c_encryptfinal_ex ctx (out `plusPtr` (fromIntegral encryptedLen)) ptrOutl)+ checkRet "ctx_ctrl_get_tag" (ssl_c_cipher_ctx_ctrl ctx ctrl_GCM_GET_TAG (fromIntegral gcmTagLength) (out `plusPtr` inputLength))+ where+ ciphertextLength = B.length input + gcmTagLength+ headerLength = B.length header+ inputLength = B.length input+{-# NOINLINE encryptGCM #-}++-- | One shot function to decrypt GCM data without any incremental handling+decryptGCM :: ByteString -> ByteString -> ByteString -> ByteString -> Maybe ByteString+decryptGCM key iv header input+ | inputLength < gcmTagLength = Nothing+ | otherwise = withGCM DirectionDecrypt key iv $ \ctx -> do+ -- consume the header as authenticated data+ when (headerLength > 0) $ do+ B.withByteArray header $ \h ->+ checkRet "decryptupdate-header" (alloca $ \outl -> ssl_c_decryptupdate ctx nullPtr outl h (fromIntegral headerLength))++ -- consume the input data and, create output data + GCM tag+ B.withByteArray input $ \inp -> do+ (r, output) <- B.allocRet plaintextLength $ \out -> do+ alloca $ \ptrOutl -> do+ checkRet "decryptupdate-input" (ssl_c_decryptupdate ctx out ptrOutl inp (fromIntegral plaintextLength))+ checkRet "ctx_ctrl_set_tag" (ssl_c_cipher_ctx_ctrl ctx ctrl_GCM_SET_TAG (fromIntegral gcmTagLength) (inp `plusPtr` plaintextLength))+ ssl_c_decryptfinal_ex ctx out ptrOutl+ if r == 0+ then return Nothing -- validation failed+ else return $ Just output+ where+ plaintextLength = B.length input - gcmTagLength+ headerLength = B.length header+ inputLength = B.length input+{-# NOINLINE decryptGCM #-}++checkRet :: String -> IO CInt -> IO ()+checkRet = checkCtx OpenSSLGcmError++contextNew :: (Ptr EVP_CIPHER_CTX -> IO ()) -> IO GCMCtx+contextNew f = do+ ptr <- mallocBytes sizeofEVP+ B.memSet (castPtr ptr) 0 (fromIntegral sizeofEVP)+ f ptr+ newForeignPtr ssl_c_cipher_ctx_cleanup ptr++nullEngine :: Ptr ENGINE+nullEngine = nullPtr
+ Crypto/OpenSSL/AES/Foreign.hsc view
@@ -0,0 +1,89 @@+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE EmptyDataDecls #-}+module Crypto.OpenSSL.AES.Foreign where++#include <openssl/opensslv.h>+#include <openssl/evp.h>++#if OPENSSL_VERSION_NUMBER > 0x10001000+#define OPENSSL_HAS_PBKDF2+#define OPENSSL_HAS_GCM+#endif++import Foreign.Ptr+import Foreign.C.Types+import Data.Word++gcmTagLength :: Int+gcmTagLength = 16++sizeofEVP :: Int+sizeofEVP = (#const sizeof(EVP_CIPHER_CTX))++data ENGINE++data EVP_CIPHER+data EVP_CIPHER_CTX++type KeyBuf = Ptr Word8++type IvBuf = Ptr Word8+type DataBuf = Ptr Word8+type OutputOffset = Ptr CInt+type InputLength = CInt++foreign import ccall unsafe "EVP_CIPHER_CTX_init"+ ssl_c_cipher_ctx_init :: Ptr EVP_CIPHER_CTX -> IO ()++foreign import ccall unsafe "&EVP_CIPHER_CTX_free"+ ssl_c_cipher_ctx_free :: FunPtr (Ptr EVP_CIPHER_CTX -> IO ())++foreign import ccall unsafe "&EVP_CIPHER_CTX_cleanup"+ ssl_c_cipher_ctx_cleanup :: FunPtr (Ptr EVP_CIPHER_CTX -> IO ())++foreign import ccall unsafe "EVP_CIPHER_CTX_ctrl"+ ssl_c_cipher_ctx_ctrl :: Ptr EVP_CIPHER_CTX -> CInt -> CInt -> Ptr a -> IO CInt++foreign import ccall unsafe "EVP_CIPHER_CTX_set_padding"+ ssl_c_cipher_ctx_set_padding :: Ptr EVP_CIPHER_CTX -> CInt -> IO CInt++foreign import ccall unsafe "EVP_CIPHER_CTX_set_key_length"+ ssl_c_cipher_ctx_set_key_length :: Ptr EVP_CIPHER_CTX -> CInt -> IO CInt++foreign import ccall unsafe "EVP_EncryptInit_ex"+ ssl_c_encryptinit_ex :: Ptr EVP_CIPHER_CTX -> Ptr EVP_CIPHER -> Ptr ENGINE -> KeyBuf -> IvBuf -> IO CInt++foreign import ccall unsafe "EVP_DecryptInit_ex"+ ssl_c_decryptinit_ex :: Ptr EVP_CIPHER_CTX -> Ptr EVP_CIPHER -> Ptr ENGINE -> KeyBuf -> IvBuf -> IO CInt++foreign import ccall unsafe "EVP_EncryptUpdate"+ ssl_c_encryptupdate :: Ptr EVP_CIPHER_CTX -> DataBuf -> OutputOffset -> DataBuf -> InputLength -> IO CInt++foreign import ccall unsafe "EVP_DecryptUpdate"+ ssl_c_decryptupdate :: Ptr EVP_CIPHER_CTX -> DataBuf -> OutputOffset -> DataBuf -> InputLength -> IO CInt++foreign import ccall unsafe "EVP_EncryptFinal_ex"+ ssl_c_encryptfinal_ex :: Ptr EVP_CIPHER_CTX -> DataBuf -> OutputOffset -> IO CInt++foreign import ccall unsafe "EVP_DecryptFinal_ex"+ ssl_c_decryptfinal_ex :: Ptr EVP_CIPHER_CTX -> DataBuf -> OutputOffset -> IO CInt++#ifdef OPENSSL_HAS_GCM+foreign import ccall unsafe "EVP_aes_256_gcm"+ ssl_c_aes_256_gcm :: IO (Ptr EVP_CIPHER)+#else+ssl_c_aes_256_gcm :: IO (Ptr EVP_CIPHER)+ssl_c_aes_256_gcm = return nullPtr+#endif++ctrl_GCM_SET_IVLEN, ctrl_GCM_GET_TAG, ctrl_GCM_SET_TAG :: CInt+#ifdef OPENSSL_HAS_GCM+ctrl_GCM_SET_IVLEN = (#const EVP_CTRL_GCM_SET_IVLEN)+ctrl_GCM_GET_TAG = (#const EVP_CTRL_GCM_GET_TAG)+ctrl_GCM_SET_TAG = (#const EVP_CTRL_GCM_SET_TAG)+#else+-- not sure if this is a good idea to hardcode it.+ctrl_GCM_SET_IVLEN = 0x9+ctrl_GCM_GET_TAG = 0x10+ctrl_GCM_SET_TAG = 0x11+#endif
+ Crypto/OpenSSL/ASN1.hs view
@@ -0,0 +1,24 @@+{-# LANGUAGE ForeignFunctionInterface #-}+module Crypto.OpenSSL.ASN1+ ( Nid(..)+ , asn1Description+ ) where++import Foreign.Ptr +import Foreign.C.Types+import Foreign.C.String+import Crypto.OpenSSL.Misc+import Control.Applicative++-- | openssl ASN1 unique identifier+newtype Nid = Nid Int++foreign import ccall unsafe "OBJ_txt2nid"+ _obj_txt2nid :: Ptr CChar -> IO CInt++asn1Description :: String -> Maybe Nid+asn1Description s = doIO $+ (mnid <$> withCString s (_obj_txt2nid))+ where mnid 0 = Nothing+ mnid i = Just $ Nid (fromIntegral i)+
+ Crypto/OpenSSL/BN.hs view
@@ -0,0 +1,43 @@+{-# LANGUAGE ForeignFunctionInterface #-}+module Crypto.OpenSSL.BN where++import Crypto.OpenSSL.BN.Foreign+import Crypto.OpenSSL.Misc+import Foreign.Ptr+import Foreign.ForeignPtr++import Data.Bits+import qualified Data.ByteString as B+import qualified Data.ByteString.Internal as B++withIntegerAsBN :: Integer -> (Ptr BIGNUM -> IO a) -> IO a+withIntegerAsBN i f = do+ bn <- withForeignPtr fptr $ \bsPtr ->+ ssl_bn_bin2 (castPtr (bsPtr `plusPtr` o)) (fromIntegral len) nullPtr+ foreignBn <- newForeignPtr ssl_bn_free bn+ withForeignPtr foreignBn f+ where (fptr, o, len) = B.toForeignPtr bs+ bs = B.reverse $ B.unfoldr fdivMod256 i+ fdivMod256 0 = Nothing+ fdivMod256 n = Just (fromIntegral a,b) where (b,a) = divMod256 n+ divMod256 :: Integer -> (Integer, Integer)+ divMod256 n = (n `shiftR` 8, n .&. 0xff)++bnToInt :: Ptr BIGNUM -> IO Integer+bnToInt bn = do+ bytes <- ssl_bn_num_bytes bn+ bs <- B.create (fromIntegral bytes) $ \bufPtr ->+ check $ ssl_bn_2bin bn (castPtr bufPtr)+ return $ os2ip bs+ where os2ip = B.foldl' (\a b -> (256 * a) .|. (fromIntegral b)) 0++withBnCtxNew :: (Ptr BN_CTX -> IO a) -> IO a+withBnCtxNew f = do+ -- UGLY, can do something more clever than this ..+ fptr <- ssl_bn_ctx_new >>= newForeignPtr ssl_bn_ctx_free+ withForeignPtr fptr f++withBnNew :: (Ptr BIGNUM -> IO a) -> IO a+withBnNew f = do+ fptr <- ssl_bn_new >>= newForeignPtr ssl_bn_free+ withForeignPtr fptr f
+ Crypto/OpenSSL/BN/Foreign.hs view
@@ -0,0 +1,35 @@+{-# LANGUAGE ForeignFunctionInterface #-}+module Crypto.OpenSSL.BN.Foreign where++import Foreign.C.Types+import Foreign.Ptr++data BN_CTX+data BIGNUM++foreign import ccall unsafe "&BN_CTX_free"+ ssl_bn_ctx_free :: FunPtr (Ptr BN_CTX -> IO ())++foreign import ccall unsafe "BN_CTX_new"+ ssl_bn_ctx_new :: IO (Ptr BN_CTX)++foreign import ccall unsafe "BN_new"+ ssl_bn_new :: IO (Ptr BIGNUM)++foreign import ccall unsafe "&BN_free"+ ssl_bn_free :: FunPtr (Ptr BIGNUM -> IO ())++foreign import ccall unsafe "BN_num_bits"+ ssl_bn_num_bits :: Ptr BIGNUM -> IO CInt++foreign import ccall unsafe "BN_bn2bin"+ ssl_bn_2bin :: Ptr BIGNUM -> Ptr CUChar -> IO CInt++foreign import ccall unsafe "BN_bin2bn"+ ssl_bn_bin2 :: Ptr CUChar -> CInt -> Ptr BIGNUM -> IO (Ptr BIGNUM)++-- bn_num_bytes is a macro, +ssl_bn_num_bytes :: Ptr BIGNUM -> IO CInt+ssl_bn_num_bytes ptr = do+ bits <- ssl_bn_num_bits ptr+ return $ ((bits + 7) `div` 8)
+ Crypto/OpenSSL/ECC.hs view
@@ -0,0 +1,456 @@+-- |+-- Module : Crypto.OpenSSL.ECC+-- License : BSD-style+-- Stability : experimental+-- Portability : Unix+--+module Crypto.OpenSSL.ECC+ ( EcPoint+ , EcGroup+ , EcKey+ -- * Curve group+ , ecGroupFromCurveOID+ , ecGroupGFp+ , ecGroupGF2m+ , ecGroupGetDegree+ , ecGroupGetOrder+ , ecGroupGetCoFactor+ , ecGroupGetGenerator+ , ecGroupGetCurveGFp+ , ecGroupGetCurveGF2m+ -- * EcPoint arithmetic+ , ecPointAdd+ , ecPointDbl+ , ecPointMul+ , ecPointMulWithGenerator+ , ecPointGeneratorMul+ , ecPointInvert+ , ecPointInfinity+ , ecPointIsAtInfinity+ , ecPointIsOnCurve+ , ecPointEq+ -- * EcPoint serialization+ , ecPointToOct+ , ecPointFromOct+ , ecPointFromJProjectiveGFp+ , ecPointToJProjectiveGFp+ , ecPointFromAffineGFp+ , ecPointToAffineGFp+ , ecPointFromAffineGF2m+ , ecPointToAffineGF2m+ -- * Key+ , ecKeyGenerateNew+ , ecKeyFromPair+ , ecKeyToPair+ ) where++import Control.Monad (void)+import Control.Applicative+import Crypto.OpenSSL.ECC.Foreign+import Crypto.OpenSSL.ASN1+import Crypto.OpenSSL.BN+import Crypto.OpenSSL.Misc+import Foreign.ForeignPtr+import Foreign.Ptr+import qualified Data.ByteArray as B++-- | An ellitic curve group+newtype EcGroup = EcGroup (ForeignPtr EC_GROUP)++-- | An elliptic curve point+newtype EcPoint = EcPoint (ForeignPtr EC_POINT)++-- | An elliptic curve key+newtype EcKey = EcKey (ForeignPtr EC_KEY)++data PointConversionForm =+ PointConversion_Compressed+ | PointConversion_Uncompressed+ | PointConversion_Hybrid+ deriving (Show,Eq)++ecPointConversionToC :: PointConversionForm -> PointConversionFormT+ecPointConversionToC PointConversion_Compressed = 2+ecPointConversionToC PointConversion_Uncompressed = 4+ecPointConversionToC PointConversion_Hybrid = 6++withPointNew :: Ptr EC_GROUP -> (Ptr EC_POINT -> IO ()) -> IO EcPoint+withPointNew grp f = do+ ptr <- ssl_point_new grp+ f ptr+ EcPoint <$> newForeignPtr ssl_point_free_funptr ptr++withPointNewWithReturn :: Ptr EC_GROUP -> (Ptr EC_POINT -> IO r) -> IO (r, EcPoint)+withPointNewWithReturn grp f = do+ ptr <- ssl_point_new grp+ r <- f ptr+ point <- EcPoint <$> newForeignPtr ssl_point_free_funptr ptr+ return (r, point)++withPointDup :: Ptr EC_GROUP -> Ptr EC_POINT -> (Ptr EC_POINT -> IO ()) -> IO EcPoint+withPointDup grp p f = do+ ptr <- ssl_point_dup p grp+ f ptr+ EcPoint <$> newForeignPtr ssl_point_free_funptr ptr++-- | try to get a curve group from an ASN1 description string (OID)+--+-- e.g.+--+-- * "1.3.132.0.35" == SEC_P521_R1+--+-- * "1.2.840.10045.3.1.7" == SEC_P256_R1+--+ecGroupFromCurveOID :: String -> Maybe EcGroup+ecGroupFromCurveOID s = asn1Description s >>= grabCurve+ where+ grabCurve (Nid i) = doIO $ do+ g <- ssl_group_new_by_curve_name (fromIntegral i)+ if g == nullPtr+ then return Nothing+ else Just . EcGroup <$> newForeignPtr ssl_group_free g+ {-# NOINLINE grabCurve #-}++-- | Create a new GFp group with explicit (p,a,b,(x,y),order,h)+--+-- Generally, this interface should not be used, and user should+-- really not stray away from already defined curves.+--+-- Use at your own risks.+ecGroupGFp :: Integer -- ^ p+ -> Integer -- ^ a+ -> Integer -- ^ b+ -> (Integer,Integer) -- ^ generator+ -> Integer -- ^ order+ -> Integer -- ^ cofactor+ -> EcGroup+ecGroupGFp p a b (genX, genY) order cofactor = doIO $+ withIntegerAsBN p $ \bnp ->+ withIntegerAsBN a $ \bna ->+ withIntegerAsBN b $ \bnb ->+ withIntegerAsBN genX $ \bnGX ->+ withIntegerAsBN genY $ \bnGY ->+ withIntegerAsBN order $ \bnOrder ->+ withIntegerAsBN cofactor $ \bnCofactor ->+ withBnCtxNew $ \bnCtx -> do+ group <- ssl_group_new_curve_GFp bnp bna bnb bnCtx+ point <- ssl_point_new group+ check $ ssl_point_set_affine_coordinates_GFp group point bnGX bnGY bnCtx+ check $ ssl_group_set_generator group point bnOrder bnCofactor+ ssl_point_free point+ EcGroup <$> newForeignPtr ssl_group_free group+{-# NOINLINE ecGroupGFp #-}++-- | Create a new GF2m group with explicit (p,a,b,(x,y),order,h)+--+-- same warning as `ecGroupGFp`+ecGroupGF2m :: Integer -- ^ p+ -> Integer -- ^ a+ -> Integer -- ^ b+ -> (Integer,Integer) -- ^ generator+ -> Integer -- ^ order+ -> Integer -- ^ cofactor+ -> EcGroup+ecGroupGF2m p a b (genX, genY) order cofactor = doIO $+ withIntegerAsBN p $ \bnp ->+ withIntegerAsBN a $ \bna ->+ withIntegerAsBN b $ \bnb ->+ withIntegerAsBN genX $ \bnGX ->+ withIntegerAsBN genY $ \bnGY ->+ withIntegerAsBN order $ \bnOrder ->+ withIntegerAsBN cofactor $ \bnCofactor ->+ withBnCtxNew $ \bnCtx -> do+ group <- ssl_group_new_curve_GF2m bnp bna bnb bnCtx+ point <- ssl_point_new group+ check $ ssl_point_set_affine_coordinates_GF2m group point bnGX bnGY bnCtx+ check $ ssl_group_set_generator group point bnOrder bnCofactor+ ssl_point_free point+ EcGroup <$> newForeignPtr ssl_group_free group+{-# NOINLINE ecGroupGF2m #-}++-- | get the group degree (number of bytes)+ecGroupGetDegree :: EcGroup -> Int+ecGroupGetDegree (EcGroup g) = doIO $+ withForeignPtr g $ \gptr ->+ fromIntegral <$> ssl_group_get_degree gptr+{-# NOINLINE ecGroupGetDegree #-}++-- | get the order of the subgroup generated by the generator+ecGroupGetOrder :: EcGroup -> Integer+ecGroupGetOrder (EcGroup g) = doIO $+ withForeignPtr g $ \gptr ->+ withBnCtxNew $ \bnCtx ->+ withBnNew $ \bn -> do+ check $ ssl_group_get_order gptr bn bnCtx+ bnToInt bn+{-# NOINLINE ecGroupGetOrder #-}++--- | get the cofactor of the curve.+--+-- usually a small number h that:+-- h = #E(Fp) / n+ecGroupGetCoFactor :: EcGroup -> Integer+ecGroupGetCoFactor (EcGroup g) = doIO $+ withForeignPtr g $ \gptr ->+ withBnCtxNew $ \bnCtx ->+ withBnNew $ \bn -> do+ check $ ssl_group_get_cofactor gptr bn bnCtx+ bnToInt bn+{-# NOINLINE ecGroupGetCoFactor #-}++-- | Get the group generator+ecGroupGetGenerator :: EcGroup -> EcPoint+ecGroupGetGenerator (EcGroup g) = doIO $+ withForeignPtr g $ \gptr ->+ withPointNew gptr $ \r -> do+ p <- ssl_group_get0_generator gptr+ check $ ssl_point_copy r p+{-# NOINLINE ecGroupGetGenerator #-}++-- | get curve's (prime,a,b)+ecGroupGetCurveGFp :: EcGroup -> (Integer, Integer, Integer)+ecGroupGetCurveGFp (EcGroup g) = doIO $+ withForeignPtr g $ \gptr ->+ withBnCtxNew $ \bnCtx ->+ withBnNew $ \pPtr ->+ withBnNew $ \aPtr ->+ withBnNew $ \bPtr -> do+ check $ ssl_group_get_curve_gfp gptr pPtr aPtr bPtr bnCtx+ (,,) <$> bnToInt pPtr <*> bnToInt aPtr <*> bnToInt bPtr+{-# NOINLINE ecGroupGetCurveGFp #-}++-- | get curve's (polynomial,a,b)+ecGroupGetCurveGF2m :: EcGroup -> (Integer, Integer, Integer)+ecGroupGetCurveGF2m (EcGroup g) = doIO $+ withForeignPtr g $ \gptr ->+ withBnCtxNew $ \bnCtx ->+ withBnNew $ \pPtr ->+ withBnNew $ \aPtr ->+ withBnNew $ \bPtr -> do+ check $ ssl_group_get_curve_gf2m gptr pPtr aPtr bPtr bnCtx+ (,,) <$> bnToInt pPtr <*> bnToInt aPtr <*> bnToInt bPtr+{-# NOINLINE ecGroupGetCurveGF2m #-}++{-+ecPointNew :: EcGroup -> IO EcPoint+ecPointNew (EcGroup fptr) = withForeignPtr fptr $ \gptr ->+ withPointNew gptr (\_ -> return ())+-}++-- | add 2 points together, r = p1 + p2+ecPointAdd :: EcGroup -> EcPoint -> EcPoint -> EcPoint+ecPointAdd (EcGroup g) (EcPoint p1) (EcPoint p2) = doIO $+ withForeignPtr g $ \gptr ->+ withForeignPtr p1 $ \p1ptr ->+ withForeignPtr p2 $ \p2ptr ->+ withBnCtxNew $ \bnCtx ->+ withPointNew gptr $ \r -> check $ ssl_point_add gptr r p1ptr p2ptr bnCtx+{-# NOINLINE ecPointAdd #-}++-- | compute the doubling of the point p, r = p^2+ecPointDbl :: EcGroup -> EcPoint -> EcPoint+ecPointDbl (EcGroup g) (EcPoint p) = doIO $+ withForeignPtr g $ \gptr ->+ withForeignPtr p $ \pptr ->+ withBnCtxNew $ \bnCtx ->+ withPointNew gptr $ \r -> check $ ssl_point_dbl gptr r pptr bnCtx+{-# NOINLINE ecPointDbl #-}++-- | compute q * m+ecPointMul :: EcGroup+ -> EcPoint -- ^ q+ -> Integer -- ^ m+ -> EcPoint+ecPointMul (EcGroup g) (EcPoint q) m = doIO $+ withForeignPtr g $ \gptr ->+ withForeignPtr q $ \qptr ->+ withBnCtxNew $ \bnCtx ->+ withIntegerAsBN m $ \bnM ->+ withPointNew gptr $ \r -> check $ ssl_point_mul gptr r nullPtr qptr bnM bnCtx+{-# NOINLINE ecPointMul #-}++-- | compute generator * n + q * m+ecPointMulWithGenerator :: EcGroup+ -> Integer -- ^ n+ -> EcPoint -- ^ q+ -> Integer -- ^ m+ -> EcPoint+ecPointMulWithGenerator (EcGroup g) n (EcPoint q) m = doIO $+ withForeignPtr g $ \gptr ->+ withForeignPtr q $ \qptr ->+ withBnCtxNew $ \bnCtx ->+ withIntegerAsBN n $ \bnN ->+ withIntegerAsBN m $ \bnM ->+ withPointNew gptr $ \r -> check $ ssl_point_mul gptr r bnN qptr bnM bnCtx+{-# NOINLINE ecPointMulWithGenerator #-}++-- | compute generator * n+ecPointGeneratorMul :: EcGroup -> Integer -> EcPoint+ecPointGeneratorMul (EcGroup g) n = doIO $+ withForeignPtr g $ \gptr ->+ withBnCtxNew $ \bnCtx ->+ withIntegerAsBN n $ \bnN ->+ withPointNew gptr $ \r -> check $ ssl_point_mul gptr r bnN nullPtr nullPtr bnCtx+{-# NOINLINE ecPointGeneratorMul #-}++-- | compute the inverse on the curve on the point p, r = p^(-1)+ecPointInvert :: EcGroup -> EcPoint -> EcPoint+ecPointInvert (EcGroup g) (EcPoint p) = doIO $+ withForeignPtr g $ \gptr ->+ withForeignPtr p $ \pptr ->+ withBnCtxNew $ \bnCtx ->+ withPointDup gptr pptr $ \dupptr ->+ check $ ssl_point_invert gptr dupptr bnCtx+{-# NOINLINE ecPointInvert #-}++ecPointInfinity :: EcGroup -> EcPoint+ecPointInfinity (EcGroup g) = doIO $+ withForeignPtr g $ \gptr ->+ withPointNew gptr $ \r ->+ check $ ssl_point_set_to_infinity gptr r+{-# NOINLINE ecPointInfinity #-}++-- | get if the point is at infinity+ecPointIsAtInfinity :: EcGroup -> EcPoint -> Bool+ecPointIsAtInfinity (EcGroup g) (EcPoint p) = doIO $+ withForeignPtr g $ \gptr ->+ withForeignPtr p $ \pptr ->+ ((==) 1 <$> ssl_point_is_at_infinity gptr pptr)+{-# NOINLINE ecPointIsAtInfinity #-}++-- | get if the point is on the curve+ecPointIsOnCurve :: EcGroup -> EcPoint -> Bool+ecPointIsOnCurve (EcGroup g) (EcPoint p) = doIO $+ withForeignPtr g $ \gptr ->+ withForeignPtr p $ \pptr ->+ withBnCtxNew $ \bnCtx ->+ ((==) 1 <$> ssl_point_is_on_curve gptr pptr bnCtx)+{-# NOINLINE ecPointIsOnCurve #-}++ecPointToOct :: B.ByteArray outBytes => EcGroup -> EcPoint -> PointConversionForm -> outBytes+ecPointToOct (EcGroup g) (EcPoint p) pconv = doIO $+ withForeignPtr g $ \gptr ->+ withForeignPtr p $ \pptr ->+ withBnCtxNew $ \bnCtx -> do+ lenRequired <- ssl_point_2oct gptr pptr form nullPtr 0 bnCtx+ B.alloc (fromIntegral lenRequired) $ \buf -> do+ void $ ssl_point_2oct gptr pptr form (castPtr buf) lenRequired bnCtx+ where form = ecPointConversionToC pconv+{-# NOINLINE ecPointToOct #-}++ecPointFromOct :: B.ByteArrayAccess inBytes => EcGroup -> inBytes -> Either String EcPoint+ecPointFromOct (EcGroup g) bs = doIO $ do+ (opensslRet,point) <- withForeignPtr g $ \gptr ->+ B.withByteArray bs $ \bsPtr ->+ withBnCtxNew $ \bnCtx ->+ withPointNewWithReturn gptr $ \r ->+ ssl_point_oct2 gptr r bsPtr (fromIntegral $ B.length bs) bnCtx+ if opensslRet == 1 then return (Right point) else return (Left "invalid point")+{-# NOINLINE ecPointFromOct #-}++ecPointFromJProjectiveGFp :: EcGroup -> (Integer,Integer,Integer) -> EcPoint+ecPointFromJProjectiveGFp (EcGroup g) (x,y,z) = doIO $+ withForeignPtr g $ \gptr ->+ withBnCtxNew $ \bnCtx ->+ withIntegerAsBN x $ \bnX ->+ withIntegerAsBN y $ \bnY ->+ withIntegerAsBN z $ \bnZ ->+ withPointNew gptr $ \r ->+ check $ ssl_point_set_Jprojective_coordinates_GFp gptr r bnX bnY bnZ bnCtx+{-# NOINLINE ecPointFromJProjectiveGFp #-}++ecPointToJProjectiveGFp :: EcGroup -> EcPoint -> (Integer,Integer,Integer)+ecPointToJProjectiveGFp (EcGroup g) (EcPoint p) = doIO $+ withForeignPtr g $ \gptr ->+ withForeignPtr p $ \pptr ->+ withBnCtxNew $ \bnCtx ->+ withBnNew $ \bnX ->+ withBnNew $ \bnY ->+ withBnNew $ \bnZ -> do+ check $ ssl_point_get_Jprojective_coordinates_GFp gptr pptr bnX bnY bnZ bnCtx+ (,,) <$> bnToInt bnX <*> bnToInt bnY <*> bnToInt bnZ+{-# NOINLINE ecPointToJProjectiveGFp #-}++ecPointFromAffineGFp :: EcGroup -> (Integer, Integer) -> EcPoint+ecPointFromAffineGFp (EcGroup g) (x,y) = doIO $+ withForeignPtr g $ \gptr ->+ withBnCtxNew $ \bnCtx ->+ withIntegerAsBN x $ \bnX ->+ withIntegerAsBN y $ \bnY ->+ withPointNew gptr $ \r ->+ check $ ssl_point_set_affine_coordinates_GFp gptr r bnX bnY bnCtx+{-# NOINLINE ecPointFromAffineGFp #-}++ecPointToAffineGFp :: EcGroup -> EcPoint -> (Integer, Integer)+ecPointToAffineGFp (EcGroup g) (EcPoint p) = doIO $+ withForeignPtr g $ \gptr ->+ withForeignPtr p $ \pptr ->+ withBnCtxNew $ \bnCtx ->+ withBnNew $ \bnX ->+ withBnNew $ \bnY -> do+ check $ ssl_point_get_affine_coordinates_GFp gptr pptr bnX bnY bnCtx+ (,) <$> bnToInt bnX <*> bnToInt bnY+{-# NOINLINE ecPointToAffineGFp #-}++ecPointFromAffineGF2m :: EcGroup -> (Integer, Integer) -> EcPoint+ecPointFromAffineGF2m (EcGroup g) (x,y) = doIO $+ withForeignPtr g $ \gptr ->+ withBnCtxNew $ \bnCtx ->+ withIntegerAsBN x $ \bnX ->+ withIntegerAsBN y $ \bnY ->+ withPointNew gptr $ \r ->+ check $ ssl_point_set_affine_coordinates_GF2m gptr r bnX bnY bnCtx+{-# NOINLINE ecPointFromAffineGF2m #-}++ecPointToAffineGF2m :: EcGroup -> EcPoint -> (Integer, Integer)+ecPointToAffineGF2m (EcGroup g) (EcPoint p) = doIO $+ withForeignPtr g $ \gptr ->+ withForeignPtr p $ \pptr ->+ withBnCtxNew $ \bnCtx ->+ withBnNew $ \bnX ->+ withBnNew $ \bnY -> do+ check $ ssl_point_get_affine_coordinates_GF2m gptr pptr bnX bnY bnCtx+ (,) <$> bnToInt bnX <*> bnToInt bnY+{-# NOINLINE ecPointToAffineGF2m #-}++-- | return if a point eq another point+ecPointEq :: EcGroup -> EcPoint -> EcPoint -> Bool+ecPointEq (EcGroup g) (EcPoint p1) (EcPoint p2) = doIO $+ withForeignPtr g $ \gptr ->+ withForeignPtr p1 $ \ptr1 ->+ withForeignPtr p2 $ \ptr2 ->+ withBnCtxNew $ \bnCtx ->+ (== 0) <$> ssl_point_cmp gptr ptr1 ptr2 bnCtx+{-# NOINLINE ecPointEq #-}++-- | generate a new key in a specific group+ecKeyGenerateNew :: EcGroup -> IO EcKey+ecKeyGenerateNew (EcGroup g) =+ withForeignPtr g $ \gptr -> do+ key <- ssl_key_new+ check $ ssl_key_set_group key gptr+ check $ ssl_key_generate_key key+ EcKey <$> newForeignPtr ssl_key_free key++-- | create a key from a group and a private integer and public point keypair+ecKeyFromPair :: EcGroup -> (Integer, EcPoint) -> EcKey+ecKeyFromPair (EcGroup g) (i, (EcPoint p)) = doIO $+ withForeignPtr g $ \gptr ->+ withForeignPtr p $ \pptr ->+ withIntegerAsBN i $ \bnI -> do+ key <- ssl_key_new+ check $ ssl_key_set_group key gptr+ check $ ssl_key_set_private_key key bnI+ check $ ssl_key_set_public_key key pptr+ EcKey <$> newForeignPtr ssl_key_free key++-- | return the private integer and public point of a key+ecKeyToPair :: EcKey -> (Integer, EcPoint)+ecKeyToPair (EcKey k) = doIO $+ withForeignPtr k $ \kptr -> do+ gptr <- ssl_key_get0_group kptr+ point <- withPointNew gptr $ \r -> do+ p <- ssl_key_get0_public_key kptr+ check $ ssl_point_copy r p+ priv <- ssl_key_get0_private_key kptr >>= bnToInt+ return (priv, point)
+ Crypto/OpenSSL/ECC/Foreign.hs view
@@ -0,0 +1,172 @@+{-# LANGUAGE ForeignFunctionInterface #-}+module Crypto.OpenSSL.ECC.Foreign where++import Foreign.C.Types+--import Foreign.C.String (withCString)+import Foreign.Ptr++import Crypto.OpenSSL.BN.Foreign++data EC_GROUP+data EC_POINT+data EC_KEY++type PointConversionFormT = CInt++foreign import ccall unsafe "OBJ_txt2nid"+ ssl_obj_txt2nid :: Ptr CChar -> IO CInt++foreign import ccall unsafe "&EC_GROUP_free"+ ssl_group_free :: FunPtr (Ptr EC_GROUP -> IO ())++foreign import ccall unsafe "EC_GROUP_new_by_curve_name"+ ssl_group_new_by_curve_name :: CInt -> IO (Ptr EC_GROUP)++foreign import ccall unsafe "EC_GROUP_new_curve_GF2m"+ ssl_group_new_curve_GF2m :: Ptr BIGNUM -> Ptr BIGNUM -> Ptr BIGNUM -> Ptr BN_CTX -> IO (Ptr EC_GROUP)++foreign import ccall unsafe "EC_GROUP_new_curve_GFp"+ ssl_group_new_curve_GFp :: Ptr BIGNUM -> Ptr BIGNUM -> Ptr BIGNUM -> Ptr BN_CTX -> IO (Ptr EC_GROUP)++foreign import ccall unsafe "EC_GROUP_get_order"+ ssl_group_get_order :: Ptr EC_GROUP -> Ptr BIGNUM -> Ptr BN_CTX -> IO CInt++foreign import ccall unsafe "EC_GROUP_get_cofactor"+ ssl_group_get_cofactor :: Ptr EC_GROUP -> Ptr BIGNUM -> Ptr BN_CTX -> IO CInt++foreign import ccall unsafe "EC_GROUP_get_degree"+ ssl_group_get_degree :: Ptr EC_GROUP -> IO CInt++foreign import ccall unsafe "EC_GROUP_get_curve_GFp"+ ssl_group_get_curve_gfp :: Ptr EC_GROUP -> Ptr BIGNUM -> Ptr BIGNUM -> Ptr BIGNUM -> Ptr BN_CTX -> IO CInt++foreign import ccall unsafe "EC_GROUP_get_curve_GF2m"+ ssl_group_get_curve_gf2m :: Ptr EC_GROUP -> Ptr BIGNUM -> Ptr BIGNUM -> Ptr BIGNUM -> Ptr BN_CTX -> IO CInt++foreign import ccall unsafe "EC_GROUP_get0_generator"+ ssl_group_get0_generator :: Ptr EC_GROUP -> IO (Ptr EC_POINT)++foreign import ccall unsafe "EC_GROUP_get_curve_name"+ ssl_group_get_curve_name :: Ptr EC_GROUP -> IO CInt++foreign import ccall unsafe "EC_GROUP_set_generator"+ ssl_group_set_generator :: Ptr EC_GROUP -> Ptr EC_POINT -> Ptr BIGNUM -> Ptr BIGNUM -> IO CInt++-------------------------------+-- EC_POINT related functions++foreign import ccall unsafe "&EC_POINT_free"+ ssl_point_free_funptr :: FunPtr (Ptr EC_POINT -> IO ())++foreign import ccall unsafe "EC_POINT_free"+ ssl_point_free :: Ptr EC_POINT -> IO ()++foreign import ccall unsafe "&EC_POINT_clear_free"+ ssl_point_clear_free :: FunPtr (Ptr EC_POINT -> IO ())++foreign import ccall unsafe "EC_POINT_new"+ ssl_point_new :: Ptr EC_GROUP -> IO (Ptr EC_POINT)++foreign import ccall unsafe "EC_POINT_dup"+ ssl_point_dup :: Ptr EC_POINT -> Ptr EC_GROUP -> IO (Ptr EC_POINT)++foreign import ccall unsafe "EC_POINT_copy"+ ssl_point_copy :: Ptr EC_POINT -> Ptr EC_POINT -> IO CInt++foreign import ccall unsafe "EC_POINT_add"+ ssl_point_add :: Ptr EC_GROUP -> Ptr EC_POINT -> Ptr EC_POINT -> Ptr EC_POINT -> Ptr BN_CTX -> IO CInt++foreign import ccall unsafe "EC_POINT_mul"+ ssl_point_mul :: Ptr EC_GROUP -> Ptr EC_POINT -> Ptr BIGNUM -> Ptr EC_POINT -> Ptr BIGNUM -> Ptr BN_CTX -> IO CInt++foreign import ccall unsafe "EC_POINT_dbl"+ ssl_point_dbl :: Ptr EC_GROUP -> Ptr EC_POINT -> Ptr EC_POINT -> Ptr BN_CTX -> IO CInt++foreign import ccall unsafe "EC_POINT_invert"+ ssl_point_invert :: Ptr EC_GROUP -> Ptr EC_POINT -> Ptr BN_CTX -> IO CInt++-- 1 is true, 0 false+foreign import ccall unsafe "EC_POINT_is_at_infinity"+ ssl_point_is_at_infinity :: Ptr EC_GROUP -> Ptr EC_POINT -> IO CInt+-- 1 is true, 0 false+foreign import ccall unsafe "EC_POINT_is_on_curve"+ ssl_point_is_on_curve :: Ptr EC_GROUP -> Ptr EC_POINT -> Ptr BN_CTX -> IO CInt++-- 1 not equal, 0 equal, -1 error+foreign import ccall unsafe "EC_POINT_cmp"+ ssl_point_cmp :: Ptr EC_GROUP -> Ptr EC_POINT -> Ptr EC_POINT -> Ptr BN_CTX -> IO CInt++foreign import ccall unsafe "EC_POINT_point2oct"+ ssl_point_2oct :: Ptr EC_GROUP -> Ptr EC_POINT -> PointConversionFormT -> Ptr CUChar -> CSize -> Ptr BN_CTX -> IO CSize++foreign import ccall unsafe "EC_POINT_oct2point"+ ssl_point_oct2 :: Ptr EC_GROUP -> Ptr EC_POINT -> Ptr CUChar -> CSize -> Ptr BN_CTX -> IO CInt++foreign import ccall unsafe "EC_POINT_point2bn"+ ssl_point_2bn :: Ptr EC_GROUP -> Ptr EC_POINT -> PointConversionFormT -> Ptr BIGNUM -> Ptr BN_CTX -> IO (Ptr BIGNUM)++foreign import ccall unsafe "EC_POINT_bn2point"+ ssl_point_bn2 :: Ptr EC_GROUP -> Ptr BIGNUM -> Ptr EC_POINT -> Ptr BN_CTX -> IO (Ptr EC_POINT)++foreign import ccall unsafe "EC_POINT_point2hex"+ ssl_point_2hex :: Ptr EC_GROUP -> Ptr EC_POINT -> PointConversionFormT -> Ptr BN_CTX -> IO (Ptr CChar)++foreign import ccall unsafe "EC_POINT_hex2point"+ ssl_point_hex2 :: Ptr EC_GROUP -> Ptr CChar -> Ptr EC_POINT -> Ptr BN_CTX -> IO (Ptr EC_POINT)++foreign import ccall unsafe "EC_POINT_set_to_infinity"+ ssl_point_set_to_infinity :: Ptr EC_GROUP -> Ptr EC_POINT -> IO CInt++foreign import ccall unsafe "EC_POINT_set_Jprojective_coordinates_GFp"+ ssl_point_set_Jprojective_coordinates_GFp :: Ptr EC_GROUP -> Ptr EC_POINT -> Ptr BIGNUM -> Ptr BIGNUM -> Ptr BIGNUM -> Ptr BN_CTX -> IO CInt++foreign import ccall unsafe "EC_POINT_get_Jprojective_coordinates_GFp"+ ssl_point_get_Jprojective_coordinates_GFp :: Ptr EC_GROUP -> Ptr EC_POINT -> Ptr BIGNUM -> Ptr BIGNUM -> Ptr BIGNUM -> Ptr BN_CTX -> IO CInt++foreign import ccall unsafe "EC_POINT_set_affine_coordinates_GFp"+ ssl_point_set_affine_coordinates_GFp :: Ptr EC_GROUP -> Ptr EC_POINT -> Ptr BIGNUM -> Ptr BIGNUM -> Ptr BN_CTX -> IO CInt++foreign import ccall unsafe "EC_POINT_get_affine_coordinates_GFp"+ ssl_point_get_affine_coordinates_GFp :: Ptr EC_GROUP -> Ptr EC_POINT -> Ptr BIGNUM -> Ptr BIGNUM -> Ptr BN_CTX -> IO CInt++foreign import ccall unsafe "EC_POINT_set_affine_coordinates_GF2m"+ ssl_point_set_affine_coordinates_GF2m :: Ptr EC_GROUP -> Ptr EC_POINT -> Ptr BIGNUM -> Ptr BIGNUM -> Ptr BN_CTX -> IO CInt++foreign import ccall unsafe "EC_POINT_get_affine_coordinates_GF2m"+ ssl_point_get_affine_coordinates_GF2m :: Ptr EC_GROUP -> Ptr EC_POINT -> Ptr BIGNUM -> Ptr BIGNUM -> Ptr BN_CTX -> IO CInt++foreign import ccall unsafe "EC_POINT_set_compressed_coordinates_GFp"+ ssl_point_set_compressed_coordinates_GFp :: Ptr EC_GROUP -> Ptr EC_POINT -> Ptr BIGNUM -> CInt -> Ptr BN_CTX -> IO CInt++foreign import ccall unsafe "EC_POINT_set_compressed_coordinates_GF2m"+ ssl_point_set_compressed_coordinates_GF2m :: Ptr EC_GROUP -> Ptr EC_POINT -> Ptr BIGNUM -> CInt -> Ptr BN_CTX -> IO CInt++-------------------------------+-- EC_KEY related functions++foreign import ccall unsafe "EC_KEY_new"+ ssl_key_new :: IO (Ptr EC_KEY)++foreign import ccall unsafe "&EC_KEY_free"+ ssl_key_free :: FunPtr (Ptr EC_KEY -> IO ())++foreign import ccall unsafe "EC_KEY_get0_group"+ ssl_key_get0_group :: Ptr EC_KEY -> IO (Ptr EC_GROUP)++foreign import ccall unsafe "EC_KEY_set_group"+ ssl_key_set_group :: Ptr EC_KEY -> Ptr EC_GROUP -> IO CInt++foreign import ccall unsafe "EC_KEY_generate_key"+ ssl_key_generate_key :: Ptr EC_KEY -> IO CInt++foreign import ccall unsafe "EC_KEY_get0_private_key"+ ssl_key_get0_private_key :: Ptr EC_KEY -> IO (Ptr BIGNUM)++foreign import ccall unsafe "EC_KEY_get0_public_key"+ ssl_key_get0_public_key :: Ptr EC_KEY -> IO (Ptr EC_POINT)++foreign import ccall unsafe "EC_KEY_set_private_key"+ ssl_key_set_private_key :: Ptr EC_KEY -> Ptr BIGNUM -> IO CInt++foreign import ccall unsafe "EC_KEY_set_public_key"+ ssl_key_set_public_key :: Ptr EC_KEY -> Ptr EC_POINT -> IO CInt
+ Crypto/OpenSSL/Misc.hs view
@@ -0,0 +1,38 @@+{-# LANGUAGE DeriveDataTypeable #-}+module Crypto.OpenSSL.Misc+ ( OpenSSLError(..)+ , OpenSSLGcmError(..)+ , check+ , checkCtx+ , doIO+ ) where++import Control.Exception+import Data.Typeable+import Foreign.C.Types (CInt)+import System.IO.Unsafe (unsafePerformIO)++data OpenSSLError = OpenSSLError Int+ deriving (Show,Read,Eq,Typeable)++instance Exception OpenSSLError++newtype OpenSSLGcmError = OpenSSLGcmError String+ deriving (Show,Read,Eq,Typeable)++instance Exception OpenSSLGcmError++check :: IO CInt -> IO ()+check f = do+ r <- f+ if r == 0+ then throwIO $ OpenSSLError (fromIntegral r)+ else return ()++checkCtx :: Exception e => (String -> e) -> String -> IO CInt -> IO ()+checkCtx exnConstr n f = do+ r <- f+ if (r /= 1) then throwIO $ exnConstr n else return ()++doIO :: IO a -> a+doIO = unsafePerformIO
+ LICENSE view
@@ -0,0 +1,29 @@+Copyright (c) 2015-2016 Vincent Hanquez <vincent@snarc.org>+Copyright (c) 2013-2015 PivotCloud, Inc.++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:++1. Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.+2. Redistributions in binary form must reproduce the above copyright+ notice, this list of conditions and the following disclaimer in the+ documentation and/or other materials provided with the distribution.+3. Neither the name of the author nor the names of his contributors+ may be used to endorse or promote products derived from this software+ without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS AS IS'' AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF+SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,60 @@+cryptonite-openssl+==================++[](https://travis-ci.org/vincenthz/cryptonite-openssl)+[](http://en.wikipedia.org/wiki/BSD_licenses)+[](http://haskell.org)++Support for OpenSSL based crypto operations in Haskell, as a bolt-in to [cryptonite](http://hackage.haskell.org/package/cryptonite)++If you have no idea what're you doing, please do not use this directly, rely on+higher level protocols or higher level implementation.++Documentation: [cryptonite-openssl on hackage](http://hackage.haskell.org/package/cryptonite-openssl)++Support+-------++cryptonite-openssl supports the following platform:++* Windows >= 7+* OSX >= 10.8+* Linux++On the following architectures:++* x86-64+* i386++On the following haskell versions:++* GHC 7.0.x+* GHC 7.4.x+* GHC 7.6.x+* GHC 7.8.x+* GHC 7.10.x++Further platforms and architectures probably works too, but until maintainer(s) don't have regular+access to them, we can't commit for further support++Building on MacOS X+-------------------++* using openssl system library+* using alternative installation++Building on windows+-------------------++You need the C++ runtime :++* http://www.microsoft.com/downloads/details.aspx?familyid=bd2a6171-e2d6-4230-b809-9a8d7548c1b6++And the right installation of OpenSSL. Some binary installations are available here:++* https://slproweb.com/products/Win32OpenSSL.html++Building with alternative OpenSSL - BoringSSL, LibreSSL+-------------------------------------------------------++TODO
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ cryptonite-openssl.cabal view
@@ -0,0 +1,60 @@+Name: cryptonite-openssl+Version: 0.1+Synopsis: Crypto stuff using OpenSSL cryptographic library+Description: cryptography+License: BSD3+License-file: LICENSE+Copyright: Vincent Hanquez <vincent@snarc.org>+Author: Vincent Hanquez <vincent@snarc.org>+Maintainer: vincent@snarc.org+Category: Cryptography+Stability: experimental+Build-Type: Simple+Homepage: https://github.com/haskell-crypto/cryptonite-openssl+Bug-reports: https://github.com/haskell-crypto/cryptonite-openssl/issues+Cabal-Version: >=1.10+extra-doc-files: README.md++source-repository head+ type: git+ location: https://github.com/haskell-crypto/cryptonite-openssl++Library+ Exposed-modules: Crypto.OpenSSL+ Crypto.OpenSSL.ECC+ Crypto.OpenSSL.BN+ Crypto.OpenSSL.AES+ Other-modules: Crypto.OpenSSL.ECC.Foreign+ , Crypto.OpenSSL.BN.Foreign+ , Crypto.OpenSSL.AES.Foreign+ , Crypto.OpenSSL.Misc+ , Crypto.OpenSSL.ASN1+ Build-depends: base >= 4.3 && < 5+ , bytestring+ , memory+ ghc-options: -Wall -fwarn-tabs -optc-O3+ default-language: Haskell2010+ if os(mingw32) || os(windows)+ extra-libraries: eay32, ssl32+ else+ if os(osx)+ extra-libraries: crypto+ extra-lib-dirs: /usr/local/lib+ include-dirs: /usr/local/include+ else+ extra-libraries: crypto+ cpp-options: -DUSE_OPENSSL++Test-Suite test-cryptonite-openssl+ type: exitcode-stdio-1.0+ hs-source-dirs: tests+ Main-is: Tests.hs+ Build-Depends: base >= 3 && < 5+ , bytestring+ , tasty+ , tasty-quickcheck+ , tasty-hunit+ , tasty-kat+ , cryptonite+ ghc-options: -Wall -fno-warn-orphans -fno-warn-missing-signatures -rtsopts+ default-language: Haskell2010
+ tests/Tests.hs view
@@ -0,0 +1,10 @@+{-# LANGUAGE OverloadedStrings #-}+module Main where++import Imports++tests = testGroup "cryptonite-openssl"+ [+ ]++main = defaultMain tests