-- | The @secp256k1@ Elliptic Curve.
--
-- At the moment somewhat slow :(
--
-- References:
--
--  * <http://en.wikipedia.org/wiki/Elliptic_curve_cryptography>
--
--  * <http://www.secg.org/collateral/sec2_final.pdf>
--
{-# LANGUAGE CPP, BangPatterns #-}
module Bitcoin.Crypto.EC.Curve where

--------------------------------------------------------------------------------

import Control.Monad

import Prelude hiding ( sqrt )

import Data.Char
import Data.Bits
import Data.Word
import Data.Maybe

import qualified Data.ByteString as B

import System.Random

import Bitcoin.Misc.HexString
import Bitcoin.Misc.BigInt
import Bitcoin.Misc.OctetStream

import Bitcoin.Protocol.Hash             
import Bitcoin.Crypto.FiniteField.Fast.Fp  hiding ( secp256k1_p )
import Bitcoin.Crypto.FiniteField.Naive.Fn hiding ( secp256k1_n )

--------------------------------------------------------------------------------

-- | A point on the elliptic curve secp256k1
data ECPoint 
  = ECPoint !Fp !Fp    -- ^ a \"regular\" element of the elliptic curve
  | ECInfinity         -- ^ the point at infinity is the unit element
  deriving (Eq,Show)

mkECPoint :: Integer -> Integer -> ECPoint
mkECPoint x y = ECPoint (toFp x) (toFp y)

isECOnCurve :: ECPoint -> Bool
isECOnCurve ep = case ep of
  ECInfinity  -> True
  ECPoint x y -> (y2 == x3 + 7) where
    y2 = y*y
    x2 = x*x
    x3 = x2*x

--------------------------------------------------------------------------------
-- * secp256k1 curve parameters. 

-- | Parameters of the secp256k1 elliptic curve.
-- 
--  * p is the order of the prime field we are working over
--  * a and b are the parameters in the curve equation @y^2 = x^3 + a*x + b@ (but @a=0@ here)
--  * G is the generator of the subgroup in the curve
--  * n is the order of G, equivalently the size of the subgroup
--  * H is the cofactor (size of the curve divided by the size of the subgroup)
--
-- See <http://www.secg.org/collateral/sec2_final.pdf>
secp256k1_p :: Integer

secp256k1_a, secp256k1_b, secp256k1_Gx, secp256k1_Gy, secp256k1_n, secp256k1_h :: Integer

secp256k1_p  = 115792089237316195423570985008687907853269984665640564039457584007908834671663
secp256k1_Gx =  55066263022277343669578718895168534326250603453777594175500187360389116729240
secp256k1_Gy =  32670510020758816978083085130507043184471273380659243275938904335757337482424
secp256k1_n  = 115792089237316195423570985008687907852837564279074904382605163141518161494337

secp256k1_a  = 0 
secp256k1_b  = 7 
secp256k1_h  = 1 

-- | G is the base point, that is the generator; @E = { G^i | i\in Z } = { G^i | i<-[1..n] }@
secp256k1_G :: ECPoint
secp256k1_G = ECPoint (fromInteger secp256k1_Gx) (fromInteger secp256k1_Gy)

--------------------------------------------------------------------------------
-- specification of the curve directly from the SEC
-- however we opt for hardcoded constants intead of parsing the hex strings

{-

printSecp256k1 :: IO ()
printSecp256k1 = do
  putStrLn $ "p  = " ++ show _secp256k1_p
  putStrLn $ "a  = " ++ show _secp256k1_a
  putStrLn $ "b  = " ++ show _secp256k1_b
  putStrLn $ "Gx = " ++ show _secp256k1_Gx
  putStrLn $ "Gy = " ++ show _secp256k1_Gy
  putStrLn $ "n  = " ++ show _secp256k1_n
  putStrLn $ "h  = " ++ show _secp256k1_h

-- | We are working over the finite field of order p (p being a prime)
-- @p = 2^256 - 2^32 - 2^9 - 2^8 - 2^7 - 2^6 - 2^4 - 1@
_secp256k1_p :: Integer
_secp256k1_p = parseSecInt "FFFFFFFF FFFFFFFF FFFFFFFF FFFFFFFF FFFFFFFF FFFFFFFF FFFFFFFE FFFFFC2F"

-- | The curve is @y^2 = x^3 + ax + b = x^3 + b@ in this case
_secp256k1_a = 0 :: Integer
_secp256k1_b = 7 :: Integer

-- | uncompressed format: 04 <x> <y>, 1+32+32=65 bytes, x and y big-endian
_secp256k1_G_uncompr = parseSecData $
  "04 79BE667E F9DCBBAC 55A06295 CE870B07 029BFCDB 2DCE28D9" ++
     "59F2815B 16F81798 483ADA77 26A3C465 5DA4FBFC 0E1108A8 FD17B448 A6855419 9C47D08F FB10D4B8"

-- | compressed format: 02 <x> if y is even, 03 <x> if y is odd (1+32+33 bytes, x big-endian)
_secp256k1_G_compr = parseSecData 
  "02 79BE667E F9DCBBAC 55A06295 CE870B07 029BFCDB 2DCE28D9 59F2815B 16F81798"

-- | Base point coordinates
_secp256k1_Gx, _secp256k1_Gy :: Integer
_secp256k1_Gx = parseSecInt "79BE667E F9DCBBAC 55A06295 CE870B07 029BFCDB 2DCE28D9 59F2815B 16F81798" 
_secp256k1_Gy = parseSecInt "483ADA77 26A3C465 5DA4FBFC 0E1108A8 FD17B448 A6855419 9C47D08F FB10D4B8"

-- | n is the smallest number such that G^n = infinity, which means the order of the subgroup generated by G
_secp256k1_n :: Integer
_secp256k1_n = parseSecInt "FFFFFFFF FFFFFFFF FFFFFFFF FFFFFFFE BAAEDCE6 AF48A03B BFD25E8C D0364141"

-- | Cofactor = 1 means that the subgroup generated by G is the whole curve.
_secp256k1_h = 1 :: Integer

data ECurve = ECurve 
  { _ec_p :: Integer
  , _eg_a :: Integer
  , _eg_b :: Integer
  , _ec_G :: (Integer,Integer)
  , _eg_n :: Integer
  , _eg_h :: Integer
  } 

secp256k1 :: ECurve
secp256k1 = ECurve 
  { _ec_p = _secp256k1_p
  , _eg_a = _secp256k1_a
  , _eg_b = _secp256k1_b
  , _ec_G = (_secp256k1_Gx,_secp256k1_Gy)
  , _eg_n = _secp256k1_n
  , _eg_h = _secp256k1_h
  } 

parseSecData :: String -> B.ByteString
parseSecData = fromHexString . HexString . ignoreSpaces where
  ignoreSpaces = filter (not . isSpace)

parseSecInt :: String -> Integer
parseSecInt = toIntegerBE . parseSecData where

-}

--------------------------------------------------------------------------------
-- * Operations on the secp256k1 curve

-- | Addition in the elliptic curve (or multiplication if you prefer to think it as a multiplicative group)
addEC :: ECPoint -> ECPoint -> ECPoint 
addEC ECInfinity eq  = eq
addEC ep ECInfinity  = ep
addEC ep@(ECPoint xp yp) eq@(ECPoint xq yq) 
  | ep == eq     = dblEC ep
  | yp+yq == 0   = ECInfinity
  | otherwise    = ECPoint xr yr 
  where
    s  = (yp-yq) / (xp-xq)
    xr = s*s - (xp+xq)
    yr = s*(xp-xr) - yp

subEC :: ECPoint -> ECPoint -> ECPoint 
subEC a b = addEC a (invEC b)

-- | Doubling a point in the elliptic curve (multiplication by the integer 2)
dblEC :: ECPoint -> ECPoint
dblEC ECInfinity = ECInfinity 
dblEC (ECPoint xp yp) 
  | yp == 0    = ECInfinity          -- P+P+0 = 0
  | otherwise  = ECPoint xr yr 
  where
    s  = (3*xp*xp) / (2*yp)    -- NOTE: it should be (3*sqr x + a) / (2*y), however, in this specific curve a=0
    xr = s*s - 2*xp
    yr = s*(xp-xr) - yp

-- | Inverse (negation) in the elliptic curve
invEC :: ECPoint -> ECPoint
invEC (ECPoint x y) = ECPoint x (negate y)
invEC ECInfinity    = ECInfinity

-- | Multiplication by a positive integer (or exponentiation, if you think multiplicatively). This is slow, use the projective version instead!
mulEC :: ECPoint -> Integer -> ECPoint
mulEC !base !exp = go ECInfinity base exp where
  go !acc _  0  = acc
  go !acc !b !e = if (e .&. 1 > 0)
    then go (addEC acc b) (dblEC b) (shiftR e 1)
    else go        acc    (dblEC b) (shiftR e 1)

--------------------------------------------------------------------------------
-- * Num instance

instance Num ECPoint where
  (+) = addEC
  (-) = subEC
  negate = invEC
  (*)    = error "ECPoint/Num: (*) doesn't makes sense"
  abs    = error "ECPoint/Num: `abs' doesn't makes sense"
  signum = error "ECPoint/Num: `signum' doesn't makes sense"
  fromInteger n = case n of
    0 -> ECInfinity
    _ -> error "ECPoint/Num: `fromInteger' doesn't makes sense, apart from 0"

--------------------------------------------------------------------------------