From 2e926396796aca084d61c85f554bedee577970d0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sat, 7 Oct 2017 15:16:53 +0200 Subject: [PATCH 1/5] Add P256.scalarMul --- Crypto/PubKey/ECC/P256.hs | 9 +++++++++ tests/KAT_PubKey/P256.hs | 4 ++++ 2 files changed, 13 insertions(+) diff --git a/Crypto/PubKey/ECC/P256.hs b/Crypto/PubKey/ECC/P256.hs index 3c350cd..7b8c7c1 100644 --- a/Crypto/PubKey/ECC/P256.hs +++ b/Crypto/PubKey/ECC/P256.hs @@ -34,6 +34,7 @@ module Crypto.PubKey.ECC.P256 , scalarIsZero , scalarAdd , scalarSub + , scalarMul , scalarInv , scalarCmp , scalarFromBinary @@ -237,6 +238,14 @@ scalarSub a b = withNewScalarFreeze $ \d -> withScalar a $ \pa -> withScalar b $ \pb -> ccryptonite_p256e_modsub ccryptonite_SECP256r1_n pa pb d +-- | Perform multiplication between two scalars +-- +-- > a * b +scalarMul :: Scalar -> Scalar -> Scalar +scalarMul a b = + withNewScalarFreeze $ \d -> withScalar a $ \pa -> withScalar b $ \pb -> + ccryptonite_p256_modmul ccryptonite_SECP256r1_n pa 0 pb d + -- | Give the inverse of the scalar -- -- > 1 / a diff --git a/tests/KAT_PubKey/P256.hs b/tests/KAT_PubKey/P256.hs index c570548..f038133 100644 --- a/tests/KAT_PubKey/P256.hs +++ b/tests/KAT_PubKey/P256.hs @@ -92,6 +92,10 @@ tests = testGroup "P256" let v = unP256 r `mod` curveN v' = P256.scalarSub (unP256Scalar r) P256.scalarZero in v `propertyEq` p256ScalarToInteger v' + , testProperty "mul" $ \r1 r2 -> + let r = (unP256 r1 * unP256 r2) `mod` curveN + r' = P256.scalarMul (unP256Scalar r1) (unP256Scalar r2) + in r `propertyEq` p256ScalarToInteger r' , testProperty "inv" $ \r' -> let inv = inverseCoprimes (unP256 r') curveN inv' = P256.scalarInv (unP256Scalar r') From e0b201b5e703f8821cdf1850b78cd9ff7f8595d1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Mon, 16 Apr 2018 19:47:49 +0200 Subject: [PATCH 2/5] Test P256.pointMul --- tests/KAT_PubKey/P256.hs | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/tests/KAT_PubKey/P256.hs b/tests/KAT_PubKey/P256.hs index f038133..cd1356d 100644 --- a/tests/KAT_PubKey/P256.hs +++ b/tests/KAT_PubKey/P256.hs @@ -54,6 +54,9 @@ unP256Scalar (P256Scalar r) = unP256 :: P256Scalar -> Integer unP256 (P256Scalar r) = r +modP256Scalar :: P256Scalar -> P256Scalar +modP256Scalar (P256Scalar r) = P256Scalar (r `mod` curveN) + p256ScalarToInteger :: P256.Scalar -> Integer p256ScalarToInteger s = os2ip (P256.scalarToBinary s :: Bytes) @@ -122,6 +125,7 @@ tests = testGroup "P256" , testProperty "lift-to-curve" $ propertyLiftToCurve , testProperty "point-add" $ propertyPointAdd , testProperty "point-negate" $ propertyPointNegate + , testProperty "point-mul" $ propertyPointMul ] ] where @@ -151,3 +155,14 @@ tests = testGroup "P256" pe = ECC.pointMul curve (unP256 r) curveGen pR = P256.pointNegate p in ECC.pointNegate curve pe `propertyEq` (pointP256ToECC pR) + + propertyPointMul s' r' = + let s = modP256Scalar s' + r = modP256Scalar r' + p = P256.toPoint (unP256Scalar r) + pe = ECC.pointMul curve (unP256 r) curveGen + pR = P256.toPoint (P256.scalarMul (unP256Scalar s) (unP256Scalar r)) + peR = ECC.pointMul curve (unP256 s) pe + in propertyHold [ eqTest "p256" pR (P256.pointMul (unP256Scalar s) p) + , eqTest "ecc" peR (pointP256ToECC pR) + ] From bdf1a7a133aada008b3627a871f4a4aba99bed10 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sun, 22 Sep 2019 09:29:50 +0200 Subject: [PATCH 3/5] Require point equality in EllipticCurveArith This is an incompatible API change but is very useful to test properties and algorithms derived from the primitives. An ECC instance sufficiently advanced to have math primitives should implement equality too. --- Crypto/ECC.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/Crypto/ECC.hs b/Crypto/ECC.hs index 8391b5a..0d4b186 100644 --- a/Crypto/ECC.hs +++ b/Crypto/ECC.hs @@ -8,6 +8,7 @@ -- Elliptic Curve Cryptography -- {-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -98,7 +99,7 @@ class EllipticCurve curve => EllipticCurveDH curve where -- value or an exception. ecdh :: proxy curve -> Scalar curve -> Point curve -> CryptoFailable SharedSecret -class EllipticCurve curve => EllipticCurveArith curve where +class (EllipticCurve curve, Eq (Point curve)) => EllipticCurveArith curve where -- | Add points on a curve pointAdd :: proxy curve -> Point curve -> Point curve -> Point curve From db8d47a76c0b00180287c270d18ce3513004f908 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sun, 22 Sep 2019 09:32:51 +0200 Subject: [PATCH 4/5] ECC arithmetic in prime-order subgroup A type-class extension packs together additional functions related to a chosen basepoint as well as scalar serialization and arithmetic modulo the subgroup order. --- Crypto/ECC.hs | 124 ++++++++++++++++++++++++++++++++++++++++++++++++++ tests/ECC.hs | 41 +++++++++++++++++ 2 files changed, 165 insertions(+) diff --git a/Crypto/ECC.hs b/Crypto/ECC.hs index 0d4b186..b3ec8ea 100644 --- a/Crypto/ECC.hs +++ b/Crypto/ECC.hs @@ -22,6 +22,7 @@ module Crypto.ECC , EllipticCurve(..) , EllipticCurveDH(..) , EllipticCurveArith(..) + , EllipticCurveBasepointArith(..) , KeyPair(..) , SharedSecret(..) ) where @@ -35,7 +36,9 @@ import Crypto.Error import Crypto.Internal.Imports import Crypto.Internal.ByteArray (ByteArray, ByteArrayAccess, ScrubbedBytes) import qualified Crypto.Internal.ByteArray as B +import Crypto.Number.Basic (numBits) import Crypto.Number.Serialize (i2ospOf_, os2ip) +import qualified Crypto.Number.Serialize.LE as LE import qualified Crypto.PubKey.Curve25519 as X25519 import qualified Crypto.PubKey.Curve448 as X448 import Data.ByteArray (convert) @@ -112,6 +115,35 @@ class (EllipticCurve curve, Eq (Point curve)) => EllipticCurveArith curve where -- -- | Scalar Inverse -- scalarInverse :: Scalar curve -> Scalar curve +class (EllipticCurveArith curve, Eq (Scalar curve)) => EllipticCurveBasepointArith curve where + -- | Get the curve order size in bits + curveOrderBits :: proxy curve -> Int + + -- | Multiply a scalar with the curve base point + pointBaseSmul :: proxy curve -> Scalar curve -> Point curve + + -- | Multiply the point @p@ with @s2@ and add a lifted to curve value @s1@ + pointsSmulVarTime :: proxy curve -> Scalar curve -> Scalar curve -> Point curve -> Point curve + pointsSmulVarTime prx s1 s2 p = pointAdd prx (pointBaseSmul prx s1) (pointSmul prx s2 p) + + -- | Encode an elliptic curve scalar into big-endian form + encodeScalar :: ByteArray bs => proxy curve -> Scalar curve -> bs + + -- | Try to decode the big-endian form of an elliptic curve scalar + decodeScalar :: ByteArray bs => proxy curve -> bs -> CryptoFailable (Scalar curve) + + -- | Convert an elliptic curve scalar to an integer + scalarToInteger :: proxy curve -> Scalar curve -> Integer + + -- | Try to create an elliptic curve scalar from an integer + scalarFromInteger :: proxy curve -> Integer -> CryptoFailable (Scalar curve) + + -- | Add two scalars and reduce modulo the curve order + scalarAdd :: proxy curve -> Scalar curve -> Scalar curve -> Scalar curve + + -- | Multiply two scalars and reduce modulo the curve order + scalarMul :: proxy curve -> Scalar curve -> Scalar curve -> Scalar curve + -- | P256 Curve -- -- also known as P256 @@ -149,6 +181,17 @@ instance EllipticCurveDH Curve_P256R1 where ecdhRaw _ s p = SharedSecret $ P256.pointDh s p ecdh prx s p = checkNonZeroDH (ecdhRaw prx s p) +instance EllipticCurveBasepointArith Curve_P256R1 where + curveOrderBits _ = 256 + pointBaseSmul _ = P256.toPoint + pointsSmulVarTime _ = P256.pointsMulVarTime + encodeScalar _ = P256.scalarToBinary + decodeScalar _ = P256.scalarFromBinary + scalarToInteger _ = P256.scalarToInteger + scalarFromInteger _ = P256.scalarFromInteger + scalarAdd _ = P256.scalarAdd + scalarMul _ = P256.scalarMul + data Curve_P384R1 = Curve_P384R1 deriving (Show,Data) @@ -172,6 +215,17 @@ instance EllipticCurveDH Curve_P384R1 where where prx = Proxy :: Proxy Simple.SEC_p384r1 +instance EllipticCurveBasepointArith Curve_P384R1 where + curveOrderBits _ = 384 + pointBaseSmul _ = Simple.pointBaseMul + pointsSmulVarTime _ = ecPointsMulVarTime + encodeScalar _ = ecScalarToBinary + decodeScalar _ = ecScalarFromBinary + scalarToInteger _ = ecScalarToInteger + scalarFromInteger _ = ecScalarFromInteger + scalarAdd _ = ecScalarAdd + scalarMul _ = ecScalarMul + data Curve_P521R1 = Curve_P521R1 deriving (Show,Data) @@ -195,6 +249,17 @@ instance EllipticCurveDH Curve_P521R1 where where prx = Proxy :: Proxy Simple.SEC_p521r1 +instance EllipticCurveBasepointArith Curve_P521R1 where + curveOrderBits _ = 521 + pointBaseSmul _ = Simple.pointBaseMul + pointsSmulVarTime _ = ecPointsMulVarTime + encodeScalar _ = ecScalarToBinary + decodeScalar _ = ecScalarFromBinary + scalarToInteger _ = ecScalarToInteger + scalarFromInteger _ = ecScalarFromInteger + scalarAdd _ = ecScalarAdd + scalarMul _ = ecScalarMul + data Curve_X25519 = Curve_X25519 deriving (Show,Data) @@ -251,6 +316,22 @@ instance EllipticCurveArith Curve_Edwards25519 where pointNegate _ p = Edwards25519.pointNegate p pointSmul _ s p = Edwards25519.pointMul s p +instance EllipticCurveBasepointArith Curve_Edwards25519 where + curveOrderBits _ = 253 + pointBaseSmul _ = Edwards25519.toPoint + pointsSmulVarTime _ = Edwards25519.pointsMulVarTime + encodeScalar _ = B.reverse . Edwards25519.scalarEncode + decodeScalar _ bs + | B.length bs == 32 = Edwards25519.scalarDecodeLong (B.reverse bs) + | otherwise = CryptoFailed CryptoError_SecretKeySizeInvalid + scalarToInteger _ s = LE.os2ip (Edwards25519.scalarEncode s :: B.Bytes) + scalarFromInteger _ i = + case LE.i2ospOf 32 i of + Nothing -> CryptoFailed CryptoError_SecretKeySizeInvalid + Just bs -> Edwards25519.scalarDecodeLong (bs :: B.Bytes) + scalarAdd _ = Edwards25519.scalarAdd + scalarMul _ = Edwards25519.scalarMul + checkNonZeroDH :: SharedSecret -> CryptoFailable SharedSecret checkNonZeroDH s@(SharedSecret b) | B.constAllZero b = CryptoFailed CryptoError_ScalarMultiplicationInvalid @@ -282,3 +363,46 @@ decodeECPoint mxy = case B.uncons mxy of y = os2ip yb in Simple.pointFromIntegers (x,y) | otherwise -> CryptoFailed $ CryptoError_PointFormatInvalid + +ecPointsMulVarTime :: forall curve . Simple.Curve curve + => Simple.Scalar curve + -> Simple.Scalar curve -> Simple.Point curve + -> Simple.Point curve +ecPointsMulVarTime n1 = Simple.pointAddTwoMuls n1 g + where g = Simple.curveEccG $ Simple.curveParameters (Proxy :: Proxy curve) + +ecScalarFromBinary :: forall curve bs . (Simple.Curve curve, ByteArrayAccess bs) + => bs -> CryptoFailable (Simple.Scalar curve) +ecScalarFromBinary ba + | B.length ba /= size = CryptoFailed CryptoError_SecretKeySizeInvalid + | otherwise = CryptoPassed (Simple.Scalar $ os2ip ba) + where size = ecCurveOrderBytes (Proxy :: Proxy curve) + +ecScalarToBinary :: forall curve bs . (Simple.Curve curve, ByteArray bs) + => Simple.Scalar curve -> bs +ecScalarToBinary (Simple.Scalar s) = i2ospOf_ size s + where size = ecCurveOrderBytes (Proxy :: Proxy curve) + +ecScalarFromInteger :: forall curve . Simple.Curve curve + => Integer -> CryptoFailable (Simple.Scalar curve) +ecScalarFromInteger s + | numBits s > nb = CryptoFailed CryptoError_SecretKeySizeInvalid + | otherwise = CryptoPassed (Simple.Scalar s) + where nb = 8 * ecCurveOrderBytes (Proxy :: Proxy curve) + +ecScalarToInteger :: Simple.Scalar curve -> Integer +ecScalarToInteger (Simple.Scalar s) = s + +ecCurveOrderBytes :: Simple.Curve c => proxy c -> Int +ecCurveOrderBytes prx = (numBits n + 7) `div` 8 + where n = Simple.curveEccN $ Simple.curveParameters prx + +ecScalarAdd :: forall curve . Simple.Curve curve + => Simple.Scalar curve -> Simple.Scalar curve -> Simple.Scalar curve +ecScalarAdd (Simple.Scalar a) (Simple.Scalar b) = Simple.Scalar ((a + b) `mod` n) + where n = Simple.curveEccN $ Simple.curveParameters (Proxy :: Proxy curve) + +ecScalarMul :: forall curve . Simple.Curve curve + => Simple.Scalar curve -> Simple.Scalar curve -> Simple.Scalar curve +ecScalarMul (Simple.Scalar a) (Simple.Scalar b) = Simple.Scalar ((a * b) `mod` n) + where n = Simple.curveEccN $ Simple.curveParameters (Proxy :: Proxy curve) diff --git a/tests/ECC.hs b/tests/ECC.hs index c00dedc..319a276 100644 --- a/tests/ECC.hs +++ b/tests/ECC.hs @@ -24,6 +24,19 @@ instance Arbitrary Curve where , Curve ECC.Curve_X448 ] +data CurveArith = forall curve. (ECC.EllipticCurveBasepointArith curve, Show curve) => CurveArith curve + +instance Show CurveArith where + showsPrec d (CurveArith curve) = showsPrec d curve + +instance Arbitrary CurveArith where + arbitrary = elements + [ CurveArith ECC.Curve_P256R1 + , CurveArith ECC.Curve_P384R1 + , CurveArith ECC.Curve_P521R1 + , CurveArith ECC.Curve_Edwards25519 + ] + data VectorPoint = VectorPoint { vpCurve :: Curve , vpHex :: ByteString @@ -298,5 +311,33 @@ tests = testGroup "ECC" bobShared' = ECC.ecdhRaw prx (ECC.keypairGetPrivate bob) (ECC.keypairGetPublic alice) in aliceShared == bobShared && aliceShared == CryptoPassed aliceShared' && bobShared == CryptoPassed bobShared' + , testProperty "decodeScalar.encodeScalar==id" $ \testDRG (CurveArith curve) -> + let prx = Just curve -- using Maybe as Proxy + s1 = withTestDRG testDRG $ ECC.curveGenerateScalar prx + bs = ECC.encodeScalar prx s1 :: ByteString + s2 = ECC.decodeScalar prx bs + in CryptoPassed s1 == s2 + , testProperty "scalarFromInteger.scalarToInteger==id" $ \testDRG (CurveArith curve) -> + let prx = Just curve -- using Maybe as Proxy + s1 = withTestDRG testDRG $ ECC.curveGenerateScalar prx + bs = ECC.scalarToInteger prx s1 + s2 = ECC.scalarFromInteger prx bs + in CryptoPassed s1 == s2 + , localOption (QuickCheckTests 20) $ testProperty "(a + b).P = a.P + b.P" $ \testDRG (CurveArith curve) -> + let prx = Just curve -- using Maybe as Proxy + (s, a, b) = withTestDRG testDRG $ + (,,) <$> ECC.curveGenerateScalar prx + <*> ECC.curveGenerateScalar prx + <*> ECC.curveGenerateScalar prx + p = ECC.pointBaseSmul prx s + in ECC.pointSmul prx (ECC.scalarAdd prx a b) p == ECC.pointAdd prx (ECC.pointSmul prx a p) (ECC.pointSmul prx b p) + , localOption (QuickCheckTests 20) $ testProperty "(a * b).P = a.(b.P)" $ \testDRG (CurveArith curve) -> + let prx = Just curve -- using Maybe as Proxy + (s, a, b) = withTestDRG testDRG $ + (,,) <$> ECC.curveGenerateScalar prx + <*> ECC.curveGenerateScalar prx + <*> ECC.curveGenerateScalar prx + p = ECC.pointBaseSmul prx s + in ECC.pointSmul prx (ECC.scalarMul prx a b) p == ECC.pointSmul prx a (ECC.pointSmul prx b p) ] ] From 6f2a59e47066044f8b12a411140b9d526cc5f57d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sat, 28 Sep 2019 17:45:16 +0200 Subject: [PATCH 5/5] Apply hlint suggestions --- Crypto/ECC.hs | 8 ++++---- Crypto/PubKey/ECC/P256.hs | 8 ++++---- tests/ECC.hs | 2 +- tests/KAT_PubKey/P256.hs | 10 +++++----- 4 files changed, 14 insertions(+), 14 deletions(-) diff --git a/Crypto/ECC.hs b/Crypto/ECC.hs index b3ec8ea..855ea60 100644 --- a/Crypto/ECC.hs +++ b/Crypto/ECC.hs @@ -166,11 +166,11 @@ instance EllipticCurve Curve_P256R1 where uncompressed = B.singleton 4 xy = P256.pointToBinary p decodePoint _ mxy = case B.uncons mxy of - Nothing -> CryptoFailed $ CryptoError_PointSizeInvalid + Nothing -> CryptoFailed CryptoError_PointSizeInvalid Just (m,xy) -- uncompressed | m == 4 -> P256.pointFromBinary xy - | otherwise -> CryptoFailed $ CryptoError_PointFormatInvalid + | otherwise -> CryptoFailed CryptoError_PointFormatInvalid instance EllipticCurveArith Curve_P256R1 where pointAdd _ a b = P256.pointAdd a b @@ -353,7 +353,7 @@ encodeECPoint (Simple.Point x y) = B.concat [uncompressed,xb,yb] decodeECPoint :: (Simple.Curve curve, ByteArray bs) => bs -> CryptoFailable (Simple.Point curve) decodeECPoint mxy = case B.uncons mxy of - Nothing -> CryptoFailed $ CryptoError_PointSizeInvalid + Nothing -> CryptoFailed CryptoError_PointSizeInvalid Just (m,xy) -- uncompressed | m == 4 -> @@ -362,7 +362,7 @@ decodeECPoint mxy = case B.uncons mxy of x = os2ip xb y = os2ip yb in Simple.pointFromIntegers (x,y) - | otherwise -> CryptoFailed $ CryptoError_PointFormatInvalid + | otherwise -> CryptoFailed CryptoError_PointFormatInvalid ecPointsMulVarTime :: forall curve . Simple.Curve curve => Simple.Scalar curve diff --git a/Crypto/PubKey/ECC/P256.hs b/Crypto/PubKey/ECC/P256.hs index 7b8c7c1..6edd8dd 100644 --- a/Crypto/PubKey/ECC/P256.hs +++ b/Crypto/PubKey/ECC/P256.hs @@ -110,7 +110,7 @@ pointAdd a b = withNewPoint $ \dx dy -> -- | Negate a point pointNegate :: Point -> Point pointNegate a = withNewPoint $ \dx dy -> - withPoint a $ \ax ay -> do + withPoint a $ \ax ay -> ccryptonite_p256e_point_negate ax ay dx dy -- | Multiply a point by a scalar @@ -188,12 +188,12 @@ pointFromBinary ba = unsafePointFromBinary ba >>= validatePoint validatePoint :: Point -> CryptoFailable Point validatePoint p | pointIsValid p = CryptoPassed p - | otherwise = CryptoFailed $ CryptoError_PointCoordinatesInvalid + | otherwise = CryptoFailed CryptoError_PointCoordinatesInvalid -- | Convert from binary to a point, possibly invalid unsafePointFromBinary :: ByteArrayAccess ba => ba -> CryptoFailable Point unsafePointFromBinary ba - | B.length ba /= pointSize = CryptoFailed $ CryptoError_PublicKeySizeInvalid + | B.length ba /= pointSize = CryptoFailed CryptoError_PublicKeySizeInvalid | otherwise = CryptoPassed $ withNewPoint $ \px py -> B.withByteArray ba $ \src -> do ccryptonite_p256_from_bin src (castPtr px) @@ -266,7 +266,7 @@ scalarCmp a b = unsafeDoIO $ -- | convert a scalar from binary scalarFromBinary :: ByteArrayAccess ba => ba -> CryptoFailable Scalar scalarFromBinary ba - | B.length ba /= scalarSize = CryptoFailed $ CryptoError_SecretKeySizeInvalid + | B.length ba /= scalarSize = CryptoFailed CryptoError_SecretKeySizeInvalid | otherwise = CryptoPassed $ withNewScalarFreeze $ \p -> B.withByteArray ba $ \b -> ccryptonite_p256_from_bin b p diff --git a/tests/ECC.hs b/tests/ECC.hs index 319a276..5faaf81 100644 --- a/tests/ECC.hs +++ b/tests/ECC.hs @@ -293,7 +293,7 @@ tests = testGroup "ECC" [ testGroup "decodePoint" $ map doPointDecodeTest (zip [katZero..] vectorsPoint) , testGroup "ECDH weak points" $ map doWeakPointECDHTest (zip [katZero..] vectorsWeakPoint) , testGroup "property" - [ testProperty "decodePoint.encodePoint==id" $ \testDRG (Curve curve) -> do + [ testProperty "decodePoint.encodePoint==id" $ \testDRG (Curve curve) -> let prx = Just curve -- using Maybe as Proxy keyPair = withTestDRG testDRG $ ECC.curveGenerateKeyPair prx p1 = ECC.keypairGetPublic keyPair diff --git a/tests/KAT_PubKey/P256.hs b/tests/KAT_PubKey/P256.hs index cd1356d..7dd508e 100644 --- a/tests/KAT_PubKey/P256.hs +++ b/tests/KAT_PubKey/P256.hs @@ -122,10 +122,10 @@ tests = testGroup "P256" t = P256.pointFromIntegers (xT, yT) r = P256.pointFromIntegers (xR, yR) in r @=? P256.pointAdd s t - , testProperty "lift-to-curve" $ propertyLiftToCurve - , testProperty "point-add" $ propertyPointAdd - , testProperty "point-negate" $ propertyPointNegate - , testProperty "point-mul" $ propertyPointMul + , testProperty "lift-to-curve" propertyLiftToCurve + , testProperty "point-add" propertyPointAdd + , testProperty "point-negate" propertyPointNegate + , testProperty "point-mul" propertyPointMul ] ] where @@ -154,7 +154,7 @@ tests = testGroup "P256" let p = P256.toPoint (unP256Scalar r) pe = ECC.pointMul curve (unP256 r) curveGen pR = P256.pointNegate p - in ECC.pointNegate curve pe `propertyEq` (pointP256ToECC pR) + in ECC.pointNegate curve pe `propertyEq` pointP256ToECC pR propertyPointMul s' r' = let s = modP256Scalar s'