diff --git a/Setup.hs b/Setup.hs deleted file mode 100644 --- a/Setup.hs +++ /dev/null @@ -1,2 +0,0 @@ -import Distribution.Simple -main = defaultMain diff --git a/Setup.lhs b/Setup.lhs new file mode 100644 --- /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 --- 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.0.0 +Synopsis: An interface to bitcoind. Description: This can be used to send Bitcoins, query balances, etc. It requires the Bitcoin daemon to be running and accessible via @@ -28,6 +16,12 @@ . To learn more about Bitcoin, see . . + Changes in v1.0 + . + - Total overhaul of the library, with almost the complete bitcoin RPC API + covered. + - Dependencies upgraded, and library modernized. + . Changes in v0.1.5 . - Correct aeson dependency @@ -35,68 +29,50 @@ Changes in v0.1.4 . - More accurate conversion of Bitcoin amounts from floating point - --- The license under which the package is released. License: BSD3 - --- The file containing the license text. License-file: LICENSE - --- The package author(s). Author: Michael Hendricks - --- An email address to which users can send suggestions, bug reports, --- and patches. -Maintainer: Michael Hendricks - +Maintainer: Clark Gaebel +Stability: experimental +Homepage: http://github.com/wowus/network-bitcoin +Bug-reports: http://github.com/wowus/network-bitcoin/issues +Copyright: Copyright 2012, Michael Hendricks + Copyright 2012, Clark Gaebel 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 - 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.1 Library hs-source-dirs: src - ghc-options: -Wall -fno-warn-unused-binds -fno-warn-incomplete-patterns + ghc-options: -Wall -- Modules exported by the library. Exposed-modules: Network.Bitcoin - Network.Bitcoin.Address + Network.Bitcoin.BlockChain + Network.Bitcoin.Dump + Network.Bitcoin.Internal + Network.Bitcoin.Mining + Network.Bitcoin.Net + Network.Bitcoin.RawTransaction + Network.Bitcoin.Types + Network.Bitcoin.Wallet -- Packages needed in order to build this package. Build-depends: - aeson == 0.3.*, - attoparsec >= 0.7, - bytestring >= 0.9, - containers >= 0.4, + aeson == 0.6.*, + bytestring >= 0.10, + attoparsec == 0.10.*, + unordered-containers >= 0.2, HTTP >= 4000, network >= 2.3, text >= 0.11, + vector >= 0.10, base == 4.* - - -- Modules not exported by this package. - -- Other-modules: - - -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source. - -- Build-tools: - -Test-suite test-main - type: exitcode-stdio-1.0 - main-is: test-main.hs Source-repository head type: git diff --git a/src/Network/Bitcoin.hs b/src/Network/Bitcoin.hs --- a/src/Network/Bitcoin.hs +++ b/src/Network/Bitcoin.hs @@ -1,287 +1,118 @@ -{-# 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 + -- * Common Types Auth(..) - , Address - , mkAddress - , Amount - , Account - , MinConf - , AddressValidation - , isValid - , isMine - , account , 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 + , getAddressByAccount + , 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 + -- , listAccounts + -- , listSinceBlock + -- , 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 --- 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 --- /dev/null +++ b/src/Network/Bitcoin/BlockChain.hs @@ -0,0 +1,164 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -Wall #-} +-- | An interface to bitcoind's available block-chain-related RPC calls. The +-- implementation of these functions can be found at +-- . +-- +-- If any APIs are missing, patches are always welcome. If you look at the +-- source of this module, you'll see that the interface code is trivial. +module Network.Bitcoin.BlockChain ( Auth(..) + , TransactionID + , BTC + , ScriptSig(..) + , getBlockCount + , getDifficulty + , setTransactionFee + , getRawMemoryPool + , BlockHash + , getBlockHash + , Block(..) + , getBlock + , OutputSetInfo(..) + , getOutputSetInfo + , OutputInfo(..) + , getOutputInfo + ) where + +import Control.Applicative +import Control.Monad +import Data.Aeson +import Network.Bitcoin.Internal + +-- | Returns the number of blocks in the longest block chain. +getBlockCount :: Auth -> IO Integer +getBlockCount auth = callApi auth "getblockcount" [] + +-- | Returns the proof-of-work difficulty as a multiple of the minimum +-- difficulty. +getDifficulty :: Auth -> IO Integer +getDifficulty auth = callApi auth "getdifficulty" [] + +-- | Sets the transaction fee will will pay to the network. Values of 0 are +-- rejected. +setTransactionFee :: Auth -> BTC -> IO () +setTransactionFee auth fee = + stupidAPI <$> callApi auth "settxfee" [ tj $ WBTC fee ] + where stupidAPI :: Bool -> () + stupidAPI = const () + +-- | Returns all transaction identifiers in the memory pool. +getRawMemoryPool :: Auth -> IO (Vector TransactionID) +getRawMemoryPool auth = callApi auth "getrawmempool" [] + +-- | The hash of a given block. +type BlockHash = HexString + +-- | Returns the hash of the block in best-block-chain at the given index. +getBlockHash :: Auth + -> Integer -- ^ Block index. + -> IO BlockHash +getBlockHash auth idx = callApi auth "getblockhash" [ tj idx ] + +-- | Information about a given block in the block chain. +data Block = Block { blockHash :: BlockHash + -- | The number of confirmations the block has. + , blkConfirmations :: Integer + -- | The size of the block. + , blkSize :: Integer + -- | The "height" of the block. TODO: Clarify this. + , blkHeight :: Integer + -- | The version of the block. + , blkVersion :: Integer + -- | The hash of the block at the root of the merkle tree + -- which this block belongs to. + , merkleRoot :: BlockHash + -- | Should this be a transaction, or transaction id? + , subTransactions :: Vector TransactionID + -- | The time it was mined. + , blkTime :: Integer + -- | The block's nonce. + , blkNonce :: Integer + , blkBits :: HexString + -- | How hard was this block to mine? + , blkDifficulty :: Integer + -- | A pointer to the next block in the chain. + , nextBlock :: Maybe BlockHash + -- | A pointer to the previous block in the chain. + , prevBlock :: Maybe BlockHash + } + deriving ( Show, Read, Ord, Eq ) + +instance FromJSON Block where + parseJSON (Object o) = Block <$> o .: "hash" + <*> o .: "confirmations" + <*> o .: "size" + <*> o .: "height" + <*> o .: "version" + <*> o .: "merkleroot" + <*> o .: "tx" + <*> o .: "time" + <*> o .: "nonce" + <*> o .: "bits" + <*> o .: "difficulty" + <*> o .:? "nextblockhash" + <*> o .:? "previousblockhash" + parseJSON _ = mzero + +-- | Returns details of a block with given block-hash. +getBlock :: Auth -> BlockHash -> IO Block +getBlock auth bh = callApi auth "getblock" [ tj bh ] + +-- | Information on the unspent transaction in the output set. +data OutputSetInfo = + OutputSetInfo { osiBestBlock :: BlockHash + -- | The number of transactions in the output set. + , numTransactions :: Integer + -- | The number of outputs for the transactions. + , transactionOutputs :: Integer + -- | The serialized size of the output set. + , serializedSize :: Integer + } + deriving ( Show, Read, Ord, Eq ) + +instance FromJSON OutputSetInfo where + parseJSON (Object o) = OutputSetInfo <$> o .: "bestblock" + <*> o .: "transactions" + <*> o .: "txouts" + <*> o .: "bytes_serialized" + parseJSON _ = mzero + +-- | Returns statistics about the unspent transaction output set. +getOutputSetInfo :: Auth -> IO OutputSetInfo +getOutputSetInfo auth = callApi auth "gettxoutsetinfo" [] + +-- | Details about an unspent transaction output. +data OutputInfo = + OutputInfo { oiBestBlock :: BlockHash + -- | The number of times this transaction has been confirmed. + , oiConfirmations :: Integer + -- | The amount transferred. + , oiAmount :: BTC + -- | The public key of the sender. + , oiScriptPubKey :: ScriptSig + -- | The version of this transaction. + , oiVersion :: Integer + -- | Is this transaction part of the coin base? + , oiCoinBase :: Bool + } + deriving ( Show, Read, Ord, Eq ) + +instance FromJSON OutputInfo where + parseJSON (Object o) = OutputInfo <$> o .: "bestblock" + <*> o .: "confirmations" + <*> (unwrapBTC <$> o .: "amount") + <*> o .: "scriptPubKey" + <*> o .: "version" + <*> o .: "coinbase" + parseJSON _ = mzero + +-- | Returns details about an unspent transaction output. +getOutputInfo :: Auth + -> TransactionID + -> Integer -- ^ The index we're looking at. + -> IO OutputInfo +getOutputInfo auth txid n = callApi auth "gettxout" [ tj txid, tj n ] diff --git a/src/Network/Bitcoin/Dump.hs b/src/Network/Bitcoin/Dump.hs new file mode 100644 --- /dev/null +++ b/src/Network/Bitcoin/Dump.hs @@ -0,0 +1,33 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -Wall #-} +-- | An interface to bitcoind's available private key calls. The implementation +-- of these functions can be found at . +-- +-- If any APIs are missing, patches are always welcome. If you look at the +-- source of this module, you'll see that the interface code is trivial. +module Network.Bitcoin.Dump ( PrivateKey + , importPrivateKey + , dumpPrivateKey + ) where + +import Network.Bitcoin.Internal + +-- | A textual representation of a bitcoin private key. +type PrivateKey = Text + +-- | Adds a private key (as returned by dumpprivkey) to your wallet. +importPrivateKey :: Auth + -> PrivateKey + -> Maybe Account + -- ^ An optional label for the key. + -> IO () +importPrivateKey auth pk Nothing = + callApi auth "importprivkey" [ tj pk ] +importPrivateKey auth pk (Just label) = + callApi auth "importprivkey" [ tj pk, tj label ] + +-- | Reveals the private key corresponding to the given address. +dumpPrivateKey :: Auth + -> Address + -> IO PrivateKey +dumpPrivateKey auth addr = callApi auth "dumpprivkey" [ tj addr ] diff --git a/src/Network/Bitcoin/Internal.hs b/src/Network/Bitcoin/Internal.hs new file mode 100644 --- /dev/null +++ b/src/Network/Bitcoin/Internal.hs @@ -0,0 +1,163 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -Wall #-} +-- | The API exposed in this module should be considered unstable, and is +-- subject to change between minor revisions. +-- +-- If the version number is a.b.c.d, and either a or b changes, then the +-- module's whole API may have changed (if only b changes, then it was +-- probably a minor change). +-- +-- If c changed, then only the internal API may change. The rest of the +-- module is guaranteed to be stable. +-- +-- If only d changes, then there were no user-facing code changes made. +module Network.Bitcoin.Internal ( module Network.Bitcoin.Types + , Text, Vector + , FromJSON(..) + , callApi + , callApi' + , tj + , WrappedBTC(..) + , AddrAddress(..) + ) where + +import Control.Applicative +import Control.Arrow +import Control.Exception +import Control.Monad +import Data.Aeson +import Data.Attoparsec.Number +import Data.Maybe +import Data.Vector ( Vector ) +import qualified Data.Vector as V +import Network.Bitcoin.Types +import Network.Browser +import Network.HTTP hiding ( password ) +import Network.URI ( parseURI ) +import qualified Data.ByteString.Lazy as BL +import Data.Text ( Text ) +import qualified Data.Text as T + +-- | RPC calls return an error object. It can either be empty; or have an +-- error message + error code. +data BitcoinRpcError = NoError -- ^ All good. + | BitcoinRpcError Int Text -- ^ Error code + error message. + deriving ( Show, Read, Ord, Eq ) + +instance FromJSON BitcoinRpcError where + parseJSON (Object v) = BitcoinRpcError <$> v .: "code" + <*> v .: "message" + parseJSON Null = return NoError + parseJSON _ = mzero + +-- | A response from bitcoind will contain the result of the JSON-RPC call, and +-- an error. The error should be null if a valid response was received. +data BitcoinRpcResponse a = BitcoinRpcResponse { btcResult :: a + , btcError :: BitcoinRpcError + } + deriving ( Show, Read, Ord, Eq ) + +instance FromJSON a => FromJSON (BitcoinRpcResponse a) where + parseJSON (Object v) = BitcoinRpcResponse <$> v .: "result" + <*> v .: "error" + parseJSON _ = mzero + +-- | The "no conversion needed" implementation of callApi. THis lets us inline +-- and specialize callApi for its parameters, while keeping the bulk of the +-- work in this function shared. +callApi' :: Auth -> BL.ByteString -> IO BL.ByteString +callApi' auth rpcReqBody = do + (_, httpRes) <- browse $ do + setOutHandler . const $ return () + addAuthority authority + setAllowBasicAuth True + request $ httpRequest (T.unpack urlString) rpcReqBody + return $ rspBody httpRes + where + authority = httpAuthority auth + urlString = rpcUrl auth + +-- | 'callApi' is a low-level interface for making authenticated API +-- calls to a Bitcoin daemon. The first argument specifies +-- authentication details (URL, username, password) and is often +-- curried for convenience: +-- +-- > callBtc = callApi $ Auth "http://127.0.0.1:8332" "user" "password" +-- +-- The second argument is the command name. The third argument provides +-- parameters for the API call. +-- +-- > let result = callBtc "getbalance" [ tj "account-name", tj 6 ] +-- +-- On error, throws a 'BitcoinException'. +callApi :: FromJSON v + => Auth -- ^ authentication credentials for bitcoind + -> Text -- ^ command name + -> [Value] -- ^ command arguments + -> IO v +callApi auth cmd params = readVal =<< callApi' auth jsonRpcReqBody + where + readVal bs = case decode' bs of + Just r@(BitcoinRpcResponse {btcError=NoError}) + -> return $ btcResult r + Just (BitcoinRpcResponse {btcError=BitcoinRpcError code msg}) + -> throw $ BitcoinApiError code msg + Nothing + -> throw $ BitcoinResultTypeError bs + jsonRpcReqBody = + encode $ object [ "jsonrpc" .= ("2.0" :: Text) + , "method" .= cmd + , "params" .= params + , "id" .= (1 :: Int) + ] +{-# INLINE callApi #-} + +-- | Internal helper functions to make callApi more readable +httpAuthority :: Auth -> Authority +httpAuthority (Auth urlString username password) = + AuthBasic { auRealm = "jsonrpc" + , auUsername = T.unpack username + , auPassword = T.unpack password + , auSite = uri + } + where + uri = fromJust . parseURI $ T.unpack urlString + +-- | Builds the JSON HTTP request. +httpRequest :: String -> BL.ByteString -> Request BL.ByteString +httpRequest urlString jsonBody = + (postRequest urlString){ + rqBody = jsonBody, + rqHeaders = [ + mkHeader HdrContentType "application/json", + mkHeader HdrContentLength (show $ BL.length jsonBody) + ] + } + +-- | A handy shortcut for toJSON, because I'm lazy. +tj :: ToJSON a => a -> Value +tj = toJSON +{-# INLINE tj #-} + +-- | Used to provide a FromJSON instance for fixed-point bitcoins. +-- This can be removed after gets +-- merged into master, and is released on Hackage. +data WrappedBTC = WBTC { unwrapBTC :: BTC } + +instance FromJSON WrappedBTC where + parseJSON (Number n) = pure . WBTC $ case n of + D d -> realToFrac d + I i -> fromIntegral i + parseJSON _ = mzero + +instance ToJSON WrappedBTC where + toJSON (WBTC btc) = toJSON $ toRational btc + +-- | A wrapper for a vector of address:amount pairs. The RPC expects that as +-- an object of "address":"amount" pairs, instead of a vector. So that's what +-- we give them with AddrAddress's ToJSON. +newtype AddrAddress = AA (Vector (Address, BTC)) + +instance ToJSON AddrAddress where + toJSON (AA vec) = object . V.toList $ uncurry (.=) . second WBTC <$> vec + diff --git a/src/Network/Bitcoin/Mining.hs b/src/Network/Bitcoin/Mining.hs new file mode 100644 --- /dev/null +++ b/src/Network/Bitcoin/Mining.hs @@ -0,0 +1,220 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -Wall #-} +-- | An interface to bitcoind's available mining RPC calls. The implementation +-- of these functions can be found at . +-- +-- If any APIs are missing, patches are always welcome. If you look at the +-- source of this module, you'll see that the interface code is trivial. +-- +-- Note that it is highly discouraged to use bitcoind for actual bitcoin +-- mining. It uses the CPU for mining, which is much, much less power +-- efficient than GPU mining. If you're paying for power, you will not come +-- out ahead. +-- +-- Instead, consider using a GPU miner listed at . +module Network.Bitcoin.Mining ( Auth(..) + , getGenerate + , setGenerate + , getHashesPerSec + , MiningInfo(..) + , getMiningInfo + , HashData(..) + , getWork + , solveBlock + , Transaction(..) + , CoinBaseAux(..) + , BlockTemplate(..) + , getBlockTemplate + , submitBlock + ) where + +import Data.Aeson as A +import Control.Applicative +import Control.Monad +import Network.Bitcoin.Internal + +-- | Returns whether or not bitcoind is generating bitcoins. +getGenerate :: Auth -- ^ bitcoind RPC authorization + -> IO Bool +getGenerate auth = callApi auth "getgenerate" [] + +-- | Controls whether or not bitcoind is generating bitcoins. +setGenerate :: Auth -- ^ bitcoind RPC authorization + -> Bool -- ^ Turn it on, or turn it off? + -> Maybe Int -- ^ Generation is limited to this number of + -- processors. Set it to Nothing to keep the value + -- at what it was before, Just -1 to use all + -- available cores, and any other value to limit it. + -> IO () +setGenerate auth onOff Nothing = + callApi auth "setgenerate" [ tj onOff ] +setGenerate auth onOff (Just limit) = + callApi auth "setgenerate" [ tj onOff, tj limit ] + +-- | Returns a recent hashes per second performance measurement while +-- generating. +getHashesPerSec :: Auth -> IO Integer +getHashesPerSec auth = callApi auth "gethashespersec" [] + +-- | Information related to the current bitcoind mining operation. +-- +-- If a field is undocumented here, it's because I don't know what it means. +-- If you DO know what it means, I'd love it if you would submit a patch to +-- help complete this documentation. +data MiningInfo = + MiningInfo { + -- | The number of blocks in our block-chain. + nBlocks :: Integer + -- | The size of the current block we're mining. + , currentBlockSize :: Integer + , currentBlockTransaction :: Integer + -- | How difficult mining currently is. + , difficulty :: Double + -- | Any mining errors that may have come up. + , miningErrors :: Text + -- | Are we currently generating bitcoins? + , isGenerating :: Bool + -- | How many processors have we limited bitcoin mining to? + , generationProcessorLimit :: Integer + -- | How fast is the mining going? + , hashesPerSecond :: Integer + , pooledTransactions :: Integer + -- | Are we on the bitcoin test network (as opposed to the real + -- thing)? + , miningOnTestNetwork :: Bool + } + deriving ( Show, Read, Ord, Eq ) + +instance FromJSON MiningInfo where + parseJSON (Object o) = MiningInfo <$> o .: "blocks" + <*> o .: "currentblocksize" + <*> o .: "currentblocktx" + <*> o .: "difficulty" + <*> o .: "errors" + <*> o .: "generate" + <*> o .: "genproclimit" + <*> o .: "hashespersec" + <*> o .: "pooledtx" + <*> o .: "testnet" + parseJSON _ = mzero + +-- | Returns an object containing mining-related information. +getMiningInfo :: Auth -> IO MiningInfo +getMiningInfo auth = callApi auth "getmininginfo" [] + +-- | The hash data returned from 'getWork'. +data HashData = + HashData { blockData :: HexString + -- | Little-endian hash target, formatted as a hexadecimal string. + , hdTarget :: HexString + } + deriving ( Show, Read, Ord, Eq ) + +instance FromJSON HashData where + parseJSON (Object o) = HashData <$> o .: "data" + <*> o .: "target" + parseJSON _ = mzero + +-- | Returns formatted hash data to work on. +getWork :: Auth -> IO HashData +getWork auth = callApi auth "getwork" [] + +-- | Tries to solve the given block, and returns true if it was successful. +solveBlock :: Auth -> HexString -> IO Bool +solveBlock auth data_ = callApi auth "getwork" [ tj data_ ] + +-- | A transaction to be included in the next block. +data Transaction = + Transaction { txnData :: HexString + , txnHash :: HexString + , depends :: Vector Integer + , txnFee :: Maybe Integer + , sigOps :: Integer + } + deriving ( Show, Read, Ord, Eq ) + +instance FromJSON Transaction where + parseJSON (Object o) = Transaction <$> o .: "data" + <*> o .: "hash" + <*> o .: "depends" + <*> o .:? "fee" + <*> o .: "sigops" + parseJSON _ = mzero + +data CoinBaseAux = CoinBaseAux { cbFlags :: HexString + } + deriving ( Show, Read, Ord, Eq ) + +instance FromJSON CoinBaseAux where + parseJSON (Object o) = CoinBaseAux <$> o .: "flags" + parseJSON _ = mzero + +-- | A template for constructing a block to work on. +-- +-- See for the full specification. +data BlockTemplate = + BlockTemplate { blockVersion :: Integer + -- | Hash of current highest block. + , previousBlockHash :: HexString + -- | Contents of non-coinbase transactions that should be + -- included in the next block. + , transactionsToInclude :: Vector Transaction + -- | Data that should be included in coinbase. + , coinBaseAux :: CoinBaseAux + -- | Maximum allowable input to coinbase transaction, + -- including the generation award and transaction fees. + , coinBaseValue :: Integer + -- | Hash target. + , btTarget :: HexString + -- | Minimum timestamp appropriate for next block. + , minTime :: Integer + -- | Range of valid nonces. + , nonceRange :: HexString + -- | Limit of sigops in blocks. + , sigopLimit :: Integer + -- | Limit of block size. + , sizeLimit :: Integer + -- | Current timestamp. + , curTime :: Integer + -- | Compressed target of the next block. + , btBits :: HexString + -- | Height of the next block. + , btHeight :: Integer + } + deriving ( Show, Read, Ord, Eq ) + +instance FromJSON BlockTemplate where + parseJSON (Object o) = BlockTemplate <$> o .: "version" + <*> o .: "previousblockhash" + <*> o .: "transactions" + <*> o .: "coinbaseaux" + <*> o .: "coinbasevalue" + <*> o .: "target" + <*> o .: "mintime" + <*> o .: "noncerange" + <*> o .: "sigoplimit" + <*> o .: "sizelimit" + <*> o .: "curtime" + <*> o .: "bits" + <*> o .: "height" + parseJSON _ = mzero + +-- | Returns data needed to construct a block to work on. +getBlockTemplate :: Auth -> IO BlockTemplate +getBlockTemplate auth = callApi auth "getblocktemplate" [] + +-- | Unfortunately, the submitblock API call returns null on success, and +-- the string "rejected" on failure. +-- +-- We use 'StupidReturnValue' to parse this ridiculous API. +data StupidReturnValue = SRV { unStupid :: Bool } + +instance FromJSON StupidReturnValue where + parseJSON Null = return $ SRV True + parseJSON _ = return $ SRV False + +-- | Attempts to submit a new block to the network. +submitBlock :: Auth + -> HexString -- ^ The block to submit. + -> IO Bool -- ^ Was the block accepted by the network? +submitBlock auth block = unStupid <$> callApi auth "submitblock" [ tj block ] diff --git a/src/Network/Bitcoin/Net.hs b/src/Network/Bitcoin/Net.hs new file mode 100644 --- /dev/null +++ b/src/Network/Bitcoin/Net.hs @@ -0,0 +1,71 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -Wall #-} +-- | An interface to bitcoind's available network-related RPC calls. +-- The implementation of these functions can be found at +-- . +-- +-- If any APIs are missing, patches are always welcome. If you look at the +-- source of this module, you'll see that the interface code is trivial. +module Network.Bitcoin.Net ( Auth(..) + , getConnectionCount + , PeerInfo(..) + , getPeerInfo + ) where + +import Control.Applicative +import Control.Monad +import Data.Aeson +import Network.Bitcoin.Internal + +-- | Returns the number of connections to other nodes. +getConnectionCount :: Auth -> IO Integer +getConnectionCount auth = callApi auth "getconnectioncount" [] + +-- | Information on a given connected node in the network. +-- +-- The documentation for this data structure is incomplete, as I honestly +-- don't know what some of these fields are for. Patches are welcome! +data PeerInfo = + PeerInfo { -- | The ip:port of this peer, as a string. + addressName :: Text + , services :: Text + -- | Relative to when we first time we conected with this peer + -- (and in milliseconds), the last time we sent this peer any + -- data. + , lastSend :: Integer + -- | Relative to the first time we connected with this peer + -- (and in milliseconds), the last time we sent this peer any + -- data. + , lastRecv :: Integer + -- | How long have we been connected to this peer (in + -- milliseconds). + , connectionTime :: Integer + -- | The version of bitcoind the peer is running. + , peerVersion :: Integer + -- | The sub-version of bitcoind the peer is running. + , peerSubversion :: Integer + , inbound :: Bool + , releaseTime :: Integer + , startingHeight :: Integer + -- | How many times has this peer behaved badly? + , banScore :: Integer + } + deriving ( Show, Read, Ord, Eq ) + +instance FromJSON PeerInfo where + parseJSON (Object o) = PeerInfo <$> o .: "addr" + <*> o .: "services" + <*> o .: "lastsend" + <*> o .: "lastrecv" + <*> o .: "conntime" + <*> o .: "version" + <*> o .: "subver" + <*> o .: "inbound" + <*> o .: "releasetime" + <*> o .: "startingheight" + <*> o .: "banscore" + parseJSON _ = mzero + +-- | Returns data about each connected network node. +getPeerInfo :: Auth -> IO PeerInfo +getPeerInfo auth = callApi auth "getpeerinfo" [] diff --git a/src/Network/Bitcoin/RawTransaction.hs b/src/Network/Bitcoin/RawTransaction.hs new file mode 100644 --- /dev/null +++ b/src/Network/Bitcoin/RawTransaction.hs @@ -0,0 +1,354 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# OPTIONS_GHC -Wall #-} +-- | An interface to bitcoind's available raw transaction-related RPC calls. +-- The implementation of these functions can be found at +-- . +-- +-- If any APIs are missing, patches are always welcome. If you look at the +-- source of this module, you'll see that the interface code is trivial. +-- +-- Also, documentation for this module is scarce. I would love the addition +-- of more documentation by anyone who knows what these things are. +module Network.Bitcoin.RawTransaction ( Auth(..) + , ScriptSig(..) + , RawTransaction + , getRawTransaction + , TxIn(..) + , TxnOutputType(..) + , ScriptPubKey(..) + , TxOut(..) + , BlockInfo(..) + , RawTransactionInfo(..) + , getRawTransactionInfo + , UnspentTransaction(..) + , listUnspent + , createRawTransaction + , DecodedRawTransaction(..) + , decodeRawTransaction + , WhoCanPay(..) + , RawSignedTransaction(..) + , signRawTransaction + , sendRawTransaction + ) where + +import Control.Applicative +import Control.Monad +import Data.Aeson as A +import Data.Aeson.Types as AT +import Data.Maybe +import qualified Data.Vector as V +import Network.Bitcoin.Internal + +-- | Just like most binary data retrieved from bitcoind, a raw transaction is +-- represented by a hexstring. +-- +-- This is a serialized, hex-encoded transaction. +type RawTransaction = HexString + +-- | Get a raw transaction from its unique ID. +getRawTransaction :: Auth -> TransactionID -> IO RawTransaction +getRawTransaction auth txid = + callApi auth "getrawtransaction" [ tj txid, tj verbose ] + where verbose = 0 :: Int + +-- | A transaction into an account. This can either be a coinbase transaction, +-- or a standard transaction with another account. +data TxIn = TxCoinbase { txCoinbase :: HexString + } + | TxIn { -- | This transaction's ID. + txInId :: TransactionID + , numOut :: Integer + , scriptSig :: ScriptSig + -- | A transaction sequence number. + , txSequence :: Integer + } + deriving ( Show, Read, Ord, Eq ) + +instance FromJSON TxIn where + parseJSON (Object o) = parseCB <|> parseTxIn + where + parseCB = TxCoinbase <$> o .: "coinbase" + parseTxIn = TxIn <$> o .: "txid" + <*> o .: "vout" + <*> o .: "scriptSig" + <*> o .: "sequence" + parseJSON _ = mzero + +-- | The type of a transaction out. +-- +-- More documentation is needed here. Submit a patch if you know what this is +-- about! +data TxnOutputType = TxnPubKey -- ^ JSON of "pubkey" received. + | TxnPubKeyHash -- ^ JSON of "pubkeyhash" received. + | TxnScriptHash -- ^ JSON of "scripthash" received. + | TxnMultisig -- ^ JSON of "multisig" received. + deriving ( Show, Read, Ord, Eq ) + +instance FromJSON TxnOutputType where + parseJSON (A.String s) | s == "pubkey" = return TxnPubKey + | s == "pubkeyhash" = return TxnPubKeyHash + | s == "scripthash" = return TxnScriptHash + | s == "multisig" = return TxnMultisig + | otherwise = mzero + parseJSON _ = mzero + +-- | A public key of someone we sent money to. +data ScriptPubKey = NonStandardScriptPubKey { -- | The JSON "asm" field. + nspkAsm :: HexString + -- | The JSON "hex" field. + , nspkHex :: HexString + } + | StandardScriptPubKey { -- | The JSON "asm" field. + sspkAsm :: HexString + -- | The JSON "hex" field. + , sspkHex :: HexString + -- | The number of required signatures. + , requiredSigs :: Integer + -- | The type of the transaction. + , sspkType :: TxnOutputType + -- | The addresses associated with this key. + , sspkAddresses :: Vector Address + } + deriving ( Show, Read, Ord, Eq ) + +instance FromJSON ScriptPubKey where + parseJSON (Object o) = parseStandard <|> parseNonstandard + where + parseStandard = StandardScriptPubKey <$> o .: "asm" + <*> o .: "hex" + <*> o .: "reqSigs" + <*> o .: "type" + <*> o .: "addresses" + parseNonstandard = NonStandardScriptPubKey <$> o .: "asm" + <*> o .: "hex" + parseJSON _ = mzero + +-- | A transaction out of an account. +data TxOut = + TxOut { -- | The amount of bitcoin transferred out. + txoutVal :: BTC + -- | The public key of the account we sent the money to. + , scriptPubKey :: ScriptPubKey + } + deriving ( Show, Read, Ord, Eq ) + +instance FromJSON TxOut where + parseJSON (Object o) = TxOut <$> (unwrapBTC <$> o .: "value") + <*> o .: "scriptPubKey" + parseJSON _ = mzero + +-- | Information on a single block. +data BlockInfo = ConfirmedBlock { -- | The number of confirmations a block has. + -- This will always be >= 1. + confirmations :: Integer + -- The JSON "time" field". + , cbTime :: Integer + -- | The JSON "blocktime" field. + , blockTime :: Integer + } + | UnconfirmedBlock + -- ^ An unconfirmed block is boring, but a possibility. + deriving ( Show, Read, Ord, Eq ) + +instance FromJSON BlockInfo where + parseJSON (Object o) = parseConfirmed <|> parseUnconfirmed + where + parseConfirmed = ConfirmedBlock <$> o .: "confirmations" + <*> o .: "time" + <*> o .: "blocktime" + parseUnconfirmed = do c <- o .: "confirmations" :: AT.Parser Integer + guard $ c == 0 + return UnconfirmedBlock + parseJSON _ = mzero + +-- | The raw transaction info for a given transaction ID. +data RawTransactionInfo = + RawTransactionInfo { -- | The raw transaction. + raw :: RawTransaction + -- | The transaction version number. + , txnVersion :: Integer + , txnLockTime :: Integer + -- | The vector of transactions in. + , vin :: Vector TxIn + -- | The vector of transactions out. + , vout :: Vector TxOut + -- | The hash of the block that was used for this + -- transaction. + , rawTxBlockHash :: HexString + -- | The transaction's block's info. + , rawBlockInfo :: BlockInfo + } + deriving ( Show, Read, Ord, Eq ) + +instance FromJSON RawTransactionInfo where + parseJSON v@(Object o) = RawTransactionInfo <$> o .: "hex" + <*> o .: "version" + <*> o .: "locktime" + <*> o .: "vin" + <*> o .: "vout" + <*> o .: "blockhash" + <*> parseJSON v + parseJSON _ = mzero + +-- | Get raw transaction info for a given transaction ID. The data structure +-- returned is quite sprawling and undocumented, so any patches to help +-- simplify things would be greatly appreciated. +getRawTransactionInfo :: Auth -> TransactionID -> IO RawTransactionInfo +getRawTransactionInfo auth txid = + callApi auth "getrawtransaction" [ tj txid, tj verbose ] + where verbose = 1 :: Int + +data UnspentTransaction = + UnspentTransaction { unspentTransactionId :: TransactionID + , outIdx :: Integer + , unspentScriptPubKey :: HexString + , redeemScript :: Maybe HexString + , unspentAmount :: BTC + , usConfirmations :: Integer + } + +instance FromJSON UnspentTransaction where + parseJSON (Object o) = UnspentTransaction <$> o .: "txid" + <*> o .: "vout" + <*> o .: "scriptPubKey" + <*> o .:? "redeemScript" + <*> (unwrapBTC <$> o .: "amount") + <*> o .: "confirmations" + parseJSON _ = mzero + +-- Instance used in 'createRawTransaction'. +instance ToJSON UnspentTransaction where + toJSON (UnspentTransaction{..}) = object [ "txid" .= unspentTransactionId + , "vout" .= outIdx + ] + +-- | Returns an array of unspent transaction outputs with between minconf and +-- maxconf (inclusive) confirmations. If addresses are given, the result will +-- be filtered to include only those addresses. +listUnspent :: Auth + -> Maybe Int -- ^ minconf. Defaults to 1 if 'Nothing'. + -> Maybe Int -- ^ maxconf. Defaults to 9999999 if 'Nothing'. + -> Vector Address -- ^ Use 'Data.Vector.empty' for no filtering. + -> IO (Vector UnspentTransaction) +listUnspent auth mmin mmax vaddrs = + let min' = fromMaybe 1 mmin + max' = fromMaybe 9999999 mmax + in callApi auth "listunspent" [ tj min', tj max', tj vaddrs ] + +-- | Create a transaction spending given inputs, sending to given addresses. +-- +-- Note that the transaction's inputs are not signed, and it is not stored +-- in the wallet or transmitted to the network. +-- +-- Also, there is no checking to see if it's possible to send that much to +-- the targets specified. In the future, such a scenario might throw an +-- exception. +createRawTransaction :: Auth + -> 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 ] + +-- | A successfully decoded raw transaction, from a given serialized, +-- hex-encoded transaction. +data DecodedRawTransaction = + DecodedRawTransaction { -- | The raw transaction. + decRaw :: RawTransaction + -- | The transaction version number. + , decTxnVersion :: Integer + , decTxnLockTime :: Integer + -- | The vector of transactions in. + , decVin :: Vector TxIn + -- | The vector of transactions out. + , decVout :: Vector TxOut + } + +instance FromJSON DecodedRawTransaction where + parseJSON (Object o) = DecodedRawTransaction <$> o .: "hex" + <*> o .: "version" + <*> o .: "locktime" + <*> o .: "vin" + <*> o .: "vout" + parseJSON _ = mzero + +-- | Decodes a raw transaction into a more accessible data structure. +decodeRawTransaction :: Auth -> RawTransaction -> IO DecodedRawTransaction +decodeRawTransaction auth tx = callApi auth "decoderawtransaction" [ tj tx ] + +-- | Used internally to give a new 'ToJSON' instance for 'UnspentTransaction'. +newtype UnspentForSigning = UFS UnspentTransaction + +instance ToJSON UnspentForSigning where + toJSON (UFS (UnspentTransaction{..})) + | isNothing redeemScript = + object [ "txid" .= unspentTransactionId + , "vout" .= outIdx + , "scriptPubKey" .= unspentScriptPubKey + ] + | otherwise = + object [ "txid" .= unspentTransactionId + , "vout" .= outIdx + , "scriptPubKey" .= unspentScriptPubKey + , "redeemScript" .= fromJust redeemScript + ] + +-- | Who can pay for a given transaction. +data WhoCanPay = All + | AllOrAnyoneCanPay + | None + | NoneOrAnyoneCanPay + | Single + | SingleOrAnyoneCanPay + +toString :: WhoCanPay -> Text +toString All = "ALL" +toString AllOrAnyoneCanPay = "ALL|ANYONECANPAY" +toString None = "NONE" +toString NoneOrAnyoneCanPay = "NONE|ANYONECANPAY" +toString Single = "SINGLE" +toString SingleOrAnyoneCanPay = "SINGLE|ANYONECANPAY" + +-- | A raw signed transaction contains the raw, signed hexstring and whether or +-- not this transaction has a complete signature set. +data RawSignedTransaction = + RawSignedTransaction { rawSigned :: HexString + , hasCompleteSigSet :: Bool + } + +-- I have no idea why they use a 1/0 to represent a boolean. +instance FromJSON RawSignedTransaction where + parseJSON (Object o) = RawSignedTransaction <$> o .: "hex" + <*> (toEnum <$> o .: "complete") + parseJSON _ = mzero + +-- | Sign inputs for a raw transaction. +signRawTransaction :: Auth + -> 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 auth rt us' privkeys wcp = + let us = V.map UFS <$> us' :: Maybe (Vector UnspentForSigning) + in callApi auth "signrawtransaction" [ tj rt + , tj us + , tj privkeys + , tj . toString $ fromMaybe All wcp + ] + +sendRawTransaction :: Auth -> RawTransaction -> IO TransactionID +sendRawTransaction auth rt = callApi auth "sendrawtransaction" [ tj rt ] diff --git a/src/Network/Bitcoin/Types.hs b/src/Network/Bitcoin/Types.hs new file mode 100644 --- /dev/null +++ b/src/Network/Bitcoin/Types.hs @@ -0,0 +1,94 @@ +{-# LANGUAGE OverloadedStrings, DeriveDataTypeable #-} +{-# OPTIONS_GHC -Wall #-} +-- | Contains the common types used through bitcoin RPC calls, that aren't +-- specific to a single submodule. +module Network.Bitcoin.Types ( Auth(..) + , BitcoinException(..) + , HexString + , TransactionID + , Satoshi(..) + , BTC + , Account + , Address + , ScriptSig(..) + ) where + +import Control.Applicative +import Control.Exception +import Control.Monad +import Data.Aeson +import Data.Fixed +import Data.Text ( Text ) +import Data.Typeable +import qualified Data.ByteString.Lazy as BL + +-- | 'Auth' describes authentication credentials for +-- making API requests to the Bitcoin daemon. +data Auth = Auth + { rpcUrl :: Text -- ^ URL, with port, where bitcoind listens + , rpcUser :: Text -- ^ same as bitcoind's 'rpcuser' config + , rpcPassword :: Text -- ^ same as bitcoind's 'rpcpassword' config + } + deriving ( Show, Read, Ord, Eq ) + +-- | A 'BitcoinException' is thrown when 'callApi encounters an +-- error. The API error code is represented as an @Int@, the message as +-- a @String@. +-- +-- It may also be thrown when the value returned by the bitcoin API wasn't +-- what we expected. +-- +-- WARNING: Any of the functions in this module's public API may throw this +-- exception. You should plan on handling it. +data BitcoinException = BitcoinApiError Int Text + -- ^ A 'BitcoinApiError' has an error code error + -- message, as returned by bitcoind's JSON-RPC + -- response. + | BitcoinResultTypeError BL.ByteString + -- ^ The raw JSON returned, if we can't figure out what + -- actually went wrong. + deriving ( Show, Read, Ord, Eq, Typeable ) + +instance Exception BitcoinException + +-- | A string returned by the bitcoind API, representing data as hex. +-- +-- What that data represents depends on the API call, but should be +-- dcumented accordingly. +type HexString = Text + +-- | A hexadecimal string representation of a 256-bit unsigned integer. +-- +-- This integer is a unique transaction identifier. +type TransactionID = HexString + +-- | A satoshi is the smallest subdivision of bitcoins. For the resolution, +-- use 'resolution' from 'Data.Fixed'. +data Satoshi = Satoshi + +instance HasResolution Satoshi where + resolution = const $ 10^(8::Integer) + {-# INLINE resolution #-} + +-- | The type of bitcoin money, represented with a fixed-point number. +type BTC = Fixed Satoshi + +-- | An address for sending or receiving money. +type Address = HexString + +-- | I don't know what this is. A signature of some sort? If you know, please +-- submit a patch documenting this properly! +data ScriptSig = ScriptSig { sigAsm :: HexString + , sigHex :: HexString + } + deriving ( Show, Read, Ord, Eq ) + +instance FromJSON ScriptSig where + parseJSON (Object o) = ScriptSig <$> o .: "asm" + <*> o .: "hex" + parseJSON _ = mzero + +-- | An account on the wallet is just a label to easily specify private keys. +-- +-- The default account is an empty string. +type Account = Text diff --git a/src/Network/Bitcoin/Wallet.hs b/src/Network/Bitcoin/Wallet.hs new file mode 100644 --- /dev/null +++ b/src/Network/Bitcoin/Wallet.hs @@ -0,0 +1,476 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -Wall #-} +-- | An interface to bitcoind's available wallet-related RPC calls. +-- The implementation of these functions can be found at +-- . +-- +-- If any APIs are missing, patches are always welcome. If you look at the +-- source of this module, you'll see that the interface code is trivial. +-- +-- Certain APIs were too complicated for me to write an interface for. If +-- you figure them out, then patches are always welcome! They're left in +-- the source as comments. +module Network.Bitcoin.Wallet ( Auth(..) + , BitcoindInfo(..) + , getBitcoindInfo + , getNewAddress + , getAccountAddress + , getAccount + , setAccount + , getAddressByAccount + , sendToAddress + , AddressInfo(..) + , listAddressGroupings + , Signature + , signMessage + , verifyMessage + , getReceivedByAddress + , getReceivedByAddress' + , getReceivedByAccount + , getReceivedByAccount' + , getBalance + , getBalance' + , getBalance'' + , moveBitcoins + , sendFromAccount + , sendMany + -- , createMultiSig + , ReceivedByAddress(..) + , listReceivedByAddress + , listReceivedByAddress' + , ReceivedByAccount(..) + , listReceivedByAccount + , listReceivedByAccount' + -- , listTransactions + -- , listAccounts + -- , listSinceBlock + -- , getTransaction + , backupWallet + , keyPoolRefill + , unlockWallet + , lockWallet + , changePassword + , encryptWallet + , isAddressValid + ) where + +import Control.Applicative +import Control.Monad +import Data.Aeson as A +import Data.Maybe +import Data.Vector as V +import Network.Bitcoin.Internal + +-- | A plethora of information about a bitcoind instance. +data BitcoindInfo = + BitcoindInfo { + -- | What version of bitcoind are we running? + bitcoinVersion :: Integer + -- | What is bitcoind's current protocol number? + , protocolVersion :: Integer + -- | What version is the wallet? + , walletVersion :: Integer + -- | How much money is currently in the wallet? + , balance :: BTC + -- | The number of blocks in our chain. + , numBlocks :: Integer + -- | How many peers are we connected to? + , numConnections :: Integer + -- | A blank string if we're not using a proxy. + , proxy :: Text + -- | The difficulty multiplier for bitcoin mining operations. + , generationDifficulty :: Double + -- | Are we on the test network (as opposed to the primary + -- bitcoin network)? + , onTestNetwork :: Bool + -- | The timestamp of the oldest key in the key pool. + , keyPoolOldest :: Integer + -- | The size of the key pool. + , keyPoolSize :: Integer + -- | How much do we currently pay as a transaction fee? + , transactionFeePaid :: BTC + -- | If the wallet is unlocked, the number of seconds until a + -- re-lock is needed. + , unlockedUntil :: Maybe Integer + -- | Any alerts will show up here. This should normally be an + -- empty string. + , bitcoindErrors :: Text + } + deriving ( Show, Read, Ord, Eq ) + +instance FromJSON BitcoindInfo where + parseJSON (Object o) = BitcoindInfo <$> o .: "version" + <*> o .: "protocolversion" + <*> o .: "walletversion" + <*> (unwrapBTC <$> o .: "balance") + <*> o .: "blocks" + <*> o .: "connections" + <*> o .: "proxy" + <*> o .: "difficulty" + <*> o .: "testnet" + <*> o .: "keypoololddest" + <*> o .: "keypoolsize" + <*> (unwrapBTC <$> o .: "paytxfee") + <*> o .:? "unlocked_until" + <*> o .: "errors" + parseJSON _ = mzero + +-- | Returns an object containing various state info. +getBitcoindInfo :: Auth -> IO BitcoindInfo +getBitcoindInfo auth = callApi auth "getinfo" [] + +-- | Returns a new bitcoin address for receiving payments. +-- +-- If an account is specified (recommended), the new address is added to the +-- address book so payments received with the address will be credited to the +-- given account. +-- +-- If no account is specified, the address will be credited to the account +-- whose name is the empty string. i.e. the default account. +getNewAddress :: Auth -> Maybe Account -> IO Address +getNewAddress auth ma = let acc = fromMaybe "" ma + in callApi auth "getnewaddress" [ tj acc ] + +-- | Returns the current Bitcoin address for receiving payments to the given +-- account. +getAccountAddress :: Auth -> Account -> IO Address +getAccountAddress auth acc = callApi auth "getaccountaddress" [ tj acc ] + +-- | Sets the account associated with the given address. +setAccount :: Auth -> Address -> Account -> IO () +setAccount auth addr acc = callApi auth "setaccount" [ tj addr, tj acc ] + +-- | Returns the account associated with the given address. +getAccount :: Auth -> Address -> IO Account +getAccount auth addr = callApi auth "getaccount" [ tj addr ] + +-- | Returns the list of addresses for the given address. +getAddressByAccount :: Auth -> Account -> IO (Vector Address) +getAddressByAccount auth acc = callApi auth "getaddressbyaccount" [ tj acc ] + +-- | Sends some bitcoins to an address. +sendToAddress :: Auth + -> Address + -- ^ Who we're sending to. + -> BTC + -- ^ The amount to send. + -> Maybe Text + -- ^ An optional comment for the transaction. + -> Maybe Text + -- ^ An optional comment-to (who did we sent this to?) for the + -- transaction. + -> IO TransactionID +sendToAddress auth addr amount comm comm2 = + callApi auth "sendtoaddress" [ tj addr, tj $ WBTC amount, tj comm, tj comm2 ] + +-- | Information on a given address. +data AddressInfo = AddressInfo { -- | The address in question. + aiAddress :: Address + -- | The address' balance. + , aiAmount :: BTC + -- | The address' linked account. + , aiAccount :: Maybe Account + } + deriving ( Show, Read, Eq, Ord ) + +-- | What a silly API. +instance FromJSON AddressInfo where + parseJSON (A.Array a) | V.length a == 2 = AddressInfo <$> parseJSON (a ! 0) + <*> (unwrapBTC <$> parseJSON (a ! 1)) + <*> pure Nothing + | V.length a == 3 = AddressInfo <$> parseJSON (a ! 0) + <*> (unwrapBTC <$> parseJSON (a ! 1)) + <*> (Just <$> parseJSON (a ! 2)) + | otherwise = mzero + parseJSON _ = mzero + +-- | Lists groups of addresses which have had their common ownership made +-- public by common use as inputs or as the resulting change in past +-- transactions. +listAddressGroupings :: Auth + -> IO (Vector (Vector AddressInfo)) +listAddressGroupings auth = + callApi auth "listaddressgroupings" [] + +-- | A signature is a base-64 encoded string. +type Signature = HexString + +-- | Sign a message with the private key of an address. +signMessage :: Auth + -> Address + -- ^ The address whose private key we'll use. + -> Text + -- ^ The message to sign. + -> IO Signature +signMessage auth addr msg = callApi auth "signmessage" [ tj addr, tj msg ] + +-- | Verifies a signed message. +verifyMessage :: Auth + -> Address + -- ^ The address of the original signer. + -> Signature + -- ^ The message's signature. + -> Text + -- ^ The message. + -> IO Bool + -- ^ Was the signature valid? +verifyMessage auth addr sig msg = + callApi auth "verifymessage" [ tj addr, tj sig, tj msg ] + +-- | Returns the total amount received by the given address with at least one +-- confirmation. +getReceivedByAddress :: Auth -> Address -> IO BTC +getReceivedByAddress auth addr = + unwrapBTC <$> callApi auth "getreceivedbyaddress" [ tj addr ] + +-- | Returns the total amount received by the given address, with at least the +-- give number of confirmations. +getReceivedByAddress' :: Auth + -> Address + -> Int -- ^ The minimum number of confirmations needed + -- for a transaction to to count towards the + -- total. + -> IO BTC +getReceivedByAddress' auth addr minconf = + unwrapBTC <$> callApi auth "getreceivedbyaddress" [ tj addr, tj minconf ] + +-- | Returns the total amount received by address with the given account. +getReceivedByAccount :: Auth -> Account -> IO BTC +getReceivedByAccount auth acc = + unwrapBTC <$> callApi auth "getreceivedbyaccount" [ tj acc ] + +-- | Returns the total amount received by addresses with the given account, +-- counting only transactions with the given minimum number of confirmations. +getReceivedByAccount' :: Auth + -> 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 = + unwrapBTC <$> callApi auth "getreceivedbyaccount" [ tj acc, tj minconf ] + +-- | Returns the server's total available balance. +getBalance :: Auth + -> IO BTC +getBalance auth = + unwrapBTC <$> callApi auth "getbalance" [] + +-- | Returns the balance in the given account, counting only transactions with +-- at least one confirmation. +getBalance' :: Auth + -> Account + -> IO BTC +getBalance' auth acc = + unwrapBTC <$> callApi auth "getbalance" [ tj acc ] + +-- | Returns the balance in the given account, counting only transactions with +-- at least the given number of confirmations. +getBalance'' :: Auth + -> Account + -> Int + -- ^ The minimum number of confirmations needed for a transaction + -- to cuont towards the total. + -> IO BTC +getBalance'' auth acc minconf = + unwrapBTC <$> callApi auth "getbalance" [ tj acc, tj minconf ] + +-- | Move bitcoins from one account in your wallet to another. +-- +-- If you want to send bitcoins to an address not in your wallet, use +-- 'sendFromAccount'. +moveBitcoins :: Auth + -> Account -- ^ From. + -> Account -- ^ To. + -> BTC -- ^ The amount to transfer. + -> Text -- ^ A comment to record for the transaction. + -> IO () +moveBitcoins auth from to amt comm = + stupidAPI <$> callApi auth "move" [ tj from, tj to, tj $ WBTC amt, tj one, tj comm ] + where one = 1 :: Int -- needs a type, else default-integer warnings. + stupidAPI :: Bool -> () + stupidAPI = const () + +-- | Sends bitcoins from a given account in our wallet to a given address. +-- +-- A transaction and sender comment may be optionally provided. +sendFromAccount :: Auth + -> Account + -- ^ The account to send from. + -> Address + -- ^ The address to send to. + -> BTC + -- ^ The amount to send. + -> Maybe Text + -- ^ An optional transaction comment. + -> Maybe Text + -- ^ An optional comment on who the money is going to. + -> IO TransactionID +sendFromAccount auth from to amount comm comm2 = + callApi auth "sendfrom" [ tj from, tj to, tj $ WBTC amount, tj one, tj comm, tj comm2 ] + where one = 1 :: Int -- needs a type, else default-integer warnings. + +-- | Send to a whole bunch of address at once. +sendMany :: Auth + -> Account + -- ^ The account to send from. + -> Vector (Address, BTC) + -- ^ The address, and how much to send to each one. + -> Maybe Text + -- ^ An optional transaction comment. + -> IO TransactionID +sendMany auth acc amounts comm = + callApi auth "sendmany" [ tj acc, tj $ AA amounts, tj comm ] + +-- TODO: createmultisig. +-- +-- I have no idea what this is doing. Patches adding this function are +-- always welcome! + +-- | Information on how much was received by a given address. +data ReceivedByAddress = + ReceivedByAddress { -- | The address which the money was deposited to. + recvAddress :: Address + -- | The account which this address belongs to. + , recvAccount :: Account + -- | The amount received. + , recvAmount :: BTC + -- | The number of confirmations of the most recent + -- included transaction. + , recvNumConfirmations :: Integer + } + deriving ( Show, Read, Ord, Eq ) + +instance FromJSON ReceivedByAddress where + parseJSON (Object o) = ReceivedByAddress <$> o .: "address" + <*> o .: "account" + <*> (unwrapBTC <$> o .: "amount") + <*> o .: "confirmations" + parseJSON _ = mzero + +-- | Lists the amount received by each address which has received money at some +-- point, counting only transactions with at least one confirmation. +listReceivedByAddress :: Auth -> IO (Vector ReceivedByAddress) +listReceivedByAddress auth = listReceivedByAddress' auth 1 False + +-- | List the amount received by each of our addresses, counting only +-- transactions with the given minimum number of confirmations. +listReceivedByAddress' :: Auth + -> Int + -- ^ The minimum number of confirmations before a + -- transaction counts toward the total amount + -- received. + -> Bool + -- ^ Should we include addresses with no money + -- received? + -> IO (Vector ReceivedByAddress) +listReceivedByAddress' auth minconf includeEmpty = + callApi auth "listreceivedbyaddress" [ tj minconf, tj includeEmpty ] + +data ReceivedByAccount = + ReceivedByAccount { raccAccount :: Account + -- ^ The account we received into. + , raccAmount :: BTC + -- ^ The mount received. + -- ^ The number of confirmations of the most recent + -- included transaction. + , raccNumConfirmations :: Integer + } + deriving ( Show, Read, Ord, Eq ) + +instance FromJSON ReceivedByAccount where + parseJSON (Object o) = ReceivedByAccount <$> o .: "account" + <*> (unwrapBTC <$> o .: "amount") + <*> o .: "confirmations" + parseJSON _ = mzero + +-- | Lists the amount received by each account which has received money at some +-- point, counting only transactions with at leaset one confirmation. +listReceivedByAccount :: Auth -> IO (Vector ReceivedByAccount) +listReceivedByAccount auth = listReceivedByAccount' auth 1 False + +-- | List the amount received by each of our accounts, counting only +-- transactions with the given minimum number of confirmations. +listReceivedByAccount' :: Auth + -> Int + -- ^ The minimum number of confirmations before a + -- transaction counts toward the total received. + -> Bool + -- ^ Should we include the accounts with no money + -- received? + -> IO (Vector ReceivedByAccount) +listReceivedByAccount' auth minconf includeEmpty = + callApi auth "listreceivedbyaccount" [ tj minconf, tj includeEmpty ] + +-- TODO: listtransactions +-- listaccounts +-- listsinceblock +-- gettransaction +-- +-- These functions are just way too complicated for me to write. +-- Patches welcome! + +-- | Safely copies wallet.dat to the given destination, which can be either a +-- directory, or a path with filename. +backupWallet :: Auth + -> FilePath + -> IO () +backupWallet auth fp = + callApi auth "backupwallet" [ tj fp ] + +-- | Fills the keypool. +keyPoolRefill :: Auth -> IO () +keyPoolRefill auth = callApi auth "keypoolrefill" [] + +-- | Stores the wallet decryption key in memory for the given amount of time. +unlockWallet :: Auth + -> Text + -- ^ The decryption key. + -> Integer + -- ^ How long to store the key in memory (in seconds). + -> IO () +unlockWallet auth pass timeout = + callApi auth "walletpassphrase" [ tj pass, tj timeout ] + +-- | Changes the wallet passphrase. +changePassword :: Auth + -> Text + -- ^ The old password. + -> Text + -- ^ The new password. + -> IO () +changePassword auth old new = + callApi auth "walletpassphrase" [ tj old, tj new ] + +-- | Removes the wallet encryption key from memory, locking the wallet. +-- +-- After calling this function, you will need to call 'unlockWallet' again +-- before being able to call methods which require the wallet to be unlocked. +-- +-- Note: In future releases, we might introduce an "unlocked" monad, so +-- locking and unlocking is automatic. +lockWallet :: Auth -> IO () +lockWallet auth = callApi auth "walletlock" [] + +-- | Encrypts the wallet with the given passphrase. +-- +-- WARNING: bitcoind will shut down after calling this method. Don't say I +-- didn't warn you. +encryptWallet :: Auth -> Text -> IO () +encryptWallet auth pass = stupidAPI <$> callApi auth "encryptwallet" [ tj pass ] + where + stupidAPI :: Text -> () + stupidAPI = const () + +-- | Just a handy wrapper to help us get only the "isvalid" field of the JSON. +-- The structure is much too complicated for what it needs to do. +data IsValid = IsValid { getValid :: Bool } + +instance FromJSON IsValid where + parseJSON (Object o) = IsValid <$> o .: "isvalid" + parseJSON _ = mzero + +-- | Checks if a given address is a valid one. +isAddressValid :: Auth -> Address -> IO Bool +isAddressValid auth addr = getValid <$> callApi auth "validateaddress" [ tj addr ]