diff --git a/Crypto/OpenSSL/BN.hs b/Crypto/OpenSSL/BN.hs --- a/Crypto/OpenSSL/BN.hs +++ b/Crypto/OpenSSL/BN.hs @@ -5,9 +5,8 @@ import Crypto.OpenSSL.Misc import Foreign.Ptr import Foreign.ForeignPtr +import Crypto.Number.Serialize -import Data.Bits -import qualified Data.ByteString as B import qualified Data.ByteString.Internal as B withIntegerAsBN :: Integer -> (Ptr BIGNUM -> IO a) -> IO a @@ -17,11 +16,7 @@ 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) + bs = i2osp i bnToInt :: Ptr BIGNUM -> IO Integer bnToInt bn = do @@ -29,7 +24,6 @@ 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 diff --git a/Crypto/OpenSSL/BN/Foreign.hs b/Crypto/OpenSSL/BN/Foreign.hs --- a/Crypto/OpenSSL/BN/Foreign.hs +++ b/Crypto/OpenSSL/BN/Foreign.hs @@ -28,7 +28,67 @@ foreign import ccall unsafe "BN_bin2bn" ssl_bn_bin2 :: Ptr CUChar -> CInt -> Ptr BIGNUM -> IO (Ptr BIGNUM) --- bn_num_bytes is a macro, +-- setter + +foreign import ccall unsafe "BN_set_word" + ssl_bn_set_word :: Ptr BIGNUM -> CULong -> IO CInt + +ssl_bn_zero :: Ptr BIGNUM -> IO CInt +ssl_bn_zero p = ssl_bn_set_word p 0 + +ssl_bn_one :: Ptr BIGNUM -> IO CInt +ssl_bn_one p = ssl_bn_set_word p 1 + +-- arithmetic operations + +foreign import ccall unsafe "BN_add" -- r = a + b + ssl_bn_add :: Ptr BIGNUM -> Ptr BIGNUM -> Ptr BIGNUM -> IO CInt + +foreign import ccall unsafe "BN_sub" -- r = a - b + ssl_bn_sub :: Ptr BIGNUM -> Ptr BIGNUM -> Ptr BIGNUM -> IO CInt + +foreign import ccall unsafe "BN_mul" -- r = a * b + ssl_bn_mul :: Ptr BIGNUM -> Ptr BIGNUM -> Ptr BIGNUM -> Ptr BN_CTX -> IO CInt + +foreign import ccall unsafe "BN_sqr" -- r = sqrt(a) + ssl_bn_sqr :: Ptr BIGNUM -> Ptr BIGNUM -> Ptr BN_CTX -> IO CInt + +foreign import ccall unsafe "BN_div" -- div,rem = a / b + ssl_bn_div :: Ptr BIGNUM -> Ptr BIGNUM -> Ptr BIGNUM -> Ptr BIGNUM -> Ptr BN_CTX -> IO CInt + +--foreign import ccall unsafe "BN_mod" -- r = a % b +-- ssl_bn_mod :: Ptr BIGNUM -> Ptr BIGNUM -> Ptr BIGNUM -> Ptr BN_CTX -> IO CInt + +foreign import ccall unsafe "BN_nnmod" -- r = a % b + ssl_bn_nnmod :: Ptr BIGNUM -> Ptr BIGNUM -> Ptr BIGNUM -> Ptr BN_CTX -> IO CInt + +-- arithmetic modular operations + +foreign import ccall unsafe "BN_mod_add" -- r = a + b [m] + ssl_bn_mod_add :: Ptr BIGNUM -> Ptr BIGNUM -> Ptr BIGNUM -> Ptr BIGNUM -> Ptr BN_CTX -> IO CInt + +foreign import ccall unsafe "BN_mod_sub" -- r = a - b [m] + ssl_bn_mod_sub :: Ptr BIGNUM -> Ptr BIGNUM -> Ptr BIGNUM -> Ptr BIGNUM -> Ptr BN_CTX -> IO CInt + +foreign import ccall unsafe "BN_mod_mul" -- r = a * b [m] + ssl_bn_mod_mul :: Ptr BIGNUM -> Ptr BIGNUM -> Ptr BIGNUM -> Ptr BIGNUM -> Ptr BN_CTX -> IO CInt + +foreign import ccall unsafe "BN_mod_sqr" -- r = sqrt a [m] + ssl_bn_mod_sqr :: Ptr BIGNUM -> Ptr BIGNUM -> Ptr BIGNUM -> Ptr BN_CTX -> IO CInt + +-- exponantiations + +foreign import ccall unsafe "BN_exp" -- r = a^p + ssl_bn_exp :: Ptr BIGNUM -> Ptr BIGNUM -> Ptr BIGNUM -> Ptr BN_CTX -> IO CInt + +foreign import ccall unsafe "BN_mod_exp" -- r = a^p [m] + ssl_bn_mod_exp :: Ptr BIGNUM -> Ptr BIGNUM -> Ptr BIGNUM -> Ptr BIGNUM -> Ptr BN_CTX -> IO CInt + +foreign import ccall unsafe "BN_gcd" -- r = gcd(a,b) + ssl_bn_gcd :: Ptr BIGNUM -> Ptr BIGNUM -> Ptr BIGNUM -> Ptr BN_CTX -> IO CInt + + +-- 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 diff --git a/Crypto/OpenSSL/ECC.hs b/Crypto/OpenSSL/ECC.hs --- a/Crypto/OpenSSL/ECC.hs +++ b/Crypto/OpenSSL/ECC.hs @@ -20,9 +20,12 @@ , ecGroupGetCurveGF2m -- * EcPoint arithmetic , ecPointAdd + , ecPointsSum , ecPointDbl , ecPointMul , ecPointMulWithGenerator + , ecPointsMulAndSum + , ecPointsMulOfPowerAndSum , ecPointGeneratorMul , ecPointInvert , ecPointInfinity @@ -45,11 +48,13 @@ , ecKeyToPair ) where -import Control.Monad (void) +import Control.Monad (void, forM_) import Control.Applicative +import Control.Exception (bracket) import Crypto.OpenSSL.ECC.Foreign import Crypto.OpenSSL.ASN1 import Crypto.OpenSSL.BN +import Crypto.OpenSSL.BN.Foreign import Crypto.OpenSSL.Misc import Foreign.ForeignPtr import Foreign.Ptr @@ -94,6 +99,10 @@ f ptr EcPoint <$> newForeignPtr ssl_point_free_funptr ptr +withPointTemp :: Ptr EC_GROUP -> (Ptr EC_POINT -> IO a) -> IO a +withPointTemp grp f = bracket (ssl_point_new grp) (ssl_point_free) f + + -- | try to get a curve group from an ASN1 description string (OID) -- -- e.g. @@ -248,6 +257,17 @@ withPointNew gptr $ \r -> check $ ssl_point_add gptr r p1ptr p2ptr bnCtx {-# NOINLINE ecPointAdd #-} +-- | Add many points together +ecPointsSum :: EcGroup -> [EcPoint] -> EcPoint +ecPointsSum g [] = ecPointInfinity g +ecPointsSum (EcGroup g) ((EcPoint x):xs) = doIO $ + withForeignPtr g $ \gptr -> + withForeignPtr x $ \xptr -> + withBnCtxNew $ \bnCtx -> + withPointDup gptr xptr $ \rptr -> + forM_ xs $ \(EcPoint p) -> withForeignPtr p $ \pptr -> do + check $ ssl_point_add gptr rptr rptr pptr bnCtx + -- | compute the doubling of the point p, r = p^2 ecPointDbl :: EcGroup -> EcPoint -> EcPoint ecPointDbl (EcGroup g) (EcPoint p) = doIO $ @@ -270,6 +290,47 @@ withPointNew gptr $ \r -> check $ ssl_point_mul gptr r nullPtr qptr bnM bnCtx {-# NOINLINE ecPointMul #-} +-- | compute sum (\(q,m) -> q * m) l +ecPointsMulAndSum :: EcGroup -> [(EcPoint, Integer)] -> EcPoint +ecPointsMulAndSum g [] = ecPointInfinity g +ecPointsMulAndSum (EcGroup g) l = doIO $ + withForeignPtr g $ \gptr -> + withBnCtxNew $ \bnCtx -> + withPointNew gptr $ \rptr -> + withPointTemp gptr $ \tptr -> do + check $ ssl_point_set_to_infinity gptr rptr + forM_ l $ \(EcPoint p,m) -> do + withForeignPtr p $ \pptr -> withIntegerAsBN m $ \bnM -> check $ ssl_point_mul gptr tptr nullPtr pptr bnM bnCtx + check $ ssl_point_add gptr rptr rptr tptr bnCtx + +-- | Compute the sum of the point to the nth power +-- +-- > f [p1,p2,..,pi] n = p1 * (n ^ 0) + p2 * (n ^ 1) + .. + pi * (n ^ i-1) +ecPointsMulOfPowerAndSum :: EcGroup -> [EcPoint] -> Integer -> EcPoint +ecPointsMulOfPowerAndSum g [] _ = ecPointInfinity g +ecPointsMulOfPowerAndSum (EcGroup g) l startn = doIO $ + withForeignPtr g $ \gptr -> + withBnCtxNew $ \bnCtx -> + withIntegerAsBN startn $ \n -> + withBnNew $ \nIter -> + withBnNew $ \gMod -> + withPointNew gptr $ \rptr -> + withPointTemp gptr $ \tptr -> do + check $ ssl_group_get_order gptr gMod bnCtx + check $ ssl_bn_one nIter + start gptr gMod bnCtx n nIter rptr tptr + where + start gptr gMod bnCtx n nIter rptr tptr = loop l + where + loop [] = return () + loop (EcPoint x:xs) = do + -- r += x * current-n + withForeignPtr x $ \xptr -> check $ ssl_point_mul gptr tptr nullPtr xptr nIter bnCtx + check $ ssl_point_add gptr rptr rptr tptr bnCtx + -- nIter = nIter * n + check $ ssl_bn_mod_mul nIter nIter n gMod bnCtx + loop xs + -- | compute generator * n + q * m ecPointMulWithGenerator :: EcGroup -> Integer -- ^ n @@ -328,6 +389,7 @@ ((==) 1 <$> ssl_point_is_on_curve gptr pptr bnCtx) {-# NOINLINE ecPointIsOnCurve #-} +-- | Create a binary represention of a point using the specific format ecPointToOct :: B.ByteArray outBytes => EcGroup -> EcPoint -> PointConversionForm -> outBytes ecPointToOct (EcGroup g) (EcPoint p) pconv = doIO $ withForeignPtr g $ \gptr -> @@ -339,6 +401,7 @@ where form = ecPointConversionToC pconv {-# NOINLINE ecPointToOct #-} +-- | Try to parse a binary representation to a point ecPointFromOct :: B.ByteArrayAccess inBytes => EcGroup -> inBytes -> Either String EcPoint ecPointFromOct (EcGroup g) bs = doIO $ do (opensslRet,point) <- withForeignPtr g $ \gptr -> @@ -372,6 +435,7 @@ (,,) <$> bnToInt bnX <*> bnToInt bnY <*> bnToInt bnZ {-# NOINLINE ecPointToJProjectiveGFp #-} +-- | Convert a (x,y) to a point representation on a prime curve. ecPointFromAffineGFp :: EcGroup -> (Integer, Integer) -> EcPoint ecPointFromAffineGFp (EcGroup g) (x,y) = doIO $ withForeignPtr g $ \gptr -> @@ -382,6 +446,7 @@ check $ ssl_point_set_affine_coordinates_GFp gptr r bnX bnY bnCtx {-# NOINLINE ecPointFromAffineGFp #-} +-- | Convert a point of a prime curve to affine representation (x,y) ecPointToAffineGFp :: EcGroup -> EcPoint -> (Integer, Integer) ecPointToAffineGFp (EcGroup g) (EcPoint p) = doIO $ withForeignPtr g $ \gptr -> diff --git a/Crypto/OpenSSL/Misc.hs b/Crypto/OpenSSL/Misc.hs --- a/Crypto/OpenSSL/Misc.hs +++ b/Crypto/OpenSSL/Misc.hs @@ -28,6 +28,7 @@ if r == 0 then throwIO $ OpenSSLError (fromIntegral r) else return () +{-# INLINE check #-} checkCtx :: Exception e => (String -> e) -> String -> IO CInt -> IO () checkCtx exnConstr n f = do diff --git a/cryptonite-openssl.cabal b/cryptonite-openssl.cabal --- a/cryptonite-openssl.cabal +++ b/cryptonite-openssl.cabal @@ -1,5 +1,5 @@ Name: cryptonite-openssl -Version: 0.2 +Version: 0.3 Synopsis: Crypto stuff using OpenSSL cryptographic library Description: cryptography License: BSD3 @@ -32,6 +32,7 @@ Build-depends: base >= 4.3 && < 5 , bytestring , memory + , cryptonite ghc-options: -Wall -fwarn-tabs -optc-O3 default-language: Haskell2010 if os(mingw32) || os(windows) @@ -47,6 +48,7 @@ type: exitcode-stdio-1.0 hs-source-dirs: tests Main-is: Tests.hs + Other-modules: Imports Build-Depends: base >= 3 && < 5 , bytestring , tasty @@ -54,5 +56,6 @@ , tasty-hunit , tasty-kat , cryptonite + , cryptonite-openssl ghc-options: -Wall -fno-warn-orphans -fno-warn-missing-signatures -rtsopts default-language: Haskell2010 diff --git a/tests/Imports.hs b/tests/Imports.hs new file mode 100644 --- /dev/null +++ b/tests/Imports.hs @@ -0,0 +1,21 @@ +module Imports + ( + -- * Individual Types + Word16, Word32, Word64 + , ByteString + -- * Modules + , module X + ) where + +import Data.Word (Word16, Word32, Word64) +import Data.ByteString (ByteString) + +import Control.Applicative as X +import Control.Monad as X +import Data.Foldable as X (foldl') +import Data.Monoid as X +import Data.ByteString.Char8 as X () + +import Test.Tasty as X +import Test.Tasty.HUnit as X +import Test.Tasty.QuickCheck as X hiding (vector) diff --git a/tests/Tests.hs b/tests/Tests.hs --- a/tests/Tests.hs +++ b/tests/Tests.hs @@ -1,10 +1,22 @@ {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ViewPatterns #-} module Main where import Imports +import Crypto.OpenSSL.ECC +p256 = maybe (error "p256 not available") id + $ ecGroupFromCurveOID "1.2.840.10045.3.1.7" + +intToInteger :: Int -> Integer +intToInteger i = toInteger i + tests = testGroup "cryptonite-openssl" - [ + [ testProperty "ring" $ \(Positive (intToInteger -> a)) (Positive (intToInteger -> b)) -> + let pa = ecPointGeneratorMul p256 a + pb = ecPointGeneratorMul p256 b + pc = ecPointGeneratorMul p256 (a+b) + in ecPointEq p256 (ecPointAdd p256 pa pb) pc ] main = defaultMain tests