{-# LANGUAGE PatternGuards,TypeOperators,FlexibleInstances,DatatypeContexts #-} -- | -- Module : Codec.Crypto.ECC.Base -- Copyright : (c) Marcel Fourné 20[09..10] -- License : BSD3 -- Maintainer : Marcel Fourné (hecc@bitrot.dyndns.org) -- -- ECC Base algorithms & point formats module Codec.Crypto.ECC.Base (ECP(..), EC(..), modinv, pmul, ison, binary, -- generateInteger, EPa(..), EPp(..), EPj(..), EPmj(..), p256point, p384point, p521point, ECPF2(..), ECCNum(..), ECurve(..), ECSC(..), modinvF2K, pmulF2, isonF2, EPaF2(..), EPpF2(..), b283point, k283point) 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.F2 import Codec.Crypto.ECC.StandardCurves import qualified Data.Array.Repa as R -- -- OLD Implementation, only for Integer -- -- |extended euclidean algorithm, recursive variant eeukl :: (Integral a ) => a -> a -> (a, a, a) eeukl a 0 = (a,1,0) eeukl a b = let (d,s,t) = eeukl b (a `mod` b) in (d,t,s-(div a b)*t) -- |computing the modular inverse of @a@ `mod` @m@ modinv :: (Integral a) => a -- ^the number to invert -> a -- ^the modulus -> a -- ^the inverted value modinv a m = let (x,y,_) = eeukl a m in if x == 1 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 | 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) 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 | p1==p2 = pdouble p1 | otherwise = let a = (y2*z1 - y1*z2) `mod` p b = (x2*z1 - x1*z2) `mod` p c = (a^(2::Int)*z1*z2 - b^(3::Int) - 2*b^(2::Int)*x1*z2) `mod` p 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) 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 | p1==p2 = pdouble p1 | otherwise = let a = (x1*z2^(2::Int)) `mod` p b = (x2*z1^(2::Int)) `mod` p c = (y1*z2^(3::Int)) `mod` p d = (y2*z1^(3::Int)) `mod` p e = (b - a) `mod` p f = (d - c) `mod` p 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) 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 | p1==p2 = pdouble p1 | otherwise = let u1 = (x1*z2^(2::Int)) `mod` p u2 = (x2*z1^(2::Int)) `mod` p s1 = (y1*z2^(3::Int)) `mod` p s2 = (y2*z1^(3::Int)) `mod` p h = (u2 - u1) `mod` p r = (s2 - s1) `mod` p x3 = (-h^(3::Int) - 2*u1*h^(2::Int) + r^(2::Int)) `mod` p 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') 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 :: (Integral a) => a -> 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) -- This class looks necessary, because repa has it's own Num-instance which is not what's wanted class ECCNum a where -- | abstract over (+) eadd :: a -> a -> a -- | abstract over (*) emul :: a -> a -> a -- | abstract over (^), used for small exponents epow :: a -> Integer -> a -- | abstract over mod emod :: a -> a -> a instance ECCNum (R.Array R.U R.DIM1 Bool) where eadd = f2eAdd emul = f2eMul epow = f2ePow emod = f2eReduceBy -- | All Elliptic Curves, binary class ECurve a where getA :: a -> R.Array R.U R.DIM1 Bool getB :: a -> R.Array R.U R.DIM1 Bool getP :: a -> R.Array R.U R.DIM1 Bool -- |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 (ECCNum a) => ECSC a = ECSC (a, a, a) deriving (Eq) instance Show (ECSC (R.Array R.U R.DIM1 Bool)) where show (ECSC (a,b,p)) = "y^2+x*y=x^3+" ++ show ((f2eToInteger a)::Integer) ++ "*x^2+" ++ show ((f2eToInteger b)::Integer) ++ " mod " ++ show ((f2eToInteger p)::Integer) instance ECurve (ECSC (R.Array R.U R.DIM1 Bool)) 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 (R.Array R.U R.DIM1 Bool) -- |generic getter, returning the affine x-value getxF2 :: a -> R.Array R.U R.DIM1 Bool -- |generic getters, returning the affine y-value getyF2 :: a -> R.Array R.U R.DIM1 Bool -- |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 (R.Array R.U R.DIM1 Bool), R.Array R.U R.DIM1 Bool, R.Array R.U R.DIM1 Bool) | InfaF2 deriving (Eq) instance Show EPaF2 where show (EPaF2 (a,b,c,d)) = show (a,b,((f2eToInteger c)::Integer),((f2eToInteger 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 `eadd` (y1 `emul` (modinvF2 x1 p))) x3 = (lambda `epow` 2) `eadd` lambda `eadd` alpha `emod` p y3 = (lambda `emul` (x1 `eadd` x3)) `eadd` x3 `eadd` y1 `emod` 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)) | ((f2eLen x1 == f2eLen x2) && (x1==x2)), (f2eLen y1 == f2eLen y2 && f2eLen x2 == f2eLen y2) && (y1==(x2 `eadd` y2)) = InfaF2 | (f2eLen x1 == f2eLen x2) && (f2eLen y1 == f2eLen y2) && a==b = pdoubleF2 a | otherwise = let lambda = ((y1 `eadd` y2) `emul` (modinvF2 (x1 `eadd` x2) p)) `emod` p x3 = ((lambda `epow` 2) `eadd` lambda `eadd` x1 `eadd` x2 `eadd` alpha) `emod` p y3 = ((lambda `emul` (x1 `eadd` x3)) `eadd` x3 `eadd` y1) `emod` p in if l==l' && c==c' then EPaF2 (l,c,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 (R.Array R.U R.DIM1 Bool), R.Array R.U R.DIM1 Bool, R.Array R.U R.DIM1 Bool, R.Array R.U R.DIM1 Bool) | InfpF2 deriving (Eq) instance Show EPpF2 where show (EPpF2 (a,b,c,d,e)) = show (a,b,((f2eToInteger c)::Integer),((f2eToInteger d)::Integer),((f2eToInteger e)::Integer)) show InfpF2 = "Null" instance ECPF2 EPpF2 where infF2 = InfpF2 fromAffineCoordsF2 (EPaF2 (l,curve,a,b)) = EPpF2 (l,curve,a,b,f2eFromInteger 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 `emul` (modinvF2 z p)) `emod` p getxF2 InfpF2 = undefined getyF2 (EPpF2 (_,(ECSC (_,_,p)),_,y,z)) = (y `emul` (modinvF2 z p)) `emod` p getyF2 InfpF2 = undefined pdoubleF2 (EPpF2 (l,curve@(ECSC (alpha,_,p)),x1,y1,z1)) = let a = (x1 `epow` 2) `emod` p b = (a `eadd` (y1 `emul` z1)) `emod` p c = (x1 `emul` z1) `emod` p d = (c `epow` 2) `emod` p e = ((b `epow` 2) `eadd` (b `emul` c) `eadd` (alpha `emul` d)) `emod` p x3 = (c `emul` e) `emod` p y3 = (((b `eadd` c) `emul` e) `eadd` ((a `epow` 2) `emul` c)) `emod` p z3 = (c `emul` d) `emod` 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)) | ((f2eLen x1 == f2eLen x2) && (x1==x2)),((f2eLen y1 == f2eLen y2 && f2eLen x2 == f2eLen y2) && y1==(x2 `eadd` y2)) = InfpF2 | (f2eLen x1 == f2eLen x2) && (f2eLen y1 == f2eLen y2) && p1==p2 = pdoubleF2 p1 | otherwise = let a = ((y1 `emul` z2) `eadd` (z1 `emul` y2)) `emod` p b = ((x1 `emul` z2) `eadd` (z1 `emul` x2)) `emod` p c = (x1 `emul` z1) `emod` p d = (c `epow` 2) `emod` p e = ((((a `epow` 2) `eadd` (a `emul` b) `eadd` (alpha `emul` c)) `emul` d) `eadd` (b `emul` c)) `emod` p x3 = (b `emul` e) `emod` p y3 = (((c `emul` ((a `emul` x1) `eadd` (y1 `emul` b))) `emul` z2) `eadd` ((a `eadd` b) `emul` e)) `emod` p z3 = ((b `epow` 3) `emul` d) `emod` p in if l==l' && curve==curve' then EPpF2 (l,curve,x3,y3,z3) else 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 -- montgomery ladder, timing-attack-resistant (except for caches...) montgladderF2 :: (ECPF2 a) => a -> Integer -> a montgladderF2 b k' = let (ECSC (_,_,p)) = getCurveF2 b k = k' `mod` ((f2eToInteger 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 `epow` 2) `eadd` (x `emul` y)) `emod` p == ((x `epow` 3) `eadd` (alpha `emul` (x `epow` 2)) `eadd` beta) `emod` 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))