Extending ECC and ECIES

Crypto/ECC.hs

@@ -0,0 +1,236 @@
+-- |
+-- Module      : Crypto.ECC
+-- License     : BSD-style
+-- Maintainer  : Vincent Hanquez <[email protected]>
+-- Stability   : experimental
+-- Portability : unknown
+--
+-- Elliptic Curve Cryptography
+--
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE TypeFamilies #-}
+module Crypto.ECC
+    ( Curve_P256R1(..)
+    , Curve_P384R1(..)
+    , Curve_P521R1(..)
+    , Curve_X25519(..)
+    , 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.Imports
+import           Crypto.Internal.ByteArray (ByteArrayAccess, ScrubbedBytes)
+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.
+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)
+
+    encodePoint :: Point curve -> ByteString
+    decodePoint :: ByteString -> Point 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.
+    --
+    -- 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
+    -- | Add points on a curve
+    pointAdd :: Point curve -> Point curve -> Point curve
+
+    -- | 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
+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
+      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
+    pointSmul s p = P256Point $ P256.pointMul (unP256Scalar s) (unP256Point p)
+
+instance EllipticCurveDH Curve_P256R1 where
+    ecdh s p = shared
+      where
+        (x, _) = P256.pointToIntegers $ unP256Point $ pointSmul 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 $ 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
+    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 = 48 -- (384 + 7) `div` 8
+        shared = SharedSecret $ i2ospOf_ len x
+
+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 $ 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
+    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 = 66 -- (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 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
+        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
+    pointSmul = undefined
+
+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

Crypto/KDF/HKDF.hs

@@ -15,18 +15,32 @@ module Crypto.KDF.HKDF
     , extract
     , extractSkip
     , expand
+    , toByteString
+    , fromByteString
     ) where
 
 import           Data.Word
 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

Crypto/PubKey/Curve25519.hs

@@ -9,6 +9,7 @@
 --
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE MagicHash #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 module Crypto.PubKey.Curve25519
     ( SecretKey
     , PublicKey
@@ -17,20 +18,28 @@ module Crypto.PubKey.Curve25519
     , dhSecret
     , publicKey
     , secretKey
+    , toPublicKey
+    , fromPublicKey
     -- * 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
 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 +119,22 @@ 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
+
+toPublicKey :: ByteString -> PublicKey
+toPublicKey bs = pub
+  where
+    CryptoPassed pub = publicKey bs
+
+fromPublicKey :: PublicKey -> ByteString
+fromPublicKey (PublicKey b) = B.convert 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

Crypto/PubKey/ECIES.hs

@@ -0,0 +1,33 @@
+-- |
+-- Module      : Crypto.PubKey.ECIES
+-- License     : BSD-style
+-- Maintainer  : Vincent Hanquez <[email protected]>
+-- Stability   : experimental
+-- Portability : unknown
+--
+-- IES with Elliptic curve <https://en.wikipedia.org/wiki/Integrated_Encryption_Scheme>
+--
+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

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