diff --git a/network-bitcoin.cabal b/network-bitcoin.cabal --- a/network-bitcoin.cabal +++ b/network-bitcoin.cabal @@ -1,5 +1,5 @@ Name: network-bitcoin -Version: 1.3.0 +Version: 1.4.0 Synopsis: An interface to bitcoind. Description: This can be used to send Bitcoins, query balances, etc. It @@ -24,7 +24,7 @@ Homepage: http://github.com/wowus/network-bitcoin Bug-reports: http://github.com/wowus/network-bitcoin/issues Copyright: 2012 Michael Hendricks - 2012 Clark Gaebel + 2013 Clark Gaebel Stability: experimental Homepage: http://github.com/mndrix/network-bitcoin Bug-reports: http://github.com/wowus/network-bitcoin/issues @@ -60,5 +60,23 @@ base == 4.* Source-repository head - type: git - location: git://github.com/wowus/network-bitcoin.git + type: git + location: git://github.com/wowus/network-bitcoin.git + +Executable network-bitcoin-tests + hs-source-dirs: src + ghc-options: -Wall + main-is: Test/Main.hs + build-depends: + aeson >= 0.6.1 && < 0.7, + bytestring >= 0.9 && < 0.11, + attoparsec == 0.10.*, + unordered-containers >= 0.2, + HTTP >= 4000, + network >= 2.3, + text >= 0.11, + vector >= 0.10, + base == 4.*, + QuickCheck == 2.5.*, + network-bitcoin + diff --git a/src/Network/Bitcoin/BlockChain.hs b/src/Network/Bitcoin/BlockChain.hs --- a/src/Network/Bitcoin/BlockChain.hs +++ b/src/Network/Bitcoin/BlockChain.hs @@ -9,7 +9,6 @@ module Network.Bitcoin.BlockChain ( Auth(..) , TransactionID , BTC - , ScriptSig(..) , getBlockCount , getDifficulty , setTransactionFee @@ -28,6 +27,7 @@ import Control.Monad import Data.Aeson import Network.Bitcoin.Internal +import Network.Bitcoin.RawTransaction -- | Returns the number of blocks in the longest block chain. getBlockCount :: Auth -> IO Integer @@ -139,7 +139,7 @@ -- | The amount transferred. , oiAmount :: BTC -- | The public key of the sender. - , oiScriptPubKey :: ScriptSig + , oiScriptPubKey :: ScriptPubKey -- | The version of this transaction. , oiVersion :: Integer -- | Is this transaction part of the coin base? @@ -150,7 +150,7 @@ instance FromJSON OutputInfo where parseJSON (Object o) = OutputInfo <$> o .: "bestblock" <*> o .: "confirmations" - <*> o .: "amount" + <*> o .: "value" <*> o .: "scriptPubKey" <*> o .: "version" <*> o .: "coinbase" diff --git a/src/Network/Bitcoin/Internal.hs b/src/Network/Bitcoin/Internal.hs --- a/src/Network/Bitcoin/Internal.hs +++ b/src/Network/Bitcoin/Internal.hs @@ -19,6 +19,7 @@ , Nil(..) , tj , AddrAddress(..) + , BitcoinRpcResponse(..) ) where import Control.Applicative @@ -96,12 +97,12 @@ callApi auth cmd params = readVal =<< callApi' auth jsonRpcReqBody where readVal bs = case decode' bs of - Just r@(BitcoinRpcResponse {btcError=NoError}) - -> return $ btcResult r - Just (BitcoinRpcResponse {btcError=BitcoinRpcError code msg}) - -> throw $ BitcoinApiError code msg - Nothing - -> throw $ BitcoinResultTypeError bs + Just r@(BitcoinRpcResponse {btcError=NoError}) + -> return $ btcResult r + Just (BitcoinRpcResponse {btcError=BitcoinRpcError code msg}) + -> throw $ BitcoinApiError code msg + Nothing + -> throw $ BitcoinResultTypeError bs jsonRpcReqBody = encode $ object [ "jsonrpc" .= ("2.0" :: Text) , "method" .= cmd diff --git a/src/Network/Bitcoin/RawTransaction.hs b/src/Network/Bitcoin/RawTransaction.hs --- a/src/Network/Bitcoin/RawTransaction.hs +++ b/src/Network/Bitcoin/RawTransaction.hs @@ -11,12 +11,12 @@ -- Also, documentation for this module is scarce. I would love the addition -- of more documentation by anyone who knows what these things are. module Network.Bitcoin.RawTransaction ( Auth(..) - , ScriptSig(..) , RawTransaction , getRawTransaction , TxIn(..) , TxnOutputType(..) , ScriptPubKey(..) + , ScriptSig(..) , TxOut(..) , BlockInfo(..) , RawTransactionInfo(..) @@ -93,6 +93,27 @@ | otherwise = mzero parseJSON _ = mzero + +-- | A transaction out of an account. +data TxOut = + TxOut { -- | The amount of bitcoin transferred out. + txoutVal :: BTC + -- | The public key of the account we sent the money to. + , scriptPubKey :: ScriptPubKey + } + deriving ( Show, Read, Ord, Eq ) + +instance FromJSON TxOut where + parseJSON (Object o) = TxOut <$> o .: "value" + <*> o .: "scriptPubKey" + parseJSON _ = mzero + +-- * Scripts +-- A script is a complex bitcoin construct that provides the creation +-- of Contracts. +-- See and . +-- It consists of two parts - a public key and a signature. + -- | A public key of someone we sent money to. data ScriptPubKey = NonStandardScriptPubKey { -- | The JSON "asm" field. nspkAsm :: HexString @@ -124,20 +145,18 @@ <*> o .: "hex" parseJSON _ = mzero --- | A transaction out of an account. -data TxOut = - TxOut { -- | The amount of bitcoin transferred out. - txoutVal :: BTC - -- | The public key of the account we sent the money to. - , scriptPubKey :: ScriptPubKey - } +-- | A script signature. +data ScriptSig = ScriptSig { sigAsm :: HexString + , sigHex :: HexString + } deriving ( Show, Read, Ord, Eq ) -instance FromJSON TxOut where - parseJSON (Object o) = TxOut <$> o .: "value" - <*> o .: "scriptPubKey" +instance FromJSON ScriptSig where + parseJSON (Object o) = ScriptSig <$> o .: "asm" + <*> o .: "hex" parseJSON _ = mzero + -- | Information on a single block. data BlockInfo = ConfirmedBlock { -- | The number of confirmations a block has. -- This will always be >= 1. @@ -201,16 +220,18 @@ data UnspentTransaction = UnspentTransaction { unspentTransactionId :: TransactionID - , outIdx :: Integer - , unspentScriptPubKey :: HexString - , redeemScript :: Maybe HexString - , unspentAmount :: BTC - , usConfirmations :: Integer - } + , outIdx :: Integer + , unspentAddress :: Address + , unspentScriptPubKey :: HexString + , redeemScript :: Maybe HexString + , unspentAmount :: BTC + , usConfirmations :: Integer + } deriving ( Show, Eq ) instance FromJSON UnspentTransaction where parseJSON (Object o) = UnspentTransaction <$> o .: "txid" <*> o .: "vout" + <*> o .: "address" <*> o .: "scriptPubKey" <*> o .:? "redeemScript" <*> o .: "amount" diff --git a/src/Network/Bitcoin/Types.hs b/src/Network/Bitcoin/Types.hs --- a/src/Network/Bitcoin/Types.hs +++ b/src/Network/Bitcoin/Types.hs @@ -10,13 +10,9 @@ , BTC , Account , Address - , ScriptSig(..) ) where -import Control.Applicative import Control.Exception -import Control.Monad -import Data.Aeson import Data.Fixed import Data.Text ( Text ) import Data.Typeable @@ -76,19 +72,8 @@ -- | An address for sending or receiving money. type Address = HexString --- | I don't know what this is. A signature of some sort? If you know, please --- submit a patch documenting this properly! -data ScriptSig = ScriptSig { sigAsm :: HexString - , sigHex :: HexString - } - deriving ( Show, Read, Ord, Eq ) - -instance FromJSON ScriptSig where - parseJSON (Object o) = ScriptSig <$> o .: "asm" - <*> o .: "hex" - parseJSON _ = mzero - -- | An account on the wallet is just a label to easily specify private keys. -- -- The default account is an empty string. type Account = Text + diff --git a/src/Test/Main.hs b/src/Test/Main.hs new file mode 100644 --- /dev/null +++ b/src/Test/Main.hs @@ -0,0 +1,51 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Main where + + +import Test.QuickCheck +import Test.QuickCheck.Monadic +import Network.Bitcoin +import Data.Aeson +import Data.Vector ( empty, mapM ) + + +main :: IO () +main = mapM_ qcOnce [ canGetInfo + , canListUnspent + , canGetOutputInfo + ] + + +qcOnce :: Property -> IO () +qcOnce = quickCheckWith stdArgs { maxSuccess = 1 + , maxSize = 1 + , maxDiscardRatio = 1 + } + + +auth :: Auth +auth = Auth "http://localhost:18332" "bitcoinrpc" "bitcoinrpcpassword" + + +canGetInfo :: Property +canGetInfo = monadicIO $ do + info <- run $ getBitcoindInfo auth + let checks = [ bitcoinVersion info > 80000 + , onTestNetwork info + , bitcoindErrors info == "" + ] + assert $ and checks + + +canListUnspent :: Property +canListUnspent = monadicIO $ do + _ <- run $ listUnspent auth Nothing Nothing Data.Vector.empty + assert True + + +canGetOutputInfo :: Property +canGetOutputInfo = monadicIO $ do + info <- run $ getOutputInfo auth "ab8e26fd95fa371ac15b43684d0c6797fb573757095e7d763ba86ad315f7db04" 1 + _ <- run $ print info + assert True