1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
|
-- | Elliptic Curve Arithmetic.
--
-- /WARNING:/ These functions are vulnerable to timing attacks.
{-# LANGUAGE ScopedTypeVariables #-}
module Crypto.ECC.Simple.Prim
( scalarGenerate
, scalarFromInteger
, pointAdd
, pointNegate
, pointDouble
, pointBaseMul
, pointMul
, pointAddTwoMuls
, pointFromIntegers
, isPointAtInfinity
, isPointValid
) where
import Data.Maybe
import Data.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 (CurvePrimeParam p) -> Point x (p - 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
|
