ECC

Main.hs

{-# LANGUAGE BlockArguments #-}
module Main where

-- hex2Integer "FF"
hex2Integer :: String -> Integer
hex2Integer [] = 0
hex2Integer x = hex2Integer2 (reverse x)

hex2Integer2 :: String -> Integer
hex2Integer2 [] = 0
hex2Integer2 (x:xs) = (w x) + 16 * hex2Integer2 xs
  where w '0' = 0
        w '1' = 1
        w '2' = 2
        w '3' = 3
        w '4' = 4
        w '5' = 5
        w '6' = 6
        w '7' = 7
        w '8' = 8
        w '9' = 9
        w 'A' = 10
        w 'B' = 11
        w 'C' = 12
        w 'D' = 13
        w 'E' = 14
        w 'F' = 15
        w 'a' = 10
        w 'b' = 11
        w 'c' = 12
        w 'd' = 13
        w 'e' = 14
        w 'f' = 15


-- hex2bin "FFF"
hex2bin :: String -> String
hex2bin [] = ""
hex2bin x = bin2trim0first( hex2bin2 x )
--hex2bin x = hex2bin2 x

hex2bin2 :: String -> String
hex2bin2 [] = ""
hex2bin2 (x:xs) = hh x ++ hex2bin2 xs
  where hh '0' = "0000"
        hh '1' = "0001"
        hh '2' = "0010"
        hh '3' = "0011"
        hh '4' = "0100"
        hh '5' = "0101"
        hh '6' = "0110"
        hh '7' = "0111"
        hh '8' = "1000"
        hh '9' = "1001"
        hh 'a' = "1010"
        hh 'b' = "1011"
        hh 'c' = "1100"
        hh 'd' = "1101"
        hh 'e' = "1110"
        hh 'f' = "1111"
        hh 'A' = "1010"
        hh 'B' = "1011"
        hh 'C' = "1100"
        hh 'D' = "1101"
        hh 'E' = "1110"
        hh 'F' = "1111"


bin2trim0first :: String -> String
bin2trim0first s = z
  where (s1:s2) = s
        z
          | s1 == '0' = bin2trim0first s2
          | s1 == '1' = s

-- integer2hex 255
integer2hex :: Integer -> String
integer2hex 0 = "0"
integer2hex x 
  | d > 15 = integer2hex d ++ hh r
  | otherwise = hh d ++ hh r
  where d = div x 16
        r = rem x 16
        hh h = case h of
          0 -> "0"
          1 -> "1"
          2 -> "2"
          3 -> "3"
          4 -> "4"
          5 -> "5"
          6 -> "6"
          7 -> "7"
          8 -> "8"
          9 -> "9"
          10 -> "A"
          11 -> "B"
          12 -> "C"
          13 -> "D"
          14 -> "E"
          15 -> "F"


p = 2^256 - 2^32 - 2^9 - 2^8 - 2^7 - 2^6 - 2^4 - 1
gX = 0x79BE667EF9DCBBAC55A06295CE870B07029BFCDB2DCE28D959F2815B16F81798
gY = 0x483ADA7726A3C4655DA4FBFC0E1108A8FD17B448A68554199C47D08FFB10D4B8

-- Extended Euclidean algorithm.  Given non-negative a and b, return x, y and g
-- such that ax + by = g, where g = gcd(a,b).  Note that x or y may be negative.
-- https://rosettacode.org/wiki/Modular_inverse#Haskell
gcdExt a 0 = (1, 0, a)
gcdExt a b = let (q, r) = a `quotRem` b
                 (s, t, g) = gcdExt b r
             in (t, s - q * t, g)

-- Given a and m, return Just x such that ax = 1 mod m.  If there is no such x
-- return Nothing.
modInv a m = 
  let (i, _, g) = gcdExt a m
  in if g == 1 then mkPos i else 0
  where mkPos x = if x < 0 then x + m else x


doublePoint :: [Integer] -> [Integer]
--doublePoint :: [Integer] -> [String]
--doublePoint (x:y:[]) = [integer2hex x2, integer2hex y2]
doublePoint (x:y:[]) = [mod x2 p, mod y2 p]
  where s0 = modInv (mod (2 * y) p) p
        s = mod (s0 * 3 * x * x) p
        x2 = mod (s * s - 2 * x) p
        y2 = mod ( - (s * (x2 - x) + y)) p
        --y2 = mod (s * (x - x2) - y) p


addPoints :: [Integer] -> [Integer] -> [Integer]
--addPoints :: [Integer] -> [Integer] -> [String]
--addPoints (x1:y1:[]) (x2:y2:[]) = [integer2hex x3, integer2hex y3]
addPoints (x1:y1:[]) (x2:y2:[]) = [x3, y3]
  where s
--         | y2 > y1 = (y2 - y1) * (modInv (x2 - x1) p)
--         | y1 > y2 = (y1 - y2) * (modInv (x1 - x2) p)
--         | y1 > y2 = (y2 - y1) * (modInv (x2 - x1) p)
--         | y2 > y1 = (y1 - y2) * (modInv (x1 - x2) p)
         | x2 > x1 = (y2 - y1) * (modInv (x2 - x1) p)
         | x1 > x2 = (y1 - y2) * (modInv (x1 - x2) p)
--         | x1 > x2 = (y2 - y1) * (modInv (x2 - x1) p)
--         | x2 > x1 = (y1 - y2) * (modInv (x1 - x2) p)
        x3 = mod ( s * s - x1 - x2) p
        y3 = mod ( s * (x1 - x3) - y1) p


-- test_Pub "FF" 255 -- hex priv_key та число на якому кроці вивести точку-результат (насправді n = 1 == 2й крок)
test_Pub :: String -> Int -> String
test_Pub s n = test_Pub2 s2 n gX gY
  where (s1:s2) = hex2bin s

test_Pub2 :: String -> Int -> Integer -> Integer -> String
test_Pub2 s 0 x y = integer2hex x ++ " " ++ integer2hex y
test_Pub2 "" n x y = integer2hex x ++ " " ++ integer2hex y
test_Pub2 s n x y = test_Pub2 s3 (n - 1) x3 y3
  where
    (s2:s3) = s
    (x3:y3:[]) = case s2 of
                   '0' -> doublePoint [x, y]
                   '1' -> addPoints (doublePoint [x, y]) [gX, gY]


main :: IO ()
main = do
  putStrLn "hello world"