module Network.Haskoin.Crypto.Keys
( PubKey(..)
, isValidPubKey
, isPubKeyU
, derivePubKey
, pubKeyAddr
, PrvKey(..)
, isValidPrvKey
, makePrvKey
, makePrvKeyU
, fromPrvKey
, isPrvKeyU
, putPrvKey
, getPrvKey
, getPrvKeyU
, fromWIF
, toWIF
, curveG
) where
import Data.Binary (Binary, get, put)
import Data.Binary.Get (Get, getWord8)
import Data.Binary.Put (Put, putWord8)
import Control.DeepSeq (NFData, rnf)
import Control.Monad (when, unless, guard)
import Control.Applicative ((<$>),(<*>))
import Data.Maybe (isJust, fromJust)
import qualified Data.ByteString as BS
( head, tail
, last, init
, cons, snoc
, length
)
import Network.Haskoin.Crypto.Curve
import Network.Haskoin.Crypto.BigWord
import Network.Haskoin.Crypto.Point
import Network.Haskoin.Crypto.Base58
import Network.Haskoin.Crypto.Hash
import Network.Haskoin.Constants
import Network.Haskoin.Util
curveG :: Point
curveG = fromJust $ makePoint (fromInteger $ fst pairG)
(fromInteger $ snd pairG)
data PubKey
= PubKey { pubKeyPoint :: !Point }
| PubKeyU { pubKeyPoint :: !Point }
deriving (Read, Show)
instance NFData PubKey where
rnf (PubKey p) = rnf p
rnf (PubKeyU p) = rnf p
instance Eq PubKey where
(PubKey InfPoint) == (PubKeyU InfPoint) = True
(PubKeyU InfPoint) == (PubKey InfPoint) = True
(PubKey a) == (PubKey b) = a == b
(PubKeyU a) == (PubKeyU b) = a == b
_ == _ = False
isValidPubKey :: PubKey -> Bool
isValidPubKey = validatePoint . pubKeyPoint
isPubKeyU :: PubKey -> Bool
isPubKeyU (PubKey _) = False
isPubKeyU (PubKeyU _) = True
derivePubKey :: PrvKey -> PubKey
derivePubKey k = case k of
(PrvKey d) -> PubKey $ mulPoint d curveG
(PrvKeyU d) -> PubKeyU $ mulPoint d curveG
instance Binary PubKey where
get = go =<< getWord8
where
go 0 = fail "InfPoint is not a valid public key"
go 4 = getUncompressed
go y | y == 2 || y == 3 = getCompressed (even y)
| otherwise = fail "Get: Invalid public key encoding"
put pk = case getAffine (pubKeyPoint pk) of
Nothing -> putWord8 0x00
Just (x,y) -> case pk of
PubKey _ -> putWord8 (if even y then 2 else 3) >> put x
PubKeyU _ -> putWord8 4 >> put x >> put y
getUncompressed :: Get PubKey
getUncompressed = do
p <- makePoint <$> get <*> get
unless (isJust p) (fail "Get: Point not on the curve")
return $ PubKeyU $ fromJust $ p
getCompressed :: Bool -> Get PubKey
getCompressed e = do
x <- get :: Get FieldP
let a = x ^ (3 :: Integer) + (curveA * x) + curveB
ys = filter matchSign (quadraticResidue a)
when (null ys) (fail $ "No ECC point for x = " ++ (show x))
let p = makePoint x (head ys)
unless (isJust p) (fail "Get: Point not on the curve")
return $ PubKey $ fromJust $ p
where
matchSign a = (even a) == e
pubKeyAddr :: PubKey -> Address
pubKeyAddr = PubKeyAddress . hash160 . hash256BS . encode'
data PrvKey
= PrvKey { prvKeyFieldN :: !FieldN }
| PrvKeyU { prvKeyFieldN :: !FieldN }
deriving (Eq, Show, Read)
instance NFData PrvKey where
rnf (PrvKey p) = rnf p
rnf (PrvKeyU p) = rnf p
isValidPrvKey :: Integer -> Bool
isValidPrvKey = isIntegerValidKey
makePrvKey :: Integer -> Maybe PrvKey
makePrvKey i
| isValidPrvKey i = Just $ PrvKey $ fromInteger i
| otherwise = Nothing
makePrvKeyU :: Integer -> Maybe PrvKey
makePrvKeyU i
| isValidPrvKey i = Just $ PrvKeyU $ fromInteger i
| otherwise = Nothing
fromPrvKey :: PrvKey -> Integer
fromPrvKey = fromIntegral . prvKeyFieldN
isPrvKeyU :: PrvKey -> Bool
isPrvKeyU (PrvKey _) = False
isPrvKeyU (PrvKeyU _) = True
putPrvKey :: PrvKey -> Put
putPrvKey k | prvKeyFieldN k == 0 = error "Put: 0 is an invalid private key"
| otherwise = put $ (fromIntegral (prvKeyFieldN k) :: Word256)
getPrvKey :: Get PrvKey
getPrvKey = do
i <- get :: Get Word256
let res = makePrvKey $ fromIntegral i
unless (isJust res) $ fail "Get: PrivateKey is invalid"
return $ fromJust res
getPrvKeyU :: Get PrvKey
getPrvKeyU = do
i <- get :: Get Word256
let res = makePrvKeyU $ fromIntegral i
unless (isJust res) $ fail "Get: PrivateKey is invalid"
return $ fromJust res
fromWIF :: String -> Maybe PrvKey
fromWIF str = do
bs <- decodeBase58Check $ stringToBS str
guard (BS.head bs == secretPrefix)
case BS.length bs of
33 -> do
let i = bsToInteger (BS.tail bs)
makePrvKeyU i
34 -> do
guard (BS.last bs == 0x01)
let i = bsToInteger $ BS.tail $ BS.init bs
makePrvKey i
_ -> Nothing
toWIF :: PrvKey -> String
toWIF k = bsToString $ encodeBase58Check $ BS.cons secretPrefix enc
where
enc | isPrvKeyU k = bs
| otherwise = BS.snoc bs 0x01
bs = runPut' $ putPrvKey k