aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ecc.hs112
1 files changed, 63 insertions, 49 deletions
diff --git a/ecc.hs b/ecc.hs
index a35fb24..56a3067 100644
--- a/ecc.hs
+++ b/ecc.hs
@@ -1,28 +1,27 @@
-import Text.Printf
+{-# LANGUAGE FlexibleInstances #-}
-data FieldElement =
- FieldElement
- { number :: Int
- , prime :: Int
- }
- deriving (Eq)
+data FieldElement a = FieldElement
+ { number :: a
+ , prime :: a
+ }
+ deriving Eq
-instance Show FieldElement where
+instance (Num a, Show a) => Show (FieldElement a) where
show a = "FieldElement_" ++ show (prime a) ++ " " ++ show (number a)
-instance Num FieldElement where
+instance Integral a => Num (FieldElement a) where
(FieldElement a b) + (FieldElement c d)
- | b /= d = error "Distinct Fields"
+ | b /= d = error "Distinct Fields"
| otherwise = FieldElement (mod (a + c) b) b
(FieldElement a b) * (FieldElement c d)
- | b /= d = error "Distinct Fields"
+ | b /= d = error "Distinct Fields"
| otherwise = FieldElement (mod (a * c) b) b
abs a = a
signum _ = 1
negate (FieldElement a b) = FieldElement (mod (b - a) b) b
fromInteger _ = error "can't transform"
-instance Fractional FieldElement where
+instance (Integral a) => Fractional (FieldElement a) where
recip a = a ^ (prime a - 2)
fromRational _ = error "can't transform"
@@ -33,63 +32,78 @@ assert x = x
aa =
let a = FieldElement 2 31
b = FieldElement 15 31
- in assert
- (and
- [ a + b == FieldElement 17 31
- , a /= b
- , a - b == FieldElement 18 31
- ])
+ in assert
+ ( (a + b == FieldElement 17 31)
+ && (a /= b)
+ && (a - b == FieldElement 18 31)
+ )
bb =
let a = FieldElement 19 31
b = FieldElement 24 31
- in a * b
+ in a * b
-data ECPoint
+data ECPoint a
= Infinity
| ECPoint
- { x :: Double
- , y :: Double
- , a :: Double
- , b :: Double
+ { x :: a
+ , y :: a
+ , a :: a
+ , b :: a
}
- deriving (Eq)
+ deriving (Eq )
-instance Show ECPoint where
+rmul :: Integral a => a -> FieldElement a -> FieldElement a
+a `rmul` (FieldElement v p) = FieldElement (mod (a * v) p) p
+
+instance Show a => Show (ECPoint (FieldElement a)) where
show Infinity = "ECPoint(Infinity)"
- show p = printf "ECPoint(%f, %f)_%f_%f" (x p) (y p) (a p) (b p)
+ show p = "ECPoint_" ++ show (prime (x p)) ++ points ++ params
+ where
+ points = "(" ++ show (number (x p)) ++ ", " ++ show (number (y p)) ++ ")"
+ params = "a_" ++ show (number (a p)) ++ "|b_" ++ show (number (b p))
+
-validECPoint :: ECPoint -> Bool
+validECPoint :: (Eq a, Num a) => ECPoint a -> 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 = new_point $ (y q - y p) / (x q - x p)
- | x p == x q && y p == 0 = Infinity
- | p == q = new_point $ (3 * x p ^ 2 + a p) / (2 * y p)
- | otherwise = error "Unexpected case of points"
- where
- new_point slope =
- let 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)
+validECPoint p = y p ^ 2 == x p ^ 3 + a p * x p + b p
+
+add :: (Eq a, Fractional a) => ECPoint a -> ECPoint a -> ECPoint a
+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 = new_point $ (y q - y p) / (x q - x p)
+ | x p == x q && y p == 0 = Infinity
+ | p == q = new_point $ (3 * x p ^ 2 + a p) / (2 * y p)
+ | otherwise = error "Unexpected case of points"
+ where
+ new_point slope =
+ let 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)
cc =
let a = ECPoint 3 (-7) 5 7
b = ECPoint 18 77 5 7
c = ECPoint (-1) (-1) 5 7
- in ( validECPoint a
+ in ( validECPoint a
, validECPoint b
, validECPoint c
, a /= b
, a == a
- , add Infinity a
- , add a (ECPoint 3 7 5 7)
+ , add Infinity a
+ , add a (ECPoint 3 7 5 7)
, add (ECPoint 3 7 5 7) c
- , add c c)
+ , add c c
+ )
+
+dd =
+ let prime = 223
+ a = FieldElement 0 prime
+ b = FieldElement 7 prime
+ x = FieldElement 192 prime
+ y = FieldElement 105 prime
+ point = ECPoint x y a b
+ in validECPoint point