{-# 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.moduleNetwork.Bitcoin.Internal(moduleNetwork.Bitcoin.Types,Text,Vector,FromJSON(..),callApi,callApi',tj,WrappedBTC(..),AddrAddress(..))whereimportControl.ApplicativeimportControl.ArrowimportControl.ExceptionimportControl.MonadimportData.AesonimportData.Attoparsec.NumberimportData.MaybeimportData.Vector(Vector)importqualifiedData.VectorasVimportNetwork.Bitcoin.TypesimportNetwork.BrowserimportNetwork.HTTPhiding(password)importNetwork.URI(parseURI)importqualifiedData.ByteString.LazyasBLimportData.Text(Text)importqualifiedData.TextasT-- | RPC calls return an error object. It can either be empty; or have an-- error message + error code.dataBitcoinRpcError=NoError-- ^ All good.|BitcoinRpcErrorIntText-- ^ Error code + error message.deriving(Show,Read,Ord,Eq)instanceFromJSONBitcoinRpcErrorwhereparseJSON(Objectv)=BitcoinRpcError<$>v.:"code"<*>v.:"message"parseJSONNull=returnNoErrorparseJSON_=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.dataBitcoinRpcResponsea=BitcoinRpcResponse{btcResult::a,btcError::BitcoinRpcError}deriving(Show,Read,Ord,Eq)instanceFromJSONa=>FromJSON(BitcoinRpcResponsea)whereparseJSON(Objectv)=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->IOBL.ByteStringcallApi'authrpcReqBody=do(_,httpRes)<-browse$dosetOutHandler.const$return()addAuthorityauthoritysetAllowBasicAuthTruerequest$httpRequest(T.unpackurlString)rpcReqBodyreturn$rspBodyhttpReswhereauthority=httpAuthorityauthurlString=rpcUrlauth-- | '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::FromJSONv=>Auth-- ^ authentication credentials for bitcoind->Text-- ^ command name->[Value]-- ^ command arguments->IOvcallApiauthcmdparams=readVal=<<callApi'authjsonRpcReqBodywherereadValbs=casedecode'bsofJustr@(BitcoinRpcResponse{btcError=NoError})->return$btcResultrJust(BitcoinRpcResponse{btcError=BitcoinRpcErrorcodemsg})->throw$BitcoinApiErrorcodemsgNothing->throw$BitcoinResultTypeErrorbsjsonRpcReqBody=encode$object["jsonrpc".=("2.0"::Text),"method".=cmd,"params".=params,"id".=(1::Int)]{-# INLINE callApi #-}-- | Internal helper functions to make callApi more readablehttpAuthority::Auth->AuthorityhttpAuthority(AuthurlStringusernamepassword)=AuthBasic{auRealm="jsonrpc",auUsername=T.unpackusername,auPassword=T.unpackpassword,auSite=uri}whereuri=fromJust.parseURI$T.unpackurlString-- | Builds the JSON HTTP request.httpRequest::String->BL.ByteString->RequestBL.ByteStringhttpRequesturlStringjsonBody=(postRequesturlString){rqBody=jsonBody,rqHeaders=[mkHeaderHdrContentType"application/json",mkHeaderHdrContentLength(show$BL.lengthjsonBody)]}-- | A handy shortcut for toJSON, because I'm lazy.tj::ToJSONa=>a->Valuetj=toJSON{-# INLINE tj #-}-- | Used to provide a FromJSON instance for fixed-point bitcoins.-- This can be removed after <https://github.com/bos/aeson/pull/89> gets-- merged into master, and is released on Hackage.dataWrappedBTC=WBTC{unwrapBTC::BTC}instanceFromJSONWrappedBTCwhereparseJSON(Numbern)=pure.WBTC$casenofDd->realToFracdIi->fromIntegraliparseJSON_=mzeroinstanceToJSONWrappedBTCwheretoJSON(WBTCbtc)=toJSON$toRationalbtc-- | 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.newtypeAddrAddress=AA(Vector(Address,BTC))instanceToJSONAddrAddresswheretoJSON(AAvec)=object.V.toList$uncurry(.=).secondWBTC<$>vec