208 lines
7.2 KiB
Haskell
208 lines
7.2 KiB
Haskell
-- | Elliptic Curve Arithmetic.
|
|
--
|
|
-- /WARNING:/ These functions are vulnerable to timing attacks.
|
|
{-# LANGUAGE ScopedTypeVariables #-}
|
|
module Crypto.ECC.Simple.Prim
|
|
( scalarGenerate
|
|
, scalarFromInteger
|
|
, pointAdd
|
|
, pointDouble
|
|
, pointBaseMul
|
|
, pointMul
|
|
, pointAddTwoMuls
|
|
, pointFromIntegers
|
|
, isPointAtInfinity
|
|
, isPointValid
|
|
) where
|
|
|
|
import Data.Maybe
|
|
import Crypto.Internal.Imports
|
|
import Crypto.Internal.Proxy
|
|
import Crypto.Number.ModArithmetic
|
|
import Crypto.Number.F2m
|
|
import Crypto.Number.Generate (generateBetween)
|
|
import Crypto.ECC.Simple.Types
|
|
import Crypto.Error
|
|
import Crypto.Random
|
|
|
|
-- | Generate a valid scalar for a specific Curve
|
|
scalarGenerate :: forall randomly curve . (MonadRandom randomly, Curve curve) => randomly (Scalar curve)
|
|
scalarGenerate =
|
|
Scalar <$> generateBetween 1 (n - 1)
|
|
where
|
|
n = curveEccN $ curveParameters (Proxy :: Proxy curve)
|
|
|
|
scalarFromInteger :: forall curve . Curve curve => Integer -> CryptoFailable (Scalar curve)
|
|
scalarFromInteger n
|
|
| n < 0 || n >= mx = CryptoFailed $ CryptoError_EcScalarOutOfBounds
|
|
| otherwise = CryptoPassed $ Scalar n
|
|
where
|
|
mx = case curveType (Proxy :: Proxy curve) of
|
|
CurveBinary (CurveBinaryParam b) -> b
|
|
CurvePrime (CurvePrimeParam p) -> p
|
|
|
|
--TODO: Extract helper function for `fromMaybe PointO...`
|
|
|
|
-- | Elliptic Curve point negation:
|
|
-- @pointNegate p@ returns point @q@ such that @pointAdd p q == PointO@.
|
|
pointNegate :: Curve curve => Point curve -> Point curve
|
|
pointNegate PointO = PointO
|
|
pointNegate point@(Point x y) =
|
|
case curveType point of
|
|
CurvePrime {} -> Point x (-y)
|
|
CurveBinary {} -> Point x (x `addF2m` y)
|
|
|
|
-- | Elliptic Curve point addition.
|
|
--
|
|
-- /WARNING:/ Vulnerable to timing attacks.
|
|
pointAdd :: Curve curve => Point curve -> Point curve -> Point curve
|
|
pointAdd PointO PointO = PointO
|
|
pointAdd PointO q = q
|
|
pointAdd p PointO = p
|
|
pointAdd p q
|
|
| p == q = pointDouble p
|
|
| p == pointNegate q = PointO
|
|
pointAdd point@(Point xp yp) (Point xq yq) =
|
|
case ty of
|
|
CurvePrime (CurvePrimeParam pr) -> 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
|
|
CurveBinary (CurveBinaryParam fx) -> fromMaybe PointO $ do
|
|
s <- divF2m fx (yp `addF2m` yq) (xp `addF2m` xq)
|
|
let xr = mulF2m fx s s `addF2m` s `addF2m` xp `addF2m` xq `addF2m` a
|
|
yr = mulF2m fx s (xp `addF2m` xr) `addF2m` xr `addF2m` yp
|
|
return $ Point xr yr
|
|
where
|
|
ty = curveType point
|
|
cc = curveParameters point
|
|
a = curveEccA cc
|
|
|
|
-- | Elliptic Curve point doubling.
|
|
--
|
|
-- /WARNING:/ Vulnerable to timing attacks.
|
|
--
|
|
-- This perform the following calculation:
|
|
-- > lambda = (3 * xp ^ 2 + a) / 2 yp
|
|
-- > xr = lambda ^ 2 - 2 xp
|
|
-- > yr = lambda (xp - xr) - yp
|
|
--
|
|
-- With binary curve:
|
|
-- > xp == 0 => P = O
|
|
-- > otherwise =>
|
|
-- > s = xp + (yp / xp)
|
|
-- > xr = s ^ 2 + s + a
|
|
-- > yr = xp ^ 2 + (s+1) * xr
|
|
--
|
|
pointDouble :: Curve curve => Point curve -> Point curve
|
|
pointDouble PointO = PointO
|
|
pointDouble point@(Point xp yp) =
|
|
case ty of
|
|
CurvePrime (CurvePrimeParam pr) -> fromMaybe PointO $ do
|
|
lambda <- divmod (3 * xp ^ (2::Int) + a) (2 * yp) pr
|
|
let xr = (lambda ^ (2::Int) - 2 * xp) `mod` pr
|
|
yr = (lambda * (xp - xr) - yp) `mod` pr
|
|
return $ Point xr yr
|
|
CurveBinary (CurveBinaryParam fx)
|
|
| xp == 0 -> PointO
|
|
| otherwise -> fromMaybe PointO $ do
|
|
s <- return . addF2m xp =<< divF2m fx yp xp
|
|
let xr = mulF2m fx s s `addF2m` s `addF2m` a
|
|
yr = mulF2m fx xp xp `addF2m` mulF2m fx xr (s `addF2m` 1)
|
|
return $ Point xr yr
|
|
where
|
|
ty = curveType point
|
|
cc = curveParameters point
|
|
a = curveEccA cc
|
|
|
|
-- | Elliptic curve point multiplication using the base
|
|
--
|
|
-- /WARNING:/ Vulnerable to timing attacks.
|
|
pointBaseMul :: Curve curve => Scalar curve -> Point curve
|
|
pointBaseMul n = pointMul n (curveEccG $ curveParameters (Proxy :: Proxy curve))
|
|
|
|
-- | Elliptic curve point multiplication (double and add algorithm).
|
|
--
|
|
-- /WARNING:/ Vulnerable to timing attacks.
|
|
pointMul :: Curve curve => Scalar curve -> Point curve -> Point curve
|
|
pointMul _ PointO = PointO
|
|
pointMul (Scalar n) p
|
|
| n == 0 = PointO
|
|
| n == 1 = p
|
|
| odd n = pointAdd p (pointMul (Scalar (n - 1)) p)
|
|
| otherwise = pointMul (Scalar (n `div` 2)) (pointDouble p)
|
|
|
|
-- | Elliptic curve double-scalar multiplication (uses Shamir's trick).
|
|
--
|
|
-- > pointAddTwoMuls n1 p1 n2 p2 == pointAdd (pointMul n1 p1)
|
|
-- > (pointMul n2 p2)
|
|
--
|
|
-- /WARNING:/ Vulnerable to timing attacks.
|
|
pointAddTwoMuls :: Curve curve => Scalar curve -> Point curve -> Scalar curve -> Point curve -> Point curve
|
|
pointAddTwoMuls _ PointO _ PointO = PointO
|
|
pointAddTwoMuls _ PointO n2 p2 = pointMul n2 p2
|
|
pointAddTwoMuls n1 p1 _ PointO = pointMul n1 p1
|
|
pointAddTwoMuls (Scalar n1) p1 (Scalar n2) p2 = go (n1, n2)
|
|
where
|
|
p0 = pointAdd p1 p2
|
|
|
|
go (0, 0 ) = PointO
|
|
go (k1, k2) =
|
|
let q = pointDouble $ go (k1 `div` 2, k2 `div` 2)
|
|
in case (odd k1, odd k2) of
|
|
(True , True ) -> pointAdd p0 q
|
|
(True , False ) -> pointAdd p1 q
|
|
(False , True ) -> pointAdd p2 q
|
|
(False , False ) -> q
|
|
|
|
-- | Check if a point is the point at infinity.
|
|
isPointAtInfinity :: Point curve -> Bool
|
|
isPointAtInfinity PointO = True
|
|
isPointAtInfinity _ = False
|
|
|
|
-- | Make a point on a curve from integer (x,y) coordinate
|
|
--
|
|
-- if the point is not valid related to the curve then an error is
|
|
-- returned instead of a point
|
|
pointFromIntegers :: forall curve . Curve curve => (Integer, Integer) -> CryptoFailable (Point curve)
|
|
pointFromIntegers (x,y)
|
|
| isPointValid (Proxy :: Proxy curve) x y = CryptoPassed $ Point x y
|
|
| otherwise = CryptoFailed $ CryptoError_PointCoordinatesInvalid
|
|
|
|
-- | check if a point is on specific curve
|
|
--
|
|
-- This perform three checks:
|
|
--
|
|
-- * x is not out of range
|
|
-- * y is not out of range
|
|
-- * the equation @y^2 = x^3 + a*x + b (mod p)@ holds
|
|
isPointValid :: Curve curve => proxy curve -> Integer -> Integer -> Bool
|
|
isPointValid proxy x y =
|
|
case ty of
|
|
CurvePrime (CurvePrimeParam p) ->
|
|
let a = curveEccA cc
|
|
b = curveEccB cc
|
|
eqModP z1 z2 = (z1 `mod` p) == (z2 `mod` p)
|
|
isValid e = e >= 0 && e < p
|
|
in isValid x && isValid y && (y ^ (2 :: Int)) `eqModP` (x ^ (3 :: Int) + a * x + b)
|
|
CurveBinary (CurveBinaryParam fx) ->
|
|
let a = curveEccA cc
|
|
b = curveEccB cc
|
|
add = addF2m
|
|
mul = mulF2m fx
|
|
isValid e = modF2m fx e == e
|
|
in and [ isValid x
|
|
, isValid y
|
|
, ((((x `add` a) `mul` x `add` y) `mul` x) `add` b `add` (squareF2m fx y)) == 0
|
|
]
|
|
where
|
|
ty = curveType proxy
|
|
cc = curveParameters proxy
|
|
|
|
-- | div and mod
|
|
divmod :: Integer -> Integer -> Integer -> Maybe Integer
|
|
divmod y x m = do
|
|
i <- inverse (x `mod` m) m
|
|
return $ y * i `mod` m
|