bitcoin-hs-0.0.1: Bitcoin/RPC/API.hs
-- | bitcoind API access (via JSON-RPC over HTTP calls)
--
-- See <https://en.bitcoin.it/wiki/Original_Bitcoin_client/API_calls_list>
--
{-# LANGUAGE PatternGuards #-}
module Bitcoin.RPC.API where
--------------------------------------------------------------------------------
import Data.Word
import Data.Bits
import Data.Maybe
import Control.Applicative
import Text.JSON
import Text.JSON.Types
import qualified Data.ByteString as B
import Bitcoin.Misc.HexString
import Bitcoin.Misc.OctetStream
import Bitcoin.Misc.UnixTime
import Bitcoin.Protocol.Address
import Bitcoin.Protocol.Amount
import Bitcoin.Protocol.Base64
import Bitcoin.Protocol.Hash
import Bitcoin.Protocol.Key
import Bitcoin.Protocol.Signature
import Bitcoin.Script.Base
import Bitcoin.BlockChain.Base
import Bitcoin.RPC.JSON
import Bitcoin.RPC.Call
--------------------------------------------------------------------------------
-- | An account in the Satoshi client wallet
type Account = String
-- | A network node
type Node = String
-- | A transaction id
type TxId = Hash256
-- | A public key
type Key = Either PubKey Address
-- | Minimum number of confirmations (default is usually 1)
type MinConf = Maybe Int
type MaxConf = Maybe Int
-- | A redeem script for a multi-sig address
type RedeemScript = RawScript
type PassPhrase = String
------------------
data AddNodeCmd
= NodeAdd
| NodeRemove
| NodeOneTry
deriving (Eq,Show)
--------------------------------------------------------------------------------
{-
-- | Subset of satoshi client API calls.
-- See <https://en.bitcoin.it/wiki/Original_Bitcoin_client/API_Calls_list>
--
data APICALL
-- client info
= GetInfo -- ^ Returns an object containing various state info.
| GetConnectionCount -- ^ Returns the number of connections to other nodes.
| Stop -- ^ Stop bitcoin server.
-- blockchain info
| GetDifficulty -- ^ Returns the proof-of-work difficulty as a multiple of the minimum difficulty.
| GetBlock Hash256 -- ^ Returns information about the given block hash.
| GetBlockCount -- ^ Returns the number of blocks in the longest block chain.
| GetBlockHash Int -- ^ Returns hash of block in best-block-chain at \<index\>
-- transaction info
| GetTransaction TxId -- ^ Returns an object about the given transaction containing: \"amount\", \"confirmations\", \"txid\", \"time\", \"details\" (details is an array of objects containing: \"account\", \"address\", \"category\", \"amount\", \"fee\")
| DecodeRawTransaction B.ByteString -- ^ version 0.7 Produces a human-readable JSON object for a (hex string of a) raw transaction.
-- wallet info
| ValidateAddress Address -- ^ Return information about \<bitcoinaddress\>.
| DumpPrivKey Address -- ^ Reveals the private key corresponding to \<bitcoinaddress\>. NOTE: Wallet needs to be unlocked!
| GetBalance (Maybe Account) MinConf -- ^ If [account] is not specified, returns the server's total available balance. Int is # of minimum confirmations
| GetAccountAddress Account -- ^ Returns the current bitcoin address for receiving payments to this account.
| GetAddressesByAccount Account -- ^ Returns the list of addresses for the given account.
| GetAccount Address -- ^ Returns the account associated with the given address.
| ListAccounts MinConf -- ^ Returns Object that has account names as keys, account balances as values. Int is number of minimal confirmations
| ListAddressGroupings -- ^ version 0.7 Returns all addresses in the wallet and info used for coincontrol.
| ListReceivedByAccount MinConf Bool -- ^ Int is minconf. Bool is \"includeempty\". Returns an array of objects containing: \"account\", \"amount\", \"confirmations\"
| ListReceivedByAddress MinConf Bool -- ^ Returns an array of objects containing: \"address\", \"account\", \"amount\", \"confirmations\". To get a list of accounts on the system, execute bitcoind listreceivedbyaddress 0 true
-- network info
| GetRawMemPool -- ^ version 0.7 Returns all transaction ids in memory pool
-- multi-sig
| AddMultiSigAddress Int [Key] (Maybe Account) -- ^ Add a n-required-to-sign multisignature address to the wallet. Each key is a bitcoin address or hex-encoded public key. If [account] is specified, assign address to [account].
| CreateMultiSig Int [Key] -- ^ Creates a multi-signature address and returns a json object
-- sending coins
| SendFrom Account Address Amount MinConf (Maybe String) (Maybe String) -- ^ \<fromaccount\> \<tobitcoinaddress\> \<amount\> [minconf=1] [comment] [comment-to]. Will send the given amount to the given address, ensuring the account has a valid balance using [minconf] confirmations. Returns the transaction ID if successful (not in JSON object). NOTE: Wallet needs to be unlocked!
| SendMany Account [(Address,Amount)] MinConf (Maybe String) -- ^ Amounts are double-precision floating point numbers. NOTE: Wallet needs to be unlocked!
| SendRawTransaction B.ByteString -- ^ version 0.7 Submits raw transaction (serialized, hex-encoded) to local node and network.
| SendToAddress Address Amount (Maybe String) (Maybe String) -- ^ \<amount\> is a real and is rounded to 8 decimal places. Returns the transaction ID \<txid\> if successful. NOTE: Wallet needs to be unlocked!
| Move Account Account Amount MinConf (Maybe String) -- ^ \<fromaccount\> \<toaccount\> \<amount\> [minconf=1] [comment]. Move from one account in your wallet to another
| SetTxFee Amount -- ^ \<amount\> is a real and is rounded to the nearest 0.00000001
-- signing
| SignMessage Address String -- ^ Sign a message with the private key of an address. NOTE: Wallet needs to be unlocked!
| VerifyMessage Address Signature String -- ^ Verify a signed message.
-- wallet operations
| GetNewAddress (Maybe Account) -- ^ Returns a new bitcoin address for receiving payments. If [account] is specified (recommended), it is added to the address book so payments received with the address will be credited to [account].
| ImportPrivKey PrivKey (Maybe String) Bool -- ^ Adds a private key (as returned by dumpprivkey) to your wallet. This may take a while, as a rescan is done, looking for existing transactions. Optional [rescan] parameter added in 0.8.0. NOTE: Wallet needs to be unlocked!
| BackupWallet FilePath -- ^ Safely copies wallet.dat to destination, which can be a directory or a path with filename.
| EncryptWallet String -- ^ Encrypts the wallet with \<passphrase\>.
| WalletLock -- ^ Removes the wallet encryption key from memory, locking the wallet. After calling this method, you will need to call walletpassphrase again before being able to call any methods which require the wallet to be unlocked.
| WalletPassPhrase String Int -- ^ Stores the wallet decryption key in memory for \<timeout\> seconds.
| WalletPassPhraseChange String String -- ^ Changes the wallet passphrase from \<oldpassphrase\> to \<newpassphrase\>.
| KeyPoolRefill -- ^ Fills the keypool, requires wallet passphrase to be set. NOTE: Wallet needs to be unlocked!
-}
--------------------------------------------------------------------------------
-- * client info
data ClientInfo = ClientInfo
{ _cliClientVersion :: (Int,Int,Int)
, _cliProtocolVersion :: (Int,Int,Int)
, _cliWalletVersion :: (Int,Int,Int)
, _cliTotalBalance :: Amount
, _cliNumberOfBlocks :: Int
, _cliTimeOffset :: Double -- ^ in hours, relative to GMT, but negated (?)
, _cliNoConnections :: Int
, _cliProxy :: String
, _cliCurrentDifficulty :: Double
, _cliOnTestnet :: Bool
, _cliKeyPoolOldest :: UnixTimeStamp
, _cliKeyPoolSize :: Int
, _cliPayTxFee :: Amount
}
deriving Show
-- | Returns an object containing various state info.
getClientInfo :: Call ClientInfo
getClientInfo = makeCall "getinfo" () $ \js -> case js of
JSObject obj ->
case obj of
_ | Just cver <- lkp "version"
, Just pver <- lkp "protocolversion"
, Just wver <- lkp "walletversion"
, Just bal <- lkp "balance"
, Just nblk <- lkp "blocks"
, Just tofs <- lkp "timeoffset"
, Just ncon <- lkp "connections"
, Just prxy <- lkp "proxy"
, Just diff <- lkp "difficulty"
, Just test <- lkp "testnet"
, Just old <- lkp "keypoololdest"
, Just pool <- lkp "keypoolsize"
, Just fee <- lkp "paytxfee"
-> Just $ ClientInfo
(parseVer cver)
(parseVer pver)
(parseVer wver)
bal
nblk
tofs
ncon
prxy
diff
test
old
pool
fee
_ -> Nothing
where
lkp :: JSON a => String -> Maybe a
lkp fld = get_field obj fld >>= myReadJSON
{-
lkp fld = case get_field obj fld of
Just js -> case readJSON js of
Ok x -> Just x
Error _ -> Nothing
Nothing -> Nothing
-}
parseVer :: Int -> (Int,Int,Int)
parseVer n = (a,b,c) where
(a,tmp) = divMod n 10000
(b,c) = divMod tmp 100
_ -> Nothing
-- | Returns the number of connections to other nodes
getConnectionCount :: Call Int
getConnectionCount = makeCall "getconnectioncount" () myReadJSON
-- | Stops the bitcoin client
stopClient :: Call ()
stopClient = makeCall "stop" () $ \_ -> Just ()
--------------------------------------------------------------------------------
-- * blockchain info
data BlockInfo = BlockInfo
{ _bliHash :: Hash256
, _bliConfirmations :: Int
, _bliSize :: Int
, _bliHeight :: Int
, _bliVersion :: Int
, _bliMerkleRoot :: Hash256
, _bliTxHashes :: [Hash256]
, _bliTime :: UnixTimeStamp
, _bliNonce :: Word32
, _bliDifficultyBits :: Word32
, _bliDifficulty :: Double
, _bliPrevHash :: Maybe Hash256
, _bliNextHash :: Maybe Hash256
}
deriving Show
-- | Returns the proof-of-work difficulty as a multiple of the minimum difficulty.
getDifficulty :: Call Double
getDifficulty = makeCall "getdifficulty" () myReadJSON
-- | Returns the number of blocks in the longest block chain.
getBlockCount :: Call Int
getBlockCount = makeCall "getblockcount" () myReadJSON
-- | Returns hash of block in best-block-chain at \<index\> transaction info
getBlockHash :: Int -> Call Hash256
getBlockHash n = makeCall "getblockhash" [n] myReadJSON
{-
("hash",JSString (JSONString {fromJSString = "00000000000000205868fe2a3147ac3ca6061e5d21a4cfdf345adc0282993c68"}))
,("confirmations",JSRational False (1 % 1))
,("size",JSRational False (138687 % 1))
,("height",JSRational False (249228 % 1))
,("version",JSRational False (2 % 1))
,("merkleroot",JSString (JSONString {fromJSString = "fe750a784090601e6bda1fbb9da8f5528706844877892545db2d78702d7172b5"}))
,("tx",JSArray [ ... ] )
,("time",JSRational False (1375184425 % 1))
,("nonce",JSRational False (3818843198 % 1))
,("bits",JSString (JSONString {fromJSString = "1a008968"}))
,("difficulty",JSRational False (3125696072776893 % 100000000))
,("previousblockhash",JSString (JSONString {fromJSString = "0000000000000077d150668c20f4ee2bfd19696b14a134cdaf7dc682e82bcbe5"}))]}))
-}
-- | Returns information about the given block hash.
getBlockInfo :: Hash256 -> Call BlockInfo
getBlockInfo blockhash = makeCall "getblock" [blockhash] $ \js -> case js of
JSObject obj ->
case obj of
_ | Just hash <- lkp "hash"
, Just conf <- lkp "confirmations"
, Just size <- lkp "size"
, Just hght <- lkp "height"
, Just ver <- lkp "version"
, Just root <- lkp "merkleroot"
, Just txs <- lkp "tx"
, Just time <- lkp "time"
, Just nonc <- lkp "nonce"
, Just bstr <- lkp "bits" , Just bits <- parseBits bstr
, Just diff <- lkp "difficulty"
, mbprev <- lkp "previousblockhash"
, mbnext <- lkp "nextblockhash"
-> Just $ BlockInfo
hash
conf
size
hght
ver
root
txs
time
nonc
bits
diff
mbprev
mbnext
_ -> Nothing
where
lkp :: JSON a => String -> Maybe a
lkp fld = get_field obj fld >>= myReadJSON
parseBits bitstring = case safeHexDecode bitstring of
Just [a,b,c,d] -> Just $ shiftL (fromIntegral a) 24
+ shiftL (fromIntegral b) 16
+ shiftL (fromIntegral c) 8
+ (fromIntegral d)
Nothing -> Nothing
_ -> Nothing
--------------------------------------------------------------------------------
-- * transaction info
data TxDetail = TxDetail
{ _txdAccount :: Account
, _txdAddress :: Address
, _txdCategory :: String
, _txdAmount :: Amount
, _txdFee :: Amount
}
deriving Show
data TxInfo = TxInfo
{ _txiAmount :: Amount
, _txiConfirmations :: Int
, _txiId :: TxId
, _txiTime :: UnixTimeStamp
, _txiDetails :: [TxDetail]
}
deriving Show
instance JSON TxDetail where
readJSON jsv = case parseTxDetail jsv of
Nothing -> Error "TxDetail/readJSON: cannot parse"
Just x -> Ok x
showJSON = error "TxDetail/showJSON: not implemented"
parseTxDetail :: JSValue -> Maybe TxDetail
parseTxDetail jsv = case jsv of
JSObject obj ->
case obj of
_ | Just acc <- lkp "account"
, Just addr <- lkp "address"
, Just cat <- lkp "category"
, Just amt <- lkp "amount"
, Just fee <- lkp "fee"
-> Just $ TxDetail acc addr cat amt fee
_ -> Nothing
where
lkp :: JSON a => String -> Maybe a
lkp fld = get_field obj fld >>= myReadJSON
_ -> Nothing
parseTxInfo :: JSValue -> Maybe TxInfo
parseTxInfo jsv = case jsv of
JSObject obj ->
case obj of
_ | Just amt <- lkp "amount"
, Just conf <- lkp "confirmations"
, Just txid <- lkp "txid"
, Just time <- lkp "time"
, Just (JSArray dets) <- lkp "details"
, mbdetails <- map parseTxDetail dets
, all isJust mbdetails
-> Just $ TxInfo amt conf txid time (catMaybes mbdetails)
_ -> Nothing
where
lkp :: JSON a => String -> Maybe a
lkp fld = get_field obj fld >>= myReadJSON
_ -> Nothing
-- | Returns an object about the given transaction. Note: this only works for the transaction in the wallet.
-- For transactions out in the blockchain, use "getRawTransaction" or "getTransactionInfo"
getWalletTransaction :: TxId -> Call TxInfo
getWalletTransaction txid = makeCall "getrawtransaction" (txid, (0::Int)) parseTxInfo
--------------------------------------------------------------------------------
-- | A scriptSig as returned by \"getrawtransaction\" (verbose=1) API call
data ScriptSigVerbose = ScriptSigVerbose
{ _scriptSigAsm :: String -- ^ human-readable script
, _scriptSigHex :: !RawScript -- ^ raw script
}
deriving (Eq,Show)
parseScriptSigVerbose :: JSValue -> Maybe ScriptSigVerbose
parseScriptSigVerbose jsv = case jsv of
JSObject obj ->
case obj of
_ | Just asm <- lkp "asm"
, Just hex <- lkp "hex"
-> Just $ ScriptSigVerbose asm hex
_ -> Nothing
where
lkp :: JSON a => String -> Maybe a
lkp fld = get_field obj fld >>= myReadJSON
_ -> Nothing
-- | A transaction input as returned by \"getrawtransaction\" (verbose=1) API call
data TxVIn = TxVIn
{ _vinTxId :: !TxId -- ^ hash of the input transaction
, _vinVOut :: !Int -- ^ which output of the input transaction we spend
, _vinScriptSig :: !ScriptSigVerbose -- ^ script signature
, _vinSequence :: !Word32 -- ^ sequence no
}
deriving (Eq,Show)
parseTxVIn :: JSValue -> Maybe TxVIn
parseTxVIn jsv = case jsv of
JSObject obj ->
case obj of
_ | Just txid <- lkp "txid"
, Just vout <- lkp "vout"
, Just ssig <- lkp "scriptSig" , Just scriptSig <- parseScriptSigVerbose ssig
, Just seqn <- lkp "sequence"
-> Just $ TxVIn txid vout scriptSig seqn
_ -> Nothing
where
lkp :: JSON a => String -> Maybe a
lkp fld = get_field obj fld >>= myReadJSON
_ -> Nothing
-- | A scriptPubKey as returned by \"getrawtransaction\" (verbose=1) API call
data ScriptPubKeyVerbose = ScriptPubKeyVerbose
{ _scriptPubKeyAsm :: String -- ^ human-readable script
, _scriptPubKeyHex :: !RawScript -- ^ raw script
, _scriptPubKeyReqSigs :: !Int -- ^ required number of signatures
, _scriptPubKeyType :: String -- ^ script type (eg. \"pubkeyhash\")
, _scriptPubKeyAddresses :: [Address] -- ^ list of addresses
}
deriving (Eq,Show)
parseScriptPubKeyVerbose :: JSValue -> Maybe ScriptPubKeyVerbose
parseScriptPubKeyVerbose jsv = case jsv of
JSObject obj ->
case obj of
_ | Just asm <- lkp "asm"
, Just hex <- lkp "hex"
, Just req <- lkp "reqSigs"
, Just typ <- lkp "type"
, Just (JSArray adrs) <- lkp "addresses"
, let mbaddresses = map myReadJSON adrs
, all isJust mbaddresses
-> Just $ ScriptPubKeyVerbose asm hex req typ (catMaybes mbaddresses)
_ -> Nothing
where
lkp :: JSON a => String -> Maybe a
lkp fld = get_field obj fld >>= myReadJSON
_ -> Nothing
-- | A transaction output as returned by \"getrawtransaction\" (verbose=1) API call
data TxVOut = TxVOut
{ _voutValue :: !Amount
, _voutN :: !Int
, _voutScriptPubKey :: !ScriptPubKeyVerbose
}
deriving (Eq,Show)
parseTxVOut :: JSValue -> Maybe TxVOut
parseTxVOut jsv = case jsv of
JSObject obj ->
case obj of
_ | Just amt <- lkp "value"
, Just n <- lkp "n"
, Just spub <- lkp "scriptPubKey" , Just scriptPubKey <- parseScriptPubKeyVerbose spub
-> Just $ TxVOut amt n scriptPubKey
_ -> Nothing
where
lkp :: JSON a => String -> Maybe a
lkp fld = get_field obj fld >>= myReadJSON
_ -> Nothing
-- | A transaction as decoded by the \"decoderawtransaction\" API call
data TxVerbose = TxVerbose
{ _txvTxId :: !TxId -- ^ hash of the transaction
, _txvVersion :: !Int -- ^ tx version
, _txvLockTime :: !LockTime -- ^ lock time
, _txvVIn :: [TxVIn] -- ^ transaction inputs
, _txvVOut :: [TxVOut] -- ^ transaction outputs
}
deriving (Eq,Show)
parseTxVerbose :: JSValue -> Maybe TxVerbose
parseTxVerbose jsv = case jsv of
JSObject obj ->
case obj of
_ | Just txid <- lkp "txid"
, Just ver <- lkp "version"
, Just lock <- lkp "locktime"
, Just (JSArray vins) <- lkp "vin"
, Just (JSArray vouts) <- lkp "vout"
, let mbins = map parseTxVIn vins
, all isJust mbins
, let mbouts = map parseTxVOut vouts
, all isJust mbouts
-> Just $ TxVerbose txid ver (parseLockTime lock) (catMaybes mbins) (catMaybes mbouts)
_ -> Nothing
where
lkp :: JSON a => String -> Maybe a
lkp fld = get_field obj fld >>= myReadJSON
_ -> Nothing
-- | A transaction as reported by the \"getrawtransaction\" (verbose=1) API call
data TxVerboseEx = TxVerboseEx
{ _txeHex :: !RawTx -- ^ full raw transaction
, _txeTxVerbose :: !TxVerbose -- ^ common details of the transaction
, _txeBlockHash :: !Hash256 -- ^ hash of the block containing the transaction (?)
, _txeConfirmations :: !Int -- ^ number of confirmations
, _txeTime :: !UnixTimeStamp -- ^ timestamp of the transaction
, _txeBlockTime :: !UnixTimeStamp -- ^ timestamp of the block
}
deriving (Eq,Show)
parseTxVerboseEx :: JSValue -> Maybe TxVerboseEx
parseTxVerboseEx jsv = case jsv of
JSObject obj ->
case obj of
_ | Just hex <- lkp "hex"
, Just txid <- lkp "txid"
, Just ver <- lkp "version"
, Just lock <- lkp "locktime"
, Just (JSArray vins) <- lkp "vin"
, Just (JSArray vouts) <- lkp "vout"
, let mbins = map parseTxVIn vins
, all isJust mbins
, let mbouts = map parseTxVOut vouts
, all isJust mbouts
, Just bhsh <- lkp "blockhash"
, Just conf <- lkp "confirmations"
, Just time <- lkp "time"
, Just btim <- lkp "blocktime"
-> Just $ TxVerboseEx hex (TxVerbose txid ver (parseLockTime lock) (catMaybes mbins) (catMaybes mbouts)) bhsh conf time btim
_ -> Nothing
where
lkp :: JSON a => String -> Maybe a
lkp fld = get_field obj fld >>= myReadJSON
_ -> Nothing
-- | \"getrawtransaction\", verbose=0. Version 0.7. Returns raw transaction representation for given transaction id.
--
-- WARNING! Important note from the version 0.8 readme:
--
-- \"This release no longer maintains a full index of historical transaction ids
-- by default, so looking up an arbitrary transaction using the getrawtransaction
-- RPC call will not work. If you need that functionality, you must run once
-- with -txindex=1 -reindex=1 to rebuild block-chain indices (see below for
-- more details).\"
--
getRawTransaction :: TxId -> Call RawTx
getRawTransaction txid = makeCall "getrawtransaction" (txid, (0::Int)) $ \js -> myReadJSON js
-- | \"getrawtransaction\", verbose=1. Version 0.7. Returns transaction representation for given transaction id,
-- in human-understandable format.
getTransactionInfo :: TxId -> Call TxVerboseEx
getTransactionInfo txid = makeCall "getrawtransaction" (txid, (1::Int)) parseTxVerboseEx
decodeRawTransaction :: RawTx -> Call TxVerbose
decodeRawTransaction rawtx = makeCall "decoderawtransaction" [rawtx] parseTxVerbose
--------------------------------------------------------------------------------
-- * wallet info
validateAddress :: Address -> Call (JSObject JSValue)
validateAddress address = makeCall "validateaddress" [address] mbJSObject
-- | Reveals the private key corresponding to \<bitcoinaddress\>. NOTE: Wallet needs to be unlocked!
dumpPrivKeyWIF :: Address -> Call WIF
dumpPrivKeyWIF address = makeCall "dumpprivkey" [address] $ myReadJSON
-- | We decode the WIF and also compute the corresponding public key for convenience.
dumpPrivPubKey :: Address -> Call (PrivKey,PubKey)
dumpPrivPubKey address = makeCall "dumpprivkey" [address] $ \js -> myReadJSON js >>= \s -> (f <$> privKeyWIFDecode (WIF s)) where
f (pfmt,priv) = (priv, computePubKey pfmt priv)
-- | If @[account]@ is not specified, returns the server\'s total available balance. @MinConf = Maybe Int@ is the number of minimum confirmations (default is 1)
getBalance :: Maybe Account -> MinConf -> Call Amount
getBalance mbacc minconf = makeCall "getbalance" (maybe "" id mbacc , maybe 1 id minconf) myReadJSON
-- | Returns the /current/ bitcoin address for receiving payments to this account.
getAccountAddress :: Account -> Call Address
getAccountAddress account = makeCall "getaccountaddress" [account] myReadJSON
-- | Returns the list of addresses for the given account.
getAddressesByAccount :: Account -> Call [Address]
getAddressesByAccount account = makeCall "getaddressesbyaccount" [account] myReadJSON
-- | Returns the account associated with the given address.
getAccount :: Address -> Call Account
getAccount address = makeCall "getaccount" [address] myReadJSON
-- | Returns a list of pairs that has account names as keys, account balances as values. Maybe Int is number of minimal confirmations (default is 1)
listAccounts :: MinConf -> Call [(Account,Amount)]
listAccounts minconf = makeCall "listaccounts" [maybe 1 id minconf] $ \jsv -> (g . map f . fromJSObject) =<< mbJSObject jsv where
f :: (String,JSValue) -> (String, Maybe Amount)
f (s,x) = (s,amountFromDouble <$> myReadJSON x)
g ambs = if all (isJust . snd) ambs
then Just $ map (\(s,mb) -> (s,fromJust mb)) ambs
else Nothing
-- | version 0.7 Returns all addresses in the wallet and info used for coincontrol.
--
-- 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 :: Call JSValue -- (JSObject JSValue) [[(Address,Amount,Account)]]
listAddressGroupings = makeCall "listaddressgroupings" () Just -- mbJSObject
--------------------------------------------------------------------------------
data Received = Received
{ _rcvAddress :: Maybe Address
, _rcvAccount :: Account
, _rcvAmount :: Amount
, _rcvConfirmations :: Int
}
deriving Show
parseReceived :: JSValue -> Maybe Received
parseReceived jsv = case jsv of
JSObject obj ->
case obj of
_ | mbaddr <- lkp "address"
, Just acc <- lkp "account"
, Just amt <- lkp "amount"
, Just conf <- lkp "confirmations"
-> Just $ Received mbaddr acc amt conf
_ -> Nothing
where
lkp :: JSON a => String -> Maybe a
lkp fld = get_field obj fld >>= myReadJSON
_ -> Nothing
-- | Bool is \"includeempty\". Returns an array of objects containing: \"account\", \"amount\", \"confirmations\"
listReceivedByAccount :: MinConf -> Bool -> Call [Received]
listReceivedByAccount minconf includeempty =
makeCall "listreceivedbyaccount" (maybe 1 id minconf, includeempty) $ \jsv -> case jsv of
JSArray arr ->
if all isJust mbs
then Just (catMaybes mbs)
else Nothing
where
mbs = map parseReceived arr
_ -> Nothing
-- | Returns an array of objects containing: \"address\", \"account\", \"amount\", \"confirmations\".
--
-- To get a list of accounts on the system, execute bitcoind listreceivedbyaddress 0 true
listReceivedByAddress :: MinConf -> Bool -> Call [Received]
listReceivedByAddress minconf includeempty =
makeCall "listreceivedbyaddress" (maybe 1 id minconf, includeempty) $ \jsv -> case jsv of
JSArray arr ->
if all isJust mbs
then Just (catMaybes mbs)
else Nothing
where
mbs = map parseReceived arr
_ -> Nothing
--------------------------------------------------------------------------------
-- | An unspent transactions as returned by the \"listunspent\" API call
data Unspent = Unspent
{ _unsTxId :: !TxId -- ^ txid is the hexadecimal transaction id
, _unsOutput :: !Int -- ^ output is which output of that transaction
, _unsScriptPubKey :: !RawScript -- ^ scriptPubKey is the hexadecimal-encoded CScript for that output
, _unsAmount :: !Amount -- ^ amount is the value of that output
, _unsConfirmations :: !Int -- ^ confirmations is the transaction's depth in the chain.
}
deriving (Eq, Show)
-- | Returns an array of unspent transaction outputs in the wallet that have between minconf and maxconf (inclusive) confirmations.
-- Each output is a 5-element object with keys: txid, output, scriptPubKey, amount, confirmations.
-- txid is the hexadecimal transaction id, output is which output of that transaction,
-- scriptPubKey is the hexadecimal-encoded CScript for that output,
-- amount is the value of that output and confirmations is the transaction's depth in the chain.
--
-- Minimum confirmations default is 1 and maximum confirmation default is 999999.
--
listUnspent :: MinConf -> MaxConf -> Call [Unspent]
listUnspent minconf maxconf =
makeCall "listunspent" [maybe 1 id minconf, maybe 999999 id maxconf] $ \jsv -> case jsv of
JSArray arr ->
if all isJust mbs
then Just (catMaybes mbs)
else Nothing
where
mbs = map parseUnspent arr
_ -> Nothing
where
parseUnspent :: JSValue -> Maybe Unspent
parseUnspent jsv = case jsv of
JSObject obj ->
case obj of
_ | Just txid <- lkp "txid"
, Just out <- lkp "output"
, Just script <- lkp "scriptPubKey"
, Just amt <- lkp "amount"
, Just conf <- lkp "confirmations"
-> Just $ Unspent txid out script amt conf
_ -> Nothing
where
lkp :: JSON a => String -> Maybe a
lkp fld = get_field obj fld >>= myReadJSON
_ -> Nothing
--------------------------------------------------------------------------------
-- * network info
-- | version 0.7: Returns all transaction ids in memory pool
getRawMemPool :: Call [TxId]
getRawMemPool = makeCall "getrawmempool" () myReadJSON
--------------------------------------------------------------------------------
-- * multi-sig
-- | Add a n-required-to-sign multisignature address to the wallet.
-- Each key is a bitcoin address or hex-encoded public key.
-- If [account] is specified, assign address to [account].
addMultiSigAddress :: Int -> [Key] -> Maybe Account -> Call Address
addMultiSigAddress n keys mbacc =
if n > length keys || n < 1
then error "addMultiSigAddress: <nrequired> must be least 1 and at most the number of keys"
else makeCall "addmultisigaddress" ( n , jskeys , maybe "" id mbacc ) myReadJSON
where
jskeys = map eiShowJSON keys
-- | Creates a multi-signature address and returns a json object.
createMultiSig :: Int -> [Key] -> Call (Address,RedeemScript)
createMultiSig n keys =
if n > length keys || n < 1
then error "createMultiSig: <nrequired> must be least 1 and at most the number of keys"
else makeCall "createmultisig" ( n , jskeys ) $ \jsv -> case jsv of
JSObject obj ->
case obj of
_ | Just addr <- lkp "address"
, Just script <- lkp "redeemScript"
-> Just (addr,script)
_ -> Nothing
where
lkp :: JSON a => String -> Maybe a
lkp fld = get_field obj fld >>= myReadJSON
_ -> Nothing
where
jskeys = map eiShowJSON keys
--------------------------------------------------------------------------------
-- * sending coins
-- | Send coins from an account to an address
--
-- > <fromaccount> <tobitcoinaddress> <amount> [minconf=1] [comment] [comment-to].
--
-- Will send the given amount to the given address, ensuring the account has a valid
-- balance using [minconf] confirmations. Returns the transaction ID if successful
-- (not in JSON object). NOTE: Wallet needs to be unlocked!
--
-- \"comment\" is the transaction comment, and \"comment-to\" is a local comment: a reminder that
-- who did we sent the coins to? (?)
sendFrom :: Account -> Address -> Amount -> MinConf -> Maybe String -> Maybe String -> Call TxId
sendFrom account address amount minconf comment comment_to =
makeCall "sendfrom" (account, address, amount, maybe 1 id minconf, maybe "" id comment, maybe "" id comment_to) myReadJSON
-- | Send coins from an account to many addresses
-- NOTE: Wallet needs to be unlocked!
sendMany :: Account -> [(Address,Amount)] -> MinConf -> Maybe String -> Call TxId
sendMany account destinations minconf comment =
makeCall "sendmany" (account,destinations,maybe 1 id minconf, maybe "" id comment) myReadJSON
-- | version 0.7. Submits raw transaction (serialized, hex-encoded) to local node and network.
sendRawTransaction :: RawTx -> Call ()
sendRawTransaction rawtx = makeCall "sendrawtransaction" [rawtx] $ \_ -> Just ()
-- | > <bitcoinaddress> <amount> [comment] [comment-to]
sendToAddress :: Address -> Amount -> Maybe String -> Maybe String -> Call TxId
sendToAddress address amount comment comment_to =
makeCall "sendtoaddress" (address,amount,maybe "" id comment, maybe "" id comment_to) myReadJSON
-- | Move from one account in your wallet to another
--
-- > <fromaccount> <toaccount> <amount> [minconf=1] [comment].
--
moveCoins :: Account -> Account -> Amount -> MinConf -> Maybe String -> Call ()
moveCoins accfrom accto amount minconf comment =
makeCall "move" (accfrom, accto, amount, maybe 1 id minconf, maybe "" id comment) $ \_ -> Just ()
-- | Sets the transaction fee
setTxFee :: Amount -> Call ()
setTxFee amount = makeCall "settxfee" [amount] $ \_ -> Just ()
--------------------------------------------------------------------------------
-- * wallet operations
-- | Adds a private key (as returned by dumpprivkey) to your wallet. The second argument is an optional label (account???).
-- This may take a while, as a rescan is done, looking for existing transactions. Optional [rescan] parameter added in 0.8.0.
-- NOTE: Wallet needs to be unlocked!
importPrivKey :: (PubKeyFormat,PrivKey) -> Maybe String -> Bool -> Call ()
importPrivKey (pkfmt,privkey) mblabel rescan =
makeCall "importprivkey" ( privKeyWIFEncode pkfmt privkey , maybe "" id mblabel , rescan ) $ \_ -> Just ()
-- | Imports a private key given as WIF (Wallet Import Format).
importPrivKeyWIF :: WIF -> Maybe String -> Bool -> Call ()
importPrivKeyWIF wif mblabel rescan =
makeCall "importprivkey" ( wif , maybe "" id mblabel , rescan ) $ \_ -> Just ()
-- | Returns a new bitcoin address for receiving payments.
-- If [account] is specified (recommended), it is added to the address book so payments
-- received with the address will be credited to [account].
getNewAddress :: Maybe Account -> Call Address
getNewAddress mbacc =
makeCall "getnewaddress" [ maybe "" id mbacc ] myReadJSON
-- | Sets the account associated with the given address.
-- Assigning address that is already assigned to the same account will create a new address associated with that account.
setAccount :: Address -> Account -> Call ()
setAccount address account = makeCall "setaccount" (address,account) $ \_ -> Just ()
-- | Fills the keypool, requires wallet passphrase to be set. NOTE: Wallet needs to be unlocked!
keyPoolRefill :: Call ()
keyPoolRefill = makeCall "keypoolrefill" () $ \_ -> Just ()
-- | Safely copies wallet.dat to destination, which can be a directory or a path with filename.
backupWallet :: FilePath -> Call ()
backupWallet fpath = makeCall "backupwallet" [fpath] $ \_ -> Just ()
-- | Removes the wallet encryption key from memory, locking the wallet.
-- After calling this method, you will need to call walletpassphrase again
-- before being able to call any methods which require the wallet to be unlocked.
walletLock :: Call ()
walletLock = makeCall "walletlock" () $ \_ -> Just ()
-- | Stores the wallet decryption key in memory for \<timeout\> seconds.
walletPassPhrase :: PassPhrase -> Int -> Call ()
walletPassPhrase pw seconds = makeCall "walletpassphrase" (pw,seconds) $ \_ -> Just ()
-- | Changes the wallet passphrase from \<oldpassphrase\> to \<newpassphrase\>.
walletPassPhraseChange :: PassPhrase -> PassPhrase -> Call ()
walletPassPhraseChange old new = makeCall "walletpassphrasechange" (old,new) $ \_ -> Just ()
-- | Encrypts the wallet with \<passphrase\>.
encryptWallet :: PassPhrase -> Call ()
encryptWallet pw = makeCall "encryptwallet" [pw] $ \_ -> Just ()
--------------------------------------------------------------------------------