diff options
| -rw-r--r-- | ecc.hs | 102 |
1 files changed, 74 insertions, 28 deletions
@@ -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 |