diff --git a/network-bitcoin.cabal b/network-bitcoin.cabal --- a/network-bitcoin.cabal +++ b/network-bitcoin.cabal @@ -1,5 +1,5 @@ Name: network-bitcoin -Version: 1.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 @@ 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 @@ 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, + http-client >= 0.4.6, network-bitcoin - diff --git a/src/Network/Bitcoin.hs b/src/Network/Bitcoin.hs --- 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 --- 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.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 @@ 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 @@ 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 @@ 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 --- a/src/Network/Bitcoin/Dump.hs +++ b/src/Network/Bitcoin/Dump.hs @@ -17,18 +17,18 @@ 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 --- a/src/Network/Bitcoin/Internal.hs +++ b/src/Network/Bitcoin/Internal.hs @@ -15,7 +15,7 @@ , Text, Vector , FromJSON(..) , callApi - , callApi' + , getClient , Nil(..) , tj , tjm @@ -32,13 +32,14 @@ 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. data BitcoinRpcError = NoError -- ^ All good. @@ -63,40 +64,44 @@ <*> 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 @@ 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 --- 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 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 @@ 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 @@ 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 @@ 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 @@ 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 --- 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 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 @@ 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 --- 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 @@ 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 @@ -- | 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 @@ -- | 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 @@ -- 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 @@ 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 @@ 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 @@ -> 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 --- 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.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 --- 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 @@ 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 @@ -- -- 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 @@ -- ^ 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 @@ -- | 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 @@ -- ^ 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 @@ -- | 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 @@ -> 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 @@ -> 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 @@ -- | 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 @@ -- ^ 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 @@ -- | 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 @@ -- ^ 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 @@ 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 @@ -- 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 @@ -- 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 @@ -> 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 @@ -> 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 @@ <*> 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 @@ -- -- 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 @@ 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 --- a/src/Test/Main.hs +++ b/src/Test/Main.hs @@ -23,13 +23,13 @@ } -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 @@ 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