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