Elliptic Curve on doubles with addition

1 files changed, 54 insertions, 0 deletions

diff --git a/ecc.hs b/ecc.hs
index 282817f..01ef90e 100644
--- a/ecc.hs
+++ b/ecc.hs
@@ -43,3 +43,57 @@ bb =
   let a = FieldElement 19 31
       b = FieldElement 24 31
    in a * b
+
+data ECPoint
+  = Infinity
+  | ECPoint
+      { x :: Double
+      , y :: Double
+      , a :: Double
+      , b :: Double
+      }
+  deriving (Eq)
+
+instance Show ECPoint where
+  show Infinity = "ECPoint(Infinity)"
+  show p =
+    "ECPoint(" ++
+    show (x p) ++ ", " ++ show (y p) ++ ")_" ++ show (a p) ++ "_" ++ show (b p)
+
+validECPoint :: ECPoint -> Bool
+validECPoint Infinity = True
+validECPoint p = (y p)^2 == (x p)^3 + (a p) * (x p) + (b p)
+
+add :: ECPoint -> ECPoint -> ECPoint
+add Infinity p = p
+add p Infinity = p
+add p q
+  | (a p) /= (a q) || (b p) /= (b q) = error "point not on same curve"
+  | (x p) == (x q) && (y p) /= (y q) = Infinity
+  | (x p) /= (x q) =
+    let slope = ((y q) - (y p)) / ((x q) - (x p))
+        new_x = slope ^ 2 - (x p) - (x q)
+        new_y = slope * (x p - new_x) - (y p)
+     in ECPoint new_x new_y (a p) (b p)
+  | (x p) == (x q) && (y p) == 0 = Infinity
+  | p == q =
+    let slope = (3 * (x p) ^ 2 + (a p)) / (2 * (y p))
+        new_x = slope ^ 2 - (x p) - (x q)
+        new_y = slope * (x p - new_x) - (y p)
+     in ECPoint new_x new_y (a p) (b p)
+  | otherwise = error "Unexpected case of points"
+
+
+cc =
+  let a = ECPoint 3 (-7) 5 7
+      b = ECPoint 18 77 5 7
+      c = ECPoint (-1) (-1) 5 7
+   in ( validECPoint a
+      , validECPoint b
+      , validECPoint c
+      , a /= b
+      , a == a
+      , add Infinity a
+      , add a (ECPoint 3 7 5 7)
+      , add (ECPoint 3 7 5 7) c
+      , add c c)