diff --git a/.gitignore b/.gitignore index a3ba534..6fbacef 100644 --- a/.gitignore +++ b/.gitignore @@ -6,3 +6,7 @@ .project Setup.hs dist/ +cabal-dev/ +network-bitcoin-tests +cabal.sandbox.config +.cabal-sandbox/ diff --git a/.travis.yml b/.travis.yml new file mode 100644 index 0000000..2e73c85 --- /dev/null +++ b/.travis.yml @@ -0,0 +1,11 @@ +language: haskell +notifications: + email: + - cg.wowus.cg@gmail.com + on_success: always + on_failure: always +install: + - cabal install --only-dependencies + - cabal configure + - cabal build + - cabal haddock 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/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 d96e71e..2ea9dae 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.1.5 - --- A short (one-line) description of the package. -Synopsis: Interface with Bitcoin RPC - --- A longer description of the package. +Version: 1.8.1 +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 @@ -27,77 +15,75 @@ Description: > auth = Auth "http://127.0.0.1:8332" "user" "password" . To learn more about Bitcoin, see . - . - Changes in v0.1.5 - . - - Correct aeson dependency - . - 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: Clark Gaebel - -Stability: experimental -Homepage: http://github.com/mndrix/network-bitcoin -Bug-reports: http://github.com/mndrix/network-bitcoin/issues - --- A copyright notice. -Copyright: Copyright 2011, 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: 2012 Michael Hendricks + 2013 Clark Gaebel +Stability: experimental +Homepage: http://github.com/mndrix/network-bitcoin +Bug-reports: http://github.com/wowus/network-bitcoin/issues 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 - +tested-with: GHC ==7.4.1, GHC ==7.6.2, GHC ==7.6.3 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 - - -- Packages needed in order to build this package. - Build-depends: - aeson == 0.3.*, - attoparsec >= 0.7, - bytestring >= 0.9, - containers >= 0.4, + Network.Bitcoin.BlockChain + Network.Bitcoin.Dump + Network.Bitcoin.Internal + Network.Bitcoin.Mining + Network.Bitcoin.Net + Network.Bitcoin.RawTransaction + Network.Bitcoin.Types + Network.Bitcoin.Wallet + + Build-depends: + aeson >= 0.8, + bytestring >= 0.9 && < 0.11, + cookie >= 0.4, + attoparsec == 0.12.*, + unordered-containers >= 0.2, HTTP >= 4000, + http-types >= 0.8.5, network >= 2.3, text >= 0.11, - base == 4.* - - -- Modules not exported by this package. - -- Other-modules: - - -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source. - -- Build-tools: + vector >= 0.10, + base == 4.*, + time >= 1.4.2, + http-client >= 0.4.6 -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 + type: git + location: git://github.com/wowus/network-bitcoin.git + +Executable network-bitcoin-tests + hs-source-dirs: src + ghc-options: -Wall + main-is: Test/Main.hs + build-depends: + aeson >= 0.8, + bytestring >= 0.9 && < 0.11, + 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 \ No newline at end of file diff --git a/src/Network/Bitcoin.hs b/src/Network/Bitcoin.hs index d7e7e7e..c2036d4 100644 --- a/src/Network/Bitcoin.hs +++ b/src/Network/Bitcoin.hs @@ -1,287 +1,126 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE TypeSynonymInstances #-} -{-# LANGUAGE FlexibleInstances #-} --- | Communicate with a Bitcoin daemon over JSON RPC +{-# OPTIONS_GHC -Wall #-} +-- | A Haskell binding to the bitcoind server. module Network.Bitcoin ( - -- * Types - Auth(..) - , Address - , mkAddress - , Amount - , Account - , MinConf - , AddressValidation - , isValid - , isMine - , account + -- * Common Types + Client + , getClient , BitcoinException(..) + , HexString + , TransactionID , Satoshi(..) - - -- * Individual API methods - , getBalance + , BTC + , Account + , Address + , ScriptSig + -- * Block Chain Operations , getBlockCount - , getConnectionCount , getDifficulty + , setTransactionFee + , getRawMemoryPool + , BlockHash + , getBlockHash + , Block(..) + , getBlock + , OutputSetInfo(..) + , getOutputSetInfo + , OutputInfo(..) + , getOutputInfo + -- * Private Key Operations + , importPrivateKey + , dumpPrivateKey + -- * Mining Operations , getGenerate + , setGenerate , getHashesPerSec - , getReceivedByAccount + , 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 - , validateAddress - , isValidAddress - - -- * Low-level API - , callApi - , FromNumber - , fromNumber + , getReceivedByAddress' + , getReceivedByAccount + , getReceivedByAccount' + , getBalance + , getBalance' + , getBalance'' + , moveBitcoins + , sendFromAccount + , sendMany + -- , createMultiSig + , ReceivedByAddress(..) + , listReceivedByAddress + , listReceivedByAddress' + , ReceivedByAccount(..) + , listReceivedByAccount + , listReceivedByAccount' + , listTransactions + , listTransactions' + , listAccounts + , SinceBlock(..) + , SimpleTransaction(..) + , TransactionCategory(..) + , listSinceBlock + , listSinceBlock' + , DetailedTransaction(..) + , DetailedTransactionDetails(..) + , getTransaction + , backupWallet + , keyPoolRefill + , unlockWallet + , lockWallet + , changePassword + , encryptWallet + , isAddressValid ) where -import Network.Bitcoin.Address - -import Control.Applicative -import Control.Exception -import Control.Monad -import Data.Aeson -import Data.Attoparsec -import Data.Attoparsec.Number -import Data.Fixed -import Data.Maybe (fromJust) -import Data.Ratio ((%)) -import Data.String (fromString) -import Data.Typeable -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 qualified Data.Text as T - --- | Defines Bitcoin's internal precision -satoshis :: Integer -satoshis = 10^(8::Integer) -data Satoshi = Satoshi -instance HasResolution Satoshi where - resolution _ = satoshis - --- | Fixed precision Bitcoin amount (to avoid floating point errors) -type Amount = Fixed Satoshi - --- | Name of a Bitcoin wallet account -type Account = String - --- | 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 :: String -- ^ URL, with port, where bitcoind listens - , rpcUser :: String -- ^ same as bitcoind's 'rpcuser' config - , rpcPassword :: String -- ^ same as bitcoind's 'rpcpassword' config - } - deriving (Show) - -data BitcoinRpcResponse = BitcoinRpcResponse { - btcResult :: Value, - btcError :: Value - } - deriving (Show) -instance FromJSON BitcoinRpcResponse 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@. -data BitcoinException - = BitcoinApiError Int String - deriving (Show,Typeable) -instance Exception BitcoinException - --- encodes an RPC request into a ByteString containing JSON -jsonRpcReqBody :: String -> [Value] -> BL.ByteString -jsonRpcReqBody cmd params = encode $ object [ - "jsonrpc" .= ("2.0"::String), - "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" ["account-name", Number 6] --- --- On error, throws a 'BitcoinException' -callApi :: Auth -- ^ authentication credentials for bitcoind - -> String -- ^ command name - -> [Value] -- ^ command arguments - -> IO Value -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 - 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 -httpAuthority :: Auth -> Authority -httpAuthority (Auth urlString username password) = - AuthBasic { - auRealm = "jsonrpc", - auUsername = username, - auPassword = password, - auSite = uri - } - where uri = fromJust $ parseURI urlString -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) - ] - } - -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 -getBalance :: Auth - -> Account - -> MinConf - -> IO Amount -getBalance auth acct minconf = callNumber "getbalance" args auth - where - args = [ String $ fromString acct, Number $ fromInteger minconf ] - --- | Returns the number of blocks in the longest block chain -getBlockCount :: Auth -> IO Integer -getBlockCount = callNumber "getblockcount" [] - --- | Returns the number of connections to other nodes -getConnectionCount :: Auth -> IO Integer -getConnectionCount = callNumber "getconnectioncount" [] - --- | Returns the proof-of-work difficulty as a multiple of the minimum --- difficulty -getDifficulty :: Auth -> IO Double -getDifficulty = callNumber "getdifficulty" [] - --- | Indicates whether the node is generating or not -getGenerate :: Auth -> IO Bool -getGenerate = callBool "getgenerate" [] - --- | Returns a recent hashes per second performance measurement while --- generating -getHashesPerSec :: Auth -> IO Integer -getHashesPerSec = callNumber "gethashespersec" [] - --- | Returns the total amount received by addresses with --- @account@ in transactions with at least @minconf@ confirmations -getReceivedByAccount :: Auth - -> Account - -> MinConf - -> IO Amount -getReceivedByAccount auth acct conf = - callNumber "getreceivedbyaccount" [toValue acct,toValue conf] auth - --- | Returns the total amount received by an address in transactions --- with at least 'minconf' confirmations. -getReceivedByAddress :: Auth - -> Address - -> MinConf - -> IO Amount -getReceivedByAddress auth addr conf = - callNumber "getreceivedbyaddress" [toValue addr,toValue conf] auth - --- | 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) - --- | 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 = 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 --- | 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 = validateAddress auth addr >>= return . isValid +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 91c97b5..0000000 --- a/src/Network/Bitcoin/Address.hs +++ /dev/null @@ -1,32 +0,0 @@ -module Network.Bitcoin.Address - ( - -- * Types - Address - - -- * Functions - , mkAddress - ) -where - --- | Represents a Bitcoin receiving address. Construct one with --- 'mkAddress'. -data Address = Address String -instance Show Address where - show (Address s) = s - --- | Construct an 'Address' from a 'String'. --- Returns 'Nothing' if the string 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 s = - if isOK 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 _ = False diff --git a/src/Network/Bitcoin/BlockChain.hs b/src/Network/Bitcoin/BlockChain.hs new file mode 100644 index 0000000..1f61f74 --- /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 ( Client + , TransactionID + , BTC + , 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 +import Network.Bitcoin.RawTransaction + +-- | Returns the number of blocks in the longest block chain. +getBlockCount :: Client -> IO Integer +getBlockCount client = callApi client "getblockcount" [] + +-- | Returns the proof-of-work difficulty as a multiple of the minimum +-- difficulty. +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 :: 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 :: 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 :: Client + -> Integer -- ^ Block index. + -> IO BlockHash +getBlockHash client idx = callApi client "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 :: Client -> BlockHash -> IO Block +getBlock client bh = callApi client "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 :: Client -> IO OutputSetInfo +getOutputSetInfo client = callApi client "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 :: ScriptPubKey + -- | 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" + <*> o .: "value" + <*> o .: "scriptPubKey" + <*> o .: "version" + <*> o .: "coinbase" + parseJSON _ = mzero + +-- | Returns details about an unspent transaction output. +getOutputInfo :: Client + -> TransactionID + -> Integer -- ^ The index we're looking at. + -> IO OutputInfo +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 new file mode 100644 index 0000000..29b7312 --- /dev/null +++ b/src/Network/Bitcoin/Dump.hs @@ -0,0 +1,34 @@ +{-# 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 Control.Applicative +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 :: Client + -> PrivateKey + -> Maybe Account + -- ^ An optional label for the key. + -> IO () +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 :: Client + -> Address + -> IO PrivateKey +dumpPrivateKey client addr = callApi client "dumpprivkey" [ tj addr ] diff --git a/src/Network/Bitcoin/Internal.hs b/src/Network/Bitcoin/Internal.hs new file mode 100644 index 0000000..c815cf9 --- /dev/null +++ b/src/Network/Bitcoin/Internal.hs @@ -0,0 +1,153 @@ +{-# 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 + , getClient + , Nil(..) + , NilOrArray(..) + , tj + , tjm + , tja + , AddrAddress(..) + , BitcoinRpcResponse(..) + ) where + +import Control.Applicative +import Control.Exception +import Control.Monad +import Data.Aeson +import Data.Maybe +import Data.Vector ( Vector ) +import qualified Data.Vector as V +import Network.Bitcoin.Types +import qualified Data.ByteString as BS +import Data.Text ( Text ) +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. + | 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 + +-- | '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 + 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 + +-- | '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) +-- +-- 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] +-- +-- On error, throws a 'BitcoinException'. +callApi :: FromJSON v + => Client -- ^ RPC client for bitcoind + -> Text -- ^ command name + -> [Value] -- ^ command arguments + -> IO v +callApi client cmd params = readVal =<< client 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 #-} + +-- | 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." + +-- | 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 +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 = fromMaybe [] $ pure . tj <$> m +{-# INLINE tja #-} + +-- | 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 (.=) <$> vec diff --git a/src/Network/Bitcoin/Mining.hs b/src/Network/Bitcoin/Mining.hs new file mode 100644 index 0000000..da98008 --- /dev/null +++ b/src/Network/Bitcoin/Mining.hs @@ -0,0 +1,232 @@ +{-# 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 ( Client + , getClient + , 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 :: Client -- ^ bitcoind RPC client + -> IO Bool +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. + -- 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 = + unArr <$> callApi client "setgenerate" [ tj onOff ] +setGenerate client onOff (Just limit) = + unArr <$> callApi client "setgenerate" [ tj onOff, tj limit ] + +-- | Returns a recent hashes per second performance measurement while +-- generating. +getHashesPerSec :: Client -> IO Integer +getHashesPerSec client = callApi client "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 :: Client -> IO MiningInfo +getMiningInfo client = callApi client "getmininginfo" [] + +-- | The hash data returned from 'getWork'. +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 + +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 :: Client -> IO HashData +getWork client = callApi client "getwork" [] + +-- | Tries to solve the given block, and returns true if it was successful. +solveBlock :: Client -> HexString -> IO Bool +solveBlock client data_ = callApi client "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 :: Client -> IO BlockTemplate +getBlockTemplate client = callApi client "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 :: Client + -> HexString -- ^ The block to submit. + -> IO Bool -- ^ Was the block accepted by the network? +submitBlock client block = unStupid <$> callApi client "submitblock" [ tj block ] diff --git a/src/Network/Bitcoin/Net.hs b/src/Network/Bitcoin/Net.hs new file mode 100644 index 0000000..03562bd --- /dev/null +++ b/src/Network/Bitcoin/Net.hs @@ -0,0 +1,73 @@ +{-# 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 ( Client + , getClient + , 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 :: Client -> IO Integer +getConnectionCount client = callApi client "getconnectioncount" [] + +-- | 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. + addressName :: Text + , services :: Text + -- | 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 + -- data. + , lastRecv :: Integer + , bytesSent :: Integer + , bytesRecv :: Integer + -- | How long have we been connected to this peer (in + -- milliseconds). + , connectionTime :: Integer + -- | The version of the Bitcion client the peer is running. + , peerVersion :: Integer + -- | The sub-version of the Bitcoin client the peer is running. + , peerSubversion :: Text + , inbound :: Bool + , 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 .: "bytessent" + <*> o .: "bytesrecv" + <*> o .: "conntime" + <*> o .: "version" + <*> o .: "subver" + <*> o .: "inbound" + <*> o .: "startingheight" + <*> o .: "banscore" + parseJSON _ = mzero + +-- | Returns data about all connected peer nodes. +getPeerInfo :: Client -> IO [PeerInfo] +getPeerInfo client = callApi client "getpeerinfo" [] diff --git a/src/Network/Bitcoin/RawTransaction.hs b/src/Network/Bitcoin/RawTransaction.hs new file mode 100644 index 0000000..4cb3a4d --- /dev/null +++ b/src/Network/Bitcoin/RawTransaction.hs @@ -0,0 +1,375 @@ +{-# 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 ( Client + , getClient + , RawTransaction + , getRawTransaction + , TxIn(..) + , TxnOutputType(..) + , ScriptPubKey(..) + , ScriptSig(..) + , 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 :: 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, +-- 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 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 + -- | 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 script signature. +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 + + +-- | 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 :: Client -> TransactionID -> IO RawTransactionInfo +getRawTransactionInfo client txid = + callApi client "getrawtransaction" [ tj txid, tj verbose ] + where verbose = 1 :: Int + +data UnspentTransaction = + UnspentTransaction { unspentTransactionId :: TransactionID + , 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" + <*> 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 :: 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 client mmin mmax vaddrs = + let min' = fromMaybe 1 mmin + max' = fromMaybe 9999999 mmax + in callApi client "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 :: 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 client us tgts = + callApi client "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 :: 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 + +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 + } + +instance FromJSON RawSignedTransaction where + parseJSON (Object o) = RawSignedTransaction <$> o .: "hex" + <*> o .: "complete" + parseJSON _ = mzero + +-- | Sign inputs for a raw transaction. +signRawTransaction :: Client + -> RawTransaction + -- ^ 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 HexString) + -- ^ An array of base58-encoded private keys that, if given, + -- will be the only keys used to sign the transaction. + -> Maybe WhoCanPay + -- ^ 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 client rt us' privkeys wcp = + let us = V.map UFS <$> us' :: Maybe (Vector UnspentForSigning) + in callApi client "signrawtransaction" [ tj rt + , tj us + , tj privkeys + , tj . toString $ fromMaybe All wcp + ] + +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 new file mode 100644 index 0000000..1ed4ff8 --- /dev/null +++ b/src/Network/Bitcoin/Types.hs @@ -0,0 +1,74 @@ +{-# 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 ( Client + , BitcoinException(..) + , HexString + , TransactionID + , Satoshi(..) + , BTC + , Account + , Address + ) where + +import Control.Exception +import Data.Fixed +import Data.Text ( Text ) +import Data.Typeable +import qualified Data.ByteString.Lazy as BL + +-- | 'Client' describes authentication credentials and host info for +-- making API requests to the Bitcoin daemon. +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 +-- 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 + +-- | An account on the wallet is just a label to easily specify private keys. +-- +-- The default account is an empty string. +type Account = Text + diff --git a/src/Network/Bitcoin/Wallet.hs b/src/Network/Bitcoin/Wallet.hs new file mode 100644 index 0000000..16c5404 --- /dev/null +++ b/src/Network/Bitcoin/Wallet.hs @@ -0,0 +1,732 @@ +{-# 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 ( Client + , getClient + , 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 + , listTransactions' + , listAccounts + , SinceBlock(..) + , SimpleTransaction(..) + , TransactionCategory(..) + , listSinceBlock + , listSinceBlock' + , DetailedTransaction(..) + , DetailedTransactionDetails(..) + , getTransaction + , backupWallet + , keyPoolRefill + , unlockWallet + , lockWallet + , changePassword + , encryptWallet + , isAddressValid + ) where + +import Control.Applicative +import Control.Monad +import Data.Aeson as A +import qualified Data.HashMap.Lazy as HM +import Data.Maybe +import Data.Text +import Data.Time.Clock.POSIX +import Data.Vector as V hiding ((++)) +import Network.Bitcoin.BlockChain (BlockHash) +import Network.Bitcoin.Internal +import Network.Bitcoin.RawTransaction (RawTransaction) + +-- | 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 :: Client -> IO BitcoindInfo +getBitcoindInfo client = callApi client "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 :: 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 :: Client -> Account -> IO Address +getAccountAddress client acc = callApi client "getaccountaddress" [ tj acc ] + +-- | Sets the account associated with the given address. +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 :: Client -> Address -> IO Account +getAccount client addr = callApi client "getaccount" [ tj addr ] + +-- | Returns the list of addresses for the given address. +getAddressesByAccount :: Client -> Account -> IO (Vector Address) +getAddressesByAccount client acc = callApi client "getaddressesbyaccount" [ tj acc ] + +-- | Sends some bitcoins to an address. +sendToAddress :: Client + -> 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 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. + 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 :: Client + -> IO (Vector (Vector AddressInfo)) +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 :: Client + -> Address + -- ^ The address whose private key we'll use. + -> Text + -- ^ The message to sign. + -> IO Signature +signMessage client addr msg = callApi client "signmessage" [ tj addr, tj msg ] + +-- | Verifies a signed message. +verifyMessage :: Client + -> Address + -- ^ The address of the original signer. + -> Signature + -- ^ The message's signature. + -> Text + -- ^ The message. + -> IO Bool + -- ^ Was the signature valid? +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 :: 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' :: Client + -> Address + -> Int -- ^ The minimum number of confirmations needed + -- for a transaction to to count towards the + -- total. + -> IO BTC +getReceivedByAddress' client addr minconf = + callApi client "getreceivedbyaddress" [ tj addr, tj minconf ] + +-- | Returns the total amount received by address with the given account. +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' :: Client + -> Account + -- ^ The account in question. + -> Int + -- ^ The minimum number of confirmations needed for a + -- transaction to count towards the total. + -> IO BTC +getReceivedByAccount' client acc minconf = + callApi client "getreceivedbyaccount" [ tj acc, tj minconf ] + +-- | Returns the server's total available balance. +getBalance :: Client + -> IO BTC +getBalance client = + callApi client "getbalance" [] + +-- | Returns the balance in the given account, counting only transactions with +-- at least one confirmation. +getBalance' :: Client + -> Account + -> IO BTC +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'' :: Client + -> Account + -> Int + -- ^ The minimum number of confirmations needed for a transaction + -- to count towards the total. + -> IO BTC +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 :: Client + -> Account -- ^ From. + -> Account -- ^ To. + -> BTC -- ^ The amount to transfer. + -> Text -- ^ A comment to record for the transaction. + -> IO () +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 () + +-- | Sends bitcoins from a given account in our wallet to a given address. +-- +-- A transaction and sender comment may be optionally provided. +sendFromAccount :: Client + -> 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 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 :: Client + -> 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 client acc amounts comm = + callApi client "sendmany" [ tj acc, tj $ AA amounts, tj (1 :: Int), 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 :: 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' :: Client + -> 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' client minconf includeEmpty = + callApi client "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 :: 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' :: Client + -> 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' client minconf includeEmpty = + callApi client "listreceivedbyaccount" [ tj minconf, tj includeEmpty ] + + +data SinceBlock = + SinceBlock { strransactions :: Vector SimpleTransaction + , sbLastBlockHash :: BlockHash + } + deriving ( Show, Ord, Eq ) + +instance FromJSON SinceBlock where + parseJSON (Object o) = SinceBlock <$> o .: "transactions" + <*> o .: "lastblock" + parseJSON _ = mzero + +-- | 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. They are never enforced on this side. +data SimpleTransaction = + SimpleTransaction { + -- | The account name associated with the transaction. The empty string + -- is the default account. + stReceivingAccount :: Account + -- | The bitcoin address of the transaction. Is 'Nothing' unless + -- 'trCategory' is 'TCSend' or 'TCReceive'. + , stAddress :: Maybe Address + -- | The category of the transaction + , stCategory :: TransactionCategory + -- | The fees paid to process the transaction. Is 'Nothing' unless + -- 'trCategory' is 'TCSend' or 'TCReceive'. + , stFee :: Maybe BTC + -- | The amount of bitcoins transferred. + , stAmount :: BTC + -- | The number of confirmations of the transaction. Is 'Nothing' unless + -- 'trCategory' is 'TCSend' or 'TCReceive'. + , stConfirmations :: Maybe Integer + -- | The hash of the block containing the transaction. Is 'Nothing' + -- unless 'trCategory' is 'TCSend' or 'TCReceive'. + , stBlockHash :: Maybe BlockHash + -- | The index of the the block containing the transaction. Is 'Nothing' + -- unless 'trCategory' is 'TCSend' or 'TCReceive'. + , stBlockIndex :: Maybe Integer + -- | The block time in seconds since epoch (1 Jan 1970 GMT). Is + -- 'Nothing' unless 'trCategory' is 'TCSend' or 'TCReceive'. + , stBlockTime :: Maybe POSIXTime + -- | The transaction id. Is 'Nothing' unless + -- 'trCategory' is 'TCSend' or 'TCReceive'. + , 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'. + , stWalletConflicts :: Maybe (Vector TransactionID) + -- | The block time in seconds since epoch (1 Jan 1970 GMT). + , 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. + , 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'. + , stOtherAccount :: Maybe Account + } + deriving ( Show, Ord, Eq ) + +instance FromJSON SimpleTransaction where + 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 + | 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 + +-- | Gets all transactions in blocks since the given block. +listSinceBlock :: Client + -> 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 client blockHash conf = + listSinceBlock' client (Just blockHash) conf + +-- | Gets all transactions in blocks since the given block, or all +-- transactions if ommited. +listSinceBlock' :: Client + -> 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' client mblockHash mminConf = + callApi client "listsinceblock" $ tja mblockHash ++ tja mminConf + + +-- | Returns transactions from the blockchain. +listTransactions :: Client + -> Account + -- ^ Limits the 'BlockTransaction' returned to those from or to + -- the given 'Account'. + -> Int + -- ^ Limits the number of 'BlockTransaction' returned. + -> Int + -- ^ Number of most recent transactions to skip. + -> IO (Vector SimpleTransaction) +listTransactions client account size from = + listTransactions' client (Just account) (Just size) (Just from) + +-- | Returns transactions from the blockchain. +listTransactions' :: Client + -> 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 SimpleTransaction) +listTransactions' client maccount mcount mfrom = + callApi client "listtransactions" $ [ tjm "*" maccount ] ++ tja mcount ++ tja mfrom + + +-- | List accounts and their current balance. +listAccounts :: Client + -> Maybe Int + -- ^ Minimum number of confirmations required before payments are + -- included in the balance. + -> IO (HM.HashMap Account BTC) +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 +-- obtained from 'listTransactions' or 'listSinceBlock' are their associated +-- methods. +data DetailedTransaction = + DetailedTransaction { + -- | The amount of bitcoins transferred. + dtAmount :: BTC + -- | The fees paid to process the transaction. Is 'Nothing' unless + -- 'trCategory' is 'TCSend' or 'TCReceive'. + , dtFee :: Maybe BTC + -- | The number of confirmations of the transaction. Is 'Nothing' unless + -- 'trCategory' is 'TCSend' or 'TCReceive'. + , dtConfirmations :: Maybe Integer + -- | The transaction id. Is 'Nothing' unless + -- 'trCategory' is 'TCSend' or 'TCReceive'. + , 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'. + , dtWalletConflicts :: Maybe (Vector TransactionID) + -- | The block time in seconds since epoch (1 Jan 1970 GMT). + , 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. + , dtTo :: Maybe Text + -- | The details of the transaction. + , dtDetails :: Vector DetailedTransactionDetails + -- | Raw data for the transaction. + , dtHex :: RawTransaction + } + deriving ( Show, Ord, Eq ) + +instance FromJSON DetailedTransaction where + 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 = + DetailedTransactionDetails { + -- | The account name associated with the transaction. The empty string + -- is the default account. + dtdReceivingAccount :: Account + -- | The bitcoin address of the transaction. + , dtdAddress :: Address + -- | The category of the transaction + , dtdCategory :: TransactionCategory + -- | The amount of bitcoins transferred. + , dtdAmount :: BTC + } + deriving ( Show, Ord, Eq ) + +instance FromJSON DetailedTransactionDetails where + parseJSON (Object o) = DetailedTransactionDetails <$> o .: "account" + <*> o .: "address" + <*> o .: "category" + <*> o .: "amount" + parseJSON _ = mzero + +getTransaction :: Client + -> TransactionID + -> IO (DetailedTransaction) +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 :: Client + -> FilePath + -> IO () +backupWallet client fp = + unNil <$> callApi client "backupwallet" [ tj fp ] + +-- | Fills the keypool. +keyPoolRefill :: Client -> IO () +keyPoolRefill client = unNil <$> callApi client "keypoolrefill" [] + +-- | Stores the wallet decryption key in memory for the given amount of time. +unlockWallet :: Client + -> Text + -- ^ The decryption key. + -> Integer + -- ^ How long to store the key in memory (in seconds). + -> IO () +unlockWallet client pass timeout = + unNil <$> callApi client "walletpassphrase" [ tj pass, tj timeout ] + +-- | Changes the wallet passphrase. +changePassword :: Client + -> Text + -- ^ The old password. + -> Text + -- ^ The new password. + -> IO () +changePassword client old new = + unNil <$> callApi client "walletpassphrasechange" [ 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 :: 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 :: Client -> Text -> IO () +encryptWallet client pass = stupidAPI <$> callApi client "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 :: 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 new file mode 100644 index 0000000..290fcd7 --- /dev/null +++ b/src/Test/Main.hs @@ -0,0 +1,50 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Main where + + +import Test.QuickCheck +import Test.QuickCheck.Monadic +import Network.Bitcoin +import Data.Vector ( empty ) + + +main :: IO () +main = mapM_ qcOnce [ canGetInfo + , canListUnspent + , canGetOutputInfo + ] + + +qcOnce :: Property -> IO () +qcOnce = quickCheckWith stdArgs { maxSuccess = 1 + , maxSize = 1 + , maxDiscardRatio = 1 + } + + +client :: IO Client +client = getClient "http://127.0.0.1:18332" "bitcoinrpc" "bitcoinrpcpassword" + + +canGetInfo :: Property +canGetInfo = monadicIO $ do + info <- run $ getBitcoindInfo =<< client + let checks = [ bitcoinVersion info > 80000 + , onTestNetwork info + , bitcoindErrors info == "" + ] + assert $ and checks + + +canListUnspent :: Property +canListUnspent = monadicIO $ do + _ <- run $ (\c -> listUnspent c Nothing Nothing Data.Vector.empty) =<< client + assert True + + +canGetOutputInfo :: Property +canGetOutputInfo = monadicIO $ do + info <- run $ (\c-> getOutputInfo c "ab8e26fd95fa371ac15b43684d0c6797fb573757095e7d763ba86ad315f7db04" 1) =<< client + _ <- run $ print info + assert True 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