From f9a305dbced6a358176044dfc6038dea52fd3213 Mon Sep 17 00:00:00 2001
From: Shreyas Minocha <sm-git@riseup.net>
Date: Tue, 26 Apr 2022 14:49:22 -0500
Subject: [PATCH] Implement elliptic curves and ECDH

---
 Ecdh.hs           | 12 ++++++++++++
 EllipticCurves.hs | 49 +++++++++++++++++++++++++++++++++++++++++++++++
 README.md         | 18 +++++++++++++++++
 3 files changed, 79 insertions(+)
 create mode 100644 Ecdh.hs
 create mode 100644 EllipticCurves.hs

diff --git a/Ecdh.hs b/Ecdh.hs
new file mode 100644
index 0000000..572bf46
--- /dev/null
+++ b/Ecdh.hs
@@ -0,0 +1,12 @@
+import EllipticCurves (Point, Curve, scalePoint)
+
+type SharedPublic = Point
+type PersonalSecret = Int
+type PersonalPublic = Point
+type SharedSecret = Point
+
+ecdhPersonalPublic :: (Int, Curve) -> SharedPublic -> PersonalSecret -> PersonalPublic
+ecdhPersonalPublic pc p1 na = scalePoint pc p1 na
+
+ecdhSharedSecret :: (Int, Curve) -> PersonalSecret -> PersonalPublic -> SharedSecret
+ecdhSharedSecret pc na qb = scalePoint pc qb na
\ No newline at end of file
diff --git a/EllipticCurves.hs b/EllipticCurves.hs
new file mode 100644
index 0000000..e91ce90
--- /dev/null
+++ b/EllipticCurves.hs
@@ -0,0 +1,49 @@
+module EllipticCurves (Point, Curve, scalePoint) where
+
+import Data.List (elemIndex)
+import Data.Maybe (fromJust)
+import LinearCongruences (inverse)
+
+type Point = (Int, Int)
+type Curve = (Int, Int)
+
+ecdlpBruteforce :: (Int, Curve) -> Point -> Point -> Int
+ecdlpBruteforce (p, c) a b = 1 + fromJust (b `elemIndex` pointMultiples (p, c) a)
+
+scalePoint :: (Int, Curve) -> Point -> Int -> Point
+scalePoint _ _ 0 = (0, 0)
+scalePoint _ p1 1 = p1
+scalePoint pc p1 n
+    | r == (-1, -1)  = (-1, -1)
+    | not (canAddPoints pc r r) = (-1, -1)
+    | n `mod` 2 == 0 = twiceR
+    | not (canAddPoints pc p1 twiceR) = (-1, -1)
+    | otherwise      = addPoints pc p1 twiceR
+    where r = scalePoint pc p1 (n `div` 2)
+          twiceR = addPoints pc r r
+
+pointMultiples :: (Int, Curve) -> Point -> [Point]
+pointMultiples (p, c) p1 = iterate (addPoints (p, c) p1) p1
+
+addPoints :: (Int, Curve) -> Point -> Point -> Point
+addPoints (p, (a, b)) p1@(x1, y1) p2@(x2, y2)
+    | p1 == (0, 0) = p2
+    | p2 == (0, 0) = p1
+    | x1 == x2 && y1 == -y2 = (0, 0)
+    | otherwise = (x3 `mod` p, y3 `mod` p)
+    where x3 = lambda^2 - x1 - x2
+          y3 = lambda * (x1 - x3) - y1
+          lambda = if p1 /= p2
+              then modDiv p (y2 - y1) (x2 - x1)
+              else modDiv p (3 * (x1^2) + a) (2 * y1)
+
+canAddPoints :: (Int, Curve) -> Point -> Point -> Bool
+canAddPoints (p, (a, b)) p1@(x1, y1) p2@(x2, y2)
+    | p1 == (0, 0) = True
+    | p2 == (0, 0) = True
+    | x1 == x2 && y1 == -y2 = True
+    | p1 /= p2  = gcd p (x2 - x1) == 1
+    | otherwise = gcd p (2 * y1) == 1
+
+modDiv :: Int -> Int -> Int -> Int
+modDiv p a b = (a * (inverse p b)) `mod` p
diff --git a/README.md b/README.md
index 39e2e69..3c61c81 100644
--- a/README.md
+++ b/README.md
@@ -158,6 +158,24 @@ isPowerSmooth 10 84 -- True
 quadraticSieve 493 11 [23..38] -- [(23,36),(25,132)]
 ```
 
+## Elliptic Curves
+
+```hs
+ecdlpBruteforce (73, (8, 7)) (32, 53) (39, 17) -- 11
+scalePoint (3623, (14, 19)) (6, 730) 947 -- (3492,60)
+```
+
+```hs
+pc = (3851, (324, 1287))
+p = (920, 303)
+
+ecdhPersonalPublic pc p 1194 -- (2067,2178)
+ecdhPersonalPublic pc p 1759 -- (3684,3125)
+
+ecdhSharedSecret pc 1194 (3684, 3125) -- (3347,1242)
+ecdhSharedSecret pc 1759 (2067, 2178) -- (3347,1242)
+```
+
 ## Miscellaneous
 
 ### Fast Powering
-- 
2.38.4