module Crypto.PubKey.ECC.Prim
( scalarGenerate
, pointAdd
, pointNegate
, pointDouble
, pointBaseMul
, pointMul
, pointAddTwoMuls
, isPointAtInfinity
, isPointValid
) where
import Data.Maybe
import Crypto.Number.ModArithmetic
import Crypto.Number.F2m
import Crypto.Number.Generate (generateBetween)
import Crypto.PubKey.ECC.Types
import Crypto.Random
scalarGenerate :: MonadRandom randomly => Curve -> randomly PrivateNumber
scalarGenerate :: forall (randomly :: * -> *).
MonadRandom randomly =>
Curve -> randomly Integer
scalarGenerate Curve
curve = forall (m :: * -> *).
MonadRandom m =>
Integer -> Integer -> m Integer
generateBetween Integer
1 (Integer
n forall a. Num a => a -> a -> a
- Integer
1)
where
n :: Integer
n = CurveCommon -> Integer
ecc_n forall a b. (a -> b) -> a -> b
$ Curve -> CurveCommon
common_curve Curve
curve
pointNegate :: Curve -> Point -> Point
pointNegate :: Curve -> Point -> Point
pointNegate Curve
_ Point
PointO = Point
PointO
pointNegate (CurveFP CurvePrime
c) (Point Integer
x Integer
y) = Integer -> Integer -> Point
Point Integer
x (CurvePrime -> Integer
ecc_p CurvePrime
c forall a. Num a => a -> a -> a
- Integer
y)
pointNegate CurveF2m{} (Point Integer
x Integer
y) = Integer -> Integer -> Point
Point Integer
x (Integer
x Integer -> Integer -> Integer
`addF2m` Integer
y)
pointAdd :: Curve -> Point -> Point -> Point
pointAdd :: Curve -> Point -> Point -> Point
pointAdd Curve
_ Point
PointO Point
PointO = Point
PointO
pointAdd Curve
_ Point
PointO Point
q = Point
q
pointAdd Curve
_ Point
p Point
PointO = Point
p
pointAdd Curve
c Point
p Point
q
| Point
p forall a. Eq a => a -> a -> Bool
== Point
q = Curve -> Point -> Point
pointDouble Curve
c Point
p
| Point
p forall a. Eq a => a -> a -> Bool
== Curve -> Point -> Point
pointNegate Curve
c Point
q = Point
PointO
pointAdd (CurveFP (CurvePrime Integer
pr CurveCommon
_)) (Point Integer
xp Integer
yp) (Point Integer
xq Integer
yq)
= forall a. a -> Maybe a -> a
fromMaybe Point
PointO forall a b. (a -> b) -> a -> b
$ do
Integer
s <- Integer -> Integer -> Integer -> Maybe Integer
divmod (Integer
yp forall a. Num a => a -> a -> a
- Integer
yq) (Integer
xp forall a. Num a => a -> a -> a
- Integer
xq) Integer
pr
let xr :: Integer
xr = (Integer
s forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
2::Int) forall a. Num a => a -> a -> a
- Integer
xp forall a. Num a => a -> a -> a
- Integer
xq) forall a. Integral a => a -> a -> a
`mod` Integer
pr
yr :: Integer
yr = (Integer
s forall a. Num a => a -> a -> a
* (Integer
xp forall a. Num a => a -> a -> a
- Integer
xr) forall a. Num a => a -> a -> a
- Integer
yp) forall a. Integral a => a -> a -> a
`mod` Integer
pr
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Point
Point Integer
xr Integer
yr
pointAdd (CurveF2m (CurveBinary Integer
fx CurveCommon
cc)) (Point Integer
xp Integer
yp) (Point Integer
xq Integer
yq)
= forall a. a -> Maybe a -> a
fromMaybe Point
PointO forall a b. (a -> b) -> a -> b
$ do
Integer
s <- Integer -> Integer -> Integer -> Maybe Integer
divF2m Integer
fx (Integer
yp Integer -> Integer -> Integer
`addF2m` Integer
yq) (Integer
xp Integer -> Integer -> Integer
`addF2m` Integer
xq)
let xr :: Integer
xr = Integer -> Integer -> Integer -> Integer
mulF2m Integer
fx Integer
s Integer
s Integer -> Integer -> Integer
`addF2m` Integer
s Integer -> Integer -> Integer
`addF2m` Integer
xp Integer -> Integer -> Integer
`addF2m` Integer
xq Integer -> Integer -> Integer
`addF2m` Integer
a
yr :: Integer
yr = Integer -> Integer -> Integer -> Integer
mulF2m Integer
fx Integer
s (Integer
xp Integer -> Integer -> Integer
`addF2m` Integer
xr) Integer -> Integer -> Integer
`addF2m` Integer
xr Integer -> Integer -> Integer
`addF2m` Integer
yp
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Point
Point Integer
xr Integer
yr
where a :: Integer
a = CurveCommon -> Integer
ecc_a CurveCommon
cc
pointDouble :: Curve -> Point -> Point
pointDouble :: Curve -> Point -> Point
pointDouble Curve
_ Point
PointO = Point
PointO
pointDouble (CurveFP (CurvePrime Integer
pr CurveCommon
cc)) (Point Integer
xp Integer
yp) = forall a. a -> Maybe a -> a
fromMaybe Point
PointO forall a b. (a -> b) -> a -> b
$ do
Integer
lambda <- Integer -> Integer -> Integer -> Maybe Integer
divmod (Integer
3 forall a. Num a => a -> a -> a
* Integer
xp forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
2::Int) forall a. Num a => a -> a -> a
+ Integer
a) (Integer
2 forall a. Num a => a -> a -> a
* Integer
yp) Integer
pr
let xr :: Integer
xr = (Integer
lambda forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
2::Int) forall a. Num a => a -> a -> a
- Integer
2 forall a. Num a => a -> a -> a
* Integer
xp) forall a. Integral a => a -> a -> a
`mod` Integer
pr
yr :: Integer
yr = (Integer
lambda forall a. Num a => a -> a -> a
* (Integer
xp forall a. Num a => a -> a -> a
- Integer
xr) forall a. Num a => a -> a -> a
- Integer
yp) forall a. Integral a => a -> a -> a
`mod` Integer
pr
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Point
Point Integer
xr Integer
yr
where a :: Integer
a = CurveCommon -> Integer
ecc_a CurveCommon
cc
pointDouble (CurveF2m (CurveBinary Integer
fx CurveCommon
cc)) (Point Integer
xp Integer
yp)
| Integer
xp forall a. Eq a => a -> a -> Bool
== Integer
0 = Point
PointO
| Bool
otherwise = forall a. a -> Maybe a -> a
fromMaybe Point
PointO forall a b. (a -> b) -> a -> b
$ do
Integer
s <- forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Integer -> Integer
addF2m Integer
xp forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Integer -> Integer -> Integer -> Maybe Integer
divF2m Integer
fx Integer
yp Integer
xp
let xr :: Integer
xr = Integer -> Integer -> Integer -> Integer
mulF2m Integer
fx Integer
s Integer
s Integer -> Integer -> Integer
`addF2m` Integer
s Integer -> Integer -> Integer
`addF2m` Integer
a
yr :: Integer
yr = Integer -> Integer -> Integer -> Integer
mulF2m Integer
fx Integer
xp Integer
xp Integer -> Integer -> Integer
`addF2m` Integer -> Integer -> Integer -> Integer
mulF2m Integer
fx Integer
xr (Integer
s Integer -> Integer -> Integer
`addF2m` Integer
1)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Point
Point Integer
xr Integer
yr
where a :: Integer
a = CurveCommon -> Integer
ecc_a CurveCommon
cc
pointBaseMul :: Curve -> Integer -> Point
pointBaseMul :: Curve -> Integer -> Point
pointBaseMul Curve
c Integer
n = Curve -> Integer -> Point -> Point
pointMul Curve
c Integer
n (CurveCommon -> Point
ecc_g forall a b. (a -> b) -> a -> b
$ Curve -> CurveCommon
common_curve Curve
c)
pointMul :: Curve -> Integer -> Point -> Point
pointMul :: Curve -> Integer -> Point -> Point
pointMul Curve
_ Integer
_ Point
PointO = Point
PointO
pointMul Curve
c Integer
n Point
p
| Integer
n forall a. Ord a => a -> a -> Bool
< Integer
0 = Curve -> Integer -> Point -> Point
pointMul Curve
c (-Integer
n) (Curve -> Point -> Point
pointNegate Curve
c Point
p)
| Integer
n forall a. Eq a => a -> a -> Bool
== Integer
0 = Point
PointO
| Integer
n forall a. Eq a => a -> a -> Bool
== Integer
1 = Point
p
| forall a. Integral a => a -> Bool
odd Integer
n = Curve -> Point -> Point -> Point
pointAdd Curve
c Point
p (Curve -> Integer -> Point -> Point
pointMul Curve
c (Integer
n forall a. Num a => a -> a -> a
- Integer
1) Point
p)
| Bool
otherwise = Curve -> Integer -> Point -> Point
pointMul Curve
c (Integer
n forall a. Integral a => a -> a -> a
`div` Integer
2) (Curve -> Point -> Point
pointDouble Curve
c Point
p)
pointAddTwoMuls :: Curve -> Integer -> Point -> Integer -> Point -> Point
pointAddTwoMuls :: Curve -> Integer -> Point -> Integer -> Point -> Point
pointAddTwoMuls Curve
_ Integer
_ Point
PointO Integer
_ Point
PointO = Point
PointO
pointAddTwoMuls Curve
c Integer
_ Point
PointO Integer
n2 Point
p2 = Curve -> Integer -> Point -> Point
pointMul Curve
c Integer
n2 Point
p2
pointAddTwoMuls Curve
c Integer
n1 Point
p1 Integer
_ Point
PointO = Curve -> Integer -> Point -> Point
pointMul Curve
c Integer
n1 Point
p1
pointAddTwoMuls Curve
c Integer
n1 Point
p1 Integer
n2 Point
p2
| Integer
n1 forall a. Ord a => a -> a -> Bool
< Integer
0 = Curve -> Integer -> Point -> Integer -> Point -> Point
pointAddTwoMuls Curve
c (-Integer
n1) (Curve -> Point -> Point
pointNegate Curve
c Point
p1) Integer
n2 Point
p2
| Integer
n2 forall a. Ord a => a -> a -> Bool
< Integer
0 = Curve -> Integer -> Point -> Integer -> Point -> Point
pointAddTwoMuls Curve
c Integer
n1 Point
p1 (-Integer
n2) (Curve -> Point -> Point
pointNegate Curve
c Point
p2)
| Bool
otherwise = forall {a} {a}. (Integral a, Integral a) => (a, a) -> Point
go (Integer
n1, Integer
n2)
where
p0 :: Point
p0 = Curve -> Point -> Point -> Point
pointAdd Curve
c Point
p1 Point
p2
go :: (a, a) -> Point
go (a
0, a
0 ) = Point
PointO
go (a
k1, a
k2) =
let q :: Point
q = Curve -> Point -> Point
pointDouble Curve
c forall a b. (a -> b) -> a -> b
$ (a, a) -> Point
go (a
k1 forall a. Integral a => a -> a -> a
`div` a
2, a
k2 forall a. Integral a => a -> a -> a
`div` a
2)
in case (forall a. Integral a => a -> Bool
odd a
k1, forall a. Integral a => a -> Bool
odd a
k2) of
(Bool
True , Bool
True ) -> Curve -> Point -> Point -> Point
pointAdd Curve
c Point
p0 Point
q
(Bool
True , Bool
False ) -> Curve -> Point -> Point -> Point
pointAdd Curve
c Point
p1 Point
q
(Bool
False , Bool
True ) -> Curve -> Point -> Point -> Point
pointAdd Curve
c Point
p2 Point
q
(Bool
False , Bool
False ) -> Point
q
isPointAtInfinity :: Point -> Bool
isPointAtInfinity :: Point -> Bool
isPointAtInfinity Point
PointO = Bool
True
isPointAtInfinity Point
_ = Bool
False
isPointValid :: Curve -> Point -> Bool
isPointValid :: Curve -> Point -> Bool
isPointValid Curve
_ Point
PointO = Bool
True
isPointValid (CurveFP (CurvePrime Integer
p CurveCommon
cc)) (Point Integer
x Integer
y) =
Integer -> Bool
isValid Integer
x Bool -> Bool -> Bool
&& Integer -> Bool
isValid Integer
y Bool -> Bool -> Bool
&& (Integer
y forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
2 :: Int)) Integer -> Integer -> Bool
`eqModP` (Integer
x forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
3 :: Int) forall a. Num a => a -> a -> a
+ Integer
a forall a. Num a => a -> a -> a
* Integer
x forall a. Num a => a -> a -> a
+ Integer
b)
where a :: Integer
a = CurveCommon -> Integer
ecc_a CurveCommon
cc
b :: Integer
b = CurveCommon -> Integer
ecc_b CurveCommon
cc
eqModP :: Integer -> Integer -> Bool
eqModP Integer
z1 Integer
z2 = (Integer
z1 forall a. Integral a => a -> a -> a
`mod` Integer
p) forall a. Eq a => a -> a -> Bool
== (Integer
z2 forall a. Integral a => a -> a -> a
`mod` Integer
p)
isValid :: Integer -> Bool
isValid Integer
e = Integer
e forall a. Ord a => a -> a -> Bool
>= Integer
0 Bool -> Bool -> Bool
&& Integer
e forall a. Ord a => a -> a -> Bool
< Integer
p
isPointValid (CurveF2m (CurveBinary Integer
fx CurveCommon
cc)) (Point Integer
x Integer
y) =
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [ Integer -> Bool
isValid Integer
x
, Integer -> Bool
isValid Integer
y
, ((((Integer
x Integer -> Integer -> Integer
`add` Integer
a) Integer -> Integer -> Integer
`mul` Integer
x Integer -> Integer -> Integer
`add` Integer
y) Integer -> Integer -> Integer
`mul` Integer
x) Integer -> Integer -> Integer
`add` Integer
b Integer -> Integer -> Integer
`add` (Integer -> Integer -> Integer
squareF2m Integer
fx Integer
y)) forall a. Eq a => a -> a -> Bool
== Integer
0
]
where a :: Integer
a = CurveCommon -> Integer
ecc_a CurveCommon
cc
b :: Integer
b = CurveCommon -> Integer
ecc_b CurveCommon
cc
add :: Integer -> Integer -> Integer
add = Integer -> Integer -> Integer
addF2m
mul :: Integer -> Integer -> Integer
mul = Integer -> Integer -> Integer -> Integer
mulF2m Integer
fx
isValid :: Integer -> Bool
isValid Integer
e = Integer -> Integer -> Integer
modF2m Integer
fx Integer
e forall a. Eq a => a -> a -> Bool
== Integer
e
divmod :: Integer -> Integer -> Integer -> Maybe Integer
divmod :: Integer -> Integer -> Integer -> Maybe Integer
divmod Integer
y Integer
x Integer
m = do
Integer
i <- Integer -> Integer -> Maybe Integer
inverse (Integer
x forall a. Integral a => a -> a -> a
`mod` Integer
m) Integer
m
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Integer
y forall a. Num a => a -> a -> a
* Integer
i forall a. Integral a => a -> a -> a
`mod` Integer
m