diff --git a/.gitignore b/.gitignore index 4729e6b..81cf521 100644 --- a/.gitignore +++ b/.gitignore @@ -2,3 +2,4 @@ tests/*.my dist cabal.sandbox.config +.stack-work/ diff --git a/DetailedTx.hs b/DetailedTx.hs index 324c18a..eb75810 100644 --- a/DetailedTx.hs +++ b/DetailedTx.hs @@ -6,11 +6,12 @@ import Data.Aeson.Types (Pair) import qualified Data.ByteString.Lazy as LBS import qualified Data.Text as T -import Network.Haskoin.Crypto (txHash,pubKeyAddr,addrToBase58,derivePubKey,toWIF) +import Network.Haskoin.Crypto (pubKeyAddr,addrToBase58,derivePubKey,toWif) +import Network.Haskoin.Transaction (txHash) import Network.Haskoin.Internals (Tx(..), TxIn(..), TxOut(..) ,scriptSender, scriptRecipient ,XPrvKey(..),XPubKey(..) - ,xPrvIsPrime,xPrvChild,xPubIsPrime,xPubChild + ,xPrvIsHard,xPrvChild,xPubIsHard,xPubChild ) import Network.Haskoin.Util (eitherToMaybe,decode') import Utils (putHex) @@ -62,10 +63,10 @@ instance ToJSON DetailedXPrvKey where ,"depth" .= xPrvDepth k ,"parent" .= xPrvParent k ,"index" .= object ["value" .= xPrvIndex k - ,(if xPrvIsPrime k then "hard" else "soft") .= xPrvChild k + ,(if xPrvIsHard k then "hard" else "soft") .= xPrvChild k ] ,"chain" .= xPrvChain k - ,"prvkey" .= toWIF (xPrvKey k) + ,"prvkey" .= toWif (xPrvKey k) ,"pubkey" .=$ putHex pub ,"address" .= addrToBase58 addr ] @@ -79,7 +80,7 @@ instance ToJSON DetailedXPubKey where ,"depth" .= xPubDepth k ,"parent" .= xPubParent k ,"index" .= object ["value" .= xPubIndex k - ,(if xPubIsPrime k then "hard" else "soft") .= xPubChild k + ,(if xPubIsHard k then "hard" else "soft") .= xPubChild k ] ,"chain" .= xPubChain k ,"pubkey" .=$ putHex pub diff --git a/Electrum.hs b/Electrum.hs index e570b5c..61bb83c 100644 --- a/Electrum.hs +++ b/Electrum.hs @@ -1,13 +1,14 @@ {-# LANGUAGE OverloadedStrings #-} module Electrum where +import Data.Maybe import Data.Word import Data.Monoid import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as B8 import Network.Haskoin.Crypto -import Network.Haskoin.Internals (FieldN, Point, curveG, addPoint, mulPoint) +import Network.Haskoin.Internals (Point, curveG, addPoint, mulPoint, pubKeyPoint) import Network.Haskoin.Util import Utils @@ -29,10 +30,11 @@ sequenceN :: Word32 -> Bool -> El_mpk -> FieldN sequenceN n c = runGet' getFieldN . sequenceBS n c point_mpk :: El_mpk -> Point -point_mpk = pubKeyPoint . decode' . BS.cons 0x04 . mpk_bytes +point_mpk mpk = pubKeyPoint (decode' . BS.cons 0x04 $ mpk_bytes mpk :: PubKey) mpk_from_secret :: FieldN -> El_mpk -mpk_from_secret = El_mpk . BS.drop 1 . encode' . derivePubKey . PrvKeyU +mpk_from_secret = + El_mpk . BS.drop 1 . encode' . derivePubKey . fromJust . makePrvKeyU . fromIntegral derived_mpk :: El_seed -> El_mpk derived_mpk = mpk_from_secret . stretched_seedN @@ -52,14 +54,14 @@ decode_mpk s0 where s = ignoreSpaces s0 derive_priv :: Word32 -> Bool -> El_seed -> PrvKey -derive_priv n for_change seed = PrvKeyU sk +derive_priv n for_change seed = toPrvKeyG . fromJust . makePrvKeyU $ fromIntegral sk where secexp = stretched_seedN seed mpk = mpk_from_secret secexp z = sequenceN n for_change mpk sk = secexp + z derive_pub :: Word32 -> Bool -> El_mpk -> PubKey -derive_pub n for_change mpk = PubKeyU pk +derive_pub n for_change mpk = toPubKeyG $ makePubKeyU pk where z = sequenceN n for_change mpk zG = mulPoint z curveG pk = addPoint (point_mpk mpk) zG @@ -73,7 +75,7 @@ hx_electrum_stretch_seed hx_electrum_priv :: [BS] -> BS -> BS hx_electrum_priv = hx_electrum_args "electrum-priv" decode_seed $ \n c s -> - B8.pack . toWIF $ derive_priv n c s + B8.pack . toWif $ derive_priv n c s hx_electrum_sequence :: [BS] -> BS -> BS hx_electrum_sequence = hx_electrum_args "electrum-sequence" decode_mpk $ \n c s -> diff --git a/ParseScript.hs b/ParseScript.hs index 2e9815a..a713ecb 100644 --- a/ParseScript.hs +++ b/ParseScript.hs @@ -9,7 +9,6 @@ import Data.ByteString.Char8 (ByteString,pack) import Data.Word (Word8) import qualified Data.ByteString.Base16 as B16 import Text.ParserCombinators.ReadP hiding (many) -import Data.Functor import Control.Applicative type Parser a = ReadP a diff --git a/Utils.hs b/Utils.hs index 695aaef..792938e 100644 --- a/Utils.hs +++ b/Utils.hs @@ -1,7 +1,6 @@ {-# LANGUAGE OverloadedStrings, TypeSynonymInstances, FlexibleInstances #-} module Utils where -import Control.Applicative import Data.Binary import Data.Char (isSpace,isDigit,toLower,isHexDigit) import Data.Maybe @@ -12,7 +11,7 @@ import qualified Data.ByteString.Lazy as LBS import qualified Data.ByteString.Char8 as B8 import qualified Data.ByteString.Base16 as B16 import Network.Haskoin.Crypto -import Network.Haskoin.Internals (FieldP, FieldN, getBigWordInteger, Point, curveN, curveP) +import Network.Haskoin.Internals (getBigWordInteger, Point, pubKeyPoint, curveN, curveP) import Network.Haskoin.Util subst :: Eq a => (a,a) -> a -> a @@ -78,7 +77,7 @@ get_int_arg n u (arg:args) | otherwise = error . unwords $ ["Non-decimal digits for", n ++ ".\nUsage:", u] no_args :: String -> [BS] -> a -> a -no_args u [] x = x +no_args _ [] x = x no_args u _ _ = error $ "Too many arguments.\nUsage: " ++ u parseInt :: String -> BS -> Int @@ -168,10 +167,10 @@ getHexLE :: (Binary a, Hex s) => String -> s -> a getHexLE msg = decode' . BS.reverse . decodeHex (msg ++ " (little endian)") getPoint :: Hex s => s -> Point -getPoint = pubKeyPoint . getHex "curve point" +getPoint s = pubKeyPoint (getHex "curve point" s :: PubKey) putPoint :: Hex s => Point -> s -putPoint = putHex . PubKey +putPoint = putHex . makePubKey interactArgs' :: (IsString s, Eq s) => (s -> IO ()) -> IO s -> ([s] -> s) -> [s] -> IO () interactArgs' puts gets f [] = puts . f . return =<< gets @@ -224,5 +223,5 @@ makePrvKey256 s makePrvKeyU256 :: BS -> PrvKey makePrvKeyU256 s - | BS.length s == 32 = fromMaybe (error "makePrvKeyU256: invalid key") . makePrvKeyU $ bsToInteger s + | BS.length s == 32 = toPrvKeyG . fromMaybe (error "makePrvKeyU256: invalid key") . makePrvKeyU $ bsToInteger s | otherwise = error $ "makePrvKeyU256: invalid size for input key, should be 256 bits and not " ++ show (BS.length s * 8) ++ " bits" diff --git a/hx.cabal b/hx.cabal index adac6f1..b4dae18 100644 --- a/hx.cabal +++ b/hx.cabal @@ -1,5 +1,5 @@ name: hx -version: 0.1.0.0 +version: 0.1.1.0 synopsis: Bitcoin CLI tools: Haskell port of Sx using Haskoin homepage: https://github.com/np/hx license: GPL-3 @@ -14,8 +14,14 @@ cabal-version: >=1.10 executable hx main-is: hx.hs + other-modules: DetailedTx + Electrum + Mnemonic + ParseScript + PrettyScript + Utils ghc-options: -Wall - build-depends: base >=4.6, haskoin, bytestring, base16-bytestring, + build-depends: base >=4.8, haskoin, bytestring, base16-bytestring, scientific, binary, RFC1751 >= 0.3, containers, aeson, cryptohash, pbkdf, -- required by aeson @@ -23,5 +29,4 @@ executable hx -- required by haskoin either default-language: Haskell2010 - -- other-modules: -- other-extensions: diff --git a/hx.hs b/hx.hs index 09338dc..07d4a07 100644 --- a/hx.hs +++ b/hx.hs @@ -6,7 +6,6 @@ import Data.Word import Data.Monoid import Data.Scientific import Data.String -import Data.Functor ((<$>)) import Data.Char (isDigit,toLower) import qualified Data.RFC1751 as RFC1751 import System.Environment @@ -24,10 +23,10 @@ import Crypto.PBKDF (sha1PBKDF1 ,sha512PBKDF2 ) -import Network.Haskoin.Crypto +import Network.Haskoin.Crypto hiding (derivePubPath, derivePath) import Network.Haskoin.Internals ( curveP, curveN, curveG, integerA, integerB , getX, getY, addPoint, doublePoint, mulPoint - , makeInfPoint + , makeInfPoint, pubKeyPoint , OutPoint(OutPoint), Tx(..), Script , SigHash(SigAll), TxSignature(TxSignature) , TxIn(..) @@ -56,18 +55,12 @@ class Compress a where uncompress :: a -> a instance Compress PrvKey where - compress (PrvKeyU k) = PrvKey k - compress k@PrvKey{} = k - - uncompress (PrvKey k) = PrvKeyU k - uncompress k@PrvKeyU{} = k + compress = toPrvKeyG . fromJust . makePrvKeyC . fromPrvKey + uncompress = toPrvKeyG . fromJust . makePrvKeyU . fromPrvKey instance Compress PubKey where - compress (PubKeyU k) = PubKey k - compress k@PubKey{} = k - - uncompress (PubKey k) = PubKeyU k - uncompress k@PubKeyU{} = k + compress = toPubKeyG . makePubKeyC . pubKeyPoint + uncompress = toPubKeyG . makePubKeyU . pubKeyPoint instance Compress Key where compress = mapKey compress compress @@ -78,7 +71,7 @@ decodeBase58E = fromMaybe (error "invalid base58 encoding") . decodeBase58 . ign xPrvImportBS :: BS -> Maybe XPrvKey xPrvImportBS s | "xprv" `BS.isPrefixOf` s = xPrvImport (B8.unpack s) - | otherwise = makeXPrvKey (decodeHex "seed" s) + | otherwise = Just $ makeXPrvKey (decodeHex "seed" s) xPubImportBS :: BS -> Maybe XPubKey xPubImportBS = xPubImport . B8.unpack @@ -117,17 +110,16 @@ pubXKey (XPub k) = k pubXKey (XPrv k) = deriveXPubKey k xMasterImportE :: Hex s => s -> XPrvKey -xMasterImportE = fromMaybe (error "failed to derived private root key from seed") - . makeXPrvKey . decodeHex "seed" +xMasterImportE = makeXPrvKey . decodeHex "seed" xKeyExportC :: Char -> XKey -> BS xKeyExportC 'A' = addrToBase58BS . xPubAddr . pubXKey xKeyExportC 'P' = putHex . xPubKey . pubXKey -xKeyExportC 'U' = putHex . uncompress . xPubKey . pubXKey +xKeyExportC 'U' = putHex . uncompress . toPubKeyG . xPubKey . pubXKey xKeyExportC 'M' = xPubExportBS . pubXKey -xKeyExportC 'p' = onXKey (B8.pack . xPrvWIF) +xKeyExportC 'p' = onXKey (B8.pack . xPrvWif) (error "Private keys can not be derived from extended public keys (expected P/, U/ or M/ not p/)") -xKeyExportC 'u' = onXKey (toWIFBS . uncompress . xPrvKey) +xKeyExportC 'u' = onXKey (toWIFBS . uncompress . toPrvKeyG . xPrvKey) (error "Uncompressed private keys can not be derived from extended public keys (expected P/, U/ or M/ not u/)") xKeyExportC 'm' = onXKey xPrvExportBS (error "Extended private keys can not be derived from extended public keys (expected M/ not m/)") @@ -164,22 +156,22 @@ derivePath :: String -> XKey -> XKey derivePath p = mapXKey (derivePrvPath p) (derivePubPath p) fromWIFE :: BS -> PrvKey -fromWIFE = fromMaybe (error "invalid WIF private key") . fromWIF . B8.unpack . ignoreSpaces +fromWIFE = fromMaybe (error "invalid WIF private key") . fromWif . B8.unpack . ignoreSpaces toWIFBS :: PrvKey -> BS -toWIFBS = B8.pack . toWIF +toWIFBS = B8.pack . toWif base58ToAddrE :: BS -> Address base58ToAddrE = fromMaybe (error "invalid bitcoin address") . base58ToAddr . B8.unpack . ignoreSpaces prvSubKeyE :: XPrvKey -> Word32 -> XPrvKey -prvSubKeyE k = fromMaybe (error "failed to derive private sub key") . prvSubKey k +prvSubKeyE k = prvSubKey k primeSubKeyE :: XPrvKey -> Word32 -> XPrvKey -primeSubKeyE k = fromMaybe (error "failed to derive private prime sub key") . primeSubKey k +primeSubKeyE k = hardSubKey k pubSubKeyE :: XPubKey -> Word32 -> XPubKey -pubSubKeyE k = fromMaybe (error "failed to derive public sub key") . pubSubKey k +pubSubKeyE k = pubSubKey k splitOnBS :: Char -> BS -> (BS,BS) splitOnBS c s = @@ -268,7 +260,7 @@ hx_addr :: BS -> BS hx_addr = keyAddrBase58 . getKey hx_wif_to_secret :: Hex s => BS -> s -hx_wif_to_secret = encodeHex . runPut' . putPrvKey . fromWIFE +hx_wif_to_secret = encodeHex . runPut' . prvKeyPutMonad . fromWIFE hx_secret_to_wif :: BS -> BS hx_secret_to_wif = toWIFBS . fromMaybe (error "invalid private key") @@ -276,7 +268,7 @@ hx_secret_to_wif = toWIFBS . fromMaybe (error "invalid private key") . decodeHex "private key" hx_hd_to_wif :: BS -> BS -hx_hd_to_wif = B8.pack . xPrvWIF . xPrvImportE +hx_hd_to_wif = B8.pack . xPrvWif . xPrvImportE hx_hd_to_address :: BS -> BS hx_hd_to_address = addrToBase58BS . xPubAddr . pubXKey . xKeyImportE diff --git a/stack.yaml b/stack.yaml new file mode 100644 index 0000000..cc556ed --- /dev/null +++ b/stack.yaml @@ -0,0 +1,12 @@ +flags: {} +packages: +- '.' +- location: + git: https://github.com/haskoin/haskoin.git + commit: b71bcfa4701e129b69776e6951fe0bb7c8b26ea3 + extra-dep: true +extra-deps: +- murmur3-1.0.0 +- pbkdf-1.1.1.1 +- RFC1751-0.3.0.1 +resolver: lts-3.4