1{-# LANGUAGE ExistentialQuantification #-}
2{-# LANGUAGE FlexibleContexts #-}
3{-# LANGUAGE OverloadedStrings #-}
4module ECC (tests) where
5
6import           Crypto.Error
7import qualified Crypto.ECC as ECC
8
9import           Data.ByteArray.Encoding
10
11import Imports
12
13data Curve = forall curve. (ECC.EllipticCurveDH curve, Show curve, Eq (ECC.Point curve)) => Curve curve
14
15instance Show Curve where
16    showsPrec d (Curve curve) = showsPrec d curve
17
18instance Arbitrary Curve where
19    arbitrary = elements
20        [ Curve ECC.Curve_P256R1
21        , Curve ECC.Curve_P384R1
22        , Curve ECC.Curve_P521R1
23        , Curve ECC.Curve_X25519
24        , Curve ECC.Curve_X448
25        ]
26
27data CurveArith = forall curve. (ECC.EllipticCurveBasepointArith curve, Show curve) => CurveArith curve
28
29instance Show CurveArith where
30    showsPrec d (CurveArith curve) = showsPrec d curve
31
32instance Arbitrary CurveArith where
33    arbitrary = elements
34        [ CurveArith ECC.Curve_P256R1
35        , CurveArith ECC.Curve_P384R1
36        , CurveArith ECC.Curve_P521R1
37        , CurveArith ECC.Curve_Edwards25519
38        ]
39
40data VectorPoint = VectorPoint
41    { vpCurve :: Curve
42    , vpHex   :: ByteString
43    , vpError :: Maybe CryptoError
44    }
45
46vectorsPoint =
47    [ VectorPoint
48        { vpCurve = Curve ECC.Curve_P256R1
49        , vpHex   = ""
50        , vpError = Just CryptoError_PointSizeInvalid
51        }
52    , VectorPoint
53        { vpCurve = Curve ECC.Curve_P256R1
54        , vpHex   = "00"
55        , vpError = Just CryptoError_PointFormatInvalid
56        }
57    , VectorPoint
58        { vpCurve = Curve ECC.Curve_P256R1
59        , vpHex   = "0408edd7b50085a952172228aca391beebe9ba942a0ae9eb15bcc8d50795d1a5505221c7b9b3bb4310f165fc3ac3114339db8170ceae6697e0f9736698b33551b8"
60        , vpError = Nothing
61        }
62    , VectorPoint
63        { vpCurve = Curve ECC.Curve_P256R1
64        , vpHex   = "04216f25b00717d46deef3402628f6abf265bfa12aea515ae8f100ce415e251e72cd5cd8f47f613a0f4e0f4f9410dd9c85c149cffcb320c2d52bf550a397ec92e5"
65        , vpError = Nothing
66        }
67    , VectorPoint
68        { vpCurve = Curve ECC.Curve_P256R1
69        , vpHex   = "0421eba6080610926609bb8d52afd3331ed1b07e0ba4c1441a118b62497d3e85f39a50c865027cdd84298cdf094b7818f2a65ae59f46c971a32ab4ea3c2c93c959"
70        , vpError = Nothing
71        }
72    , VectorPoint
73        { vpCurve = Curve ECC.Curve_P256R1
74        , vpHex   = "0400d7fc4050dfe73475502d5d1fadc105d7725508f48da2cd4729bf191fd6490a0001a16f417a27530e756efeb4a228f02db878072b9f833e99a2821d85fa78fc"
75        , vpError = Nothing
76        }
77    , VectorPoint
78        { vpCurve = Curve ECC.Curve_P256R1
79        , vpHex   = "040000fc4050dfe73475502d5d1fadc105d7725508f48da2cd4729bf191fd6490a0001a16f417a27530e756efeb4a228f02db878072b9f833e99a2821d85fa78fc"
80        , vpError = Just CryptoError_PointCoordinatesInvalid
81        }
82    , VectorPoint
83        { vpCurve = Curve ECC.Curve_P256R1
84        , vpHex   = "04d7fc4050dfe73475502d5d1fadc105d7725508f48da2cd4729bf191fd6490a01a16f417a27530e756efeb4a228f02db878072b9f833e99a2821d85fa78fc"
85        , vpError = Just CryptoError_PublicKeySizeInvalid -- tests leading zeros
86        }
87    , VectorPoint
88        { vpCurve = Curve ECC.Curve_P256R1
89        , vpHex   = "040000d7fc4050dfe73475502d5d1fadc105d7725508f48da2cd4729bf191fd6490a000001a16f417a27530e756efeb4a228f02db878072b9f833e99a2821d85fa78fc"
90        , vpError = Just CryptoError_PublicKeySizeInvalid -- tests leading zeros
91        }
92    , VectorPoint
93        { vpCurve = Curve ECC.Curve_P384R1
94        , vpHex   = ""
95        , vpError = Just CryptoError_PointSizeInvalid
96        }
97    , VectorPoint
98        { vpCurve = Curve ECC.Curve_P384R1
99        , vpHex   = "00"
100        , vpError = Just CryptoError_PointFormatInvalid
101        }
102    , VectorPoint
103        { vpCurve = Curve ECC.Curve_P384R1
104        , vpHex   = "0409281a103fb1773445e16eec86adb095e32928ccc9c806bd210c649712813bdb6cab40163a8cb163b578ea8dda5eb32cfb5208ebf0d31a6c590fa92f5a61f32dbc0d518b166ea5a9adf9dd21c1bd09932ca21c6a5725ca89542ac57b6a9eca6f"
105        , vpError = Nothing
106        }
107    , VectorPoint
108        { vpCurve = Curve ECC.Curve_P384R1
109        , vpHex   = "040c7b3fb575c1db7bc61fe7a456cc34a8289f41e167938a56e5ba2787723f3de2c645112705e13ed24f477730173935ca4e0ff468e7e0acf78a9f59dadff8193a0e23789eb3737730c089b27a0f94de7d95b8db4466d017fb21a5710d6ca85775"
110        , vpError = Nothing
111        }
112    , VectorPoint
113        { vpCurve = Curve ECC.Curve_P384R1
114        , vpHex   = "0438e7705220b60460194be63d21c8945be2a211957168fa60f26b2ad4e8f5cd96a7779e7edff4deda9ded63243c2127e273d4444edaaba03b79b6caafc5033432af13776f851c0c7e1080c60d7ee3b61740720ab98461813dab5fb8c31bfa9ed9"
115        , vpError = Nothing
116        }
117    , VectorPoint
118        { vpCurve = Curve ECC.Curve_P384R1
119        , vpHex   = "04000836bf09614bf5b3c0ffe9b0822a2cc109a90b13d4d3510ce14f766e7d90875ec4bc8d6bee11fc1fdf97473a67884c00b1e2685367bdb846c95181b0f35a35cfbee04451122cc55a1e363acaa6c002e71b0b6ff7d0f5dc830a32f0e5086189"
120        , vpError = Nothing
121        }
122    , VectorPoint
123        { vpCurve = Curve ECC.Curve_P384R1
124        , vpHex   = "04000036bf09614bf5b3c0ffe9b0822a2cc109a90b13d4d3510ce14f766e7d90875ec4bc8d6bee11fc1fdf97473a67884c00b1e2685367bdb846c95181b0f35a35cfbee04451122cc55a1e363acaa6c002e71b0b6ff7d0f5dc830a32f0e5086189"
125        , vpError = Just CryptoError_PointCoordinatesInvalid
126        }
127    , VectorPoint
128        { vpCurve = Curve ECC.Curve_P384R1
129        , vpHex   = "040836bf09614bf5b3c0ffe9b0822a2cc109a90b13d4d3510ce14f766e7d90875ec4bc8d6bee11fc1fdf97473a67884cb1e2685367bdb846c95181b0f35a35cfbee04451122cc55a1e363acaa6c002e71b0b6ff7d0f5dc830a32f0e5086189"
130        , vpError = Nothing -- ignores leading zeros
131        }
132    , VectorPoint
133        { vpCurve = Curve ECC.Curve_P384R1
134        , vpHex   = "0400000836bf09614bf5b3c0ffe9b0822a2cc109a90b13d4d3510ce14f766e7d90875ec4bc8d6bee11fc1fdf97473a67884c0000b1e2685367bdb846c95181b0f35a35cfbee04451122cc55a1e363acaa6c002e71b0b6ff7d0f5dc830a32f0e5086189"
135        , vpError = Nothing -- ignores leading zeros
136        }
137    , VectorPoint
138        { vpCurve = Curve ECC.Curve_P521R1
139        , vpHex   = ""
140        , vpError = Just CryptoError_PointSizeInvalid
141        }
142    , VectorPoint
143        { vpCurve = Curve ECC.Curve_P521R1
144        , vpHex   = "00"
145        , vpError = Just CryptoError_PointFormatInvalid
146        }
147    , VectorPoint
148        { vpCurve = Curve ECC.Curve_P521R1
149        , vpHex   = "04000ce5c207335134567026063743df82c1b551a009cf616471f0e23fa9767a50cc7f8771ef13a65c49ce7e1cd1ac3ad721dcc3ddd35f98ae5d380a0832f87a9f0ca4012914911d6bea7f3c481d694fb1645be27c7b66b09b28e261f8030b3fb8206f6a95f6ad73db755765b64f592a799234f8f451cb787abe95b1a54991a799ad0d69da"
150        , vpError = Nothing
151        }
152    , VectorPoint
153        { vpCurve = Curve ECC.Curve_P521R1
154        , vpHex   = "04003a5e6c1ce3a6a323757005da17b357db991bd1ad835e6201411f458b5c2edb3c66786b727b7e15fbad7dd74a4b0eb542183b5242e5952061cb85e7229353eb0dc300aac2dbd5232d582481ba7a59a993eb04c4466a1b17ba0015b65c616ce8703e70880969d8d58e633acb29c3ca017eb1b88649387b867466090ce1a57c2b4f8376bb"
155        , vpError = Nothing
156        }
157    , VectorPoint
158        { vpCurve = Curve ECC.Curve_P521R1
159        , vpHex   = "04003e0659fe9498695a3d8c88b8e25fa8133c30ab10eccbe9094344c99924f89fb69d9b3acf03bf438328f9cba55fa28a05be9a7e18780706b3728abfee2592aeb86d0001ea5ff64f2ca7a6453c79f80550e971843e073f4f8fec75bad2e52a4483ebf1f16f43d0de27e1967ea22f9722527652fa74439fdc03a569fba29e2d6f7c012db6"
160        , vpError = Nothing
161        }
162    , VectorPoint
163        { vpCurve = Curve ECC.Curve_P521R1
164        , vpHex   = "040043f91fd92d9ccd6d5584b265a2a775d222f4a41ff98190677d985e0889737cbe631d525835fe04faffcdebeccb783538280f4600ae82347b0470583abd9def306000a2e9bdc34f42b134517fc1e961befea0affd1f9666361a039192082a892dd722931d5865b62b69d7369e74895120e540cb10030cccb6049d809fbcf3f54537b378"
165        , vpError = Nothing
166        }
167    , VectorPoint
168        { vpCurve = Curve ECC.Curve_P521R1
169        , vpHex   = "040000f91fd92d9ccd6d5584b265a2a775d222f4a41ff98190677d985e0889737cbe631d525835fe04faffcdebeccb783538280f4600ae82347b0470583abd9def306000a2e9bdc34f42b134517fc1e961befea0affd1f9666361a039192082a892dd722931d5865b62b69d7369e74895120e540cb10030cccb6049d809fbcf3f54537b378"
170        , vpError = Just CryptoError_PointCoordinatesInvalid
171        }
172    , VectorPoint
173        { vpCurve = Curve ECC.Curve_P521R1
174        , vpHex   = "0443f91fd92d9ccd6d5584b265a2a775d222f4a41ff98190677d985e0889737cbe631d525835fe04faffcdebeccb783538280f4600ae82347b0470583abd9def3060a2e9bdc34f42b134517fc1e961befea0affd1f9666361a039192082a892dd722931d5865b62b69d7369e74895120e540cb10030cccb6049d809fbcf3f54537b378"
175        , vpError = Nothing -- ignores leading zeros
176        }
177    , VectorPoint
178        { vpCurve = Curve ECC.Curve_P521R1
179        , vpHex   = "04000043f91fd92d9ccd6d5584b265a2a775d222f4a41ff98190677d985e0889737cbe631d525835fe04faffcdebeccb783538280f4600ae82347b0470583abd9def30600000a2e9bdc34f42b134517fc1e961befea0affd1f9666361a039192082a892dd722931d5865b62b69d7369e74895120e540cb10030cccb6049d809fbcf3f54537b378"
180        , vpError = Nothing -- ignores leading zeros
181        }
182    , VectorPoint
183        { vpCurve = Curve ECC.Curve_X25519
184        , vpHex   = ""
185        , vpError = Just CryptoError_PublicKeySizeInvalid
186        }
187    , VectorPoint
188        { vpCurve = Curve ECC.Curve_X25519
189        , vpHex   = "22cd98c65fb50db3be0d6d359456c0cd3516952a6e7229ff672893944f703f10"
190        , vpError = Nothing
191        }
192    , VectorPoint
193        { vpCurve = Curve ECC.Curve_X25519
194        , vpHex   = "23cd98c65fb50db3be0d6d359456c0cd3516952a6e7229ff672893944f703f10"
195        , vpError = Nothing
196        }
197    , VectorPoint
198        { vpCurve = Curve ECC.Curve_X25519
199        , vpHex   = "0023cd98c65fb50db3be0d6d359456c0cd3516952a6e7229ff672893944f703f10"
200        , vpError = Just CryptoError_PublicKeySizeInvalid
201        }
202    , VectorPoint
203        { vpCurve = Curve ECC.Curve_X448
204        , vpHex   = ""
205        , vpError = Just CryptoError_PublicKeySizeInvalid
206        }
207    , VectorPoint
208        { vpCurve = Curve ECC.Curve_X448
209        , vpHex   = "2b162c2fef165ecbb203e40975ae4424f0f8db25ab582cb96b2e5ffe90a31798b35480b594c99dc32b437e61a74f792d8ecf5fc3e8cfeb75"
210        , vpError = Nothing
211        }
212    , VectorPoint
213        { vpCurve = Curve ECC.Curve_X448
214        , vpHex   = "2c162c2fef165ecbb203e40975ae4424f0f8db25ab582cb96b2e5ffe90a31798b35480b594c99dc32b437e61a74f792d8ecf5fc3e8cfeb75"
215        , vpError = Nothing
216        }
217    , VectorPoint
218        { vpCurve = Curve ECC.Curve_X448
219        , vpHex   = "002c162c2fef165ecbb203e40975ae4424f0f8db25ab582cb96b2e5ffe90a31798b35480b594c99dc32b437e61a74f792d8ecf5fc3e8cfeb75"
220        , vpError = Just CryptoError_PublicKeySizeInvalid
221        }
222    ]
223
224vectorsWeakPoint =
225    [ VectorPoint
226        { vpCurve = Curve ECC.Curve_X25519
227        , vpHex   = "0000000000000000000000000000000000000000000000000000000000000000"
228        , vpError = Just CryptoError_ScalarMultiplicationInvalid
229        }
230    , VectorPoint
231        { vpCurve = Curve ECC.Curve_X25519
232        , vpHex   = "0100000000000000000000000000000000000000000000000000000000000000"
233        , vpError = Just CryptoError_ScalarMultiplicationInvalid
234        }
235    , VectorPoint
236        { vpCurve = Curve ECC.Curve_X25519
237        , vpHex   = "e0eb7a7c3b41b8ae1656e3faf19fc46ada098deb9c32b1fd866205165f49b800"
238        , vpError = Just CryptoError_ScalarMultiplicationInvalid
239        }
240    , VectorPoint
241        { vpCurve = Curve ECC.Curve_X25519
242        , vpHex   = "5f9c95bca3508c24b1d0b1559c83ef5b04445cc4581c8e86d8224eddd09f1157"
243        , vpError = Just CryptoError_ScalarMultiplicationInvalid
244        }
245    , VectorPoint
246        { vpCurve = Curve ECC.Curve_X25519
247        , vpHex   = "ecffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff7f"
248        , vpError = Just CryptoError_ScalarMultiplicationInvalid
249        }
250    , VectorPoint
251        { vpCurve = Curve ECC.Curve_X25519
252        , vpHex   = "edffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff7f"
253        , vpError = Just CryptoError_ScalarMultiplicationInvalid
254        }
255    , VectorPoint
256        { vpCurve = Curve ECC.Curve_X25519
257        , vpHex   = "eeffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff7f"
258        , vpError = Just CryptoError_ScalarMultiplicationInvalid
259        }
260    , VectorPoint
261        { vpCurve = Curve ECC.Curve_X448
262        , vpHex   = "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
263        , vpError = Just CryptoError_ScalarMultiplicationInvalid
264        }
265    , VectorPoint
266        { vpCurve = Curve ECC.Curve_X448
267        , vpHex   = "0100000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
268        , vpError = Just CryptoError_ScalarMultiplicationInvalid
269        }
270    ]
271
272vpEncodedPoint :: VectorPoint -> ByteString
273vpEncodedPoint vector = let Right bs = convertFromBase Base16 (vpHex vector) in bs
274
275cryptoError :: CryptoFailable a -> Maybe CryptoError
276cryptoError = onCryptoFailure Just (const Nothing)
277
278doPointDecodeTest i vector =
279    case vpCurve vector of
280        Curve curve ->
281            let prx = Just curve -- using Maybe as Proxy
282             in testCase (show i) (vpError vector @=? cryptoError (ECC.decodePoint prx $ vpEncodedPoint vector))
283
284doWeakPointECDHTest i vector =
285    case vpCurve vector of
286        Curve curve -> testCase (show i) $ do
287            let prx = Just curve -- using Maybe as Proxy
288                CryptoPassed public = ECC.decodePoint prx $ vpEncodedPoint vector
289            keyPair <- ECC.curveGenerateKeyPair prx
290            vpError vector @=? cryptoError (ECC.ecdh prx (ECC.keypairGetPrivate keyPair) public)
291
292tests = testGroup "ECC"
293    [ testGroup "decodePoint" $ zipWith doPointDecodeTest [katZero..] vectorsPoint
294    , testGroup "ECDH weak points" $ zipWith doWeakPointECDHTest [katZero..] vectorsWeakPoint
295    , testGroup "property"
296        [ testProperty "decodePoint.encodePoint==id" $ \testDRG (Curve curve) ->
297            let prx = Just curve -- using Maybe as Proxy
298                keyPair = withTestDRG testDRG $ ECC.curveGenerateKeyPair prx
299                p1 = ECC.keypairGetPublic keyPair
300                bs = ECC.encodePoint prx p1 :: ByteString
301                p2 = ECC.decodePoint prx bs
302             in CryptoPassed p1 == p2
303        , localOption (QuickCheckTests 20) $ testProperty "ECDH commutes" $ \testDRG (Curve curve) ->
304            let prx = Just curve -- using Maybe as Proxy
305                (alice, bob) = withTestDRG testDRG $
306                                   (,) <$> ECC.curveGenerateKeyPair prx
307                                       <*> ECC.curveGenerateKeyPair prx
308                aliceShared  = ECC.ecdh    prx (ECC.keypairGetPrivate alice) (ECC.keypairGetPublic bob)
309                bobShared    = ECC.ecdh    prx (ECC.keypairGetPrivate bob) (ECC.keypairGetPublic alice)
310                aliceShared' = ECC.ecdhRaw prx (ECC.keypairGetPrivate alice) (ECC.keypairGetPublic bob)
311                bobShared'   = ECC.ecdhRaw prx (ECC.keypairGetPrivate bob) (ECC.keypairGetPublic alice)
312             in aliceShared == bobShared && aliceShared == CryptoPassed aliceShared'
313                                         && bobShared   == CryptoPassed bobShared'
314        , testProperty "decodeScalar.encodeScalar==id" $ \testDRG (CurveArith curve) ->
315            let prx = Just curve -- using Maybe as Proxy
316                s1 = withTestDRG testDRG $ ECC.curveGenerateScalar prx
317                bs = ECC.encodeScalar prx s1 :: ByteString
318                s2 = ECC.decodeScalar prx bs
319             in CryptoPassed s1 == s2
320        , testProperty "scalarFromInteger.scalarToInteger==id" $ \testDRG (CurveArith curve) ->
321            let prx = Just curve -- using Maybe as Proxy
322                s1 = withTestDRG testDRG $ ECC.curveGenerateScalar prx
323                bs = ECC.scalarToInteger prx s1
324                s2 = ECC.scalarFromInteger prx bs
325             in CryptoPassed s1 == s2
326        , localOption (QuickCheckTests 20) $ testProperty "(a + b).P = a.P + b.P" $ \testDRG (CurveArith curve) ->
327            let prx = Just curve -- using Maybe as Proxy
328                (s, a, b) = withTestDRG testDRG $
329                                (,,) <$> ECC.curveGenerateScalar prx
330                                     <*> ECC.curveGenerateScalar prx
331                                     <*> ECC.curveGenerateScalar prx
332                p = ECC.pointBaseSmul prx s
333             in ECC.pointSmul prx (ECC.scalarAdd prx a b) p == ECC.pointAdd prx (ECC.pointSmul prx a p) (ECC.pointSmul prx b p)
334        , localOption (QuickCheckTests 20) $ testProperty "(a * b).P = a.(b.P)" $ \testDRG (CurveArith curve) ->
335            let prx = Just curve -- using Maybe as Proxy
336                (s, a, b) = withTestDRG testDRG $
337                                (,,) <$> ECC.curveGenerateScalar prx
338                                     <*> ECC.curveGenerateScalar prx
339                                     <*> ECC.curveGenerateScalar prx
340                p = ECC.pointBaseSmul prx s
341             in ECC.pointSmul prx (ECC.scalarMul prx a b) p == ECC.pointSmul prx a (ECC.pointSmul prx b p)
342        ]
343    ]
344