haskell/cryptonite
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

complete rewrite of the type class

Browse Source 
Now there's no type created by associated type, it just become a routing type class,
however this has a cost, since the associated type are not injective,
requiring more witness for the curve than before.
This commit is contained in:
Vincent Hanquez 2016-12-02 15:02:48 +00:00
parent 955f010bff
commit 7e6d7ccb1c
1 changed files with 78 additions and 107 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

185
Crypto/ECC.hs
View File

@ -23,10 +23,11 @@ module Crypto.ECC
) where ) where
import qualified Crypto.PubKey.ECC.P256 as P256 import qualified Crypto.PubKey.ECC.P256 as P256
import qualified Crypto.PubKey.ECC.Types as H import qualified Crypto.ECC.Simple.Types as Simple
import qualified Crypto.PubKey.ECC.Prim as H import qualified Crypto.ECC.Simple.Prim as Simple
import Crypto.Random import Crypto.Random
import Crypto.Error import Crypto.Error
import Crypto.Internal.Proxy
import Crypto.Internal.Imports import Crypto.Internal.Imports
import Crypto.Internal.ByteArray (ByteArray, ByteArrayAccess, ScrubbedBytes) import Crypto.Internal.ByteArray (ByteArray, ByteArrayAccess, ScrubbedBytes)
import qualified Crypto.Internal.ByteArray as B import qualified Crypto.Internal.ByteArray as B
@ -47,44 +48,26 @@ newtype SharedSecret = SharedSecret ScrubbedBytes
class EllipticCurve curve where class EllipticCurve curve where
-- | Point on an Elliptic Curve -- | Point on an Elliptic Curve
data Point curve :: * type Point curve :: *
-- | Scalar in the Elliptic Curve domain -- | Scalar in the Elliptic Curve domain
data Scalar curve :: * type Scalar curve :: *
-- | get the order of the Curve
curveGetOrder :: curve -> Integer
-- | get the curve related to a point on a curve
curveOfPoint :: Point curve -> curve
-- | get the curve related to a curve's scalar
curveOfScalar :: Scalar curve -> curve
-- | get the base point of the Curve
curveGetBasePoint :: Point curve
-- | Generate a new random scalar on the curve. -- | Generate a new random scalar on the curve.
-- The scalar will represent a number between 1 and the order of the curve non included -- The scalar will represent a number between 1 and the order of the curve non included
curveGenerateScalar :: MonadRandom randomly => randomly (Scalar curve) curveGenerateScalar :: MonadRandom randomly => proxy curve -> randomly (Scalar curve)
-- | Generate a new random keypair -- | Generate a new random keypair
curveGenerateKeyPair :: MonadRandom randomly => randomly (KeyPair curve) curveGenerateKeyPair :: MonadRandom randomly => proxy curve -> randomly (KeyPair curve)
encodePoint :: ByteArray bs => Point curve -> bs -- | Get the curve size in bits
decodePoint :: ByteArray bs => bs -> CryptoFailable (Point curve) curveSizeBits :: proxy curve -> Int
instance {-# OVERLAPPABLE #-} Show (Point a) where -- | Encode a elliptic curve point into binary form
show _ = undefined encodePoint :: ByteArray bs => proxy curve -> Point curve -> bs
instance {-# OVERLAPPABLE #-} Eq (Point a) where -- | Try to decode the binary form of an elliptic curve point
_ == _ = undefined decodePoint :: ByteArray bs => proxy curve -> bs -> CryptoFailable (Point curve)
instance {-# OVERLAPPABLE #-} Show (Scalar a) where
show _ = undefined
instance {-# OVERLAPPABLE #-} Eq (Scalar a) where
_ == _ = undefined
class EllipticCurve curve => EllipticCurveDH curve where class EllipticCurve curve => EllipticCurveDH curve where
-- | Generate a Diffie hellman secret value. -- | Generate a Diffie hellman secret value.
@ -93,14 +76,14 @@ class EllipticCurve curve => EllipticCurveDH curve where
-- is not hashed. -- is not hashed.
-- --
-- use `pointSmul` to keep the result in Point format. -- use `pointSmul` to keep the result in Point format.
ecdh :: Scalar curve -> Point curve -> SharedSecret ecdh :: proxy curve -> Scalar curve -> Point curve -> SharedSecret
class EllipticCurve curve => EllipticCurveArith curve where class EllipticCurve curve => EllipticCurveArith curve where
-- | Add points on a curve -- | Add points on a curve
pointAdd :: Point curve -> Point curve -> Point curve pointAdd :: proxy curve -> Point curve -> Point curve -> Point curve
-- | Scalar Multiplication on a curve -- | Scalar Multiplication on a curve
pointSmul :: Scalar curve -> Point curve -> Point curve pointSmul :: proxy curve -> Scalar curve -> Point curve -> Point curve
-- -- | Scalar Inverse -- -- | Scalar Inverse
-- scalarInverse :: Scalar curve -> Scalar curve -- scalarInverse :: Scalar curve -> Scalar curve
@ -111,118 +94,103 @@ class EllipticCurve curve => EllipticCurveArith curve where
data Curve_P256R1 = Curve_P256R1 data Curve_P256R1 = Curve_P256R1
instance EllipticCurve Curve_P256R1 where instance EllipticCurve Curve_P256R1 where
newtype Point Curve_P256R1 = P256Point { unP256Point :: P256.Point } deriving (Eq,Show) type Point Curve_P256R1 = P256.Point
newtype Scalar Curve_P256R1 = P256Scalar { unP256Scalar :: P256.Scalar } deriving (Eq,Show) type Scalar Curve_P256R1 = P256.Scalar
curveGetOrder _ = 0xffffffff00000000ffffffffffffffffbce6faada7179e84f3b9cac2fc632551 curveSizeBits _ = 256
curveGetBasePoint = P256Point P256.pointBase curveGenerateScalar _ = P256.scalarGenerate
curveOfScalar _ = Curve_P256R1 curveGenerateKeyPair _ = toKeyPair <$> P256.scalarGenerate
curveOfPoint _ = Curve_P256R1 where toKeyPair scalar = KeyPair (P256.toPoint scalar) scalar
curveGenerateScalar = P256Scalar <$> P256.scalarGenerate encodePoint _ p = encodeECPoint (Simple.Point x y :: Simple.Point Simple.SEC_p256r1)
curveGenerateKeyPair = toKeyPair <$> P256.scalarGenerate
where toKeyPair scalar = KeyPair (P256Point $ P256.toPoint scalar) (P256Scalar scalar)
encodePoint (P256Point p) = encodeECPoint x y 32
where where
(x,y) = P256.pointToIntegers p (x,y) = P256.pointToIntegers p
decodePoint bs = fromPoint <$> decodeECPoint bs decodePoint _ bs = fromSimplePoint <$> decodeECPoint bs
where fromPoint (H.Point x y) = P256Point $ P256.pointFromIntegers (x,y) where fromSimplePoint :: Simple.Point Simple.SEC_p256r1 -> P256.Point
fromPoint H.PointO = error "impossible happened: fromPoint is infinite" fromSimplePoint (Simple.Point x y) = P256.pointFromIntegers (x,y)
fromSimplePoint Simple.PointO = error "impossible happened: fromPoint is infinite"
instance EllipticCurveArith Curve_P256R1 where instance EllipticCurveArith Curve_P256R1 where
pointAdd a b = P256Point $ (P256.pointAdd `on` unP256Point) a b pointAdd _ a b = P256.pointAdd a b
pointSmul s p = P256Point $ P256.pointMul (unP256Scalar s) (unP256Point p) pointSmul _ s p = P256.pointMul s p
instance EllipticCurveDH Curve_P256R1 where instance EllipticCurveDH Curve_P256R1 where
ecdh s p = shared ecdh proxy s p = shared
where where
(x, _) = P256.pointToIntegers $ unP256Point $ pointSmul s p (x, _) = P256.pointToIntegers $ pointSmul proxy s p
len = 32 -- (256 + 7) `div` 8 len = 32 -- (256 + 7) `div` 8
shared = SharedSecret $ i2ospOf_ len x shared = SharedSecret $ i2ospOf_ len x
data Curve_P384R1 = Curve_P384R1 data Curve_P384R1 = Curve_P384R1
instance EllipticCurve Curve_P384R1 where instance EllipticCurve Curve_P384R1 where
newtype Point Curve_P384R1 = P384Point { unP384Point :: H.Point } deriving (Eq,Show) type Point Curve_P384R1 = Simple.Point Simple.SEC_p384r1
newtype Scalar Curve_P384R1 = P384Scalar { unP384Scalar :: H.PrivateNumber } deriving (Eq,Show) type Scalar Curve_P384R1 = Simple.Scalar Simple.SEC_p384r1
curveGetOrder _ = H.ecc_n $ H.common_curve $ H.getCurveByName H.SEC_p384r1 curveSizeBits _ = 384
curveGetBasePoint = P384Point $ H.ecc_g $ H.common_curve $ H.getCurveByName H.SEC_p384r1 curveGenerateScalar _ = Simple.scalarGenerate
curveOfScalar _ = Curve_P384R1 curveGenerateKeyPair _ = toKeyPair <$> Simple.scalarGenerate
curveOfPoint _ = Curve_P384R1 where toKeyPair scalar = KeyPair (Simple.pointBaseMul scalar) scalar
curveGenerateScalar = P384Scalar <$> H.scalarGenerate (H.getCurveByName H.SEC_p384r1) encodePoint _ point = encodeECPoint point
curveGenerateKeyPair = toKeyPair <$> H.scalarGenerate (H.getCurveByName H.SEC_p384r1) decodePoint _ bs = decodeECPoint bs
where toKeyPair scalar = KeyPair (P384Point $ H.pointBaseMul (H.getCurveByName H.SEC_p384r1) scalar) (P384Scalar scalar)
encodePoint (P384Point (H.Point x y)) = encodeECPoint x y 48
encodePoint (P384Point _) = error "encodePoint P384"
decodePoint bs = P384Point <$> decodeECPoint bs
instance EllipticCurveArith Curve_P384R1 where instance EllipticCurveArith Curve_P384R1 where
pointAdd a b = P384Point $ (H.pointAdd (H.getCurveByName H.SEC_p384r1) `on` unP384Point) a b pointAdd _ a b = Simple.pointAdd a b
pointSmul s p = P384Point (H.pointMul (H.getCurveByName H.SEC_p384r1) (unP384Scalar s) (unP384Point p)) pointSmul _ s p = Simple.pointMul s p
instance EllipticCurveDH Curve_P384R1 where instance EllipticCurveDH Curve_P384R1 where
ecdh s p = shared ecdh _ s p = SharedSecret $ i2ospOf_ (curveSizeBytes prx) x
where where
H.Point x _ = unP384Point $ pointSmul s p prx = Proxy :: Proxy Curve_P384R1
len = 48 -- (384 + 7) `div` 8 Simple.Point x _ = pointSmul prx s p
shared = SharedSecret $ i2ospOf_ len x
data Curve_P521R1 = Curve_P521R1 data Curve_P521R1 = Curve_P521R1
instance EllipticCurve Curve_P521R1 where instance EllipticCurve Curve_P521R1 where
newtype Point Curve_P521R1 = P521Point { unP521Point :: H.Point } deriving (Eq,Show) type Point Curve_P521R1 = Simple.Point Simple.SEC_p521r1
newtype Scalar Curve_P521R1 = P521Scalar { unP521Scalar :: H.PrivateNumber } deriving (Eq,Show) type Scalar Curve_P521R1 = Simple.Scalar Simple.SEC_p521r1
curveGetOrder _ = H.ecc_n $ H.common_curve $ H.getCurveByName H.SEC_p521r1 curveSizeBits _ = 521
curveGetBasePoint = P521Point $ H.ecc_g $ H.common_curve $ H.getCurveByName H.SEC_p521r1 curveGenerateScalar _ = Simple.scalarGenerate
curveOfScalar _ = Curve_P521R1 curveGenerateKeyPair _ = toKeyPair <$> Simple.scalarGenerate
curveOfPoint _ = Curve_P521R1 where toKeyPair scalar = KeyPair (Simple.pointBaseMul scalar) scalar
curveGenerateScalar = P521Scalar <$> H.scalarGenerate (H.getCurveByName H.SEC_p521r1) encodePoint _ point = encodeECPoint point
curveGenerateKeyPair = toKeyPair <$> H.scalarGenerate (H.getCurveByName H.SEC_p521r1) decodePoint _ bs = decodeECPoint bs
where toKeyPair scalar = KeyPair (P521Point $ H.pointBaseMul (H.getCurveByName H.SEC_p521r1) scalar) (P521Scalar scalar)
encodePoint (P521Point (H.Point x y)) = encodeECPoint x y 66
encodePoint (P521Point _) = error "encodePoint P521"
decodePoint bs = P521Point <$> decodeECPoint bs
instance EllipticCurveArith Curve_P521R1 where instance EllipticCurveArith Curve_P521R1 where
pointAdd a b = P521Point $ (H.pointAdd (H.getCurveByName H.SEC_p521r1) `on` unP521Point) a b pointAdd _ a b = Simple.pointAdd a b
pointSmul s p = P521Point (H.pointMul (H.getCurveByName H.SEC_p521r1) (unP521Scalar s) (unP521Point p)) pointSmul _ s p = Simple.pointMul s p
instance EllipticCurveDH Curve_P521R1 where instance EllipticCurveDH Curve_P521R1 where
ecdh s p = shared ecdh _ s p = SharedSecret $ i2ospOf_ (curveSizeBytes prx) x
where where
H.Point x _ = unP521Point $ pointSmul s p prx = Proxy :: Proxy Curve_P521R1
len = 66 -- (521 + 7) `div` 8 Simple.Point x _ = pointSmul prx s p
shared = SharedSecret $ i2ospOf_ len x
data Curve_X25519 = Curve_X25519 data Curve_X25519 = Curve_X25519
instance EllipticCurve Curve_X25519 where instance EllipticCurve Curve_X25519 where
newtype Point Curve_X25519 = X25519Point X25519.PublicKey deriving (Eq,Show) type Point Curve_X25519 = X25519.PublicKey
newtype Scalar Curve_X25519 = X25519Scalar X25519.SecretKey deriving (Eq,Show) type Scalar Curve_X25519 = X25519.SecretKey
curveGetOrder _ = undefined curveSizeBits _ = 255
curveGetBasePoint = undefined curveGenerateScalar _ = X25519.generateSecretKey
curveOfScalar _ = Curve_X25519 curveGenerateKeyPair _ = do
curveOfPoint _ = Curve_X25519
curveGenerateScalar = X25519Scalar <$> X25519.generateSecretKey
curveGenerateKeyPair = do
s <- X25519.generateSecretKey s <- X25519.generateSecretKey
let p = X25519.toPublic s return $ KeyPair (X25519.toPublic s) s
return $ KeyPair (X25519Point p) (X25519Scalar s) encodePoint _ p = B.convert p
encodePoint (X25519Point p) = B.convert p decodePoint _ bs = X25519.publicKey bs
decodePoint bs = X25519Point <$> X25519.publicKey bs
instance EllipticCurveDH Curve_X25519 where instance EllipticCurveDH Curve_X25519 where
ecdh (X25519Scalar s) (X25519Point p) = SharedSecret $ convert secret ecdh _ s p = SharedSecret $ convert secret
where where secret = X25519.dh p s
secret = X25519.dh p s
encodeECPoint :: forall bs. ByteArray bs => Integer -> Integer -> Int -> bs encodeECPoint :: forall curve bs . (Simple.Curve curve, ByteArray bs) => Simple.Point curve -> bs
encodeECPoint x y siz = B.concat [uncompressed,xb,yb] encodeECPoint Simple.PointO = error "encodeECPoint: cannot serialize point at infinity"
encodeECPoint (Simple.Point x y) = B.concat [uncompressed,xb,yb]
where where
size = Simple.curveSizeBytes (Proxy :: Proxy curve)
uncompressed, xb, yb :: bs uncompressed, xb, yb :: bs
uncompressed = B.singleton 4 uncompressed = B.singleton 4
xb = i2ospOf_ siz x xb = i2ospOf_ size x
yb = i2ospOf_ siz y yb = i2ospOf_ size y
decodeECPoint :: ByteArray bs => bs -> CryptoFailable H.Point decodeECPoint :: (Simple.Curve curve, ByteArray bs) => bs -> CryptoFailable (Simple.Point curve)
decodeECPoint mxy = case B.uncons mxy of decodeECPoint mxy = case B.uncons mxy of
Nothing -> CryptoFailed $ CryptoError_PointSizeInvalid Nothing -> CryptoFailed $ CryptoError_PointSizeInvalid
Just (m,xy) Just (m,xy)
@ -232,5 +200,8 @@ decodeECPoint mxy = case B.uncons mxy of
(xb,yb) = B.splitAt siz xy (xb,yb) = B.splitAt siz xy
x = os2ip xb x = os2ip xb
y = os2ip yb y = os2ip yb
in CryptoPassed $ H.Point x y in CryptoPassed $ Simple.Point x y
| otherwise -> CryptoFailed $ CryptoError_PointFormatInvalid | otherwise -> CryptoFailed $ CryptoError_PointFormatInvalid
curveSizeBytes :: EllipticCurve c => Proxy c -> Int
curveSizeBytes proxy = (curveSizeBits proxy + 7) `div` 8