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