implmenting encodePoint and decodePoint for TLS.
This commit is contained in:
Kazu Yamamoto
parent
a6f177352a
commit
c0b0846232
@ -27,10 +27,12 @@ import qualified Crypto.PubKey.ECC.Prim as H
|
||||
import Crypto.Random
|
||||
import Crypto.Internal.Imports
|
||||
import Crypto.Internal.ByteArray (ByteArrayAccess, ScrubbedBytes)
|
||||
import Crypto.Number.Serialize (i2ospOf_)
|
||||
import Crypto.Number.Serialize (i2ospOf_, os2ip)
|
||||
import qualified Crypto.PubKey.Curve25519 as X25519
|
||||
import Data.Function (on)
|
||||
import Data.ByteArray (convert)
|
||||
import Data.ByteString (ByteString)
|
||||
import qualified Data.ByteString as B
|
||||
|
||||
-- | An elliptic curve key pair composed of the private part (a scalar), and
|
||||
-- the associated point.
|
||||
@ -68,6 +70,9 @@ class EllipticCurve curve where
|
||||
-- | Generate a new random keypair
|
||||
curveGenerateKeyPair :: MonadRandom randomly => randomly (KeyPair curve)
|
||||
|
||||
encodePoint :: Point curve -> ByteString
|
||||
decodePoint :: ByteString -> Point curve
|
||||
|
||||
instance {-# OVERLAPPABLE #-} Show (Point a) where
|
||||
show _ = undefined
|
||||
|
||||
@ -114,6 +119,10 @@ instance EllipticCurve Curve_P256R1 where
|
||||
curveGenerateScalar = P256Scalar <$> P256.scalarGenerate
|
||||
curveGenerateKeyPair = toKeyPair <$> P256.scalarGenerate
|
||||
where toKeyPair scalar = KeyPair (P256Point $ P256.toPoint scalar) (P256Scalar scalar)
|
||||
encodePoint (P256Point p) = encodeECPoint x y 32
|
||||
where
|
||||
(x,y) = P256.pointToIntegers p
|
||||
decodePoint bs = P256Point $ P256.pointFromIntegers $ decodeECPoint bs
|
||||
|
||||
instance EllipticCurveArith Curve_P256R1 where
|
||||
pointAdd a b = P256Point $ (P256.pointAdd `on` unP256Point) a b
|
||||
@ -123,7 +132,7 @@ instance EllipticCurveDH Curve_P256R1 where
|
||||
ecdh s p = shared
|
||||
where
|
||||
(x, _) = P256.pointToIntegers $ unP256Point $ pointSmul s p
|
||||
len = (256 + 7) `div` 8
|
||||
len = 32 -- (256 + 7) `div` 8
|
||||
shared = SharedSecret $ i2ospOf_ len x
|
||||
|
||||
data Curve_P384R1 = Curve_P384R1
|
||||
@ -138,6 +147,11 @@ instance EllipticCurve Curve_P384R1 where
|
||||
curveGenerateScalar = P384Scalar <$> H.scalarGenerate (H.getCurveByName H.SEC_p384r1)
|
||||
curveGenerateKeyPair = toKeyPair <$> H.scalarGenerate (H.getCurveByName H.SEC_p384r1)
|
||||
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 $ H.Point x y
|
||||
where
|
||||
(x,y) = decodeECPoint bs
|
||||
|
||||
instance EllipticCurveArith Curve_P384R1 where
|
||||
pointAdd a b = P384Point $ (H.pointAdd (H.getCurveByName H.SEC_p384r1) `on` unP384Point) a b
|
||||
@ -147,7 +161,7 @@ instance EllipticCurveDH Curve_P384R1 where
|
||||
ecdh s p = shared
|
||||
where
|
||||
H.Point x _ = unP384Point $ pointSmul s p
|
||||
len = (384 + 7) `div` 8
|
||||
len = 48 -- (384 + 7) `div` 8
|
||||
shared = SharedSecret $ i2ospOf_ len x
|
||||
|
||||
data Curve_P521R1 = Curve_P521R1
|
||||
@ -162,6 +176,11 @@ instance EllipticCurve Curve_P521R1 where
|
||||
curveGenerateScalar = P521Scalar <$> H.scalarGenerate (H.getCurveByName H.SEC_p521r1)
|
||||
curveGenerateKeyPair = toKeyPair <$> H.scalarGenerate (H.getCurveByName H.SEC_p521r1)
|
||||
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 $ H.Point x y
|
||||
where
|
||||
(x,y) = decodeECPoint bs
|
||||
|
||||
instance EllipticCurveArith Curve_P521R1 where
|
||||
pointAdd a b = P521Point $ (H.pointAdd (H.getCurveByName H.SEC_p521r1) `on` unP521Point) a b
|
||||
@ -171,7 +190,7 @@ instance EllipticCurveDH Curve_P521R1 where
|
||||
ecdh s p = shared
|
||||
where
|
||||
H.Point x _ = unP521Point $ pointSmul s p
|
||||
len = (521 + 7) `div` 8
|
||||
len = 66 -- (521 + 7) `div` 8
|
||||
shared = SharedSecret $ i2ospOf_ len x
|
||||
|
||||
data Curve_X25519 = Curve_X25519
|
||||
@ -188,6 +207,8 @@ instance EllipticCurve Curve_X25519 where
|
||||
s <- X25519.generateSecretKey
|
||||
let p = X25519.toPublic s
|
||||
return $ KeyPair (X25519Point p) (X25519Scalar s)
|
||||
encodePoint (X25519Point p) = X25519.fromPublicKey p
|
||||
decodePoint bs = X25519Point $ X25519.toPublicKey bs
|
||||
|
||||
instance EllipticCurveArith Curve_X25519 where
|
||||
pointAdd = undefined
|
||||
@ -197,3 +218,19 @@ instance EllipticCurveDH Curve_X25519 where
|
||||
ecdh (X25519Scalar s) (X25519Point p) = SharedSecret $ convert secret
|
||||
where
|
||||
secret = X25519.dh p s
|
||||
|
||||
encodeECPoint :: Integer -> Integer -> Int -> ByteString
|
||||
encodeECPoint x y siz = B.concat [uncompressed,xb,yb]
|
||||
where
|
||||
uncompressed = B.singleton 4
|
||||
xb = i2ospOf_ siz x
|
||||
yb = i2ospOf_ siz y
|
||||
|
||||
decodeECPoint :: ByteString -> (Integer,Integer)
|
||||
decodeECPoint mxy = (x,y)
|
||||
where
|
||||
xy = B.drop 1 mxy -- dropping 4 (uncompressed)
|
||||
siz = B.length xy `div` 2
|
||||
(xb,yb) = B.splitAt siz xy
|
||||
x = os2ip xb
|
||||
y = os2ip yb
|
||||
|
||||
@ -18,6 +18,8 @@ module Crypto.PubKey.Curve25519
|
||||
, dhSecret
|
||||
, publicKey
|
||||
, secretKey
|
||||
, toPublicKey
|
||||
, fromPublicKey
|
||||
-- * methods
|
||||
, dh
|
||||
, toPublic
|
||||
@ -128,3 +130,11 @@ generateSecretKey = return $ unsafeDoIO $ do
|
||||
pokeByteOff inp 31 ((e31 .&. 0x7f) .|. 0x40)
|
||||
let CryptoPassed s = secretKey bs
|
||||
return s
|
||||
|
||||
toPublicKey :: ByteString -> PublicKey
|
||||
toPublicKey bs = pub
|
||||
where
|
||||
CryptoPassed pub = publicKey bs
|
||||
|
||||
fromPublicKey :: PublicKey -> ByteString
|
||||
fromPublicKey (PublicKey b) = B.convert b
|
||||
|
||||
Loading…
Reference in New Issue
Block a user