From b1e222cf3dd26bb2d7bd228268fddb5339db45b3 Mon Sep 17 00:00:00 2001 From: Vincent Hanquez Date: Mon, 30 Mar 2015 10:32:28 +0100 Subject: [PATCH] merge crypto-pubkey-types and crypto-pubkey adapt CPRG to MonadRandom --- Crypto/PubKey/DH.hs | 74 +++++ Crypto/PubKey/DSA.hs | 130 +++++++++ Crypto/PubKey/ECC/DH.hs | 36 +++ Crypto/PubKey/ECC/ECDSA.hs | 119 ++++++++ Crypto/PubKey/ECC/Generate.hs | 30 ++ Crypto/PubKey/ECC/Prim.hs | 124 ++++++++ Crypto/PubKey/ECC/Types.hs | 485 +++++++++++++++++++++++++++++++ Crypto/PubKey/ElGamal.hs | 143 +++++++++ Crypto/PubKey/HashDescr.hs | 102 +++++++ Crypto/PubKey/Internal.hs | 24 ++ Crypto/PubKey/MaskGenFunction.hs | 31 ++ Crypto/PubKey/RSA.hs | 161 ++++++++++ Crypto/PubKey/RSA/OAEP.hs | 151 ++++++++++ Crypto/PubKey/RSA/PKCS15.hs | 144 +++++++++ Crypto/PubKey/RSA/PSS.hs | 135 +++++++++ Crypto/PubKey/RSA/Prim.hs | 61 ++++ Crypto/PubKey/RSA/Types.hs | 26 ++ cryptonite.cabal | 13 + 18 files changed, 1989 insertions(+) create mode 100644 Crypto/PubKey/DH.hs create mode 100644 Crypto/PubKey/DSA.hs create mode 100644 Crypto/PubKey/ECC/DH.hs create mode 100644 Crypto/PubKey/ECC/ECDSA.hs create mode 100644 Crypto/PubKey/ECC/Generate.hs create mode 100644 Crypto/PubKey/ECC/Prim.hs create mode 100644 Crypto/PubKey/ECC/Types.hs create mode 100644 Crypto/PubKey/ElGamal.hs create mode 100644 Crypto/PubKey/HashDescr.hs create mode 100644 Crypto/PubKey/Internal.hs create mode 100644 Crypto/PubKey/MaskGenFunction.hs create mode 100644 Crypto/PubKey/RSA.hs create mode 100644 Crypto/PubKey/RSA/OAEP.hs create mode 100644 Crypto/PubKey/RSA/PKCS15.hs create mode 100644 Crypto/PubKey/RSA/PSS.hs create mode 100644 Crypto/PubKey/RSA/Prim.hs create mode 100644 Crypto/PubKey/RSA/Types.hs diff --git a/Crypto/PubKey/DH.hs b/Crypto/PubKey/DH.hs new file mode 100644 index 0000000..9008641 --- /dev/null +++ b/Crypto/PubKey/DH.hs @@ -0,0 +1,74 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + +-- | +-- Module : Crypto.PubKey.DH +-- License : BSD-style +-- Maintainer : Vincent Hanquez +-- Stability : experimental +-- Portability : Good +-- +{-# LANGUAGE DeriveDataTypeable #-} +module Crypto.PubKey.DH + ( Params(..) + , PublicNumber(..) + , PrivateNumber(..) + , SharedKey(..) + , generateParams + , generatePrivate + , calculatePublic + , generatePublic + , getShared + ) where + +import Control.Applicative +import Crypto.Number.ModArithmetic (expSafe) +import Crypto.Number.Prime (generateSafePrime) +import Crypto.Number.Generate (generateMax) +import Crypto.Random.Types +import Data.Data + +-- | Represent Diffie Hellman parameters namely P (prime), and G (generator). +data Params = Params + { params_p :: Integer + , params_g :: Integer + } deriving (Show,Read,Eq,Data,Typeable) + +-- | Represent Diffie Hellman public number Y. +newtype PublicNumber = PublicNumber Integer + deriving (Show,Read,Eq,Enum,Real,Num,Ord) + +-- | Represent Diffie Hellman private number X. +newtype PrivateNumber = PrivateNumber Integer + deriving (Show,Read,Eq,Enum,Real,Num,Ord) + +-- | Represent Diffie Hellman shared secret. +newtype SharedKey = SharedKey Integer + deriving (Show,Read,Eq,Enum,Real,Num,Ord) + +-- | generate params from a specific generator (2 or 5 are common values) +-- we generate a safe prime (a prime number of the form 2p+1 where p is also prime) +generateParams :: MonadRandom m => Int -> Integer -> m Params +generateParams bits generator = + (\p -> Params p generator) <$> generateSafePrime bits + +-- | generate a private number with no specific property +-- this number is usually called X in DH text. +generatePrivate :: MonadRandom m => Params -> m PrivateNumber +generatePrivate (Params p _) = PrivateNumber <$> generateMax p + +-- | calculate the public number from the parameters and the private key +-- this number is usually called Y in DH text. +calculatePublic :: Params -> PrivateNumber -> PublicNumber +calculatePublic (Params p g) (PrivateNumber x) = PublicNumber $ expSafe g x p + +-- | calculate the public number from the parameters and the private key +-- this number is usually called Y in DH text. +-- +-- DEPRECATED use calculatePublic +generatePublic :: Params -> PrivateNumber -> PublicNumber +generatePublic = calculatePublic +-- commented until 0.3 {-# DEPRECATED generatePublic "use calculatePublic" #-} + +-- | generate a shared key using our private number and the other party public number +getShared :: Params -> PrivateNumber -> PublicNumber -> SharedKey +getShared (Params p _) (PrivateNumber x) (PublicNumber y) = SharedKey $ expSafe y x p diff --git a/Crypto/PubKey/DSA.hs b/Crypto/PubKey/DSA.hs new file mode 100644 index 0000000..afa15ca --- /dev/null +++ b/Crypto/PubKey/DSA.hs @@ -0,0 +1,130 @@ +-- | +-- Module : Crypto.PubKey.DSA +-- License : BSD-style +-- Maintainer : Vincent Hanquez +-- Stability : experimental +-- Portability : Good +-- +-- An implementation of the Digital Signature Algorithm (DSA) +{-# LANGUAGE DeriveDataTypeable #-} +module Crypto.PubKey.DSA + ( Params(..) + , Signature(..) + , PublicKey(..) + , PrivateKey(..) + -- * generation + , generatePrivate + , calculatePublic + -- * signature primitive + , sign + , signWith + -- * verification primitive + , verify + ) where + +import Crypto.Random.Types +import Data.Data +import Data.Maybe +import Data.ByteString (ByteString) +import Crypto.Number.ModArithmetic (expFast, expSafe, inverse) +import Crypto.Number.Serialize +import Crypto.Number.Generate +import Crypto.PubKey.HashDescr + +-- | DSA Public Number, usually embedded in DSA Public Key +type PublicNumber = Integer + +-- | DSA Private Number, usually embedded in DSA Private Key +type PrivateNumber = Integer + +-- | Represent DSA parameters namely P, G, and Q. +data Params = Params + { params_p :: Integer -- ^ DSA p + , params_g :: Integer -- ^ DSA g + , params_q :: Integer -- ^ DSA q + } deriving (Show,Read,Eq,Data,Typeable) + +-- | Represent a DSA signature namely R and S. +data Signature = Signature + { sign_r :: Integer -- ^ DSA r + , sign_s :: Integer -- ^ DSA s + } deriving (Show,Read,Eq,Data,Typeable) + +-- | Represent a DSA public key. +data PublicKey = PublicKey + { public_params :: Params -- ^ DSA parameters + , public_y :: PublicNumber -- ^ DSA public Y + } deriving (Show,Read,Eq,Data,Typeable) + +-- | Represent a DSA private key. +-- +-- Only x need to be secret. +-- the DSA parameters are publicly shared with the other side. +data PrivateKey = PrivateKey + { private_params :: Params -- ^ DSA parameters + , private_x :: PrivateNumber -- ^ DSA private X + } deriving (Show,Read,Eq,Data,Typeable) + +-- | Represent a DSA key pair +data KeyPair = KeyPair Params PublicNumber PrivateNumber + deriving (Show,Read,Eq,Data,Typeable) + +-- | Public key of a DSA Key pair +toPublicKey :: KeyPair -> PublicKey +toPublicKey (KeyPair params pub _) = PublicKey params pub + +-- | Private key of a DSA Key pair +toPrivateKey :: KeyPair -> PrivateKey +toPrivateKey (KeyPair params _ priv) = PrivateKey params priv + +-- | generate a private number with no specific property +-- this number is usually called X in DSA text. +generatePrivate :: MonadRandom m => Params -> m PrivateNumber +generatePrivate (Params _ _ q) = generateMax q + +-- | Calculate the public number from the parameters and the private key +calculatePublic :: Params -> PrivateNumber -> PublicNumber +calculatePublic (Params p g _) x = expSafe g x p + +-- | sign message using the private key and an explicit k number. +signWith :: Integer -- ^ k random number + -> PrivateKey -- ^ private key + -> HashFunction -- ^ hash function + -> ByteString -- ^ message to sign + -> Maybe Signature +signWith k pk hash msg + | r == 0 || s == 0 = Nothing + | otherwise = Just $ Signature r s + where -- parameters + (Params p g q) = private_params pk + x = private_x pk + -- compute r,s + kInv = fromJust $ inverse k q + hm = os2ip $ hash msg + r = expSafe g k p `mod` q + s = (kInv * (hm + x * r)) `mod` q + +-- | sign message using the private key. +sign :: MonadRandom m => PrivateKey -> HashFunction -> ByteString -> m Signature +sign pk hash msg = do + k <- generateMax q + case signWith k pk hash msg of + Nothing -> sign pk hash msg + Just sig -> return sig + where + (Params _ _ q) = private_params pk + +-- | verify a bytestring using the public key. +verify :: HashFunction -> PublicKey -> Signature -> ByteString -> Bool +verify hash pk (Signature r s) m + -- Reject the signature if either 0 < r < q or 0 < s < q is not satisfied. + | r <= 0 || r >= q || s <= 0 || s >= q = False + | otherwise = v == r + where (Params p g q) = public_params pk + y = public_y pk + hm = os2ip $ hash m + + w = fromJust $ inverse s q + u1 = (hm*w) `mod` q + u2 = (r*w) `mod` q + v = ((expFast g u1 p) * (expFast y u2 p)) `mod` p `mod` q diff --git a/Crypto/PubKey/ECC/DH.hs b/Crypto/PubKey/ECC/DH.hs new file mode 100644 index 0000000..c2b7fd4 --- /dev/null +++ b/Crypto/PubKey/ECC/DH.hs @@ -0,0 +1,36 @@ +module Crypto.PubKey.ECC.DH ( + Curve + , PublicPoint + , PrivateNumber + , SharedKey(..) + , generatePrivate + , calculatePublic + , getShared + ) where + +import Crypto.Number.Generate (generateMax) +import Crypto.PubKey.ECC.Prim (pointMul) +import Crypto.Random.Types +import Crypto.PubKey.DH (SharedKey(..)) +import Crypto.PubKey.ECC.Types (PublicPoint, PrivateNumber, Curve, Point(..)) +import Crypto.PubKey.ECC.Types (ecc_n, ecc_g, common_curve) + +-- | Generating a private number d. +generatePrivate :: MonadRandom m => Curve -> m PrivateNumber +generatePrivate curve = generateMax n + where + n = ecc_n $ common_curve curve + +-- | Generating a public point Q. +calculatePublic :: Curve -> PrivateNumber -> PublicPoint +calculatePublic curve d = q + where + g = ecc_g $ common_curve curve + q = pointMul curve d g + +-- | Generating a shared key using our private number and +-- the other party public point. +getShared :: Curve -> PrivateNumber -> PublicPoint -> SharedKey +getShared curve db qa = SharedKey x + where + Point x _ = pointMul curve db qa diff --git a/Crypto/PubKey/ECC/ECDSA.hs b/Crypto/PubKey/ECC/ECDSA.hs new file mode 100644 index 0000000..ccee525 --- /dev/null +++ b/Crypto/PubKey/ECC/ECDSA.hs @@ -0,0 +1,119 @@ +-- | /WARNING:/ Signature operations may leak the private key. Signature verification +-- should be safe. +{-# LANGUAGE DeriveDataTypeable #-} +module Crypto.PubKey.ECC.ECDSA + ( Signature(..) + , PublicPoint + , PublicKey(..) + , PrivateNumber + , PrivateKey(..) + , KeyPair(..) + , toPublicKey + , toPrivateKey + , signWith + , sign + , verify + ) where + +import Control.Monad +import Crypto.Random.Types +import Data.Bits (shiftR) +import Data.ByteString (ByteString) +import Data.Data +import Crypto.Number.ModArithmetic (inverse) +import Crypto.Number.Serialize +import Crypto.Number.Generate +import Crypto.PubKey.ECC.Types +import Crypto.PubKey.HashDescr +import Crypto.PubKey.ECC.Prim + +-- | Represent a ECDSA signature namely R and S. +data Signature = Signature + { sign_r :: Integer -- ^ ECDSA r + , sign_s :: Integer -- ^ ECDSA s + } deriving (Show,Read,Eq,Data,Typeable) + +-- | ECDSA Private Key. +data PrivateKey = PrivateKey + { private_curve :: Curve + , private_d :: PrivateNumber + } deriving (Show,Read,Eq,Data,Typeable) + +-- | ECDSA Public Key. +data PublicKey = PublicKey + { public_curve :: Curve + , public_q :: PublicPoint + } deriving (Show,Read,Eq,Data,Typeable) + +-- | ECDSA Key Pair. +data KeyPair = KeyPair Curve PublicPoint PrivateNumber + deriving (Show,Read,Eq,Data,Typeable) + +-- | Public key of a ECDSA Key pair. +toPublicKey :: KeyPair -> PublicKey +toPublicKey (KeyPair curve pub _) = PublicKey curve pub + +-- | Private key of a ECDSA Key pair. +toPrivateKey :: KeyPair -> PrivateKey +toPrivateKey (KeyPair curve _ priv) = PrivateKey curve priv + +-- | Sign message using the private key and an explicit k number. +-- +-- /WARNING:/ Vulnerable to timing attacks. +signWith :: Integer -- ^ k random number + -> PrivateKey -- ^ private key + -> HashFunction -- ^ hash function + -> ByteString -- ^ message to sign + -> Maybe Signature +signWith k (PrivateKey curve d) hash msg = do + let z = tHash hash msg n + CurveCommon _ _ g n _ = common_curve curve + let point = pointMul curve k g + r <- case point of + PointO -> Nothing + Point x _ -> return $ x `mod` n + kInv <- inverse k n + let s = kInv * (z + r * d) `mod` n + when (r == 0 || s == 0) Nothing + return $ Signature r s + +-- | Sign message using the private key. +-- +-- /WARNING:/ Vulnerable to timing attacks. +sign :: MonadRandom m => PrivateKey -> HashFunction -> ByteString -> m Signature +sign pk hash msg = do + k <- generateBetween 1 (n - 1) + case signWith k pk hash msg of + Nothing -> sign pk hash msg + Just sig -> return sig + where n = ecc_n . common_curve $ private_curve pk + +-- | Verify a bytestring using the public key. +verify :: HashFunction -> PublicKey -> Signature -> ByteString -> Bool +verify _ (PublicKey _ PointO) _ _ = False +verify hash pk@(PublicKey curve q) (Signature r s) msg + | r < 1 || r >= n || s < 1 || s >= n = False + | otherwise = maybe False (r ==) $ do + w <- inverse s n + let z = tHash hash msg n + u1 = z * w `mod` n + u2 = r * w `mod` n + -- TODO: Use Shamir's trick + g' = pointMul curve u1 g + q' = pointMul curve u2 q + x = pointAdd curve g' q' + case x of + PointO -> Nothing + Point x1 _ -> return $ x1 `mod` n + where n = ecc_n cc + g = ecc_g cc + cc = common_curve $ public_curve pk + +-- | Truncate and hash. +tHash :: HashFunction -> ByteString -> Integer -> Integer +tHash hash m n + | d > 0 = shiftR e d + | otherwise = e + where e = os2ip $ hash m + d = log2 e - log2 n + log2 = ceiling . logBase (2 :: Double) . fromIntegral diff --git a/Crypto/PubKey/ECC/Generate.hs b/Crypto/PubKey/ECC/Generate.hs new file mode 100644 index 0000000..c763d8b --- /dev/null +++ b/Crypto/PubKey/ECC/Generate.hs @@ -0,0 +1,30 @@ +-- | Signature generation. +module Crypto.PubKey.ECC.Generate where + +import Crypto.Random.Types +import Crypto.PubKey.ECC.Types +import Crypto.PubKey.ECC.ECDSA +import Crypto.Number.Generate +import Crypto.PubKey.ECC.Prim + +-- | Generate Q given d. +-- +-- /WARNING:/ Vulnerable to timing attacks. +generateQ :: Curve + -> Integer + -> Point +generateQ curve d = pointMul curve d g + where g = ecc_g $ common_curve curve + +-- | Generate a pair of (private, public) key. +-- +-- /WARNING:/ Vulnerable to timing attacks. +generate :: MonadRandom m + => Curve -- ^ Elliptic Curve + -> m (PublicKey, PrivateKey) +generate curve = do + d <- generateBetween 1 (n - 1) + let q = generateQ curve d + return (PublicKey curve q, PrivateKey curve d) + where + n = ecc_n $ common_curve curve diff --git a/Crypto/PubKey/ECC/Prim.hs b/Crypto/PubKey/ECC/Prim.hs new file mode 100644 index 0000000..ec47bd1 --- /dev/null +++ b/Crypto/PubKey/ECC/Prim.hs @@ -0,0 +1,124 @@ +-- | Elliptic Curve Arithmetic. +-- +-- /WARNING:/ These functions are vulnerable to timing attacks. +module Crypto.PubKey.ECC.Prim + ( pointAdd + , pointDouble + , pointMul + , isPointAtInfinity + , isPointValid + ) where + +import Data.Maybe +import Crypto.Number.ModArithmetic +import Crypto.Number.F2m +import Crypto.PubKey.ECC.Types + +--TODO: Extract helper function for `fromMaybe PointO...` + +-- | Elliptic Curve point addition. +-- +-- /WARNING:/ Vulnerable to timing attacks. +pointAdd :: Curve -> Point -> Point -> Point +pointAdd _ PointO PointO = PointO +pointAdd _ PointO q = q +pointAdd _ p PointO = p +pointAdd c@(CurveFP (CurvePrime pr _)) p@(Point xp yp) q@(Point xq yq) + | p == Point xq (-yq) = PointO + | p == q = pointDouble c p + | otherwise = 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 +pointAdd c@(CurveF2m (CurveBinary fx cc)) p@(Point xp yp) q@(Point xq yq) + | p == Point xq (xq `addF2m` yq) = PointO + | p == q = pointDouble c p + | otherwise = 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 a = ecc_a 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 -> Point -> Point +pointDouble _ PointO = PointO +pointDouble (CurveFP (CurvePrime pr cc)) (Point xp yp) = 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 + where a = ecc_a cc +pointDouble (CurveF2m (CurveBinary fx cc)) (Point xp yp) + | 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 a = ecc_a cc + +-- | Elliptic curve point multiplication (double and add algorithm). +-- +-- /WARNING:/ Vulnerable to timing attacks. +pointMul :: Curve -> Integer -> Point -> Point +pointMul _ _ PointO = PointO +pointMul c n p@(Point xp yp) + | n < 0 = pointMul c (-n) (Point xp (-yp)) + | n == 0 = PointO + | n == 1 = p + | odd n = pointAdd c p (pointMul c (n - 1) p) + | otherwise = pointMul c (n `div` 2) (pointDouble c p) + +-- | Check if a point is the point at infinity. +isPointAtInfinity :: Point -> 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 -> Point -> Bool +isPointValid _ PointO = True +isPointValid (CurveFP (CurvePrime p cc)) (Point x y) = + isValid x && isValid y && (y ^ (2 :: Int)) `eqModP` (x ^ (3 :: Int) + a * x + b) + where a = ecc_a cc + b = ecc_b cc + eqModP z1 z2 = (z1 `mod` p) == (z2 `mod` p) + isValid e = e >= 0 && e < p +isPointValid curve@(CurveF2m (CurveBinary fx cc)) pt@(Point x y) = + and [ isValid x + , isValid y + , ((((x `add` a) `mul` x `add` y) `mul` x) `add` b `add` (squareF2m fx y)) == 0 + ] + where a = ecc_a cc + b = ecc_b cc + add = addF2m + mul = mulF2m fx + isValid e = modF2m fx e == e + +-- | 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/PubKey/ECC/Types.hs b/Crypto/PubKey/ECC/Types.hs new file mode 100644 index 0000000..16cc996 --- /dev/null +++ b/Crypto/PubKey/ECC/Types.hs @@ -0,0 +1,485 @@ +{-# LANGUAGE DeriveDataTypeable #-} +-- | +-- Module : Crypto.PubKey.ECC.types +-- License : BSD-style +-- Maintainer : Vincent Hanquez +-- Stability : Experimental +-- Portability : Excellent +-- +-- references: +-- +-- +module Crypto.PubKey.ECC.Types + ( Curve(..) + , Point(..) + , PublicPoint + , PrivateNumber + , CurveBinary(..) + , CurvePrime(..) + , common_curve + , ecc_fx + , ecc_p + , CurveCommon(..) + -- * recommended curves definition + , CurveName(..) + , getCurveByName + ) where + +import Data.Data +import Data.Tuple (swap) + +-- | Define either a binary curve or a prime curve. +data Curve = CurveF2m CurveBinary -- ^ 𝔽(2^m) + | CurveFP CurvePrime -- ^ 𝔽p + deriving (Show,Read,Eq,Data,Typeable) + +-- | ECC Public Point +type PublicPoint = Point + +-- | ECC Private Number +type PrivateNumber = Integer + +-- | Define a point on a curve. +data Point = Point Integer Integer + | PointO -- ^ Point at Infinity + deriving (Show,Read,Eq,Data,Typeable) + +-- | Define an elliptic curve in 𝔽(2^m). +-- The firt parameter is the Integer representatioin of the irreducible polynomial f(x). +data CurveBinary = CurveBinary Integer CurveCommon + deriving (Show,Read,Eq,Data,Typeable) + +-- | Define an elliptic curve in 𝔽p. +-- The first parameter is the Prime Number. +data CurvePrime = CurvePrime Integer CurveCommon + deriving (Show,Read,Eq,Data,Typeable) + +-- | Parameters in common between binary and prime curves. +common_curve :: Curve -> CurveCommon +common_curve (CurveF2m (CurveBinary _ cc)) = cc +common_curve (CurveFP (CurvePrime _ cc)) = cc + +-- | Irreducible polynomial representing the characteristic of a CurveBinary. +ecc_fx :: CurveBinary -> Integer +ecc_fx (CurveBinary fx _) = fx + +-- | Prime number representing the characteristic of a CurvePrime. +ecc_p :: CurvePrime -> Integer +ecc_p (CurvePrime p _) = p + +-- | Define common parameters in a curve definition +-- of the form: y^2 = x^3 + ax + b. +data CurveCommon = CurveCommon + { ecc_a :: Integer -- ^ curve parameter a + , ecc_b :: Integer -- ^ curve parameter b + , ecc_g :: Point -- ^ base point + , ecc_n :: Integer -- ^ order of G + , ecc_h :: Integer -- ^ cofactor + } deriving (Show,Read,Eq,Data,Typeable) + +-- | Define names for known recommended curves. +data CurveName = + 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 + deriving (Show,Read,Eq,Ord,Enum,Data,Typeable) + +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]) + ] + +-- | Get the curve definition associated with a recommended known curve name. +getCurveByName :: CurveName -> Curve +getCurveByName SEC_p112r1 = CurveFP $ CurvePrime + 0xdb7c2abf62e35e668076bead208b + (CurveCommon + { ecc_a = 0xdb7c2abf62e35e668076bead2088 + , ecc_b = 0x659ef8ba043916eede8911702b22 + , ecc_g = Point 0x09487239995a5ee76b55f9c2f098 + 0xa89ce5af8724c0a23e0e0ff77500 + , ecc_n = 0xdb7c2abf62e35e7628dfac6561c5 + , ecc_h = 1 + }) +getCurveByName SEC_p112r2 = CurveFP $ CurvePrime + 0xdb7c2abf62e35e668076bead208b + (CurveCommon + { ecc_a = 0x6127c24c05f38a0aaaf65c0ef02c + , ecc_b = 0x51def1815db5ed74fcc34c85d709 + , ecc_g = Point 0x4ba30ab5e892b4e1649dd0928643 + 0xadcd46f5882e3747def36e956e97 + , ecc_n = 0x36df0aafd8b8d7597ca10520d04b + , ecc_h = 4 + }) +getCurveByName SEC_p128r1 = CurveFP $ CurvePrime + 0xfffffffdffffffffffffffffffffffff + (CurveCommon + { ecc_a = 0xfffffffdfffffffffffffffffffffffc + , ecc_b = 0xe87579c11079f43dd824993c2cee5ed3 + , ecc_g = Point 0x161ff7528b899b2d0c28607ca52c5b86 + 0xcf5ac8395bafeb13c02da292dded7a83 + , ecc_n = 0xfffffffe0000000075a30d1b9038a115 + , ecc_h = 1 + }) +getCurveByName SEC_p128r2 = CurveFP $ CurvePrime + 0xfffffffdffffffffffffffffffffffff + (CurveCommon + { ecc_a = 0xd6031998d1b3bbfebf59cc9bbff9aee1 + , ecc_b = 0x5eeefca380d02919dc2c6558bb6d8a5d + , ecc_g = Point 0x7b6aa5d85e572983e6fb32a7cdebc140 + 0x27b6916a894d3aee7106fe805fc34b44 + , ecc_n = 0x3fffffff7fffffffbe0024720613b5a3 + , ecc_h = 4 + }) +getCurveByName SEC_p160k1 = CurveFP $ CurvePrime + 0x00fffffffffffffffffffffffffffffffeffffac73 + (CurveCommon + { ecc_a = 0x000000000000000000000000000000000000000000 + , ecc_b = 0x000000000000000000000000000000000000000007 + , ecc_g = Point 0x003b4c382ce37aa192a4019e763036f4f5dd4d7ebb + 0x00938cf935318fdced6bc28286531733c3f03c4fee + , ecc_n = 0x0100000000000000000001b8fa16dfab9aca16b6b3 + , ecc_h = 1 + }) +getCurveByName SEC_p160r1 = CurveFP $ CurvePrime + 0x00ffffffffffffffffffffffffffffffff7fffffff + (CurveCommon + { ecc_a = 0x00ffffffffffffffffffffffffffffffff7ffffffc + , ecc_b = 0x001c97befc54bd7a8b65acf89f81d4d4adc565fa45 + , ecc_g = Point 0x004a96b5688ef573284664698968c38bb913cbfc82 + 0x0023a628553168947d59dcc912042351377ac5fb32 + , ecc_n = 0x0100000000000000000001f4c8f927aed3ca752257 + , ecc_h = 1 + }) +getCurveByName SEC_p160r2 = CurveFP $ CurvePrime + 0x00fffffffffffffffffffffffffffffffeffffac73 + (CurveCommon + { ecc_a = 0x00fffffffffffffffffffffffffffffffeffffac70 + , ecc_b = 0x00b4e134d3fb59eb8bab57274904664d5af50388ba + , ecc_g = Point 0x0052dcb034293a117e1f4ff11b30f7199d3144ce6d + 0x00feaffef2e331f296e071fa0df9982cfea7d43f2e + , ecc_n = 0x0100000000000000000000351ee786a818f3a1a16b + , ecc_h = 1 + }) +getCurveByName SEC_p192k1 = CurveFP $ CurvePrime + 0xfffffffffffffffffffffffffffffffffffffffeffffee37 + (CurveCommon + { ecc_a = 0x000000000000000000000000000000000000000000000000 + , ecc_b = 0x000000000000000000000000000000000000000000000003 + , ecc_g = Point 0xdb4ff10ec057e9ae26b07d0280b7f4341da5d1b1eae06c7d + 0x9b2f2f6d9c5628a7844163d015be86344082aa88d95e2f9d + , ecc_n = 0xfffffffffffffffffffffffe26f2fc170f69466a74defd8d + , ecc_h = 1 + }) +getCurveByName SEC_p192r1 = CurveFP $ CurvePrime + 0xfffffffffffffffffffffffffffffffeffffffffffffffff + (CurveCommon + { ecc_a = 0xfffffffffffffffffffffffffffffffefffffffffffffffc + , ecc_b = 0x64210519e59c80e70fa7e9ab72243049feb8deecc146b9b1 + , ecc_g = Point 0x188da80eb03090f67cbf20eb43a18800f4ff0afd82ff1012 + 0x07192b95ffc8da78631011ed6b24cdd573f977a11e794811 + , ecc_n = 0xffffffffffffffffffffffff99def836146bc9b1b4d22831 + , ecc_h = 1 + }) +getCurveByName SEC_p224k1 = CurveFP $ CurvePrime + 0x00fffffffffffffffffffffffffffffffffffffffffffffffeffffe56d + (CurveCommon + { ecc_a = 0x0000000000000000000000000000000000000000000000000000000000 + , ecc_b = 0x0000000000000000000000000000000000000000000000000000000005 + , ecc_g = Point 0x00a1455b334df099df30fc28a169a467e9e47075a90f7e650eb6b7a45c + 0x007e089fed7fba344282cafbd6f7e319f7c0b0bd59e2ca4bdb556d61a5 + , ecc_n = 0x010000000000000000000000000001dce8d2ec6184caf0a971769fb1f7 + , ecc_h = 1 + }) +getCurveByName SEC_p224r1 = CurveFP $ CurvePrime + 0xffffffffffffffffffffffffffffffff000000000000000000000001 + (CurveCommon + { ecc_a = 0xfffffffffffffffffffffffffffffffefffffffffffffffffffffffe + , ecc_b = 0xb4050a850c04b3abf54132565044b0b7d7bfd8ba270b39432355ffb4 + , ecc_g = Point 0xb70e0cbd6bb4bf7f321390b94a03c1d356c21122343280d6115c1d21 + 0xbd376388b5f723fb4c22dfe6cd4375a05a07476444d5819985007e34 + , ecc_n = 0xffffffffffffffffffffffffffff16a2e0b8f03e13dd29455c5c2a3d + , ecc_h = 1 + }) +getCurveByName SEC_p256k1 = CurveFP $ CurvePrime + 0xfffffffffffffffffffffffffffffffffffffffffffffffffffffffefffffc2f + (CurveCommon + { ecc_a = 0x0000000000000000000000000000000000000000000000000000000000000000 + , ecc_b = 0x0000000000000000000000000000000000000000000000000000000000000007 + , ecc_g = Point 0x79be667ef9dcbbac55a06295ce870b07029bfcdb2dce28d959f2815b16f81798 + 0x483ada7726a3c4655da4fbfc0e1108a8fd17b448a68554199c47d08ffb10d4b8 + , ecc_n = 0xfffffffffffffffffffffffffffffffebaaedce6af48a03bbfd25e8cd0364141 + , ecc_h = 1 + }) +getCurveByName SEC_p256r1 = CurveFP $ CurvePrime + 0xffffffff00000001000000000000000000000000ffffffffffffffffffffffff + (CurveCommon + { ecc_a = 0xffffffff00000001000000000000000000000000fffffffffffffffffffffffc + , ecc_b = 0x5ac635d8aa3a93e7b3ebbd55769886bc651d06b0cc53b0f63bce3c3e27d2604b + , ecc_g = Point 0x6b17d1f2e12c4247f8bce6e563a440f277037d812deb33a0f4a13945d898c296 + 0x4fe342e2fe1a7f9b8ee7eb4a7c0f9e162bce33576b315ececbb6406837bf51f5 + , ecc_n = 0xffffffff00000000ffffffffffffffffbce6faada7179e84f3b9cac2fc632551 + , ecc_h = 1 + }) +getCurveByName SEC_p384r1 = CurveFP $ CurvePrime + 0xfffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffeffffffff0000000000000000ffffffff + (CurveCommon + { ecc_a = 0xfffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffeffffffff0000000000000000fffffffc + , ecc_b = 0xb3312fa7e23ee7e4988e056be3f82d19181d9c6efe8141120314088f5013875ac656398d8a2ed19d2a85c8edd3ec2aef + , ecc_g = Point 0xaa87ca22be8b05378eb1c71ef320ad746e1d3b628ba79b9859f741e082542a385502f25dbf55296c3a545e3872760ab7 + 0x3617de4a96262c6f5d9e98bf9292dc29f8f41dbd289a147ce9da3113b5f0b8c00a60b1ce1d7e819d7a431d7c90ea0e5f + , ecc_n = 0xffffffffffffffffffffffffffffffffffffffffffffffffc7634d81f4372ddf581a0db248b0a77aecec196accc52973 + , ecc_h = 1 + }) +getCurveByName SEC_p521r1 = CurveFP $ CurvePrime + 0x01ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff + (CurveCommon + { ecc_a = 0x01fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffc + , ecc_b = 0x0051953eb9618e1c9a1f929a21a0b68540eea2da725b99b315f3b8b489918ef109e156193951ec7e937b1652c0bd3bb1bf073573df883d2c34f1ef451fd46b503f00 + , ecc_g = Point 0x00c6858e06b70404e9cd9e3ecb662395b4429c648139053fb521f828af606b4d3dbaa14b5e77efe75928fe1dc127a2ffa8de3348b3c1856a429bf97e7e31c2e5bd66 + 0x011839296a789a3bc0045c8a5fb42c7d1bd998f54449579b446817afbd17273e662c97ee72995ef42640c550b9013fad0761353c7086a272c24088be94769fd16650 + , ecc_n = 0x01fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffa51868783bf2f966b7fcc0148f709a5d03bb5c9b8899c47aebb6fb71e91386409 + , ecc_h = 1 + }) +getCurveByName SEC_t113r1 = CurveF2m $ CurveBinary + 0x020000000000000000000000000201 + (CurveCommon + { ecc_a = 0x003088250ca6e7c7fe649ce85820f7 + , ecc_b = 0x00e8bee4d3e2260744188be0e9c723 + , ecc_g = Point 0x009d73616f35f4ab1407d73562c10f + 0x00a52830277958ee84d1315ed31886 + , ecc_n = 0x0100000000000000d9ccec8a39e56f + , ecc_h = 2 + }) +getCurveByName SEC_t113r2 = CurveF2m $ CurveBinary + 0x020000000000000000000000000201 + (CurveCommon + { ecc_a = 0x00689918dbec7e5a0dd6dfc0aa55c7 + , ecc_b = 0x0095e9a9ec9b297bd4bf36e059184f + , ecc_g = Point 0x01a57a6a7b26ca5ef52fcdb8164797 + 0x00b3adc94ed1fe674c06e695baba1d + , ecc_n = 0x010000000000000108789b2496af93 + , ecc_h = 2 + }) +getCurveByName SEC_t131r1 = CurveF2m $ CurveBinary + 0x080000000000000000000000000000010d + (CurveCommon + { ecc_a = 0x07a11b09a76b562144418ff3ff8c2570b8 + , ecc_b = 0x0217c05610884b63b9c6c7291678f9d341 + , ecc_g = Point 0x0081baf91fdf9833c40f9c181343638399 + 0x078c6e7ea38c001f73c8134b1b4ef9e150 + , ecc_n = 0x0400000000000000023123953a9464b54d + , ecc_h = 2 + }) +getCurveByName SEC_t131r2 = CurveF2m $ CurveBinary + 0x080000000000000000000000000000010d + (CurveCommon + { ecc_a = 0x03e5a88919d7cafcbf415f07c2176573b2 + , ecc_b = 0x04b8266a46c55657ac734ce38f018f2192 + , ecc_g = Point 0x0356dcd8f2f95031ad652d23951bb366a8 + 0x0648f06d867940a5366d9e265de9eb240f + , ecc_n = 0x0400000000000000016954a233049ba98f + , ecc_h = 2 + }) +getCurveByName SEC_t163k1 = CurveF2m $ CurveBinary + 0x0800000000000000000000000000000000000000c9 + (CurveCommon + { ecc_a = 0x000000000000000000000000000000000000000001 + , ecc_b = 0x000000000000000000000000000000000000000001 + , ecc_g = Point 0x02fe13c0537bbc11acaa07d793de4e6d5e5c94eee8 + 0x0289070fb05d38ff58321f2e800536d538ccdaa3d9 + , ecc_n = 0x04000000000000000000020108a2e0cc0d99f8a5ef + , ecc_h = 2 + }) +getCurveByName SEC_t163r1 = CurveF2m $ CurveBinary + 0x0800000000000000000000000000000000000000c9 + (CurveCommon + { ecc_a = 0x07b6882caaefa84f9554ff8428bd88e246d2782ae2 + , ecc_b = 0x0713612dcddcb40aab946bda29ca91f73af958afd9 + , ecc_g = Point 0x0369979697ab43897789566789567f787a7876a654 + 0x00435edb42efafb2989d51fefce3c80988f41ff883 + , ecc_n = 0x03ffffffffffffffffffff48aab689c29ca710279b + , ecc_h = 2 + }) +getCurveByName SEC_t163r2 = CurveF2m $ CurveBinary + 0x0800000000000000000000000000000000000000c9 + (CurveCommon + { ecc_a = 0x000000000000000000000000000000000000000001 + , ecc_b = 0x020a601907b8c953ca1481eb10512f78744a3205fd + , ecc_g = Point 0x03f0eba16286a2d57ea0991168d4994637e8343e36 + 0x00d51fbc6c71a0094fa2cdd545b11c5c0c797324f1 + , ecc_n = 0x040000000000000000000292fe77e70c12a4234c33 + , ecc_h = 2 + }) +getCurveByName SEC_t193r1 = CurveF2m $ CurveBinary + 0x02000000000000000000000000000000000000000000008001 + (CurveCommon + { ecc_a = 0x0017858feb7a98975169e171f77b4087de098ac8a911df7b01 + , ecc_b = 0x00fdfb49bfe6c3a89facadaa7a1e5bbc7cc1c2e5d831478814 + , ecc_g = Point 0x01f481bc5f0ff84a74ad6cdf6fdef4bf6179625372d8c0c5e1 + 0x0025e399f2903712ccf3ea9e3a1ad17fb0b3201b6af7ce1b05 + , ecc_n = 0x01000000000000000000000000c7f34a778f443acc920eba49 + , ecc_h = 2 + }) +getCurveByName SEC_t193r2 = CurveF2m $ CurveBinary + 0x02000000000000000000000000000000000000000000008001 + (CurveCommon + { ecc_a = 0x0163f35a5137c2ce3ea6ed8667190b0bc43ecd69977702709b + , ecc_b = 0x00c9bb9e8927d4d64c377e2ab2856a5b16e3efb7f61d4316ae + , ecc_g = Point 0x00d9b67d192e0367c803f39e1a7e82ca14a651350aae617e8f + 0x01ce94335607c304ac29e7defbd9ca01f596f927224cdecf6c + , ecc_n = 0x010000000000000000000000015aab561b005413ccd4ee99d5 + , ecc_h = 2 + }) +getCurveByName SEC_t233k1 = CurveF2m $ CurveBinary + 0x020000000000000000000000000000000000000004000000000000000001 + (CurveCommon + { ecc_a = 0x000000000000000000000000000000000000000000000000000000000000 + , ecc_b = 0x000000000000000000000000000000000000000000000000000000000001 + , ecc_g = Point 0x017232ba853a7e731af129f22ff4149563a419c26bf50a4c9d6eefad6126 + 0x01db537dece819b7f70f555a67c427a8cd9bf18aeb9b56e0c11056fae6a3 + , ecc_n = 0x008000000000000000000000000000069d5bb915bcd46efb1ad5f173abdf + , ecc_h = 4 + }) +getCurveByName SEC_t233r1 = CurveF2m $ CurveBinary + 0x020000000000000000000000000000000000000004000000000000000001 + (CurveCommon + { ecc_a = 0x000000000000000000000000000000000000000000000000000000000001 + , ecc_b = 0x0066647ede6c332c7f8c0923bb58213b333b20e9ce4281fe115f7d8f90ad + , ecc_g = Point 0x00fac9dfcbac8313bb2139f1bb755fef65bc391f8b36f8f8eb7371fd558b + 0x01006a08a41903350678e58528bebf8a0beff867a7ca36716f7e01f81052 + , ecc_n = 0x01000000000000000000000000000013e974e72f8a6922031d2603cfe0d7 + , ecc_h = 2 + }) +getCurveByName SEC_t239k1 = CurveF2m $ CurveBinary + 0x800000000000000000004000000000000000000000000000000000000001 + (CurveCommon + { ecc_a = 0x000000000000000000000000000000000000000000000000000000000000 + , ecc_b = 0x000000000000000000000000000000000000000000000000000000000001 + , ecc_g = Point 0x29a0b6a887a983e9730988a68727a8b2d126c44cc2cc7b2a6555193035dc + 0x76310804f12e549bdb011c103089e73510acb275fc312a5dc6b76553f0ca + , ecc_n = 0x2000000000000000000000000000005a79fec67cb6e91f1c1da800e478a5 + , ecc_h = 4 + }) +getCurveByName SEC_t283k1 = CurveF2m $ CurveBinary + 0x0800000000000000000000000000000000000000000000000000000000000000000010a1 + (CurveCommon + { ecc_a = 0x000000000000000000000000000000000000000000000000000000000000000000000000 + , ecc_b = 0x000000000000000000000000000000000000000000000000000000000000000000000001 + , ecc_g = Point 0x0503213f78ca44883f1a3b8162f188e553cd265f23c1567a16876913b0c2ac2458492836 + 0x01ccda380f1c9e318d90f95d07e5426fe87e45c0e8184698e45962364e34116177dd2259 + , ecc_n = 0x01ffffffffffffffffffffffffffffffffffe9ae2ed07577265dff7f94451e061e163c61 + , ecc_h = 4 + }) +getCurveByName SEC_t283r1 = CurveF2m $ CurveBinary + 0x0800000000000000000000000000000000000000000000000000000000000000000010a1 + (CurveCommon + { ecc_a = 0x000000000000000000000000000000000000000000000000000000000000000000000001 + , ecc_b = 0x027b680ac8b8596da5a4af8a19a0303fca97fd7645309fa2a581485af6263e313b79a2f5 + , ecc_g = Point 0x05f939258db7dd90e1934f8c70b0dfec2eed25b8557eac9c80e2e198f8cdbecd86b12053 + 0x03676854fe24141cb98fe6d4b20d02b4516ff702350eddb0826779c813f0df45be8112f4 + , ecc_n = 0x03ffffffffffffffffffffffffffffffffffef90399660fc938a90165b042a7cefadb307 + , ecc_h = 2 + }) +getCurveByName SEC_t409k1 = CurveF2m $ CurveBinary + 0x02000000000000000000000000000000000000000000000000000000000000000000000000000000008000000000000000000001 + (CurveCommon + { ecc_a = 0x00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 + , ecc_b = 0x00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 + , ecc_g = Point 0x0060f05f658f49c1ad3ab1890f7184210efd0987e307c84c27accfb8f9f67cc2c460189eb5aaaa62ee222eb1b35540cfe9023746 + 0x01e369050b7c4e42acba1dacbf04299c3460782f918ea427e6325165e9ea10e3da5f6c42e9c55215aa9ca27a5863ec48d8e0286b + , ecc_n = 0x007ffffffffffffffffffffffffffffffffffffffffffffffffffe5f83b2d4ea20400ec4557d5ed3e3e7ca5b4b5c83b8e01e5fcf + , ecc_h = 4 + }) +getCurveByName SEC_t409r1 = CurveF2m $ CurveBinary + 0x02000000000000000000000000000000000000000000000000000000000000000000000000000000008000000000000000000001 + (CurveCommon + { ecc_a = 0x00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 + , ecc_b = 0x0021a5c2c8ee9feb5c4b9a753b7b476b7fd6422ef1f3dd674761fa99d6ac27c8a9a197b272822f6cd57a55aa4f50ae317b13545f + , ecc_g = Point 0x015d4860d088ddb3496b0c6064756260441cde4af1771d4db01ffe5b34e59703dc255a868a1180515603aeab60794e54bb7996a7 + 0x0061b1cfab6be5f32bbfa78324ed106a7636b9c5a7bd198d0158aa4f5488d08f38514f1fdf4b4f40d2181b3681c364ba0273c706 + , ecc_n = 0x010000000000000000000000000000000000000000000000000001e2aad6a612f33307be5fa47c3c9e052f838164cd37d9a21173 + , ecc_h = 2 + }) +getCurveByName SEC_t571k1 = CurveF2m $ CurveBinary + 0x080000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000425 + (CurveCommon + { ecc_a = 0x000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 + , ecc_b = 0x000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 + , ecc_g = Point 0x026eb7a859923fbc82189631f8103fe4ac9ca2970012d5d46024804801841ca44370958493b205e647da304db4ceb08cbbd1ba39494776fb988b47174dca88c7e2945283a01c8972 + 0x0349dc807f4fbf374f4aeade3bca95314dd58cec9f307a54ffc61efc006d8a2c9d4979c0ac44aea74fbebbb9f772aedcb620b01a7ba7af1b320430c8591984f601cd4c143ef1c7a3 + , ecc_n = 0x020000000000000000000000000000000000000000000000000000000000000000000000131850e1f19a63e4b391a8db917f4138b630d84be5d639381e91deb45cfe778f637c1001 + , ecc_h = 4 + }) +getCurveByName SEC_t571r1 = CurveF2m $ CurveBinary + 0x080000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000425 + (CurveCommon + { ecc_a = 0x000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 + , ecc_b = 0x02f40e7e2221f295de297117b7f3d62f5c6a97ffcb8ceff1cd6ba8ce4a9a18ad84ffabbd8efa59332be7ad6756a66e294afd185a78ff12aa520e4de739baca0c7ffeff7f2955727a + , ecc_g = Point 0x0303001d34b856296c16c0d40d3cd7750a93d1d2955fa80aa5f40fc8db7b2abdbde53950f4c0d293cdd711a35b67fb1499ae60038614f1394abfa3b4c850d927e1e7769c8eec2d19 + 0x037bf27342da639b6dccfffeb73d69d78c6c27a6009cbbca1980f8533921e8a684423e43bab08a576291af8f461bb2a8b3531d2f0485c19b16e2f1516e23dd3c1a4827af1b8ac15b + , ecc_n = 0x03ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffe661ce18ff55987308059b186823851ec7dd9ca1161de93d5174d66e8382e9bb2fe84e47 + , ecc_h = 2 + }) diff --git a/Crypto/PubKey/ElGamal.hs b/Crypto/PubKey/ElGamal.hs new file mode 100644 index 0000000..d699c92 --- /dev/null +++ b/Crypto/PubKey/ElGamal.hs @@ -0,0 +1,143 @@ +-- | +-- Module : Crypto.PubKey.ElGamal +-- License : BSD-style +-- Maintainer : Vincent Hanquez +-- Stability : experimental +-- Portability : Good +-- +-- This module is a work in progress. do not use: +-- it might eat your dog, your data or even both. +-- +-- TODO: provide a mapping between integer and ciphertext +-- generate numbers correctly +-- +module Crypto.PubKey.ElGamal + ( Params + , PublicNumber + , PrivateNumber + , EphemeralKey(..) + , SharedKey + , Signature + -- * generation + , generatePrivate + , generatePublic + -- * encryption and decryption with no scheme + , encryptWith + , encrypt + , decrypt + -- * signature primitives + , signWith + , sign + -- * verification primitives + , verify + ) where + +import Control.Applicative +import Data.Maybe (fromJust) +import Data.ByteString (ByteString) +import Crypto.Number.ModArithmetic (expSafe, expFast, inverse) +import Crypto.Number.Generate (generateMax) +import Crypto.Number.Serialize (os2ip) +import Crypto.Number.Basic (gcde_binary) +import Crypto.Random.Types +import Crypto.PubKey.HashDescr (HashFunction) +import Crypto.PubKey.DH (PrivateNumber(..), PublicNumber(..), Params(..), SharedKey(..)) + +-- | ElGamal Signature +data Signature = Signature (Integer, Integer) + +-- | ElGamal Ephemeral key. also called Temporary key. +newtype EphemeralKey = EphemeralKey Integer + +-- | generate a private number with no specific property +-- this number is usually called a and need to be between +-- 0 and q (order of the group G). +-- +generatePrivate :: MonadRandom m => Integer -> m PrivateNumber +generatePrivate q = PrivateNumber <$> generateMax q + +-- | generate an ephemeral key which is a number with no specific property, +-- and need to be between 0 and q (order of the group G). +-- +generateEphemeral :: MonadRandom m => Integer -> m EphemeralKey +generateEphemeral q = toEphemeral <$> generatePrivate q + where toEphemeral (PrivateNumber n) = EphemeralKey n + +-- | generate a public number that is for the other party benefits. +-- this number is usually called h=g^a +generatePublic :: Params -> PrivateNumber -> PublicNumber +generatePublic (Params p g) (PrivateNumber a) = PublicNumber $ expSafe g a p + +-- | encrypt with a specified ephemeral key +-- do not reuse ephemeral key. +encryptWith :: EphemeralKey -> Params -> PublicNumber -> Integer -> (Integer,Integer) +encryptWith (EphemeralKey b) (Params p g) (PublicNumber h) m = (c1,c2) + where s = expSafe h b p + c1 = expSafe g b p + c2 = (s * m) `mod` p + +-- | encrypt a message using params and public keys +-- will generate b (called the ephemeral key) +encrypt :: MonadRandom m => Params -> PublicNumber -> Integer -> m (Integer,Integer) +encrypt params@(Params p _) public m = (\b -> encryptWith b params public m) <$> generateEphemeral q + where q = p-1 -- p is prime, hence order of the group is p-1 + +-- | decrypt message +decrypt :: Params -> PrivateNumber -> (Integer, Integer) -> Integer +decrypt (Params p _) (PrivateNumber a) (c1,c2) = (c2 * sm1) `mod` p + where s = expSafe c1 a p + sm1 = fromJust $ inverse s p -- always inversible in Zp + +-- | sign a message with an explicit k number +-- +-- if k is not appropriate, then no signature is returned. +-- +-- with some appropriate value of k, the signature generation can fail, +-- and no signature is returned. User of this function need to retry +-- with a different k value. +signWith :: Integer -- ^ random number k, between 0 and p-1 and gcd(k,p-1)=1 + -> Params -- ^ DH params (p,g) + -> PrivateNumber -- ^ DH private key + -> HashFunction -- ^ collision resistant hash function + -> ByteString -- ^ message to sign + -> Maybe Signature +signWith k (Params p g) (PrivateNumber x) hashF msg + | k >= p-1 || d > 1 = Nothing -- gcd(k,p-1) is not 1 + | s == 0 = Nothing + | otherwise = Just $ Signature (r,s) + where r = expSafe g k p + h = os2ip $ hashF msg + s = ((h - x*r) * kInv) `mod` (p-1) + (kInv,_,d) = gcde_binary k (p-1) + +-- | sign message +-- +-- This function will generate a random number, however +-- as the signature might fail, the function will automatically retry +-- until a proper signature has been created. +-- +sign :: MonadRandom m + => Params -- ^ DH params (p,g) + -> PrivateNumber -- ^ DH private key + -> HashFunction -- ^ collision resistant hash function + -> ByteString -- ^ message to sign + -> m Signature +sign params@(Params p _) priv hashF msg = do + k <- generateMax (p-1) + case signWith k params priv hashF msg of + Nothing -> sign params priv hashF msg + Just sig -> return sig + +-- | verify a signature +verify :: Params + -> PublicNumber + -> HashFunction + -> ByteString + -> Signature + -> Bool +verify (Params p g) (PublicNumber y) hashF msg (Signature (r,s)) + | or [r <= 0,r >= p,s <= 0,s >= (p-1)] = False + | otherwise = lhs == rhs + where h = os2ip $ hashF msg + lhs = expFast g h p + rhs = (expFast y r p * expFast r s p) `mod` p diff --git a/Crypto/PubKey/HashDescr.hs b/Crypto/PubKey/HashDescr.hs new file mode 100644 index 0000000..26d9eea --- /dev/null +++ b/Crypto/PubKey/HashDescr.hs @@ -0,0 +1,102 @@ +{-# LANGUAGE OverloadedStrings #-} +-- | +-- Module : Crypto.PubKey.HashDescr +-- License : BSD-style +-- Maintainer : Vincent Hanquez +-- Stability : experimental +-- Portability : Good +-- +-- Standard digests wrapped in ASN1 structure +-- +module Crypto.PubKey.HashDescr + ( + -- * Types + HashFunction + , HashDescr(..) + -- * List of known hash description + , hashDescrMD2 + , hashDescrMD5 + , hashDescrSHA1 + , hashDescrSHA224 + , hashDescrSHA256 + , hashDescrSHA384 + , hashDescrSHA512 + , hashDescrRIPEMD160 + ) where + +import Data.ByteString (ByteString) +import Data.Byteable (toBytes) +import qualified Data.ByteString as B +import Crypto.Hash + +-- | A standard hash function returning a digest object +type HashFunction = ByteString -> ByteString + +-- | Describe a hash function and a way to wrap the digest into +-- an DER encoded ASN1 marshalled structure. +data HashDescr = HashDescr { hashFunction :: HashFunction -- ^ hash function + , digestToASN1 :: ByteString -> ByteString -- ^ convertion to an ASN1 wrapped digest bytestring + } + +-- | Describe the MD2 hashing algorithm +hashDescrMD2 :: HashDescr +hashDescrMD2 = + HashDescr { hashFunction = toBytes . (hash :: ByteString -> Digest MD2) + , digestToASN1 = toHashWithInfo "\x30\x20\x30\x0c\x06\x08\x2a\x86\x48\x86\xf7\x0d\x02\x02\x05\x00\x04\x10" + } +-- | Describe the MD5 hashing algorithm +hashDescrMD5 :: HashDescr +hashDescrMD5 = + HashDescr { hashFunction = toBytes . (hash :: ByteString -> Digest MD5) + , digestToASN1 = toHashWithInfo "\x30\x20\x30\x0c\x06\x08\x2a\x86\x48\x86\xf7\x0d\x02\x05\x05\x00\x04\x10" + } +-- | Describe the SHA1 hashing algorithm +hashDescrSHA1 :: HashDescr +hashDescrSHA1 = + HashDescr { hashFunction = toBytes . (hash :: ByteString -> Digest SHA1) + , digestToASN1 = toHashWithInfo "\x30\x21\x30\x09\x06\x05\x2b\x0e\x03\x02\x1a\x05\x00\x04\x14" + } +-- | Describe the SHA224 hashing algorithm +hashDescrSHA224 :: HashDescr +hashDescrSHA224 = + HashDescr { hashFunction = toBytes . (hash :: ByteString -> Digest SHA224) + , digestToASN1 = toHashWithInfo "\x30\x2d\x30\x0d\x06\x09\x60\x86\x48\x01\x65\x03\x04\x02\x04\x05\x00\x04\x1c" + } +-- | Describe the SHA256 hashing algorithm +hashDescrSHA256 :: HashDescr +hashDescrSHA256 = + HashDescr { hashFunction = toBytes . (hash :: ByteString -> Digest SHA256) + , digestToASN1 = toHashWithInfo "\x30\x31\x30\x0d\x06\x09\x60\x86\x48\x01\x65\x03\x04\x02\x01\x05\x00\x04\x20" + } +-- | Describe the SHA384 hashing algorithm +hashDescrSHA384 :: HashDescr +hashDescrSHA384 = + HashDescr { hashFunction = toBytes . (hash :: ByteString -> Digest SHA384) + , digestToASN1 = toHashWithInfo "\x30\x41\x30\x0d\x06\x09\x60\x86\x48\x01\x65\x03\x04\x02\x02\x05\x00\x04\x30" + } +-- | Describe the SHA512 hashing algorithm +hashDescrSHA512 :: HashDescr +hashDescrSHA512 = + HashDescr { hashFunction = toBytes . (hash :: ByteString -> Digest SHA512) + , digestToASN1 = toHashWithInfo "\x30\x51\x30\x0d\x06\x09\x60\x86\x48\x01\x65\x03\x04\x02\x03\x05\x00\x04\x40" + } + +-- | Describe the RIPEMD160 hashing algorithm +hashDescrRIPEMD160 :: HashDescr +hashDescrRIPEMD160 = + HashDescr { hashFunction = toBytes . (hash :: ByteString -> Digest RIPEMD160) + , digestToASN1 = toHashWithInfo "\x30\x21\x30\x09\x06\x05\x2b\x24\x03\x02\x01\x05\x00\x04\x14" + } + +-- | Generate the marshalled structure with the following ASN1 structure: +-- +-- Start Sequence +-- ,Start Sequence +-- ,OID oid +-- ,Null +-- ,End Sequence +-- ,OctetString digest +-- ,End Sequence +-- +toHashWithInfo :: ByteString -> ByteString -> ByteString +toHashWithInfo pre digest = pre `B.append` digest diff --git a/Crypto/PubKey/Internal.hs b/Crypto/PubKey/Internal.hs new file mode 100644 index 0000000..d0be813 --- /dev/null +++ b/Crypto/PubKey/Internal.hs @@ -0,0 +1,24 @@ +-- | +-- Module : Crypto.PubKey.Internal +-- License : BSD-style +-- Maintainer : Vincent Hanquez +-- Stability : experimental +-- Portability : Good +-- +module Crypto.PubKey.Internal + ( and' + , (&&!) + ) where + +import Data.List (foldl') + +-- | This is a strict version of and +and' :: [Bool] -> Bool +and' l = foldl' (&&!) True l + +-- | This is a strict version of &&. +(&&!) :: Bool -> Bool -> Bool +True &&! True = True +True &&! False = False +False &&! True = False +False &&! False = False diff --git a/Crypto/PubKey/MaskGenFunction.hs b/Crypto/PubKey/MaskGenFunction.hs new file mode 100644 index 0000000..c06cde8 --- /dev/null +++ b/Crypto/PubKey/MaskGenFunction.hs @@ -0,0 +1,31 @@ +-- | +-- Module : Crypto.PubKey.MaskGenFunction +-- License : BSD-style +-- Maintainer : Vincent Hanquez +-- Stability : experimental +-- Portability : Good +-- +module Crypto.PubKey.MaskGenFunction + ( MaskGenAlgorithm + , mgf1 + ) where + +import Data.ByteString (ByteString) +import qualified Data.ByteString as B +import Crypto.PubKey.HashDescr +import Crypto.Number.Serialize (i2ospOf_) + +-- | Represent a mask generation algorithm +type MaskGenAlgorithm = HashFunction -- ^ hash function to use + -> ByteString -- ^ seed + -> Int -- ^ length to generate + -> ByteString + +-- | Mask generation algorithm MGF1 +mgf1 :: MaskGenAlgorithm +mgf1 hashF seed len = loop B.empty 0 + where loop t counter + | B.length t >= len = B.take len t + | otherwise = let counterBS = i2ospOf_ 4 counter + newT = t `B.append` hashF (seed `B.append` counterBS) + in loop newT (counter+1) diff --git a/Crypto/PubKey/RSA.hs b/Crypto/PubKey/RSA.hs new file mode 100644 index 0000000..381a110 --- /dev/null +++ b/Crypto/PubKey/RSA.hs @@ -0,0 +1,161 @@ +-- | +-- Module : Crypto.PubKey.RSA +-- License : BSD-style +-- Maintainer : Vincent Hanquez +-- Stability : experimental +-- Portability : Good +-- +{-# LANGUAGE DeriveDataTypeable #-} +module Crypto.PubKey.RSA + ( Error(..) + , PublicKey(..) + , PrivateKey(..) + , Blinder(..) + -- * generation function + , generateWith + , generate + , generateBlinder + ) where + +import Data.Bits +import Data.Data +import Data.Word +import Control.Applicative +import Crypto.Random.Types +import Crypto.Number.ModArithmetic (inverse, inverseCoprimes) +import Crypto.Number.Generate (generateMax) +import Crypto.Number.Prime (generatePrime) +import Crypto.PubKey.RSA.Types + +-- | Represent a RSA public key +data PublicKey = PublicKey + { public_size :: Int -- ^ size of key in bytes + , public_n :: Integer -- ^ public p*q + , public_e :: Integer -- ^ public exponant e + } deriving (Show,Read,Eq,Data,Typeable) + +-- | Represent a RSA private key. +-- +-- Only the pub, d fields are mandatory to fill. +-- +-- p, q, dP, dQ, qinv are by-product during RSA generation, +-- but are useful to record here to speed up massively +-- the decrypt and sign operation. +-- +-- implementations can leave optional fields to 0. +-- +data PrivateKey = PrivateKey + { private_pub :: PublicKey -- ^ public part of a private key (size, n and e) + , private_d :: Integer -- ^ private exponant d + , private_p :: Integer -- ^ p prime number + , private_q :: Integer -- ^ q prime number + , private_dP :: Integer -- ^ d mod (p-1) + , private_dQ :: Integer -- ^ d mod (q-1) + , private_qinv :: Integer -- ^ q^(-1) mod p + } deriving (Show,Read,Eq,Data,Typeable) + +-- | get the size in bytes from a private key +private_size = public_size . private_pub + +-- | get n from a private key +private_n = public_n . private_pub + +-- | get e from a private key +private_e = public_e . private_pub + +-- | Represent RSA KeyPair +-- +-- note the RSA private key contains already an instance of public key for efficiency +newtype KeyPair = KeyPair PrivateKey + deriving (Show,Read,Eq,Data,Typeable) + +-- | Public key of a RSA KeyPair +toPublicKey :: KeyPair -> PublicKey +toPublicKey (KeyPair priv) = private_pub priv + +-- | Private key of a RSA KeyPair +toPrivateKey :: KeyPair -> PrivateKey +toPrivateKey (KeyPair priv) = priv + +-- some bad implementation will not serialize ASN.1 integer properly, leading +-- to negative modulus. +-- TODO : Find a better place for this +toPositive :: Integer -> Integer +toPositive int + | int < 0 = uintOfBytes $ bytesOfInt int + | otherwise = int + where uintOfBytes = foldl (\acc n -> (acc `shiftL` 8) + fromIntegral n) 0 + bytesOfInt :: Integer -> [Word8] + bytesOfInt n = if testBit (head nints) 7 then nints else 0xff : nints + where nints = reverse $ plusOne $ reverse $ map complement $ bytesOfUInt (abs n) + plusOne [] = [1] + plusOne (x:xs) = if x == 0xff then 0 : plusOne xs else (x+1) : xs + bytesOfUInt x = reverse (list x) + where list i = if i <= 0xff then [fromIntegral i] else (fromIntegral i .&. 0xff) : list (i `shiftR` 8) + +-- | Generate a key pair given p and q. +-- +-- p and q need to be distinct prime numbers. +-- +-- e need to be coprime to phi=(p-1)*(q-1). If that's not the +-- case, the function will not return a key pair. +-- A small hamming weight results in better performance. +-- +-- * e=0x10001 is a popular choice +-- +-- * e=3 is popular as well, but proven to not be as secure for some cases. +-- +generateWith :: (Integer, Integer) -- ^ chosen distinct primes p and q + -> Int -- ^ size in bytes + -> Integer -- ^ RSA public exponant 'e' + -> Maybe (PublicKey, PrivateKey) +generateWith (p,q) size e = + case inverse e phi of + Nothing -> Nothing + Just d -> Just (pub,priv d) + where n = p*q + phi = (p-1)*(q-1) + -- q and p should be *distinct* *prime* numbers, hence always coprime + qinv = inverseCoprimes q p + pub = PublicKey { public_size = size + , public_n = n + , public_e = e + } + priv d = PrivateKey { private_pub = pub + , private_d = d + , private_p = p + , private_q = q + , private_dP = d `mod` (p-1) + , private_dQ = d `mod` (q-1) + , private_qinv = qinv + } + +-- | generate a pair of (private, public) key of size in bytes. +generate :: MonadRandom m + => Int -- ^ size in bytes + -> Integer -- ^ RSA public exponant 'e' + -> m (PublicKey, PrivateKey) +generate size e = loop + where + loop = do -- loop until we find a valid key pair given e + pq <- generatePQ + case generateWith pq size e of + Nothing -> loop + Just pp -> return pp + generatePQ = do + p <- generatePrime (8 * (size `div` 2)) + q <- generateQ p + return (p,q) + generateQ p = do + q <- generatePrime (8 * (size - (size `div` 2))) + if p == q then generateQ p else return q + +-- | Generate a blinder to use with decryption and signing operation +-- +-- the unique parameter apart from the random number generator is the +-- public key value N. +generateBlinder :: MonadRandom m + => Integer -- ^ RSA public N parameter. + -> m Blinder +generateBlinder n = + (\r -> Blinder r (inverseCoprimes r n)) <$> generateMax n diff --git a/Crypto/PubKey/RSA/OAEP.hs b/Crypto/PubKey/RSA/OAEP.hs new file mode 100644 index 0000000..9a80dd5 --- /dev/null +++ b/Crypto/PubKey/RSA/OAEP.hs @@ -0,0 +1,151 @@ +-- | +-- Module : Crypto.PubKey.RSA.OAEP +-- License : BSD-style +-- Maintainer : Vincent Hanquez +-- Stability : experimental +-- Portability : Good +-- +-- RSA OAEP mode +-- +-- +{-# LANGUAGE OverloadedStrings #-} +module Crypto.PubKey.RSA.OAEP + ( + OAEPParams(..) + , defaultOAEPParams + -- * OAEP encryption + , encryptWithSeed + , encrypt + -- * OAEP decryption + , decrypt + , decryptSafer + ) where + +import Crypto.Random +import Crypto.Types.PubKey.RSA +import Crypto.PubKey.HashDescr +import Crypto.PubKey.MaskGenFunction +import Crypto.PubKey.RSA.Prim +import Crypto.PubKey.RSA.Types +import Crypto.PubKey.RSA (generateBlinder) +import Crypto.PubKey.Internal (and') +import Data.ByteString (ByteString) +import qualified Data.ByteString as B +import Data.Bits (xor) + +-- | Parameters for OAEP encryption/decryption +data OAEPParams = OAEPParams + { oaepHash :: HashFunction -- ^ Hash function to use. + , oaepMaskGenAlg :: MaskGenAlgorithm -- ^ Mask Gen algorithm to use. + , oaepLabel :: Maybe ByteString -- ^ Optional label prepended to message. + } + +-- | Default Params with a specified hash function +defaultOAEPParams :: HashFunction -> OAEPParams +defaultOAEPParams hashF = + OAEPParams { oaepHash = hashF + , oaepMaskGenAlg = mgf1 + , oaepLabel = Nothing + } + +-- | Encrypt a message using OAEP with a predefined seed. +encryptWithSeed :: ByteString -- ^ Seed + -> OAEPParams -- ^ OAEP params to use for encryption + -> PublicKey -- ^ Public key. + -> ByteString -- ^ Message to encrypt + -> Either Error ByteString +encryptWithSeed seed oaep pk msg + | k < 2*hashLen+2 = Left InvalidParameters + | B.length seed /= hashLen = Left InvalidParameters + | mLen > k - 2*hashLen-2 = Left MessageTooLong + | otherwise = Right $ ep pk em + where -- parameters + k = public_size pk + mLen = B.length msg + hashF = oaepHash oaep + mgf = (oaepMaskGenAlg oaep) hashF + labelHash = hashF $ maybe B.empty id $ oaepLabel oaep + hashLen = B.length labelHash + + -- put fields + ps = B.replicate (k - mLen - 2*hashLen - 2) 0 + db = B.concat [labelHash, ps, B.singleton 0x1, msg] + dbmask = mgf seed (k - hashLen - 1) + maskedDB = B.pack $ B.zipWith xor db dbmask + seedMask = mgf maskedDB hashLen + maskedSeed = B.pack $ B.zipWith xor seed seedMask + em = B.concat [B.singleton 0x0,maskedSeed,maskedDB] + +-- | Encrypt a message using OAEP +encrypt :: CPRG g + => g -- ^ random number generator. + -> OAEPParams -- ^ OAEP params to use for encryption. + -> PublicKey -- ^ Public key. + -> ByteString -- ^ Message to encrypt + -> (Either Error ByteString, g) +encrypt g oaep pk msg = (encryptWithSeed seed oaep pk msg, g') + where hashF = oaepHash oaep + hashLen = B.length (hashF B.empty) + (seed, g') = cprgGenerate hashLen g + +-- | un-pad a OAEP encoded message. +-- +-- It doesn't apply the RSA decryption primitive +unpad :: OAEPParams -- ^ OAEP params to use + -> Int -- ^ size of the key in bytes + -> ByteString -- ^ encoded message (not encrypted) + -> Either Error ByteString +unpad oaep k em + | paddingSuccess = Right msg + | otherwise = Left MessageNotRecognized + where -- parameters + hashF = oaepHash oaep + mgf = (oaepMaskGenAlg oaep) hashF + labelHash = hashF $ maybe B.empty id $ oaepLabel oaep + hashLen = B.length labelHash + -- getting em's fields + (pb, em0) = B.splitAt 1 em + (maskedSeed,maskedDB) = B.splitAt hashLen em0 + seedMask = mgf maskedDB hashLen + seed = B.pack $ B.zipWith xor maskedSeed seedMask + dbmask = mgf seed (k - hashLen - 1) + db = B.pack $ B.zipWith xor maskedDB dbmask + -- getting db's fields + (labelHash',db1) = B.splitAt hashLen db + (_,db2) = B.break (/= 0) db1 + (ps1,msg) = B.splitAt 1 db2 + + paddingSuccess = and' [ labelHash' == labelHash -- no need for constant eq + , ps1 == "\x01" + , pb == "\x00" + ] + +-- | Decrypt a ciphertext using OAEP +-- +-- When the signature is not in a context where an attacker could gain +-- information from the timing of the operation, the blinder can be set to None. +-- +-- If unsure always set a blinder or use decryptSafer +decrypt :: Maybe Blinder -- ^ Optional blinder + -> OAEPParams -- ^ OAEP params to use for decryption + -> PrivateKey -- ^ Private key + -> ByteString -- ^ Cipher text + -> Either Error ByteString +decrypt blinder oaep pk cipher + | B.length cipher /= k = Left MessageSizeIncorrect + | k < 2*hashLen+2 = Left InvalidParameters + | otherwise = unpad oaep (private_size pk) $ dp blinder pk cipher + where -- parameters + k = private_size pk + hashF = oaepHash oaep + hashLen = B.length (hashF B.empty) + +-- | Decrypt a ciphertext using OAEP and by automatically generating a blinder. +decryptSafer :: CPRG g + => g -- ^ random number generator + -> OAEPParams -- ^ OAEP params to use for decryption + -> PrivateKey -- ^ Private key + -> ByteString -- ^ Cipher text + -> (Either Error ByteString, g) +decryptSafer rng oaep pk cipher = (decrypt (Just blinder) oaep pk cipher, rng') + where (blinder, rng') = generateBlinder rng (private_n pk) diff --git a/Crypto/PubKey/RSA/PKCS15.hs b/Crypto/PubKey/RSA/PKCS15.hs new file mode 100644 index 0000000..cc33fa4 --- /dev/null +++ b/Crypto/PubKey/RSA/PKCS15.hs @@ -0,0 +1,144 @@ +-- | +-- Module : Crypto.PubKey.RSA.PKCS15 +-- License : BSD-style +-- Maintainer : Vincent Hanquez +-- Stability : experimental +-- Portability : Good +-- +{-# LANGUAGE OverloadedStrings #-} +module Crypto.PubKey.RSA.PKCS15 + ( + -- * padding and unpadding + pad + , padSignature + , unpad + -- * private key operations + , decrypt + , decryptSafer + , sign + , signSafer + -- * public key operations + , encrypt + , verify + ) where + +import Crypto.Random +import Crypto.PubKey.Internal (and') +import Crypto.Types.PubKey.RSA +import Data.ByteString (ByteString) +import qualified Data.ByteString as B +import Crypto.PubKey.RSA.Prim +import Crypto.PubKey.RSA.Types +import Crypto.PubKey.RSA (generateBlinder) +import Crypto.PubKey.HashDescr + +-- | This produce a standard PKCS1.5 padding for encryption +pad :: CPRG g => g -> Int -> ByteString -> Either Error (ByteString, g) +pad rng len m + | B.length m > len - 11 = Left MessageTooLong + | otherwise = + let (padding, rng') = getNonNullRandom rng (len - B.length m - 3) + in Right (B.concat [ B.singleton 0, B.singleton 2, padding, B.singleton 0, m ], rng') + + where {- get random non-null bytes -} + getNonNullRandom :: CPRG g => g -> Int -> (ByteString, g) + getNonNullRandom g n = + let (bs0,g') = cprgGenerate n g + bytes = B.pack $ filter (/= 0) $ B.unpack $ bs0 + left = (n - B.length bytes) + in if left == 0 + then (bytes, g') + else let (bend, g'') = getNonNullRandom g' left + in (bytes `B.append` bend, g'') + +-- | Produce a standard PKCS1.5 padding for signature +padSignature :: Int -> ByteString -> Either Error ByteString +padSignature klen signature + | klen < siglen+1 = Left SignatureTooLong + | otherwise = Right $ B.concat [B.singleton 0,B.singleton 1,padding,B.singleton 0,signature] + where + siglen = B.length signature + padding = B.replicate (klen - siglen - 3) 0xff + +-- | Try to remove a standard PKCS1.5 encryption padding. +unpad :: ByteString -> Either Error ByteString +unpad packed + | paddingSuccess = Right m + | otherwise = Left MessageNotRecognized + where + (zt, ps0m) = B.splitAt 2 packed + (ps, zm) = B.span (/= 0) ps0m + (z, m) = B.splitAt 1 zm + paddingSuccess = and' [ zt == "\x00\x02" + , z == "\x00" + , B.length ps >= 8 + ] + +-- | decrypt message using the private key. +-- +-- When the decryption is not in a context where an attacker could gain +-- information from the timing of the operation, the blinder can be set to None. +-- +-- If unsure always set a blinder or use decryptSafer +decrypt :: Maybe Blinder -- ^ optional blinder + -> PrivateKey -- ^ RSA private key + -> ByteString -- ^ cipher text + -> Either Error ByteString +decrypt blinder pk c + | B.length c /= (private_size pk) = Left MessageSizeIncorrect + | otherwise = unpad $ dp blinder pk c + +-- | decrypt message using the private key and by automatically generating a blinder. +decryptSafer :: CPRG g + => g -- ^ random generator + -> PrivateKey -- ^ RSA private key + -> ByteString -- ^ cipher text + -> (Either Error ByteString, g) +decryptSafer rng pk b = + let (blinder, rng') = generateBlinder rng (private_n pk) + in (decrypt (Just blinder) pk b, rng') + +-- | encrypt a bytestring using the public key and a CPRG random generator. +-- +-- the message need to be smaller than the key size - 11 +encrypt :: CPRG g => g -> PublicKey -> ByteString -> (Either Error ByteString, g) +encrypt rng pk m = do + case pad rng (public_size pk) m of + Left err -> (Left err, rng) + Right (em, rng') -> (Right (ep pk em), rng') + +-- | sign message using private key, a hash and its ASN1 description +-- +-- When the signature is not in a context where an attacker could gain +-- information from the timing of the operation, the blinder can be set to None. +-- +-- If unsure always set a blinder or use signSafer +sign :: Maybe Blinder -- ^ optional blinder + -> HashDescr -- ^ hash descriptor + -> PrivateKey -- ^ private key + -> ByteString -- ^ message to sign + -> Either Error ByteString +sign blinder hashDescr pk m = dp blinder pk `fmap` makeSignature hashDescr (private_size pk) m + +-- | sign message using the private key and by automatically generating a blinder. +signSafer :: CPRG g + => g -- ^ random generator + -> HashDescr -- ^ Hash descriptor + -> PrivateKey -- ^ private key + -> ByteString -- ^ message to sign + -> (Either Error ByteString, g) +signSafer rng hashDescr pk m = + let (blinder, rng') = generateBlinder rng (private_n pk) + in (sign (Just blinder) hashDescr pk m, rng') + +-- | verify message with the signed message +verify :: HashDescr -> PublicKey -> ByteString -> ByteString -> Bool +verify hashDescr pk m sm = + case makeSignature hashDescr (public_size pk) m of + Left _ -> False + Right s -> s == (ep pk sm) + +{- makeSignature for sign and verify -} +makeSignature :: HashDescr -> Int -> ByteString -> Either Error ByteString +makeSignature hashDescr klen m = padSignature klen signature + where signature = (digestToASN1 hashDescr) $ (hashFunction hashDescr) m diff --git a/Crypto/PubKey/RSA/PSS.hs b/Crypto/PubKey/RSA/PSS.hs new file mode 100644 index 0000000..42ad20b --- /dev/null +++ b/Crypto/PubKey/RSA/PSS.hs @@ -0,0 +1,135 @@ +-- | +-- Module : Crypto.PubKey.RSA.PSS +-- License : BSD-style +-- Maintainer : Vincent Hanquez +-- Stability : experimental +-- Portability : Good +-- +module Crypto.PubKey.RSA.PSS + ( PSSParams(..) + , defaultPSSParams + , defaultPSSParamsSHA1 + -- * Sign and verify functions + , signWithSalt + , sign + , signSafer + , verify + ) where + +import Crypto.Random +import Crypto.Types.PubKey.RSA +import Data.ByteString (ByteString) +import Data.Byteable +import qualified Data.ByteString as B +import Crypto.PubKey.RSA.Prim +import Crypto.PubKey.RSA.Types +import Crypto.PubKey.RSA (generateBlinder) +import Crypto.PubKey.HashDescr +import Crypto.PubKey.MaskGenFunction +import Crypto.Hash +import Data.Bits (xor, shiftR, (.&.)) +import Data.Word + +-- | Parameters for PSS signature/verification. +data PSSParams = PSSParams { pssHash :: HashFunction -- ^ Hash function to use + , pssMaskGenAlg :: MaskGenAlgorithm -- ^ Mask Gen algorithm to use + , pssSaltLength :: Int -- ^ Length of salt. need to be <= to hLen. + , pssTrailerField :: Word8 -- ^ Trailer field, usually 0xbc + } + +-- | Default Params with a specified hash function +defaultPSSParams :: HashFunction -> PSSParams +defaultPSSParams hashF = + PSSParams { pssHash = hashF + , pssMaskGenAlg = mgf1 + , pssSaltLength = B.length $ hashF B.empty + , pssTrailerField = 0xbc + } + +-- | Default Params using SHA1 algorithm. +defaultPSSParamsSHA1 :: PSSParams +defaultPSSParamsSHA1 = defaultPSSParams (toBytes . (hash :: ByteString -> Digest SHA1)) + +-- | Sign using the PSS parameters and the salt explicitely passed as parameters. +-- +-- the function ignore SaltLength from the PSS Parameters +signWithSalt :: ByteString -- ^ Salt to use + -> Maybe Blinder -- ^ optional blinder to use + -> PSSParams -- ^ PSS Parameters to use + -> PrivateKey -- ^ RSA Private Key + -> ByteString -- ^ Message to sign + -> Either Error ByteString +signWithSalt salt blinder params pk m + | k < hashLen + saltLen + 2 = Left InvalidParameters + | otherwise = Right $ dp blinder pk em + where mHash = (pssHash params) m + k = private_size pk + dbLen = k - hashLen - 1 + saltLen = B.length salt + hashLen = B.length (hashF B.empty) + hashF = pssHash params + pubBits = private_size pk * 8 -- to change if public_size is converted in bytes + + m' = B.concat [B.replicate 8 0,mHash,salt] + h = hashF m' + db = B.concat [B.replicate (dbLen - saltLen - 1) 0,B.singleton 1,salt] + dbmask = (pssMaskGenAlg params) hashF h dbLen + maskedDB = B.pack $ normalizeToKeySize pubBits $ B.zipWith xor db dbmask + em = B.concat [maskedDB, h, B.singleton (pssTrailerField params)] + +-- | Sign using the PSS Parameters +sign :: CPRG g + => g -- ^ random generator to use to generate the salt + -> Maybe Blinder -- ^ optional blinder to use + -> PSSParams -- ^ PSS Parameters to use + -> PrivateKey -- ^ RSA Private Key + -> ByteString -- ^ Message to sign + -> (Either Error ByteString, g) +sign rng blinder params pk m = (signWithSalt salt blinder params pk m, rng') + where (salt,rng') = cprgGenerate (pssSaltLength params) rng + +-- | Sign using the PSS Parameters and an automatically generated blinder. +signSafer :: CPRG g + => g -- ^ random generator + -> PSSParams -- ^ PSS Parameters to use + -> PrivateKey -- ^ private key + -> ByteString -- ^ message to sign + -> (Either Error ByteString, g) +signSafer rng params pk m = sign rng' (Just blinder) params pk m + where (blinder, rng') = generateBlinder rng (private_n pk) + +-- | Verify a signature using the PSS Parameters +verify :: PSSParams -- ^ PSS Parameters to use to verify, + -- this need to be identical to the parameters when signing + -> PublicKey -- ^ RSA Public Key + -> ByteString -- ^ Message to verify + -> ByteString -- ^ Signature + -> Bool +verify params pk m s + | public_size pk /= B.length s = False + | B.last em /= pssTrailerField params = False + | not (B.all (== 0) ps0) = False + | b1 /= B.singleton 1 = False + | otherwise = h == h' + where -- parameters + hashF = pssHash params + hashLen = B.length (hashF B.empty) + dbLen = public_size pk - hashLen - 1 + pubBits = public_size pk * 8 -- to change if public_size is converted in bytes + -- unmarshall fields + em = ep pk s + maskedDB = B.take (B.length em - hashLen - 1) em + h = B.take hashLen $ B.drop (B.length maskedDB) em + dbmask = (pssMaskGenAlg params) hashF h dbLen + db = B.pack $ normalizeToKeySize pubBits $ B.zipWith xor maskedDB dbmask + (ps0,z) = B.break (== 1) db + (b1,salt) = B.splitAt 1 z + mHash = hashF m + m' = B.concat [B.replicate 8 0,mHash,salt] + h' = hashF m' + +normalizeToKeySize :: Int -> [Word8] -> [Word8] +normalizeToKeySize _ [] = [] -- very unlikely +normalizeToKeySize bits (x:xs) = x .&. mask : xs + where mask = if sh > 0 then 0xff `shiftR` (8-sh) else 0xff + sh = ((bits-1) .&. 0x7) diff --git a/Crypto/PubKey/RSA/Prim.hs b/Crypto/PubKey/RSA/Prim.hs new file mode 100644 index 0000000..b0c42e0 --- /dev/null +++ b/Crypto/PubKey/RSA/Prim.hs @@ -0,0 +1,61 @@ +-- | +-- Module : Crypto.PubKey.RSA.Prim +-- License : BSD-style +-- Maintainer : Vincent Hanquez +-- Stability : experimental +-- Portability : Good +-- +module Crypto.PubKey.RSA.Prim + ( + -- * decrypt primitive + dp + -- * encrypt primitive + , ep + ) where + +import Data.ByteString (ByteString) +import Crypto.PubKey.RSA.Types (Blinder(..)) +import Crypto.Types.PubKey.RSA +import Crypto.Number.ModArithmetic (expFast, expSafe) +import Crypto.Number.Serialize (os2ip, i2ospOf_) + +{- dpSlow computes the decrypted message not using any precomputed cache value. + only n and d need to valid. -} +dpSlow :: PrivateKey -> ByteString -> ByteString +dpSlow pk c = i2ospOf_ (private_size pk) $ expSafe (os2ip c) (private_d pk) (private_n pk) + +{- dpFast computes the decrypted message more efficiently if the + precomputed private values are available. mod p and mod q are faster + to compute than mod pq -} +dpFast :: Blinder -> PrivateKey -> ByteString -> ByteString +dpFast (Blinder r rm1) pk c = + i2ospOf_ (private_size pk) (multiplication rm1 (m2 + h * (private_q pk)) (private_n pk)) + where + re = expFast r (public_e $ private_pub pk) (private_n pk) + iC = multiplication re (os2ip c) (private_n pk) + m1 = expSafe iC (private_dP pk) (private_p pk) + m2 = expSafe iC (private_dQ pk) (private_q pk) + h = ((private_qinv pk) * (m1 - m2)) `mod` (private_p pk) + +dpFastNoBlinder :: PrivateKey -> ByteString -> ByteString +dpFastNoBlinder pk c = i2ospOf_ (private_size pk) (m2 + h * (private_q pk)) + where iC = os2ip c + m1 = expSafe iC (private_dP pk) (private_p pk) + m2 = expSafe iC (private_dQ pk) (private_q pk) + h = ((private_qinv pk) * (m1 - m2)) `mod` (private_p pk) + +-- | Compute the RSA decrypt primitive. +-- if the p and q numbers are available, then dpFast is used +-- otherwise, we use dpSlow which only need d and n. +dp :: Maybe Blinder -> PrivateKey -> ByteString -> ByteString +dp blinder pk + | private_p pk /= 0 && private_q pk /= 0 = maybe dpFastNoBlinder dpFast blinder $ pk + | otherwise = dpSlow pk + +-- | Compute the RSA encrypt primitive +ep :: PublicKey -> ByteString -> ByteString +ep pk m = i2ospOf_ (public_size pk) $ expFast (os2ip m) (public_e pk) (public_n pk) + +-- | multiply 2 integers in Zm only performing the modulo operation if necessary +multiplication :: Integer -> Integer -> Integer -> Integer +multiplication a b m = (a * b) `mod` m diff --git a/Crypto/PubKey/RSA/Types.hs b/Crypto/PubKey/RSA/Types.hs new file mode 100644 index 0000000..56b6c99 --- /dev/null +++ b/Crypto/PubKey/RSA/Types.hs @@ -0,0 +1,26 @@ +-- | +-- Module : Crypto.PubKey.RSA.Types +-- License : BSD-style +-- Maintainer : Vincent Hanquez +-- Stability : experimental +-- Portability : Good +-- +module Crypto.PubKey.RSA.Types + ( Error(..) + , Blinder(..) + ) where + +-- | Blinder which is used to obfuscate the timing +-- of the decryption primitive (used by decryption and signing). +data Blinder = Blinder !Integer !Integer + deriving (Show,Eq) + +-- | error possible during encryption, decryption or signing. +data Error = + MessageSizeIncorrect -- ^ the message to decrypt is not of the correct size (need to be == private_size) + | MessageTooLong -- ^ the message to encrypt is too long + | MessageNotRecognized -- ^ the message decrypted doesn't have a PKCS15 structure (0 2 .. 0 msg) + | SignatureTooLong -- ^ the message's digest is too long + | InvalidParameters -- ^ some parameters lead to breaking assumptions. + deriving (Show,Eq) + diff --git a/cryptonite.cabal b/cryptonite.cabal index 02660b8..f096496 100644 --- a/cryptonite.cabal +++ b/cryptonite.cabal @@ -59,6 +59,17 @@ Library Crypto.Hash.Tiger Crypto.Hash.Whirlpool Crypto.PubKey.Curve25519 + Crypto.PubKey.HashDescr + Crypto.PubKey.MaskGenFunction + Crypto.PubKey.DH + Crypto.PubKey.DSA + Crypto.PubKey.ECC.Generate + Crypto.PubKey.ECC.Prim + Crypto.PubKey.ECC.DH + Crypto.PubKey.ECC.ECDSA + Crypto.PubKey.ECC.Types + Crypto.PubKey.RSA + Crypto.PubKey.RSA.Types Crypto.Random Crypto.Random.Types Crypto.Random.Entropy @@ -86,6 +97,8 @@ Library Crypto.Random.Entropy.Source Crypto.Random.Entropy.Backend Crypto.Random.ChaChaDRG + Crypto.PubKey.Internal + Crypto.PubKey.ElGamal Crypto.Internal.Compat Crypto.Internal.Bytes Crypto.Internal.ByteArray