{-# OPTIONS -fno-warn-orphans #-}
module Curve.Edwards
( module Curve
, module Curve.Edwards
, module Group
, Point(..)
) where
import Protolude
import GaloisField (GaloisField(..))
import Text.PrettyPrint.Leijen.Text (Pretty(..))
import Curve (Coordinates(..), Curve(..), Form(..), PrimeField')
import Group (Group(..))
type EPoint = Point 'Edwards
class (GaloisField q, PrimeField' r, Curve 'Edwards c e q r) => ECurve c e q r where
{-# MINIMAL a_, d_, h_, q_, r_, x_, y_ #-}
a_ :: EPoint c e q r -> q
d_ :: EPoint c e q r -> q
h_ :: EPoint c e q r -> Integer
q_ :: EPoint c e q r -> Integer
r_ :: EPoint c e q r -> Integer
x_ :: EPoint c e q r -> q
y_ :: EPoint c e q r -> q
type EAPoint = EPoint 'Affine
class ECurve 'Affine e q r => EACurve e q r where
{-# MINIMAL gA_ #-}
gA_ :: EAPoint e q r
instance EACurve e q r => Curve 'Edwards 'Affine e q r where
data instance Point 'Edwards 'Affine e q r = A q q
deriving (Eq, Generic, NFData, Read, Show)
char = q_
{-# INLINABLE char #-}
cof = h_
{-# INLINABLE cof #-}
disc _ = d * (1 - d)
where
d = d_ (witness :: EAPoint e q r)
{-# INLINABLE disc #-}
fromA = identity
{-# INLINABLE fromA #-}
point x y = let p = A x y in if def p then Just p else Nothing
{-# INLINABLE point #-}
pointX x = A x <$> yX (witness :: EAPoint e q r) x
{-# INLINABLE pointX #-}
toA = identity
{-# INLINABLE toA #-}
yX _ x = sr ((1 - a * xx) / (1 - d * xx))
where
a = a_ (witness :: EAPoint e q r)
d = d_ (witness :: EAPoint e q r)
xx = x * x
{-# INLINABLE yX #-}
instance EACurve e q r => Group (EAPoint e q r) where
add (A x1 y1) (A x2 y2) = A x3 y3
where
a = a_ (witness :: EAPoint e q r)
d = d_ (witness :: EAPoint e q r)
x1x2 = x1 * x2
y1y2 = y1 * y2
x1y2 = x1 * y2
x2y1 = x2 * y1
dxy = d * x1x2 * y1y2
x3 = (x1y2 + x2y1) / (1 + dxy)
y3 = (y1y2 - a * x1x2) / (1 - dxy)
{-# INLINABLE add #-}
dbl = join add
{-# INLINABLE dbl #-}
def (A x y) = a * xx + yy == 1 + d * xx * yy
where
a = a_ (witness :: EAPoint e q r)
d = d_ (witness :: EAPoint e q r)
xx = x * x
yy = y * y
{-# INLINABLE def #-}
gen = gA_
{-# INLINABLE gen #-}
id = A 0 1
{-# INLINABLE id #-}
inv (A x y) = A (-x) y
{-# INLINABLE inv #-}
order = r_
{-# INLINABLE order #-}
instance EACurve e q r => Pretty (EAPoint e q r) where
pretty (A x y) = pretty (x, y)
type EPPoint = EPoint 'Projective
class ECurve 'Projective e q r => EPCurve e q r where
{-# MINIMAL gP_ #-}
gP_ :: EPPoint e q r
instance EPCurve e q r => Curve 'Edwards 'Projective e q r where
data instance Point 'Edwards 'Projective e q r = P q q q
deriving (Generic, NFData, Read, Show)
char = q_
{-# INLINABLE char #-}
cof = h_
{-# INLINABLE cof #-}
disc _ = d * (1 - d)
where
d = d_ (witness :: EPPoint e q r)
{-# INLINABLE disc #-}
fromA (A x y) = P x y 1
{-# INLINABLE fromA #-}
point x y = let p = P x y 1 in if def p then Just p else Nothing
{-# INLINABLE point #-}
pointX x = flip (P x) 1 <$> yX (witness :: EPPoint e q r) x
{-# INLINABLE pointX #-}
toA (P x y z) = A (x / z) (y / z)
{-# INLINABLE toA #-}
yX _ x = sr ((1 - a * xx) / (1 - d * xx))
where
a = a_ (witness :: EPPoint e q r)
d = d_ (witness :: EPPoint e q r)
xx = x * x
{-# INLINABLE yX #-}
instance EPCurve e q r => Group (EPPoint e q r) where
add (P x1 y1 z1) (P x2 y2 z2) = P x3 y3 z3
where
a' = a_ (witness :: EPPoint e q r)
d' = d_ (witness :: EPPoint e q r)
a = z1 * z2
b = a * a
c = x1 * x2
d = y1 * y2
e = d' * c * d
f = b - e
g = b + e
x3 = a * f * ((x1 + y1) * (x2 + y2) - c - d)
y3 = a * g * (d - a' * c)
z3 = f * g
{-# INLINABLE add #-}
dbl (P x1 y1 z1) = P x3 y3 z3
where
a = a_ (witness :: EPPoint e q r)
xy = x1 + y1
b = xy * xy
c = x1 * x1
d = y1 * y1
e = a * c
f = e + d
h = z1 * z1
j = f - 2 * h
x3 = (b - c - d) * j
y3 = f * (e - d)
z3 = f * j
{-# INLINABLE dbl #-}
def (P x y z) = (a * xx + yy - zz) * zz == d * xx * yy
where
a = a_ (witness :: EPPoint e q r)
d = d_ (witness :: EPPoint e q r)
xx = x * x
yy = y * y
zz = z * z
{-# INLINABLE def #-}
gen = gP_
{-# INLINABLE gen #-}
id = P 0 1 1
{-# INLINABLE id #-}
inv (P x y z) = P (-x) y z
{-# INLINABLE inv #-}
order = r_
{-# INLINABLE order #-}
instance EPCurve e q r => Eq (EPPoint e q r) where
P x1 y1 z1 == P x2 y2 z2 = z1 == 0 && z2 == 0
|| x1 * z2 == x2 * z1 && y1 * z2 == y2 * z1
instance EPCurve e q r => Pretty (EPPoint e q r) where
pretty (P x y z) = pretty (x, y, z)