crypto-pubkey 0.2.5 → 0.2.6
raw patch · 5 files changed
+111/−51 lines, 5 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
+ Crypto.PubKey.ECC.Prim: isPointAtInfinity :: Point -> Bool
Files
- Benchs/Bench.hs +40/−36
- Crypto/PubKey/ECC/Prim.hs +25/−11
- Tests/EccArithmetic.hs +43/−0
- Tests/Tests.hs +2/−3
- crypto-pubkey.cabal +1/−1
Benchs/Bench.hs view
@@ -36,46 +36,50 @@ ecdsaSignatureP = fst $ ECDSA.sign rng ecdsaPrivatekeyP SHA1.hash bs ecdsaSignatureB = fst $ ECDSA.sign rng ecdsaPrivatekeyB SHA1.hash bs defaultMain- [ bgroup "RSA PKCS15"- [ bench "encryption" $ nf (right . fst . PKCS15.encrypt rng rsaPublickey) bs- , bgroup "decryption"- [ bench "slow" $ nf (right . PKCS15.decrypt Nothing privateKeySlow) encryptedMsgPKCS- , bench "fast" $ nf (right . PKCS15.decrypt Nothing rsaPrivatekey) encryptedMsgPKCS- , bench "slow+blinding" $ nf (right . PKCS15.decrypt (Just blinder) privateKeySlow) encryptedMsgPKCS- , bench "fast+blinding" $ nf (right . PKCS15.decrypt (Just blinder) rsaPrivatekey) encryptedMsgPKCS+ [ bgroup "RSA"+ [ bgroup "PKCS15"+ [ bench "encryption" $ nf (right . fst . PKCS15.encrypt rng rsaPublickey) bs+ , bgroup "decryption"+ [ bench "slow" $ nf (right . PKCS15.decrypt Nothing privateKeySlow) encryptedMsgPKCS+ , bench "fast" $ nf (right . PKCS15.decrypt Nothing rsaPrivatekey) encryptedMsgPKCS+ , bench "slow+blinding" $ nf (right . PKCS15.decrypt (Just blinder) privateKeySlow) encryptedMsgPKCS+ , bench "fast+blinding" $ nf (right . PKCS15.decrypt (Just blinder) rsaPrivatekey) encryptedMsgPKCS+ ]+ , bgroup "signing"+ [ bench "slow" $ nf (right . PKCS15.sign Nothing hashDescrSHA1 privateKeySlow) bs+ , bench "fast" $ nf (right . PKCS15.sign Nothing hashDescrSHA1 rsaPrivatekey) bs+ , bench "slow+blinding" $ nf (right . PKCS15.sign (Just blinder) hashDescrSHA1 privateKeySlow) bs+ , bench "fast+blinding" $ nf (right . PKCS15.sign (Just blinder) hashDescrSHA1 rsaPrivatekey) bs+ ]+ , bench "verify" $ nf (PKCS15.verify hashDescrSHA1 rsaPublickey bs) signedMsgPKCS ]- , bgroup "signing"- [ bench "slow" $ nf (right . PKCS15.sign Nothing hashDescrSHA1 privateKeySlow) bs- , bench "fast" $ nf (right . PKCS15.sign Nothing hashDescrSHA1 rsaPrivatekey) bs- , bench "slow+blinding" $ nf (right . PKCS15.sign (Just blinder) hashDescrSHA1 privateKeySlow) bs- , bench "fast+blinding" $ nf (right . PKCS15.sign (Just blinder) hashDescrSHA1 rsaPrivatekey) bs+ , bgroup "OAEP"+ [ bench "encryption" $ nf (right . fst . OAEP.encrypt rng oaepParams rsaPublickey) bs+ , bgroup "decryption"+ [ bench "slow" $ nf (right . OAEP.decrypt Nothing oaepParams privateKeySlow) encryptedMsgOAEP+ , bench "fast" $ nf (right . OAEP.decrypt Nothing oaepParams rsaPrivatekey) encryptedMsgOAEP+ , bench "slow+blinding" $ nf (right . OAEP.decrypt (Just blinder) oaepParams privateKeySlow) encryptedMsgOAEP+ , bench "fast+blinding" $ nf (right . OAEP.decrypt (Just blinder) oaepParams rsaPrivatekey) encryptedMsgOAEP+ ] ]- , bench "verify" $ nf (PKCS15.verify hashDescrSHA1 rsaPublickey bs) signedMsgPKCS- ]- , bgroup "RSA OAEP"- [ bench "encryption" $ nf (right . fst . OAEP.encrypt rng oaepParams rsaPublickey) bs- , bgroup "decryption"- [ bench "slow" $ nf (right . OAEP.decrypt Nothing oaepParams privateKeySlow) encryptedMsgOAEP- , bench "fast" $ nf (right . OAEP.decrypt Nothing oaepParams rsaPrivatekey) encryptedMsgOAEP- , bench "slow+blinding" $ nf (right . OAEP.decrypt (Just blinder) oaepParams privateKeySlow) encryptedMsgOAEP- , bench "fast+blinding" $ nf (right . OAEP.decrypt (Just blinder) oaepParams rsaPrivatekey) encryptedMsgOAEP+ , bgroup "PSS"+ [ bgroup "signing"+ [ bench "slow" $ nf (right . fst . PSS.sign rng Nothing pssParams privateKeySlow) bs+ , bench "fast" $ nf (right . fst . PSS.sign rng Nothing pssParams rsaPrivatekey) bs+ , bench "slow+blinding" $ nf (right . fst . PSS.sign rng (Just blinder) pssParams privateKeySlow) bs+ , bench "fast+blinding" $ nf (right . fst . PSS.sign rng (Just blinder) pssParams rsaPrivatekey) bs+ ]+ , bench "verify" $ nf (PSS.verify pssParams rsaPublickey bs) signedMsgPSS ] ]- , bgroup "RSA PSS"- [ bgroup "signing"- [ bench "slow" $ nf (right . fst . PSS.sign rng Nothing pssParams privateKeySlow) bs- , bench "fast" $ nf (right . fst . PSS.sign rng Nothing pssParams rsaPrivatekey) bs- , bench "slow+blinding" $ nf (right . fst . PSS.sign rng (Just blinder) pssParams privateKeySlow) bs- , bench "fast+blinding" $ nf (right . fst . PSS.sign rng (Just blinder) pssParams rsaPrivatekey) bs+ , bgroup "ECDSA"+ [ bgroup "secp160r1"+ [ bench "sign" $ nf (fst . ECDSA.sign rng ecdsaPrivatekeyP SHA1.hash) bs+ , bench "verify" $ nf (ECDSA.verify SHA1.hash ecdsaPublickeyP ecdsaSignatureP) bs ]- , bench "verify" $ nf (PSS.verify pssParams rsaPublickey bs) signedMsgPSS- ]- , bgroup "ECDSA secp160r1"- [ bench "sign" $ nf (fst . ECDSA.sign rng ecdsaPrivatekeyP SHA1.hash) bs- , bench "verify" $ nf (ECDSA.verify SHA1.hash ecdsaPublickeyP ecdsaSignatureP) bs- ]- , bgroup "ECDSA sect163k1"- [ bench "sign" $ nf (fst . ECDSA.sign rng ecdsaPrivatekeyB SHA1.hash) bs- , bench "verify" $ nf (ECDSA.verify SHA1.hash ecdsaPublickeyB ecdsaSignatureB) bs+ , bgroup "sect163k1"+ [ bench "sign" $ nf (fst . ECDSA.sign rng ecdsaPrivatekeyB SHA1.hash) bs+ , bench "verify" $ nf (ECDSA.verify SHA1.hash ecdsaPublickeyB ecdsaSignatureB) bs+ ] ] ]
Crypto/PubKey/ECC/Prim.hs view
@@ -5,6 +5,7 @@ ( pointAdd , pointDouble , pointMul+ , isPointAtInfinity ) where import Data.Maybe@@ -12,6 +13,8 @@ import Crypto.Number.F2m import Crypto.Types.PubKey.ECC +--TODO: Extract helper function for `fromMaybe PointO...`+ -- | Elliptic Curve point addition. -- -- /WARNING:/ Vulnerable to timing attacks.@@ -22,10 +25,11 @@ pointAdd c@(CurveFP (CurvePrime pr _)) p@(Point xp yp) q@(Point xq yq) | p == Point xq (-yq) = PointO | p == q = pointDouble c p- | otherwise = let s = divmod (yp - yq) (xp - xq) pr- xr = (s ^ (2::Int) - xp - xq) `mod` pr- yr = (s * (xp - xr) - yp) `mod` pr- in Point xr yr+ | otherwise = fromMaybe PointO $ do+ s <- divmod (yp - yq) (xp - xq) pr+ let xr = (s ^ (2::Int) - xp - xq) `mod` pr+ yr = (s * (xp - xr) - yp) `mod` pr+ return $ Point xr yr pointAdd c@(CurveF2m (CurveBinary fx cc)) p@(Point xp yp) q@(Point xq yq) | p == Point xq (xq `addF2m` yq) = PointO | p == q = pointDouble c p@@ -41,11 +45,11 @@ -- /WARNING:/ Vulnerable to timing attacks. pointDouble :: Curve -> Point -> Point pointDouble _ PointO = PointO-pointDouble (CurveFP (CurvePrime pr cc)) (Point xp yp) =- let l = divmod (3 * xp ^ (2::Int) + a) (2 * yp) pr- xr = (l ^ (2::Int) - 2 * xp) `mod` pr+pointDouble (CurveFP (CurvePrime pr cc)) (Point xp yp) = fromMaybe PointO $ do+ l <- divmod (3 * xp ^ (2::Int) + a) (2 * yp) pr+ let xr = (l ^ (2::Int) - 2 * xp) `mod` pr yr = (l * (xp - xr) - yp) `mod` pr- in Point xr yr+ return $ Point xr yr where a = ecc_a cc pointDouble (CurveF2m (CurveBinary fx cc)) (Point xp yp) = fromMaybe PointO $ do s <- return . addF2m xp =<< divF2m fx yp xp@@ -58,11 +62,21 @@ -- -- /WARNING:/ Vulnerable to timing attacks. pointMul :: Curve -> Integer -> Point -> Point-pointMul c n p+pointMul _ _ PointO = PointO+pointMul c n p@(Point xp yp)+ | n < 0 = pointMul c (-n) (Point xp (-yp))+ | n == 0 = PointO | n == 1 = p | odd n = pointAdd c p (pointMul c (n - 1) p) | otherwise = pointMul c (n `div` 2) (pointDouble c p) +-- | Check if a point is the point at infinity.+isPointAtInfinity :: Point -> Bool+isPointAtInfinity PointO = True+isPointAtInfinity _ = False+ -- | div and mod-divmod :: Integer -> Integer -> Integer -> Integer-divmod y x m = y * fromJust (inverse (x `mod` m) m) `mod` m+divmod :: Integer -> Integer -> Integer -> Maybe Integer+divmod y x m = do+ i <- inverse (x `mod` m) m+ return $ y * i `mod` m
+ Tests/EccArithmetic.hs view
@@ -0,0 +1,43 @@+module EccArithmetic (properties_ecc_arithmetic) where++import Test.Framework.Providers.QuickCheck2 (testProperty)+import Test.QuickCheck+import Test.QuickCheck.Test++import Crypto.Types.PubKey.ECC+import Crypto.PubKey.ECC.Generate+import Crypto.PubKey.ECC.Prim++data GeneratePoint1 = GeneratePoint1 Curve Point+ deriving (Show,Eq)+data GeneratePoint2 = GeneratePoint2 Curve Point Point+ deriving (Show,Eq)++arbitraryPoint curve = do+ sec <- choose (1,n)+ return $ pointMul curve sec g+ where common = common_curve curve+ n = ecc_n common+ g = ecc_g common++instance Arbitrary Curve where+ arbitrary = elements $ map getCurveByName $ enumFrom SEC_p112r1++instance Arbitrary GeneratePoint1 where+ arbitrary = do+ curve <- arbitrary+ p1 <- arbitraryPoint curve+ return $ GeneratePoint1 curve p1++instance Arbitrary GeneratePoint2 where+ arbitrary = do+ curve <- arbitrary+ p1 <- arbitraryPoint curve+ p2 <- arbitraryPoint curve+ return $ GeneratePoint2 curve p1 p2++properties_ecc_arithmetic =+ [ testProperty "commutative" $ \(GeneratePoint2 curve p1 p2) ->+ pointAdd curve p1 p2 == pointAdd curve p2 p1+ , testProperty "add-neutral" $ \(GeneratePoint1 curve p1) -> pointAdd curve p1 PointO == p1+ ]
Tests/Tests.hs view
@@ -33,6 +33,7 @@ import RNG import KAT import PregenKeys+import EccArithmetic withAleasInteger :: Rng -> Seed -> (Rng -> (a,Rng)) -> a withAleasInteger rng (Seed i) f = fst $ f $ reseed (i2osp (if i < 0 then -i else i)) rng@@ -136,9 +137,6 @@ let q = generateQ curve d return $ ECDSA.KeyPair curve q d -instance Arbitrary Curve where- arbitrary = elements $ map getCurveByName $ enumFrom SEC_p112r1- instance Arbitrary DH.PrivateNumber where arbitrary = fromIntegral <$> (suchThat (arbitrary :: Gen Integer) (\x -> x >= 1)) @@ -173,6 +171,7 @@ asymOtherTests = testGroup "assymetric other tests" [ testProperty "DH valid" prop_dh_valid+ , testGroup "ECC arithmetic" properties_ecc_arithmetic ] main = defaultMain
crypto-pubkey.cabal view
@@ -1,5 +1,5 @@ Name: crypto-pubkey-Version: 0.2.5+Version: 0.2.6 Description: Public Key cryptography .