From d783ffd4b1ec3c23bbe158ccbdf4b6be6e69ce5d Mon Sep 17 00:00:00 2001 From: Clark Gaebel Date: Thu, 25 Oct 2012 01:39:57 -0400 Subject: [PATCH 01/73] Updated to the latest version of all the dependencies, and updated the API calls to match the latest version of bitcoind. --- Setup.lhs | 4 + network-bitcoin.cabal | 22 +- src/Network/Bitcoin.hs | 633 +++++++++++++++++++++++++-------- src/Network/Bitcoin/Address.hs | 40 ++- src/test-main.hs | 33 -- 5 files changed, 533 insertions(+), 199 deletions(-) create mode 100755 Setup.lhs delete mode 100644 src/test-main.hs diff --git a/Setup.lhs b/Setup.lhs new file mode 100755 index 0000000..de34346 --- /dev/null +++ b/Setup.lhs @@ -0,0 +1,4 @@ +#!/usr/bin/env runhaskell + +> import Distribution.Simple +> main = defaultMain diff --git a/network-bitcoin.cabal b/network-bitcoin.cabal index e40110b..0e95e99 100644 --- a/network-bitcoin.cabal +++ b/network-bitcoin.cabal @@ -7,7 +7,7 @@ Name: network-bitcoin -- The package version. See the Haskell package versioning policy -- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for -- standards guiding when and how versions should be incremented. -Version: 0.1.5 +Version: 0.2.0 -- A short (one-line) description of the package. Synopsis: Interface with Bitcoin RPC @@ -28,6 +28,11 @@ Description: . To learn more about Bitcoin, see . . + Changes in v2.0 + . + - Support for many more API calls + - Update to latest version of aeson and family. + . Changes in v0.1.5 . - Correct aeson dependency @@ -54,7 +59,7 @@ Homepage: http://github.com/mndrix/network-bitcoin Bug-reports: http://github.com/mndrix/network-bitcoin/issues -- A copyright notice. -Copyright: Copyright 2011, Michael Hendricks +Copyright: Copyright 2012, Michael Hendricks Category: Network @@ -79,13 +84,14 @@ Library -- Packages needed in order to build this package. Build-depends: - aeson == 0.3.*, - attoparsec >= 0.7, - bytestring >= 0.9, - containers >= 0.4, + aeson == 0.6.*, + bytestring >= 0.10, + attoparsec == 0.10.*, + unordered-containers >= 0.2, HTTP >= 4000, network >= 2.3, text >= 0.11, + vector >= 0.10, base == 4.* -- Modules not exported by this package. @@ -94,10 +100,6 @@ Library -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source. -- Build-tools: -Test-suite test-main - type: exitcode-stdio-1.0 - main-is: test-main.hs - Source-repository head type: git location: git://github.com/mndrix/network-bitcoin.git diff --git a/src/Network/Bitcoin.hs b/src/Network/Bitcoin.hs index d7e7e7e..706ce92 100644 --- a/src/Network/Bitcoin.hs +++ b/src/Network/Bitcoin.hs @@ -2,7 +2,11 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE FlexibleInstances #-} --- | Communicate with a Bitcoin daemon over JSON RPC +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE ImpredicativeTypes #-} +{-# OPTIONS_GHC -Wall #-} +-- | A Haskell binding to the bitcoind server. module Network.Bitcoin ( -- * Types @@ -20,138 +24,212 @@ module Network.Bitcoin , Satoshi(..) -- * Individual API methods + -- ** Account Administration + , getAccount + , setAccount + , getAccountAddress + , getAddressesByAccount , getBalance + , getNewAddress + -- ** Amount Paid By Someone Retrieval + , getReceivedByAccount + , getReceivedByAddress +-- , getTransaction -- TODO +-- , getWork -- TODO +-- , listAccounts -- TODO + -- ** Listing Payments Received + , ReceivedPaymentByAcc(..) + , listReceivedByAccount + , listReceivedByAccount' + , ReceivedPaymentByAddr(..) + , listReceivedByAddress + , listReceivedByAddress' + -- ** Listing Transactions + , TransactionDetails(..) + , listTransactions + -- ** Moving Bitcoins + , moveBitcoins + , moveBitcoins' + -- ** Sending Bitcoins + , sendBitcoins + , sendBitcoins' + -- ** Server Administration + , BitcoinServerInfo(..) + , getInfo + , backupWallet , getBlockCount + , getBlockNumber , getConnectionCount , getDifficulty , getGenerate + , setGenerate , getHashesPerSec - , getReceivedByAccount - , getReceivedByAddress + , stopBitcoind + -- ** Validation , validateAddress , isValidAddress -- * Low-level API , callApi - , FromNumber - , fromNumber ) where + import Network.Bitcoin.Address import Control.Applicative import Control.Exception import Control.Monad -import Data.Aeson -import Data.Attoparsec +import Data.Aeson as A import Data.Attoparsec.Number import Data.Fixed -import Data.Maybe (fromJust) +import Data.Maybe (fromJust, fromMaybe) import Data.Ratio ((%)) -import Data.String (fromString) import Data.Typeable +import Data.Vector ( Vector ) import Network.Browser import Network.HTTP hiding (password) import Network.URI (parseURI) -import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL -import qualified Data.Map as M +import Data.Text ( Text ) import qualified Data.Text as T -- | Defines Bitcoin's internal precision satoshis :: Integer satoshis = 10^(8::Integer) + +-- | We just use this datatype to implement an instance of 'Fixed' for +-- satoshis (the unit of bitcoin). data Satoshi = Satoshi + instance HasResolution Satoshi where resolution _ = satoshis --- | Fixed precision Bitcoin amount (to avoid floating point errors) -type Amount = Fixed Satoshi +-- | Fixed precision Bitcoin amount (to avoid floating point errors). +newtype Amount = Amount (Fixed Satoshi) + deriving ( Typeable + , Enum + , Eq + , Fractional + , Num + , Ord + , Read + , Real + , RealFrac + , Show ) --- | Name of a Bitcoin wallet account -type Account = String +-- | The name of a Bitcoin wallet account. +type Account = Text --- | Minimum number of confirmations for a payment -type MinConf = Integer +-- | Reprsents the minimum number of confirmations for a payment. +type MinConf = Integer -- | 'Auth' describes authentication credentials for --- making API requests to the Bitcoin daemon +-- making API requests to the Bitcoin daemon. data Auth = Auth - { rpcUrl :: String -- ^ URL, with port, where bitcoind listens - , rpcUser :: String -- ^ same as bitcoind's 'rpcuser' config - , rpcPassword :: String -- ^ same as bitcoind's 'rpcpassword' config + { rpcUrl :: Text -- ^ URL, with port, where bitcoind listens + , rpcUser :: Text -- ^ same as bitcoind's 'rpcuser' config + , rpcPassword :: Text -- ^ same as bitcoind's 'rpcpassword' config } - deriving (Show) + deriving (Show, Read, Ord, Eq) -data BitcoinRpcResponse = BitcoinRpcResponse { - btcResult :: Value, - btcError :: Value - } - deriving (Show) -instance FromJSON BitcoinRpcResponse where - parseJSON (Object v) = BitcoinRpcResponse <$> v .: "result" - <*> v .: "error" +-- | RPC calls return an error object. It can either be empty; or have an +-- error message + error code. +data BitcoinRpcError = NoError -- ^ All good. + | BitcoinRpcError Int Text -- ^ Error code + error message. + deriving ( Show, Read, Ord, Eq ) + +instance FromJSON BitcoinRpcError where + parseJSON (Object v) = BitcoinRpcError <$> v .: "code" + <*> v .: "message" + parseJSON Null = return NoError parseJSON _ = mzero --- |A 'BitcoinException' is thrown when 'callApi' encounters an --- error. The API error code is represented as an @Int@, the message as --- a @String@. -data BitcoinException - = BitcoinApiError Int String +-- | A response from bitcoind will contain the result of the JSON-RPC call, and +-- an error. The error should be null if a valid response was received. +data BitcoinRpcResponse a = BitcoinRpcResponse { btcResult :: a + , btcError :: BitcoinRpcError + } + deriving ( Show, Read, Ord, Eq ) + +instance FromJSON a => FromJSON (BitcoinRpcResponse a) where + parseJSON (Object v) = BitcoinRpcResponse <$> v .: "result" + <*> v .: "error" + parseJSON _ = mzero + +-- | A 'BitcoinException' is thrown when 'callApi encounters an +-- error. The API error code is represented as an @Int@, the message as +-- a @String@. +-- +-- It may also be thrown when the value returned by the bitcoin API wasn't +-- what we expected. +-- +-- WARNING: Any of the functions in this module's public API may throw this +-- exception. You should plan on handling it. +data BitcoinException = BitcoinApiError Int String + -- ^ A 'BitcoinApiError' has an error code error + -- message, as returned by bitcoind's JSON-RPC + -- response. + | BitcoinResultTypeError BL.ByteString + -- ^ The raw JSON returned. deriving (Show,Typeable) + instance Exception BitcoinException --- encodes an RPC request into a ByteString containing JSON -jsonRpcReqBody :: String -> [Value] -> BL.ByteString +-- | encodes an RPC request into a ByteString containing JSON +jsonRpcReqBody :: Text -> [Value] -> BL.ByteString jsonRpcReqBody cmd params = encode $ object [ - "jsonrpc" .= ("2.0"::String), + "jsonrpc" .= ("2.0"::Text), "method" .= cmd, "params" .= params, "id" .= (1::Int) ] --- |'callApi' is a low-level interface for making authenticated API --- calls to a Bitcoin daemon. The first argument specifies --- authentication details (URL, username, password) and is often --- curried for convenience: +-- | 'callApi is a low-level interface for making authenticated API +-- calls to a Bitcoin daemon. The first argument specifies +-- authentication details (URL, username, password) and is often +-- curried for convenience: -- --- > callBtc = callApi $ Auth "http://127.0.0.1:8332" "user" "password" +-- > callBtc = callApi $ Auth "http://127.0.0.1:8332" "user" "password" -- --- The second argument is the command name. The third argument provides --- parameters for the API call. +-- The second argument is the command name. The third argument provides +-- parameters for the API call. -- --- > let result = callBtc "getbalance" ["account-name", Number 6] +-- > let result = callBtc "getbalance" [ toJSON "account-name", toJSON 6 ] -- --- On error, throws a 'BitcoinException' -callApi :: Auth -- ^ authentication credentials for bitcoind - -> String -- ^ command name - -> [Value] -- ^ command arguments - -> IO Value +-- On error, throws a 'BitcoinException'. +callApi :: FromJSON v + => Auth -- ^ authentication credentials for bitcoind + -> Text -- ^ command name + -> [Value] -- ^ command arguments + -> IO v callApi auth command params = do (_,httpRes) <- browse $ do setOutHandler $ const $ return () addAuthority authority setAllowBasicAuth True - request $ httpRequest urlString $ jsonRpcReqBody command params - let res = fromSuccess $ fromJSON $ toVal $ rspBody httpRes - case res of - BitcoinRpcResponse {btcError=Null} -> return $ btcResult res - BitcoinRpcResponse {btcError=e} -> throw $ buildBtcError e + request . httpRequest (T.unpack urlString) $ jsonRpcReqBody command params + let response = rspBody httpRes + case decode' response of + Just r@(BitcoinRpcResponse {btcError=NoError}) + -> return $ btcResult r + Just (BitcoinRpcResponse {btcError=BitcoinRpcError code msg}) + -> throw $ BitcoinApiError code (T.unpack msg) + Nothing + -> throw . BitcoinResultTypeError $ response where authority = httpAuthority auth urlString = rpcUrl auth - toStrict = B.concat . BL.toChunks - justParseJSON = fromJust . maybeResult . parse json - toVal = justParseJSON . toStrict --- Internal helper functions to make callApi more readable +-- | Internal helper functions to make callApi more readable httpAuthority :: Auth -> Authority httpAuthority (Auth urlString username password) = AuthBasic { auRealm = "jsonrpc", - auUsername = username, - auPassword = password, + auUsername = T.unpack username, + auPassword = T.unpack password, auSite = uri } - where uri = fromJust $ parseURI urlString + where uri = fromJust . parseURI $ T.unpack urlString + +-- | Builds the JSON HTTP request. httpRequest :: String -> BL.ByteString -> Request BL.ByteString httpRequest urlString jsonBody = (postRequest urlString){ @@ -162,107 +240,379 @@ httpRequest urlString jsonBody = ] } -fromSuccess :: Data.Aeson.Result t -> t -fromSuccess (Success a) = a -fromSuccess (Error s) = error s - -buildBtcError :: Value -> BitcoinException -buildBtcError (Object o) = BitcoinApiError code msg - where find k = fromSuccess . fromJSON . fromJust . M.lookup k - code = find "code" o - msg = find "message" o -buildBtcError _ = error "Need an object to buildBtcError" - --- | Convert JSON numeric values to more specific numeric types -class FromNumber a where - fromNumber :: Number -> a -instance FromNumber Amount where - fromNumber (I i) = fromInteger i - fromNumber (D d) = fromRational $ numerator % satoshis - where - numerator = round $ d * (fromInteger satoshis) -instance FromNumber Integer where - fromNumber (I i) = i - fromNumber (D d) = round d -instance FromNumber Double where - fromNumber (I i) = fromInteger i - fromNumber (D d) = d - --- Class of types that can be converted to a JSON representation -class ToValue a where - toValue :: a -> Value -instance ToValue Address where - toValue addr = String $ fromString $ show addr -instance ToValue MinConf where - toValue conf = Number $ fromInteger conf -instance ToValue Account where - toValue acct = String $ fromString acct - -callNumber :: FromNumber a => String -> [Value] -> Auth -> IO a -callNumber cmd args auth = do - (Number n) <- callApi auth cmd args - return $ fromNumber n - -callBool :: String -> [Value] -> Auth -> IO Bool -callBool cmd args auth = do - (Bool b) <- callApi auth cmd args - return b - --- | Returns the balance of a specific Bitcoin account +instance FromJSON Amount where + parseJSON (Number (I n)) = return $ fromInteger n + parseJSON (Number (D n)) = let numerator = round $ n*fromInteger satoshis + in return . fromRational $ numerator % satoshis + parseJSON _ = mzero + +-- THIS MIGHT BE TROUBLE. We're converting to double. Does the bitcoin API +-- accept satoshis? Those would be better to use. +instance ToJSON Amount where + toJSON (Amount n) = toJSON (realToFrac n :: Double) + +-- | A handy shortcut. +tj :: ToJSON a => a -> Value +tj = toJSON + +-- | Safely copies *wallet.dat* to 'destination', which can be a +-- directory or a path with filename. +backupWallet :: Auth + -> Text -- ^ destination + -> IO () +backupWallet auth dest = callApi auth "backupwallet" [ tj dest ] + +-- | Returns the account associated with the given address. +-- +-- If an invalid address is given, a 'BitcoinException' will be thrown. +getAccount :: Auth + -> Address -- ^ bitcoin address + -> IO Account +getAccount auth addr = callApi auth "getaccount" [ tj addr ] + +-- | Sets the account associated with the given address. The account may be +-- 'Nothing' to remove an address from the account. +setAccount :: Auth + -> Address -- ^ The address to associate with the account. + -> Maybe Account -- ^ The account to associate with the address. + -> IO () +setAccount auth addr Nothing = callApi auth "setaccount" [ tj addr ] +setAccount auth addr (Just acc) = callApi auth "setaccount" [ tj addr, tj acc ] + +-- | Returns a new bitcoin address for the given account. +getAccountAddress :: Auth + -> Account + -> IO Address +getAccountAddress auth acc = callApi auth "getaccountaddress" [ tj acc ] + +-- | Returns the list of addresses associated with the given 'account'. +getAddressesByAccount :: Auth + -> Account + -> IO (Vector Address) +getAddressesByAccount auth acc = callApi auth "getaddressesbyaccount" [ tj acc ] + +-- | Returns the server's available balance, or, if an account is given, the +-- balance for the given account. getBalance :: Auth - -> Account - -> MinConf + -> Maybe Account -> IO Amount -getBalance auth acct minconf = callNumber "getbalance" args auth - where - args = [ String $ fromString acct, Number $ fromInteger minconf ] +getBalance auth Nothing = callApi auth "getbalance" [] +getBalance auth (Just acc) = callApi auth "getbalance" [ tj acc ] --- | Returns the number of blocks in the longest block chain +-- | Returns the number of blocks in the longest block chain. getBlockCount :: Auth -> IO Integer -getBlockCount = callNumber "getblockcount" [] +getBlockCount auth = callApi auth "getblockcount" [] + +-- | Returns the block number of the latest block in the +-- longest block chain. +getBlockNumber :: Auth -> IO Integer +getBlockNumber auth = callApi auth "getblocknumber" [] --- | Returns the number of connections to other nodes +-- | Returns the number of connections to other nodes. getConnectionCount :: Auth -> IO Integer -getConnectionCount = callNumber "getconnectioncount" [] +getConnectionCount auth = callApi auth "getconnectioncount" [] -- | Returns the proof-of-work difficulty as a multiple of the minimum --- difficulty +-- difficulty. getDifficulty :: Auth -> IO Double -getDifficulty = callNumber "getdifficulty" [] +getDifficulty auth = callApi auth "getdifficulty" [] --- | Indicates whether the node is generating or not +-- | Returns boolean true if server is trying to generate bitcoins, +-- false otherwise. getGenerate :: Auth -> IO Bool -getGenerate = callBool "getgenerate" [] +getGenerate auth = callApi auth "getgenerate" [] + +-- | Generation is limited to the given number of processors, -1 is +-- unlimited. +setGenerate :: Auth + -> Bool -- ^ Should we generate bitcoins? + -> Int -- ^ The processor limit. + -> IO () +setGenerate auth shouldStart n = callApi auth "setgenerate" [ tj shouldStart, tj n ] -- | Returns a recent hashes per second performance measurement while --- generating +-- generating. getHashesPerSec :: Auth -> IO Integer -getHashesPerSec = callNumber "gethashespersec" [] +getHashesPerSec auth = callApi auth "gethashespersec" [] + +-- | A structural representation of the response bitcoind gives on a 'getInfo' +-- call. +data BitcoinServerInfo = BitcoinServerInfo { bsiVersion :: Integer + , bsiBalance :: Amount + , bsiBlocks :: Integer + , bsiConnections :: Integer + , bsiProxy :: Text + , bsiGenerate :: Bool + , bsiGenProcLimit :: Integer + , bsiDifficulty :: Double + , bsiHashesPerSec :: Double + , bsiTestnet :: Bool + , bsiKeyPoolOldDest :: Integer + , bsiPayTxFee :: Amount + , bsiErrors :: Text + } + deriving (Eq, Ord, Show, Read) + +instance FromJSON BitcoinServerInfo where + parseJSON (Object o) = BitcoinServerInfo <$> o .: "version" + <*> o .: "balance" + <*> o .: "blocks" + <*> o .: "connections" + <*> o .: "proxy" + <*> o .: "generate" + <*> o .: "genproclimit" + <*> o .: "difficulty" + <*> o .: "hashespersec" + <*> o .: "testnet" + <*> o .: "keypoololddest" + <*> o .: "paytxfee" + <*> o .: "errors" + parseJSON _ = mzero + +-- | Retrieves a whole bunch of stats on bitcoind. +getInfo :: Auth -> IO BitcoinServerInfo +getInfo auth = callApi auth "getinfo" [] + +-- | Returns a new bitcoin address for receiving payments. If an account +-- is specified (recommended), it is added to the address book so payments +-- received with the address will be credited to the account automatically. +getNewAddress :: Auth + -> Maybe Account + -> IO Address +getNewAddress auth (Just acc) = callApi auth "getnewaddress" [ tj acc ] +getNewAddress auth Nothing = callApi auth "getnewaddress" [] --- | Returns the total amount received by addresses with --- @account@ in transactions with at least @minconf@ confirmations +-- | Returns the total amount received by addresses associated with 'account' +-- in transactions with at least 'MinConf' confirmations. +-- +-- A good default value for 'MinConf' is 1. getReceivedByAccount :: Auth -> Account -> MinConf -> IO Amount -getReceivedByAccount auth acct conf = - callNumber "getreceivedbyaccount" [toValue acct,toValue conf] auth +getReceivedByAccount auth acct conf = callApi auth "getreceivedbyaccount" [ tj acct, tj conf ] --- | Returns the total amount received by an address in transactions --- with at least 'minconf' confirmations. +-- | Returns the total amount received by the given address in transactions +-- with at least 'MinConf' confirmations. +-- +-- A good default value for 'MinConf' is 1. getReceivedByAddress :: Auth -> Address -> MinConf -> IO Amount -getReceivedByAddress auth addr conf = - callNumber "getreceivedbyaddress" [toValue addr,toValue conf] auth +getReceivedByAddress auth addr conf = callApi auth "getreceivedbyaddress" [ tj addr, tj conf ] + +-- | Represents a single received payment for an account. +data ReceivedPaymentByAcc = ReceivedPaymentByAcc { receivedInto :: Account + -- ^ The account of the receiving address. + , byAcctAmountReceived :: Amount + -- ^ Total amount received by the address. + , byAcctReceivedConfirmations :: Integer + -- ^ number of confirmations of the most + -- recent transaction included. + } + deriving ( Show, Read, Eq, Ord ) + +instance FromJSON ReceivedPaymentByAcc where + parseJSON (Object o) = ReceivedPaymentByAcc <$> o .: "account" + <*> o .: "amount" + <*> o .: "confirmations" + parseJSON _ = mzero + +-- | Returns a vector of 'ReceivedPaymentByAcc's. +listReceivedByAccount' :: Auth + -> MinConf -- ^ The minimum number of confirmations + -- needed for a transaction to be valid. + -> Bool -- ^ Should we include addresses which haven't + -- received any payments? + -> IO (Vector ReceivedPaymentByAcc) +listReceivedByAccount' auth mc includeEmpty = callApi auth "listreceivedbyaccount" [ tj mc, tj includeEmpty ] + +-- | Returns a vector of 'ReceivedPaymentByAcc's. +-- +-- Is a shortcut for: `\auth -> listReceivedByAccount' auth 1 False` +listReceivedByAccount :: Auth + -> IO (Vector ReceivedPaymentByAcc) +listReceivedByAccount auth = callApi auth "listreceivedbyaccount" [] + +-- | Represents a single received payment for an address. +data ReceivedPaymentByAddr = ReceivedPaymentByAddr { receiveAddress :: Address + -- ^ The address the payment was received from. + , byAddrReceivedInto :: Account + -- ^ The account of the receiving address. + , amountReceived :: Amount + -- ^ Total amount received by the address. + , byAddrReceivedConfirmations :: Integer + -- ^ number of confirmations of the most + -- recent transaction included. + } + deriving ( Show, Read, Eq, Ord ) + +instance FromJSON ReceivedPaymentByAddr where + parseJSON (Object o) = ReceivedPaymentByAddr <$> o .: "address" + <*> o .: "account" + <*> o .: "amount" + <*> o .: "confirmations" + parseJSON _ = mzero + + +-- | Returns a vector of 'ReceivedPaymentByAddr's. +listReceivedByAddress' :: Auth + -> MinConf -- ^ The minimum number of confirmations + -- needed for a transaction to be valid. + -> Bool -- ^ Should we include addresses which haven't + -- received any payments? + -> IO (Vector ReceivedPaymentByAddr) +listReceivedByAddress' auth mc includeEmpty = callApi auth "listreceivedbyaddress" [ tj mc, tj includeEmpty ] + +-- | Returns a vector of 'ReceivedPaymentByAddr's. +-- +-- Is a shortcut for: `\auth -> listReceivedByAddress' auth 1 False` +listReceivedByAddress :: Auth + -> IO (Vector ReceivedPaymentByAddr) +listReceivedByAddress auth = callApi auth "listreceivedbyaddress" [] + +-- | A transaction category is used to classify the transaction details we +-- receive from bitcoind. +data TransactionCategory = TxnGenerate + | TxnSend + | TxnReceive + | TxnMove + deriving ( Show, Read, Eq, Ord ) + +instance FromJSON TransactionCategory where + parseJSON (String x) | x == "generate" = return TxnGenerate + | x == "send" = return TxnSend + | x == "receive" = return TxnReceive + | x == "move" = return TxnMove + parseJSON _ = mzero + +-- | Information on a specific transaction. +data TransactionDetails = TransactionDetails { txnCategory :: TransactionCategory + , txnAmount :: Amount + -- ^ Amount of transaction. + , txnFee :: Maybe Amount + -- ^ Fee (if any) paid. Only for send transactions. + , txnConfirmations :: Maybe Integer + -- ^ Number of confirmations. Only for generate/send/receive. + , txnID :: Maybe Text + -- ^ Transaction ID. Only for generate/send/receive. + , txnOtherAccount :: Maybe Account + -- ^ Account funds were moved to or from. Move only. + , txnMessage :: Maybe Text + -- ^ Message associated with transaction. Send only. + , txnTo :: Maybe Address + -- ^ Message-to associated with transaction. Send only. + } + deriving ( Show, Read, Eq, Ord ) + +instance FromJSON TransactionDetails where + parseJSON (Object o) = TransactionDetails <$> o .: "category" + <*> o .: "amount" + <*> o .:? "fee" + <*> o .:? "confirmations" + <*> o .:? "txid" + <*> o .:? "otheraccount" + <*> o .:? "message" + <*> o .:? "to" + parseJSON _ = mzero + +-- | Returns a vector of 'TransactionDetails's. +listTransactions' :: Auth + -> Maybe Account -- ^ If nothing, retrieves transactions for + -- all accounts. Otherwise, only retrieves + -- transactions from the given account. + -> Integer -- ^ How far back (in transactions) should we look? + -> IO (Vector TransactionDetails) +listTransactions' auth (Just acc) count = callApi auth "listtransactions" [ tj acc, tj count ] +listTransactions' auth Nothing count = callApi auth "listtransactions" [ tj ("*"::Text), tj count ] + +-- | The simple API to 'listTransactions'' +-- +-- Returns the last 10 transactions through any account. +listTransactions :: Auth -> IO (Vector TransactionDetails) +listTransactions auth = listTransactions' auth Nothing 10 + +-- | Move funds between accounts. +moveBitcoins' :: Auth + -> Account -- ^ The account we're withdrawing from. + -> Account -- ^ The account we're depositing into. + -> Amount -- ^ The amount of bitcoins to transfer. + -> MinConf -- ^ The minimum number of confirmations to wait for. + -> Maybe Text -- ^ A comment for the transaction. + -> Maybe Text -- ^ A comment-to for the transaction. + -> IO () +moveBitcoins' auth from to amt conf comm comm2 = callApi auth "move" [ tj from + , tj to + , tj amt + , tj conf + , tj comm' + , tj comm2' + ] + where + comm' = fromMaybe "" comm + comm2' = fromMaybe "" comm2 + +-- | Move funds between accounts - the simple version. +moveBitcoins :: Auth + -> Account -- ^ The account we're withdrawing from. + -> Account -- ^ The account we're depositing into. + -> Amount -- ^ The amount of bitcoins to transfer. + -> Maybe Text -- ^ A comment, if you wish. + -> IO () +moveBitcoins auth from to amt comm = moveBitcoins' auth from to amt 1 comm Nothing + +-- | Send bitcoins from an account to a given bitcoin address. +-- +-- If the funds are not available, a 'BitcoinException' will be thrown. +-- Otherwise, the transaction ID will be returned. +sendBitcoins' :: Auth + -> Maybe Account -- ^ The account to transfer from. If 'Nothing', + -- uses the default account of \"\". + -> Address -- ^ The address to transfer to. + -> Amount -- ^ The amount of bitcoins to transfer. + -> MinConf -- ^ The minimum number of confirmations to wait for. + -> Maybe Text -- ^ A comment for the transaction. + -> Maybe Text -- ^ A comment-to for the transaction. + -> IO Text -- ^ Returns a transaction ID on success. +sendBitcoins' auth Nothing addr amt _ comm comm2 = callApi auth "sendtoaddress" [ tj addr, tj amt, tj comm', tj comm2' ] + where comm' = fromMaybe "" comm + comm2' = fromMaybe "" comm2 +sendBitcoins' auth (Just acc) addr amt conf comm comm2 = callApi auth "sendfrom" [ tj acc, tj addr, tj amt, tj conf, tj comm', tj comm2' ] + where comm' = fromMaybe "" comm + comm2' = fromMaybe "" comm2 + +-- | The simpler version of 'sendBitcoins''. +-- +-- Sends the given amount of bitcoins to the given address. +-- The funds will be taken from the default account. If you +-- wish to specify the account, use 'sendBitcoins'' instead. +-- +-- If the funds are not available, a 'BitcoinException' will +-- be thrown. Otherwise, the transaction ID will be returned. +sendBitcoins :: Auth + -> Address -- ^ The address to send to. + -> Amount -- ^ The amount of bitcoins to send. + -> Maybe Text -- ^ An optional comment. + -> IO Text -- ^ Returns a transaction ID on success. +sendBitcoins auth addr amt comm = sendBitcoins' auth Nothing addr amt 1 comm Nothing + +-- | Stops the bitcoin server. +stopBitcoind :: Auth -> IO () +stopBitcoind auth = callApi auth "stop" [] -- | Encapsulates address validation results from 'validateAddress' data AddressValidation = AddressValidation { isValid :: Bool -- ^ Is the address valid? , isMine :: Bool -- ^ Does the address belong to my wallet? , account :: Account -- ^ To which account does this address belong? - } deriving (Show) + } deriving ( Show, Read, Eq, Ord ) + +instance FromJSON AddressValidation where + parseJSON (Object o) = AddressValidation <$> o .: "isvalid" + <*> o .: "ismine" + <*> o .: "address" + parseJSON _ = mzero -- | Return information about an address. -- If the address is invalid or doesn't belong to us, the account name @@ -270,18 +620,9 @@ data AddressValidation = AddressValidation validateAddress :: Auth -> Address -> IO AddressValidation -validateAddress auth addr = do - (Object result) <- callApi auth "validateaddress" [toValue addr] - return AddressValidation - { isValid = bool False "isvalid" result - , isMine = bool False "ismine" result - , account = str "" "account" result - } - where - bool d k r = maybe d (\(Bool b)->b) $ M.lookup k r - str d k r = maybe d (\(String t)->T.unpack t) $ M.lookup k r +validateAddress auth addr = callApi auth "validateaddress" [ tj addr ] -- | Returns true if the RPC says the address is valid. --- Use this function until 'mkAddress' verifies address checksums +-- Use this function until 'mkAddress' verifies address checksums isValidAddress :: Auth -> Address -> IO Bool -isValidAddress auth addr = validateAddress auth addr >>= return . isValid +isValidAddress auth addr = isValid <$> validateAddress auth addr diff --git a/src/Network/Bitcoin/Address.hs b/src/Network/Bitcoin/Address.hs index 91c97b5..d5af07c 100644 --- a/src/Network/Bitcoin/Address.hs +++ b/src/Network/Bitcoin/Address.hs @@ -1,3 +1,7 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE DeriveDataTypeable #-} +-- | This module contains an encapsulated method of generating and extracting +-- valid bitcoin addresses. module Network.Bitcoin.Address ( -- * Types @@ -5,28 +9,44 @@ module Network.Bitcoin.Address -- * Functions , mkAddress + , addressToText ) where +import Data.Aeson +import Data.Text ( Text ) +import qualified Data.Text as T +import Data.Typeable + -- | Represents a Bitcoin receiving address. Construct one with -- 'mkAddress'. -data Address = Address String -instance Show Address where - show (Address s) = s +newtype Address = Address Text + deriving ( ToJSON + , FromJSON + , Typeable + , Eq + , Ord + , Read + , Show + ) + +-- | Converts a given address to its textual representation. +addressToText :: Address -> Text +addressToText (Address t) = t --- | Construct an 'Address' from a 'String'. --- Returns 'Nothing' if the string is not a valid Bitcoin address. +-- | Construct an 'Address' from 'Text'. +-- Returns 'Nothing' if the text is not a valid Bitcoin address. -- -- Only validates approximate address format. -- /Does not/ validate address checksum. -- Until full validation is done, use 'isValidAddress' RPC call instead -mkAddress :: String -> Maybe Address +mkAddress :: Text -> Maybe Address mkAddress s = - if isOK s + if isOK (T.unpack s) then Just $ Address s else Nothing where -- TODO validate address checksum (write base58 module first) - isOK ('1':_) = (length s >= 25) && (length s <= 34) - isOK ('m':_) = (length s >= 26) && (length s <= 34) - isOK ('n':_) = (length s >= 26) && (length s <= 34) + isOK ('1':_) = (T.length s >= 25) && (T.length s <= 34) + isOK ('m':_) = (T.length s >= 26) && (T.length s <= 34) + isOK ('n':_) = (T.length s >= 26) && (T.length s <= 34) isOK _ = False diff --git a/src/test-main.hs b/src/test-main.hs deleted file mode 100644 index e912871..0000000 --- a/src/test-main.hs +++ /dev/null @@ -1,33 +0,0 @@ -{-# LANGUAGE TypeSynonymInstances #-} -module Main where - -import System.Exit (exitFailure, exitSuccess) -import Test.QuickCheck -import Data.Attoparsec.Number -import Network.Bitcoin -import Data.Ratio -import Data.Fixed -import Text.Printf - --- Creates an amount with the specified number of satoshis -satoshis :: Integer -> Ratio Integer -satoshis = (%resolution (Fixed Satoshi)) - -instance Arbitrary Number where - arbitrary = fmap (D . fromRational . satoshis . abs) arbitrarySizedIntegral - -fromNumberRoundTrip :: Number -> Bool -fromNumberRoundTrip n = (origString n) == rtString - where - trimZeros = reverse . dropWhile (=='0') . reverse - origString (I i) = show i - origString (D d) = trimZeros $ printf "%.8f" d - rtString = trimZeros $ show (fromNumber n :: Amount) - -main = do - result <- quickCheckResult fromNumberRoundTrip - case result of - Success{} -> exitSuccess - GaveUp{} -> exitFailure - Failure{} -> exitFailure - NoExpectedFailure{} -> exitSuccess From 65123ff74b8191ff9b05958c2a4b91f471923678 Mon Sep 17 00:00:00 2001 From: Clark Gaebel Date: Thu, 25 Oct 2012 22:28:50 -0400 Subject: [PATCH 02/73] Added a travis config. --- .travis.yml | 4 ++++ 1 file changed, 4 insertions(+) create mode 100644 .travis.yml diff --git a/.travis.yml b/.travis.yml new file mode 100644 index 0000000..1f3cb55 --- /dev/null +++ b/.travis.yml @@ -0,0 +1,4 @@ +language: haskell +notifications: + email: + - cg.wowus.cg@gmail.com From 678866925e613887f325d450810eb3541acd7de3 Mon Sep 17 00:00:00 2001 From: Clark Gaebel Date: Thu, 25 Oct 2012 22:44:40 -0400 Subject: [PATCH 03/73] Testing travis-ci. --- empty-file | 0 1 file changed, 0 insertions(+), 0 deletions(-) create mode 100644 empty-file diff --git a/empty-file b/empty-file new file mode 100644 index 0000000..e69de29 From 65917da661fabdadd3856fd638e78bda95fccfa5 Mon Sep 17 00:00:00 2001 From: Clark Gaebel Date: Thu, 25 Oct 2012 22:44:54 -0400 Subject: [PATCH 04/73] Testing travis-ci part 2. --- empty-file | 0 1 file changed, 0 insertions(+), 0 deletions(-) delete mode 100644 empty-file diff --git a/empty-file b/empty-file deleted file mode 100644 index e69de29..0000000 From 5689d32b9badb09bcfe87b9f1511b2bd34ffaab0 Mon Sep 17 00:00:00 2001 From: Clark Gaebel Date: Thu, 25 Oct 2012 22:53:18 -0400 Subject: [PATCH 05/73] Changed the email notifications for Travis CI. --- .travis.yml | 2 ++ 1 file changed, 2 insertions(+) diff --git a/.travis.yml b/.travis.yml index 1f3cb55..4c2f68b 100644 --- a/.travis.yml +++ b/.travis.yml @@ -2,3 +2,5 @@ language: haskell notifications: email: - cg.wowus.cg@gmail.com + on_success: always + on_failure: always From b9847fa4cf1b84cedc44a21f68644a5ec924193b Mon Sep 17 00:00:00 2001 From: Clark Gaebel Date: Thu, 25 Oct 2012 23:18:40 -0400 Subject: [PATCH 06/73] More travis.yml updates. --- .travis.yml | 2 ++ 1 file changed, 2 insertions(+) diff --git a/.travis.yml b/.travis.yml index 4c2f68b..5ea5f3a 100644 --- a/.travis.yml +++ b/.travis.yml @@ -4,3 +4,5 @@ notifications: - cg.wowus.cg@gmail.com on_success: always on_failure: always +install: + - cabal install --enable-tests --haddock-html --haddock-internal From 1653057d75c1e4e6fbb2e81d1a01fff080f0266a Mon Sep 17 00:00:00 2001 From: Clark Gaebel Date: Sat, 3 Nov 2012 23:23:27 -0400 Subject: [PATCH 07/73] Reorganized/rewrote the library to better conform to bitcoind's internal RPC representation. --- network-bitcoin.cabal | 67 +-- src/Network/Bitcoin.hs | 716 ++++---------------------- src/Network/Bitcoin/Address.hs | 52 -- src/Network/Bitcoin/BlockChain.hs | 164 ++++++ src/Network/Bitcoin/Dump.hs | 33 ++ src/Network/Bitcoin/Internal.hs | 163 ++++++ src/Network/Bitcoin/Mining.hs | 220 ++++++++ src/Network/Bitcoin/Net.hs | 71 +++ src/Network/Bitcoin/RawTransaction.hs | 354 +++++++++++++ src/Network/Bitcoin/Types.hs | 92 ++++ src/Network/Bitcoin/Wallet.hs | 465 +++++++++++++++++ 11 files changed, 1684 insertions(+), 713 deletions(-) delete mode 100644 src/Network/Bitcoin/Address.hs create mode 100644 src/Network/Bitcoin/BlockChain.hs create mode 100644 src/Network/Bitcoin/Dump.hs create mode 100644 src/Network/Bitcoin/Internal.hs create mode 100644 src/Network/Bitcoin/Mining.hs create mode 100644 src/Network/Bitcoin/Net.hs create mode 100644 src/Network/Bitcoin/RawTransaction.hs create mode 100644 src/Network/Bitcoin/Types.hs create mode 100644 src/Network/Bitcoin/Wallet.hs diff --git a/network-bitcoin.cabal b/network-bitcoin.cabal index 0e95e99..89da5d1 100644 --- a/network-bitcoin.cabal +++ b/network-bitcoin.cabal @@ -1,18 +1,6 @@ --- network-bitcoin.cabal auto-generated by cabal init. For additional --- options, see --- http://www.haskell.org/cabal/release/cabal-latest/doc/users-guide/authors.html#pkg-descr. --- The name of the package. Name: network-bitcoin - --- The package version. See the Haskell package versioning policy --- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for --- standards guiding when and how versions should be incremented. -Version: 0.2.0 - --- A short (one-line) description of the package. -Synopsis: Interface with Bitcoin RPC - --- A longer description of the package. +Version: 1.0.0 +Synopsis: An interface to bitcoind. Description: This can be used to send Bitcoins, query balances, etc. It requires the Bitcoin daemon to be running and accessible via @@ -28,10 +16,11 @@ Description: . To learn more about Bitcoin, see . . - Changes in v2.0 + Changes in v1.0 . - - Support for many more API calls - - Update to latest version of aeson and family. + - Total overhaul of the library, with almost the complete bitcoin RPC API + covered. + - Dependencies upgraded, and library modernized. . Changes in v0.1.5 . @@ -40,47 +29,35 @@ Description: Changes in v0.1.4 . - More accurate conversion of Bitcoin amounts from floating point - --- The license under which the package is released. License: BSD3 - --- The file containing the license text. License-file: LICENSE - --- The package author(s). Author: Michael Hendricks - --- An email address to which users can send suggestions, bug reports, --- and patches. Maintainer: Michael Hendricks - -Stability: experimental -Homepage: http://github.com/mndrix/network-bitcoin -Bug-reports: http://github.com/mndrix/network-bitcoin/issues - --- A copyright notice. +Stability: experimental +Homepage: http://github.com/wowus/network-bitcoin +Bug-reports: http://github.com/wowus/network-bitcoin/issues Copyright: Copyright 2012, Michael Hendricks - + Copyright 2012, Clark Gaebel Category: Network - Build-type: Simple - --- Extra files to be distributed with the package, such as examples or --- a README. --- Extra-source-files: - --- Constraint on the version of Cabal needed to build this package. Cabal-version: >=1.8 Library hs-source-dirs: src - ghc-options: -Wall -fno-warn-unused-binds -fno-warn-incomplete-patterns + ghc-options: -Wall -- Modules exported by the library. Exposed-modules: Network.Bitcoin - Network.Bitcoin.Address + Network.Bitcoin.BlockChain + Network.Bitcoin.Dump + Network.Bitcoin.Internal + Network.Bitcoin.Mining + Network.Bitcoin.Net + Network.Bitcoin.RawTransaction + Network.Bitcoin.Types + Network.Bitcoin.Wallet -- Packages needed in order to build this package. Build-depends: @@ -94,12 +71,6 @@ Library vector >= 0.10, base == 4.* - -- Modules not exported by this package. - -- Other-modules: - - -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source. - -- Build-tools: - Source-repository head type: git location: git://github.com/mndrix/network-bitcoin.git diff --git a/src/Network/Bitcoin.hs b/src/Network/Bitcoin.hs index 706ce92..c0d44a4 100644 --- a/src/Network/Bitcoin.hs +++ b/src/Network/Bitcoin.hs @@ -1,628 +1,118 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE TypeSynonymInstances #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE ImpredicativeTypes #-} {-# OPTIONS_GHC -Wall #-} -- | A Haskell binding to the bitcoind server. module Network.Bitcoin ( - -- * Types + -- * Common Types Auth(..) - , Address - , mkAddress - , Amount - , Account - , MinConf - , AddressValidation - , isValid - , isMine - , account , BitcoinException(..) + , HexString + , TransactionID , Satoshi(..) - - -- * Individual API methods - -- ** Account Administration + , BTC + , Account + , Address + , ScriptSig + -- * Block Chain Operations + , getBlockCount + , getDifficulty + , setTransactionFee + , getRawMemoryPool + , BlockHash + , getBlockHash + , Block(..) + , getBlock + , OutputSetInfo(..) + , getOutputSetInfo + , OutputInfo(..) + , getOutputInfo + -- * Private Key Operations + , importPrivateKey + , dumpPrivateKey + -- * Mining Operations + , getGenerate + , setGenerate + , getHashesPerSec + , MiningInfo(..) + , getMiningInfo + , HashData(..) + , getWork + , solveBlock + , Transaction(..) + , CoinBaseAux(..) + , BlockTemplate(..) + , getBlockTemplate + , submitBlock + -- * Network Operations + , getConnectionCount + , PeerInfo(..) + , getPeerInfo + -- * Raw Transaction Operations + , RawTransaction + , getRawTransaction + , TxIn(..) + , TxnOutputType(..) + , ScriptPubKey(..) + , TxOut(..) + , BlockInfo(..) + , RawTransactionInfo(..) + , getRawTransactionInfo + , UnspentTransaction(..) + , listUnspent + , createRawTransaction + , DecodedRawTransaction(..) + , decodeRawTransaction + , WhoCanPay(..) + , RawSignedTransaction(..) + , signRawTransaction + , sendRawTransaction + -- * Wallet Operations + , BitcoindInfo(..) + , getBitcoindInfo + , getNewAddress + , getAccountAddress , getAccount , setAccount - , getAccountAddress - , getAddressesByAccount - , getBalance - , getNewAddress - -- ** Amount Paid By Someone Retrieval - , getReceivedByAccount + , getAddressByAccount + , sendToAddress + , AddressInfo(..) + , listAddressGroupings + , Signature + , signMessage + , verifyMessage , getReceivedByAddress --- , getTransaction -- TODO --- , getWork -- TODO --- , listAccounts -- TODO - -- ** Listing Payments Received - , ReceivedPaymentByAcc(..) - , listReceivedByAccount - , listReceivedByAccount' - , ReceivedPaymentByAddr(..) + , getReceivedByAddress' + , getReceivedByAccount + , getReceivedByAccount' + , getBalance + , getBalance' + , getBalance'' + , moveBitcoins + , sendFromAccount + , sendMany + -- , createMultiSig + , ReceivedByAddress(..) , listReceivedByAddress , listReceivedByAddress' - -- ** Listing Transactions - , TransactionDetails(..) - , listTransactions - -- ** Moving Bitcoins - , moveBitcoins - , moveBitcoins' - -- ** Sending Bitcoins - , sendBitcoins - , sendBitcoins' - -- ** Server Administration - , BitcoinServerInfo(..) - , getInfo + , ReceivedByAccount(..) + , listReceivedByAccount + , listReceivedByAccount' + -- , listTransactions + -- , listAccounts + -- , listSinceBlock + -- , getTransaction , backupWallet - , getBlockCount - , getBlockNumber - , getConnectionCount - , getDifficulty - , getGenerate - , setGenerate - , getHashesPerSec - , stopBitcoind - -- ** Validation - , validateAddress - , isValidAddress - - -- * Low-level API - , callApi + , keyPoolRefill + , unlockWallet + , lockWallet + , changePassword + , encryptWallet + , isAddressValid ) where -import Network.Bitcoin.Address - -import Control.Applicative -import Control.Exception -import Control.Monad -import Data.Aeson as A -import Data.Attoparsec.Number -import Data.Fixed -import Data.Maybe (fromJust, fromMaybe) -import Data.Ratio ((%)) -import Data.Typeable -import Data.Vector ( Vector ) -import Network.Browser -import Network.HTTP hiding (password) -import Network.URI (parseURI) -import qualified Data.ByteString.Lazy as BL -import Data.Text ( Text ) -import qualified Data.Text as T - --- | Defines Bitcoin's internal precision -satoshis :: Integer -satoshis = 10^(8::Integer) - --- | We just use this datatype to implement an instance of 'Fixed' for --- satoshis (the unit of bitcoin). -data Satoshi = Satoshi - -instance HasResolution Satoshi where - resolution _ = satoshis - --- | Fixed precision Bitcoin amount (to avoid floating point errors). -newtype Amount = Amount (Fixed Satoshi) - deriving ( Typeable - , Enum - , Eq - , Fractional - , Num - , Ord - , Read - , Real - , RealFrac - , Show ) - --- | The name of a Bitcoin wallet account. -type Account = Text - --- | Reprsents the minimum number of confirmations for a payment. -type MinConf = Integer - --- | 'Auth' describes authentication credentials for --- making API requests to the Bitcoin daemon. -data Auth = Auth - { rpcUrl :: Text -- ^ URL, with port, where bitcoind listens - , rpcUser :: Text -- ^ same as bitcoind's 'rpcuser' config - , rpcPassword :: Text -- ^ same as bitcoind's 'rpcpassword' config - } - deriving (Show, Read, Ord, Eq) - --- | RPC calls return an error object. It can either be empty; or have an --- error message + error code. -data BitcoinRpcError = NoError -- ^ All good. - | BitcoinRpcError Int Text -- ^ Error code + error message. - deriving ( Show, Read, Ord, Eq ) - -instance FromJSON BitcoinRpcError where - parseJSON (Object v) = BitcoinRpcError <$> v .: "code" - <*> v .: "message" - parseJSON Null = return NoError - parseJSON _ = mzero - --- | A response from bitcoind will contain the result of the JSON-RPC call, and --- an error. The error should be null if a valid response was received. -data BitcoinRpcResponse a = BitcoinRpcResponse { btcResult :: a - , btcError :: BitcoinRpcError - } - deriving ( Show, Read, Ord, Eq ) - -instance FromJSON a => FromJSON (BitcoinRpcResponse a) where - parseJSON (Object v) = BitcoinRpcResponse <$> v .: "result" - <*> v .: "error" - parseJSON _ = mzero - --- | A 'BitcoinException' is thrown when 'callApi encounters an --- error. The API error code is represented as an @Int@, the message as --- a @String@. --- --- It may also be thrown when the value returned by the bitcoin API wasn't --- what we expected. --- --- WARNING: Any of the functions in this module's public API may throw this --- exception. You should plan on handling it. -data BitcoinException = BitcoinApiError Int String - -- ^ A 'BitcoinApiError' has an error code error - -- message, as returned by bitcoind's JSON-RPC - -- response. - | BitcoinResultTypeError BL.ByteString - -- ^ The raw JSON returned. - deriving (Show,Typeable) - -instance Exception BitcoinException - --- | encodes an RPC request into a ByteString containing JSON -jsonRpcReqBody :: Text -> [Value] -> BL.ByteString -jsonRpcReqBody cmd params = encode $ object [ - "jsonrpc" .= ("2.0"::Text), - "method" .= cmd, - "params" .= params, - "id" .= (1::Int) - ] - --- | 'callApi is a low-level interface for making authenticated API --- calls to a Bitcoin daemon. The first argument specifies --- authentication details (URL, username, password) and is often --- curried for convenience: --- --- > callBtc = callApi $ Auth "http://127.0.0.1:8332" "user" "password" --- --- The second argument is the command name. The third argument provides --- parameters for the API call. --- --- > let result = callBtc "getbalance" [ toJSON "account-name", toJSON 6 ] --- --- On error, throws a 'BitcoinException'. -callApi :: FromJSON v - => Auth -- ^ authentication credentials for bitcoind - -> Text -- ^ command name - -> [Value] -- ^ command arguments - -> IO v -callApi auth command params = do - (_,httpRes) <- browse $ do - setOutHandler $ const $ return () - addAuthority authority - setAllowBasicAuth True - request . httpRequest (T.unpack urlString) $ jsonRpcReqBody command params - let response = rspBody httpRes - case decode' response of - Just r@(BitcoinRpcResponse {btcError=NoError}) - -> return $ btcResult r - Just (BitcoinRpcResponse {btcError=BitcoinRpcError code msg}) - -> throw $ BitcoinApiError code (T.unpack msg) - Nothing - -> throw . BitcoinResultTypeError $ response - where authority = httpAuthority auth - urlString = rpcUrl auth - --- | Internal helper functions to make callApi more readable -httpAuthority :: Auth -> Authority -httpAuthority (Auth urlString username password) = - AuthBasic { - auRealm = "jsonrpc", - auUsername = T.unpack username, - auPassword = T.unpack password, - auSite = uri - } - where uri = fromJust . parseURI $ T.unpack urlString - --- | Builds the JSON HTTP request. -httpRequest :: String -> BL.ByteString -> Request BL.ByteString -httpRequest urlString jsonBody = - (postRequest urlString){ - rqBody = jsonBody, - rqHeaders = [ - mkHeader HdrContentType "application/json", - mkHeader HdrContentLength (show $ BL.length jsonBody) - ] - } - -instance FromJSON Amount where - parseJSON (Number (I n)) = return $ fromInteger n - parseJSON (Number (D n)) = let numerator = round $ n*fromInteger satoshis - in return . fromRational $ numerator % satoshis - parseJSON _ = mzero - --- THIS MIGHT BE TROUBLE. We're converting to double. Does the bitcoin API --- accept satoshis? Those would be better to use. -instance ToJSON Amount where - toJSON (Amount n) = toJSON (realToFrac n :: Double) - --- | A handy shortcut. -tj :: ToJSON a => a -> Value -tj = toJSON - --- | Safely copies *wallet.dat* to 'destination', which can be a --- directory or a path with filename. -backupWallet :: Auth - -> Text -- ^ destination - -> IO () -backupWallet auth dest = callApi auth "backupwallet" [ tj dest ] - --- | Returns the account associated with the given address. --- --- If an invalid address is given, a 'BitcoinException' will be thrown. -getAccount :: Auth - -> Address -- ^ bitcoin address - -> IO Account -getAccount auth addr = callApi auth "getaccount" [ tj addr ] - --- | Sets the account associated with the given address. The account may be --- 'Nothing' to remove an address from the account. -setAccount :: Auth - -> Address -- ^ The address to associate with the account. - -> Maybe Account -- ^ The account to associate with the address. - -> IO () -setAccount auth addr Nothing = callApi auth "setaccount" [ tj addr ] -setAccount auth addr (Just acc) = callApi auth "setaccount" [ tj addr, tj acc ] - --- | Returns a new bitcoin address for the given account. -getAccountAddress :: Auth - -> Account - -> IO Address -getAccountAddress auth acc = callApi auth "getaccountaddress" [ tj acc ] - --- | Returns the list of addresses associated with the given 'account'. -getAddressesByAccount :: Auth - -> Account - -> IO (Vector Address) -getAddressesByAccount auth acc = callApi auth "getaddressesbyaccount" [ tj acc ] - --- | Returns the server's available balance, or, if an account is given, the --- balance for the given account. -getBalance :: Auth - -> Maybe Account - -> IO Amount -getBalance auth Nothing = callApi auth "getbalance" [] -getBalance auth (Just acc) = callApi auth "getbalance" [ tj acc ] - --- | Returns the number of blocks in the longest block chain. -getBlockCount :: Auth -> IO Integer -getBlockCount auth = callApi auth "getblockcount" [] - --- | Returns the block number of the latest block in the --- longest block chain. -getBlockNumber :: Auth -> IO Integer -getBlockNumber auth = callApi auth "getblocknumber" [] - --- | Returns the number of connections to other nodes. -getConnectionCount :: Auth -> IO Integer -getConnectionCount auth = callApi auth "getconnectioncount" [] - --- | Returns the proof-of-work difficulty as a multiple of the minimum --- difficulty. -getDifficulty :: Auth -> IO Double -getDifficulty auth = callApi auth "getdifficulty" [] - --- | Returns boolean true if server is trying to generate bitcoins, --- false otherwise. -getGenerate :: Auth -> IO Bool -getGenerate auth = callApi auth "getgenerate" [] - --- | Generation is limited to the given number of processors, -1 is --- unlimited. -setGenerate :: Auth - -> Bool -- ^ Should we generate bitcoins? - -> Int -- ^ The processor limit. - -> IO () -setGenerate auth shouldStart n = callApi auth "setgenerate" [ tj shouldStart, tj n ] - --- | Returns a recent hashes per second performance measurement while --- generating. -getHashesPerSec :: Auth -> IO Integer -getHashesPerSec auth = callApi auth "gethashespersec" [] - --- | A structural representation of the response bitcoind gives on a 'getInfo' --- call. -data BitcoinServerInfo = BitcoinServerInfo { bsiVersion :: Integer - , bsiBalance :: Amount - , bsiBlocks :: Integer - , bsiConnections :: Integer - , bsiProxy :: Text - , bsiGenerate :: Bool - , bsiGenProcLimit :: Integer - , bsiDifficulty :: Double - , bsiHashesPerSec :: Double - , bsiTestnet :: Bool - , bsiKeyPoolOldDest :: Integer - , bsiPayTxFee :: Amount - , bsiErrors :: Text - } - deriving (Eq, Ord, Show, Read) - -instance FromJSON BitcoinServerInfo where - parseJSON (Object o) = BitcoinServerInfo <$> o .: "version" - <*> o .: "balance" - <*> o .: "blocks" - <*> o .: "connections" - <*> o .: "proxy" - <*> o .: "generate" - <*> o .: "genproclimit" - <*> o .: "difficulty" - <*> o .: "hashespersec" - <*> o .: "testnet" - <*> o .: "keypoololddest" - <*> o .: "paytxfee" - <*> o .: "errors" - parseJSON _ = mzero - --- | Retrieves a whole bunch of stats on bitcoind. -getInfo :: Auth -> IO BitcoinServerInfo -getInfo auth = callApi auth "getinfo" [] - --- | Returns a new bitcoin address for receiving payments. If an account --- is specified (recommended), it is added to the address book so payments --- received with the address will be credited to the account automatically. -getNewAddress :: Auth - -> Maybe Account - -> IO Address -getNewAddress auth (Just acc) = callApi auth "getnewaddress" [ tj acc ] -getNewAddress auth Nothing = callApi auth "getnewaddress" [] - --- | Returns the total amount received by addresses associated with 'account' --- in transactions with at least 'MinConf' confirmations. --- --- A good default value for 'MinConf' is 1. -getReceivedByAccount :: Auth - -> Account - -> MinConf - -> IO Amount -getReceivedByAccount auth acct conf = callApi auth "getreceivedbyaccount" [ tj acct, tj conf ] - --- | Returns the total amount received by the given address in transactions --- with at least 'MinConf' confirmations. --- --- A good default value for 'MinConf' is 1. -getReceivedByAddress :: Auth - -> Address - -> MinConf - -> IO Amount -getReceivedByAddress auth addr conf = callApi auth "getreceivedbyaddress" [ tj addr, tj conf ] - --- | Represents a single received payment for an account. -data ReceivedPaymentByAcc = ReceivedPaymentByAcc { receivedInto :: Account - -- ^ The account of the receiving address. - , byAcctAmountReceived :: Amount - -- ^ Total amount received by the address. - , byAcctReceivedConfirmations :: Integer - -- ^ number of confirmations of the most - -- recent transaction included. - } - deriving ( Show, Read, Eq, Ord ) - -instance FromJSON ReceivedPaymentByAcc where - parseJSON (Object o) = ReceivedPaymentByAcc <$> o .: "account" - <*> o .: "amount" - <*> o .: "confirmations" - parseJSON _ = mzero - --- | Returns a vector of 'ReceivedPaymentByAcc's. -listReceivedByAccount' :: Auth - -> MinConf -- ^ The minimum number of confirmations - -- needed for a transaction to be valid. - -> Bool -- ^ Should we include addresses which haven't - -- received any payments? - -> IO (Vector ReceivedPaymentByAcc) -listReceivedByAccount' auth mc includeEmpty = callApi auth "listreceivedbyaccount" [ tj mc, tj includeEmpty ] - --- | Returns a vector of 'ReceivedPaymentByAcc's. --- --- Is a shortcut for: `\auth -> listReceivedByAccount' auth 1 False` -listReceivedByAccount :: Auth - -> IO (Vector ReceivedPaymentByAcc) -listReceivedByAccount auth = callApi auth "listreceivedbyaccount" [] - --- | Represents a single received payment for an address. -data ReceivedPaymentByAddr = ReceivedPaymentByAddr { receiveAddress :: Address - -- ^ The address the payment was received from. - , byAddrReceivedInto :: Account - -- ^ The account of the receiving address. - , amountReceived :: Amount - -- ^ Total amount received by the address. - , byAddrReceivedConfirmations :: Integer - -- ^ number of confirmations of the most - -- recent transaction included. - } - deriving ( Show, Read, Eq, Ord ) - -instance FromJSON ReceivedPaymentByAddr where - parseJSON (Object o) = ReceivedPaymentByAddr <$> o .: "address" - <*> o .: "account" - <*> o .: "amount" - <*> o .: "confirmations" - parseJSON _ = mzero - - --- | Returns a vector of 'ReceivedPaymentByAddr's. -listReceivedByAddress' :: Auth - -> MinConf -- ^ The minimum number of confirmations - -- needed for a transaction to be valid. - -> Bool -- ^ Should we include addresses which haven't - -- received any payments? - -> IO (Vector ReceivedPaymentByAddr) -listReceivedByAddress' auth mc includeEmpty = callApi auth "listreceivedbyaddress" [ tj mc, tj includeEmpty ] - --- | Returns a vector of 'ReceivedPaymentByAddr's. --- --- Is a shortcut for: `\auth -> listReceivedByAddress' auth 1 False` -listReceivedByAddress :: Auth - -> IO (Vector ReceivedPaymentByAddr) -listReceivedByAddress auth = callApi auth "listreceivedbyaddress" [] - --- | A transaction category is used to classify the transaction details we --- receive from bitcoind. -data TransactionCategory = TxnGenerate - | TxnSend - | TxnReceive - | TxnMove - deriving ( Show, Read, Eq, Ord ) - -instance FromJSON TransactionCategory where - parseJSON (String x) | x == "generate" = return TxnGenerate - | x == "send" = return TxnSend - | x == "receive" = return TxnReceive - | x == "move" = return TxnMove - parseJSON _ = mzero - --- | Information on a specific transaction. -data TransactionDetails = TransactionDetails { txnCategory :: TransactionCategory - , txnAmount :: Amount - -- ^ Amount of transaction. - , txnFee :: Maybe Amount - -- ^ Fee (if any) paid. Only for send transactions. - , txnConfirmations :: Maybe Integer - -- ^ Number of confirmations. Only for generate/send/receive. - , txnID :: Maybe Text - -- ^ Transaction ID. Only for generate/send/receive. - , txnOtherAccount :: Maybe Account - -- ^ Account funds were moved to or from. Move only. - , txnMessage :: Maybe Text - -- ^ Message associated with transaction. Send only. - , txnTo :: Maybe Address - -- ^ Message-to associated with transaction. Send only. - } - deriving ( Show, Read, Eq, Ord ) - -instance FromJSON TransactionDetails where - parseJSON (Object o) = TransactionDetails <$> o .: "category" - <*> o .: "amount" - <*> o .:? "fee" - <*> o .:? "confirmations" - <*> o .:? "txid" - <*> o .:? "otheraccount" - <*> o .:? "message" - <*> o .:? "to" - parseJSON _ = mzero - --- | Returns a vector of 'TransactionDetails's. -listTransactions' :: Auth - -> Maybe Account -- ^ If nothing, retrieves transactions for - -- all accounts. Otherwise, only retrieves - -- transactions from the given account. - -> Integer -- ^ How far back (in transactions) should we look? - -> IO (Vector TransactionDetails) -listTransactions' auth (Just acc) count = callApi auth "listtransactions" [ tj acc, tj count ] -listTransactions' auth Nothing count = callApi auth "listtransactions" [ tj ("*"::Text), tj count ] - --- | The simple API to 'listTransactions'' --- --- Returns the last 10 transactions through any account. -listTransactions :: Auth -> IO (Vector TransactionDetails) -listTransactions auth = listTransactions' auth Nothing 10 - --- | Move funds between accounts. -moveBitcoins' :: Auth - -> Account -- ^ The account we're withdrawing from. - -> Account -- ^ The account we're depositing into. - -> Amount -- ^ The amount of bitcoins to transfer. - -> MinConf -- ^ The minimum number of confirmations to wait for. - -> Maybe Text -- ^ A comment for the transaction. - -> Maybe Text -- ^ A comment-to for the transaction. - -> IO () -moveBitcoins' auth from to amt conf comm comm2 = callApi auth "move" [ tj from - , tj to - , tj amt - , tj conf - , tj comm' - , tj comm2' - ] - where - comm' = fromMaybe "" comm - comm2' = fromMaybe "" comm2 - --- | Move funds between accounts - the simple version. -moveBitcoins :: Auth - -> Account -- ^ The account we're withdrawing from. - -> Account -- ^ The account we're depositing into. - -> Amount -- ^ The amount of bitcoins to transfer. - -> Maybe Text -- ^ A comment, if you wish. - -> IO () -moveBitcoins auth from to amt comm = moveBitcoins' auth from to amt 1 comm Nothing - --- | Send bitcoins from an account to a given bitcoin address. --- --- If the funds are not available, a 'BitcoinException' will be thrown. --- Otherwise, the transaction ID will be returned. -sendBitcoins' :: Auth - -> Maybe Account -- ^ The account to transfer from. If 'Nothing', - -- uses the default account of \"\". - -> Address -- ^ The address to transfer to. - -> Amount -- ^ The amount of bitcoins to transfer. - -> MinConf -- ^ The minimum number of confirmations to wait for. - -> Maybe Text -- ^ A comment for the transaction. - -> Maybe Text -- ^ A comment-to for the transaction. - -> IO Text -- ^ Returns a transaction ID on success. -sendBitcoins' auth Nothing addr amt _ comm comm2 = callApi auth "sendtoaddress" [ tj addr, tj amt, tj comm', tj comm2' ] - where comm' = fromMaybe "" comm - comm2' = fromMaybe "" comm2 -sendBitcoins' auth (Just acc) addr amt conf comm comm2 = callApi auth "sendfrom" [ tj acc, tj addr, tj amt, tj conf, tj comm', tj comm2' ] - where comm' = fromMaybe "" comm - comm2' = fromMaybe "" comm2 - --- | The simpler version of 'sendBitcoins''. --- --- Sends the given amount of bitcoins to the given address. --- The funds will be taken from the default account. If you --- wish to specify the account, use 'sendBitcoins'' instead. --- --- If the funds are not available, a 'BitcoinException' will --- be thrown. Otherwise, the transaction ID will be returned. -sendBitcoins :: Auth - -> Address -- ^ The address to send to. - -> Amount -- ^ The amount of bitcoins to send. - -> Maybe Text -- ^ An optional comment. - -> IO Text -- ^ Returns a transaction ID on success. -sendBitcoins auth addr amt comm = sendBitcoins' auth Nothing addr amt 1 comm Nothing - --- | Stops the bitcoin server. -stopBitcoind :: Auth -> IO () -stopBitcoind auth = callApi auth "stop" [] - --- | Encapsulates address validation results from 'validateAddress' -data AddressValidation = AddressValidation - { isValid :: Bool -- ^ Is the address valid? - , isMine :: Bool -- ^ Does the address belong to my wallet? - , account :: Account -- ^ To which account does this address belong? - } deriving ( Show, Read, Eq, Ord ) - -instance FromJSON AddressValidation where - parseJSON (Object o) = AddressValidation <$> o .: "isvalid" - <*> o .: "ismine" - <*> o .: "address" - parseJSON _ = mzero - --- | Return information about an address. --- If the address is invalid or doesn't belong to us, the account name --- is the empty string. -validateAddress :: Auth - -> Address - -> IO AddressValidation -validateAddress auth addr = callApi auth "validateaddress" [ tj addr ] - --- | Returns true if the RPC says the address is valid. --- Use this function until 'mkAddress' verifies address checksums -isValidAddress :: Auth -> Address -> IO Bool -isValidAddress auth addr = isValid <$> validateAddress auth addr +import Network.Bitcoin.Types +import Network.Bitcoin.BlockChain +import Network.Bitcoin.Dump +import Network.Bitcoin.Mining +import Network.Bitcoin.Net +import Network.Bitcoin.RawTransaction +import Network.Bitcoin.Wallet diff --git a/src/Network/Bitcoin/Address.hs b/src/Network/Bitcoin/Address.hs deleted file mode 100644 index d5af07c..0000000 --- a/src/Network/Bitcoin/Address.hs +++ /dev/null @@ -1,52 +0,0 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE DeriveDataTypeable #-} --- | This module contains an encapsulated method of generating and extracting --- valid bitcoin addresses. -module Network.Bitcoin.Address - ( - -- * Types - Address - - -- * Functions - , mkAddress - , addressToText - ) -where - -import Data.Aeson -import Data.Text ( Text ) -import qualified Data.Text as T -import Data.Typeable - --- | Represents a Bitcoin receiving address. Construct one with --- 'mkAddress'. -newtype Address = Address Text - deriving ( ToJSON - , FromJSON - , Typeable - , Eq - , Ord - , Read - , Show - ) - --- | Converts a given address to its textual representation. -addressToText :: Address -> Text -addressToText (Address t) = t - --- | Construct an 'Address' from 'Text'. --- Returns 'Nothing' if the text is not a valid Bitcoin address. --- --- Only validates approximate address format. --- /Does not/ validate address checksum. --- Until full validation is done, use 'isValidAddress' RPC call instead -mkAddress :: Text -> Maybe Address -mkAddress s = - if isOK (T.unpack s) - then Just $ Address s - else Nothing - where -- TODO validate address checksum (write base58 module first) - isOK ('1':_) = (T.length s >= 25) && (T.length s <= 34) - isOK ('m':_) = (T.length s >= 26) && (T.length s <= 34) - isOK ('n':_) = (T.length s >= 26) && (T.length s <= 34) - isOK _ = False diff --git a/src/Network/Bitcoin/BlockChain.hs b/src/Network/Bitcoin/BlockChain.hs new file mode 100644 index 0000000..1d50ca2 --- /dev/null +++ b/src/Network/Bitcoin/BlockChain.hs @@ -0,0 +1,164 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -Wall #-} +-- | An interface to bitcoind's available block-chain-related RPC calls. The +-- implementation of these functions can be found at +-- . +-- +-- If any APIs are missing, patches are always welcome. If you look at the +-- source of this module, you'll see that the interface code is trivial. +module Network.Bitcoin.BlockChain ( Auth(..) + , TransactionID + , BTC + , ScriptSig(..) + , getBlockCount + , getDifficulty + , setTransactionFee + , getRawMemoryPool + , BlockHash + , getBlockHash + , Block(..) + , getBlock + , OutputSetInfo(..) + , getOutputSetInfo + , OutputInfo(..) + , getOutputInfo + ) where + +import Control.Applicative +import Control.Monad +import Data.Aeson +import Network.Bitcoin.Internal + +-- | Returns the number of blocks in the longest block chain. +getBlockCount :: Auth -> IO Integer +getBlockCount auth = callApi auth "getblockcount" [] + +-- | Returns the proof-of-work difficulty as a multiple of the minimum +-- difficulty. +getDifficulty :: Auth -> IO Integer +getDifficulty auth = callApi auth "getdifficulty" [] + +-- | Sets the transaction fee will will pay to the network. Values of 0 are +-- rejected. +setTransactionFee :: Auth -> BTC -> IO () +setTransactionFee auth fee = + stupidAPI <$> callApi auth "settxfee" [ tj $ WBTC fee ] + where stupidAPI :: Bool -> () + stupidAPI = const () + +-- | Returns all transaction identifiers in the memory pool. +getRawMemoryPool :: Auth -> IO (Vector TransactionID) +getRawMemoryPool auth = callApi auth "getrawmempool" [] + +-- | The hash of a given block. +type BlockHash = HexString + +-- | Returns the hash of the block in best-block-chain at the given index. +getBlockHash :: Auth + -> Integer -- ^ Block index. + -> IO BlockHash +getBlockHash auth idx = callApi auth "getblockhash" [ tj idx ] + +-- | Information about a given block in the block chain. +data Block = Block { blockHash :: BlockHash + -- | The number of confirmations the block has. + , blkConfirmations :: Integer + -- | The size of the block. + , blkSize :: Integer + -- | The "height" of the block. TODO: Clarify this. + , blkHeight :: Integer + -- | The version of the block. + , blkVersion :: Integer + -- | The hash of the block at the root of the merkle tree + -- which this block belongs to. + , merkleRoot :: BlockHash + -- | Should this be a transaction, or transaction id? + , subTransactions :: Vector TransactionID + -- | The time it was mined. + , blkTime :: Integer + -- | The block's nonce. + , blkNonce :: Integer + , blkBits :: HexString + -- | How hard was this block to mine? + , blkDifficulty :: Integer + -- | A pointer to the next block in the chain. + , nextBlock :: Maybe BlockHash + -- | A pointer to the previous block in the chain. + , prevBlock :: Maybe BlockHash + } + deriving ( Show, Read, Ord, Eq ) + +instance FromJSON Block where + parseJSON (Object o) = Block <$> o .: "hash" + <*> o .: "confirmations" + <*> o .: "size" + <*> o .: "height" + <*> o .: "version" + <*> o .: "merkleroot" + <*> o .: "tx" + <*> o .: "time" + <*> o .: "nonce" + <*> o .: "bits" + <*> o .: "difficulty" + <*> o .:? "nextblockhash" + <*> o .:? "previousblockhash" + parseJSON _ = mzero + +-- | Returns details of a block with given block-hash. +getBlock :: Auth -> BlockHash -> IO Block +getBlock auth bh = callApi auth "getblock" [ tj bh ] + +-- | Information on the unspent transaction in the output set. +data OutputSetInfo = + OutputSetInfo { osiBestBlock :: BlockHash + -- | The number of transactions in the output set. + , numTransactions :: Integer + -- | The number of outputs for the transactions. + , transactionOutputs :: Integer + -- | The serialized size of the output set. + , serializedSize :: Integer + } + deriving ( Show, Read, Ord, Eq ) + +instance FromJSON OutputSetInfo where + parseJSON (Object o) = OutputSetInfo <$> o .: "bestblock" + <*> o .: "transactions" + <*> o .: "txouts" + <*> o .: "bytes_serialized" + parseJSON _ = mzero + +-- | Returns statistics about the unspent transaction output set. +getOutputSetInfo :: Auth -> IO OutputSetInfo +getOutputSetInfo auth = callApi auth "gettxoutsetinfo" [] + +-- | Details about an unspent transaction output. +data OutputInfo = + OutputInfo { oiBestBlock :: BlockHash + -- | The number of times this transaction has been confirmed. + , oiConfirmations :: Integer + -- | The amount transferred. + , oiAmount :: BTC + -- | The public key of the sender. + , oiScriptPubKey :: ScriptSig + -- | The version of this transaction. + , oiVersion :: Integer + -- | Is this transaction part of the coin base? + , oiCoinBase :: Bool + } + deriving ( Show, Read, Ord, Eq ) + +instance FromJSON OutputInfo where + parseJSON (Object o) = OutputInfo <$> o .: "bestblock" + <*> o .: "confirmations" + <*> (unwrapBTC <$> o .: "amount") + <*> o .: "scriptPubKey" + <*> o .: "version" + <*> o .: "coinbase" + parseJSON _ = mzero + +-- | Returns details about an unspent transaction output. +getOutputInfo :: Auth + -> TransactionID + -> Integer -- ^ The index we're looking at. + -> IO OutputInfo +getOutputInfo auth txid n = callApi auth "gettxout" [ tj txid, tj n ] diff --git a/src/Network/Bitcoin/Dump.hs b/src/Network/Bitcoin/Dump.hs new file mode 100644 index 0000000..63c75f2 --- /dev/null +++ b/src/Network/Bitcoin/Dump.hs @@ -0,0 +1,33 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -Wall #-} +-- | An interface to bitcoind's available private key calls. The implementation +-- of these functions can be found at . +-- +-- If any APIs are missing, patches are always welcome. If you look at the +-- source of this module, you'll see that the interface code is trivial. +module Network.Bitcoin.Dump ( PrivateKey + , importPrivateKey + , dumpPrivateKey + ) where + +import Network.Bitcoin.Internal + +-- | A textual representation of a bitcoin private key. +type PrivateKey = Text + +-- | Adds a private key (as returned by dumpprivkey) to your wallet. +importPrivateKey :: Auth + -> PrivateKey + -- | An optional label for the key. + -> Maybe Account + -> IO () +importPrivateKey auth pk Nothing = + callApi auth "importprivkey" [ tj pk ] +importPrivateKey auth pk (Just label) = + callApi auth "importprivkey" [ tj pk, tj label ] + +-- | Reveals the private key corresponding to the given address. +dumpPrivateKey :: Auth + -> Address + -> IO PrivateKey +dumpPrivateKey auth addr = callApi auth "dumpprivkey" [ tj addr ] diff --git a/src/Network/Bitcoin/Internal.hs b/src/Network/Bitcoin/Internal.hs new file mode 100644 index 0000000..982fedd --- /dev/null +++ b/src/Network/Bitcoin/Internal.hs @@ -0,0 +1,163 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -Wall #-} +-- | The API exposed in this module should be considered unstable, and is +-- subject to change between minor revisions. +-- +-- If the version number is a.b.c.d, and either a or b changes, then the +-- module's whole API may have changed (if only b changes, then it was +-- probably a minor change). +-- +-- If c changed, then only the internal API may change. The rest of the +-- module is guaranteed to be stable. +-- +-- If only d changes, then there were no user-facing code changes made. +module Network.Bitcoin.Internal ( module Network.Bitcoin.Types + , Text, Vector + , FromJSON(..) + , callApi + , callApi' + , tj + , WrappedBTC(..) + , AddrAddress(..) + ) where + +import Control.Applicative +import Control.Arrow +import Control.Exception +import Control.Monad +import Data.Aeson +import Data.Attoparsec.Number +import Data.Maybe +import Data.Vector ( Vector ) +import qualified Data.Vector as V +import Network.Bitcoin.Types +import Network.Browser +import Network.HTTP hiding ( password ) +import Network.URI ( parseURI ) +import qualified Data.ByteString.Lazy as BL +import Data.Text ( Text ) +import qualified Data.Text as T + +-- | RPC calls return an error object. It can either be empty; or have an +-- error message + error code. +data BitcoinRpcError = NoError -- ^ All good. + | BitcoinRpcError Int Text -- ^ Error code + error message. + deriving ( Show, Read, Ord, Eq ) + +instance FromJSON BitcoinRpcError where + parseJSON (Object v) = BitcoinRpcError <$> v .: "code" + <*> v .: "message" + parseJSON Null = return NoError + parseJSON _ = mzero + +-- | A response from bitcoind will contain the result of the JSON-RPC call, and +-- an error. The error should be null if a valid response was received. +data BitcoinRpcResponse a = BitcoinRpcResponse { btcResult :: a + , btcError :: BitcoinRpcError + } + deriving ( Show, Read, Ord, Eq ) + +instance FromJSON a => FromJSON (BitcoinRpcResponse a) where + parseJSON (Object v) = BitcoinRpcResponse <$> v .: "result" + <*> v .: "error" + parseJSON _ = mzero + +-- | The "no conversion needed" implementation of callApi. THis lets us inline +-- and specialize callApi for its parameters, while keeping the bulk of the +-- work in this function shared. +callApi' :: Auth -> BL.ByteString -> IO BL.ByteString +callApi' auth rpcReqBody = do + (_, httpRes) <- browse $ do + setOutHandler . const $ return () + addAuthority authority + setAllowBasicAuth True + request $ httpRequest (T.unpack urlString) rpcReqBody + return $ rspBody httpRes + where + authority = httpAuthority auth + urlString = rpcUrl auth + +-- | 'callApi' is a low-level interface for making authenticated API +-- calls to a Bitcoin daemon. The first argument specifies +-- authentication details (URL, username, password) and is often +-- curried for convenience: +-- +-- > callBtc = callApi $ Auth "http://127.0.0.1:8332" "user" "password" +-- +-- The second argument is the command name. The third argument provides +-- parameters for the API call. +-- +-- > let result = callBtc "getbalance" [ tj "account-name", tj 6 ] +-- +-- On error, throws a 'BitcoinException'. +callApi :: FromJSON v + => Auth -- ^ authentication credentials for bitcoind + -> Text -- ^ command name + -> [Value] -- ^ command arguments + -> IO v +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 + jsonRpcReqBody = + encode $ object [ "jsonrpc" .= ("2.0" :: Text) + , "method" .= cmd + , "params" .= params + , "id" .= (1 :: Int) + ] +{-# INLINE callApi #-} + +-- | Internal helper functions to make callApi more readable +httpAuthority :: Auth -> Authority +httpAuthority (Auth urlString username password) = + AuthBasic { auRealm = "jsonrpc" + , auUsername = T.unpack username + , auPassword = T.unpack password + , auSite = uri + } + where + uri = fromJust . parseURI $ T.unpack urlString + +-- | Builds the JSON HTTP request. +httpRequest :: String -> BL.ByteString -> Request BL.ByteString +httpRequest urlString jsonBody = + (postRequest urlString){ + rqBody = jsonBody, + rqHeaders = [ + mkHeader HdrContentType "application/json", + mkHeader HdrContentLength (show $ BL.length jsonBody) + ] + } + +-- | A handy shortcut for toJSON, because I'm lazy. +tj :: ToJSON a => a -> Value +tj = toJSON +{-# INLINE tj #-} + +-- | Used to provide a FromJSON instance for fixed-point bitcoins. +-- This can be removed after gets +-- merged into master, and is released on Hackage. +data WrappedBTC = WBTC { unwrapBTC :: BTC } + +instance FromJSON WrappedBTC where + parseJSON (Number n) = pure . WBTC $ case n of + D d -> realToFrac d + I i -> fromIntegral i + parseJSON _ = mzero + +instance ToJSON WrappedBTC where + toJSON (WBTC btc) = toJSON $ toRational btc + +-- | A wrapper for a vector of address:amount pairs. The RPC expects that as +-- an object of "address":"amount" pairs, instead of a vector. So that's what +-- we give them with AddrAddress's ToJSON. +newtype AddrAddress = AA (Vector (Address, BTC)) + +instance ToJSON AddrAddress where + toJSON (AA vec) = object . V.toList $ uncurry (.=) . second WBTC <$> vec + diff --git a/src/Network/Bitcoin/Mining.hs b/src/Network/Bitcoin/Mining.hs new file mode 100644 index 0000000..19b546f --- /dev/null +++ b/src/Network/Bitcoin/Mining.hs @@ -0,0 +1,220 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -Wall #-} +-- | An interface to bitcoind's available mining RPC calls. The implementation +-- of these functions can be found at . +-- +-- If any APIs are missing, patches are always welcome. If you look at the +-- source of this module, you'll see that the interface code is trivial. +-- +-- Note that it is highly discouraged to use bitcoind for actual bitcoin +-- mining. It uses the CPU for mining, which is much, much less power +-- efficient than GPU mining. If you're paying for power, you will not come +-- out ahead. +-- +-- Instead, consider using a GPU miner listed at . +module Network.Bitcoin.Mining ( Auth(..) + , getGenerate + , setGenerate + , getHashesPerSec + , MiningInfo(..) + , getMiningInfo + , HashData(..) + , getWork + , solveBlock + , Transaction(..) + , CoinBaseAux(..) + , BlockTemplate(..) + , getBlockTemplate + , submitBlock + ) where + +import Data.Aeson as A +import Control.Applicative +import Control.Monad +import Network.Bitcoin.Internal + +-- | Returns whether or not bitcoind is generating bitcoins. +getGenerate :: Auth -- ^ bitcoind RPC authorization + -> IO Bool +getGenerate auth = callApi auth "getgenerate" [] + +-- | Controls whether or not bitcoind is generating bitcoins. +setGenerate :: Auth -- ^ bitcoind RPC authorization + -> Bool -- ^ Turn it on, or turn it off? + -> Maybe Int -- ^ Generation is limited to this number of + -- processors. Set it to Nothing to keep the value + -- at what it was before, Just -1 to use all + -- available cores, and any other value to limit it. + -> IO () +setGenerate auth onOff Nothing = + callApi auth "setgenerate" [ tj onOff ] +setGenerate auth onOff (Just limit) = + callApi auth "setgenerate" [ tj onOff, tj limit ] + +-- | Returns a recent hashes per second performance measurement while +-- generating. +getHashesPerSec :: Auth -> IO Integer +getHashesPerSec auth = callApi auth "gethashespersec" [] + +-- | Information related to the current bitcoind mining operation. +-- +-- If a field is undocumented here, it's because I don't know what it means. +-- If you DO know what it means, I'd love it if you would submit a patch to +-- help complete this documentation. +data MiningInfo = + MiningInfo { + -- | The number of blocks in our block-chain. + nBlocks :: Integer + -- | The size of the current block we're mining. + , currentBlockSize :: Integer + , currentBlockTransaction :: Integer + -- | How difficult mining currently is. + , difficulty :: Double + -- | Any mining errors that may have come up. + , miningErrors :: Text + -- | Are we currently generating bitcoins? + , isGenerating :: Bool + -- | How many processors have we limited bitcoin mining to? + , generationProcessorLimit :: Integer + -- | How fast is the mining going? + , hashesPerSecond :: Integer + , pooledTransactions :: Integer + -- | Are we on the bitcoin test network (as opposed to the real + -- thing)? + , miningOnTestNetwork :: Bool + } + deriving ( Show, Read, Ord, Eq ) + +instance FromJSON MiningInfo where + parseJSON (Object o) = MiningInfo <$> o .: "blocks" + <*> o .: "currentblocksize" + <*> o .: "currentblocktx" + <*> o .: "difficulty" + <*> o .: "errors" + <*> o .: "generate" + <*> o .: "genproclimit" + <*> o .: "hashespersec" + <*> o .: "pooledtx" + <*> o .: "testnet" + parseJSON _ = mzero + +-- | Returns an object containing mining-related information. +getMiningInfo :: Auth -> IO MiningInfo +getMiningInfo auth = callApi auth "getmininginfo" [] + +-- | The hash data returned from 'getWork'. +data HashData = + HashData { blockData :: HexString + -- | Little-endian hash target, formatted as a hexadecimal string. + , hdTarget :: HexString + } + deriving ( Show, Read, Ord, Eq ) + +instance FromJSON HashData where + parseJSON (Object o) = HashData <$> o .: "data" + <*> o .: "target" + parseJSON _ = mzero + +-- | Returns formatted hash data to work on. +getWork :: Auth -> IO HashData +getWork auth = callApi auth "getwork" [] + +-- | Tries to solve the given block, and returns true if it was successful. +solveBlock :: Auth -> HexString -> IO Bool +solveBlock auth data_ = callApi auth "getwork" [ tj data_ ] + +-- | A transaction to be included in the next block. +data Transaction = + Transaction { txnData :: HexString + , txnHash :: HexString + , depends :: Vector Integer + , txnFee :: Maybe Integer + , sigOps :: Integer + } + deriving ( Show, Read, Ord, Eq ) + +instance FromJSON Transaction where + parseJSON (Object o) = Transaction <$> o .: "data" + <*> o .: "hash" + <*> o .: "depends" + <*> o .:? "fee" + <*> o .: "sigops" + parseJSON _ = mzero + +data CoinBaseAux = CoinBaseAux { cbFlags :: HexString + } + deriving ( Show, Read, Ord, Eq ) + +instance FromJSON CoinBaseAux where + parseJSON (Object o) = CoinBaseAux <$> o .: "flags" + parseJSON _ = mzero + +-- | A template for constructing a block to work on. +-- +-- See for the full specification. +data BlockTemplate = + BlockTemplate { blockVersion :: Integer + -- | Hash of current highest block. + , previousBlockHash :: HexString + -- | Contents of non-coinbase transactions that should be + -- included in the next block. + , transactionsToInclude :: Vector Transaction + -- | Data that should be included in coinbase. + , coinBaseAux :: CoinBaseAux + -- | Maximum allowable input to coinbase transaction, + -- including the generation award and transaction fees. + , coinBaseValue :: Integer + -- | Hash target. + , btTarget :: HexString + -- | Minimum timestamp appropriate for next block. + , minTime :: Integer + -- | Range of valid nonces. + , nonceRange :: HexString + -- | Limit of sigops in blocks. + , sigopLimit :: Integer + -- | Limit of block size. + , sizeLimit :: Integer + -- | Current timestamp. + , curTime :: Integer + -- | Compressed target of the next block. + , btBits :: HexString + -- | Height of the next block. + , btHeight :: Integer + } + deriving ( Show, Read, Ord, Eq ) + +instance FromJSON BlockTemplate where + parseJSON (Object o) = BlockTemplate <$> o .: "version" + <*> o .: "previousblockhash" + <*> o .: "transactions" + <*> o .: "coinbaseaux" + <*> o .: "coinbasevalue" + <*> o .: "target" + <*> o .: "mintime" + <*> o .: "noncerange" + <*> o .: "sigoplimit" + <*> o .: "sizelimit" + <*> o .: "curtime" + <*> o .: "bits" + <*> o .: "height" + parseJSON _ = mzero + +-- | Returns data needed to construct a block to work on. +getBlockTemplate :: Auth -> IO BlockTemplate +getBlockTemplate auth = callApi auth "getblocktemplate" [] + +-- | Unfortunately, the submitblock API call returns null on success, and +-- the string "rejected" on failure. +-- +-- We use 'StupidReturnValue' to parse this ridiculous API. +data StupidReturnValue = SRV { unStupid :: Bool } + +instance FromJSON StupidReturnValue where + parseJSON Null = return $ SRV True + parseJSON _ = return $ SRV False + +-- | Attempts to submit a new block to the network. +submitBlock :: Auth + -> HexString -- ^ The block to submit. + -> IO Bool -- ^ Was the block accepted by the network? +submitBlock auth block = unStupid <$> callApi auth "submitblock" [ tj block ] diff --git a/src/Network/Bitcoin/Net.hs b/src/Network/Bitcoin/Net.hs new file mode 100644 index 0000000..738b911 --- /dev/null +++ b/src/Network/Bitcoin/Net.hs @@ -0,0 +1,71 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -Wall #-} +-- | An interface to bitcoind's available network-related RPC calls. +-- The implementation of these functions can be found at +-- . +-- +-- If any APIs are missing, patches are always welcome. If you look at the +-- source of this module, you'll see that the interface code is trivial. +module Network.Bitcoin.Net ( Auth(..) + , getConnectionCount + , PeerInfo(..) + , getPeerInfo + ) where + +import Control.Applicative +import Control.Monad +import Data.Aeson +import Network.Bitcoin.Internal + +-- | Returns the number of connections to other nodes. +getConnectionCount :: Auth -> IO Integer +getConnectionCount auth = callApi auth "getconnectioncount" [] + +-- | Information on a given connected node in the network. +-- +-- The documentation for this data structure is incomplete, as I honestly +-- don't know what some of these fields are for. Patches are welcome! +data PeerInfo = + PeerInfo { -- | The ip:port of this peer, as a string. + addressName :: Text + , services :: Text + -- | Relative to when we first time we conected with this peer + -- (and in milliseconds), the last time we sent this peer any + -- data. + , lastSend :: Integer + -- | Relative to the first time we connected with this peer + -- (and in milliseconds), the last time we sent this peer any + -- data. + , lastRecv :: Integer + -- | How long have we been connected to this peer (in + -- milliseconds). + , connectionTime :: Integer + -- | The version of bitcoind the peer is running. + , peerVersion :: Integer + -- | The sub-version of bitcoind the peer is running. + , peerSubversion :: Integer + , inbound :: Bool + , releaseTime :: Integer + , startingHeight :: Integer + -- | How many times has this peer behaved badly? + , banScore :: Integer + } + deriving ( Show, Read, Ord, Eq ) + +instance FromJSON PeerInfo where + parseJSON (Object o) = PeerInfo <$> o .: "addr" + <*> o .: "services" + <*> o .: "lastsend" + <*> o .: "lastrecv" + <*> o .: "conntime" + <*> o .: "version" + <*> o .: "subver" + <*> o .: "inbound" + <*> o .: "releasetime" + <*> o .: "startingheight" + <*> o .: "banscore" + parseJSON _ = mzero + +-- | Returns data about each connected network node. +getPeerInfo :: Auth -> IO PeerInfo +getPeerInfo auth = callApi auth "getpeerinfo" [] diff --git a/src/Network/Bitcoin/RawTransaction.hs b/src/Network/Bitcoin/RawTransaction.hs new file mode 100644 index 0000000..39c43c1 --- /dev/null +++ b/src/Network/Bitcoin/RawTransaction.hs @@ -0,0 +1,354 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# OPTIONS_GHC -Wall #-} +-- | An interface to bitcoind's available raw transaction-related RPC calls. +-- The implementation of these functions can be found at +-- . +-- +-- If any APIs are missing, patches are always welcome. If you look at the +-- source of this module, you'll see that the interface code is trivial. +-- +-- 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(..) + , TxOut(..) + , BlockInfo(..) + , RawTransactionInfo(..) + , getRawTransactionInfo + , UnspentTransaction(..) + , listUnspent + , createRawTransaction + , DecodedRawTransaction(..) + , decodeRawTransaction + , WhoCanPay(..) + , RawSignedTransaction(..) + , signRawTransaction + , sendRawTransaction + ) where + +import Control.Applicative +import Control.Monad +import Data.Aeson as A +import Data.Aeson.Types as AT +import Data.Maybe +import qualified Data.Vector as V +import Network.Bitcoin.Internal + +-- | Just like most binary data retrieved from bitcoind, a raw transaction is +-- represented by a hexstring. +-- +-- This is a serialized, hex-encoded transaction. +type RawTransaction = HexString + +-- | Get a raw transaction from its unique ID. +getRawTransaction :: Auth -> TransactionID -> IO RawTransaction +getRawTransaction auth txid = + callApi auth "getrawtransaction" [ tj txid, tj verbose ] + where verbose = 0 :: Int + +-- | A transaction into an account. This can either be a coinbase transaction, +-- or a standard transaction with another account. +data TxIn = TxCoinbase { txCoinbase :: HexString + } + | TxIn { -- | This transaction's ID. + txInId :: TransactionID + , numOut :: Integer + , scriptSig :: ScriptSig + -- | A transaction sequence number. + , txSequence :: Integer + } + deriving ( Show, Read, Ord, Eq ) + +instance FromJSON TxIn where + parseJSON (Object o) = parseCB <|> parseTxIn + where + parseCB = TxCoinbase <$> o .: "coinbase" + parseTxIn = TxIn <$> o .: "txid" + <*> o .: "vout" + <*> o .: "scriptSig" + <*> o .: "sequence" + parseJSON _ = mzero + +-- | The type of a transaction out. +-- +-- More documentation is needed here. Submit a patch if you know what this is +-- about! +data TxnOutputType = TxnPubKey -- ^ JSON of "pubkey" received. + | TxnPubKeyHash -- ^ JSON of "pubkeyhash" received. + | TxnScriptHash -- ^ JSON of "scripthash" received. + | TxnMultisig -- ^ JSON of "multisig" received. + deriving ( Show, Read, Ord, Eq ) + +instance FromJSON TxnOutputType where + parseJSON (A.String s) | s == "pubkey" = return TxnPubKey + | s == "pubkeyhash" = return TxnPubKeyHash + | s == "scripthash" = return TxnScriptHash + | s == "multisig" = return TxnMultisig + | otherwise = mzero + parseJSON _ = mzero + +-- | A public key of someone we sent money to. +data ScriptPubKey = NonStandardScriptPubKey { -- | The JSON "asm" field. + nspkAsm :: HexString + -- | The JSON "hex" field. + , nspkHex :: HexString + } + | StandardScriptPubKey { -- | The JSON "asm" field. + sspkAsm :: HexString + -- | The JSON "hex" field. + , sspkHex :: HexString + -- | The number of required signatures. + , requiredSigs :: Integer + -- | The type of the transaction. + , sspkType :: TxnOutputType + -- | The addresses associated with this key. + , sspkAddresses :: Vector Address + } + deriving ( Show, Read, Ord, Eq ) + +instance FromJSON ScriptPubKey where + parseJSON (Object o) = parseStandard <|> parseNonstandard + where + parseStandard = StandardScriptPubKey <$> o .: "asm" + <*> o .: "hex" + <*> o .: "reqSigs" + <*> o .: "type" + <*> o .: "addresses" + parseNonstandard = NonStandardScriptPubKey <$> o .: "asm" + <*> 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 + } + deriving ( Show, Read, Ord, Eq ) + +instance FromJSON TxOut where + parseJSON (Object o) = TxOut <$> (unwrapBTC <$> o .: "value") + <*> o .: "scriptPubKey" + parseJSON _ = mzero + +-- | Information on a single block. +data BlockInfo = ConfirmedBlock { -- | The number of confirmations a block has. + -- This will always be >= 1. + confirmations :: Integer + -- The JSON "time" field". + , cbTime :: Integer + -- | The JSON "blocktime" field. + , blockTime :: Integer + } + | UnconfirmedBlock + -- ^ An unconfirmed block is boring, but a possibility. + deriving ( Show, Read, Ord, Eq ) + +instance FromJSON BlockInfo where + parseJSON (Object o) = parseConfirmed <|> parseUnconfirmed + where + parseConfirmed = ConfirmedBlock <$> o .: "confirmations" + <*> o .: "time" + <*> o .: "blocktime" + parseUnconfirmed = do c <- o .: "confirmations" :: AT.Parser Integer + guard $ c == 0 + return UnconfirmedBlock + parseJSON _ = mzero + +-- | The raw transaction info for a given transaction ID. +data RawTransactionInfo = + RawTransactionInfo { -- | The raw transaction. + raw :: RawTransaction + -- | The transaction version number. + , txnVersion :: Integer + , txnLockTime :: Integer + -- | The vector of transactions in. + , vin :: Vector TxIn + -- | The vector of transactions out. + , vout :: Vector TxOut + -- | The hash of the block that was used for this + -- transaction. + , rawTxBlockHash :: HexString + -- | The transaction's block's info. + , rawBlockInfo :: BlockInfo + } + deriving ( Show, Read, Ord, Eq ) + +instance FromJSON RawTransactionInfo where + parseJSON v@(Object o) = RawTransactionInfo <$> o .: "hex" + <*> o .: "version" + <*> o .: "locktime" + <*> o .: "vin" + <*> o .: "vout" + <*> o .: "blockhash" + <*> parseJSON v + parseJSON _ = mzero + +-- | Get raw transaction info for a given transaction ID. The data structure +-- returned is quite sprawling and undocumented, so any patches to help +-- simplify things would be greatly appreciated. +getRawTransactionInfo :: Auth -> TransactionID -> IO RawTransactionInfo +getRawTransactionInfo auth txid = + callApi auth "getrawtransaction" [ tj txid, tj verbose ] + where verbose = 1 :: Int + +data UnspentTransaction = + UnspentTransaction { unspentTransactionId :: TransactionID + , outIdx :: Integer + , unspentScriptPubKey :: HexString + , redeemScript :: Maybe HexString + , unspentAmount :: BTC + , usConfirmations :: Integer + } + +instance FromJSON UnspentTransaction where + parseJSON (Object o) = UnspentTransaction <$> o .: "txid" + <*> o .: "vout" + <*> o .: "scriptPubKey" + <*> o .:? "redeemScript" + <*> (unwrapBTC <$> o .: "amount") + <*> o .: "confirmations" + parseJSON _ = mzero + +-- Instance used in 'createRawTransaction'. +instance ToJSON UnspentTransaction where + toJSON (UnspentTransaction{..}) = object [ "txid" .= unspentTransactionId + , "vout" .= outIdx + ] + +-- | Returns an array of unspent transaction outputs with between minconf and +-- maxconf (inclusive) confirmations. If addresses are given, the result will +-- be filtered to include only those addresses. +listUnspent :: Auth + -> Maybe Int -- ^ minconf. Defaults to 1 if 'Nothing'. + -> Maybe Int -- ^ maxconf. Defaults to 9999999 if 'Nothing'. + -> Vector Address -- ^ Use 'Data.Vector.empty' for no filtering. + -> IO (Vector UnspentTransaction) +listUnspent auth mmin mmax vaddrs = + let min' = fromMaybe 1 mmin + max' = fromMaybe 9999999 mmax + in callApi auth "listunspent" [ tj min', tj max', tj vaddrs ] + +-- | Create a transaction spending given inputs, sending to given addresses. +-- +-- Note that the transaction's inputs are not signed, and it is not stored +-- in the wallet or transmitted to the network. +-- +-- Also, there is no checking to see if it's possible to send that much to +-- the targets specified. In the future, such a scenario might throw an +-- exception. +createRawTransaction :: Auth + -- | The unspent transactions we'll be using as our output. + -> Vector UnspentTransaction + -- | The addresses we're sending money to, along with how + -- much each of them gets. + -> Vector (Address, BTC) + -> IO HexString +createRawTransaction auth us tgts = + callApi auth "createrawtransaction" [ tj us, tj $ AA tgts ] + +-- | A successfully decoded raw transaction, from a given serialized, +-- hex-encoded transaction. +data DecodedRawTransaction = + DecodedRawTransaction { -- | The raw transaction. + decRaw :: RawTransaction + -- | The transaction version number. + , decTxnVersion :: Integer + , decTxnLockTime :: Integer + -- | The vector of transactions in. + , decVin :: Vector TxIn + -- | The vector of transactions out. + , decVout :: Vector TxOut + } + +instance FromJSON DecodedRawTransaction where + parseJSON (Object o) = DecodedRawTransaction <$> o .: "hex" + <*> o .: "version" + <*> o .: "locktime" + <*> o .: "vin" + <*> o .: "vout" + parseJSON _ = mzero + +-- | Decodes a raw transaction into a more accessible data structure. +decodeRawTransaction :: Auth -> RawTransaction -> IO DecodedRawTransaction +decodeRawTransaction auth tx = callApi auth "decoderawtransaction" [ tj tx ] + +-- | Used internally to give a new 'ToJSON' instance for 'UnspentTransaction'. +newtype UnspentForSigning = UFS UnspentTransaction + +instance ToJSON UnspentForSigning where + toJSON (UFS (UnspentTransaction{..})) + | isNothing redeemScript = + object [ "txid" .= unspentTransactionId + , "vout" .= outIdx + , "scriptPubKey" .= unspentScriptPubKey + ] + | otherwise = + object [ "txid" .= unspentTransactionId + , "vout" .= outIdx + , "scriptPubKey" .= unspentScriptPubKey + , "redeemScript" .= fromJust redeemScript + ] + +-- | Who can pay for a given transaction. +data WhoCanPay = All + | AllOrAnyoneCanPay + | None + | NoneOrAnyoneCanPay + | Single + | SingleOrAnyoneCanPay + +toString :: WhoCanPay -> Text +toString All = "ALL" +toString AllOrAnyoneCanPay = "ALL|ANYONECANPAY" +toString None = "NONE" +toString NoneOrAnyoneCanPay = "NONE|ANYONECANPAY" +toString Single = "SINGLE" +toString SingleOrAnyoneCanPay = "SINGLE|ANYONECANPAY" + +-- | A raw signed transaction contains the raw, signed hexstring and whether or +-- not this transaction has a complete signature set. +data RawSignedTransaction = + RawSignedTransaction { rawSigned :: HexString + , hasCompleteSigSet :: Bool + } + +-- I have no idea why they use a 1/0 to represent a boolean. +instance FromJSON RawSignedTransaction where + parseJSON (Object o) = RawSignedTransaction <$> o .: "hex" + <*> (toEnum <$> o .: "complete") + parseJSON _ = mzero + +-- | Sign inputs for a raw transaction. +signRawTransaction :: Auth + -- | The raw transaction whose inputs we're signing. + -> RawTransaction + -- | An optional list of previous transaction outputs that + -- this transaction depends on but may not yet be in the + -- block chain. + -> Maybe (Vector UnspentTransaction) + -- | An array of base58-encoded private keys that, if given, + -- will be the only keys used to sign the transaction. + -> Maybe (Vector HexString) + -- | Who can pay for this transaction? 'All' by default. + -> Maybe WhoCanPay + -- | Returns 'Nothing' if the transaction has a complete set + -- of signatures, and the raw signed transa + -> IO RawSignedTransaction +signRawTransaction auth rt us' privkeys wcp = + let us = V.map UFS <$> us' :: Maybe (Vector UnspentForSigning) + in callApi auth "signrawtransaction" [ tj rt + , tj us + , tj privkeys + , tj . toString $ fromMaybe All wcp + ] + +sendRawTransaction :: Auth -> RawTransaction -> IO TransactionID +sendRawTransaction auth rt = callApi auth "sendrawtransaction" [ tj rt ] diff --git a/src/Network/Bitcoin/Types.hs b/src/Network/Bitcoin/Types.hs new file mode 100644 index 0000000..e149a2a --- /dev/null +++ b/src/Network/Bitcoin/Types.hs @@ -0,0 +1,92 @@ +{-# LANGUAGE OverloadedStrings, DeriveDataTypeable #-} +{-# OPTIONS_GHC -Wall #-} +module Network.Bitcoin.Types ( Auth(..) + , BitcoinException(..) + , HexString + , TransactionID + , Satoshi(..) + , 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 +import qualified Data.ByteString.Lazy as BL + +-- | 'Auth' describes authentication credentials for +-- making API requests to the Bitcoin daemon. +data Auth = Auth + { rpcUrl :: Text -- ^ URL, with port, where bitcoind listens + , rpcUser :: Text -- ^ same as bitcoind's 'rpcuser' config + , rpcPassword :: Text -- ^ same as bitcoind's 'rpcpassword' config + } + deriving ( Show, Read, Ord, Eq ) + +-- | A 'BitcoinException' is thrown when 'callApi encounters an +-- error. The API error code is represented as an @Int@, the message as +-- a @String@. +-- +-- It may also be thrown when the value returned by the bitcoin API wasn't +-- what we expected. +-- +-- WARNING: Any of the functions in this module's public API may throw this +-- exception. You should plan on handling it. +data BitcoinException = BitcoinApiError Int Text + -- ^ A 'BitcoinApiError' has an error code error + -- message, as returned by bitcoind's JSON-RPC + -- response. + | BitcoinResultTypeError BL.ByteString + -- ^ The raw JSON returned, if we can't figure out what + -- actually went wrong. + deriving ( Show, Read, Ord, Eq, Typeable ) + +instance Exception BitcoinException + +-- | A string returned by the bitcoind API, representing data as hex. +-- +-- What that data represents depends on the API call, but should be +-- dcumented accordingly. +type HexString = Text + +-- | A hexadecimal string representation of a 256-bit unsigned integer. +-- +-- This integer is a unique transaction identifier. +type TransactionID = HexString + +-- | A satoshi is the smallest subdivision of bitcoins. For the resolution, +-- use 'resolution' from 'Data.Fixed'. +data Satoshi = Satoshi + +instance HasResolution Satoshi where + resolution = const $ 10^(8::Integer) + {-# INLINE resolution #-} + +-- | The type of bitcoin money, represented with a fixed-point number. +type BTC = Fixed Satoshi + +-- | 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 "". +type Account = Text diff --git a/src/Network/Bitcoin/Wallet.hs b/src/Network/Bitcoin/Wallet.hs new file mode 100644 index 0000000..fb146a1 --- /dev/null +++ b/src/Network/Bitcoin/Wallet.hs @@ -0,0 +1,465 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -Wall #-} +module Network.Bitcoin.Wallet ( Auth(..) + , BitcoindInfo(..) + , getBitcoindInfo + , getNewAddress + , getAccountAddress + , getAccount + , setAccount + , getAddressByAccount + , sendToAddress + , AddressInfo(..) + , listAddressGroupings + , Signature + , signMessage + , verifyMessage + , getReceivedByAddress + , getReceivedByAddress' + , getReceivedByAccount + , getReceivedByAccount' + , getBalance + , getBalance' + , getBalance'' + , moveBitcoins + , sendFromAccount + , sendMany + -- , createMultiSig + , ReceivedByAddress(..) + , listReceivedByAddress + , listReceivedByAddress' + , ReceivedByAccount(..) + , listReceivedByAccount + , listReceivedByAccount' + -- , listTransactions + -- , listAccounts + -- , listSinceBlock + -- , getTransaction + , backupWallet + , keyPoolRefill + , unlockWallet + , lockWallet + , changePassword + , encryptWallet + , isAddressValid + ) where + +import Control.Applicative +import Control.Monad +import Data.Aeson as A +import Data.Maybe +import Data.Vector as V +import Network.Bitcoin.Internal + +-- | A plethora of information about a bitcoind instance. +data BitcoindInfo = + BitcoindInfo { + -- | What version of bitcoind are we running? + bitcoinVersion :: Integer + -- | What is bitcoind's current protocol number? + , protocolVersion :: Integer + -- | What version is the wallet? + , walletVersion :: Integer + -- | How much money is currently in the wallet? + , balance :: BTC + -- | The number of blocks in our chain. + , numBlocks :: Integer + -- | How many peers are we connected to? + , numConnections :: Integer + -- | A blank string if we're not using a proxy. + , proxy :: Text + -- | The difficulty multiplier for bitcoin mining operations. + , generationDifficulty :: Double + -- | Are we on the test network (as opposed to the primary + -- bitcoin network)? + , onTestNetwork :: Bool + -- | The timestamp of the oldest key in the key pool. + , keyPoolOldest :: Integer + -- | The size of the key pool. + , keyPoolSize :: Integer + -- | How much do we currently pay as a transaction fee? + , transactionFeePaid :: BTC + -- | If the wallet is unlocked, the number of seconds until a + -- re-lock is needed. + , unlockedUntil :: Maybe Integer + -- | Any alerts will show up here. This should normally be an + -- empty string. + , bitcoindErrors :: Text + } + deriving ( Show, Read, Ord, Eq ) + +instance FromJSON BitcoindInfo where + parseJSON (Object o) = BitcoindInfo <$> o .: "version" + <*> o .: "protocolversion" + <*> o .: "walletversion" + <*> (unwrapBTC <$> o .: "balance") + <*> o .: "blocks" + <*> o .: "connections" + <*> o .: "proxy" + <*> o .: "difficulty" + <*> o .: "testnet" + <*> o .: "keypoololddest" + <*> o .: "keypoolsize" + <*> (unwrapBTC <$> o .: "paytxfee") + <*> o .:? "unlocked_until" + <*> o .: "errors" + parseJSON _ = mzero + +-- | Returns an object containing various state info. +getBitcoindInfo :: Auth -> IO BitcoindInfo +getBitcoindInfo auth = callApi auth "getinfo" [] + +-- | Returns a new bitcoin address for receiving payments. +-- +-- If an account is specified (recommended), the new address is added to the +-- address book so payments received with the address will be credited to the +-- given account. +-- +-- If no account is specified, the address will be credited to "". +getNewAddress :: Auth -> Maybe Account -> IO Address +getNewAddress auth ma = let acc = fromMaybe "" ma + in callApi auth "getnewaddress" [ tj acc ] + +-- | Returns the current Bitcoin address for receiving payments to the given +-- account. +getAccountAddress :: Auth -> Account -> IO Address +getAccountAddress auth acc = callApi auth "getaccountaddress" [ tj acc ] + +-- | Sets the account associated with the given address. +setAccount :: Auth -> Address -> Account -> IO () +setAccount auth addr acc = callApi auth "setaccount" [ tj addr, tj acc ] + +-- | Returns the account associated with the given address. +getAccount :: Auth -> Address -> IO Account +getAccount auth addr = callApi auth "getaccount" [ tj addr ] + +-- | Returns the list of addresses for the given address. +getAddressByAccount :: Auth -> Account -> IO (Vector Address) +getAddressByAccount auth acc = callApi auth "getaddressbyaccount" [ tj acc ] + +-- | Sends some bitcoins to an address. +sendToAddress :: Auth + -- | Who we're sending to. + -> Address + -- | The amount to send. + -> BTC + -- | An optional comment for the transaction. + -> Maybe Text + -- | An optional comment-to (who did we sent this to?) for the + -- transaction. + -> Maybe Text + -> IO TransactionID +sendToAddress auth addr amount comm comm2 = + callApi auth "sendtoaddress" [ tj addr, tj $ WBTC amount, tj comm, tj comm2 ] + +-- | Information on a given address. +data AddressInfo = AddressInfo { -- | The address in question. + aiAddress :: Address + -- | The address' balance. + , aiAmount :: BTC + -- | The address' linked account. + , aiAccount :: Maybe Account + } + deriving ( Show, Read, Eq, Ord ) + +-- | What a silly API. +instance FromJSON AddressInfo where + parseJSON (A.Array a) | V.length a == 2 = AddressInfo <$> parseJSON (a ! 0) + <*> (unwrapBTC <$> parseJSON (a ! 1)) + <*> pure Nothing + | V.length a == 3 = AddressInfo <$> parseJSON (a ! 0) + <*> (unwrapBTC <$> parseJSON (a ! 1)) + <*> (Just <$> parseJSON (a ! 2)) + | otherwise = mzero + parseJSON _ = mzero + +-- | Lists groups of addresses which have had their common ownership made +-- public by common use as inputs or as the resulting change in past +-- transactions. +listAddressGroupings :: Auth + -> IO (Vector (Vector AddressInfo)) +listAddressGroupings auth = + callApi auth "listaddressgroupings" [] + +-- | A signature is a base-64 encoded string. +type Signature = HexString + +-- | Sign a message with the private key of an address. +signMessage :: Auth + -- | The address whose private key we'll use. + -> Address + -- | The message to sign. + -> Text + -> IO Signature +signMessage auth addr msg = callApi auth "signmessage" [ tj addr, tj msg ] + +-- | Verifies a signed message. +verifyMessage :: Auth + -- | The address of the original signer. + -> Address + -- | The message's signature. + -> Signature + -- | The message. + -> Text + -- | Was the signature valid? + -> IO Bool +verifyMessage auth addr sig msg = + callApi auth "verifymessage" [ tj addr, tj sig, tj msg ] + +-- | Returns the total amount received by the given address with at least one +-- confirmation. +getReceivedByAddress :: Auth -> Address -> IO BTC +getReceivedByAddress auth addr = + unwrapBTC <$> callApi auth "getreceivedbyaddress" [ tj addr ] + +-- | Returns the total amount received by the given address, with at least the +-- give number of confirmations. +getReceivedByAddress' :: Auth + -> Address + -> Int -- ^ The minimum number of confirmations needed + -- for a transaction to to count towards the + -- total. + -> IO BTC +getReceivedByAddress' auth addr minconf = + unwrapBTC <$> callApi auth "getreceivedbyaddress" [ tj addr, tj minconf ] + +-- | Returns the total amount received by address with the given account. +getReceivedByAccount :: Auth -> Account -> IO BTC +getReceivedByAccount auth acc = + unwrapBTC <$> callApi auth "getreceivedbyaccount" [ tj acc ] + +-- | Returns the total amount received by addresses with the given account, +-- counting only transactions with the given minimum number of confirmations. +getReceivedByAccount' :: Auth + -- | The account in question. + -> Account + -- | The minimum number of confirmations needed for a + -- transaction to count towards the total. + -> Int + -> IO BTC +getReceivedByAccount' auth acc minconf = + unwrapBTC <$> callApi auth "getreceivedbyaccount" [ tj acc, tj minconf ] + +-- | Returns the server's total available balance. +getBalance :: Auth + -> IO BTC +getBalance auth = + unwrapBTC <$> callApi auth "getbalance" [] + +-- | Returns the balance in the given account, counting only transactions with +-- at least one confirmation. +getBalance' :: Auth + -> Account + -> IO BTC +getBalance' auth acc = + unwrapBTC <$> callApi auth "getbalance" [ tj acc ] + +-- | Returns the balance in the given account, counting only transactions with +-- at least the given number of confirmations. +getBalance'' :: Auth + -> Account + -- | The minimum number of confirmations needed for a transaction + -- to cuont towards the total. + -> Int + -> IO BTC +getBalance'' auth acc minconf = + unwrapBTC <$> callApi auth "getbalance" [ tj acc, tj minconf ] + +-- | Move bitcoins from one account in your wallet to another. +-- +-- If you want to send bitcoins to an address not in your wallet, use +-- 'sendFromAccount'. +moveBitcoins :: Auth + -> Account -- ^ From. + -> Account -- ^ To. + -> BTC -- ^ The amount to transfer. + -> Text -- ^ A comment to record for the transaction. + -> IO () +moveBitcoins auth from to amt comm = + stupidAPI <$> callApi auth "move" [ tj from, tj to, tj $ WBTC amt, tj one, tj comm ] + where one = 1 :: Int -- needs a type, else default-integer warnings. + stupidAPI :: Bool -> () + stupidAPI = const () + +-- | Sends bitcoins from a given account in our wallet to a given address. +-- +-- A transaction and sender comment may be optionally provided. +sendFromAccount :: Auth + -- | The account to send from. + -> Account + -- | The address to send to. + -> Address + -- | The amount to send. + -> BTC + -- | An optional transaction comment. + -> Maybe Text + -- | An optional comment on who the money is going to. + -> Maybe Text + -> IO TransactionID +sendFromAccount auth from to amount comm comm2 = + callApi auth "sendfrom" [ tj from, tj to, tj $ WBTC amount, tj one, tj comm, tj comm2 ] + where one = 1 :: Int -- needs a type, else default-integer warnings. + +-- | Send to a whole bunch of address at once. +sendMany :: Auth + -- | The account to send from. + -> Account + -- | The address, and how much to send to each one. + -> Vector (Address, BTC) + -- | An optional transaction comment. + -> Maybe Text + -> IO TransactionID +sendMany auth acc amounts comm = + callApi auth "sendmany" [ tj acc, tj $ AA amounts, tj comm ] + +-- TODO: createmultisig. +-- +-- I have no idea what this is doing. Patches adding this function are +-- always welcome! + +-- | Information on how much was received by a given address. +data ReceivedByAddress = + ReceivedByAddress { -- | The address which the money was deposited to. + recvAddress :: Address + -- | The account which this address belongs to. + , recvAccount :: Account + -- | The amount received. + , recvAmount :: BTC + -- | The number of confirmations of the most recent + -- included transaction. + , recvNumConfirmations :: Integer + } + deriving ( Show, Read, Ord, Eq ) + +instance FromJSON ReceivedByAddress where + parseJSON (Object o) = ReceivedByAddress <$> o .: "address" + <*> o .: "account" + <*> (unwrapBTC <$> o .: "amount") + <*> o .: "confirmations" + parseJSON _ = mzero + +-- | Lists the amount received by each address which has received money at some +-- point, counting only transactions with at least one confirmation. +listReceivedByAddress :: Auth -> IO (Vector ReceivedByAddress) +listReceivedByAddress auth = listReceivedByAddress' auth 1 False + +-- | List the amount received by each of our addresses, counting only +-- transactions with the given minimum number of confirmations. +listReceivedByAddress' :: Auth + -- | The minimum number of confirmations before a + -- transaction counts toward the total amount + -- received. + -> Int + -- | Should we include addresses with no money + -- received? + -> Bool + -> IO (Vector ReceivedByAddress) +listReceivedByAddress' auth minconf includeEmpty = + callApi auth "listreceivedbyaddress" [ tj minconf, tj includeEmpty ] + +data ReceivedByAccount = + ReceivedByAccount { -- | The account we received into. + raccAccount :: Account + -- | The mount received. + , raccAmount :: BTC + -- | The number of confirmations of the most recent + -- included transaction. + , raccNumConfirmations :: Integer + } + deriving ( Show, Read, Ord, Eq ) + +instance FromJSON ReceivedByAccount where + parseJSON (Object o) = ReceivedByAccount <$> o .: "account" + <*> (unwrapBTC <$> o .: "amount") + <*> o .: "confirmations" + parseJSON _ = mzero + +-- | Lists the amount received by each account which has received money at some +-- point, counting only transactions with at leaset one confirmation. +listReceivedByAccount :: Auth -> IO (Vector ReceivedByAccount) +listReceivedByAccount auth = listReceivedByAccount' auth 1 False + +-- | List the amount received by each of our accounts, counting only +-- transactions with the given minimum number of confirmations. +listReceivedByAccount' :: Auth + -- | The minimum number of confirmations before a + -- transaction counts toward the total received. + -> Int + -- | Should we include the accounts with no money + -- received? + -> Bool + -> IO (Vector ReceivedByAccount) +listReceivedByAccount' auth minconf includeEmpty = + callApi auth "listreceivedbyaccount" [ tj minconf, tj includeEmpty ] + +-- TODO: listtransactions +-- listaccounts +-- listsinceblock +-- gettransaction +-- +-- These functions are just way too complicated for me to write. +-- Patches welcome! + +-- | Safely copies wallet.dat to the given destination, which can be either a +-- directory, or a path with filename. +backupWallet :: Auth + -> FilePath + -> IO () +backupWallet auth fp = + callApi auth "backupwallet" [ tj fp ] + +-- | Fills the keypool. +keyPoolRefill :: Auth -> IO () +keyPoolRefill auth = callApi auth "keypoolrefill" [] + +-- | Stores the wallet decryption key in memory for the given amount of time. +unlockWallet :: Auth + -- | The decryption key. + -> Text + -- | How long to store the key in memory (in seconds). + -> Integer + -> IO () +unlockWallet auth pass timeout = + callApi auth "walletpassphrase" [ tj pass, tj timeout ] + +-- | Changes the wallet passphrase. +changePassword :: Auth + -- | The old password. + -> Text + -- | The new password. + -> Text + -> IO () +changePassword auth old new = + callApi auth "walletpassphrase" [ tj old, tj new ] + +-- | Removes the wallet encryption key from memory, locking the wallet. +-- +-- After calling this function, you will need to call 'unlockWallet' again +-- before being able to call methods which require the wallet to be unlocked. +-- +-- Note: In future releases, we might introduce an "unlocked" monad, so +-- locking and unlocking is automatic. +lockWallet :: Auth -> IO () +lockWallet auth = callApi auth "walletlock" [] + +-- | Encrypts the wallet with the given passphrase. +-- +-- WARNING: bitcoind will shut down after calling this method. Don't say I +-- didn't warn you. +encryptWallet :: Auth -> Text -> IO () +encryptWallet auth pass = stupidAPI <$> callApi auth "encryptwallet" [ tj pass ] + where + stupidAPI :: Text -> () + stupidAPI = const () + +-- | Just a handy wrapper to help us get only the "isvalid" field of the JSON. +-- The structure is much too complicated for what it needs to do. +data IsValid = IsValid { getValid :: Bool } + +instance FromJSON IsValid where + parseJSON (Object o) = IsValid <$> o .: "isvalid" + parseJSON _ = mzero + +-- | Checks if a given address is a valid one. +isAddressValid :: Auth -> Address -> IO Bool +isAddressValid auth addr = getValid <$> callApi auth "validateaddress" [ tj addr ] From 73eb8b2871dd3524e197fd8411ddf844b4375879 Mon Sep 17 00:00:00 2001 From: Clark Gaebel Date: Sat, 3 Nov 2012 23:25:12 -0400 Subject: [PATCH 08/73] Made the travis build generate haddocks. --- .travis.yml | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/.travis.yml b/.travis.yml index 5ea5f3a..2e73c85 100644 --- a/.travis.yml +++ b/.travis.yml @@ -5,4 +5,7 @@ notifications: on_success: always on_failure: always install: - - cabal install --enable-tests --haddock-html --haddock-internal + - cabal install --only-dependencies + - cabal configure + - cabal build + - cabal haddock From 754fb3cb6aa3e0351983b0e39cf3c4df4423b1d3 Mon Sep 17 00:00:00 2001 From: Clark Gaebel Date: Sat, 3 Nov 2012 23:26:14 -0400 Subject: [PATCH 09/73] Made the travis build generate haddocks. --- src/Network/Bitcoin/Types.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Network/Bitcoin/Types.hs b/src/Network/Bitcoin/Types.hs index e149a2a..1fc121b 100644 --- a/src/Network/Bitcoin/Types.hs +++ b/src/Network/Bitcoin/Types.hs @@ -88,5 +88,5 @@ instance FromJSON ScriptSig where -- | An account on the wallet is just a label to easily specify private keys. -- --- The default account is "". +-- The default account is an empty string. type Account = Text From 6ac300e12d5abfa5697eb45f892c3d8dfcf6cfe7 Mon Sep 17 00:00:00 2001 From: Clark Gaebel Date: Sat, 3 Nov 2012 23:35:48 -0400 Subject: [PATCH 10/73] Fixed up the haddocks. --- src/Network/Bitcoin/Dump.hs | 2 +- src/Network/Bitcoin/RawTransaction.hs | 22 +++---- src/Network/Bitcoin/Types.hs | 2 + src/Network/Bitcoin/Wallet.hs | 93 +++++++++++++++------------ 4 files changed, 66 insertions(+), 53 deletions(-) diff --git a/src/Network/Bitcoin/Dump.hs b/src/Network/Bitcoin/Dump.hs index 63c75f2..7b0af01 100644 --- a/src/Network/Bitcoin/Dump.hs +++ b/src/Network/Bitcoin/Dump.hs @@ -18,8 +18,8 @@ type PrivateKey = Text -- | Adds a private key (as returned by dumpprivkey) to your wallet. importPrivateKey :: Auth -> PrivateKey - -- | An optional label for the key. -> Maybe Account + -- ^ An optional label for the key. -> IO () importPrivateKey auth pk Nothing = callApi auth "importprivkey" [ tj pk ] diff --git a/src/Network/Bitcoin/RawTransaction.hs b/src/Network/Bitcoin/RawTransaction.hs index 39c43c1..3ff37f5 100644 --- a/src/Network/Bitcoin/RawTransaction.hs +++ b/src/Network/Bitcoin/RawTransaction.hs @@ -245,11 +245,11 @@ listUnspent auth mmin mmax vaddrs = -- the targets specified. In the future, such a scenario might throw an -- exception. createRawTransaction :: Auth - -- | The unspent transactions we'll be using as our output. -> Vector UnspentTransaction - -- | The addresses we're sending money to, along with how - -- much each of them gets. + -- ^ The unspent transactions we'll be using as our output. -> Vector (Address, BTC) + -- ^ The addresses we're sending money to, along with how + -- much each of them gets. -> IO HexString createRawTransaction auth us tgts = callApi auth "createrawtransaction" [ tj us, tj $ AA tgts ] @@ -328,20 +328,20 @@ instance FromJSON RawSignedTransaction where -- | Sign inputs for a raw transaction. signRawTransaction :: Auth - -- | The raw transaction whose inputs we're signing. -> RawTransaction - -- | An optional list of previous transaction outputs that + -- ^ The raw transaction whose inputs we're signing. + -> Maybe (Vector UnspentTransaction) + -- ^ An optional list of previous transaction outputs that -- this transaction depends on but may not yet be in the -- block chain. - -> Maybe (Vector UnspentTransaction) - -- | An array of base58-encoded private keys that, if given, - -- will be the only keys used to sign the transaction. -> Maybe (Vector HexString) - -- | Who can pay for this transaction? 'All' by default. + -- ^ An array of base58-encoded private keys that, if given, + -- will be the only keys used to sign the transaction. -> Maybe WhoCanPay - -- | Returns 'Nothing' if the transaction has a complete set - -- of signatures, and the raw signed transa + -- ^ Who can pay for this transaction? 'All' by default. -> IO RawSignedTransaction + -- ^ Returns 'Nothing' if the transaction has a complete set + -- of signatures, and the raw signed transa signRawTransaction auth rt us' privkeys wcp = let us = V.map UFS <$> us' :: Maybe (Vector UnspentForSigning) in callApi auth "signrawtransaction" [ tj rt diff --git a/src/Network/Bitcoin/Types.hs b/src/Network/Bitcoin/Types.hs index 1fc121b..f4d90a7 100644 --- a/src/Network/Bitcoin/Types.hs +++ b/src/Network/Bitcoin/Types.hs @@ -1,5 +1,7 @@ {-# LANGUAGE OverloadedStrings, DeriveDataTypeable #-} {-# OPTIONS_GHC -Wall #-} +-- | Contains the common types used through bitcoin RPC calls, that aren't +-- specific to a single submodule. module Network.Bitcoin.Types ( Auth(..) , BitcoinException(..) , HexString diff --git a/src/Network/Bitcoin/Wallet.hs b/src/Network/Bitcoin/Wallet.hs index fb146a1..9d85d26 100644 --- a/src/Network/Bitcoin/Wallet.hs +++ b/src/Network/Bitcoin/Wallet.hs @@ -1,5 +1,15 @@ {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -Wall #-} +-- | An interface to bitcoind's available wallet-related RPC calls. +-- The implementation of these functions can be found at +-- . +-- +-- If any APIs are missing, patches are always welcome. If you look at the +-- source of this module, you'll see that the interface code is trivial. +-- +-- Certain APIs were too complicated for me to write an interface for. If +-- you figure them out, then patches are always welcome! They're left in +-- the source as comments. module Network.Bitcoin.Wallet ( Auth(..) , BitcoindInfo(..) , getBitcoindInfo @@ -115,7 +125,8 @@ getBitcoindInfo auth = callApi auth "getinfo" [] -- address book so payments received with the address will be credited to the -- given account. -- --- If no account is specified, the address will be credited to "". +-- If no account is specified, the address will be credited to the account +-- whose name is the empty string. i.e. the default account. getNewAddress :: Auth -> Maybe Account -> IO Address getNewAddress auth ma = let acc = fromMaybe "" ma in callApi auth "getnewaddress" [ tj acc ] @@ -139,15 +150,15 @@ getAddressByAccount auth acc = callApi auth "getaddressbyaccount" [ tj acc ] -- | Sends some bitcoins to an address. sendToAddress :: Auth - -- | Who we're sending to. -> Address - -- | The amount to send. + -- ^ Who we're sending to. -> BTC - -- | An optional comment for the transaction. + -- ^ The amount to send. -> Maybe Text - -- | An optional comment-to (who did we sent this to?) for the - -- transaction. + -- ^ An optional comment for the transaction. -> Maybe Text + -- ^ An optional comment-to (who did we sent this to?) for the + -- transaction. -> IO TransactionID sendToAddress auth addr amount comm comm2 = callApi auth "sendtoaddress" [ tj addr, tj $ WBTC amount, tj comm, tj comm2 ] @@ -186,23 +197,23 @@ type Signature = HexString -- | Sign a message with the private key of an address. signMessage :: Auth - -- | The address whose private key we'll use. -> Address - -- | The message to sign. + -- ^ The address whose private key we'll use. -> Text + -- ^ The message to sign. -> IO Signature signMessage auth addr msg = callApi auth "signmessage" [ tj addr, tj msg ] -- | Verifies a signed message. verifyMessage :: Auth - -- | The address of the original signer. -> Address - -- | The message's signature. + -- ^ The address of the original signer. -> Signature - -- | The message. + -- ^ The message's signature. -> Text - -- | Was the signature valid? + -- ^ The message. -> IO Bool + -- ^ Was the signature valid? verifyMessage auth addr sig msg = callApi auth "verifymessage" [ tj addr, tj sig, tj msg ] @@ -231,11 +242,11 @@ getReceivedByAccount auth acc = -- | Returns the total amount received by addresses with the given account, -- counting only transactions with the given minimum number of confirmations. getReceivedByAccount' :: Auth - -- | The account in question. -> Account - -- | The minimum number of confirmations needed for a - -- transaction to count towards the total. + -- ^ The account in question. -> Int + -- ^ The minimum number of confirmations needed for a + -- transaction to count towards the total. -> IO BTC getReceivedByAccount' auth acc minconf = unwrapBTC <$> callApi auth "getreceivedbyaccount" [ tj acc, tj minconf ] @@ -258,9 +269,9 @@ getBalance' auth acc = -- at least the given number of confirmations. getBalance'' :: Auth -> Account - -- | The minimum number of confirmations needed for a transaction - -- to cuont towards the total. -> Int + -- ^ The minimum number of confirmations needed for a transaction + -- to cuont towards the total. -> IO BTC getBalance'' auth acc minconf = unwrapBTC <$> callApi auth "getbalance" [ tj acc, tj minconf ] @@ -285,16 +296,16 @@ moveBitcoins auth from to amt comm = -- -- A transaction and sender comment may be optionally provided. sendFromAccount :: Auth - -- | The account to send from. -> Account - -- | The address to send to. + -- ^ The account to send from. -> Address - -- | The amount to send. + -- ^ The address to send to. -> BTC - -- | An optional transaction comment. + -- ^ The amount to send. -> Maybe Text - -- | An optional comment on who the money is going to. + -- ^ An optional transaction comment. -> Maybe Text + -- ^ An optional comment on who the money is going to. -> IO TransactionID sendFromAccount auth from to amount comm comm2 = callApi auth "sendfrom" [ tj from, tj to, tj $ WBTC amount, tj one, tj comm, tj comm2 ] @@ -302,12 +313,12 @@ sendFromAccount auth from to amount comm comm2 = -- | Send to a whole bunch of address at once. sendMany :: Auth - -- | The account to send from. -> Account - -- | The address, and how much to send to each one. + -- ^ The account to send from. -> Vector (Address, BTC) - -- | An optional transaction comment. + -- ^ The address, and how much to send to each one. -> Maybe Text + -- ^ An optional transaction comment. -> IO TransactionID sendMany auth acc amounts comm = callApi auth "sendmany" [ tj acc, tj $ AA amounts, tj comm ] @@ -346,23 +357,23 @@ listReceivedByAddress auth = listReceivedByAddress' auth 1 False -- | List the amount received by each of our addresses, counting only -- transactions with the given minimum number of confirmations. listReceivedByAddress' :: Auth - -- | The minimum number of confirmations before a + -> Int + -- ^ The minimum number of confirmations before a -- transaction counts toward the total amount -- received. - -> Int - -- | Should we include addresses with no money - -- received? -> Bool + -- ^ Should we include addresses with no money + -- received? -> IO (Vector ReceivedByAddress) listReceivedByAddress' auth minconf includeEmpty = callApi auth "listreceivedbyaddress" [ tj minconf, tj includeEmpty ] data ReceivedByAccount = - ReceivedByAccount { -- | The account we received into. - raccAccount :: Account - -- | The mount received. + ReceivedByAccount { raccAccount :: Account + -- ^ The account we received into. , raccAmount :: BTC - -- | The number of confirmations of the most recent + -- ^ The mount received. + -- ^ The number of confirmations of the most recent -- included transaction. , raccNumConfirmations :: Integer } @@ -382,12 +393,12 @@ listReceivedByAccount auth = listReceivedByAccount' auth 1 False -- | List the amount received by each of our accounts, counting only -- transactions with the given minimum number of confirmations. listReceivedByAccount' :: Auth - -- | The minimum number of confirmations before a - -- transaction counts toward the total received. -> Int - -- | Should we include the accounts with no money - -- received? + -- ^ The minimum number of confirmations before a + -- transaction counts toward the total received. -> Bool + -- ^ Should we include the accounts with no money + -- received? -> IO (Vector ReceivedByAccount) listReceivedByAccount' auth minconf includeEmpty = callApi auth "listreceivedbyaccount" [ tj minconf, tj includeEmpty ] @@ -414,20 +425,20 @@ keyPoolRefill auth = callApi auth "keypoolrefill" [] -- | Stores the wallet decryption key in memory for the given amount of time. unlockWallet :: Auth - -- | The decryption key. -> Text - -- | How long to store the key in memory (in seconds). + -- ^ The decryption key. -> Integer + -- ^ How long to store the key in memory (in seconds). -> IO () unlockWallet auth pass timeout = callApi auth "walletpassphrase" [ tj pass, tj timeout ] -- | Changes the wallet passphrase. changePassword :: Auth - -- | The old password. -> Text - -- | The new password. + -- ^ The old password. -> Text + -- ^ The new password. -> IO () changePassword auth old new = callApi auth "walletpassphrase" [ tj old, tj new ] From d45c5e9ce4430ef4c39f8046d622e20860be8d4a Mon Sep 17 00:00:00 2001 From: Clark Gaebel Date: Sat, 3 Nov 2012 23:40:42 -0400 Subject: [PATCH 11/73] Added tested-with clauses. --- network-bitcoin.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/network-bitcoin.cabal b/network-bitcoin.cabal index 89da5d1..3fad6f2 100644 --- a/network-bitcoin.cabal +++ b/network-bitcoin.cabal @@ -41,7 +41,7 @@ Copyright: Copyright 2012, Michael Hendricks Category: Network Build-type: Simple Cabal-version: >=1.8 - +tested-with: GHC ==7.4.1, GHC ==7.6.1 Library hs-source-dirs: src From 99af85d3300c07d6b9587cb237c69ebc617dde31 Mon Sep 17 00:00:00 2001 From: Clark Gaebel Date: Sat, 3 Nov 2012 23:48:04 -0400 Subject: [PATCH 12/73] Slightly prettier cabal intro. --- network-bitcoin.cabal | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/network-bitcoin.cabal b/network-bitcoin.cabal index ac794dc..2a9c929 100644 --- a/network-bitcoin.cabal +++ b/network-bitcoin.cabal @@ -1,5 +1,5 @@ Name: network-bitcoin -Version: 1.0.0 +Version: 1.0.1 Synopsis: An interface to bitcoind. Description: This can be used to send Bitcoins, query balances, etc. It @@ -20,6 +20,7 @@ Description: . - Total overhaul of the library, with almost the complete bitcoin RPC API covered. + . - Dependencies upgraded, and library modernized. . Changes in v0.1.5 @@ -32,12 +33,13 @@ Description: License: BSD3 License-file: LICENSE Author: Michael Hendricks + Clark Gaebel Maintainer: Clark Gaebel Stability: experimental Homepage: http://github.com/wowus/network-bitcoin Bug-reports: http://github.com/wowus/network-bitcoin/issues -Copyright: Copyright 2012, Michael Hendricks - Copyright 2012, Clark Gaebel +Copyright: 2012 Michael Hendricks + 2012 Clark Gaebel Stability: experimental Homepage: http://github.com/mndrix/network-bitcoin Bug-reports: http://github.com/mndrix/network-bitcoin/issues From fca657b267dad500af32f6af041ce16ae8952734 Mon Sep 17 00:00:00 2001 From: paul Date: Wed, 16 Jan 2013 23:30:50 +0100 Subject: [PATCH 13/73] Buildable on 12.04 LTS without breaking Yesod --- network-bitcoin.cabal | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/network-bitcoin.cabal b/network-bitcoin.cabal index 2a9c929..fd2ce96 100644 --- a/network-bitcoin.cabal +++ b/network-bitcoin.cabal @@ -1,5 +1,5 @@ Name: network-bitcoin -Version: 1.0.1 +Version: 1.0.2 Synopsis: An interface to bitcoind. Description: This can be used to send Bitcoins, query balances, etc. It @@ -67,7 +67,7 @@ Library -- Packages needed in order to build this package. Build-depends: aeson == 0.6.*, - bytestring >= 0.10, + bytestring >= 0.9 && < 0.11, attoparsec == 0.10.*, unordered-containers >= 0.2, HTTP >= 4000, From 2532b6e9a45bf219ee4b5a7edfb4ea87cb9ca780 Mon Sep 17 00:00:00 2001 From: Charlotte Vindico Date: Tue, 19 Mar 2013 03:55:55 -0400 Subject: [PATCH 14/73] typo --- src/Network/Bitcoin/Wallet.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Network/Bitcoin/Wallet.hs b/src/Network/Bitcoin/Wallet.hs index 9d85d26..e172956 100644 --- a/src/Network/Bitcoin/Wallet.hs +++ b/src/Network/Bitcoin/Wallet.hs @@ -271,7 +271,7 @@ getBalance'' :: Auth -> Account -> Int -- ^ The minimum number of confirmations needed for a transaction - -- to cuont towards the total. + -- to count towards the total. -> IO BTC getBalance'' auth acc minconf = unwrapBTC <$> callApi auth "getbalance" [ tj acc, tj minconf ] From 4c76fda4458ffef4d4d363d7cf6d597d0c5178d0 Mon Sep 17 00:00:00 2001 From: Charlotte Vindico Date: Tue, 19 Mar 2013 04:09:53 -0400 Subject: [PATCH 15/73] it's "getAddressesByAccount" --- src/Network/Bitcoin.hs | 2 +- src/Network/Bitcoin/Wallet.hs | 6 +++--- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/Network/Bitcoin.hs b/src/Network/Bitcoin.hs index c0d44a4..55ac570 100644 --- a/src/Network/Bitcoin.hs +++ b/src/Network/Bitcoin.hs @@ -72,7 +72,7 @@ module Network.Bitcoin , getAccountAddress , getAccount , setAccount - , getAddressByAccount + , getAddressesByAccount , sendToAddress , AddressInfo(..) , listAddressGroupings diff --git a/src/Network/Bitcoin/Wallet.hs b/src/Network/Bitcoin/Wallet.hs index e172956..553c5f4 100644 --- a/src/Network/Bitcoin/Wallet.hs +++ b/src/Network/Bitcoin/Wallet.hs @@ -17,7 +17,7 @@ module Network.Bitcoin.Wallet ( Auth(..) , getAccountAddress , getAccount , setAccount - , getAddressByAccount + , getAddressesByAccount , sendToAddress , AddressInfo(..) , listAddressGroupings @@ -145,8 +145,8 @@ getAccount :: Auth -> Address -> IO Account getAccount auth addr = callApi auth "getaccount" [ tj addr ] -- | Returns the list of addresses for the given address. -getAddressByAccount :: Auth -> Account -> IO (Vector Address) -getAddressByAccount auth acc = callApi auth "getaddressbyaccount" [ tj acc ] +getAddressesByAccount :: Auth -> Account -> IO (Vector Address) +getAddressesByAccount auth acc = callApi auth "getAddressesByAccount" [ tj acc ] -- | Sends some bitcoins to an address. sendToAddress :: Auth From 595fd7af94c7c776a1a219e5e30858f96cff4c05 Mon Sep 17 00:00:00 2001 From: Charlotte Vindico Date: Tue, 19 Mar 2013 04:27:59 -0400 Subject: [PATCH 16/73] use aeson 0.6.1's Fixed instances, removing need for WrappedBTC --- network-bitcoin.cabal | 2 +- src/Network/Bitcoin/BlockChain.hs | 4 ++-- src/Network/Bitcoin/Internal.hs | 19 +--------------- src/Network/Bitcoin/RawTransaction.hs | 4 ++-- src/Network/Bitcoin/Wallet.hs | 32 +++++++++++++-------------- 5 files changed, 22 insertions(+), 39 deletions(-) diff --git a/network-bitcoin.cabal b/network-bitcoin.cabal index 2a9c929..8bb8d77 100644 --- a/network-bitcoin.cabal +++ b/network-bitcoin.cabal @@ -66,7 +66,7 @@ Library -- Packages needed in order to build this package. Build-depends: - aeson == 0.6.*, + aeson >= 0.6.1, bytestring >= 0.10, attoparsec == 0.10.*, unordered-containers >= 0.2, diff --git a/src/Network/Bitcoin/BlockChain.hs b/src/Network/Bitcoin/BlockChain.hs index 1d50ca2..a8ec446 100644 --- a/src/Network/Bitcoin/BlockChain.hs +++ b/src/Network/Bitcoin/BlockChain.hs @@ -42,7 +42,7 @@ getDifficulty auth = callApi auth "getdifficulty" [] -- rejected. setTransactionFee :: Auth -> BTC -> IO () setTransactionFee auth fee = - stupidAPI <$> callApi auth "settxfee" [ tj $ WBTC fee ] + stupidAPI <$> callApi auth "settxfee" [ tj fee ] where stupidAPI :: Bool -> () stupidAPI = const () @@ -150,7 +150,7 @@ data OutputInfo = instance FromJSON OutputInfo where parseJSON (Object o) = OutputInfo <$> o .: "bestblock" <*> o .: "confirmations" - <*> (unwrapBTC <$> o .: "amount") + <*> o .: "amount" <*> o .: "scriptPubKey" <*> o .: "version" <*> o .: "coinbase" diff --git a/src/Network/Bitcoin/Internal.hs b/src/Network/Bitcoin/Internal.hs index 982fedd..22907f6 100644 --- a/src/Network/Bitcoin/Internal.hs +++ b/src/Network/Bitcoin/Internal.hs @@ -17,16 +17,13 @@ module Network.Bitcoin.Internal ( module Network.Bitcoin.Types , callApi , callApi' , tj - , WrappedBTC(..) , AddrAddress(..) ) where import Control.Applicative -import Control.Arrow import Control.Exception import Control.Monad import Data.Aeson -import Data.Attoparsec.Number import Data.Maybe import Data.Vector ( Vector ) import qualified Data.Vector as V @@ -139,25 +136,11 @@ tj :: ToJSON a => a -> Value tj = toJSON {-# INLINE tj #-} --- | Used to provide a FromJSON instance for fixed-point bitcoins. --- This can be removed after gets --- merged into master, and is released on Hackage. -data WrappedBTC = WBTC { unwrapBTC :: BTC } - -instance FromJSON WrappedBTC where - parseJSON (Number n) = pure . WBTC $ case n of - D d -> realToFrac d - I i -> fromIntegral i - parseJSON _ = mzero - -instance ToJSON WrappedBTC where - toJSON (WBTC btc) = toJSON $ toRational btc - -- | A wrapper for a vector of address:amount pairs. The RPC expects that as -- an object of "address":"amount" pairs, instead of a vector. So that's what -- we give them with AddrAddress's ToJSON. newtype AddrAddress = AA (Vector (Address, BTC)) instance ToJSON AddrAddress where - toJSON (AA vec) = object . V.toList $ uncurry (.=) . second WBTC <$> vec + toJSON (AA vec) = object . V.toList $ uncurry (.=) <$> vec diff --git a/src/Network/Bitcoin/RawTransaction.hs b/src/Network/Bitcoin/RawTransaction.hs index 3ff37f5..64fcf13 100644 --- a/src/Network/Bitcoin/RawTransaction.hs +++ b/src/Network/Bitcoin/RawTransaction.hs @@ -134,7 +134,7 @@ data TxOut = deriving ( Show, Read, Ord, Eq ) instance FromJSON TxOut where - parseJSON (Object o) = TxOut <$> (unwrapBTC <$> o .: "value") + parseJSON (Object o) = TxOut <$> o .: "value" <*> o .: "scriptPubKey" parseJSON _ = mzero @@ -213,7 +213,7 @@ instance FromJSON UnspentTransaction where <*> o .: "vout" <*> o .: "scriptPubKey" <*> o .:? "redeemScript" - <*> (unwrapBTC <$> o .: "amount") + <*> o .: "amount" <*> o .: "confirmations" parseJSON _ = mzero diff --git a/src/Network/Bitcoin/Wallet.hs b/src/Network/Bitcoin/Wallet.hs index 553c5f4..65d143e 100644 --- a/src/Network/Bitcoin/Wallet.hs +++ b/src/Network/Bitcoin/Wallet.hs @@ -102,7 +102,7 @@ instance FromJSON BitcoindInfo where parseJSON (Object o) = BitcoindInfo <$> o .: "version" <*> o .: "protocolversion" <*> o .: "walletversion" - <*> (unwrapBTC <$> o .: "balance") + <*> o .: "balance" <*> o .: "blocks" <*> o .: "connections" <*> o .: "proxy" @@ -110,7 +110,7 @@ instance FromJSON BitcoindInfo where <*> o .: "testnet" <*> o .: "keypoololddest" <*> o .: "keypoolsize" - <*> (unwrapBTC <$> o .: "paytxfee") + <*> o .: "paytxfee" <*> o .:? "unlocked_until" <*> o .: "errors" parseJSON _ = mzero @@ -161,7 +161,7 @@ sendToAddress :: Auth -- transaction. -> IO TransactionID sendToAddress auth addr amount comm comm2 = - callApi auth "sendtoaddress" [ tj addr, tj $ WBTC amount, tj comm, tj comm2 ] + callApi auth "sendtoaddress" [ tj addr, tj amount, tj comm, tj comm2 ] -- | Information on a given address. data AddressInfo = AddressInfo { -- | The address in question. @@ -176,10 +176,10 @@ data AddressInfo = AddressInfo { -- | The address in question. -- | What a silly API. instance FromJSON AddressInfo where parseJSON (A.Array a) | V.length a == 2 = AddressInfo <$> parseJSON (a ! 0) - <*> (unwrapBTC <$> parseJSON (a ! 1)) + <*> parseJSON (a ! 1) <*> pure Nothing | V.length a == 3 = AddressInfo <$> parseJSON (a ! 0) - <*> (unwrapBTC <$> parseJSON (a ! 1)) + <*> parseJSON (a ! 1) <*> (Just <$> parseJSON (a ! 2)) | otherwise = mzero parseJSON _ = mzero @@ -221,7 +221,7 @@ verifyMessage auth addr sig msg = -- confirmation. getReceivedByAddress :: Auth -> Address -> IO BTC getReceivedByAddress auth addr = - unwrapBTC <$> callApi auth "getreceivedbyaddress" [ tj addr ] + callApi auth "getreceivedbyaddress" [ tj addr ] -- | Returns the total amount received by the given address, with at least the -- give number of confirmations. @@ -232,12 +232,12 @@ getReceivedByAddress' :: Auth -- total. -> IO BTC getReceivedByAddress' auth addr minconf = - unwrapBTC <$> callApi auth "getreceivedbyaddress" [ tj addr, tj minconf ] + callApi auth "getreceivedbyaddress" [ tj addr, tj minconf ] -- | Returns the total amount received by address with the given account. getReceivedByAccount :: Auth -> Account -> IO BTC getReceivedByAccount auth acc = - unwrapBTC <$> callApi auth "getreceivedbyaccount" [ tj acc ] + callApi auth "getreceivedbyaccount" [ tj acc ] -- | Returns the total amount received by addresses with the given account, -- counting only transactions with the given minimum number of confirmations. @@ -249,13 +249,13 @@ getReceivedByAccount' :: Auth -- transaction to count towards the total. -> IO BTC getReceivedByAccount' auth acc minconf = - unwrapBTC <$> callApi auth "getreceivedbyaccount" [ tj acc, tj minconf ] + callApi auth "getreceivedbyaccount" [ tj acc, tj minconf ] -- | Returns the server's total available balance. getBalance :: Auth -> IO BTC getBalance auth = - unwrapBTC <$> callApi auth "getbalance" [] + callApi auth "getbalance" [] -- | Returns the balance in the given account, counting only transactions with -- at least one confirmation. @@ -263,7 +263,7 @@ getBalance' :: Auth -> Account -> IO BTC getBalance' auth acc = - unwrapBTC <$> callApi auth "getbalance" [ tj acc ] + callApi auth "getbalance" [ tj acc ] -- | Returns the balance in the given account, counting only transactions with -- at least the given number of confirmations. @@ -274,7 +274,7 @@ getBalance'' :: Auth -- to count towards the total. -> IO BTC getBalance'' auth acc minconf = - unwrapBTC <$> callApi auth "getbalance" [ tj acc, tj minconf ] + callApi auth "getbalance" [ tj acc, tj minconf ] -- | Move bitcoins from one account in your wallet to another. -- @@ -287,7 +287,7 @@ moveBitcoins :: Auth -> Text -- ^ A comment to record for the transaction. -> IO () moveBitcoins auth from to amt comm = - stupidAPI <$> callApi auth "move" [ tj from, tj to, tj $ WBTC amt, tj one, tj comm ] + stupidAPI <$> callApi auth "move" [ tj from, tj to, tj amt, tj one, tj comm ] where one = 1 :: Int -- needs a type, else default-integer warnings. stupidAPI :: Bool -> () stupidAPI = const () @@ -308,7 +308,7 @@ sendFromAccount :: Auth -- ^ An optional comment on who the money is going to. -> IO TransactionID sendFromAccount auth from to amount comm comm2 = - callApi auth "sendfrom" [ tj from, tj to, tj $ WBTC amount, tj one, tj comm, tj comm2 ] + callApi auth "sendfrom" [ tj from, tj to, tj amount, tj one, tj comm, tj comm2 ] where one = 1 :: Int -- needs a type, else default-integer warnings. -- | Send to a whole bunch of address at once. @@ -345,7 +345,7 @@ data ReceivedByAddress = instance FromJSON ReceivedByAddress where parseJSON (Object o) = ReceivedByAddress <$> o .: "address" <*> o .: "account" - <*> (unwrapBTC <$> o .: "amount") + <*> o .: "amount" <*> o .: "confirmations" parseJSON _ = mzero @@ -381,7 +381,7 @@ data ReceivedByAccount = instance FromJSON ReceivedByAccount where parseJSON (Object o) = ReceivedByAccount <$> o .: "account" - <*> (unwrapBTC <$> o .: "amount") + <*> o .: "amount" <*> o .: "confirmations" parseJSON _ = mzero From 48802f5bdbc1f51dfa5660f8c6fa56e01126f2c9 Mon Sep 17 00:00:00 2001 From: Charlotte Vindico Date: Tue, 19 Mar 2013 04:47:45 -0400 Subject: [PATCH 17/73] remove unnecessary attoparsec dependency --- network-bitcoin.cabal | 1 - 1 file changed, 1 deletion(-) diff --git a/network-bitcoin.cabal b/network-bitcoin.cabal index 8bb8d77..0205418 100644 --- a/network-bitcoin.cabal +++ b/network-bitcoin.cabal @@ -68,7 +68,6 @@ Library Build-depends: aeson >= 0.6.1, bytestring >= 0.10, - attoparsec == 0.10.*, unordered-containers >= 0.2, HTTP >= 4000, network >= 2.3, From 00e2620e7cd4eb1bb14e92a1b803c59a3c91f275 Mon Sep 17 00:00:00 2001 From: Charlotte Vindico Date: Tue, 19 Mar 2013 04:50:21 -0400 Subject: [PATCH 18/73] remove unnecessary unordered-containers dependency --- network-bitcoin.cabal | 1 - 1 file changed, 1 deletion(-) diff --git a/network-bitcoin.cabal b/network-bitcoin.cabal index 0205418..0c1de11 100644 --- a/network-bitcoin.cabal +++ b/network-bitcoin.cabal @@ -68,7 +68,6 @@ Library Build-depends: aeson >= 0.6.1, bytestring >= 0.10, - unordered-containers >= 0.2, HTTP >= 4000, network >= 2.3, text >= 0.11, From 918c58ee8620e1f883325d97b3b104136ef79161 Mon Sep 17 00:00:00 2001 From: Clark Gaebel Date: Tue, 19 Mar 2013 22:10:12 -0400 Subject: [PATCH 19/73] Version number bump. --- network-bitcoin.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/network-bitcoin.cabal b/network-bitcoin.cabal index 0c1de11..62b29db 100644 --- a/network-bitcoin.cabal +++ b/network-bitcoin.cabal @@ -1,5 +1,5 @@ Name: network-bitcoin -Version: 1.0.1 +Version: 1.0.3 Synopsis: An interface to bitcoind. Description: This can be used to send Bitcoins, query balances, etc. It From b82c92ff8265cf7cdc43462a7116f8cd27c5d2f4 Mon Sep 17 00:00:00 2001 From: Charlotte Vindico Date: Wed, 20 Mar 2013 05:08:45 -0400 Subject: [PATCH 20/73] Actually fix "getaddressesbyaccount" RPC call --- src/Network/Bitcoin/Wallet.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Network/Bitcoin/Wallet.hs b/src/Network/Bitcoin/Wallet.hs index 65d143e..b5d78bc 100644 --- a/src/Network/Bitcoin/Wallet.hs +++ b/src/Network/Bitcoin/Wallet.hs @@ -146,7 +146,7 @@ getAccount auth addr = callApi auth "getaccount" [ tj addr ] -- | Returns the list of addresses for the given address. getAddressesByAccount :: Auth -> Account -> IO (Vector Address) -getAddressesByAccount auth acc = callApi auth "getAddressesByAccount" [ tj acc ] +getAddressesByAccount auth acc = callApi auth "getaddressesbyaccount" [ tj acc ] -- | Sends some bitcoins to an address. sendToAddress :: Auth From 9f1ee3d1278023d1edc05d3cfa05745f260252f5 Mon Sep 17 00:00:00 2001 From: Charlotte Vindico Date: Wed, 20 Mar 2013 22:47:21 -0400 Subject: [PATCH 21/73] Restore support for bytestring 0.9, to fix compilation alongside Yesod etc. --- network-bitcoin.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/network-bitcoin.cabal b/network-bitcoin.cabal index 62b29db..066c8e6 100644 --- a/network-bitcoin.cabal +++ b/network-bitcoin.cabal @@ -67,7 +67,7 @@ Library -- Packages needed in order to build this package. Build-depends: aeson >= 0.6.1, - bytestring >= 0.10, + bytestring >= 0.9, HTTP >= 4000, network >= 2.3, text >= 0.11, From 1d8db04d0c7a8f5840a1590510336178e9f17d06 Mon Sep 17 00:00:00 2001 From: Colin Rice Date: Thu, 21 Mar 2013 15:16:43 -0400 Subject: [PATCH 22/73] Add missing fields for HashData returned from getWork --- src/Network/Bitcoin/Mining.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/Network/Bitcoin/Mining.hs b/src/Network/Bitcoin/Mining.hs index 19b546f..b7d064a 100644 --- a/src/Network/Bitcoin/Mining.hs +++ b/src/Network/Bitcoin/Mining.hs @@ -107,12 +107,16 @@ data HashData = HashData { blockData :: HexString -- | Little-endian hash target, formatted as a hexadecimal string. , hdTarget :: HexString + , hash1 :: HexString + , midstate :: HexString } deriving ( Show, Read, Ord, Eq ) instance FromJSON HashData where parseJSON (Object o) = HashData <$> o .: "data" <*> o .: "target" + <*> o .: "hash1" + <*> o .: "midstate" parseJSON _ = mzero -- | Returns formatted hash data to work on. From e8645e2d3f1131e28b69679d4df942377eaa566a Mon Sep 17 00:00:00 2001 From: Colin Rice Date: Thu, 21 Mar 2013 15:40:13 -0400 Subject: [PATCH 23/73] Add toJSON instance to hashdata --- src/Network/Bitcoin/Mining.hs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/Network/Bitcoin/Mining.hs b/src/Network/Bitcoin/Mining.hs index b7d064a..70bad8a 100644 --- a/src/Network/Bitcoin/Mining.hs +++ b/src/Network/Bitcoin/Mining.hs @@ -119,6 +119,9 @@ instance FromJSON HashData where <*> o .: "midstate" parseJSON _ = mzero +instance ToJSON HashData where + toJSON (HashData dat tar has mid) = object ["data" .= dat, "target" .= tar, "hash1" .= has, "midstate" .= mid] + -- | Returns formatted hash data to work on. getWork :: Auth -> IO HashData getWork auth = callApi auth "getwork" [] From d0e708fc6a54ebe4cd7b2b727b3dd821b6991923 Mon Sep 17 00:00:00 2001 From: Clark Gaebel Date: Thu, 21 Mar 2013 18:01:38 -0400 Subject: [PATCH 24/73] Added a changelog, and released v1.1.0. --- .gitignore | 1 + CHANGELOG | 5 +++++ network-bitcoin.cabal | 29 ++++++----------------------- 3 files changed, 12 insertions(+), 23 deletions(-) create mode 100644 CHANGELOG diff --git a/.gitignore b/.gitignore index a3ba534..5beab98 100644 --- a/.gitignore +++ b/.gitignore @@ -6,3 +6,4 @@ .project Setup.hs dist/ +cabal-dev/ diff --git a/CHANGELOG b/CHANGELOG new file mode 100644 index 0000000..f3b4b11 --- /dev/null +++ b/CHANGELOG @@ -0,0 +1,5 @@ +1.1.0 + + * Added missing HashData fields + * Added a ToJSON instance for HashData + * Fixed getAddressesByAccount diff --git a/network-bitcoin.cabal b/network-bitcoin.cabal index 066c8e6..9e1f4fb 100644 --- a/network-bitcoin.cabal +++ b/network-bitcoin.cabal @@ -1,5 +1,5 @@ Name: network-bitcoin -Version: 1.0.3 +Version: 1.1.0 Synopsis: An interface to bitcoind. Description: This can be used to send Bitcoins, query balances, etc. It @@ -15,21 +15,6 @@ Description: > auth = Auth "http://127.0.0.1:8332" "user" "password" . To learn more about Bitcoin, see . - . - Changes in v1.0 - . - - Total overhaul of the library, with almost the complete bitcoin RPC API - covered. - . - - Dependencies upgraded, and library modernized. - . - Changes in v0.1.5 - . - - Correct aeson dependency - . - Changes in v0.1.4 - . - - More accurate conversion of Bitcoin amounts from floating point License: BSD3 License-file: LICENSE Author: Michael Hendricks @@ -40,19 +25,18 @@ Homepage: http://github.com/wowus/network-bitcoin Bug-reports: http://github.com/wowus/network-bitcoin/issues Copyright: 2012 Michael Hendricks 2012 Clark Gaebel -Stability: experimental -Homepage: http://github.com/mndrix/network-bitcoin -Bug-reports: http://github.com/mndrix/network-bitcoin/issues +Stability: experimental +Homepage: http://github.com/mndrix/network-bitcoin +Bug-reports: http://github.com/wowus/network-bitcoin/issues Category: Network Build-type: Simple Cabal-version: >=1.8 -tested-with: GHC ==7.4.1, GHC ==7.6.1 +tested-with: GHC ==7.4.1, GHC ==7.6.2 Library hs-source-dirs: src ghc-options: -Wall - -- Modules exported by the library. Exposed-modules: Network.Bitcoin Network.Bitcoin.BlockChain @@ -64,7 +48,6 @@ Library Network.Bitcoin.Types Network.Bitcoin.Wallet - -- Packages needed in order to build this package. Build-depends: aeson >= 0.6.1, bytestring >= 0.9, @@ -76,4 +59,4 @@ Library Source-repository head type: git - location: git://github.com/mndrix/network-bitcoin.git + location: git://github.com/wowus/network-bitcoin.git From d2201a3db47e4d20e310866efe7f656827784291 Mon Sep 17 00:00:00 2001 From: Eric Pashman Date: Mon, 6 May 2013 13:55:12 -0500 Subject: [PATCH 25/73] Fix parsing of data about connected peers. Bad typing caused calls to getPeerInfo to throw exceptions. For parsing to succeed, the peerSubversion field of PeerInfo must have type Text and the result type of getPeerInfo must contain a list. After updates, PeerInfo remains incompletely documented. --- src/Network/Bitcoin/Net.hs | 19 +++++++++---------- 1 file changed, 9 insertions(+), 10 deletions(-) diff --git a/src/Network/Bitcoin/Net.hs b/src/Network/Bitcoin/Net.hs index 738b911..b3c6805 100644 --- a/src/Network/Bitcoin/Net.hs +++ b/src/Network/Bitcoin/Net.hs @@ -21,17 +21,16 @@ import Network.Bitcoin.Internal getConnectionCount :: Auth -> IO Integer getConnectionCount auth = callApi auth "getconnectioncount" [] --- | Information on a given connected node in the network. +-- | Information about a peer node of the Bitcoin network. -- -- The documentation for this data structure is incomplete, as I honestly -- don't know what some of these fields are for. Patches are welcome! data PeerInfo = - PeerInfo { -- | The ip:port of this peer, as a string. + PeerInfo { -- | The IP:port of this peer, as a string. addressName :: Text , services :: Text - -- | Relative to when we first time we conected with this peer - -- (and in milliseconds), the last time we sent this peer any - -- data. + -- | Relative to the first time we conected with this peer (and in + -- milliseconds), the last time we sent this peer any data. , lastSend :: Integer -- | Relative to the first time we connected with this peer -- (and in milliseconds), the last time we sent this peer any @@ -40,10 +39,10 @@ data PeerInfo = -- | How long have we been connected to this peer (in -- milliseconds). , connectionTime :: Integer - -- | The version of bitcoind the peer is running. + -- | The version of the Bitcion client the peer is running. , peerVersion :: Integer - -- | The sub-version of bitcoind the peer is running. - , peerSubversion :: Integer + -- | The sub-version of the Bitcoin client the peer is running. + , peerSubversion :: Text , inbound :: Bool , releaseTime :: Integer , startingHeight :: Integer @@ -66,6 +65,6 @@ instance FromJSON PeerInfo where <*> o .: "banscore" parseJSON _ = mzero --- | Returns data about each connected network node. -getPeerInfo :: Auth -> IO PeerInfo +-- | Returns data about all connected peer nodes. +getPeerInfo :: Auth -> IO [PeerInfo] getPeerInfo auth = callApi auth "getpeerinfo" [] From f73602b41b84f256eb76d777dd83a86d9f7e6a2a Mon Sep 17 00:00:00 2001 From: Clark Gaebel Date: Mon, 6 May 2013 18:47:33 -0400 Subject: [PATCH 26/73] Version bump. --- network-bitcoin.cabal | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/network-bitcoin.cabal b/network-bitcoin.cabal index 9e1f4fb..e186e10 100644 --- a/network-bitcoin.cabal +++ b/network-bitcoin.cabal @@ -1,5 +1,5 @@ Name: network-bitcoin -Version: 1.1.0 +Version: 1.2.0 Synopsis: An interface to bitcoind. Description: This can be used to send Bitcoins, query balances, etc. It @@ -31,7 +31,7 @@ Bug-reports: http://github.com/wowus/network-bitcoin/issues Category: Network Build-type: Simple Cabal-version: >=1.8 -tested-with: GHC ==7.4.1, GHC ==7.6.2 +tested-with: GHC ==7.4.1, GHC ==7.6.2, GHC ==7.6.3 Library hs-source-dirs: src From 4b62dca171ba8389903ae5be4e8c89f21ca8171a Mon Sep 17 00:00:00 2001 From: Eric Pashman Date: Fri, 17 May 2013 19:11:09 -0500 Subject: [PATCH 27/73] Fixed implementation of the `getinfo` API call. There was a typo in the name of a JSON field referenced in the `FromJSON` implementation of `BitcoindInfo`. Because the field was required, all calls to `getBitcoinInfo` threw exceptions. --- src/Network/Bitcoin/Wallet.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Network/Bitcoin/Wallet.hs b/src/Network/Bitcoin/Wallet.hs index b5d78bc..b1c93d6 100644 --- a/src/Network/Bitcoin/Wallet.hs +++ b/src/Network/Bitcoin/Wallet.hs @@ -108,7 +108,7 @@ instance FromJSON BitcoindInfo where <*> o .: "proxy" <*> o .: "difficulty" <*> o .: "testnet" - <*> o .: "keypoololddest" + <*> o .: "keypoololdest" <*> o .: "keypoolsize" <*> o .: "paytxfee" <*> o .:? "unlocked_until" From f4ae683fbbe890c138b7e380d9bbf03b98e40d1a Mon Sep 17 00:00:00 2001 From: Clark Gaebel Date: Fri, 17 May 2013 22:20:57 -0400 Subject: [PATCH 28/73] A first attempt to fix issue #5. --- src/Network/Bitcoin/Internal.hs | 8 ++++++++ src/Network/Bitcoin/Wallet.hs | 2 +- 2 files changed, 9 insertions(+), 1 deletion(-) diff --git a/src/Network/Bitcoin/Internal.hs b/src/Network/Bitcoin/Internal.hs index 22907f6..97bd3e3 100644 --- a/src/Network/Bitcoin/Internal.hs +++ b/src/Network/Bitcoin/Internal.hs @@ -16,6 +16,7 @@ module Network.Bitcoin.Internal ( module Network.Bitcoin.Types , FromJSON(..) , callApi , callApi' + , Nil(..) , tj , AddrAddress(..) ) where @@ -109,6 +110,13 @@ callApi auth cmd params = readVal =<< callApi' auth jsonRpcReqBody ] {-# INLINE callApi #-} +-- | Used to allow "null" to decode to a tuple. +data Nil = Nil { unNil :: () } + +instance FromJSON Nil where + parseJSON Null = return $ Nil () + parseJSON x = fail $ "\"null\" was expected, but " ++ show x ++ " was recieved." + -- | Internal helper functions to make callApi more readable httpAuthority :: Auth -> Authority httpAuthority (Auth urlString username password) = diff --git a/src/Network/Bitcoin/Wallet.hs b/src/Network/Bitcoin/Wallet.hs index b5d78bc..f0a5ca8 100644 --- a/src/Network/Bitcoin/Wallet.hs +++ b/src/Network/Bitcoin/Wallet.hs @@ -421,7 +421,7 @@ backupWallet auth fp = -- | Fills the keypool. keyPoolRefill :: Auth -> IO () -keyPoolRefill auth = callApi auth "keypoolrefill" [] +keyPoolRefill auth = unNil <$> callApi auth "keypoolrefill" [] -- | Stores the wallet decryption key in memory for the given amount of time. unlockWallet :: Auth From ade4773ea1a6ad4a74dd9f78c9467ad694dcc831 Mon Sep 17 00:00:00 2001 From: Clark Gaebel Date: Fri, 17 May 2013 22:25:25 -0400 Subject: [PATCH 29/73] The rest of the fixes for #5, if necessary. --- src/Network/Bitcoin/Mining.hs | 4 ++-- src/Network/Bitcoin/Wallet.hs | 8 ++++---- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/src/Network/Bitcoin/Mining.hs b/src/Network/Bitcoin/Mining.hs index 70bad8a..42686ff 100644 --- a/src/Network/Bitcoin/Mining.hs +++ b/src/Network/Bitcoin/Mining.hs @@ -47,9 +47,9 @@ setGenerate :: Auth -- ^ bitcoind RPC authorization -- available cores, and any other value to limit it. -> IO () setGenerate auth onOff Nothing = - callApi auth "setgenerate" [ tj onOff ] + unNil <$> callApi auth "setgenerate" [ tj onOff ] setGenerate auth onOff (Just limit) = - callApi auth "setgenerate" [ tj onOff, tj limit ] + unNil <$> callApi auth "setgenerate" [ tj onOff, tj limit ] -- | Returns a recent hashes per second performance measurement while -- generating. diff --git a/src/Network/Bitcoin/Wallet.hs b/src/Network/Bitcoin/Wallet.hs index 13adb10..561725e 100644 --- a/src/Network/Bitcoin/Wallet.hs +++ b/src/Network/Bitcoin/Wallet.hs @@ -417,7 +417,7 @@ backupWallet :: Auth -> FilePath -> IO () backupWallet auth fp = - callApi auth "backupwallet" [ tj fp ] + unNil <$> callApi auth "backupwallet" [ tj fp ] -- | Fills the keypool. keyPoolRefill :: Auth -> IO () @@ -431,7 +431,7 @@ unlockWallet :: Auth -- ^ How long to store the key in memory (in seconds). -> IO () unlockWallet auth pass timeout = - callApi auth "walletpassphrase" [ tj pass, tj timeout ] + unNil <$> callApi auth "walletpassphrase" [ tj pass, tj timeout ] -- | Changes the wallet passphrase. changePassword :: Auth @@ -441,7 +441,7 @@ changePassword :: Auth -- ^ The new password. -> IO () changePassword auth old new = - callApi auth "walletpassphrase" [ tj old, tj new ] + unNil <$> callApi auth "walletpassphrase" [ tj old, tj new ] -- | Removes the wallet encryption key from memory, locking the wallet. -- @@ -451,7 +451,7 @@ changePassword auth old new = -- Note: In future releases, we might introduce an "unlocked" monad, so -- locking and unlocking is automatic. lockWallet :: Auth -> IO () -lockWallet auth = callApi auth "walletlock" [] +lockWallet auth = unNil <$> callApi auth "walletlock" [] -- | Encrypts the wallet with the given passphrase. -- From 06ed3b1b7ff432ccbe1fab58c61d62e80ddeee96 Mon Sep 17 00:00:00 2001 From: Clark Gaebel Date: Fri, 17 May 2013 22:32:18 -0400 Subject: [PATCH 30/73] Version bump. --- network-bitcoin.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/network-bitcoin.cabal b/network-bitcoin.cabal index e186e10..33e2fd4 100644 --- a/network-bitcoin.cabal +++ b/network-bitcoin.cabal @@ -1,5 +1,5 @@ Name: network-bitcoin -Version: 1.2.0 +Version: 1.2.1 Synopsis: An interface to bitcoind. Description: This can be used to send Bitcoins, query balances, etc. It From 74ce53659b1858680a3213c95ca87ba0788dd3cb Mon Sep 17 00:00:00 2001 From: Clark Gaebel Date: Sun, 21 Jul 2013 20:20:52 -0400 Subject: [PATCH 31/73] Fixed #7. --- network-bitcoin.cabal | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/network-bitcoin.cabal b/network-bitcoin.cabal index 060eb74..de10b0a 100644 --- a/network-bitcoin.cabal +++ b/network-bitcoin.cabal @@ -47,9 +47,9 @@ Library Network.Bitcoin.RawTransaction Network.Bitcoin.Types Network.Bitcoin.Wallet - - Build-depends: - aeson == 0.6.*, + + Build-depends: + aeson >= 0.6.1 && < 0.7, bytestring >= 0.9 && < 0.11, attoparsec == 0.10.*, unordered-containers >= 0.2, @@ -58,7 +58,7 @@ Library text >= 0.11, vector >= 0.10, base == 4.* - + Source-repository head type: git location: git://github.com/wowus/network-bitcoin.git From 296a594536405d227cc0ece922f8bebc7395c5df Mon Sep 17 00:00:00 2001 From: Clark Gaebel Date: Sun, 21 Jul 2013 20:21:27 -0400 Subject: [PATCH 32/73] Version bump. --- network-bitcoin.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/network-bitcoin.cabal b/network-bitcoin.cabal index de10b0a..b164c3e 100644 --- a/network-bitcoin.cabal +++ b/network-bitcoin.cabal @@ -1,5 +1,5 @@ Name: network-bitcoin -Version: 1.2.2 +Version: 1.3.0 Synopsis: An interface to bitcoind. Description: This can be used to send Bitcoins, query balances, etc. It From 05b54bbbbafade58db31e788ae0cecd4f0e2b4b2 Mon Sep 17 00:00:00 2001 From: Schell Scivally Date: Thu, 12 Sep 2013 10:45:39 -0700 Subject: [PATCH 33/73] Added testing stub. --- .gitignore | 1 + network-bitcoin.cabal | 15 +++++++++++++-- src/Test/Main.hs | 4 ++++ 3 files changed, 18 insertions(+), 2 deletions(-) create mode 100644 src/Test/Main.hs diff --git a/.gitignore b/.gitignore index 5beab98..c5da61f 100644 --- a/.gitignore +++ b/.gitignore @@ -7,3 +7,4 @@ Setup.hs dist/ cabal-dev/ +network-bitcoin-tests diff --git a/network-bitcoin.cabal b/network-bitcoin.cabal index de10b0a..98735e2 100644 --- a/network-bitcoin.cabal +++ b/network-bitcoin.cabal @@ -60,5 +60,16 @@ Library 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: + base, + network-bitcoin, + test-framework >=0.8, + test-framework-quickcheck2 >= 0.3.0.1, + QuickCheck == 2.5.* diff --git a/src/Test/Main.hs b/src/Test/Main.hs new file mode 100644 index 0000000..621bf4e --- /dev/null +++ b/src/Test/Main.hs @@ -0,0 +1,4 @@ +module Main where + +main :: IO () +main = putStrLn "network-bitcoin-test" From 6708880f69d63f86eea34668189011c915f33a79 Mon Sep 17 00:00:00 2001 From: Schell Scivally Date: Thu, 12 Sep 2013 11:10:34 -0700 Subject: [PATCH 34/73] Added stub test. --- src/Test/Main.hs | 18 +++++++++++++++++- 1 file changed, 17 insertions(+), 1 deletion(-) diff --git a/src/Test/Main.hs b/src/Test/Main.hs index 621bf4e..765db22 100644 --- a/src/Test/Main.hs +++ b/src/Test/Main.hs @@ -1,4 +1,20 @@ module Main where +import Test.Framework ( Test, defaultMain, testGroup ) +import Test.Framework.Providers.QuickCheck2 +import Test.QuickCheck + main :: IO () -main = putStrLn "network-bitcoin-test" +main = defaultMain tests + + +tests :: [Test] +tests = [ testGroup "Test test" [testTest] ] + + +testTest :: Test +testTest = testProperty "test test" prop_test + + +prop_test :: Bool -> Bool +prop_test b = b || not b From 4aa979852382ebcff48695bcd158aa3d67c46191 Mon Sep 17 00:00:00 2001 From: Schell Scivally Date: Thu, 12 Sep 2013 11:23:29 -0700 Subject: [PATCH 35/73] Added IO Test stub. --- src/Test/Main.hs | 19 ++++++++++++++++--- 1 file changed, 16 insertions(+), 3 deletions(-) diff --git a/src/Test/Main.hs b/src/Test/Main.hs index 765db22..6a0ba06 100644 --- a/src/Test/Main.hs +++ b/src/Test/Main.hs @@ -1,20 +1,33 @@ module Main where -import Test.Framework ( Test, defaultMain, testGroup ) +import Test.Framework ( defaultMain ) import Test.Framework.Providers.QuickCheck2 +import Test.Framework.Providers.API import Test.QuickCheck main :: IO () -main = defaultMain tests +main = defaultMain $ tests ++ testsIO tests :: [Test] tests = [ testGroup "Test test" [testTest] ] +testsIO :: [Test] +testsIO = map buildTest [ ioTest ] + + testTest :: Test -testTest = testProperty "test test" prop_test +testTest = testProperty "Test" prop_test + + +ioTest :: IO Test +ioTest = do + putStrLn "Making an IO test." + return $ testProperty "IO Test" prop_test prop_test :: Bool -> Bool prop_test b = b || not b + + From 76c966e7704343c98cf972f423c52d4e8594b943 Mon Sep 17 00:00:00 2001 From: Schell Scivally Date: Thu, 12 Sep 2013 12:17:37 -0700 Subject: [PATCH 36/73] Removed test-framework. --- network-bitcoin.cabal | 16 +++++++++++----- src/Test/Main.hs | 43 ++++++++++++++++++++++--------------------- 2 files changed, 33 insertions(+), 26 deletions(-) diff --git a/network-bitcoin.cabal b/network-bitcoin.cabal index 98735e2..1936ebf 100644 --- a/network-bitcoin.cabal +++ b/network-bitcoin.cabal @@ -68,8 +68,14 @@ Executable network-bitcoin-tests ghc-options: -Wall main-is: Test/Main.hs build-depends: - base, - network-bitcoin, - test-framework >=0.8, - test-framework-quickcheck2 >= 0.3.0.1, - QuickCheck == 2.5.* + 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/Test/Main.hs b/src/Test/Main.hs index 6a0ba06..287b5f2 100644 --- a/src/Test/Main.hs +++ b/src/Test/Main.hs @@ -1,33 +1,34 @@ -module Main where - -import Test.Framework ( defaultMain ) -import Test.Framework.Providers.QuickCheck2 -import Test.Framework.Providers.API -import Test.QuickCheck - -main :: IO () -main = defaultMain $ tests ++ testsIO +{-# LANGUAGE OverloadedStrings #-} +module Main where -tests :: [Test] -tests = [ testGroup "Test test" [testTest] ] +import Test.QuickCheck +import Test.QuickCheck.Monadic +import Network.Bitcoin -testsIO :: [Test] -testsIO = map buildTest [ ioTest ] +main :: IO () +main = mapM_ qcOnce [ canGetInfo ]--defaultMain tests -testTest :: Test -testTest = testProperty "Test" prop_test +qcOnce :: Property -> IO () +qcOnce = quickCheckWith stdArgs { maxSuccess = 1 + , maxSize = 1 + , maxDiscardRatio = 1 + } -ioTest :: IO Test -ioTest = do - putStrLn "Making an IO test." - return $ testProperty "IO Test" prop_test +auth :: Auth +auth = Auth "http://localhost:18332" "bitcoinrpc" "bitcoinrpcpassword" -prop_test :: Bool -> Bool -prop_test b = b || not b +canGetInfo :: Property +canGetInfo = monadicIO $ do + info <- run $ getBitcoindInfo auth + let checks = [ bitcoinVersion info > 80000 + , onTestNetwork info + , bitcoindErrors info == "" + ] + assert $ and checks From 380e7d3e355de7536a89ef66c70df2280bb04b54 Mon Sep 17 00:00:00 2001 From: Schell Scivally Date: Fri, 13 Sep 2013 08:55:12 -0700 Subject: [PATCH 37/73] added output address to UnspentTransaction --- network-bitcoin.cabal | 1 + src/Network/Bitcoin/RawTransaction.hs | 14 ++++++++------ src/Test/Main.hs | 22 ++++++++++++++++------ 3 files changed, 25 insertions(+), 12 deletions(-) diff --git a/network-bitcoin.cabal b/network-bitcoin.cabal index 1936ebf..c7221c3 100644 --- a/network-bitcoin.cabal +++ b/network-bitcoin.cabal @@ -79,3 +79,4 @@ Executable network-bitcoin-tests base == 4.*, QuickCheck == 2.5.*, network-bitcoin + diff --git a/src/Network/Bitcoin/RawTransaction.hs b/src/Network/Bitcoin/RawTransaction.hs index 64fcf13..f47f47b 100644 --- a/src/Network/Bitcoin/RawTransaction.hs +++ b/src/Network/Bitcoin/RawTransaction.hs @@ -201,16 +201,18 @@ getRawTransactionInfo auth txid = 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/Test/Main.hs b/src/Test/Main.hs index 287b5f2..0b33951 100644 --- a/src/Test/Main.hs +++ b/src/Test/Main.hs @@ -6,29 +6,39 @@ 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 ]--defaultMain tests +main = mapM_ qcOnce [ canGetInfo + , canListUnspent + ] qcOnce :: Property -> IO () qcOnce = quickCheckWith stdArgs { maxSuccess = 1 , maxSize = 1 - , maxDiscardRatio = 1 + , maxDiscardRatio = 1 } + auth :: Auth -auth = Auth "http://localhost:18332" "bitcoinrpc" "bitcoinrpcpassword" +auth = Auth "http://localhost:18332" "bitcoinrpc" "bitcoinrpcpassword" -canGetInfo :: Property +canGetInfo :: Property canGetInfo = monadicIO $ do info <- run $ getBitcoindInfo auth let checks = [ bitcoinVersion info > 80000 - , onTestNetwork info + , onTestNetwork info , bitcoindErrors info == "" ] - assert $ and checks + assert $ and checks +canListUnspent :: Property +canListUnspent = monadicIO $ do + vUnspent <- run $ listUnspent auth Nothing Nothing Data.Vector.empty + _ <- run $ print vUnspent + Data.Vector.mapM (\coins -> assert True) vUnspent From 530d44bb65c5d9231d2761434a6c8a39c1b6f334 Mon Sep 17 00:00:00 2001 From: Schell Scivally Date: Fri, 13 Sep 2013 10:30:37 -0700 Subject: [PATCH 38/73] Added a test. --- src/Test/Main.hs | 13 ++++++++++--- 1 file changed, 10 insertions(+), 3 deletions(-) diff --git a/src/Test/Main.hs b/src/Test/Main.hs index 0b33951..fe7835c 100644 --- a/src/Test/Main.hs +++ b/src/Test/Main.hs @@ -13,6 +13,7 @@ import Data.Vector ( empty, mapM ) main :: IO () main = mapM_ qcOnce [ canGetInfo , canListUnspent + , canGetOutputInfo ] @@ -39,6 +40,12 @@ canGetInfo = monadicIO $ do canListUnspent :: Property canListUnspent = monadicIO $ do - vUnspent <- run $ listUnspent auth Nothing Nothing Data.Vector.empty - _ <- run $ print vUnspent - Data.Vector.mapM (\coins -> assert True) vUnspent + _ <- 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 From ff391b18b53fe5521ffe1d7378b693b6f30d4b95 Mon Sep 17 00:00:00 2001 From: Schell Scivally Date: Fri, 13 Sep 2013 11:31:35 -0700 Subject: [PATCH 39/73] Updated types and GetOutputInfo parsing, though still erring. --- src/Network/Bitcoin/BlockChain.hs | 6 ++-- src/Network/Bitcoin/RawTransaction.hs | 41 ++++++++++++++++++++------- src/Network/Bitcoin/Types.hs | 17 +---------- 3 files changed, 34 insertions(+), 30 deletions(-) diff --git a/src/Network/Bitcoin/BlockChain.hs b/src/Network/Bitcoin/BlockChain.hs index a8ec446..390de45 100644 --- 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.Applicative 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 @@ data OutputInfo = -- | The amount transferred. , oiAmount :: BTC -- | The public key of the sender. - , oiScriptPubKey :: ScriptSig + , oiScriptPubKey :: HexString -- | The version of this transaction. , oiVersion :: Integer -- | Is this transaction part of the coin base? @@ -150,7 +150,7 @@ data OutputInfo = 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/RawTransaction.hs b/src/Network/Bitcoin/RawTransaction.hs index f47f47b..d57f377 100644 --- 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 @@ instance FromJSON TxnOutputType where | 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 @@ instance FromJSON ScriptPubKey where <*> 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. diff --git a/src/Network/Bitcoin/Types.hs b/src/Network/Bitcoin/Types.hs index f4d90a7..12b77e8 100644 --- a/src/Network/Bitcoin/Types.hs +++ b/src/Network/Bitcoin/Types.hs @@ -10,13 +10,9 @@ module Network.Bitcoin.Types ( Auth(..) , 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 @@ type BTC = Fixed Satoshi -- | 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 + From a7dea60f28d27e7ffb1d0abfb6a845e82179c746 Mon Sep 17 00:00:00 2001 From: Schell Scivally Date: Fri, 20 Sep 2013 17:02:24 -0700 Subject: [PATCH 40/73] Fixes #8, in that `getOutputInfo` no longer errors. --- src/Network/Bitcoin/BlockChain.hs | 2 +- src/Network/Bitcoin/Internal.hs | 13 +++++++------ 2 files changed, 8 insertions(+), 7 deletions(-) diff --git a/src/Network/Bitcoin/BlockChain.hs b/src/Network/Bitcoin/BlockChain.hs index 390de45..8fb5c4d 100644 --- a/src/Network/Bitcoin/BlockChain.hs +++ b/src/Network/Bitcoin/BlockChain.hs @@ -139,7 +139,7 @@ data OutputInfo = -- | The amount transferred. , oiAmount :: BTC -- | The public key of the sender. - , oiScriptPubKey :: HexString + , oiScriptPubKey :: ScriptPubKey -- | The version of this transaction. , oiVersion :: Integer -- | Is this transaction part of the coin base? diff --git a/src/Network/Bitcoin/Internal.hs b/src/Network/Bitcoin/Internal.hs index 97bd3e3..4326ca8 100644 --- a/src/Network/Bitcoin/Internal.hs +++ b/src/Network/Bitcoin/Internal.hs @@ -19,6 +19,7 @@ module Network.Bitcoin.Internal ( module Network.Bitcoin.Types , Nil(..) , tj , AddrAddress(..) + , BitcoinRpcResponse(..) ) where import Control.Applicative @@ -96,12 +97,12 @@ callApi :: FromJSON v 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 From c802ab3a38e741f465c4f0e1541bc944823582a0 Mon Sep 17 00:00:00 2001 From: Clark Gaebel Date: Mon, 23 Sep 2013 20:24:44 -0400 Subject: [PATCH 41/73] ++gitignore for latest cabal --- .gitignore | 1 + 1 file changed, 1 insertion(+) diff --git a/.gitignore b/.gitignore index c5da61f..2543971 100644 --- a/.gitignore +++ b/.gitignore @@ -8,3 +8,4 @@ Setup.hs dist/ cabal-dev/ network-bitcoin-tests +cabal.sandbox.config From 078a253607ce5f5cdf4bc8fb51fea84e6d1bef2b Mon Sep 17 00:00:00 2001 From: Clark Gaebel Date: Mon, 23 Sep 2013 20:26:37 -0400 Subject: [PATCH 42/73] version bump --- network-bitcoin.cabal | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/network-bitcoin.cabal b/network-bitcoin.cabal index 8af6cc2..66a29f5 100644 --- 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 @@ Stability: experimental 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 From 77c7123bc331c7e092470c4a1760cf885ba94e22 Mon Sep 17 00:00:00 2001 From: Clark Gaebel Date: Wed, 20 Nov 2013 13:34:10 -0500 Subject: [PATCH 43/73] Fix #11. --- .gitignore | 1 + src/Network/Bitcoin/Net.hs | 6 ++++-- src/Test/Main.hs | 3 +-- 3 files changed, 6 insertions(+), 4 deletions(-) diff --git a/.gitignore b/.gitignore index 2543971..6fbacef 100644 --- a/.gitignore +++ b/.gitignore @@ -9,3 +9,4 @@ dist/ cabal-dev/ network-bitcoin-tests cabal.sandbox.config +.cabal-sandbox/ diff --git a/src/Network/Bitcoin/Net.hs b/src/Network/Bitcoin/Net.hs index b3c6805..68ae981 100644 --- a/src/Network/Bitcoin/Net.hs +++ b/src/Network/Bitcoin/Net.hs @@ -36,6 +36,8 @@ data PeerInfo = -- (and in milliseconds), the last time we sent this peer any -- data. , lastRecv :: Integer + , bytesSent :: Integer + , bytesRecv :: Integer -- | How long have we been connected to this peer (in -- milliseconds). , connectionTime :: Integer @@ -44,7 +46,6 @@ data PeerInfo = -- | The sub-version of the Bitcoin client the peer is running. , peerSubversion :: Text , inbound :: Bool - , releaseTime :: Integer , startingHeight :: Integer -- | How many times has this peer behaved badly? , banScore :: Integer @@ -56,11 +57,12 @@ instance FromJSON PeerInfo where <*> o .: "services" <*> o .: "lastsend" <*> o .: "lastrecv" + <*> o .: "bytessent" + <*> o .: "bytesrecv" <*> o .: "conntime" <*> o .: "version" <*> o .: "subver" <*> o .: "inbound" - <*> o .: "releasetime" <*> o .: "startingheight" <*> o .: "banscore" parseJSON _ = mzero diff --git a/src/Test/Main.hs b/src/Test/Main.hs index fe7835c..0c3fec3 100644 --- a/src/Test/Main.hs +++ b/src/Test/Main.hs @@ -6,8 +6,7 @@ module Main where import Test.QuickCheck import Test.QuickCheck.Monadic import Network.Bitcoin -import Data.Aeson -import Data.Vector ( empty, mapM ) +import Data.Vector ( empty ) main :: IO () From c8c0457eab25d5427ad51fb6693601a990d53a06 Mon Sep 17 00:00:00 2001 From: Clark Gaebel Date: Wed, 20 Nov 2013 19:19:47 -0500 Subject: [PATCH 44/73] Added mising unNils. --- network-bitcoin.cabal | 2 +- src/Network/Bitcoin/Dump.hs | 5 +++-- src/Network/Bitcoin/Wallet.hs | 2 +- 3 files changed, 5 insertions(+), 4 deletions(-) diff --git a/network-bitcoin.cabal b/network-bitcoin.cabal index 66a29f5..560bf2a 100644 --- a/network-bitcoin.cabal +++ b/network-bitcoin.cabal @@ -1,5 +1,5 @@ Name: network-bitcoin -Version: 1.4.0 +Version: 1.5.0 Synopsis: An interface to bitcoind. Description: This can be used to send Bitcoins, query balances, etc. It diff --git a/src/Network/Bitcoin/Dump.hs b/src/Network/Bitcoin/Dump.hs index 7b0af01..30caefa 100644 --- a/src/Network/Bitcoin/Dump.hs +++ b/src/Network/Bitcoin/Dump.hs @@ -10,6 +10,7 @@ module Network.Bitcoin.Dump ( PrivateKey , dumpPrivateKey ) where +import Control.Applicative import Network.Bitcoin.Internal -- | A textual representation of a bitcoin private key. @@ -22,9 +23,9 @@ importPrivateKey :: Auth -- ^ An optional label for the key. -> IO () importPrivateKey auth pk Nothing = - callApi auth "importprivkey" [ tj pk ] + unNil <$> callApi auth "importprivkey" [ tj pk ] importPrivateKey auth pk (Just label) = - callApi auth "importprivkey" [ tj pk, tj label ] + unNil <$> callApi auth "importprivkey" [ tj pk, tj label ] -- | Reveals the private key corresponding to the given address. dumpPrivateKey :: Auth diff --git a/src/Network/Bitcoin/Wallet.hs b/src/Network/Bitcoin/Wallet.hs index 561725e..84a6d77 100644 --- a/src/Network/Bitcoin/Wallet.hs +++ b/src/Network/Bitcoin/Wallet.hs @@ -138,7 +138,7 @@ getAccountAddress auth acc = callApi auth "getaccountaddress" [ tj acc ] -- | Sets the account associated with the given address. setAccount :: Auth -> Address -> Account -> IO () -setAccount auth addr acc = callApi auth "setaccount" [ tj addr, tj acc ] +setAccount auth addr acc = unNil <$> callApi auth "setaccount" [ tj addr, tj acc ] -- | Returns the account associated with the given address. getAccount :: Auth -> Address -> IO Account From cddcc4d67152b8281a0e5deec8a1ddcf1ccc36eb Mon Sep 17 00:00:00 2001 From: Clark Gaebel Date: Wed, 18 Dec 2013 14:34:26 -0500 Subject: [PATCH 45/73] remove outdated dependency --- network-bitcoin.cabal | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/network-bitcoin.cabal b/network-bitcoin.cabal index 560bf2a..a6c9eff 100644 --- a/network-bitcoin.cabal +++ b/network-bitcoin.cabal @@ -1,5 +1,5 @@ Name: network-bitcoin -Version: 1.5.0 +Version: 1.5.1 Synopsis: An interface to bitcoind. Description: This can be used to send Bitcoins, query balances, etc. It @@ -77,6 +77,6 @@ Executable network-bitcoin-tests text >= 0.11, vector >= 0.10, base == 4.*, - QuickCheck == 2.5.*, + QuickCheck == 2.6.*, network-bitcoin From 888e5049d32105cdf6d89de97ada959b397ae62f Mon Sep 17 00:00:00 2001 From: michaelbeaumont Date: Sat, 1 Mar 2014 01:12:27 +0100 Subject: [PATCH 46/73] Removed dependency on old version of Aeson --- network-bitcoin.cabal | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/network-bitcoin.cabal b/network-bitcoin.cabal index a6c9eff..f819fe1 100644 --- a/network-bitcoin.cabal +++ b/network-bitcoin.cabal @@ -49,7 +49,7 @@ Library Network.Bitcoin.Wallet Build-depends: - aeson >= 0.6.1 && < 0.7, + aeson >= 0.6.1, bytestring >= 0.9 && < 0.11, attoparsec == 0.10.*, unordered-containers >= 0.2, @@ -68,7 +68,7 @@ Executable network-bitcoin-tests ghc-options: -Wall main-is: Test/Main.hs build-depends: - aeson >= 0.6.1 && < 0.7, + aeson >= 0.6.1, bytestring >= 0.9 && < 0.11, attoparsec == 0.10.*, unordered-containers >= 0.2, From 187cc38ed2ae833ef2f145b92b6b63425bfa31eb Mon Sep 17 00:00:00 2001 From: michaelbeaumont Date: Sat, 1 Mar 2014 10:36:43 +0100 Subject: [PATCH 47/73] Added upper bound --- network-bitcoin.cabal | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/network-bitcoin.cabal b/network-bitcoin.cabal index f819fe1..44eb7e2 100644 --- a/network-bitcoin.cabal +++ b/network-bitcoin.cabal @@ -49,7 +49,7 @@ Library Network.Bitcoin.Wallet Build-depends: - aeson >= 0.6.1, + aeson >= 0.6.1 && < 0.7.1, bytestring >= 0.9 && < 0.11, attoparsec == 0.10.*, unordered-containers >= 0.2, @@ -68,7 +68,7 @@ Executable network-bitcoin-tests ghc-options: -Wall main-is: Test/Main.hs build-depends: - aeson >= 0.6.1, + aeson >= 0.6.1 && < 0.7.1, bytestring >= 0.9 && < 0.11, attoparsec == 0.10.*, unordered-containers >= 0.2, From 11eca1cd9c590e74e0d9ce88a099043bd38cb28e Mon Sep 17 00:00:00 2001 From: gxt Date: Sat, 26 Apr 2014 19:20:43 -0400 Subject: [PATCH 48/73] Added experimental support for method "listsinceblock". --- src/Network/Bitcoin.hs | 4 +- src/Network/Bitcoin.hs~ | 118 +++++++ src/Network/Bitcoin/Wallet.hs | 68 ++++- src/Network/Bitcoin/Wallet.hs~ | 540 +++++++++++++++++++++++++++++++++ 4 files changed, 727 insertions(+), 3 deletions(-) create mode 100644 src/Network/Bitcoin.hs~ create mode 100644 src/Network/Bitcoin/Wallet.hs~ diff --git a/src/Network/Bitcoin.hs b/src/Network/Bitcoin.hs index 55ac570..7f6b7a9 100644 --- a/src/Network/Bitcoin.hs +++ b/src/Network/Bitcoin.hs @@ -98,7 +98,9 @@ module Network.Bitcoin , listReceivedByAccount' -- , listTransactions -- , listAccounts - -- , listSinceBlock + , SinceBlock(..) + , SinceBlockTransaction(..) + , listSinceBlock -- , getTransaction , backupWallet , keyPoolRefill diff --git a/src/Network/Bitcoin.hs~ b/src/Network/Bitcoin.hs~ new file mode 100644 index 0000000..164079a --- /dev/null +++ b/src/Network/Bitcoin.hs~ @@ -0,0 +1,118 @@ +{-# OPTIONS_GHC -Wall #-} +-- | A Haskell binding to the bitcoind server. +module Network.Bitcoin + ( + -- * Common Types + Auth(..) + , BitcoinException(..) + , HexString + , TransactionID + , Satoshi(..) + , BTC + , Account + , Address + , ScriptSig + -- * Block Chain Operations + , getBlockCount + , getDifficulty + , setTransactionFee + , getRawMemoryPool + , BlockHash + , getBlockHash + , Block(..) + , getBlock + , OutputSetInfo(..) + , getOutputSetInfo + , OutputInfo(..) + , getOutputInfo + -- * Private Key Operations + , importPrivateKey + , dumpPrivateKey + -- * Mining Operations + , getGenerate + , setGenerate + , getHashesPerSec + , MiningInfo(..) + , getMiningInfo + , HashData(..) + , getWork + , solveBlock + , Transaction(..) + , CoinBaseAux(..) + , BlockTemplate(..) + , getBlockTemplate + , submitBlock + -- * Network Operations + , getConnectionCount + , PeerInfo(..) + , getPeerInfo + -- * Raw Transaction Operations + , RawTransaction + , getRawTransaction + , TxIn(..) + , TxnOutputType(..) + , ScriptPubKey(..) + , TxOut(..) + , BlockInfo(..) + , RawTransactionInfo(..) + , getRawTransactionInfo + , UnspentTransaction(..) + , listUnspent + , createRawTransaction + , DecodedRawTransaction(..) + , decodeRawTransaction + , WhoCanPay(..) + , RawSignedTransaction(..) + , signRawTransaction + , sendRawTransaction + -- * Wallet Operations + , BitcoindInfo(..) + , getBitcoindInfo + , getNewAddress + , getAccountAddress + , getAccount + , setAccount + , getAddressesByAccount + , sendToAddress + , AddressInfo(..) + , listAddressGroupings + , Signature + , signMessage + , verifyMessage + , getReceivedByAddress + , getReceivedByAddress' + , getReceivedByAccount + , getReceivedByAccount' + , getBalance + , getBalance' + , getBalance'' + , moveBitcoins + , sendFromAccount + , sendMany + -- , createMultiSig + , ReceivedByAddress(..) + , listReceivedByAddress + , listReceivedByAddress' + , ReceivedByAccount(..) + , listReceivedByAccount + , listReceivedByAccount' + -- , listTransactions + -- , listAccounts + , listSinceBlock + -- , getTransaction + , backupWallet + , keyPoolRefill + , unlockWallet + , lockWallet + , changePassword + , encryptWallet + , isAddressValid + ) where + +import Network.Bitcoin.Types +import Network.Bitcoin.BlockChain +import Network.Bitcoin.Dump +import Network.Bitcoin.Mining +import Network.Bitcoin.Net +import Network.Bitcoin.RawTransaction +import Network.Bitcoin.Wallet diff --git a/src/Network/Bitcoin/Wallet.hs b/src/Network/Bitcoin/Wallet.hs index 84a6d77..708001a 100644 --- a/src/Network/Bitcoin/Wallet.hs +++ b/src/Network/Bitcoin/Wallet.hs @@ -43,7 +43,9 @@ module Network.Bitcoin.Wallet ( Auth(..) , listReceivedByAccount' -- , listTransactions -- , listAccounts - -- , listSinceBlock + , SinceBlock(..) + , SinceBlockTransaction(..) + , listSinceBlock -- , getTransaction , backupWallet , keyPoolRefill @@ -60,6 +62,7 @@ import Data.Aeson as A import Data.Maybe import Data.Vector as V import Network.Bitcoin.Internal +import Network.Bitcoin.BlockChain (BlockHash) -- | A plethora of information about a bitcoind instance. data BitcoindInfo = @@ -402,10 +405,71 @@ listReceivedByAccount' :: Auth -> IO (Vector ReceivedByAccount) listReceivedByAccount' auth minconf includeEmpty = callApi auth "listreceivedbyaccount" [ tj minconf, tj includeEmpty ] + + +data SinceBlock = + SinceBlock { transactions :: Vector SinceBlockTransaction + , lastBlockHash :: BlockHash + } + deriving ( Show, Read, Ord, Eq ) + +instance FromJSON SinceBlock where + parseJSON (Object o) = SinceBlock <$> o .: "transactions" + <*> o .: "lastblock" + parseJSON _ = mzero + +data SinceBlockTransaction = + SinceBlockTransaction { + -- | The account associated with the receiving address. + sbtReceivingAccount :: Account + -- | The receiving address of the transaction. + , sbtAddress :: Address + -- | The category of the transaction (As of 0.8.6 this field can be send,orphan,immature,generate,receive,move). + , sbtCategory :: Text + -- | The amount of bitcoins transferred. + , sbtAmountBitcoin :: BTC + -- | The number of confirmation of the transaction. + , sbtConfirmations :: Integer + -- | The hash of the block containing the transaction. + , sbtBlockHash :: BlockHash + , sbtBlockIndex :: Integer + , sbtBlockTime :: Double + , sbtTransactionId :: TransactionID + -- | The list of transaction ids containing the same data as the original transaction (See ID-malleation bug). + , sbtWalletConflicts :: Vector TransactionID + , sbtTime :: Integer + , sbtTimeReceived :: Integer + } + deriving ( Show, Read, Ord, Eq ) + +instance FromJSON SinceBlockTransaction where + parseJSON (Object o) = SinceBlockTransaction <$> o .: "account" + <*> o .: "address" + <*> o .: "category" + <*> o .: "amount" + <*> o .: "confirmations" + <*> o .: "blockhash" + <*> o .: "blockindex" + <*> o .: "blocktime" + <*> o .: "txid" + <*> o .: "walletconflicts" + <*> o .: "time" + <*> o .: "timereceived" + parseJSON _ = mzero + +listSinceBlock :: Auth + -> BlockHash + -> Maybe Int + -- ^ The minimum number of confirmations before a + -- transaction counts toward the total received. + -> IO (SinceBlock) +listSinceBlock auth blockHash (Just minConf) = + callApi auth "listsinceblock" [ tj blockHash, tj minConf ] +listSinceBlock auth blockHash _ = + callApi auth "listsinceblock" [ tj blockHash ] -- TODO: listtransactions -- listaccounts --- listsinceblock -- gettransaction -- -- These functions are just way too complicated for me to write. diff --git a/src/Network/Bitcoin/Wallet.hs~ b/src/Network/Bitcoin/Wallet.hs~ new file mode 100644 index 0000000..ec5ba3c --- /dev/null +++ b/src/Network/Bitcoin/Wallet.hs~ @@ -0,0 +1,540 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -Wall #-} +-- | An interface to bitcoind's available wallet-related RPC calls. +-- The implementation of these functions can be found at +-- . +-- +-- If any APIs are missing, patches are always welcome. If you look at the +-- source of this module, you'll see that the interface code is trivial. +-- +-- Certain APIs were too complicated for me to write an interface for. If +-- you figure them out, then patches are always welcome! They're left in +-- the source as comments. +module Network.Bitcoin.Wallet ( Auth(..) + , BitcoindInfo(..) + , getBitcoindInfo + , getNewAddress + , getAccountAddress + , getAccount + , setAccount + , getAddressesByAccount + , sendToAddress + , AddressInfo(..) + , listAddressGroupings + , Signature + , signMessage + , verifyMessage + , getReceivedByAddress + , getReceivedByAddress' + , getReceivedByAccount + , getReceivedByAccount' + , getBalance + , getBalance' + , getBalance'' + , moveBitcoins + , sendFromAccount + , sendMany + -- , createMultiSig + , ReceivedByAddress(..) + , listReceivedByAddress + , listReceivedByAddress' + , ReceivedByAccount(..) + , listReceivedByAccount + , listReceivedByAccount' + -- , listTransactions + -- , listAccounts + , SinceBlock(..) + , SinceBlockTransaction(..) + , listSinceBlock + -- , getTransaction + , backupWallet + , keyPoolRefill + , unlockWallet + , lockWallet + , changePassword + , encryptWallet + , isAddressValid + ) where + +import Control.Applicative +import Control.Monad +import Data.Aeson as A +import Data.Maybe +import Data.Vector as V +import Network.Bitcoin.Internal +import Network.Bitcoin.BlockChain (BlockHash) + +-- | A plethora of information about a bitcoind instance. +data BitcoindInfo = + BitcoindInfo { + -- | What version of bitcoind are we running? + bitcoinVersion :: Integer + -- | What is bitcoind's current protocol number? + , protocolVersion :: Integer + -- | What version is the wallet? + , walletVersion :: Integer + -- | How much money is currently in the wallet? + , balance :: BTC + -- | The number of blocks in our chain. + , numBlocks :: Integer + -- | How many peers are we connected to? + , numConnections :: Integer + -- | A blank string if we're not using a proxy. + , proxy :: Text + -- | The difficulty multiplier for bitcoin mining operations. + , generationDifficulty :: Double + -- | Are we on the test network (as opposed to the primary + -- bitcoin network)? + , onTestNetwork :: Bool + -- | The timestamp of the oldest key in the key pool. + , keyPoolOldest :: Integer + -- | The size of the key pool. + , keyPoolSize :: Integer + -- | How much do we currently pay as a transaction fee? + , transactionFeePaid :: BTC + -- | If the wallet is unlocked, the number of seconds until a + -- re-lock is needed. + , unlockedUntil :: Maybe Integer + -- | Any alerts will show up here. This should normally be an + -- empty string. + , bitcoindErrors :: Text + } + deriving ( Show, Read, Ord, Eq ) + +instance FromJSON BitcoindInfo where + parseJSON (Object o) = BitcoindInfo <$> o .: "version" + <*> o .: "protocolversion" + <*> o .: "walletversion" + <*> o .: "balance" + <*> o .: "blocks" + <*> o .: "connections" + <*> o .: "proxy" + <*> o .: "difficulty" + <*> o .: "testnet" + <*> o .: "keypoololdest" + <*> o .: "keypoolsize" + <*> o .: "paytxfee" + <*> o .:? "unlocked_until" + <*> o .: "errors" + parseJSON _ = mzero + +-- | Returns an object containing various state info. +getBitcoindInfo :: Auth -> IO BitcoindInfo +getBitcoindInfo auth = callApi auth "getinfo" [] + +-- | Returns a new bitcoin address for receiving payments. +-- +-- If an account is specified (recommended), the new address is added to the +-- address book so payments received with the address will be credited to the +-- given account. +-- +-- If no account is specified, the address will be credited to the account +-- whose name is the empty string. i.e. the default account. +getNewAddress :: Auth -> Maybe Account -> IO Address +getNewAddress auth ma = let acc = fromMaybe "" ma + in callApi auth "getnewaddress" [ tj acc ] + +-- | Returns the current Bitcoin address for receiving payments to the given +-- account. +getAccountAddress :: Auth -> Account -> IO Address +getAccountAddress auth acc = callApi auth "getaccountaddress" [ tj acc ] + +-- | Sets the account associated with the given address. +setAccount :: Auth -> Address -> Account -> IO () +setAccount auth addr acc = unNil <$> callApi auth "setaccount" [ tj addr, tj acc ] + +-- | Returns the account associated with the given address. +getAccount :: Auth -> Address -> IO Account +getAccount auth addr = callApi auth "getaccount" [ tj addr ] + +-- | Returns the list of addresses for the given address. +getAddressesByAccount :: Auth -> Account -> IO (Vector Address) +getAddressesByAccount auth acc = callApi auth "getaddressesbyaccount" [ tj acc ] + +-- | Sends some bitcoins to an address. +sendToAddress :: Auth + -> Address + -- ^ Who we're sending to. + -> BTC + -- ^ The amount to send. + -> Maybe Text + -- ^ An optional comment for the transaction. + -> Maybe Text + -- ^ An optional comment-to (who did we sent this to?) for the + -- transaction. + -> IO TransactionID +sendToAddress auth addr amount comm comm2 = + callApi auth "sendtoaddress" [ tj addr, tj amount, tj comm, tj comm2 ] + +-- | Information on a given address. +data AddressInfo = AddressInfo { -- | The address in question. + aiAddress :: Address + -- | The address' balance. + , aiAmount :: BTC + -- | The address' linked account. + , aiAccount :: Maybe Account + } + deriving ( Show, Read, Eq, Ord ) + +-- | What a silly API. +instance FromJSON AddressInfo where + parseJSON (A.Array a) | V.length a == 2 = AddressInfo <$> parseJSON (a ! 0) + <*> parseJSON (a ! 1) + <*> pure Nothing + | V.length a == 3 = AddressInfo <$> parseJSON (a ! 0) + <*> parseJSON (a ! 1) + <*> (Just <$> parseJSON (a ! 2)) + | otherwise = mzero + parseJSON _ = mzero + +-- | Lists groups of addresses which have had their common ownership made +-- public by common use as inputs or as the resulting change in past +-- transactions. +listAddressGroupings :: Auth + -> IO (Vector (Vector AddressInfo)) +listAddressGroupings auth = + callApi auth "listaddressgroupings" [] + +-- | A signature is a base-64 encoded string. +type Signature = HexString + +-- | Sign a message with the private key of an address. +signMessage :: Auth + -> Address + -- ^ The address whose private key we'll use. + -> Text + -- ^ The message to sign. + -> IO Signature +signMessage auth addr msg = callApi auth "signmessage" [ tj addr, tj msg ] + +-- | Verifies a signed message. +verifyMessage :: Auth + -> Address + -- ^ The address of the original signer. + -> Signature + -- ^ The message's signature. + -> Text + -- ^ The message. + -> IO Bool + -- ^ Was the signature valid? +verifyMessage auth addr sig msg = + callApi auth "verifymessage" [ tj addr, tj sig, tj msg ] + +-- | Returns the total amount received by the given address with at least one +-- confirmation. +getReceivedByAddress :: Auth -> Address -> IO BTC +getReceivedByAddress auth addr = + callApi auth "getreceivedbyaddress" [ tj addr ] + +-- | Returns the total amount received by the given address, with at least the +-- give number of confirmations. +getReceivedByAddress' :: Auth + -> Address + -> Int -- ^ The minimum number of confirmations needed + -- for a transaction to to count towards the + -- total. + -> IO BTC +getReceivedByAddress' auth addr minconf = + callApi auth "getreceivedbyaddress" [ tj addr, tj minconf ] + +-- | Returns the total amount received by address with the given account. +getReceivedByAccount :: Auth -> Account -> IO BTC +getReceivedByAccount auth acc = + callApi auth "getreceivedbyaccount" [ tj acc ] + +-- | Returns the total amount received by addresses with the given account, +-- counting only transactions with the given minimum number of confirmations. +getReceivedByAccount' :: Auth + -> Account + -- ^ The account in question. + -> Int + -- ^ The minimum number of confirmations needed for a + -- transaction to count towards the total. + -> IO BTC +getReceivedByAccount' auth acc minconf = + callApi auth "getreceivedbyaccount" [ tj acc, tj minconf ] + +-- | Returns the server's total available balance. +getBalance :: Auth + -> IO BTC +getBalance auth = + callApi auth "getbalance" [] + +-- | Returns the balance in the given account, counting only transactions with +-- at least one confirmation. +getBalance' :: Auth + -> Account + -> IO BTC +getBalance' auth acc = + callApi auth "getbalance" [ tj acc ] + +-- | Returns the balance in the given account, counting only transactions with +-- at least the given number of confirmations. +getBalance'' :: Auth + -> Account + -> Int + -- ^ The minimum number of confirmations needed for a transaction + -- to count towards the total. + -> IO BTC +getBalance'' auth acc minconf = + callApi auth "getbalance" [ tj acc, tj minconf ] + +-- | Move bitcoins from one account in your wallet to another. +-- +-- If you want to send bitcoins to an address not in your wallet, use +-- 'sendFromAccount'. +moveBitcoins :: Auth + -> Account -- ^ From. + -> Account -- ^ To. + -> BTC -- ^ The amount to transfer. + -> Text -- ^ A comment to record for the transaction. + -> IO () +moveBitcoins auth from to amt comm = + stupidAPI <$> callApi auth "move" [ tj from, tj to, tj amt, tj one, tj comm ] + where one = 1 :: Int -- needs a type, else default-integer warnings. + stupidAPI :: Bool -> () + stupidAPI = const () + +-- | Sends bitcoins from a given account in our wallet to a given address. +-- +-- A transaction and sender comment may be optionally provided. +sendFromAccount :: Auth + -> Account + -- ^ The account to send from. + -> Address + -- ^ The address to send to. + -> BTC + -- ^ The amount to send. + -> Maybe Text + -- ^ An optional transaction comment. + -> Maybe Text + -- ^ An optional comment on who the money is going to. + -> IO TransactionID +sendFromAccount auth from to amount comm comm2 = + callApi auth "sendfrom" [ tj from, tj to, tj amount, tj one, tj comm, tj comm2 ] + where one = 1 :: Int -- needs a type, else default-integer warnings. + +-- | Send to a whole bunch of address at once. +sendMany :: Auth + -> Account + -- ^ The account to send from. + -> Vector (Address, BTC) + -- ^ The address, and how much to send to each one. + -> Maybe Text + -- ^ An optional transaction comment. + -> IO TransactionID +sendMany auth acc amounts comm = + callApi auth "sendmany" [ tj acc, tj $ AA amounts, tj comm ] + +-- TODO: createmultisig. +-- +-- I have no idea what this is doing. Patches adding this function are +-- always welcome! + +-- | Information on how much was received by a given address. +data ReceivedByAddress = + ReceivedByAddress { -- | The address which the money was deposited to. + recvAddress :: Address + -- | The account which this address belongs to. + , recvAccount :: Account + -- | The amount received. + , recvAmount :: BTC + -- | The number of confirmations of the most recent + -- included transaction. + , recvNumConfirmations :: Integer + } + deriving ( Show, Read, Ord, Eq ) + +instance FromJSON ReceivedByAddress where + parseJSON (Object o) = ReceivedByAddress <$> o .: "address" + <*> o .: "account" + <*> o .: "amount" + <*> o .: "confirmations" + parseJSON _ = mzero + +-- | Lists the amount received by each address which has received money at some +-- point, counting only transactions with at least one confirmation. +listReceivedByAddress :: Auth -> IO (Vector ReceivedByAddress) +listReceivedByAddress auth = listReceivedByAddress' auth 1 False + +-- | List the amount received by each of our addresses, counting only +-- transactions with the given minimum number of confirmations. +listReceivedByAddress' :: Auth + -> Int + -- ^ The minimum number of confirmations before a + -- transaction counts toward the total amount + -- received. + -> Bool + -- ^ Should we include addresses with no money + -- received? + -> IO (Vector ReceivedByAddress) +listReceivedByAddress' auth minconf includeEmpty = + callApi auth "listreceivedbyaddress" [ tj minconf, tj includeEmpty ] + +data ReceivedByAccount = + ReceivedByAccount { raccAccount :: Account + -- ^ The account we received into. + , raccAmount :: BTC + -- ^ The mount received. + -- ^ The number of confirmations of the most recent + -- included transaction. + , raccNumConfirmations :: Integer + } + deriving ( Show, Read, Ord, Eq ) + +instance FromJSON ReceivedByAccount where + parseJSON (Object o) = ReceivedByAccount <$> o .: "account" + <*> o .: "amount" + <*> o .: "confirmations" + parseJSON _ = mzero + +-- | Lists the amount received by each account which has received money at some +-- point, counting only transactions with at leaset one confirmation. +listReceivedByAccount :: Auth -> IO (Vector ReceivedByAccount) +listReceivedByAccount auth = listReceivedByAccount' auth 1 False + +-- | List the amount received by each of our accounts, counting only +-- transactions with the given minimum number of confirmations. +listReceivedByAccount' :: Auth + -> Int + -- ^ The minimum number of confirmations before a + -- transaction counts toward the total received. + -> Bool + -- ^ Should we include the accounts with no money + -- received? + -> IO (Vector ReceivedByAccount) +listReceivedByAccount' auth minconf includeEmpty = + callApi auth "listreceivedbyaccount" [ tj minconf, tj includeEmpty ] + + +data SinceBlock = + SinceBlock { transactions :: Vector SinceBlockTransaction + , lastBlockHash :: BlockHash + } + deriving ( Show, Read, Ord, Eq ) + +instance FromJSON SinceBlock where + parseJSON (Object o) = SinceBlock <$> o .: "transactions" + <*> o .: "lastblock" + parseJSON _ = mzero + +data SinceBlockTransaction = + SinceBlockTransaction { + -- | The account associated with the receiving address. + sbtReceivingAccount :: Account + -- | The receiving address of the transaction. + , sbtAddress :: Address + -- | The category of the transaction (As of 0.8.6 this field can be send,orphan,immature,generate,receive,move). + , sbtCategory :: Text + -- | The amount of bitcoins transferred. + , sbtAmountBitcoin :: BTC + -- | The number of confirmation of the transaction. + , sbtConfirmations :: Integer + -- | The hash of the block containing the transaction. + , sbtBlockHash :: BlockHash + , sbtBlockIndex :: Integer + , sbtBlockTime :: Double + , sbtTransactionId :: TransactionID + -- | The list of transaction ids containing the same data as the original transaction (See ID-malleation bug). + , sbtWalletConflicts :: Vector TransactionID + , sbtTime :: Integer + , sbtTimeReceived :: Integer + } + deriving ( Show, Read, Ord, Eq ) + +instance FromJSON SinceBlockTransaction where + parseJSON (Object o) = SinceBlockTransaction <$> o .: "account" + <*> o .: "address" + <*> o .: "category" + <*> o .: "amount" + <*> o .: "confirmations" + <*> o .: "blockhash" + <*> o .: "blockindex" + <*> o .: "blocktime" + <*> o .: "txid" + <*> o .: "walletconflicts" + <*> o .: "time" + <*> o .: "timereceived" + parseJSON _ = mzero + +listSinceBlock :: Auth + -> BlockHash + -> Maybe Int + -- ^ The minimum number of confirmations before a + -- transaction counts toward the total received. + -> IO (ListSinceBlockResult) +listSinceBlock auth blockHash (Just minConf) = + callApi auth "listsinceblock" [ tj blockHash, tj minConf ] +listSinceBlock auth blockHash _ = + callApi auth "listsinceblock" [ tj blockHash ] + +-- TODO: listtransactions +-- listaccounts +-- gettransaction +-- +-- These functions are just way too complicated for me to write. +-- Patches welcome! + +-- | Safely copies wallet.dat to the given destination, which can be either a +-- directory, or a path with filename. +backupWallet :: Auth + -> FilePath + -> IO () +backupWallet auth fp = + unNil <$> callApi auth "backupwallet" [ tj fp ] + +-- | Fills the keypool. +keyPoolRefill :: Auth -> IO () +keyPoolRefill auth = unNil <$> callApi auth "keypoolrefill" [] + +-- | Stores the wallet decryption key in memory for the given amount of time. +unlockWallet :: Auth + -> Text + -- ^ The decryption key. + -> Integer + -- ^ How long to store the key in memory (in seconds). + -> IO () +unlockWallet auth pass timeout = + unNil <$> callApi auth "walletpassphrase" [ tj pass, tj timeout ] + +-- | Changes the wallet passphrase. +changePassword :: Auth + -> Text + -- ^ The old password. + -> Text + -- ^ The new password. + -> IO () +changePassword auth old new = + unNil <$> callApi auth "walletpassphrase" [ tj old, tj new ] + +-- | Removes the wallet encryption key from memory, locking the wallet. +-- +-- After calling this function, you will need to call 'unlockWallet' again +-- before being able to call methods which require the wallet to be unlocked. +-- +-- Note: In future releases, we might introduce an "unlocked" monad, so +-- locking and unlocking is automatic. +lockWallet :: Auth -> IO () +lockWallet auth = unNil <$> callApi auth "walletlock" [] + +-- | Encrypts the wallet with the given passphrase. +-- +-- WARNING: bitcoind will shut down after calling this method. Don't say I +-- didn't warn you. +encryptWallet :: Auth -> Text -> IO () +encryptWallet auth pass = stupidAPI <$> callApi auth "encryptwallet" [ tj pass ] + where + stupidAPI :: Text -> () + stupidAPI = const () + +-- | Just a handy wrapper to help us get only the "isvalid" field of the JSON. +-- The structure is much too complicated for what it needs to do. +data IsValid = IsValid { getValid :: Bool } + +instance FromJSON IsValid where + parseJSON (Object o) = IsValid <$> o .: "isvalid" + parseJSON _ = mzero + +-- | Checks if a given address is a valid one. +isAddressValid :: Auth -> Address -> IO Bool +isAddressValid auth addr = getValid <$> callApi auth "validateaddress" [ tj addr ] From db3818e4eb737c6106295e15e61920a91234d1a7 Mon Sep 17 00:00:00 2001 From: MomemtumMori Date: Sat, 26 Apr 2014 19:26:10 -0400 Subject: [PATCH 49/73] Delete Bitcoin.hs~ --- src/Network/Bitcoin.hs~ | 118 ---------------------------------------- 1 file changed, 118 deletions(-) delete mode 100644 src/Network/Bitcoin.hs~ diff --git a/src/Network/Bitcoin.hs~ b/src/Network/Bitcoin.hs~ deleted file mode 100644 index 164079a..0000000 --- a/src/Network/Bitcoin.hs~ +++ /dev/null @@ -1,118 +0,0 @@ -{-# OPTIONS_GHC -Wall #-} --- | A Haskell binding to the bitcoind server. -module Network.Bitcoin - ( - -- * Common Types - Auth(..) - , BitcoinException(..) - , HexString - , TransactionID - , Satoshi(..) - , BTC - , Account - , Address - , ScriptSig - -- * Block Chain Operations - , getBlockCount - , getDifficulty - , setTransactionFee - , getRawMemoryPool - , BlockHash - , getBlockHash - , Block(..) - , getBlock - , OutputSetInfo(..) - , getOutputSetInfo - , OutputInfo(..) - , getOutputInfo - -- * Private Key Operations - , importPrivateKey - , dumpPrivateKey - -- * Mining Operations - , getGenerate - , setGenerate - , getHashesPerSec - , MiningInfo(..) - , getMiningInfo - , HashData(..) - , getWork - , solveBlock - , Transaction(..) - , CoinBaseAux(..) - , BlockTemplate(..) - , getBlockTemplate - , submitBlock - -- * Network Operations - , getConnectionCount - , PeerInfo(..) - , getPeerInfo - -- * Raw Transaction Operations - , RawTransaction - , getRawTransaction - , TxIn(..) - , TxnOutputType(..) - , ScriptPubKey(..) - , TxOut(..) - , BlockInfo(..) - , RawTransactionInfo(..) - , getRawTransactionInfo - , UnspentTransaction(..) - , listUnspent - , createRawTransaction - , DecodedRawTransaction(..) - , decodeRawTransaction - , WhoCanPay(..) - , RawSignedTransaction(..) - , signRawTransaction - , sendRawTransaction - -- * Wallet Operations - , BitcoindInfo(..) - , getBitcoindInfo - , getNewAddress - , getAccountAddress - , getAccount - , setAccount - , getAddressesByAccount - , sendToAddress - , AddressInfo(..) - , listAddressGroupings - , Signature - , signMessage - , verifyMessage - , getReceivedByAddress - , getReceivedByAddress' - , getReceivedByAccount - , getReceivedByAccount' - , getBalance - , getBalance' - , getBalance'' - , moveBitcoins - , sendFromAccount - , sendMany - -- , createMultiSig - , ReceivedByAddress(..) - , listReceivedByAddress - , listReceivedByAddress' - , ReceivedByAccount(..) - , listReceivedByAccount - , listReceivedByAccount' - -- , listTransactions - -- , listAccounts - , listSinceBlock - -- , getTransaction - , backupWallet - , keyPoolRefill - , unlockWallet - , lockWallet - , changePassword - , encryptWallet - , isAddressValid - ) where - -import Network.Bitcoin.Types -import Network.Bitcoin.BlockChain -import Network.Bitcoin.Dump -import Network.Bitcoin.Mining -import Network.Bitcoin.Net -import Network.Bitcoin.RawTransaction -import Network.Bitcoin.Wallet From 8441bd03dd56b9fd32aefc8d9e7269ad537df915 Mon Sep 17 00:00:00 2001 From: MomemtumMori Date: Sat, 26 Apr 2014 19:26:23 -0400 Subject: [PATCH 50/73] Delete Wallet.hs~ --- src/Network/Bitcoin/Wallet.hs~ | 540 --------------------------------- 1 file changed, 540 deletions(-) delete mode 100644 src/Network/Bitcoin/Wallet.hs~ diff --git a/src/Network/Bitcoin/Wallet.hs~ b/src/Network/Bitcoin/Wallet.hs~ deleted file mode 100644 index ec5ba3c..0000000 --- a/src/Network/Bitcoin/Wallet.hs~ +++ /dev/null @@ -1,540 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# OPTIONS_GHC -Wall #-} --- | An interface to bitcoind's available wallet-related RPC calls. --- The implementation of these functions can be found at --- . --- --- If any APIs are missing, patches are always welcome. If you look at the --- source of this module, you'll see that the interface code is trivial. --- --- Certain APIs were too complicated for me to write an interface for. If --- you figure them out, then patches are always welcome! They're left in --- the source as comments. -module Network.Bitcoin.Wallet ( Auth(..) - , BitcoindInfo(..) - , getBitcoindInfo - , getNewAddress - , getAccountAddress - , getAccount - , setAccount - , getAddressesByAccount - , sendToAddress - , AddressInfo(..) - , listAddressGroupings - , Signature - , signMessage - , verifyMessage - , getReceivedByAddress - , getReceivedByAddress' - , getReceivedByAccount - , getReceivedByAccount' - , getBalance - , getBalance' - , getBalance'' - , moveBitcoins - , sendFromAccount - , sendMany - -- , createMultiSig - , ReceivedByAddress(..) - , listReceivedByAddress - , listReceivedByAddress' - , ReceivedByAccount(..) - , listReceivedByAccount - , listReceivedByAccount' - -- , listTransactions - -- , listAccounts - , SinceBlock(..) - , SinceBlockTransaction(..) - , listSinceBlock - -- , getTransaction - , backupWallet - , keyPoolRefill - , unlockWallet - , lockWallet - , changePassword - , encryptWallet - , isAddressValid - ) where - -import Control.Applicative -import Control.Monad -import Data.Aeson as A -import Data.Maybe -import Data.Vector as V -import Network.Bitcoin.Internal -import Network.Bitcoin.BlockChain (BlockHash) - --- | A plethora of information about a bitcoind instance. -data BitcoindInfo = - BitcoindInfo { - -- | What version of bitcoind are we running? - bitcoinVersion :: Integer - -- | What is bitcoind's current protocol number? - , protocolVersion :: Integer - -- | What version is the wallet? - , walletVersion :: Integer - -- | How much money is currently in the wallet? - , balance :: BTC - -- | The number of blocks in our chain. - , numBlocks :: Integer - -- | How many peers are we connected to? - , numConnections :: Integer - -- | A blank string if we're not using a proxy. - , proxy :: Text - -- | The difficulty multiplier for bitcoin mining operations. - , generationDifficulty :: Double - -- | Are we on the test network (as opposed to the primary - -- bitcoin network)? - , onTestNetwork :: Bool - -- | The timestamp of the oldest key in the key pool. - , keyPoolOldest :: Integer - -- | The size of the key pool. - , keyPoolSize :: Integer - -- | How much do we currently pay as a transaction fee? - , transactionFeePaid :: BTC - -- | If the wallet is unlocked, the number of seconds until a - -- re-lock is needed. - , unlockedUntil :: Maybe Integer - -- | Any alerts will show up here. This should normally be an - -- empty string. - , bitcoindErrors :: Text - } - deriving ( Show, Read, Ord, Eq ) - -instance FromJSON BitcoindInfo where - parseJSON (Object o) = BitcoindInfo <$> o .: "version" - <*> o .: "protocolversion" - <*> o .: "walletversion" - <*> o .: "balance" - <*> o .: "blocks" - <*> o .: "connections" - <*> o .: "proxy" - <*> o .: "difficulty" - <*> o .: "testnet" - <*> o .: "keypoololdest" - <*> o .: "keypoolsize" - <*> o .: "paytxfee" - <*> o .:? "unlocked_until" - <*> o .: "errors" - parseJSON _ = mzero - --- | Returns an object containing various state info. -getBitcoindInfo :: Auth -> IO BitcoindInfo -getBitcoindInfo auth = callApi auth "getinfo" [] - --- | Returns a new bitcoin address for receiving payments. --- --- If an account is specified (recommended), the new address is added to the --- address book so payments received with the address will be credited to the --- given account. --- --- If no account is specified, the address will be credited to the account --- whose name is the empty string. i.e. the default account. -getNewAddress :: Auth -> Maybe Account -> IO Address -getNewAddress auth ma = let acc = fromMaybe "" ma - in callApi auth "getnewaddress" [ tj acc ] - --- | Returns the current Bitcoin address for receiving payments to the given --- account. -getAccountAddress :: Auth -> Account -> IO Address -getAccountAddress auth acc = callApi auth "getaccountaddress" [ tj acc ] - --- | Sets the account associated with the given address. -setAccount :: Auth -> Address -> Account -> IO () -setAccount auth addr acc = unNil <$> callApi auth "setaccount" [ tj addr, tj acc ] - --- | Returns the account associated with the given address. -getAccount :: Auth -> Address -> IO Account -getAccount auth addr = callApi auth "getaccount" [ tj addr ] - --- | Returns the list of addresses for the given address. -getAddressesByAccount :: Auth -> Account -> IO (Vector Address) -getAddressesByAccount auth acc = callApi auth "getaddressesbyaccount" [ tj acc ] - --- | Sends some bitcoins to an address. -sendToAddress :: Auth - -> Address - -- ^ Who we're sending to. - -> BTC - -- ^ The amount to send. - -> Maybe Text - -- ^ An optional comment for the transaction. - -> Maybe Text - -- ^ An optional comment-to (who did we sent this to?) for the - -- transaction. - -> IO TransactionID -sendToAddress auth addr amount comm comm2 = - callApi auth "sendtoaddress" [ tj addr, tj amount, tj comm, tj comm2 ] - --- | Information on a given address. -data AddressInfo = AddressInfo { -- | The address in question. - aiAddress :: Address - -- | The address' balance. - , aiAmount :: BTC - -- | The address' linked account. - , aiAccount :: Maybe Account - } - deriving ( Show, Read, Eq, Ord ) - --- | What a silly API. -instance FromJSON AddressInfo where - parseJSON (A.Array a) | V.length a == 2 = AddressInfo <$> parseJSON (a ! 0) - <*> parseJSON (a ! 1) - <*> pure Nothing - | V.length a == 3 = AddressInfo <$> parseJSON (a ! 0) - <*> parseJSON (a ! 1) - <*> (Just <$> parseJSON (a ! 2)) - | otherwise = mzero - parseJSON _ = mzero - --- | Lists groups of addresses which have had their common ownership made --- public by common use as inputs or as the resulting change in past --- transactions. -listAddressGroupings :: Auth - -> IO (Vector (Vector AddressInfo)) -listAddressGroupings auth = - callApi auth "listaddressgroupings" [] - --- | A signature is a base-64 encoded string. -type Signature = HexString - --- | Sign a message with the private key of an address. -signMessage :: Auth - -> Address - -- ^ The address whose private key we'll use. - -> Text - -- ^ The message to sign. - -> IO Signature -signMessage auth addr msg = callApi auth "signmessage" [ tj addr, tj msg ] - --- | Verifies a signed message. -verifyMessage :: Auth - -> Address - -- ^ The address of the original signer. - -> Signature - -- ^ The message's signature. - -> Text - -- ^ The message. - -> IO Bool - -- ^ Was the signature valid? -verifyMessage auth addr sig msg = - callApi auth "verifymessage" [ tj addr, tj sig, tj msg ] - --- | Returns the total amount received by the given address with at least one --- confirmation. -getReceivedByAddress :: Auth -> Address -> IO BTC -getReceivedByAddress auth addr = - callApi auth "getreceivedbyaddress" [ tj addr ] - --- | Returns the total amount received by the given address, with at least the --- give number of confirmations. -getReceivedByAddress' :: Auth - -> Address - -> Int -- ^ The minimum number of confirmations needed - -- for a transaction to to count towards the - -- total. - -> IO BTC -getReceivedByAddress' auth addr minconf = - callApi auth "getreceivedbyaddress" [ tj addr, tj minconf ] - --- | Returns the total amount received by address with the given account. -getReceivedByAccount :: Auth -> Account -> IO BTC -getReceivedByAccount auth acc = - callApi auth "getreceivedbyaccount" [ tj acc ] - --- | Returns the total amount received by addresses with the given account, --- counting only transactions with the given minimum number of confirmations. -getReceivedByAccount' :: Auth - -> Account - -- ^ The account in question. - -> Int - -- ^ The minimum number of confirmations needed for a - -- transaction to count towards the total. - -> IO BTC -getReceivedByAccount' auth acc minconf = - callApi auth "getreceivedbyaccount" [ tj acc, tj minconf ] - --- | Returns the server's total available balance. -getBalance :: Auth - -> IO BTC -getBalance auth = - callApi auth "getbalance" [] - --- | Returns the balance in the given account, counting only transactions with --- at least one confirmation. -getBalance' :: Auth - -> Account - -> IO BTC -getBalance' auth acc = - callApi auth "getbalance" [ tj acc ] - --- | Returns the balance in the given account, counting only transactions with --- at least the given number of confirmations. -getBalance'' :: Auth - -> Account - -> Int - -- ^ The minimum number of confirmations needed for a transaction - -- to count towards the total. - -> IO BTC -getBalance'' auth acc minconf = - callApi auth "getbalance" [ tj acc, tj minconf ] - --- | Move bitcoins from one account in your wallet to another. --- --- If you want to send bitcoins to an address not in your wallet, use --- 'sendFromAccount'. -moveBitcoins :: Auth - -> Account -- ^ From. - -> Account -- ^ To. - -> BTC -- ^ The amount to transfer. - -> Text -- ^ A comment to record for the transaction. - -> IO () -moveBitcoins auth from to amt comm = - stupidAPI <$> callApi auth "move" [ tj from, tj to, tj amt, tj one, tj comm ] - where one = 1 :: Int -- needs a type, else default-integer warnings. - stupidAPI :: Bool -> () - stupidAPI = const () - --- | Sends bitcoins from a given account in our wallet to a given address. --- --- A transaction and sender comment may be optionally provided. -sendFromAccount :: Auth - -> Account - -- ^ The account to send from. - -> Address - -- ^ The address to send to. - -> BTC - -- ^ The amount to send. - -> Maybe Text - -- ^ An optional transaction comment. - -> Maybe Text - -- ^ An optional comment on who the money is going to. - -> IO TransactionID -sendFromAccount auth from to amount comm comm2 = - callApi auth "sendfrom" [ tj from, tj to, tj amount, tj one, tj comm, tj comm2 ] - where one = 1 :: Int -- needs a type, else default-integer warnings. - --- | Send to a whole bunch of address at once. -sendMany :: Auth - -> Account - -- ^ The account to send from. - -> Vector (Address, BTC) - -- ^ The address, and how much to send to each one. - -> Maybe Text - -- ^ An optional transaction comment. - -> IO TransactionID -sendMany auth acc amounts comm = - callApi auth "sendmany" [ tj acc, tj $ AA amounts, tj comm ] - --- TODO: createmultisig. --- --- I have no idea what this is doing. Patches adding this function are --- always welcome! - --- | Information on how much was received by a given address. -data ReceivedByAddress = - ReceivedByAddress { -- | The address which the money was deposited to. - recvAddress :: Address - -- | The account which this address belongs to. - , recvAccount :: Account - -- | The amount received. - , recvAmount :: BTC - -- | The number of confirmations of the most recent - -- included transaction. - , recvNumConfirmations :: Integer - } - deriving ( Show, Read, Ord, Eq ) - -instance FromJSON ReceivedByAddress where - parseJSON (Object o) = ReceivedByAddress <$> o .: "address" - <*> o .: "account" - <*> o .: "amount" - <*> o .: "confirmations" - parseJSON _ = mzero - --- | Lists the amount received by each address which has received money at some --- point, counting only transactions with at least one confirmation. -listReceivedByAddress :: Auth -> IO (Vector ReceivedByAddress) -listReceivedByAddress auth = listReceivedByAddress' auth 1 False - --- | List the amount received by each of our addresses, counting only --- transactions with the given minimum number of confirmations. -listReceivedByAddress' :: Auth - -> Int - -- ^ The minimum number of confirmations before a - -- transaction counts toward the total amount - -- received. - -> Bool - -- ^ Should we include addresses with no money - -- received? - -> IO (Vector ReceivedByAddress) -listReceivedByAddress' auth minconf includeEmpty = - callApi auth "listreceivedbyaddress" [ tj minconf, tj includeEmpty ] - -data ReceivedByAccount = - ReceivedByAccount { raccAccount :: Account - -- ^ The account we received into. - , raccAmount :: BTC - -- ^ The mount received. - -- ^ The number of confirmations of the most recent - -- included transaction. - , raccNumConfirmations :: Integer - } - deriving ( Show, Read, Ord, Eq ) - -instance FromJSON ReceivedByAccount where - parseJSON (Object o) = ReceivedByAccount <$> o .: "account" - <*> o .: "amount" - <*> o .: "confirmations" - parseJSON _ = mzero - --- | Lists the amount received by each account which has received money at some --- point, counting only transactions with at leaset one confirmation. -listReceivedByAccount :: Auth -> IO (Vector ReceivedByAccount) -listReceivedByAccount auth = listReceivedByAccount' auth 1 False - --- | List the amount received by each of our accounts, counting only --- transactions with the given minimum number of confirmations. -listReceivedByAccount' :: Auth - -> Int - -- ^ The minimum number of confirmations before a - -- transaction counts toward the total received. - -> Bool - -- ^ Should we include the accounts with no money - -- received? - -> IO (Vector ReceivedByAccount) -listReceivedByAccount' auth minconf includeEmpty = - callApi auth "listreceivedbyaccount" [ tj minconf, tj includeEmpty ] - - -data SinceBlock = - SinceBlock { transactions :: Vector SinceBlockTransaction - , lastBlockHash :: BlockHash - } - deriving ( Show, Read, Ord, Eq ) - -instance FromJSON SinceBlock where - parseJSON (Object o) = SinceBlock <$> o .: "transactions" - <*> o .: "lastblock" - parseJSON _ = mzero - -data SinceBlockTransaction = - SinceBlockTransaction { - -- | The account associated with the receiving address. - sbtReceivingAccount :: Account - -- | The receiving address of the transaction. - , sbtAddress :: Address - -- | The category of the transaction (As of 0.8.6 this field can be send,orphan,immature,generate,receive,move). - , sbtCategory :: Text - -- | The amount of bitcoins transferred. - , sbtAmountBitcoin :: BTC - -- | The number of confirmation of the transaction. - , sbtConfirmations :: Integer - -- | The hash of the block containing the transaction. - , sbtBlockHash :: BlockHash - , sbtBlockIndex :: Integer - , sbtBlockTime :: Double - , sbtTransactionId :: TransactionID - -- | The list of transaction ids containing the same data as the original transaction (See ID-malleation bug). - , sbtWalletConflicts :: Vector TransactionID - , sbtTime :: Integer - , sbtTimeReceived :: Integer - } - deriving ( Show, Read, Ord, Eq ) - -instance FromJSON SinceBlockTransaction where - parseJSON (Object o) = SinceBlockTransaction <$> o .: "account" - <*> o .: "address" - <*> o .: "category" - <*> o .: "amount" - <*> o .: "confirmations" - <*> o .: "blockhash" - <*> o .: "blockindex" - <*> o .: "blocktime" - <*> o .: "txid" - <*> o .: "walletconflicts" - <*> o .: "time" - <*> o .: "timereceived" - parseJSON _ = mzero - -listSinceBlock :: Auth - -> BlockHash - -> Maybe Int - -- ^ The minimum number of confirmations before a - -- transaction counts toward the total received. - -> IO (ListSinceBlockResult) -listSinceBlock auth blockHash (Just minConf) = - callApi auth "listsinceblock" [ tj blockHash, tj minConf ] -listSinceBlock auth blockHash _ = - callApi auth "listsinceblock" [ tj blockHash ] - --- TODO: listtransactions --- listaccounts --- gettransaction --- --- These functions are just way too complicated for me to write. --- Patches welcome! - --- | Safely copies wallet.dat to the given destination, which can be either a --- directory, or a path with filename. -backupWallet :: Auth - -> FilePath - -> IO () -backupWallet auth fp = - unNil <$> callApi auth "backupwallet" [ tj fp ] - --- | Fills the keypool. -keyPoolRefill :: Auth -> IO () -keyPoolRefill auth = unNil <$> callApi auth "keypoolrefill" [] - --- | Stores the wallet decryption key in memory for the given amount of time. -unlockWallet :: Auth - -> Text - -- ^ The decryption key. - -> Integer - -- ^ How long to store the key in memory (in seconds). - -> IO () -unlockWallet auth pass timeout = - unNil <$> callApi auth "walletpassphrase" [ tj pass, tj timeout ] - --- | Changes the wallet passphrase. -changePassword :: Auth - -> Text - -- ^ The old password. - -> Text - -- ^ The new password. - -> IO () -changePassword auth old new = - unNil <$> callApi auth "walletpassphrase" [ tj old, tj new ] - --- | Removes the wallet encryption key from memory, locking the wallet. --- --- After calling this function, you will need to call 'unlockWallet' again --- before being able to call methods which require the wallet to be unlocked. --- --- Note: In future releases, we might introduce an "unlocked" monad, so --- locking and unlocking is automatic. -lockWallet :: Auth -> IO () -lockWallet auth = unNil <$> callApi auth "walletlock" [] - --- | Encrypts the wallet with the given passphrase. --- --- WARNING: bitcoind will shut down after calling this method. Don't say I --- didn't warn you. -encryptWallet :: Auth -> Text -> IO () -encryptWallet auth pass = stupidAPI <$> callApi auth "encryptwallet" [ tj pass ] - where - stupidAPI :: Text -> () - stupidAPI = const () - --- | Just a handy wrapper to help us get only the "isvalid" field of the JSON. --- The structure is much too complicated for what it needs to do. -data IsValid = IsValid { getValid :: Bool } - -instance FromJSON IsValid where - parseJSON (Object o) = IsValid <$> o .: "isvalid" - parseJSON _ = mzero - --- | Checks if a given address is a valid one. -isAddressValid :: Auth -> Address -> IO Bool -isAddressValid auth addr = getValid <$> callApi auth "validateaddress" [ tj addr ] From ae9b93ff7067a0b8fbfb4023ce3f2e687be06442 Mon Sep 17 00:00:00 2001 From: Momemtum Mori Date: Sun, 27 Apr 2014 20:02:43 -0400 Subject: [PATCH 51/73] Added a type for SinceBlockTransaction's category, TransactionCategory. --- src/Network/Bitcoin.hs | 1 + src/Network/Bitcoin/Wallet.hs | 26 ++++++++++++++++++++++++-- 2 files changed, 25 insertions(+), 2 deletions(-) diff --git a/src/Network/Bitcoin.hs b/src/Network/Bitcoin.hs index 7f6b7a9..cc867e1 100644 --- a/src/Network/Bitcoin.hs +++ b/src/Network/Bitcoin.hs @@ -100,6 +100,7 @@ module Network.Bitcoin -- , listAccounts , SinceBlock(..) , SinceBlockTransaction(..) + , TransactionCategory(..) , listSinceBlock -- , getTransaction , backupWallet diff --git a/src/Network/Bitcoin/Wallet.hs b/src/Network/Bitcoin/Wallet.hs index 708001a..9e338e7 100644 --- a/src/Network/Bitcoin/Wallet.hs +++ b/src/Network/Bitcoin/Wallet.hs @@ -45,6 +45,7 @@ module Network.Bitcoin.Wallet ( Auth(..) -- , listAccounts , SinceBlock(..) , SinceBlockTransaction(..) + , TransactionCategory(..) , listSinceBlock -- , getTransaction , backupWallet @@ -421,11 +422,11 @@ instance FromJSON SinceBlock where data SinceBlockTransaction = SinceBlockTransaction { -- | The account associated with the receiving address. - sbtReceivingAccount :: Account + sbtReceivingAccount :: Account -- | The receiving address of the transaction. , sbtAddress :: Address -- | The category of the transaction (As of 0.8.6 this field can be send,orphan,immature,generate,receive,move). - , sbtCategory :: Text + , sbtCategory :: TransactionCategory -- | The amount of bitcoins transferred. , sbtAmountBitcoin :: BTC -- | The number of confirmation of the transaction. @@ -456,6 +457,27 @@ instance FromJSON SinceBlockTransaction where <*> o .: "time" <*> o .: "timereceived" parseJSON _ = mzero + +data TransactionCategory = TCSend + | TCOrphan + | TCImmature + | TCGenerate + | TCReceive + | TCMove + | TCErrorUnexpected Text + deriving ( Show, Read, Ord, Eq ) + +instance FromJSON TransactionCategory where + parseJSON (String s) = return $ createTC s + where createTC :: Text -> TransactionCategory + createTC "send" = TCSend + createTC "orphan" = TCOrphan + createTC "immature" = TCImmature + createTC "generate" = TCGenerate + createTC "receive" = TCReceive + createTC "move" = TCMove + createTC uc = TCErrorUnexpected uc + parseJSON _ = mzero listSinceBlock :: Auth -> BlockHash From 2eb40f731ce445cf4363b29c9413620d3ba3fda7 Mon Sep 17 00:00:00 2001 From: Clark Gaebel Date: Mon, 28 Apr 2014 08:34:19 -0400 Subject: [PATCH 52/73] version bump + release --- network-bitcoin.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/network-bitcoin.cabal b/network-bitcoin.cabal index 44eb7e2..1625275 100644 --- a/network-bitcoin.cabal +++ b/network-bitcoin.cabal @@ -1,5 +1,5 @@ Name: network-bitcoin -Version: 1.5.1 +Version: 1.5.2 Synopsis: An interface to bitcoind. Description: This can be used to send Bitcoins, query balances, etc. It From eb4e77fbc4182a5ea4b2bfb20bdd562e3557c93f Mon Sep 17 00:00:00 2001 From: Momemtum Mori Date: Mon, 28 Apr 2014 19:46:34 -0400 Subject: [PATCH 53/73] Added listTransactions (very experimental). Renamed SinceBlockTransaction to BlockTransaction since it is also used by listTransactions. --- src/Network/Bitcoin.hs | 4 +- src/Network/Bitcoin/Wallet.hs | 115 +++++++++++++++++++++++----------- 2 files changed, 80 insertions(+), 39 deletions(-) diff --git a/src/Network/Bitcoin.hs b/src/Network/Bitcoin.hs index cc867e1..571970c 100644 --- a/src/Network/Bitcoin.hs +++ b/src/Network/Bitcoin.hs @@ -96,10 +96,10 @@ module Network.Bitcoin , ReceivedByAccount(..) , listReceivedByAccount , listReceivedByAccount' - -- , listTransactions + , listTransactions -- , listAccounts , SinceBlock(..) - , SinceBlockTransaction(..) + , BlockTransaction(..) , TransactionCategory(..) , listSinceBlock -- , getTransaction diff --git a/src/Network/Bitcoin/Wallet.hs b/src/Network/Bitcoin/Wallet.hs index 9e338e7..b1c62d6 100644 --- a/src/Network/Bitcoin/Wallet.hs +++ b/src/Network/Bitcoin/Wallet.hs @@ -41,10 +41,10 @@ module Network.Bitcoin.Wallet ( Auth(..) , ReceivedByAccount(..) , listReceivedByAccount , listReceivedByAccount' - -- , listTransactions + , listTransactions -- , listAccounts , SinceBlock(..) - , SinceBlockTransaction(..) + , BlockTransaction(..) , TransactionCategory(..) , listSinceBlock -- , getTransaction @@ -409,8 +409,8 @@ listReceivedByAccount' auth minconf includeEmpty = data SinceBlock = - SinceBlock { transactions :: Vector SinceBlockTransaction - , lastBlockHash :: BlockHash + SinceBlock { sbTransactions :: [BlockTransaction] + , sbLastBlockHash :: BlockHash } deriving ( Show, Read, Ord, Eq ) @@ -419,43 +419,44 @@ instance FromJSON SinceBlock where <*> o .: "lastblock" parseJSON _ = mzero -data SinceBlockTransaction = - SinceBlockTransaction { +data BlockTransaction = + BlockTransaction { -- | The account associated with the receiving address. - sbtReceivingAccount :: Account + btReceivingAccount :: Account -- | The receiving address of the transaction. - , sbtAddress :: Address - -- | The category of the transaction (As of 0.8.6 this field can be send,orphan,immature,generate,receive,move). - , sbtCategory :: TransactionCategory + , btAddress :: Address + -- | The category of the transaction + , btCategory :: TransactionCategory -- | The amount of bitcoins transferred. - , sbtAmountBitcoin :: BTC + , btAmountBitcoin :: BTC -- | The number of confirmation of the transaction. - , sbtConfirmations :: Integer + , btConfirmations :: Integer -- | The hash of the block containing the transaction. - , sbtBlockHash :: BlockHash - , sbtBlockIndex :: Integer - , sbtBlockTime :: Double - , sbtTransactionId :: TransactionID - -- | The list of transaction ids containing the same data as the original transaction (See ID-malleation bug). - , sbtWalletConflicts :: Vector TransactionID - , sbtTime :: Integer - , sbtTimeReceived :: Integer + , btBlockHash :: BlockHash + , btBlockIndex :: Integer + , btBlockTime :: Double + , btTransactionId :: TransactionID + -- | The list of transaction ids containing the same data as the + -- original transaction (See ID-malleation bug). + , btWalletConflicts :: Vector TransactionID + , btTime :: Integer + , btTimeReceived :: Integer } deriving ( Show, Read, Ord, Eq ) -instance FromJSON SinceBlockTransaction where - parseJSON (Object o) = SinceBlockTransaction <$> o .: "account" - <*> o .: "address" - <*> o .: "category" - <*> o .: "amount" - <*> o .: "confirmations" - <*> o .: "blockhash" - <*> o .: "blockindex" - <*> o .: "blocktime" - <*> o .: "txid" - <*> o .: "walletconflicts" - <*> o .: "time" - <*> o .: "timereceived" +instance FromJSON BlockTransaction where + parseJSON (Object o) = BlockTransaction <$> o .: "account" + <*> o .: "address" + <*> o .: "category" + <*> o .: "amount" + <*> o .: "confirmations" + <*> o .: "blockhash" + <*> o .: "blockindex" + <*> o .: "blocktime" + <*> o .: "txid" + <*> o .: "walletconflicts" + <*> o .: "time" + <*> o .: "timereceived" parseJSON _ = mzero data TransactionCategory = TCSend @@ -478,17 +479,57 @@ instance FromJSON TransactionCategory where createTC "move" = TCMove createTC uc = TCErrorUnexpected uc parseJSON _ = mzero - + +-- | Gets all transactions in blocks since the given block. listSinceBlock :: Auth -> BlockHash + -- ^ The hash of the first block to list. -> Maybe Int -- ^ The minimum number of confirmations before a - -- transaction counts toward the total received. + -- transaction can be returned as 'sbLastBlockHash'. This does + -- not in any way affect which transactions are returned + -- (see https://github.com/bitcoin/bitcoin/pull/199#issuecomment-1514952) -> IO (SinceBlock) -listSinceBlock auth blockHash (Just minConf) = +listSinceBlock auth blockHash conf = + listSinceBlock' auth (Just blockHash) conf + +-- | Gets all transactions in blocks since the given block, or all +-- transactions if ommited. +listSinceBlock' :: Auth + -> Maybe BlockHash + -- ^ The hash of the first block to list. + -> Maybe Int + -- ^ The minimum number of confirmations before a + -- transaction can be returned as 'sbLastBlockHash'. This does + -- not in any way affect which transactions are returned + -- (see https://github.com/bitcoin/bitcoin/pull/199#issuecomment-1514952) + -> IO (SinceBlock) +listSinceBlock' auth (Just blockHash) (Just minConf) = callApi auth "listsinceblock" [ tj blockHash, tj minConf ] -listSinceBlock auth blockHash _ = +listSinceBlock' auth (Just blockHash) _ = callApi auth "listsinceblock" [ tj blockHash ] +listSinceBlock' auth _ _ = + callApi auth "listsinceblock" [] + + +-- | Returns transactions from the blockchain. +listTransactions :: Auth + -> Maybe Account + -- ^ Limits the 'BlockTransaction' returned to those from or to + -- the given 'Account'. If 'Nothing' all accounts are + -- included in the query. + -> Maybe Int + -- ^ Limits the number of 'BlockTransaction' returned. If + -- 'Nothing' all transactions are returned. + -> Maybe Int + -- ^ Number of most recent transactions to skip. + -> IO (Vector BlockTransaction) +listTransactions auth maccount mcount mfrom = do + callApi auth "listtransactions" $ [] ||| maccount ||| mcount ||| mfrom + +-- Takes a list of 'Value' and a 'Maybe a' which is passed to 'maybe', converted using toJSON and finally appended to the list. If 'Nothing', +(|||) :: ToJSON a => [Value] -> Maybe a -> [Value] +params ||| mparam = maybe [] (\param -> params Prelude.++ [toJSON param]) mparam -- TODO: listtransactions -- listaccounts From c317f02f7abeff98967c4bf389d4106fd05e4d44 Mon Sep 17 00:00:00 2001 From: Momemtum Mori Date: Tue, 29 Apr 2014 13:21:20 -0400 Subject: [PATCH 54/73] Added listAccounts. --- src/Network/Bitcoin.hs | 4 +- src/Network/Bitcoin/Wallet.hs | 120 ++++++++++++++++++++++++---------- 2 files changed, 87 insertions(+), 37 deletions(-) diff --git a/src/Network/Bitcoin.hs b/src/Network/Bitcoin.hs index 571970c..2a744a5 100644 --- a/src/Network/Bitcoin.hs +++ b/src/Network/Bitcoin.hs @@ -97,11 +97,13 @@ module Network.Bitcoin , listReceivedByAccount , listReceivedByAccount' , listTransactions - -- , listAccounts + , listTransactions' + , listAccounts , SinceBlock(..) , BlockTransaction(..) , TransactionCategory(..) , listSinceBlock + , listSinceBlock' -- , getTransaction , backupWallet , keyPoolRefill diff --git a/src/Network/Bitcoin/Wallet.hs b/src/Network/Bitcoin/Wallet.hs index b1c62d6..a897cfa 100644 --- a/src/Network/Bitcoin/Wallet.hs +++ b/src/Network/Bitcoin/Wallet.hs @@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE FlexibleInstances #-} {-# OPTIONS_GHC -Wall #-} -- | An interface to bitcoind's available wallet-related RPC calls. -- The implementation of these functions can be found at @@ -42,11 +43,13 @@ module Network.Bitcoin.Wallet ( Auth(..) , listReceivedByAccount , listReceivedByAccount' , listTransactions - -- , listAccounts + , listTransactions' + , listAccounts , SinceBlock(..) , BlockTransaction(..) , TransactionCategory(..) , listSinceBlock + , listSinceBlock' -- , getTransaction , backupWallet , keyPoolRefill @@ -60,6 +63,8 @@ module Network.Bitcoin.Wallet ( Auth(..) import Control.Applicative import Control.Monad import Data.Aeson as A +import Data.Aeson.Types (Parser) +import qualified Data.HashMap.Lazy as HM import Data.Maybe import Data.Vector as V import Network.Bitcoin.Internal @@ -421,42 +426,54 @@ instance FromJSON SinceBlock where data BlockTransaction = BlockTransaction { - -- | The account associated with the receiving address. + -- | The receiving account of the transaction. btReceivingAccount :: Account - -- | The receiving address of the transaction. - , btAddress :: Address + -- | The receiving address of the transaction (Can be ommited, for + -- instance when a move is performed). + , btAddress :: Maybe Address -- | The category of the transaction , btCategory :: TransactionCategory + -- | The fees paid to process the transaction. + , btFee :: Maybe BTC -- | The amount of bitcoins transferred. , btAmountBitcoin :: BTC -- | The number of confirmation of the transaction. - , btConfirmations :: Integer + , btConfirmations :: Maybe Integer -- | The hash of the block containing the transaction. - , btBlockHash :: BlockHash - , btBlockIndex :: Integer - , btBlockTime :: Double - , btTransactionId :: TransactionID + , btGenerated :: Maybe Bool + , btBlockHash :: Maybe BlockHash + , btBlockIndex :: Maybe Integer + , btBlockTime :: Maybe Double + , btTransactionId :: Maybe TransactionID -- | The list of transaction ids containing the same data as the -- original transaction (See ID-malleation bug). - , btWalletConflicts :: Vector TransactionID + , btWalletConflicts :: Maybe (Vector TransactionID) , btTime :: Integer - , btTimeReceived :: Integer + -- | Set when performing a move to indicate which other account was + -- included in the transaction. + , btOtherAccount :: Maybe Account + , btComment :: Maybe Text + , btTimeReceived :: Maybe Integer } deriving ( Show, Read, Ord, Eq ) instance FromJSON BlockTransaction where parseJSON (Object o) = BlockTransaction <$> o .: "account" - <*> o .: "address" + <*> o .:? "address" <*> o .: "category" + <*> o .:? "fee" <*> o .: "amount" - <*> o .: "confirmations" - <*> o .: "blockhash" - <*> o .: "blockindex" - <*> o .: "blocktime" - <*> o .: "txid" - <*> o .: "walletconflicts" + <*> o .:? "confirmations" + <*> o .:? "generated" + <*> o .:? "blockhash" + <*> o .:? "blockindex" + <*> o .:? "blocktime" + <*> o .:? "txid" + <*> o .:? "walletconflicts" <*> o .: "time" - <*> o .: "timereceived" + <*> o .:? "otheraccount" + <*> o .:? "comment" + <*> o .:? "timereceived" parseJSON _ = mzero data TransactionCategory = TCSend @@ -511,29 +528,60 @@ listSinceBlock' auth (Just blockHash) _ = listSinceBlock' auth _ _ = callApi auth "listsinceblock" [] - + -- | Returns transactions from the blockchain. listTransactions :: Auth - -> Maybe Account + -> Account -- ^ Limits the 'BlockTransaction' returned to those from or to - -- the given 'Account'. If 'Nothing' all accounts are - -- included in the query. - -> Maybe Int - -- ^ Limits the number of 'BlockTransaction' returned. If - -- 'Nothing' all transactions are returned. - -> Maybe Int + -- the given 'Account'. + -> Int + -- ^ Limits the number of 'BlockTransaction' returned. + -> Int -- ^ Number of most recent transactions to skip. -> IO (Vector BlockTransaction) -listTransactions auth maccount mcount mfrom = do - callApi auth "listtransactions" $ [] ||| maccount ||| mcount ||| mfrom - --- Takes a list of 'Value' and a 'Maybe a' which is passed to 'maybe', converted using toJSON and finally appended to the list. If 'Nothing', -(|||) :: ToJSON a => [Value] -> Maybe a -> [Value] -params ||| mparam = maybe [] (\param -> params Prelude.++ [toJSON param]) mparam +listTransactions auth account count from = + listTransactions' auth (Just account) (Just count) (Just from) + +-- | Returns transactions from the blockchain. +listTransactions' :: Auth + -> Maybe Account + -- ^ Limits the 'BlockTransaction' returned to those from or to + -- the given 'Account'. If 'Nothing' all accounts are + -- included in the query. + -> Maybe Int + -- ^ Limits the number of 'BlockTransaction' returned. If + -- 'Nothing' all transactions are returned. + -> Maybe Int + -- ^ Number of most recent transactions to skip. + -> IO (Vector BlockTransaction) +listTransactions' auth maccount mcount mfrom = + callApi auth "listtransactions" [ + tj $ fromMaybe "*" maccount + , tj $ fromMaybe 10 mcount + , tj $ fromMaybe 0 mfrom + ] + + +instance FromJSON (Vector (Account, BTC)) where + parseJSON (Object o) = toAccountBalance $ V.fromList $ HM.toList o + where toAccountBalance :: Vector (Text, Value) -> Parser (Vector (Account, BTC)) + toAccountBalance kps = V.mapM (magic) kps + magic :: (Text, Value) -> Parser (Account, BTC) + magic (acc, v) = do + bal <- (parseJSON :: Value -> Parser BTC) v + return (acc, bal) + parseJSON _ = mzero + +-- | List accounts and their current balance. +listAccounts :: Auth + -> Maybe Int + -- ^ Minimum number of confirmations required before payments are + -- included in the balance. + -> IO (Vector (Account, BTC)) +listAccounts auth mconf = + callApi auth "listaccounts" [ tj $ fromMaybe 1 mconf ] --- TODO: listtransactions --- listaccounts --- gettransaction +-- TODO: gettransaction -- -- These functions are just way too complicated for me to write. -- Patches welcome! From c712cabbb91673e4406970f1495ecd727ff1b0f8 Mon Sep 17 00:00:00 2001 From: Momemtum Mori Date: Tue, 29 Apr 2014 14:37:29 -0400 Subject: [PATCH 55/73] Refactor of Transactions in Wallet. Added listAccounts and listTransactions. --- src/Network/Bitcoin.hs | 2 +- src/Network/Bitcoin/Wallet.hs | 117 ++++++++++++++++++++-------------- 2 files changed, 69 insertions(+), 50 deletions(-) diff --git a/src/Network/Bitcoin.hs b/src/Network/Bitcoin.hs index 2a744a5..ed78f9d 100644 --- a/src/Network/Bitcoin.hs +++ b/src/Network/Bitcoin.hs @@ -100,7 +100,7 @@ module Network.Bitcoin , listTransactions' , listAccounts , SinceBlock(..) - , BlockTransaction(..) + , SimpleTransaction(..) , TransactionCategory(..) , listSinceBlock , listSinceBlock' diff --git a/src/Network/Bitcoin/Wallet.hs b/src/Network/Bitcoin/Wallet.hs index a897cfa..4b89ecf 100644 --- a/src/Network/Bitcoin/Wallet.hs +++ b/src/Network/Bitcoin/Wallet.hs @@ -46,7 +46,7 @@ module Network.Bitcoin.Wallet ( Auth(..) , listTransactions' , listAccounts , SinceBlock(..) - , BlockTransaction(..) + , SimpleTransaction(..) , TransactionCategory(..) , listSinceBlock , listSinceBlock' @@ -414,7 +414,7 @@ listReceivedByAccount' auth minconf includeEmpty = data SinceBlock = - SinceBlock { sbTransactions :: [BlockTransaction] + SinceBlock { strransactions :: Vector SimpleTransaction , sbLastBlockHash :: BlockHash } deriving ( Show, Read, Ord, Eq ) @@ -424,58 +424,77 @@ instance FromJSON SinceBlock where <*> o .: "lastblock" parseJSON _ = mzero -data BlockTransaction = - BlockTransaction { - -- | The receiving account of the transaction. - btReceivingAccount :: Account - -- | The receiving address of the transaction (Can be ommited, for - -- instance when a move is performed). - , btAddress :: Maybe Address +-- | Data type for simple transactions. Rules involving 'trCategory' are +-- indications of the most probable value only when the transaction is +-- obtained from 'listTransactions' or 'listSinceBlock' are their associated +-- methods. +data SimpleTransaction = + SimpleTransaction { + -- | The account name associated with the transaction. The empty string + -- is the default account. + trReceivingAccount :: Account + -- | The bitcoin address of the transaction. Is 'Nothing' unless + -- 'trCategory' is 'TCSend' or 'TCReceive'. + , trAddress :: Maybe Address -- | The category of the transaction - , btCategory :: TransactionCategory - -- | The fees paid to process the transaction. - , btFee :: Maybe BTC + , trCategory :: TransactionCategory + -- | The fees paid to process the transaction. Is 'Nothing' unless + -- 'trCategory' is 'TCSend' or 'TCReceive'. + , trFee :: Maybe BTC -- | The amount of bitcoins transferred. - , btAmountBitcoin :: BTC - -- | The number of confirmation of the transaction. - , btConfirmations :: Maybe Integer - -- | The hash of the block containing the transaction. - , btGenerated :: Maybe Bool - , btBlockHash :: Maybe BlockHash - , btBlockIndex :: Maybe Integer - , btBlockTime :: Maybe Double - , btTransactionId :: Maybe TransactionID + , trAmount :: BTC + -- | The number of confirmations of the transaction. Is 'Nothing' unless + -- 'trCategory' is 'TCSend' or 'TCReceive'. + , trConfirmations :: Maybe Integer + -- | The hash of the block containing the transaction. Is 'Nothing' + -- unless 'trCategory' is 'TCSend' or 'TCReceive'. + , trBlockHash :: Maybe BlockHash + -- | The index of the the block containing the transaction. Is 'Nothing' + -- unless 'trCategory' is 'TCSend' or 'TCReceive'. + , trBlockIndex :: Maybe Integer + -- | The block time in seconds since epoch (1 Jan 1970 GMT). Is + -- 'Nothing' unless 'trCategory' is 'TCSend' or 'TCReceive'. + , trBlockTime :: Maybe Integer + -- | The transaction id. Is 'Nothing' unless + -- 'trCategory' is 'TCSend' or 'TCReceive'. + , trTransactionId :: Maybe TransactionID -- | The list of transaction ids containing the same data as the - -- original transaction (See ID-malleation bug). - , btWalletConflicts :: Maybe (Vector TransactionID) - , btTime :: Integer - -- | Set when performing a move to indicate which other account was - -- included in the transaction. - , btOtherAccount :: Maybe Account - , btComment :: Maybe Text - , btTimeReceived :: Maybe Integer + -- original transaction (See ID-malleation bug). Is 'Nothing' unless + -- 'trCategory' is 'TCSend' or 'TCReceive'. + , trWalletConflicts :: Maybe (Vector TransactionID) + -- | The block time in seconds since epoch (1 Jan 1970 GMT). + , trTime :: Integer + , trTimeReceived :: Maybe Integer + -- | Is 'Nothing' unless a comment is associated with the transaction. + , trComment :: Maybe Text + -- | Is 'Nothing' unless a \"to\" is associated with the transaction. + , trTo :: Maybe Text + -- | The account the funds came from (for receiving funds, positive + -- amounts), or went to (for sending funds, negative amounts). Is + -- 'Nothing' unless 'trCategory' is 'TCMove'. + , trOtherAccount :: Maybe Account } deriving ( Show, Read, Ord, Eq ) -instance FromJSON BlockTransaction where - parseJSON (Object o) = BlockTransaction <$> o .: "account" - <*> o .:? "address" - <*> o .: "category" - <*> o .:? "fee" - <*> o .: "amount" - <*> o .:? "confirmations" - <*> o .:? "generated" - <*> o .:? "blockhash" - <*> o .:? "blockindex" - <*> o .:? "blocktime" - <*> o .:? "txid" - <*> o .:? "walletconflicts" - <*> o .: "time" - <*> o .:? "otheraccount" - <*> o .:? "comment" - <*> o .:? "timereceived" +instance FromJSON SimpleTransaction where + parseJSON (Object o) = SimpleTransaction <$> o .: "account" + <*> o .:? "address" + <*> o .: "category" + <*> o .:? "fee" + <*> o .: "amount" + <*> o .:? "confirmations" + <*> o .:? "blockhash" + <*> o .:? "blockindex" + <*> o .:? "blocktime" + <*> o .:? "txid" + <*> o .:? "walletconflicts" + <*> o .: "time" + <*> o .:? "timereceived" + <*> o .:? "comment" + <*> o .:? "to" + <*> o .:? "otheraccount" parseJSON _ = mzero - + data TransactionCategory = TCSend | TCOrphan | TCImmature @@ -538,7 +557,7 @@ listTransactions :: Auth -- ^ Limits the number of 'BlockTransaction' returned. -> Int -- ^ Number of most recent transactions to skip. - -> IO (Vector BlockTransaction) + -> IO (Vector SimpleTransaction) listTransactions auth account count from = listTransactions' auth (Just account) (Just count) (Just from) @@ -553,7 +572,7 @@ listTransactions' :: Auth -- 'Nothing' all transactions are returned. -> Maybe Int -- ^ Number of most recent transactions to skip. - -> IO (Vector BlockTransaction) + -> IO (Vector SimpleTransaction) listTransactions' auth maccount mcount mfrom = callApi auth "listtransactions" [ tj $ fromMaybe "*" maccount From 1ae04525179109a1836fbed6902c990cc9b51d19 Mon Sep 17 00:00:00 2001 From: Momemtum Mori Date: Tue, 29 Apr 2014 14:37:29 -0400 Subject: [PATCH 56/73] Refactor of Transactions in Wallet. Polished listAccounts and listTransactions. --- src/Network/Bitcoin.hs | 2 +- src/Network/Bitcoin/Wallet.hs | 117 ++++++++++++++++++++-------------- 2 files changed, 69 insertions(+), 50 deletions(-) diff --git a/src/Network/Bitcoin.hs b/src/Network/Bitcoin.hs index 2a744a5..ed78f9d 100644 --- a/src/Network/Bitcoin.hs +++ b/src/Network/Bitcoin.hs @@ -100,7 +100,7 @@ module Network.Bitcoin , listTransactions' , listAccounts , SinceBlock(..) - , BlockTransaction(..) + , SimpleTransaction(..) , TransactionCategory(..) , listSinceBlock , listSinceBlock' diff --git a/src/Network/Bitcoin/Wallet.hs b/src/Network/Bitcoin/Wallet.hs index a897cfa..4b89ecf 100644 --- a/src/Network/Bitcoin/Wallet.hs +++ b/src/Network/Bitcoin/Wallet.hs @@ -46,7 +46,7 @@ module Network.Bitcoin.Wallet ( Auth(..) , listTransactions' , listAccounts , SinceBlock(..) - , BlockTransaction(..) + , SimpleTransaction(..) , TransactionCategory(..) , listSinceBlock , listSinceBlock' @@ -414,7 +414,7 @@ listReceivedByAccount' auth minconf includeEmpty = data SinceBlock = - SinceBlock { sbTransactions :: [BlockTransaction] + SinceBlock { strransactions :: Vector SimpleTransaction , sbLastBlockHash :: BlockHash } deriving ( Show, Read, Ord, Eq ) @@ -424,58 +424,77 @@ instance FromJSON SinceBlock where <*> o .: "lastblock" parseJSON _ = mzero -data BlockTransaction = - BlockTransaction { - -- | The receiving account of the transaction. - btReceivingAccount :: Account - -- | The receiving address of the transaction (Can be ommited, for - -- instance when a move is performed). - , btAddress :: Maybe Address +-- | Data type for simple transactions. Rules involving 'trCategory' are +-- indications of the most probable value only when the transaction is +-- obtained from 'listTransactions' or 'listSinceBlock' are their associated +-- methods. +data SimpleTransaction = + SimpleTransaction { + -- | The account name associated with the transaction. The empty string + -- is the default account. + trReceivingAccount :: Account + -- | The bitcoin address of the transaction. Is 'Nothing' unless + -- 'trCategory' is 'TCSend' or 'TCReceive'. + , trAddress :: Maybe Address -- | The category of the transaction - , btCategory :: TransactionCategory - -- | The fees paid to process the transaction. - , btFee :: Maybe BTC + , trCategory :: TransactionCategory + -- | The fees paid to process the transaction. Is 'Nothing' unless + -- 'trCategory' is 'TCSend' or 'TCReceive'. + , trFee :: Maybe BTC -- | The amount of bitcoins transferred. - , btAmountBitcoin :: BTC - -- | The number of confirmation of the transaction. - , btConfirmations :: Maybe Integer - -- | The hash of the block containing the transaction. - , btGenerated :: Maybe Bool - , btBlockHash :: Maybe BlockHash - , btBlockIndex :: Maybe Integer - , btBlockTime :: Maybe Double - , btTransactionId :: Maybe TransactionID + , trAmount :: BTC + -- | The number of confirmations of the transaction. Is 'Nothing' unless + -- 'trCategory' is 'TCSend' or 'TCReceive'. + , trConfirmations :: Maybe Integer + -- | The hash of the block containing the transaction. Is 'Nothing' + -- unless 'trCategory' is 'TCSend' or 'TCReceive'. + , trBlockHash :: Maybe BlockHash + -- | The index of the the block containing the transaction. Is 'Nothing' + -- unless 'trCategory' is 'TCSend' or 'TCReceive'. + , trBlockIndex :: Maybe Integer + -- | The block time in seconds since epoch (1 Jan 1970 GMT). Is + -- 'Nothing' unless 'trCategory' is 'TCSend' or 'TCReceive'. + , trBlockTime :: Maybe Integer + -- | The transaction id. Is 'Nothing' unless + -- 'trCategory' is 'TCSend' or 'TCReceive'. + , trTransactionId :: Maybe TransactionID -- | The list of transaction ids containing the same data as the - -- original transaction (See ID-malleation bug). - , btWalletConflicts :: Maybe (Vector TransactionID) - , btTime :: Integer - -- | Set when performing a move to indicate which other account was - -- included in the transaction. - , btOtherAccount :: Maybe Account - , btComment :: Maybe Text - , btTimeReceived :: Maybe Integer + -- original transaction (See ID-malleation bug). Is 'Nothing' unless + -- 'trCategory' is 'TCSend' or 'TCReceive'. + , trWalletConflicts :: Maybe (Vector TransactionID) + -- | The block time in seconds since epoch (1 Jan 1970 GMT). + , trTime :: Integer + , trTimeReceived :: Maybe Integer + -- | Is 'Nothing' unless a comment is associated with the transaction. + , trComment :: Maybe Text + -- | Is 'Nothing' unless a \"to\" is associated with the transaction. + , trTo :: Maybe Text + -- | The account the funds came from (for receiving funds, positive + -- amounts), or went to (for sending funds, negative amounts). Is + -- 'Nothing' unless 'trCategory' is 'TCMove'. + , trOtherAccount :: Maybe Account } deriving ( Show, Read, Ord, Eq ) -instance FromJSON BlockTransaction where - parseJSON (Object o) = BlockTransaction <$> o .: "account" - <*> o .:? "address" - <*> o .: "category" - <*> o .:? "fee" - <*> o .: "amount" - <*> o .:? "confirmations" - <*> o .:? "generated" - <*> o .:? "blockhash" - <*> o .:? "blockindex" - <*> o .:? "blocktime" - <*> o .:? "txid" - <*> o .:? "walletconflicts" - <*> o .: "time" - <*> o .:? "otheraccount" - <*> o .:? "comment" - <*> o .:? "timereceived" +instance FromJSON SimpleTransaction where + parseJSON (Object o) = SimpleTransaction <$> o .: "account" + <*> o .:? "address" + <*> o .: "category" + <*> o .:? "fee" + <*> o .: "amount" + <*> o .:? "confirmations" + <*> o .:? "blockhash" + <*> o .:? "blockindex" + <*> o .:? "blocktime" + <*> o .:? "txid" + <*> o .:? "walletconflicts" + <*> o .: "time" + <*> o .:? "timereceived" + <*> o .:? "comment" + <*> o .:? "to" + <*> o .:? "otheraccount" parseJSON _ = mzero - + data TransactionCategory = TCSend | TCOrphan | TCImmature @@ -538,7 +557,7 @@ listTransactions :: Auth -- ^ Limits the number of 'BlockTransaction' returned. -> Int -- ^ Number of most recent transactions to skip. - -> IO (Vector BlockTransaction) + -> IO (Vector SimpleTransaction) listTransactions auth account count from = listTransactions' auth (Just account) (Just count) (Just from) @@ -553,7 +572,7 @@ listTransactions' :: Auth -- 'Nothing' all transactions are returned. -> Maybe Int -- ^ Number of most recent transactions to skip. - -> IO (Vector BlockTransaction) + -> IO (Vector SimpleTransaction) listTransactions' auth maccount mcount mfrom = callApi auth "listtransactions" [ tj $ fromMaybe "*" maccount From 448f298d3692678893cdeb0670292f74f1ccc023 Mon Sep 17 00:00:00 2001 From: Momemtum Mori Date: Wed, 30 Apr 2014 21:47:23 -0400 Subject: [PATCH 57/73] Added getTransaction. --- src/Network/Bitcoin.hs | 4 +- src/Network/Bitcoin/Wallet.hs | 92 ++++++++++++++++++++++++++++++++--- 2 files changed, 87 insertions(+), 9 deletions(-) diff --git a/src/Network/Bitcoin.hs b/src/Network/Bitcoin.hs index ed78f9d..eddb2a7 100644 --- a/src/Network/Bitcoin.hs +++ b/src/Network/Bitcoin.hs @@ -104,7 +104,9 @@ module Network.Bitcoin , TransactionCategory(..) , listSinceBlock , listSinceBlock' - -- , getTransaction + , DetailedTransaction(..) + , DetailedTransactionDetails(..) + , getTransaction , backupWallet , keyPoolRefill , unlockWallet diff --git a/src/Network/Bitcoin/Wallet.hs b/src/Network/Bitcoin/Wallet.hs index 4b89ecf..05dd49a 100644 --- a/src/Network/Bitcoin/Wallet.hs +++ b/src/Network/Bitcoin/Wallet.hs @@ -50,7 +50,9 @@ module Network.Bitcoin.Wallet ( Auth(..) , TransactionCategory(..) , listSinceBlock , listSinceBlock' - -- , getTransaction + , DetailedTransaction(..) + , DetailedTransactionDetails(..) + , getTransaction , backupWallet , keyPoolRefill , unlockWallet @@ -67,8 +69,9 @@ import Data.Aeson.Types (Parser) import qualified Data.HashMap.Lazy as HM import Data.Maybe import Data.Vector as V -import Network.Bitcoin.Internal import Network.Bitcoin.BlockChain (BlockHash) +import Network.Bitcoin.Internal +import Network.Bitcoin.RawTransaction (RawTransaction) -- | A plethora of information about a bitcoind instance. data BitcoindInfo = @@ -424,10 +427,10 @@ instance FromJSON SinceBlock where <*> o .: "lastblock" parseJSON _ = mzero --- | Data type for simple transactions. Rules involving 'trCategory' are +-- | Data type for simple transactions. Rules involving 'Maybe' are -- indications of the most probable value only when the transaction is -- obtained from 'listTransactions' or 'listSinceBlock' are their associated --- methods. +-- methods. They are never enforced on this side. data SimpleTransaction = SimpleTransaction { -- | The account name associated with the transaction. The empty string @@ -600,10 +603,83 @@ listAccounts :: Auth listAccounts auth mconf = callApi auth "listaccounts" [ tj $ fromMaybe 1 mconf ] --- TODO: gettransaction --- --- These functions are just way too complicated for me to write. --- Patches welcome! + +-- | Data type for detailed transactions. Rules involving 'trCategory' are +-- indications of the most probable value only when the transaction is +-- obtained from 'listTransactions' or 'listSinceBlock' are their associated +-- methods. +data DetailedTransaction = + DetailedTransaction { + -- | The amount of bitcoins transferred. + dtrAmount :: BTC + -- | The fees paid to process the transaction. Is 'Nothing' unless + -- 'trCategory' is 'TCSend' or 'TCReceive'. + , dtrFee :: Maybe BTC + -- | The number of confirmations of the transaction. Is 'Nothing' unless + -- 'trCategory' is 'TCSend' or 'TCReceive'. + , dtrConfirmations :: Maybe Integer + -- | The transaction id. Is 'Nothing' unless + -- 'trCategory' is 'TCSend' or 'TCReceive'. + , dtrTransactionId :: Maybe TransactionID + -- | The list of transaction ids containing the same data as the + -- original transaction (See ID-malleation bug). Is 'Nothing' unless + -- 'trCategory' is 'TCSend' or 'TCReceive'. + , dtrWalletConflicts :: Maybe (Vector TransactionID) + -- | The block time in seconds since epoch (1 Jan 1970 GMT). + , dtrTime :: Integer + , dtrTimeReceived :: Maybe Integer + -- | Is 'Nothing' unless a comment is associated with the transaction. + , dtrComment :: Maybe Text + -- | Is 'Nothing' unless a \"to\" is associated with the transaction. + , dtrTo :: Maybe Text + -- | The details of the transaction. + , dtrDetails :: Vector DetailedTransactionDetails + -- | Raw data for the transaction. + , dtrHex :: RawTransaction + } + deriving ( Show, Read, Ord, Eq ) + +instance FromJSON DetailedTransaction where + parseJSON (Object o) = DetailedTransaction <$> o .: "amount" + <*> o .:? "fee" + <*> o .: "confirmations" + <*> o .:? "txid" + <*> o .:? "walletconflicts" + <*> o .: "time" + <*> o .:? "timereceived" + <*> o .:? "comment" + <*> o .:? "to" + <*> o .: "details" + <*> o .: "hex" + parseJSON _ = mzero + +data DetailedTransactionDetails = + DetailedTransactionDetails { + -- | The account name associated with the transaction. The empty string + -- is the default account. + dtrdReceivingAccount :: Account + -- | The bitcoin address of the transaction. + , dtrdAddress :: Address + -- | The category of the transaction + , dtrdCategory :: TransactionCategory + -- | The amount of bitcoins transferred. + , dtrdAmount :: BTC + } + deriving ( Show, Read, Ord, Eq ) + +instance FromJSON DetailedTransactionDetails where + parseJSON (Object o) = DetailedTransactionDetails <$> o .: "account" + <*> o .: "address" + <*> o .: "category" + <*> o .: "amount" + parseJSON _ = mzero + +getTransaction :: Auth + -> TransactionID + -> IO (DetailedTransaction) +getTransaction auth txid = + callApi auth "gettransaction" [ tj txid ] + -- | Safely copies wallet.dat to the given destination, which can be either a -- directory, or a path with filename. From 93c08501c21a34b0015c913eccb656d69a8552b1 Mon Sep 17 00:00:00 2001 From: Momemtum Mori Date: Wed, 30 Apr 2014 21:51:49 -0400 Subject: [PATCH 58/73] Fixed naming to improve consistency. --- src/Network/Bitcoin/Wallet.hs | 62 +++++++++++++++++------------------ 1 file changed, 31 insertions(+), 31 deletions(-) diff --git a/src/Network/Bitcoin/Wallet.hs b/src/Network/Bitcoin/Wallet.hs index 05dd49a..abc9084 100644 --- a/src/Network/Bitcoin/Wallet.hs +++ b/src/Network/Bitcoin/Wallet.hs @@ -435,47 +435,47 @@ data SimpleTransaction = SimpleTransaction { -- | The account name associated with the transaction. The empty string -- is the default account. - trReceivingAccount :: Account + stReceivingAccount :: Account -- | The bitcoin address of the transaction. Is 'Nothing' unless -- 'trCategory' is 'TCSend' or 'TCReceive'. - , trAddress :: Maybe Address + , stAddress :: Maybe Address -- | The category of the transaction - , trCategory :: TransactionCategory + , stCategory :: TransactionCategory -- | The fees paid to process the transaction. Is 'Nothing' unless -- 'trCategory' is 'TCSend' or 'TCReceive'. - , trFee :: Maybe BTC + , stFee :: Maybe BTC -- | The amount of bitcoins transferred. - , trAmount :: BTC + , stAmount :: BTC -- | The number of confirmations of the transaction. Is 'Nothing' unless -- 'trCategory' is 'TCSend' or 'TCReceive'. - , trConfirmations :: Maybe Integer + , stConfirmations :: Maybe Integer -- | The hash of the block containing the transaction. Is 'Nothing' -- unless 'trCategory' is 'TCSend' or 'TCReceive'. - , trBlockHash :: Maybe BlockHash + , stBlockHash :: Maybe BlockHash -- | The index of the the block containing the transaction. Is 'Nothing' -- unless 'trCategory' is 'TCSend' or 'TCReceive'. - , trBlockIndex :: Maybe Integer + , stBlockIndex :: Maybe Integer -- | The block time in seconds since epoch (1 Jan 1970 GMT). Is -- 'Nothing' unless 'trCategory' is 'TCSend' or 'TCReceive'. - , trBlockTime :: Maybe Integer + , stBlockTime :: Maybe Integer -- | The transaction id. Is 'Nothing' unless -- 'trCategory' is 'TCSend' or 'TCReceive'. - , trTransactionId :: Maybe TransactionID + , stTransactionId :: Maybe TransactionID -- | The list of transaction ids containing the same data as the -- original transaction (See ID-malleation bug). Is 'Nothing' unless -- 'trCategory' is 'TCSend' or 'TCReceive'. - , trWalletConflicts :: Maybe (Vector TransactionID) + , stWalletConflicts :: Maybe (Vector TransactionID) -- | The block time in seconds since epoch (1 Jan 1970 GMT). - , trTime :: Integer - , trTimeReceived :: Maybe Integer + , stTime :: Integer + , stTimeReceived :: Maybe Integer -- | Is 'Nothing' unless a comment is associated with the transaction. - , trComment :: Maybe Text + , stComment :: Maybe Text -- | Is 'Nothing' unless a \"to\" is associated with the transaction. - , trTo :: Maybe Text + , stTo :: Maybe Text -- | The account the funds came from (for receiving funds, positive -- amounts), or went to (for sending funds, negative amounts). Is -- 'Nothing' unless 'trCategory' is 'TCMove'. - , trOtherAccount :: Maybe Account + , stOtherAccount :: Maybe Account } deriving ( Show, Read, Ord, Eq ) @@ -611,31 +611,31 @@ listAccounts auth mconf = data DetailedTransaction = DetailedTransaction { -- | The amount of bitcoins transferred. - dtrAmount :: BTC + dtAmount :: BTC -- | The fees paid to process the transaction. Is 'Nothing' unless -- 'trCategory' is 'TCSend' or 'TCReceive'. - , dtrFee :: Maybe BTC + , dtFee :: Maybe BTC -- | The number of confirmations of the transaction. Is 'Nothing' unless -- 'trCategory' is 'TCSend' or 'TCReceive'. - , dtrConfirmations :: Maybe Integer + , dtConfirmations :: Maybe Integer -- | The transaction id. Is 'Nothing' unless -- 'trCategory' is 'TCSend' or 'TCReceive'. - , dtrTransactionId :: Maybe TransactionID + , dtTransactionId :: Maybe TransactionID -- | The list of transaction ids containing the same data as the -- original transaction (See ID-malleation bug). Is 'Nothing' unless -- 'trCategory' is 'TCSend' or 'TCReceive'. - , dtrWalletConflicts :: Maybe (Vector TransactionID) + , dtWalletConflicts :: Maybe (Vector TransactionID) -- | The block time in seconds since epoch (1 Jan 1970 GMT). - , dtrTime :: Integer - , dtrTimeReceived :: Maybe Integer + , dtTime :: Integer + , dtTimeReceived :: Maybe Integer -- | Is 'Nothing' unless a comment is associated with the transaction. - , dtrComment :: Maybe Text + , dtComment :: Maybe Text -- | Is 'Nothing' unless a \"to\" is associated with the transaction. - , dtrTo :: Maybe Text + , dtTo :: Maybe Text -- | The details of the transaction. - , dtrDetails :: Vector DetailedTransactionDetails + , dtDetails :: Vector DetailedTransactionDetails -- | Raw data for the transaction. - , dtrHex :: RawTransaction + , dtHex :: RawTransaction } deriving ( Show, Read, Ord, Eq ) @@ -657,13 +657,13 @@ data DetailedTransactionDetails = DetailedTransactionDetails { -- | The account name associated with the transaction. The empty string -- is the default account. - dtrdReceivingAccount :: Account + dtdReceivingAccount :: Account -- | The bitcoin address of the transaction. - , dtrdAddress :: Address + , dtdAddress :: Address -- | The category of the transaction - , dtrdCategory :: TransactionCategory + , dtdCategory :: TransactionCategory -- | The amount of bitcoins transferred. - , dtrdAmount :: BTC + , dtdAmount :: BTC } deriving ( Show, Read, Ord, Eq ) From a8fb288eaafd349c1adaf5ee1ccf28dbd7bb928e Mon Sep 17 00:00:00 2001 From: MomemtumMori Date: Thu, 1 May 2014 02:04:29 -0400 Subject: [PATCH 59/73] Simplified listAccounts. --- src/Network/Bitcoin/Wallet.hs | 13 +------------ 1 file changed, 1 insertion(+), 12 deletions(-) diff --git a/src/Network/Bitcoin/Wallet.hs b/src/Network/Bitcoin/Wallet.hs index abc9084..a18e691 100644 --- a/src/Network/Bitcoin/Wallet.hs +++ b/src/Network/Bitcoin/Wallet.hs @@ -65,7 +65,6 @@ module Network.Bitcoin.Wallet ( Auth(..) import Control.Applicative import Control.Monad import Data.Aeson as A -import Data.Aeson.Types (Parser) import qualified Data.HashMap.Lazy as HM import Data.Maybe import Data.Vector as V @@ -584,22 +583,12 @@ listTransactions' auth maccount mcount mfrom = ] -instance FromJSON (Vector (Account, BTC)) where - parseJSON (Object o) = toAccountBalance $ V.fromList $ HM.toList o - where toAccountBalance :: Vector (Text, Value) -> Parser (Vector (Account, BTC)) - toAccountBalance kps = V.mapM (magic) kps - magic :: (Text, Value) -> Parser (Account, BTC) - magic (acc, v) = do - bal <- (parseJSON :: Value -> Parser BTC) v - return (acc, bal) - parseJSON _ = mzero - -- | List accounts and their current balance. listAccounts :: Auth -> Maybe Int -- ^ Minimum number of confirmations required before payments are -- included in the balance. - -> IO (Vector (Account, BTC)) + -> IO (HM.HashMap Account BTC) listAccounts auth mconf = callApi auth "listaccounts" [ tj $ fromMaybe 1 mconf ] From 3c5be7bbbcc3949d84224e4f9a9fe6ad3ebeb364 Mon Sep 17 00:00:00 2001 From: MomemtumMori Date: Thu, 1 May 2014 05:19:45 -0400 Subject: [PATCH 60/73] Added methods for optional arguments of the api. --- src/Network/Bitcoin/Internal.hs | 18 ++++++++++++++++++ src/Network/Bitcoin/Wallet.hs | 18 +++++------------- 2 files changed, 23 insertions(+), 13 deletions(-) diff --git a/src/Network/Bitcoin/Internal.hs b/src/Network/Bitcoin/Internal.hs index 4326ca8..65a7389 100644 --- a/src/Network/Bitcoin/Internal.hs +++ b/src/Network/Bitcoin/Internal.hs @@ -18,6 +18,9 @@ module Network.Bitcoin.Internal ( module Network.Bitcoin.Types , callApi' , Nil(..) , tj + , tjm + , tja + , (|||) , AddrAddress(..) , BitcoinRpcResponse(..) ) where @@ -145,6 +148,21 @@ tj :: ToJSON a => a -> Value tj = toJSON {-# INLINE tj #-} +tjm :: ToJSON a => a -> Maybe a -> Value +tjm d m = tj $ fromMaybe d m +{-# INLINE tjm #-} + +tja :: ToJSON a => Maybe a -> [Value] +tja m = case m of + Just v -> [ tj v ] + _ -> [] +{-# INLINE tja #-} + +(|||) :: ToJSON a => [Value] -> Maybe a -> [Value] +vs ||| m = vs ++ tja m +{-# INLINE (|||) #-} + + -- | A wrapper for a vector of address:amount pairs. The RPC expects that as -- an object of "address":"amount" pairs, instead of a vector. So that's what -- we give them with AddrAddress's ToJSON. diff --git a/src/Network/Bitcoin/Wallet.hs b/src/Network/Bitcoin/Wallet.hs index a18e691..16a70d1 100644 --- a/src/Network/Bitcoin/Wallet.hs +++ b/src/Network/Bitcoin/Wallet.hs @@ -542,13 +542,9 @@ listSinceBlock' :: Auth -- not in any way affect which transactions are returned -- (see https://github.com/bitcoin/bitcoin/pull/199#issuecomment-1514952) -> IO (SinceBlock) -listSinceBlock' auth (Just blockHash) (Just minConf) = - callApi auth "listsinceblock" [ tj blockHash, tj minConf ] -listSinceBlock' auth (Just blockHash) _ = - callApi auth "listsinceblock" [ tj blockHash ] -listSinceBlock' auth _ _ = - callApi auth "listsinceblock" [] - +listSinceBlock' auth mblockHash mminConf = + callApi auth "listsinceblock" $ tja mblockHash ||| mminConf + -- | Returns transactions from the blockchain. listTransactions :: Auth @@ -576,11 +572,7 @@ listTransactions' :: Auth -- ^ Number of most recent transactions to skip. -> IO (Vector SimpleTransaction) listTransactions' auth maccount mcount mfrom = - callApi auth "listtransactions" [ - tj $ fromMaybe "*" maccount - , tj $ fromMaybe 10 mcount - , tj $ fromMaybe 0 mfrom - ] + callApi auth "listtransactions" $ [ tjm "*" maccount ] ||| mcount ||| mfrom -- | List accounts and their current balance. @@ -590,7 +582,7 @@ listAccounts :: Auth -- included in the balance. -> IO (HM.HashMap Account BTC) listAccounts auth mconf = - callApi auth "listaccounts" [ tj $ fromMaybe 1 mconf ] + callApi auth "listaccounts" [ tjm 1 mconf ] -- | Data type for detailed transactions. Rules involving 'trCategory' are From 125119dfbc1b38a58ac9be406f5380422de3459f Mon Sep 17 00:00:00 2001 From: MomemtumMori Date: Fri, 2 May 2014 02:26:17 -0400 Subject: [PATCH 61/73] Changed Transaction times from Integer to POSIXTime. --- network-bitcoin.cabal | 6 +++-- src/Network/Bitcoin/Wallet.hs | 42 ++++++++++++++++++++++------------- 2 files changed, 30 insertions(+), 18 deletions(-) diff --git a/network-bitcoin.cabal b/network-bitcoin.cabal index 1625275..73adb81 100644 --- a/network-bitcoin.cabal +++ b/network-bitcoin.cabal @@ -57,7 +57,8 @@ Library network >= 2.3, text >= 0.11, vector >= 0.10, - base == 4.* + base == 4.*, + time >= 1.4.2 Source-repository head type: git @@ -77,6 +78,7 @@ Executable network-bitcoin-tests text >= 0.11, vector >= 0.10, base == 4.*, - QuickCheck == 2.6.*, + time >= 1.4.2, + QuickCheck >= 2.6, network-bitcoin diff --git a/src/Network/Bitcoin/Wallet.hs b/src/Network/Bitcoin/Wallet.hs index 16a70d1..b215c28 100644 --- a/src/Network/Bitcoin/Wallet.hs +++ b/src/Network/Bitcoin/Wallet.hs @@ -65,8 +65,11 @@ module Network.Bitcoin.Wallet ( Auth(..) import Control.Applicative import Control.Monad import Data.Aeson as A +import Data.Aeson.Types import qualified Data.HashMap.Lazy as HM import Data.Maybe +import Data.Text +import Data.Time.Clock.POSIX import Data.Vector as V import Network.Bitcoin.BlockChain (BlockHash) import Network.Bitcoin.Internal @@ -419,7 +422,7 @@ data SinceBlock = SinceBlock { strransactions :: Vector SimpleTransaction , sbLastBlockHash :: BlockHash } - deriving ( Show, Read, Ord, Eq ) + deriving ( Show, Ord, Eq ) instance FromJSON SinceBlock where parseJSON (Object o) = SinceBlock <$> o .: "transactions" @@ -456,7 +459,7 @@ data SimpleTransaction = , stBlockIndex :: Maybe Integer -- | The block time in seconds since epoch (1 Jan 1970 GMT). Is -- 'Nothing' unless 'trCategory' is 'TCSend' or 'TCReceive'. - , stBlockTime :: Maybe Integer + , stBlockTime :: Maybe POSIXTime -- | The transaction id. Is 'Nothing' unless -- 'trCategory' is 'TCSend' or 'TCReceive'. , stTransactionId :: Maybe TransactionID @@ -465,8 +468,8 @@ data SimpleTransaction = -- 'trCategory' is 'TCSend' or 'TCReceive'. , stWalletConflicts :: Maybe (Vector TransactionID) -- | The block time in seconds since epoch (1 Jan 1970 GMT). - , stTime :: Integer - , stTimeReceived :: Maybe Integer + , stTime :: POSIXTime + , stTimeReceived :: Maybe POSIXTime -- | Is 'Nothing' unless a comment is associated with the transaction. , stComment :: Maybe Text -- | Is 'Nothing' unless a \"to\" is associated with the transaction. @@ -476,7 +479,14 @@ data SimpleTransaction = -- 'Nothing' unless 'trCategory' is 'TCMove'. , stOtherAccount :: Maybe Account } - deriving ( Show, Read, Ord, Eq ) + deriving ( Show, Ord, Eq ) + +applyParserMaybe :: Parser (Maybe a) -> (a -> b) -> Parser (Maybe b) +applyParserMaybe p f = do + mv <- p + case mv of + Just v -> return $ Just $ f v + _ -> return Nothing instance FromJSON SimpleTransaction where parseJSON (Object o) = SimpleTransaction <$> o .: "account" @@ -487,11 +497,11 @@ instance FromJSON SimpleTransaction where <*> o .:? "confirmations" <*> o .:? "blockhash" <*> o .:? "blockindex" - <*> o .:? "blocktime" + <*> (applyParserMaybe (o .:? "blocktime") (fromIntegral :: Integer -> POSIXTime)) <*> o .:? "txid" <*> o .:? "walletconflicts" - <*> o .: "time" - <*> o .:? "timereceived" + <*> ((fromIntegral :: Integer -> POSIXTime) <$> o .: "time") + <*> (applyParserMaybe (o .:? "timereceived") (fromIntegral :: Integer -> POSIXTime)) <*> o .:? "comment" <*> o .:? "to" <*> o .:? "otheraccount" @@ -556,8 +566,8 @@ listTransactions :: Auth -> Int -- ^ Number of most recent transactions to skip. -> IO (Vector SimpleTransaction) -listTransactions auth account count from = - listTransactions' auth (Just account) (Just count) (Just from) +listTransactions auth account size from = + listTransactions' auth (Just account) (Just size) (Just from) -- | Returns transactions from the blockchain. listTransactions' :: Auth @@ -607,8 +617,8 @@ data DetailedTransaction = -- 'trCategory' is 'TCSend' or 'TCReceive'. , dtWalletConflicts :: Maybe (Vector TransactionID) -- | The block time in seconds since epoch (1 Jan 1970 GMT). - , dtTime :: Integer - , dtTimeReceived :: Maybe Integer + , dtTime :: POSIXTime + , dtTimeReceived :: Maybe POSIXTime -- | Is 'Nothing' unless a comment is associated with the transaction. , dtComment :: Maybe Text -- | Is 'Nothing' unless a \"to\" is associated with the transaction. @@ -618,7 +628,7 @@ data DetailedTransaction = -- | Raw data for the transaction. , dtHex :: RawTransaction } - deriving ( Show, Read, Ord, Eq ) + deriving ( Show, Ord, Eq ) instance FromJSON DetailedTransaction where parseJSON (Object o) = DetailedTransaction <$> o .: "amount" @@ -626,8 +636,8 @@ instance FromJSON DetailedTransaction where <*> o .: "confirmations" <*> o .:? "txid" <*> o .:? "walletconflicts" - <*> o .: "time" - <*> o .:? "timereceived" + <*> ((fromIntegral :: Integer -> POSIXTime) <$> (o .: "time")) + <*> (applyParserMaybe (o .:? "time") (fromIntegral :: Integer -> POSIXTime)) <*> o .:? "comment" <*> o .:? "to" <*> o .: "details" @@ -646,7 +656,7 @@ data DetailedTransactionDetails = -- | The amount of bitcoins transferred. , dtdAmount :: BTC } - deriving ( Show, Read, Ord, Eq ) + deriving ( Show, Ord, Eq ) instance FromJSON DetailedTransactionDetails where parseJSON (Object o) = DetailedTransactionDetails <$> o .: "account" From df2cee1abc3dafb0a8150a4e8d051d957286fb8b Mon Sep 17 00:00:00 2001 From: Clark Gaebel Date: Sun, 4 May 2014 14:45:06 -0400 Subject: [PATCH 62/73] cleanup --- src/Network/Bitcoin/Internal.hs | 10 +---- src/Network/Bitcoin/Wallet.hs | 74 +++++++++++++++------------------ 2 files changed, 35 insertions(+), 49 deletions(-) diff --git a/src/Network/Bitcoin/Internal.hs b/src/Network/Bitcoin/Internal.hs index 65a7389..256cb1d 100644 --- a/src/Network/Bitcoin/Internal.hs +++ b/src/Network/Bitcoin/Internal.hs @@ -20,7 +20,6 @@ module Network.Bitcoin.Internal ( module Network.Bitcoin.Types , tj , tjm , tja - , (|||) , AddrAddress(..) , BitcoinRpcResponse(..) ) where @@ -153,16 +152,9 @@ tjm d m = tj $ fromMaybe d m {-# INLINE tjm #-} tja :: ToJSON a => Maybe a -> [Value] -tja m = case m of - Just v -> [ tj v ] - _ -> [] +tja m = fromMaybe [] $ pure . tj <$> m {-# INLINE tja #-} -(|||) :: ToJSON a => [Value] -> Maybe a -> [Value] -vs ||| m = vs ++ tja m -{-# INLINE (|||) #-} - - -- | A wrapper for a vector of address:amount pairs. The RPC expects that as -- an object of "address":"amount" pairs, instead of a vector. So that's what -- we give them with AddrAddress's ToJSON. diff --git a/src/Network/Bitcoin/Wallet.hs b/src/Network/Bitcoin/Wallet.hs index b215c28..efbe063 100644 --- a/src/Network/Bitcoin/Wallet.hs +++ b/src/Network/Bitcoin/Wallet.hs @@ -1,5 +1,4 @@ {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE FlexibleInstances #-} {-# OPTIONS_GHC -Wall #-} -- | An interface to bitcoind's available wallet-related RPC calls. -- The implementation of these functions can be found at @@ -65,12 +64,11 @@ module Network.Bitcoin.Wallet ( Auth(..) import Control.Applicative import Control.Monad import Data.Aeson as A -import Data.Aeson.Types import qualified Data.HashMap.Lazy as HM import Data.Maybe import Data.Text import Data.Time.Clock.POSIX -import Data.Vector as V +import Data.Vector as V hiding ((++)) import Network.Bitcoin.BlockChain (BlockHash) import Network.Bitcoin.Internal import Network.Bitcoin.RawTransaction (RawTransaction) @@ -481,30 +479,25 @@ data SimpleTransaction = } deriving ( Show, Ord, Eq ) -applyParserMaybe :: Parser (Maybe a) -> (a -> b) -> Parser (Maybe b) -applyParserMaybe p f = do - mv <- p - case mv of - Just v -> return $ Just $ f v - _ -> return Nothing - instance FromJSON SimpleTransaction where - parseJSON (Object o) = SimpleTransaction <$> o .: "account" - <*> o .:? "address" - <*> o .: "category" - <*> o .:? "fee" - <*> o .: "amount" - <*> o .:? "confirmations" - <*> o .:? "blockhash" - <*> o .:? "blockindex" - <*> (applyParserMaybe (o .:? "blocktime") (fromIntegral :: Integer -> POSIXTime)) - <*> o .:? "txid" - <*> o .:? "walletconflicts" - <*> ((fromIntegral :: Integer -> POSIXTime) <$> o .: "time") - <*> (applyParserMaybe (o .:? "timereceived") (fromIntegral :: Integer -> POSIXTime)) - <*> o .:? "comment" - <*> o .:? "to" - <*> o .:? "otheraccount" + parseJSON (Object o) = + SimpleTransaction + <$> o .: "account" + <*> o .:? "address" + <*> o .: "category" + <*> o .:? "fee" + <*> o .: "amount" + <*> o .:? "confirmations" + <*> o .:? "blockhash" + <*> o .:? "blockindex" + <*> (fmap fromInteger <$> o .:? "blocktime") + <*> o .:? "txid" + <*> o .:? "walletconflicts" + <*> (fromInteger <$> o .: "time") + <*> (fmap fromInteger <$> o .:? "timereceived") + <*> o .:? "comment" + <*> o .:? "to" + <*> o .:? "otheraccount" parseJSON _ = mzero data TransactionCategory = TCSend @@ -553,7 +546,7 @@ listSinceBlock' :: Auth -- (see https://github.com/bitcoin/bitcoin/pull/199#issuecomment-1514952) -> IO (SinceBlock) listSinceBlock' auth mblockHash mminConf = - callApi auth "listsinceblock" $ tja mblockHash ||| mminConf + callApi auth "listsinceblock" $ tja mblockHash ++ tja mminConf -- | Returns transactions from the blockchain. @@ -582,7 +575,7 @@ listTransactions' :: Auth -- ^ Number of most recent transactions to skip. -> IO (Vector SimpleTransaction) listTransactions' auth maccount mcount mfrom = - callApi auth "listtransactions" $ [ tjm "*" maccount ] ||| mcount ||| mfrom + callApi auth "listtransactions" $ [ tjm "*" maccount ] ++ tja mcount ++ tja mfrom -- | List accounts and their current balance. @@ -594,7 +587,6 @@ listAccounts :: Auth listAccounts auth mconf = callApi auth "listaccounts" [ tjm 1 mconf ] - -- | Data type for detailed transactions. Rules involving 'trCategory' are -- indications of the most probable value only when the transaction is -- obtained from 'listTransactions' or 'listSinceBlock' are their associated @@ -631,17 +623,19 @@ data DetailedTransaction = deriving ( Show, Ord, Eq ) instance FromJSON DetailedTransaction where - parseJSON (Object o) = DetailedTransaction <$> o .: "amount" - <*> o .:? "fee" - <*> o .: "confirmations" - <*> o .:? "txid" - <*> o .:? "walletconflicts" - <*> ((fromIntegral :: Integer -> POSIXTime) <$> (o .: "time")) - <*> (applyParserMaybe (o .:? "time") (fromIntegral :: Integer -> POSIXTime)) - <*> o .:? "comment" - <*> o .:? "to" - <*> o .: "details" - <*> o .: "hex" + parseJSON (Object o) = + DetailedTransaction + <$> o .: "amount" + <*> o .:? "fee" + <*> o .: "confirmations" + <*> o .:? "txid" + <*> o .:? "walletconflicts" + <*> (fromInteger <$> o .: "time") + <*> (fmap fromInteger <$> o .:? "timereceived") + <*> o .:? "comment" + <*> o .:? "to" + <*> o .: "details" + <*> o .: "hex" parseJSON _ = mzero data DetailedTransactionDetails = From 64b668715ddc5d8afb1e2fd560478129acd23a86 Mon Sep 17 00:00:00 2001 From: Clark Gaebel Date: Sun, 4 May 2014 14:45:22 -0400 Subject: [PATCH 63/73] major version bump --- network-bitcoin.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/network-bitcoin.cabal b/network-bitcoin.cabal index 73adb81..1f011aa 100644 --- a/network-bitcoin.cabal +++ b/network-bitcoin.cabal @@ -1,5 +1,5 @@ Name: network-bitcoin -Version: 1.5.2 +Version: 1.6.0 Synopsis: An interface to bitcoind. Description: This can be used to send Bitcoins, query balances, etc. It From 380da9a7d23940f8dcf535852da7460a3c209170 Mon Sep 17 00:00:00 2001 From: dlomsak Date: Thu, 1 Jan 2015 12:43:40 -0500 Subject: [PATCH 64/73] modify API to reuse HTTP connections via Manager --- network-bitcoin.cabal | 21 ++- src/Network/Bitcoin.hs | 3 +- src/Network/Bitcoin/BlockChain.hs | 36 ++--- src/Network/Bitcoin/Dump.hs | 14 +- src/Network/Bitcoin/Internal.hs | 76 ++++------ src/Network/Bitcoin/Mining.hs | 41 +++--- src/Network/Bitcoin/Net.hs | 11 +- src/Network/Bitcoin/RawTransaction.hs | 41 +++--- src/Network/Bitcoin/Types.hs | 11 +- src/Network/Bitcoin/Wallet.hs | 201 +++++++++++++------------- src/Test/Main.hs | 10 +- 11 files changed, 227 insertions(+), 238 deletions(-) diff --git a/network-bitcoin.cabal b/network-bitcoin.cabal index 1f011aa..fd0c969 100644 --- a/network-bitcoin.cabal +++ b/network-bitcoin.cabal @@ -1,5 +1,5 @@ Name: network-bitcoin -Version: 1.6.0 +Version: 1.7.0 Synopsis: An interface to bitcoind. Description: This can be used to send Bitcoins, query balances, etc. It @@ -49,16 +49,19 @@ Library Network.Bitcoin.Wallet Build-depends: - aeson >= 0.6.1 && < 0.7.1, + aeson >= 0.8, bytestring >= 0.9 && < 0.11, - attoparsec == 0.10.*, + cookie >= 0.4, + attoparsec == 0.12.*, unordered-containers >= 0.2, HTTP >= 4000, + http-types >= 0.8.5, network >= 2.3, text >= 0.11, vector >= 0.10, base == 4.*, - time >= 1.4.2 + time >= 1.4.2, + http-client >= 0.4.6 Source-repository head type: git @@ -69,16 +72,18 @@ Executable network-bitcoin-tests ghc-options: -Wall main-is: Test/Main.hs build-depends: - aeson >= 0.6.1 && < 0.7.1, + aeson >= 0.8, bytestring >= 0.9 && < 0.11, - attoparsec == 0.10.*, + cookie >= 0.4, + attoparsec == 0.12.*, unordered-containers >= 0.2, HTTP >= 4000, + http-types >= 0.8.5, network >= 2.3, text >= 0.11, vector >= 0.10, base == 4.*, time >= 1.4.2, QuickCheck >= 2.6, - network-bitcoin - + http-client >= 0.4.6, + network-bitcoin \ No newline at end of file diff --git a/src/Network/Bitcoin.hs b/src/Network/Bitcoin.hs index eddb2a7..c2036d4 100644 --- a/src/Network/Bitcoin.hs +++ b/src/Network/Bitcoin.hs @@ -3,7 +3,8 @@ module Network.Bitcoin ( -- * Common Types - Auth(..) + Client + , getClient , BitcoinException(..) , HexString , TransactionID diff --git a/src/Network/Bitcoin/BlockChain.hs b/src/Network/Bitcoin/BlockChain.hs index 8fb5c4d..1f61f74 100644 --- a/src/Network/Bitcoin/BlockChain.hs +++ b/src/Network/Bitcoin/BlockChain.hs @@ -6,7 +6,7 @@ -- -- If any APIs are missing, patches are always welcome. If you look at the -- source of this module, you'll see that the interface code is trivial. -module Network.Bitcoin.BlockChain ( Auth(..) +module Network.Bitcoin.BlockChain ( Client , TransactionID , BTC , getBlockCount @@ -30,34 +30,34 @@ import Network.Bitcoin.Internal import Network.Bitcoin.RawTransaction -- | Returns the number of blocks in the longest block chain. -getBlockCount :: Auth -> IO Integer -getBlockCount auth = callApi auth "getblockcount" [] +getBlockCount :: Client -> IO Integer +getBlockCount client = callApi client "getblockcount" [] -- | Returns the proof-of-work difficulty as a multiple of the minimum -- difficulty. -getDifficulty :: Auth -> IO Integer -getDifficulty auth = callApi auth "getdifficulty" [] +getDifficulty :: Client -> IO Integer +getDifficulty client = callApi client "getdifficulty" [] -- | Sets the transaction fee will will pay to the network. Values of 0 are -- rejected. -setTransactionFee :: Auth -> BTC -> IO () -setTransactionFee auth fee = - stupidAPI <$> callApi auth "settxfee" [ tj fee ] +setTransactionFee :: Client -> BTC -> IO () +setTransactionFee client fee = + stupidAPI <$> callApi client "settxfee" [ tj fee ] where stupidAPI :: Bool -> () stupidAPI = const () -- | Returns all transaction identifiers in the memory pool. -getRawMemoryPool :: Auth -> IO (Vector TransactionID) -getRawMemoryPool auth = callApi auth "getrawmempool" [] +getRawMemoryPool :: Client -> IO (Vector TransactionID) +getRawMemoryPool client = callApi client "getrawmempool" [] -- | The hash of a given block. type BlockHash = HexString -- | Returns the hash of the block in best-block-chain at the given index. -getBlockHash :: Auth +getBlockHash :: Client -> Integer -- ^ Block index. -> IO BlockHash -getBlockHash auth idx = callApi auth "getblockhash" [ tj idx ] +getBlockHash client idx = callApi client "getblockhash" [ tj idx ] -- | Information about a given block in the block chain. data Block = Block { blockHash :: BlockHash @@ -105,8 +105,8 @@ instance FromJSON Block where parseJSON _ = mzero -- | Returns details of a block with given block-hash. -getBlock :: Auth -> BlockHash -> IO Block -getBlock auth bh = callApi auth "getblock" [ tj bh ] +getBlock :: Client -> BlockHash -> IO Block +getBlock client bh = callApi client "getblock" [ tj bh ] -- | Information on the unspent transaction in the output set. data OutputSetInfo = @@ -128,8 +128,8 @@ instance FromJSON OutputSetInfo where parseJSON _ = mzero -- | Returns statistics about the unspent transaction output set. -getOutputSetInfo :: Auth -> IO OutputSetInfo -getOutputSetInfo auth = callApi auth "gettxoutsetinfo" [] +getOutputSetInfo :: Client -> IO OutputSetInfo +getOutputSetInfo client = callApi client "gettxoutsetinfo" [] -- | Details about an unspent transaction output. data OutputInfo = @@ -157,8 +157,8 @@ instance FromJSON OutputInfo where parseJSON _ = mzero -- | Returns details about an unspent transaction output. -getOutputInfo :: Auth +getOutputInfo :: Client -> TransactionID -> Integer -- ^ The index we're looking at. -> IO OutputInfo -getOutputInfo auth txid n = callApi auth "gettxout" [ tj txid, tj n ] +getOutputInfo client txid n = callApi client "gettxout" [ tj txid, tj n ] diff --git a/src/Network/Bitcoin/Dump.hs b/src/Network/Bitcoin/Dump.hs index 30caefa..29b7312 100644 --- a/src/Network/Bitcoin/Dump.hs +++ b/src/Network/Bitcoin/Dump.hs @@ -17,18 +17,18 @@ import Network.Bitcoin.Internal type PrivateKey = Text -- | Adds a private key (as returned by dumpprivkey) to your wallet. -importPrivateKey :: Auth +importPrivateKey :: Client -> PrivateKey -> Maybe Account -- ^ An optional label for the key. -> IO () -importPrivateKey auth pk Nothing = - unNil <$> callApi auth "importprivkey" [ tj pk ] -importPrivateKey auth pk (Just label) = - unNil <$> callApi auth "importprivkey" [ tj pk, tj label ] +importPrivateKey client pk Nothing = + unNil <$> callApi client "importprivkey" [ tj pk ] +importPrivateKey client pk (Just label) = + unNil <$> callApi client "importprivkey" [ tj pk, tj label ] -- | Reveals the private key corresponding to the given address. -dumpPrivateKey :: Auth +dumpPrivateKey :: Client -> Address -> IO PrivateKey -dumpPrivateKey auth addr = callApi auth "dumpprivkey" [ tj addr ] +dumpPrivateKey client addr = callApi client "dumpprivkey" [ tj addr ] diff --git a/src/Network/Bitcoin/Internal.hs b/src/Network/Bitcoin/Internal.hs index 256cb1d..fe94b24 100644 --- a/src/Network/Bitcoin/Internal.hs +++ b/src/Network/Bitcoin/Internal.hs @@ -15,7 +15,7 @@ module Network.Bitcoin.Internal ( module Network.Bitcoin.Types , Text, Vector , FromJSON(..) , callApi - , callApi' + , getClient , Nil(..) , tj , tjm @@ -32,12 +32,13 @@ import Data.Maybe import Data.Vector ( Vector ) import qualified Data.Vector as V import Network.Bitcoin.Types -import Network.Browser -import Network.HTTP hiding ( password ) -import Network.URI ( parseURI ) import qualified Data.ByteString.Lazy as BL +import qualified Data.ByteString as BS import Data.Text ( Text ) import qualified Data.Text as T +import Network.HTTP.Client +import Network.HTTP.Types.Header + -- | RPC calls return an error object. It can either be empty; or have an -- error message + error code. @@ -63,40 +64,44 @@ instance FromJSON a => FromJSON (BitcoinRpcResponse a) where <*> v .: "error" parseJSON _ = mzero --- | The "no conversion needed" implementation of callApi. THis lets us inline --- and specialize callApi for its parameters, while keeping the bulk of the --- work in this function shared. -callApi' :: Auth -> BL.ByteString -> IO BL.ByteString -callApi' auth rpcReqBody = do - (_, httpRes) <- browse $ do - setOutHandler . const $ return () - addAuthority authority - setAllowBasicAuth True - request $ httpRequest (T.unpack urlString) rpcReqBody - return $ rspBody httpRes - where - authority = httpAuthority auth - urlString = rpcUrl auth +-- | 'getClient' takes a url, rpc username, and rpc password +-- and returns a Client that can be used to make API calls. Each +-- Client encloses a Manager (from http-client) that re-uses +-- connections for requests, so long as the same Client is +-- is used for each call. +getClient :: String + -> BS.ByteString + -> BS.ByteString + -> IO Client +getClient url user pass = do + mgr <- newManager defaultManagerSettings + return $ \r -> do + resp <- httpLbs (baseReq { requestBody = RequestBodyLBS r }) mgr + return $ responseBody resp + where + baseReq = applyBasicAuth user pass $ (fromJust $ parseUrl url) + { method = "POST" + , requestHeaders = [(hContentType, "application/json")] + } -- | 'callApi' is a low-level interface for making authenticated API -- calls to a Bitcoin daemon. The first argument specifies --- authentication details (URL, username, password) and is often --- curried for convenience: --- --- > callBtc = callApi $ Auth "http://127.0.0.1:8332" "user" "password" +-- rpc client details (URL, username, password) -- -- The second argument is the command name. The third argument provides -- parameters for the API call. -- --- > let result = callBtc "getbalance" [ tj "account-name", tj 6 ] +-- > genHash = do +-- client <- getClient "http://127.0.0.1:8332" "user" "password" +-- callApi client "getblockhash" [tj 0] -- -- On error, throws a 'BitcoinException'. callApi :: FromJSON v - => Auth -- ^ authentication credentials for bitcoind + => Client -- ^ RPC client for bitcoind -> Text -- ^ command name -> [Value] -- ^ command arguments -> IO v -callApi auth cmd params = readVal =<< callApi' auth jsonRpcReqBody +callApi client cmd params = readVal =<< client jsonRpcReqBody where readVal bs = case decode' bs of Just r@(BitcoinRpcResponse {btcError=NoError}) @@ -120,27 +125,6 @@ instance FromJSON Nil where parseJSON Null = return $ Nil () parseJSON x = fail $ "\"null\" was expected, but " ++ show x ++ " was recieved." --- | Internal helper functions to make callApi more readable -httpAuthority :: Auth -> Authority -httpAuthority (Auth urlString username password) = - AuthBasic { auRealm = "jsonrpc" - , auUsername = T.unpack username - , auPassword = T.unpack password - , auSite = uri - } - where - uri = fromJust . parseURI $ T.unpack urlString - --- | Builds the JSON HTTP request. -httpRequest :: String -> BL.ByteString -> Request BL.ByteString -httpRequest urlString jsonBody = - (postRequest urlString){ - rqBody = jsonBody, - rqHeaders = [ - mkHeader HdrContentType "application/json", - mkHeader HdrContentLength (show $ BL.length jsonBody) - ] - } -- | A handy shortcut for toJSON, because I'm lazy. tj :: ToJSON a => a -> Value diff --git a/src/Network/Bitcoin/Mining.hs b/src/Network/Bitcoin/Mining.hs index 42686ff..62fb411 100644 --- a/src/Network/Bitcoin/Mining.hs +++ b/src/Network/Bitcoin/Mining.hs @@ -12,7 +12,8 @@ -- out ahead. -- -- Instead, consider using a GPU miner listed at . -module Network.Bitcoin.Mining ( Auth(..) +module Network.Bitcoin.Mining ( Client + , getClient , getGenerate , setGenerate , getHashesPerSec @@ -34,27 +35,27 @@ import Control.Monad import Network.Bitcoin.Internal -- | Returns whether or not bitcoind is generating bitcoins. -getGenerate :: Auth -- ^ bitcoind RPC authorization +getGenerate :: Client -- ^ bitcoind RPC client -> IO Bool -getGenerate auth = callApi auth "getgenerate" [] +getGenerate client = callApi client "getgenerate" [] -- | Controls whether or not bitcoind is generating bitcoins. -setGenerate :: Auth -- ^ bitcoind RPC authorization +setGenerate :: Client -- ^ bitcoind RPC client -> Bool -- ^ Turn it on, or turn it off? -> Maybe Int -- ^ Generation is limited to this number of -- processors. Set it to Nothing to keep the value -- at what it was before, Just -1 to use all -- available cores, and any other value to limit it. -> IO () -setGenerate auth onOff Nothing = - unNil <$> callApi auth "setgenerate" [ tj onOff ] -setGenerate auth onOff (Just limit) = - unNil <$> callApi auth "setgenerate" [ tj onOff, tj limit ] +setGenerate client onOff Nothing = + unNil <$> callApi client "setgenerate" [ tj onOff ] +setGenerate client onOff (Just limit) = + unNil <$> callApi client "setgenerate" [ tj onOff, tj limit ] -- | Returns a recent hashes per second performance measurement while -- generating. -getHashesPerSec :: Auth -> IO Integer -getHashesPerSec auth = callApi auth "gethashespersec" [] +getHashesPerSec :: Client -> IO Integer +getHashesPerSec client = callApi client "gethashespersec" [] -- | Information related to the current bitcoind mining operation. -- @@ -99,8 +100,8 @@ instance FromJSON MiningInfo where parseJSON _ = mzero -- | Returns an object containing mining-related information. -getMiningInfo :: Auth -> IO MiningInfo -getMiningInfo auth = callApi auth "getmininginfo" [] +getMiningInfo :: Client -> IO MiningInfo +getMiningInfo client = callApi client "getmininginfo" [] -- | The hash data returned from 'getWork'. data HashData = @@ -123,12 +124,12 @@ instance ToJSON HashData where toJSON (HashData dat tar has mid) = object ["data" .= dat, "target" .= tar, "hash1" .= has, "midstate" .= mid] -- | Returns formatted hash data to work on. -getWork :: Auth -> IO HashData -getWork auth = callApi auth "getwork" [] +getWork :: Client -> IO HashData +getWork client = callApi client "getwork" [] -- | Tries to solve the given block, and returns true if it was successful. -solveBlock :: Auth -> HexString -> IO Bool -solveBlock auth data_ = callApi auth "getwork" [ tj data_ ] +solveBlock :: Client -> HexString -> IO Bool +solveBlock client data_ = callApi client "getwork" [ tj data_ ] -- | A transaction to be included in the next block. data Transaction = @@ -207,8 +208,8 @@ instance FromJSON BlockTemplate where parseJSON _ = mzero -- | Returns data needed to construct a block to work on. -getBlockTemplate :: Auth -> IO BlockTemplate -getBlockTemplate auth = callApi auth "getblocktemplate" [] +getBlockTemplate :: Client -> IO BlockTemplate +getBlockTemplate client = callApi client "getblocktemplate" [] -- | Unfortunately, the submitblock API call returns null on success, and -- the string "rejected" on failure. @@ -221,7 +222,7 @@ instance FromJSON StupidReturnValue where parseJSON _ = return $ SRV False -- | Attempts to submit a new block to the network. -submitBlock :: Auth +submitBlock :: Client -> HexString -- ^ The block to submit. -> IO Bool -- ^ Was the block accepted by the network? -submitBlock auth block = unStupid <$> callApi auth "submitblock" [ tj block ] +submitBlock client block = unStupid <$> callApi client "submitblock" [ tj block ] diff --git a/src/Network/Bitcoin/Net.hs b/src/Network/Bitcoin/Net.hs index 68ae981..03562bd 100644 --- a/src/Network/Bitcoin/Net.hs +++ b/src/Network/Bitcoin/Net.hs @@ -6,7 +6,8 @@ -- -- If any APIs are missing, patches are always welcome. If you look at the -- source of this module, you'll see that the interface code is trivial. -module Network.Bitcoin.Net ( Auth(..) +module Network.Bitcoin.Net ( Client + , getClient , getConnectionCount , PeerInfo(..) , getPeerInfo @@ -18,8 +19,8 @@ import Data.Aeson import Network.Bitcoin.Internal -- | Returns the number of connections to other nodes. -getConnectionCount :: Auth -> IO Integer -getConnectionCount auth = callApi auth "getconnectioncount" [] +getConnectionCount :: Client -> IO Integer +getConnectionCount client = callApi client "getconnectioncount" [] -- | Information about a peer node of the Bitcoin network. -- @@ -68,5 +69,5 @@ instance FromJSON PeerInfo where parseJSON _ = mzero -- | Returns data about all connected peer nodes. -getPeerInfo :: Auth -> IO [PeerInfo] -getPeerInfo auth = callApi auth "getpeerinfo" [] +getPeerInfo :: Client -> IO [PeerInfo] +getPeerInfo client = callApi client "getpeerinfo" [] diff --git a/src/Network/Bitcoin/RawTransaction.hs b/src/Network/Bitcoin/RawTransaction.hs index d57f377..5f12968 100644 --- a/src/Network/Bitcoin/RawTransaction.hs +++ b/src/Network/Bitcoin/RawTransaction.hs @@ -10,7 +10,8 @@ -- -- 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(..) +module Network.Bitcoin.RawTransaction ( Client + , getClient , RawTransaction , getRawTransaction , TxIn(..) @@ -47,9 +48,9 @@ import Network.Bitcoin.Internal type RawTransaction = HexString -- | Get a raw transaction from its unique ID. -getRawTransaction :: Auth -> TransactionID -> IO RawTransaction -getRawTransaction auth txid = - callApi auth "getrawtransaction" [ tj txid, tj verbose ] +getRawTransaction :: Client -> TransactionID -> IO RawTransaction +getRawTransaction client txid = + callApi client "getrawtransaction" [ tj txid, tj verbose ] where verbose = 0 :: Int -- | A transaction into an account. This can either be a coinbase transaction, @@ -213,9 +214,9 @@ instance FromJSON RawTransactionInfo where -- | Get raw transaction info for a given transaction ID. The data structure -- returned is quite sprawling and undocumented, so any patches to help -- simplify things would be greatly appreciated. -getRawTransactionInfo :: Auth -> TransactionID -> IO RawTransactionInfo -getRawTransactionInfo auth txid = - callApi auth "getrawtransaction" [ tj txid, tj verbose ] +getRawTransactionInfo :: Client -> TransactionID -> IO RawTransactionInfo +getRawTransactionInfo client txid = + callApi client "getrawtransaction" [ tj txid, tj verbose ] where verbose = 1 :: Int data UnspentTransaction = @@ -247,15 +248,15 @@ instance ToJSON UnspentTransaction where -- | Returns an array of unspent transaction outputs with between minconf and -- maxconf (inclusive) confirmations. If addresses are given, the result will -- be filtered to include only those addresses. -listUnspent :: Auth +listUnspent :: Client -> Maybe Int -- ^ minconf. Defaults to 1 if 'Nothing'. -> Maybe Int -- ^ maxconf. Defaults to 9999999 if 'Nothing'. -> Vector Address -- ^ Use 'Data.Vector.empty' for no filtering. -> IO (Vector UnspentTransaction) -listUnspent auth mmin mmax vaddrs = +listUnspent client mmin mmax vaddrs = let min' = fromMaybe 1 mmin max' = fromMaybe 9999999 mmax - in callApi auth "listunspent" [ tj min', tj max', tj vaddrs ] + in callApi client "listunspent" [ tj min', tj max', tj vaddrs ] -- | Create a transaction spending given inputs, sending to given addresses. -- @@ -265,15 +266,15 @@ listUnspent auth mmin mmax vaddrs = -- Also, there is no checking to see if it's possible to send that much to -- the targets specified. In the future, such a scenario might throw an -- exception. -createRawTransaction :: Auth +createRawTransaction :: Client -> Vector UnspentTransaction -- ^ The unspent transactions we'll be using as our output. -> Vector (Address, BTC) -- ^ The addresses we're sending money to, along with how -- much each of them gets. -> IO HexString -createRawTransaction auth us tgts = - callApi auth "createrawtransaction" [ tj us, tj $ AA tgts ] +createRawTransaction client us tgts = + callApi client "createrawtransaction" [ tj us, tj $ AA tgts ] -- | A successfully decoded raw transaction, from a given serialized, -- hex-encoded transaction. @@ -298,8 +299,8 @@ instance FromJSON DecodedRawTransaction where parseJSON _ = mzero -- | Decodes a raw transaction into a more accessible data structure. -decodeRawTransaction :: Auth -> RawTransaction -> IO DecodedRawTransaction -decodeRawTransaction auth tx = callApi auth "decoderawtransaction" [ tj tx ] +decodeRawTransaction :: Client -> RawTransaction -> IO DecodedRawTransaction +decodeRawTransaction client tx = callApi client "decoderawtransaction" [ tj tx ] -- | Used internally to give a new 'ToJSON' instance for 'UnspentTransaction'. newtype UnspentForSigning = UFS UnspentTransaction @@ -348,7 +349,7 @@ instance FromJSON RawSignedTransaction where parseJSON _ = mzero -- | Sign inputs for a raw transaction. -signRawTransaction :: Auth +signRawTransaction :: Client -> RawTransaction -- ^ The raw transaction whose inputs we're signing. -> Maybe (Vector UnspentTransaction) @@ -363,13 +364,13 @@ signRawTransaction :: Auth -> IO RawSignedTransaction -- ^ Returns 'Nothing' if the transaction has a complete set -- of signatures, and the raw signed transa -signRawTransaction auth rt us' privkeys wcp = +signRawTransaction client rt us' privkeys wcp = let us = V.map UFS <$> us' :: Maybe (Vector UnspentForSigning) - in callApi auth "signrawtransaction" [ tj rt + in callApi client "signrawtransaction" [ tj rt , tj us , tj privkeys , tj . toString $ fromMaybe All wcp ] -sendRawTransaction :: Auth -> RawTransaction -> IO TransactionID -sendRawTransaction auth rt = callApi auth "sendrawtransaction" [ tj rt ] +sendRawTransaction :: Client -> RawTransaction -> IO TransactionID +sendRawTransaction client rt = callApi client "sendrawtransaction" [ tj rt ] diff --git a/src/Network/Bitcoin/Types.hs b/src/Network/Bitcoin/Types.hs index 12b77e8..1ed4ff8 100644 --- a/src/Network/Bitcoin/Types.hs +++ b/src/Network/Bitcoin/Types.hs @@ -2,7 +2,7 @@ {-# OPTIONS_GHC -Wall #-} -- | Contains the common types used through bitcoin RPC calls, that aren't -- specific to a single submodule. -module Network.Bitcoin.Types ( Auth(..) +module Network.Bitcoin.Types ( Client , BitcoinException(..) , HexString , TransactionID @@ -18,14 +18,9 @@ import Data.Text ( Text ) import Data.Typeable import qualified Data.ByteString.Lazy as BL --- | 'Auth' describes authentication credentials for +-- | 'Client' describes authentication credentials and host info for -- making API requests to the Bitcoin daemon. -data Auth = Auth - { rpcUrl :: Text -- ^ URL, with port, where bitcoind listens - , rpcUser :: Text -- ^ same as bitcoind's 'rpcuser' config - , rpcPassword :: Text -- ^ same as bitcoind's 'rpcpassword' config - } - deriving ( Show, Read, Ord, Eq ) +type Client = BL.ByteString -> IO BL.ByteString -- | A 'BitcoinException' is thrown when 'callApi encounters an -- error. The API error code is represented as an @Int@, the message as diff --git a/src/Network/Bitcoin/Wallet.hs b/src/Network/Bitcoin/Wallet.hs index efbe063..10ba4e1 100644 --- a/src/Network/Bitcoin/Wallet.hs +++ b/src/Network/Bitcoin/Wallet.hs @@ -10,7 +10,8 @@ -- Certain APIs were too complicated for me to write an interface for. If -- you figure them out, then patches are always welcome! They're left in -- the source as comments. -module Network.Bitcoin.Wallet ( Auth(..) +module Network.Bitcoin.Wallet ( Client + , getClient , BitcoindInfo(..) , getBitcoindInfo , getNewAddress @@ -128,8 +129,8 @@ instance FromJSON BitcoindInfo where parseJSON _ = mzero -- | Returns an object containing various state info. -getBitcoindInfo :: Auth -> IO BitcoindInfo -getBitcoindInfo auth = callApi auth "getinfo" [] +getBitcoindInfo :: Client -> IO BitcoindInfo +getBitcoindInfo client = callApi client "getinfo" [] -- | Returns a new bitcoin address for receiving payments. -- @@ -139,29 +140,29 @@ getBitcoindInfo auth = callApi auth "getinfo" [] -- -- If no account is specified, the address will be credited to the account -- whose name is the empty string. i.e. the default account. -getNewAddress :: Auth -> Maybe Account -> IO Address -getNewAddress auth ma = let acc = fromMaybe "" ma - in callApi auth "getnewaddress" [ tj acc ] +getNewAddress :: Client -> Maybe Account -> IO Address +getNewAddress client ma = let acc = fromMaybe "" ma + in callApi client "getnewaddress" [ tj acc ] -- | Returns the current Bitcoin address for receiving payments to the given -- account. -getAccountAddress :: Auth -> Account -> IO Address -getAccountAddress auth acc = callApi auth "getaccountaddress" [ tj acc ] +getAccountAddress :: Client -> Account -> IO Address +getAccountAddress client acc = callApi client "getaccountaddress" [ tj acc ] -- | Sets the account associated with the given address. -setAccount :: Auth -> Address -> Account -> IO () -setAccount auth addr acc = unNil <$> callApi auth "setaccount" [ tj addr, tj acc ] +setAccount :: Client -> Address -> Account -> IO () +setAccount client addr acc = unNil <$> callApi client "setaccount" [ tj addr, tj acc ] -- | Returns the account associated with the given address. -getAccount :: Auth -> Address -> IO Account -getAccount auth addr = callApi auth "getaccount" [ tj addr ] +getAccount :: Client -> Address -> IO Account +getAccount client addr = callApi client "getaccount" [ tj addr ] -- | Returns the list of addresses for the given address. -getAddressesByAccount :: Auth -> Account -> IO (Vector Address) -getAddressesByAccount auth acc = callApi auth "getaddressesbyaccount" [ tj acc ] +getAddressesByAccount :: Client -> Account -> IO (Vector Address) +getAddressesByAccount client acc = callApi client "getaddressesbyaccount" [ tj acc ] -- | Sends some bitcoins to an address. -sendToAddress :: Auth +sendToAddress :: Client -> Address -- ^ Who we're sending to. -> BTC @@ -172,8 +173,8 @@ sendToAddress :: Auth -- ^ An optional comment-to (who did we sent this to?) for the -- transaction. -> IO TransactionID -sendToAddress auth addr amount comm comm2 = - callApi auth "sendtoaddress" [ tj addr, tj amount, tj comm, tj comm2 ] +sendToAddress client addr amount comm comm2 = + callApi client "sendtoaddress" [ tj addr, tj amount, tj comm, tj comm2 ] -- | Information on a given address. data AddressInfo = AddressInfo { -- | The address in question. @@ -199,25 +200,25 @@ instance FromJSON AddressInfo where -- | Lists groups of addresses which have had their common ownership made -- public by common use as inputs or as the resulting change in past -- transactions. -listAddressGroupings :: Auth +listAddressGroupings :: Client -> IO (Vector (Vector AddressInfo)) -listAddressGroupings auth = - callApi auth "listaddressgroupings" [] +listAddressGroupings client = + callApi client "listaddressgroupings" [] -- | A signature is a base-64 encoded string. type Signature = HexString -- | Sign a message with the private key of an address. -signMessage :: Auth +signMessage :: Client -> Address -- ^ The address whose private key we'll use. -> Text -- ^ The message to sign. -> IO Signature -signMessage auth addr msg = callApi auth "signmessage" [ tj addr, tj msg ] +signMessage client addr msg = callApi client "signmessage" [ tj addr, tj msg ] -- | Verifies a signed message. -verifyMessage :: Auth +verifyMessage :: Client -> Address -- ^ The address of the original signer. -> Signature @@ -226,80 +227,80 @@ verifyMessage :: Auth -- ^ The message. -> IO Bool -- ^ Was the signature valid? -verifyMessage auth addr sig msg = - callApi auth "verifymessage" [ tj addr, tj sig, tj msg ] +verifyMessage client addr sig msg = + callApi client "verifymessage" [ tj addr, tj sig, tj msg ] -- | Returns the total amount received by the given address with at least one -- confirmation. -getReceivedByAddress :: Auth -> Address -> IO BTC -getReceivedByAddress auth addr = - callApi auth "getreceivedbyaddress" [ tj addr ] +getReceivedByAddress :: Client -> Address -> IO BTC +getReceivedByAddress client addr = + callApi client "getreceivedbyaddress" [ tj addr ] -- | Returns the total amount received by the given address, with at least the -- give number of confirmations. -getReceivedByAddress' :: Auth +getReceivedByAddress' :: Client -> Address -> Int -- ^ The minimum number of confirmations needed -- for a transaction to to count towards the -- total. -> IO BTC -getReceivedByAddress' auth addr minconf = - callApi auth "getreceivedbyaddress" [ tj addr, tj minconf ] +getReceivedByAddress' client addr minconf = + callApi client "getreceivedbyaddress" [ tj addr, tj minconf ] -- | Returns the total amount received by address with the given account. -getReceivedByAccount :: Auth -> Account -> IO BTC -getReceivedByAccount auth acc = - callApi auth "getreceivedbyaccount" [ tj acc ] +getReceivedByAccount :: Client -> Account -> IO BTC +getReceivedByAccount client acc = + callApi client "getreceivedbyaccount" [ tj acc ] -- | Returns the total amount received by addresses with the given account, -- counting only transactions with the given minimum number of confirmations. -getReceivedByAccount' :: Auth +getReceivedByAccount' :: Client -> Account -- ^ The account in question. -> Int -- ^ The minimum number of confirmations needed for a -- transaction to count towards the total. -> IO BTC -getReceivedByAccount' auth acc minconf = - callApi auth "getreceivedbyaccount" [ tj acc, tj minconf ] +getReceivedByAccount' client acc minconf = + callApi client "getreceivedbyaccount" [ tj acc, tj minconf ] -- | Returns the server's total available balance. -getBalance :: Auth +getBalance :: Client -> IO BTC -getBalance auth = - callApi auth "getbalance" [] +getBalance client = + callApi client "getbalance" [] -- | Returns the balance in the given account, counting only transactions with -- at least one confirmation. -getBalance' :: Auth +getBalance' :: Client -> Account -> IO BTC -getBalance' auth acc = - callApi auth "getbalance" [ tj acc ] +getBalance' client acc = + callApi client "getbalance" [ tj acc ] -- | Returns the balance in the given account, counting only transactions with -- at least the given number of confirmations. -getBalance'' :: Auth +getBalance'' :: Client -> Account -> Int -- ^ The minimum number of confirmations needed for a transaction -- to count towards the total. -> IO BTC -getBalance'' auth acc minconf = - callApi auth "getbalance" [ tj acc, tj minconf ] +getBalance'' client acc minconf = + callApi client "getbalance" [ tj acc, tj minconf ] -- | Move bitcoins from one account in your wallet to another. -- -- If you want to send bitcoins to an address not in your wallet, use -- 'sendFromAccount'. -moveBitcoins :: Auth +moveBitcoins :: Client -> Account -- ^ From. -> Account -- ^ To. -> BTC -- ^ The amount to transfer. -> Text -- ^ A comment to record for the transaction. -> IO () -moveBitcoins auth from to amt comm = - stupidAPI <$> callApi auth "move" [ tj from, tj to, tj amt, tj one, tj comm ] +moveBitcoins client from to amt comm = + stupidAPI <$> callApi client "move" [ tj from, tj to, tj amt, tj one, tj comm ] where one = 1 :: Int -- needs a type, else default-integer warnings. stupidAPI :: Bool -> () stupidAPI = const () @@ -307,7 +308,7 @@ moveBitcoins auth from to amt comm = -- | Sends bitcoins from a given account in our wallet to a given address. -- -- A transaction and sender comment may be optionally provided. -sendFromAccount :: Auth +sendFromAccount :: Client -> Account -- ^ The account to send from. -> Address @@ -319,12 +320,12 @@ sendFromAccount :: Auth -> Maybe Text -- ^ An optional comment on who the money is going to. -> IO TransactionID -sendFromAccount auth from to amount comm comm2 = - callApi auth "sendfrom" [ tj from, tj to, tj amount, tj one, tj comm, tj comm2 ] +sendFromAccount client from to amount comm comm2 = + callApi client "sendfrom" [ tj from, tj to, tj amount, tj one, tj comm, tj comm2 ] where one = 1 :: Int -- needs a type, else default-integer warnings. -- | Send to a whole bunch of address at once. -sendMany :: Auth +sendMany :: Client -> Account -- ^ The account to send from. -> Vector (Address, BTC) @@ -332,8 +333,8 @@ sendMany :: Auth -> Maybe Text -- ^ An optional transaction comment. -> IO TransactionID -sendMany auth acc amounts comm = - callApi auth "sendmany" [ tj acc, tj $ AA amounts, tj comm ] +sendMany client acc amounts comm = + callApi client "sendmany" [ tj acc, tj $ AA amounts, tj comm ] -- TODO: createmultisig. -- @@ -363,12 +364,12 @@ instance FromJSON ReceivedByAddress where -- | Lists the amount received by each address which has received money at some -- point, counting only transactions with at least one confirmation. -listReceivedByAddress :: Auth -> IO (Vector ReceivedByAddress) -listReceivedByAddress auth = listReceivedByAddress' auth 1 False +listReceivedByAddress :: Client -> IO (Vector ReceivedByAddress) +listReceivedByAddress client = listReceivedByAddress' client 1 False -- | List the amount received by each of our addresses, counting only -- transactions with the given minimum number of confirmations. -listReceivedByAddress' :: Auth +listReceivedByAddress' :: Client -> Int -- ^ The minimum number of confirmations before a -- transaction counts toward the total amount @@ -377,8 +378,8 @@ listReceivedByAddress' :: Auth -- ^ Should we include addresses with no money -- received? -> IO (Vector ReceivedByAddress) -listReceivedByAddress' auth minconf includeEmpty = - callApi auth "listreceivedbyaddress" [ tj minconf, tj includeEmpty ] +listReceivedByAddress' client minconf includeEmpty = + callApi client "listreceivedbyaddress" [ tj minconf, tj includeEmpty ] data ReceivedByAccount = ReceivedByAccount { raccAccount :: Account @@ -399,12 +400,12 @@ instance FromJSON ReceivedByAccount where -- | Lists the amount received by each account which has received money at some -- point, counting only transactions with at leaset one confirmation. -listReceivedByAccount :: Auth -> IO (Vector ReceivedByAccount) -listReceivedByAccount auth = listReceivedByAccount' auth 1 False +listReceivedByAccount :: Client -> IO (Vector ReceivedByAccount) +listReceivedByAccount client = listReceivedByAccount' client 1 False -- | List the amount received by each of our accounts, counting only -- transactions with the given minimum number of confirmations. -listReceivedByAccount' :: Auth +listReceivedByAccount' :: Client -> Int -- ^ The minimum number of confirmations before a -- transaction counts toward the total received. @@ -412,8 +413,8 @@ listReceivedByAccount' :: Auth -- ^ Should we include the accounts with no money -- received? -> IO (Vector ReceivedByAccount) -listReceivedByAccount' auth minconf includeEmpty = - callApi auth "listreceivedbyaccount" [ tj minconf, tj includeEmpty ] +listReceivedByAccount' client minconf includeEmpty = + callApi client "listreceivedbyaccount" [ tj minconf, tj includeEmpty ] data SinceBlock = @@ -522,7 +523,7 @@ instance FromJSON TransactionCategory where parseJSON _ = mzero -- | Gets all transactions in blocks since the given block. -listSinceBlock :: Auth +listSinceBlock :: Client -> BlockHash -- ^ The hash of the first block to list. -> Maybe Int @@ -531,12 +532,12 @@ listSinceBlock :: Auth -- not in any way affect which transactions are returned -- (see https://github.com/bitcoin/bitcoin/pull/199#issuecomment-1514952) -> IO (SinceBlock) -listSinceBlock auth blockHash conf = - listSinceBlock' auth (Just blockHash) conf +listSinceBlock client blockHash conf = + listSinceBlock' client (Just blockHash) conf -- | Gets all transactions in blocks since the given block, or all -- transactions if ommited. -listSinceBlock' :: Auth +listSinceBlock' :: Client -> Maybe BlockHash -- ^ The hash of the first block to list. -> Maybe Int @@ -545,12 +546,12 @@ listSinceBlock' :: Auth -- not in any way affect which transactions are returned -- (see https://github.com/bitcoin/bitcoin/pull/199#issuecomment-1514952) -> IO (SinceBlock) -listSinceBlock' auth mblockHash mminConf = - callApi auth "listsinceblock" $ tja mblockHash ++ tja mminConf +listSinceBlock' client mblockHash mminConf = + callApi client "listsinceblock" $ tja mblockHash ++ tja mminConf -- | Returns transactions from the blockchain. -listTransactions :: Auth +listTransactions :: Client -> Account -- ^ Limits the 'BlockTransaction' returned to those from or to -- the given 'Account'. @@ -559,11 +560,11 @@ listTransactions :: Auth -> Int -- ^ Number of most recent transactions to skip. -> IO (Vector SimpleTransaction) -listTransactions auth account size from = - listTransactions' auth (Just account) (Just size) (Just from) +listTransactions client account size from = + listTransactions' client (Just account) (Just size) (Just from) -- | Returns transactions from the blockchain. -listTransactions' :: Auth +listTransactions' :: Client -> Maybe Account -- ^ Limits the 'BlockTransaction' returned to those from or to -- the given 'Account'. If 'Nothing' all accounts are @@ -574,18 +575,18 @@ listTransactions' :: Auth -> Maybe Int -- ^ Number of most recent transactions to skip. -> IO (Vector SimpleTransaction) -listTransactions' auth maccount mcount mfrom = - callApi auth "listtransactions" $ [ tjm "*" maccount ] ++ tja mcount ++ tja mfrom +listTransactions' client maccount mcount mfrom = + callApi client "listtransactions" $ [ tjm "*" maccount ] ++ tja mcount ++ tja mfrom -- | List accounts and their current balance. -listAccounts :: Auth +listAccounts :: Client -> Maybe Int -- ^ Minimum number of confirmations required before payments are -- included in the balance. -> IO (HM.HashMap Account BTC) -listAccounts auth mconf = - callApi auth "listaccounts" [ tjm 1 mconf ] +listAccounts client mconf = + callApi client "listaccounts" [ tjm 1 mconf ] -- | Data type for detailed transactions. Rules involving 'trCategory' are -- indications of the most probable value only when the transaction is @@ -659,44 +660,44 @@ instance FromJSON DetailedTransactionDetails where <*> o .: "amount" parseJSON _ = mzero -getTransaction :: Auth +getTransaction :: Client -> TransactionID -> IO (DetailedTransaction) -getTransaction auth txid = - callApi auth "gettransaction" [ tj txid ] +getTransaction client txid = + callApi client "gettransaction" [ tj txid ] -- | Safely copies wallet.dat to the given destination, which can be either a -- directory, or a path with filename. -backupWallet :: Auth +backupWallet :: Client -> FilePath -> IO () -backupWallet auth fp = - unNil <$> callApi auth "backupwallet" [ tj fp ] +backupWallet client fp = + unNil <$> callApi client "backupwallet" [ tj fp ] -- | Fills the keypool. -keyPoolRefill :: Auth -> IO () -keyPoolRefill auth = unNil <$> callApi auth "keypoolrefill" [] +keyPoolRefill :: Client -> IO () +keyPoolRefill client = unNil <$> callApi client "keypoolrefill" [] -- | Stores the wallet decryption key in memory for the given amount of time. -unlockWallet :: Auth +unlockWallet :: Client -> Text -- ^ The decryption key. -> Integer -- ^ How long to store the key in memory (in seconds). -> IO () -unlockWallet auth pass timeout = - unNil <$> callApi auth "walletpassphrase" [ tj pass, tj timeout ] +unlockWallet client pass timeout = + unNil <$> callApi client "walletpassphrase" [ tj pass, tj timeout ] -- | Changes the wallet passphrase. -changePassword :: Auth +changePassword :: Client -> Text -- ^ The old password. -> Text -- ^ The new password. -> IO () -changePassword auth old new = - unNil <$> callApi auth "walletpassphrase" [ tj old, tj new ] +changePassword client old new = + unNil <$> callApi client "walletpassphrase" [ tj old, tj new ] -- | Removes the wallet encryption key from memory, locking the wallet. -- @@ -705,15 +706,15 @@ changePassword auth old new = -- -- Note: In future releases, we might introduce an "unlocked" monad, so -- locking and unlocking is automatic. -lockWallet :: Auth -> IO () -lockWallet auth = unNil <$> callApi auth "walletlock" [] +lockWallet :: Client -> IO () +lockWallet client = unNil <$> callApi client "walletlock" [] -- | Encrypts the wallet with the given passphrase. -- -- WARNING: bitcoind will shut down after calling this method. Don't say I -- didn't warn you. -encryptWallet :: Auth -> Text -> IO () -encryptWallet auth pass = stupidAPI <$> callApi auth "encryptwallet" [ tj pass ] +encryptWallet :: Client -> Text -> IO () +encryptWallet client pass = stupidAPI <$> callApi client "encryptwallet" [ tj pass ] where stupidAPI :: Text -> () stupidAPI = const () @@ -727,5 +728,5 @@ instance FromJSON IsValid where parseJSON _ = mzero -- | Checks if a given address is a valid one. -isAddressValid :: Auth -> Address -> IO Bool -isAddressValid auth addr = getValid <$> callApi auth "validateaddress" [ tj addr ] +isAddressValid :: Client -> Address -> IO Bool +isAddressValid client addr = getValid <$> callApi client "validateaddress" [ tj addr ] diff --git a/src/Test/Main.hs b/src/Test/Main.hs index 0c3fec3..290fcd7 100644 --- a/src/Test/Main.hs +++ b/src/Test/Main.hs @@ -23,13 +23,13 @@ qcOnce = quickCheckWith stdArgs { maxSuccess = 1 } -auth :: Auth -auth = Auth "http://localhost:18332" "bitcoinrpc" "bitcoinrpcpassword" +client :: IO Client +client = getClient "http://127.0.0.1:18332" "bitcoinrpc" "bitcoinrpcpassword" canGetInfo :: Property canGetInfo = monadicIO $ do - info <- run $ getBitcoindInfo auth + info <- run $ getBitcoindInfo =<< client let checks = [ bitcoinVersion info > 80000 , onTestNetwork info , bitcoindErrors info == "" @@ -39,12 +39,12 @@ canGetInfo = monadicIO $ do canListUnspent :: Property canListUnspent = monadicIO $ do - _ <- run $ listUnspent auth Nothing Nothing Data.Vector.empty + _ <- run $ (\c -> listUnspent c Nothing Nothing Data.Vector.empty) =<< client assert True canGetOutputInfo :: Property canGetOutputInfo = monadicIO $ do - info <- run $ getOutputInfo auth "ab8e26fd95fa371ac15b43684d0c6797fb573757095e7d763ba86ad315f7db04" 1 + info <- run $ (\c-> getOutputInfo c "ab8e26fd95fa371ac15b43684d0c6797fb573757095e7d763ba86ad315f7db04" 1) =<< client _ <- run $ print info assert True From 74f72fe307c47dc0704dd374691584ee7765c93b Mon Sep 17 00:00:00 2001 From: charlescharles Date: Sun, 8 Feb 2015 17:06:23 -0500 Subject: [PATCH 65/73] Fix boolean parsing in signrawtransaction response --- src/Network/Bitcoin/RawTransaction.hs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/Network/Bitcoin/RawTransaction.hs b/src/Network/Bitcoin/RawTransaction.hs index 5f12968..4cb3a4d 100644 --- a/src/Network/Bitcoin/RawTransaction.hs +++ b/src/Network/Bitcoin/RawTransaction.hs @@ -342,10 +342,9 @@ data RawSignedTransaction = , hasCompleteSigSet :: Bool } --- I have no idea why they use a 1/0 to represent a boolean. instance FromJSON RawSignedTransaction where parseJSON (Object o) = RawSignedTransaction <$> o .: "hex" - <*> (toEnum <$> o .: "complete") + <*> o .: "complete" parseJSON _ = mzero -- | Sign inputs for a raw transaction. From f3bbfc6d47f02bcc2a4f97eec4390837ac2aacf5 Mon Sep 17 00:00:00 2001 From: Eric Pashman Date: Tue, 10 Feb 2015 15:16:25 -0600 Subject: [PATCH 66/73] Rewrite `getClient` to remove `fromJust` and expose `InvalidUrlException` thrown by `parseUrl`, fixing #18. --- src/Network/Bitcoin/Internal.hs | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/src/Network/Bitcoin/Internal.hs b/src/Network/Bitcoin/Internal.hs index fe94b24..3472a7f 100644 --- a/src/Network/Bitcoin/Internal.hs +++ b/src/Network/Bitcoin/Internal.hs @@ -74,15 +74,14 @@ getClient :: String -> BS.ByteString -> IO Client getClient url user pass = do + url' <- parseUrl url mgr <- newManager defaultManagerSettings + let baseReq = applyBasicAuth user pass url' + { method = "POST" + , requestHeaders = [(hContentType, "application/json")] } return $ \r -> do resp <- httpLbs (baseReq { requestBody = RequestBodyLBS r }) mgr return $ responseBody resp - where - baseReq = applyBasicAuth user pass $ (fromJust $ parseUrl url) - { method = "POST" - , requestHeaders = [(hContentType, "application/json")] - } -- | 'callApi' is a low-level interface for making authenticated API -- calls to a Bitcoin daemon. The first argument specifies From f7c82ac9b0412be45d8972462cf025efee29f424 Mon Sep 17 00:00:00 2001 From: Clark Gaebel Date: Tue, 10 Feb 2015 17:03:20 -0500 Subject: [PATCH 67/73] version bump --- network-bitcoin.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/network-bitcoin.cabal b/network-bitcoin.cabal index fd0c969..856f462 100644 --- a/network-bitcoin.cabal +++ b/network-bitcoin.cabal @@ -1,5 +1,5 @@ Name: network-bitcoin -Version: 1.7.0 +Version: 1.7.1 Synopsis: An interface to bitcoind. Description: This can be used to send Bitcoins, query balances, etc. It From 2bc1de2f257d544a495919f643c58a5f0e2803fc Mon Sep 17 00:00:00 2001 From: Jakob Runge Date: Wed, 1 Apr 2015 15:55:22 +0200 Subject: [PATCH 68/73] Fixed changePassword changePassword called "walletpassphrase" just like unlockWallet, when instead it should call "walletpassphrasechange" according to https://en.bitcoin.it/wiki/Original_Bitcoin_client/API_Calls_list --- src/Network/Bitcoin/Wallet.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Network/Bitcoin/Wallet.hs b/src/Network/Bitcoin/Wallet.hs index 10ba4e1..d0cb613 100644 --- a/src/Network/Bitcoin/Wallet.hs +++ b/src/Network/Bitcoin/Wallet.hs @@ -697,7 +697,7 @@ changePassword :: Client -- ^ The new password. -> IO () changePassword client old new = - unNil <$> callApi client "walletpassphrase" [ tj old, tj new ] + unNil <$> callApi client "walletpassphrasechange" [ tj old, tj new ] -- | Removes the wallet encryption key from memory, locking the wallet. -- From 1afdf4bb7c3fe7bfb84893bb1dc855f009322981 Mon Sep 17 00:00:00 2001 From: Clark Gaebel Date: Wed, 1 Apr 2015 11:39:59 -0400 Subject: [PATCH 69/73] little update + version bump --- network-bitcoin.cabal | 2 +- src/Network/Bitcoin/Internal.hs | 7 ++----- 2 files changed, 3 insertions(+), 6 deletions(-) diff --git a/network-bitcoin.cabal b/network-bitcoin.cabal index 856f462..2f77de3 100644 --- a/network-bitcoin.cabal +++ b/network-bitcoin.cabal @@ -1,5 +1,5 @@ Name: network-bitcoin -Version: 1.7.1 +Version: 1.7.2 Synopsis: An interface to bitcoind. Description: This can be used to send Bitcoins, query balances, etc. It diff --git a/src/Network/Bitcoin/Internal.hs b/src/Network/Bitcoin/Internal.hs index 3472a7f..3847051 100644 --- a/src/Network/Bitcoin/Internal.hs +++ b/src/Network/Bitcoin/Internal.hs @@ -32,10 +32,8 @@ import Data.Maybe import Data.Vector ( Vector ) import qualified Data.Vector as V import Network.Bitcoin.Types -import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString as BS import Data.Text ( Text ) -import qualified Data.Text as T import Network.HTTP.Client import Network.HTTP.Types.Header @@ -85,14 +83,14 @@ getClient url user pass = do -- | 'callApi' is a low-level interface for making authenticated API -- calls to a Bitcoin daemon. The first argument specifies --- rpc client details (URL, username, password) +-- rpc client details (URL, username, password) -- -- The second argument is the command name. The third argument provides -- parameters for the API call. -- -- > genHash = do -- client <- getClient "http://127.0.0.1:8332" "user" "password" --- callApi client "getblockhash" [tj 0] +-- callApi client "getblockhash" [tj 0] -- -- On error, throws a 'BitcoinException'. callApi :: FromJSON v @@ -145,4 +143,3 @@ newtype AddrAddress = AA (Vector (Address, BTC)) instance ToJSON AddrAddress where toJSON (AA vec) = object . V.toList $ uncurry (.=) <$> vec - From 50bc0060b9a3bcf7c720b86c5a0c522b735d2fec Mon Sep 17 00:00:00 2001 From: Jakob Runge Date: Fri, 3 Apr 2015 12:31:24 +0200 Subject: [PATCH 70/73] Fixed setGenerate in regtest mode When calling setGenerate while running bitcoind in regtest mode, setGenerate is supposed to parse a [HexString] rather than Nil in some cases. In regtest mode the setgenerate API call doesn't take a number of processors, but rather a number of hashes to generate, and than proceeds to return these hashes. --- src/Network/Bitcoin/Internal.hs | 8 ++++++++ src/Network/Bitcoin/Mining.hs | 10 +++++++--- 2 files changed, 15 insertions(+), 3 deletions(-) diff --git a/src/Network/Bitcoin/Internal.hs b/src/Network/Bitcoin/Internal.hs index 3847051..c815cf9 100644 --- a/src/Network/Bitcoin/Internal.hs +++ b/src/Network/Bitcoin/Internal.hs @@ -17,6 +17,7 @@ module Network.Bitcoin.Internal ( module Network.Bitcoin.Types , callApi , getClient , Nil(..) + , NilOrArray(..) , tj , tjm , tja @@ -122,6 +123,13 @@ instance FromJSON Nil where parseJSON Null = return $ Nil () parseJSON x = fail $ "\"null\" was expected, but " ++ show x ++ " was recieved." +-- | Used to parse "null" or [HexString] +data NilOrArray = NilOrArray {unArr :: Maybe [HexString]} + +instance FromJSON NilOrArray where + parseJSON Null = return $ NilOrArray Nothing + parseJSON a@(Array _) = liftM NilOrArray $ parseJSON a + parseJSON x = fail $ "Expected \"null\" or array, but " ++ show x ++ " was recieved." -- | A handy shortcut for toJSON, because I'm lazy. tj :: ToJSON a => a -> Value diff --git a/src/Network/Bitcoin/Mining.hs b/src/Network/Bitcoin/Mining.hs index 62fb411..da98008 100644 --- a/src/Network/Bitcoin/Mining.hs +++ b/src/Network/Bitcoin/Mining.hs @@ -40,17 +40,21 @@ getGenerate :: Client -- ^ bitcoind RPC client getGenerate client = callApi client "getgenerate" [] -- | Controls whether or not bitcoind is generating bitcoins. +-- If bitcoind runs in regtest mode the number of generated hashes is returned. +-- See https://bitcoin.org/en/developer-reference#setgenerate for more details. setGenerate :: Client -- ^ bitcoind RPC client -> Bool -- ^ Turn it on, or turn it off? -> Maybe Int -- ^ Generation is limited to this number of -- processors. Set it to Nothing to keep the value -- at what it was before, Just -1 to use all -- available cores, and any other value to limit it. - -> IO () + -- If bitcoind runs in regtest mode instead of the number of processors, + -- this specifies the number of hashes to generate. + -> IO (Maybe [HexString]) setGenerate client onOff Nothing = - unNil <$> callApi client "setgenerate" [ tj onOff ] + unArr <$> callApi client "setgenerate" [ tj onOff ] setGenerate client onOff (Just limit) = - unNil <$> callApi client "setgenerate" [ tj onOff, tj limit ] + unArr <$> callApi client "setgenerate" [ tj onOff, tj limit ] -- | Returns a recent hashes per second performance measurement while -- generating. From 89a3b29e0b93dadacbc2df549925d4ff1f2ca03a Mon Sep 17 00:00:00 2001 From: Clark Gaebel Date: Fri, 3 Apr 2015 12:20:26 -0400 Subject: [PATCH 71/73] bump minor version --- network-bitcoin.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/network-bitcoin.cabal b/network-bitcoin.cabal index 2f77de3..543fbe8 100644 --- a/network-bitcoin.cabal +++ b/network-bitcoin.cabal @@ -1,5 +1,5 @@ Name: network-bitcoin -Version: 1.7.2 +Version: 1.8.0 Synopsis: An interface to bitcoind. Description: This can be used to send Bitcoins, query balances, etc. It From 636facc92ee4a5dd41474348ecaef7080dc05a8a Mon Sep 17 00:00:00 2001 From: Jakob Runge Date: Tue, 7 Apr 2015 18:25:55 +0200 Subject: [PATCH 72/73] Bugfix in sendMany According to [1], sendMany expects a number of minimum confirmations as its third parameter. With null or the comment given as third parameter, as before, bitcoind complained in regtest mode and didn't process the request as expected. [1]: https://bitcoin.org/en/developer-reference#sendmany --- src/Network/Bitcoin/Wallet.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Network/Bitcoin/Wallet.hs b/src/Network/Bitcoin/Wallet.hs index d0cb613..16c5404 100644 --- a/src/Network/Bitcoin/Wallet.hs +++ b/src/Network/Bitcoin/Wallet.hs @@ -334,7 +334,7 @@ sendMany :: Client -- ^ An optional transaction comment. -> IO TransactionID sendMany client acc amounts comm = - callApi client "sendmany" [ tj acc, tj $ AA amounts, tj comm ] + callApi client "sendmany" [ tj acc, tj $ AA amounts, tj (1 :: Int), tj comm ] -- TODO: createmultisig. -- From 4fe4a123635d7b5642a13a5242acc8b544c4eef9 Mon Sep 17 00:00:00 2001 From: Clark Gaebel Date: Tue, 7 Apr 2015 12:48:41 -0400 Subject: [PATCH 73/73] version bump --- network-bitcoin.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/network-bitcoin.cabal b/network-bitcoin.cabal index 543fbe8..2ea9dae 100644 --- a/network-bitcoin.cabal +++ b/network-bitcoin.cabal @@ -1,5 +1,5 @@ Name: network-bitcoin -Version: 1.8.0 +Version: 1.8.1 Synopsis: An interface to bitcoind. Description: This can be used to send Bitcoins, query balances, etc. It