relaxing types of encodePoint and decodePoint.

This commit is contained in:
Kazu Yamamoto 2016-11-30 15:34:35 +09:00
parent 58151b9965
commit e9ea55ab57

View File

@ -9,6 +9,7 @@
-- --
{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Crypto.ECC module Crypto.ECC
( Curve_P256R1(..) ( Curve_P256R1(..)
, Curve_P384R1(..) , Curve_P384R1(..)
@ -26,13 +27,12 @@ import qualified Crypto.PubKey.ECC.Types as H
import qualified Crypto.PubKey.ECC.Prim as H import qualified Crypto.PubKey.ECC.Prim as H
import Crypto.Random import Crypto.Random
import Crypto.Internal.Imports import Crypto.Internal.Imports
import Crypto.Internal.ByteArray (ByteArrayAccess, ScrubbedBytes) import Crypto.Internal.ByteArray (ByteArray, ByteArrayAccess, ScrubbedBytes)
import qualified Crypto.Internal.ByteArray as B
import Crypto.Number.Serialize (i2ospOf_, os2ip) import Crypto.Number.Serialize (i2ospOf_, os2ip)
import qualified Crypto.PubKey.Curve25519 as X25519 import qualified Crypto.PubKey.Curve25519 as X25519
import Data.Function (on) import Data.Function (on)
import Data.ByteArray (convert) 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 -- | An elliptic curve key pair composed of the private part (a scalar), and
-- the associated point. -- the associated point.
@ -70,8 +70,8 @@ class EllipticCurve curve where
-- | Generate a new random keypair -- | Generate a new random keypair
curveGenerateKeyPair :: MonadRandom randomly => randomly (KeyPair curve) curveGenerateKeyPair :: MonadRandom randomly => randomly (KeyPair curve)
encodePoint :: Point curve -> ByteString encodePoint :: ByteArray bs => Point curve -> bs
decodePoint :: ByteString -> Point curve decodePoint :: ByteArray bs => bs -> Point curve
instance {-# OVERLAPPABLE #-} Show (Point a) where instance {-# OVERLAPPABLE #-} Show (Point a) where
show _ = undefined show _ = undefined
@ -219,18 +219,22 @@ instance EllipticCurveDH Curve_X25519 where
where where
secret = X25519.dh p s secret = X25519.dh p s
encodeECPoint :: Integer -> Integer -> Int -> ByteString encodeECPoint :: forall bs. ByteArray bs => Integer -> Integer -> Int -> bs
encodeECPoint x y siz = B.concat [uncompressed,xb,yb] encodeECPoint x y siz = B.concat [uncompressed,xb,yb]
where where
uncompressed, xb, yb :: bs
uncompressed = B.singleton 4 uncompressed = B.singleton 4
xb = i2ospOf_ siz x xb = i2ospOf_ siz x
yb = i2ospOf_ siz y yb = i2ospOf_ siz y
decodeECPoint :: ByteString -> (Integer,Integer) decodeECPoint :: ByteArray bs => bs -> (Integer,Integer)
decodeECPoint mxy = (x,y) decodeECPoint mxy = case B.uncons mxy of
where Nothing -> error "decodeECPoint"
xy = B.drop 1 mxy -- dropping 4 (uncompressed) Just (m,xy)
siz = B.length xy `div` 2 -- uncompressed
(xb,yb) = B.splitAt siz xy | m == 4 -> let siz = B.length xy `div` 2
x = os2ip xb (xb,yb) = B.splitAt siz xy
y = os2ip yb x = os2ip xb
y = os2ip yb
in (x,y)
| otherwise -> error $ "decodeECPoint: unknown " ++ show m