Upgraded to stack and LTS Haskell 3.4 with GHC 7.10.2

np · Sep 28, 2015 · 8bf622b · 8bf622b
1 parent 7f00f7f
commit 8bf622b
Show file tree

Hide file tree

Showing 8 changed files with 58 additions and 47 deletions.
diff --git a/.gitignore b/.gitignore
@@ -2,3 +2,4 @@
 tests/*.my
 dist
 cabal.sandbox.config
+.stack-work/
diff --git 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
@@ -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
@@ -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
@@ -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
@@ -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,14 +14,19 @@ 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
                        attoparsec, hashable, unordered-containers, text,
                        -- required by haskoin
                        either
   default-language:    Haskell2010
-  -- other-modules:       
   -- other-extensions:    
diff --git 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,15 +260,15 @@ 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")
                  . makePrvKey . bsToInteger
                  . 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
@@ -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