bitcoin-api (empty) → 0.9.0
raw patch · 17 files changed
+854/−0 lines, 17 filesdep +aesondep +basedep +base58stringsetup-changed
Dependencies added: aeson, base, base58string, binary, bitcoin-api, bitcoin-block, bitcoin-script, bitcoin-tx, bitcoin-types, bytestring, groom, hexstring, hspec, http-client, lens, lens-aeson, text, unordered-containers, wreq
Files
- LICENSE +22/−0
- README.md +10/−0
- Setup.hs +3/−0
- bitcoin-api.cabal +89/−0
- src/Network/Bitcoin/Api/Blockchain.hs +29/−0
- src/Network/Bitcoin/Api/Client.hs +28/−0
- src/Network/Bitcoin/Api/Dump.hs +15/−0
- src/Network/Bitcoin/Api/Internal.hs +57/−0
- src/Network/Bitcoin/Api/Mining.hs +21/−0
- src/Network/Bitcoin/Api/Misc.hs +89/−0
- src/Network/Bitcoin/Api/Transaction.hs +125/−0
- src/Network/Bitcoin/Api/Types.hs +11/−0
- src/Network/Bitcoin/Api/Types/UnspentTransaction.hs +74/−0
- src/Network/Bitcoin/Api/Wallet.hs +77/−0
- test/Main.hs +8/−0
- test/Network/Bitcoin/ClientSpec.hs +195/−0
- test/Spec.hs +1/−0
+ LICENSE view
@@ -0,0 +1,22 @@+The MIT License (MIT) + +Copyright (c) 2015 Leon Mergen + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. +
+ README.md view
@@ -0,0 +1,10 @@+haskell-bitcoin-script +================== + +[](https://travis-ci.org/solatis/haskell-bitcoin-script) +[](https://coveralls.io/r/solatis/haskell-bitcoin-script?branch=master) +[](http://en.wikipedia.org/wiki/MIT_License) +[](http://haskell.org) + +This library provides utilities for compiling, manipulation and decompiling of +Bitcoin scripts.
+ Setup.hs view
@@ -0,0 +1,3 @@+import Distribution.Simple + +main = defaultMain
+ bitcoin-api.cabal view
@@ -0,0 +1,89 @@+name: bitcoin-api +category: Network, Finance +version: 0.9.0 +license: MIT +license-file: LICENSE +copyright: (c) 2015 Leon Mergen +author: Leon Mergen +maintainer: leon@solatis.com +homepage: http://www.leonmergen.com/opensource.html +bug-reports: http://github.com/solatis/haskell-bitcoin-script/issues +stability: experimental +synopsis: Provides access to the RPC API of Bitcoin Core +description: + The Bitcoin Core application provides an HTTP RPC interface for communication. + This library implements access to these functions. It builds on top of the + `bitcoin-tx` and `bitcoin-script`, and as such provides an extremely flexible + environment to create, manipulate and store transactions and custom scripts. + +build-type: Simple +data-files: LICENSE, README.md +cabal-version: >= 1.10 +tested-with: GHC == 7.6, GHC == 7.8, GHC == 7.10 + +library + hs-source-dirs: src + ghc-options: -Wall -ferror-spans + default-language: Haskell2010 + + exposed-modules: Network.Bitcoin.Api.Client + Network.Bitcoin.Api.Types + Network.Bitcoin.Api.Types.UnspentTransaction + Network.Bitcoin.Api.Blockchain + Network.Bitcoin.Api.Dump + Network.Bitcoin.Api.Mining + Network.Bitcoin.Api.Misc + Network.Bitcoin.Api.Transaction + Network.Bitcoin.Api.Wallet + + other-modules: Network.Bitcoin.Api.Internal + + build-depends: base >= 4.3 && < 5 + , text + , bytestring + , binary + , hexstring + , base58string + + , aeson + , lens + , lens-aeson + , unordered-containers + , wreq + + , bitcoin-types + , bitcoin-block + , bitcoin-tx + , bitcoin-script + +test-suite test-suite + type: exitcode-stdio-1.0 + ghc-options: -Wall -ferror-spans -threaded -auto-all -caf-all -fno-warn-type-defaults + default-language: Haskell2010 + hs-source-dirs: test + main-is: Main.hs + + other-modules: Network.Bitcoin.ClientSpec + Spec + Main + + build-depends: base >= 4.3 && < 5 + , groom + , bytestring + , text + , base58string + + , http-client + , wreq + , lens + + , hspec + + , bitcoin-tx + , bitcoin-script + , bitcoin-api + +source-repository head + type: git + location: git://github.com/solatis/haskell-bitcoin-script.git + branch: master
+ src/Network/Bitcoin/Api/Blockchain.hs view
@@ -0,0 +1,29 @@+{-# LANGUAGE OverloadedStrings #-} + +module Network.Bitcoin.Api.Blockchain where + +import Data.Aeson +import Data.Aeson.Types (emptyArray) + +import qualified Data.HexString as HS +import qualified Data.Bitcoin.Block as Btc + +import qualified Data.Bitcoin.Types as BT +import qualified Network.Bitcoin.Api.Internal as I +import qualified Network.Bitcoin.Api.Types as T + +getBlockCount :: T.Client -> IO Integer +getBlockCount client = + I.call client "getblockcount" emptyArray + +getBlockHash :: T.Client -> Integer -> IO BT.BlockHash +getBlockHash client offset = + let configuration = [toJSON offset] + + in I.call client "getblockhash" configuration + +getBlock :: T.Client -> HS.HexString -> IO Btc.Block +getBlock client hash = + let configuration = [toJSON hash, toJSON False] + + in (return . Btc.decode) =<< I.call client "getblock" configuration
+ src/Network/Bitcoin/Api/Client.hs view
@@ -0,0 +1,28 @@+{-# LANGUAGE OverloadedStrings #-} + +module Network.Bitcoin.Api.Client ( T.Client (..) + , withClient ) where + +import Control.Lens ((&), (?~)) +import qualified Network.Wreq as W +import qualified Network.Wreq.Session as WS + +import qualified Data.Text as T +import qualified Data.Text.Encoding as TE + +import qualified Network.Bitcoin.Api.Types as T + +-- | Initializes a client and prepares it for making requests against the +-- Bitcoin RPC API. Connection reuse is provided, and cleanup of any acquired +-- resources is handled automatically. +withClient :: String -> Int -> T.Text -> T.Text -> (T.Client -> IO a) -> IO a +withClient host port user pass callback = + let options :: W.Options + options = W.defaults & applyAuth + + applyAuth = W.auth ?~ W.basicAuth (TE.encodeUtf8 user) (TE.encodeUtf8 pass) + + generateUrl :: String + generateUrl = "http://" ++ host ++ ":" ++ show port + + in WS.withSession (callback . T.Client generateUrl options)
+ src/Network/Bitcoin/Api/Dump.hs view
@@ -0,0 +1,15 @@+{-# LANGUAGE OverloadedStrings #-} + +module Network.Bitcoin.Api.Dump where + +import Data.Aeson.Types (emptyArray) + +import qualified Data.Bitcoin.Types as BT + +import qualified Network.Bitcoin.Api.Internal as I +import qualified Network.Bitcoin.Api.Types as T + +getPrivateKey :: T.Client -> BT.Address -> IO BT.PrivateKey +getPrivateKey client addr = + let configuration = [addr] + in I.call client "dumpprivkey" configuration
+ src/Network/Bitcoin/Api/Internal.hs view
@@ -0,0 +1,57 @@+{-# LANGUAGE OverloadedStrings #-} + +module Network.Bitcoin.Api.Internal where + +import Control.Applicative ((<$>)) +import Control.Lens ((^.)) +import Control.Monad (mzero) +import qualified Network.Wreq as W +import qualified Network.Wreq.Session as WS + +import Data.Aeson +import qualified Data.HashMap.Strict as HM + +import qualified Data.Text as T +import qualified Network.Bitcoin.Api.Types as T + +data RpcResult a = RpcResultError String + | RpcResultOk a + deriving (Show) + +instance FromJSON a => FromJSON (RpcResult a) where + parseJSON (Object o) = + let checkError :: Bool + checkError = HM.member "error" o && HM.lookup "error" o /= Just Null + + parseResult hasError o' + | hasError = RpcResultError <$> o' .: "error" + | otherwise = RpcResultOk <$> o' .: "result" + + in parseResult checkError o + + parseJSON _ = mzero + +call :: ( ToJSON a + , FromJSON b + , Show b ) + => T.Client -- ^ Our client context + -> String -- ^ The command we wish to execute + -> a -- ^ The parameters we wish to provide + -> IO b -- ^ The result that was returned +call client method params = + let command = object [ "jsonrpc" .= T.pack "2.0" + , "method" .= T.pack method + , "params" .= params + , "id" .= (1 :: Int)] + + call' = do + putStrLn ("Now sending JSON command: " ++ show (encode command)) + r <- W.asJSON =<< WS.postWith (T.clientOpts client) (T.clientSession client) (T.clientUrl client) command + return (r ^. W.responseBody) + + in do + res <- call' + + case res of + (RpcResultError err) -> fail ("An error occured: " ++ show err) + (RpcResultOk obj) -> return obj
+ src/Network/Bitcoin/Api/Mining.hs view
@@ -0,0 +1,21 @@+{-# LANGUAGE OverloadedStrings #-} + +module Network.Bitcoin.Api.Mining where + +import Data.Aeson + +import qualified Data.Bitcoin.Block as Btc + +import qualified Network.Bitcoin.Api.Internal as I +import qualified Network.Bitcoin.Api.Types as T +import qualified Network.Bitcoin.Api.Blockchain as Blockchain + +-- | Generate a certain amount of new blocks. Available in 'regtest' mode only. +generate :: T.Client -- ^ Our client context + -> Integer -- ^ Amount of blocks to generate + -> IO [Btc.Block] -- ^ The generated blocks +generate client blocks = + let configuration = [toJSON True, toJSON blocks] + in do + hashes <- I.call client "setgenerate" configuration + mapM (Blockchain.getBlock client) hashes
+ src/Network/Bitcoin/Api/Misc.hs view
@@ -0,0 +1,89 @@+{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} + +module Network.Bitcoin.Api.Misc where + +import Control.Applicative ((<$>), (<*>)) +import Control.Lens.TH (makeLenses) +import Control.Monad (mzero) + +import Data.Aeson +import Data.Aeson.Types (emptyArray) +import qualified Data.Text as T + +import qualified Network.Bitcoin.Api.Internal as I +import qualified Network.Bitcoin.Api.Types as T + +data BitcoinInfo = BitcoinInfo { + + -- | 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 :: Integer, + + -- | 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 :: T.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 :: Integer, + + -- | 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 :: T.Text + + } deriving ( Show ) + +makeLenses ''BitcoinInfo + +instance FromJSON BitcoinInfo where + parseJSON (Object o) = + BitcoinInfo + <$> o .: "version" + <*> o .: "protocolversion" + <*> o .: "walletversion" + <*> o .: "balance" + <*> o .: "blocks" + <*> o .: "connections" + <*> o .: "proxy" + <*> o .: "difficulty" + <*> o .: "testnet" + <*> o .: "keypoololdest" + <*> o .: "keypoolsize" + <*> o .: "paytxfee" + <*> o .:? "unlocked_until" + <*> o .: "errors" + parseJSON _ = mzero + +getInfo :: T.Client -> IO BitcoinInfo +getInfo client = + I.call client "getinfo" emptyArray
+ src/Network/Bitcoin/Api/Transaction.hs view
@@ -0,0 +1,125 @@+{-# LANGUAGE OverloadedStrings #-} + +-- | This module provides functionality to manipulate raw transaction. It +-- automatically interprets transactions using the `bitcoin-tx` package, so +-- you can work with actual 'Btc.Transaction' objects rather than their +-- serialized format. + +module Network.Bitcoin.Api.Transaction where + +import Data.Aeson +import Data.Aeson.Lens +import Data.Maybe (fromMaybe) + +import Control.Lens ((^.), (^?)) + +import qualified Data.Base58String as B58S +import qualified Data.Bitcoin.Transaction as Btc +import qualified Data.Bitcoin.Block as Btc (Block (..)) + +import qualified Network.Bitcoin.Api.Blockchain as Blockchain +import qualified Data.Bitcoin.Types as BT +import qualified Network.Bitcoin.Api.Internal as I +import qualified Network.Bitcoin.Api.Types as T + +import Network.Bitcoin.Api.Types.UnspentTransaction + +-- | Creates a new transaction, but does not sign or submit it yet. You provide +-- a set of unspent transactions that you have the authority to spend, and you +-- provide a destination for all your bitcoins. +-- +-- __WARNING: Check your math!__ If the sum of the Btc in unspent transactions +-- of your request is more than the sum of the Btc in the destinations, this +-- will be the miner's fee. It is reasonable to leave a small amount for the +-- miners, but if there is a large discrepancy between input and output, there +-- are no guarantees you will be warned. +-- +-- All this function does is create a default script on how to spend coins from +-- one or more inputs to one or more outputs. Checking and verifying the +-- transaction will only happen when you actually submit the transaction to +-- the network. + +create :: T.Client -- ^ The client session we are using + -> [UnspentTransaction] -- ^ The inputs we are using for this transaction + -> [(BT.Address, BT.Btc)] -- ^ A key/value pair which associates a + -- destination address with a specific amount + -- of bitcoins to send. + -> IO Btc.Transaction +create client utxs outputs = + let configuration = [toJSON (map txToOutpoint utxs), object (map outToAddress outputs)] + + txToOutpoint tx = object [ + ("txid", toJSON (tx ^. transactionId)), + ("vout", toJSON (tx ^. vout))] + + outToAddress (addr, btc) = (B58S.toText addr, toJSON btc) + + in (return . Btc.decode) =<< I.call client "createrawtransaction" configuration + + +-- | Signs a raw transaction with configurable parameters. +sign :: T.Client -- ^ Our client context + -> Btc.Transaction -- ^ The transaction to sign + -> Maybe [UnspentTransaction] -- ^ Previous outputs being spent by this transaction + -> Maybe [BT.PrivateKey] -- ^ Private keys to use for signing. + -> IO (Btc.Transaction, Bool) -- ^ The signed transaction, and a boolean that is true + -- when the signing is complete or and is false when + -- more signatures are required. +sign client tx utxs pks = + let configuration = [configurationTx tx, configurationUtxs utxs, configurationPks pks] + + configurationTx tx' = + toJSON (Btc.encode tx') + + configurationUtxs Nothing = Null + configurationUtxs (Just utxs') = + toJSON (map utxToDependency utxs') + + where + utxToDependency utx = object [ + ("txid", toJSON (utx ^. transactionId)), + ("vout", toJSON (utx ^. vout)), + ("scriptPubKey", toJSON (utx ^. scriptPubKey)), + ("redeemScript", toJSON (utx ^. redeemScript))] + + + configurationPks Nothing = Null + configurationPks (Just privateKeys) = + toJSON privateKeys + + extractTransaction res = + maybe + (error "Incorrect JSON response") + Btc.decode + (res ^? key "hex" . _JSON) + + extractCompleted res = + fromMaybe + (error "Incorrect JSON response") + (res ^? key "complete" . _JSON) + + in do + res <- I.call client "signrawtransaction" configuration :: IO Value + return (extractTransaction res, extractCompleted res) + +-- | Sends a transaction through the Bitcoin network +send :: T.Client + -> Btc.Transaction + -> IO BT.TransactionId +send client tx = + let configuration = [toJSON (Btc.encode tx)] + + in I.call client "sendrawtransaction" configuration + +-- | Returns a list of transactions that occured since a certain block height. +-- If no block height was provided, the genisis block with height 0 is assumed. +-- The transactions returned are listed chronologically. +list :: T.Client + -> Maybe Integer + -> IO [Btc.Transaction] +list client Nothing = list client (Just 0) +list client (Just offset) = do + limit <- Blockchain.getBlockCount client + blocks <- mapM (Blockchain.getBlock client) =<< mapM (Blockchain.getBlockHash client) [offset..limit - 1] + + return $ foldl (\lhs rhs -> lhs ++ Btc.blockTxns rhs) [] blocks
+ src/Network/Bitcoin/Api/Types.hs view
@@ -0,0 +1,11 @@+module Network.Bitcoin.Api.Types where + +import qualified Network.Wreq as W +import qualified Network.Wreq.Session as WS + +-- | Client session data +data Client = Client { + clientUrl :: String, -- ^ The JSON RPC url + clientOpts :: W.Options, -- ^ Default HTTP options to use with `wreq` requests + clientSession :: WS.Session -- ^ Connection reuse of our HTTP session + } deriving ( Show )
+ src/Network/Bitcoin/Api/Types/UnspentTransaction.hs view
@@ -0,0 +1,74 @@+{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} + +module Network.Bitcoin.Api.Types.UnspentTransaction where + +import Control.Applicative ((<$>), (<*>)) +import Control.Lens.TH (makeLenses) +import Control.Monad (mzero) + +import qualified Data.Base58String as B58S +import Data.Word (Word64) + +import Data.Aeson +import Data.Aeson.Types + +import qualified Data.Bitcoin.Types as BT + +import qualified Data.Text as T + +-- | A transaction that is not yet spent. Every output transaction +-- relies on one or more unspent input transansactions. +-- +-- For more detailed documentation of the fields, see: +-- https://bitcoin.org/en/developer-reference#listunspent +data UnspentTransaction = UnspentTransaction { + + -- | The transaction amount in 'BT.Btc' + _amount :: BT.Btc, + + -- | Transaction identifier to uniquely identify the transaction. + _transactionId :: BT.TransactionId, + + -- | The index of the output of the transaction that has been spent. + _vout :: Integer, + + -- | Whether this input is spendable. If not, it means it is an output + -- of a watch-only address. + _spendable :: Bool, + + -- | The P2PKH or P2SH address this transaction belongs to. Only available in + -- case of P2PKH or P2SH output scripts. + _address :: Maybe B58S.Base58String, + + -- | If the address belongs to an account, the account is returned. + _account :: Maybe T.Text, + + -- | The amount of confirmations this transaction has + _confirmations :: Integer, + + -- | The output script paid, encoded as hex + _scriptPubKey :: T.Text, + + -- | If the output is a P2SH whose script belongs to this wallet, this is the + -- redeem script. + _redeemScript :: Maybe T.Text + + } deriving ( Show ) + +makeLenses ''UnspentTransaction + +instance FromJSON UnspentTransaction where + parseJSON (Object o) = + UnspentTransaction + <$> o .: "amount" + <*> o .: "txid" + <*> o .: "vout" + <*> o .: "spendable" + <*> o .:? "address" + <*> o .:? "account" + <*> o .: "confirmations" + <*> o .: "scriptPubKey" + <*> o .:? "redeemScript" + + parseJSON _ = mzero
+ src/Network/Bitcoin/Api/Wallet.hs view
@@ -0,0 +1,77 @@+{-# LANGUAGE OverloadedStrings #-} + +module Network.Bitcoin.Api.Wallet where + +import Data.Aeson +import Data.Aeson.Types + +import qualified Data.HashMap.Strict as HM +import qualified Data.Text as T + +import qualified Data.Bitcoin.Types as BT +import qualified Network.Bitcoin.Api.Internal as I +import qualified Network.Bitcoin.Api.Types as T +import Network.Bitcoin.Api.Types.UnspentTransaction (UnspentTransaction) + +-- | Lists unspent transaction with default parameters +listUnspent :: T.Client + -> IO [UnspentTransaction] +listUnspent client = listUnspentWith client 1 9999999 + +-- | Lists unspent transactions with configurable parameters +listUnspentWith :: T.Client -- ^ Our client context + -> Integer -- ^ Minimum amount of confirmations needed. Defaults to 1. + -> Integer -- ^ Maximum amount of confirmations. Defaults to 9999999. + -> IO [UnspentTransaction] +listUnspentWith client confMin confMax = + let configuration = [toJSON confMin, toJSON confMax, emptyArray] + + in I.call client "listunspent" configuration + +-- | Lists all accounts currently known by the wallet with default parameters +listAccounts :: T.Client + -> IO [(BT.Account, BT.Btc)] +listAccounts client = listAccountsWith client 1 False + +-- | Lists all accounts currently known by the wallet with configurable parameters +listAccountsWith :: T.Client -- ^ Our client context + -> Integer -- ^ Minimum amount of confirmations a transaction needs + -> Bool -- ^ Whether or not to include watch-only addresses + -> IO [(BT.Account, BT.Btc)] +listAccountsWith client confirmations watchOnly = + let configuration = [toJSON confirmations, toJSON watchOnly] + + in + return . HM.toList =<< I.call client "listaccounts" configuration + +-- | Provides access to a new receiving address filed under the default account. +-- Intended to be published to another party that wishes to send you money. +newAddress :: T.Client -- ^ Our client context + -> IO BT.Address -- ^ The address created +newAddress client = + I.call client "getnewaddress" emptyArray + +-- | Provides access to a new receiving address filed under a specific account. +-- Intended to be published to another party that wishes to send you money. +newAddressWith :: T.Client -- ^ Our client context + -> BT.Account -- ^ The account to create the address under + -> IO BT.Address -- ^ The address created +newAddressWith client account = + let configuration = [account] + + in I.call client "getnewaddress" configuration + +-- | Provides access to a new change address, which will not appear in the UI. +-- This is to be used with raw transactions only. +newChangeAddress :: T.Client -- ^ Our client context + -> IO BT.Address -- ^ The address created +newChangeAddress client = + I.call client "getrawchangeaddress" emptyArray + +-- | Provides access to the 'BT.Account' an 'BT.Address' belongs to. +getAddressAccount :: T.Client + -> BT.Address + -> IO BT.Account +getAddressAccount client address = + let configuration = [address] + in I.call client "getaccount" configuration
+ test/Main.hs view
@@ -0,0 +1,8 @@+module Main where + +import Test.Hspec.Runner +import qualified Spec + +main :: IO () +main = + hspecWith defaultConfig Spec.spec
+ test/Network/Bitcoin/ClientSpec.hs view
@@ -0,0 +1,195 @@+{-# LANGUAGE LambdaCase #-} + +module Network.Bitcoin.ClientSpec where + +import qualified Data.Bitcoin.Script as Btc +import qualified Data.Bitcoin.Transaction as Btc +import qualified Data.List as L (find) +import Data.Maybe (isJust, mapMaybe) + +import qualified Data.Text as T (pack) + +import Network.HTTP.Client (HttpException (..)) + +import Control.Lens ((^.)) +import Network.Bitcoin.Api.Client + +import qualified Network.Bitcoin.Api.Blockchain as Blockchain +import qualified Network.Bitcoin.Api.Dump as Dump +import qualified Network.Bitcoin.Api.Mining as Mining +import qualified Network.Bitcoin.Api.Misc as Misc +import qualified Network.Bitcoin.Api.Transaction as Transaction +import Network.Bitcoin.Api.Types.UnspentTransaction (address, amount) +import qualified Network.Bitcoin.Api.Wallet as Wallet +import Network.Wreq.Lens (statusCode) + +import Test.Hspec + +testClient :: (Client -> IO a) -> IO a +testClient = withClient "127.0.0.1" 18332 (T.pack "user") (T.pack "pass") + +isStatusCodeException :: Int -> HttpException -> Bool +isStatusCodeException code (StatusCodeException s _ _) = s ^. statusCode == code +isStatusCodeException _ _ = False + +spec :: Spec +spec = do + describe "when creating a new client session" $ do + it "callback returns generated value" $ do + testClient (\_ -> return "foo") `shouldReturn` "foo" + + it "fails when providing invalid authentication credentials" $ do + withClient "127.0.0.1" 18332 (T.pack "invaliduser") (T.pack "invalidpass") Misc.getInfo `shouldThrow` isStatusCodeException 401 + + describe "when testing miscelaneous functions" $ do + it "should be able to return server info" $ do + r <- testClient Misc.getInfo + + r ^. Misc.bitcoinVersion `shouldBe` 100100 + r ^. Misc.bitcoindErrors `shouldBe` (T.pack "") + + describe "when testing mining functions" $ do + it "can generate blocks" $ do + countBefore <- testClient Blockchain.getBlockCount + r <- testClient $ \client -> do + Mining.generate client 1 + + countAfter <- testClient Blockchain.getBlockCount + + length r `shouldBe` 1 + (countBefore + 1) `shouldBe` countAfter + + describe "when testing blockchain functions" $ do + it "can request blockcount" $ do + r <- testClient Blockchain.getBlockCount + + r `shouldSatisfy` (>= 100) + + it "can request block hashes" $ do + testClient $ \client -> do + count <- Blockchain.getBlockCount client + hashes <- mapM (Blockchain.getBlockHash client) [0..count - 1] + + fromIntegral (length (hashes)) `shouldBe` count + + it "can request blocks" $ do + testClient $ \client -> do + count <- Blockchain.getBlockCount client + blocks <- mapM (Blockchain.getBlock client) =<< mapM (Blockchain.getBlockHash client) [0..count - 1] + + fromIntegral (length (blocks)) `shouldBe` count + + describe "when testing wallet functions" $ do + it "should be able list unspent transactions" $ do + r <- testClient Wallet.listUnspent + length r `shouldSatisfy` (>= 1) + + it "should be able list all accounts" $ do + r <- testClient Wallet.listAccounts + length r `shouldSatisfy` (>= 1) + + it "should be able to create a new address under the default account" $ do + testClient $ \client -> do + addr <- Wallet.newAddress client + acc <- Wallet.getAddressAccount client addr + + acc `shouldBe` (T.pack "") + + it "should be able to create a new address under a specific account" $ do + testClient $ \client -> do + addr <- Wallet.newAddressWith client (T.pack "testAccount") + acc <- Wallet.getAddressAccount client addr + + acc `shouldBe` (T.pack "testAccount") + + -- Extra validation that the account also appears in the wallet + list <- Wallet.listAccounts client + L.find (\(needle, _) -> needle == T.pack "testAccount") list `shouldSatisfy` isJust + + it "should be able to create a change address" $ do + testClient $ \client -> do + addr <- Wallet.newChangeAddress client + acc <- Wallet.getAddressAccount client addr + + acc `shouldBe` (T.pack "") + + describe "when testing transaction functions" $ do + it "can create transaction" $ do + testClient $ \client -> do + utxs <- Wallet.listUnspent client + addr <- Wallet.newAddress client + tx <- Transaction.create client utxs [(addr, 50)] + + case tx of + (Btc.Transaction 1 _ [(Btc.TransactionOut 5000000000 (Btc.Script _))] 0) -> return () + _ -> expectationFailure ("Result does not match expected: " ++ show tx) + + it "can sign transaction without providing any input transactions" $ do + testClient $ \client -> do + utxs <- Wallet.listUnspent client + addr <- Wallet.newAddress client + tx <- Transaction.create client utxs [(addr, 50)] + (_, completed) <- Transaction.sign client tx Nothing Nothing + + completed `shouldBe` True + + it "can sign transaction when providing any input transactions" $ do + testClient $ \client -> do + utxs <- Wallet.listUnspent client + addr <- Wallet.newAddress client + tx <- Transaction.create client utxs [(addr, 50)] + (_, completed) <- Transaction.sign client tx (Just utxs) Nothing + + completed `shouldBe` True + + it "can sign transaction when providing any explicit signing key" $ do + testClient $ \client -> do + utxs <- Wallet.listUnspent client + addr <- Wallet.newAddress client + + -- Generates an array of private keys of all the input addresses we use + keys <- mapM (Dump.getPrivateKey client) $ mapMaybe (^. address) utxs + + tx <- Transaction.create client utxs [(addr, 50)] + (_, completed) <- Transaction.sign client tx Nothing (Just keys) + + -- This is an important check, since it validates that we are using the + -- correct keys and our manual signing works properly. + completed `shouldBe` True + + it "can send a transaction" $ do + testClient $ \client -> do + utxs <- Wallet.listUnspent client + + (length utxs) `shouldSatisfy` (>= 1) + + -- Calculate the total BTC of all unspent transactions + let btc = foldr (+) 0 $ map (^. amount) utxs + + addr <- Wallet.newAddress client + tx <- Transaction.create client utxs [(addr, (btc - 0.0001))] + (tx', completed) <- Transaction.sign client tx (Just utxs) Nothing + + completed `shouldBe` True + + txid <- Transaction.send client tx' + putStrLn ("txid = " ++ show txid) + True `shouldBe` True + + it "can list transactions" $ do + -- Generate some blocks, so we know for sure that some transactions are in + -- some blocks. + _ <- testClient $ \client -> Mining.generate client 10 + txs <- testClient $ \client -> Transaction.list client Nothing + + -- :TODO: validate that there transactions are in chronological order + length (txs) `shouldSatisfy` (>= 1) + + describe "when testing import/dump functions" $ do + it "should be able to dump private key" $ do + testClient $ \client -> do + addr <- Wallet.newAddress client + r <- Dump.getPrivateKey client addr + + putStrLn ("r = " ++ show r) + True `shouldBe` True
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --module-name=Spec #-}