1-- | Elliptic Curve Arithmetic. 2-- 3-- /WARNING:/ These functions are vulnerable to timing attacks. 4module Crypto.PubKey.ECC.Prim 5 ( scalarGenerate 6 , pointAdd 7 , pointNegate 8 , pointDouble 9 , pointBaseMul 10 , pointMul 11 , pointAddTwoMuls 12 , isPointAtInfinity 13 , isPointValid 14 ) where 15 16import Data.Maybe 17import Crypto.Number.ModArithmetic 18import Crypto.Number.F2m 19import Crypto.Number.Generate (generateBetween) 20import Crypto.PubKey.ECC.Types 21import Crypto.Random 22 23-- | Generate a valid scalar for a specific Curve 24scalarGenerate :: MonadRandom randomly => Curve -> randomly PrivateNumber 25scalarGenerate curve = generateBetween 1 (n - 1) 26 where 27 n = ecc_n $ common_curve curve 28 29--TODO: Extract helper function for `fromMaybe PointO...` 30 31-- | Elliptic Curve point negation: 32-- @pointNegate c p@ returns point @q@ such that @pointAdd c p q == PointO@. 33pointNegate :: Curve -> Point -> Point 34pointNegate _ PointO = PointO 35pointNegate (CurveFP c) (Point x y) = Point x (ecc_p c - y) 36pointNegate CurveF2m{} (Point x y) = Point x (x `addF2m` y) 37 38-- | Elliptic Curve point addition. 39-- 40-- /WARNING:/ Vulnerable to timing attacks. 41pointAdd :: Curve -> Point -> Point -> Point 42pointAdd _ PointO PointO = PointO 43pointAdd _ PointO q = q 44pointAdd _ p PointO = p 45pointAdd c p q 46 | p == q = pointDouble c p 47 | p == pointNegate c q = PointO 48pointAdd (CurveFP (CurvePrime pr _)) (Point xp yp) (Point xq yq) 49 = fromMaybe PointO $ do 50 s <- divmod (yp - yq) (xp - xq) pr 51 let xr = (s ^ (2::Int) - xp - xq) `mod` pr 52 yr = (s * (xp - xr) - yp) `mod` pr 53 return $ Point xr yr 54pointAdd (CurveF2m (CurveBinary fx cc)) (Point xp yp) (Point xq yq) 55 = fromMaybe PointO $ do 56 s <- divF2m fx (yp `addF2m` yq) (xp `addF2m` xq) 57 let xr = mulF2m fx s s `addF2m` s `addF2m` xp `addF2m` xq `addF2m` a 58 yr = mulF2m fx s (xp `addF2m` xr) `addF2m` xr `addF2m` yp 59 return $ Point xr yr 60 where a = ecc_a cc 61 62-- | Elliptic Curve point doubling. 63-- 64-- /WARNING:/ Vulnerable to timing attacks. 65-- 66-- This perform the following calculation: 67-- > lambda = (3 * xp ^ 2 + a) / 2 yp 68-- > xr = lambda ^ 2 - 2 xp 69-- > yr = lambda (xp - xr) - yp 70-- 71-- With binary curve: 72-- > xp == 0 => P = O 73-- > otherwise => 74-- > s = xp + (yp / xp) 75-- > xr = s ^ 2 + s + a 76-- > yr = xp ^ 2 + (s+1) * xr 77-- 78pointDouble :: Curve -> Point -> Point 79pointDouble _ PointO = PointO 80pointDouble (CurveFP (CurvePrime pr cc)) (Point xp yp) = fromMaybe PointO $ do 81 lambda <- divmod (3 * xp ^ (2::Int) + a) (2 * yp) pr 82 let xr = (lambda ^ (2::Int) - 2 * xp) `mod` pr 83 yr = (lambda * (xp - xr) - yp) `mod` pr 84 return $ Point xr yr 85 where a = ecc_a cc 86pointDouble (CurveF2m (CurveBinary fx cc)) (Point xp yp) 87 | xp == 0 = PointO 88 | otherwise = fromMaybe PointO $ do 89 s <- return . addF2m xp =<< divF2m fx yp xp 90 let xr = mulF2m fx s s `addF2m` s `addF2m` a 91 yr = mulF2m fx xp xp `addF2m` mulF2m fx xr (s `addF2m` 1) 92 return $ Point xr yr 93 where a = ecc_a cc 94 95-- | Elliptic curve point multiplication using the base 96-- 97-- /WARNING:/ Vulnerable to timing attacks. 98pointBaseMul :: Curve -> Integer -> Point 99pointBaseMul c n = pointMul c n (ecc_g $ common_curve c) 100 101-- | Elliptic curve point multiplication (double and add algorithm). 102-- 103-- /WARNING:/ Vulnerable to timing attacks. 104pointMul :: Curve -> Integer -> Point -> Point 105pointMul _ _ PointO = PointO 106pointMul c n p 107 | n < 0 = pointMul c (-n) (pointNegate c p) 108 | n == 0 = PointO 109 | n == 1 = p 110 | odd n = pointAdd c p (pointMul c (n - 1) p) 111 | otherwise = pointMul c (n `div` 2) (pointDouble c p) 112 113-- | Elliptic curve double-scalar multiplication (uses Shamir's trick). 114-- 115-- > pointAddTwoMuls c n1 p1 n2 p2 == pointAdd c (pointMul c n1 p1) 116-- > (pointMul c n2 p2) 117-- 118-- /WARNING:/ Vulnerable to timing attacks. 119pointAddTwoMuls :: Curve -> Integer -> Point -> Integer -> Point -> Point 120pointAddTwoMuls _ _ PointO _ PointO = PointO 121pointAddTwoMuls c _ PointO n2 p2 = pointMul c n2 p2 122pointAddTwoMuls c n1 p1 _ PointO = pointMul c n1 p1 123pointAddTwoMuls c n1 p1 n2 p2 124 | n1 < 0 = pointAddTwoMuls c (-n1) (pointNegate c p1) n2 p2 125 | n2 < 0 = pointAddTwoMuls c n1 p1 (-n2) (pointNegate c p2) 126 | otherwise = go (n1, n2) 127 128 where 129 p0 = pointAdd c p1 p2 130 131 go (0, 0 ) = PointO 132 go (k1, k2) = 133 let q = pointDouble c $ go (k1 `div` 2, k2 `div` 2) 134 in case (odd k1, odd k2) of 135 (True , True ) -> pointAdd c p0 q 136 (True , False ) -> pointAdd c p1 q 137 (False , True ) -> pointAdd c p2 q 138 (False , False ) -> q 139 140-- | Check if a point is the point at infinity. 141isPointAtInfinity :: Point -> Bool 142isPointAtInfinity PointO = True 143isPointAtInfinity _ = False 144 145-- | check if a point is on specific curve 146-- 147-- This perform three checks: 148-- 149-- * x is not out of range 150-- * y is not out of range 151-- * the equation @y^2 = x^3 + a*x + b (mod p)@ holds 152isPointValid :: Curve -> Point -> Bool 153isPointValid _ PointO = True 154isPointValid (CurveFP (CurvePrime p cc)) (Point x y) = 155 isValid x && isValid y && (y ^ (2 :: Int)) `eqModP` (x ^ (3 :: Int) + a * x + b) 156 where a = ecc_a cc 157 b = ecc_b cc 158 eqModP z1 z2 = (z1 `mod` p) == (z2 `mod` p) 159 isValid e = e >= 0 && e < p 160isPointValid (CurveF2m (CurveBinary fx cc)) (Point x y) = 161 and [ isValid x 162 , isValid y 163 , ((((x `add` a) `mul` x `add` y) `mul` x) `add` b `add` (squareF2m fx y)) == 0 164 ] 165 where a = ecc_a cc 166 b = ecc_b cc 167 add = addF2m 168 mul = mulF2m fx 169 isValid e = modF2m fx e == e 170 171-- | div and mod 172divmod :: Integer -> Integer -> Integer -> Maybe Integer 173divmod y x m = do 174 i <- inverse (x `mod` m) m 175 return $ y * i `mod` m 176