From e00c89fb25ffedf19536755258295f9d7875d781 Mon Sep 17 00:00:00 2001 From: Kazu Yamamoto Date: Tue, 8 Nov 2016 13:18:36 +0900 Subject: [PATCH 01/36] adding toByteString and fromByteString to PRK. --- Crypto/KDF/HKDF.hs | 16 +++++++++++++++- 1 file changed, 15 insertions(+), 1 deletion(-) diff --git a/Crypto/KDF/HKDF.hs b/Crypto/KDF/HKDF.hs index 0b956011..86c4d91a 100644 --- a/Crypto/KDF/HKDF.hs +++ b/Crypto/KDF/HKDF.hs @@ -15,6 +15,8 @@ module Crypto.KDF.HKDF , extract , extractSkip , expand + , toByteString + , fromByteString ) where import Data.Word @@ -22,11 +24,23 @@ import Crypto.Hash import Crypto.MAC.HMAC import Crypto.Internal.ByteArray (ScrubbedBytes, Bytes, ByteArray, ByteArrayAccess) import qualified Crypto.Internal.ByteArray as B +import qualified Data.ByteString as BS -- | Pseudo Random Key data PRK a = PRK (HMAC a) | PRK_NoExpand ScrubbedBytes deriving (Eq) +instance Show (PRK a) where + show (PRK hm) = show (hmacGetDigest hm) + show (PRK_NoExpand sb) = show sb + +toByteString :: PRK a -> BS.ByteString +toByteString (PRK hm) = B.convert hm +toByteString (PRK_NoExpand sb) = B.convert sb + +fromByteString :: BS.ByteString -> PRK a +fromByteString = extractSkip + -- | Extract a Pseudo Random Key using the parameter and the underlaying hash mechanism extract :: (HashAlgorithm a, ByteArrayAccess salt, ByteArrayAccess ikm) => salt -- ^ Salt @@ -38,7 +52,7 @@ extract salt ikm = PRK $ hmac salt ikm -- -- Only use when guaranteed to have a good quality and random data to use directly as key. -- This effectively skip a HMAC with key=salt and data=key. -extractSkip :: (HashAlgorithm a, ByteArrayAccess ikm) +extractSkip :: ByteArrayAccess ikm => ikm -> PRK a extractSkip ikm = PRK_NoExpand $ B.convert ikm From 60bb2cacb46ebafe8446581fe95344700543dba2 Mon Sep 17 00:00:00 2001 From: Vincent Hanquez Date: Fri, 16 Oct 2015 09:50:45 +0100 Subject: [PATCH 02/36] [ECC] Improve the code base to allow multiples different implementations * Use TypeFamilies; need to see what to do for older GHC versions * Start implementing some API related to ECIES --- Crypto/ECC.hs | 112 +++++++++++++++++++++++++++++++++++++++++ Crypto/PubKey/ECIES.hs | 33 ++++++++++++ cryptonite.cabal | 2 + 3 files changed, 147 insertions(+) create mode 100644 Crypto/ECC.hs create mode 100644 Crypto/PubKey/ECIES.hs diff --git a/Crypto/ECC.hs b/Crypto/ECC.hs new file mode 100644 index 00000000..9a9008a2 --- /dev/null +++ b/Crypto/ECC.hs @@ -0,0 +1,112 @@ +-- | +-- Module : Crypto.ECC +-- License : BSD-style +-- Maintainer : Vincent Hanquez +-- Stability : experimental +-- Portability : unknown +-- +-- Elliptic Curve Cryptography +-- +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE TypeFamilies #-} +module Crypto.ECC + ( Curve_P256R1(..) + , Curve_P521R1(..) + , EllipticCurve(..) + , EllipticCurveDH(..) + , EllipticCurveArith(..) + , KeyPair(..) + , SharedSecret(..) + ) where + +import qualified Crypto.PubKey.ECC.P256 as P256 +import qualified Crypto.PubKey.ECC.Types as H +import qualified Crypto.PubKey.ECC.Prim as H +import Crypto.Random +import Crypto.Internal.ByteArray (ByteArrayAccess, ScrubbedBytes) +import Data.Function (on) + +-- | An elliptic curve key pair composed of the private part (a scalar), and +-- the associated point. +data KeyPair curve = KeyPair + { keypairGetPublic :: !(Point curve) + , keypairGetPrivate :: !(Scalar curve) + } + +newtype SharedSecret = SharedSecret ScrubbedBytes + deriving (Eq, ByteArrayAccess) + +class EllipticCurve curve where + -- | Point on an Elliptic Curve + data Point curve :: * + + -- | Scalar in the Elliptic Curve domain + data 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. + -- The scalar will represent a number between 1 and the order of the curve non included + curveGenerateScalar :: MonadRandom randomly => randomly (Scalar curve) + + -- | Generate a new random keypair + curveGenerateKeyPair :: MonadRandom randomly => randomly (KeyPair curve) + +class EllipticCurve curve => EllipticCurveDH curve where + -- | Generate a Diffie hellman secret + ecdh :: Scalar curve -> Point curve -> SharedSecret + +class EllipticCurve curve => EllipticCurveArith curve where + -- | Add points on a curve + pointAdd :: Point curve -> Point curve -> Point curve + + -- | Scalar Multiplication on a curve + pointSmul :: Scalar curve -> Point curve -> Point curve + +-- | P256 Curve +-- +-- also known as P256 +data Curve_P256R1 = Curve_P256R1 + +instance EllipticCurve Curve_P256R1 where + newtype Point Curve_P256R1 = P256Point { unP256Point :: P256.Point } + newtype Scalar Curve_P256R1 = P256Scalar { unP256Scalar :: P256.Scalar } + curveGetOrder _ = 0xffffffff00000000ffffffffffffffffbce6faada7179e84f3b9cac2fc632551 + curveGetBasePoint = P256Point P256.pointBase + curveOfScalar _ = Curve_P256R1 + curveOfPoint _ = Curve_P256R1 + curveGenerateScalar = P256Scalar <$> P256.scalarGenerate + curveGenerateKeyPair = toKeyPair <$> P256.scalarGenerate + where toKeyPair scalar = KeyPair (P256Point $ P256.toPoint scalar) (P256Scalar scalar) +instance EllipticCurveArith Curve_P256R1 where + pointAdd a b = P256Point $ (P256.pointAdd `on` unP256Point) a b + pointSmul s p = P256Point $ P256.pointMul (unP256Scalar s) (unP256Point p) +instance EllipticCurveDH Curve_P256R1 where + ecdh s p = undefined + +data Curve_P521R1 = Curve_P521R1 + +instance EllipticCurve Curve_P521R1 where + newtype Point Curve_P521R1 = P521Point { unP521Point :: H.Point } + newtype Scalar Curve_P521R1 = P521Scalar { unP521Scalar :: H.PrivateNumber } + curveGetOrder _ = H.ecc_n $ H.common_curve $ H.getCurveByName H.SEC_p521r1 + curveGetBasePoint = P521Point $ H.ecc_g $ H.common_curve $ H.getCurveByName H.SEC_p521r1 + curveOfScalar _ = Curve_P521R1 + curveOfPoint _ = Curve_P521R1 + 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) +instance EllipticCurveArith Curve_P521R1 where + pointAdd a b = P521Point $ (H.pointAdd (H.getCurveByName H.SEC_p521r1) `on` unP521Point) a b + pointSmul s p = P521Point (H.pointMul (H.getCurveByName H.SEC_p521r1) (unP521Scalar s) (unP521Point p)) + diff --git a/Crypto/PubKey/ECIES.hs b/Crypto/PubKey/ECIES.hs new file mode 100644 index 00000000..2f6a646a --- /dev/null +++ b/Crypto/PubKey/ECIES.hs @@ -0,0 +1,33 @@ +-- | +-- Module : Crypto.PubKey.ECIES +-- License : BSD-style +-- Maintainer : Vincent Hanquez +-- Stability : experimental +-- Portability : unknown +-- +-- IES with Elliptic curve +-- +module Crypto.PubKey.ECIES + ( deriveEncrypt + , deriveDecrypt + ) where + +import Crypto.ECC +import Crypto.Random + +-- | Generate random a new Shared secret and the associated point +-- to do a ECIES style encryption +deriveEncrypt :: (MonadRandom randomly, EllipticCurveDH curve) + => Point curve -- ^ the public key of the receiver + -> randomly (Point curve, SharedSecret) +deriveEncrypt pub = do + (KeyPair rPoint rScalar) <- curveGenerateKeyPair + return (rPoint, ecdh rScalar pub) + +-- | Derive the shared secret with the receiver key +-- and the R point of the scheme. +deriveDecrypt :: EllipticCurveDH curve + => Point curve -- ^ The received R (supposedly, randomly generate on the encrypt side) + -> Scalar curve -- ^ The secret key of the receiver + -> SharedSecret +deriveDecrypt point secret = ecdh secret point diff --git a/cryptonite.cabal b/cryptonite.cabal index 580e8025..1447961d 100644 --- a/cryptonite.cabal +++ b/cryptonite.cabal @@ -101,6 +101,7 @@ Library Crypto.ConstructHash.MiyaguchiPreneel Crypto.Data.AFIS Crypto.Data.Padding + Crypto.ECC Crypto.Error Crypto.MAC.CMAC Crypto.MAC.Poly1305 @@ -129,6 +130,7 @@ Library Crypto.PubKey.ECC.ECDSA Crypto.PubKey.ECC.P256 Crypto.PubKey.ECC.Types + Crypto.PubKey.ECIES Crypto.PubKey.Ed25519 Crypto.PubKey.Ed448 Crypto.PubKey.RSA From 7c833eddfd85ea70547c83a9d6a12ff284b482d6 Mon Sep 17 00:00:00 2001 From: Vincent Hanquez Date: Mon, 21 Mar 2016 08:52:32 +0000 Subject: [PATCH 03/36] improve description --- Crypto/ECC.hs | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/Crypto/ECC.hs b/Crypto/ECC.hs index 9a9008a2..40cfb911 100644 --- a/Crypto/ECC.hs +++ b/Crypto/ECC.hs @@ -63,7 +63,12 @@ class EllipticCurve curve where curveGenerateKeyPair :: MonadRandom randomly => randomly (KeyPair curve) class EllipticCurve curve => EllipticCurveDH curve where - -- | Generate a Diffie hellman secret + -- | Generate a Diffie hellman secret value. + -- + -- This is generally just the .x coordinate of the resulting point, that + -- is not hashed. + -- + -- use `pointSmul` to keep the result in Point format. ecdh :: Scalar curve -> Point curve -> SharedSecret class EllipticCurve curve => EllipticCurveArith curve where From f3255c2fa01e31386b703e2ea211a217318f3bf2 Mon Sep 17 00:00:00 2001 From: Vincent Hanquez Date: Wed, 23 Mar 2016 08:22:20 +0000 Subject: [PATCH 04/36] fix imports on older versions --- Crypto/ECC.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/Crypto/ECC.hs b/Crypto/ECC.hs index 40cfb911..0a8c637a 100644 --- a/Crypto/ECC.hs +++ b/Crypto/ECC.hs @@ -23,6 +23,7 @@ import qualified Crypto.PubKey.ECC.P256 as P256 import qualified Crypto.PubKey.ECC.Types as H import qualified Crypto.PubKey.ECC.Prim as H import Crypto.Random +import Crypto.Internal.Imports import Crypto.Internal.ByteArray (ByteArrayAccess, ScrubbedBytes) import Data.Function (on) From c29fa8241778c960112ce065287aab7048b1399f Mon Sep 17 00:00:00 2001 From: Vincent Hanquez Date: Thu, 24 Mar 2016 05:56:18 +0000 Subject: [PATCH 05/36] add a note about scalarInverse --- Crypto/ECC.hs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/Crypto/ECC.hs b/Crypto/ECC.hs index 0a8c637a..bf1039e2 100644 --- a/Crypto/ECC.hs +++ b/Crypto/ECC.hs @@ -79,6 +79,9 @@ class EllipticCurve curve => EllipticCurveArith curve where -- | Scalar Multiplication on a curve pointSmul :: Scalar curve -> Point curve -> Point curve +-- -- | Scalar Inverse +-- scalarInverse :: Scalar curve -> Scalar curve + -- | P256 Curve -- -- also known as P256 From 9a0ec9166aca0a600bb05b03e2ba38ed7db63419 Mon Sep 17 00:00:00 2001 From: Kazu Yamamoto Date: Tue, 15 Nov 2016 15:41:00 +0900 Subject: [PATCH 06/36] implementing ecdh fpr P256 and P521. --- Crypto/ECC.hs | 16 +++++++++++++++- 1 file changed, 15 insertions(+), 1 deletion(-) diff --git a/Crypto/ECC.hs b/Crypto/ECC.hs index bf1039e2..4ab08f7d 100644 --- a/Crypto/ECC.hs +++ b/Crypto/ECC.hs @@ -25,6 +25,7 @@ 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 Data.Function (on) -- | An elliptic curve key pair composed of the private part (a scalar), and @@ -97,11 +98,17 @@ instance EllipticCurve Curve_P256R1 where curveGenerateScalar = P256Scalar <$> P256.scalarGenerate curveGenerateKeyPair = toKeyPair <$> P256.scalarGenerate where toKeyPair scalar = KeyPair (P256Point $ P256.toPoint scalar) (P256Scalar scalar) + instance EllipticCurveArith Curve_P256R1 where pointAdd a b = P256Point $ (P256.pointAdd `on` unP256Point) a b pointSmul s p = P256Point $ P256.pointMul (unP256Scalar s) (unP256Point p) + instance EllipticCurveDH Curve_P256R1 where - ecdh s p = undefined + ecdh s p = shared + where + (x, _) = P256.pointToIntegers $ unP256Point $ pointSmul s p + len = (256 + 7) `div` 8 + shared = SharedSecret $ i2ospOf_ len x data Curve_P521R1 = Curve_P521R1 @@ -115,7 +122,14 @@ 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) + instance EllipticCurveArith Curve_P521R1 where pointAdd a b = P521Point $ (H.pointAdd (H.getCurveByName H.SEC_p521r1) `on` unP521Point) a b pointSmul s p = P521Point (H.pointMul (H.getCurveByName H.SEC_p521r1) (unP521Scalar s) (unP521Point p)) +instance EllipticCurveDH Curve_P521R1 where + ecdh s p = shared + where + H.Point x _ = unP521Point $ pointSmul s p + len = (521 + 7) `div` 8 + shared = SharedSecret $ i2ospOf_ len x From dea0469c612423506606a410fcb17b19224300c8 Mon Sep 17 00:00:00 2001 From: Kazu Yamamoto Date: Wed, 16 Nov 2016 10:02:00 +0900 Subject: [PATCH 07/36] adding Curve_P384R1. --- Crypto/ECC.hs | 25 +++++++++++++++++++++++++ 1 file changed, 25 insertions(+) diff --git a/Crypto/ECC.hs b/Crypto/ECC.hs index 4ab08f7d..d7e893c0 100644 --- a/Crypto/ECC.hs +++ b/Crypto/ECC.hs @@ -11,6 +11,7 @@ {-# LANGUAGE TypeFamilies #-} module Crypto.ECC ( Curve_P256R1(..) + , Curve_P384R1(..) , Curve_P521R1(..) , EllipticCurve(..) , EllipticCurveDH(..) @@ -110,6 +111,30 @@ instance EllipticCurveDH Curve_P256R1 where len = (256 + 7) `div` 8 shared = SharedSecret $ i2ospOf_ len x +data Curve_P384R1 = Curve_P384R1 + +instance EllipticCurve Curve_P384R1 where + newtype Point Curve_P384R1 = P384Point { unP384Point :: H.Point } + newtype Scalar Curve_P384R1 = P384Scalar { unP384Scalar :: H.PrivateNumber } + curveGetOrder _ = H.ecc_n $ H.common_curve $ H.getCurveByName H.SEC_p384r1 + curveGetBasePoint = P384Point $ H.ecc_g $ H.common_curve $ H.getCurveByName H.SEC_p384r1 + curveOfScalar _ = Curve_P384R1 + curveOfPoint _ = Curve_P384R1 + 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) + +instance EllipticCurveArith Curve_P384R1 where + pointAdd a b = P384Point $ (H.pointAdd (H.getCurveByName H.SEC_p384r1) `on` unP384Point) a b + pointSmul s p = P384Point (H.pointMul (H.getCurveByName H.SEC_p384r1) (unP384Scalar s) (unP384Point p)) + +instance EllipticCurveDH Curve_P384R1 where + ecdh s p = shared + where + H.Point x _ = unP384Point $ pointSmul s p + len = (384 + 7) `div` 8 + shared = SharedSecret $ i2ospOf_ len x + data Curve_P521R1 = Curve_P521R1 instance EllipticCurve Curve_P521R1 where From aa33c008559b1c6fb560088e6d7dcb27b1f7f937 Mon Sep 17 00:00:00 2001 From: Kazu Yamamoto Date: Wed, 16 Nov 2016 13:10:57 +0900 Subject: [PATCH 08/36] adding Curve_X25519. --- Crypto/ECC.hs | 27 +++++++++++++++++++++++++++ Crypto/PubKey/Curve25519.hs | 18 ++++++++++++++++++ 2 files changed, 45 insertions(+) diff --git a/Crypto/ECC.hs b/Crypto/ECC.hs index d7e893c0..eb8541e6 100644 --- a/Crypto/ECC.hs +++ b/Crypto/ECC.hs @@ -13,6 +13,7 @@ module Crypto.ECC ( Curve_P256R1(..) , Curve_P384R1(..) , Curve_P521R1(..) + , Curve_X25519(..) , EllipticCurve(..) , EllipticCurveDH(..) , EllipticCurveArith(..) @@ -27,7 +28,9 @@ import Crypto.Random import Crypto.Internal.Imports import Crypto.Internal.ByteArray (ByteArrayAccess, ScrubbedBytes) import Crypto.Number.Serialize (i2ospOf_) +import qualified Crypto.PubKey.Curve25519 as X25519 import Data.Function (on) +import Data.ByteArray (convert) -- | An elliptic curve key pair composed of the private part (a scalar), and -- the associated point. @@ -158,3 +161,27 @@ instance EllipticCurveDH Curve_P521R1 where H.Point x _ = unP521Point $ pointSmul s p len = (521 + 7) `div` 8 shared = SharedSecret $ i2ospOf_ len x + +data Curve_X25519 = Curve_X25519 + +instance EllipticCurve Curve_X25519 where + newtype Point Curve_X25519 = X25519Point X25519.PublicKey + newtype Scalar Curve_X25519 = X25519Scalar X25519.SecretKey + curveGetOrder _ = undefined + curveGetBasePoint = undefined + curveOfScalar _ = Curve_X25519 + curveOfPoint _ = Curve_X25519 + curveGenerateScalar = X25519Scalar <$> X25519.generateSecretKey + curveGenerateKeyPair = do + s <- X25519.generateSecretKey + let p = X25519.toPublic s + return $ KeyPair (X25519Point p) (X25519Scalar s) + +instance EllipticCurveArith Curve_X25519 where + pointAdd = undefined + pointSmul = undefined + +instance EllipticCurveDH Curve_X25519 where + ecdh (X25519Scalar s) (X25519Point p) = SharedSecret $ convert secret + where + secret = X25519.dh p s diff --git a/Crypto/PubKey/Curve25519.hs b/Crypto/PubKey/Curve25519.hs index 32163bdd..06dddfb9 100644 --- a/Crypto/PubKey/Curve25519.hs +++ b/Crypto/PubKey/Curve25519.hs @@ -9,6 +9,7 @@ -- {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MagicHash #-} +{-# LANGUAGE ScopedTypeVariables #-} module Crypto.PubKey.Curve25519 ( SecretKey , PublicKey @@ -20,10 +21,14 @@ module Crypto.PubKey.Curve25519 -- * methods , dh , toPublic + , generateSecretKey ) where +import Data.Bits +import Data.ByteString (ByteString) import Data.Word import Foreign.Ptr +import Foreign.Storable import GHC.Ptr import Crypto.Error @@ -31,6 +36,8 @@ import Crypto.Internal.Compat import Crypto.Internal.Imports import Crypto.Internal.ByteArray (ByteArrayAccess, ScrubbedBytes, Bytes, withByteArray) import qualified Crypto.Internal.ByteArray as B +import Crypto.Error (CryptoFailable(..)) +import Crypto.Random -- | A Curve25519 Secret key newtype SecretKey = SecretKey ScrubbedBytes @@ -110,3 +117,14 @@ foreign import ccall "cryptonite_curve25519_donna" -> Ptr Word8 -- ^ secret -> Ptr Word8 -- ^ basepoint -> IO () + +generateSecretKey :: MonadRandom m => m SecretKey +generateSecretKey = return $ unsafeDoIO $ do + bs :: ByteString <- getRandomBytes 32 + withByteArray bs $ \inp -> do + e0 :: Word8 <- peek inp + poke inp (e0 .&. 0xf8) + e31 :: Word8 <- peekByteOff inp 31 + pokeByteOff inp 31 ((e31 .&. 0x7f) .|. 0x40) + let CryptoPassed s = secretKey bs + return s From a6f177352a31706ab73cb27af21d9fac2afc1c03 Mon Sep 17 00:00:00 2001 From: Kazu Yamamoto Date: Wed, 16 Nov 2016 16:53:43 +0900 Subject: [PATCH 09/36] Eq and Show for Point and Scalar. --- Crypto/ECC.hs | 28 ++++++++++++++++++++-------- Crypto/PubKey/ECC/P256.hs | 2 +- 2 files changed, 21 insertions(+), 9 deletions(-) diff --git a/Crypto/ECC.hs b/Crypto/ECC.hs index eb8541e6..24c20eac 100644 --- a/Crypto/ECC.hs +++ b/Crypto/ECC.hs @@ -68,6 +68,18 @@ class EllipticCurve curve where -- | Generate a new random keypair curveGenerateKeyPair :: MonadRandom randomly => randomly (KeyPair curve) +instance {-# OVERLAPPABLE #-} Show (Point a) where + show _ = undefined + +instance {-# OVERLAPPABLE #-} Eq (Point a) where + _ == _ = undefined + +instance {-# OVERLAPPABLE #-} Show (Scalar a) where + show _ = undefined + +instance {-# OVERLAPPABLE #-} Eq (Scalar a) where + _ == _ = undefined + class EllipticCurve curve => EllipticCurveDH curve where -- | Generate a Diffie hellman secret value. -- @@ -93,8 +105,8 @@ class EllipticCurve curve => EllipticCurveArith curve where data Curve_P256R1 = Curve_P256R1 instance EllipticCurve Curve_P256R1 where - newtype Point Curve_P256R1 = P256Point { unP256Point :: P256.Point } - newtype Scalar Curve_P256R1 = P256Scalar { unP256Scalar :: P256.Scalar } + newtype Point Curve_P256R1 = P256Point { unP256Point :: P256.Point } deriving (Eq,Show) + newtype Scalar Curve_P256R1 = P256Scalar { unP256Scalar :: P256.Scalar } deriving (Eq,Show) curveGetOrder _ = 0xffffffff00000000ffffffffffffffffbce6faada7179e84f3b9cac2fc632551 curveGetBasePoint = P256Point P256.pointBase curveOfScalar _ = Curve_P256R1 @@ -117,8 +129,8 @@ instance EllipticCurveDH Curve_P256R1 where data Curve_P384R1 = Curve_P384R1 instance EllipticCurve Curve_P384R1 where - newtype Point Curve_P384R1 = P384Point { unP384Point :: H.Point } - newtype Scalar Curve_P384R1 = P384Scalar { unP384Scalar :: H.PrivateNumber } + newtype Point Curve_P384R1 = P384Point { unP384Point :: H.Point } deriving (Eq,Show) + newtype Scalar Curve_P384R1 = P384Scalar { unP384Scalar :: H.PrivateNumber } deriving (Eq,Show) curveGetOrder _ = H.ecc_n $ H.common_curve $ H.getCurveByName H.SEC_p384r1 curveGetBasePoint = P384Point $ H.ecc_g $ H.common_curve $ H.getCurveByName H.SEC_p384r1 curveOfScalar _ = Curve_P384R1 @@ -141,8 +153,8 @@ instance EllipticCurveDH Curve_P384R1 where data Curve_P521R1 = Curve_P521R1 instance EllipticCurve Curve_P521R1 where - newtype Point Curve_P521R1 = P521Point { unP521Point :: H.Point } - newtype Scalar Curve_P521R1 = P521Scalar { unP521Scalar :: H.PrivateNumber } + newtype Point Curve_P521R1 = P521Point { unP521Point :: H.Point } deriving (Eq,Show) + newtype Scalar Curve_P521R1 = P521Scalar { unP521Scalar :: H.PrivateNumber } deriving (Eq,Show) curveGetOrder _ = H.ecc_n $ H.common_curve $ H.getCurveByName H.SEC_p521r1 curveGetBasePoint = P521Point $ H.ecc_g $ H.common_curve $ H.getCurveByName H.SEC_p521r1 curveOfScalar _ = Curve_P521R1 @@ -165,8 +177,8 @@ instance EllipticCurveDH Curve_P521R1 where data Curve_X25519 = Curve_X25519 instance EllipticCurve Curve_X25519 where - newtype Point Curve_X25519 = X25519Point X25519.PublicKey - newtype Scalar Curve_X25519 = X25519Scalar X25519.SecretKey + newtype Point Curve_X25519 = X25519Point X25519.PublicKey deriving (Eq,Show) + newtype Scalar Curve_X25519 = X25519Scalar X25519.SecretKey deriving (Eq,Show) curveGetOrder _ = undefined curveGetBasePoint = undefined curveOfScalar _ = Curve_X25519 diff --git a/Crypto/PubKey/ECC/P256.hs b/Crypto/PubKey/ECC/P256.hs index f7048f7b..f8fa113b 100644 --- a/Crypto/PubKey/ECC/P256.hs +++ b/Crypto/PubKey/ECC/P256.hs @@ -56,7 +56,7 @@ import qualified Crypto.Number.Serialize as S (os2ip, i2ospOf) -- | A P256 scalar newtype Scalar = Scalar ScrubbedBytes - deriving (Eq,ByteArrayAccess) + deriving (Show,Eq,ByteArrayAccess) -- | A P256 point newtype Point = Point Bytes From c0b0846232f80e4478534a99097606172cb5be25 Mon Sep 17 00:00:00 2001 From: Kazu Yamamoto Date: Thu, 17 Nov 2016 13:08:21 +0900 Subject: [PATCH 10/36] implmenting encodePoint and decodePoint for TLS. --- Crypto/ECC.hs | 45 +++++++++++++++++++++++++++++++++---- Crypto/PubKey/Curve25519.hs | 10 +++++++++ 2 files changed, 51 insertions(+), 4 deletions(-) diff --git a/Crypto/ECC.hs b/Crypto/ECC.hs index 24c20eac..52890dff 100644 --- a/Crypto/ECC.hs +++ b/Crypto/ECC.hs @@ -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 diff --git a/Crypto/PubKey/Curve25519.hs b/Crypto/PubKey/Curve25519.hs index 06dddfb9..d1115c97 100644 --- a/Crypto/PubKey/Curve25519.hs +++ b/Crypto/PubKey/Curve25519.hs @@ -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 From 2b9dce2c8a968bc90069195a9de7e8cee8838d59 Mon Sep 17 00:00:00 2001 From: Kazu Yamamoto Date: Mon, 28 Nov 2016 19:23:20 +0900 Subject: [PATCH 11/36] Dropping Show from PRK. --- Crypto/KDF/HKDF.hs | 4 ---- 1 file changed, 4 deletions(-) diff --git a/Crypto/KDF/HKDF.hs b/Crypto/KDF/HKDF.hs index 86c4d91a..5c10dbfa 100644 --- a/Crypto/KDF/HKDF.hs +++ b/Crypto/KDF/HKDF.hs @@ -30,10 +30,6 @@ import qualified Data.ByteString as BS data PRK a = PRK (HMAC a) | PRK_NoExpand ScrubbedBytes deriving (Eq) -instance Show (PRK a) where - show (PRK hm) = show (hmacGetDigest hm) - show (PRK_NoExpand sb) = show sb - toByteString :: PRK a -> BS.ByteString toByteString (PRK hm) = B.convert hm toByteString (PRK_NoExpand sb) = B.convert sb From 39ecb3597abf5692e7284c35f6a3a94e10014069 Mon Sep 17 00:00:00 2001 From: Kazu Yamamoto Date: Wed, 30 Nov 2016 14:06:21 +0900 Subject: [PATCH 12/36] removing a trailing space / a warning. --- Crypto/KDF/HKDF.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Crypto/KDF/HKDF.hs b/Crypto/KDF/HKDF.hs index 5c10dbfa..bd3b5635 100644 --- a/Crypto/KDF/HKDF.hs +++ b/Crypto/KDF/HKDF.hs @@ -20,9 +20,9 @@ module Crypto.KDF.HKDF ) where import Data.Word -import Crypto.Hash +import Crypto.Hash import Crypto.MAC.HMAC -import Crypto.Internal.ByteArray (ScrubbedBytes, Bytes, ByteArray, ByteArrayAccess) +import Crypto.Internal.ByteArray (ScrubbedBytes, ByteArray, ByteArrayAccess) import qualified Crypto.Internal.ByteArray as B import qualified Data.ByteString as BS From 3a2eb3c63108bfb7b34c5a44c0e204ff59e3c802 Mon Sep 17 00:00:00 2001 From: Kazu Yamamoto Date: Wed, 30 Nov 2016 14:19:39 +0900 Subject: [PATCH 13/36] using ByteArray(Access) instead of ByteString. --- Crypto/KDF/HKDF.hs | 15 +++++++-------- 1 file changed, 7 insertions(+), 8 deletions(-) diff --git a/Crypto/KDF/HKDF.hs b/Crypto/KDF/HKDF.hs index bd3b5635..3d15a2bf 100644 --- a/Crypto/KDF/HKDF.hs +++ b/Crypto/KDF/HKDF.hs @@ -15,8 +15,8 @@ module Crypto.KDF.HKDF , extract , extractSkip , expand - , toByteString - , fromByteString + , fromPRK + , toPRK ) where import Data.Word @@ -24,18 +24,17 @@ import Crypto.Hash import Crypto.MAC.HMAC import Crypto.Internal.ByteArray (ScrubbedBytes, ByteArray, ByteArrayAccess) import qualified Crypto.Internal.ByteArray as B -import qualified Data.ByteString as BS -- | Pseudo Random Key data PRK a = PRK (HMAC a) | PRK_NoExpand ScrubbedBytes deriving (Eq) -toByteString :: PRK a -> BS.ByteString -toByteString (PRK hm) = B.convert hm -toByteString (PRK_NoExpand sb) = B.convert sb +fromPRK :: ByteArray b => PRK a -> b +fromPRK (PRK hm) = B.convert hm +fromPRK (PRK_NoExpand sb) = B.convert sb -fromByteString :: BS.ByteString -> PRK a -fromByteString = extractSkip +toPRK :: ByteArrayAccess b => b -> PRK a +toPRK = extractSkip -- | Extract a Pseudo Random Key using the parameter and the underlaying hash mechanism extract :: (HashAlgorithm a, ByteArrayAccess salt, ByteArrayAccess ikm) From be6bf111384b642ae409f8e2a866092473ec9936 Mon Sep 17 00:00:00 2001 From: Kazu Yamamoto Date: Wed, 30 Nov 2016 14:41:01 +0900 Subject: [PATCH 14/36] using ScrubbedBytes directly. --- Crypto/PubKey/Curve25519.hs | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/Crypto/PubKey/Curve25519.hs b/Crypto/PubKey/Curve25519.hs index d1115c97..08b4a1c3 100644 --- a/Crypto/PubKey/Curve25519.hs +++ b/Crypto/PubKey/Curve25519.hs @@ -122,14 +122,13 @@ foreign import ccall "cryptonite_curve25519_donna" generateSecretKey :: MonadRandom m => m SecretKey generateSecretKey = return $ unsafeDoIO $ do - bs :: ByteString <- getRandomBytes 32 - withByteArray bs $ \inp -> do + sb <- getRandomBytes 32 + withByteArray sb $ \inp -> do e0 :: Word8 <- peek inp poke inp (e0 .&. 0xf8) e31 :: Word8 <- peekByteOff inp 31 pokeByteOff inp 31 ((e31 .&. 0x7f) .|. 0x40) - let CryptoPassed s = secretKey bs - return s + return $ SecretKey sb toPublicKey :: ByteString -> PublicKey toPublicKey bs = pub From f84aa5d7ce7678c6d0785d5951834d5f9413e5f8 Mon Sep 17 00:00:00 2001 From: Kazu Yamamoto Date: Wed, 30 Nov 2016 14:48:49 +0900 Subject: [PATCH 15/36] documentation & relaxing types. --- Crypto/PubKey/Curve25519.hs | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/Crypto/PubKey/Curve25519.hs b/Crypto/PubKey/Curve25519.hs index 08b4a1c3..9fef8281 100644 --- a/Crypto/PubKey/Curve25519.hs +++ b/Crypto/PubKey/Curve25519.hs @@ -27,7 +27,6 @@ module Crypto.PubKey.Curve25519 ) where import Data.Bits -import Data.ByteString (ByteString) import Data.Word import Foreign.Ptr import Foreign.Storable @@ -36,7 +35,7 @@ import GHC.Ptr import Crypto.Error import Crypto.Internal.Compat import Crypto.Internal.Imports -import Crypto.Internal.ByteArray (ByteArrayAccess, ScrubbedBytes, Bytes, withByteArray) +import Crypto.Internal.ByteArray (ByteArrayAccess, ByteArray, ScrubbedBytes, Bytes, withByteArray) import qualified Crypto.Internal.ByteArray as B import Crypto.Error (CryptoFailable(..)) import Crypto.Random @@ -120,6 +119,7 @@ foreign import ccall "cryptonite_curve25519_donna" -> Ptr Word8 -- ^ basepoint -> IO () +-- | Generate a secret key. generateSecretKey :: MonadRandom m => m SecretKey generateSecretKey = return $ unsafeDoIO $ do sb <- getRandomBytes 32 @@ -130,10 +130,12 @@ generateSecretKey = return $ unsafeDoIO $ do pokeByteOff inp 31 ((e31 .&. 0x7f) .|. 0x40) return $ SecretKey sb -toPublicKey :: ByteString -> PublicKey +-- | Create a public key. +toPublicKey :: ByteArrayAccess bs => bs -> PublicKey toPublicKey bs = pub where CryptoPassed pub = publicKey bs -fromPublicKey :: PublicKey -> ByteString +-- | Convert a public key. +fromPublicKey :: ByteArray bs => PublicKey -> bs fromPublicKey (PublicKey b) = B.convert b From 58151b9965199f39d3090e3d25219edc91354bb9 Mon Sep 17 00:00:00 2001 From: Kazu Yamamoto Date: Wed, 30 Nov 2016 15:10:48 +0900 Subject: [PATCH 16/36] making PRK an instance of ByteArrayAccess and removing fromPRK/toPRK. --- Crypto/KDF/HKDF.hs | 13 +++++-------- 1 file changed, 5 insertions(+), 8 deletions(-) diff --git a/Crypto/KDF/HKDF.hs b/Crypto/KDF/HKDF.hs index 3d15a2bf..e9d0b4cd 100644 --- a/Crypto/KDF/HKDF.hs +++ b/Crypto/KDF/HKDF.hs @@ -15,8 +15,6 @@ module Crypto.KDF.HKDF , extract , extractSkip , expand - , fromPRK - , toPRK ) where import Data.Word @@ -29,12 +27,11 @@ import qualified Crypto.Internal.ByteArray as B data PRK a = PRK (HMAC a) | PRK_NoExpand ScrubbedBytes deriving (Eq) -fromPRK :: ByteArray b => PRK a -> b -fromPRK (PRK hm) = B.convert hm -fromPRK (PRK_NoExpand sb) = B.convert sb - -toPRK :: ByteArrayAccess b => b -> PRK a -toPRK = extractSkip +instance ByteArrayAccess (PRK a) where + length (PRK hm) = B.length hm + length (PRK_NoExpand sb) = B.length sb + withByteArray (PRK hm) = B.withByteArray hm + withByteArray (PRK_NoExpand sb) = B.withByteArray sb -- | Extract a Pseudo Random Key using the parameter and the underlaying hash mechanism extract :: (HashAlgorithm a, ByteArrayAccess salt, ByteArrayAccess ikm) From e9ea55ab57a8512cb025e47b14bd51280de315b4 Mon Sep 17 00:00:00 2001 From: Kazu Yamamoto Date: Wed, 30 Nov 2016 15:34:35 +0900 Subject: [PATCH 17/36] relaxing types of encodePoint and decodePoint. --- Crypto/ECC.hs | 32 ++++++++++++++++++-------------- 1 file changed, 18 insertions(+), 14 deletions(-) diff --git a/Crypto/ECC.hs b/Crypto/ECC.hs index 52890dff..990105d7 100644 --- a/Crypto/ECC.hs +++ b/Crypto/ECC.hs @@ -9,6 +9,7 @@ -- {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE ScopedTypeVariables #-} module Crypto.ECC ( Curve_P256R1(..) , Curve_P384R1(..) @@ -26,13 +27,12 @@ import qualified Crypto.PubKey.ECC.Types as H import qualified Crypto.PubKey.ECC.Prim as H import Crypto.Random 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 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. @@ -70,8 +70,8 @@ class EllipticCurve curve where -- | Generate a new random keypair curveGenerateKeyPair :: MonadRandom randomly => randomly (KeyPair curve) - encodePoint :: Point curve -> ByteString - decodePoint :: ByteString -> Point curve + encodePoint :: ByteArray bs => Point curve -> bs + decodePoint :: ByteArray bs => bs -> Point curve instance {-# OVERLAPPABLE #-} Show (Point a) where show _ = undefined @@ -219,18 +219,22 @@ instance EllipticCurveDH Curve_X25519 where where 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] where + uncompressed, xb, yb :: bs 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 +decodeECPoint :: ByteArray bs => bs -> (Integer,Integer) +decodeECPoint mxy = case B.uncons mxy of + Nothing -> error "decodeECPoint" + Just (m,xy) + -- uncompressed + | m == 4 -> let siz = B.length xy `div` 2 + (xb,yb) = B.splitAt siz xy + x = os2ip xb + y = os2ip yb + in (x,y) + | otherwise -> error $ "decodeECPoint: unknown " ++ show m From a5fb2ee23a47a6b967b90bf1add70ff3dc1ec30a Mon Sep 17 00:00:00 2001 From: Vincent Hanquez Date: Thu, 1 Dec 2016 12:50:01 +0000 Subject: [PATCH 18/36] don't export function that replace existing functionality and by-pass errors handling --- Crypto/PubKey/Curve25519.hs | 12 ------------ 1 file changed, 12 deletions(-) diff --git a/Crypto/PubKey/Curve25519.hs b/Crypto/PubKey/Curve25519.hs index 9fef8281..59cf36bd 100644 --- a/Crypto/PubKey/Curve25519.hs +++ b/Crypto/PubKey/Curve25519.hs @@ -18,8 +18,6 @@ module Crypto.PubKey.Curve25519 , dhSecret , publicKey , secretKey - , toPublicKey - , fromPublicKey -- * methods , dh , toPublic @@ -129,13 +127,3 @@ generateSecretKey = return $ unsafeDoIO $ do e31 :: Word8 <- peekByteOff inp 31 pokeByteOff inp 31 ((e31 .&. 0x7f) .|. 0x40) return $ SecretKey sb - --- | Create a public key. -toPublicKey :: ByteArrayAccess bs => bs -> PublicKey -toPublicKey bs = pub - where - CryptoPassed pub = publicKey bs - --- | Convert a public key. -fromPublicKey :: ByteArray bs => PublicKey -> bs -fromPublicKey (PublicKey b) = B.convert b From d80a87da48b00c4e41da71a1b46309825906a0c5 Mon Sep 17 00:00:00 2001 From: Vincent Hanquez Date: Thu, 1 Dec 2016 12:50:10 +0000 Subject: [PATCH 19/36] add new EC errors --- Crypto/Error/Types.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/Crypto/Error/Types.hs b/Crypto/Error/Types.hs index dff0c8b7..edaf6548 100644 --- a/Crypto/Error/Types.hs +++ b/Crypto/Error/Types.hs @@ -34,6 +34,10 @@ data CryptoError = | CryptoError_SecretKeyStructureInvalid | CryptoError_PublicKeySizeInvalid | CryptoError_SharedSecretSizeInvalid + -- elliptic cryptography error + | CryptoError_PointSizeInvalid + | CryptoError_PointFormatInvalid + | CryptoError_PointFormatUnsupported -- Message authentification error | CryptoError_MacKeyInvalid | CryptoError_AuthenticationTagSizeInvalid From a9e39173343857498c4fcd3cbb5ce4b9245d283c Mon Sep 17 00:00:00 2001 From: Vincent Hanquez Date: Thu, 1 Dec 2016 12:50:31 +0000 Subject: [PATCH 20/36] fix Curve25519 generate secret key to work in the MonadRandom instead of IO --- Crypto/PubKey/Curve25519.hs | 23 ++++++++++++----------- 1 file changed, 12 insertions(+), 11 deletions(-) diff --git a/Crypto/PubKey/Curve25519.hs b/Crypto/PubKey/Curve25519.hs index 59cf36bd..d8463eb8 100644 --- a/Crypto/PubKey/Curve25519.hs +++ b/Crypto/PubKey/Curve25519.hs @@ -111,19 +111,20 @@ toPublic (SecretKey sec) = PublicKey <$> basePoint = Ptr "\x09\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"# {-# NOINLINE toPublic #-} +-- | Generate a secret key. +generateSecretKey :: MonadRandom m => m SecretKey +generateSecretKey = tweakToSecretKey <$> getRandomBytes 32 + where + tweakToSecretKey :: ScrubbedBytes -> SecretKey + tweakToSecretKey bin = SecretKey $ B.copyAndFreeze bin $ \inp -> do + modifyByte inp 0 (\e0 -> e0 .&. 0xf8) + modifyByte inp 31 (\e31 -> (e31 .&. 0x7f) .|. 0x40) + + modifyByte :: Ptr Word8 -> Int -> (Word8 -> Word8) -> IO () + modifyByte p n f = peekByteOff p n >>= pokeByteOff p n . f + foreign import ccall "cryptonite_curve25519_donna" ccryptonite_curve25519 :: Ptr Word8 -- ^ public -> Ptr Word8 -- ^ secret -> Ptr Word8 -- ^ basepoint -> IO () - --- | Generate a secret key. -generateSecretKey :: MonadRandom m => m SecretKey -generateSecretKey = return $ unsafeDoIO $ do - sb <- getRandomBytes 32 - withByteArray sb $ \inp -> do - e0 :: Word8 <- peek inp - poke inp (e0 .&. 0xf8) - e31 :: Word8 <- peekByteOff inp 31 - pokeByteOff inp 31 ((e31 .&. 0x7f) .|. 0x40) - return $ SecretKey sb From 55f385a136d2d4e55d385a0b826314865e47f43c Mon Sep 17 00:00:00 2001 From: Vincent Hanquez Date: Thu, 1 Dec 2016 12:51:26 +0000 Subject: [PATCH 21/36] change point decoding to be able to fail explicitely instead of async error call. --- Crypto/ECC.hs | 40 ++++++++++++++++++++-------------------- 1 file changed, 20 insertions(+), 20 deletions(-) diff --git a/Crypto/ECC.hs b/Crypto/ECC.hs index 990105d7..45f48a46 100644 --- a/Crypto/ECC.hs +++ b/Crypto/ECC.hs @@ -26,6 +26,7 @@ import qualified Crypto.PubKey.ECC.P256 as P256 import qualified Crypto.PubKey.ECC.Types as H import qualified Crypto.PubKey.ECC.Prim as H import Crypto.Random +import Crypto.Error import Crypto.Internal.Imports import Crypto.Internal.ByteArray (ByteArray, ByteArrayAccess, ScrubbedBytes) import qualified Crypto.Internal.ByteArray as B @@ -71,7 +72,7 @@ class EllipticCurve curve where curveGenerateKeyPair :: MonadRandom randomly => randomly (KeyPair curve) encodePoint :: ByteArray bs => Point curve -> bs - decodePoint :: ByteArray bs => bs -> Point curve + decodePoint :: ByteArray bs => bs -> CryptoFailable (Point curve) instance {-# OVERLAPPABLE #-} Show (Point a) where show _ = undefined @@ -122,7 +123,9 @@ instance EllipticCurve Curve_P256R1 where encodePoint (P256Point p) = encodeECPoint x y 32 where (x,y) = P256.pointToIntegers p - decodePoint bs = P256Point $ P256.pointFromIntegers $ decodeECPoint bs + decodePoint bs = fromPoint <$> decodeECPoint bs + where fromPoint (H.Point x y) = P256Point $ P256.pointFromIntegers (x,y) + fromPoint H.PointO = error "impossible happened: fromPoint is infinite" instance EllipticCurveArith Curve_P256R1 where pointAdd a b = P256Point $ (P256.pointAdd `on` unP256Point) a b @@ -149,9 +152,7 @@ instance EllipticCurve Curve_P384R1 where 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 + decodePoint bs = P384Point <$> decodeECPoint bs instance EllipticCurveArith Curve_P384R1 where pointAdd a b = P384Point $ (H.pointAdd (H.getCurveByName H.SEC_p384r1) `on` unP384Point) a b @@ -178,9 +179,7 @@ instance EllipticCurve Curve_P521R1 where 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 + decodePoint bs = P521Point <$> decodeECPoint bs instance EllipticCurveArith Curve_P521R1 where pointAdd a b = P521Point $ (H.pointAdd (H.getCurveByName H.SEC_p521r1) `on` unP521Point) a b @@ -207,8 +206,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 + encodePoint (X25519Point p) = B.convert p + decodePoint bs = X25519Point <$> X25519.publicKey bs instance EllipticCurveArith Curve_X25519 where pointAdd = undefined @@ -227,14 +226,15 @@ encodeECPoint x y siz = B.concat [uncompressed,xb,yb] xb = i2ospOf_ siz x yb = i2ospOf_ siz y -decodeECPoint :: ByteArray bs => bs -> (Integer,Integer) +decodeECPoint :: ByteArray bs => bs -> CryptoFailable H.Point decodeECPoint mxy = case B.uncons mxy of - Nothing -> error "decodeECPoint" - Just (m,xy) - -- uncompressed - | m == 4 -> let siz = B.length xy `div` 2 - (xb,yb) = B.splitAt siz xy - x = os2ip xb - y = os2ip yb - in (x,y) - | otherwise -> error $ "decodeECPoint: unknown " ++ show m + Nothing -> CryptoFailed $ CryptoError_PointSizeInvalid + Just (m,xy) + -- uncompressed + | m == 4 -> + let siz = B.length xy `div` 2 + (xb,yb) = B.splitAt siz xy + x = os2ip xb + y = os2ip yb + in CryptoPassed $ H.Point x y + | otherwise -> CryptoFailed $ CryptoError_PointFormatInvalid From f37d0b79ec6d536dcc9db630eb0083b0dc314f6f Mon Sep 17 00:00:00 2001 From: Vincent Hanquez Date: Thu, 1 Dec 2016 12:53:56 +0000 Subject: [PATCH 22/36] remove arithmetic on Curve25519. it's mathematically not possible --- Crypto/ECC.hs | 4 ---- 1 file changed, 4 deletions(-) diff --git a/Crypto/ECC.hs b/Crypto/ECC.hs index 45f48a46..cd3753a7 100644 --- a/Crypto/ECC.hs +++ b/Crypto/ECC.hs @@ -209,10 +209,6 @@ instance EllipticCurve Curve_X25519 where encodePoint (X25519Point p) = B.convert p decodePoint bs = X25519Point <$> X25519.publicKey bs -instance EllipticCurveArith Curve_X25519 where - pointAdd = undefined - pointSmul = undefined - instance EllipticCurveDH Curve_X25519 where ecdh (X25519Scalar s) (X25519Point p) = SharedSecret $ convert secret where From f1ebbff464ac26a4d17da7ac81b474c004445821 Mon Sep 17 00:00:00 2001 From: Vincent Hanquez Date: Thu, 1 Dec 2016 16:55:17 +0000 Subject: [PATCH 23/36] fixup haddock markup --- Crypto/PubKey/ECC/Types.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Crypto/PubKey/ECC/Types.hs b/Crypto/PubKey/ECC/Types.hs index 57ea9a91..8f6a0704 100644 --- a/Crypto/PubKey/ECC/Types.hs +++ b/Crypto/PubKey/ECC/Types.hs @@ -1,6 +1,6 @@ {-# LANGUAGE DeriveDataTypeable #-} -- | --- Module : Crypto.PubKey.ECC.types +-- Module : Crypto.PubKey.ECC.Types -- License : BSD-style -- Maintainer : Vincent Hanquez -- Stability : Experimental From 07b6e80b6db3f93305a34f17be557f28209c1291 Mon Sep 17 00:00:00 2001 From: Vincent Hanquez Date: Thu, 1 Dec 2016 16:56:28 +0000 Subject: [PATCH 24/36] Rewrite EC primitive and types to have the curve as type --- Crypto/ECC/Simple/Prim.hs | 197 ++++++++++++ Crypto/ECC/Simple/Types.hs | 610 +++++++++++++++++++++++++++++++++++++ Crypto/Error/Types.hs | 1 + cryptonite.cabal | 2 + 4 files changed, 810 insertions(+) create mode 100644 Crypto/ECC/Simple/Prim.hs create mode 100644 Crypto/ECC/Simple/Types.hs diff --git a/Crypto/ECC/Simple/Prim.hs b/Crypto/ECC/Simple/Prim.hs new file mode 100644 index 00000000..39a6cdaf --- /dev/null +++ b/Crypto/ECC/Simple/Prim.hs @@ -0,0 +1,197 @@ +-- | Elliptic Curve Arithmetic. +-- +-- /WARNING:/ These functions are vulnerable to timing attacks. +{-# LANGUAGE ScopedTypeVariables #-} +module Crypto.ECC.Simple.Prim + ( scalarGenerate + , scalarFromInteger + , pointAdd + , pointDouble + , pointBaseMul + , pointMul + , pointAddTwoMuls + , isPointAtInfinity + , isPointValid + ) where + +import Data.Maybe +import Data.Proxy +import Crypto.Number.ModArithmetic +import Crypto.Number.F2m +import Crypto.Number.Generate (generateBetween) +import Crypto.ECC.Simple.Types +import Crypto.Error +import Crypto.Random + +-- | Generate a valid scalar for a specific Curve +scalarGenerate :: forall randomly curve . (MonadRandom randomly, Curve curve) => randomly (Scalar curve) +scalarGenerate = + Scalar <$> generateBetween 1 (n - 1) + where + n = curveEccN $ curveParameters (Proxy :: Proxy curve) + +scalarFromInteger :: forall curve . Curve curve => Integer -> CryptoFailable (Scalar curve) +scalarFromInteger n + | n < 0 || n >= mx = CryptoFailed $ CryptoError_EcScalarOutOfBounds + | otherwise = CryptoPassed $ Scalar n + where + mx = case curveType (Proxy :: Proxy curve) of + CurveBinary (CurveBinaryParam b) -> b + CurvePrime (CurvePrimeParam p) -> p + +--TODO: Extract helper function for `fromMaybe PointO...` + +-- | Elliptic Curve point negation: +-- @pointNegate c p@ returns point @q@ such that @pointAdd c p q == PointO@. +pointNegate :: Curve curve => Point curve -> Point curve +pointNegate PointO = PointO +pointNegate point@(Point x y) = + case curveType point of + CurvePrime {} -> Point x (-y) + CurveBinary {} -> Point x (x `addF2m` y) + +-- | Elliptic Curve point addition. +-- +-- /WARNING:/ Vulnerable to timing attacks. +pointAdd :: Curve curve => Point curve -> Point curve -> Point curve +pointAdd PointO PointO = PointO +pointAdd PointO q = q +pointAdd p PointO = p +pointAdd p q + | p == q = pointDouble p + | p == pointNegate q = PointO +pointAdd point@(Point xp yp) (Point xq yq) = + case ty of + CurvePrime (CurvePrimeParam pr) -> fromMaybe PointO $ do + s <- divmod (yp - yq) (xp - xq) pr + let xr = (s ^ (2::Int) - xp - xq) `mod` pr + yr = (s * (xp - xr) - yp) `mod` pr + return $ Point xr yr + CurveBinary (CurveBinaryParam fx) -> fromMaybe PointO $ do + s <- divF2m fx (yp `addF2m` yq) (xp `addF2m` xq) + let xr = mulF2m fx s s `addF2m` s `addF2m` xp `addF2m` xq `addF2m` a + yr = mulF2m fx s (xp `addF2m` xr) `addF2m` xr `addF2m` yp + return $ Point xr yr + where + ty = curveType point + cc = curveParameters point + a = curveEccA cc + +-- | Elliptic Curve point doubling. +-- +-- /WARNING:/ Vulnerable to timing attacks. +-- +-- This perform the following calculation: +-- > lambda = (3 * xp ^ 2 + a) / 2 yp +-- > xr = lambda ^ 2 - 2 xp +-- > yr = lambda (xp - xr) - yp +-- +-- With binary curve: +-- > xp == 0 => P = O +-- > otherwise => +-- > s = xp + (yp / xp) +-- > xr = s ^ 2 + s + a +-- > yr = xp ^ 2 + (s+1) * xr +-- +pointDouble :: Curve curve => Point curve -> Point curve +pointDouble PointO = PointO +pointDouble point@(Point xp yp) = + case ty of + CurvePrime (CurvePrimeParam pr) -> fromMaybe PointO $ do + lambda <- divmod (3 * xp ^ (2::Int) + a) (2 * yp) pr + let xr = (lambda ^ (2::Int) - 2 * xp) `mod` pr + yr = (lambda * (xp - xr) - yp) `mod` pr + return $ Point xr yr + CurveBinary (CurveBinaryParam fx) + | xp == 0 -> PointO + | otherwise -> fromMaybe PointO $ do + s <- return . addF2m xp =<< divF2m fx yp xp + let xr = mulF2m fx s s `addF2m` s `addF2m` a + yr = mulF2m fx xp xp `addF2m` mulF2m fx xr (s `addF2m` 1) + return $ Point xr yr + where + ty = curveType point + cc = curveParameters point + a = curveEccA cc + +-- | Elliptic curve point multiplication using the base +-- +-- /WARNING:/ Vulnerable to timing attacks. +pointBaseMul :: Curve curve => Scalar curve -> Point curve +pointBaseMul n = pointMul n (curveEccG $ curveParameters (Proxy :: Proxy curve)) + +-- | Elliptic curve point multiplication (double and add algorithm). +-- +-- /WARNING:/ Vulnerable to timing attacks. +pointMul :: Curve curve => Scalar curve -> Point curve -> Point curve +pointMul _ PointO = PointO +pointMul (Scalar n) p + | n == 0 = PointO + | n == 1 = p + | odd n = pointAdd p (pointMul (Scalar (n - 1)) p) + | otherwise = pointMul (Scalar (n `div` 2)) (pointDouble p) + +-- | Elliptic curve double-scalar multiplication (uses Shamir's trick). +-- +-- > pointAddTwoMuls c n1 p1 n2 p2 == pointAdd c (pointMul c n1 p1) +-- > (pointMul c n2 p2) +-- +-- /WARNING:/ Vulnerable to timing attacks. +pointAddTwoMuls :: Curve curve => Scalar curve -> Point curve -> Scalar curve -> Point curve -> Point curve +pointAddTwoMuls _ PointO _ PointO = PointO +pointAddTwoMuls _ PointO n2 p2 = pointMul n2 p2 +pointAddTwoMuls n1 p1 _ PointO = pointMul n1 p1 +pointAddTwoMuls (Scalar n1) p1 (Scalar n2) p2 = go (n1, n2) + where + p0 = pointAdd p1 p2 + + go (0, 0 ) = PointO + go (k1, k2) = + let q = pointDouble $ go (k1 `div` 2, k2 `div` 2) + in case (odd k1, odd k2) of + (True , True ) -> pointAdd p0 q + (True , False ) -> pointAdd p1 q + (False , True ) -> pointAdd p2 q + (False , False ) -> q + +-- | Check if a point is the point at infinity. +isPointAtInfinity :: Point curve -> Bool +isPointAtInfinity PointO = True +isPointAtInfinity _ = False + +-- | check if a point is on specific curve +-- +-- This perform three checks: +-- +-- * x is not out of range +-- * y is not out of range +-- * the equation @y^2 = x^3 + a*x + b (mod p)@ holds +isPointValid :: Curve curve => Point curve -> Bool +isPointValid PointO = True +isPointValid point@(Point x y) = + case ty of + CurvePrime (CurvePrimeParam p) -> + let a = curveEccA cc + b = curveEccB cc + eqModP z1 z2 = (z1 `mod` p) == (z2 `mod` p) + isValid e = e >= 0 && e < p + in isValid x && isValid y && (y ^ (2 :: Int)) `eqModP` (x ^ (3 :: Int) + a * x + b) + CurveBinary (CurveBinaryParam fx) -> + let a = curveEccA cc + b = curveEccB cc + add = addF2m + mul = mulF2m fx + isValid e = modF2m fx e == e + in and [ isValid x + , isValid y + , ((((x `add` a) `mul` x `add` y) `mul` x) `add` b `add` (squareF2m fx y)) == 0 + ] + where + ty = curveType point + cc = curveParameters point + +-- | div and mod +divmod :: Integer -> Integer -> Integer -> Maybe Integer +divmod y x m = do + i <- inverse (x `mod` m) m + return $ y * i `mod` m diff --git a/Crypto/ECC/Simple/Types.hs b/Crypto/ECC/Simple/Types.hs new file mode 100644 index 00000000..d45309a5 --- /dev/null +++ b/Crypto/ECC/Simple/Types.hs @@ -0,0 +1,610 @@ +{-# LANGUAGE DeriveDataTypeable #-} +-- | +-- Module : Crypto.ECC.Simple.Types +-- License : BSD-style +-- Maintainer : Vincent Hanquez +-- Stability : Experimental +-- Portability : Excellent +-- +-- references: +-- +-- +{-# OPTIONS_GHC -fno-warn-missing-signatures #-} +module Crypto.ECC.Simple.Types + ( Curve(..) + , Point(..) + , Scalar(..) + , CurveType(..) + , CurveBinaryParam(..) + , CurvePrimeParam(..) + , curveSizeBits + , CurveParameters(..) + -- * specific curves definition + , SEC_p112r1(..) + , SEC_p112r2(..) + , SEC_p128r1(..) + , SEC_p128r2(..) + , SEC_p160k1(..) + , SEC_p160r1(..) + , SEC_p160r2(..) + , SEC_p192k1(..) + , SEC_p192r1(..) -- aka prime192v1 + , SEC_p224k1(..) + , SEC_p224r1(..) + , SEC_p256k1(..) + , SEC_p256r1(..) -- aka prime256v1 + , SEC_p384r1(..) + , SEC_p521r1(..) + , SEC_t113r1(..) + , SEC_t113r2(..) + , SEC_t131r1(..) + , SEC_t131r2(..) + , SEC_t163k1(..) + , SEC_t163r1(..) + , SEC_t163r2(..) + , SEC_t193r1(..) + , SEC_t193r2(..) + , SEC_t233k1(..) -- aka NIST K-233 + , SEC_t233r1(..) + , SEC_t239k1(..) + , SEC_t283k1(..) + , SEC_t283r1(..) + , SEC_t409k1(..) + , SEC_t409r1(..) + , SEC_t571k1(..) + , SEC_t571r1(..) + ) where + +import Data.Data +import Crypto.Internal.Imports +import Crypto.Number.Basic (numBits) + +class Curve curve where + curveParameters :: proxy curve -> CurveParameters curve + curveType :: proxy curve -> CurveType + +-- | get the size of the curve in bits +curveSizeBits :: Curve curve => proxy curve -> Int +curveSizeBits proxy = + case curveType proxy of + CurvePrime (CurvePrimeParam p) -> numBits p + CurveBinary (CurveBinaryParam c) -> numBits c - 1 + +-- | Define common parameters in a curve definition +-- of the form: y^2 = x^3 + ax + b. +data CurveParameters curve = CurveParameters + { curveEccA :: Integer -- ^ curve parameter a + , curveEccB :: Integer -- ^ curve parameter b + , curveEccG :: Point curve -- ^ base point + , curveEccN :: Integer -- ^ order of G + , curveEccH :: Integer -- ^ cofactor + } deriving (Show,Eq,Data,Typeable) + +newtype CurveBinaryParam = CurveBinaryParam Integer + deriving (Show,Read,Eq,Data,Typeable) + +newtype CurvePrimeParam = CurvePrimeParam Integer + deriving (Show,Read,Eq,Data,Typeable) + +data CurveType = + CurveBinary CurveBinaryParam + | CurvePrime CurvePrimeParam + deriving (Show,Read,Eq,Data,Typeable) + +-- | ECC Private Number +newtype Scalar curve = Scalar Integer + deriving (Show,Read,Eq,Data,Typeable) + +-- | Define a point on a curve. +data Point curve = + Point Integer Integer + | PointO -- ^ Point at Infinity + deriving (Show,Read,Eq,Data,Typeable) + +instance NFData (Point curve) where + rnf (Point x y) = x `seq` y `seq` () + rnf PointO = () + +data SEC_p112r1 = SEC_p112r1 deriving (Show,Read,Eq) +data SEC_p112r2 = SEC_p112r2 deriving (Show,Read,Eq) +data SEC_p128r1 = SEC_p128r1 deriving (Show,Read,Eq) +data SEC_p128r2 = SEC_p128r2 deriving (Show,Read,Eq) +data SEC_p160k1 = SEC_p160k1 deriving (Show,Read,Eq) +data SEC_p160r1 = SEC_p160r1 deriving (Show,Read,Eq) +data SEC_p160r2 = SEC_p160r2 deriving (Show,Read,Eq) +data SEC_p192k1 = SEC_p192k1 deriving (Show,Read,Eq) +data SEC_p192r1 = SEC_p192r1 deriving (Show,Read,Eq) +data SEC_p224k1 = SEC_p224k1 deriving (Show,Read,Eq) +data SEC_p224r1 = SEC_p224r1 deriving (Show,Read,Eq) +data SEC_p256k1 = SEC_p256k1 deriving (Show,Read,Eq) +data SEC_p256r1 = SEC_p256r1 deriving (Show,Read,Eq) +data SEC_p384r1 = SEC_p384r1 deriving (Show,Read,Eq) +data SEC_p521r1 = SEC_p521r1 deriving (Show,Read,Eq) +data SEC_t113r1 = SEC_t113r1 deriving (Show,Read,Eq) +data SEC_t113r2 = SEC_t113r2 deriving (Show,Read,Eq) +data SEC_t131r1 = SEC_t131r1 deriving (Show,Read,Eq) +data SEC_t131r2 = SEC_t131r2 deriving (Show,Read,Eq) +data SEC_t163k1 = SEC_t163k1 deriving (Show,Read,Eq) +data SEC_t163r1 = SEC_t163r1 deriving (Show,Read,Eq) +data SEC_t163r2 = SEC_t163r2 deriving (Show,Read,Eq) +data SEC_t193r1 = SEC_t193r1 deriving (Show,Read,Eq) +data SEC_t193r2 = SEC_t193r2 deriving (Show,Read,Eq) +data SEC_t233k1 = SEC_t233k1 deriving (Show,Read,Eq) +data SEC_t233r1 = SEC_t233r1 deriving (Show,Read,Eq) +data SEC_t239k1 = SEC_t239k1 deriving (Show,Read,Eq) +data SEC_t283k1 = SEC_t283k1 deriving (Show,Read,Eq) +data SEC_t283r1 = SEC_t283r1 deriving (Show,Read,Eq) +data SEC_t409k1 = SEC_t409k1 deriving (Show,Read,Eq) +data SEC_t409r1 = SEC_t409r1 deriving (Show,Read,Eq) +data SEC_t571k1 = SEC_t571k1 deriving (Show,Read,Eq) +data SEC_t571r1 = SEC_t571r1 deriving (Show,Read,Eq) + +-- | Define names for known recommended curves. +instance Curve SEC_p112r1 where + curveType _ = typeSEC_p112r1 + curveParameters _ = paramSEC_p112r1 + +instance Curve SEC_p112r2 where + curveType _ = typeSEC_p112r2 + curveParameters _ = paramSEC_p112r2 + +instance Curve SEC_p128r1 where + curveType _ = typeSEC_p128r1 + curveParameters _ = paramSEC_p128r1 + +instance Curve SEC_p128r2 where + curveType _ = typeSEC_p128r2 + curveParameters _ = paramSEC_p128r2 + +instance Curve SEC_p160k1 where + curveType _ = typeSEC_p160k1 + curveParameters _ = paramSEC_p160k1 + +instance Curve SEC_p160r1 where + curveType _ = typeSEC_p160r1 + curveParameters _ = paramSEC_p160r1 + +instance Curve SEC_p160r2 where + curveType _ = typeSEC_p160r2 + curveParameters _ = paramSEC_p160r2 + +instance Curve SEC_p192k1 where + curveType _ = typeSEC_p192k1 + curveParameters _ = paramSEC_p192k1 + +instance Curve SEC_p192r1 where + curveType _ = typeSEC_p192r1 + curveParameters _ = paramSEC_p192r1 + +instance Curve SEC_p224k1 where + curveType _ = typeSEC_p224k1 + curveParameters _ = paramSEC_p224k1 + +instance Curve SEC_p224r1 where + curveType _ = typeSEC_p224r1 + curveParameters _ = paramSEC_p224r1 + +instance Curve SEC_p256k1 where + curveType _ = typeSEC_p256k1 + curveParameters _ = paramSEC_p256k1 + +instance Curve SEC_p256r1 where + curveType _ = typeSEC_p256r1 + curveParameters _ = paramSEC_p256r1 + +instance Curve SEC_p384r1 where + curveType _ = typeSEC_p384r1 + curveParameters _ = paramSEC_p384r1 + +instance Curve SEC_p521r1 where + curveType _ = typeSEC_p521r1 + curveParameters _ = paramSEC_p521r1 + +instance Curve SEC_t113r1 where + curveType _ = typeSEC_t113r1 + curveParameters _ = paramSEC_t113r1 + +instance Curve SEC_t113r2 where + curveType _ = typeSEC_t113r2 + curveParameters _ = paramSEC_t113r2 + +instance Curve SEC_t131r1 where + curveType _ = typeSEC_t131r1 + curveParameters _ = paramSEC_t131r1 + +instance Curve SEC_t131r2 where + curveType _ = typeSEC_t131r2 + curveParameters _ = paramSEC_t131r2 + +instance Curve SEC_t163k1 where + curveType _ = typeSEC_t163k1 + curveParameters _ = paramSEC_t163k1 + +instance Curve SEC_t163r1 where + curveType _ = typeSEC_t163r1 + curveParameters _ = paramSEC_t163r1 + +instance Curve SEC_t163r2 where + curveType _ = typeSEC_t163r2 + curveParameters _ = paramSEC_t163r2 + +instance Curve SEC_t193r1 where + curveType _ = typeSEC_t193r1 + curveParameters _ = paramSEC_t193r1 + +instance Curve SEC_t193r2 where + curveType _ = typeSEC_t193r2 + curveParameters _ = paramSEC_t193r2 + +instance Curve SEC_t233k1 where + curveType _ = typeSEC_t233k1 + curveParameters _ = paramSEC_t233k1 + +instance Curve SEC_t233r1 where + curveType _ = typeSEC_t233r1 + curveParameters _ = paramSEC_t233r1 + +instance Curve SEC_t239k1 where + curveType _ = typeSEC_t239k1 + curveParameters _ = paramSEC_t239k1 + +instance Curve SEC_t283k1 where + curveType _ = typeSEC_t283k1 + curveParameters _ = paramSEC_t283k1 + +instance Curve SEC_t283r1 where + curveType _ = typeSEC_t283r1 + curveParameters _ = paramSEC_t283r1 + +instance Curve SEC_t409k1 where + curveType _ = typeSEC_t409k1 + curveParameters _ = paramSEC_t409k1 + +instance Curve SEC_t409r1 where + curveType _ = typeSEC_t409r1 + curveParameters _ = paramSEC_t409r1 + +instance Curve SEC_t571k1 where + curveType _ = typeSEC_t571k1 + curveParameters _ = paramSEC_t571k1 + +instance Curve SEC_t571r1 where + curveType _ = typeSEC_t571r1 + curveParameters _ = paramSEC_t571r1 + +{- +curvesOIDs :: [ (CurveName, [Integer]) ] +curvesOIDs = + [ (SEC_p112r1, [1,3,132,0,6]) + , (SEC_p112r2, [1,3,132,0,7]) + , (SEC_p128r1, [1,3,132,0,28]) + , (SEC_p128r2, [1,3,132,0,29]) + , (SEC_p160k1, [1,3,132,0,9]) + , (SEC_p160r1, [1,3,132,0,8]) + , (SEC_p160r2, [1,3,132,0,30]) + , (SEC_p192k1, [1,3,132,0,31]) + , (SEC_p192r1, [1,2,840,10045,3,1,1]) + , (SEC_p224k1, [1,3,132,0,32]) + , (SEC_p224r1, [1,3,132,0,33]) + , (SEC_p256k1, [1,3,132,0,10]) + , (SEC_p256r1, [1,2,840,10045,3,1,7]) + , (SEC_p384r1, [1,3,132,0,34]) + , (SEC_p521r1, [1,3,132,0,35]) + , (SEC_t113r1, [1,3,132,0,4]) + , (SEC_t113r2, [1,3,132,0,5]) + , (SEC_t131r1, [1,3,132,0,22]) + , (SEC_t131r2, [1,3,132,0,23]) + , (SEC_t163k1, [1,3,132,0,1]) + , (SEC_t163r1, [1,3,132,0,2]) + , (SEC_t163r2, [1,3,132,0,15]) + , (SEC_t193r1, [1,3,132,0,24]) + , (SEC_t193r2, [1,3,132,0,25]) + , (SEC_t233k1, [1,3,132,0,26]) + , (SEC_t233r1, [1,3,132,0,27]) + , (SEC_t239k1, [1,3,132,0,3]) + , (SEC_t283k1, [1,3,132,0,16]) + , (SEC_t283r1, [1,3,132,0,17]) + , (SEC_t409k1, [1,3,132,0,36]) + , (SEC_t409r1, [1,3,132,0,37]) + , (SEC_t571k1, [1,3,132,0,38]) + , (SEC_t571r1, [1,3,132,0,39]) + ] +-} + +typeSEC_p112r1 = CurvePrime $ CurvePrimeParam 0xdb7c2abf62e35e668076bead208b +paramSEC_p112r1 = CurveParameters + { curveEccA = 0xdb7c2abf62e35e668076bead2088 + , curveEccB = 0x659ef8ba043916eede8911702b22 + , curveEccG = Point 0x09487239995a5ee76b55f9c2f098 + 0xa89ce5af8724c0a23e0e0ff77500 + , curveEccN = 0xdb7c2abf62e35e7628dfac6561c5 + , curveEccH = 1 + } +typeSEC_p112r2 = CurvePrime $ CurvePrimeParam 0xdb7c2abf62e35e668076bead208b +paramSEC_p112r2 = CurveParameters + { curveEccA = 0x6127c24c05f38a0aaaf65c0ef02c + , curveEccB = 0x51def1815db5ed74fcc34c85d709 + , curveEccG = Point 0x4ba30ab5e892b4e1649dd0928643 + 0xadcd46f5882e3747def36e956e97 + , curveEccN = 0x36df0aafd8b8d7597ca10520d04b + , curveEccH = 4 + } +typeSEC_p128r1 = CurvePrime $ CurvePrimeParam 0xfffffffdffffffffffffffffffffffff +paramSEC_p128r1 = CurveParameters + { curveEccA = 0xfffffffdfffffffffffffffffffffffc + , curveEccB = 0xe87579c11079f43dd824993c2cee5ed3 + , curveEccG = Point 0x161ff7528b899b2d0c28607ca52c5b86 + 0xcf5ac8395bafeb13c02da292dded7a83 + , curveEccN = 0xfffffffe0000000075a30d1b9038a115 + , curveEccH = 1 + } +typeSEC_p128r2 = CurvePrime $ CurvePrimeParam 0xfffffffdffffffffffffffffffffffff +paramSEC_p128r2 = CurveParameters + { curveEccA = 0xd6031998d1b3bbfebf59cc9bbff9aee1 + , curveEccB = 0x5eeefca380d02919dc2c6558bb6d8a5d + , curveEccG = Point 0x7b6aa5d85e572983e6fb32a7cdebc140 + 0x27b6916a894d3aee7106fe805fc34b44 + , curveEccN = 0x3fffffff7fffffffbe0024720613b5a3 + , curveEccH = 4 + } +typeSEC_p160k1 = CurvePrime $ CurvePrimeParam 0x00fffffffffffffffffffffffffffffffeffffac73 +paramSEC_p160k1 = CurveParameters + { curveEccA = 0x000000000000000000000000000000000000000000 + , curveEccB = 0x000000000000000000000000000000000000000007 + , curveEccG = Point 0x003b4c382ce37aa192a4019e763036f4f5dd4d7ebb + 0x00938cf935318fdced6bc28286531733c3f03c4fee + , curveEccN = 0x0100000000000000000001b8fa16dfab9aca16b6b3 + , curveEccH = 1 + } +typeSEC_p160r1 = CurvePrime $ CurvePrimeParam 0x00ffffffffffffffffffffffffffffffff7fffffff +paramSEC_p160r1 = CurveParameters + { curveEccA = 0x00ffffffffffffffffffffffffffffffff7ffffffc + , curveEccB = 0x001c97befc54bd7a8b65acf89f81d4d4adc565fa45 + , curveEccG = Point 0x004a96b5688ef573284664698968c38bb913cbfc82 + 0x0023a628553168947d59dcc912042351377ac5fb32 + , curveEccN = 0x0100000000000000000001f4c8f927aed3ca752257 + , curveEccH = 1 + } +typeSEC_p160r2 = CurvePrime $ CurvePrimeParam 0x00fffffffffffffffffffffffffffffffeffffac73 +paramSEC_p160r2 = CurveParameters + { curveEccA = 0x00fffffffffffffffffffffffffffffffeffffac70 + , curveEccB = 0x00b4e134d3fb59eb8bab57274904664d5af50388ba + , curveEccG = Point 0x0052dcb034293a117e1f4ff11b30f7199d3144ce6d + 0x00feaffef2e331f296e071fa0df9982cfea7d43f2e + , curveEccN = 0x0100000000000000000000351ee786a818f3a1a16b + , curveEccH = 1 + } +typeSEC_p192k1 = CurvePrime $ CurvePrimeParam 0xfffffffffffffffffffffffffffffffffffffffeffffee37 +paramSEC_p192k1 = CurveParameters + { curveEccA = 0x000000000000000000000000000000000000000000000000 + , curveEccB = 0x000000000000000000000000000000000000000000000003 + , curveEccG = Point 0xdb4ff10ec057e9ae26b07d0280b7f4341da5d1b1eae06c7d + 0x9b2f2f6d9c5628a7844163d015be86344082aa88d95e2f9d + , curveEccN = 0xfffffffffffffffffffffffe26f2fc170f69466a74defd8d + , curveEccH = 1 + } +typeSEC_p192r1 = CurvePrime $ CurvePrimeParam 0xfffffffffffffffffffffffffffffffeffffffffffffffff +paramSEC_p192r1 = CurveParameters + { curveEccA = 0xfffffffffffffffffffffffffffffffefffffffffffffffc + , curveEccB = 0x64210519e59c80e70fa7e9ab72243049feb8deecc146b9b1 + , curveEccG = Point 0x188da80eb03090f67cbf20eb43a18800f4ff0afd82ff1012 + 0x07192b95ffc8da78631011ed6b24cdd573f977a11e794811 + , curveEccN = 0xffffffffffffffffffffffff99def836146bc9b1b4d22831 + , curveEccH = 1 + } +typeSEC_p224k1 = CurvePrime $ CurvePrimeParam 0x00fffffffffffffffffffffffffffffffffffffffffffffffeffffe56d +paramSEC_p224k1 = CurveParameters + { curveEccA = 0x0000000000000000000000000000000000000000000000000000000000 + , curveEccB = 0x0000000000000000000000000000000000000000000000000000000005 + , curveEccG = Point 0x00a1455b334df099df30fc28a169a467e9e47075a90f7e650eb6b7a45c + 0x007e089fed7fba344282cafbd6f7e319f7c0b0bd59e2ca4bdb556d61a5 + , curveEccN = 0x010000000000000000000000000001dce8d2ec6184caf0a971769fb1f7 + , curveEccH = 1 + } +typeSEC_p224r1 = CurvePrime $ CurvePrimeParam 0xffffffffffffffffffffffffffffffff000000000000000000000001 +paramSEC_p224r1 = CurveParameters + { curveEccA = 0xfffffffffffffffffffffffffffffffefffffffffffffffffffffffe + , curveEccB = 0xb4050a850c04b3abf54132565044b0b7d7bfd8ba270b39432355ffb4 + , curveEccG = Point 0xb70e0cbd6bb4bf7f321390b94a03c1d356c21122343280d6115c1d21 + 0xbd376388b5f723fb4c22dfe6cd4375a05a07476444d5819985007e34 + , curveEccN = 0xffffffffffffffffffffffffffff16a2e0b8f03e13dd29455c5c2a3d + , curveEccH = 1 + } +typeSEC_p256k1 = CurvePrime $ CurvePrimeParam 0xfffffffffffffffffffffffffffffffffffffffffffffffffffffffefffffc2f +paramSEC_p256k1 = CurveParameters + { curveEccA = 0x0000000000000000000000000000000000000000000000000000000000000000 + , curveEccB = 0x0000000000000000000000000000000000000000000000000000000000000007 + , curveEccG = Point 0x79be667ef9dcbbac55a06295ce870b07029bfcdb2dce28d959f2815b16f81798 + 0x483ada7726a3c4655da4fbfc0e1108a8fd17b448a68554199c47d08ffb10d4b8 + , curveEccN = 0xfffffffffffffffffffffffffffffffebaaedce6af48a03bbfd25e8cd0364141 + , curveEccH = 1 + } +typeSEC_p256r1 = CurvePrime $ CurvePrimeParam 0xffffffff00000001000000000000000000000000ffffffffffffffffffffffff +paramSEC_p256r1 = CurveParameters + { curveEccA = 0xffffffff00000001000000000000000000000000fffffffffffffffffffffffc + , curveEccB = 0x5ac635d8aa3a93e7b3ebbd55769886bc651d06b0cc53b0f63bce3c3e27d2604b + , curveEccG = Point 0x6b17d1f2e12c4247f8bce6e563a440f277037d812deb33a0f4a13945d898c296 + 0x4fe342e2fe1a7f9b8ee7eb4a7c0f9e162bce33576b315ececbb6406837bf51f5 + , curveEccN = 0xffffffff00000000ffffffffffffffffbce6faada7179e84f3b9cac2fc632551 + , curveEccH = 1 + } +typeSEC_p384r1 = CurvePrime $ CurvePrimeParam 0xfffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffeffffffff0000000000000000ffffffff +paramSEC_p384r1 = CurveParameters + { curveEccA = 0xfffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffeffffffff0000000000000000fffffffc + , curveEccB = 0xb3312fa7e23ee7e4988e056be3f82d19181d9c6efe8141120314088f5013875ac656398d8a2ed19d2a85c8edd3ec2aef + , curveEccG = Point 0xaa87ca22be8b05378eb1c71ef320ad746e1d3b628ba79b9859f741e082542a385502f25dbf55296c3a545e3872760ab7 + 0x3617de4a96262c6f5d9e98bf9292dc29f8f41dbd289a147ce9da3113b5f0b8c00a60b1ce1d7e819d7a431d7c90ea0e5f + , curveEccN = 0xffffffffffffffffffffffffffffffffffffffffffffffffc7634d81f4372ddf581a0db248b0a77aecec196accc52973 + , curveEccH = 1 + } +typeSEC_p521r1 = CurvePrime $ CurvePrimeParam 0x01ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff +paramSEC_p521r1 = CurveParameters + { curveEccA = 0x01fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffc + , curveEccB = 0x0051953eb9618e1c9a1f929a21a0b68540eea2da725b99b315f3b8b489918ef109e156193951ec7e937b1652c0bd3bb1bf073573df883d2c34f1ef451fd46b503f00 + , curveEccG = Point 0x00c6858e06b70404e9cd9e3ecb662395b4429c648139053fb521f828af606b4d3dbaa14b5e77efe75928fe1dc127a2ffa8de3348b3c1856a429bf97e7e31c2e5bd66 + 0x011839296a789a3bc0045c8a5fb42c7d1bd998f54449579b446817afbd17273e662c97ee72995ef42640c550b9013fad0761353c7086a272c24088be94769fd16650 + , curveEccN = 0x01fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffa51868783bf2f966b7fcc0148f709a5d03bb5c9b8899c47aebb6fb71e91386409 + , curveEccH = 1 + } +typeSEC_t113r1 = CurveBinary $ CurveBinaryParam 0x020000000000000000000000000201 +paramSEC_t113r1 = CurveParameters + { curveEccA = 0x003088250ca6e7c7fe649ce85820f7 + , curveEccB = 0x00e8bee4d3e2260744188be0e9c723 + , curveEccG = Point 0x009d73616f35f4ab1407d73562c10f + 0x00a52830277958ee84d1315ed31886 + , curveEccN = 0x0100000000000000d9ccec8a39e56f + , curveEccH = 2 + } +typeSEC_t113r2 = CurveBinary $ CurveBinaryParam 0x020000000000000000000000000201 +paramSEC_t113r2 = CurveParameters + { curveEccA = 0x00689918dbec7e5a0dd6dfc0aa55c7 + , curveEccB = 0x0095e9a9ec9b297bd4bf36e059184f + , curveEccG = Point 0x01a57a6a7b26ca5ef52fcdb8164797 + 0x00b3adc94ed1fe674c06e695baba1d + , curveEccN = 0x010000000000000108789b2496af93 + , curveEccH = 2 + } +typeSEC_t131r1 = CurveBinary $ CurveBinaryParam 0x080000000000000000000000000000010d +paramSEC_t131r1 = CurveParameters + { curveEccA = 0x07a11b09a76b562144418ff3ff8c2570b8 + , curveEccB = 0x0217c05610884b63b9c6c7291678f9d341 + , curveEccG = Point 0x0081baf91fdf9833c40f9c181343638399 + 0x078c6e7ea38c001f73c8134b1b4ef9e150 + , curveEccN = 0x0400000000000000023123953a9464b54d + , curveEccH = 2 + } +typeSEC_t131r2 = CurveBinary $ CurveBinaryParam 0x080000000000000000000000000000010d +paramSEC_t131r2 = CurveParameters + { curveEccA = 0x03e5a88919d7cafcbf415f07c2176573b2 + , curveEccB = 0x04b8266a46c55657ac734ce38f018f2192 + , curveEccG = Point 0x0356dcd8f2f95031ad652d23951bb366a8 + 0x0648f06d867940a5366d9e265de9eb240f + , curveEccN = 0x0400000000000000016954a233049ba98f + , curveEccH = 2 + } +typeSEC_t163k1 = CurveBinary $ CurveBinaryParam 0x0800000000000000000000000000000000000000c9 +paramSEC_t163k1 = CurveParameters + { curveEccA = 0x000000000000000000000000000000000000000001 + , curveEccB = 0x000000000000000000000000000000000000000001 + , curveEccG = Point 0x02fe13c0537bbc11acaa07d793de4e6d5e5c94eee8 + 0x0289070fb05d38ff58321f2e800536d538ccdaa3d9 + , curveEccN = 0x04000000000000000000020108a2e0cc0d99f8a5ef + , curveEccH = 2 + } +typeSEC_t163r1 = CurveBinary $ CurveBinaryParam 0x0800000000000000000000000000000000000000c9 +paramSEC_t163r1 = CurveParameters + { curveEccA = 0x07b6882caaefa84f9554ff8428bd88e246d2782ae2 + , curveEccB = 0x0713612dcddcb40aab946bda29ca91f73af958afd9 + , curveEccG = Point 0x0369979697ab43897789566789567f787a7876a654 + 0x00435edb42efafb2989d51fefce3c80988f41ff883 + , curveEccN = 0x03ffffffffffffffffffff48aab689c29ca710279b + , curveEccH = 2 + } +typeSEC_t163r2 = CurveBinary $ CurveBinaryParam 0x0800000000000000000000000000000000000000c9 +paramSEC_t163r2 = CurveParameters + { curveEccA = 0x000000000000000000000000000000000000000001 + , curveEccB = 0x020a601907b8c953ca1481eb10512f78744a3205fd + , curveEccG = Point 0x03f0eba16286a2d57ea0991168d4994637e8343e36 + 0x00d51fbc6c71a0094fa2cdd545b11c5c0c797324f1 + , curveEccN = 0x040000000000000000000292fe77e70c12a4234c33 + , curveEccH = 2 + } +typeSEC_t193r1 = CurveBinary $ CurveBinaryParam 0x02000000000000000000000000000000000000000000008001 +paramSEC_t193r1 = CurveParameters + { curveEccA = 0x0017858feb7a98975169e171f77b4087de098ac8a911df7b01 + , curveEccB = 0x00fdfb49bfe6c3a89facadaa7a1e5bbc7cc1c2e5d831478814 + , curveEccG = Point 0x01f481bc5f0ff84a74ad6cdf6fdef4bf6179625372d8c0c5e1 + 0x0025e399f2903712ccf3ea9e3a1ad17fb0b3201b6af7ce1b05 + , curveEccN = 0x01000000000000000000000000c7f34a778f443acc920eba49 + , curveEccH = 2 + } +typeSEC_t193r2 = CurveBinary $ CurveBinaryParam 0x02000000000000000000000000000000000000000000008001 +paramSEC_t193r2 = CurveParameters + { curveEccA = 0x0163f35a5137c2ce3ea6ed8667190b0bc43ecd69977702709b + , curveEccB = 0x00c9bb9e8927d4d64c377e2ab2856a5b16e3efb7f61d4316ae + , curveEccG = Point 0x00d9b67d192e0367c803f39e1a7e82ca14a651350aae617e8f + 0x01ce94335607c304ac29e7defbd9ca01f596f927224cdecf6c + , curveEccN = 0x010000000000000000000000015aab561b005413ccd4ee99d5 + , curveEccH = 2 + } +typeSEC_t233k1 = CurveBinary $ CurveBinaryParam 0x020000000000000000000000000000000000000004000000000000000001 +paramSEC_t233k1 = CurveParameters + { curveEccA = 0x000000000000000000000000000000000000000000000000000000000000 + , curveEccB = 0x000000000000000000000000000000000000000000000000000000000001 + , curveEccG = Point 0x017232ba853a7e731af129f22ff4149563a419c26bf50a4c9d6eefad6126 + 0x01db537dece819b7f70f555a67c427a8cd9bf18aeb9b56e0c11056fae6a3 + , curveEccN = 0x008000000000000000000000000000069d5bb915bcd46efb1ad5f173abdf + , curveEccH = 4 + } +typeSEC_t233r1 = CurveBinary $ CurveBinaryParam 0x020000000000000000000000000000000000000004000000000000000001 +paramSEC_t233r1 = CurveParameters + { curveEccA = 0x000000000000000000000000000000000000000000000000000000000001 + , curveEccB = 0x0066647ede6c332c7f8c0923bb58213b333b20e9ce4281fe115f7d8f90ad + , curveEccG = Point 0x00fac9dfcbac8313bb2139f1bb755fef65bc391f8b36f8f8eb7371fd558b + 0x01006a08a41903350678e58528bebf8a0beff867a7ca36716f7e01f81052 + , curveEccN = 0x01000000000000000000000000000013e974e72f8a6922031d2603cfe0d7 + , curveEccH = 2 + } +typeSEC_t239k1 = CurveBinary $ CurveBinaryParam 0x800000000000000000004000000000000000000000000000000000000001 +paramSEC_t239k1 = CurveParameters + { curveEccA = 0x000000000000000000000000000000000000000000000000000000000000 + , curveEccB = 0x000000000000000000000000000000000000000000000000000000000001 + , curveEccG = Point 0x29a0b6a887a983e9730988a68727a8b2d126c44cc2cc7b2a6555193035dc + 0x76310804f12e549bdb011c103089e73510acb275fc312a5dc6b76553f0ca + , curveEccN = 0x2000000000000000000000000000005a79fec67cb6e91f1c1da800e478a5 + , curveEccH = 4 + } +typeSEC_t283k1 = CurveBinary $ CurveBinaryParam 0x0800000000000000000000000000000000000000000000000000000000000000000010a1 +paramSEC_t283k1 = CurveParameters + { curveEccA = 0x000000000000000000000000000000000000000000000000000000000000000000000000 + , curveEccB = 0x000000000000000000000000000000000000000000000000000000000000000000000001 + , curveEccG = Point 0x0503213f78ca44883f1a3b8162f188e553cd265f23c1567a16876913b0c2ac2458492836 + 0x01ccda380f1c9e318d90f95d07e5426fe87e45c0e8184698e45962364e34116177dd2259 + , curveEccN = 0x01ffffffffffffffffffffffffffffffffffe9ae2ed07577265dff7f94451e061e163c61 + , curveEccH = 4 + } +typeSEC_t283r1 = CurveBinary $ CurveBinaryParam 0x0800000000000000000000000000000000000000000000000000000000000000000010a1 +paramSEC_t283r1 = CurveParameters + { curveEccA = 0x000000000000000000000000000000000000000000000000000000000000000000000001 + , curveEccB = 0x027b680ac8b8596da5a4af8a19a0303fca97fd7645309fa2a581485af6263e313b79a2f5 + , curveEccG = Point 0x05f939258db7dd90e1934f8c70b0dfec2eed25b8557eac9c80e2e198f8cdbecd86b12053 + 0x03676854fe24141cb98fe6d4b20d02b4516ff702350eddb0826779c813f0df45be8112f4 + , curveEccN = 0x03ffffffffffffffffffffffffffffffffffef90399660fc938a90165b042a7cefadb307 + , curveEccH = 2 + } +typeSEC_t409k1 = CurveBinary $ CurveBinaryParam 0x02000000000000000000000000000000000000000000000000000000000000000000000000000000008000000000000000000001 +paramSEC_t409k1 = CurveParameters + { curveEccA = 0x00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 + , curveEccB = 0x00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 + , curveEccG = Point 0x0060f05f658f49c1ad3ab1890f7184210efd0987e307c84c27accfb8f9f67cc2c460189eb5aaaa62ee222eb1b35540cfe9023746 + 0x01e369050b7c4e42acba1dacbf04299c3460782f918ea427e6325165e9ea10e3da5f6c42e9c55215aa9ca27a5863ec48d8e0286b + , curveEccN = 0x007ffffffffffffffffffffffffffffffffffffffffffffffffffe5f83b2d4ea20400ec4557d5ed3e3e7ca5b4b5c83b8e01e5fcf + , curveEccH = 4 + } +typeSEC_t409r1 = CurveBinary $ CurveBinaryParam 0x02000000000000000000000000000000000000000000000000000000000000000000000000000000008000000000000000000001 +paramSEC_t409r1 = CurveParameters + { curveEccA = 0x00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 + , curveEccB = 0x0021a5c2c8ee9feb5c4b9a753b7b476b7fd6422ef1f3dd674761fa99d6ac27c8a9a197b272822f6cd57a55aa4f50ae317b13545f + , curveEccG = Point 0x015d4860d088ddb3496b0c6064756260441cde4af1771d4db01ffe5b34e59703dc255a868a1180515603aeab60794e54bb7996a7 + 0x0061b1cfab6be5f32bbfa78324ed106a7636b9c5a7bd198d0158aa4f5488d08f38514f1fdf4b4f40d2181b3681c364ba0273c706 + , curveEccN = 0x010000000000000000000000000000000000000000000000000001e2aad6a612f33307be5fa47c3c9e052f838164cd37d9a21173 + , curveEccH = 2 + } +typeSEC_t571k1 = CurveBinary $ CurveBinaryParam 0x080000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000425 +paramSEC_t571k1 = CurveParameters + { curveEccA = 0x000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 + , curveEccB = 0x000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 + , curveEccG = Point 0x026eb7a859923fbc82189631f8103fe4ac9ca2970012d5d46024804801841ca44370958493b205e647da304db4ceb08cbbd1ba39494776fb988b47174dca88c7e2945283a01c8972 + 0x0349dc807f4fbf374f4aeade3bca95314dd58cec9f307a54ffc61efc006d8a2c9d4979c0ac44aea74fbebbb9f772aedcb620b01a7ba7af1b320430c8591984f601cd4c143ef1c7a3 + , curveEccN = 0x020000000000000000000000000000000000000000000000000000000000000000000000131850e1f19a63e4b391a8db917f4138b630d84be5d639381e91deb45cfe778f637c1001 + , curveEccH = 4 + } +typeSEC_t571r1 = CurveBinary $ CurveBinaryParam 0x080000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000425 +paramSEC_t571r1 = CurveParameters + { curveEccA = 0x000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 + , curveEccB = 0x02f40e7e2221f295de297117b7f3d62f5c6a97ffcb8ceff1cd6ba8ce4a9a18ad84ffabbd8efa59332be7ad6756a66e294afd185a78ff12aa520e4de739baca0c7ffeff7f2955727a + , curveEccG = Point 0x0303001d34b856296c16c0d40d3cd7750a93d1d2955fa80aa5f40fc8db7b2abdbde53950f4c0d293cdd711a35b67fb1499ae60038614f1394abfa3b4c850d927e1e7769c8eec2d19 + 0x037bf27342da639b6dccfffeb73d69d78c6c27a6009cbbca1980f8533921e8a684423e43bab08a576291af8f461bb2a8b3531d2f0485c19b16e2f1516e23dd3c1a4827af1b8ac15b + , curveEccN = 0x03ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffe661ce18ff55987308059b186823851ec7dd9ca1161de93d5174d66e8382e9bb2fe84e47 + , curveEccH = 2 + } diff --git a/Crypto/Error/Types.hs b/Crypto/Error/Types.hs index edaf6548..7363763f 100644 --- a/Crypto/Error/Types.hs +++ b/Crypto/Error/Types.hs @@ -35,6 +35,7 @@ data CryptoError = | CryptoError_PublicKeySizeInvalid | CryptoError_SharedSecretSizeInvalid -- elliptic cryptography error + | CryptoError_EcScalarOutOfBounds | CryptoError_PointSizeInvalid | CryptoError_PointFormatInvalid | CryptoError_PointFormatUnsupported diff --git a/cryptonite.cabal b/cryptonite.cabal index 1447961d..ce81c31b 100644 --- a/cryptonite.cabal +++ b/cryptonite.cabal @@ -186,6 +186,8 @@ Library Crypto.Random.Probabilistic Crypto.PubKey.Internal Crypto.PubKey.ElGamal + Crypto.ECC.Simple.Types + Crypto.ECC.Simple.Prim Crypto.Internal.ByteArray Crypto.Internal.Compat Crypto.Internal.CompatPrim From 422c5fdb09f43acad0ef665c59e1d694182c3043 Mon Sep 17 00:00:00 2001 From: Vincent Hanquez Date: Fri, 2 Dec 2016 11:36:48 +0000 Subject: [PATCH 25/36] remove reference to the old api in the documentation --- Crypto/ECC/Simple/Prim.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/Crypto/ECC/Simple/Prim.hs b/Crypto/ECC/Simple/Prim.hs index 39a6cdaf..cf2f7bd3 100644 --- a/Crypto/ECC/Simple/Prim.hs +++ b/Crypto/ECC/Simple/Prim.hs @@ -42,7 +42,7 @@ scalarFromInteger n --TODO: Extract helper function for `fromMaybe PointO...` -- | Elliptic Curve point negation: --- @pointNegate c p@ returns point @q@ such that @pointAdd c p q == PointO@. +-- @pointNegate p@ returns point @q@ such that @pointAdd p q == PointO@. pointNegate :: Curve curve => Point curve -> Point curve pointNegate PointO = PointO pointNegate point@(Point x y) = @@ -133,8 +133,8 @@ pointMul (Scalar n) p -- | Elliptic curve double-scalar multiplication (uses Shamir's trick). -- --- > pointAddTwoMuls c n1 p1 n2 p2 == pointAdd c (pointMul c n1 p1) --- > (pointMul c n2 p2) +-- > pointAddTwoMuls n1 p1 n2 p2 == pointAdd (pointMul n1 p1) +-- > (pointMul n2 p2) -- -- /WARNING:/ Vulnerable to timing attacks. pointAddTwoMuls :: Curve curve => Scalar curve -> Point curve -> Scalar curve -> Point curve -> Point curve From 11e42a256dc99ad6641558259a7affcdaa6a7d73 Mon Sep 17 00:00:00 2001 From: Vincent Hanquez Date: Fri, 2 Dec 2016 14:59:46 +0000 Subject: [PATCH 26/36] add the binding to get the size by bytes --- Crypto/ECC/Simple/Types.hs | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/Crypto/ECC/Simple/Types.hs b/Crypto/ECC/Simple/Types.hs index d45309a5..c97daa29 100644 --- a/Crypto/ECC/Simple/Types.hs +++ b/Crypto/ECC/Simple/Types.hs @@ -18,6 +18,7 @@ module Crypto.ECC.Simple.Types , CurveBinaryParam(..) , CurvePrimeParam(..) , curveSizeBits + , curveSizeBytes , CurveParameters(..) -- * specific curves definition , SEC_p112r1(..) @@ -70,6 +71,10 @@ curveSizeBits proxy = CurvePrime (CurvePrimeParam p) -> numBits p CurveBinary (CurveBinaryParam c) -> numBits c - 1 +-- | get the size of the curve in bytes +curveSizeBytes :: Curve curve => proxy curve -> Int +curveSizeBytes proxy = (curveSizeBits proxy + 7) `div` 8 + -- | Define common parameters in a curve definition -- of the form: y^2 = x^3 + ax + b. data CurveParameters curve = CurveParameters From 955f010bffafa69795dbfeebd84da73ac7763035 Mon Sep 17 00:00:00 2001 From: Vincent Hanquez Date: Fri, 2 Dec 2016 15:00:05 +0000 Subject: [PATCH 27/36] add internal proxy type to create witnesses --- Crypto/Internal/Proxy.hs | 13 +++++++++++++ cryptonite.cabal | 1 + 2 files changed, 14 insertions(+) create mode 100644 Crypto/Internal/Proxy.hs diff --git a/Crypto/Internal/Proxy.hs b/Crypto/Internal/Proxy.hs new file mode 100644 index 00000000..1873b2b1 --- /dev/null +++ b/Crypto/Internal/Proxy.hs @@ -0,0 +1,13 @@ +-- | +-- Module : Crypto.Internal.Proxy +-- License : BSD-style +-- Maintainer : Vincent Hanquez +-- Stability : experimental +-- Portability : Good +-- +module Crypto.Internal.Proxy + ( Proxy(..) + ) where + +-- | A type witness for 'a' as phantom type +data Proxy a = Proxy diff --git a/cryptonite.cabal b/cryptonite.cabal index ce81c31b..ac83d56a 100644 --- a/cryptonite.cabal +++ b/cryptonite.cabal @@ -188,6 +188,7 @@ Library Crypto.PubKey.ElGamal Crypto.ECC.Simple.Types Crypto.ECC.Simple.Prim + Crypto.Internal.Proxy Crypto.Internal.ByteArray Crypto.Internal.Compat Crypto.Internal.CompatPrim From 7e6d7ccb1c77e23fa11792473ddd25bfe60e4c0a Mon Sep 17 00:00:00 2001 From: Vincent Hanquez Date: Fri, 2 Dec 2016 15:02:48 +0000 Subject: [PATCH 28/36] complete rewrite of the type class 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. --- Crypto/ECC.hs | 185 +++++++++++++++++++++----------------------------- 1 file changed, 78 insertions(+), 107 deletions(-) diff --git a/Crypto/ECC.hs b/Crypto/ECC.hs index cd3753a7..df2864ac 100644 --- a/Crypto/ECC.hs +++ b/Crypto/ECC.hs @@ -23,10 +23,11 @@ module Crypto.ECC ) where import qualified Crypto.PubKey.ECC.P256 as P256 -import qualified Crypto.PubKey.ECC.Types as H -import qualified Crypto.PubKey.ECC.Prim as H +import qualified Crypto.ECC.Simple.Types as Simple +import qualified Crypto.ECC.Simple.Prim as Simple import Crypto.Random import Crypto.Error +import Crypto.Internal.Proxy import Crypto.Internal.Imports import Crypto.Internal.ByteArray (ByteArray, ByteArrayAccess, ScrubbedBytes) import qualified Crypto.Internal.ByteArray as B @@ -47,44 +48,26 @@ newtype SharedSecret = SharedSecret ScrubbedBytes class EllipticCurve curve where -- | Point on an Elliptic Curve - data Point curve :: * + type Point curve :: * -- | Scalar in the Elliptic Curve domain - data 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 + type Scalar 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 - curveGenerateScalar :: MonadRandom randomly => randomly (Scalar curve) + curveGenerateScalar :: MonadRandom randomly => proxy curve -> randomly (Scalar curve) -- | Generate a new random keypair - curveGenerateKeyPair :: MonadRandom randomly => randomly (KeyPair curve) - - encodePoint :: ByteArray bs => Point curve -> bs - decodePoint :: ByteArray bs => bs -> CryptoFailable (Point curve) + curveGenerateKeyPair :: MonadRandom randomly => proxy curve -> randomly (KeyPair curve) -instance {-# OVERLAPPABLE #-} Show (Point a) where - show _ = undefined + -- | Get the curve size in bits + curveSizeBits :: proxy curve -> Int -instance {-# OVERLAPPABLE #-} Eq (Point a) where - _ == _ = undefined + -- | Encode a elliptic curve point into binary form + encodePoint :: ByteArray bs => proxy curve -> Point curve -> bs -instance {-# OVERLAPPABLE #-} Show (Scalar a) where - show _ = undefined - -instance {-# OVERLAPPABLE #-} Eq (Scalar a) where - _ == _ = undefined + -- | Try to decode the binary form of an elliptic curve point + decodePoint :: ByteArray bs => proxy curve -> bs -> CryptoFailable (Point curve) class EllipticCurve curve => EllipticCurveDH curve where -- | Generate a Diffie hellman secret value. @@ -93,14 +76,14 @@ class EllipticCurve curve => EllipticCurveDH curve where -- is not hashed. -- -- 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 -- | 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 - pointSmul :: Scalar curve -> Point curve -> Point curve + pointSmul :: proxy curve -> Scalar curve -> Point curve -> Point curve -- -- | Scalar Inverse -- scalarInverse :: Scalar curve -> Scalar curve @@ -111,118 +94,103 @@ class EllipticCurve curve => EllipticCurveArith curve where data Curve_P256R1 = Curve_P256R1 instance EllipticCurve Curve_P256R1 where - newtype Point Curve_P256R1 = P256Point { unP256Point :: P256.Point } deriving (Eq,Show) - newtype Scalar Curve_P256R1 = P256Scalar { unP256Scalar :: P256.Scalar } deriving (Eq,Show) - curveGetOrder _ = 0xffffffff00000000ffffffffffffffffbce6faada7179e84f3b9cac2fc632551 - curveGetBasePoint = P256Point P256.pointBase - curveOfScalar _ = Curve_P256R1 - curveOfPoint _ = Curve_P256R1 - 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 + type Point Curve_P256R1 = P256.Point + type Scalar Curve_P256R1 = P256.Scalar + curveSizeBits _ = 256 + curveGenerateScalar _ = P256.scalarGenerate + curveGenerateKeyPair _ = toKeyPair <$> P256.scalarGenerate + where toKeyPair scalar = KeyPair (P256.toPoint scalar) scalar + encodePoint _ p = encodeECPoint (Simple.Point x y :: Simple.Point Simple.SEC_p256r1) where (x,y) = P256.pointToIntegers p - decodePoint bs = fromPoint <$> decodeECPoint bs - where fromPoint (H.Point x y) = P256Point $ P256.pointFromIntegers (x,y) - fromPoint H.PointO = error "impossible happened: fromPoint is infinite" + decodePoint _ bs = fromSimplePoint <$> decodeECPoint bs + where fromSimplePoint :: Simple.Point Simple.SEC_p256r1 -> P256.Point + fromSimplePoint (Simple.Point x y) = P256.pointFromIntegers (x,y) + fromSimplePoint Simple.PointO = error "impossible happened: fromPoint is infinite" instance EllipticCurveArith Curve_P256R1 where - pointAdd a b = P256Point $ (P256.pointAdd `on` unP256Point) a b - pointSmul s p = P256Point $ P256.pointMul (unP256Scalar s) (unP256Point p) + pointAdd _ a b = P256.pointAdd a b + pointSmul _ s p = P256.pointMul s p instance EllipticCurveDH Curve_P256R1 where - ecdh s p = shared + ecdh proxy s p = shared where - (x, _) = P256.pointToIntegers $ unP256Point $ pointSmul s p + (x, _) = P256.pointToIntegers $ pointSmul proxy s p len = 32 -- (256 + 7) `div` 8 shared = SharedSecret $ i2ospOf_ len x data Curve_P384R1 = Curve_P384R1 instance EllipticCurve Curve_P384R1 where - newtype Point Curve_P384R1 = P384Point { unP384Point :: H.Point } deriving (Eq,Show) - newtype Scalar Curve_P384R1 = P384Scalar { unP384Scalar :: H.PrivateNumber } deriving (Eq,Show) - curveGetOrder _ = H.ecc_n $ H.common_curve $ H.getCurveByName H.SEC_p384r1 - curveGetBasePoint = P384Point $ H.ecc_g $ H.common_curve $ H.getCurveByName H.SEC_p384r1 - curveOfScalar _ = Curve_P384R1 - curveOfPoint _ = Curve_P384R1 - 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 <$> decodeECPoint bs + type Point Curve_P384R1 = Simple.Point Simple.SEC_p384r1 + type Scalar Curve_P384R1 = Simple.Scalar Simple.SEC_p384r1 + curveSizeBits _ = 384 + curveGenerateScalar _ = Simple.scalarGenerate + curveGenerateKeyPair _ = toKeyPair <$> Simple.scalarGenerate + where toKeyPair scalar = KeyPair (Simple.pointBaseMul scalar) scalar + encodePoint _ point = encodeECPoint point + decodePoint _ bs = decodeECPoint bs instance EllipticCurveArith Curve_P384R1 where - pointAdd a b = P384Point $ (H.pointAdd (H.getCurveByName H.SEC_p384r1) `on` unP384Point) a b - pointSmul s p = P384Point (H.pointMul (H.getCurveByName H.SEC_p384r1) (unP384Scalar s) (unP384Point p)) + pointAdd _ a b = Simple.pointAdd a b + pointSmul _ s p = Simple.pointMul s p instance EllipticCurveDH Curve_P384R1 where - ecdh s p = shared + ecdh _ s p = SharedSecret $ i2ospOf_ (curveSizeBytes prx) x where - H.Point x _ = unP384Point $ pointSmul s p - len = 48 -- (384 + 7) `div` 8 - shared = SharedSecret $ i2ospOf_ len x + prx = Proxy :: Proxy Curve_P384R1 + Simple.Point x _ = pointSmul prx s p data Curve_P521R1 = Curve_P521R1 instance EllipticCurve Curve_P521R1 where - newtype Point Curve_P521R1 = P521Point { unP521Point :: H.Point } deriving (Eq,Show) - newtype Scalar Curve_P521R1 = P521Scalar { unP521Scalar :: H.PrivateNumber } deriving (Eq,Show) - curveGetOrder _ = H.ecc_n $ H.common_curve $ H.getCurveByName H.SEC_p521r1 - curveGetBasePoint = P521Point $ H.ecc_g $ H.common_curve $ H.getCurveByName H.SEC_p521r1 - curveOfScalar _ = Curve_P521R1 - curveOfPoint _ = Curve_P521R1 - 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 <$> decodeECPoint bs + type Point Curve_P521R1 = Simple.Point Simple.SEC_p521r1 + type Scalar Curve_P521R1 = Simple.Scalar Simple.SEC_p521r1 + curveSizeBits _ = 521 + curveGenerateScalar _ = Simple.scalarGenerate + curveGenerateKeyPair _ = toKeyPair <$> Simple.scalarGenerate + where toKeyPair scalar = KeyPair (Simple.pointBaseMul scalar) scalar + encodePoint _ point = encodeECPoint point + decodePoint _ bs = decodeECPoint bs instance EllipticCurveArith Curve_P521R1 where - pointAdd a b = P521Point $ (H.pointAdd (H.getCurveByName H.SEC_p521r1) `on` unP521Point) a b - pointSmul s p = P521Point (H.pointMul (H.getCurveByName H.SEC_p521r1) (unP521Scalar s) (unP521Point p)) + pointAdd _ a b = Simple.pointAdd a b + pointSmul _ s p = Simple.pointMul s p instance EllipticCurveDH Curve_P521R1 where - ecdh s p = shared + ecdh _ s p = SharedSecret $ i2ospOf_ (curveSizeBytes prx) x where - H.Point x _ = unP521Point $ pointSmul s p - len = 66 -- (521 + 7) `div` 8 - shared = SharedSecret $ i2ospOf_ len x + prx = Proxy :: Proxy Curve_P521R1 + Simple.Point x _ = pointSmul prx s p data Curve_X25519 = Curve_X25519 instance EllipticCurve Curve_X25519 where - newtype Point Curve_X25519 = X25519Point X25519.PublicKey deriving (Eq,Show) - newtype Scalar Curve_X25519 = X25519Scalar X25519.SecretKey deriving (Eq,Show) - curveGetOrder _ = undefined - curveGetBasePoint = undefined - curveOfScalar _ = Curve_X25519 - curveOfPoint _ = Curve_X25519 - curveGenerateScalar = X25519Scalar <$> X25519.generateSecretKey - curveGenerateKeyPair = do + type Point Curve_X25519 = X25519.PublicKey + type Scalar Curve_X25519 = X25519.SecretKey + curveSizeBits _ = 255 + curveGenerateScalar _ = X25519.generateSecretKey + curveGenerateKeyPair _ = do s <- X25519.generateSecretKey - let p = X25519.toPublic s - return $ KeyPair (X25519Point p) (X25519Scalar s) - encodePoint (X25519Point p) = B.convert p - decodePoint bs = X25519Point <$> X25519.publicKey bs + return $ KeyPair (X25519.toPublic s) s + encodePoint _ p = B.convert p + decodePoint _ bs = X25519.publicKey bs instance EllipticCurveDH Curve_X25519 where - ecdh (X25519Scalar s) (X25519Point p) = SharedSecret $ convert secret - where - secret = X25519.dh p s + ecdh _ s p = SharedSecret $ convert secret + where secret = X25519.dh p s -encodeECPoint :: forall bs. ByteArray bs => Integer -> Integer -> Int -> bs -encodeECPoint x y siz = B.concat [uncompressed,xb,yb] +encodeECPoint :: forall curve bs . (Simple.Curve curve, ByteArray bs) => Simple.Point curve -> bs +encodeECPoint Simple.PointO = error "encodeECPoint: cannot serialize point at infinity" +encodeECPoint (Simple.Point x y) = B.concat [uncompressed,xb,yb] where + size = Simple.curveSizeBytes (Proxy :: Proxy curve) uncompressed, xb, yb :: bs uncompressed = B.singleton 4 - xb = i2ospOf_ siz x - yb = i2ospOf_ siz y + xb = i2ospOf_ size x + 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 Nothing -> CryptoFailed $ CryptoError_PointSizeInvalid Just (m,xy) @@ -232,5 +200,8 @@ decodeECPoint mxy = case B.uncons mxy of (xb,yb) = B.splitAt siz xy x = os2ip xb y = os2ip yb - in CryptoPassed $ H.Point x y + in CryptoPassed $ Simple.Point x y | otherwise -> CryptoFailed $ CryptoError_PointFormatInvalid + +curveSizeBytes :: EllipticCurve c => Proxy c -> Int +curveSizeBytes proxy = (curveSizeBits proxy + 7) `div` 8 From 8b5a36f44e077493efdef1b1c616661ca0d061dc Mon Sep 17 00:00:00 2001 From: Vincent Hanquez Date: Fri, 2 Dec 2016 15:03:08 +0000 Subject: [PATCH 29/36] fix ECIES to work with the rewrite --- Crypto/PubKey/ECIES.hs | 15 +++++++++------ 1 file changed, 9 insertions(+), 6 deletions(-) diff --git a/Crypto/PubKey/ECIES.hs b/Crypto/PubKey/ECIES.hs index 2f6a646a..e26cf149 100644 --- a/Crypto/PubKey/ECIES.hs +++ b/Crypto/PubKey/ECIES.hs @@ -14,20 +14,23 @@ module Crypto.PubKey.ECIES import Crypto.ECC import Crypto.Random +import Crypto.Internal.Proxy -- | Generate random a new Shared secret and the associated point -- to do a ECIES style encryption deriveEncrypt :: (MonadRandom randomly, EllipticCurveDH curve) - => Point curve -- ^ the public key of the receiver + => proxy curve -- ^ representation of the curve + -> Point curve -- ^ the public key of the receiver -> randomly (Point curve, SharedSecret) -deriveEncrypt pub = do - (KeyPair rPoint rScalar) <- curveGenerateKeyPair - return (rPoint, ecdh rScalar pub) +deriveEncrypt proxy pub = do + (KeyPair rPoint rScalar) <- curveGenerateKeyPair proxy + return (rPoint, ecdh proxy rScalar pub) -- | Derive the shared secret with the receiver key -- and the R point of the scheme. deriveDecrypt :: EllipticCurveDH curve - => Point curve -- ^ The received R (supposedly, randomly generate on the encrypt side) + => proxy curve -- ^ representation of the curve + -> Point curve -- ^ The received R (supposedly, randomly generated on the encrypt side) -> Scalar curve -- ^ The secret key of the receiver -> SharedSecret -deriveDecrypt point secret = ecdh secret point +deriveDecrypt proxy point secret = ecdh proxy secret point From 922bed5ac575b444ea773f953511020865f015a5 Mon Sep 17 00:00:00 2001 From: Vincent Hanquez Date: Fri, 2 Dec 2016 15:03:19 +0000 Subject: [PATCH 30/36] add some documentation to ECIES --- Crypto/PubKey/ECIES.hs | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/Crypto/PubKey/ECIES.hs b/Crypto/PubKey/ECIES.hs index e26cf149..cd3aac8b 100644 --- a/Crypto/PubKey/ECIES.hs +++ b/Crypto/PubKey/ECIES.hs @@ -7,6 +7,18 @@ -- -- IES with Elliptic curve -- +-- This is a simple cryptographic system between 2 parties using Elliptic Curve. +-- +-- The sending party create a shared secret using the receiver public key, and use the shared secret +-- to generate cryptographic material for an symmetric encryption scheme (preferably authenticated encryption). +-- +-- The receiving party receive the temporary ephemeral public key which is combined to its secret key +-- to create the shared secret which just like on the sending is used to generate cryptographic material. +-- +-- This module doesn't provide any symmetric data encryption capability or any mean to derive +-- cryptographic key material for a symmetric key from the shared secret. +-- this is left to the user for now. +-- module Crypto.PubKey.ECIES ( deriveEncrypt , deriveDecrypt From 052417e5b124d488b411b43b414bb2a705a50d12 Mon Sep 17 00:00:00 2001 From: Vincent Hanquez Date: Fri, 2 Dec 2016 15:28:03 +0000 Subject: [PATCH 31/36] properly check for point validity before making a point --- Crypto/ECC.hs | 2 +- Crypto/ECC/Simple/Prim.hs | 19 ++++++++++++++----- Crypto/Error/Types.hs | 1 + 3 files changed, 16 insertions(+), 6 deletions(-) diff --git a/Crypto/ECC.hs b/Crypto/ECC.hs index df2864ac..adecae87 100644 --- a/Crypto/ECC.hs +++ b/Crypto/ECC.hs @@ -200,7 +200,7 @@ decodeECPoint mxy = case B.uncons mxy of (xb,yb) = B.splitAt siz xy x = os2ip xb y = os2ip yb - in CryptoPassed $ Simple.Point x y + in Simple.pointFromIntegers (x,y) | otherwise -> CryptoFailed $ CryptoError_PointFormatInvalid curveSizeBytes :: EllipticCurve c => Proxy c -> Int diff --git a/Crypto/ECC/Simple/Prim.hs b/Crypto/ECC/Simple/Prim.hs index cf2f7bd3..872e77eb 100644 --- a/Crypto/ECC/Simple/Prim.hs +++ b/Crypto/ECC/Simple/Prim.hs @@ -10,6 +10,7 @@ module Crypto.ECC.Simple.Prim , pointBaseMul , pointMul , pointAddTwoMuls + , pointFromIntegers , isPointAtInfinity , isPointValid ) where @@ -159,6 +160,15 @@ isPointAtInfinity :: Point curve -> Bool isPointAtInfinity PointO = True isPointAtInfinity _ = False +-- | Make a point on a curve from integer (x,y) coordinate +-- +-- if the point is not valid related to the curve then an error is +-- returned instead of a point +pointFromIntegers :: forall curve . Curve curve => (Integer, Integer) -> CryptoFailable (Point curve) +pointFromIntegers (x,y) + | isPointValid (Proxy :: Proxy curve) x y = CryptoPassed $ Point x y + | otherwise = CryptoFailed $ CryptoError_PointCoordinatesInvalid + -- | check if a point is on specific curve -- -- This perform three checks: @@ -166,9 +176,8 @@ isPointAtInfinity _ = False -- * x is not out of range -- * y is not out of range -- * the equation @y^2 = x^3 + a*x + b (mod p)@ holds -isPointValid :: Curve curve => Point curve -> Bool -isPointValid PointO = True -isPointValid point@(Point x y) = +isPointValid :: Curve curve => proxy curve -> Integer -> Integer -> Bool +isPointValid proxy x y = case ty of CurvePrime (CurvePrimeParam p) -> let a = curveEccA cc @@ -187,8 +196,8 @@ isPointValid point@(Point x y) = , ((((x `add` a) `mul` x `add` y) `mul` x) `add` b `add` (squareF2m fx y)) == 0 ] where - ty = curveType point - cc = curveParameters point + ty = curveType proxy + cc = curveParameters proxy -- | div and mod divmod :: Integer -> Integer -> Integer -> Maybe Integer diff --git a/Crypto/Error/Types.hs b/Crypto/Error/Types.hs index 7363763f..4aaf4e04 100644 --- a/Crypto/Error/Types.hs +++ b/Crypto/Error/Types.hs @@ -39,6 +39,7 @@ data CryptoError = | CryptoError_PointSizeInvalid | CryptoError_PointFormatInvalid | CryptoError_PointFormatUnsupported + | CryptoError_PointCoordinatesInvalid -- Message authentification error | CryptoError_MacKeyInvalid | CryptoError_AuthenticationTagSizeInvalid From 5e52a7ffa2bfc1ca7fb5b17e9e74c7864eecd7e2 Mon Sep 17 00:00:00 2001 From: Vincent Hanquez Date: Fri, 2 Dec 2016 15:28:36 +0000 Subject: [PATCH 32/36] use binary serializer for P256 instead of going through the simple point layer --- Crypto/ECC.hs | 9 ++------- 1 file changed, 2 insertions(+), 7 deletions(-) diff --git a/Crypto/ECC.hs b/Crypto/ECC.hs index adecae87..bccd9464 100644 --- a/Crypto/ECC.hs +++ b/Crypto/ECC.hs @@ -100,13 +100,8 @@ instance EllipticCurve Curve_P256R1 where curveGenerateScalar _ = P256.scalarGenerate curveGenerateKeyPair _ = toKeyPair <$> P256.scalarGenerate where toKeyPair scalar = KeyPair (P256.toPoint scalar) scalar - encodePoint _ p = encodeECPoint (Simple.Point x y :: Simple.Point Simple.SEC_p256r1) - where - (x,y) = P256.pointToIntegers p - decodePoint _ bs = fromSimplePoint <$> decodeECPoint bs - where fromSimplePoint :: Simple.Point Simple.SEC_p256r1 -> P256.Point - fromSimplePoint (Simple.Point x y) = P256.pointFromIntegers (x,y) - fromSimplePoint Simple.PointO = error "impossible happened: fromPoint is infinite" + encodePoint _ p = P256.pointToBinary p + decodePoint _ bs = P256.pointFromBinary bs instance EllipticCurveArith Curve_P256R1 where pointAdd _ a b = P256.pointAdd a b From f627bf437a52483f04a58b1ad75ff308cec9f460 Mon Sep 17 00:00:00 2001 From: Vincent Hanquez Date: Fri, 2 Dec 2016 15:47:51 +0000 Subject: [PATCH 33/36] make a faster and more secure related to memory blits of pointDh for P256 --- Crypto/ECC.hs | 6 +----- Crypto/PubKey/ECC/P256.hs | 14 +++++++++++++- 2 files changed, 14 insertions(+), 6 deletions(-) diff --git a/Crypto/ECC.hs b/Crypto/ECC.hs index bccd9464..e2897dae 100644 --- a/Crypto/ECC.hs +++ b/Crypto/ECC.hs @@ -108,11 +108,7 @@ instance EllipticCurveArith Curve_P256R1 where pointSmul _ s p = P256.pointMul s p instance EllipticCurveDH Curve_P256R1 where - ecdh proxy s p = shared - where - (x, _) = P256.pointToIntegers $ pointSmul proxy s p - len = 32 -- (256 + 7) `div` 8 - shared = SharedSecret $ i2ospOf_ len x + ecdh _ s p = SharedSecret $ P256.pointDh s p data Curve_P384R1 = Curve_P384R1 diff --git a/Crypto/PubKey/ECC/P256.hs b/Crypto/PubKey/ECC/P256.hs index f8fa113b..99ecbccd 100644 --- a/Crypto/PubKey/ECC/P256.hs +++ b/Crypto/PubKey/ECC/P256.hs @@ -18,6 +18,7 @@ module Crypto.PubKey.ECC.P256 , pointBase , pointAdd , pointMul + , pointDh , pointsMulVarTime , pointIsValid , toPoint @@ -48,7 +49,7 @@ import Crypto.Internal.Compat import Crypto.Internal.Imports import Crypto.Internal.ByteArray import qualified Crypto.Internal.ByteArray as B -import Data.Memory.PtrMethods (memSet) +import Data.Memory.PtrMethods (memSet, memCopy) import Crypto.Error import Crypto.Random import Crypto.Number.Serialize.Internal (os2ip, i2ospOf) @@ -112,6 +113,14 @@ pointMul scalar p = withNewPoint $ \dx dy -> withScalar scalar $ \n -> withPoint p $ \px py -> withScalarZero $ \nzero -> ccryptonite_p256_points_mul_vartime nzero n px py dx dy +-- | Similar to 'pointMul', serializing the x coordinate as binary +pointDh :: ByteArray binary => Scalar -> Point -> binary +pointDh scalar p = + B.unsafeCreate scalarSize $ \dst -> withTempPoint $ \dx dy -> do + withScalar scalar $ \n -> withPoint p $ \px py -> withScalarZero $ \nzero -> + ccryptonite_p256_points_mul_vartime nzero n px py dx dy + memCopy dst (castPtr dx) scalarSize + -- | multiply the point @p with @n2 and add a lifted to curve value @n1 -- -- > n1 * G + n2 * p @@ -282,6 +291,9 @@ withNewScalarFreeze :: (Ptr P256Scalar -> IO ()) -> Scalar withNewScalarFreeze f = Scalar $ B.allocAndFreeze scalarSize f {-# NOINLINE withNewScalarFreeze #-} +withTempPoint :: (Ptr P256X -> Ptr P256Y -> IO a) -> IO a +withTempPoint f = allocTempScrubbed scalarSize (\p -> let px = castPtr p in f px (pxToPy px)) + withTempScalar :: (Ptr P256Scalar -> IO a) -> IO a withTempScalar f = allocTempScrubbed scalarSize (f . castPtr) From a9b722b4925e7f296a4ccd18949d09da2727fa95 Mon Sep 17 00:00:00 2001 From: Vincent Hanquez Date: Fri, 2 Dec 2016 15:48:05 +0000 Subject: [PATCH 34/36] Add missing compatibility modules --- Crypto/ECC.hs | 1 + Crypto/ECC/Simple/Prim.hs | 1 + 2 files changed, 2 insertions(+) diff --git a/Crypto/ECC.hs b/Crypto/ECC.hs index e2897dae..77348665 100644 --- a/Crypto/ECC.hs +++ b/Crypto/ECC.hs @@ -27,6 +27,7 @@ import qualified Crypto.ECC.Simple.Types as Simple import qualified Crypto.ECC.Simple.Prim as Simple import Crypto.Random import Crypto.Error +import Crypto.Internal.Compat import Crypto.Internal.Proxy import Crypto.Internal.Imports import Crypto.Internal.ByteArray (ByteArray, ByteArrayAccess, ScrubbedBytes) diff --git a/Crypto/ECC/Simple/Prim.hs b/Crypto/ECC/Simple/Prim.hs index 872e77eb..21e492fb 100644 --- a/Crypto/ECC/Simple/Prim.hs +++ b/Crypto/ECC/Simple/Prim.hs @@ -17,6 +17,7 @@ module Crypto.ECC.Simple.Prim import Data.Maybe import Data.Proxy +import Crypto.Internal.Compat import Crypto.Number.ModArithmetic import Crypto.Number.F2m import Crypto.Number.Generate (generateBetween) From 6e1d18f6c2337cf5b00e8aa5d93a0ef6eac159c9 Mon Sep 17 00:00:00 2001 From: Vincent Hanquez Date: Fri, 2 Dec 2016 16:29:49 +0000 Subject: [PATCH 35/36] use the correct compat imports --- Crypto/ECC.hs | 1 - Crypto/ECC/Simple/Prim.hs | 2 +- 2 files changed, 1 insertion(+), 2 deletions(-) diff --git a/Crypto/ECC.hs b/Crypto/ECC.hs index 77348665..e2897dae 100644 --- a/Crypto/ECC.hs +++ b/Crypto/ECC.hs @@ -27,7 +27,6 @@ import qualified Crypto.ECC.Simple.Types as Simple import qualified Crypto.ECC.Simple.Prim as Simple import Crypto.Random import Crypto.Error -import Crypto.Internal.Compat import Crypto.Internal.Proxy import Crypto.Internal.Imports import Crypto.Internal.ByteArray (ByteArray, ByteArrayAccess, ScrubbedBytes) diff --git a/Crypto/ECC/Simple/Prim.hs b/Crypto/ECC/Simple/Prim.hs index 21e492fb..e11bd2fb 100644 --- a/Crypto/ECC/Simple/Prim.hs +++ b/Crypto/ECC/Simple/Prim.hs @@ -17,7 +17,7 @@ module Crypto.ECC.Simple.Prim import Data.Maybe import Data.Proxy -import Crypto.Internal.Compat +import Crypto.Internal.Imports import Crypto.Number.ModArithmetic import Crypto.Number.F2m import Crypto.Number.Generate (generateBetween) From 07bfa10ad78ccd723955c919c5edd9b67eac381d Mon Sep 17 00:00:00 2001 From: Vincent Hanquez Date: Fri, 2 Dec 2016 21:07:13 +0000 Subject: [PATCH 36/36] fix proxy --- Crypto/ECC/Simple/Prim.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Crypto/ECC/Simple/Prim.hs b/Crypto/ECC/Simple/Prim.hs index e11bd2fb..4a36b054 100644 --- a/Crypto/ECC/Simple/Prim.hs +++ b/Crypto/ECC/Simple/Prim.hs @@ -16,8 +16,8 @@ module Crypto.ECC.Simple.Prim ) where import Data.Maybe -import Data.Proxy import Crypto.Internal.Imports +import Crypto.Internal.Proxy import Crypto.Number.ModArithmetic import Crypto.Number.F2m import Crypto.Number.Generate (generateBetween)