1-- | 2-- Module : Crypto.ECC 3-- License : BSD-style 4-- Maintainer : Vincent Hanquez <vincent@snarc.org> 5-- Stability : experimental 6-- Portability : unknown 7-- 8-- Elliptic Curve Cryptography 9-- 10{-# LANGUAGE DeriveDataTypeable #-} 11{-# LANGUAGE FlexibleContexts #-} 12{-# LANGUAGE GeneralizedNewtypeDeriving #-} 13{-# LANGUAGE TypeFamilies #-} 14{-# LANGUAGE ScopedTypeVariables #-} 15module Crypto.ECC 16 ( Curve_P256R1(..) 17 , Curve_P384R1(..) 18 , Curve_P521R1(..) 19 , Curve_X25519(..) 20 , Curve_X448(..) 21 , Curve_Edwards25519(..) 22 , EllipticCurve(..) 23 , EllipticCurveDH(..) 24 , EllipticCurveArith(..) 25 , EllipticCurveBasepointArith(..) 26 , KeyPair(..) 27 , SharedSecret(..) 28 ) where 29 30import qualified Crypto.PubKey.ECC.P256 as P256 31import qualified Crypto.ECC.Edwards25519 as Edwards25519 32import qualified Crypto.ECC.Simple.Types as Simple 33import qualified Crypto.ECC.Simple.Prim as Simple 34import Crypto.Random 35import Crypto.Error 36import Crypto.Internal.Imports 37import Crypto.Internal.ByteArray (ByteArray, ByteArrayAccess, ScrubbedBytes) 38import qualified Crypto.Internal.ByteArray as B 39import Crypto.Number.Basic (numBits) 40import Crypto.Number.Serialize (i2ospOf_, os2ip) 41import qualified Crypto.Number.Serialize.LE as LE 42import qualified Crypto.PubKey.Curve25519 as X25519 43import qualified Crypto.PubKey.Curve448 as X448 44import Data.ByteArray (convert) 45import Data.Data (Data()) 46import Data.Kind (Type) 47import Data.Proxy 48 49-- | An elliptic curve key pair composed of the private part (a scalar), and 50-- the associated point. 51data KeyPair curve = KeyPair 52 { keypairGetPublic :: !(Point curve) 53 , keypairGetPrivate :: !(Scalar curve) 54 } 55 56newtype SharedSecret = SharedSecret ScrubbedBytes 57 deriving (Eq, ByteArrayAccess, NFData) 58 59class EllipticCurve curve where 60 -- | Point on an Elliptic Curve 61 type Point curve :: Type 62 63 -- | Scalar in the Elliptic Curve domain 64 type Scalar curve :: Type 65 66 -- | Generate a new random scalar on the curve. 67 -- The scalar will represent a number between 1 and the order of the curve non included 68 curveGenerateScalar :: MonadRandom randomly => proxy curve -> randomly (Scalar curve) 69 70 -- | Generate a new random keypair 71 curveGenerateKeyPair :: MonadRandom randomly => proxy curve -> randomly (KeyPair curve) 72 73 -- | Get the curve size in bits 74 curveSizeBits :: proxy curve -> Int 75 76 -- | Encode a elliptic curve point into binary form 77 encodePoint :: ByteArray bs => proxy curve -> Point curve -> bs 78 79 -- | Try to decode the binary form of an elliptic curve point 80 decodePoint :: ByteArray bs => proxy curve -> bs -> CryptoFailable (Point curve) 81 82class EllipticCurve curve => EllipticCurveDH curve where 83 -- | Generate a Diffie hellman secret value. 84 -- 85 -- This is generally just the .x coordinate of the resulting point, that 86 -- is not hashed. 87 -- 88 -- use `pointSmul` to keep the result in Point format. 89 -- 90 -- /WARNING:/ Curve implementations may return a special value or an 91 -- exception when the public point lies in a subgroup of small order. 92 -- This function is adequate when the scalar is in expected range and 93 -- contributory behaviour is not needed. Otherwise use 'ecdh'. 94 ecdhRaw :: proxy curve -> Scalar curve -> Point curve -> SharedSecret 95 ecdhRaw prx s = throwCryptoError . ecdh prx s 96 97 -- | Generate a Diffie hellman secret value and verify that the result 98 -- is not the point at infinity. 99 -- 100 -- This additional test avoids risks existing with function 'ecdhRaw'. 101 -- Implementations always return a 'CryptoError' instead of a special 102 -- value or an exception. 103 ecdh :: proxy curve -> Scalar curve -> Point curve -> CryptoFailable SharedSecret 104 105class (EllipticCurve curve, Eq (Point curve)) => EllipticCurveArith curve where 106 -- | Add points on a curve 107 pointAdd :: proxy curve -> Point curve -> Point curve -> Point curve 108 109 -- | Negate a curve point 110 pointNegate :: proxy curve -> Point curve -> Point curve 111 112 -- | Scalar Multiplication on a curve 113 pointSmul :: proxy curve -> Scalar curve -> Point curve -> Point curve 114 115-- -- | Scalar Inverse 116-- scalarInverse :: Scalar curve -> Scalar curve 117 118class (EllipticCurveArith curve, Eq (Scalar curve)) => EllipticCurveBasepointArith curve where 119 -- | Get the curve order size in bits 120 curveOrderBits :: proxy curve -> Int 121 122 -- | Multiply a scalar with the curve base point 123 pointBaseSmul :: proxy curve -> Scalar curve -> Point curve 124 125 -- | Multiply the point @p@ with @s2@ and add a lifted to curve value @s1@ 126 pointsSmulVarTime :: proxy curve -> Scalar curve -> Scalar curve -> Point curve -> Point curve 127 pointsSmulVarTime prx s1 s2 p = pointAdd prx (pointBaseSmul prx s1) (pointSmul prx s2 p) 128 129 -- | Encode an elliptic curve scalar into big-endian form 130 encodeScalar :: ByteArray bs => proxy curve -> Scalar curve -> bs 131 132 -- | Try to decode the big-endian form of an elliptic curve scalar 133 decodeScalar :: ByteArray bs => proxy curve -> bs -> CryptoFailable (Scalar curve) 134 135 -- | Convert an elliptic curve scalar to an integer 136 scalarToInteger :: proxy curve -> Scalar curve -> Integer 137 138 -- | Try to create an elliptic curve scalar from an integer 139 scalarFromInteger :: proxy curve -> Integer -> CryptoFailable (Scalar curve) 140 141 -- | Add two scalars and reduce modulo the curve order 142 scalarAdd :: proxy curve -> Scalar curve -> Scalar curve -> Scalar curve 143 144 -- | Multiply two scalars and reduce modulo the curve order 145 scalarMul :: proxy curve -> Scalar curve -> Scalar curve -> Scalar curve 146 147-- | P256 Curve 148-- 149-- also known as P256 150data Curve_P256R1 = Curve_P256R1 151 deriving (Show,Data) 152 153instance EllipticCurve Curve_P256R1 where 154 type Point Curve_P256R1 = P256.Point 155 type Scalar Curve_P256R1 = P256.Scalar 156 curveSizeBits _ = 256 157 curveGenerateScalar _ = P256.scalarGenerate 158 curveGenerateKeyPair _ = toKeyPair <$> P256.scalarGenerate 159 where toKeyPair scalar = KeyPair (P256.toPoint scalar) scalar 160 encodePoint _ p = mxy 161 where 162 mxy :: forall bs. ByteArray bs => bs 163 mxy = B.concat [uncompressed, xy] 164 where 165 uncompressed, xy :: bs 166 uncompressed = B.singleton 4 167 xy = P256.pointToBinary p 168 decodePoint _ mxy = case B.uncons mxy of 169 Nothing -> CryptoFailed CryptoError_PointSizeInvalid 170 Just (m,xy) 171 -- uncompressed 172 | m == 4 -> P256.pointFromBinary xy 173 | otherwise -> CryptoFailed CryptoError_PointFormatInvalid 174 175instance EllipticCurveArith Curve_P256R1 where 176 pointAdd _ a b = P256.pointAdd a b 177 pointNegate _ p = P256.pointNegate p 178 pointSmul _ s p = P256.pointMul s p 179 180instance EllipticCurveDH Curve_P256R1 where 181 ecdhRaw _ s p = SharedSecret $ P256.pointDh s p 182 ecdh prx s p = checkNonZeroDH (ecdhRaw prx s p) 183 184instance EllipticCurveBasepointArith Curve_P256R1 where 185 curveOrderBits _ = 256 186 pointBaseSmul _ = P256.toPoint 187 pointsSmulVarTime _ = P256.pointsMulVarTime 188 encodeScalar _ = P256.scalarToBinary 189 decodeScalar _ = P256.scalarFromBinary 190 scalarToInteger _ = P256.scalarToInteger 191 scalarFromInteger _ = P256.scalarFromInteger 192 scalarAdd _ = P256.scalarAdd 193 scalarMul _ = P256.scalarMul 194 195data Curve_P384R1 = Curve_P384R1 196 deriving (Show,Data) 197 198instance EllipticCurve Curve_P384R1 where 199 type Point Curve_P384R1 = Simple.Point Simple.SEC_p384r1 200 type Scalar Curve_P384R1 = Simple.Scalar Simple.SEC_p384r1 201 curveSizeBits _ = 384 202 curveGenerateScalar _ = Simple.scalarGenerate 203 curveGenerateKeyPair _ = toKeyPair <$> Simple.scalarGenerate 204 where toKeyPair scalar = KeyPair (Simple.pointBaseMul scalar) scalar 205 encodePoint _ point = encodeECPoint point 206 decodePoint _ bs = decodeECPoint bs 207 208instance EllipticCurveArith Curve_P384R1 where 209 pointAdd _ a b = Simple.pointAdd a b 210 pointNegate _ p = Simple.pointNegate p 211 pointSmul _ s p = Simple.pointMul s p 212 213instance EllipticCurveDH Curve_P384R1 where 214 ecdh _ s p = encodeECShared prx (Simple.pointMul s p) 215 where 216 prx = Proxy :: Proxy Simple.SEC_p384r1 217 218instance EllipticCurveBasepointArith Curve_P384R1 where 219 curveOrderBits _ = 384 220 pointBaseSmul _ = Simple.pointBaseMul 221 pointsSmulVarTime _ = ecPointsMulVarTime 222 encodeScalar _ = ecScalarToBinary 223 decodeScalar _ = ecScalarFromBinary 224 scalarToInteger _ = ecScalarToInteger 225 scalarFromInteger _ = ecScalarFromInteger 226 scalarAdd _ = ecScalarAdd 227 scalarMul _ = ecScalarMul 228 229data Curve_P521R1 = Curve_P521R1 230 deriving (Show,Data) 231 232instance EllipticCurve Curve_P521R1 where 233 type Point Curve_P521R1 = Simple.Point Simple.SEC_p521r1 234 type Scalar Curve_P521R1 = Simple.Scalar Simple.SEC_p521r1 235 curveSizeBits _ = 521 236 curveGenerateScalar _ = Simple.scalarGenerate 237 curveGenerateKeyPair _ = toKeyPair <$> Simple.scalarGenerate 238 where toKeyPair scalar = KeyPair (Simple.pointBaseMul scalar) scalar 239 encodePoint _ point = encodeECPoint point 240 decodePoint _ bs = decodeECPoint bs 241 242instance EllipticCurveArith Curve_P521R1 where 243 pointAdd _ a b = Simple.pointAdd a b 244 pointNegate _ p = Simple.pointNegate p 245 pointSmul _ s p = Simple.pointMul s p 246 247instance EllipticCurveDH Curve_P521R1 where 248 ecdh _ s p = encodeECShared prx (Simple.pointMul s p) 249 where 250 prx = Proxy :: Proxy Simple.SEC_p521r1 251 252instance EllipticCurveBasepointArith Curve_P521R1 where 253 curveOrderBits _ = 521 254 pointBaseSmul _ = Simple.pointBaseMul 255 pointsSmulVarTime _ = ecPointsMulVarTime 256 encodeScalar _ = ecScalarToBinary 257 decodeScalar _ = ecScalarFromBinary 258 scalarToInteger _ = ecScalarToInteger 259 scalarFromInteger _ = ecScalarFromInteger 260 scalarAdd _ = ecScalarAdd 261 scalarMul _ = ecScalarMul 262 263data Curve_X25519 = Curve_X25519 264 deriving (Show,Data) 265 266instance EllipticCurve Curve_X25519 where 267 type Point Curve_X25519 = X25519.PublicKey 268 type Scalar Curve_X25519 = X25519.SecretKey 269 curveSizeBits _ = 255 270 curveGenerateScalar _ = X25519.generateSecretKey 271 curveGenerateKeyPair _ = do 272 s <- X25519.generateSecretKey 273 return $ KeyPair (X25519.toPublic s) s 274 encodePoint _ p = B.convert p 275 decodePoint _ bs = X25519.publicKey bs 276 277instance EllipticCurveDH Curve_X25519 where 278 ecdhRaw _ s p = SharedSecret $ convert secret 279 where secret = X25519.dh p s 280 ecdh prx s p = checkNonZeroDH (ecdhRaw prx s p) 281 282data Curve_X448 = Curve_X448 283 deriving (Show,Data) 284 285instance EllipticCurve Curve_X448 where 286 type Point Curve_X448 = X448.PublicKey 287 type Scalar Curve_X448 = X448.SecretKey 288 curveSizeBits _ = 448 289 curveGenerateScalar _ = X448.generateSecretKey 290 curveGenerateKeyPair _ = do 291 s <- X448.generateSecretKey 292 return $ KeyPair (X448.toPublic s) s 293 encodePoint _ p = B.convert p 294 decodePoint _ bs = X448.publicKey bs 295 296instance EllipticCurveDH Curve_X448 where 297 ecdhRaw _ s p = SharedSecret $ convert secret 298 where secret = X448.dh p s 299 ecdh prx s p = checkNonZeroDH (ecdhRaw prx s p) 300 301data Curve_Edwards25519 = Curve_Edwards25519 302 deriving (Show,Data) 303 304instance EllipticCurve Curve_Edwards25519 where 305 type Point Curve_Edwards25519 = Edwards25519.Point 306 type Scalar Curve_Edwards25519 = Edwards25519.Scalar 307 curveSizeBits _ = 255 308 curveGenerateScalar _ = Edwards25519.scalarGenerate 309 curveGenerateKeyPair _ = toKeyPair <$> Edwards25519.scalarGenerate 310 where toKeyPair scalar = KeyPair (Edwards25519.toPoint scalar) scalar 311 encodePoint _ point = Edwards25519.pointEncode point 312 decodePoint _ bs = Edwards25519.pointDecode bs 313 314instance EllipticCurveArith Curve_Edwards25519 where 315 pointAdd _ a b = Edwards25519.pointAdd a b 316 pointNegate _ p = Edwards25519.pointNegate p 317 pointSmul _ s p = Edwards25519.pointMul s p 318 319instance EllipticCurveBasepointArith Curve_Edwards25519 where 320 curveOrderBits _ = 253 321 pointBaseSmul _ = Edwards25519.toPoint 322 pointsSmulVarTime _ = Edwards25519.pointsMulVarTime 323 encodeScalar _ = B.reverse . Edwards25519.scalarEncode 324 decodeScalar _ bs 325 | B.length bs == 32 = Edwards25519.scalarDecodeLong (B.reverse bs) 326 | otherwise = CryptoFailed CryptoError_SecretKeySizeInvalid 327 scalarToInteger _ s = LE.os2ip (Edwards25519.scalarEncode s :: B.Bytes) 328 scalarFromInteger _ i = 329 case LE.i2ospOf 32 i of 330 Nothing -> CryptoFailed CryptoError_SecretKeySizeInvalid 331 Just bs -> Edwards25519.scalarDecodeLong (bs :: B.Bytes) 332 scalarAdd _ = Edwards25519.scalarAdd 333 scalarMul _ = Edwards25519.scalarMul 334 335checkNonZeroDH :: SharedSecret -> CryptoFailable SharedSecret 336checkNonZeroDH s@(SharedSecret b) 337 | B.constAllZero b = CryptoFailed CryptoError_ScalarMultiplicationInvalid 338 | otherwise = CryptoPassed s 339 340encodeECShared :: Simple.Curve curve => Proxy curve -> Simple.Point curve -> CryptoFailable SharedSecret 341encodeECShared _ Simple.PointO = CryptoFailed CryptoError_ScalarMultiplicationInvalid 342encodeECShared prx (Simple.Point x _) = CryptoPassed . SharedSecret $ i2ospOf_ (Simple.curveSizeBytes prx) x 343 344encodeECPoint :: forall curve bs . (Simple.Curve curve, ByteArray bs) => Simple.Point curve -> bs 345encodeECPoint Simple.PointO = error "encodeECPoint: cannot serialize point at infinity" 346encodeECPoint (Simple.Point x y) = B.concat [uncompressed,xb,yb] 347 where 348 size = Simple.curveSizeBytes (Proxy :: Proxy curve) 349 uncompressed, xb, yb :: bs 350 uncompressed = B.singleton 4 351 xb = i2ospOf_ size x 352 yb = i2ospOf_ size y 353 354decodeECPoint :: (Simple.Curve curve, ByteArray bs) => bs -> CryptoFailable (Simple.Point curve) 355decodeECPoint mxy = case B.uncons mxy of 356 Nothing -> CryptoFailed CryptoError_PointSizeInvalid 357 Just (m,xy) 358 -- uncompressed 359 | m == 4 -> 360 let siz = B.length xy `div` 2 361 (xb,yb) = B.splitAt siz xy 362 x = os2ip xb 363 y = os2ip yb 364 in Simple.pointFromIntegers (x,y) 365 | otherwise -> CryptoFailed CryptoError_PointFormatInvalid 366 367ecPointsMulVarTime :: forall curve . Simple.Curve curve 368 => Simple.Scalar curve 369 -> Simple.Scalar curve -> Simple.Point curve 370 -> Simple.Point curve 371ecPointsMulVarTime n1 = Simple.pointAddTwoMuls n1 g 372 where g = Simple.curveEccG $ Simple.curveParameters (Proxy :: Proxy curve) 373 374ecScalarFromBinary :: forall curve bs . (Simple.Curve curve, ByteArrayAccess bs) 375 => bs -> CryptoFailable (Simple.Scalar curve) 376ecScalarFromBinary ba 377 | B.length ba /= size = CryptoFailed CryptoError_SecretKeySizeInvalid 378 | otherwise = CryptoPassed (Simple.Scalar $ os2ip ba) 379 where size = ecCurveOrderBytes (Proxy :: Proxy curve) 380 381ecScalarToBinary :: forall curve bs . (Simple.Curve curve, ByteArray bs) 382 => Simple.Scalar curve -> bs 383ecScalarToBinary (Simple.Scalar s) = i2ospOf_ size s 384 where size = ecCurveOrderBytes (Proxy :: Proxy curve) 385 386ecScalarFromInteger :: forall curve . Simple.Curve curve 387 => Integer -> CryptoFailable (Simple.Scalar curve) 388ecScalarFromInteger s 389 | numBits s > nb = CryptoFailed CryptoError_SecretKeySizeInvalid 390 | otherwise = CryptoPassed (Simple.Scalar s) 391 where nb = 8 * ecCurveOrderBytes (Proxy :: Proxy curve) 392 393ecScalarToInteger :: Simple.Scalar curve -> Integer 394ecScalarToInteger (Simple.Scalar s) = s 395 396ecCurveOrderBytes :: Simple.Curve c => proxy c -> Int 397ecCurveOrderBytes prx = (numBits n + 7) `div` 8 398 where n = Simple.curveEccN $ Simple.curveParameters prx 399 400ecScalarAdd :: forall curve . Simple.Curve curve 401 => Simple.Scalar curve -> Simple.Scalar curve -> Simple.Scalar curve 402ecScalarAdd (Simple.Scalar a) (Simple.Scalar b) = Simple.Scalar ((a + b) `mod` n) 403 where n = Simple.curveEccN $ Simple.curveParameters (Proxy :: Proxy curve) 404 405ecScalarMul :: forall curve . Simple.Curve curve 406 => Simple.Scalar curve -> Simple.Scalar curve -> Simple.Scalar curve 407ecScalarMul (Simple.Scalar a) (Simple.Scalar b) = Simple.Scalar ((a * b) `mod` n) 408 where n = Simple.curveEccN $ Simple.curveParameters (Proxy :: Proxy curve) 409