network-bitcoin (empty) → 0.1.0
raw patch · 5 files changed
+428/−0 lines, 5 filesdep +HTTPdep +aesondep +attoparsecsetup-changed
Dependencies added: HTTP, aeson, attoparsec, base, bytestring, containers, network, text
Files
- LICENSE +30/−0
- Setup.hs +2/−0
- network-bitcoin.cabal +88/−0
- src/Network/Bitcoin.hs +278/−0
- src/Network/Bitcoin/Address.hs +30/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c)2011, Michael Hendricks++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Michael Hendricks nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ network-bitcoin.cabal view
@@ -0,0 +1,88 @@+-- 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.0++-- A short (one-line) description of the package.+Synopsis: Interface with Bitcoin RPC++-- A longer description of the package.+Description:+ This can be used to send Bitcoins, query balances, etc. It+ requires the Bitcoin daemon to be running and accessible via+ HTTP.+ .+ > import Network.Bitcoin+ >+ > main = do+ > balance <- getBalance auth+ > putStrLn $ show balance ++ " BTC"+ > where+ > auth = Auth "http://127.0.0.1:8332" "user" "password"+ .+ To learn more about Bitcoin, see <http://www.bitcoin.org>.++-- 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 <michael@ndrix.org>++-- An email address to which users can send suggestions, bug reports,+-- and patches.+Maintainer: Michael Hendricks <michael@ndrix.org>++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.6+++Library+ hs-source-dirs: src+ ghc-options: -Wall -fno-warn-unused-binds -fno-warn-incomplete-patterns++ -- 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 && < 0.10,+ bytestring == 0.9.*,+ containers == 0.4.*,+ HTTP == 4000.*,+ network == 2.3.*,+ text == 0.11.*,+ base == 4.3.*+ + -- Modules not exported by this package.+ -- Other-modules: + + -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source.+ -- Build-tools: +
+ src/Network/Bitcoin.hs view
@@ -0,0 +1,278 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE TypeSynonymInstances #-}+-- | Communicate with a Bitcoin daemon over JSON RPC+module Network.Bitcoin+ (+ -- * Types+ Auth(..)+ , Address+ , mkAddress+ , Amount+ , Account+ , MinConf+ , AddressValidation+ , isValid+ , isMine+ , account+ , BitcoinException(..)++ -- * Individual API methods+ , getBalance+ , getBlockCount+ , getConnectionCount+ , getDifficulty+ , getGenerate+ , getHashesPerSec+ , getReceivedByAccount+ , getReceivedByAddress+ , validateAddress+ , isValidAddress++ -- * Low-level API+ , callApi+ ) 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.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++-- Define Bitcoin's internal precision+data Satoshi = Satoshi+instance HasResolution Satoshi where+ resolution _ = 10^(8::Integer)++-- | 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 $ toRational d+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
+ src/Network/Bitcoin/Address.hs view
@@ -0,0 +1,30 @@+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 == 34)+ isOK _ = False