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