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.
This commit is contained in:
Olivier Chéron
parent
bdf1a7a133
commit
db8d47a76c
124
Crypto/ECC.hs
124
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)
|
||||
|
||||
41
tests/ECC.hs
41
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)
|
||||
]
|
||||
]
|
||||
|
||||
Loading…
Reference in New Issue
Block a user