aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ecc.hs102
1 files changed, 74 insertions, 28 deletions
diff --git a/ecc.hs b/ecc.hs
index 42a9220..19fe1a0 100644
--- a/ecc.hs
+++ b/ecc.hs
@@ -6,13 +6,12 @@
import Data.Bits
import Data.Proxy
---import Data.Ratio (denominator, numerator)
import GHC.TypeLits
import Text.Printf (PrintfArg, printf)
-- FiniteFields
--https://stackoverflow.com/questions/39823408/prime-finite-field-z-pz-in-haskell-with-operator-overloading
-newtype FieldElement (p :: Nat) = FieldElement Integer deriving Eq
+newtype FieldElement (n :: Nat) = FieldElement Integer deriving Eq
instance KnownNat n => Num (FieldElement n) where
FieldElement x + FieldElement y = fromInteger $ x + y
@@ -60,13 +59,12 @@ data ECPoint a
instance {-# OVERLAPPABLE #-} (PrintfArg a, Num a) => Show (ECPoint a) where
show Infinity = "ECPoint(Infinity)"
- show p = printf "ECPoint(%f, %f)_%f_%f" (x p) (y p) (a p) (b p)
+ show p = printf "ECPoint(%f, %f)_%f_%f" (x p) (y p) (a p) (b p)
instance {-# OVERLAPPING #-} KnownNat n => Show (ECPoint (FieldElement n)) where
show Infinity = "ECPoint(Infinity)"
- show p
- | n == (2 ^ 256 - 2 ^ 32 - 977) = "S256Point" ++ points
- | otherwise = "ECPoint_" ++ show n ++ points ++ params
+ show p | n == (2 ^ 256 - 2 ^ 32 - 977) = "S256Point" ++ points
+ | otherwise = "ECPoint_" ++ show n ++ points ++ params
where
n = natVal (Proxy :: Proxy n)
points = "(" ++ si (x p) ++ ", " ++ si (y p) ++ ")"
@@ -81,13 +79,12 @@ validECPoint (ECPoint x y a b) = y ^ 2 == x ^ 3 + a * x + b
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"
+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
@@ -96,10 +93,10 @@ add p q
binaryExpansion :: (Semigroup a) => Integer -> a -> a -> a
-binaryExpansion m value result | m == 0 = result
- | otherwise = binaryExpansion (m `shiftR` 1) (value <> value) accumulator
- where
- accumulator = if m .&. 1 == 1 then result <> value else result
+binaryExpansion m value result
+ | m == 0 = result
+ | otherwise = binaryExpansion (m `shiftR` 1) (value <> value) accumulator
+ where accumulator = if m .&. 1 == 1 then result <> value else result
scalarProduct :: (Eq a, Fractional a) => Integer -> ECPoint a -> ECPoint a
scalarProduct m ec = binaryExpansion m ec Infinity
@@ -127,30 +124,79 @@ cc =
)
dd =
- let a = FieldElement 0 :: FieldElement 223
- b = FieldElement 7
- x = FieldElement 192
- y = FieldElement 105
- in ECPoint x y a b
+ let a = FieldElement 0 :: FieldElement 223
+ b = FieldElement 7
+ x = FieldElement 192
+ y = FieldElement 105
+ in ECPoint x y a b
ee = ECPoint 192 105 (FieldElement 0 :: FieldElement 223) 7
ff = ECPoint 192 105 0 7 :: ECPoint (FieldElement 223)
aPoint = ECPoint 192 105 0 7 :: ECPoint (FieldElement 223)
total = add aPoint $ add aPoint $ add aPoint $ add aPoint aPoint
-totalfold=foldr add Infinity $ replicate 5 aPoint
-totalmconcat = mconcat $ replicate 5 aPoint
+totalfold = foldr add Infinity $ replicate 5 aPoint
+totalmconcat = mconcat $ replicate 5 aPoint
type S256Field = FieldElement (2 ^ 256- 2^ 32 - 977)
+type NField
+ = FieldElement
+ 0xfffffffffffffffffffffffffffffffebaaedce6af48a03bbfd25e8cd0364141
type S256Point = ECPoint S256Field
s256point :: S256Field -> S256Field -> S256Point
-s256point x y = ECPoint x y 0 7
+s256point x y =
+ let p = ECPoint x y 0 7
+ in if validECPoint p then p else error "Invalid point"
li :: S256Field
li = 12
-ll :: ECPoint ( FieldElement 31)
+ll :: ECPoint (FieldElement 31)
ll = Infinity
-ri= ECPoint 3 7 5 7 :: S256Point
+ri = ECPoint 3 7 5 7 :: S256Point
ncons = 0xfffffffffffffffffffffffffffffffebaaedce6af48a03bbfd25e8cd0364141
-gcons = s256point 0x79be667ef9dcbbac55a06295ce870b07029bfcdb2dce28d959f2815b16f81798 0x483ada7726a3c4655da4fbfc0e1108a8fd17b448a68554199c47d08ffb10d4b8
+gcons = s256point
+ 0x79be667ef9dcbbac55a06295ce870b07029bfcdb2dce28d959f2815b16f81798
+ 0x483ada7726a3c4655da4fbfc0e1108a8fd17b448a68554199c47d08ffb10d4b8
+
+asInt :: KnownNat n => FieldElement n -> Integer
+asInt (FieldElement n) = n
+
+-- z = 0xbc62d4b80d9e36da29c16c5d4d9f11731f36052c72401a76c23c0fb5a9b74423
+-- r = 0x37206a0610995c58074999cb9767b87af4c4978db68c06e8e6e81d282047a7c6
+-- s = 0x8ca63759c1157ebeaec0d03cecca119fc9a75bf8e6d0fa65c841c8e2738cdaec ::NField
+-- px = 0x04519fac3d910ca7e7138f7013706f619fa8f033e6ec6e09370ea38cee6a7574
+-- py = 0x82b51eab8c27c66e26c858a079bcdf4f1ada34cec420cafc7eac1a42216fb6c4
+-- point = s256point px py
+-- u = z / s
+-- v = r / s
+-- signa = scalarProduct (asInt u) gcons <> scalarProduct (asInt v) point
+
+pub = s256point
+ 0x887387e452b8eacc4acfde10d9aaf7f6d9a0f975aabb10d006e4da568744d06c
+ 0x61de6d95231cd89026e286df3b6ae4a894a3378e393e93a0f45b666329a0ae34
+
+z1 = 0xec208baa0fc1c19f708a9ca96fdeff3ac3f230bb4a7ba4aede4942ad003c0f60
+r1 = 0xac8d1c87e51d0d441be8b3dd5b05c8795b48875dffe00b7ffcfac23010d3a395
+s1 =
+ 0x68342ceff8935ededd102dd876ffd6ba72d6a427a3edb13d26eb0781cb423c4 :: NField
+
+signa1 =
+ scalarProduct (asInt $ z1 / s1) gcons <> scalarProduct (asInt $ r1 / s1) pub
+
+z2 = 0x7c076ff316692a3d7eb3c3bb0f8b1488cf72e1afcd929e29307032997a838a3d::NField
+r2 = 0xeff69ef2b1bd93a66ed5219add4fb51e11a840f404876325a1e8ffe0529a2c::NField
+s2 =
+ 0xc7207fee197d27c618aea621406f6bf5ef6fca38681d82b2f06fddbdce6feab6 :: NField
+
+
+data Signature = Signature
+ { r :: NField
+ , s :: NField
+ }
+
+verifySignanture :: NField -> Signature -> S256Point -> Bool
+verifySignanture z (Signature r s) pub = asInt (x target) == asInt r
+ where
+ target =
+ scalarProduct (asInt $ z / s) gcons <> scalarProduct (asInt $ r / s) pub