hecc 0.3.3 → 0.4
raw patch · 6 files changed
+587/−455 lines, 6 filesdep +cereal
Dependencies added: cereal
Files
- README +3/−9
- hecc.cabal +5/−4
- src/Codec/Crypto/ECC/Base.hs +508/−397
- src/Codec/Crypto/ECC/StandardCurves.hs +26/−13
- src/Examples.hs +6/−6
- src/bench.hs +39/−26
README view
@@ -1,13 +1,11 @@ ECC ---- RSA just doesn't cut it anymore for fast public-key crypto. Keys are large for reasonable security making it quite slow... Enter elliptic curves: smaller numbers are necessary and everything is faster. Maybe this library is not for embedded system usage, but now people can experiment with ECC for those use-cases where some form of RSA would be chosen otherwise. Hecc.Base ------------ This is the Haskell-Elliptic-Curve-Cryptography-library, or maybe more appropriately atm it is only the basic math for many ECC-algorithms the user of this library may wish to implement. As an example the EC-variant of the Diffie-Hellman key-exchange is included which shows how the values can be computed with this library (a better variant will follow, this is just an example). Also included is a basic speed-benchmarking-file (point multiplication) for example on the NIST Curve P-256 (the author wants some usage results and performance-numbers... so...).@@ -15,7 +13,6 @@ The API -------- ...is not stable right now. If anybody wants to use the library in its current state for serious cryptographic uses, then by all means contact the author! The Code began as a prototyped script and has since been polished, but this is best-effort work in progress.@@ -23,7 +20,6 @@ pmul ----- Point multiplication can be done by this library using one of two algorithms: double-and-add and mongomery ladder. The latter is the default and is intended to be mostly resistant to timing attacks, the former may be faster, depending on the number it multiplies by. @@ -36,14 +32,12 @@ Plan ------Some algorithms using these primitives will likely follow (ECDH, maybe ECDSA; also: better versions of the primitives).+Some algorithms using these primitives will likely follow (ECDH, ECDSA, OpenPGP; also: better versions of the primitives). Speed is a good goal, may have some more improvements in the future.-Testing is on the list.+A testing suite is on the list. Hyperelliptic Curves... maybe.-The upcoming Integer/GMP switch... haven't decided whether side to take... GMP-bindings or pure Haskell. + Motivation ----------- This is a side-project from which other people may benefit. Due to time-constraints, I can't work as much on it as I would like. If you use/like it or want to make some criticism heard, please write me an email.
hecc.cabal view
@@ -1,13 +1,13 @@ Name: hecc-Version: 0.3.3+Version: 0.4 Synopsis: Elliptic Curve Cryptography for Haskell Description: Pure math & algorithms for Elliptic Curve Cryptography in Haskell License: BSD3 License-file: COPYING-Copyright: (c) Marcel Fourné, 2009-2012+Copyright: (c) Marcel Fourné, 2009-2013 Author: Marcel Fourné Maintainer: Marcel Fourné (hecc@bitrot.dyndns.org)-Category: Cryptography+Category: Cryptography, Codec Stability: alpha Build-Type: Simple Cabal-Version: >=1.6@@ -19,10 +19,11 @@ src Build-Depends: base >= 4 && < 5,+ cereal, crypto-api, hF2 Exposed-modules: Codec.Crypto.ECC.Base Codec.Crypto.ECC.StandardCurves ghc-options:- -Wall -O2 -fllvm -feager-blackholing+ -Wall -O2 -fllvm -optlo-O3 -feager-blackholing
src/Codec/Crypto/ECC/Base.hs view
@@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Codec.Crypto.ECC.Base--- Copyright : (c) Marcel Fourné 20[09..12]+-- Copyright : (c) Marcel Fourné 20[09..13] -- License : BSD3 -- Maintainer : Marcel Fourné (hecc@bitrot.dyndns.org) --@@ -9,47 +9,385 @@ -- ----------------------------------------------------------------------------- -{-# LANGUAGE PatternGuards #-}+{-# LANGUAGE GADTs, PatternGuards, FlexibleInstances #-} -module Codec.Crypto.ECC.Base (ECP(..),- EC(..),+module Codec.Crypto.ECC.Base (EC(..),+ getBitLength,+ geta,+ getb,+ getp,+ getr,+ ECPF(..),+ getCurve,+ getx,+ gety,+ getz,+ getaz4,+ getxA,+ getyA,+ padd,+ pdouble, modinv, pmul, ison,- binary,--- generateInteger,- EPa(..), - EPp(..), - EPj(..), - EPmj(..),- p256point,- p384point,- p521point,- ECPF2(..),- ECurve(..),- ECSC(..),- modinvF2K, - pmulF2, - isonF2,- EPaF2(..), - EPpF2(..), - b283point,- k283point)- where + binary) + where -import Data.Bits-import Numeric-import Data.Char-import Data.List as L (length)-import Crypto.Types--- import Crypto.Random-import Codec.Crypto.ECC.StandardCurves import qualified Data.F2 as F2+import Data.Bits (testBit)+import Data.List as L (length)+import Numeric (showIntAtBase)+import Data.Char (intToDigit)+import Crypto.Types (BitLength)+import Data.Serialize (Serialize,put,get)+import Control.Applicative ((<$>),(<*>)) --- --- OLD Implementation, only for Integer--- +-- |all Elliptic Curves, the parameters being the BitLength L, A, B and P+data EC a where+ -- the Integer Curves, having the form y^2=x^3+A*x+B mod P+ ECi :: (BitLength, Integer, Integer, Integer,Integer) -> EC Integer+ -- the Curves on F2, having the form y^2+x*y=x^3+a*x^2+b mod P; relevant for "ison"+ ECb :: (BitLength, F2.F2, F2.F2, F2.F2,F2.F2) -> EC F2.F2+instance Eq (EC a) where+ (ECi (l,a,b,p,r)) == (ECi (l',a',b',p',r')) = l==l' && a==a' && b==b' && p==p' && r==r'+ (ECb (l,a,b,p,r)) == (ECb (l',a',b',p',r')) = l==l' && a==a' && b==b' && p==p' && r==r'+ _ == _ = False+instance Show (EC a) where+ show (ECi (l,a,b,p,r)) = "Curve with length" ++ show l ++", y^2=x^3+" ++ show a ++ "*x+" ++ show b ++ " mod " ++ show p ++ " and group order " ++ show r+ show (ECb (l,a,b,p,r)) = "Curve with length" ++ show l ++", y^2=x^3+" ++ show a ++ "*x+" ++ show b ++ " mod " ++ show p ++ " and group order " ++ show r+-- for now only an EC Integer instance, since F2 is not instance of Serialize; also: a very simple one+instance Serialize (EC Integer) where+ put (ECi (l,a,b,p,r)) = put l >> put a >> put b >> put p >> put r+ get = (ECi) <$> ((,,,,) <$> get <*> get <*> get <*> get <*> get) +-- |get bitlength +getBitLength :: EC a -> Int+getBitLength (ECi (l,_,_,_,_)) = l+getBitLength (ECb (l,_,_,_,_)) = l++-- |get Curve parameter A+geta :: EC a -> a+geta (ECi (_,a,_,_,_)) = a+geta (ECb (_,a,_,_,_)) = a++-- |get Curve parameter B+getb :: EC a -> a+getb (ECi (_,_,b,_,_)) = b+getb (ECb (_,_,b,_,_)) = b++-- |get Curve parameter P+getp :: EC a -> a+getp (ECi (_,_,_,p,_)) = p+getp (ECb (_,_,_,p,_)) = p++-- |get Curve order r+getr :: EC a -> a+getr (ECi (_,_,_,_,r)) = r+getr (ECb (_,_,_,_,r)) = r++-- every point has a curve on which it is valid (has to be tested manually), plus possibly some coordinates+-- parametrised by the kind of numbers one which it may be computed+-- point formats may be translated through functions+-- |data of all Elliptic Curve Points+data ECPF a where + -- Elliptic Curve Point Affine coordinates, two parameters x and y+ ECPa :: (EC Integer, Integer, Integer) -> ECPF Integer+ -- Elliptic Curve Point Projective coordinates, three parameters x, y and z, like affine (x/z,y/z)+ ECPp ::(EC Integer, Integer, Integer, Integer) -> ECPF Integer+ -- Elliptic Curve Point Jacobian coordinates, three parameter x, y and z, like affine (x/z^2,y/z^3)+ ECPj :: (EC Integer, Integer, Integer, Integer) -> ECPF Integer+ -- Elliptic Curve Point Modified Jacobian coordinates, four parameters x,y,z and A*z^4 (A being the first curve-parameter), like affine coordinates (x/z^2,y/z^3)+ ECPmj :: (EC Integer, Integer, Integer, Integer, Integer) -> ECPF Integer+ -- Elliptic Curve Point Affine coordinates in F2, two parameters x and y+ ECPaF2 :: (EC F2.F2, F2.F2, F2.F2) -> ECPF F2.F2+ -- Elliptic Curve Point Projective coordinates in F2, three parameters x, y and z, like affine (x/z,y/z)+ ECPpF2 :: (EC F2.F2, F2.F2, F2.F2, F2.F2) -> ECPF F2.F2+ -- conserve the elliptic curve, but the point at infinity does not need coordinates+ -- Elliptic Curve Point at Infinity on an Integer Curve+ ECPInfI :: (EC Integer) -> ECPF Integer+ -- Elliptic Curve Point at Infinity on an F2 Curve+ ECPInfF2 :: (EC F2.F2) -> ECPF F2.F2+instance Eq (ECPF a) where+ (ECPa (curve,x,y)) == (ECPa (curve',x',y')) = curve==curve' && x==x' && y==y'+ (ECPp (curve,x,y,z)) == (ECPp (curve',x',y',z')) = curve==curve' && x==x' && y==y' && z==z'+ (ECPj (curve,x,y,z)) == (ECPj (curve',x',y',z')) = curve==curve' && x==x' && y==y' && z==z'+ (ECPmj (curve,x,y,z,az4)) == (ECPmj (curve',x',y',z',az4')) = curve==curve' && x==x' && y==y' && z==z' && az4==az4'+ (ECPaF2 (curve,x,y)) == (ECPaF2 (curve',x',y')) = curve==curve' && x==x' && y==y'+ (ECPpF2 (curve,x,y,z)) == (ECPpF2 (curve',x',y',z')) = curve==curve' && x==x' && y==y' && z==z'+ (ECPInfI curve) == (ECPInfI curve') = curve==curve'+ (ECPInfF2 curve) == (ECPInfF2 curve') = curve==curve'+ _ == _ = False+instance Show (ECPF a) where+ show (ECPa (curve,x,y)) = show (curve,x,y)+ show (ECPp (curve,x,y,z)) = show (curve,x,y,z)+ show (ECPj (curve,x,y,z)) = show (curve,x,y,z)+ show (ECPmj (curve,x,y,z,az4)) = show (curve,x,y,z,az4)+ show (ECPaF2 (curve,x,y)) = show (curve,x,y) + show (ECPpF2 (curve,x,y,z)) = show (curve,x,y,z)+ show (ECPInfI curve) = show "Point at Infinity on the " ++ show curve+ show (ECPInfF2 curve) = show "Point at Infinity on the " ++ show curve+-- for now only an ECPF Integer instance, since F2 is not instance of Serialize; also: a very simple one+instance Serialize (ECPF Integer) where+ -- not using getxA,getzA for a single put, because "decode . encode = id" and ECPInfI!+ -- the first char is a simple tag+ put pt@(ECPa _) = put 'a' >> (put $ getCurve pt) >> (put $ getx pt) >> (put $ gety pt)+ put pt@(ECPp _) = put 'p' >> (put $ getCurve pt) >> (put $ getx pt) >> (put $ gety pt) >> (put $ getz pt)+ put pt@(ECPj _) = put 'j' >> (put $ getCurve pt) >> (put $ getx pt) >> (put $ gety pt) >> (put $ getz pt)+ put pt@(ECPmj _) = put 'j' >> (put $ getCurve pt) >> (put $ getx pt) >> (put $ gety pt) >> (put $ getz pt) >> (put $ getaz4 pt)+ put pt@(ECPInfI _) = put 'i' >> (put $ getCurve pt)+ -- in the following part a monad is needed, because the tag t implicates the output type and how many get are done+ get = do+ t <- get+ case t of+ 'a' -> (ECPa) <$> ((,,) <$> get <*> get <*> get)+ 'p' -> (ECPp) <$> ((,,,) <$> get <*> get <*> get <*> get)+ 'j' -> (ECPj) <$> ((,,,) <$> get <*> get <*> get <*> get)+ 'm' -> (ECPmj) <$> ((,,,,) <$> get <*> get <*> get <*> get <*> get)+ 'i' -> (ECPInfI) <$> get+ _ -> fail "Wrong format!"+ + +-- |get contents of the curve+getCurve :: ECPF a -> EC a+getCurve (ECPa (curve,_,_)) = curve+getCurve (ECPp (curve,_,_,_)) = curve+getCurve (ECPj (curve,_,_,_)) = curve+getCurve (ECPmj (curve,_,_,_,_)) = curve+getCurve (ECPaF2 (curve,_,_)) = curve+getCurve (ECPpF2 (curve,_,_,_)) = curve+getCurve (ECPInfI c) = c+getCurve (ECPInfF2 c) = c++-- |generic getter, returning the x-value+getx :: ECPF a -> a+getx (ECPa (_,x,_)) = x+getx (ECPp (_,x,_,_)) = x+getx (ECPj (_,x,_,_)) = x+getx (ECPmj (_,x,_,_,_)) = x+getx (ECPaF2 (_,x,_)) = x+getx (ECPpF2 (_,x,_,_)) = x+getx (ECPInfI _) = undefined+getx (ECPInfF2 _) = undefined++-- |generic getter, returning the y-value+gety :: ECPF a -> a+gety (ECPa (_,_,y)) = y+gety (ECPp (_,_,y,_)) = y+gety (ECPj (_,_,y,_)) = y+gety (ECPmj (_,_,y,_,_)) = y+gety (ECPaF2 (_,_,y)) = y+gety (ECPpF2 (_,_,y,_)) = y+gety (ECPInfI _) = undefined+gety (ECPInfF2 _) = undefined++-- |generic getter, returning the z-value for points having them+getz :: ECPF a -> a+getz (ECPa _) = undefined+getz (ECPp (_,_,_,z)) = z+getz (ECPj (_,_,_,z)) = z+getz (ECPmj (_,_,_,z,_)) = z+getz (ECPaF2 _) = undefined+getz (ECPpF2 (_,_,_,z)) = z+getz (ECPInfI _) = undefined+getz (ECPInfF2 _) = undefined++-- |generic getter, returning the a*z^4-value for points having them+getaz4 :: ECPF a -> a+getaz4 (ECPa _) = undefined+getaz4 (ECPp _) = undefined+getaz4 (ECPj _) = undefined+getaz4 (ECPmj (_,_,_,_,az4)) = az4+getaz4 (ECPaF2 _) = undefined+getaz4 (ECPpF2 _) = undefined+getaz4 (ECPInfI _) = undefined+getaz4 (ECPInfF2 _) = undefined++-- |generic getter, returning the affine x-value+getxA :: ECPF a -> a+getxA pt@(ECPa _) = getx pt+getxA pt@(ECPp _) = + let p = getp $ getCurve pt+ x = getx pt+ z = getz pt + in (x * (modinv z p)) `mod` p+getxA pt@(ECPj _) = + let p = getp $ getCurve pt+ x = getx pt+ z = getz pt + in (x * (modinv (z^(2::Int)) p)) `mod` p+getxA pt@(ECPmj _) = + let p = getp $ getCurve pt+ x = getx pt+ z = getz pt + in (x * (modinv (z^(2::Int)) p)) `mod` p+getxA pt@(ECPaF2 _) = getx pt+getxA pt@(ECPpF2 _) = + let p = getp $ getCurve pt+ x = getx pt+ z = getz pt + in (x `F2.mul` (F2.bininv z p)) `F2.reduceBy` p+getxA (ECPInfI _) = undefined+getxA (ECPInfF2 _) = undefined++-- |generic getter, returning the affine y-value+getyA :: ECPF a -> a+getyA pt@(ECPa _) = gety pt+getyA pt@(ECPp _) = + let p = getp $ getCurve pt+ y = gety pt+ z = getz pt + in (y * (modinv z p)) `mod` p+getyA pt@(ECPj _) = + let p = getp $ getCurve pt+ y = gety pt+ z = getz pt + in (y * (modinv (z^(3::Int)) p)) `mod` p+getyA pt@(ECPmj _) = + let p = getp $ getCurve pt+ y = gety pt+ z = getz pt + in (y * (modinv (z^(3::Int)) p)) `mod` p+getyA pt@(ECPaF2 _) = gety pt+getyA pt@(ECPpF2 _) = + let p = getp $ getCurve pt+ y = gety pt+ z = getz pt + in (y `F2.mul` (F2.bininv z p)) `F2.reduceBy` p+getyA (ECPInfI _) = undefined+getyA (ECPInfF2 _) = undefined++-- |add an elliptic point onto itself, base for padd a a+pdouble :: (ECPF a) -> (ECPF a)+pdouble pt@(ECPInfI _) = pt+pdouble pt@(ECPInfF2 _) = pt+pdouble pt@(ECPa _) = let curve = getCurve pt+ alpha = geta curve + p = getp curve+ x1 = getx pt+ y1 = gety pt+ lambda = ((3*x1^(2::Int)+alpha)*(modinv (2*y1) p)) `mod` p+ x3 = (lambda^(2::Int) - 2*x1) `mod` p+ y3 = (lambda*(x1-x3)-y1) `mod` p+ in ECPa (curve,x3,y3)+pdouble pt@(ECPp _) = let curve = getCurve pt+ alpha = geta curve + p = getp curve+ x1 = getx pt+ y1 = gety pt+ z1 = getz pt+ a = (alpha*z1^(2::Int)+3*x1^(2::Int)) `mod` p+ b = (y1*z1) `mod` p+ c = (x1*y1*b) `mod` p+ d = (a^(2::Int)-8*c) `mod` p+ x3 = (2*b*d) `mod` p+ y3 = (a*(4*c-d)-8*y1^(2::Int)*b^(2::Int)) `mod` p+ z3 = (8*b^(3::Int)) `mod` p+ in ECPp (curve,x3,y3,z3)+pdouble pt@(ECPj _) = let curve = getCurve pt+ alpha = geta curve + p = getp curve+ x1 = getx pt+ y1 = gety pt+ z1 = getz pt+ a = 4*x1*y1^(2::Int) `mod` p+ b = (3*x1^(2::Int) + alpha*z1^(4::Int)) `mod` p+ x3 = (-2*a + b^(2::Int)) `mod` p+ y3 = (-8*y1^(4::Int) + b*(a-x3)) `mod` p+ z3 = 2*y1*z1 `mod` p+ in ECPj (curve,x3,y3,z3)+pdouble pt@(ECPmj _) = let curve = getCurve pt+ p = getp curve+ x1 = getx pt+ y1 = gety pt+ z1 = getz pt+ z1' = getaz4 pt+ s = 4*x1*y1^(2::Int) `mod` p+ u = 8*y1^(4::Int) `mod` p+ m = (3*x1^(2::Int) + z1') `mod` p+ t = (-2*s + m^(2::Int)) `mod` p+ x3 = t+ y3 = (m*(s - t) - u) `mod` p+ z3 = 2*y1*z1 `mod` p+ z3' = 2*u*z1' `mod` p+ in ECPmj (curve,x3,y3,z3,z3')+pdouble pt@(ECPaF2 _) = let curve = getCurve pt+ alpha = geta curve + p = getp curve+ x1 = getx pt+ y1 = gety pt+ lambda = (x1 `F2.add` (y1 `F2.mul` (F2.bininv x1 p)))+ x3 = (lambda `F2.pow` (F2.fromInteger 2)) `F2.add` lambda `F2.add` alpha `F2.reduceBy` p+ y3 = (lambda `F2.mul` (x1 `F2.add` x3)) `F2.add` x3 `F2.add` y1 `F2.reduceBy` p+ in ECPaF2 (curve,x3,y3)+pdouble pt@(ECPpF2 _) = let curve = getCurve pt+ alpha = geta curve + p = getp curve+ x1 = getx pt+ y1 = gety pt+ z1 = getz pt+ a = (x1 `F2.pow` (F2.fromInteger 2)) `F2.reduceBy` p+ b = (a `F2.add` (y1 `F2.mul` z1)) `F2.reduceBy` p+ c = (x1 `F2.mul` z1) `F2.reduceBy` p+ d = (c `F2.pow` (F2.fromInteger 2)) `F2.reduceBy` p+ e = ((b `F2.pow` (F2.fromInteger 2)) `F2.add` (b `F2.mul` c) `F2.add` (alpha `F2.mul` d)) `F2.reduceBy` p+ x3 = (c `F2.mul` e) `F2.reduceBy` p+ y3 = (((b `F2.add` c) `F2.mul` e) `F2.add` ((a `F2.pow` (F2.fromInteger 2)) `F2.mul` c)) `F2.reduceBy` p+ z3 = (c `F2.mul` d) `F2.reduceBy` p+ in ECPpF2 (curve,x3,y3,z3)++-- |"generic" verify, if generic ECP is on EC via getxA and getyA+ison :: ECPF a -> Bool+ison pt@(ECPa _) = + let curve = getCurve pt+ alpha = geta curve+ beta = getb curve+ p = getp curve+ x = getxA pt+ y = getyA pt+ in (y^(2::Int)) `mod` p == (x^(3::Int)+alpha*x+beta) `mod` p+ison pt@(ECPp _) = + let curve = getCurve pt+ alpha = geta curve+ beta = getb curve+ p = getp curve+ x = getxA pt+ y = getyA pt+ in (y^(2::Int)) `mod` p == (x^(3::Int)+alpha*x+beta) `mod` p+ison pt@(ECPj _) = + let curve = getCurve pt+ alpha = geta curve+ beta = getb curve+ p = getp curve+ x = getxA pt+ y = getyA pt+ in (y^(2::Int)) `mod` p == (x^(3::Int)+alpha*x+beta) `mod` p+ison pt@(ECPmj _) = + let curve = getCurve pt+ alpha = geta curve+ beta = getb curve+ p = getp curve+ x = getxA pt+ y = getyA pt+ in (y^(2::Int)) `mod` p == (x^(3::Int)+alpha*x+beta) `mod` p+ison pt@(ECPaF2 _) = + let curve = getCurve pt+ alpha = geta curve+ beta = getb curve+ p = getp curve+ x = getxA pt+ y = getyA pt+ in ((y `F2.pow` (F2.fromInteger 2)) `F2.add` (x `F2.mul` y)) `F2.reduceBy` p == ((x `F2.pow` (F2.fromInteger 3)) `F2.add` (alpha `F2.mul` (x `F2.pow` (F2.fromInteger 2))) `F2.add` beta) `F2.reduceBy` p+ison pt@(ECPpF2 _) = + let curve = getCurve pt+ alpha = geta curve+ beta = getb curve+ p = getp curve+ x = getxA pt+ y = getyA pt+ in ((y `F2.pow` (F2.fromInteger 2)) `F2.add` (x `F2.mul` y)) `F2.reduceBy` p == ((x `F2.pow` (F2.fromInteger 3)) `F2.add` (alpha `F2.mul` (x `F2.pow` (F2.fromInteger 2))) `F2.add` beta) `F2.reduceBy` p+ison (ECPInfI _) = True+ison (ECPInfF2 _) = True+ -- |extended euclidean algorithm, recursive variant eeukl :: (Integral a ) => a -> a -> (a, a, a) eeukl a 0 = (a,1,0)@@ -65,99 +403,30 @@ then mod y m else undefined ----- |class of all Elliptic Curves, has the form y^2=x^3+A*x+B mod P, the parameters being A, B and P-data EC = EC (Integer, Integer, Integer)- deriving (Eq)-instance Show EC where show (EC (a,b,p)) = "y^2=x^3+" ++ show a ++ "*x+" ++ show b ++ " mod " ++ show p---- |class of all Elliptic Curve Points-class ECP a where- -- |function returning the appropriate INF in the specific ECP-Format, for generic higher-level-algorithms- inf :: a- -- |build point from one in affine coordinates- fromAffineCoords :: EPa -> a- -- |get bitlength- getBitLength :: a -> Int- -- |get contents of the curve- getCurve :: a -> EC- -- |generic getter, returning the affine x-value- getx :: a -> Integer- -- |generic getters, returning the affine y-value- gety :: a -> Integer- -- |add an elliptic point onto itself, base for padd a a- pdouble :: a -> a- -- |add 2 elliptic points- padd :: a -> a -> a- --- |Elliptic Point Affine coordinates, two parameters x and y-data EPa = EPa (BitLength, EC, Integer, Integer) - | Infa- deriving (Eq)-instance Show EPa where show (EPa (a,b,c,d)) = show (a,b,c,d)- show Infa = "Null"-instance ECP EPa where - inf = Infa- fromAffineCoords = id- getBitLength (EPa (l,_,_,_)) = l- getBitLength (Infa) = undefined- getCurve (EPa (_,c,_,_)) = c- getCurve (Infa) = undefined- getx (EPa (_,_,x,_)) = x- getx Infa = undefined- gety (EPa (_,_,_,y)) = y- gety Infa = undefined- pdouble (EPa (l,c@(EC (alpha,_,p)),x1,y1)) = - let lambda = ((3*x1^(2::Int)+alpha)*(modinv (2*y1) p)) `mod` p- x3 = (lambda^(2::Int) - 2*x1) `mod` p- y3 = (lambda*(x1-x3)-y1) `mod` p- in EPa (l,c,x3,y3)- pdouble Infa = Infa- padd Infa a = a- padd a Infa = a- padd a@(EPa (l,c@(EC (_,_,p)),x1,y1)) b@(EPa (l',c',x2,y2)) - | x1==x2,y1==(-y2) = Infa+-- |add 2 elliptic points+padd :: (ECPF a) -> (ECPF a) -> (ECPF a)+padd pt@(ECPInfI _) _ = pt+padd _ pt@(ECPInfI _) = pt+padd pt@(ECPInfF2 _) _ = pt+padd _ pt@(ECPInfF2 _) = pt+padd a@(ECPa _) b@(ECPa _) + | x1==x2,y1==(-y2),curve==curve' = ECPInfI curve | a==b = pdouble a | otherwise = let lambda = ((y2-y1)*(modinv (x2-x1) p)) `mod` p x3 = (lambda^(2::Int) - x1 - x2) `mod` p y3 = (lambda*(x1-x3)-y1) `mod` p- in if l==l' && c==c' then EPa (l,c,x3,y3)+ in if curve==curve' then ECPa (curve,x3,y3) else undefined---- |Elliptic Point Projective coordinates, three parameters x, y and z, like affine (x/z,y/z)-data EPp = EPp (BitLength,EC,Integer, Integer, Integer) - | Infp- deriving (Eq)-instance Show EPp where show (EPp (a,b,c,d,e)) = show (a,b,c,d,e)- show Infp = "Null"-instance ECP EPp where- inf = Infp- fromAffineCoords (EPa (l,curve,a,b)) = EPp (l,curve,a,b,1)- fromAffineCoords Infa = Infp- getBitLength (EPp (l,_,_,_,_)) = l- getBitLength (Infp) = undefined- getCurve (EPp (_,c,_,_,_)) = c- getCurve (Infp) = undefined- getx (EPp (_,(EC (_,_,p)),x,_,z))= (x * (modinv z p)) `mod` p- getx Infp = undefined- gety (EPp (_,(EC (_,_,p)),_,y,z)) = (y * (modinv z p)) `mod` p- gety Infp = undefined- pdouble (EPp (l,curve@(EC (alpha,_,p)),x1,y1,z1)) = - let a = (alpha*z1^(2::Int)+3*x1^(2::Int)) `mod` p- b = (y1*z1) `mod` p- c = (x1*y1*b) `mod` p- d = (a^(2::Int)-8*c) `mod` p- x3 = (2*b*d) `mod` p- y3 = (a*(4*c-d)-8*y1^(2::Int)*b^(2::Int)) `mod` p- z3 = (8*b^(3::Int)) `mod` p- in EPp (l,curve,x3,y3,z3)- pdouble Infp = Infp- padd Infp a = a- padd a Infp = a- padd p1@(EPp (l,curve@(EC (_,_,p)),x1,y1,z1)) p2@(EPp (l',curve',x2,y2,z2))- | x1==x2,y1==(-y2) = Infp+ where curve = getCurve a+ p = getp curve+ x1 = getx a+ y1 = gety a+ curve' = getCurve b+ x2 = getx b+ y2 = gety b+padd p1@(ECPp _) p2@(ECPp _)+ | x1==x2,y1==(-y2),curve==curve' = ECPInfI curve | p1==p2 = pdouble p1 | otherwise = let a = (y2*z1 - y1*z2) `mod` p@@ -166,39 +435,19 @@ x3 = (b*c) `mod` p y3 = (a*(b^(2::Int)*x1*z2-c)-b^(3::Int)*y1*z2) `mod` p z3 = (b^(3::Int)*z1*z2) `mod` p- in if l==l' && curve==curve' then EPp (l,curve,x3,y3,z3)+ in if curve==curve' then ECPp (curve,x3,y3,z3) else undefined- --- |Elliptic Point Jacobian coordinates, three parameter x, y and z, like affine (x/z^2,y/z^3)-data EPj = EPj (BitLength,EC,Integer, Integer, Integer) - | Infj- deriving (Eq)-instance Show EPj where show (EPj (a,b,c,d,e)) = show (a,b,c,d,e)- show Infj = "Null"-instance ECP EPj where- inf = Infj- fromAffineCoords (EPa (l,curve,a,b)) = EPj (l,curve,a,b,1)- fromAffineCoords Infa = Infj- getBitLength (EPj (l,_,_,_,_)) = l- getBitLength (Infj) = undefined- getCurve (EPj (_,c,_,_,_)) = c- getCurve (Infj) = undefined- getx (EPj (_,(EC (_,_,p)),x,_,z))= (x * (modinv (z^(2::Int)) p)) `mod` p- getx Infj = undefined- gety (EPj (_,(EC (_,_,p)),_,y,z)) = (y * (modinv (z^(3::Int)) p)) `mod` p- gety Infj = undefined- pdouble (EPj (l,c@(EC (alpha,_,p)),x1,y1,z1)) = - let a = 4*x1*y1^(2::Int) `mod` p- b = (3*x1^(2::Int) + alpha*z1^(4::Int)) `mod` p- x3 = (-2*a + b^(2::Int)) `mod` p- y3 = (-8*y1^(4::Int) + b*(a-x3)) `mod` p- z3 = 2*y1*z1 `mod` p- in EPj (l,c,x3,y3,z3)- pdouble Infj = Infj- padd Infj a = a- padd a Infj = a - padd p1@(EPj (l,curve@(EC (_,_,p)),x1,y1,z1)) p2@(EPj (l',curve',x2,y2,z2))- | x1==x2,y1==(-y2) = Infj+ where curve = getCurve p1+ p = getp curve+ x1 = getx p1+ y1 = gety p1+ z1 = getz p1+ curve' = getCurve p2+ x2 = getx p2+ y2 = gety p2 + z2 = getz p2+padd p1@(ECPj _) p2@(ECPj _)+ | x1==x2,y1==(-y2),curve==curve' = ECPInfI curve | p1==p2 = pdouble p1 | otherwise = let a = (x1*z2^(2::Int)) `mod` p@@ -210,42 +459,19 @@ x3 = (-e^(3::Int) - 2*a*e^(2::Int) + f^(2::Int)) `mod` p y3 = (-c*e^(3::Int) + f*(a*e^(2::Int) - x3)) `mod` p z3 = (z1*z2*e) `mod` p- in if l==l' && curve==curve' then EPj (l,curve,x3,y3,z3)+ in if curve==curve' then ECPj (curve,x3,y3,z3) else undefined---- |Elliptic Point Modified Jacobian coordinates, four parameters x,y,z and A*z^4 (A being the first curve-parameter), like affine coordinates (x/z^2,y/z^3)-data EPmj = EPmj (BitLength,EC,Integer, Integer, Integer, Integer) - | Infmj- deriving (Eq)-instance Show EPmj where show (EPmj (a,b,c,d,e,f)) = show (a,b,c,d,e,f)- show Infmj = "Null"-instance ECP EPmj where- inf = Infmj- fromAffineCoords (EPa (l,curve@(EC (alpha,_,_)),a,b)) = EPmj (l,curve,a,b,1,alpha)- fromAffineCoords Infa = Infmj- getBitLength (EPmj (l,_,_,_,_,_)) = l- getBitLength (Infmj) = undefined- getCurve (EPmj (_,c,_,_,_,_)) = c- getCurve (Infmj) = undefined- getx (EPmj (_,(EC (_,_,p)),x,_,z,_)) = (x * (modinv (z^(2::Int)) p)) `mod` p- getx Infmj = undefined- gety (EPmj (_,(EC (_,_,p)),_,y,z,_)) = (y * (modinv (z^(3::Int)) p)) `mod` p- gety Infmj = undefined- pdouble (EPmj (l,c@(EC (_,_,p)),x1,y1,z1,z1')) = - let s = 4*x1*y1^(2::Int) `mod` p- u = 8*y1^(4::Int) `mod` p- m = (3*x1^(2::Int) + z1') `mod` p- t = (-2*s + m^(2::Int)) `mod` p- x3 = t- y3 = (m*(s - t) - u) `mod` p- z3 = 2*y1*z1 `mod` p- z3' = 2*u*z1' `mod` p- in EPmj (l,c,x3,y3,z3,z3')- pdouble Infmj = Infmj- padd Infmj a = a- padd a Infmj = a - padd p1@(EPmj (l,curve@(EC (alpha,_,p)),x1,y1,z1,_)) p2@(EPmj (l',curve',x2,y2,z2,_))- | x1==x2,y1==(-y2) = Infmj+ where curve = getCurve p1+ p = getp curve+ x1 = getx p1+ y1 = gety p1+ z1 = getz p1+ curve' = getCurve p2+ x2 = getx p2+ y2 = gety p2 + z2 = getz p2+padd p1@(ECPmj _) p2@(ECPmj _)+ | x1==x2,y1==(-y2),curve==curve' = ECPInfI curve | p1==p2 = pdouble p1 | otherwise = let u1 = (x1*z2^(2::Int)) `mod` p@@ -258,195 +484,38 @@ y3 = (-s1*h^(3::Int) + r*(u1*h^(2::Int) - x3)) `mod` p z3 = (z1*z2*h) `mod` p z3' = (alpha*z3^(4::Int)) `mod` p- in if l==l' && curve==curve' then EPmj (l,curve,x3,y3,z3,z3')+ in if curve==curve' then ECPmj (curve,x3,y3,z3,z3') else undefined---- |this is a generic handle for Point Multiplication. The implementation may change.-pmul :: (ECP a) => a -- ^the point to multiply- -> Integer -- ^times to multiply the point- -> a -- ^the result-point-pmul = montgladder-{-pmul = dnadd---- |double and add for generic ECP-dnadd :: (ECP a) => a -> Integer -> a-dnadd b k' = - let (EC (_,_,p)) = getCurve b- k = k' `mod` (p - 1)- ex a i- | i < 0 = a- | not (testBit k i) = ex (pdouble a) (i - 1)- | otherwise = ex (padd (pdouble a) b) (i - 1)- in ex inf (L.length (binary k) - 1)--}---- montgomery ladder, timing-attack-resistant (except for caches...)-montgladder :: (ECP a) => a -> Integer -> a-montgladder b k' =- let (EC (_,_,p)) = getCurve b- k = k' `mod` (p - 1)- ex p1 p2 i- | i < 0 = p1- | not (testBit k i) = ex (pdouble p1) (padd p1 p2) (i - 1)- | otherwise = ex (padd p1 p2) (pdouble p2) (i - 1)- in ex b (pdouble b) ((L.length (binary k)) - 2)---- binary representation of an integer--- taken from http://haskell.org/haskellwiki/Fibonacci_primes_in_parallel-binary :: Integer -> String-binary = flip (showIntAtBase 2 intToDigit) []---- |generic verify, if generic ECP is on EC via getx and gety-ison :: (ECP a) => a -- ^ the elliptic curve point which we check- -> Bool -- ^is the point on the curve?-ison pt = let (EC (alpha,beta,p)) = getCurve pt- x = getx pt- y = gety pt- in (y^(2::Int)) `mod` p == (x^(3::Int)+alpha*x+beta) `mod` p-{---- | given a generator and a curve, generate a point randomly-genkey :: (ECP a) => a -- ^a generator (a point on the curve which multiplied gets to be every other point on the curve)- -> EC -- ^the curve- -> IO a -- ^the random point which will be the key-genkey a c@(EC (_,_,p)) = do- n <- evalRandIO $ getRandomR (1,p)- return $ pmul a n c--}-{--generateInteger :: (ECP a, CryptoRandomGen g) => a -> g -> Maybe (Integer, g)-generateInteger base g = let (EC (_,_,p)) = getCurve base- in case genInteger g (1,p-1) of- Left _ -> Nothing- Right (random1,g') -> Just (random1,g')--} --- helper-functions for getting basic points with less fuss-p521point :: (ECP a) => a-p521point = fromAffineCoords (EPa (stdc_l p521,(EC (stdc_a p521,stdc_b p521,stdc_p p521)), stdc_xp p521,stdc_xp p521))--p256point :: (ECP a) => a-p256point = fromAffineCoords (EPa (stdc_l p256,(EC (stdc_a p256,stdc_b p256,stdc_p p256)), stdc_xp p256,stdc_xp p256))--p384point :: (ECP a) => a-p384point = fromAffineCoords (EPa (stdc_l p384,(EC (stdc_a p384,stdc_b p384,stdc_p p384)), stdc_xp p384,stdc_xp p384))------ --- NEW Implementation, for F(2^e)--- ---- platzhalter, falls aufteilen mehr bringt, ansonsten weiter montgladder--- |computing the modular inverse of @a@ `emod` @m@-modinvF2K :: (ECPF2 a) => a -- ^the point to invert- -> a -- ^the inverted point-modinvF2K x = let d = getBitLengthF2 x- in pmulF2 x ((2^d)-2)- --- | All Elliptic Curves, binary-class ECurve a where- getA :: a -> F2.F2- getB :: a -> F2.F2- getP :: a -> F2.F2---- DATATYPECONTEXT, fix?!--- |class of (non-hyper) Elliptic Curves, has the form y^2+x*y=x^3+A*x^2+B mod P, the parameters being A, B and P-data ECSC = ECSC (F2.F2, F2.F2, F2.F2)- deriving (Eq)-instance Show ECSC where show (ECSC (a,b,p)) = "y^2+x*y=x^3+" ++ show ((F2.toInteger a)::Integer) ++ "*x^2+" ++ show ((F2.toInteger b)::Integer) ++ " mod " ++ show ((F2.toInteger p)::Integer)-instance ECurve ECSC where- getA (ECSC (a,_,_)) = a- getB (ECSC (_,b,_)) = b- getP (ECSC (_,_,p)) = p---- |class of all Elliptic Curve Points-class ECPF2 a where- -- |function returning the appropriate INF in the specific ECP-Format, for generic higher-level-algorithms- infF2 :: a- -- |build point from one in affine coordinates- fromAffineCoordsF2 :: EPaF2 -> a- -- |get bitlength- getBitLengthF2 :: a -> BitLength- -- |get contents of the curve- getCurveF2 :: a -> ECSC- -- |generic getter, returning the affine x-value- getxF2 :: a -> F2.F2- -- |generic getters, returning the affine y-value- getyF2 :: a -> F2.F2- -- |add an elliptic point onto itself, base for padd a a- pdoubleF2 :: a -> a- -- |add 2 elliptic points- paddF2 :: a -> a -> a- --- |Elliptic Point Affine coordinates, two parameters x and y-data EPaF2 = EPaF2 (BitLength, ECSC, F2.F2, F2.F2) - | InfaF2- deriving (Eq)-instance Show EPaF2 where show (EPaF2 (a,b,c,d)) = show (a,b,((F2.toInteger c)::Integer),((F2.toInteger d)::Integer))- show InfaF2 = "Null"-instance ECPF2 EPaF2 where - infF2 = InfaF2- fromAffineCoordsF2 = id- getBitLengthF2 (EPaF2 (l,_,_,_)) = l- getBitLengthF2 (InfaF2) = undefined- getCurveF2 (EPaF2 (_,c,_,_)) = c- getCurveF2 (InfaF2) = undefined- getxF2 (EPaF2 (_,_,x,_)) = x- getxF2 InfaF2 = undefined- getyF2 (EPaF2 (_,_,_,y)) = y- getyF2 InfaF2 = undefined- pdoubleF2 (EPaF2 (l,c@(ECSC (alpha,_,p)),x1,y1)) = - let lambda = (x1 `F2.add` (y1 `F2.mul` (F2.bininv x1 p)))- x3 = (lambda `F2.pow` (F2.fromInteger 2)) `F2.add` lambda `F2.add` alpha `F2.reduceBy` p- y3 = (lambda `F2.mul` (x1 `F2.add` x3)) `F2.add` x3 `F2.add` y1 `F2.reduceBy` p- in EPaF2 (l,c,x3,y3)- pdoubleF2 InfaF2 = InfaF2- paddF2 InfaF2 a = a- paddF2 a InfaF2 = a- paddF2 a@(EPaF2 (l,c@(ECSC (alpha,_,p)),x1,y1)) b@(EPaF2 (l',c',x2,y2)) - | ((F2.length x1 == F2.length x2) && (x1==x2)), (F2.length y1 == F2.length y2 && F2.length x2 == F2.length y2) && (y1==(x2 `F2.add` y2)) = InfaF2- | (F2.length x1 == F2.length x2) && (F2.length y1 == F2.length y2) && a==b = pdoubleF2 a+ where curve = getCurve p1+ alpha = geta curve+ p = getp curve+ x1 = getx p1+ y1 = gety p1+ z1 = getz p1+ curve' = getCurve p2+ x2 = getx p2+ y2 = gety p2 + z2 = getz p2+padd a@(ECPaF2 _) b@(ECPaF2 _) + | ((F2.length x1 == F2.length x2) && (x1==x2)), (F2.length y1 == F2.length y2 && F2.length x2 == F2.length y2) && (y1==(x2 `F2.add` y2)), curve==curve' = ECPInfF2 curve+ | (F2.length x1 == F2.length x2) && (F2.length y1 == F2.length y2) && a==b = pdouble a | otherwise = let lambda = ((y1 `F2.add` y2) `F2.mul` (F2.bininv (x1 `F2.add` x2) p)) `F2.reduceBy` p x3 = ((lambda `F2.pow` (F2.fromInteger 2)) `F2.add` lambda `F2.add` x1 `F2.add` x2 `F2.add` alpha) `F2.reduceBy` p y3 = ((lambda `F2.mul` (x1 `F2.add` x3)) `F2.add` x3 `F2.add` y1) `F2.reduceBy` p- in if l==l' && c==c' then EPaF2 (l,c,x3,y3)+ in if curve==curve' then ECPaF2 (curve,x3,y3) else undefined---- |Elliptic Point Projective coordinates, three parameters x, y and z, like affine (x/z,y/z)-data EPpF2 = EPpF2 (BitLength, ECSC, F2.F2, F2.F2, F2.F2) - | InfpF2- deriving (Eq)-instance Show EPpF2 where show (EPpF2 (a,b,c,d,e)) = show (a,b,((F2.toInteger c)::Integer),((F2.toInteger d)::Integer),((F2.toInteger e)::Integer))- show InfpF2 = "Null"--instance ECPF2 EPpF2 where- infF2 = InfpF2- fromAffineCoordsF2 (EPaF2 (l,curve,a,b)) = EPpF2 (l,curve,a,b,F2.fromInteger 1)- fromAffineCoordsF2 InfaF2 = InfpF2- getBitLengthF2 (EPpF2 (l,_,_,_,_)) = l- getBitLengthF2 (InfpF2) = undefined- getCurveF2 (EPpF2 (_,c,_,_,_)) = c- getCurveF2 (InfpF2) = undefined- getxF2 (EPpF2 (_,(ECSC (_,_,p)),x,_,z))= (x `F2.mul` (F2.bininv z p)) `F2.reduceBy` p- getxF2 InfpF2 = undefined- getyF2 (EPpF2 (_,(ECSC (_,_,p)),_,y,z)) = (y `F2.mul` (F2.bininv z p)) `F2.reduceBy` p- getyF2 InfpF2 = undefined- pdoubleF2 (EPpF2 (l,curve@(ECSC (alpha,_,p)),x1,y1,z1)) = - let a = (x1 `F2.pow` (F2.fromInteger 2)) `F2.reduceBy` p- b = (a `F2.add` (y1 `F2.mul` z1)) `F2.reduceBy` p- c = (x1 `F2.mul` z1) `F2.reduceBy` p- d = (c `F2.pow` (F2.fromInteger 2)) `F2.reduceBy` p- e = ((b `F2.pow` (F2.fromInteger 2)) `F2.add` (b `F2.mul` c) `F2.add` (alpha `F2.mul` d)) `F2.reduceBy` p- x3 = (c `F2.mul` e) `F2.reduceBy` p- y3 = (((b `F2.add` c) `F2.mul` e) `F2.add` ((a `F2.pow` (F2.fromInteger 2)) `F2.mul` c)) `F2.reduceBy` p- z3 = (c `F2.mul` d) `F2.reduceBy` p- in EPpF2 (l,curve,x3,y3,z3)- pdoubleF2 InfpF2 = InfpF2- paddF2 InfpF2 a = a- paddF2 a InfpF2 = a- paddF2 p1@(EPpF2 (l,curve@(ECSC (alpha,_,p)),x1,y1,z1)) p2@(EPpF2 (l',curve',x2,y2,z2))- | ((F2.length x1 == F2.length x2) && (x1==x2)),((F2.length y1 == F2.length y2 && F2.length x2 == F2.length y2) && y1==(x2 `F2.add` y2)) = InfpF2- | (F2.length x1 == F2.length x2) && (F2.length y1 == F2.length y2) && p1==p2 = pdoubleF2 p1+ where curve = getCurve a+ alpha = geta curve+ p = getp curve+ x1 = getx a+ y1 = gety a+ curve' = getCurve b+ x2 = getx b+ y2 = gety b+padd p1@(ECPpF2 _) p2@(ECPpF2 _)+ | ((F2.length x1 == F2.length x2) && (x1==x2)),((F2.length y1 == F2.length y2 && F2.length x2 == F2.length y2) && y1==(x2 `F2.add` y2)) = ECPInfF2 curve+ | (F2.length x1 == F2.length x2) && (F2.length y1 == F2.length y2) && p1==p2 = pdouble p1 | otherwise = let a = ((y1 `F2.mul` z2) `F2.add` (z1 `F2.mul` y2)) `F2.reduceBy` p b = ((x1 `F2.mul` z2) `F2.add` (z1 `F2.mul` x2)) `F2.reduceBy` p@@ -456,36 +525,78 @@ x3 = (b `F2.mul` e) `F2.reduceBy` p y3 = (((c `F2.mul` ((a `F2.mul` x1) `F2.add` (y1 `F2.mul` b))) `F2.mul` z2) `F2.add` ((a `F2.add` b) `F2.mul` e)) `F2.reduceBy` p z3 = ((b `F2.pow` (F2.fromInteger 3)) `F2.mul` d) `F2.reduceBy` p- in if l==l' && curve==curve' then EPpF2 (l,curve,x3,y3,z3)+ in if curve==curve' then ECPpF2 (curve,x3,y3,z3) else undefined- + where curve = getCurve p1+ alpha = geta curve+ p = getp curve+ x1 = getx p1+ y1 = gety p1+ z1 = getz p1+ curve' = getCurve p2+ x2 = getx p2+ y2 = gety p2 + z2 = getz p2+padd _ _ = undefined+ -- |this is a generic handle for Point Multiplication. The implementation may change.-pmulF2 :: (ECPF2 a) => a -- ^the point to multiply- -> Integer -- ^times to multiply the point- -> (ECPF2 a) => a -- ^the result-point-pmulF2 = montgladderF2+pmul :: (ECPF a) -> Integer -> (ECPF a)+pmul = montgladder -- montgomery ladder, timing-attack-resistant (except for caches...)-montgladderF2 :: (ECPF2 a) => a -> Integer -> a-montgladderF2 b k' =- let (ECSC (_,_,p)) = getCurveF2 b+montgladder :: (ECPF a) -> Integer -> (ECPF a)+montgladder b@(ECPa _) k' = + let p = getp $ getCurve b+ k = k' `mod` (p - 1)+ ex p1 p2 i+ | i < 0 = p1+ | not (testBit k i) = ex (pdouble p1) (padd p1 p2) (i - 1)+ | otherwise = ex (padd p1 p2) (pdouble p2) (i - 1)+ in ex b (pdouble b) ((L.length (binary k)) - 2)+montgladder b@(ECPp _) k' = + let p = getp $ getCurve b+ k = k' `mod` (p - 1)+ ex p1 p2 i+ | i < 0 = p1+ | not (testBit k i) = ex (pdouble p1) (padd p1 p2) (i - 1)+ | otherwise = ex (padd p1 p2) (pdouble p2) (i - 1)+ in ex b (pdouble b) ((L.length (binary k)) - 2)+montgladder b@(ECPj _) k' = + let p = getp $ getCurve b+ k = k' `mod` (p - 1)+ ex p1 p2 i+ | i < 0 = p1+ | not (testBit k i) = ex (pdouble p1) (padd p1 p2) (i - 1)+ | otherwise = ex (padd p1 p2) (pdouble p2) (i - 1)+ in ex b (pdouble b) ((L.length (binary k)) - 2)+montgladder b@(ECPmj _) k' = + let p = getp $ getCurve b+ k = k' `mod` (p - 1)+ ex p1 p2 i+ | i < 0 = p1+ | not (testBit k i) = ex (pdouble p1) (padd p1 p2) (i - 1)+ | otherwise = ex (padd p1 p2) (pdouble p2) (i - 1)+ in ex b (pdouble b) ((L.length (binary k)) - 2)+montgladder b@(ECPaF2 _) k' = + let p = getp $ getCurve b k = k' `mod` ((F2.toInteger p) - 1) ex p1 p2 i | i < 0 = p1- | not (testBit k i) = ex (pdoubleF2 p1) (paddF2 p1 p2) (i - 1)- | otherwise = ex (paddF2 p1 p2) (pdoubleF2 p2) (i - 1)- in ex b (pdoubleF2 b) ((L.length (binary k)) - 2)---- |generic verify, if generic ECP is on EC via getx and gety-isonF2 :: (ECPF2 a, Eq a) => a -- ^ the elliptic curve point which we check- -> Bool -- ^is the point on the curve?-isonF2 pt = let (ECSC (alpha,beta,p)) = getCurveF2 pt- x = getxF2 pt- y = getyF2 pt- in ((y `F2.pow` (F2.fromInteger 2)) `F2.add` (x `F2.mul` y)) `F2.reduceBy` p == ((x `F2.pow` (F2.fromInteger 3)) `F2.add` (alpha `F2.mul` (x `F2.pow` (F2.fromInteger 2))) `F2.add` beta) `F2.reduceBy` p--b283point :: (ECPF2 a) => a-b283point = fromAffineCoordsF2 (EPaF2 (stdcF_l b283,(ECSC (stdcF_a b283,stdcF_b b283,stdcF_p b283)), stdcF_xp b283,stdcF_yp b283))--k283point :: (ECPF2 a) => a-k283point = fromAffineCoordsF2 (EPaF2 (stdcF_l k283,(ECSC (stdcF_a k283,stdcF_b k283,stdcF_p k283)), stdcF_xp k283,stdcF_yp k283))+ | not (testBit k i) = ex (pdouble p1) (padd p1 p2) (i - 1)+ | otherwise = ex (padd p1 p2) (pdouble p2) (i - 1)+ in ex b (pdouble b) ((L.length (binary k)) - 2)+montgladder b@(ECPpF2 _) k' = + let p = getp $ getCurve b+ k = k' `mod` ((F2.toInteger p) - 1)+ ex p1 p2 i+ | i < 0 = p1+ | not (testBit k i) = ex (pdouble p1) (padd p1 p2) (i - 1)+ | otherwise = ex (padd p1 p2) (pdouble p2) (i - 1)+ in ex b (pdouble b) ((L.length (binary k)) - 2)+montgladder b@(ECPInfI _) _ = b+montgladder b@(ECPInfF2 _) _ = b+ +-- |binary representation of an integer+-- |taken from http://haskell.org/haskellwiki/Fibonacci_primes_in_parallel+binary :: Integer -> String+binary = flip (showIntAtBase 2 intToDigit) []
src/Codec/Crypto/ECC/StandardCurves.hs view
@@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Codec.Crypto.ECC.StandardCurves--- Copyright : (c) Marcel Fourné 2009-2012+-- Copyright : (c) Marcel Fourné 20[09..13] -- License : BSD3 -- Maintainer : Marcel Fourné (hecc@bitrot.dyndns.org) --@@ -13,57 +13,70 @@ where import qualified Data.F2 as F2+import Crypto.Types (BitLength) -data StandardCurve = StandardCurve {stdc_l::Int,stdc_p::Integer,stdc_a::Integer,stdc_b::Integer,stdc_xp::Integer,stdc_yp::Integer}+-- | Datatype for Prime Curves+data StandardCurve = StandardCurve {stdc_l::BitLength,stdc_p::Integer,stdc_r::Integer,stdc_a::Integer,stdc_b::Integer,stdc_xp::Integer,stdc_yp::Integer} --- Curves over Prime Fields, NIST variety+-- | Datatype for Curves on Binary Fields (F2)+data StandardCurveF2 = StandardCurveF2 {stdcF_l::Int,stdcF_p::F2.F2,stdcF_r::F2.F2,stdcF_a::F2.F2,stdcF_b::F2.F2,stdcF_xp::F2.F2,stdcF_yp::F2.F2} -p521:: StandardCurve-p521 = StandardCurve {- stdc_l = 521,- stdc_p = 6864797660130609714981900799081393217269435300143305409394463459185543183397656052122559640661454554977296311391480858037121987999716643812574028291115057151,- stdc_a = 6864797660130609714981900799081393217269435300143305409394463459185543183397656052122559640661454554977296311391480858037121987999716643812574028291115057148,- stdc_b = 1093849038073734274511112390766805569936207598951683748994586394495953116150735016013708737573759623248592132296706313309438452531591012912142327488478985984,- stdc_xp = 2661740802050217063228768716723360960729859168756973147706671368418802944996427808491545080627771902352094241225065558662157113545570916814161637315895999846,- stdc_yp = 3757180025770020463545507224491183603594455134769762486694567779615544477440556316691234405012945539562144444537289428522585666729196580810124344277578376784- }+-- Curves over Prime Fields, NIST variety +-- | NIST Prime Curve P-256 p256:: StandardCurve p256 = StandardCurve { stdc_l = 256, stdc_p = 115792089210356248762697446949407573530086143415290314195533631308867097853951,+ stdc_r = 0, stdc_a = 115792089210356248762697446949407573530086143415290314195533631308867097853948, stdc_b = 41058363725152142129326129780047268409114441015993725554835256314039467401291, stdc_xp = 48439561293906451759052585252797914202762949526041747995844080717082404635286, stdc_yp = 36134250956749795798585127919587881956611106672985015071877198253568414405109 } +-- | NIST Prime Curve P-384 p384:: StandardCurve p384 = StandardCurve { stdc_l = 384, stdc_p = 39402006196394479212279040100143613805079739270465446667948293404245721771496870329047266088258938001861606973112319,+ stdc_r = 0, stdc_a = 39402006196394479212279040100143613805079739270465446667948293404245721771496870329047266088258938001861606973112316, stdc_b = 27580193559959705877849011840389048093056905856361568521428707301988689241309860865136260764883745107765439761230575, stdc_xp = 26247035095799689268623156744566981891852923491109213387815615900925518854738050089022388053975719786650872476732087, stdc_yp = 8325710961489029985546751289520108179287853048861315594709205902480503199884419224438643760392947333078086511627871 } -data StandardCurveF2 = StandardCurveF2 {stdcF_l::Int,stdcF_p::F2.F2,stdcF_a::F2.F2,stdcF_b::F2.F2,stdcF_xp::F2.F2,stdcF_yp::F2.F2}+-- | NIST Prime Curve P-521+p521:: StandardCurve+p521 = StandardCurve {+ stdc_l = 521,+ stdc_p = 6864797660130609714981900799081393217269435300143305409394463459185543183397656052122559640661454554977296311391480858037121987999716643812574028291115057151,+ stdc_r = 0,+ stdc_a = 6864797660130609714981900799081393217269435300143305409394463459185543183397656052122559640661454554977296311391480858037121987999716643812574028291115057148,+ stdc_b = 1093849038073734274511112390766805569936207598951683748994586394495953116150735016013708737573759623248592132296706313309438452531591012912142327488478985984,+ stdc_xp = 2661740802050217063228768716723360960729859168756973147706671368418802944996427808491545080627771902352094241225065558662157113545570916814161637315895999846,+ stdc_yp = 3757180025770020463545507224491183603594455134769762486694567779615544477440556316691234405012945539562144444537289428522585666729196580810124344277578376784+ } +-- | NIST Binary Field Curve K-283 k283:: StandardCurveF2 k283 = StandardCurveF2 { stdcF_l = 283, stdcF_p = F2.fromInteger 15541351137805832567355695254588151253139254712417116170014499277911234281641667989665,+ stdcF_r = F2.fromInteger 0, stdcF_a = F2.fromInteger 0, stdcF_b = F2.fromInteger 1, stdcF_xp = F2.fromInteger 9737095673315832344313391497449387731784428326114441977662399932694280557468376967222, stdcF_yp = F2.fromInteger 3497201781826516614681192670485202061196189998012192335594744939847890291586353668697 } +-- | NIST Binary Field Curve B-283 b283:: StandardCurveF2 b283 = StandardCurveF2 { stdcF_l = 283, stdcF_p = F2.fromInteger 15541351137805832567355695254588151253139254712417116170014499277911234281641667989665,+ stdcF_r = F2.fromInteger 0, stdcF_a = F2.fromInteger 1, stdcF_b = F2.fromInteger 4821813576056072374006997780399081180312270030300601270120450341205914644378616963829, stdcF_xp = F2.fromInteger 11604587487407003699882500449177537465719784002620028212980871291231978603047872962643,
src/Examples.hs view
@@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module : --- Copyright : (c) Marcel Fourné 2009+-- Copyright : (c) Marcel Fourné 20[09-13] -- License : BSD3 -- Maintainer : Marcel Fourné (hecc@bitrot.dyndns.org --@@ -11,8 +11,8 @@ import Codec.Crypto.ECC.Base -ecdh :: (ECP a) => EC -> a -> Integer -> t -> Integer-ecdh c a kprivA kprivB = let kpubA = pmul a kprivA c- kpubB = pmul a kprivA c- ergA = pmul kpubB kprivA c- in getx ergA c+ecdh :: ECPF Integer -> Integer -> t -> Integer+ecdh a kprivA kprivB = let kpubA = pmul a kprivA+ kpubB = pmul a kprivA+ ergA = pmul kpubB kprivA+ in getx ergA
src/bench.hs view
@@ -1,53 +1,66 @@ ----------------------------------------------------------------------------- -- | -- Module : --- Copyright : (c) Marcel Fourné 2009+-- Copyright : (c) Marcel Fourné 20[09..13] -- License : BSD3 -- Maintainer : Marcel Fourné (hecc@bitrot.dyndns.org -- -- benchmarking playground, not production quality+-- recommended:+-- $ ghc --make -O2 -feager-blackholing -fforce-recomp -fllvm -threaded bench.hs+-- best performance measured with just 1 thread -- -----------------------------------------------------------------------------+{-# LANGUAGE ScopedTypeVariables #-}+ import Codec.Crypto.ECC.Base--- import Data.Array.Repa--- import Examples--- import Codec.Crypto.ECC.StandardCurves--- import Control.Monad.Random--- import Char+import Codec.Crypto.ECC.StandardCurves+import Control.Monad.Random+import Criterion+import Criterion.Main+import Data.Serialize+import qualified Data.F2 as F2 -testfkt:: (ECP a) => a -> Integer -> Int -> a+testfkt:: ECPF Integer -> Integer -> Int -> ECPF Integer testfkt b k' n = pmul b ((toInteger (n-n)) + k') +main::IO () main = do-{-- let p = p256point::EPp+-- {-+ let p = ECPp (ECi (stdc_l p256,stdc_a p256,stdc_b p256,stdc_p p256,stdc_r p256), stdc_xp p256,stdc_yp p256,1) -- k' = 78260987815077071890976764339238653408132491773166348437934213365482899760747 -- k' = 2^254+2^253+2^252+2^251+2^250+2^249 -- k' = 2^254+2^200+2^150+2^100+2^50+1 k' <- evalRandIO $ getRandomR (1,stdc_p p256)+ defaultMain [ bench "NIST P-256" $ whnf (testfkt p k') 10]+{- + case ((decode . encode) p) of+ Left msg -> print msg+ Right (pt::(ECPF Integer)) -> print pt+-}+-- -}+{-+ let p = ECPp (ECi (stdc_l p521, stdc_a p521, stdc_b p521,stdc_p p521,stdc_r p521),stdc_xp p521,stdc_yp p521,1)+-- k' = 1093849038073734274511112390766805569936207598951683748994586394495953116150735016013708737573759623248592132296706313309438452531591012912142327488478985984+ k' <- evalRandIO $ getRandomR (1,stdc_p p521) defaultMain [- bench "NIST P-256" $ whnf (testfkt p k') 10+ bench "NIST P-521" $ whnf (testfkt p k') 10 ]----}+-- -} {-- let c = EC (stdc_a p521, stdc_b p521,stdc_p p521)- k' = 1093849038073734274511112390766805569936207598951683748994586394495953116150735016013708737573759623248592132296706313309438452531591012912142327488478985984- in defaultMain [- bench "NIST P-521" $ whnf (testfkt (EPp (stdc_xp p521,stdc_yp p521,1)) k' c) 10- ]----}--- {-- let p = b283point::EPaF2+ let p = ECPpF2 (ECb (stdcF_l b283, stdcF_a b283, stdcF_b b283,stdcF_p b283,stdcF_r b283),stdcF_xp b283,stdcF_yp b283,F2.fromInteger 1) -- k' = 115792089210356248762697446949407573529996955224135760342422259061068512044368 -- k' = 2 -- k' = 3- k' = 2^20+ k' = 2^10 -- print p--- print (pdoubleF2 p)--- print $ modinvF2 (f2eFromInteger 4) (f2eFromInteger 7)- print $ pmulF2 p k'--- print $ isonF2 p----}+-- print (pdouble p)+-- print $ modinv (F2.fromInteger 4) (F2.fromInteger 7)+ print $ pmul p k'+-- print $ ison p+-- -}++-- for this one the prerequisites are not ready {- let p = 6277101735386680763835789423207666416083908700390324961279 a = 6277101735386680763835789423207666416083908700390324961276@@ -61,4 +74,4 @@ in defaultMain [ bench "ecdh" $ print [ (x,y)|x <-[1], y <- [(ecdh c alpha kprivA kprivB)]] ]----}+-- -}