module Codec.Crypto.ECC.Base (ECP(..),
EC(..),
modinv,
pmul,
ison,
binary,
EPa(..),
EPp(..),
EPj(..),
EPmj(..),
p256point,
p384point,
p521point,
ECPF2(..),
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 Codec.Crypto.ECC.StandardCurves
import qualified Data.F2 as F2
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)
modinv :: (Integral a) => a
-> a
-> a
modinv a m = let (x,y,_) = eeukl a m
in if x == 1
then mod y m
else undefined
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 ECP a where
inf :: a
fromAffineCoords :: EPa -> a
getBitLength :: a -> Int
getCurve :: a -> EC
getx :: a -> Integer
gety :: a -> Integer
pdouble :: a -> a
padd :: a -> a -> a
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*(x1x3)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 = ((y2y1)*(modinv (x2x1) p)) `mod` p
x3 = (lambda^(2::Int) x1 x2) `mod` p
y3 = (lambda*(x1x3)y1) `mod` p
in if l==l' && c==c' then EPa (l,c,x3,y3)
else undefined
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*cd)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*z2c)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
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*(ax3)) `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
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
pmul :: (ECP a) => a
-> Integer
-> a
pmul = montgladder
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 :: Integer -> String
binary = flip (showIntAtBase 2 intToDigit) []
ison :: (ECP a) => a
-> Bool
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
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))
modinvF2K :: (ECPF2 a) => a
-> a
modinvF2K x = let d = getBitLengthF2 x
in pmulF2 x ((2^d)2)
class ECurve a where
getA :: a -> F2.F2
getB :: a -> F2.F2
getP :: a -> F2.F2
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 ECPF2 a where
infF2 :: a
fromAffineCoordsF2 :: EPaF2 -> a
getBitLengthF2 :: a -> BitLength
getCurveF2 :: a -> ECSC
getxF2 :: a -> F2.F2
getyF2 :: a -> F2.F2
pdoubleF2 :: a -> a
paddF2 :: a -> a -> a
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
| 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)
else undefined
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
| 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
c = (x1 `F2.mul` z1) `F2.reduceBy` p
d = (c `F2.pow` (F2.fromInteger 2)) `F2.reduceBy` p
e = ((((a `F2.pow` (F2.fromInteger 2)) `F2.add` (a `F2.mul` b) `F2.add` (alpha `F2.mul` c)) `F2.mul` d) `F2.add` (b `F2.mul` c)) `F2.reduceBy` p
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)
else undefined
pmulF2 :: (ECPF2 a) => a
-> Integer
-> (ECPF2 a) => a
pmulF2 = montgladderF2
montgladderF2 :: (ECPF2 a) => a -> Integer -> a
montgladderF2 b k' =
let (ECSC (_,_,p)) = getCurveF2 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)
isonF2 :: (ECPF2 a, Eq a) => a
-> Bool
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))